|
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: 36864 (0x9000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Complement_Array, seg_0499bb, seg_049a49, seg_049a70
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Text_Io, Complement_Identifier_Array,
Field_Identifier_Array, Generic_String_Sort_Array;
package body Complement_Array is
package C_Array is new Generic_String_Sort_Array
(Element => Complement.Object,
Max_Element_Number =>
Complement_Identifier_Array.Max_Element,
Null_Element => Complement.Null_Object,
Get_Key => Complement.Name,
Show_Element => Complement.Show);
The_Array : C_Array.Object := C_Array.Null_Object;
The_Iterator : C_Array.Iterator := C_Array.Null_Iterator;
Global_Ok : Boolean;
procedure Put (Old_Subject : in Complement.Object;
Name : in Identifier.Object;
Ok : out Boolean) is
New_Subject : Complement.Object;
Local_Ok : Boolean;
begin
if Complement.Is_A_Subject (Old_Subject) then
Local_Ok := True;
Complement.Copy (Old_Subject, New_Subject);
Complement.Put_Name (New_Subject, Name, Local_Ok);
C_Array.Put (The_Array, New_Subject, Local_Ok);
if Local_Ok then
Complement_Identifier_Array.Put (Name);
end if;
else
Local_Ok := False;
end if;
Ok := Local_Ok;
end Put;
procedure Put_Word (Word : in Identifier.Object; Ok : out Boolean) is
New_Word : Complement.Object;
Local_Ok : Boolean;
begin
Complement.Put_Word (New_Word, Word);
C_Array.Put (The_Array, New_Word, Local_Ok);
if Local_Ok then
Complement_Identifier_Array.Put (Word);
end if;
Ok := Local_Ok;
end Put_Word;
procedure Put_Verb (A_Synonym, A_Verb : in Identifier.Object;
Ok : out Boolean) is
New_Verb : Complement.Object;
Local_Ok : Boolean;
begin
Complement.Put_Verb (New_Verb, A_Synonym, A_Verb);
C_Array.Put (The_Array, New_Verb, Local_Ok);
if Local_Ok then
Complement_Identifier_Array.Put (A_Synonym);
end if;
Ok := Local_Ok;
end Put_Verb;
procedure Create_Number_Field (Subject_Index : in Natural;
Field_Index : in Positive;
Ok : out Boolean) is
A_Subject : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Subject, Subject_Index, Local_Ok);
if Local_Ok then
Complement.Create_Number_Field (A_Subject, Field_Index, Ok);
C_Array.Put (The_Array, A_Subject);
else
Ok := False;
end if;
end Create_Number_Field;
procedure Create_Sentence_Field (Subject_Index : in Natural;
Field_Index : in Positive;
Ok : out Boolean) is
A_Subject : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Subject, Subject_Index, Local_Ok);
if Local_Ok then
Complement.Create_Sentence_Field (A_Subject, Field_Index, Ok);
C_Array.Put (The_Array, A_Subject);
else
Ok := False;
end if;
end Create_Sentence_Field;
procedure Create_Enumerate_Field (Subject_Index : in Natural;
Field_Index : in Positive;
Ok : out Boolean) is
A_Subject : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Subject, Subject_Index, Local_Ok);
if Local_Ok then
Complement.Create_Enumerate_Field (A_Subject, Field_Index, Ok);
C_Array.Put (The_Array, A_Subject);
else
Ok := False;
end if;
end Create_Enumerate_Field;
procedure Field_Put_Number (Subject_Index : in Natural;
Field_Index : in Positive;
Number : in Integer;
Ok : out Boolean) is
A_Subject : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Subject, Subject_Index, Local_Ok);
if Local_Ok then
Complement.Field_Put_Number (A_Subject, Field_Index, Number, Ok);
C_Array.Put (The_Array, A_Subject);
else
Ok := False;
end if;
end Field_Put_Number;
procedure Field_Put_Sentence (Subject_Index : in Natural;
Field_Index : in Positive;
Sentence : in Identifier.Object;
Ok : out Boolean) is
A_Subject : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Subject, Subject_Index, Local_Ok);
if Local_Ok then
Complement.Field_Put_Sentence
(A_Subject, Field_Index, Sentence, Ok);
C_Array.Put (The_Array, A_Subject);
else
Ok := False;
end if;
end Field_Put_Sentence;
procedure Field_Put_Enumerate (Subject_Index : in Natural;
Field_Index : in Positive;
Enumeration, Literal : in Positive;
Ok : out Boolean) is
A_Subject : Complement.Object;
Direction : Natural := Complement_Identifier_Array.Index
(Field_Identifier_Array.Image (Field_Index));
Other_Direction : Natural;
Other_Place : Natural;
Other_Field_Index : Natural;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Subject, Subject_Index, Local_Ok);
if Local_Ok then
Complement.Field_Put_Enumerate (A_Subject, Field_Index,
Enumeration, Literal, Local_Ok);
C_Array.Put (The_Array, A_Subject);
if Direction in Positive and then
Complement.Exit_Exist (A_Subject, Direction) then
Other_Direction := Complement.Next_Direction
(A_Subject, Direction);
Other_Place := Complement.Next_Place (A_Subject, Direction);
Other_Field_Index :=
Field_Identifier_Array.Index
(Complement_Identifier_Array.Image (Other_Direction));
C_Array.Get (The_Array, A_Subject, Other_Place, Local_Ok);
if Local_Ok then
Complement.Field_Put_Enumerate
(A_Subject, Other_Field_Index,
Enumeration, Literal, Local_Ok);
C_Array.Put (The_Array, A_Subject);
end if;
end if;
end if;
Ok := Local_Ok;
end Field_Put_Enumerate;
procedure Put_Movement (Animate_Name : in Identifier.Object;
Place : in Positive) is
An_Animate : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, An_Animate,
Identifier.Image (Animate_Name), Local_Ok);
if Local_Ok then
Complement.Put_Movement (An_Animate, Place);
C_Array.Put (The_Array, An_Animate);
end if;
end Put_Movement;
procedure Move (Animate_Index : in Natural) is
An_Animate : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, An_Animate, Animate_Index, Local_Ok);
if Local_Ok then
Complement.Move (An_Animate);
C_Array.Put (The_Array, An_Animate);
end if;
end Move;
procedure Put_Exit (Place_Index : in Natural;
Name, Start_Place, Start_Direction,
Next_Place, Next_Direction : in Positive;
Ok : out Boolean) is
A_Place : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Place, Place_Index, Local_Ok);
if Local_Ok then
Complement.Put_Exit (A_Place, Name, Start_Place, Start_Direction,
Next_Place, Next_Direction, Ok);
C_Array.Put (The_Array, A_Place);
else
Ok := False;
end if;
end Put_Exit;
function Exit_Exist (Place_Index : in Natural; Direction : in Positive)
return Boolean is
A_Place : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Place, Place_Index, Local_Ok);
if Local_Ok then
return Complement.Exit_Exist (A_Place, Direction);
else
return False;
end if;
end Exit_Exist;
function Exits_Exist (Place_Index : in Natural) return Boolean is
A_Place : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Place, Place_Index, Local_Ok);
if Local_Ok then
return Complement.Exits_Exist (A_Place);
else
return False;
end if;
end Exits_Exist;
function Exit_Name (Place_Index : in Natural; Direction : in Positive)
return String is
A_Place : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Place, Place_Index, Local_Ok);
if Local_Ok then
return Name (Complement.Exit_Name (A_Place, Direction));
else
return "";
end if;
end Exit_Name;
function Next_Place (Place_Index : in Natural; Direction : in Positive)
return Natural is
A_Place : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Place, Place_Index, Local_Ok);
if Local_Ok then
return Complement.Next_Place (A_Place, Direction);
else
return 0;
end if;
end Next_Place;
procedure Put_Place (Subject_Index : in Natural;
Place : in Natural;
Ok : out Boolean) is
A_Subject : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Subject, Subject_Index, Local_Ok);
if Local_Ok then
Complement.Put_Place (A_Subject, Place, Ok);
C_Array.Put (The_Array, A_Subject);
else
Ok := False;
end if;
end Put_Place;
procedure Show is
begin
Text_Io.Put_Line ("Complement Array :");
C_Array.Show (The_Array);
end Show;
procedure Show (Subject_Name : in String) is
A_Subject : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Subject, Subject_Name, Local_Ok);
if Local_Ok then
Complement.Show (A_Subject);
end if;
end Show;
procedure List_Exits_Init (Place_Index : in Natural) is
A_Place : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Place, Place_Index, Local_Ok);
if Local_Ok then
Complement.List_Exits_Init (A_Place);
C_Array.Put (The_Array, A_Place);
end if;
end List_Exits_Init;
procedure List_Exits_Next (Place_Index : in Natural) is
A_Place : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Place, Place_Index, Local_Ok);
if Local_Ok then
Complement.List_Exits_Next (A_Place);
C_Array.Put (The_Array, A_Place);
end if;
end List_Exits_Next;
function List_Exits_Direction (Place_Index : in Natural) return String is
A_Place : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Place, Place_Index, Local_Ok);
if Local_Ok then
return Name (Complement.List_Exits_Direction (A_Place));
else
return "";
end if;
end List_Exits_Direction;
function List_Exits_Done (Place_Index : in Natural) return Boolean is
A_Place : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Place, Place_Index, Local_Ok);
if Local_Ok then
return Complement.List_Exits_Done (A_Place);
else
return True;
end if;
end List_Exits_Done;
procedure Put_Group (Complement_Name : in Identifier.Object;
A_Group : in Identifier.Object;
Ok : out Boolean) is
A_Complement : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Complement,
Identifier.Image (Complement_Name), Local_Ok);
if Local_Ok then
Complement.Put_Group (A_Complement, A_Group, Ok);
C_Array.Put (The_Array, A_Complement);
else
Ok := False;
end if;
end Put_Group;
function Group (Complement_Name : in String) return String is
A_Complement : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Complement, Complement_Name, Local_Ok);
if Local_Ok then
return Complement.Group (A_Complement);
else
return "";
end if;
end Group;
procedure List_Complement_Init is
begin
C_Array.Init (The_Array, The_Iterator);
end List_Complement_Init;
procedure List_Complement_Next is
begin
C_Array.Next (The_Iterator);
end List_Complement_Next;
function List_Complement_Place return Natural is
begin
return Complement.Place (C_Array.Value (The_Iterator));
end List_Complement_Place;
function List_Complement_Name return String is
begin
return Complement.Name (C_Array.Value (The_Iterator));
end List_Complement_Name;
function List_Complement_Done return Boolean is
begin
return C_Array.Done (The_Iterator);
end List_Complement_Done;
function Field_Is_A_Number
(Subject_Index : in Natural; Field_Index : in Positive)
return Boolean is
A_Subject : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Subject, Subject_Index, Local_Ok);
if Local_Ok then
return Complement.Field_Is_A_Number (A_Subject, Field_Index);
else
return False;
end if;
end Field_Is_A_Number;
function Field_Is_A_Sentence
(Subject_Index : in Natural; Field_Index : in Positive)
return Boolean is
A_Subject : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Subject, Subject_Index, Local_Ok);
if Local_Ok then
return Complement.Field_Is_A_Sentence (A_Subject, Field_Index);
else
return False;
end if;
end Field_Is_A_Sentence;
function Field_Is_An_Enumerate
(Subject_Index : in Natural; Field_Index : in Positive)
return Boolean is
A_Subject : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Subject, Subject_Index, Local_Ok);
if Local_Ok then
return Complement.Field_Is_An_Enumerate (A_Subject, Field_Index);
else
return False;
end if;
end Field_Is_An_Enumerate;
function Field_Belong
(Subject_Index : in Natural; Field_Index : in Positive)
return Boolean is
A_Subject : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Subject, Subject_Index, Local_Ok);
if Local_Ok then
return Complement.Field_Belong (A_Subject, Field_Index);
else
return False;
end if;
end Field_Belong;
function Is_A_Subject (Complement_Name : in String) return Boolean is
A_Complement : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Complement, Complement_Name, Local_Ok);
if Local_Ok then
return Complement.Is_A_Subject (A_Complement);
else
return False;
end if;
end Is_A_Subject;
function Is_An_Animate (Complement_Name : in String) return Boolean is
A_Complement : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Complement, Complement_Name, Local_Ok);
if Local_Ok then
return Complement.Is_An_Animate (A_Complement);
else
return False;
end if;
end Is_An_Animate;
function Is_A_Place (Complement_Name : in String) return Boolean is
A_Complement : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Complement, Complement_Name, Local_Ok);
if Local_Ok then
return Complement.Is_A_Place (A_Complement);
else
return False;
end if;
end Is_A_Place;
function Is_An_Entity (Complement_Name : in String) return Boolean is
A_Complement : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Complement, Complement_Name, Local_Ok);
if Local_Ok then
return Complement.Is_An_Entity (A_Complement);
else
return False;
end if;
end Is_An_Entity;
function Is_A_Word (Complement_Name : in String) return Boolean is
A_Complement : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Complement, Complement_Name, Local_Ok);
if Local_Ok then
return Complement.Is_A_Word (A_Complement);
else
return False;
end if;
end Is_A_Word;
function Is_A_Verb (Complement_Name : in String) return Boolean is
A_Complement : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Complement, Complement_Name, Local_Ok);
if Local_Ok then
return Complement.Is_A_Verb (A_Complement);
else
return False;
end if;
end Is_A_Verb;
function Belong (Complement_Name : in String) return Boolean is
begin
return C_Array.Belong (The_Array, Complement_Name);
end Belong;
function Name (Subject_Index : in Natural) return String is
A_Complement : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Complement, Subject_Index, Local_Ok);
if Local_Ok then
return Complement.Name (A_Complement);
else
return "";
end if;
end Name;
function Index (Complement_Name : in String) return Natural is
begin
return C_Array.Index (The_Array, Complement_Name);
end Index;
function Place (Subject_Index : in Natural) return Natural is
A_Subject : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Subject, Subject_Index, Local_Ok);
if Local_Ok then
return Complement.Place (A_Subject);
else
return 0;
end if;
end Place;
function Field_Number
(Subject_Index : in Natural; Field_Index : in Positive)
return Integer is
A_Subject : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Subject, Subject_Index, Local_Ok);
if Local_Ok then
return Complement.Field_Number (A_Subject, Field_Index);
else
return 0;
end if;
end Field_Number;
function Field_Sentence
(Subject_Index : in Natural; Field_Index : in Positive)
return String is
A_Subject : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Subject, Subject_Index, Local_Ok);
if Local_Ok then
return Complement.Field_Sentence (A_Subject, Field_Index);
else
return "";
end if;
end Field_Sentence;
function Field_Enumeration
(Subject_Index : in Natural; Field_Index : in Positive)
return Natural is
A_Subject : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Subject, Subject_Index, Local_Ok);
if Local_Ok then
return Complement.Field_Enumeration (A_Subject, Field_Index);
else
return 0;
end if;
end Field_Enumeration;
function Field_Literal
(Subject_Index : in Natural; Field_Index : in Positive)
return Natural is
A_Subject : Complement.Object;
Local_Ok : Boolean;
begin
C_Array.Get (The_Array, A_Subject, Subject_Index, Local_Ok);
if Local_Ok then
return Complement.Field_Literal (A_Subject, Field_Index);
else
return 0;
end if;
end Field_Literal;
end Complement_Array;
nblk1=23
nid=1a
hdr6=32
[0x00] rec0=1b rec1=00 rec2=01 rec3=02e
[0x01] rec0=20 rec1=00 rec2=1f rec3=00c
[0x02] rec0=1e rec1=00 rec2=23 rec3=012
[0x03] rec0=1b rec1=00 rec2=1d rec3=03a
[0x04] rec0=1d rec1=00 rec2=13 rec3=004
[0x05] rec0=19 rec1=00 rec2=1c rec3=036
[0x06] rec0=08 rec1=00 rec2=12 rec3=042
[0x07] rec0=15 rec1=00 rec2=1b rec3=03c
[0x08] rec0=1f rec1=00 rec2=0f rec3=000
[0x09] rec0=20 rec1=00 rec2=0e rec3=03a
[0x0a] rec0=0c rec1=00 rec2=1e rec3=056
[0x0b] rec0=21 rec1=00 rec2=0c rec3=000
[0x0c] rec0=28 rec1=00 rec2=17 rec3=02c
[0x0d] rec0=20 rec1=00 rec2=0b rec3=014
[0x0e] rec0=20 rec1=00 rec2=18 rec3=016
[0x0f] rec0=27 rec1=00 rec2=11 rec3=022
[0x10] rec0=23 rec1=00 rec2=0a rec3=01e
[0x11] rec0=20 rec1=00 rec2=08 rec3=02a
[0x12] rec0=0d rec1=00 rec2=20 rec3=002
[0x13] rec0=1f rec1=00 rec2=16 rec3=018
[0x14] rec0=23 rec1=00 rec2=06 rec3=046
[0x15] rec0=24 rec1=00 rec2=05 rec3=01a
[0x16] rec0=24 rec1=00 rec2=03 rec3=00a
[0x17] rec0=20 rec1=00 rec2=02 rec3=04c
[0x18] rec0=0d rec1=00 rec2=15 rec3=000
[0x19] rec0=1c rec1=00 rec2=08 rec3=046
[0x1a] rec0=1f rec1=00 rec2=07 rec3=002
[0x1b] rec0=01 rec1=00 rec2=20 rec3=002
[0x1c] rec0=1f rec1=00 rec2=16 rec3=018
[0x1d] rec0=23 rec1=00 rec2=06 rec3=046
[0x1e] rec0=23 rec1=00 rec2=05 rec3=058
[0x1f] rec0=20 rec1=00 rec2=03 rec3=004
[0x20] rec0=1d rec1=00 rec2=02 rec3=00c
[0x21] rec0=1c rec1=00 rec2=15 rec3=048
[0x22] rec0=12 rec1=00 rec2=1a rec3=000
tail 0x2174dfc8a865f818048b6 0x42a00088462060003
Free Block Chain:
0x1a: 0000 00 07 01 c4 80 21 78 20 3a 20 69 6e 20 4e 61 74 ┆ !x : in Nat┆
0x7: 0000 00 09 03 fc 80 23 61 6e 5f 65 6e 75 6d 65 72 61 ┆ #an_enumera┆
0x9: 0000 00 22 00 09 80 06 6e 74 65 6e 63 65 06 07 08 09 ┆ " ntence ┆
0x22: 0000 00 19 00 09 80 06 6d 65 20 28 43 5f 06 20 72 65 ┆ me (C_ re┆
0x19: 0000 00 21 03 fc 80 11 20 72 65 74 75 72 6e 20 53 74 ┆ ! return St┆
0x21: 0000 00 04 00 37 80 34 6e 63 74 69 6f 6e 20 4c 69 73 ┆ 7 4nction Lis┆
0x4: 0000 00 10 03 fc 00 40 20 20 20 20 20 20 20 20 43 5f ┆ @ C_┆
0x10: 0000 00 0d 03 f9 80 3a 70 6c 65 6d 65 6e 74 2e 70 75 ┆ :plement.pu┆
0xd: 0000 00 14 00 6b 80 01 3b 01 00 00 00 00 07 2d 2d 62 ┆ k ; --b┆
0x14: 0000 00 00 00 1f 00 1c 2d 2d 20 20 20 20 20 20 63 6f ┆ -- co┆