DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

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 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦b8eff26fc⟧ TextFile

    Length: 9429 (0x24d5)
    Types: TextFile
    Names: »B«

Derivation

└─⟦516dceb10⟧ Bits:30000751 8mm tape, Rational 1000, RCI_VADS
    └─ ⟦9a14c9417⟧ »DATA« 
        └─⟦this⟧ 

TextFile

-- WITH Get_Attributes;

separate (M68k_Sunos_Vdx)

function Get_Attribute_Info return Attributes.Object is

    package Attr renames Attributes;

    -- GENERAL NOTES PERTAINING TO ATTRIBUTES DEFINED HERE
    --
    -- There are three "implementation dependant" attributes documented in
    -- the Appendix F found in the "Sun Ada 1.0 for Sun4 SunOS 4.x"
    -- Programmer's Guide.  These include:
    --
    --   X'Address,
    --   X'Ref and System.Address'Ref(N), and
    --   X'Task_Id
    --
    -- The implementation for the X'Address attribute is already provided
    -- by the R1000 semanticist and is therefore not defined here.
    --
    -- 'Ref is "overloaded" in that it has two permitted forms. The form
    -- X'Ref is used only in machine code insertions.  Both forms could not
    -- be implemented in the RCI. Because machine code insertions should be
    -- used somewhat infrequently, this customization implements only the
    -- System.Address'Ref(N) form.
    --
    -- In the case of both System.Address'Ref(N) and X'Task_Id a known bug
    -- in the Rev1_0_0 release of the RCF prevents usages of these
    -- attributes in a view using this customization from semantizing
    -- properly.  The bug has reportedly been fixed in the upcoming
    -- maintanence release.  Once this release becomes available, the use
    -- of these attributes will have to be tested.  It is believed that
    -- they are properly defined here.
    --



    -- 'Ref has two permitted forms
    --
    -- X'Ref -  Used only in machine_code procedures
    --    X must be either a constant, variable, procedure, function, or
    --      label.
    --    Returns a value of type Machine_Code.Operand.
    --    May be used only to designate an operand within a code-statement.
    --
    -- System.Address'Ref(N) - Used anywhere to convert the
    --      Universal_Integer value N to an Address.
    --    Returns a type of System.Address.
    --    N must be a static value of type Universal_Integer.
    --
    -- Of the two permitted forms, only System.Address'Ref(N) is
    -- implemented at this time.


    Ref_Textual_Types : constant Checking.Type_Name_Array :=
       (1 => Text.Build (S => "System.Address", For_Target => T_Name));

    Ref_Type_Set : constant Checking.Type_Set :=
       Checking.Build (Enforced_Type_Restrictions =>
                          Checking.All_Type_Restrictions,
                       Valid_Structural_Types => Checking.No_Structural_Types,
                       Valid_Textual_Types => Ref_Textual_Types,
                       For_Target => T_Name);

    Ref_Prefix : constant Attr.Prefix :=
       Attr.Build (Valid_Objects             => Checking.Null_Object_Set,
                   Valid_Miscellaneous_Names =>
                      Checking.Null_Miscellaneous_Name_Set,
                   Valid_Types               => Ref_Type_Set,
                   For_Target                => T_Name);

    Ref_Result : constant Attr.Result :=
       Attr.Build_With_Value_Result
          (Type_Name => "System.Address", For_Target => T_Name);


    Ref_Designator : constant Attr.Designator :=
       Attr.Build (Function_Parameter =>
                      Checking.Build
                         (Expression_Type => "Universal_Integer",
                          Constraint      => Checking.Null_Constraint (T_Name),
                          For_Target      => T_Name),
                   For_Target         => T_Name);

    Ref_Attr : constant Attr.Attribute :=
       Attr.Build (The_Name       => "Ref",
                   The_Prefix     => Ref_Prefix,
                   The_Result     => Ref_Result,
                   The_Designator => Ref_Designator,
                   For_Target     => T_Name);

----------------------------------------------------------------------

    Xref_Type_Set : Checking.Type_Set :=
       Checking.Build (Enforced_Type_Restrictions =>
                          Checking.No_Type_Restrictions,
                       Valid_Structural_Types => Checking.All_Structural_Types,
                       Valid_Textual_Types => Checking.No_Type_Names,
                       Required_Pragmas => Checking.No_Pragmas,
                       Prohibited_Pragmas => Checking.No_Pragmas,
                       For_Target => T_Name);

    Xref_Objects : constant Checking.Object_Set :=
       Checking.Build (Valid_Kinds        => (Checking.Constant_Kind => True,
                                              Checking.Variable => True,
                                              Checking.In_Parameter => True,  
                                              Checking.Out_Parameter => True,
                                              Checking.In_Out_Parameter => True,
                                              others => False),
                       Allowed_Types      => Xref_Type_Set,
                       Required_Pragmas   => Checking.No_Pragmas,
                       Prohibited_Pragmas => Checking.No_Pragmas,
                       For_Target         => T_Name);

    Xref_Misc_Names : constant Checking.Miscellaneous_Name_Set :=
       Checking.Build (Valid_Kinds        =>
                          (Checking.Function_Kind => True,
                           Checking.Procedure_Kind => True,
                           Checking.Label_Kind => True,
                           Checking.Enumeration_Literal_Kind => True,
                           Checking.Generic_Function_Kind => True,
                           Checking.Generic_Procedure_Kind => True,
                           Checking.Generic_Formal_Function => True,
                           Checking.Generic_Formal_Procedure => True,
                           others => False),
                       Ambiguity_Allowed  => False,
                       Required_Pragmas   => Checking.No_Pragmas,
                       Prohibited_Pragmas => Checking.No_Pragmas,
                       For_Target         => T_Name);

    Xref_Prefix : constant Attr.Prefix :=
       Attr.Build (Valid_Objects             => Xref_Objects,
                   Valid_Miscellaneous_Names => Xref_Misc_Names,
                   Valid_Types               => Checking.Null_Type_Set,
                   For_Target                => T_Name);

    Xref_Result : constant Attr.Result :=
       Attr.Build_With_Value_Result
          (Type_Name => "Machine_Code.Operand", For_Target => T_Name);


    Xref_Designator : constant Attr.Designator := Attributes.Null_Designator;

    Xref_Attr : constant Attr.Attribute :=
       Attr.Build (The_Name       => "Ref",
                   The_Prefix     => Xref_Prefix,
                   The_Result     => Xref_Result,
                   The_Designator => Xref_Designator,
                   For_Target     => T_Name);


---------------------------------------------------------------------------

    -- X'Task_Id
    -- X is supposed to be limited to a "task object or a value".  However,
    -- the SunAda documentation is unclear as to what they mean by "a
    -- value" in this context.  At this time, the implementation limits use
    -- of the 'Task_Id to objects which are task types or are derived from
    -- task types.

    Task_Id_Types_Set : constant Checking.Type_Set :=
       Checking.Build (Enforced_Type_Restrictions =>
                          Checking.No_Type_Restrictions,
                       Valid_Structural_Types     =>
                          (Checking.Task_Type => True, others => False),
                       For_Target                 => T_Name);

    Task_Id_Object_Set : constant Checking.Object_Set :=
       Checking.Build (Valid_Kinds   => Checking.All_Object_Kinds,
                       Allowed_Types => Task_Id_Types_Set,
                       For_Target    => T_Name);

    Task_Id_Misc_Name_Set : constant Checking.Miscellaneous_Name_Set :=
       Checking.Build (Valid_Kinds =>
                          (Checking.Task_Kind => True, others => False),
                       For_Target  => T_Name);


    Task_Id_Prefix : constant Attr.Prefix :=
       Attr.Build (Valid_Objects             => Task_Id_Object_Set,
                   Valid_Miscellaneous_Names => Task_Id_Misc_Name_Set,
                   Valid_Types               => Checking.Null_Type_Set,
                   For_Target                => T_Name);

    Task_Id_Result : constant Attr.Result :=
       Attr.Build_With_Value_Result
          (Type_Name => "System.Task_Id", For_Target => T_Name);


    Task_Id_Designator : constant Attr.Designator := Attr.Null_Designator;

    Task_Id_Attr : constant Attr.Attribute :=
       Attr.Build (The_Name       => "Task_Id",
                   The_Prefix     => Task_Id_Prefix,
                   The_Result     => Task_Id_Result,
                   The_Designator => Task_Id_Designator,
                   For_Target     => T_Name);



-----------------------------------------------------------------------


    Attr_List : constant Attr.Attribute_Array :=
       (1 => Ref_Attr, 2 => Xref_Attr, 3 => Task_Id_Attr);


begin

    -- FOR I IN Attr_List'Range LOOP
    --    Io.Put_Line (Attr.Get_Name (Attr_List (I)));
    --    Io.Put_Line ("  Result: " & Attr.Get_Name
    --                                   (Attr.Get_Result (Attr_List (I))));
    -- END LOOP;
    --
    return Attr.Build (Attribute_List => Attr_List, For_Target => T_Name);

    -- RETURN Get_Attributes (T_Name);
end Get_Attribute_Info;