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

⟦ac8bdf856⟧ TextFile

    Length: 21336 (0x5358)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

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_Code      (see limitations)
    -- Pragma Share_Body      (same as Share_Code)
    -- 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);

    True_False_Argument : constant Pragmas.Argument :=  
       Pragmas.Build_Name_Argument  
          (Name => "True_False",
           Valid_Special_Identifiers =>  
              (Text.Build ("True", T_Name),  
               Text.Build ("False", T_Name)),
           For_Target => T_Name);

    True_False_Argument_Array : constant Pragmas.Argument_Array :=  
       (1 => True_False_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 abritrarily 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);


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

    -- This pragma definition was changed to add the second required
    -- parameter of either True or False.  This parameter was inadvertently
    -- left off in previous versions.
    -- CHANGED BY:  Larry Paise, Rational
    -- April 7, 1992 18:20
    --

    -- PRAGMA SHARE_CODE(Generic_Unit_Name,True_False_Value)
    -- 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,
               others => False),
           Ambiguity_Allowed => False,
           For_Target        => T_Name);

    Share_Code_Argurment : constant Pragmas.Argument :=
       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);



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

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

    -- ADDED BY:  Larry Paise, Rational
    -- April 7, 1992 18:20
    --

    -- PRAGMA SHARE_BODY(Generic_Unit_Name,True_False_Value)
    -- Per the SunAda Appendix F, this pragma may be used in the place of
    -- pragma SHARE_CODE with the same effect.  Checking for this pragma has
    -- the same limitations as pragma SHARE_CODE.

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

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

    -- PRAGMA VOLATILE(Object_Name)

    Volatile_Argurment : 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_Argurment),
           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_Code_Pragma,  
        Share_Body_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;
end Get_Pragma_Info;