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

⟦40a8dffa2⟧ TextFile

    Length: 21777 (0x5511)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

-- with Get_Pragmas;

separate (M68k_Sunos_Vdx)

function Get_Pragma_Info return Pragmas.Object is

    -- The following pragmas have been implemented.  Any limitations in the
    -- implementation are included in the comments associated with the
    -- pragma involved.
    --
    -- The details of each pragma's use and functionality are documented in
    -- the "Sun Ada 1.0 for Sun4 SunOS 4.x Programmer's Guide".
    --
    -- Pragma Controlled
    -- Pragma Elaborate
    -- Pragma External_Name
    -- Pragma Implicit_Code   (see limitations)
    -- Pragma Inline
    -- Pragma Inline_Only     (see limitations)
    -- Pragma Interface
    -- Pragma Interface_Name  (see limitations)
    -- Pragma Link_With
    -- Pragma List
    -- Pragma Memory_Size
    -- Pragma No_Image
    -- Pragma Non_Reentrant
    -- Pragma Not_Elaborated  (see limitations)
    -- Pragma Optimize
    -- Pragma Optimize_Code   (see limitations)
    -- Pragma Pack
    -- Pragma Page
    -- Pragma Passive         (see limitations)
    -- Pragma Priority
    -- Pragma Share_Body      (see limitations)
    -- Pragma Share_Code      (see limitations)
    -- Pragma Shared
    -- Pragma Storage_Unit
    -- Pragma Suppress
    -- Pragma System_Name
    -- Pragma Volatile


    -- Declarations used by more than one pragma definition

    All_Types_Allowed : 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);

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

    Null_Constraint : constant Checking.Range_Constraint :=
       Checking.Null_Constraint (For_Target => T_Name);

    String_Expression : constant Checking.Expression :=
       Checking.Build (Expression_Type => "String",
                       Constraint      => Null_Constraint,
                       For_Target      => T_Name);

    On_Off_Argument : constant Pragmas.Argument :=
       Pragmas.Build_Name_Argument
          (Name => "On_Off",
           Valid_Special_Identifiers =>
              (Text.Build ("On", T_Name), Text.Build ("Off", T_Name)),
           For_Target => T_Name);

    On_Off_Arguments : constant Pragmas.Argument_Array :=
       (1 => On_Off_Argument);

    Link_Name_Arg : constant Pragmas.Argument :=
       Pragmas.Build_Expression_Argument
          (Name              => "Link_Name",
           Valid_Expressions => String_Expression,
           For_Target        => T_Name);


    Subprogram_Misc_Names : Checking.Miscellaneous_Name_Set :=
       Checking.Build (Valid_Kinds => (Checking.Function_Kind => True,
                                       Checking.Procedure_Kind => True,
                                       Checking.Generic_Function_Kind => True,
                                       Checking.Generic_Procedure_Kind => True,
                                       others => False),
                       For_Target  => T_Name);


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

    -- PRAGMA EXTERNAL_NAME(Ada_Name,"Link_Name")

    External_Name_Objects : Checking.Object_Set :=
       Checking.Build (Valid_Kinds   =>
                          (Checking.Variable => True, others => False),
                       Allowed_Types => All_Types_Allowed,
                       For_Target    => T_Name);

    External_Name_Misc_Names : Checking.Miscellaneous_Name_Set :=
       Checking.Build (Valid_Kinds       => (Checking.Function_Kind  => True,
                                             Checking.Procedure_Kind => True,
                                             others                  => False),
                       Ambiguity_Allowed => False,
                       For_Target        => T_Name);

    External_Name_Arg_1 : constant Pragmas.Argument :=
       Pragmas.Build_Name_Argument
          (Name => "Ada_Name",
           Valid_Objects => External_Name_Objects,
           Valid_Miscellaneous_Names => External_Name_Misc_Names,
           For_Target => T_Name);


    External_Name_Arguments : constant Pragmas.Argument_Array :=
       (External_Name_Arg_1, Link_Name_Arg);


    External_Name_Pragma : constant Pragmas.Target_Pragma :=
       Pragmas.Build (Name                   => "External_Name",
                      Valid_Locations        =>
                         (Pragmas.Declaration => True, others => False),
                      Arguments              => External_Name_Arguments,
                      Last_Required_Argument => 2,
                      For_Target             => T_Name);


----------------------------------------------------------------------
    --PRAGMA IMPLICIT_CODE(ON)
    --PRAGMA IMPLICIT_CODE(OFF)
    -- Allowed only in the declarative part of a machine code
    -- procedure. No way to really enforce this.


    Implicit_Code_Pragma : constant Pragmas.Target_Pragma :=
       Pragmas.Build (Name                   => "Implicit_Code",
                      Valid_Locations        =>
                         (Pragmas.Declaration => True, others => False),
                      Arguments              => On_Off_Arguments,
                      Last_Required_Argument => 1,
                      For_Target             => T_Name);

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

    -- PRAGMA INLINE_ONLY
    -- Used in the same manner as pragma INLINE, refer Appendix B of the
    -- LRM. This implementation arbitrarily limits the number of arguments
    -- to 5, but the Sun Ada documentation imposes no limitation.  If more
    -- than 5 parameters are supplied, the semanticist will only issue a
    -- warning, but the code will still install.

    Inline_Only_Arg_1 : constant Pragmas.Argument :=
       Pragmas.Build_Name_Argument
          (Name => "Ada_Subprogram_Name",
           Valid_Objects => Checking.Null_Object_Set,
           Valid_Miscellaneous_Names => Subprogram_Misc_Names,
           For_Target => T_Name);

    Inline_Only_Arguments : constant Pragmas.Argument_Array :=
       (1 => Inline_Only_Arg_1,
        2 => Inline_Only_Arg_1,
        3 => Inline_Only_Arg_1,
        4 => Inline_Only_Arg_1,
        5 => Inline_Only_Arg_1);

    Inline_Only_Pragma : constant Pragmas.Target_Pragma :=
       Pragmas.Build (Name                   => "Inline_Only",
                      Valid_Locations        => (Pragmas.Comp_Unit   => True,
                                                 Pragmas.Declaration => True,
                                                 others              => False),
                      Arguments              => Inline_Only_Arguments,
                      Last_Required_Argument => 1,
                      For_Target             => T_Name);

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


    --PRAGMA INTERFACE_NAME (Ada_Name,"Link_Name")
    -- Allowed only in declarative portion of a package spec. If applied to
    -- an object, must be scalar or Access Type and cannot be loop
    -- variable, constant, initialized_variable, array or record. If
    -- applied to a subprogram, a pragma INTERFACE must have already been
    -- specified for the subprogram. It may not be possible to correctly
    -- enforce these restrictions.


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


    Interface_Name_Objects : Checking.Object_Set :=
       Checking.Build (Valid_Kinds   =>
                          (Checking.Variable => True, others => False),
                       Allowed_Types => Interface_Name_Allowed_Types,
                       For_Target    => T_Name);


    Interface_Name_Required_Pragmas : constant Checking.Pragma_Array :=
       (1 => Text.Build (S => "Interface", For_Target => T_Name));


    Interface_Name_Misc_Names : Checking.Miscellaneous_Name_Set :=
       Checking.Build (Valid_Kinds       => (Checking.Function_Kind  => True,
                                             Checking.Procedure_Kind => True,
                                             others                  => False),
                       Ambiguity_Allowed => False,
                       Required_Pragmas  => Interface_Name_Required_Pragmas,
                       For_Target        => T_Name);


    Interface_Name_Arg_1 : constant Pragmas.Argument :=
       Pragmas.Build_Name_Argument
          (Name => "Ada_Name",
           Valid_Objects => Interface_Name_Objects,
           Valid_Miscellaneous_Names => Interface_Name_Misc_Names,
           For_Target => T_Name);

    Interface_Name_Arguments : constant Pragmas.Argument_Array :=
       (Interface_Name_Arg_1, Link_Name_Arg);


    Interface_Name_Pragma : constant Pragmas.Target_Pragma :=
       Pragmas.Build (Name                   => "Interface_Name",
                      Valid_Locations        =>
                         (Pragmas.Declaration => True, others => False),
                      Arguments              => Interface_Name_Arguments,
                      Last_Required_Argument => 2,
                      For_Target             => T_Name);


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

    -- PRAGMA LINK_WITH ("Linker_Argument");

    Link_With_Argument : constant Pragmas.Argument :=
       Pragmas.Build_Expression_Argument
          (Name              => "Linker_Option",
           Valid_Expressions => String_Expression,
           For_Target        => T_Name);


    Link_With_Pragma : constant Pragmas.Target_Pragma :=
       Pragmas.Build (Name                   => "Link_With",
                      Valid_Locations        =>
                         (Pragmas.Declaration => True, others => False),
                      Arguments              => (1 => Link_With_Argument),
                      Last_Required_Argument => 1,
                      For_Target             => T_Name);


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

    -- PRAGMA NO_IMAGE (Type_Name);

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

    No_Image_Argument : constant Pragmas.Argument :=
       Pragmas.Build_Name_Argument (Name        => "No_Image",
                                    Valid_Types => No_Image_Arg_Types,
                                    For_Target  => T_Name);

    No_Image_Pragma : constant Pragmas.Target_Pragma :=
       Pragmas.Build (Name                   => "No_Image",
                      Valid_Locations        =>
                         (Pragmas.Declaration => True, others => False),
                      Arguments              => (1 => No_Image_Argument),
                      Last_Required_Argument => 1,
                      For_Target             => T_Name);

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

    -- PRAGMA NON_REENTRANT(Ada_Subprogram_Name)


    Non_Reentrant_Arg : constant Pragmas.Argument :=
       Pragmas.Build_Name_Argument
          (Name => "Ada_Subprogram_Name",
           Valid_Objects => Checking.Null_Object_Set,
           Valid_Miscellaneous_Names => Subprogram_Misc_Names,
           For_Target => T_Name);

    Non_Reentrant_Pragma : constant Pragmas.Target_Pragma :=
       Pragmas.Build (Name                   => "Non_Reentrant",
                      Valid_Locations        => (Pragmas.Comp_Unit   => True,
                                                 Pragmas.Declaration => True,
                                                 others              => False),
                      Arguments              => (1 => Non_Reentrant_Arg),
                      Last_Required_Argument => 1,
                      For_Target             => T_Name);


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

    -- PRAGMA NOT_ELABORATED
    -- Can appear ONLY in a package spec.
    --
    -- Valid_Locations is currently limited in its ability to limit where a
    -- pragma may appear.  It is up to the user to properly locate the
    -- pragma.

    Not_Elaborated_Pragma : constant Pragmas.Target_Pragma :=
       Pragmas.Build (Name                   => "Not_Elaborated",
                      Valid_Locations        => (Pragmas.Comp_Unit   => True,
                                                 Pragmas.Declaration => True,
                                                 others              => False),
                      Arguments              => Pragmas.No_Arguments,
                      Last_Required_Argument => 0,
                      For_Target             => T_Name);


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

    -- PRAGMA Optimize_Code(ON)
    -- PRAGMA Optimize_Code(OFF)
    -- May appear in any subprogram.  Default is ON.
    --
    -- Valid_Locations is currently limited in its ability to limit where a
    -- pragma may appear.  It is up to the user to properly locate the
    -- pragma.

    Optimize_Code_Pragma : constant Pragmas.Target_Pragma :=
       Pragmas.Build (Name                   => "Optimize_Code",
                      Valid_Locations        =>
                         (Pragmas.Declaration => True, others => False),
                      Arguments              => On_Off_Arguments,
                      Last_Required_Argument => 1,
                      For_Target             => T_Name);

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

    -- PRAGMA Passive
    -- PRAGMA Passive(Semaphore)
    -- PRAGMA Passive(Interrupt,nnn)
    --
    -- Because there are three valid forms of the Pragma, the code below
    -- allows the user to successfully semanticize all three.  However,
    -- improper combinations will also semanticize on the R1000 (such as
    -- PRAGMA Passive(nnn), PRAGMA Passive(Semaphore,nnn) or
    -- PRAGMA Passive(Interrupt)).  It is up to the user to use the pragma
    -- correctly.
    --
    -- Pragma can only be applied to a task or task type declared
    -- immediately within a package spec or body.
    --
    -- Valid_Locations is currently limited in its ability to limit where a
    -- pragma may appear.  It is up to the user to properly locate the
    -- pragma.


    Passive_Arguments : constant Pragmas.Argument_Array :=
       (1 => Pragmas.Build_Name_Argument
                (Name => "Semaphore_or_Interrupt",
                 Valid_Objects => Checking.Null_Object_Set,
                 Valid_Miscellaneous_Names =>
                    Checking.Null_Miscellaneous_Name_Set,
                 Valid_Types => Checking.Null_Type_Set,
                 Valid_Special_Identifiers =>
                    (Text.Build (S => "Semaphore", For_Target => T_Name),
                     Text.Build (S => "Interrupt", For_Target => T_Name)),
                 For_Target => T_Name),
        2 => Pragmas.Build_Expression_Argument
                (Name              => "Interrupt_Mask",
                 Valid_Expressions =>
                    Checking.Build
                       (Expression_Type => "Integer",
                        Constraint      => Checking.Null_Constraint (T_Name),
                        For_Target      => T_Name),
                 For_Target        => T_Name));


    Passive_Pragma : constant Pragmas.Target_Pragma :=
       Pragmas.Build (Name                   => "Passive",
                      Valid_Locations        =>
                         (Pragmas.Task_Spec => True, others => False),
                      Arguments              => Passive_Arguments,
                      Last_Required_Argument => 0,
                      For_Target             => T_Name);


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

    -- PRAGMA SHARE_BODY(Generic_Unit_Name,TRUE)
    -- PRAGMA SHARE_BODY(Generic_Unit_Name,FALSE)
    --
    -- PRAGMA SHARE_CODE(Generic_Unit_Name,TRUE)
    -- PRAGMA SHARE_CODE(Generic_Unit_Name,FALSE)
    --
    -- SHARE_BODY and SHARE_CODE are identical.
    --
    -- This pragma may be applied to EITHER a generic unit OR to an
    -- an instanitation of a generic unit.  We can only check for the
    -- former.  Therefore, the use of this pragma applied to an
    -- instantiation will cause the R1000 to generate a compiler warning
    -- that may be ignored.

    Share_Code_Misc_Names : Checking.Miscellaneous_Name_Set :=
       Checking.Build (Valid_Kinds => (Checking.Generic_Package_Kind => True,
                                       Checking.Generic_Procedure_Kind => True,
                                       Checking.Generic_Function_Kind => True,
                                       Checking.Package_Kind => True,
                                       Checking.Procedure_Kind => True,
                                       Checking.Function_Kind => True,
                                       others => False),
                       Ambiguity_Allowed => False,
                       For_Target => T_Name);

    Share_Code_Arguments : constant Pragmas.Argument_Array :=
       (1 => Pragmas.Build_Name_Argument
                (Name => "Generic_Unit_Or_Instantiation",
                 Valid_Objects => Checking.Null_Object_Set,
                 Valid_Miscellaneous_Names => Share_Code_Misc_Names,
                 For_Target => T_Name),
        2 => Pragmas.Build_Name_Argument
                (Name => "True_False",
                 Valid_Special_Identifiers =>
                    (Text.Build ("True", T_Name), Text.Build ("False", T_Name)),
                 For_Target => T_Name));


    Share_Body_Pragma : constant Pragmas.Target_Pragma :=
       Pragmas.Build (Name => "Share_Body",
                      Valid_Locations => (Pragmas.Context_Clause => False,
                                          Pragmas.Statement      => False,
                                          others                 => True),
                      Arguments => Share_Code_Arguments,
                      Last_Required_Argument => 2,
                      For_Target => T_Name);

    Share_Code_Pragma : constant Pragmas.Target_Pragma :=
       Pragmas.Build (Name => "Share_Code",
                      Valid_Locations => (Pragmas.Context_Clause => False,
                                          Pragmas.Statement      => False,
                                          others                 => True),
                      Arguments => Share_Code_Arguments,
                      Last_Required_Argument => 2,
                      For_Target => T_Name);

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

    -- PRAGMA VOLATILE(Object_Name)

    Volatile_Argument : constant Pragmas.Argument :=
       Pragmas.Build_Name_Argument (Name          => "Volatile_Object",
                                    Valid_Objects => All_Objects_Allowed,
                                    For_Target    => T_Name);

    Volatile_Pragma : constant Pragmas.Target_Pragma :=
       Pragmas.Build (Name                   => "Volatile",
                      Valid_Locations        =>
                         (Pragmas.Declaration => True, others => False),
                      Arguments              => (1 => Volatile_Argument),
                      Last_Required_Argument => 1,
                      For_Target             => T_Name);

----------------------------------------------------------------------
-- The above definitions are used to create the following structures
----------------------------------------------------------------------

    Implementation_Dependent_Pragmas : constant Pragmas.Target_Pragma_Array :=
       (External_Name_Pragma, Implicit_Code_Pragma, Inline_Only_Pragma,
        Interface_Name_Pragma, Link_With_Pragma, No_Image_Pragma,
        Non_Reentrant_Pragma, Not_Elaborated_Pragma, Optimize_Code_Pragma,
        Passive_Pragma, Share_Body_Pragma, Share_Code_Pragma, Volatile_Pragma);

    Lrm_Defined_Pragmas : constant Pragmas.Ada_Pragma_Array := (others => True);

    Pragma_Object : constant Pragmas.Object :=
       Pragmas.Build (Supported_Ada_Pragmas => Lrm_Defined_Pragmas,
                      Target_Pragmas        => Implementation_Dependent_Pragmas,
                      Interface_Languages   =>
                         (1 => Text.Build ("C", T_Name),
                          2 => Text.Build ("Ada", T_Name),
                          3 => Text.Build ("FORTRAN", T_Name),
                          4 => Text.Build ("Pascal", T_Name),
                          5 => Text.Build ("Unchecked", T_Name)),
                      For_Target            => T_Name);

begin
    return Pragma_Object;

    -- return Get_Pragmas (T_Name);
end Get_Pragma_Info;