|
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, package body Aggregate_Templates, seg_004614
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Bounds_Utilities;
with String_Utilities;
with Lrm_Utilities;
with Ada_Program;
with Lrm_Renames;
use Lrm_Renames;
package body Aggregate_Templates is
procedure Put_Expression_Prompt (Named : String := "") is
begin
if Named = "" then
Put ("[expression]");
else
Put ("[" & Named & "-expression]");
end if;
end Put_Expression_Prompt;
function Number_Of_Index_Subscripts
(Array_Type_Def : Ada.Element) return Natural is
Iter : Ada.Element_Iterator := Types.Index_Constraints (Array_Type_Def);
begin
return Lrm_Utilities.Count (Iter);
end Number_Of_Index_Subscripts;
procedure Array_Bounds (Type_Def : Ada.Element;
Max_Components : Positive;
Lower, Upper : out Integer) is
Iter : Ada.Element_Iterator := Types.Index_Constraints (Type_Def);
Index : Ada.Element := Ada.Value (Iter);
Lo, Hi : Long_Integer;
Static : Boolean;
Lo_Exp, Hi_Exp : Ada.Element;
begin
Bounds_Utilities.Find_Range (Index, Lo, Hi, Static, Lo_Exp, Hi_Exp);
if Static then
Lower := Integer (Lo);
if Hi - Lo <= Long_Integer (Max_Components) then
Upper := Integer (Hi);
else
Upper := Integer (Lo) + Integer (Max_Components) - 1;
end if;
else
Lower := 1;
Upper := 1;
end if;
end Array_Bounds;
procedure Put_Allocator (For_Type : Ada.Declaration; Expand : Boolean) is
begin
Put ("new " & Lrm_Utilities.Qualified_Reference (For_Type) & "'");
Put_Decl (For_Type, False, 1, Expand => Expand);
end Put_Allocator;
procedure Put_Decl (Type_Decl : Ada_Program.Element;
Number_Array_Components : Boolean := False;
Max_Array_Components : Positive;
Expand : Boolean := False) is
Type_Spec : Types.Type_Definition :=
Decls.Type_Specification (Type_Decl);
Upper, Lower : Integer;
begin
if Expand then
case Types.Kind (Type_Spec) is
when Types.An_Array_Type_Definition =>
Array_Bounds (Decls.Type_Specification (Type_Decl),
Max_Array_Components, Upper, Lower);
Put_Array (Type_Decl, Upper, Lower,
Number_Array_Components, Expand);
when Types.A_Record_Type_Definition =>
Put_Record (Type_Decl, Number_Array_Components,
Max_Array_Components, Expand);
when Types.An_Access_Type_Definition =>
Put_Allocator (For_Type => Ada.Definition
(Types.Access_To (Type_Spec)),
Expand => Expand);
when Types.A_Derived_Type_Definition =>
Put (Lrm_Utilities.Qualified_Reference (Type_Decl) & "(");
Put_Decl (Ada.Definition (Types.Derived_From (Type_Spec)),
Number_Array_Components,
Max_Array_Components, Expand);
Put (")");
when others =>
Put_Expression_Prompt (Decls.Name (Type_Decl));
end case;
else
Put_Expression_Prompt (Decls.Name (Type_Decl));
end if;
end Put_Decl;
procedure Put_Expression (Component : Ada.Element;
Is_String : Boolean := False) is
Init : Ada.Element;
Component_Type : Ada.Element := Ada.Definition
(Decls.Object_Type (Component));
begin
Init := Decls.Initial_Value (Component);
if Ada.Is_Nil (Init) then
if Is_String then
Put ("""" & """");
else
Put_Expression_Prompt (Decls.Name (Component_Type));
end if;
else
Put (Ada.Image (Init));
end if;
end Put_Expression;
procedure Put_Record_Component (Component : Ada.Element;
Number_Array_Components : Boolean := False;
Max_Array_Components : Positive;
Type_Ref : Ada.Element;
Expand : Boolean := False) is
Type_Decl : Ada.Element := Types.Parent_Declaration (Type_Ref);
Type_Def : Ada.Element := Decls.Type_Specification (Type_Decl);
Upper, Lower : Integer;
begin
Put (Decls.Name (Component));
Put (" => ");
if Expand then
case Types.Kind (Type_Def) is
when Types.An_Array_Type_Definition =>
if Types.Is_Predefined (Type_Def) then -- string type
Put_Expression (Component, Is_String => True);
else
Array_Bounds (Type_Def, Max_Array_Components,
Upper, Lower);
Put_Array (Type_Decl, Upper, Lower, False, Expand);
end if;
when Types.A_Record_Type_Definition =>
Put_Record (Type_Decl, Number_Array_Components,
Max_Array_Components, Expand);
when others =>
Put_Expression (Component);
end case;
else
Put_Expression (Component);
end if;
end Put_Record_Component;
procedure Put_Record (Type_Decl : Ada_Program.Element;
Number_Array_Components : Boolean := False;
Max_Array_Components : Positive;
Expand : Boolean := False) is
Type_Def : Ada.Element := Decls.Type_Specification (Type_Decl);
Type_Ref : Ada.Element;
Components : Ada.Element_Iterator := Types.Record_Components (Type_Def);
Component : Ada.Element;
Discriminants : Ada.Element_Iterator := Types.Discriminants (Type_Def);
Discriminant : Ada.Element;
begin
Put ("(");
while not Ada.Done (Discriminants) loop
Discriminant := Ada.Value (Discriminants);
Put (Decls.Name (Discriminant) & " => ");
Put_Expression_Prompt;
Ada.Next (Discriminants);
Put (", ");
New_Line;
end loop;
while not Ada.Done (Components) loop
Component := Ada.Value (Components);
case Types.Component_Kind (Component) is
when Types.A_Null_Component | Types.Not_A_Component =>
null;
when Types.A_Variant_Part_Component =>
Put ("-- variant_component here");
New_Line;
Put_Expression_Prompt;
when Types.A_Variable_Component =>
Put_Record_Component
(Component, Number_Array_Components,
Max_Array_Components,
Decls.Object_Type (Component), Expand);
end case;
Ada.Next (Components);
if not Ada.Done (Components) then
Put (", ");
New_Line;
end if;
end loop;
Put (")");
New_Line;
end Put_Record;
procedure Put_Array (Type_Decl : Ada_Program.Element;
Lower_Bound : Integer;
Upper_Bound : Integer;
Add_Numbering : Boolean := False;
Expand : Boolean := False) is
Return_Type_Ref : Types.Type_Definition :=
Types.Component_Type (Decls.Type_Specification (Type_Decl));
Return_Type_Decl : Ada.Element := Ada.Parent
(Ada.Definition (Return_Type_Ref));
begin
Put ("(");
for I in Lower_Bound .. Upper_Bound loop
if Add_Numbering then
Put (String_Utilities.Strip (Integer'Image (I)));
Put (" => ");
end if;
Put_Decl (Return_Type_Decl, Add_Numbering,
Upper_Bound - Lower_Bound + 1, Expand);
if I < Upper_Bound then
Put (", ");
New_Line;
end if;
end loop;
Put (")");
New_Line;
end Put_Array;
end Aggregate_Templates;
nblk1=d
nid=0
hdr6=1a
[0x00] rec0=1e rec1=00 rec2=01 rec3=036
[0x01] rec0=1b rec1=00 rec2=02 rec3=032
[0x02] rec0=12 rec1=00 rec2=03 rec3=086
[0x03] rec0=00 rec1=00 rec2=0d rec3=006
[0x04] rec0=18 rec1=00 rec2=04 rec3=01a
[0x05] rec0=00 rec1=00 rec2=0c rec3=014
[0x06] rec0=1c rec1=00 rec2=05 rec3=02c
[0x07] rec0=00 rec1=00 rec2=0b rec3=00e
[0x08] rec0=16 rec1=00 rec2=06 rec3=07a
[0x09] rec0=1d rec1=00 rec2=07 rec3=02a
[0x0a] rec0=00 rec1=00 rec2=0a rec3=004
[0x0b] rec0=1a rec1=00 rec2=08 rec3=03a
[0x0c] rec0=1c rec1=00 rec2=09 rec3=000
tail 0x21700244c815c65b34973 0x42a00088462061e03