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

⟦a3f4725cf⟧ Ada Source

    Length: 14336 (0x3800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body V_T2, seg_045507

Derivation

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

with Tds, T_T2, Text_Io, Unbounded_String, Stack_Generic;

package body V_T2 is

    Master_Table, Current_Table : Tds.Object;

    type Context is
        record
            Table : Tds.Object;
            Element : Natural;
        end record;

    Initialization_Context : Context;  
    package Type_Context_Stack is new Stack_Generic (Element => Context);  
    Context_Stack : Type_Context_Stack.Stack;


    package Unlimited_String is new Unbounded_String (10);
    package Type_String_Stack is
       new Stack_Generic (Element => Unlimited_String.Variable_String);
    My_String_Stack : Type_String_Stack.Stack;


    procedure Create (Variable_Name, Type_Name : in String;
                      L, C : in Natural) is  
        Source_Table, Target_Table : Tds.Object;
    begin  
        Current_Table := Master_Table;  
        begin
            Source_Table := T_T2.Get_Type (Type_Name);  
        exception
            when T_T2.Demanded_Type_Does_Not_Exist =>
                raise Type_Does_Not_Exist;
        end;
        Tds.Insert_Table_Symbol (Master_Table, Variable_Name, Type_Name, L, C);
        Target_Table := Tds.Get_Table (Master_Table, Variable_Name);
        Tds.Deep_Copy (Source_Table, Target_Table);
    end Create;


    procedure Create (Variable_Name : in String;
                      Variable_Type : in Dynamic_Value.Kinds;
                      L, C : in Natural) is  
        V : Dynamic_Value.Object;
    begin  
        Current_Table := Master_Table;
        case Variable_Type is
            when Dynamic_Value.Unknown =>
                null;
            when Dynamic_Value.Integer_Number =>
                Dynamic_Value.Set_Value (V, 0);
            when Dynamic_Value.Boolean_Number =>
                Dynamic_Value.Set_Value (V, False);
            when Dynamic_Value.String_Of_Characters =>
                Dynamic_Value.Set_Value (V, "");
            when Dynamic_Value.Vocabulary_Word =>
                Dynamic_Value.Set_Value (V, "", Dynamic_Value.Voca_Value);
            when Dynamic_Value.Set_Of_Words =>
                null;
        end case;
        Tds.Insert_Value_Symbol (Master_Table, Variable_Name, L, C, V);
    end Create;




    procedure Init_Acces_Path is
    begin  
        Type_String_Stack.Make_Empty (My_String_Stack);
    end Init_Acces_Path;

    procedure Append_To_Acces_Path (Element : String) is
    begin
        Type_String_Stack.Push
           (Unlimited_String.Value (Element), My_String_Stack);
    end Append_To_Acces_Path;


    function Get_Access_On (Name : in String) return Dynamic_Value.Object is
        V : Dynamic_Value.Object;
    begin
        begin
            V := Tds.Get_Access_On_Value (Current_Table, Name);
        exception
            when Tds.Name_Does_Not_Exist_In_This_Table =>
                raise Variable_Does_Not_Exist;
            when Tds.Name_Does_Not_Correspond_To_A_Value =>
                raise Variable_Does_Not_Exist;
        end;
        return V;
    end Get_Access_On;


    function Get_Access_Through_Path return Dynamic_Value.Object is  
        V : Dynamic_Value.Object;
        My_Stack_Iterator : Type_String_Stack.Iterator;  
        Current_Element : Unlimited_String.Variable_String;
        Temporary_Table : Tds.Object;
    begin  
        Temporary_Table := Current_Table;
        Current_Table := Master_Table;

        Type_String_Stack.Init (My_Stack_Iterator, My_String_Stack);
        Current_Element := Type_String_Stack.Value (My_Stack_Iterator);
        Type_String_Stack.Next (My_Stack_Iterator);

        while not (Type_String_Stack.Done (My_Stack_Iterator)) loop  
            Go_In (Unlimited_String.Image (Current_Element));
            Current_Element := Type_String_Stack.Value (My_Stack_Iterator);
            Type_String_Stack.Next (My_Stack_Iterator);
        end loop;
        V := Get_Access_On (Unlimited_String.Image (Current_Element));  
        Current_Table := Temporary_Table;
        return V;  
    end Get_Access_Through_Path;


    procedure Go_In (Variable_Name : in String) is
        T : Tds.Object;
    begin
        begin  
            T := Tds.Get_Table (Current_Table, Variable_Name);
        exception
            when Tds.Name_Does_Not_Exist_In_This_Table =>
                raise Variable_Does_Not_Exist;
            when Tds.Name_Does_Not_Correspond_To_A_Table =>
                raise Cannot_Go_In_This_Variable;
        end;
        Current_Table := T;
    end Go_In;


    procedure Go_To_Top_Level is
    begin
        Current_Table := Master_Table;
    end Go_To_Top_Level;


    procedure Begin_Initialization is
    begin
        -- purger la pile
        Type_Context_Stack.Make_Empty (Context_Stack);
        Initialization_Context.Table := Current_Table;
        Initialization_Context.Element := 0;
    end Begin_Initialization;

    procedure Go_To_Next_Record_To_Initialize (Type_Name : in String) is
        Name : Unlimited_String.Variable_String;  
        use Tds;
    begin

        Text_Io.Put_Line ("le type recherche est : " & Type_Name);

        Initialization_Context.Element := Initialization_Context.Element + 1;

        while (Tds.Get_Number_Of_Symbols (Initialization_Context.Table) <
               Initialization_Context.Element) loop
            -- on remonte tant que le element>nb_symboles_dans la table
            Initialization_Context := Type_Context_Stack.Top (Context_Stack);
            Type_Context_Stack.Pop (Context_Stack);
            Initialization_Context.Element :=
               Initialization_Context.Element + 1;

            Text_Io.Put_Line ("je remonte ");

        end loop;

        Name := Unlimited_String.Value
                   (Tds.Get_Name (Initialization_Context.Table,
                                  Initialization_Context.Element));
        while ((Tds.Get_Type_Name (Initialization_Context.Table,
                                   Unlimited_String.Image (Name)) /=
                Type_Name) and
               (Tds.Get_Kind_Of_Symbol (Initialization_Context.Table,
                                        Unlimited_String.Image (Name)) =
                Tds.Record_Value)) loop
            -- on descend tant qu'on le peut
            Type_Context_Stack.Push (Initialization_Context, Context_Stack);
            Initialization_Context.Table :=
               Tds.Get_Table (Initialization_Context.Table,
                              Unlimited_String.Image (Name));
            Initialization_Context.Element := 1;
            Name := Unlimited_String.Value
                       (Tds.Get_Name (Initialization_Context.Table,
                                      Initialization_Context.Element));

            Text_Io.Put_Line (" je descend ");

        end loop;
       if (Tds.Get_Type_Name
               (Initialization_Context.Table, Unlimited_String.Image (Name)) /=
            Type_Name) then
            -- raise This_type_name_is_not_expected_here;
            Text_Io.Put_Line ("je ne trouve pas le type recherche ");
        end if;

    exception
        when Type_Context_Stack.Underflow =>
            raise Initialization_Too_Long;

    end Go_To_Next_Record_To_Initialize;


    procedure Go_To_Next_Value_To_Initialize is
        Name : Unlimited_String.Variable_String;  
        use Tds;
    begin  
        Initialization_Context.Element := Initialization_Context.Element + 1;

        while (Tds.Get_Number_Of_Symbols (Initialization_Context.Table) <
               Initialization_Context.Element) loop
            -- on remonte tant que le element>nb_symboles_dans la table
            Initialization_Context := Type_Context_Stack.Top (Context_Stack);
            Type_Context_Stack.Pop (Context_Stack);
            Initialization_Context.Element :=
               Initialization_Context.Element + 1;
        end loop;

        Name := Unlimited_String.Value
                   (Tds.Get_Name (Initialization_Context.Table,
                                  Initialization_Context.Element));
        while (Tds.Get_Kind_Of_Symbol (Initialization_Context.Table,
                                       Unlimited_String.Image (Name)) =
               Tds.Record_Value) loop
            Type_Context_Stack.Push (Initialization_Context, Context_Stack);
            Initialization_Context.Table :=
               Tds.Get_Table (Initialization_Context.Table,
                              Unlimited_String.Image (Name));
            Initialization_Context.Element := 1;
            Name := Unlimited_String.Value
                       (Tds.Get_Name (Initialization_Context.Table,
                                      Initialization_Context.Element));
        end loop;


    exception
        when Type_Context_Stack.Underflow =>
            raise Initialization_Too_Long;
    end Go_To_Next_Value_To_Initialize;


    procedure Initialize_With (V : in Dynamic_Value.Object) is
        Value : Dynamic_Value.Object;
        Name : Unlimited_String.Variable_String;
        I : Integer;
        B : Boolean;
        S : Unlimited_String.Variable_String;
    begin  
        Go_To_Next_Value_To_Initialize;
        Name := Unlimited_String.Value
                   (Tds.Get_Name (Initialization_Context.Table,
                                  Initialization_Context.Element));
        Value := Tds.Get_Access_On_Value (Initialization_Context.Table,
                                          Unlimited_String.Image (Name));  
        case Dynamic_Value.Get_Kind (V) is
            when Dynamic_Value.Integer_Number =>
                I := Dynamic_Value.Get_Value (V);  
                Dynamic_Value.Set_Value (Value, I);
            when Dynamic_Value.String_Of_Characters =>
                S := Unlimited_String.Value (Dynamic_Value.Get_Value (V));
                Dynamic_Value.Set_Value (Value, Unlimited_String.Image (S));
            when Dynamic_Value.Boolean_Number =>
                B := Dynamic_Value.Get_Value (V);
                Dynamic_Value.Set_Value (Value, B);
            when others =>
                null;
        end case;
    end Initialize_With;


    procedure Initialize_With (Variable_Name : in String) is
        Name : Unlimited_String.Variable_String;  
        Source_Table, Target_Table : Tds.Object;
    begin
        Go_To_Next_Record_To_Initialize
           (Tds.Get_Type_Name (Master_Table, Variable_Name));
        Name := Unlimited_String.Value
                   (Tds.Get_Name (Initialization_Context.Table,
                                  Initialization_Context.Element));
        Target_Table := Tds.Get_Table (Initialization_Context.Table,
                                       Unlimited_String.Image (Name));
        Source_Table := Tds.Get_Table (Master_Table, Variable_Name);
        Tds.Deep_Copy (Source_Table, Target_Table);
    end Initialize_With;


    procedure Print is
    begin
        Text_Io.Put (" VARIABLES  ");
        Tds.Print (Master_Table);
    end Print;

end V_T2;

    nblk1=d
    nid=4
    hdr6=18
        [0x00] rec0=21 rec1=00 rec2=01 rec3=03e
        [0x01] rec0=18 rec1=00 rec2=0a rec3=01e
        [0x02] rec0=1f rec1=00 rec2=0b rec3=02e
        [0x03] rec0=18 rec1=00 rec2=08 rec3=022
        [0x04] rec0=21 rec1=00 rec2=07 rec3=046
        [0x05] rec0=1a rec1=00 rec2=03 rec3=03c
        [0x06] rec0=15 rec1=00 rec2=02 rec3=002
        [0x07] rec0=18 rec1=00 rec2=09 rec3=02c
        [0x08] rec0=13 rec1=00 rec2=0c rec3=010
        [0x09] rec0=1a rec1=00 rec2=0d rec3=008
        [0x0a] rec0=16 rec1=00 rec2=06 rec3=018
        [0x0b] rec0=0d rec1=00 rec2=05 rec3=000
        [0x0c] rec0=0d rec1=00 rec2=05 rec3=001
    tail 0x215419c68864a7e428a7e 0x42a00088462060003
Free Block Chain:
  0x4: 0000  00 00 03 fc 80 12 29 3b 20 20 20 20 20 20 20 20  ┆      );        ┆