diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 88 | ||||
| -rw-r--r-- | gcc/ada/bindgen.adb | 49 | ||||
| -rw-r--r-- | gcc/ada/exp_ch6.adb | 58 | ||||
| -rw-r--r-- | gcc/ada/g-debpoo.adb | 72 | ||||
| -rw-r--r-- | gcc/ada/g-debpoo.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/gnat_ugn.texi | 11 | ||||
| -rw-r--r-- | gcc/ada/lib-xref.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/lib.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/lib.ads | 11 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/makegpr.adb | 60 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-mingw.adb | 179 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-vxworks.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/par-ch12.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/par-prag.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/prj-part.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/prj-strt.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/restrict.adb | 169 | ||||
| -rw-r--r-- | gcc/ada/restrict.ads | 36 | ||||
| -rw-r--r-- | gcc/ada/s-rident.ads | 108 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/sem_ch7.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/sem_elab.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 142 | ||||
| -rw-r--r-- | gcc/ada/snames.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/snames.ads | 1018 | ||||
| -rw-r--r-- | gcc/ada/snames.h | 233 | ||||
| -rw-r--r-- | gcc/ada/symbols-vms-alpha.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/targparm.adb | 47 | ||||
| -rw-r--r-- | gcc/ada/targparm.ads | 5 |
30 files changed, 1445 insertions, 911 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8e5893d..8cb9164 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,91 @@ +2004-06-14 Pascal Obry <obry@gnat.com> + + * gnat_ugn.texi: Document relocatable vs. dynamic Library_Kind on + Windows. Fix minor typo. + + * mlib-tgt-mingw.adb: New implementation using the GCC -shared option + which is now supported on Windows. With this implementation using the + Library Project feature is no different on Windows than on UNIX. + +2004-06-14 Vincent Celier <celier@gnat.com> + + * makegpr.adb (Compile_Sources): Nothing to do when there are no + non-Ada sources. + + * mlib-tgt-vxworks.adb (Library_Exists_For): Remove incorrect comment + + * prj-part.adb (Parse_Single_Project): When a duplicate project name is + found, show the project name and the path of the previously parsed + project file. + +2004-06-14 Ed Schonberg <schonberg@gnat.com> + + * exp_ch6.adb (Add_Call_By_Copy_Code): For an out-parameter that is an + array, avoid copying the actual before the call. + +2004-06-14 Thomas Quinot <quinot@act-europe.fr> + + * g-debpoo.adb: Remove alignment assumptions from GNAT.Debug_Pools. + Instead, allocate memory on worst-case alignment assumptions, and then + return an aligned address within the allocated zone. + +2004-06-14 Robert Dewar <dewar@gnat.com> + + * bindgen.adb (Gen_Adainit_Ada): Do not generate external references to + elab entities in predefined units in No_Run_Time_Mode. + (Gen_Adainit_C): Same fix + (Gen_Elab_Calls_Ada): Do not generate calls to elaborate predefined + units in No_Run_Time_Mode + (Gen_Elab_Calls_C): Same fix + + * symbols-vms-alpha.adb: Minor reformatting + + * g-debpoo.ads: Minor reformatting + + * lib.adb (In_Same_Extended_Unit): Version working on node id's + + * lib.ads (In_Same_Extended_Unit): Version working on node id's + + * lib-xref.adb: Minor cleanup, use new version of In_Same_Extended_Unit + working on nodes. + + * make.adb: Minor reformatting + + * par-ch12.adb: Minor reformatting + + * par-prag.adb: Add dummy entry for pragma Profile_Warnings + + * prj-strt.adb: Minor reformatting + + * restrict.ads, restrict.adb: Redo handling of profile restrictions to + be more general. + + * sem_attr.adb: Minor reformatting + + * sem_ch7.adb: Minor reformatting + + * sem_elab.adb (Check_A_Call): Deal with problem of calling init proc + for type in the same unit as the object declaration. + + * sem_prag.adb (Check_Arg_Is_External_Name): New procedure, allows + static string expressions and not just string literals. + Minor reformatting + (Set_Warning): Reset restriction warning flag for restriction pragma + Implement pragma Profile_Warnings + Implement pragma Profile (Restricted) + Give obolescent messages for old restrictions and pragmas + + * snames.h, snames.ads, snames.adb: Add new entry for pragma + Profile_Warnings. + + * s-rident.ads: Add declarations for restrictions required by profile + Restricted and profile Ravenscar. + + * targparm.ads, targparm.adb: Allow pragma Profile in system.ads + + * gnat_ugn.texi: Correct some missing entries in the list of GNAT + configuration pragmas. + 2004-06-11 Vincent Celier <celier@gnat.com> * mlib-tgt-vms-alpha.adb (Build_Dynamic_Library): Issue switch -R to diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index ec1670f..76626a8 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -371,7 +371,21 @@ package body Bindgen is U : Unit_Record renames Units.Table (Unum); begin - if U.Set_Elab_Entity and then not U.Interface then + -- Check for Elab_Entity to be set for this unit + + if U.Set_Elab_Entity + + -- Don't generate reference for stand alone library + + and then not U.Interface + + -- Don't generate reference for predefined file in No_Run_Time + -- mode, since we don't include the object files in this case + + and then not + (No_Run_Time_Mode + and then Is_Predefined_File_Name (U.Sfile)) + then Set_String (" "); Set_String ("E"); Set_Unit_Number (Unum); @@ -667,8 +681,23 @@ package body Bindgen is declare Unum : constant Unit_Id := Elab_Order.Table (E); U : Unit_Record renames Units.Table (Unum); + begin - if U.Set_Elab_Entity and then not U.Interface then + -- Check for Elab entity to be set for this unit + + if U.Set_Elab_Entity + + -- Don't generate reference for stand alone library + + and then not U.Interface + + -- Don't generate reference for predefined file in No_Run_Time + -- mode, since we don't include the object files in this case + + and then not + (No_Run_Time_Mode + and then Is_Predefined_File_Name (U.Sfile)) + then Set_String (" extern char "); Get_Name_String (U.Uname); Set_Unit_Name; @@ -894,9 +923,14 @@ package body Bindgen is Unum_Spec := Unum; end if; + -- Nothing to do if predefined unit in no run time mode + + if No_Run_Time_Mode and then Is_Predefined_File_Name (U.Sfile) then + null; + -- Case of no elaboration code - if U.No_Elab then + elsif U.No_Elab then -- The only case in which we have to do something is if -- this is a body, with a separate spec, where the separate @@ -989,7 +1023,6 @@ package body Bindgen is procedure Gen_Elab_Calls_C is begin - for E in Elab_Order.First .. Elab_Order.Last loop declare Unum : constant Unit_Id := Elab_Order.Table (E); @@ -1008,9 +1041,14 @@ package body Bindgen is Unum_Spec := Unum; end if; + -- Nothing to do if predefined unit in no run time mode + + if No_Run_Time_Mode and then Is_Predefined_File_Name (U.Sfile) then + null; + -- Case of no elaboration code - if U.No_Elab then + elsif U.No_Elab then -- The only case in which we have to do something is if -- this is a body, with a separate spec, where the separate @@ -1867,6 +1905,7 @@ package body Bindgen is or else GNAT.OS_Lib.Is_Regular_File (Name_Buffer (1 .. Name_Len)) then Write_Info_Ada_C (" -- ", "", Name_Buffer (1 .. Name_Len)); + if Output_Object_List then Write_Str (Name_Buffer (1 .. Name_Len)); Write_Eol; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index edb3184..951d272 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -529,12 +529,13 @@ package body Exp_Ch6 is --------------------------- procedure Add_Call_By_Copy_Code is - Expr : Node_Id; - Init : Node_Id; - Temp : Entity_Id; - Var : Entity_Id; - V_Typ : Entity_Id; - Crep : Boolean; + Expr : Node_Id; + Init : Node_Id; + Temp : Entity_Id; + Indic : Node_Id := New_Occurrence_Of (Etype (Formal), Loc); + Var : Entity_Id; + V_Typ : Entity_Id; + Crep : Boolean; begin Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('T')); @@ -560,10 +561,14 @@ package body Exp_Ch6 is -- parameter where the formal is an unconstrained array (in the -- latter case, we have to pass in an object with bounds). + -- If this is an out parameter, the initial copy is wasteful, so as + -- an optimization for the one-dimensional case we extract the + -- bounds of the actual and build an uninitialized temporary of the + -- right size. + if Ekind (Formal) = E_In_Out_Parameter or else (Is_Array_Type (Etype (Formal)) - and then - not Is_Constrained (Etype (Formal))) + and then not Is_Constrained (Etype (Formal))) then if Nkind (Actual) = N_Type_Conversion then if Conversion_OK (Actual) then @@ -573,6 +578,33 @@ package body Exp_Ch6 is Init := Convert_To (Etype (Formal), New_Occurrence_Of (Var, Loc)); end if; + + elsif Ekind (Formal) = E_Out_Parameter + and then Number_Dimensions (Etype (Formal)) = 1 + and then not Has_Non_Null_Base_Init_Proc (Etype (Formal)) + then + -- Actual is a one-dimensional array or slice, and the type + -- requires no initialization. Create a temporary of the + -- right size, but do copy actual into it (optimization). + + Init := Empty; + Indic := + Make_Subtype_Indication (Loc, + Subtype_Mark => + New_Occurrence_Of (Etype (Formal), Loc), + Constraint => + Make_Index_Or_Discriminant_Constraint (Loc, + Constraints => New_List ( + Make_Range (Loc, + Low_Bound => + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Var, Loc), + Attribute_name => Name_First), + High_Bound => + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Var, Loc), + Attribute_Name => Name_Last))))); + else Init := New_Occurrence_Of (Var, Loc); end if; @@ -607,8 +639,7 @@ package body Exp_Ch6 is N_Node := Make_Object_Declaration (Loc, Defining_Identifier => Temp, - Object_Definition => - New_Occurrence_Of (Etype (Formal), Loc), + Object_Definition => Indic, Expression => Init); Set_Assignment_OK (N_Node); Insert_Action (N, N_Node); @@ -2527,9 +2558,12 @@ package body Exp_Ch6 is -- In this case, for optimization purposes, we do not need to -- continue the traversal once more than one use is encountered. + ---------------- + -- Count_Uses -- + ---------------- + function Count_Uses (N : Node_Id) return Traverse_Result is begin - -- The original node is an identifier if Nkind (N) = N_Identifier @@ -2565,10 +2599,8 @@ package body Exp_Ch6 is -- Start of processing for Formal_Is_Used_Once begin - Count_Formal_Uses (Orig_Bod); return Use_Counter = 1; - end Formal_Is_Used_Once; -- Start of processing for Expand_Inlined_Call diff --git a/gcc/ada/g-debpoo.adb b/gcc/ada/g-debpoo.adb index 340c2f6..5184618 100644 --- a/gcc/ada/g-debpoo.adb +++ b/gcc/ada/g-debpoo.adb @@ -146,7 +146,10 @@ package body GNAT.Debug_Pools is -- Traceback_Htable_Elem_Ptr. type Allocation_Header is record - Block_Size : Storage_Offset; + Allocation_Address : System.Address; + -- Address of the block returned by malloc, possibly unaligned. + + Block_Size : Storage_Offset; -- Needed only for advanced freeing algorithms (traverse all allocated -- blocks for potential references). This value is negated when the -- chunk of memory has been logically freed by the application. This @@ -154,7 +157,7 @@ package body GNAT.Debug_Pools is Alloc_Traceback : Traceback_Htable_Elem_Ptr; Dealloc_Traceback : Traceback_Ptr_Or_Address; - -- Pointer to the traceback for the allocation (if the memory chunck is + -- Pointer to the traceback for the allocation (if the memory chunk is -- still valid), or to the first deallocation otherwise. Make sure this -- is a thin pointer to save space. -- @@ -183,21 +186,23 @@ package body GNAT.Debug_Pools is function To_Traceback is new Ada.Unchecked_Conversion (Traceback_Htable_Elem_Ptr, Traceback_Ptr_Or_Address); + Header_Offset : constant Storage_Count + := Default_Alignment * + ((Allocation_Header'Size / System.Storage_Unit + Default_Alignment - 1) + / Default_Alignment); + -- Offset of user data after allocation header. + Minimum_Allocation : constant Storage_Count := - Default_Alignment * - (Allocation_Header'Size / - System.Storage_Unit / - Default_Alignment) + - Default_Alignment; - -- Extra bytes to allocate to store the header. The header needs to be - -- correctly aligned as well, so we have to allocate multiples of the - -- alignment. + Default_Alignment - 1 + + Header_Offset; + -- Minimal allocation: size of allocation_header rounded up to next + -- multiple of default alignment + worst-case padding. ----------------------- -- Allocations table -- ----------------------- - -- This table is indexed on addresses modulo Minimum_Allocation, and + -- This table is indexed on addresses modulo Default_Alignment, and -- for each index it indicates whether that memory block is valid. -- Its behavior is similar to GNAT.Table, except that we need to pack -- the table to save space, so we cannot reuse GNAT.Table as is. @@ -249,7 +254,7 @@ package body GNAT.Debug_Pools is Edata : System.Address := System.Null_Address; -- Address in memory that matches the index 0 in Valid_Blocks. It is named -- after the symbol _edata, which, on most systems, indicate the lowest - -- possible address returned by malloc (). Unfortunately, this symbol + -- possible address returned by malloc. Unfortunately, this symbol -- doesn't exist on windows, so we cannot use it instead of this variable. ----------------------- @@ -341,7 +346,7 @@ package body GNAT.Debug_Pools is function Convert is new Ada.Unchecked_Conversion (System.Address, Allocation_Header_Access); begin - return Convert (Address - Minimum_Allocation); + return Convert (Address - Header_Offset); end Header_Of; -------------- @@ -670,8 +675,6 @@ package body GNAT.Debug_Pools is type Local_Storage_Array is new Storage_Array (1 .. Size_In_Storage_Elements + Minimum_Allocation); - for Local_Storage_Array'Alignment use Standard'Maximum_Alignment; - -- For performance reasons, make sure the alignment is maximized. type Ptr is access Local_Storage_Array; -- On some systems, we might want to physically protect pages @@ -716,7 +719,14 @@ package body GNAT.Debug_Pools is P := new Local_Storage_Array; end; - Storage_Address := P.all'Address + Minimum_Allocation; + Storage_Address := System.Null_Address + Default_Alignment + * (((P.all'Address + Default_Alignment - 1) - System.Null_Address) + / Default_Alignment) + + Header_Offset; + pragma Assert ((Storage_Address - System.Null_Address) + mod Default_Alignment = 0); + pragma Assert (Storage_Address + Size_In_Storage_Elements + <= P.all'Address + P'Length); Trace := Find_Or_Create_Traceback (Pool, Alloc, Size_In_Storage_Elements, @@ -728,10 +738,11 @@ package body GNAT.Debug_Pools is -- Default_Alignment. Header_Of (Storage_Address).all := - (Alloc_Traceback => Trace, - Dealloc_Traceback => To_Traceback (null), - Next => Pool.First_Used_Block, - Block_Size => Size_In_Storage_Elements); + (Allocation_Address => P.all'Address, + Alloc_Traceback => Trace, + Dealloc_Traceback => To_Traceback (null), + Next => Pool.First_Used_Block, + Block_Size => Size_In_Storage_Elements); pragma Warnings (On); @@ -928,7 +939,7 @@ package body GNAT.Debug_Pools is end; Next := Header.Next; - System.Memory.Free (Header.all'Address); + System.Memory.Free (Header.Allocation_Address); Set_Valid (Tmp, False); -- Remove this block from the list. @@ -1141,15 +1152,16 @@ package body GNAT.Debug_Pools is -- Update the header Header.all := - (Alloc_Traceback => Header.Alloc_Traceback, - Dealloc_Traceback => To_Traceback - (Find_Or_Create_Traceback - (Pool, Dealloc, - Size_In_Storage_Elements, - Deallocate_Label'Address, - Code_Address_For_Deallocate_End)), - Next => System.Null_Address, - Block_Size => -Size_In_Storage_Elements); + (Allocation_Address => Header.Allocation_Address, + Alloc_Traceback => Header.Alloc_Traceback, + Dealloc_Traceback => To_Traceback + (Find_Or_Create_Traceback + (Pool, Dealloc, + Size_In_Storage_Elements, + Deallocate_Label'Address, + Code_Address_For_Deallocate_End)), + Next => System.Null_Address, + Block_Size => -Size_In_Storage_Elements); if Pool.Reset_Content_On_Free then Set_Dead_Beef (Storage_Address, Size_In_Storage_Elements); diff --git a/gcc/ada/g-debpoo.ads b/gcc/ada/g-debpoo.ads index 6207f93..0d458f4 100644 --- a/gcc/ada/g-debpoo.ads +++ b/gcc/ada/g-debpoo.ads @@ -260,8 +260,8 @@ private Alignment : Storage_Count); -- Mark a block of memory as invalid. It might not be physically removed -- immediately, depending on the setup of the debug pool, so that checks - -- are still possible. - -- The parameters have the same semantics as defined in the ARM95. + -- are still possible. The parameters have the same semantics as defined + -- in the RM. function Storage_Size (Pool : Debug_Pool) return SSC; -- Return the maximal size of data that can be allocated through Pool. diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 809973c..2b5ff08 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -9996,10 +9996,13 @@ recognized by @code{GNAT}: Normalize_Scalars Polling Profile + Profile_Warnings Propagate_Exceptions Queuing_Policy + Ravenscar Restricted_Run_Time Restrictions + Restrictions_Warnings Reviewable Source_File_Name Style_Checks @@ -12452,6 +12455,12 @@ Depending on the operating system, there may or may not be a distinction between dynamic and relocatable libraries. For Unix and VMS Unix there is no such distinction. +@ifset unw +On Windows @code{"relocatable"} will build a relocatable @code{DLL} +and @code{"dynamic"} will build a non-relocatable @code{DLL}. +@pxref{Introduction to Dynamic Link Libraries (DLLs)}. +@end ifset + If you need to build both a static and a dynamic library, you should use two different object directories, since in some cases some extra code needs to be generated for the latter. For such cases, it is recommended to either use @@ -13155,7 +13164,7 @@ When a library project file is specified, switches ^-b^/ACTION=BIND^ and ^-l^/ACTION=LINK^ have special meanings. @itemize @bullet -@item ^-b^/ACTION=BIND^ is only allwed for stand-alone libraries. It indicates +@item ^-b^/ACTION=BIND^ is only allowed for stand-alone libraries. It indicates to @command{gnatmake} that @command{gnatbind} should be invoked for the library. diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index eb8d725..f34dd8a 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -357,7 +357,7 @@ package body Lib.Xref is -- this source unit (occasion for possible warning to be issued) if Has_Pragma_Unreferenced (E) - and then In_Same_Extended_Unit (Sloc (E), Sloc (N)) + and then In_Same_Extended_Unit (E, N) then -- A reference as a named parameter in a call does not count -- as a violation of pragma Unreferenced for this purpose. diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index d1e8781..722f563 100644 --- a/gcc/ada/lib.adb +++ b/gcc/ada/lib.adb @@ -640,7 +640,7 @@ package body Lib is else return - In_Same_Extended_Unit (Sloc (N), Sloc (Cunit (Main_Unit))); + In_Same_Extended_Unit (N, Cunit (Main_Unit)); end if; end In_Extended_Main_Code_Unit; @@ -765,6 +765,13 @@ package body Lib is -- In_Same_Extended_Unit -- --------------------------- + function In_Same_Extended_Unit + (N1, N2 : Node_Or_Entity_Id) return Boolean + is + begin + return Check_Same_Extended_Unit (Sloc (N1), Sloc (N2)) /= No; + end In_Same_Extended_Unit; + function In_Same_Extended_Unit (S1, S2 : Source_Ptr) return Boolean is begin return Check_Same_Extended_Unit (S1, S2) /= No; diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index e48f224..f0f09ef 100644 --- a/gcc/ada/lib.ads +++ b/gcc/ada/lib.ads @@ -454,10 +454,19 @@ package Lib is -- code unit, the criterion being that Get_Code_Unit yields the same -- value for each argument. + function In_Same_Extended_Unit (N1, N2 : Node_Or_Entity_Id) return Boolean; + pragma Inline (In_Same_Extended_Unit); + -- Determines if two nodes or entities N1 and N2 are in the same + -- extended unit, where an extended unit is defined as a unit and all + -- its subunits (considered recursively, i.e. subunits of subunits are + -- included). Returns true if S1 and S2 are in the same extended unit + -- and False otherwise. + function In_Same_Extended_Unit (S1, S2 : Source_Ptr) return Boolean; + pragma Inline (In_Same_Extended_Unit); -- Determines if the two source locations S1 and S2 are in the same -- extended unit, where an extended unit is defined as a unit and all - -- its subunits (considered recursively, i.e. subunits or subunits are + -- its subunits (considered recursively, i.e. subunits of subunits are -- included). Returns true if S1 and S2 are in the same extended unit -- and False otherwise. diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 3de414c..7035854 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -5587,14 +5587,19 @@ package body Make is if not OpenVMS then declare Command : constant String := Command_Name; + begin for Index in reverse Command'Range loop if Command (Index) = Directory_Separator then declare Absolute_Dir : constant String := - Normalize_Pathname (Command (Command'First .. Index)); + Normalize_Pathname + (Command (Command'First .. Index)); + PATH : constant String := - Absolute_Dir & Path_Separator & Getenv ("PATH").all; + Absolute_Dir & + Path_Separator & + Getenv ("PATH").all; begin Setenv ("PATH", PATH); diff --git a/gcc/ada/makegpr.adb b/gcc/ada/makegpr.adb index 691a6de..5947f19 100644 --- a/gcc/ada/makegpr.adb +++ b/gcc/ada/makegpr.adb @@ -2139,7 +2139,9 @@ package body Makegpr is Local_Errors := False; Data := Projects.Table (Project); - if not Data.Virtual then + -- Nothing to do when no sources of language other than Ada + + if (not Data.Virtual) and then Data.Sources_Present then -- If the imported directory switches are unknown, compute them @@ -2149,51 +2151,47 @@ package body Makegpr is Projects.Table (Project) := Data; end if; - -- Nothing to do when no sources of language other than Ada + Need_To_Rebuild_Archive := Force_Compilations; - if Data.Sources_Present then - Need_To_Rebuild_Archive := Force_Compilations; + -- Compilation will occur in the object directory - -- Compilation will occur in the object directory + Change_Dir (Get_Name_String (Data.Object_Directory)); - Change_Dir (Get_Name_String (Data.Object_Directory)); + Source_Id := Data.First_Other_Source; - Source_Id := Data.First_Other_Source; + -- Process each source one by one - -- Process each source one by one + while Source_Id /= No_Other_Source loop + Source := Other_Sources.Table (Source_Id); + Need_To_Compile := Force_Compilations; - while Source_Id /= No_Other_Source loop - Source := Other_Sources.Table (Source_Id); - Need_To_Compile := Force_Compilations; + -- Check if compilation is needed - -- Check if compilation is needed - - if not Need_To_Compile then - Check_Compilation_Needed (Source, Need_To_Compile); - end if; + if not Need_To_Compile then + Check_Compilation_Needed (Source, Need_To_Compile); + end if; - -- Proceed, if compilation is needed + -- Proceed, if compilation is needed - if Need_To_Compile then + if Need_To_Compile then - -- If a source is compiled/recompiled, of course the - -- archive will need to be built/rebuilt. + -- If a source is compiled/recompiled, of course the + -- archive will need to be built/rebuilt. - Need_To_Rebuild_Archive := True; - Compile (Source_Id, Data, Local_Errors); - end if; + Need_To_Rebuild_Archive := True; + Compile (Source_Id, Data, Local_Errors); + end if; - -- Next source, if any + -- Next source, if any - Source_Id := Source.Next; - end loop; + Source_Id := Source.Next; + end loop; - -- If there was no compilation error, build/rebuild the archive - -- if necessary. + -- If there was no compilation error, build/rebuild the archive + -- if necessary. - if not Local_Errors then - Build_Archive (Project, Need_To_Rebuild_Archive); - end if; + if not Local_Errors then + Build_Archive (Project, Need_To_Rebuild_Archive); end if; end if; end loop; diff --git a/gcc/ada/mlib-tgt-mingw.adb b/gcc/ada/mlib-tgt-mingw.adb index 485be34..a47ff42 100644 --- a/gcc/ada/mlib-tgt-mingw.adb +++ b/gcc/ada/mlib-tgt-mingw.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2004, Ada Core Technologies, 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- -- @@ -28,7 +28,8 @@ -- This package provides a set of target dependent routines to build -- static, dynamic and shared libraries. --- This is the Windows version of the body. +-- This is the Windows version of the body. Works only with GCC versions +-- supporting the "-shared" option. with Namet; use Namet; with Opt; @@ -37,12 +38,14 @@ with Prj.Com; with GNAT.OS_Lib; use GNAT.OS_Lib; -with MDLL; -with MDLL.Utl; with MLib.Fil; +with MLib.Utl; package body MLib.Tgt is + package Files renames MLib.Fil; + package Tools renames MLib.Utl; + --------------------- -- Archive_Builder -- --------------------- @@ -98,73 +101,121 @@ package body MLib.Tgt is Relocatable : Boolean := False; Auto_Init : Boolean := False) is - pragma Unreferenced (Ofiles); - pragma Unreferenced (Interfaces); + pragma Unreferenced (Foreign); + pragma Unreferenced (Afiles); + pragma Unreferenced (Auto_Init); pragma Unreferenced (Symbol_Data); - pragma Unreferenced (Driver_Name); + pragma Unreferenced (Interfaces); pragma Unreferenced (Lib_Version); - pragma Unreferenced (Auto_Init); - Imp_File : constant String := - "lib" & MLib.Fil.Ext_To (Lib_Filename, Archive_Ext); - -- Name of the import library + Strip_Name : constant String := "strip"; + Strip_Exec : String_Access; - DLL_File : constant String := MLib.Fil.Ext_To (Lib_Filename, DLL_Ext); - -- Name of the DLL file + procedure Strip_Reloc (Lib_File : String); + -- Strip .reloc section to build a non relocatable DLL - Lib_File : constant String := Lib_Dir & Directory_Separator & DLL_File; - -- Full path of the DLL file + ----------------- + -- Strip_Reloc -- + ----------------- - Success : Boolean; + procedure Strip_Reloc (Lib_File : String) is + Arguments : Argument_List (1 .. 3); + Success : Boolean; + Line_Length : Natural; - begin - if Opt.Verbose_Mode then - if Relocatable then - Write_Str ("building relocatable shared library "); - else - Write_Str ("building non-relocatable shared library "); + begin + -- Look for strip executable + + Strip_Exec := Locate_Exec_On_Path (Strip_Name); + + if Strip_Exec = null then + Fail (Strip_Name, " not found in path"); + + elsif Opt.Verbose_Mode then + Write_Str ("found "); + Write_Line (Strip_Exec.all); end if; - Write_Line (Lib_File); - end if; + -- Call it: strip -R .reloc <dll> - MDLL.Verbose := Opt.Verbose_Mode; - MDLL.Quiet := not MDLL.Verbose; + Arguments (1) := new String'("-R"); + Arguments (2) := new String'(".reloc"); + Arguments (3) := new String'(Lib_File); - MDLL.Utl.Locate; + if not Opt.Quiet_Output then + Write_Str (Strip_Exec.all); + Line_Length := Strip_Exec'Length; - MDLL.Build_Dynamic_Library - (Foreign, Afiles, - MDLL.Null_Argument_List, MDLL.Null_Argument_List, Options, - Lib_Filename, Lib_Filename & ".def", - Lib_Address, True, Relocatable); + for K in Arguments'Range loop - -- Move the DLL and import library in the lib directory + -- Make sure the Output buffer does not overflow - Copy_File (DLL_File, Lib_Dir, Success, Mode => Overwrite); + if Line_Length + 1 + Arguments (K)'Length > + Integer (Opt.Max_Line_Length) + then + Write_Eol; + Line_Length := 0; + end if; - if not Success then - Fail ("could not copy DLL to library dir"); - end if; + Write_Char (' '); + Write_Str (Arguments (K).all); + Line_Length := Line_Length + 1 + Arguments (K)'Length; + end loop; - Copy_File (Imp_File, Lib_Dir, Success, Mode => Overwrite); + Write_Eol; + end if; - if not Success then - Fail ("could not copy import library to library dir"); - end if; + Spawn (Strip_Exec.all, Arguments, Success); + + if not Success then + Fail (Strip_Name, " execution error."); + end if; + + for K in Arguments'Range loop + Free (Arguments (K)); + end loop; + end Strip_Reloc; + + Lib_File : constant String := + Lib_Dir & Directory_Separator & "lib" & + Files.Ext_To (Lib_Filename, DLL_Ext); + + I_Base : aliased String := "-Wl,--image-base," & Lib_Address; + + Options_2 : Argument_List (1 .. 1); + O_Index : Natural := 0; + + -- Start of processing for Build_Dynamic_Library + + begin + if Opt.Verbose_Mode then + Write_Str ("building "); - -- Delete files + if not Relocatable then + Write_Str ("non-"); + end if; - Delete_File (DLL_File, Success); + Write_Str ("relocatable shared library "); + Write_Line (Lib_File); + end if; - if not Success then - Fail ("could not delete DLL from build dir"); + if not Relocatable then + O_Index := O_Index + 1; + Options_2 (O_Index) := I_Base'Unchecked_Access; end if; - Delete_File (Imp_File, Success); + Tools.Gcc + (Output_File => Lib_File, + Objects => Ofiles, + Options => Options, + Driver_Name => Driver_Name, + Options_2 => Options_2 (1 .. O_Index)); + + if not Relocatable then - if not Success then - Fail ("could not delete import library from build dir"); + -- Strip reloc symbols from the DLL + + Strip_Reloc (Lib_File); end if; end Build_Dynamic_Library; @@ -192,7 +243,7 @@ package body MLib.Tgt is function Dynamic_Option return String is begin - return ""; + return "-shared"; end Dynamic_Option; ------------------- @@ -219,7 +270,7 @@ package body MLib.Tgt is function Is_Archive_Ext (Ext : String) return Boolean is begin - return Ext = ".a"; + return Ext = ".a" or else Ext = ".dll"; end Is_Archive_Ext; ------------- @@ -245,24 +296,21 @@ package body MLib.Tgt is else declare Lib_Dir : constant String := - Get_Name_String (Projects.Table (Project).Library_Dir); + Get_Name_String + (Projects.Table (Project).Library_Dir); Lib_Name : constant String := - Get_Name_String (Projects.Table (Project).Library_Name); + Get_Name_String + (Projects.Table (Project).Library_Name); begin if Projects.Table (Project).Library_Kind = Static then - - -- Static libraries are named : lib<name>.a - return Is_Regular_File (Lib_Dir & Directory_Separator & "lib" & MLib.Fil.Ext_To (Lib_Name, Archive_Ext)); else - -- Shared libraries are named : <name>.dll - return Is_Regular_File - (Lib_Dir & Directory_Separator & + (Lib_Dir & Directory_Separator & "lib" & MLib.Fil.Ext_To (Lib_Name, DLL_Ext)); end if; end; @@ -283,23 +331,16 @@ package body MLib.Tgt is else declare Lib_Name : constant String := - Get_Name_String - (Projects.Table (Project).Library_Name); + Get_Name_String (Projects.Table (Project).Library_Name); begin - if Projects.Table (Project).Library_Kind = Static then - - -- Static libraries are named : lib<name>.a - - Name_Len := 3; - Name_Buffer (1 .. Name_Len) := "lib"; + Name_Len := 3; + Name_Buffer (1 .. Name_Len) := "lib"; + if Projects.Table (Project).Library_Kind = Static then Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext)); else - -- Shared libraries are named : <name>.dll - - Name_Len := 0; Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, DLL_Ext)); end if; diff --git a/gcc/ada/mlib-tgt-vxworks.adb b/gcc/ada/mlib-tgt-vxworks.adb index 9b3f575..9fa24c5 100644 --- a/gcc/ada/mlib-tgt-vxworks.adb +++ b/gcc/ada/mlib-tgt-vxworks.adb @@ -222,7 +222,7 @@ package body MLib.Tgt is if not Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " & "for non library project"); - return False; -- To avoid warning; + return False; else declare diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb index 4dd2b1e..e9fe553 100644 --- a/gcc/ada/par-ch12.adb +++ b/gcc/ada/par-ch12.adb @@ -203,8 +203,8 @@ package body Ch12 is Set_Specification (Gen_Decl, P_Subprogram_Specification); - if Nkind (Defining_Unit_Name (Specification (Gen_Decl))) - = N_Defining_Program_Unit_Name + if Nkind (Defining_Unit_Name (Specification (Gen_Decl))) = + N_Defining_Program_Unit_Name and then Scope.Last > 0 then Error_Msg_SP ("child unit allowed only at library level"); diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 0754319..112170b 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -994,6 +994,7 @@ begin Pragma_Preelaborate | Pragma_Priority | Pragma_Profile | + Pragma_Profile_Warnings | Pragma_Propagate_Exceptions | Pragma_Psect_Object | Pragma_Pure | diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index c03e191..8c89aae 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -1164,8 +1164,9 @@ package body Prj.Part is end; declare - Project_Name : Name_Id := - Tree_Private_Part.Projects_Htable.Get_First.Name; + Name_And_Node : Tree_Private_Part.Project_Name_And_Node := + Tree_Private_Part.Projects_Htable.Get_First; + Project_Name : Name_Id := Name_And_Node.Name; begin -- Check if we already have a project with this name @@ -1173,13 +1174,17 @@ package body Prj.Part is while Project_Name /= No_Name and then Project_Name /= Name_Of_Project loop - Project_Name := Tree_Private_Part.Projects_Htable.Get_Next.Name; + Name_And_Node := Tree_Private_Part.Projects_Htable.Get_Next; + Project_Name := Name_And_Node.Name; end loop; -- Report an error if we already have a project with this name if Project_Name /= No_Name then - Error_Msg ("duplicate project name", Token_Ptr); + Error_Msg_Name_1 := Project_Name; + Error_Msg ("duplicate project name {", Location_Of (Project)); + Error_Msg_Name_1 := Path_Name_Of (Name_And_Node.Node); + Error_Msg ("\already in {", Location_Of (Project)); else -- Otherwise, add the name of the project to the hash table, so diff --git a/gcc/ada/prj-strt.adb b/gcc/ada/prj-strt.adb index dabd2a1..d6a2efa 100644 --- a/gcc/ada/prj-strt.adb +++ b/gcc/ada/prj-strt.adb @@ -282,6 +282,7 @@ package body Prj.Strt is end loop; -- If only one is not used, report a single warning for this value + if Non_Used = 1 then Error_Msg_Name_1 := Choices.Table (First_Non_Used).The_String; Error_Msg ("?value { is not used as label", Case_Location); diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index a8336c9..d35a9ec 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -31,12 +31,24 @@ with Fname; use Fname; with Fname.UF; use Fname.UF; with Lib; use Lib; with Namet; use Namet; +with Opt; use Opt; +with Sinfo; use Sinfo; with Sinput; use Sinput; with Snames; use Snames; with Uname; use Uname; package body Restrict is + Restricted_Profile_Result : Boolean := False; + -- This switch memoizes the result of Restricted_Profile function + -- calls for improved efficiency. Its setting is valid only if + -- Restricted_Profile_Cached is True. Note that if this switch + -- is ever set True, it need never be turned off again. + + Restricted_Profile_Cached : Boolean := False; + -- This flag is set to True if the Restricted_Profile_Result + -- contains the correct cached result of Restricted_Profile calls. + ----------------------- -- Local Subprograms -- ----------------------- @@ -361,57 +373,75 @@ package body Restrict is -- Note: body of this function must be coordinated with list of -- renaming declarations in System.Rident. - function Process_Restriction_Synonyms (Id : Name_Id) return Name_Id is + function Process_Restriction_Synonyms (N : Node_Id) return Name_Id + is + Old_Name : constant Name_Id := Chars (N); + New_Name : Name_Id; + begin - case Id is + case Old_Name is when Name_Boolean_Entry_Barriers => - return Name_Simple_Barriers; + New_Name := Name_Simple_Barriers; when Name_Max_Entry_Queue_Depth => - return Name_Max_Entry_Queue_Length; + New_Name := Name_Max_Entry_Queue_Length; when Name_No_Dynamic_Interrupts => - return Name_No_Dynamic_Attachment; + New_Name := Name_No_Dynamic_Attachment; when Name_No_Requeue => - return Name_No_Requeue_Statements; + New_Name := Name_No_Requeue_Statements; when Name_No_Task_Attributes => - return Name_No_Task_Attributes_Package; + New_Name := Name_No_Task_Attributes_Package; when others => - return Id; + return Old_Name; end case; + + if Warn_On_Obsolescent_Feature then + Error_Msg_Name_1 := Old_Name; + Error_Msg_N ("restriction identifier % is obsolescent?", N); + Error_Msg_Name_1 := New_Name; + Error_Msg_N ("|use restriction identifier % instead", N); + end if; + + return New_Name; end Process_Restriction_Synonyms; ------------------------ -- Restricted_Profile -- ------------------------ - -- This implementation must be coordinated with Set_Restricted_Profile - function Restricted_Profile return Boolean is begin - return Restrictions.Set (No_Abort_Statements) - and then Restrictions.Set (No_Asynchronous_Control) - and then Restrictions.Set (No_Entry_Queue) - and then Restrictions.Set (No_Task_Hierarchy) - and then Restrictions.Set (No_Task_Allocators) - and then Restrictions.Set (No_Dynamic_Priorities) - and then Restrictions.Set (No_Terminate_Alternatives) - and then Restrictions.Set (No_Dynamic_Attachment) - and then Restrictions.Set (No_Protected_Type_Allocators) - and then Restrictions.Set (No_Local_Protected_Objects) - and then Restrictions.Set (No_Requeue_Statements) - and then Restrictions.Set (No_Task_Attributes_Package) - and then Restrictions.Set (Max_Asynchronous_Select_Nesting) - and then Restrictions.Set (Max_Task_Entries) - and then Restrictions.Set (Max_Protected_Entries) - and then Restrictions.Set (Max_Select_Alternatives) - and then Restrictions.Value (Max_Asynchronous_Select_Nesting) = 0 - and then Restrictions.Value (Max_Task_Entries) = 0 - and then Restrictions.Value (Max_Protected_Entries) <= 1 - and then Restrictions.Value (Max_Select_Alternatives) = 0; + if Restricted_Profile_Cached then + return Restricted_Profile_Result; + + else + Restricted_Profile_Result := True; + Restricted_Profile_Cached := True; + + declare + R : Restriction_Flags renames Profile_Info (Restricted).Set; + V : Restriction_Values renames Profile_Info (Restricted).Value; + begin + for J in R'Range loop + if R (J) + and then (Restrictions.Set (J) = False + or else Restriction_Warnings (J) + or else + (J in All_Parameter_Restrictions + and then Restrictions.Value (J) > V (J))) + then + Restricted_Profile_Result := False; + exit; + end if; + end loop; + + return Restricted_Profile_Result; + end; + end if; end Restricted_Profile; ------------------------ @@ -466,52 +496,31 @@ package body Restrict is Error_Msg_N (B (1 .. P), N); end Restriction_Msg; - ------------------- - -- Set_Ravenscar -- - ------------------- + ------------------------------ + -- Set_Profile_Restrictions -- + ------------------------------ + + procedure Set_Profile_Restrictions + (P : Profile_Name; + N : Node_Id; + Warn : Boolean) + is + R : Restriction_Flags renames Profile_Info (P).Set; + V : Restriction_Values renames Profile_Info (P).Value; - procedure Set_Ravenscar (N : Node_Id) is - begin - Set_Restricted_Profile (N); - Set_Restriction (Simple_Barriers, N); - Set_Restriction (No_Select_Statements, N); - Set_Restriction (No_Calendar, N); - Set_Restriction (No_Entry_Queue, N); - Set_Restriction (No_Relative_Delay, N); - Set_Restriction (No_Task_Termination, N); - Set_Restriction (No_Implicit_Heap_Allocations, N); - end Set_Ravenscar; - - ---------------------------- - -- Set_Restricted_Profile -- - ---------------------------- - - -- This must be coordinated with Restricted_Profile - - procedure Set_Restricted_Profile (N : Node_Id) is begin - -- Set Boolean restrictions for Restricted Profile - - Set_Restriction (No_Abort_Statements, N); - Set_Restriction (No_Asynchronous_Control, N); - Set_Restriction (No_Entry_Queue, N); - Set_Restriction (No_Task_Hierarchy, N); - Set_Restriction (No_Task_Allocators, N); - Set_Restriction (No_Dynamic_Priorities, N); - Set_Restriction (No_Terminate_Alternatives, N); - Set_Restriction (No_Dynamic_Attachment, N); - Set_Restriction (No_Protected_Type_Allocators, N); - Set_Restriction (No_Local_Protected_Objects, N); - Set_Restriction (No_Requeue_Statements, N); - Set_Restriction (No_Task_Attributes_Package, N); - - -- Set parameter restrictions - - Set_Restriction (Max_Asynchronous_Select_Nesting, N, 0); - Set_Restriction (Max_Task_Entries, N, 0); - Set_Restriction (Max_Select_Alternatives, N, 0); - Set_Restriction (Max_Protected_Entries, N, 1); - end Set_Restricted_Profile; + for J in R'Range loop + if R (J) then + if J in All_Boolean_Restrictions then + Set_Restriction (J, N); + else + Set_Restriction (J, N, V (J)); + end if; + + Restriction_Warnings (J) := Warn; + end if; + end loop; + end Set_Profile_Restrictions; --------------------- -- Set_Restriction -- @@ -526,6 +535,12 @@ package body Restrict is begin Restrictions.Set (R) := True; + if Restricted_Profile_Cached and Restricted_Profile_Result then + null; + else + Restricted_Profile_Cached := False; + end if; + -- Set location, but preserve location of system -- restriction for nice error msg with run time name @@ -557,6 +572,12 @@ package body Restrict is V : Integer) is begin + if Restricted_Profile_Cached and Restricted_Profile_Result then + null; + else + Restricted_Profile_Cached := False; + end if; + if Restrictions.Set (R) then if V < Restrictions.Value (R) then Restrictions.Value (R) := V; diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads index 0766bb8..b2658d0 100644 --- a/gcc/ada/restrict.ads +++ b/gcc/ada/restrict.ads @@ -200,11 +200,11 @@ package Restrict is -- handlers are present. This function is called by Gigi when it needs to -- expand an AT END clean up identifier with no exception handler. - function Process_Restriction_Synonyms (Id : Name_Id) return Name_Id; - -- Id is the name of a restriction. If it is one of synonyms that we - -- allow for historical purposes (for list see System.Rident), then - -- the proper official name is returned. Otherwise the argument is - -- returned unchanged. + function Process_Restriction_Synonyms (N : Node_Id) return Name_Id; + -- Id is a node whose Chars field contains the name of a restriction. + -- If it is one of synonyms that we allow for historical purposes (for + -- list see System.Rident), then the proper official name is returned. + -- Otherwise the Chars field of the argument is returned unchanged. function Restriction_Active (R : All_Restrictions) return Boolean; pragma Inline (Restriction_Active); @@ -213,13 +213,20 @@ package Restrict is -- active. Always use Check_Restriction to record a violation. function Restricted_Profile return Boolean; - -- Tests to see if tasking operations follow the GNAT restricted run time - -- profile. - - procedure Set_Ravenscar (N : Node_Id); - -- Enables the set of restrictions for Ravenscar. N is the corresponding - -- pragma node, which is used for error messages on any constructs that - -- violate the profile. + -- Tests if set of restrictions corresponding to Profile (Restricted) is + -- currently in effect (set by pragma Profile, or by an appropriate set + -- of individual Restrictions pragms). Returns True only if all the + -- required restrictions are set. + + procedure Set_Profile_Restrictions + (P : Profile_Name; + N : Node_Id; + Warn : Boolean); + -- Sets the set of restrictions associated with the given profile + -- name. N is the node of the construct to which error messages + -- are to be attached as required. Warn is set True for the case + -- of Profile_Warnings where the restrictions are set as warnings + -- rather than legality requirements. procedure Set_Restriction (R : All_Boolean_Restrictions; @@ -235,11 +242,6 @@ package Restrict is -- 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_Restricted_Profile (N : Node_Id); - -- Enables the set of restrictions for pragma Restricted_Run_Time. N is - -- the corresponding pragma node, which is used for error messages on - -- constructs that violate the profile. - function Tasking_Allowed return Boolean; pragma Inline (Tasking_Allowed); -- Tests to see if tasking operations are allowed by the current diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads index 996b057..f0fbc49 100644 --- a/gcc/ada/s-rident.ads +++ b/gcc/ada/s-rident.ads @@ -283,4 +283,112 @@ package System.Rident is -- that the actual violation count is at least 3 but might be higher. end record; + ---------------------------------- + -- Profile Definitions and Data -- + ---------------------------------- + + type Profile_Name is (Ravenscar, Restricted); + -- Names of recognized pfofiles + + type Profile_Data is record + Set : Restriction_Flags; + -- Set to True if given restriction must be set for the profile, + -- and False if it need not be set (False does not mean that it + -- must not be set, just that it need not be set). If the flag + -- is True for a parameter restriction, then the Value array + -- gives the maximum value permitted by the profile. + + Value : Restriction_Values; + -- An entry in this array is meaningful only if the corresponding + -- flag in Set is True. In that case, the value in this array is + -- the maximum value of the parameter permitted by the profile. + end record; + + Profile_Info : array (Profile_Name) of Profile_Data := + + -- Restricted Profile + + (Restricted => + + -- Restrictions for Restricted profile + + (Set => + (No_Abort_Statements => True, + No_Asynchronous_Control => True, + No_Dynamic_Attachment => True, + No_Dynamic_Priorities => True, + No_Entry_Queue => True, + No_Local_Protected_Objects => True, + No_Protected_Type_Allocators => True, + No_Requeue_Statements => True, + No_Task_Allocators => True, + No_Task_Attributes_Package => True, + No_Task_Hierarchy => True, + No_Terminate_Alternatives => True, + Max_Asynchronous_Select_Nesting => True, + Max_Protected_Entries => True, + Max_Select_Alternatives => True, + Max_Task_Entries => True, + others => False), + + -- Value settings for Restricted profile + + Value => + (Max_Asynchronous_Select_Nesting => 0, + Max_Protected_Entries => 1, + Max_Select_Alternatives => 0, + Max_Task_Entries => 0, + others => 0)), + + -- Ravenscar Profile + + -- Note: the table entries here only represent the + -- required restriction profile for Ravenscar. The + -- full Ravenscar profile also requires: + + -- pragma Dispatching_Policy (FIFO_Within_Priorities); + -- pragma Locking_Policy (Ceiling_Locking); + -- pragma Detect_Blocking_Mode ??? + + Ravenscar => + + -- Restrictions for Ravenscar = Restricted profile .. + + (Set => + (No_Abort_Statements => True, + No_Asynchronous_Control => True, + No_Dynamic_Attachment => True, + No_Dynamic_Priorities => True, + No_Entry_Queue => True, + No_Local_Protected_Objects => True, + No_Protected_Type_Allocators => True, + No_Requeue_Statements => True, + No_Task_Allocators => True, + No_Task_Attributes_Package => True, + No_Task_Hierarchy => True, + No_Terminate_Alternatives => True, + Max_Asynchronous_Select_Nesting => True, + Max_Protected_Entries => True, + Max_Select_Alternatives => True, + Max_Task_Entries => True, + + -- plus these additional restrictions: + + No_Calendar => True, + No_Implicit_Heap_Allocations => True, + No_Relative_Delay => True, + No_Select_Statements => True, + No_Task_Termination => True, + Simple_Barriers => True, + others => False), + + -- Value settings for Ravenscar (same as Restricted) + + Value => + (Max_Asynchronous_Select_Nesting => 0, + Max_Protected_Entries => 1, + Max_Select_Alternatives => 0, + Max_Task_Entries => 0, + others => 0))); + end System.Rident; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 18c6177..f7aa92b 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -862,6 +862,7 @@ package body Sem_Attr is -- Case of an expression Resolve (P); + if Is_Access_Type (P_Type) then -- If there is an implicit dereference, then we must freeze diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index d0a5b63..2331802 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -805,8 +805,8 @@ package body Sem_Ch7 is procedure Inspect_Deferred_Constant_Completion is Decl : Node_Id; - begin + begin Decl := First (Priv_Decls); while Present (Decl) loop @@ -828,7 +828,6 @@ package body Sem_Ch7 is Error_Msg_N ("constant declaration requires initialization expression", Defining_Identifier (Decl)); - end if; Decl := Next (Decl); @@ -929,8 +928,7 @@ package body Sem_Ch7 is Analyze_Declarations (Priv_Decls); - -- Check the private declarations for incomplete deferred - -- constants. + -- Check the private declarations for incomplete deferred constants Inspect_Deferred_Constant_Completion; diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 78b5663..4248544 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -359,7 +359,7 @@ package body Sem_Elab is return; end if; - -- Nothing to do for imported entities, + -- Nothing to do for imported entities if Is_Imported (Ent) then return; @@ -426,8 +426,8 @@ package body Sem_Elab is -- If the generic entity is within a deeper instance than we are, then -- either the instantiation to which we refer itself caused an ABE, in - -- which case that will be handled separately. Otherwise, we know that - -- the body we need appears as needed at the point of the instantiation. + -- which case that will be handled separately, or else we know that the + -- body we need appears as needed at the point of the instantiation. -- However, this assumption is only valid if we are in static mode. if not Dynamic_Elaboration_Checks @@ -638,11 +638,13 @@ package body Sem_Elab is -- Find top level scope for called entity (not following renamings -- or derivations). This is where the Elaborate_All will go if it -- is needed. We start with the called entity, except in the case - -- of initialization procedures, where the init proc is in the root - -- package, where we start fromn the entity of the name in the call. + -- of an initialization procedure outside the current package, where + -- the init proc is in the root package, and we start from the entity + -- of the name in the call. if Is_Entity_Name (Name (N)) and then Is_Init_Proc (Entity (Name (N))) + and then not In_Same_Extended_Unit (N, Entity (Name (N))) then W_Scope := Scope (Entity (Name (N))); else @@ -810,7 +812,7 @@ package body Sem_Elab is -- current declarative part if not Same_Elaboration_Scope (Current_Scope, Scope (Ent)) - or else not In_Same_Extended_Unit (Sloc (N), Sloc (Ent)) + or else not In_Same_Extended_Unit (N, Ent) then return; end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 8501a71..0d8c1e1 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -244,6 +244,12 @@ package body Sem_Prag is -- 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. @@ -589,13 +595,61 @@ package body Sem_Prag is end if; end Check_Arg_Count; + -------------------------------- + -- Check_Arg_Is_External_Name -- + -------------------------------- + + procedure Check_Arg_Is_External_Name (Arg : Node_Id) is + Argx : constant Node_Id := Get_Pragma_Arg (Arg); + + begin + if Nkind (Argx) = N_Identifier then + return; + + else + Analyze_And_Resolve (Argx, Standard_String); + + if Is_OK_Static_Expression (Argx) then + return; + + elsif Etype (Argx) = Any_Type then + raise Pragma_Exit; + + -- An interesting special case, if we have a string literal and + -- we are in Ada 83 mode, then we allow it even though it will + -- not be flagged as static. This allows expected Ada 83 mode + -- use of external names which are string literals, even though + -- technically these are not static in Ada 83. + + elsif Ada_Version = Ada_83 + and then Nkind (Argx) = N_String_Literal + then + return; + + -- Static expression that raises Constraint_Error. This has + -- already been flagged, so just exit from pragma processing. + + elsif Is_Static_Expression (Argx) then + raise Pragma_Exit; + + -- Here we have a real error (non-static expression) + + else + Error_Msg_Name_1 := Chars (N); + Flag_Non_Static_Expr + ("argument for pragma% must be a identifier or " & + "static string expression!", Argx); + raise Pragma_Exit; + end if; + end if; + end Check_Arg_Is_External_Name; + ----------------------------- -- Check_Arg_Is_Identifier -- ----------------------------- procedure Check_Arg_Is_Identifier (Arg : Node_Id) is Argx : constant Node_Id := Get_Pragma_Arg (Arg); - begin if Nkind (Argx) /= N_Identifier then Error_Pragma_Arg @@ -609,7 +663,6 @@ package body Sem_Prag is procedure Check_Arg_Is_Integer_Literal (Arg : Node_Id) is Argx : constant Node_Id := Get_Pragma_Arg (Arg); - begin if Nkind (Argx) /= N_Integer_Literal then Error_Pragma_Arg @@ -2084,13 +2137,8 @@ package body Sem_Prag is Set_Extended_Import_Export_External_Name (Def_Id, Arg_External); - if Present (Arg_Size) - and then Nkind (Arg_Size) /= N_Identifier - and then Nkind (Arg_Size) /= N_String_Literal - then - Error_Pragma_Arg - ("pragma% Size argument must be identifier or string literal", - Arg_Size); + if Present (Arg_Size) then + Check_Arg_Is_External_Name (Arg_Size); end if; -- Export_Object case @@ -3271,7 +3319,8 @@ package body Sem_Prag is Val : Uint; procedure Set_Warning (R : All_Restrictions); - -- If this is a Restriction_Warnings pragma, set warning flag + -- If this is a Restriction_Warnings pragma, set warning flag, + -- otherwise reset the flag. ----------------- -- Set_Warning -- @@ -3281,6 +3330,8 @@ package body Sem_Prag is begin if Prag_Id = Pragma_Restriction_Warnings then Restriction_Warnings (R) := True; + else + Restriction_Warnings (R) := False; end if; end Set_Warning; @@ -3306,7 +3357,7 @@ package body Sem_Prag is R_Id := Get_Restriction_Id - (Process_Restriction_Synonyms (Chars (Expr))); + (Process_Restriction_Synonyms (Expr)); if R_Id not in All_Boolean_Restrictions then Error_Pragma_Arg @@ -3334,7 +3385,7 @@ package body Sem_Prag is -- Case of restriction identifier present else - R_Id := Get_Restriction_Id (Process_Restriction_Synonyms (Id)); + R_Id := Get_Restriction_Id (Process_Restriction_Synonyms (Arg)); Analyze_And_Resolve (Expr, Any_Integer); if R_Id not in All_Parameter_Restrictions then @@ -3609,8 +3660,11 @@ package body Sem_Prag is begin if No (Arg_External) then return; + end if; + + Check_Arg_Is_External_Name (Arg_External); - elsif Nkind (Arg_External) = N_String_Literal then + if Nkind (Arg_External) = N_String_Literal then if String_Length (Strval (Arg_External)) = 0 then return; else @@ -3620,10 +3674,12 @@ package body Sem_Prag is elsif Nkind (Arg_External) = N_Identifier then New_Name := Get_Default_External_Name (Arg_External); + -- Check_Arg_Is_External_Name should let through only + -- identifiers and string literals or static string + -- expressions (which are folded to string literals). + else - Error_Pragma_Arg - ("incorrect form for External parameter for pragma%", - Arg_External); + raise Program_Error; end if; -- If we already have an external name set (by a prior normal @@ -3848,7 +3904,7 @@ package body Sem_Prag is -- Set Detect_Blocking mode ??? - -- Set required restrictions (see Restrict.Set_Ravenscar for details) + -- Set required restrictions (see System.Rident for detailed list) procedure Set_Ravenscar_Profile (N : Node_Id) is begin @@ -3896,7 +3952,7 @@ package body Sem_Prag is -- Set the corresponding restrictions - Set_Ravenscar (N); + Set_Profile_Restrictions (Ravenscar, N, Warn => False); end Set_Ravenscar_Profile; -- Start of processing for Analyze_Pragma @@ -8095,10 +8151,9 @@ package body Sem_Prag is -- pragma Profile (profile_IDENTIFIER); - -- profile_IDENTIFIER => Ravenscar + -- profile_IDENTIFIER => Protected | Ravenscar when Pragma_Profile => - GNAT_Pragma; Check_Arg_Count (1); Check_Valid_Configuration_Pragma; Check_No_Identifiers; @@ -8108,6 +8163,36 @@ package body Sem_Prag is begin if Chars (Argx) = Name_Ravenscar then Set_Ravenscar_Profile (N); + + elsif Chars (Argx) = Name_Restricted then + Set_Profile_Restrictions (Restricted, N, Warn => False); + else + Error_Pragma_Arg ("& is not a valid profile", Argx); + end if; + end; + + ---------------------- + -- Profile_Warnings -- + ---------------------- + + -- pragma Profile_Warnings (profile_IDENTIFIER); + + -- profile_IDENTIFIER => Protected | Ravenscar + + when Pragma_Profile_Warnings => + GNAT_Pragma; + Check_Arg_Count (1); + Check_Valid_Configuration_Pragma; + Check_No_Identifiers; + + declare + Argx : constant Node_Id := Get_Pragma_Arg (Arg1); + begin + if Chars (Argx) = Name_Ravenscar then + Set_Profile_Restrictions (Ravenscar, N, Warn => True); + + elsif Chars (Argx) = Name_Restricted then + Set_Profile_Restrictions (Restricted, N, Warn => True); else Error_Pragma_Arg ("& is not a valid profile", Argx); end if; @@ -8579,6 +8664,13 @@ package body Sem_Prag is Check_Valid_Configuration_Pragma; Set_Ravenscar_Profile (N); + if Warn_On_Obsolescent_Feature then + Error_Msg_N + ("pragma Ravenscar is an obsolescent feature?", N); + Error_Msg_N + ("|use pragma Profile (Ravenscar) instead", N); + end if; + ------------------------- -- Restricted_Run_Time -- ------------------------- @@ -8589,7 +8681,14 @@ package body Sem_Prag is GNAT_Pragma; Check_Arg_Count (0); Check_Valid_Configuration_Pragma; - Set_Restricted_Profile (N); + Set_Profile_Restrictions (Restricted, N, Warn => False); + + if Warn_On_Obsolescent_Feature then + Error_Msg_N + ("pragma Restricted_Run_Time is an obsolescent feature?", N); + Error_Msg_N + ("|use pragma Profile (Restricted) instead", N); + end if; ------------------ -- Restrictions -- @@ -10158,6 +10257,7 @@ package body Sem_Prag is Pragma_Preelaborate => -1, Pragma_Priority => -1, Pragma_Profile => 0, + Pragma_Profile_Warnings => 0, Pragma_Propagate_Exceptions => -1, Pragma_Psect_Object => -1, Pragma_Pure => 0, diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb index b8c20bb..272801b 100644 --- a/gcc/ada/snames.adb +++ b/gcc/ada/snames.adb @@ -191,6 +191,7 @@ package body Snames is "persistent_data#" & "persistent_object#" & "profile#" & + "profile_warnings#" & "propagate_exceptions#" & "queuing_policy#" & "ravenscar#" & diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads index ceaa723..153ea27 100644 --- a/gcc/ada/snames.ads +++ b/gcc/ada/snames.ads @@ -301,8 +301,8 @@ package Snames is -- of these implementation dependent pragmas may be found in the -- appropriate section in unit Sem_Prag in file sem-prag.adb. - -- The entries marked Ada0Y are technically implementation dependent - -- pragmas, but they correspond to standard proposals for Ada 0Y. + -- The entries marked Ada05 are technically implementation dependent + -- pragmas, but they correspond to standard proposals for Ada 2005. -- The entries marked VMS are VMS specific pragmas that are recognized -- only in OpenVMS versions of GNAT. They are ignored in other versions @@ -342,32 +342,33 @@ package Snames is Name_Polling : constant Name_Id := N + 130; -- GNAT Name_Persistent_Data : constant Name_Id := N + 131; -- GNAT Name_Persistent_Object : constant Name_Id := N + 132; -- GNAT - Name_Profile : constant Name_Id := N + 133; -- Ada0Y - Name_Propagate_Exceptions : constant Name_Id := N + 134; -- GNAT - Name_Queuing_Policy : constant Name_Id := N + 135; - Name_Ravenscar : constant Name_Id := N + 136; - Name_Restricted_Run_Time : constant Name_Id := N + 137; - Name_Restrictions : constant Name_Id := N + 138; - Name_Restriction_Warnings : constant Name_Id := N + 139; -- GNAT - Name_Reviewable : constant Name_Id := N + 140; - Name_Source_File_Name : constant Name_Id := N + 141; -- GNAT - Name_Source_File_Name_Project : constant Name_Id := N + 142; -- GNAT - Name_Style_Checks : constant Name_Id := N + 143; -- GNAT - Name_Suppress : constant Name_Id := N + 144; - Name_Suppress_Exception_Locations : constant Name_Id := N + 145; -- GNAT - Name_Task_Dispatching_Policy : constant Name_Id := N + 146; - Name_Universal_Data : constant Name_Id := N + 147; -- AAMP - Name_Unsuppress : constant Name_Id := N + 148; -- GNAT - Name_Use_VADS_Size : constant Name_Id := N + 149; -- GNAT - Name_Validity_Checks : constant Name_Id := N + 150; -- GNAT - Name_Warnings : constant Name_Id := N + 151; -- GNAT - Last_Configuration_Pragma_Name : constant Name_Id := N + 151; + Name_Profile : constant Name_Id := N + 133; -- Ada05 + Name_Profile_Warnings : constant Name_Id := N + 134; -- GNAT + Name_Propagate_Exceptions : constant Name_Id := N + 135; -- GNAT + Name_Queuing_Policy : constant Name_Id := N + 136; + Name_Ravenscar : constant Name_Id := N + 137; + Name_Restricted_Run_Time : constant Name_Id := N + 138; + Name_Restrictions : constant Name_Id := N + 139; + Name_Restriction_Warnings : constant Name_Id := N + 140; -- GNAT + Name_Reviewable : constant Name_Id := N + 141; + Name_Source_File_Name : constant Name_Id := N + 142; -- GNAT + Name_Source_File_Name_Project : constant Name_Id := N + 143; -- GNAT + Name_Style_Checks : constant Name_Id := N + 144; -- GNAT + Name_Suppress : constant Name_Id := N + 145; + Name_Suppress_Exception_Locations : constant Name_Id := N + 146; -- GNAT + Name_Task_Dispatching_Policy : constant Name_Id := N + 147; + Name_Universal_Data : constant Name_Id := N + 148; -- AAMP + Name_Unsuppress : constant Name_Id := N + 149; -- GNAT + Name_Use_VADS_Size : constant Name_Id := N + 150; -- GNAT + Name_Validity_Checks : constant Name_Id := N + 151; -- GNAT + Name_Warnings : constant Name_Id := N + 152; -- GNAT + Last_Configuration_Pragma_Name : constant Name_Id := N + 152; -- Remaining pragma names - Name_Abort_Defer : constant Name_Id := N + 152; -- GNAT - Name_All_Calls_Remote : constant Name_Id := N + 153; - Name_Annotate : constant Name_Id := N + 154; -- GNAT + Name_Abort_Defer : constant Name_Id := N + 153; -- GNAT + Name_All_Calls_Remote : constant Name_Id := N + 154; + Name_Annotate : constant Name_Id := N + 155; -- GNAT -- Note: AST_Entry is not in this list because its name matches the -- name of the corresponding attribute. However, it is included in the @@ -375,78 +376,78 @@ package Snames is -- and Check_Pragma_Id correctly recognize and process Name_AST_Entry. -- AST_Entry is a VMS specific pragma. - Name_Assert : constant Name_Id := N + 155; -- GNAT - Name_Asynchronous : constant Name_Id := N + 156; - Name_Atomic : constant Name_Id := N + 157; - Name_Atomic_Components : constant Name_Id := N + 158; - Name_Attach_Handler : constant Name_Id := N + 159; - Name_Comment : constant Name_Id := N + 160; -- GNAT - Name_Common_Object : constant Name_Id := N + 161; -- GNAT - Name_Complex_Representation : constant Name_Id := N + 162; -- GNAT - Name_Controlled : constant Name_Id := N + 163; - Name_Convention : constant Name_Id := N + 164; - Name_CPP_Class : constant Name_Id := N + 165; -- GNAT - Name_CPP_Constructor : constant Name_Id := N + 166; -- GNAT - Name_CPP_Virtual : constant Name_Id := N + 167; -- GNAT - Name_CPP_Vtable : constant Name_Id := N + 168; -- GNAT - Name_Debug : constant Name_Id := N + 169; -- GNAT - Name_Elaborate : constant Name_Id := N + 170; -- Ada 83 - Name_Elaborate_All : constant Name_Id := N + 171; - Name_Elaborate_Body : constant Name_Id := N + 172; - Name_Export : constant Name_Id := N + 173; - Name_Export_Exception : constant Name_Id := N + 174; -- VMS - Name_Export_Function : constant Name_Id := N + 175; -- GNAT - Name_Export_Object : constant Name_Id := N + 176; -- GNAT - Name_Export_Procedure : constant Name_Id := N + 177; -- GNAT - Name_Export_Value : constant Name_Id := N + 178; -- GNAT - Name_Export_Valued_Procedure : constant Name_Id := N + 179; -- GNAT - Name_External : constant Name_Id := N + 180; -- GNAT - Name_Finalize_Storage_Only : constant Name_Id := N + 181; -- GNAT - Name_Ident : constant Name_Id := N + 182; -- VMS - Name_Import : constant Name_Id := N + 183; - Name_Import_Exception : constant Name_Id := N + 184; -- VMS - Name_Import_Function : constant Name_Id := N + 185; -- GNAT - Name_Import_Object : constant Name_Id := N + 186; -- GNAT - Name_Import_Procedure : constant Name_Id := N + 187; -- GNAT - Name_Import_Valued_Procedure : constant Name_Id := N + 188; -- GNAT - Name_Inline : constant Name_Id := N + 189; - Name_Inline_Always : constant Name_Id := N + 190; -- GNAT - Name_Inline_Generic : constant Name_Id := N + 191; -- GNAT - Name_Inspection_Point : constant Name_Id := N + 192; - Name_Interface : constant Name_Id := N + 193; -- Ada 83 - Name_Interface_Name : constant Name_Id := N + 194; -- GNAT - Name_Interrupt_Handler : constant Name_Id := N + 195; - Name_Interrupt_Priority : constant Name_Id := N + 196; - Name_Java_Constructor : constant Name_Id := N + 197; -- GNAT - Name_Java_Interface : constant Name_Id := N + 198; -- GNAT - Name_Keep_Names : constant Name_Id := N + 199; -- GNAT - Name_Link_With : constant Name_Id := N + 200; -- GNAT - Name_Linker_Alias : constant Name_Id := N + 201; -- GNAT - Name_Linker_Options : constant Name_Id := N + 202; - Name_Linker_Section : constant Name_Id := N + 203; -- GNAT - Name_List : constant Name_Id := N + 204; - Name_Machine_Attribute : constant Name_Id := N + 205; -- GNAT - Name_Main : constant Name_Id := N + 206; -- GNAT - Name_Main_Storage : constant Name_Id := N + 207; -- GNAT - Name_Memory_Size : constant Name_Id := N + 208; -- Ada 83 - Name_No_Return : constant Name_Id := N + 209; -- GNAT - Name_Obsolescent : constant Name_Id := N + 210; -- GNAT - Name_Optimize : constant Name_Id := N + 211; - Name_Optional_Overriding : constant Name_Id := N + 212; - Name_Overriding : constant Name_Id := N + 213; - Name_Pack : constant Name_Id := N + 214; - Name_Page : constant Name_Id := N + 215; - Name_Passive : constant Name_Id := N + 216; -- GNAT - Name_Preelaborate : constant Name_Id := N + 217; - Name_Priority : constant Name_Id := N + 218; - Name_Psect_Object : constant Name_Id := N + 219; -- VMS - Name_Pure : constant Name_Id := N + 220; - Name_Pure_Function : constant Name_Id := N + 221; -- GNAT - Name_Remote_Call_Interface : constant Name_Id := N + 222; - Name_Remote_Types : constant Name_Id := N + 223; - Name_Share_Generic : constant Name_Id := N + 224; -- GNAT - Name_Shared : constant Name_Id := N + 225; -- Ada 83 - Name_Shared_Passive : constant Name_Id := N + 226; + Name_Assert : constant Name_Id := N + 156; -- GNAT + Name_Asynchronous : constant Name_Id := N + 157; + Name_Atomic : constant Name_Id := N + 158; + Name_Atomic_Components : constant Name_Id := N + 159; + Name_Attach_Handler : constant Name_Id := N + 160; + Name_Comment : constant Name_Id := N + 161; -- GNAT + Name_Common_Object : constant Name_Id := N + 162; -- GNAT + Name_Complex_Representation : constant Name_Id := N + 163; -- GNAT + Name_Controlled : constant Name_Id := N + 164; + Name_Convention : constant Name_Id := N + 165; + Name_CPP_Class : constant Name_Id := N + 166; -- GNAT + Name_CPP_Constructor : constant Name_Id := N + 167; -- GNAT + Name_CPP_Virtual : constant Name_Id := N + 168; -- GNAT + Name_CPP_Vtable : constant Name_Id := N + 169; -- GNAT + Name_Debug : constant Name_Id := N + 170; -- GNAT + Name_Elaborate : constant Name_Id := N + 171; -- Ada 83 + Name_Elaborate_All : constant Name_Id := N + 172; + Name_Elaborate_Body : constant Name_Id := N + 173; + Name_Export : constant Name_Id := N + 174; + Name_Export_Exception : constant Name_Id := N + 175; -- VMS + Name_Export_Function : constant Name_Id := N + 176; -- GNAT + Name_Export_Object : constant Name_Id := N + 177; -- GNAT + Name_Export_Procedure : constant Name_Id := N + 178; -- GNAT + Name_Export_Value : constant Name_Id := N + 179; -- GNAT + Name_Export_Valued_Procedure : constant Name_Id := N + 180; -- GNAT + Name_External : constant Name_Id := N + 181; -- GNAT + Name_Finalize_Storage_Only : constant Name_Id := N + 182; -- GNAT + Name_Ident : constant Name_Id := N + 183; -- VMS + Name_Import : constant Name_Id := N + 184; + Name_Import_Exception : constant Name_Id := N + 185; -- VMS + Name_Import_Function : constant Name_Id := N + 186; -- GNAT + Name_Import_Object : constant Name_Id := N + 187; -- GNAT + Name_Import_Procedure : constant Name_Id := N + 188; -- GNAT + Name_Import_Valued_Procedure : constant Name_Id := N + 189; -- GNAT + Name_Inline : constant Name_Id := N + 190; + Name_Inline_Always : constant Name_Id := N + 191; -- GNAT + Name_Inline_Generic : constant Name_Id := N + 192; -- GNAT + Name_Inspection_Point : constant Name_Id := N + 193; + Name_Interface : constant Name_Id := N + 194; -- Ada 83 + Name_Interface_Name : constant Name_Id := N + 195; -- GNAT + Name_Interrupt_Handler : constant Name_Id := N + 196; + Name_Interrupt_Priority : constant Name_Id := N + 197; + Name_Java_Constructor : constant Name_Id := N + 198; -- GNAT + Name_Java_Interface : constant Name_Id := N + 199; -- GNAT + Name_Keep_Names : constant Name_Id := N + 200; -- GNAT + Name_Link_With : constant Name_Id := N + 201; -- GNAT + Name_Linker_Alias : constant Name_Id := N + 202; -- GNAT + Name_Linker_Options : constant Name_Id := N + 203; + Name_Linker_Section : constant Name_Id := N + 204; -- GNAT + Name_List : constant Name_Id := N + 205; + Name_Machine_Attribute : constant Name_Id := N + 206; -- GNAT + Name_Main : constant Name_Id := N + 207; -- GNAT + Name_Main_Storage : constant Name_Id := N + 208; -- GNAT + Name_Memory_Size : constant Name_Id := N + 209; -- Ada 83 + Name_No_Return : constant Name_Id := N + 210; -- GNAT + Name_Obsolescent : constant Name_Id := N + 211; -- GNAT + Name_Optimize : constant Name_Id := N + 212; + Name_Optional_Overriding : constant Name_Id := N + 213; + Name_Overriding : constant Name_Id := N + 214; + Name_Pack : constant Name_Id := N + 215; + Name_Page : constant Name_Id := N + 216; + Name_Passive : constant Name_Id := N + 217; -- GNAT + Name_Preelaborate : constant Name_Id := N + 218; + Name_Priority : constant Name_Id := N + 219; + Name_Psect_Object : constant Name_Id := N + 220; -- VMS + Name_Pure : constant Name_Id := N + 221; + Name_Pure_Function : constant Name_Id := N + 222; -- GNAT + Name_Remote_Call_Interface : constant Name_Id := N + 223; + Name_Remote_Types : constant Name_Id := N + 224; + Name_Share_Generic : constant Name_Id := N + 225; -- GNAT + Name_Shared : constant Name_Id := N + 226; -- Ada 83 + Name_Shared_Passive : constant Name_Id := N + 227; -- Note: Storage_Size is not in this list because its name matches the -- name of the corresponding attribute. However, it is included in the @@ -456,27 +457,27 @@ package Snames is -- Note: Storage_Unit is also omitted from the list because of a clash -- with an attribute name, and is treated similarly. - Name_Source_Reference : constant Name_Id := N + 227; -- GNAT - Name_Stream_Convert : constant Name_Id := N + 228; -- GNAT - Name_Subtitle : constant Name_Id := N + 229; -- GNAT - Name_Suppress_All : constant Name_Id := N + 230; -- GNAT - Name_Suppress_Debug_Info : constant Name_Id := N + 231; -- GNAT - Name_Suppress_Initialization : constant Name_Id := N + 232; -- GNAT - Name_System_Name : constant Name_Id := N + 233; -- Ada 83 - Name_Task_Info : constant Name_Id := N + 234; -- GNAT - Name_Task_Name : constant Name_Id := N + 235; -- GNAT - Name_Task_Storage : constant Name_Id := N + 236; -- VMS - Name_Thread_Body : constant Name_Id := N + 237; -- GNAT - Name_Time_Slice : constant Name_Id := N + 238; -- GNAT - Name_Title : constant Name_Id := N + 239; -- GNAT - Name_Unchecked_Union : constant Name_Id := N + 240; -- GNAT - Name_Unimplemented_Unit : constant Name_Id := N + 241; -- GNAT - Name_Unreferenced : constant Name_Id := N + 242; -- GNAT - Name_Unreserve_All_Interrupts : constant Name_Id := N + 243; -- GNAT - Name_Volatile : constant Name_Id := N + 244; - Name_Volatile_Components : constant Name_Id := N + 245; - Name_Weak_External : constant Name_Id := N + 246; -- GNAT - Last_Pragma_Name : constant Name_Id := N + 246; + Name_Source_Reference : constant Name_Id := N + 228; -- GNAT + Name_Stream_Convert : constant Name_Id := N + 229; -- GNAT + Name_Subtitle : constant Name_Id := N + 230; -- GNAT + Name_Suppress_All : constant Name_Id := N + 231; -- GNAT + Name_Suppress_Debug_Info : constant Name_Id := N + 232; -- GNAT + Name_Suppress_Initialization : constant Name_Id := N + 233; -- GNAT + Name_System_Name : constant Name_Id := N + 234; -- Ada 83 + Name_Task_Info : constant Name_Id := N + 235; -- GNAT + Name_Task_Name : constant Name_Id := N + 236; -- GNAT + Name_Task_Storage : constant Name_Id := N + 237; -- VMS + Name_Thread_Body : constant Name_Id := N + 238; -- GNAT + Name_Time_Slice : constant Name_Id := N + 239; -- GNAT + Name_Title : constant Name_Id := N + 240; -- GNAT + Name_Unchecked_Union : constant Name_Id := N + 241; -- GNAT + Name_Unimplemented_Unit : constant Name_Id := N + 242; -- GNAT + Name_Unreferenced : constant Name_Id := N + 243; -- GNAT + Name_Unreserve_All_Interrupts : constant Name_Id := N + 244; -- GNAT + Name_Volatile : constant Name_Id := N + 245; + Name_Volatile_Components : constant Name_Id := N + 246; + Name_Weak_External : constant Name_Id := N + 247; -- GNAT + Last_Pragma_Name : constant Name_Id := N + 247; -- Language convention names for pragma Convention/Export/Import/Interface -- Note that Name_C is not included in this list, since it was already @@ -487,105 +488,105 @@ package Snames is -- Entry and Protected, this is because these conventions cannot be -- specified by a pragma. - First_Convention_Name : constant Name_Id := N + 247; - Name_Ada : constant Name_Id := N + 247; - Name_Assembler : constant Name_Id := N + 248; - Name_COBOL : constant Name_Id := N + 249; - Name_CPP : constant Name_Id := N + 250; - Name_Fortran : constant Name_Id := N + 251; - Name_Intrinsic : constant Name_Id := N + 252; - Name_Java : constant Name_Id := N + 253; - Name_Stdcall : constant Name_Id := N + 254; - Name_Stubbed : constant Name_Id := N + 255; - Last_Convention_Name : constant Name_Id := N + 255; + First_Convention_Name : constant Name_Id := N + 248; + Name_Ada : constant Name_Id := N + 248; + Name_Assembler : constant Name_Id := N + 249; + Name_COBOL : constant Name_Id := N + 250; + Name_CPP : constant Name_Id := N + 251; + Name_Fortran : constant Name_Id := N + 252; + Name_Intrinsic : constant Name_Id := N + 253; + Name_Java : constant Name_Id := N + 254; + Name_Stdcall : constant Name_Id := N + 255; + Name_Stubbed : constant Name_Id := N + 256; + Last_Convention_Name : constant Name_Id := N + 256; -- The following names are preset as synonyms for Assembler - Name_Asm : constant Name_Id := N + 256; - Name_Assembly : constant Name_Id := N + 257; + Name_Asm : constant Name_Id := N + 257; + Name_Assembly : constant Name_Id := N + 258; -- The following names are preset as synonyms for C - Name_Default : constant Name_Id := N + 258; + Name_Default : constant Name_Id := N + 259; -- Name_Exernal (previously defined as pragma) -- The following names are present as synonyms for Stdcall - Name_DLL : constant Name_Id := N + 259; - Name_Win32 : constant Name_Id := N + 260; + Name_DLL : constant Name_Id := N + 260; + Name_Win32 : constant Name_Id := N + 261; -- Other special names used in processing pragmas - Name_As_Is : constant Name_Id := N + 261; - Name_Body_File_Name : constant Name_Id := N + 262; - Name_Boolean_Entry_Barriers : constant Name_Id := N + 263; - Name_Casing : constant Name_Id := N + 264; - Name_Code : constant Name_Id := N + 265; - Name_Component : constant Name_Id := N + 266; - Name_Component_Size_4 : constant Name_Id := N + 267; - Name_Copy : constant Name_Id := N + 268; - Name_D_Float : constant Name_Id := N + 269; - Name_Descriptor : constant Name_Id := N + 270; - Name_Dot_Replacement : constant Name_Id := N + 271; - Name_Dynamic : constant Name_Id := N + 272; - Name_Entity : constant Name_Id := N + 273; - Name_External_Name : constant Name_Id := N + 274; - Name_First_Optional_Parameter : constant Name_Id := N + 275; - Name_Form : constant Name_Id := N + 276; - Name_G_Float : constant Name_Id := N + 277; - Name_Gcc : constant Name_Id := N + 278; - Name_Gnat : constant Name_Id := N + 279; - Name_GPL : constant Name_Id := N + 280; - Name_IEEE_Float : constant Name_Id := N + 281; - Name_Internal : constant Name_Id := N + 282; - Name_Link_Name : constant Name_Id := N + 283; - Name_Lowercase : constant Name_Id := N + 284; - Name_Max_Entry_Queue_Depth : constant Name_Id := N + 285; - Name_Max_Entry_Queue_Length : constant Name_Id := N + 286; - Name_Max_Size : constant Name_Id := N + 287; - Name_Mechanism : constant Name_Id := N + 288; - Name_Mixedcase : constant Name_Id := N + 289; - Name_Modified_GPL : constant Name_Id := N + 290; - Name_Name : constant Name_Id := N + 291; - Name_NCA : constant Name_Id := N + 292; - Name_No : constant Name_Id := N + 293; - Name_On : constant Name_Id := N + 294; - Name_Parameter_Types : constant Name_Id := N + 295; - Name_Reference : constant Name_Id := N + 296; - Name_No_Dynamic_Attachment : constant Name_Id := N + 297; - Name_No_Dynamic_Interrupts : constant Name_Id := N + 298; - Name_No_Requeue : constant Name_Id := N + 299; - Name_No_Requeue_Statements : constant Name_Id := N + 300; - Name_No_Task_Attributes : constant Name_Id := N + 301; - Name_No_Task_Attributes_Package : constant Name_Id := N + 302; - Name_Restricted : constant Name_Id := N + 303; - Name_Result_Mechanism : constant Name_Id := N + 304; - Name_Result_Type : constant Name_Id := N + 305; - Name_Runtime : constant Name_Id := N + 306; - Name_SB : constant Name_Id := N + 307; - Name_Secondary_Stack_Size : constant Name_Id := N + 308; - Name_Section : constant Name_Id := N + 309; - Name_Semaphore : constant Name_Id := N + 310; - Name_Simple_Barriers : constant Name_Id := N + 311; - Name_Spec_File_Name : constant Name_Id := N + 312; - Name_Static : constant Name_Id := N + 313; - Name_Stack_Size : constant Name_Id := N + 314; - Name_Subunit_File_Name : constant Name_Id := N + 315; - Name_Task_Stack_Size_Default : constant Name_Id := N + 316; - Name_Task_Type : constant Name_Id := N + 317; - Name_Time_Slicing_Enabled : constant Name_Id := N + 318; - Name_Top_Guard : constant Name_Id := N + 319; - Name_UBA : constant Name_Id := N + 320; - Name_UBS : constant Name_Id := N + 321; - Name_UBSB : constant Name_Id := N + 322; - Name_Unit_Name : constant Name_Id := N + 323; - Name_Unknown : constant Name_Id := N + 324; - Name_Unrestricted : constant Name_Id := N + 325; - Name_Uppercase : constant Name_Id := N + 326; - Name_User : constant Name_Id := N + 327; - Name_VAX_Float : constant Name_Id := N + 328; - Name_VMS : constant Name_Id := N + 329; - Name_Working_Storage : constant Name_Id := N + 330; + Name_As_Is : constant Name_Id := N + 262; + Name_Body_File_Name : constant Name_Id := N + 263; + Name_Boolean_Entry_Barriers : constant Name_Id := N + 264; + Name_Casing : constant Name_Id := N + 265; + Name_Code : constant Name_Id := N + 266; + Name_Component : constant Name_Id := N + 267; + Name_Component_Size_4 : constant Name_Id := N + 268; + Name_Copy : constant Name_Id := N + 269; + Name_D_Float : constant Name_Id := N + 270; + Name_Descriptor : constant Name_Id := N + 271; + Name_Dot_Replacement : constant Name_Id := N + 272; + Name_Dynamic : constant Name_Id := N + 273; + Name_Entity : constant Name_Id := N + 274; + Name_External_Name : constant Name_Id := N + 275; + Name_First_Optional_Parameter : constant Name_Id := N + 276; + Name_Form : constant Name_Id := N + 277; + Name_G_Float : constant Name_Id := N + 278; + Name_Gcc : constant Name_Id := N + 279; + Name_Gnat : constant Name_Id := N + 280; + Name_GPL : constant Name_Id := N + 281; + Name_IEEE_Float : constant Name_Id := N + 282; + Name_Internal : constant Name_Id := N + 283; + Name_Link_Name : constant Name_Id := N + 284; + Name_Lowercase : constant Name_Id := N + 285; + Name_Max_Entry_Queue_Depth : constant Name_Id := N + 286; + Name_Max_Entry_Queue_Length : constant Name_Id := N + 287; + Name_Max_Size : constant Name_Id := N + 288; + Name_Mechanism : constant Name_Id := N + 289; + Name_Mixedcase : constant Name_Id := N + 290; + Name_Modified_GPL : constant Name_Id := N + 291; + Name_Name : constant Name_Id := N + 292; + Name_NCA : constant Name_Id := N + 293; + Name_No : constant Name_Id := N + 294; + Name_On : constant Name_Id := N + 295; + Name_Parameter_Types : constant Name_Id := N + 296; + Name_Reference : constant Name_Id := N + 297; + Name_No_Dynamic_Attachment : constant Name_Id := N + 298; + Name_No_Dynamic_Interrupts : constant Name_Id := N + 299; + Name_No_Requeue : constant Name_Id := N + 300; + Name_No_Requeue_Statements : constant Name_Id := N + 301; + Name_No_Task_Attributes : constant Name_Id := N + 302; + Name_No_Task_Attributes_Package : constant Name_Id := N + 303; + Name_Restricted : constant Name_Id := N + 304; + Name_Result_Mechanism : constant Name_Id := N + 305; + Name_Result_Type : constant Name_Id := N + 306; + Name_Runtime : constant Name_Id := N + 307; + Name_SB : constant Name_Id := N + 308; + Name_Secondary_Stack_Size : constant Name_Id := N + 309; + Name_Section : constant Name_Id := N + 310; + Name_Semaphore : constant Name_Id := N + 311; + Name_Simple_Barriers : constant Name_Id := N + 312; + Name_Spec_File_Name : constant Name_Id := N + 313; + Name_Static : constant Name_Id := N + 314; + Name_Stack_Size : constant Name_Id := N + 315; + Name_Subunit_File_Name : constant Name_Id := N + 316; + Name_Task_Stack_Size_Default : constant Name_Id := N + 317; + Name_Task_Type : constant Name_Id := N + 318; + Name_Time_Slicing_Enabled : constant Name_Id := N + 319; + Name_Top_Guard : constant Name_Id := N + 320; + Name_UBA : constant Name_Id := N + 321; + Name_UBS : constant Name_Id := N + 322; + Name_UBSB : constant Name_Id := N + 323; + Name_Unit_Name : constant Name_Id := N + 324; + Name_Unknown : constant Name_Id := N + 325; + Name_Unrestricted : constant Name_Id := N + 326; + Name_Uppercase : constant Name_Id := N + 327; + Name_User : constant Name_Id := N + 328; + Name_VAX_Float : constant Name_Id := N + 329; + Name_VMS : constant Name_Id := N + 330; + Name_Working_Storage : constant Name_Id := N + 331; -- 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 @@ -599,158 +600,158 @@ package Snames is -- 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 + 331; - Name_Abort_Signal : constant Name_Id := N + 331; -- GNAT - Name_Access : constant Name_Id := N + 332; - Name_Address : constant Name_Id := N + 333; - Name_Address_Size : constant Name_Id := N + 334; -- GNAT - Name_Aft : constant Name_Id := N + 335; - Name_Alignment : constant Name_Id := N + 336; - Name_Asm_Input : constant Name_Id := N + 337; -- GNAT - Name_Asm_Output : constant Name_Id := N + 338; -- GNAT - Name_AST_Entry : constant Name_Id := N + 339; -- VMS - Name_Bit : constant Name_Id := N + 340; -- GNAT - Name_Bit_Order : constant Name_Id := N + 341; - Name_Bit_Position : constant Name_Id := N + 342; -- GNAT - Name_Body_Version : constant Name_Id := N + 343; - Name_Callable : constant Name_Id := N + 344; - Name_Caller : constant Name_Id := N + 345; - Name_Code_Address : constant Name_Id := N + 346; -- GNAT - Name_Component_Size : constant Name_Id := N + 347; - Name_Compose : constant Name_Id := N + 348; - Name_Constrained : constant Name_Id := N + 349; - Name_Count : constant Name_Id := N + 350; - Name_Default_Bit_Order : constant Name_Id := N + 351; -- GNAT - Name_Definite : constant Name_Id := N + 352; - Name_Delta : constant Name_Id := N + 353; - Name_Denorm : constant Name_Id := N + 354; - Name_Digits : constant Name_Id := N + 355; - Name_Elaborated : constant Name_Id := N + 356; -- GNAT - Name_Emax : constant Name_Id := N + 357; -- Ada 83 - Name_Enum_Rep : constant Name_Id := N + 358; -- GNAT - Name_Epsilon : constant Name_Id := N + 359; -- Ada 83 - Name_Exponent : constant Name_Id := N + 360; - Name_External_Tag : constant Name_Id := N + 361; - Name_First : constant Name_Id := N + 362; - Name_First_Bit : constant Name_Id := N + 363; - Name_Fixed_Value : constant Name_Id := N + 364; -- GNAT - Name_Fore : constant Name_Id := N + 365; - Name_Has_Discriminants : constant Name_Id := N + 366; -- GNAT - Name_Identity : constant Name_Id := N + 367; - Name_Img : constant Name_Id := N + 368; -- GNAT - Name_Integer_Value : constant Name_Id := N + 369; -- GNAT - Name_Large : constant Name_Id := N + 370; -- Ada 83 - Name_Last : constant Name_Id := N + 371; - Name_Last_Bit : constant Name_Id := N + 372; - Name_Leading_Part : constant Name_Id := N + 373; - Name_Length : constant Name_Id := N + 374; - Name_Machine_Emax : constant Name_Id := N + 375; - Name_Machine_Emin : constant Name_Id := N + 376; - Name_Machine_Mantissa : constant Name_Id := N + 377; - Name_Machine_Overflows : constant Name_Id := N + 378; - Name_Machine_Radix : constant Name_Id := N + 379; - Name_Machine_Rounds : constant Name_Id := N + 380; - Name_Machine_Size : constant Name_Id := N + 381; -- GNAT - Name_Mantissa : constant Name_Id := N + 382; -- Ada 83 - Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 383; - Name_Maximum_Alignment : constant Name_Id := N + 384; -- GNAT - Name_Mechanism_Code : constant Name_Id := N + 385; -- GNAT - Name_Model_Emin : constant Name_Id := N + 386; - Name_Model_Epsilon : constant Name_Id := N + 387; - Name_Model_Mantissa : constant Name_Id := N + 388; - Name_Model_Small : constant Name_Id := N + 389; - Name_Modulus : constant Name_Id := N + 390; - Name_Null_Parameter : constant Name_Id := N + 391; -- GNAT - Name_Object_Size : constant Name_Id := N + 392; -- GNAT - Name_Partition_ID : constant Name_Id := N + 393; - Name_Passed_By_Reference : constant Name_Id := N + 394; -- GNAT - Name_Pool_Address : constant Name_Id := N + 395; - Name_Pos : constant Name_Id := N + 396; - Name_Position : constant Name_Id := N + 397; - Name_Range : constant Name_Id := N + 398; - Name_Range_Length : constant Name_Id := N + 399; -- GNAT - Name_Round : constant Name_Id := N + 400; - Name_Safe_Emax : constant Name_Id := N + 401; -- Ada 83 - Name_Safe_First : constant Name_Id := N + 402; - Name_Safe_Large : constant Name_Id := N + 403; -- Ada 83 - Name_Safe_Last : constant Name_Id := N + 404; - Name_Safe_Small : constant Name_Id := N + 405; -- Ada 83 - Name_Scale : constant Name_Id := N + 406; - Name_Scaling : constant Name_Id := N + 407; - Name_Signed_Zeros : constant Name_Id := N + 408; - Name_Size : constant Name_Id := N + 409; - Name_Small : constant Name_Id := N + 410; - Name_Storage_Size : constant Name_Id := N + 411; - Name_Storage_Unit : constant Name_Id := N + 412; -- GNAT - Name_Tag : constant Name_Id := N + 413; - Name_Target_Name : constant Name_Id := N + 414; -- GNAT - Name_Terminated : constant Name_Id := N + 415; - Name_To_Address : constant Name_Id := N + 416; -- GNAT - Name_Type_Class : constant Name_Id := N + 417; -- GNAT - Name_UET_Address : constant Name_Id := N + 418; -- GNAT - Name_Unbiased_Rounding : constant Name_Id := N + 419; - Name_Unchecked_Access : constant Name_Id := N + 420; - Name_Unconstrained_Array : constant Name_Id := N + 421; - Name_Universal_Literal_String : constant Name_Id := N + 422; -- GNAT - Name_Unrestricted_Access : constant Name_Id := N + 423; -- GNAT - Name_VADS_Size : constant Name_Id := N + 424; -- GNAT - Name_Val : constant Name_Id := N + 425; - Name_Valid : constant Name_Id := N + 426; - Name_Value_Size : constant Name_Id := N + 427; -- GNAT - Name_Version : constant Name_Id := N + 428; - Name_Wchar_T_Size : constant Name_Id := N + 429; -- GNAT - Name_Wide_Width : constant Name_Id := N + 430; - Name_Width : constant Name_Id := N + 431; - Name_Word_Size : constant Name_Id := N + 432; -- GNAT + First_Attribute_Name : constant Name_Id := N + 332; + Name_Abort_Signal : constant Name_Id := N + 332; -- GNAT + Name_Access : constant Name_Id := N + 333; + Name_Address : constant Name_Id := N + 334; + Name_Address_Size : constant Name_Id := N + 335; -- GNAT + Name_Aft : constant Name_Id := N + 336; + Name_Alignment : constant Name_Id := N + 337; + Name_Asm_Input : constant Name_Id := N + 338; -- GNAT + Name_Asm_Output : constant Name_Id := N + 339; -- GNAT + Name_AST_Entry : constant Name_Id := N + 340; -- VMS + Name_Bit : constant Name_Id := N + 341; -- GNAT + Name_Bit_Order : constant Name_Id := N + 342; + Name_Bit_Position : constant Name_Id := N + 343; -- GNAT + Name_Body_Version : constant Name_Id := N + 344; + Name_Callable : constant Name_Id := N + 345; + Name_Caller : constant Name_Id := N + 346; + Name_Code_Address : constant Name_Id := N + 347; -- GNAT + Name_Component_Size : constant Name_Id := N + 348; + Name_Compose : constant Name_Id := N + 349; + Name_Constrained : constant Name_Id := N + 350; + Name_Count : constant Name_Id := N + 351; + Name_Default_Bit_Order : constant Name_Id := N + 352; -- GNAT + Name_Definite : constant Name_Id := N + 353; + Name_Delta : constant Name_Id := N + 354; + Name_Denorm : constant Name_Id := N + 355; + Name_Digits : constant Name_Id := N + 356; + Name_Elaborated : constant Name_Id := N + 357; -- GNAT + Name_Emax : constant Name_Id := N + 358; -- Ada 83 + Name_Enum_Rep : constant Name_Id := N + 359; -- GNAT + Name_Epsilon : constant Name_Id := N + 360; -- Ada 83 + Name_Exponent : constant Name_Id := N + 361; + Name_External_Tag : constant Name_Id := N + 362; + Name_First : constant Name_Id := N + 363; + Name_First_Bit : constant Name_Id := N + 364; + Name_Fixed_Value : constant Name_Id := N + 365; -- GNAT + Name_Fore : constant Name_Id := N + 366; + Name_Has_Discriminants : constant Name_Id := N + 367; -- GNAT + Name_Identity : constant Name_Id := N + 368; + Name_Img : constant Name_Id := N + 369; -- GNAT + Name_Integer_Value : constant Name_Id := N + 370; -- GNAT + Name_Large : constant Name_Id := N + 371; -- Ada 83 + Name_Last : constant Name_Id := N + 372; + Name_Last_Bit : constant Name_Id := N + 373; + Name_Leading_Part : constant Name_Id := N + 374; + Name_Length : constant Name_Id := N + 375; + Name_Machine_Emax : constant Name_Id := N + 376; + Name_Machine_Emin : constant Name_Id := N + 377; + Name_Machine_Mantissa : constant Name_Id := N + 378; + Name_Machine_Overflows : constant Name_Id := N + 379; + Name_Machine_Radix : constant Name_Id := N + 380; + Name_Machine_Rounds : constant Name_Id := N + 381; + Name_Machine_Size : constant Name_Id := N + 382; -- GNAT + Name_Mantissa : constant Name_Id := N + 383; -- Ada 83 + Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 384; + Name_Maximum_Alignment : constant Name_Id := N + 385; -- GNAT + Name_Mechanism_Code : constant Name_Id := N + 386; -- GNAT + Name_Model_Emin : constant Name_Id := N + 387; + Name_Model_Epsilon : constant Name_Id := N + 388; + Name_Model_Mantissa : constant Name_Id := N + 389; + Name_Model_Small : constant Name_Id := N + 390; + Name_Modulus : constant Name_Id := N + 391; + Name_Null_Parameter : constant Name_Id := N + 392; -- GNAT + Name_Object_Size : constant Name_Id := N + 393; -- GNAT + Name_Partition_ID : constant Name_Id := N + 394; + Name_Passed_By_Reference : constant Name_Id := N + 395; -- GNAT + Name_Pool_Address : constant Name_Id := N + 396; + Name_Pos : constant Name_Id := N + 397; + Name_Position : constant Name_Id := N + 398; + Name_Range : constant Name_Id := N + 399; + Name_Range_Length : constant Name_Id := N + 400; -- GNAT + Name_Round : constant Name_Id := N + 401; + Name_Safe_Emax : constant Name_Id := N + 402; -- Ada 83 + Name_Safe_First : constant Name_Id := N + 403; + Name_Safe_Large : constant Name_Id := N + 404; -- Ada 83 + Name_Safe_Last : constant Name_Id := N + 405; + Name_Safe_Small : constant Name_Id := N + 406; -- Ada 83 + Name_Scale : constant Name_Id := N + 407; + Name_Scaling : constant Name_Id := N + 408; + Name_Signed_Zeros : constant Name_Id := N + 409; + Name_Size : constant Name_Id := N + 410; + Name_Small : constant Name_Id := N + 411; + Name_Storage_Size : constant Name_Id := N + 412; + Name_Storage_Unit : constant Name_Id := N + 413; -- GNAT + Name_Tag : constant Name_Id := N + 414; + Name_Target_Name : constant Name_Id := N + 415; -- GNAT + Name_Terminated : constant Name_Id := N + 416; + Name_To_Address : constant Name_Id := N + 417; -- GNAT + Name_Type_Class : constant Name_Id := N + 418; -- GNAT + Name_UET_Address : constant Name_Id := N + 419; -- GNAT + Name_Unbiased_Rounding : constant Name_Id := N + 420; + Name_Unchecked_Access : constant Name_Id := N + 421; + Name_Unconstrained_Array : constant Name_Id := N + 422; + Name_Universal_Literal_String : constant Name_Id := N + 423; -- GNAT + Name_Unrestricted_Access : constant Name_Id := N + 424; -- GNAT + Name_VADS_Size : constant Name_Id := N + 425; -- GNAT + Name_Val : constant Name_Id := N + 426; + Name_Valid : constant Name_Id := N + 427; + Name_Value_Size : constant Name_Id := N + 428; -- GNAT + Name_Version : constant Name_Id := N + 429; + Name_Wchar_T_Size : constant Name_Id := N + 430; -- GNAT + Name_Wide_Width : constant Name_Id := N + 431; + Name_Width : constant Name_Id := N + 432; + Name_Word_Size : constant Name_Id := N + 433; -- 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 + 433; - Name_Adjacent : constant Name_Id := N + 433; - Name_Ceiling : constant Name_Id := N + 434; - Name_Copy_Sign : constant Name_Id := N + 435; - Name_Floor : constant Name_Id := N + 436; - Name_Fraction : constant Name_Id := N + 437; - Name_Image : constant Name_Id := N + 438; - Name_Input : constant Name_Id := N + 439; - Name_Machine : constant Name_Id := N + 440; - Name_Max : constant Name_Id := N + 441; - Name_Min : constant Name_Id := N + 442; - Name_Model : constant Name_Id := N + 443; - Name_Pred : constant Name_Id := N + 444; - Name_Remainder : constant Name_Id := N + 445; - Name_Rounding : constant Name_Id := N + 446; - Name_Succ : constant Name_Id := N + 447; - Name_Truncation : constant Name_Id := N + 448; - Name_Value : constant Name_Id := N + 449; - Name_Wide_Image : constant Name_Id := N + 450; - Name_Wide_Value : constant Name_Id := N + 451; - Last_Renamable_Function_Attribute : constant Name_Id := N + 451; + First_Renamable_Function_Attribute : constant Name_Id := N + 434; + Name_Adjacent : constant Name_Id := N + 434; + Name_Ceiling : constant Name_Id := N + 435; + Name_Copy_Sign : constant Name_Id := N + 436; + Name_Floor : constant Name_Id := N + 437; + Name_Fraction : constant Name_Id := N + 438; + Name_Image : constant Name_Id := N + 439; + Name_Input : constant Name_Id := N + 440; + Name_Machine : constant Name_Id := N + 441; + Name_Max : constant Name_Id := N + 442; + Name_Min : constant Name_Id := N + 443; + Name_Model : constant Name_Id := N + 444; + Name_Pred : constant Name_Id := N + 445; + Name_Remainder : constant Name_Id := N + 446; + Name_Rounding : constant Name_Id := N + 447; + Name_Succ : constant Name_Id := N + 448; + Name_Truncation : constant Name_Id := N + 449; + Name_Value : constant Name_Id := N + 450; + Name_Wide_Image : constant Name_Id := N + 451; + Name_Wide_Value : constant Name_Id := N + 452; + Last_Renamable_Function_Attribute : constant Name_Id := N + 452; -- Attributes that designate procedures - First_Procedure_Attribute : constant Name_Id := N + 452; - Name_Output : constant Name_Id := N + 452; - Name_Read : constant Name_Id := N + 453; - Name_Write : constant Name_Id := N + 454; - Last_Procedure_Attribute : constant Name_Id := N + 454; + First_Procedure_Attribute : constant Name_Id := N + 453; + Name_Output : constant Name_Id := N + 453; + Name_Read : constant Name_Id := N + 454; + Name_Write : constant Name_Id := N + 455; + Last_Procedure_Attribute : constant Name_Id := N + 455; -- Remaining attributes are ones that return entities - First_Entity_Attribute_Name : constant Name_Id := N + 455; - Name_Elab_Body : constant Name_Id := N + 455; -- GNAT - Name_Elab_Spec : constant Name_Id := N + 456; -- GNAT - Name_Storage_Pool : constant Name_Id := N + 457; + First_Entity_Attribute_Name : constant Name_Id := N + 456; + Name_Elab_Body : constant Name_Id := N + 456; -- GNAT + Name_Elab_Spec : constant Name_Id := N + 457; -- GNAT + Name_Storage_Pool : constant Name_Id := N + 458; -- These attributes are the ones that return types - First_Type_Attribute_Name : constant Name_Id := N + 458; - Name_Base : constant Name_Id := N + 458; - Name_Class : constant Name_Id := N + 459; - Last_Type_Attribute_Name : constant Name_Id := N + 459; - Last_Entity_Attribute_Name : constant Name_Id := N + 459; - Last_Attribute_Name : constant Name_Id := N + 459; + First_Type_Attribute_Name : constant Name_Id := N + 459; + Name_Base : constant Name_Id := N + 459; + Name_Class : constant Name_Id := N + 460; + Last_Type_Attribute_Name : constant Name_Id := N + 460; + Last_Entity_Attribute_Name : constant Name_Id := N + 460; + Last_Attribute_Name : constant Name_Id := N + 460; -- Names of recognized locking policy identifiers @@ -758,10 +759,10 @@ package Snames is -- 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 + 460; - Name_Ceiling_Locking : constant Name_Id := N + 460; - Name_Inheritance_Locking : constant Name_Id := N + 461; - Last_Locking_Policy_Name : constant Name_Id := N + 461; + First_Locking_Policy_Name : constant Name_Id := N + 461; + Name_Ceiling_Locking : constant Name_Id := N + 461; + Name_Inheritance_Locking : constant Name_Id := N + 462; + Last_Locking_Policy_Name : constant Name_Id := N + 462; -- Names of recognized queuing policy identifiers. @@ -769,10 +770,10 @@ package Snames is -- 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 + 462; - Name_FIFO_Queuing : constant Name_Id := N + 462; - Name_Priority_Queuing : constant Name_Id := N + 463; - Last_Queuing_Policy_Name : constant Name_Id := N + 463; + First_Queuing_Policy_Name : constant Name_Id := N + 463; + Name_FIFO_Queuing : constant Name_Id := N + 463; + Name_Priority_Queuing : constant Name_Id := N + 464; + Last_Queuing_Policy_Name : constant Name_Id := N + 464; -- Names of recognized task dispatching policy identifiers @@ -780,194 +781,194 @@ package Snames is -- 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 + 464; - Name_FIFO_Within_Priorities : constant Name_Id := N + 464; - Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 464; + First_Task_Dispatching_Policy_Name : constant Name_Id := N + 465; + Name_FIFO_Within_Priorities : constant Name_Id := N + 465; + Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 465; -- Names of recognized checks for pragma Suppress - First_Check_Name : constant Name_Id := N + 465; - Name_Access_Check : constant Name_Id := N + 465; - Name_Accessibility_Check : constant Name_Id := N + 466; - Name_Discriminant_Check : constant Name_Id := N + 467; - Name_Division_Check : constant Name_Id := N + 468; - Name_Elaboration_Check : constant Name_Id := N + 469; - Name_Index_Check : constant Name_Id := N + 470; - Name_Length_Check : constant Name_Id := N + 471; - Name_Overflow_Check : constant Name_Id := N + 472; - Name_Range_Check : constant Name_Id := N + 473; - Name_Storage_Check : constant Name_Id := N + 474; - Name_Tag_Check : constant Name_Id := N + 475; - Name_All_Checks : constant Name_Id := N + 476; - Last_Check_Name : constant Name_Id := N + 476; + First_Check_Name : constant Name_Id := N + 466; + Name_Access_Check : constant Name_Id := N + 466; + Name_Accessibility_Check : constant Name_Id := N + 467; + Name_Discriminant_Check : constant Name_Id := N + 468; + Name_Division_Check : constant Name_Id := N + 469; + Name_Elaboration_Check : constant Name_Id := N + 470; + Name_Index_Check : constant Name_Id := N + 471; + Name_Length_Check : constant Name_Id := N + 472; + Name_Overflow_Check : constant Name_Id := N + 473; + Name_Range_Check : constant Name_Id := N + 474; + Name_Storage_Check : constant Name_Id := N + 475; + Name_Tag_Check : constant Name_Id := N + 476; + Name_All_Checks : constant Name_Id := N + 477; + Last_Check_Name : constant Name_Id := N + 477; -- Names corresponding to reserved keywords, excluding those already -- declared in the attribute list (Access, Delta, Digits, Range). - Name_Abort : constant Name_Id := N + 477; - Name_Abs : constant Name_Id := N + 478; - Name_Accept : constant Name_Id := N + 479; - Name_And : constant Name_Id := N + 480; - Name_All : constant Name_Id := N + 481; - Name_Array : constant Name_Id := N + 482; - Name_At : constant Name_Id := N + 483; - Name_Begin : constant Name_Id := N + 484; - Name_Body : constant Name_Id := N + 485; - Name_Case : constant Name_Id := N + 486; - Name_Constant : constant Name_Id := N + 487; - Name_Declare : constant Name_Id := N + 488; - Name_Delay : constant Name_Id := N + 489; - Name_Do : constant Name_Id := N + 490; - Name_Else : constant Name_Id := N + 491; - Name_Elsif : constant Name_Id := N + 492; - Name_End : constant Name_Id := N + 493; - Name_Entry : constant Name_Id := N + 494; - Name_Exception : constant Name_Id := N + 495; - Name_Exit : constant Name_Id := N + 496; - Name_For : constant Name_Id := N + 497; - Name_Function : constant Name_Id := N + 498; - Name_Generic : constant Name_Id := N + 499; - Name_Goto : constant Name_Id := N + 500; - Name_If : constant Name_Id := N + 501; - Name_In : constant Name_Id := N + 502; - Name_Is : constant Name_Id := N + 503; - Name_Limited : constant Name_Id := N + 504; - Name_Loop : constant Name_Id := N + 505; - Name_Mod : constant Name_Id := N + 506; - Name_New : constant Name_Id := N + 507; - Name_Not : constant Name_Id := N + 508; - Name_Null : constant Name_Id := N + 509; - Name_Of : constant Name_Id := N + 510; - Name_Or : constant Name_Id := N + 511; - Name_Others : constant Name_Id := N + 512; - Name_Out : constant Name_Id := N + 513; - Name_Package : constant Name_Id := N + 514; - Name_Pragma : constant Name_Id := N + 515; - Name_Private : constant Name_Id := N + 516; - Name_Procedure : constant Name_Id := N + 517; - Name_Raise : constant Name_Id := N + 518; - Name_Record : constant Name_Id := N + 519; - Name_Rem : constant Name_Id := N + 520; - Name_Renames : constant Name_Id := N + 521; - Name_Return : constant Name_Id := N + 522; - Name_Reverse : constant Name_Id := N + 523; - Name_Select : constant Name_Id := N + 524; - Name_Separate : constant Name_Id := N + 525; - Name_Subtype : constant Name_Id := N + 526; - Name_Task : constant Name_Id := N + 527; - Name_Terminate : constant Name_Id := N + 528; - Name_Then : constant Name_Id := N + 529; - Name_Type : constant Name_Id := N + 530; - Name_Use : constant Name_Id := N + 531; - Name_When : constant Name_Id := N + 532; - Name_While : constant Name_Id := N + 533; - Name_With : constant Name_Id := N + 534; - Name_Xor : constant Name_Id := N + 535; + Name_Abort : constant Name_Id := N + 478; + Name_Abs : constant Name_Id := N + 479; + Name_Accept : constant Name_Id := N + 480; + Name_And : constant Name_Id := N + 481; + Name_All : constant Name_Id := N + 482; + Name_Array : constant Name_Id := N + 483; + Name_At : constant Name_Id := N + 484; + Name_Begin : constant Name_Id := N + 485; + Name_Body : constant Name_Id := N + 486; + Name_Case : constant Name_Id := N + 487; + Name_Constant : constant Name_Id := N + 488; + Name_Declare : constant Name_Id := N + 489; + Name_Delay : constant Name_Id := N + 490; + Name_Do : constant Name_Id := N + 491; + Name_Else : constant Name_Id := N + 492; + Name_Elsif : constant Name_Id := N + 493; + Name_End : constant Name_Id := N + 494; + Name_Entry : constant Name_Id := N + 495; + Name_Exception : constant Name_Id := N + 496; + Name_Exit : constant Name_Id := N + 497; + Name_For : constant Name_Id := N + 498; + Name_Function : constant Name_Id := N + 499; + Name_Generic : constant Name_Id := N + 500; + Name_Goto : constant Name_Id := N + 501; + Name_If : constant Name_Id := N + 502; + Name_In : constant Name_Id := N + 503; + Name_Is : constant Name_Id := N + 504; + Name_Limited : constant Name_Id := N + 505; + Name_Loop : constant Name_Id := N + 506; + Name_Mod : constant Name_Id := N + 507; + Name_New : constant Name_Id := N + 508; + Name_Not : constant Name_Id := N + 509; + Name_Null : constant Name_Id := N + 510; + Name_Of : constant Name_Id := N + 511; + Name_Or : constant Name_Id := N + 512; + Name_Others : constant Name_Id := N + 513; + Name_Out : constant Name_Id := N + 514; + Name_Package : constant Name_Id := N + 515; + Name_Pragma : constant Name_Id := N + 516; + Name_Private : constant Name_Id := N + 517; + Name_Procedure : constant Name_Id := N + 518; + Name_Raise : constant Name_Id := N + 519; + Name_Record : constant Name_Id := N + 520; + Name_Rem : constant Name_Id := N + 521; + Name_Renames : constant Name_Id := N + 522; + Name_Return : constant Name_Id := N + 523; + Name_Reverse : constant Name_Id := N + 524; + Name_Select : constant Name_Id := N + 525; + Name_Separate : constant Name_Id := N + 526; + Name_Subtype : constant Name_Id := N + 527; + Name_Task : constant Name_Id := N + 528; + Name_Terminate : constant Name_Id := N + 529; + Name_Then : constant Name_Id := N + 530; + Name_Type : constant Name_Id := N + 531; + Name_Use : constant Name_Id := N + 532; + Name_When : constant Name_Id := N + 533; + Name_While : constant Name_Id := N + 534; + Name_With : constant Name_Id := N + 535; + Name_Xor : constant Name_Id := N + 536; -- 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 + 536; - Name_Divide : constant Name_Id := N + 536; - Name_Enclosing_Entity : constant Name_Id := N + 537; - Name_Exception_Information : constant Name_Id := N + 538; - Name_Exception_Message : constant Name_Id := N + 539; - Name_Exception_Name : constant Name_Id := N + 540; - Name_File : constant Name_Id := N + 541; - Name_Import_Address : constant Name_Id := N + 542; - Name_Import_Largest_Value : constant Name_Id := N + 543; - Name_Import_Value : constant Name_Id := N + 544; - Name_Is_Negative : constant Name_Id := N + 545; - Name_Line : constant Name_Id := N + 546; - Name_Rotate_Left : constant Name_Id := N + 547; - Name_Rotate_Right : constant Name_Id := N + 548; - Name_Shift_Left : constant Name_Id := N + 549; - Name_Shift_Right : constant Name_Id := N + 550; - Name_Shift_Right_Arithmetic : constant Name_Id := N + 551; - Name_Source_Location : constant Name_Id := N + 552; - Name_Unchecked_Conversion : constant Name_Id := N + 553; - Name_Unchecked_Deallocation : constant Name_Id := N + 554; - Name_To_Pointer : constant Name_Id := N + 555; - Last_Intrinsic_Name : constant Name_Id := N + 555; + First_Intrinsic_Name : constant Name_Id := N + 537; + Name_Divide : constant Name_Id := N + 537; + Name_Enclosing_Entity : constant Name_Id := N + 538; + Name_Exception_Information : constant Name_Id := N + 539; + Name_Exception_Message : constant Name_Id := N + 540; + Name_Exception_Name : constant Name_Id := N + 541; + Name_File : constant Name_Id := N + 542; + Name_Import_Address : constant Name_Id := N + 543; + Name_Import_Largest_Value : constant Name_Id := N + 544; + Name_Import_Value : constant Name_Id := N + 545; + Name_Is_Negative : constant Name_Id := N + 546; + Name_Line : constant Name_Id := N + 547; + Name_Rotate_Left : constant Name_Id := N + 548; + Name_Rotate_Right : constant Name_Id := N + 549; + Name_Shift_Left : constant Name_Id := N + 550; + Name_Shift_Right : constant Name_Id := N + 551; + Name_Shift_Right_Arithmetic : constant Name_Id := N + 552; + Name_Source_Location : constant Name_Id := N + 553; + Name_Unchecked_Conversion : constant Name_Id := N + 554; + Name_Unchecked_Deallocation : constant Name_Id := N + 555; + Name_To_Pointer : constant Name_Id := N + 556; + Last_Intrinsic_Name : constant Name_Id := N + 556; -- Reserved words used only in Ada 95 - First_95_Reserved_Word : constant Name_Id := N + 556; - Name_Abstract : constant Name_Id := N + 556; - Name_Aliased : constant Name_Id := N + 557; - Name_Protected : constant Name_Id := N + 558; - Name_Until : constant Name_Id := N + 559; - Name_Requeue : constant Name_Id := N + 560; - Name_Tagged : constant Name_Id := N + 561; - Last_95_Reserved_Word : constant Name_Id := N + 561; + First_95_Reserved_Word : constant Name_Id := N + 557; + Name_Abstract : constant Name_Id := N + 557; + Name_Aliased : constant Name_Id := N + 558; + Name_Protected : constant Name_Id := N + 559; + Name_Until : constant Name_Id := N + 560; + Name_Requeue : constant Name_Id := N + 561; + Name_Tagged : constant Name_Id := N + 562; + Last_95_Reserved_Word : constant Name_Id := N + 562; 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 + 562; + Name_Raise_Exception : constant Name_Id := N + 563; -- Additional reserved words in GNAT Project Files -- Note that Name_External is already previously declared - Name_Binder : constant Name_Id := N + 563; - Name_Body_Suffix : constant Name_Id := N + 564; - Name_Builder : constant Name_Id := N + 565; - Name_Compiler : constant Name_Id := N + 566; - Name_Cross_Reference : constant Name_Id := N + 567; - Name_Default_Switches : constant Name_Id := N + 568; - Name_Exec_Dir : constant Name_Id := N + 569; - Name_Executable : constant Name_Id := N + 570; - Name_Executable_Suffix : constant Name_Id := N + 571; - Name_Extends : constant Name_Id := N + 572; - Name_Finder : constant Name_Id := N + 573; - Name_Global_Configuration_Pragmas : constant Name_Id := N + 574; - Name_Gnatls : constant Name_Id := N + 575; - Name_Gnatstub : constant Name_Id := N + 576; - Name_Implementation : constant Name_Id := N + 577; - Name_Implementation_Exceptions : constant Name_Id := N + 578; - Name_Implementation_Suffix : constant Name_Id := N + 579; - Name_Languages : constant Name_Id := N + 580; - Name_Library_Dir : constant Name_Id := N + 581; - Name_Library_Auto_Init : constant Name_Id := N + 582; - Name_Library_GCC : constant Name_Id := N + 583; - Name_Library_Interface : constant Name_Id := N + 584; - Name_Library_Kind : constant Name_Id := N + 585; - Name_Library_Name : constant Name_Id := N + 586; - Name_Library_Options : constant Name_Id := N + 587; - Name_Library_Reference_Symbol_File : constant Name_Id := N + 588; - Name_Library_Src_Dir : constant Name_Id := N + 589; - Name_Library_Symbol_File : constant Name_Id := N + 590; - Name_Library_Symbol_Policy : constant Name_Id := N + 591; - Name_Library_Version : constant Name_Id := N + 592; - Name_Linker : constant Name_Id := N + 593; - Name_Local_Configuration_Pragmas : constant Name_Id := N + 594; - Name_Locally_Removed_Files : constant Name_Id := N + 595; - Name_Metrics : constant Name_Id := N + 596; - Name_Naming : constant Name_Id := N + 597; - Name_Object_Dir : constant Name_Id := N + 598; - Name_Pretty_Printer : constant Name_Id := N + 599; - Name_Project : constant Name_Id := N + 600; - Name_Separate_Suffix : constant Name_Id := N + 601; - Name_Source_Dirs : constant Name_Id := N + 602; - Name_Source_Files : constant Name_Id := N + 603; - Name_Source_List_File : constant Name_Id := N + 604; - Name_Spec : constant Name_Id := N + 605; - Name_Spec_Suffix : constant Name_Id := N + 606; - Name_Specification : constant Name_Id := N + 607; - Name_Specification_Exceptions : constant Name_Id := N + 608; - Name_Specification_Suffix : constant Name_Id := N + 609; - Name_Switches : constant Name_Id := N + 610; + Name_Binder : constant Name_Id := N + 564; + Name_Body_Suffix : constant Name_Id := N + 565; + Name_Builder : constant Name_Id := N + 566; + Name_Compiler : constant Name_Id := N + 567; + Name_Cross_Reference : constant Name_Id := N + 568; + Name_Default_Switches : constant Name_Id := N + 569; + Name_Exec_Dir : constant Name_Id := N + 570; + Name_Executable : constant Name_Id := N + 571; + Name_Executable_Suffix : constant Name_Id := N + 572; + Name_Extends : constant Name_Id := N + 573; + Name_Finder : constant Name_Id := N + 574; + Name_Global_Configuration_Pragmas : constant Name_Id := N + 575; + Name_Gnatls : constant Name_Id := N + 576; + Name_Gnatstub : constant Name_Id := N + 577; + Name_Implementation : constant Name_Id := N + 578; + Name_Implementation_Exceptions : constant Name_Id := N + 579; + Name_Implementation_Suffix : constant Name_Id := N + 580; + Name_Languages : constant Name_Id := N + 581; + Name_Library_Dir : constant Name_Id := N + 582; + Name_Library_Auto_Init : constant Name_Id := N + 583; + Name_Library_GCC : constant Name_Id := N + 584; + Name_Library_Interface : constant Name_Id := N + 585; + Name_Library_Kind : constant Name_Id := N + 586; + Name_Library_Name : constant Name_Id := N + 587; + Name_Library_Options : constant Name_Id := N + 588; + Name_Library_Reference_Symbol_File : constant Name_Id := N + 589; + Name_Library_Src_Dir : constant Name_Id := N + 590; + Name_Library_Symbol_File : constant Name_Id := N + 591; + Name_Library_Symbol_Policy : constant Name_Id := N + 592; + Name_Library_Version : constant Name_Id := N + 593; + Name_Linker : constant Name_Id := N + 594; + Name_Local_Configuration_Pragmas : constant Name_Id := N + 595; + Name_Locally_Removed_Files : constant Name_Id := N + 596; + Name_Metrics : constant Name_Id := N + 597; + Name_Naming : constant Name_Id := N + 598; + Name_Object_Dir : constant Name_Id := N + 599; + Name_Pretty_Printer : constant Name_Id := N + 600; + Name_Project : constant Name_Id := N + 601; + Name_Separate_Suffix : constant Name_Id := N + 602; + Name_Source_Dirs : constant Name_Id := N + 603; + Name_Source_Files : constant Name_Id := N + 604; + Name_Source_List_File : constant Name_Id := N + 605; + Name_Spec : constant Name_Id := N + 606; + Name_Spec_Suffix : constant Name_Id := N + 607; + Name_Specification : constant Name_Id := N + 608; + Name_Specification_Exceptions : constant Name_Id := N + 609; + Name_Specification_Suffix : constant Name_Id := N + 610; + Name_Switches : constant Name_Id := N + 611; -- Other miscellaneous names used in front end - Name_Unaligned_Valid : constant Name_Id := N + 611; + Name_Unaligned_Valid : constant Name_Id := N + 612; -- Mark last defined name for consistency check in Snames body - Last_Predefined_Name : constant Name_Id := N + 611; + Last_Predefined_Name : constant Name_Id := N + 612; subtype Any_Operator_Name is Name_Id range First_Operator_Name .. Last_Operator_Name; @@ -1197,6 +1198,7 @@ package Snames is Pragma_Persistent_Data, Pragma_Persistent_Object, Pragma_Profile, + Pragma_Profile_Warnings, Pragma_Propagate_Exceptions, Pragma_Queuing_Policy, Pragma_Ravenscar, diff --git a/gcc/ada/snames.h b/gcc/ada/snames.h index 38033da..29caf0e 100644 --- a/gcc/ada/snames.h +++ b/gcc/ada/snames.h @@ -223,128 +223,129 @@ extern unsigned char Get_Pragma_Id (int); #define Pragma_Persistent_Data 24 #define Pragma_Persistent_Object 25 #define Pragma_Profile 26 -#define Pragma_Propagate_Exceptions 27 -#define Pragma_Queuing_Policy 28 -#define Pragma_Ravenscar 29 -#define Pragma_Restricted_Run_Time 30 -#define Pragma_Restrictions 31 -#define Pragma_Restriction_Warnings 32 -#define Pragma_Reviewable 33 -#define Pragma_Source_File_Name 34 -#define Pragma_Source_File_Name_Project 35 -#define Pragma_Style_Checks 36 -#define Pragma_Suppress 37 -#define Pragma_Suppress_Exception_Locations 38 -#define Pragma_Task_Dispatching_Policy 39 -#define Pragma_Universal_Data 40 -#define Pragma_Unsuppress 41 -#define Pragma_Use_VADS_Size 42 -#define Pragma_Validity_Checks 43 -#define Pragma_Warnings 44 +#define Pragma_Profile_Warnings 27 +#define Pragma_Propagate_Exceptions 28 +#define Pragma_Queuing_Policy 29 +#define Pragma_Ravenscar 30 +#define Pragma_Restricted_Run_Time 31 +#define Pragma_Restrictions 32 +#define Pragma_Restriction_Warnings 33 +#define Pragma_Reviewable 34 +#define Pragma_Source_File_Name 35 +#define Pragma_Source_File_Name_Project 36 +#define Pragma_Style_Checks 37 +#define Pragma_Suppress 38 +#define Pragma_Suppress_Exception_Locations 39 +#define Pragma_Task_Dispatching_Policy 40 +#define Pragma_Universal_Data 41 +#define Pragma_Unsuppress 42 +#define Pragma_Use_VADS_Size 43 +#define Pragma_Validity_Checks 44 +#define Pragma_Warnings 45 /* Remaining pragmas */ -#define Pragma_Abort_Defer 45 -#define Pragma_All_Calls_Remote 46 -#define Pragma_Annotate 47 -#define Pragma_Assert 48 -#define Pragma_Asynchronous 49 -#define Pragma_Atomic 50 -#define Pragma_Atomic_Components 51 -#define Pragma_Attach_Handler 52 -#define Pragma_Comment 53 -#define Pragma_Common_Object 54 -#define Pragma_Complex_Representation 55 -#define Pragma_Controlled 56 -#define Pragma_Convention 57 -#define Pragma_CPP_Class 58 -#define Pragma_CPP_Constructor 59 -#define Pragma_CPP_Virtual 60 -#define Pragma_CPP_Vtable 61 -#define Pragma_Debug 62 -#define Pragma_Elaborate 63 -#define Pragma_Elaborate_All 64 -#define Pragma_Elaborate_Body 65 -#define Pragma_Export 66 -#define Pragma_Export_Exception 67 -#define Pragma_Export_Function 68 -#define Pragma_Export_Object 69 -#define Pragma_Export_Procedure 70 -#define Pragma_Export_Value 71 -#define Pragma_Export_Valued_Procedure 72 -#define Pragma_External 73 -#define Pragma_Finalize_Storage_Only 74 -#define Pragma_Ident 75 -#define Pragma_Import 76 -#define Pragma_Import_Exception 77 -#define Pragma_Import_Function 78 -#define Pragma_Import_Object 79 -#define Pragma_Import_Procedure 80 -#define Pragma_Import_Valued_Procedure 81 -#define Pragma_Inline 82 -#define Pragma_Inline_Always 83 -#define Pragma_Inline_Generic 84 -#define Pragma_Inspection_Point 85 -#define Pragma_Interface 86 -#define Pragma_Interface_Name 87 -#define Pragma_Interrupt_Handler 88 -#define Pragma_Interrupt_Priority 89 -#define Pragma_Java_Constructor 90 -#define Pragma_Java_Interface 91 -#define Pragma_Keep_Names 92 -#define Pragma_Link_With 93 -#define Pragma_Linker_Alias 94 -#define Pragma_Linker_Options 95 -#define Pragma_Linker_Section 96 -#define Pragma_List 97 -#define Pragma_Machine_Attribute 98 -#define Pragma_Main 99 -#define Pragma_Main_Storage 100 -#define Pragma_Memory_Size 101 -#define Pragma_No_Return 102 -#define Pragma_Obsolescent 103 -#define Pragma_Optimize 104 -#define Pragma_Optional_Overriding 105 -#define Pragma_Overriding 106 -#define Pragma_Pack 107 -#define Pragma_Page 108 -#define Pragma_Passive 109 -#define Pragma_Preelaborate 110 -#define Pragma_Priority 111 -#define Pragma_Psect_Object 112 -#define Pragma_Pure 113 -#define Pragma_Pure_Function 114 -#define Pragma_Remote_Call_Interface 115 -#define Pragma_Remote_Types 116 -#define Pragma_Share_Generic 117 -#define Pragma_Shared 118 -#define Pragma_Shared_Passive 119 -#define Pragma_Source_Reference 120 -#define Pragma_Stream_Convert 121 -#define Pragma_Subtitle 122 -#define Pragma_Suppress_All 123 -#define Pragma_Suppress_Debug_Info 124 -#define Pragma_Suppress_Initialization 125 -#define Pragma_System_Name 126 -#define Pragma_Task_Info 127 -#define Pragma_Task_Name 128 -#define Pragma_Task_Storage 129 -#define Pragma_Thread_Body 130 -#define Pragma_Time_Slice 131 -#define Pragma_Title 132 -#define Pragma_Unchecked_Union 133 -#define Pragma_Unimplemented_Unit 134 -#define Pragma_Unreferenced 135 -#define Pragma_Unreserve_All_Interrupts 136 -#define Pragma_Volatile 137 -#define Pragma_Volatile_Components 138 -#define Pragma_Weak_External 139 +#define Pragma_Abort_Defer 46 +#define Pragma_All_Calls_Remote 47 +#define Pragma_Annotate 48 +#define Pragma_Assert 49 +#define Pragma_Asynchronous 50 +#define Pragma_Atomic 51 +#define Pragma_Atomic_Components 52 +#define Pragma_Attach_Handler 53 +#define Pragma_Comment 54 +#define Pragma_Common_Object 55 +#define Pragma_Complex_Representation 56 +#define Pragma_Controlled 57 +#define Pragma_Convention 58 +#define Pragma_CPP_Class 59 +#define Pragma_CPP_Constructor 60 +#define Pragma_CPP_Virtual 61 +#define Pragma_CPP_Vtable 62 +#define Pragma_Debug 63 +#define Pragma_Elaborate 64 +#define Pragma_Elaborate_All 65 +#define Pragma_Elaborate_Body 66 +#define Pragma_Export 67 +#define Pragma_Export_Exception 68 +#define Pragma_Export_Function 69 +#define Pragma_Export_Object 70 +#define Pragma_Export_Procedure 71 +#define Pragma_Export_Value 72 +#define Pragma_Export_Valued_Procedure 73 +#define Pragma_External 74 +#define Pragma_Finalize_Storage_Only 75 +#define Pragma_Ident 76 +#define Pragma_Import 77 +#define Pragma_Import_Exception 78 +#define Pragma_Import_Function 79 +#define Pragma_Import_Object 80 +#define Pragma_Import_Procedure 81 +#define Pragma_Import_Valued_Procedure 82 +#define Pragma_Inline 83 +#define Pragma_Inline_Always 84 +#define Pragma_Inline_Generic 85 +#define Pragma_Inspection_Point 86 +#define Pragma_Interface 87 +#define Pragma_Interface_Name 88 +#define Pragma_Interrupt_Handler 89 +#define Pragma_Interrupt_Priority 90 +#define Pragma_Java_Constructor 91 +#define Pragma_Java_Interface 92 +#define Pragma_Keep_Names 93 +#define Pragma_Link_With 94 +#define Pragma_Linker_Alias 95 +#define Pragma_Linker_Options 96 +#define Pragma_Linker_Section 97 +#define Pragma_List 98 +#define Pragma_Machine_Attribute 99 +#define Pragma_Main 100 +#define Pragma_Main_Storage 101 +#define Pragma_Memory_Size 102 +#define Pragma_No_Return 103 +#define Pragma_Obsolescent 104 +#define Pragma_Optimize 105 +#define Pragma_Optional_Overriding 106 +#define Pragma_Overriding 107 +#define Pragma_Pack 108 +#define Pragma_Page 109 +#define Pragma_Passive 110 +#define Pragma_Preelaborate 111 +#define Pragma_Priority 112 +#define Pragma_Psect_Object 113 +#define Pragma_Pure 114 +#define Pragma_Pure_Function 115 +#define Pragma_Remote_Call_Interface 116 +#define Pragma_Remote_Types 117 +#define Pragma_Share_Generic 118 +#define Pragma_Shared 119 +#define Pragma_Shared_Passive 120 +#define Pragma_Source_Reference 121 +#define Pragma_Stream_Convert 122 +#define Pragma_Subtitle 123 +#define Pragma_Suppress_All 124 +#define Pragma_Suppress_Debug_Info 125 +#define Pragma_Suppress_Initialization 126 +#define Pragma_System_Name 127 +#define Pragma_Task_Info 128 +#define Pragma_Task_Name 129 +#define Pragma_Task_Storage 130 +#define Pragma_Thread_Body 131 +#define Pragma_Time_Slice 132 +#define Pragma_Title 133 +#define Pragma_Unchecked_Union 134 +#define Pragma_Unimplemented_Unit 135 +#define Pragma_Unreferenced 136 +#define Pragma_Unreserve_All_Interrupts 137 +#define Pragma_Volatile 138 +#define Pragma_Volatile_Components 139 +#define Pragma_Weak_External 140 /* The following are deliberately out of alphabetical order, see Snames */ -#define Pragma_AST_Entry 140 -#define Pragma_Storage_Size 141 -#define Pragma_Storage_Unit 142 +#define Pragma_AST_Entry 141 +#define Pragma_Storage_Size 142 +#define Pragma_Storage_Unit 143 /* Define the numeric values for the conventions. */ diff --git a/gcc/ada/symbols-vms-alpha.adb b/gcc/ada/symbols-vms-alpha.adb index 0f0c624..2151706 100644 --- a/gcc/ada/symbols-vms-alpha.adb +++ b/gcc/ada/symbols-vms-alpha.adb @@ -718,8 +718,7 @@ package body Symbols is Put (File, Case_Sensitive); Put_Line (File, "yes"); - -- Put a line in the symbol file for each symbol in the symbol - -- table. + -- Put a line in the symbol file for each symbol in symbol table for Index in 1 .. Symbol_Table.Last (Original_Symbols) loop if Original_Symbols.Table (Index).Present then diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb index 4896da3..6918d99 100644 --- a/gcc/ada/targparm.adb +++ b/gcc/ada/targparm.adb @@ -152,6 +152,33 @@ package body Targparm is HIM_Str'Access, LSI_Str'Access); + ----------------------- + -- Local Subprograms -- + ----------------------- + + procedure Set_Profile_Restrictions (P : Profile_Name); + -- Set Restrictions_On_Target for the given profile + + ------------------------------ + -- Set_Profile_Restrictions -- + ------------------------------ + + procedure Set_Profile_Restrictions (P : Profile_Name) is + R : Restriction_Flags renames Profile_Info (P).Set; + V : Restriction_Values renames Profile_Info (P).Value; + + begin + for J in R'Range loop + if R (J) then + Restrictions_On_Target.Set (J) := True; + + if J in All_Parameter_Restrictions then + Restrictions_On_Target.Value (J) := V (J); + end if; + end if; + end loop; + end Set_Profile_Restrictions; + --------------------------- -- Get_Target_Parameters -- --------------------------- @@ -215,6 +242,26 @@ package body Targparm is if System_Text (P) = '-' then goto Line_Loop_Continue; + -- Test for pragma Profile (Ravenscar); + + elsif System_Text (P .. P + 26) = + "pragma Profile (Ravenscar);" + then + Set_Profile_Restrictions (Ravenscar); + Opt.Task_Dispatching_Policy := 'F'; + Opt.Locking_Policy := 'C'; + P := P + 27; + goto Line_Loop_Continue; + + -- Test for pragma Profile (Restricted); + + elsif System_Text (P .. P + 27) = + "pragma Profile (Restricted);" + then + Set_Profile_Restrictions (Restricted); + P := P + 28; + goto Line_Loop_Continue; + -- Test for pragma Restrictions elsif System_Text (P .. P + 20) = "pragma Restrictions (" then diff --git a/gcc/ada/targparm.ads b/gcc/ada/targparm.ads index 01e8a15..48c1469 100644 --- a/gcc/ada/targparm.ads +++ b/gcc/ada/targparm.ads @@ -104,6 +104,9 @@ package Targparm is -- if a pragma Suppress_Exception_Locations appears, then the flag -- Opt.Exception_Locations_Suppressed is set to True. + -- If a pragma Profile with a valid profile argument appears, then + -- the appropriate restrictions and policy flags are set. + -- The only other pragma allowed is a pragma Restrictions that specifies -- a restriction that will be imposed on all units in the partition. Note -- that in this context, only one restriction can be specified in a single @@ -112,6 +115,8 @@ package Targparm is Restrictions_On_Target : Restrictions_Info; -- Records restrictions specified by system.ads. Only the Set and Value -- members are modified. The Violated and Count fields are never modified. + -- Note that entries can be set either by a pragma Restrictions or by + -- a pragma Profile. ------------------- -- Run Time Name -- |