DataMuseum.dk

top - download

    Length: 2003 (0x7d3)
    Types: TextFile
    Names: »B«

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Group_Tree;

package body Tad_Local is

    procedure Create_New_Local_Var
                 (The_Object : out Object; The_Name : String) is
        New_Name : String (1 .. 20) := (1 .. 20 => ' ');
    begin
        New_Name (1 .. The_Name'Last) := The_Name;
        The_Object := Object'(New_Name, Notype, 0, Group_Tree.Create_New_Tree);
    end Create_New_Local_Var;

    procedure Set_Type (The_Object : in out Object; The_Type : Var_Type) is
    begin
        The_Object.The_Type := The_Type;
    end Set_Type;

    procedure Set_Value (The_Object : in out Object; The_Value : Natural) is
    begin
        The_Object.Value := The_Value;
    end Set_Value;

    procedure Set_Members (The_Object : in out Object;
                           The_Members : Group_Tree.Object) is
    begin
        The_Object.Members := The_Members;
    end Set_Members;

    function Get_Type (The_Object : Object) return Var_Type is
    begin
        return The_Object.The_Type;
    end Get_Type;

    function Get_Value (The_Object : Object) return Natural is
    begin
        return The_Object.Value;
    end Get_Value;

    function Get_Members (The_Object : Object) return Group_Tree.Object is
    begin
        return The_Object.Members;
    end Get_Members;

    function Compare_Name (Object1, Object2 : Object) return Integer is
    begin
        if Object1.Name = Object2.Name then
            return 0;
        end if;
        if Object1.Name > Object2.Name then
            return 1;
        else
            return -1;
        end if;
    end Compare_Name;


    function Export_Value_Pointer (The_Object : Object) return Pnatural is
        Export : Pnatural;
    begin
        Export.all := Get_Value (The_Object);
        return Export;
    end Export_Value_Pointer;


    function Export_Type_Pointer (The_Object : Object) return Pvar_Type is
        Export : Pvar_Type;
    begin
        Export.all := Get_Type (The_Object);
        return Export;
    end Export_Type_Pointer;


end Tad_Local;