|
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: 12288 (0x3000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Our_List, seg_0496a1
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Text_Io;
package body Our_List is
L : List;
Pointer_Types, Pointer_Fields : List;
Part_Of_The_Script : Integer := 0;
Tmp_String : Our_String.Variable_String;
Is_It_First_Field : Boolean := False;
procedure Init_List is
Tmp : Object;
begin
L := Create;
Tmp := Affect ("string");
Attach (L, Tmp);
Tmp := Affect ("boolean");
Attach (L, Tmp);
Tmp := Affect ("enum");
Attach (L, Tmp);
Tmp := Affect ("integer");
Attach (L, Tmp);
end Init_List;
function Get_List_Of_Types return List is
begin
return (L);
end Get_List_Of_Types;
procedure Printall_List_Of_Types is
begin
Printall (Makelistiter (L));
end Printall_List_Of_Types;
procedure Set_Part_Of_The_Script (The_Part : Integer) is
begin
Part_Of_The_Script := The_Part;
end Set_Part_Of_The_Script;
function Get_Part_Of_The_Script return Integer is
begin
return Part_Of_The_Script;
end Get_Part_Of_The_Script;
procedure First_Field is
begin
Is_It_First_Field := True;
end First_Field;
procedure Add_Type (New_Type : String) is
Tmp : Object;
Tmp_Iter : Iter;
begin
Tmp := Affect (New_Type);
if not (Isinlist (L, Tmp)) then
Pointer_Types := Go_To_End (L);
Attach (L, Tmp);
Pointer_Types := Tail (Pointer_Types);
Pointer_Fields := Pointer_Types;
else
Tmp_Iter := Iteronobject (L, New_Type);
Pointer_Types := List (Tmp_Iter);
Pointer_Fields := Pointer_Types;
end if;
end Add_Type;
procedure Add_Field (New_Field : String) is
begin
if Part_Of_The_Script = 1 then
Our_String.Free (Tmp_String);
Our_String.Copy (Tmp_String, New_Field);
end if;
end Add_Field;
procedure Complete_Field_With_Type (Type_Of_Field : String) is
Tmp, Tmp1 : Object;
begin
if (Isinlist (L, Pointer_Fields.Info) and (Type_Of_Field = "enum")) then
Our_String.Copy (Pointer_Fields.Info.The_Type, "enum");
else
Tmp1 := Affect (Type_Of_Field);
if Isinlist (L, Tmp1) then
Tmp := Affect (Our_String.Image (Tmp_String), Type_Of_Field);
if Is_It_First_Field then
Pointer_Types.Info.Pointer := Create;
Attach (Pointer_Types.Info.Pointer, Tmp);
Pointer_Fields := Pointer_Types.Info.Pointer;
Is_It_First_Field := False;
else
Attach (Pointer_Types.Info.Pointer, Tmp);
Pointer_Fields := Tail (Pointer_Fields);
end if;
else
Text_Io.Put_Line ("Unknown type : " & Type_Of_Field);
end if;
end if;
end Complete_Field_With_Type;
procedure Add_Enum (New_Enum : String) is
Tmp : Object;
begin
if Part_Of_The_Script = 1 then
Tmp := Affect (New_Enum);
Attach (Pointer_Fields.Info.Pointer, Tmp);
end if;
end Add_Enum;
function Affect (A_Name : String;
A_Type : String := "";
A_String_Value : String := "") return Object is
Tmp : Object;
begin
Our_String.Copy (Tmp.Name, A_Name);
Our_String.Copy (Tmp.The_Type, A_Type);
Our_String.Copy (Tmp.Value, A_String_Value);
Tmp.Pointer := null;
return Tmp;
end Affect;
function Create return List is
begin
return P_List.Create;
end Create;
function Cellvalue (The_Iter : Iter) return Object is
begin
return P_List.Cellvalue (The_Iter);
end Cellvalue;
procedure Attach (The_List : in out List; The_Object : Object) is
begin
P_List.Attach (The_List, The_Object);
end Attach;
procedure Attach (The_List1 : in out List; The_List2 : List) is
begin
P_List.Attach (The_List1, The_List2);
end Attach;
function Attach (The_Object1 : Object; The_Object2 : Object) return List is
begin
return P_List.Attach (The_Object1, The_Object2);
end Attach;
function Copy (The_List : List) return List is
begin
return P_List.Copy (The_List);
end Copy;
procedure Destroy (The_List : in out List) is
begin
P_List.Destroy (The_List);
end Destroy;
procedure Forward (The_Iter : in out Iter) is
begin
P_List.Forward (The_Iter);
end Forward;
function Isinlist (The_List : List; The_Object : Object) return Boolean is
begin
return P_List.Isinlist (The_List, The_Object);
end Isinlist;
function Isinlist (The_List : List; The_Name : String) return Boolean is
Tmp_Object : Object;
begin
Tmp_Object := Affect (The_Name);
return P_List.Isinlist (The_List, Tmp_Object);
end Isinlist;
function Makelistiter (The_List : List) return Iter is
begin
return P_List.Makelistiter (The_List);
end Makelistiter;
function Makeiterlist (The_Iter : Iter) return List is
begin
return List (The_Iter);
end Makeiterlist;
function Iteronobject (The_List : List; The_Name : String) return Iter is
I : Iter;
begin
if Isinlist (The_List, The_Name) then
I := Makelistiter (The_List);
while not (Our_String.Image (Cellvalue (I).Name) = The_Name) loop
Forward (I);
end loop;
end if;
return I;
end Iteronobject;
function More (The_Iter : Iter) return Boolean is
begin
return P_List.More (The_Iter);
end More;
procedure Print (The_Iter : Iter) is
begin
Text_Io.Put ("Name : " & Our_String.Image (The_Iter.Info.Name));
Text_Io.Put (", the_type : " &
Our_String.Image (The_Iter.Info.The_Type));
Text_Io.Put_Line (", string_value : " &
Our_String.Image (The_Iter.Info.Value));
end Print;
function Go_To_End (The_List : List) return List is
Tmp_List : List;
begin
Tmp_List := The_List;
if More (Iter (Tmp_List)) then
if More (Iter (Tmp_List.Next)) then
while More (Iter (Tmp_List.Next)) loop
Tmp_List := Tail (Tmp_List);
end loop;
end if;
end if;
return (Tmp_List);
end Go_To_End;
procedure Printall (The_Iter : Iter) is
Tmp_Iter : Iter;
use P_List;
begin
Tmp_Iter := The_Iter;
while More (Tmp_Iter) loop
Print (Tmp_Iter);
if More (Iter (Tmp_Iter.Info.Pointer)) then
Printall (Iter (Tmp_Iter.Info.Pointer));
end if;
Forward (Tmp_Iter);
end loop;
end Printall;
function Tail (The_List : in List) return List is
begin
return P_List.Tail (The_List);
end Tail;
end Our_List;
nblk1=b
nid=5
hdr6=14
[0x00] rec0=2b rec1=00 rec2=01 rec3=03e
[0x01] rec0=0c rec1=00 rec2=0a rec3=004
[0x02] rec0=23 rec1=00 rec2=08 rec3=068
[0x03] rec0=1e rec1=00 rec2=07 rec3=00a
[0x04] rec0=2c rec1=00 rec2=0b rec3=05a
[0x05] rec0=04 rec1=00 rec2=03 rec3=01c
[0x06] rec0=2e rec1=00 rec2=06 rec3=000
[0x07] rec0=2c rec1=00 rec2=04 rec3=000
[0x08] rec0=22 rec1=00 rec2=09 rec3=01c
[0x09] rec0=0f rec1=00 rec2=02 rec3=000
[0x0a] rec0=17 rec1=00 rec2=05 rec3=000
tail 0x21546c42e865e5b976053 0x42a00088462060003
Free Block Chain:
0x5: 0000 00 00 03 23 00 1c 20 20 20 20 20 20 20 20 54 6d ┆ # Tm┆