|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 17408 (0x4400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Standard_Ada_Io, package body Subprograms, seg_004633
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Unbounded_String;
package body Standard_Ada_Io is
package Unbounded is new Unbounded_String (128);
Lf1 : constant String (1 .. 1) := (others => Ascii.Lf);
Lf2 : constant String (1 .. 2) := (others => Ascii.Lf);
Cr3 : constant String (1 .. 3) := (others => Ascii.Lf);
function Make_Label (For_Input : String) return String is
begin
if For_Input = "" then
return "";
else
return For_Input & ":" & Lf1;
end if;
end Make_Label;
function Make_With_Clause (Name : String) return String is
begin
return "with " & Name & ";" & Lf1;
end Make_With_Clause;
function Part_Indicator (For_Part : Unit_Part) return String is
begin
case For_Part is
when Spec_Part =>
return "";
when Body_Part =>
return "body ";
when Call =>
return "";
end case;
end Part_Indicator;
function Function_Part_Terminator (For_Part : Unit_Part) return String is
begin
case For_Part is
when Spec_Part =>
return ";" & Lf1;
when Body_Part =>
return " is" & Lf1;
when Call =>
return Lf1;
end case;
end Function_Part_Terminator;
function Procedure_Part_Terminator (For_Part : Unit_Part) return String is
begin
case For_Part is
when Spec_Part =>
return ";" & Lf1;
when Body_Part =>
return " is" & Lf1;
when Call =>
return ";" & Lf1;
end case;
end Procedure_Part_Terminator;
function Parameter_Separator (For_Part : Unit_Part) return String is
begin
case For_Part is
when Spec_Part =>
return "; " & Lf1;
when Body_Part =>
return "; " & Lf1;
when Call =>
return ", ";
end case;
end Parameter_Separator;
function Make_Package (Name : String; Kind : Unit_Part) return String is
begin
case Kind is
when Spec_Part =>
return "package " & Part_Indicator (Kind) & Name & " is" & Lf2;
when Body_Part =>
return "package " & Part_Indicator (Kind) & Name & " is" & Lf2;
when Call =>
raise Program_Error;
end case;
end Make_Package;
package body Subprograms is
function Form_Initial_Value (Current : String) return String is
begin
if Current = "" then
return Current;
else
return " := " & Current;
end if;
end Form_Initial_Value;
procedure Append_Parameters (Image : in out Unbounded.Variable_String;
Kind : Unit_Part;
Iter : in out Parameter_Iterator) is
Ids : Id_Iterator;
begin
while not Done (Iter) loop
case Kind is
when Spec_Part =>
Unbounded.Append (Image,
Formal_Name (Iter) & " : " &
Mode (Iter) & Type_Name (Iter) &
Form_Initial_Value
(Initial_Value (Iter)) & Lf1);
when Body_Part =>
Unbounded.Append (Image,
Formal_Name (Iter) & " : " &
Mode (Iter) & Type_Name (Iter) &
Form_Initial_Value
(Initial_Value (Iter)) & Lf1);
when Call =>
Ids := Formal_Names (Iter);
while not Ids_Done (Ids) loop
Unbounded.Append (Image,
Name (Ids) & " => " &
Ids_Initial_Value (Ids) & Lf1);
Ids_Next (Ids);
if not Ids_Done (Ids) then
Unbounded.Append (Image,
Parameter_Separator (Kind));
end if;
end loop;
end case;
Next (Iter);
if not Done (Iter) then
Unbounded.Append (Image, Parameter_Separator (Kind));
end if;
end loop;
end Append_Parameters;
function Make_Procedure
(Name : String;
Kind : Unit_Part;
Param_Iter : Parameter_Iterator) return String is
Local_Image : Unbounded.Variable_String;
No_Parameters : Boolean := Done (Param_Iter);
Local_Iter : Parameter_Iterator := Param_Iter;
begin
case Kind is
when Spec_Part | Body_Part =>
Unbounded.Append (Local_Image, "procedure " & Name);
when Call =>
Unbounded.Append (Local_Image, Name);
end case;
if not No_Parameters then
Unbounded.Append (Local_Image, " (");
Append_Parameters (Local_Image, Kind, Local_Iter);
Unbounded.Append (Local_Image, ")");
end if;
Unbounded.Append (Local_Image, Procedure_Part_Terminator (Kind));
return Unbounded.Image (Local_Image);
end Make_Procedure;
function Make_Function (Name : String;
Kind : Unit_Part;
Param_Iter : Parameter_Iterator;
Return_Expression : String) return String is
Local_Image : Unbounded.Variable_String;
No_Parameters : Boolean := Done (Param_Iter);
Local_Iter : Parameter_Iterator := Param_Iter;
begin
case Kind is
when Spec_Part | Body_Part =>
Unbounded.Append (Local_Image, "function " & Name);
when Call =>
Unbounded.Append (Local_Image, Name);
end case;
if not No_Parameters then
Unbounded.Append (Local_Image, " (");
Append_Parameters (Local_Image, Kind, Local_Iter);
Unbounded.Append (Local_Image, ") ");
end if;
case Kind is
when Spec_Part | Body_Part =>
Unbounded.Append (Local_Image,
" return " & Return_Expression);
when Call =>
null;
end case;
Unbounded.Append (Local_Image, Function_Part_Terminator (Kind));
return Unbounded.Image (Local_Image);
end Make_Function;
end Subprograms;
function Make_Procedure (Name : String;
Kind : Unit_Part;
Parameters_Image : String) return String is
begin
case Kind is
when Spec_Part =>
return "procedure " & Name & " (" &
Parameters_Image & ");" & Lf1;
when Body_Part =>
return "procedure " & Name & " (" &
Parameters_Image & ") is" & Lf1;
when Call =>
return Name & " (" & Parameters_Image & ");" & Lf1;
end case;
end Make_Procedure;
function Make_Function (Name : String;
Kind : Unit_Part;
Parameters_Image : String;
Return_Expression : String) return String is
begin
case Kind is
when Spec_Part =>
return "function " & Name & " (" & Parameters_Image &
") return " & Return_Expression & ";" & Lf1;
when Body_Part =>
return "function " & Name & " (" & Parameters_Image &
") return " & Return_Expression & " is" & Lf1;
when Call =>
return Return_Expression & " := " & Name &
" (" & Parameters_Image & ")" & Lf1;
end case;
end Make_Function;
function Make_Exception (Name : String) return String is
begin
return Name & " : exception;" & Lf1;
end Make_Exception;
function Make_Assignment (Name : String;
Expression : String) return String is
begin
return Name & " := " & Expression & ";" & Lf1;
end Make_Assignment;
function Make_Declare (Label : String := "") return String is
begin
return Make_Label (Label) & "declare" & Lf1;
end Make_Declare;
function Make_Begin return String is
begin
return "begin" & Lf1;
end Make_Begin;
function Make_End (Name : String := "") return String is
begin
return "end " & Name & ";" & Lf1;
end Make_End;
function Make_Exception_Handler return String is
begin
return "exception" & Lf1;
end Make_Exception_Handler;
function Make_If_Header (Expression : String) return String is
begin
return "if " & Expression & " then" & Lf1;
end Make_If_Header;
function Make_Elsif (Expression : String) return String is
begin
return "elsif " & Expression & " then" & Lf1;
end Make_Elsif;
function Make_Else return String is
begin
return "else" & Lf1;
end Make_Else;
function Make_End_If return String is
begin
return "end if;" & Lf1;
end Make_End_If;
function Make_Case_Header (Expression : String) return String is
begin
return "case " & Expression & " is" & Lf1;
end Make_Case_Header;
function Make_Alternative (Expression : String) return String is
begin
return "when " & Expression & " =>" & Lf1;
end Make_Alternative;
function Make_End_Case return String is
begin
return "end case;" & Lf1;
end Make_End_Case;
function Make_Loop (Label : String := "") return String is
begin
return Make_Label (Label) & "loop" & Lf1;
end Make_Loop;
function Make_For_Loop (Iteration_Variable : String := "I";
Lower : String;
Upper : String;
Label : String := "";
Add_Reverse : Boolean := False) return String is
begin
if Add_Reverse then
return Make_Label (Label) & "for " & Iteration_Variable &
" in " & Lower & " .. " & Upper & " loop" & Lf1;
else
return Make_Label (Label) & "for " & Iteration_Variable &
" in reverse " & Lower & " .. " & Upper & " loop" & Lf1;
end if;
end Make_For_Loop;
function Make_While_Loop (Termination_Expression : String;
Label : String := "") return String is
begin
return Make_Label (Label) & "while " &
Termination_Expression & " loop" & Lf1;
end Make_While_Loop;
function Make_End_Loop return String is
begin
return "end loop;" & Lf1;
end Make_End_Loop;
function Make_Exit (Condition : String := "") return String is
begin
if Condition = "" then
return "exit;" & Lf1;
else
return "exit when " & Condition & ";" & Lf1;
end if;
end Make_Exit;
function Make_Return (Expression : String := "") return String is
begin
if Expression = "" then
return "return;" & Lf1;
else
return "return " & Expression & ";" & Lf1;
end if;
end Make_Return;
function Make_Variable_Declaration (Name : String;
Type_Mark : String) return String is
begin
return Name & " : " & Type_Mark & ";" & Lf1;
end Make_Variable_Declaration;
function Make_Constant_Declaration (Name : String;
Type_Mark : String;
Initial_Value : String) return String is
begin
return Name & " : constant " & Type_Mark &
" := " & Initial_Value & ";" & Lf1;
end Make_Constant_Declaration;
function Make_Raise (The_Exception : String := "") return String is
begin
if The_Exception = "" then
return "raise;" & Lf1;
else
return "raise " & The_Exception & ";" & Lf1;
end if;
end Make_Raise;
end Standard_Ada_Io;
nblk1=10
nid=0
hdr6=20
[0x00] rec0=23 rec1=00 rec2=01 rec3=008
[0x01] rec0=20 rec1=00 rec2=02 rec3=02c
[0x02] rec0=1e rec1=00 rec2=03 rec3=048
[0x03] rec0=13 rec1=00 rec2=04 rec3=00a
[0x04] rec0=1a rec1=00 rec2=05 rec3=050
[0x05] rec0=1a rec1=00 rec2=06 rec3=036
[0x06] rec0=02 rec1=00 rec2=10 rec3=016
[0x07] rec0=17 rec1=00 rec2=07 rec3=026
[0x08] rec0=01 rec1=00 rec2=0f rec3=010
[0x09] rec0=1a rec1=00 rec2=08 rec3=02e
[0x0a] rec0=18 rec1=00 rec2=09 rec3=004
[0x0b] rec0=21 rec1=00 rec2=0a rec3=000
[0x0c] rec0=24 rec1=00 rec2=0b rec3=032
[0x0d] rec0=18 rec1=00 rec2=0c rec3=00a
[0x0e] rec0=1d rec1=00 rec2=0d rec3=044
[0x0f] rec0=10 rec1=00 rec2=0e rec3=000
tail 0x2150044cc815c66152ca4 0x42a00088462061e03