Subversion Repositories openrisc_me

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

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                             S E M _ P R A G                              --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --

--                                                                          --

-- GNAT is free software;  you can  redistribute it  and/or modify it under --

-- terms of the  GNU General Public License as published  by the Free Soft- --

-- ware  Foundation;  either version 3,  or (at your option) any later ver- --

-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --

-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --

-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --

-- for  more details.  You should have  received  a copy of the GNU General --

-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --

-- http://www.gnu.org/licenses for a complete copy of the license.          --

--                                                                          --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

--                                                                          --

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

--  This unit contains the semantic processing for all pragmas, both language

--  and implementation defined. For most pragmas, the parser only does the

--  most basic job of checking the syntax, so Sem_Prag also contains the code

--  to complete the syntax checks. Certain pragmas are handled partially or

--  completely by the parser (see Par.Prag for further details).

with Atree;    use Atree;

with Casing;   use Casing;

with Checks;   use Checks;

with Csets;    use Csets;

with Debug;    use Debug;

with Einfo;    use Einfo;

with Elists;   use Elists;

with Errout;   use Errout;

with Exp_Dist; use Exp_Dist;

with Lib;      use Lib;

with Lib.Writ; use Lib.Writ;

with Lib.Xref; use Lib.Xref;

with Namet.Sp; use Namet.Sp;

with Nlists;   use Nlists;

with Nmake;    use Nmake;

with Opt;      use Opt;

with Output;   use Output;

with Restrict; use Restrict;

with Rident;   use Rident;

with Rtsfind;  use Rtsfind;

with Sem;      use Sem;

with Sem_Aux;  use Sem_Aux;

with Sem_Ch3;  use Sem_Ch3;

with Sem_Ch6;  use Sem_Ch6;

with Sem_Ch8;  use Sem_Ch8;

with Sem_Ch12; use Sem_Ch12;

with Sem_Ch13; use Sem_Ch13;

with Sem_Dist; use Sem_Dist;

with Sem_Elim; use Sem_Elim;

with Sem_Eval; use Sem_Eval;

with Sem_Intr; use Sem_Intr;

with Sem_Mech; use Sem_Mech;

with Sem_Res;  use Sem_Res;

with Sem_Type; use Sem_Type;

with Sem_Util; use Sem_Util;

with Sem_VFpt; use Sem_VFpt;

with Sem_Warn; use Sem_Warn;

with Stand;    use Stand;

with Sinfo;    use Sinfo;

with Sinfo.CN; use Sinfo.CN;

with Sinput;   use Sinput;

with Snames;   use Snames;

with Stringt;  use Stringt;

with Stylesw;  use Stylesw;

with Table;

with Targparm; use Targparm;

with Tbuild;   use Tbuild;

with Ttypes;

with Uintp;    use Uintp;

with Uname;    use Uname;

with Urealp;   use Urealp;

with Validsw;  use Validsw;

package body Sem_Prag is

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

   -- Common Handling of Import-Export Pragmas --

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

   --  In the following section, a number of Import_xxx and Export_xxx

   --  pragmas are defined by GNAT. These are compatible with the DEC

   --  pragmas of the same name, and all have the following common

   --  form and processing:

   --  pragma Export_xxx

   --        [Internal                 =>] LOCAL_NAME

   --     [, [External                 =>] EXTERNAL_SYMBOL]

   --     [, other optional parameters   ]);

   --  pragma Import_xxx

   --        [Internal                 =>] LOCAL_NAME

   --     [, [External                 =>] EXTERNAL_SYMBOL]

   --     [, other optional parameters   ]);

   --   EXTERNAL_SYMBOL ::=

   --     IDENTIFIER

   --   | static_string_EXPRESSION

   --  The internal LOCAL_NAME designates the entity that is imported or

   --  exported, and must refer to an entity in the current declarative

   --  part (as required by the rules for LOCAL_NAME).

   --  The external linker name is designated by the External parameter if

   --  given, or the Internal parameter if not (if there is no External

   --  parameter, the External parameter is a copy of the Internal name).

   --  If the External parameter is given as a string, then this string is

   --  treated as an external name (exactly as though it had been given as an

   --  External_Name parameter for a normal Import pragma).

   --  If the External parameter is given as an identifier (or there is no

   --  External parameter, so that the Internal identifier is used), then

   --  the external name is the characters of the identifier, translated

   --  to all upper case letters for OpenVMS versions of GNAT, and to all

   --  lower case letters for all other versions

   --  Note: the external name specified or implied by any of these special

   --  Import_xxx or Export_xxx pragmas override an external or link name

   --  specified in a previous Import or Export pragma.

   --  Note: these and all other DEC-compatible GNAT pragmas allow full use of

   --  named notation, following the standard rules for subprogram calls, i.e.

   --  parameters can be given in any order if named notation is used, and

   --  positional and named notation can be mixed, subject to the rule that all

   --  positional parameters must appear first.

   --  Note: All these pragmas are implemented exactly following the DEC design

   --  and implementation and are intended to be fully compatible with the use

   --  of these pragmas in the DEC Ada compiler.

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

   -- Checking for Duplicated External Names --

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

   --  It is suspicious if two separate Export pragmas use the same external

   --  name. The following table is used to diagnose this situation so that

   --  an appropriate warning can be issued.

   --  The Node_Id stored is for the N_String_Literal node created to hold

   --  the value of the external name. The Sloc of this node is used to

   --  cross-reference the location of the duplication.

   package Externals is new Table.Table (

     Table_Component_Type => Node_Id,

     Table_Index_Type     => Int,

     Table_Low_Bound      => 0,

     Table_Initial        => 100,

     Table_Increment      => 100,

     Table_Name           => "Name_Externals");

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

   -- Local Subprograms and Variables --

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

   function Adjust_External_Name_Case (N : Node_Id) return Node_Id;

   --  This routine is used for possible casing adjustment of an explicit

   --  external name supplied as a string literal (the node N), according to

   --  the casing requirement of Opt.External_Name_Casing. If this is set to

   --  As_Is, then the string literal is returned unchanged, but if it is set

   --  to Uppercase or Lowercase, then a new string literal with appropriate

   --  casing is constructed.

   function Get_Base_Subprogram (Def_Id : Entity_Id) return Entity_Id;

   --  If Def_Id refers to a renamed subprogram, then the base subprogram (the

   --  original one, following the renaming chain) is returned. Otherwise the

   --  entity is returned unchanged. Should be in Einfo???

   function Get_Pragma_Arg (Arg : Node_Id) return Node_Id;

   --  All the routines that check pragma arguments take either a pragma

   --  argument association (in which case the expression of the argument

   --  association is checked), or the expression directly. The function

   --  Get_Pragma_Arg is a utility used to deal with these two cases. If Arg

   --  is a pragma argument association node, then its expression is returned,

   --  otherwise Arg is returned unchanged.

   procedure rv;

   --  This is a dummy function called by the processing for pragma Reviewable.

   --  It is there for assisting front end debugging. By placing a Reviewable

   --  pragma in the source program, a breakpoint on rv catches this place in

   --  the source, allowing convenient stepping to the point of interest.

   procedure Set_Unit_Name (N : Node_Id; With_Item : Node_Id);

   --  Place semantic information on the argument of an Elaborate/Elaborate_All

   --  pragma. Entity name for unit and its parents is taken from item in

   --  previous with_clause that mentions the unit.

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

   -- Adjust_External_Name_Case --

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

   function Adjust_External_Name_Case (N : Node_Id) return Node_Id is

      CC : Char_Code;

   begin

      --  Adjust case of literal if required

      if Opt.External_Name_Exp_Casing = As_Is then

         return N;

      else

         --  Copy existing string

         Start_String;

         --  Set proper casing

         for J in 1 .. String_Length (Strval (N)) loop

            CC := Get_String_Char (Strval (N), J);

            if Opt.External_Name_Exp_Casing = Uppercase

              and then CC >= Get_Char_Code ('a')

              and then CC <= Get_Char_Code ('z')

            then

               Store_String_Char (CC - 32);

            elsif Opt.External_Name_Exp_Casing = Lowercase

              and then CC >= Get_Char_Code ('A')

              and then CC <= Get_Char_Code ('Z')

            then

               Store_String_Char (CC + 32);

            else

               Store_String_Char (CC);

            end if;

         end loop;

         return

           Make_String_Literal (Sloc (N),

             Strval => End_String);

      end if;

   end Adjust_External_Name_Case;

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

   -- Analyze_PPC_In_Decl_Part --

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

   procedure Analyze_PPC_In_Decl_Part (N : Node_Id; S : Entity_Id) is

      Arg1 : constant Node_Id :=

               First (Pragma_Argument_Associations (N));

      Arg2 : constant Node_Id := Next (Arg1);

   begin

      --  Install formals and push subprogram spec onto scope stack so that we

      --  can see the formals from the pragma.

      Install_Formals (S);

      Push_Scope (S);

      --  Preanalyze the boolean expression, we treat this as a spec expression

      --  (i.e. similar to a default expression).

      Preanalyze_Spec_Expression

        (Get_Pragma_Arg (Arg1), Standard_Boolean);

      --  If there is a message argument, analyze it the same way

      if Present (Arg2) then

         Preanalyze_Spec_Expression

           (Get_Pragma_Arg (Arg2), Standard_String);

      end if;

      --  Remove the subprogram from the scope stack now that the pre-analysis

      --  of the precondition/postcondition is done.

      End_Scope;

   end Analyze_PPC_In_Decl_Part;

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

   -- Analyze_Pragma --

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

   procedure Analyze_Pragma (N : Node_Id) is

      Loc     : constant Source_Ptr := Sloc (N);

      Pname   : constant Name_Id    := Pragma_Name (N);

      Prag_Id : Pragma_Id;

      Pragma_Exit : exception;

      --  This exception is used to exit pragma processing completely. It is

      --  used when an error is detected, and no further processing is

      --  required. It is also used if an earlier error has left the tree in

      --  a state where the pragma should not be processed.

      Arg_Count : Nat;

      --  Number of pragma argument associations

      Arg1 : Node_Id;

      Arg2 : Node_Id;

      Arg3 : Node_Id;

      Arg4 : Node_Id;

      --  First four pragma arguments (pragma argument association nodes, or

      --  Empty if the corresponding argument does not exist).

      type Name_List is array (Natural range <>) of Name_Id;

      type Args_List is array (Natural range <>) of Node_Id;

      --  Types used for arguments to Check_Arg_Order and Gather_Associations

      procedure Ada_2005_Pragma;

      --  Called for pragmas defined in Ada 2005, that are not in Ada 95. In

      --  Ada 95 mode, these are implementation defined pragmas, so should be

      --  caught by the No_Implementation_Pragmas restriction

      procedure Check_Ada_83_Warning;

      --  Issues a warning message for the current pragma if operating in Ada

      --  83 mode (used for language pragmas that are not a standard part of

      --  Ada 83). This procedure does not raise Error_Pragma. Also notes use

      --  of 95 pragma.

      procedure Check_Arg_Count (Required : Nat);

      --  Check argument count for pragma is equal to given parameter. If not,

      --  then issue an error message and raise Pragma_Exit.

      --  Note: all routines whose name is Check_Arg_Is_xxx take an argument

      --  Arg which can either be a pragma argument association, in which case

      --  the check is applied to the expression of the association or an

      --  expression directly.

      procedure Check_Arg_Is_External_Name (Arg : Node_Id);

      --  Check that an argument has the right form for an EXTERNAL_NAME

      --  parameter of an extended import/export pragma. The rule is that the

      --  name must be an identifier or string literal (in Ada 83 mode) or a

      --  static string expression (in Ada 95 mode).

      procedure Check_Arg_Is_Identifier (Arg : Node_Id);

      --  Check the specified argument Arg to make sure that it is an

      --  identifier. If not give error and raise Pragma_Exit.

      procedure Check_Arg_Is_Integer_Literal (Arg : Node_Id);

      --  Check the specified argument Arg to make sure that it is an integer

      --  literal. If not give error and raise Pragma_Exit.

      procedure Check_Arg_Is_Library_Level_Local_Name (Arg : Node_Id);

      --  Check the specified argument Arg to make sure that it has the proper

      --  syntactic form for a local name and meets the semantic requirements

      --  for a local name. The local name is analyzed as part of the

      --  processing for this call. In addition, the local name is required

      --  to represent an entity at the library level.

      procedure Check_Arg_Is_Local_Name (Arg : Node_Id);

      --  Check the specified argument Arg to make sure that it has the proper

      --  syntactic form for a local name and meets the semantic requirements

      --  for a local name. The local name is analyzed as part of the

      --  processing for this call.

      procedure Check_Arg_Is_Locking_Policy (Arg : Node_Id);

      --  Check the specified argument Arg to make sure that it is a valid

      --  locking policy name. If not give error and raise Pragma_Exit.

      procedure Check_Arg_Is_One_Of (Arg : Node_Id; N1, N2 : Name_Id);

      procedure Check_Arg_Is_One_Of (Arg : Node_Id; N1, N2, N3 : Name_Id);

      procedure Check_Arg_Is_One_Of (Arg : Node_Id; N1, N2, N3, N4 : Name_Id);

      --  Check the specified argument Arg to make sure that it is an

      --  identifier whose name matches either N1 or N2 (or N3 if present).

      --  If not then give error and raise Pragma_Exit.

      procedure Check_Arg_Is_Queuing_Policy (Arg : Node_Id);

      --  Check the specified argument Arg to make sure that it is a valid

      --  queuing policy name. If not give error and raise Pragma_Exit.

      procedure Check_Arg_Is_Static_Expression

        (Arg : Node_Id;

         Typ : Entity_Id := Empty);

      --  Check the specified argument Arg to make sure that it is a static

      --  expression of the given type (i.e. it will be analyzed and resolved

      --  using this type, which can be any valid argument to Resolve, e.g.

      --  Any_Integer is OK). If not, given error and raise Pragma_Exit. If

      --  Typ is left Empty, then any static expression is allowed.

      procedure Check_Arg_Is_String_Literal (Arg : Node_Id);

      --  Check the specified argument Arg to make sure that it is a string

      --  literal. If not give error and raise Pragma_Exit

      procedure Check_Arg_Is_Task_Dispatching_Policy (Arg : Node_Id);

      --  Check the specified argument Arg to make sure that it is a valid task

      --  dispatching policy name. If not give error and raise Pragma_Exit.

      procedure Check_Arg_Order (Names : Name_List);

      --  Checks for an instance of two arguments with identifiers for the

      --  current pragma which are not in the sequence indicated by Names,

      --  and if so, generates a fatal message about bad order of arguments.

      procedure Check_At_Least_N_Arguments (N : Nat);

      --  Check there are at least N arguments present

      procedure Check_At_Most_N_Arguments (N : Nat);

      --  Check there are no more than N arguments present

      procedure Check_Component (Comp : Node_Id);

      --  Examine Unchecked_Union component for correct use of per-object

      --  constrained subtypes, and for restrictions on finalizable components.

      procedure Check_Duplicated_Export_Name (Nam : Node_Id);

      --  Nam is an N_String_Literal node containing the external name set by

      --  an Import or Export pragma (or extended Import or Export pragma).

      --  This procedure checks for possible duplications if this is the export

      --  case, and if found, issues an appropriate error message.

      procedure Check_First_Subtype (Arg : Node_Id);

      --  Checks that Arg, whose expression is an entity name referencing a

      --  subtype, does not reference a type that is not a first subtype.

      procedure Check_In_Main_Program;

      --  Common checks for pragmas that appear within a main program

      --  (Priority, Main_Storage, Time_Slice, Relative_Deadline).

      procedure Check_Interrupt_Or_Attach_Handler;

      --  Common processing for first argument of pragma Interrupt_Handler or

      --  pragma Attach_Handler.

      procedure Check_Is_In_Decl_Part_Or_Package_Spec;

      --  Check that pragma appears in a declarative part, or in a package

      --  specification, i.e. that it does not occur in a statement sequence

      --  in a body.

      procedure Check_No_Identifier (Arg : Node_Id);

      --  Checks that the given argument does not have an identifier. If

      --  an identifier is present, then an error message is issued, and

      --  Pragma_Exit is raised.

      procedure Check_No_Identifiers;

      --  Checks that none of the arguments to the pragma has an identifier.

      --  If any argument has an identifier, then an error message is issued,

      --  and Pragma_Exit is raised.

      procedure Check_Optional_Identifier (Arg : Node_Id; Id : Name_Id);

      --  Checks if the given argument has an identifier, and if so, requires

      --  it to match the given identifier name. If there is a non-matching

      --  identifier, then an error message is given and Error_Pragmas raised.

      procedure Check_Optional_Identifier (Arg : Node_Id; Id : String);

      --  Checks if the given argument has an identifier, and if so, requires

      --  it to match the given identifier name. If there is a non-matching

      --  identifier, then an error message is given and Error_Pragmas raised.

      --  In this version of the procedure, the identifier name is given as

      --  a string with lower case letters.

      procedure Check_Precondition_Postcondition (In_Body : out Boolean);

      --  Called to process a precondition or postcondition pragma. There are

      --  three cases:

      --

      --    The pragma appears after a subprogram spec

      --

      --      If the corresponding check is not enabled, the pragma is analyzed

      --      but otherwise ignored and control returns with In_Body set False.

      --

      --      If the check is enabled, then the first step is to analyze the

      --      pragma, but this is skipped if the subprogram spec appears within

      --      a package specification (because this is the case where we delay

      --      analysis till the end of the spec). Then (whether or not it was

      --      analyzed), the pragma is chained to the subprogram in question

      --      (using Spec_PPC_List and Next_Pragma) and control returns to the

      --      caller with In_Body set False.

      --

      --    The pragma appears at the start of subprogram body declarations

      --

      --      In this case an immediate return to the caller is made with

      --      In_Body set True, and the pragma is NOT analyzed.

      --

      --    In all other cases, an error message for bad placement is given

      procedure Check_Static_Constraint (Constr : Node_Id);

      --  Constr is a constraint from an N_Subtype_Indication node from a

      --  component constraint in an Unchecked_Union type. This routine checks

      --  that the constraint is static as required by the restrictions for

      --  Unchecked_Union.

      procedure Check_Valid_Configuration_Pragma;

      --  Legality checks for placement of a configuration pragma

      procedure Check_Valid_Library_Unit_Pragma;

      --  Legality checks for library unit pragmas. A special case arises for

      --  pragmas in generic instances that come from copies of the original

      --  library unit pragmas in the generic templates. In the case of other

      --  than library level instantiations these can appear in contexts which

      --  would normally be invalid (they only apply to the original template

      --  and to library level instantiations), and they are simply ignored,

      --  which is implemented by rewriting them as null statements.

      procedure Check_Variant (Variant : Node_Id);

      --  Check Unchecked_Union variant for lack of nested variants and

      --  presence of at least one component.

      procedure Error_Pragma (Msg : String);

      pragma No_Return (Error_Pragma);

      --  Outputs error message for current pragma. The message contains a %

      --  that will be replaced with the pragma name, and the flag is placed

      --  on the pragma itself. Pragma_Exit is then raised.

      procedure Error_Pragma_Arg (Msg : String; Arg : Node_Id);

      pragma No_Return (Error_Pragma_Arg);

      --  Outputs error message for current pragma. The message may contain

      --  a % that will be replaced with the pragma name. The parameter Arg

      --  may either be a pragma argument association, in which case the flag

      --  is placed on the expression of this association, or an expression,

      --  in which case the flag is placed directly on the expression. The

      --  message is placed using Error_Msg_N, so the message may also contain

      --  an & insertion character which will reference the given Arg value.

      --  After placing the message, Pragma_Exit is raised.

      procedure Error_Pragma_Arg (Msg1, Msg2 : String; Arg : Node_Id);

      pragma No_Return (Error_Pragma_Arg);

      --  Similar to above form of Error_Pragma_Arg except that two messages

      --  are provided, the second is a continuation comment starting with \.

      procedure Error_Pragma_Arg_Ident (Msg : String; Arg : Node_Id);

      pragma No_Return (Error_Pragma_Arg_Ident);

      --  Outputs error message for current pragma. The message may contain

      --  a % that will be replaced with the pragma name. The parameter Arg

      --  must be a pragma argument association with a non-empty identifier

      --  (i.e. its Chars field must be set), and the error message is placed

      --  on the identifier. The message is placed using Error_Msg_N so

      --  the message may also contain an & insertion character which will

      --  reference the identifier. After placing the message, Pragma_Exit

      --  is raised.

      procedure Error_Pragma_Ref (Msg : String; Ref : Entity_Id);

      pragma No_Return (Error_Pragma_Ref);

      --  Outputs error message for current pragma. The message may contain

      --  a % that will be replaced with the pragma name. The parameter Ref

      --  must be an entity whose name can be referenced by & and sloc by #.

      --  After placing the message, Pragma_Exit is raised.

      function Find_Lib_Unit_Name return Entity_Id;

      --  Used for a library unit pragma to find the entity to which the

      --  library unit pragma applies, returns the entity found.

      procedure Find_Program_Unit_Name (Id : Node_Id);

      --  If the pragma is a compilation unit pragma, the id must denote the

      --  compilation unit in the same compilation, and the pragma must appear

      --  in the list of preceding or trailing pragmas. If it is a program

      --  unit pragma that is not a compilation unit pragma, then the

      --  identifier must be visible.

      function Find_Unique_Parameterless_Procedure

        (Name : Entity_Id;

         Arg  : Node_Id) return Entity_Id;

      --  Used for a procedure pragma to find the unique parameterless

      --  procedure identified by Name, returns it if it exists, otherwise

      --  errors out and uses Arg as the pragma argument for the message.

      procedure Gather_Associations

        (Names : Name_List;

         Args  : out Args_List);

      --  This procedure is used to gather the arguments for a pragma that

      --  permits arbitrary ordering of parameters using the normal rules

      --  for named and positional parameters. The Names argument is a list

      --  of Name_Id values that corresponds to the allowed pragma argument

      --  association identifiers in order. The result returned in Args is

      --  a list of corresponding expressions that are the pragma arguments.

      --  Note that this is a list of expressions, not of pragma argument

      --  associations (Gather_Associations has completely checked all the

      --  optional identifiers when it returns). An entry in Args is Empty

      --  on return if the corresponding argument is not present.

      procedure GNAT_Pragma;

      --  Called for all GNAT defined pragmas to check the relevant restriction

      --  (No_Implementation_Pragmas).

      function Is_Before_First_Decl

        (Pragma_Node : Node_Id;

         Decls       : List_Id) return Boolean;

      --  Return True if Pragma_Node is before the first declarative item in

      --  Decls where Decls is the list of declarative items.

      function Is_Configuration_Pragma return Boolean;

      --  Determines if the placement of the current pragma is appropriate

      --  for a configuration pragma.

      function Is_In_Context_Clause return Boolean;

      --  Returns True if pragma appears within the context clause of a unit,

      --  and False for any other placement (does not generate any messages).

      function Is_Static_String_Expression (Arg : Node_Id) return Boolean;

      --  Analyzes the argument, and determines if it is a static string

      --  expression, returns True if so, False if non-static or not String.

      procedure Pragma_Misplaced;

      pragma No_Return (Pragma_Misplaced);

      --  Issue fatal error message for misplaced pragma

      procedure Process_Atomic_Shared_Volatile;

      --  Common processing for pragmas Atomic, Shared, Volatile. Note that

      --  Shared is an obsolete Ada 83 pragma, treated as being identical

      --  in effect to pragma Atomic.

      procedure Process_Compile_Time_Warning_Or_Error;

      --  Common processing for Compile_Time_Error and Compile_Time_Warning

      procedure Process_Convention

        (C   : out Convention_Id;

         Ent : out Entity_Id);

      --  Common processing for Convention, Interface, Import and Export.

      --  Checks first two arguments of pragma, and sets the appropriate

      --  convention value in the specified entity or entities. On return

      --  C is the convention, Ent is the referenced entity.

      procedure Process_Extended_Import_Export_Exception_Pragma

        (Arg_Internal : Node_Id;

         Arg_External : Node_Id;

         Arg_Form     : Node_Id;

         Arg_Code     : Node_Id);

      --  Common processing for the pragmas Import/Export_Exception. The three

      --  arguments correspond to the three named parameters of the pragma. An

      --  argument is empty if the corresponding parameter is not present in

      --  the pragma.

      procedure Process_Extended_Import_Export_Object_Pragma

        (Arg_Internal : Node_Id;

         Arg_External : Node_Id;

         Arg_Size     : Node_Id);

      --  Common processing for the pragmas Import/Export_Object. The three

      --  arguments correspond to the three named parameters of the pragmas. An

      --  argument is empty if the corresponding parameter is not present in

      --  the pragma.

      procedure Process_Extended_Import_Export_Internal_Arg

        (Arg_Internal : Node_Id := Empty);

      --  Common processing for all extended Import and Export pragmas. The

      --  argument is the pragma parameter for the Internal argument. If

      --  Arg_Internal is empty or inappropriate, an error message is posted.

      --  Otherwise, on normal return, the Entity_Field of Arg_Internal is

      --  set to identify the referenced entity.

      procedure Process_Extended_Import_Export_Subprogram_Pragma

        (Arg_Internal                 : Node_Id;

         Arg_External                 : Node_Id;

         Arg_Parameter_Types          : Node_Id;

         Arg_Result_Type              : Node_Id := Empty;

         Arg_Mechanism                : Node_Id;

         Arg_Result_Mechanism         : Node_Id := Empty;

         Arg_First_Optional_Parameter : Node_Id := Empty);

      --  Common processing for all extended Import and Export pragmas applying

      --  to subprograms. The caller omits any arguments that do not apply to

      --  the pragma in question (for example, Arg_Result_Type can be non-Empty

      --  only in the Import_Function and Export_Function cases). The argument

      --  names correspond to the allowed pragma association identifiers.

      procedure Process_Generic_List;

      --  Common processing for Share_Generic and Inline_Generic

      procedure Process_Import_Or_Interface;

      --  Common processing for Import of Interface

      procedure Process_Inline (Active : Boolean);

      --  Common processing for Inline and Inline_Always. The parameter

      --  indicates if the inline pragma is active, i.e. if it should actually

      --  cause inlining to occur.

      procedure Process_Interface_Name

        (Subprogram_Def : Entity_Id;

         Ext_Arg        : Node_Id;

         Link_Arg       : Node_Id);

      --  Given the last two arguments of pragma Import, pragma Export, or

      --  pragma Interface_Name, performs validity checks and sets the

      --  Interface_Name field of the given subprogram entity to the

      --  appropriate external or link name, depending on the arguments given.

      --  Ext_Arg is always present, but Link_Arg may be missing. Note that

      --  Ext_Arg may represent the Link_Name if Link_Arg is missing, and

      --  appropriate named notation is used for Ext_Arg. If neither Ext_Arg

      --  nor Link_Arg is present, the interface name is set to the default

      --  from the subprogram name.

      procedure Process_Interrupt_Or_Attach_Handler;

      --  Common processing for Interrupt and Attach_Handler pragmas

      procedure Process_Restrictions_Or_Restriction_Warnings (Warn : Boolean);

      --  Common processing for Restrictions and Restriction_Warnings pragmas.

      --  Warn is True for Restriction_Warnings, or for Restrictions if the

      --  flag Treat_Restrictions_As_Warnings is set, and False if this flag

      --  is not set in the Restrictions case.

      procedure Process_Suppress_Unsuppress (Suppress_Case : Boolean);

      --  Common processing for Suppress and Unsuppress. The boolean parameter

      --  Suppress_Case is True for the Suppress case, and False for the

      --  Unsuppress case.

      procedure Set_Exported (E : Entity_Id; Arg : Node_Id);

      --  This procedure sets the Is_Exported flag for the given entity,

      --  checking that the entity was not previously imported. Arg is

      --  the argument that specified the entity. A check is also made

      --  for exporting inappropriate entities.

      procedure Set_Extended_Import_Export_External_Name

        (Internal_Ent : Entity_Id;

         Arg_External : Node_Id);

      --  Common processing for all extended import export pragmas. The first

      --  argument, Internal_Ent, is the internal entity, which has already

      --  been checked for validity by the caller. Arg_External is from the

      --  Import or Export pragma, and may be null if no External parameter

      --  was present. If Arg_External is present and is a non-null string

      --  (a null string is treated as the default), then the Interface_Name

      --  field of Internal_Ent is set appropriately.

      procedure Set_Imported (E : Entity_Id);

      --  This procedure sets the Is_Imported flag for the given entity,

      --  checking that it is not previously exported or imported.

      procedure Set_Mechanism_Value (Ent : Entity_Id; Mech_Name : Node_Id);

      --  Mech is a parameter passing mechanism (see Import_Function syntax

      --  for MECHANISM_NAME). This routine checks that the mechanism argument

      --  has the right form, and if not issues an error message. If the

      --  argument has the right form then the Mechanism field of Ent is

      --  set appropriately.

      procedure Set_Ravenscar_Profile (N : Node_Id);

      --  Activate the set of configuration pragmas and restrictions that make

      --  up the Ravenscar Profile. N is the corresponding pragma node, which

      --  is used for error messages on any constructs that violate the

      --  profile.

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

      -- Ada_2005_Pragma --

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

      procedure Ada_2005_Pragma is

      begin

         if Ada_Version <= Ada_95 then

            Check_Restriction (No_Implementation_Pragmas, N);

         end if;

      end Ada_2005_Pragma;

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

      -- Check_Ada_83_Warning --

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

      procedure Check_Ada_83_Warning is

      begin

         if Ada_Version = Ada_83 and then Comes_From_Source (N) then

            Error_Msg_N ("(Ada 83) pragma& is non-standard?", N);

         end if;

      end Check_Ada_83_Warning;

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

      -- Check_Arg_Count --

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

      procedure Check_Arg_Count (Required : Nat) is

      begin

         if Arg_Count /= Required then

            Error_Pragma ("wrong number of arguments for pragma%");

         end if;

      end Check_Arg_Count;

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

      -- Check_Arg_Is_External_Name --

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

      procedure Check_Arg_Is_External_Name (Arg : Node_Id) is

         Argx : constant Node_Id := Get_Pragma_Arg (Arg);

      begin

         if Nkind (Argx) = N_Identifier then

            return;

         else

            Analyze_And_Resolve (Argx, Standard_String);

            if Is_OK_Static_Expression (Argx) then

               return;

            elsif Etype (Argx) = Any_Type then

               raise Pragma_Exit;

            --  An interesting special case, if we have a string literal and

            --  we are in Ada 83 mode, then we allow it even though it will

            --  not be flagged as static. This allows expected Ada 83 mode

            --  use of external names which are string literals, even though

            --  technically these are not static in Ada 83.

            elsif Ada_Version = Ada_83

              and then Nkind (Argx) = N_String_Literal

            then

               return;

            --  Static expression that raises Constraint_Error. This has

            --  already been flagged, so just exit from pragma processing.

            elsif Is_Static_Expression (Argx) then

               raise Pragma_Exit;

            --  Here we have a real error (non-static expression)

            else

               Error_Msg_Name_1 := Pname;

               Flag_Non_Static_Expr

                 ("argument for pragma% must be a identifier or " &

                  "static string expression!", Argx);

               raise Pragma_Exit;

            end if;

         end if;

      end Check_Arg_Is_External_Name;

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

      -- Check_Arg_Is_Identifier --