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 - metrics - download

⟦8ca32a2af⟧ Ada Source

    Length: 7168 (0x1c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Type_Table, seg_0465f3

Derivation

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

with Tds, Error, Text_Io, Unbounded_String;

package body Type_Table is

    package Unlimited_String is new Unbounded_String (10);

    Master_Table, Current_Table : Tds.Object;  
    Type_Currently_In_Declaration : Unlimited_String.Variable_String;

    procedure Declare_Type_Name (Name : in String; L, C : in Natural) is
    begin
        Tds.Insert_Table_Symbol (Master_Table, Name, Name, L, C);
        Current_Table := Tds.Get_Table (Master_Table, Name);  
        Type_Currently_In_Declaration := Unlimited_String.Value (Name);
    end Declare_Type_Name;


    procedure Append_Field_In_Current_Type (Name : in String;
                                            The_Type : in Dynamic_Value.Kinds;
                                            L, C : in Natural) is  
        V : Dynamic_Value.Object;
    begin  
        case The_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 =>
                Dynamic_Value.Create (V);  
                Dynamic_Value.Append_To_Set (V, "");  
                Dynamic_Value.Print (V);
        end case;
        Tds.Insert_Value_Symbol (Current_Table, Name, L, C, V);
    end Append_Field_In_Current_Type;


    procedure Inherite_Type
                 (Name, Parent_Name : in String; L, C : in Natural) is
        Source_Tempo_Table, Target_Tempo_Table : Tds.Object;
    begin  
        if (Parent_Name = Unlimited_String.Image
                             (Type_Currently_In_Declaration)) then
            Error.Set_Type_Error (Error.Recursive_Declaration);
            raise Error.Excep_Semantic_Error;
        end if;
        begin
            Source_Tempo_Table := Tds.Get_Table (Master_Table, Parent_Name);  
        exception
            when Tds.Name_Does_Not_Exist_In_This_Table |
                 Tds.Name_Does_Not_Correspond_To_A_Table =>
                Error.Set_Type_Error (Error.Inherited_Type_Does_Not_Exist);
                raise Error.Excep_Semantic_Error;
        end;
        Tds.Insert_Table_Symbol (Current_Table, Name, Parent_Name, L, C);
        Target_Tempo_Table := Tds.Get_Table (Current_Table, Name);
        Tds.Deep_Copy (Source_Tempo_Table, Target_Tempo_Table);
    end Inherite_Type;


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


    procedure Go_In_Type (Name : in String) is
    begin
        Current_Table := Tds.Get_Table (Master_Table, Name);
    exception
        when Tds.Name_Does_Not_Exist_In_This_Table =>
            null;
        when Tds.Name_Does_Not_Correspond_To_A_Table =>
            null;
    end Go_In_Type;


    function Get_Type (Name : in String) return Tds.Object is
        Table : Tds.Object;
    begin
        Table := Tds.Get_Table (Master_Table, Name);
        return Table;
    exception
        when Tds.Name_Does_Not_Correspond_To_A_Table |
             Tds.Name_Does_Not_Exist_In_This_Table =>
            raise Demanded_Type_Does_Not_Exist;
    end Get_Type;

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

end Type_Table;

    nblk1=6
    nid=6
    hdr6=a
        [0x00] rec0=1c rec1=00 rec2=01 rec3=008
        [0x01] rec0=15 rec1=00 rec2=02 rec3=084
        [0x02] rec0=03 rec1=00 rec2=05 rec3=00c
        [0x03] rec0=1b rec1=00 rec2=04 rec3=036
        [0x04] rec0=17 rec1=00 rec2=03 rec3=000
        [0x05] rec0=43 rec1=1f rec2=31 rec3=1ec
    tail 0x2154311ee865075771621 0x42a00088462060003
Free Block Chain:
  0x6: 0000  00 00 00 04 80 01 20 01 00 00 00 00 00 00 00 00  ┆                ┆