|
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: 9216 (0x2400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Identification, seg_05721f
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with List_Generic;
package body Identification is
Num_Id : Tclient_Id := 1;
Client_Id : Tclient_Id;
Pile_Vide : Boolean := True;
Id_Null : constant Tclient_Id := 0;
Pile_Unique_Id : array (1 .. 50) of Tclient_Id := (1 .. 50 => Id_Null);
type Object is
record
The_Description : Tdescription;
The_Client : Identification.Tclient_Id;
end record;
package Object_List is new List_Generic (Object);
List_Of_Object : Object_List.List := Object_List.Nil;
procedure Empiler (Client_Num : in Tclient_Id) is
I : Integer := 1;
begin
if Pile_Vide = False then
while Pile_Unique_Id (I) /= Id_Null loop
I := I + 1;
end loop;
Pile_Unique_Id (I) := Client_Num;
else
Pile_Unique_Id (1) := Client_Num;
Pile_Vide := False;
end if;
end Empiler;
procedure Depiler (Client_Num : out Tclient_Id) is
I : Integer := 1;
begin
while Pile_Unique_Id (I + 1) /= Id_Null loop
I := I + 1;
end loop;
Client_Num := Pile_Unique_Id (I);
Pile_Unique_Id (I) := Id_Null;
end Depiler;
procedure Set_Unique_Id (Client_Num : out Tclient_Id) is
begin
if Pile_Vide then
Client_Num := Num_Id;
Num_Id := Num_Id + 1;
else
Depiler (Client_Num);
if Pile_Unique_Id (1) = Id_Null then
Pile_Vide := True;
end if;
end if;
end Set_Unique_Id;
procedure Unset_Unique_Id (Client_Num : Tclient_Id) is
begin
Empiler (Client_Num);
end Unset_Unique_Id;
procedure Enter_New_Object (Ident : in out Tclient_Id;
Description : in Tdescription) is
An_Object : Object;
begin
An_Object.The_Description := Description;
Set_Unique_Id (Ident);
An_Object.The_Client := Ident;
List_Of_Object := Object_List.Make (An_Object, List_Of_Object);
end Enter_New_Object;
procedure Search_Object (Ident : in Tclient_Id;
Description : out Tdescription) is
Iter : Object_List.Iterator;
An_Object : Object;
begin
Object_List.Init (Iter, List_Of_Object);
loop
exit when Object_List.Done (Iter);
An_Object := Object_List.Value (Iter);
exit when Tclient_Id'Image (An_Object.The_Client) =
Tclient_Id'Image (Ident);
Object_List.Next (Iter);
end loop;
Description := An_Object.The_Description;
end Search_Object;
procedure Delete_Object (Ident : in Tclient_Id) is
List_Inter : Object_List.List := Object_List.Nil;
An_Object : Object;
Iter : Object_List.Iterator;
begin
Object_List.Init (Iter, List_Of_Object);
loop
exit when Object_List.Done (Iter);
An_Object := Object_List.Value (Iter);
if Tclient_Id'Image (An_Object.The_Client) =
Tclient_Id'Image (Ident) then
null;
else
List_Inter := Object_List.Make (An_Object, List_Inter);
end if;
Object_List.Next (Iter);
end loop;
List_Of_Object := List_Inter;
Object_List.Free (List_Inter);
Unset_Unique_Id (Ident);
end Delete_Object;
end Identification;
nblk1=8
nid=7
hdr6=a
[0x00] rec0=23 rec1=00 rec2=01 rec3=034
[0x01] rec0=06 rec1=00 rec2=04 rec3=01e
[0x02] rec0=20 rec1=00 rec2=05 rec3=032
[0x03] rec0=1d rec1=00 rec2=06 rec3=016
[0x04] rec0=0e rec1=00 rec2=03 rec3=000
[0x05] rec0=14 rec1=00 rec2=03 rec3=000
[0x06] rec0=17 rec1=00 rec2=03 rec3=010
[0x07] rec0=01 rec1=00 rec2=02 rec3=001
tail 0x2154d98f287c37a003954 0x42a00088462060003
Free Block Chain:
0x7: 0000 00 02 03 fc 80 03 31 29 3b 03 00 16 20 20 20 20 ┆ 1); ┆
0x2: 0000 00 08 00 03 00 00 00 01 00 00 00 00 00 00 00 00 ┆ ┆
0x8: 0000 00 00 00 04 80 01 20 01 02 c2 04 e0 00 07 a0 00 ┆ ┆