-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 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- --
-- For a non-constrained variant record type, we read into an
-- intermediate buffer, since we may have the case of discriminated
-- records where a discriminant check is required, and we may need
- -- to assign only part of the record buffer originally written
+ -- to assign only part of the record buffer originally written.
+ -- Note: we have to turn warnings on/off because this use of
+ -- the Constrained attribute is an obsolescent feature.
+
+ pragma Warnings (Off);
if not Element_Type'Constrained then
+ pragma Warnings (On);
+
declare
Buf : Element_Type;
begin
-- Same processing for unconstrained case as above
+ -- Note: we have to turn warnings on/off because this use of
+ -- the Constrained attribute is an obsolescent feature.
+
+ pragma Warnings (Off);
if not Element_Type'Constrained then
+ pragma Warnings (On);
+
declare
Buf : Element_Type;
Pi : constant :=
3.14159_26535_89793_23846_26433_83279_50288_41971_69399_37511;
+ ["03C0"] : constant := Pi;
+ -- This is the greek letter Pi. Note that it is conforming to have this
+ -- present even in Ada 95 mode, because there is no way for a normal mode
+ -- Ada 95 program to reference this identifier in any case.
+
e : constant :=
- 2.71828_18284_59045_23536_02874_71352_66249_77572_47093_69996;
+ 2.71828_18284_59045_23536_02874_71352_66249_77572_47093_69996;
end Ada.Numerics;
procedure Error_Msg_SP (Msg : String);
- -- Instantiation of Styleg, needed to instantiate Scng
+ procedure Obsolescent_Check (S : Source_Ptr);
+
+ -- Instantiation of Styleg, needed to instantiate Scng
package Style is new Styleg
(Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP);
-- Get_File_Checksum).
package Scanner is new Scng
- (Post_Scan, Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP, Style);
+ (Post_Scan, Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP,
+ Obsolescent_Check, Style);
type Header_Num is range 0 .. 1_000;
Interfaces.Reset;
end Initialize_ALI_Source;
+ -----------------------
+ -- Obsolescent_Check --
+ -----------------------
+
+ procedure Obsolescent_Check (S : Source_Ptr) is
+ pragma Warnings (Off, S);
+ begin
+ null;
+ end Obsolescent_Check;
+
---------------
-- Post_Scan --
---------------
-- Initialize all tables
ALIs.Init;
+ No_Deps.Init;
Units.Init;
Withs.Init;
Sdep.Init;
-- quote.
function Get_Nat return Nat;
- -- Skip blanks, then scan out an unsigned integer value in Nat range.
+ -- Skip blanks, then scan out an unsigned integer value in Nat range
function Get_Stamp return Time_Stamp_Type;
-- Skip blanks, then scan out a time stamp
-- at end of line). Also skips past any following blank lines.
procedure Skip_Line;
- -- Skip rest of current line and any following blank lines.
+ -- Skip rest of current line and any following blank lines
procedure Skip_Space;
-- Skip past white space (blanks or horizontal tab)
C := Getc;
Check_Unknown_Line;
- -- Acquire restrictions line
+ -- Acquire first restrictions line
while C /= 'R' loop
if Ignore_Errors then
-- Save cumulative restrictions in case we have a fatal error
Bad_R_Line : exception;
- -- Signal bad restrictions line
+ -- Signal bad restrictions line (raised on unexpected character)
begin
Checkc (' ');
null;
when others =>
- Fatal_Error;
+ raise Bad_R_Line;
end case;
end loop;
end;
when others =>
- Fatal_Error;
+ raise Bad_R_Line;
end case;
-- Acquire restrictions violations information
end if;
when others =>
- Fatal_Error;
+ raise Bad_R_Line;
end case;
end loop;
if Ignore_Errors then
Cumulative_Restrictions := Save_R;
ALIs.Table (Id).Restrictions := Restrictions_Initial;
+ Skip_Eol;
-- In normal mode, this is a fatal error
end Scan_Restrictions;
end if;
- -- Acquire 'I' lines if present
+ -- Acquire additional restrictions (No_Dependence) lines if present
C := Getc;
+ while C = 'R' loop
+ if Ignore ('R') then
+ Skip_Line;
+ else
+ Skip_Space;
+ No_Deps.Append ((Id, Get_Name));
+ end if;
+
+ Skip_Eol;
+ C := Getc;
+ end loop;
+
+ -- Acquire 'I' lines if present
+
Check_Unknown_Line;
while C = 'I' loop
Hash => SHash,
Equal => SEq);
+ -------------------------
+ -- No_Dependency Table --
+ -------------------------
+
+ -- Each R line for a No_Dependency Restriction generates an entry in
+ -- this No_Dependency table.
+
+ type No_Dep_Record is record
+ ALI_File : ALI_Id;
+ -- ALI File containing tne entry
+
+ No_Dep_Unit : Name_Id;
+ -- Id for names table entry including entire name, including periods.
+ end record;
+
+ package No_Deps is new Table.Table (
+ Table_Component_Type => No_Dep_Record,
+ Table_Index_Type => Integer,
+ Table_Low_Bound => 0,
+ Table_Initial => 200,
+ Table_Increment => 400,
+ Table_Name => "No_Deps");
+
------------------------------------
-- Sdep (Source Dependency) Table --
------------------------------------
--------------------------------------
procedure Initialize_ALI;
- -- Initialize the ALI tables. Also resets all switch values to defaults.
+ -- Initialize the ALI tables. Also resets all switch values to defaults
function Scan_ALI
(F : File_Name_Type;
procedure Check_Consistent_Zero_Cost_Exception_Handling;
procedure Consistency_Error_Msg (Msg : String);
- -- Produce an error or a warning message, depending on whether
- -- an inconsistent configuration is permitted or not.
+ -- Produce an error or a warning message, depending on whether an
+ -- inconsistent configuration is permitted or not.
+
+ function Same_Unit (U1 : Name_Id; U2 : Name_Id) return Boolean;
+ -- Used to compare two unit names for No_Dependence checks. U1 is in
+ -- standard unit name format, and U2 is in literal form with periods.
------------------------------------
-- Check_Consistent_Configuration --
end loop;
end if;
end loop;
+
+ -- Now deal with No_Dependence indications. Note that we put the loop
+ -- through entries in the no dependency table first, since this loop
+ -- is most often empty (no such pragma Restrictions in use).
+
+ for ND in No_Deps.First .. No_Deps.Last loop
+ declare
+ ND_Unit : constant Name_Id := No_Deps.Table (ND).No_Dep_Unit;
+
+ begin
+ for J in ALIs.First .. ALIs.Last loop
+ declare
+ A : ALIs_Record renames ALIs.Table (J);
+
+ begin
+ for K in A.First_Unit .. A.Last_Unit loop
+ declare
+ U : Unit_Record renames Units.Table (K);
+ begin
+ for L in U.First_With .. U.Last_With loop
+ if Same_Unit (Withs.Table (L).Uname, ND_Unit) then
+ Error_Msg_Name_1 := U.Uname;
+ Error_Msg_Name_2 := ND_Unit;
+ Consistency_Error_Msg
+ ("unit & violates restriction " &
+ "No_Dependence => %");
+ end if;
+ end loop;
+ end;
+ end loop;
+ end;
+ end loop;
+ end;
+ end loop;
end Check_Consistent_Restrictions;
+ ---------------
+ -- Same_Unit --
+ ---------------
+
+ function Same_Unit (U1 : Name_Id; U2 : Name_Id) return Boolean is
+ begin
+ -- Note, the string U1 has a terminating %s or %b, U2 does not
+
+ if Length_Of_Name (U1) - 2 = Length_Of_Name (U2) then
+ Get_Name_String (U1);
+
+ declare
+ U1_Str : constant String := Name_Buffer (1 .. Name_Len - 2);
+ begin
+ Get_Name_String (U2);
+ return U1_Str = Name_Buffer (1 .. Name_Len);
+ end;
+
+ else
+ return False;
+ end if;
+ end Same_Unit;
+
---------------------------------------------------
-- Check_Consistent_Zero_Cost_Exception_Handling --
---------------------------------------------------
Analyze_And_Resolve (N, Typ);
end Mantissa;
+ ---------
+ -- Mod --
+ ---------
+
+ when Attribute_Mod => Mod_Case : declare
+ Arg : constant Node_Id := Relocate_Node (First (Exprs));
+ Hi : constant Node_Id := Type_High_Bound (Etype (Arg));
+ Modv : constant Uint := Modulus (Btyp);
+
+ begin
+
+ -- This is not so simple. The issue is what type to use for the
+ -- computation of the modular value.
+
+ -- The easy case is when the modulus value is within the bounds
+ -- of the signed integer type of the argument. In this case we can
+ -- just do the computation in that signed integer type, and then
+ -- do an ordinary conversion to the target type.
+
+ if Modv <= Expr_Value (Hi) then
+ Rewrite (N,
+ Convert_To (Btyp,
+ Make_Op_Mod (Loc,
+ Left_Opnd => Arg,
+ Right_Opnd => Make_Integer_Literal (Loc, Modv))));
+
+ -- Here we know that the modulus is larger than type'Last of the
+ -- integer type. There are three possible cases to consider:
+
+ -- a) The integer value is non-negative. In this case, it is
+ -- returned as the result (since it is less than the modulus).
+
+ -- b) The integer value is negative. In this case, we know that
+ -- the result is modulus + value, where the value might be as
+ -- small as -modulus. The trouble is what type do we use to do
+ -- this subtraction. No type will do, since modulus can be as
+ -- big as 2**64, and no integer type accomodates this value.
+ -- Let's do a bit of algebra
+
+ -- modulus + value
+ -- = modulus - (-value)
+ -- = (modulus - 1) - (-value - 1)
+
+ -- Now modulus - 1 is certainly in range of the modular type.
+ -- -value is in the range 1 .. modulus, so -value -1 is in the
+ -- range 0 .. modulus-1 which is in range of the modular type.
+ -- Furthermore, (-value - 1) can be expressed as -(value + 1)
+ -- which we can compute using the integer base type.
+
+ else
+ Rewrite (N,
+ Make_Conditional_Expression (Loc,
+ Expressions => New_List (
+ Make_Op_Ge (Loc,
+ Left_Opnd => Duplicate_Subexpr (Arg),
+ Right_Opnd => Make_Integer_Literal (Loc, 0)),
+
+ Convert_To (Btyp,
+ Duplicate_Subexpr_No_Checks (Arg)),
+
+ Make_Op_Subtract (Loc,
+ Left_Opnd =>
+ Make_Integer_Literal (Loc,
+ Intval => Modv - 1),
+ Right_Opnd =>
+ Convert_To (Btyp,
+ Make_Op_Minus (Loc,
+ Right_Opnd =>
+ Make_Op_Add (Loc,
+ Left_Opnd => Duplicate_Subexpr_No_Checks (Arg),
+ Right_Opnd =>
+ Make_Integer_Literal (Loc,
+ Intval => 1))))))));
+
+
+
+ end if;
+
+ Analyze_And_Resolve (N, Btyp);
+ end Mod_Case;
+
-----------
-- Model --
-----------
procedure Display_Copyright;
-- Display the copyright notice
+ procedure Obsolescent_Check (S : Source_Ptr);
+ -- Null procedure, needed by instantiation of Scng below
+
procedure Post_Scan;
-- Null procedure, needed by instantiation of Scng below
Errutil.Error_Msg_S,
Errutil.Error_Msg_SC,
Errutil.Error_Msg_SP,
+ Obsolescent_Check,
Errutil.Style);
-- The scanner for the preprocessor
New_Line (Outfile.all);
end New_EOL_To_Outfile;
+ -----------------------
+ -- Obsolescent_Check --
+ -----------------------
+
+ procedure Obsolescent_Check (S : Source_Ptr) is
+ pragma Warnings (Off, S);
+ begin
+ null;
+ end Obsolescent_Check;
+
+
---------------
-- Post_Scan --
---------------
package body Lib.Writ is
+ -----------------------
+ -- Local Subprograms --
+ -----------------------
+
+ procedure Write_Unit_Name (N : Node_Id);
+ -- Used to write out the unit name for R (pragma Restriction) lines
+ -- for uses of Restriction (No_Dependence => unit-name).
+
----------------------------------
-- Add_Preprocessing_Dependency --
----------------------------------
end if;
end loop;
- -- Output restrictions line
+ -- Output first restrictions line
Write_Info_Initiate ('R');
Write_Info_Char (' ');
Write_Info_EOL;
+ -- Output R lines for No_Dependence entries
+
+ for J in No_Dependence.First .. No_Dependence.Last loop
+ if In_Extended_Main_Source_Unit (No_Dependence.Table (J).Unit)
+ and then not No_Dependence.Table (J).Warn
+ then
+ Write_Info_Initiate ('R');
+ Write_Info_Char (' ');
+ Write_Unit_Name (No_Dependence.Table (J).Unit);
+ Write_Info_EOL;
+ end if;
+ end loop;
+
-- Output interrupt state lines
for J in Interrupt_States.First .. Interrupt_States.Last loop
Output_References;
Write_Info_Terminate;
Close_Output_Library_Info;
-
end Write_ALI;
+ ---------------------
+ -- Write_Unit_Name --
+ ---------------------
+
+ procedure Write_Unit_Name (N : Node_Id) is
+ begin
+ if Nkind (N) = N_Identifier then
+ Write_Info_Name (Chars (N));
+
+ else
+ pragma Assert (Nkind (N) = N_Selected_Component);
+ Write_Unit_Name (Prefix (N));
+ Write_Info_Char ('.');
+ Write_Unit_Name (Selector_Name (N));
+ end if;
+ end Write_Unit_Name;
+
end Lib.Writ;
-- -- R Restrictions --
-- ---------------------
- -- The R line records the status of restrictions generated by pragma
+ -- The first R line records the status of restrictions generated by pragma
-- Restrictions encountered, as well as information on what the compiler
-- has been able to determine with respect to restrictions violations.
-- The format is:
-- signal a fatal error if it is missing. This means that future
-- changes to the ALI file format must retain the R line.
+ -- Subsequent R lines are present only if pragma Restriction No_Dependence
+ -- is used. There is one such line for each such pragma appearing in the
+ -- extended main unit. The format is
+
+ -- R unit_name
+
+ -- Here the unit name is in all lower case. The components of the unit
+ -- name are separated by periods. The names themselves are in encoded
+ -- form, as documented in Namet.
+
-- ------------------------
-- -- I Interrupt States --
-- ------------------------
with Namet; use Namet;
with Nlists; use Nlists;
with Opt; use Opt;
+with Restrict; use Restrict;
+with Rident; use Rident;
with Sem_Prag; use Sem_Prag;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
begin
pragma Assert (Nkind (E) in N_Entity);
+ if E = Standard_ASCII then
+ Check_Restriction (No_Obsolescent_Features, N);
+ end if;
+
-- Never collect references if not in main source unit. However,
-- we omit this test if Typ is 'e' or 'k', since these entries are
-- really structural, and it is useful to have them in units
elsif Token = Tok_Access then
Attr_Name := Name_Access;
+ elsif Token = Tok_Mod and then Ada_Version = Ada_05 then
+ Attr_Name := Name_Mod;
+
elsif Apostrophe_Should_Be_Semicolon then
Expr_Form := EF_Name;
return Name_Node;
with Fname.UF; use Fname.UF;
with Osint; use Osint;
+with Rident; use Rident;
+with Restrict; use Restrict;
with Stringt; use Stringt;
with Stylesw; use Stylesw;
with Uintp; use Uintp;
function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
Pragma_Name : constant Name_Id := Chars (Pragma_Node);
+ Prag_Id : constant Pragma_Id := Get_Pragma_Id (Pragma_Name);
Pragma_Sloc : constant Source_Ptr := Sloc (Pragma_Node);
Arg_Count : Nat;
Arg_Node : Node_Id;
-- Same as Check_Optional_Identifier, except that the name is required
-- to be present and to match the given Id value.
+ procedure Process_Restrictions_Or_Restriction_Warnings;
+ -- Common processing for Restrictions and Restriction_Warnings pragmas.
+ -- This routine only processes the case of No_Obsolescent_Features,
+ -- which is the only restriction that has syntactic effects. No general
+ -- error checking is done, since this will be done in Sem_Prag. The
+ -- other case processed is pragma Restrictions No_Dependence, since
+ -- otherwise this is done too late.
+
----------
-- Arg1 --
----------
end if;
end Check_Required_Identifier;
- ----------
- -- Prag --
- ----------
+ --------------------------------------------------
+ -- Process_Restrictions_Or_Restriction_Warnings --
+ --------------------------------------------------
+
+ procedure Process_Restrictions_Or_Restriction_Warnings is
+ Arg : Node_Id;
+ Id : Name_Id;
+ Expr : Node_Id;
+
+ begin
+ Arg := Arg1;
+ while Present (Arg) loop
+ Id := Chars (Arg);
+ Expr := Expression (Arg);
+
+ if Id = No_Name
+ and then Nkind (Expr) = N_Identifier
+ and then Get_Restriction_Id (Chars (Expr)) = No_Obsolescent_Features
+ then
+ Set_Restriction (No_Obsolescent_Features, Pragma_Node);
+ Restriction_Warnings (No_Obsolescent_Features) :=
+ Prag_Id = Pragma_Restriction_Warnings;
+
+ elsif Id = Name_No_Dependence then
+ Set_Restriction_No_Dependence
+ (Unit => Expr,
+ Warn => Prag_Id = Pragma_Restriction_Warnings);
+ end if;
+
+ Next (Arg);
+ end loop;
+ end Process_Restrictions_Or_Restriction_Warnings;
+
+-- Start if processing for Prag
begin
Error_Msg_Name_1 := Pragma_Name;
-- it is a semantic error, not a syntactic one (we have already checked
-- the syntax for the unrecognized pragma as required by (RM 2.8(11)).
- if not Is_Pragma_Name (Chars (Pragma_Node)) then
+ if Prag_Id = Unknown_Pragma then
return Pragma_Node;
end if;
-- Remaining processing is pragma dependent
- case Get_Pragma_Id (Pragma_Name) is
+ case Prag_Id is
------------
-- Ada_83 --
List_Pragmas.Increment_Last;
List_Pragmas.Table (List_Pragmas.Last) := (Page, Semi);
+ ------------------
+ -- Restrictions --
+ ------------------
+
+ -- pragma Restrictions (RESTRICTION {, RESTRICTION});
+
+ -- RESTRICTION ::=
+ -- restriction_IDENTIFIER
+ -- | restriction_parameter_IDENTIFIER => EXPRESSION
+
+ -- We process the case of No_Obsolescent_Features, since this has
+ -- a syntactic effect that we need to detect at parse time (the use
+ -- of replacement characters such as colon for pound sign).
+
+ when Pragma_Restrictions =>
+ Process_Restrictions_Or_Restriction_Warnings;
+
+ --------------------------
+ -- Restriction_Warnings --
+ --------------------------
+
+ -- pragma Restriction_Warnings (RESTRICTION {, RESTRICTION});
+
+ -- RESTRICTION ::=
+ -- restriction_IDENTIFIER
+ -- | restriction_parameter_IDENTIFIER => EXPRESSION
+
+ -- See above comment for pragma Restrictions
+
+ when Pragma_Restriction_Warnings =>
+ Process_Restrictions_Or_Restriction_Warnings;
+
----------------------------------------------------------
-- Source_File_Name and Source_File_Name_Project (GNAT) --
----------------------------------------------------------
Pragma_Queuing_Policy |
Pragma_Remote_Call_Interface |
Pragma_Remote_Types |
- Pragma_Restrictions |
- Pragma_Restriction_Warnings |
Pragma_Restricted_Run_Time |
Pragma_Ravenscar |
Pragma_Reviewable |
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 2002-2004 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- --
package body Prj.Err is
+ -----------------------
+ -- Obsolescent_Check --
+ -----------------------
+
+ procedure Obsolescent_Check (S : Source_Ptr) is
+ pragma Warnings (Off, S);
+ begin
+ null;
+ end Obsolescent_Check;
+
---------------
-- Post_Scan --
---------------
-- --
-- S p e c --
-- --
--- Copyright (C) 2002-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 2002-2004 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- --
-- file before using any of the other routines in the package.
procedure Finalize (Source_Type : String := "project")
- renames Errutil.Finalize;
+ renames Errutil.Finalize;
-- Finalize processing of error messages for one file and output message
-- indicating the number of detected errors.
procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr)
- renames Errutil.Error_Msg;
+ renames Errutil.Error_Msg;
-- Output a message at specified location.
procedure Error_Msg_S (Msg : String) renames Errutil.Error_Msg_S;
-- Instantiation of the generic style package, needed for the instantiation
-- of the generic scanner below.
+ procedure Obsolescent_Check (S : Source_Ptr);
+ -- Dummy null procedure for Scng instantiation
+
procedure Post_Scan;
-- Convert an Ada operator symbol into a standard string
package Scanner is new Scng
- (Post_Scan => Post_Scan,
- Error_Msg => Error_Msg,
- Error_Msg_S => Error_Msg_S,
- Error_Msg_SC => Error_Msg_SC,
- Error_Msg_SP => Error_Msg_SP,
- Style => Style);
+ (Post_Scan => Post_Scan,
+ Error_Msg => Error_Msg,
+ Error_Msg_S => Error_Msg_S,
+ Error_Msg_SC => Error_Msg_SC,
+ Error_Msg_SP => Error_Msg_SP,
+ Obsolescent_Check => Obsolescent_Check,
+ Style => Style);
-- Instantiation of the generic scanner
end Prj.Err;
-- in the Names table, and this table will be locked if we are
-- generating a message from gigi.
+ function Same_Unit (U1, U2 : Node_Id) return Boolean;
+ -- Returns True iff U1 and U2 represent the same library unit. Used for
+ -- handling of No_Dependence => Unit restriction case.
+
function Suppress_Restriction_Message (N : Node_Id) return Boolean;
-- N is the node for a possible restriction violation message, but
-- the message is to be suppressed if this is an internal file and
end if;
end Check_Restriction;
+ -------------------------------------
+ -- Check_Restriction_No_Dependence --
+ -------------------------------------
+
+ procedure Check_Restriction_No_Dependence (U : Node_Id; Err : Node_Id) is
+ DU : Node_Id;
+
+ begin
+ for J in No_Dependence.First .. No_Dependence.Last loop
+ DU := No_Dependence.Table (J).Unit;
+
+ if Same_Unit (U, DU) then
+ Error_Msg_Sloc := Sloc (DU);
+ Error_Msg_Node_1 := DU;
+
+ if No_Dependence.Table (J).Warn then
+ Error_Msg
+ ("?violation of restriction `No_Dependence '='> &`#",
+ Sloc (Err));
+ else
+ Error_Msg
+ ("|violation of restriction `No_Dependence '='> &`#",
+ Sloc (Err));
+ end if;
+
+ return;
+ end if;
+ end loop;
+ end Check_Restriction_No_Dependence;
+
----------------------------------------
-- Cunit_Boolean_Restrictions_Restore --
----------------------------------------
Error_Msg_N (B (1 .. P), N);
end Restriction_Msg;
+ ---------------
+ -- Same_Unit --
+ ---------------
+
+ function Same_Unit (U1, U2 : Node_Id) return Boolean is
+ begin
+ if Nkind (U1) = N_Identifier then
+ return Nkind (U2) = N_Identifier and then Chars (U1) = Chars (U2);
+
+ elsif Nkind (U2) = N_Identifier then
+ return False;
+
+ elsif (Nkind (U1) = N_Selected_Component
+ or else Nkind (U1) = N_Expanded_Name)
+ and then
+ (Nkind (U2) = N_Selected_Component
+ or else Nkind (U2) = N_Expanded_Name)
+ then
+ return Same_Unit (Prefix (U1), Prefix (U2))
+ and then Same_Unit (Selector_Name (U1), Selector_Name (U2));
+ else
+ return False;
+ end if;
+ end Same_Unit;
+
------------------------------
-- Set_Profile_Restrictions --
------------------------------
end if;
end Set_Restriction;
+ -----------------------------------
+ -- Set_Restriction_No_Dependence --
+ -----------------------------------
+
+ procedure Set_Restriction_No_Dependence
+ (Unit : Node_Id;
+ Warn : Boolean)
+ is
+ begin
+ -- Loop to check for duplicate entry
+
+ for J in No_Dependence.First .. No_Dependence.Last loop
+
+ -- Case of entry already in table
+
+ if Same_Unit (Unit, No_Dependence.Table (J).Unit) then
+
+ -- Error has precedence over warning
+
+ if not Warn then
+ No_Dependence.Table (J).Warn := False;
+ end if;
+
+ return;
+ end if;
+ end loop;
+
+ -- Entry is in table
+
+ No_Dependence.Append ((Unit, Warn));
+ end Set_Restriction_No_Dependence;
+
----------------------------------
-- Suppress_Restriction_Message --
----------------------------------
-- This package deals with the implementation of the Restrictions pragma
with Rident; use Rident;
+with Table;
with Types; use Types;
with Uintp; use Uintp;
No_Elaboration_Code => True,
others => False);
+ -- The following table records entries made by Restrictions pragmas
+ -- that specify a parameter for No_Dependence. Each such pragma makes
+ -- an entry in this table.
+
+ -- Note: we have chosen to implement this restriction in the "syntactic"
+ -- form, where we do not check that the named package is a language defined
+ -- package, but instead we allow arbitrary package names. The discussion of
+ -- this issue is not complete in the ARG, but the sense seems to be leaning
+ -- in this direction, which makes more sense to us, since it is much more
+ -- useful, and much easier to implement.
+
+ type ND_Entry is record
+ Unit : Node_Id;
+ -- The unit parameter from the No_Dependence pragma
+
+ Warn : Boolean;
+ -- True if from Restriction_Warnings, False if from Restrictions
+ end record;
+
+ package No_Dependence is new Table.Table (
+ Table_Component_Type => ND_Entry,
+ Table_Index_Type => Int,
+ Table_Low_Bound => 0,
+ Table_Initial => 200,
+ Table_Increment => 200,
+ Table_Name => "Name_No_Dependence");
+
-----------------
-- Subprograms --
-----------------
-- violation. If the exact count is not known, V is left at its
-- default value of -1 which indicates an unknown count.
+ procedure Check_Restriction_No_Dependence (U : Node_Id; Err : Node_Id);
+ -- Called when a dependence on a unit is created (either implicitly, or by
+ -- an explicit WITH clause). U is a node for the unit involved, and Err
+ -- is the node to which an error will be attached if necessary.
+
procedure Check_Elaboration_Code_Allowed (N : Node_Id);
-- Tests to see if elaboration code is allowed by the current restrictions
-- settings. This function is called by Gigi when it needs to define
-- Similar to the above, except that this is used for the case of a
-- parameter restriction, and the corresponding value V is given.
+ procedure Set_Restriction_No_Dependence
+ (Unit : Node_Id;
+ Warn : Boolean);
+ -- Sets given No_Dependence restriction in table if not there already.
+ -- Warn is True if from Restriction_Warnings, False if from Restrictions.
+
function Tasking_Allowed return Boolean;
pragma Inline (Tasking_Allowed);
-- Tests to see if tasking operations are allowed by the current
with Nmake; use Nmake;
with Output; use Output;
with Opt; use Opt;
+with Restrict; use Restrict;
with Sem; use Sem;
with Sem_Ch7; use Sem_Ch7;
with Sem_Util; use Sem_Util;
Mark_Rewrite_Insertion (Withn);
Append (Withn, Context_Items (Cunit (Current_Sem_Unit)));
+ Check_Restriction_No_Dependence (Name (Withn), Current_Error_Node);
end;
end if;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
"Object is unconstrained array type" & ASCII.LF &
"To_Pointer results may not have bounds");
- xyz : Boolean := Object'Constrained;
+ -- Capture constrained status, suppressing warnings, since this is
+ -- an obsolescent feature to use Constrained in this way (RM J.4).
+
+ pragma Warnings (Off);
+ Xyz : Boolean := Object'Constrained;
+ pragma Warnings (On);
type Object_Pointer is access all Object;
for Object_Pointer'Size use Standard'Address_Size;
No_Implementation_Pragmas, -- GNAT
No_Implementation_Restrictions, -- GNAT
No_Elaboration_Code, -- GNAT
+ No_Obsolescent_Features, -- Ada 2005 AI-368
-- The following cases require a parameter value
-- All restrictions (excluding only Not_A_Restriction_Id)
subtype All_Boolean_Restrictions is Restriction_Id range
- Simple_Barriers .. No_Elaboration_Code;
+ Simple_Barriers .. No_Obsolescent_Features;
-- All restrictions which do not take a parameter
subtype Partition_Boolean_Restrictions is All_Boolean_Restrictions range
-- case of Boolean restrictions.
subtype Cunit_Boolean_Restrictions is All_Boolean_Restrictions range
- Immediate_Reclamation .. No_Elaboration_Code;
+ Immediate_Reclamation .. No_Obsolescent_Features;
-- Boolean restrictions that are not checked for partition consistency
-- and that thus apply only to the current unit. Note that for these
-- restrictions, the compiler does not apply restrictions found in
with Csets; use Csets;
with Namet; use Namet;
with Opt; use Opt;
+with Restrict; use Restrict;
+with Rident; use Rident;
with Scans; use Scans;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
end loop;
end Initialize_Scanner;
+ -----------------------
+ -- Obsolescent_Check --
+ -----------------------
+
+ procedure Obsolescent_Check (S : Source_Ptr) is
+ begin
+ -- This is a pain in the neck case, since we normally need a node to
+ -- call Check_Restrictions, and all we have is a source pointer. The
+ -- easiest thing is to construct a dummy node. A bit kludgy, but this
+ -- is a marginal case. It's not worth trying to do things more cleanly.
+
+ Check_Restriction (No_Obsolescent_Features, New_Node (N_Empty, S));
+ end Obsolescent_Check;
+
------------------------------
-- Scan_Reserved_Identifier --
------------------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 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- --
-- Determines the casing style of the current token, which is
-- either a keyword or an identifier. See also package Casing.
+ procedure Obsolescent_Check (S : Source_Ptr);
+ -- Called to handle pragma restrictions check for usage of obsolescent
+ -- character replacements during the scan.
+
procedure Post_Scan;
pragma Inline (Post_Scan);
-- Create nodes for tokens: Char_Literal, Identifier, Real_Literal,
-- generic package Scng with routines appropriate to the compiler
package Scanner is new Scng
- (Post_Scan => Post_Scan,
- Error_Msg => Error_Msg,
- Error_Msg_S => Error_Msg_S,
- Error_Msg_SC => Error_Msg_SC,
- Error_Msg_SP => Error_Msg_SP,
- Style => Style.Style_Inst);
+ (Post_Scan => Post_Scan,
+ Error_Msg => Error_Msg,
+ Error_Msg_S => Error_Msg_S,
+ Error_Msg_SC => Error_Msg_SC,
+ Error_Msg_SP => Error_Msg_SP,
+ Obsolescent_Check => Obsolescent_Check,
+ Style => Style.Style_Inst);
procedure Scan renames Scanner.Scan;
-- Scan scans out the next token, and advances the scan state accordingly
Initialize_Checksum;
- -- Do not call Scan, otherwise the License stuff does not work in Scn.
+ -- Do not call Scan, otherwise the License stuff does not work in Scn
end Initialize_Scanner;
or else
Source (Scan_Ptr + 1) in 'a' .. 'z'))
then
- if C = ':' and then Warn_On_Obsolescent_Feature then
- Error_Msg_S
- ("use of "":"" is an obsolescent feature ('R'M 'J.2(3))?");
- Error_Msg_S
- ("\use ""'#"" instead?");
+ if C = ':' then
+ Obsolescent_Check (Scan_Ptr);
+
+ if Warn_On_Obsolescent_Feature then
+ Error_Msg_S
+ ("use of "":"" is an obsolescent feature ('R'M 'J.2(3))?");
+ Error_Msg_S
+ ("\use ""'#"" instead?");
+ end if;
end if;
+
Accumulate_Checksum (C);
Base_Char := C;
UI_Base := UI_Int_Value;
-- Percent starting a string literal
when '%' =>
+ Obsolescent_Check (Token_Ptr);
+
if Warn_On_Obsolescent_Feature then
Error_Msg_S
("use of ""'%"" is an obsolescent feature ('R'M 'J.2(4))?");
when '!' => Exclamation_Case : begin
Accumulate_Checksum ('!');
+ Obsolescent_Check (Token_Ptr);
if Warn_On_Obsolescent_Feature then
Error_Msg_S
-- in particular allows bracket or other notation
-- to be used for upper half letters.
- if Identifier_Character_Set /= 'w' then
+ -- Wide characters are always allowed in Ada 2005
+
+ if Identifier_Character_Set /= 'w'
+ and then Ada_Version < Ada_05
+ then
Error_Msg
("wide character not allowed in identifier", Sptr);
end if;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 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- --
with procedure Error_Msg_SP (Msg : String);
-- Output a message at the start of the previous token
+ with procedure Obsolescent_Check (S : Source_Ptr);
+ -- Called when one of the obsolescent character replacements is
+ -- used with S pointing to the character in question.
+
with package Style is new Styleg
(Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP);
-- Instantiation of Styleg with the same error reporting routines
procedure Check_Library_Unit;
-- Verify that prefix of attribute N is a library unit
+ procedure Check_Modular_Integer_Type;
+ -- Verify that prefix of attribute N is a modular integer type
+
procedure Check_Not_Incomplete_Type;
-- Check that P (the prefix of the attribute) is not an incomplete
-- type or a private type for which no full view has been given.
end if;
end Check_Library_Unit;
+ --------------------------------
+ -- Check_Modular_Integer_Type --
+ --------------------------------
+
+ procedure Check_Modular_Integer_Type is
+ begin
+ Check_Type;
+
+ if not Is_Modular_Integer_Type (P_Type) then
+ Error_Attr
+ ("prefix of % attribute must be modular integer type", P);
+ end if;
+ end Check_Modular_Integer_Type;
+
-------------------------------
-- Check_Not_Incomplete_Type --
-------------------------------
-- Case from RM J.4(2) of constrained applied to private type
if Is_Entity_Name (P) and then Is_Type (Entity (P)) then
+ Check_Restriction (No_Obsolescent_Features, N);
+
+ if Warn_On_Obsolescent_Feature then
+ Error_Msg_N
+ ("constrained for private type is an " &
+ "obsolescent feature ('R'M 'J.4)?", N);
+ end if;
-- If we are within an instance, the attribute must be legal
-- because it was valid in the generic unit. Ditto if this is
Resolve (E2, P_Base_Type);
Set_Etype (N, P_Base_Type);
+ ---------
+ -- Mod --
+ ---------
+
+ when Attribute_Mod =>
+
+ -- Note: this attribute is only allowed in Ada 2005 mode, but
+ -- we do not need to test that here, since Mod is only recognized
+ -- as an attribute name in Ada 2005 mode during the parse.
+
+ Check_E1;
+ Check_Modular_Integer_Type;
+ Resolve (E1, Any_Integer);
+ Set_Etype (N, P_Base_Type);
+
-----------
-- Model --
-----------
when Attribute_Modulus =>
Check_E0;
- Check_Type;
-
- if not Is_Modular_Integer_Type (P_Type) then
- Error_Attr ("prefix of % attribute must be modular type", P);
- end if;
-
+ Check_Modular_Integer_Type;
Set_Etype (N, Universal_Integer);
--------------------
Fold_Ureal
(N, UR_Min (Expr_Value_R (E1), Expr_Value_R (E2)), Static);
else
- Fold_Uint (N, UI_Min (Expr_Value (E1), Expr_Value (E2)), Static);
+ Fold_Uint
+ (N, UI_Min (Expr_Value (E1), Expr_Value (E2)), Static);
end if;
end Min;
+ ---------
+ -- Mod --
+ ---------
+
+ when Attribute_Mod =>
+ Fold_Uint
+ (N, UI_Mod (Expr_Value (E1), Modulus (P_Base_Type)), Static);
+
-----------
-- Model --
-----------
elsif Is_Overloaded (P) then
- -- Use the designated type of the context to disambiguate
+ -- Use the designated type of the context to disambiguate
+ -- Note that this was not strictly conformant to Ada 95,
+ -- but was the implementation adopted by most Ada 95 compilers.
+ -- The use of the context type to resolve an Access attribute
+ -- reference is now mandated in AI-235 for Ada 2005.
declare
Index : Interp_Index;
It : Interp;
+
begin
Get_First_Interp (P, Index, It);
-
while Present (It.Typ) loop
if Covers (Designated_Type (Typ), It.Typ) then
Resolve (P, It.Typ);
end if;
U := Unit (Library_Unit (N));
+ Check_Restriction_No_Dependence (Name (N), N);
Intunit := Is_Internal_File_Name (Unit_File_Name (Current_Sem_Unit));
-- Following checks are skipped for dummy packages (those supplied
if Ekind (Uname) = E_Package then
Set_From_With_Type (Uname, False);
end if;
+
+ -- Ada 2005 (AI-377): it is illegal for a with_clause to name a child
+ -- unit if there is a visible homograph for it declared in the same
+ -- declarative region. This pathological case can only arise when an
+ -- instance I1 of a generic unit G1 has an explicit child unit I1.G2,
+ -- G1 has a generic child also named G2, and the context includes with_
+ -- clauses for both I1.G2 and for G1.G2, making an implicit declaration
+ -- of I1.G2 visible as well.
+
+ if Is_Child_Unit (Uname)
+ and then Is_Visible_Child_Unit (Uname)
+ and then Ada_Version >= Ada_05
+ then
+ declare
+ Decl1 : constant Node_Id := Unit_Declaration_Node (P);
+ Decl2 : Node_Id;
+ P2 : Entity_Id;
+ U2 : Entity_Id;
+
+ begin
+ U2 := Homonym (Uname);
+ while Present (U2) loop
+ P2 := Scope (U2);
+ Decl2 := Unit_Declaration_Node (P2);
+
+ if Is_Child_Unit (U2)
+ and then Is_Visible_Child_Unit (U2)
+ then
+ if Is_Generic_Instance (P)
+ and then Nkind (Decl1) = N_Package_Declaration
+ and then Generic_Parent (Specification (Decl1)) = P2
+ then
+ Error_Msg_N ("illegal with_clause", With_Clause);
+ Error_Msg_N
+ ("\child unit has visible homograph" &
+ " ('R'M 8.3(26), 10.1.1(19))",
+ With_Clause);
+ exit;
+
+ elsif Is_Generic_Instance (P2)
+ and then Nkind (Decl2) = N_Package_Declaration
+ and then Generic_Parent (Specification (Decl2)) = P
+ then
+ -- With_clause for child unit of instance appears before
+ -- in the context. We want to place the error message on
+ -- it, not on the generic child unit itself.
+
+ declare
+ Prev_Clause : Node_Id;
+
+ begin
+ Prev_Clause := First (List_Containing (With_Clause));
+ while Entity (Name (Prev_Clause)) /= U2 loop
+ Next (Prev_Clause);
+ end loop;
+
+ pragma Assert (Present (Prev_Clause));
+ Error_Msg_N ("illegal with_clause", Prev_Clause);
+ Error_Msg_N
+ ("\child unit has visible homograph" &
+ " ('R'M 8.3(26), 10.1.1(19))",
+ Prev_Clause);
+ exit;
+ end;
+ end if;
+ end if;
+
+ U2 := Homonym (U2);
+ end loop;
+ end;
+ end if;
end Install_Withed_Unit;
-------------------
else
if Present (Renamed_Entity (Entity (Id))) then
- if Entity (Id) = Standard_Numeric_Error
- and then Warn_On_Obsolescent_Feature
- then
- Error_Msg_N
- ("Numeric_Error is an " &
- "obsolescent feature ('R'M 'J.6(1))?", Id);
- Error_Msg_N
- ("\use Constraint_Error instead?", Id);
+ if Entity (Id) = Standard_Numeric_Error then
+ Check_Restriction (No_Obsolescent_Features, Id);
+
+ if Warn_On_Obsolescent_Feature then
+ Error_Msg_N
+ ("Numeric_Error is an " &
+ "obsolescent feature ('R'M 'J.6(1))?", Id);
+ Error_Msg_N
+ ("\use Constraint_Error instead?", Id);
+ end if;
end if;
end if;
------------------------------------------------------------------------------
--- --
+-- c --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ C H 1 3 --
with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
+with Restrict; use Restrict;
+with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Ch8; use Sem_Ch8;
procedure Analyze_At_Clause (N : Node_Id) is
begin
+ Check_Restriction (No_Obsolescent_Features, N);
+
if Warn_On_Obsolescent_Feature then
Error_Msg_N
("at clause is an obsolescent feature ('R'M 'J.7(2))?", N);
("\?only one task can be declared of this type", N);
end if;
+ Check_Restriction (No_Obsolescent_Features, N);
+
if Warn_On_Obsolescent_Feature then
Error_Msg_N
("attaching interrupt to task entry is an " &
begin
if Is_Task_Type (U_Ent) then
+ Check_Restriction (No_Obsolescent_Features, N);
+
if Warn_On_Obsolescent_Feature then
Error_Msg_N
("storage size clause for task is an " &
pragma Warnings (Off, Mod_Val);
begin
+ Check_Restriction (No_Obsolescent_Features, Mod_Clause (N));
+
if Warn_On_Obsolescent_Feature then
Error_Msg_N
("mod clause is an obsolescent feature ('R'M 'J.8)?", N);
-- Digits constraint present
if Nkind (C) = N_Digits_Constraint then
+ Check_Restriction (No_Obsolescent_Features, C);
+
if Warn_On_Obsolescent_Feature then
Error_Msg_N
("subtype digits constraint is an " &
-- Delta constraint present
if Nkind (C) = N_Delta_Constraint then
+ Check_Restriction (No_Obsolescent_Features, C);
+
if Warn_On_Obsolescent_Feature then
Error_Msg_S
("subtype delta constraint is an " &
-- Process_Restrictions_Or_Restriction_Warnings --
--------------------------------------------------
+ -- Note: some of the simple identifier cases were handled in par-prag,
+ -- but it is harmless (and more straightforward) to simply handle all
+ -- cases here, even if it means we repeat a bit of work in some cases.
+
procedure Process_Restrictions_Or_Restriction_Warnings is
Arg : Node_Id;
R_Id : Restriction_Id;
Expr : Node_Id;
Val : Uint;
+ procedure Check_Unit_Name (N : Node_Id);
+ -- Checks unit name parameter for No_Dependence. Returns if it has
+ -- an appropriate form, otherwise raises pragma argument error.
+
procedure Set_Warning (R : All_Restrictions);
-- If this is a Restriction_Warnings pragma, set warning flag,
-- otherwise reset the flag.
+ ---------------------
+ -- Check_Unit_Name --
+ ---------------------
+
+ procedure Check_Unit_Name (N : Node_Id) is
+ begin
+ if Nkind (N) = N_Selected_Component then
+ Check_Unit_Name (Prefix (N));
+ Check_Unit_Name (Selector_Name (N));
+
+ elsif Nkind (N) = N_Identifier then
+ return;
+
+ else
+ Error_Pragma_Arg
+ ("wrong form for unit name for No_Dependence", N);
+ end if;
+ end Check_Unit_Name;
+
-----------------
-- Set_Warning --
-----------------
Scope_Suppress := (others => True);
end if;
- -- Case of restriction identifier present
+ -- Case of No_Dependence => unit-name. Note that the parser
+ -- already made the necessary entry in the No_Dependence table.
+
+ elsif Id = Name_No_Dependence then
+ Check_Unit_Name (Expr);
+
+ -- All other cases of restriction identifier present
else
R_Id := Get_Restriction_Id (Process_Restriction_Synonyms (Arg));
end if;
if Present (External) then
+ Check_Arg_Is_External_Name (External);
Check_Too_Long (External);
end if;
"name#" &
"nca#" &
"no#" &
- "on#" &
- "parameter_types#" &
- "reference#" &
+ "no_dependence#" &
"no_dynamic_attachment#" &
"no_dynamic_interrupts#" &
"no_requeue#" &
"no_requeue_statements#" &
"no_task_attributes#" &
"no_task_attributes_package#" &
+ "on#" &
+ "parameter_types#" &
+ "reference#" &
"restricted#" &
"result_mechanism#" &
"result_type#" &
"max_size_in_storage_elements#" &
"maximum_alignment#" &
"mechanism_code#" &
+ "mod#" &
"model_emin#" &
"model_epsilon#" &
"model_mantissa#" &
"is#" &
"limited#" &
"loop#" &
- "mod#" &
"new#" &
"not#" &
"null#" &
Name_Name : constant Name_Id := N + 296;
Name_NCA : constant Name_Id := N + 297;
Name_No : constant Name_Id := N + 298;
- Name_On : constant Name_Id := N + 299;
- Name_Parameter_Types : constant Name_Id := N + 300;
- Name_Reference : constant Name_Id := N + 301;
- Name_No_Dynamic_Attachment : constant Name_Id := N + 302;
- Name_No_Dynamic_Interrupts : constant Name_Id := N + 303;
- Name_No_Requeue : constant Name_Id := N + 304;
- Name_No_Requeue_Statements : constant Name_Id := N + 305;
- Name_No_Task_Attributes : constant Name_Id := N + 306;
- Name_No_Task_Attributes_Package : constant Name_Id := N + 307;
- Name_Restricted : constant Name_Id := N + 308;
- Name_Result_Mechanism : constant Name_Id := N + 309;
- Name_Result_Type : constant Name_Id := N + 310;
- Name_Runtime : constant Name_Id := N + 311;
- Name_SB : constant Name_Id := N + 312;
- Name_Secondary_Stack_Size : constant Name_Id := N + 313;
- Name_Section : constant Name_Id := N + 314;
- Name_Semaphore : constant Name_Id := N + 315;
- Name_Simple_Barriers : constant Name_Id := N + 316;
- Name_Spec_File_Name : constant Name_Id := N + 317;
- Name_Static : constant Name_Id := N + 318;
- Name_Stack_Size : constant Name_Id := N + 319;
- Name_Subunit_File_Name : constant Name_Id := N + 320;
- Name_Task_Stack_Size_Default : constant Name_Id := N + 321;
- Name_Task_Type : constant Name_Id := N + 322;
- Name_Time_Slicing_Enabled : constant Name_Id := N + 323;
- Name_Top_Guard : constant Name_Id := N + 324;
- Name_UBA : constant Name_Id := N + 325;
- Name_UBS : constant Name_Id := N + 326;
- Name_UBSB : constant Name_Id := N + 327;
- Name_Unit_Name : constant Name_Id := N + 328;
- Name_Unknown : constant Name_Id := N + 329;
- Name_Unrestricted : constant Name_Id := N + 330;
- Name_Uppercase : constant Name_Id := N + 331;
- Name_User : constant Name_Id := N + 332;
- Name_VAX_Float : constant Name_Id := N + 333;
- Name_VMS : constant Name_Id := N + 334;
- Name_Working_Storage : constant Name_Id := N + 335;
+ Name_No_Dependence : constant Name_Id := N + 299;
+ Name_No_Dynamic_Attachment : constant Name_Id := N + 300;
+ Name_No_Dynamic_Interrupts : constant Name_Id := N + 301;
+ Name_No_Requeue : constant Name_Id := N + 302;
+ Name_No_Requeue_Statements : constant Name_Id := N + 303;
+ Name_No_Task_Attributes : constant Name_Id := N + 304;
+ Name_No_Task_Attributes_Package : constant Name_Id := N + 305;
+ Name_On : constant Name_Id := N + 306;
+ Name_Parameter_Types : constant Name_Id := N + 307;
+ Name_Reference : constant Name_Id := N + 308;
+ Name_Restricted : constant Name_Id := N + 309;
+ Name_Result_Mechanism : constant Name_Id := N + 310;
+ Name_Result_Type : constant Name_Id := N + 311;
+ Name_Runtime : constant Name_Id := N + 312;
+ Name_SB : constant Name_Id := N + 313;
+ Name_Secondary_Stack_Size : constant Name_Id := N + 314;
+ Name_Section : constant Name_Id := N + 315;
+ Name_Semaphore : constant Name_Id := N + 316;
+ Name_Simple_Barriers : constant Name_Id := N + 317;
+ Name_Spec_File_Name : constant Name_Id := N + 318;
+ Name_Static : constant Name_Id := N + 319;
+ Name_Stack_Size : constant Name_Id := N + 320;
+ Name_Subunit_File_Name : constant Name_Id := N + 321;
+ Name_Task_Stack_Size_Default : constant Name_Id := N + 322;
+ Name_Task_Type : constant Name_Id := N + 323;
+ Name_Time_Slicing_Enabled : constant Name_Id := N + 324;
+ Name_Top_Guard : constant Name_Id := N + 325;
+ Name_UBA : constant Name_Id := N + 326;
+ Name_UBS : constant Name_Id := N + 327;
+ Name_UBSB : constant Name_Id := N + 328;
+ Name_Unit_Name : constant Name_Id := N + 329;
+ Name_Unknown : constant Name_Id := N + 330;
+ Name_Unrestricted : constant Name_Id := N + 331;
+ Name_Uppercase : constant Name_Id := N + 332;
+ Name_User : constant Name_Id := N + 333;
+ Name_VAX_Float : constant Name_Id := N + 334;
+ Name_VMS : constant Name_Id := N + 335;
+ Name_Working_Storage : constant Name_Id := N + 336;
-- Names of recognized attributes. The entries with the comment "Ada 83"
-- are attributes that are defined in Ada 83, but not in Ada 95. These
-- The entries marked VMS are recognized only in OpenVMS implementations
-- of GNAT, and are treated as illegal in all other contexts.
- First_Attribute_Name : constant Name_Id := N + 336;
- Name_Abort_Signal : constant Name_Id := N + 336; -- GNAT
- Name_Access : constant Name_Id := N + 337;
- Name_Address : constant Name_Id := N + 338;
- Name_Address_Size : constant Name_Id := N + 339; -- GNAT
- Name_Aft : constant Name_Id := N + 340;
- Name_Alignment : constant Name_Id := N + 341;
- Name_Asm_Input : constant Name_Id := N + 342; -- GNAT
- Name_Asm_Output : constant Name_Id := N + 343; -- GNAT
- Name_AST_Entry : constant Name_Id := N + 344; -- VMS
- Name_Bit : constant Name_Id := N + 345; -- GNAT
- Name_Bit_Order : constant Name_Id := N + 346;
- Name_Bit_Position : constant Name_Id := N + 347; -- GNAT
- Name_Body_Version : constant Name_Id := N + 348;
- Name_Callable : constant Name_Id := N + 349;
- Name_Caller : constant Name_Id := N + 350;
- Name_Code_Address : constant Name_Id := N + 351; -- GNAT
- Name_Component_Size : constant Name_Id := N + 352;
- Name_Compose : constant Name_Id := N + 353;
- Name_Constrained : constant Name_Id := N + 354;
- Name_Count : constant Name_Id := N + 355;
- Name_Default_Bit_Order : constant Name_Id := N + 356; -- GNAT
- Name_Definite : constant Name_Id := N + 357;
- Name_Delta : constant Name_Id := N + 358;
- Name_Denorm : constant Name_Id := N + 359;
- Name_Digits : constant Name_Id := N + 360;
- Name_Elaborated : constant Name_Id := N + 361; -- GNAT
- Name_Emax : constant Name_Id := N + 362; -- Ada 83
- Name_Enum_Rep : constant Name_Id := N + 363; -- GNAT
- Name_Epsilon : constant Name_Id := N + 364; -- Ada 83
- Name_Exponent : constant Name_Id := N + 365;
- Name_External_Tag : constant Name_Id := N + 366;
- Name_First : constant Name_Id := N + 367;
- Name_First_Bit : constant Name_Id := N + 368;
- Name_Fixed_Value : constant Name_Id := N + 369; -- GNAT
- Name_Fore : constant Name_Id := N + 370;
- Name_Has_Access_Values : constant Name_Id := N + 371; -- GNAT
- Name_Has_Discriminants : constant Name_Id := N + 372; -- GNAT
- Name_Identity : constant Name_Id := N + 373;
- Name_Img : constant Name_Id := N + 374; -- GNAT
- Name_Integer_Value : constant Name_Id := N + 375; -- GNAT
- Name_Large : constant Name_Id := N + 376; -- Ada 83
- Name_Last : constant Name_Id := N + 377;
- Name_Last_Bit : constant Name_Id := N + 378;
- Name_Leading_Part : constant Name_Id := N + 379;
- Name_Length : constant Name_Id := N + 380;
- Name_Machine_Emax : constant Name_Id := N + 381;
- Name_Machine_Emin : constant Name_Id := N + 382;
- Name_Machine_Mantissa : constant Name_Id := N + 383;
- Name_Machine_Overflows : constant Name_Id := N + 384;
- Name_Machine_Radix : constant Name_Id := N + 385;
- Name_Machine_Rounds : constant Name_Id := N + 386;
- Name_Machine_Size : constant Name_Id := N + 387; -- GNAT
- Name_Mantissa : constant Name_Id := N + 388; -- Ada 83
- Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 389;
- Name_Maximum_Alignment : constant Name_Id := N + 390; -- GNAT
- Name_Mechanism_Code : constant Name_Id := N + 391; -- GNAT
- Name_Model_Emin : constant Name_Id := N + 392;
- Name_Model_Epsilon : constant Name_Id := N + 393;
- Name_Model_Mantissa : constant Name_Id := N + 394;
- Name_Model_Small : constant Name_Id := N + 395;
- Name_Modulus : constant Name_Id := N + 396;
- Name_Null_Parameter : constant Name_Id := N + 397; -- GNAT
- Name_Object_Size : constant Name_Id := N + 398; -- GNAT
- Name_Partition_ID : constant Name_Id := N + 399;
- Name_Passed_By_Reference : constant Name_Id := N + 400; -- GNAT
- Name_Pool_Address : constant Name_Id := N + 401;
- Name_Pos : constant Name_Id := N + 402;
- Name_Position : constant Name_Id := N + 403;
- Name_Range : constant Name_Id := N + 404;
- Name_Range_Length : constant Name_Id := N + 405; -- GNAT
- Name_Round : constant Name_Id := N + 406;
- Name_Safe_Emax : constant Name_Id := N + 407; -- Ada 83
- Name_Safe_First : constant Name_Id := N + 408;
- Name_Safe_Large : constant Name_Id := N + 409; -- Ada 83
- Name_Safe_Last : constant Name_Id := N + 410;
- Name_Safe_Small : constant Name_Id := N + 411; -- Ada 83
- Name_Scale : constant Name_Id := N + 412;
- Name_Scaling : constant Name_Id := N + 413;
- Name_Signed_Zeros : constant Name_Id := N + 414;
- Name_Size : constant Name_Id := N + 415;
- Name_Small : constant Name_Id := N + 416;
- Name_Storage_Size : constant Name_Id := N + 417;
- Name_Storage_Unit : constant Name_Id := N + 418; -- GNAT
- Name_Tag : constant Name_Id := N + 419;
- Name_Target_Name : constant Name_Id := N + 420; -- GNAT
- Name_Terminated : constant Name_Id := N + 421;
- Name_To_Address : constant Name_Id := N + 422; -- GNAT
- Name_Type_Class : constant Name_Id := N + 423; -- GNAT
- Name_UET_Address : constant Name_Id := N + 424; -- GNAT
- Name_Unbiased_Rounding : constant Name_Id := N + 425;
- Name_Unchecked_Access : constant Name_Id := N + 426;
- Name_Unconstrained_Array : constant Name_Id := N + 427;
- Name_Universal_Literal_String : constant Name_Id := N + 428; -- GNAT
- Name_Unrestricted_Access : constant Name_Id := N + 429; -- GNAT
- Name_VADS_Size : constant Name_Id := N + 430; -- GNAT
- Name_Val : constant Name_Id := N + 431;
- Name_Valid : constant Name_Id := N + 432;
- Name_Value_Size : constant Name_Id := N + 433; -- GNAT
- Name_Version : constant Name_Id := N + 434;
- Name_Wchar_T_Size : constant Name_Id := N + 435; -- GNAT
- Name_Wide_Width : constant Name_Id := N + 436;
- Name_Width : constant Name_Id := N + 437;
- Name_Word_Size : constant Name_Id := N + 438; -- GNAT
+ First_Attribute_Name : constant Name_Id := N + 337;
+ Name_Abort_Signal : constant Name_Id := N + 337; -- GNAT
+ Name_Access : constant Name_Id := N + 338;
+ Name_Address : constant Name_Id := N + 339;
+ Name_Address_Size : constant Name_Id := N + 340; -- GNAT
+ Name_Aft : constant Name_Id := N + 341;
+ Name_Alignment : constant Name_Id := N + 342;
+ Name_Asm_Input : constant Name_Id := N + 343; -- GNAT
+ Name_Asm_Output : constant Name_Id := N + 344; -- GNAT
+ Name_AST_Entry : constant Name_Id := N + 345; -- VMS
+ Name_Bit : constant Name_Id := N + 346; -- GNAT
+ Name_Bit_Order : constant Name_Id := N + 347;
+ Name_Bit_Position : constant Name_Id := N + 348; -- GNAT
+ Name_Body_Version : constant Name_Id := N + 349;
+ Name_Callable : constant Name_Id := N + 350;
+ Name_Caller : constant Name_Id := N + 351;
+ Name_Code_Address : constant Name_Id := N + 352; -- GNAT
+ Name_Component_Size : constant Name_Id := N + 353;
+ Name_Compose : constant Name_Id := N + 354;
+ Name_Constrained : constant Name_Id := N + 355;
+ Name_Count : constant Name_Id := N + 356;
+ Name_Default_Bit_Order : constant Name_Id := N + 357; -- GNAT
+ Name_Definite : constant Name_Id := N + 358;
+ Name_Delta : constant Name_Id := N + 359;
+ Name_Denorm : constant Name_Id := N + 360;
+ Name_Digits : constant Name_Id := N + 361;
+ Name_Elaborated : constant Name_Id := N + 362; -- GNAT
+ Name_Emax : constant Name_Id := N + 363; -- Ada 83
+ Name_Enum_Rep : constant Name_Id := N + 364; -- GNAT
+ Name_Epsilon : constant Name_Id := N + 365; -- Ada 83
+ Name_Exponent : constant Name_Id := N + 366;
+ Name_External_Tag : constant Name_Id := N + 367;
+ Name_First : constant Name_Id := N + 368;
+ Name_First_Bit : constant Name_Id := N + 369;
+ Name_Fixed_Value : constant Name_Id := N + 370; -- GNAT
+ Name_Fore : constant Name_Id := N + 371;
+ Name_Has_Access_Values : constant Name_Id := N + 372; -- GNAT
+ Name_Has_Discriminants : constant Name_Id := N + 373; -- GNAT
+ Name_Identity : constant Name_Id := N + 374;
+ Name_Img : constant Name_Id := N + 375; -- GNAT
+ Name_Integer_Value : constant Name_Id := N + 376; -- GNAT
+ Name_Large : constant Name_Id := N + 377; -- Ada 83
+ Name_Last : constant Name_Id := N + 378;
+ Name_Last_Bit : constant Name_Id := N + 379;
+ Name_Leading_Part : constant Name_Id := N + 380;
+ Name_Length : constant Name_Id := N + 381;
+ Name_Machine_Emax : constant Name_Id := N + 382;
+ Name_Machine_Emin : constant Name_Id := N + 383;
+ Name_Machine_Mantissa : constant Name_Id := N + 384;
+ Name_Machine_Overflows : constant Name_Id := N + 385;
+ Name_Machine_Radix : constant Name_Id := N + 386;
+ Name_Machine_Rounds : constant Name_Id := N + 387;
+ Name_Machine_Size : constant Name_Id := N + 388; -- GNAT
+ Name_Mantissa : constant Name_Id := N + 389; -- Ada 83
+ Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 390;
+ Name_Maximum_Alignment : constant Name_Id := N + 391; -- GNAT
+ Name_Mechanism_Code : constant Name_Id := N + 392; -- GNAT
+ Name_Mod : constant Name_Id := N + 393;
+ Name_Model_Emin : constant Name_Id := N + 394;
+ Name_Model_Epsilon : constant Name_Id := N + 395;
+ Name_Model_Mantissa : constant Name_Id := N + 396;
+ Name_Model_Small : constant Name_Id := N + 397;
+ Name_Modulus : constant Name_Id := N + 398;
+ Name_Null_Parameter : constant Name_Id := N + 399; -- GNAT
+ Name_Object_Size : constant Name_Id := N + 400; -- GNAT
+ Name_Partition_ID : constant Name_Id := N + 401;
+ Name_Passed_By_Reference : constant Name_Id := N + 402; -- GNAT
+ Name_Pool_Address : constant Name_Id := N + 403;
+ Name_Pos : constant Name_Id := N + 404;
+ Name_Position : constant Name_Id := N + 405;
+ Name_Range : constant Name_Id := N + 406;
+ Name_Range_Length : constant Name_Id := N + 407; -- GNAT
+ Name_Round : constant Name_Id := N + 408;
+ Name_Safe_Emax : constant Name_Id := N + 409; -- Ada 83
+ Name_Safe_First : constant Name_Id := N + 410;
+ Name_Safe_Large : constant Name_Id := N + 411; -- Ada 83
+ Name_Safe_Last : constant Name_Id := N + 412;
+ Name_Safe_Small : constant Name_Id := N + 413; -- Ada 83
+ Name_Scale : constant Name_Id := N + 414;
+ Name_Scaling : constant Name_Id := N + 415;
+ Name_Signed_Zeros : constant Name_Id := N + 416;
+ Name_Size : constant Name_Id := N + 417;
+ Name_Small : constant Name_Id := N + 418;
+ Name_Storage_Size : constant Name_Id := N + 419;
+ Name_Storage_Unit : constant Name_Id := N + 420; -- GNAT
+ Name_Tag : constant Name_Id := N + 421;
+ Name_Target_Name : constant Name_Id := N + 422; -- GNAT
+ Name_Terminated : constant Name_Id := N + 423;
+ Name_To_Address : constant Name_Id := N + 424; -- GNAT
+ Name_Type_Class : constant Name_Id := N + 425; -- GNAT
+ Name_UET_Address : constant Name_Id := N + 426; -- GNAT
+ Name_Unbiased_Rounding : constant Name_Id := N + 427;
+ Name_Unchecked_Access : constant Name_Id := N + 428;
+ Name_Unconstrained_Array : constant Name_Id := N + 429;
+ Name_Universal_Literal_String : constant Name_Id := N + 430; -- GNAT
+ Name_Unrestricted_Access : constant Name_Id := N + 431; -- GNAT
+ Name_VADS_Size : constant Name_Id := N + 432; -- GNAT
+ Name_Val : constant Name_Id := N + 433;
+ Name_Valid : constant Name_Id := N + 434;
+ Name_Value_Size : constant Name_Id := N + 435; -- GNAT
+ Name_Version : constant Name_Id := N + 436;
+ Name_Wchar_T_Size : constant Name_Id := N + 437; -- GNAT
+ Name_Wide_Width : constant Name_Id := N + 438;
+ Name_Width : constant Name_Id := N + 439;
+ Name_Word_Size : constant Name_Id := N + 440; -- GNAT
-- Attributes that designate attributes returning renamable functions,
- -- i.e. functions that return other than a universal value.
-
- First_Renamable_Function_Attribute : constant Name_Id := N + 439;
- Name_Adjacent : constant Name_Id := N + 439;
- Name_Ceiling : constant Name_Id := N + 440;
- Name_Copy_Sign : constant Name_Id := N + 441;
- Name_Floor : constant Name_Id := N + 442;
- Name_Fraction : constant Name_Id := N + 443;
- Name_Image : constant Name_Id := N + 444;
- Name_Input : constant Name_Id := N + 445;
- Name_Machine : constant Name_Id := N + 446;
- Name_Max : constant Name_Id := N + 447;
- Name_Min : constant Name_Id := N + 448;
- Name_Model : constant Name_Id := N + 449;
- Name_Pred : constant Name_Id := N + 450;
- Name_Remainder : constant Name_Id := N + 451;
- Name_Rounding : constant Name_Id := N + 452;
- Name_Succ : constant Name_Id := N + 453;
- Name_Truncation : constant Name_Id := N + 454;
- Name_Value : constant Name_Id := N + 455;
- Name_Wide_Image : constant Name_Id := N + 456;
- Name_Wide_Value : constant Name_Id := N + 457;
- Last_Renamable_Function_Attribute : constant Name_Id := N + 457;
+ -- i.e. functions that return other than a universal value and that
+ -- have non-universal arguments.
+
+ First_Renamable_Function_Attribute : constant Name_Id := N + 441;
+ Name_Adjacent : constant Name_Id := N + 441;
+ Name_Ceiling : constant Name_Id := N + 442;
+ Name_Copy_Sign : constant Name_Id := N + 443;
+ Name_Floor : constant Name_Id := N + 444;
+ Name_Fraction : constant Name_Id := N + 445;
+ Name_Image : constant Name_Id := N + 446;
+ Name_Input : constant Name_Id := N + 447;
+ Name_Machine : constant Name_Id := N + 448;
+ Name_Max : constant Name_Id := N + 449;
+ Name_Min : constant Name_Id := N + 450;
+ Name_Model : constant Name_Id := N + 451;
+ Name_Pred : constant Name_Id := N + 452;
+ Name_Remainder : constant Name_Id := N + 453;
+ Name_Rounding : constant Name_Id := N + 454;
+ Name_Succ : constant Name_Id := N + 455;
+ Name_Truncation : constant Name_Id := N + 456;
+ Name_Value : constant Name_Id := N + 457;
+ Name_Wide_Image : constant Name_Id := N + 458;
+ Name_Wide_Value : constant Name_Id := N + 459;
+ Last_Renamable_Function_Attribute : constant Name_Id := N + 459;
-- Attributes that designate procedures
- First_Procedure_Attribute : constant Name_Id := N + 458;
- Name_Output : constant Name_Id := N + 458;
- Name_Read : constant Name_Id := N + 459;
- Name_Write : constant Name_Id := N + 460;
- Last_Procedure_Attribute : constant Name_Id := N + 460;
+ First_Procedure_Attribute : constant Name_Id := N + 460;
+ Name_Output : constant Name_Id := N + 460;
+ Name_Read : constant Name_Id := N + 461;
+ Name_Write : constant Name_Id := N + 462;
+ Last_Procedure_Attribute : constant Name_Id := N + 462;
-- Remaining attributes are ones that return entities
- First_Entity_Attribute_Name : constant Name_Id := N + 461;
- Name_Elab_Body : constant Name_Id := N + 461; -- GNAT
- Name_Elab_Spec : constant Name_Id := N + 462; -- GNAT
- Name_Storage_Pool : constant Name_Id := N + 463;
+ First_Entity_Attribute_Name : constant Name_Id := N + 463;
+ Name_Elab_Body : constant Name_Id := N + 463; -- GNAT
+ Name_Elab_Spec : constant Name_Id := N + 464; -- GNAT
+ Name_Storage_Pool : constant Name_Id := N + 465;
-- These attributes are the ones that return types
- First_Type_Attribute_Name : constant Name_Id := N + 464;
- Name_Base : constant Name_Id := N + 464;
- Name_Class : constant Name_Id := N + 465;
- Last_Type_Attribute_Name : constant Name_Id := N + 465;
- Last_Entity_Attribute_Name : constant Name_Id := N + 465;
- Last_Attribute_Name : constant Name_Id := N + 465;
+ First_Type_Attribute_Name : constant Name_Id := N + 466;
+ Name_Base : constant Name_Id := N + 466;
+ Name_Class : constant Name_Id := N + 467;
+ Last_Type_Attribute_Name : constant Name_Id := N + 467;
+ Last_Entity_Attribute_Name : constant Name_Id := N + 467;
+ Last_Attribute_Name : constant Name_Id := N + 467;
-- Names of recognized locking policy identifiers
-- name (e.g. C for Ceiling_Locking). If new policy names are added,
-- the first character must be distinct.
- First_Locking_Policy_Name : constant Name_Id := N + 466;
- Name_Ceiling_Locking : constant Name_Id := N + 466;
- Name_Inheritance_Locking : constant Name_Id := N + 467;
- Last_Locking_Policy_Name : constant Name_Id := N + 467;
+ First_Locking_Policy_Name : constant Name_Id := N + 468;
+ Name_Ceiling_Locking : constant Name_Id := N + 468;
+ Name_Inheritance_Locking : constant Name_Id := N + 469;
+ Last_Locking_Policy_Name : constant Name_Id := N + 469;
-- Names of recognized queuing policy identifiers.
-- name (e.g. F for FIFO_Queuing). If new policy names are added,
-- the first character must be distinct.
- First_Queuing_Policy_Name : constant Name_Id := N + 468;
- Name_FIFO_Queuing : constant Name_Id := N + 468;
- Name_Priority_Queuing : constant Name_Id := N + 469;
- Last_Queuing_Policy_Name : constant Name_Id := N + 469;
+ First_Queuing_Policy_Name : constant Name_Id := N + 470;
+ Name_FIFO_Queuing : constant Name_Id := N + 470;
+ Name_Priority_Queuing : constant Name_Id := N + 471;
+ Last_Queuing_Policy_Name : constant Name_Id := N + 471;
-- Names of recognized task dispatching policy identifiers
-- name (e.g. F for FIFO_WIthinn_Priorities). If new policy names
-- are added, the first character must be distinct.
- First_Task_Dispatching_Policy_Name : constant Name_Id := N + 470;
- Name_FIFO_Within_Priorities : constant Name_Id := N + 470;
- Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 470;
+ First_Task_Dispatching_Policy_Name : constant Name_Id := N + 472;
+ Name_FIFO_Within_Priorities : constant Name_Id := N + 472;
+ Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 472;
-- Names of recognized checks for pragma Suppress
- First_Check_Name : constant Name_Id := N + 471;
- Name_Access_Check : constant Name_Id := N + 471;
- Name_Accessibility_Check : constant Name_Id := N + 472;
- Name_Discriminant_Check : constant Name_Id := N + 473;
- Name_Division_Check : constant Name_Id := N + 474;
- Name_Elaboration_Check : constant Name_Id := N + 475;
- Name_Index_Check : constant Name_Id := N + 476;
- Name_Length_Check : constant Name_Id := N + 477;
- Name_Overflow_Check : constant Name_Id := N + 478;
- Name_Range_Check : constant Name_Id := N + 479;
- Name_Storage_Check : constant Name_Id := N + 480;
- Name_Tag_Check : constant Name_Id := N + 481;
- Name_All_Checks : constant Name_Id := N + 482;
- Last_Check_Name : constant Name_Id := N + 482;
+ First_Check_Name : constant Name_Id := N + 473;
+ Name_Access_Check : constant Name_Id := N + 473;
+ Name_Accessibility_Check : constant Name_Id := N + 474;
+ Name_Discriminant_Check : constant Name_Id := N + 475;
+ Name_Division_Check : constant Name_Id := N + 476;
+ Name_Elaboration_Check : constant Name_Id := N + 477;
+ Name_Index_Check : constant Name_Id := N + 478;
+ Name_Length_Check : constant Name_Id := N + 479;
+ Name_Overflow_Check : constant Name_Id := N + 480;
+ Name_Range_Check : constant Name_Id := N + 481;
+ Name_Storage_Check : constant Name_Id := N + 482;
+ Name_Tag_Check : constant Name_Id := N + 483;
+ Name_All_Checks : constant Name_Id := N + 484;
+ Last_Check_Name : constant Name_Id := N + 484;
-- Names corresponding to reserved keywords, excluding those already
- -- declared in the attribute list (Access, Delta, Digits, Range).
-
- Name_Abort : constant Name_Id := N + 483;
- Name_Abs : constant Name_Id := N + 484;
- Name_Accept : constant Name_Id := N + 485;
- Name_And : constant Name_Id := N + 486;
- Name_All : constant Name_Id := N + 487;
- Name_Array : constant Name_Id := N + 488;
- Name_At : constant Name_Id := N + 489;
- Name_Begin : constant Name_Id := N + 490;
- Name_Body : constant Name_Id := N + 491;
- Name_Case : constant Name_Id := N + 492;
- Name_Constant : constant Name_Id := N + 493;
- Name_Declare : constant Name_Id := N + 494;
- Name_Delay : constant Name_Id := N + 495;
- Name_Do : constant Name_Id := N + 496;
- Name_Else : constant Name_Id := N + 497;
- Name_Elsif : constant Name_Id := N + 498;
- Name_End : constant Name_Id := N + 499;
- Name_Entry : constant Name_Id := N + 500;
- Name_Exception : constant Name_Id := N + 501;
- Name_Exit : constant Name_Id := N + 502;
- Name_For : constant Name_Id := N + 503;
- Name_Function : constant Name_Id := N + 504;
- Name_Generic : constant Name_Id := N + 505;
- Name_Goto : constant Name_Id := N + 506;
- Name_If : constant Name_Id := N + 507;
- Name_In : constant Name_Id := N + 508;
- Name_Is : constant Name_Id := N + 509;
- Name_Limited : constant Name_Id := N + 510;
- Name_Loop : constant Name_Id := N + 511;
- Name_Mod : constant Name_Id := N + 512;
- Name_New : constant Name_Id := N + 513;
- Name_Not : constant Name_Id := N + 514;
- Name_Null : constant Name_Id := N + 515;
- Name_Of : constant Name_Id := N + 516;
- Name_Or : constant Name_Id := N + 517;
- Name_Others : constant Name_Id := N + 518;
- Name_Out : constant Name_Id := N + 519;
- Name_Package : constant Name_Id := N + 520;
- Name_Pragma : constant Name_Id := N + 521;
- Name_Private : constant Name_Id := N + 522;
- Name_Procedure : constant Name_Id := N + 523;
- Name_Raise : constant Name_Id := N + 524;
- Name_Record : constant Name_Id := N + 525;
- Name_Rem : constant Name_Id := N + 526;
- Name_Renames : constant Name_Id := N + 527;
- Name_Return : constant Name_Id := N + 528;
- Name_Reverse : constant Name_Id := N + 529;
- Name_Select : constant Name_Id := N + 530;
- Name_Separate : constant Name_Id := N + 531;
- Name_Subtype : constant Name_Id := N + 532;
- Name_Task : constant Name_Id := N + 533;
- Name_Terminate : constant Name_Id := N + 534;
- Name_Then : constant Name_Id := N + 535;
- Name_Type : constant Name_Id := N + 536;
- Name_Use : constant Name_Id := N + 537;
- Name_When : constant Name_Id := N + 538;
- Name_While : constant Name_Id := N + 539;
- Name_With : constant Name_Id := N + 540;
- Name_Xor : constant Name_Id := N + 541;
+ -- declared in the attribute list (Access, Delta, Digits, Mod, Range).
+
+ Name_Abort : constant Name_Id := N + 485;
+ Name_Abs : constant Name_Id := N + 486;
+ Name_Accept : constant Name_Id := N + 487;
+ Name_And : constant Name_Id := N + 488;
+ Name_All : constant Name_Id := N + 489;
+ Name_Array : constant Name_Id := N + 490;
+ Name_At : constant Name_Id := N + 491;
+ Name_Begin : constant Name_Id := N + 492;
+ Name_Body : constant Name_Id := N + 493;
+ Name_Case : constant Name_Id := N + 494;
+ Name_Constant : constant Name_Id := N + 495;
+ Name_Declare : constant Name_Id := N + 496;
+ Name_Delay : constant Name_Id := N + 497;
+ Name_Do : constant Name_Id := N + 498;
+ Name_Else : constant Name_Id := N + 499;
+ Name_Elsif : constant Name_Id := N + 500;
+ Name_End : constant Name_Id := N + 501;
+ Name_Entry : constant Name_Id := N + 502;
+ Name_Exception : constant Name_Id := N + 503;
+ Name_Exit : constant Name_Id := N + 504;
+ Name_For : constant Name_Id := N + 505;
+ Name_Function : constant Name_Id := N + 506;
+ Name_Generic : constant Name_Id := N + 507;
+ Name_Goto : constant Name_Id := N + 508;
+ Name_If : constant Name_Id := N + 509;
+ Name_In : constant Name_Id := N + 510;
+ Name_Is : constant Name_Id := N + 511;
+ Name_Limited : constant Name_Id := N + 512;
+ Name_Loop : constant Name_Id := N + 513;
+ Name_New : constant Name_Id := N + 514;
+ Name_Not : constant Name_Id := N + 515;
+ Name_Null : constant Name_Id := N + 516;
+ Name_Of : constant Name_Id := N + 517;
+ Name_Or : constant Name_Id := N + 518;
+ Name_Others : constant Name_Id := N + 519;
+ Name_Out : constant Name_Id := N + 520;
+ Name_Package : constant Name_Id := N + 521;
+ Name_Pragma : constant Name_Id := N + 522;
+ Name_Private : constant Name_Id := N + 523;
+ Name_Procedure : constant Name_Id := N + 524;
+ Name_Raise : constant Name_Id := N + 525;
+ Name_Record : constant Name_Id := N + 526;
+ Name_Rem : constant Name_Id := N + 527;
+ Name_Renames : constant Name_Id := N + 528;
+ Name_Return : constant Name_Id := N + 529;
+ Name_Reverse : constant Name_Id := N + 530;
+ Name_Select : constant Name_Id := N + 531;
+ Name_Separate : constant Name_Id := N + 532;
+ Name_Subtype : constant Name_Id := N + 533;
+ Name_Task : constant Name_Id := N + 534;
+ Name_Terminate : constant Name_Id := N + 535;
+ Name_Then : constant Name_Id := N + 536;
+ Name_Type : constant Name_Id := N + 537;
+ Name_Use : constant Name_Id := N + 538;
+ Name_When : constant Name_Id := N + 539;
+ Name_While : constant Name_Id := N + 540;
+ Name_With : constant Name_Id := N + 541;
+ Name_Xor : constant Name_Id := N + 542;
-- Names of intrinsic subprograms
-- Note: Asm is missing from this list, since Asm is a legitimate
-- convention name. So is To_Adress, which is a GNAT attribute.
- First_Intrinsic_Name : constant Name_Id := N + 542;
- Name_Divide : constant Name_Id := N + 542;
- Name_Enclosing_Entity : constant Name_Id := N + 543;
- Name_Exception_Information : constant Name_Id := N + 544;
- Name_Exception_Message : constant Name_Id := N + 545;
- Name_Exception_Name : constant Name_Id := N + 546;
- Name_File : constant Name_Id := N + 547;
- Name_Import_Address : constant Name_Id := N + 548;
- Name_Import_Largest_Value : constant Name_Id := N + 549;
- Name_Import_Value : constant Name_Id := N + 550;
- Name_Is_Negative : constant Name_Id := N + 551;
- Name_Line : constant Name_Id := N + 552;
- Name_Rotate_Left : constant Name_Id := N + 553;
- Name_Rotate_Right : constant Name_Id := N + 554;
- Name_Shift_Left : constant Name_Id := N + 555;
- Name_Shift_Right : constant Name_Id := N + 556;
- Name_Shift_Right_Arithmetic : constant Name_Id := N + 557;
- Name_Source_Location : constant Name_Id := N + 558;
- Name_Unchecked_Conversion : constant Name_Id := N + 559;
- Name_Unchecked_Deallocation : constant Name_Id := N + 560;
- Name_To_Pointer : constant Name_Id := N + 561;
- Last_Intrinsic_Name : constant Name_Id := N + 561;
+ First_Intrinsic_Name : constant Name_Id := N + 543;
+ Name_Divide : constant Name_Id := N + 543;
+ Name_Enclosing_Entity : constant Name_Id := N + 544;
+ Name_Exception_Information : constant Name_Id := N + 545;
+ Name_Exception_Message : constant Name_Id := N + 546;
+ Name_Exception_Name : constant Name_Id := N + 547;
+ Name_File : constant Name_Id := N + 548;
+ Name_Import_Address : constant Name_Id := N + 549;
+ Name_Import_Largest_Value : constant Name_Id := N + 550;
+ Name_Import_Value : constant Name_Id := N + 551;
+ Name_Is_Negative : constant Name_Id := N + 552;
+ Name_Line : constant Name_Id := N + 553;
+ Name_Rotate_Left : constant Name_Id := N + 554;
+ Name_Rotate_Right : constant Name_Id := N + 555;
+ Name_Shift_Left : constant Name_Id := N + 556;
+ Name_Shift_Right : constant Name_Id := N + 557;
+ Name_Shift_Right_Arithmetic : constant Name_Id := N + 558;
+ Name_Source_Location : constant Name_Id := N + 559;
+ Name_Unchecked_Conversion : constant Name_Id := N + 560;
+ Name_Unchecked_Deallocation : constant Name_Id := N + 561;
+ Name_To_Pointer : constant Name_Id := N + 562;
+ Last_Intrinsic_Name : constant Name_Id := N + 562;
-- Reserved words used only in Ada 95
- First_95_Reserved_Word : constant Name_Id := N + 562;
- Name_Abstract : constant Name_Id := N + 562;
- Name_Aliased : constant Name_Id := N + 563;
- Name_Protected : constant Name_Id := N + 564;
- Name_Until : constant Name_Id := N + 565;
- Name_Requeue : constant Name_Id := N + 566;
- Name_Tagged : constant Name_Id := N + 567;
- Last_95_Reserved_Word : constant Name_Id := N + 567;
+ First_95_Reserved_Word : constant Name_Id := N + 563;
+ Name_Abstract : constant Name_Id := N + 563;
+ Name_Aliased : constant Name_Id := N + 564;
+ Name_Protected : constant Name_Id := N + 565;
+ Name_Until : constant Name_Id := N + 566;
+ Name_Requeue : constant Name_Id := N + 567;
+ Name_Tagged : constant Name_Id := N + 568;
+ Last_95_Reserved_Word : constant Name_Id := N + 568;
subtype Ada_95_Reserved_Words is
Name_Id range First_95_Reserved_Word .. Last_95_Reserved_Word;
-- Miscellaneous names used in semantic checking
- Name_Raise_Exception : constant Name_Id := N + 568;
+ Name_Raise_Exception : constant Name_Id := N + 569;
-- Additional reserved words and identifiers used in GNAT Project Files
-- Note that Name_External is already previously declared
- Name_Ada_Roots : constant Name_Id := N + 569;
- Name_Binder : constant Name_Id := N + 570;
- Name_Binder_Driver : constant Name_Id := N + 571;
- Name_Body_Suffix : constant Name_Id := N + 572;
- Name_Builder : constant Name_Id := N + 573;
- Name_Compiler : constant Name_Id := N + 574;
- Name_Compiler_Driver : constant Name_Id := N + 575;
- Name_Compiler_Kind : constant Name_Id := N + 576;
- Name_Compute_Dependency : constant Name_Id := N + 577;
- Name_Cross_Reference : constant Name_Id := N + 578;
- Name_Default_Linker : constant Name_Id := N + 579;
- Name_Default_Switches : constant Name_Id := N + 580;
- Name_Dependency_Option : constant Name_Id := N + 581;
- Name_Exec_Dir : constant Name_Id := N + 582;
- Name_Executable : constant Name_Id := N + 583;
- Name_Executable_Suffix : constant Name_Id := N + 584;
- Name_Extends : constant Name_Id := N + 585;
- Name_Externally_Built : constant Name_Id := N + 586;
- Name_Finder : constant Name_Id := N + 587;
- Name_Global_Configuration_Pragmas : constant Name_Id := N + 588;
- Name_Gnatls : constant Name_Id := N + 589;
- Name_Gnatstub : constant Name_Id := N + 590;
- Name_Implementation : constant Name_Id := N + 591;
- Name_Implementation_Exceptions : constant Name_Id := N + 592;
- Name_Implementation_Suffix : constant Name_Id := N + 593;
- Name_Include_Option : constant Name_Id := N + 594;
- Name_Language_Processing : constant Name_Id := N + 595;
- Name_Languages : constant Name_Id := N + 596;
- Name_Library_Dir : constant Name_Id := N + 597;
- Name_Library_Auto_Init : constant Name_Id := N + 598;
- Name_Library_GCC : constant Name_Id := N + 599;
- Name_Library_Interface : constant Name_Id := N + 600;
- Name_Library_Kind : constant Name_Id := N + 601;
- Name_Library_Name : constant Name_Id := N + 602;
- Name_Library_Options : constant Name_Id := N + 603;
- Name_Library_Reference_Symbol_File : constant Name_Id := N + 604;
- Name_Library_Src_Dir : constant Name_Id := N + 605;
- Name_Library_Symbol_File : constant Name_Id := N + 606;
- Name_Library_Symbol_Policy : constant Name_Id := N + 607;
- Name_Library_Version : constant Name_Id := N + 608;
- Name_Linker : constant Name_Id := N + 609;
- Name_Local_Configuration_Pragmas : constant Name_Id := N + 610;
- Name_Locally_Removed_Files : constant Name_Id := N + 611;
- Name_Metrics : constant Name_Id := N + 612;
- Name_Naming : constant Name_Id := N + 613;
- Name_Object_Dir : constant Name_Id := N + 614;
- Name_Pretty_Printer : constant Name_Id := N + 615;
- Name_Project : constant Name_Id := N + 616;
- Name_Separate_Suffix : constant Name_Id := N + 617;
- Name_Source_Dirs : constant Name_Id := N + 618;
- Name_Source_Files : constant Name_Id := N + 619;
- Name_Source_List_File : constant Name_Id := N + 620;
- Name_Spec : constant Name_Id := N + 621;
- Name_Spec_Suffix : constant Name_Id := N + 622;
- Name_Specification : constant Name_Id := N + 623;
- Name_Specification_Exceptions : constant Name_Id := N + 624;
- Name_Specification_Suffix : constant Name_Id := N + 625;
- Name_Switches : constant Name_Id := N + 626;
+ Name_Ada_Roots : constant Name_Id := N + 570;
+ Name_Binder : constant Name_Id := N + 571;
+ Name_Binder_Driver : constant Name_Id := N + 572;
+ Name_Body_Suffix : constant Name_Id := N + 573;
+ Name_Builder : constant Name_Id := N + 574;
+ Name_Compiler : constant Name_Id := N + 575;
+ Name_Compiler_Driver : constant Name_Id := N + 576;
+ Name_Compiler_Kind : constant Name_Id := N + 577;
+ Name_Compute_Dependency : constant Name_Id := N + 578;
+ Name_Cross_Reference : constant Name_Id := N + 579;
+ Name_Default_Linker : constant Name_Id := N + 580;
+ Name_Default_Switches : constant Name_Id := N + 581;
+ Name_Dependency_Option : constant Name_Id := N + 582;
+ Name_Exec_Dir : constant Name_Id := N + 583;
+ Name_Executable : constant Name_Id := N + 584;
+ Name_Executable_Suffix : constant Name_Id := N + 585;
+ Name_Extends : constant Name_Id := N + 586;
+ Name_Externally_Built : constant Name_Id := N + 587;
+ Name_Finder : constant Name_Id := N + 588;
+ Name_Global_Configuration_Pragmas : constant Name_Id := N + 589;
+ Name_Gnatls : constant Name_Id := N + 590;
+ Name_Gnatstub : constant Name_Id := N + 591;
+ Name_Implementation : constant Name_Id := N + 592;
+ Name_Implementation_Exceptions : constant Name_Id := N + 593;
+ Name_Implementation_Suffix : constant Name_Id := N + 594;
+ Name_Include_Option : constant Name_Id := N + 595;
+ Name_Language_Processing : constant Name_Id := N + 596;
+ Name_Languages : constant Name_Id := N + 597;
+ Name_Library_Dir : constant Name_Id := N + 598;
+ Name_Library_Auto_Init : constant Name_Id := N + 599;
+ Name_Library_GCC : constant Name_Id := N + 600;
+ Name_Library_Interface : constant Name_Id := N + 601;
+ Name_Library_Kind : constant Name_Id := N + 602;
+ Name_Library_Name : constant Name_Id := N + 603;
+ Name_Library_Options : constant Name_Id := N + 604;
+ Name_Library_Reference_Symbol_File : constant Name_Id := N + 605;
+ Name_Library_Src_Dir : constant Name_Id := N + 606;
+ Name_Library_Symbol_File : constant Name_Id := N + 607;
+ Name_Library_Symbol_Policy : constant Name_Id := N + 608;
+ Name_Library_Version : constant Name_Id := N + 609;
+ Name_Linker : constant Name_Id := N + 610;
+ Name_Local_Configuration_Pragmas : constant Name_Id := N + 611;
+ Name_Locally_Removed_Files : constant Name_Id := N + 612;
+ Name_Metrics : constant Name_Id := N + 613;
+ Name_Naming : constant Name_Id := N + 614;
+ Name_Object_Dir : constant Name_Id := N + 615;
+ Name_Pretty_Printer : constant Name_Id := N + 616;
+ Name_Project : constant Name_Id := N + 617;
+ Name_Separate_Suffix : constant Name_Id := N + 618;
+ Name_Source_Dirs : constant Name_Id := N + 619;
+ Name_Source_Files : constant Name_Id := N + 620;
+ Name_Source_List_File : constant Name_Id := N + 621;
+ Name_Spec : constant Name_Id := N + 622;
+ Name_Spec_Suffix : constant Name_Id := N + 623;
+ Name_Specification : constant Name_Id := N + 624;
+ Name_Specification_Exceptions : constant Name_Id := N + 625;
+ Name_Specification_Suffix : constant Name_Id := N + 626;
+ Name_Switches : constant Name_Id := N + 627;
-- Other miscellaneous names used in front end
- Name_Unaligned_Valid : constant Name_Id := N + 627;
+ Name_Unaligned_Valid : constant Name_Id := N + 628;
-- Mark last defined name for consistency check in Snames body
- Last_Predefined_Name : constant Name_Id := N + 627;
+ Last_Predefined_Name : constant Name_Id := N + 628;
subtype Any_Operator_Name is Name_Id range
First_Operator_Name .. Last_Operator_Name;
Attribute_Max_Size_In_Storage_Elements,
Attribute_Maximum_Alignment,
Attribute_Mechanism_Code,
+ Attribute_Mod,
Attribute_Model_Emin,
Attribute_Model_Epsilon,
Attribute_Model_Mantissa,
#define Attr_Max_Size_In_Storage_Elements 53
#define Attr_Maximum_Alignment 54
#define Attr_Mechanism_Code 55
-#define Attr_Model_Emin 56
-#define Attr_Model_Epsilon 57
-#define Attr_Model_Mantissa 58
-#define Attr_Model_Small 59
-#define Attr_Modulus 60
-#define Attr_Null_Parameter 61
-#define Attr_Object_Size 62
-#define Attr_Partition_ID 63
-#define Attr_Passed_By_Reference 64
-#define Attr_Pool_Address 65
-#define Attr_Pos 66
-#define Attr_Position 67
-#define Attr_Range 68
-#define Attr_Range_Length 69
-#define Attr_Round 70
-#define Attr_Safe_Emax 71
-#define Attr_Safe_First 72
-#define Attr_Safe_Large 73
-#define Attr_Safe_Last 74
-#define Attr_Safe_Small 75
-#define Attr_Scale 76
-#define Attr_Scaling 77
-#define Attr_Signed_Zeros 78
-#define Attr_Size 79
-#define Attr_Small 80
-#define Attr_Storage_Size 81
-#define Attr_Storage_Unit 82
-#define Attr_Tag 83
-#define Attr_Target_Name 84
-#define Attr_Terminated 85
-#define Attr_To_Address 86
-#define Attr_Type_Class 87
-#define Attr_UET_Address 88
-#define Attr_Unbiased_Rounding 89
-#define Attr_Unchecked_Access 90
-#define Attr_Unconstrained_Array 91
-#define Attr_Universal_Literal_String 92
-#define Attr_Unrestricted_Access 93
-#define Attr_VADS_Size 94
-#define Attr_Val 95
-#define Attr_Valid 96
-#define Attr_Value_Size 97
-#define Attr_Version 98
-#define Attr_Wide_Character_Size 99
-#define Attr_Wide_Width 100
-#define Attr_Width 101
-#define Attr_Word_Size 102
+#define Attr_Mod 56
+#define Attr_Model_Emin 57
+#define Attr_Model_Epsilon 58
+#define Attr_Model_Mantissa 59
+#define Attr_Model_Small 60
+#define Attr_Modulus 61
+#define Attr_Null_Parameter 62
+#define Attr_Object_Size 63
+#define Attr_Partition_ID 64
+#define Attr_Passed_By_Reference 65
+#define Attr_Pool_Address 66
+#define Attr_Pos 67
+#define Attr_Position 68
+#define Attr_Range 69
+#define Attr_Range_Length 70
+#define Attr_Round 71
+#define Attr_Safe_Emax 72
+#define Attr_Safe_First 73
+#define Attr_Safe_Large 74
+#define Attr_Safe_Last 75
+#define Attr_Safe_Small 76
+#define Attr_Scale 77
+#define Attr_Scaling 78
+#define Attr_Signed_Zeros 79
+#define Attr_Size 80
+#define Attr_Small 81
+#define Attr_Storage_Size 82
+#define Attr_Storage_Unit 83
+#define Attr_Tag 84
+#define Attr_Target_Name 85
+#define Attr_Terminated 86
+#define Attr_To_Address 87
+#define Attr_Type_Class 88
+#define Attr_UET_Address 89
+#define Attr_Unbiased_Rounding 90
+#define Attr_Unchecked_Access 91
+#define Attr_Unconstrained_Array 92
+#define Attr_Universal_Literal_String 93
+#define Attr_Unrestricted_Access 94
+#define Attr_VADS_Size 95
+#define Attr_Val 96
+#define Attr_Valid 97
+#define Attr_Value_Size 98
+#define Attr_Version 99
+#define Attr_Wide_Character_Size 100
+#define Attr_Wide_Width 101
+#define Attr_Width 102
+#define Attr_Word_Size 103
-#define Attr_Adjacent 103
-#define Attr_Ceiling 104
-#define Attr_Copy_Sign 105
-#define Attr_Floor 106
-#define Attr_Fraction 107
-#define Attr_Image 108
-#define Attr_Input 109
-#define Attr_Machine 110
-#define Attr_Max 111
-#define Attr_Min 112
-#define Attr_Model 113
-#define Attr_Pred 114
-#define Attr_Remainder 115
-#define Attr_Rounding 116
-#define Attr_Succ 117
-#define Attr_Truncation 118
-#define Attr_Value 119
-#define Attr_Wide_Image 120
-#define Attr_Wide_Value 121
+#define Attr_Adjacent 104
+#define Attr_Ceiling 105
+#define Attr_Copy_Sign 106
+#define Attr_Floor 107
+#define Attr_Fraction 108
+#define Attr_Image 109
+#define Attr_Input 110
+#define Attr_Machine 111
+#define Attr_Max 112
+#define Attr_Min 113
+#define Attr_Model 114
+#define Attr_Pred 115
+#define Attr_Remainder 116
+#define Attr_Rounding 117
+#define Attr_Succ 118
+#define Attr_Truncation 119
+#define Attr_Value 120
+#define Attr_Wide_Image 121
+#define Attr_Wide_Value 122
-#define Attr_Output 122
-#define Attr_Read 123
-#define Attr_Write 124
+#define Attr_Output 123
+#define Attr_Read 124
+#define Attr_Write 125
-#define Attr_Elab_Body 125
-#define Attr_Elab_Spec 126
-#define Attr_Storage_Pool 127
+#define Attr_Elab_Body 126
+#define Attr_Elab_Spec 127
+#define Attr_Storage_Pool 128
-#define Attr_Base 128
-#define Attr_Class 129
+#define Attr_Base 129
+#define Attr_Class 130
/* Define the function to check if a Name_Id value is a valid pragma */
projects / thirdparty / gcc.git / commitdiff
