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

⟦bf4281798⟧ TextFile

    Length: 40739 (0x9f23)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

with Log;  
with Product_Authorization;
with Profile;  
with String_Utilities;
with Universal;

package body Rcf_Semantics is

    package Checking renames Sc.Checking;
    package Su       renames String_Utilities;
    package Text     renames Sc.Text;

    This_Target : constant String := "Sparc_Sun_Xt";

    T_Name : constant String := "Sparc_Sun_Xt";

    Supported_Targets : array (1 .. 7) of String (1 .. 16) :=
       (1 => "Rs6000_Aix_Ibm  ",
        2 => "Vax_Vms_Dec_Xt  ",
        3 => "I386_Lynx_Als_Xt",
        4 => "I486_Iux_Als_Xt ",
        5 => "I960_Vms_Tar_Xt ",
        6 => "IC30_Vms_Tar_Xt ",
        7 => "Sparc_Sun_Xt    ");
    -- Table containing all valid target keys


    function Is_Authorized (Target_Key_Name : String) return Boolean is
    begin
        for I in Supported_Targets'First .. Supported_Targets'Last loop
            if Su.Equal (Str1        => Su.Strip (Target_Key_Name),
                         Str2        => Su.Strip (Supported_Targets (I)),
                         Ignore_Case => True) then

                return Product_Authorization.Is_Registered (Target_Key_Name);

            end if;
        end loop;

        return True;
    end Is_Authorized;


    function Get_Attribute_Info
                (Target_Key_Name : String) 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,
                                           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,
                                           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
        if not Is_Authorized (This_Target) then
            Log.Put_Line
               (Message =>
                   "The " & This_Target &
                      " target has not been authorized on this machine.",
                Kind    => Profile.Error_Msg);
            raise Program_Error;
        end if;

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

    end Get_Attribute_Info;


    function Get_Predefined_Info
                (Target_Key_Name : String) return Predefined.Object is

-- AN IMPORTANT NOTE!
-- Any time a change is made to the definitions found in this body, the
-- STANDARD_VERSION parameter to the final Predefined.Build command must be
-- incremented.  This is what causes a new version of the package Standard
-- to be created.
--
-- WARNING:
-- Creation of a new version of package standard causes all units contained
-- in any worlds/views with the SPARC_SUN_XT target key to be demoted and
-- repromoted.
--
-- Be advised that running the SPARC_SUN_XT.REGISTER command after making
-- changes to this body and incrementing the STANDARD_VERSION parameter will
-- cause this command to take quite a while to run.  BE PATIENT, it really
-- is doing something.
--
--
        Tiny_Int : constant Predefined.Integer_Type_Descriptor :=
           Predefined.Build (Name => "TINY_INTEGER",
                             Size => 8,
                             Lo_Bound => Universal.Value (Integer'(-2 ** 7)),
                             Hi_Bound => Universal.Value (Integer'(2 ** 7 - 1)),
                             For_Target => T_Name);

        Short_Int : constant Predefined.Integer_Type_Descriptor :=
           Predefined.Build
              (Name       => "SHORT_INTEGER",
               Size       => 16,
               Lo_Bound   => Universal.Value (Integer'(-2 ** 15)),
               Hi_Bound   => Universal.Value (Integer'(2 ** 15 - 1)),
               For_Target => T_Name);

        Int : constant Predefined.Integer_Type_Descriptor :=
           Predefined.Build
              (Name       => "INTEGER",
               Size       => 32,
               Lo_Bound   => Universal.Value (Long_Integer'(-2 ** 31)),
               Hi_Bound   => Universal.Value (Long_Integer'(2 ** 31 - 1)),
               For_Target => T_Name);


        -- The definition of the RCF_UNSIGNED_INTEGER is made here to
        -- facilitate the implementation of the Ada spec of package
        -- Unsigned_Integer.  RCF_UNSIGNED_INTEGER IS NOT PORTABLE AND SHOULD
        -- NOT BE USED BY IMPLEMENTORS.
        --
        -- Implementors may chose to use SunAda's package Unsigned_Integer.
        -- The RCI implementation of this package spec requires that we create
        -- the RCF_UNSIGNED_INTEGER type in package Standard.
        --
        -- Users should see the WARNINGS pertaining to the use of the
        -- non-standard package Unsigned_Integer in the SunAda appendix F.
        --
        --
        Rcf_Us_Int : constant Predefined.Integer_Type_Descriptor :=
           Predefined.Build
              (Name       => "RCF_UNSIGNED_INTEGER",
               Size       => 32,
               Lo_Bound   => Universal.Value (Long_Integer'(0)),
               Hi_Bound   => Universal.Value (Long_Integer'(2 ** 32 - 1)),
               For_Target => T_Name);


        Integers : constant Predefined.Integer_Type_Array :=
           (Tiny_Int, Short_Int, Int, Rcf_Us_Int);

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

        Single_Last : constant Universal.Real := Universal.Value (3.40282E+38);
        Double_Last : constant Universal.Real :=
           Universal.Value (1.79769313486231E+308);

        Short_Flo : constant Predefined.Float_Type_Descriptor :=
           Predefined.Build (Name              => "SHORT_FLOAT",
                             Digitz            => 6,
                             Size              => 32,
                             Lo_Bound          => Universal."-" (Single_Last),
                             Hi_Bound          => Single_Last,
                             Safe_Emax         => 125,
                             Machine_Emax      => 128,
                             Machine_Emin      => -125,
                             Machine_Radix     => 2,
                             Machine_Mantissa  => 24,
                             Machine_Rounds    => True,
                             Machine_Overflows => True,
                             For_Target        => T_Name);

        Flo : constant Predefined.Float_Type_Descriptor :=
           Predefined.Build (Name              => "FLOAT",
                             Digitz            => 15,
                             Size              => 64,
                             Lo_Bound          => Universal."-" (Double_Last),
                             Hi_Bound          => Double_Last,
                             Safe_Emax         => 1021,
                             Machine_Emax      => 1024,
                             Machine_Emin      => -1021,
                             Machine_Radix     => 2,
                             Machine_Mantissa  => 53,
                             Machine_Rounds    => True,
                             Machine_Overflows => True,
                             For_Target        => T_Name);

        Floats : constant Predefined.Float_Type_Array := (Short_Flo, Flo);

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

        Dur : constant Predefined.Fixed_Type_Descriptor :=
           Predefined.Build (Name       => "DURATION",
                             Size       => 32,
                             Scale      => -10,
                             Lo_Bound   => Universal.Value (-2147483.648),
                             Hi_Bound   => Universal.Value (2147483.647),
                             For_Target => T_Name);


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

        Predefined_Characteristics : constant Predefined.Object :=
           Predefined.Build (Standard_Version => 14,
                             Integer_Types    => Integers,
                             Float_Types      => Floats,
                             Duration_Type    => Dur,
                             For_Target       => T_Name);

    begin
        if not Is_Authorized (This_Target) then

            Log.Put_Line
               (Message =>
                   "The " & This_Target &
                      " target has not been authorized on this machine.",
                Kind    => Profile.Error_Msg);
            raise Program_Error;
        end if;

        return Predefined_Characteristics;

    end Get_Predefined_Info;


    function Get_Pragma_Info (Target_Key_Name : String) 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
        if not Is_Authorized (This_Target) then

            Log.Put_Line
               (Message =>
                   "The " & This_Target &
                      " target has not been authorized on this machine.",
                Kind    => Profile.Error_Msg);
            raise Program_Error;
        end if;

        return Pragma_Object;

    end Get_Pragma_Info;


    function Get_Rep_Spec_Info
                (Target_Key_Name : String) return Rep_Specs.Object is

    begin
        if not Is_Authorized (This_Target) then

            Log.Put_Line
               (Message =>
                   "The " & This_Target &
                      " target has not been authorized on this machine.",
                Kind    => Profile.Error_Msg);
            raise Program_Error;
        end if;

        return (Rep_Specs.Build (For_Target => Target_Key_Name));

    end Get_Rep_Spec_Info;

end Rcf_Semantics;