DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

This is an automatic "excavation" of a thematic subset of artifacts from Datamuseum.dk's BitArchive. See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - download

⟦e13d624e0⟧ Ada Source

    Length: 9216 (0x2400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Identification, seg_0558a6

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

with Transport_Name;  
with Utils;
with Byte_Defs;
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);

    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
    begin
        null;
        Unset_Unique_Id (Ident);
    end Delete_Object;

    procedure Host_Id_To_String
                 (From : Transport_Defs.Host_Id;
                  Target : in out Bounded_String.Variable_String) is
    begin
        Bounded_String.Copy
           (Source => Transport_Name.Host_Id_To_Host (From), Target => Target);
    end Host_Id_To_String;

    procedure String_To_Host_Id (From : Bounded_String.Variable_String;
                                 Target : in out Transport_Defs.Host_Id) is
    begin
        Target := Transport_Name.Host_To_Host_Id (Bounded_String.Image (From));
    end String_To_Host_Id;

    procedure Socket_Id_To_String
                 (From : Transport_Defs.Socket_Id;
                  Target : in out Bounded_String.Variable_String) is
        A, B : Byte_Defs.Byte;
    begin
        A := From (1);
        B := From (2);
        Bounded_String.Copy (Source => Byte_Defs.Byte'Image (A) & '.' &
                                          Byte_Defs.Byte'Image (B) & '.',
                             Target => Target);
    end Socket_Id_To_String;

    procedure String_To_Socket_Id (From : Bounded_String.Variable_String;
                                   Target : in out Transport_Defs.Socket_Id) is  
        I, J : Natural := 1;
        A, B : Byte_Defs.Byte;
    begin
        loop
            exit when Bounded_String.Extract (From, J, J) = ".";
            J := J + 1;
        end loop;
        Target (1) := Byte_Defs.Byte'Value
                         (Bounded_String.Extract (From, I, J - 1));  
        J := J + 1;
        I := J;
        loop
            exit when Bounded_String.Extract (From, J, J) = ".";
            J := J + 1;
        end loop;  
        Target (2) := Byte_Defs.Byte'Value
                         (Bounded_String.Extract (From, I, J - 1));
    end String_To_Socket_Id;

end Identification;

    nblk1=8
    nid=2
    hdr6=c
        [0x00] rec0=22 rec1=00 rec2=01 rec3=042
        [0x01] rec0=01 rec1=00 rec2=04 rec3=012
        [0x02] rec0=21 rec1=00 rec2=05 rec3=026
        [0x03] rec0=1d rec1=00 rec2=06 rec3=034
        [0x04] rec0=19 rec1=00 rec2=07 rec3=016
        [0x05] rec0=11 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 0x217602a7887be4da016b4 0x42a00088462060003
Free Block Chain:
  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  ┆                ┆