|
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 - metrics - download
Length: 14336 (0x3800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Put_Code_For_Array_Type, seg_020bd4, separate Rpc_Io.Build_Interchange_Package_Body
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with String_Utilities;
with Bounds_Utilities;
with Lrm_Utilities;
separate (Rpc_Io.Build_Interchange_Package_Body)
procedure Put_Code_For_Array_Type (Array_Type_Decl : Ada.Declaration;
Array_Type_Def : Ada.Element) is
Component_Type : Ada.Element :=
Decls.Enclosing_Declaration (Ada.Definition
(Types.Component_Type (Array_Type_Def)));
function Image (Value : Integer;
Base : Natural := 10;
Width : Natural := 0;
Leading : Character := ' ') return String
renames String_Utilities.Number_To_String;
function Image_Of_Current_Type
(Type_Iterator : Ada.Element_Iterator) return String is
begin
return Analysis.Reference
(Decls.Enclosing_Declaration
(Ada.Definition (Ada.Value (Type_Iterator))));
end Image_Of_Current_Type;
function Data_Variable_Ref (No_Of_Dimensions : Natural) return String is
begin
if No_Of_Dimensions = 1 then
return "I1";
else
return Data_Variable_Ref (No_Of_Dimensions - 1) &
", " & "I" & Image (No_Of_Dimensions);
end if;
end Data_Variable_Ref;
begin
if Types.Is_Constrained_Array (Array_Type_Def) then
declare
Index_Types : Ada.Element_Iterator :=
Types.Index_Constraints (Array_Type_Def);
Index_Type : Ada.Element :=
Decls.Enclosing_Declaration
(Ada.Definition (Ada.Value (Index_Types)));
No_Of_Dimensions : Natural := Lrm_Utilities.Count (Index_Types);
Data_Variable_Image : constant String :=
"Data (" & Data_Variable_Ref (No_Of_Dimensions) & ")";
begin
Ada.Next (Index_Types);
Traverse (Index_Type);
Traverse (Component_Type);
-- BUILD PUT PROCEDURE
--
Put_Body_Start
(Array_Type_Decl, Kind => Put, Internal_Comment => "");
-- Build FOR loops
--
for Dimension in 1 .. No_Of_Dimensions loop
Put ("for I" & Image (Dimension) & " in Data'Range(" &
Image (Dimension) & ") loop", 1);
end loop;
if Is_Predefined (Component_Type) then
Put ("Transport_Interchange.Put (Into, " &
Data_Variable_Image & ");", 1);
else
Put ("Put (Into, " & Data_Variable_Image & ");", 1);
end if;
for Dimension in 1 .. No_Of_Dimensions loop
Put ("end loop;", 1);
end loop;
-- Build exception handlers
--
Put ("exception", 1);
Put ("when Standard.Constraint_Error | ");
Put ("Standard.Numeric_Error =>", 1);
Put ("raise Interchange.Constraint_Error;", 1);
Put (Ada_Io.Make_End);
-- BUILD GET FUNCTION
--
Put_Body_Start (Decl => Array_Type_Decl,
Make_Null => False,
Kind => Get,
Internal_Comment => "");
-- Build FOR loops
--
for Dimension in 1 .. No_Of_Dimensions loop
Put ("for I" & Image (Dimension) & " in Data'Range(" &
Image (Dimension) & ") loop", 1);
end loop;
if Is_Predefined (Component_Type) then
Put ("Transport_Interchange.Get (From, " &
Data_Variable_Image & ");", 1);
else
Put ("Get (From, " & Data_Variable_Image & ");", 1);
end if;
for Dimension in 1 .. No_Of_Dimensions loop
Put ("end loop;", 1);
end loop;
-- Build exception handler
--
Put ("exception", 1);
Put ("when Standard.Constraint_Error | ");
Put ("Standard.Numeric_Error =>", 1);
Put ("raise Interchange.Constraint_Error;", 1);
Put (Ada_Io.Make_End);
end;
else
declare
Index_Types : Ada.Element_Iterator :=
Types.Index_Subtype_Definitions (Array_Type_Def);
Index_Type : Ada.Element :=
Decls.Enclosing_Declaration
(Ada.Definition (Ada.Value (Index_Types)));
No_Of_Dimensions : Natural := Lrm_Utilities.Count (Index_Types);
Data_Variable_Image : constant String :=
"Data (" & Data_Variable_Ref (No_Of_Dimensions) & ")";
begin
Ada.Next (Index_Types);
Traverse (Index_Type);
Traverse (Component_Type);
-- BUILD PUT PROCEDURE
--
Put_Body_Start
(Array_Type_Decl, Kind => Put, Internal_Comment => "");
-- Build PUT calls for bounds
--
Ada.Reset (Index_Types);
for Dimension in 1 .. No_Of_Dimensions loop
Put ("Transport_Interchange.Put (Into, Interchange.Natural (" &
Image_Of_Current_Type (Index_Types) &
"'Pos (Data'First(" & Image (Dimension) & "))));", 1);
Put ("Transport_Interchange.Put (Into, Interchange.Natural (" &
Image_Of_Current_Type (Index_Types) &
"'Pos (Data'last(" & Image (Dimension) & "))));", 2);
Ada.Next (Index_Types);
end loop;
-- Build FOR loops
--
for Dimension in 1 .. No_Of_Dimensions loop
Put ("for I" & Image (Dimension) & " in Data'Range(" &
Image (Dimension) & ") loop", 1);
end loop;
if Is_Predefined (Component_Type) then
Put ("Transport_Interchange.Put (Into, " &
Data_Variable_Image & ");", 1);
else
Put ("Put (Into, " & Data_Variable_Image & ");", 1);
end if;
for Dimension in 1 .. No_Of_Dimensions loop
Put ("end loop;", 1);
end loop;
-- Build exception handlers
--
Put ("exception", 1);
Put ("when Standard.Constraint_Error | ");
Put ("Standard.Numeric_Error =>", 1);
Put ("raise Interchange.Constraint_Error;", 1);
Put (Ada_Io.Make_End);
-- BUILD GET FUNCTION
--
Put (Ascii.Lf & Ascii.Lf &
Ada_Io.Make_Function
(Name => "Get",
Kind => Ada_Io.Body_Part,
Parameters_Image => "From : Transport_Stream.Stream_Id",
Return_Expression =>
Analysis.Reference (Array_Type_Decl)));
-- Build local variable declarations
--
for Dimension in 1 .. No_Of_Dimensions loop
Put ("Lower_Bound" & Image (Dimension) &
" : Interchange.Natural;", 1);
Put ("Upper_Bound" & Image (Dimension) &
" : Interchange.Natural;", 1);
end loop;
Put (Ada_Io.Make_Begin);
-- Build GET calls for bounds
--
for Dimension in 1 .. No_Of_Dimensions loop
Put ("Transport_Interchange.Get (From, Lower_Bound" &
Image (Dimension) & ");", 1);
Put ("Transport_Interchange.Get (From, Upper_Bound" &
Image (Dimension) & ");", 2);
end loop;
Put ("declare", 1);
-- Build declaration for Data variable
--
Put ("Data : " & Analysis.Reference (Array_Type_Decl) & " (");
Ada.Reset (Index_Types);
for Dimension in 1 .. No_Of_Dimensions loop
Put (Image_Of_Current_Type (Index_Types) &
"'Val(Lower_Bound" & Image (Dimension) & ") .. " &
Image_Of_Current_Type (Index_Types) &
"'Val (Upper_Bound" & Image (Dimension) & ")");
if Dimension /= No_Of_Dimensions then
Put (", ");
end if;
Ada.Next (Index_Types);
end loop;
Put (");");
Put (Ada_Io.Make_Begin);
-- Build FOR loops
--
for Dimension in 1 .. No_Of_Dimensions loop
Put ("for I" & Image (Dimension) & " in Data'Range(" &
Image (Dimension) & ") loop", 1);
end loop;
if Is_Predefined (Component_Type) then
Put ("Transport_Interchange.Get (From, " &
Data_Variable_Image & ");", 1);
else
Put ("Get (From, " & Data_Variable_Image & ");", 1);
end if;
for Dimension in 1 .. No_Of_Dimensions loop
Put ("end loop;", 1);
end loop;
-- Build return and end clause;
--
Put ("return Data;", 1);
Put ("end;", 1);
-- Build exception handler
--
Put ("exception", 1);
Put ("when Standard.Constraint_Error | ");
Put ("Standard.Numeric_Error =>", 1);
Put ("raise Interchange.Constraint_Error;", 1);
Put (Ada_Io.Make_End);
end;
end if;
end Put_Code_For_Array_Type;
nblk1=d
nid=0
hdr6=1a
[0x00] rec0=1a rec1=00 rec2=01 rec3=038
[0x01] rec0=1a rec1=00 rec2=02 rec3=03a
[0x02] rec0=01 rec1=00 rec2=0d rec3=018
[0x03] rec0=1c rec1=00 rec2=03 rec3=066
[0x04] rec0=1a rec1=00 rec2=04 rec3=01a
[0x05] rec0=19 rec1=00 rec2=05 rec3=046
[0x06] rec0=01 rec1=00 rec2=0c rec3=028
[0x07] rec0=18 rec1=00 rec2=06 rec3=01e
[0x08] rec0=1c rec1=00 rec2=07 rec3=028
[0x09] rec0=16 rec1=00 rec2=08 rec3=072
[0x0a] rec0=1b rec1=00 rec2=09 rec3=006
[0x0b] rec0=1c rec1=00 rec2=0a rec3=00e
[0x0c] rec0=04 rec1=00 rec2=0b rec3=000
tail 0x2171d3098838d456bac4a 0x42a00088462061e03