Subversion Repositories openrisc

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

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

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

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-2012, 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 Aspects;  use Aspects;

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 Exp_Util; use Exp_Util;

with Freeze;   use Freeze;

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 Par_SCO;  use Par_SCO;

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_Disp; use Sem_Disp;

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;

with Warnsw;   use Warnsw;

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???

   procedure Preanalyze_TC_Args (N, Arg_Req, Arg_Ens : Node_Id);

   --  Preanalyze the boolean expressions in the Requires and Ensures arguments

   --  of a Test_Case pragma if present (possibly Empty). We treat these as

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

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

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

      --  In ASIS mode, for a pragma generated from a source aspect, also

      --  analyze the original aspect expression.

      if ASIS_Mode

        and then Present (Corresponding_Aspect (N))

      then

         Preanalyze_Spec_Expression

           (Expression (Corresponding_Aspect (N)), Standard_Boolean);

      end if;

      --  For a class-wide condition, a reference to a controlling formal must

      --  be interpreted as having the class-wide type (or an access to such)

      --  so that the inherited condition can be properly applied to any

      --  overriding operation (see ARM12 6.6.1 (7)).

      if Class_Present (N) then

         Class_Wide_Condition : declare

            T   : constant Entity_Id := Find_Dispatching_Type (S);

            ACW : Entity_Id := Empty;

            --  Access to T'class, created if there is a controlling formal

            --  that is an access parameter.

            function Get_ACW return Entity_Id;

            --  If the expression has a reference to an controlling access

            --  parameter, create an access to T'class for the necessary

            --  conversions if one does not exist.

            function Process (N : Node_Id) return Traverse_Result;

            --  ARM 6.1.1: Within the expression for a Pre'Class or Post'Class

            --  aspect for a primitive subprogram of a tagged type T, a name

            --  that denotes a formal parameter of type T is interpreted as

            --  having type T'Class. Similarly, a name that denotes a formal

            --  accessparameter of type access-to-T is interpreted as having

            --  type access-to-T'Class. This ensures the expression is well-

            --  defined for a primitive subprogram of a type descended from T.

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

            -- Get_ACW --

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

            function Get_ACW return Entity_Id is

               Loc  : constant Source_Ptr := Sloc (N);

               Decl : Node_Id;

            begin

               if No (ACW) then

                  Decl := Make_Full_Type_Declaration (Loc,

                    Defining_Identifier => Make_Temporary (Loc, 'T'),

                    Type_Definition =>

                       Make_Access_To_Object_Definition (Loc,

                       Subtype_Indication =>

                         New_Occurrence_Of (Class_Wide_Type (T), Loc),

                       All_Present => True));

                  Insert_Before (Unit_Declaration_Node (S), Decl);

                  Analyze (Decl);

                  ACW := Defining_Identifier (Decl);

                  Freeze_Before (Unit_Declaration_Node (S), ACW);

               end if;

               return ACW;

            end Get_ACW;

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

            -- Process --

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

            function Process (N : Node_Id) return Traverse_Result is

               Loc : constant Source_Ptr := Sloc (N);

               Typ : Entity_Id;

            begin

               if Is_Entity_Name (N)

                 and then Is_Formal (Entity (N))

                 and then Nkind (Parent (N)) /= N_Type_Conversion

               then

                  if Etype (Entity (N)) = T then

                     Typ := Class_Wide_Type (T);

                  elsif Is_Access_Type (Etype (Entity (N)))

                    and then Designated_Type (Etype (Entity (N))) = T

                  then

                     Typ := Get_ACW;

                  else

                     Typ := Empty;

                  end if;

                  if Present (Typ) then

                     Rewrite (N,

                       Make_Type_Conversion (Loc,

                         Subtype_Mark =>

                           New_Occurrence_Of (Typ, Loc),

                         Expression  => New_Occurrence_Of (Entity (N), Loc)));

                     Set_Etype (N, Typ);

                  end if;

               end if;

               return OK;

            end Process;

            procedure Replace_Type is new Traverse_Proc (Process);

         --  Start of processing for Class_Wide_Condition

         begin

            if not Present (T) then

               Error_Msg_Name_1 :=

                 Chars (Identifier (Corresponding_Aspect (N)));

               Error_Msg_Name_2 := Name_Class;

               Error_Msg_N

                 ("aspect `%''%` can only be specified for a primitive " &

                  "operation of a tagged type",

                  Corresponding_Aspect (N));

            end if;

            Replace_Type (Get_Pragma_Arg (Arg1));

         end Class_Wide_Condition;

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

      Prag_Id : Pragma_Id;

      Pname : Name_Id;

      --  Name of the source pragma, or name of the corresponding aspect for

      --  pragmas which originate in a source aspect. In the latter case, the

      --  name may be different from the pragma name.

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

      --  Called for pragmas defined in Ada 2012, that are not in Ada 95 or 05.

      --  In Ada 95 or 05 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);

      procedure Check_Arg_Is_One_Of

        (Arg                : Node_Id;

         N1, N2, N3, N4, N5 : Name_Id);

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

      --  identifier whose name matches either N1 or N2 (or N3, N4, N5 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_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;

         UU_Typ          : Entity_Id;

         In_Variant_Part : Boolean := False);

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

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

      --  UU_Typ is the related Unchecked_Union type. Flag In_Variant_Part

      --  should be set when Comp comes from a record variant.

      procedure Check_Duplicate_Pragma (E : Entity_Id);

      --  Check if a pragma of the same name as the current pragma is already

      --  chained as a rep pragma to the given entity. If so give a message

      --  about the duplicate, and then raise Pragma_Exit so does not return.

      --  Also checks for delayed aspect specification node in the chain.

      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_Expr_Is_Static_Expression

        (Expr : Node_Id;

         Typ  : Entity_Id := Empty);

      --  Check the specified expression Expr 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_First_Subtype (Arg : Node_Id);

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

      --  first subtype.

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

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

      --  it to match the given identifier name. If there is no identifier, or

      --  a non-matching identifier, then an error message is given and

      --  Pragma_Exit is raised.

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

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

      --  it to match one of the given identifier names. If there is no

      --  identifier, or a non-matching identifier, then an error message is

      --  given and Pragma_Exit is raised.

      procedure Check_In_Main_Program;

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

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

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

      --  Checks that no link name is specified

      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 Pragma_Exit is 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 Pragma_Exit is 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_Test_Case;

      --  Called to process a test-case pragma. The treatment is similar to the

      --  one for pre- and postcondition in Check_Precondition_Postcondition,

      --  except the placement rules for the test-case pragma are stricter.

      --  This pragma may only occur after a subprogram spec declared directly

      --  in a package spec unit. In this case, the pragma is chained to the

      --  subprogram in question (using Spec_TC_List and Next_Pragma) and

      --  analysis of the pragma is delayed till the end of the spec. In

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

      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; UU_Typ : Entity_Id);

      --  Check an Unchecked_Union variant for lack of nested variants and

      --  presence of at least one component. UU_Typ is the related Unchecked_

      --  Union type.

      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 Fix_Error (Msg : in out String);

      --  This is called prior to issuing an error message. Msg is a string

      --  that typically contains the substring "pragma". If the current pragma

      --  comes from an aspect, each such "pragma" substring is replaced with

      --  the characters "aspect", and if Error_Msg_Name_1 is Name_Precondition

      --  (resp Name_Postcondition) it is changed to Name_Pre (resp Name_Post).

      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_Disable_Enable_Atomic_Sync (Nam : Name_Id);

      --  Common processing for Disable/Enable_Atomic_Synchronization. Nam is

      --  Name_Suppress for Disable and Name_Unsuppress for Enable.

      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