diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2004-07-06 13:57:33 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2004-07-06 13:57:33 +0000 |
| commit | 5c99c290e017aced8ef378745fd0070ec80894af (patch) | |
| tree | 242c4d5505932ff31c97e368e02a5597dee1c5a9 /gcc | |
| parent | 6b122edbab8bb1030b2f9286dfdbdaa9a629707c (diff) | |
| download | gcc-5c99c290e017aced8ef378745fd0070ec80894af.tar.gz | |
2004-07-06 Vincent Celier <celier@gnat.com>
* vms_conv.ads: Minor reformatting.
Alphabetical order for enumerated values of type Command_Type, to have
the command in alphabetical order for the usage.
* vms_conv.adb (Process_Argument): Set Keep_Temporary_Files to True for
the special qualifier /KEEP_TEMPORARY_FILES (minimum 6 characters).
* gnat_ugn.texi: Document new switch -dn for the GNAT driver.
* makegpr.adb (Global_Archive_Exists): New global Boolean variable
(Add_Archive_Path): Only add the global archive if there is one.
(Build_Global_Archive): Set Global_Archive_Exists depending if there is
or not any object file to put in the global archive, and don't build
a global archive if there is none.
(X_Switches): New table
(Compile_Link_With_Gnatmake): Pass to gnatmake the -X switches stored
in the X_Switches table, if any.
(Initialize): Make sure the X_Switches table is empty
(Scan_Arg): Record -X switches in table X_Switches
* opt.ads (Keep_Temporary_Files): New Boolean flag, defaulted to False.
* make.adb: Minor comment fix
* gnatname.adb (Gnatname): When not on VMS, and gnatname has been
invoked with directory information, add the directory in front of the
path.
* gnatchop.adb (Gnatchop): When not on VMS, and gnatchop has been
invoked with directory information, add the directory in front of the
path.
* gnatcmd.adb (Delete_Temp_Config_Files): Only delete temporary files
when Keep_Temporary_Files is False.
(GNATCmd): When not on VMS, and the GNAT driver has been invoked with
directory information, add the directory in front of the path.
When not on VMS, handle new switch -dn before the command to set
Keep_Temporary_Files to True.
(Non_VMS_Usage): Use lower case for the non VMS usage: this is valid
everywhere.
* gnatlink.adb (Gnatlink): When not on VMS, and gnatlink has been
invoked with directory information, add the directory in front of the
path.
2004-07-06 Thomas Quinot <quinot@act-europe.fr>
* snames.ads, snames.adb (Name_Stub): New name for the distributed
systems annex.
* rtsfind.ads: New RTE TC_Object, for DSA/PolyORB.
New RTEs RAS_Proxy_Type and RAS_Proxy_Type_Access, for DSA.
* g-socket.adb (To_Timeval): Fix incorrect conversion of
Selector_Duration to Timeval for the case of 0.0.
* exp_util.ads (Evolve_Or_Else): Fix overenthusiastic copy/paste of
documentation from Evolve_And_Then.
2004-07-06 Jose Ruiz <ruiz@act-europe.fr>
* s-taprop-tru64.adb, s-taprop-os2.adb,
s-taprop-mingw.adb, s-taprop-posix.adb: Update comment.
2004-07-06 Robert Dewar <dewar@gnat.com>
* s-osinte-hpux.ads, s-osinte-freebsd.ads,
s-osinte-lynxos.ads, s-taprop-lynxos.adb, s-osinte-tru64.ads,
s-osinte-aix.ads, s-osinte-irix.ads, s-taprop-irix.adb,
s-interr-sigaction.adb, s-taprop-irix-athread.adb,
s-osinte-hpux-dce.adb, s-taprop-hpux-dce.adb,
s-taprop-linux.adb, s-taprop-dummy.adb, s-taprop-solaris.adb,
s-interr-vms.adb, s-osinte-vms.ads, s-taprop-vms.adb,
s-osinte-vxworks.ads, s-osprim-vxworks.adb, a-numaux-x86.adb,
a-except.adb, a-exexpr.adb, a-intsig.adb, a-tags.adb,
a-tags.ads, bindgen.ads, checks.adb, checks.adb,
csets.ads, einfo.ads, einfo.ads, elists.adb, exp_ch4.adb,
exp_ch7.adb, exp_dist.adb, exp_util.adb, freeze.adb,
g-dynhta.adb, gnatmem.adb, g-regexp.adb, inline.adb,
i-os2thr.ads, osint.adb, prj.adb, scng.adb, sem_cat.adb,
sem_ch10.adb, sem_ch12.adb, sem_ch4.adb, sem_ch7.adb,
sem_ch8.adb, sem_disp.adb, sem_prag.adb, sem_res.adb,
sem_type.adb, sem_type.ads, sem_warn.adb, s-ficobl.ads,
s-finimp.adb, s-htable.adb, sinfo.ads, sinput-l.ads,
s-interr.adb, s-interr.ads, sprint.adb, s-tarest.adb,
s-tasini.ads, s-taskin.ads, s-taskin.ads, uname.adb,
vms_data.ads: Minor reformatting,
Fix bad box comment format.
* gnat_rm.texi: Fix minor grammatical error
* sem_attr.adb, exp_attr.adb: New attribute Has_Access_Values
* sem_util.ads, sem_util.adb (Requires_Transient_Scope): Allow many
more cases of discriminated records to be recognized as not needing a
secondary stack.
(Has_Access_Values): New function.
* snames.h, snames.adb, snames.ads: New attribute Has_Access_Values
* cstand.adb, layout.ads, layout.adb, sem_ch13.ads: Change name
Set_Prim_Alignment to Set_Elem_Alignment (more accurate correspondence
with LRM terminology).
Change terminology in comments primitive type => elementary type.
2004-07-06 Ed Schonberg <schonberg@gnat.com>
PR ada/15602
* sem_ch7.adb (Unit_Requires_Body): For a generic package, the formal
parameters do not impose any requirements on the presence of a body.
2004-07-06 Ed Schonberg <schonberg@gnat.com>
PR ada/15593
* sem_ch12.adb (Analyze_Package_Instantiation): If the generic is not a
compilation unit and is in an open scope at the point of instantiation,
assume that a body may be present later.
2004-07-06 Ed Schonberg <schonberg@gnat.com>
* sem_ch13.adb (Analyze_Attribute_Definition_Clause, case 'Size):
Improve error message when specified size is not supported.
* sem_ch6.adb (Maybe_Primitive_Operation): A library-level subprogram
is never a primitive operation.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@84152 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
102 files changed, 2061 insertions, 1627 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ac4e70ab744..c2be151e536 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,131 @@ +2004-07-06 Vincent Celier <celier@gnat.com> + + * vms_conv.ads: Minor reformatting. + Alphabetical order for enumerated values of type Command_Type, to have + the command in alphabetical order for the usage. + + * vms_conv.adb (Process_Argument): Set Keep_Temporary_Files to True for + the special qualifier /KEEP_TEMPORARY_FILES (minimum 6 characters). + + * gnat_ugn.texi: Document new switch -dn for the GNAT driver. + + * makegpr.adb (Global_Archive_Exists): New global Boolean variable + (Add_Archive_Path): Only add the global archive if there is one. + (Build_Global_Archive): Set Global_Archive_Exists depending if there is + or not any object file to put in the global archive, and don't build + a global archive if there is none. + (X_Switches): New table + (Compile_Link_With_Gnatmake): Pass to gnatmake the -X switches stored + in the X_Switches table, if any. + (Initialize): Make sure the X_Switches table is empty + (Scan_Arg): Record -X switches in table X_Switches + + * opt.ads (Keep_Temporary_Files): New Boolean flag, defaulted to False. + + * make.adb: Minor comment fix + + * gnatname.adb (Gnatname): When not on VMS, and gnatname has been + invoked with directory information, add the directory in front of the + path. + + * gnatchop.adb (Gnatchop): When not on VMS, and gnatchop has been + invoked with directory information, add the directory in front of the + path. + + * gnatcmd.adb (Delete_Temp_Config_Files): Only delete temporary files + when Keep_Temporary_Files is False. + (GNATCmd): When not on VMS, and the GNAT driver has been invoked with + directory information, add the directory in front of the path. + When not on VMS, handle new switch -dn before the command to set + Keep_Temporary_Files to True. + (Non_VMS_Usage): Use lower case for the non VMS usage: this is valid + everywhere. + + * gnatlink.adb (Gnatlink): When not on VMS, and gnatlink has been + invoked with directory information, add the directory in front of the + path. + +2004-07-06 Thomas Quinot <quinot@act-europe.fr> + + * snames.ads, snames.adb (Name_Stub): New name for the distributed + systems annex. + + * rtsfind.ads: New RTE TC_Object, for DSA/PolyORB. + New RTEs RAS_Proxy_Type and RAS_Proxy_Type_Access, for DSA. + + * g-socket.adb (To_Timeval): Fix incorrect conversion of + Selector_Duration to Timeval for the case of 0.0. + + * exp_util.ads (Evolve_Or_Else): Fix overenthusiastic copy/paste of + documentation from Evolve_And_Then. + +2004-07-06 Jose Ruiz <ruiz@act-europe.fr> + + * s-taprop-tru64.adb, s-taprop-os2.adb, + s-taprop-mingw.adb, s-taprop-posix.adb: Update comment. + +2004-07-06 Robert Dewar <dewar@gnat.com> + + * s-osinte-hpux.ads, s-osinte-freebsd.ads, + s-osinte-lynxos.ads, s-taprop-lynxos.adb, s-osinte-tru64.ads, + s-osinte-aix.ads, s-osinte-irix.ads, s-taprop-irix.adb, + s-interr-sigaction.adb, s-taprop-irix-athread.adb, + s-osinte-hpux-dce.adb, s-taprop-hpux-dce.adb, + s-taprop-linux.adb, s-taprop-dummy.adb, s-taprop-solaris.adb, + s-interr-vms.adb, s-osinte-vms.ads, s-taprop-vms.adb, + s-osinte-vxworks.ads, s-osprim-vxworks.adb, a-numaux-x86.adb, + a-except.adb, a-exexpr.adb, a-intsig.adb, a-tags.adb, + a-tags.ads, bindgen.ads, checks.adb, checks.adb, + csets.ads, einfo.ads, einfo.ads, elists.adb, exp_ch4.adb, + exp_ch7.adb, exp_dist.adb, exp_util.adb, freeze.adb, + g-dynhta.adb, gnatmem.adb, g-regexp.adb, inline.adb, + i-os2thr.ads, osint.adb, prj.adb, scng.adb, sem_cat.adb, + sem_ch10.adb, sem_ch12.adb, sem_ch4.adb, sem_ch7.adb, + sem_ch8.adb, sem_disp.adb, sem_prag.adb, sem_res.adb, + sem_type.adb, sem_type.ads, sem_warn.adb, s-ficobl.ads, + s-finimp.adb, s-htable.adb, sinfo.ads, sinput-l.ads, + s-interr.adb, s-interr.ads, sprint.adb, s-tarest.adb, + s-tasini.ads, s-taskin.ads, s-taskin.ads, uname.adb, + vms_data.ads: Minor reformatting, + Fix bad box comment format. + + * gnat_rm.texi: Fix minor grammatical error + + * sem_attr.adb, exp_attr.adb: New attribute Has_Access_Values + + * sem_util.ads, sem_util.adb (Requires_Transient_Scope): Allow many + more cases of discriminated records to be recognized as not needing a + secondary stack. + (Has_Access_Values): New function. + + * snames.h, snames.adb, snames.ads: New attribute Has_Access_Values + + * cstand.adb, layout.ads, layout.adb, sem_ch13.ads: Change name + Set_Prim_Alignment to Set_Elem_Alignment (more accurate correspondence + with LRM terminology). + Change terminology in comments primitive type => elementary type. + +2004-07-06 Ed Schonberg <schonberg@gnat.com> + + PR ada/15602 + * sem_ch7.adb (Unit_Requires_Body): For a generic package, the formal + parameters do not impose any requirements on the presence of a body. + +2004-07-06 Ed Schonberg <schonberg@gnat.com> + + PR ada/15593 + * sem_ch12.adb (Analyze_Package_Instantiation): If the generic is not a + compilation unit and is in an open scope at the point of instantiation, + assume that a body may be present later. + +2004-07-06 Ed Schonberg <schonberg@gnat.com> + + * sem_ch13.adb (Analyze_Attribute_Definition_Clause, case 'Size): + Improve error message when specified size is not supported. + + * sem_ch6.adb (Maybe_Primitive_Operation): A library-level subprogram + is never a primitive operation. + 2004-07-05 Andreas Schwab <schwab@suse.de> * ada-tree.h (TYPE_LEFT_JUSTIFIED_MODULAR_P): Use diff --git a/gcc/ada/a-except.adb b/gcc/ada/a-except.adb index 477caa87558..6a0885f1cd4 100644 --- a/gcc/ada/a-except.adb +++ b/gcc/ada/a-except.adb @@ -122,9 +122,9 @@ package body Ada.Exceptions is package Exception_Data is - ---------------------------------- - -- Exception messages routines -- - ---------------------------------- + --------------------------------- + -- Exception messages routines -- + --------------------------------- procedure Set_Exception_C_Msg (Id : Exception_Id; diff --git a/gcc/ada/a-exexpr.adb b/gcc/ada/a-exexpr.adb index 41fb21d7f3c..675af7c749e 100644 --- a/gcc/ada/a-exexpr.adb +++ b/gcc/ada/a-exexpr.adb @@ -122,9 +122,9 @@ package body Exception_Propagation is -- maximally aligned (see unwind.h). See additional comments on the -- alignment below. - --------------------------------------------------------------- - -- GNAT specific entities to deal with the GCC eh circuitry -- - --------------------------------------------------------------- + -------------------------------------------------------------- + -- GNAT Specific Entities To Deal With The GCC EH Circuitry -- + -------------------------------------------------------------- -- A GNAT exception object to be dealt with by the personality routine -- called by the GCC unwinding runtime. diff --git a/gcc/ada/a-intsig.adb b/gcc/ada/a-intsig.adb index 44e658a4328..781290e18e7 100644 --- a/gcc/ada/a-intsig.adb +++ b/gcc/ada/a-intsig.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2004 Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -34,9 +34,9 @@ with System.Interrupt_Management.Operations; package body Ada.Interrupts.Signal is - ------------------------- - -- Generate_Interrupt -- - ------------------------- + ------------------------ + -- Generate_Interrupt -- + ------------------------ procedure Generate_Interrupt (Interrupt : Interrupt_ID) is begin diff --git a/gcc/ada/a-numaux-x86.adb b/gcc/ada/a-numaux-x86.adb index b11867036f2..47231a89444 100644 --- a/gcc/ada/a-numaux-x86.adb +++ b/gcc/ada/a-numaux-x86.adb @@ -62,9 +62,9 @@ package body Ada.Numerics.Aux is pragma Inline (Is_Nan); pragma Inline (Reduce); - --------------------------------- - -- Basic Elementary Functions -- - --------------------------------- + -------------------------------- + -- Basic Elementary Functions -- + -------------------------------- -- This section implements a few elementary functions that are used to -- build the more complex ones. This ordering enables better inlining. diff --git a/gcc/ada/a-tags.adb b/gcc/ada/a-tags.adb index c232695ce75..dddf1bb8835 100644 --- a/gcc/ada/a-tags.adb +++ b/gcc/ada/a-tags.adb @@ -221,9 +221,9 @@ package body Ada.Tags is end HTable_Subprograms; - -------------------- - -- CW_Membership -- - -------------------- + ------------------- + -- CW_Membership -- + ------------------- -- Canonical implementation of Classwide Membership corresponding to: diff --git a/gcc/ada/a-tags.ads b/gcc/ada/a-tags.ads index 6e6adbfa4e1..d6875705b9e 100644 --- a/gcc/ada/a-tags.ads +++ b/gcc/ada/a-tags.ads @@ -55,9 +55,9 @@ package Ada.Tags is private - ---------------------------------------------------------------- - -- Abstract procedural interface for the GNAT dispatch table -- - ---------------------------------------------------------------- + --------------------------------------------------------------- + -- Abstract Procedural Interface For The GNAT Dispatch Table -- + --------------------------------------------------------------- -- GNAT's Dispatch Table format is customizable in order to match the -- format used in another langauge. GNAT supports programs that use diff --git a/gcc/ada/bindgen.ads b/gcc/ada/bindgen.ads index 846f98620d9..60d53db76d9 100644 --- a/gcc/ada/bindgen.ads +++ b/gcc/ada/bindgen.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992,1993,1994,1995,1996 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -35,10 +35,6 @@ package Bindgen is - ------------------ - -- Subprograms -- - ------------------ - procedure Gen_Output_File (Filename : String); -- Filename is the full path name of the binder output file diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 122a94c520f..82e286fbc6c 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -909,7 +909,7 @@ package body Checks is if Static and then Siz >= Check_Siz then Insert_Action (N, Make_Raise_Storage_Error (Loc, - Reason => SE_Object_Too_Large)); + Reason => SE_Object_Too_Large)); Error_Msg_N ("?Storage_Error will be raised at run-time", N); Uintp.Release (Umark); return; @@ -4070,9 +4070,9 @@ package body Checks is Reason => CE_Discriminant_Check_Failed)); end Generate_Discriminant_Check; - ---------------------------- - -- Generate_Index_Checks -- - ---------------------------- + --------------------------- + -- Generate_Index_Checks -- + --------------------------- procedure Generate_Index_Checks (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); diff --git a/gcc/ada/csets.ads b/gcc/ada/csets.ads index cccf32426d6..06dd0130a4a 100644 --- a/gcc/ada/csets.ads +++ b/gcc/ada/csets.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2002 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -51,9 +51,9 @@ pragma Elaborate_Body (Csets); -- do NOT pack this table, since we don't want the extra overhead of -- accessing a packed bit string. - ----------------------------------------------- - -- Character Tables For Current Compilation -- - ----------------------------------------------- + ---------------------------------------------- + -- Character Tables For Current Compilation -- + ---------------------------------------------- procedure Initialize; -- Routine to initialize following character tables, whose content depends diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index 3782c75bcca..191e223d38d 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -145,7 +145,7 @@ package body CStand is Set_Ekind (E, E_Floating_Point_Type); Set_Etype (E, E); Init_Size (E, Siz); - Set_Prim_Alignment (E); + Set_Elem_Alignment (E); Init_Digits_Value (E, Digs); Set_Float_Bounds (E); Set_Is_Frozen (E); @@ -171,7 +171,7 @@ package body CStand is Set_Ekind (E, E_Signed_Integer_Type); Set_Etype (E, E); Init_Size (E, Siz); - Set_Prim_Alignment (E); + Set_Elem_Alignment (E); Set_Integer_Bounds (E, E, Lbound, Ubound); Set_Is_Frozen (E); Set_Is_Public (E); @@ -358,7 +358,7 @@ package body CStand is Set_Etype (Standard_Boolean, Standard_Boolean); Init_Esize (Standard_Boolean, Standard_Character_Size); Init_RM_Size (Standard_Boolean, 1); - Set_Prim_Alignment (Standard_Boolean); + Set_Elem_Alignment (Standard_Boolean); Set_Is_Unsigned_Type (Standard_Boolean); Set_Size_Known_At_Compile_Time (Standard_Boolean); @@ -480,7 +480,7 @@ package body CStand is Set_Etype (Standard_Character, Standard_Character); Init_Esize (Standard_Character, Standard_Character_Size); Init_RM_Size (Standard_Character, 8); - Set_Prim_Alignment (Standard_Character); + Set_Elem_Alignment (Standard_Character); Set_Is_Unsigned_Type (Standard_Character); Set_Is_Character_Type (Standard_Character); @@ -526,7 +526,7 @@ package body CStand is Set_Etype (Standard_Wide_Character, Standard_Wide_Character); Init_Size (Standard_Wide_Character, Standard_Wide_Character_Size); - Set_Prim_Alignment (Standard_Wide_Character); + Set_Elem_Alignment (Standard_Wide_Character); Set_Is_Unsigned_Type (Standard_Wide_Character); Set_Is_Character_Type (Standard_Wide_Character); Set_Is_Known_Valid (Standard_Wide_Character); @@ -636,7 +636,7 @@ package body CStand is Set_Etype (Standard_Natural, Base_Type (Standard_Integer)); Init_Esize (Standard_Natural, Standard_Integer_Size); Init_RM_Size (Standard_Natural, Standard_Integer_Size - 1); - Set_Prim_Alignment (Standard_Natural); + Set_Elem_Alignment (Standard_Natural); Set_Size_Known_At_Compile_Time (Standard_Natural); Set_Integer_Bounds (Standard_Natural, @@ -659,7 +659,7 @@ package body CStand is Set_Etype (Standard_Positive, Base_Type (Standard_Integer)); Init_Esize (Standard_Positive, Standard_Integer_Size); Init_RM_Size (Standard_Positive, Standard_Integer_Size - 1); - Set_Prim_Alignment (Standard_Positive); + Set_Elem_Alignment (Standard_Positive); Set_Size_Known_At_Compile_Time (Standard_Positive); @@ -777,7 +777,7 @@ package body CStand is Set_Scope (Standard_A_Char, Standard_Standard); Set_Etype (Standard_A_Char, Standard_A_String); Init_Size (Standard_A_Char, System_Address_Size); - Set_Prim_Alignment (Standard_A_Char); + Set_Elem_Alignment (Standard_A_Char); Set_Directly_Designated_Type (Standard_A_Char, Standard_Character); Make_Name (Standard_A_Char, "access_character"); @@ -811,7 +811,7 @@ package body CStand is Set_Scope (Any_Access, Standard_Standard); Set_Etype (Any_Access, Any_Access); Init_Size (Any_Access, System_Address_Size); - Set_Prim_Alignment (Any_Access); + Set_Elem_Alignment (Any_Access); Make_Name (Any_Access, "an access type"); Any_Character := New_Standard_Entity; @@ -822,7 +822,7 @@ package body CStand is Set_Is_Character_Type (Any_Character); Init_Esize (Any_Character, Standard_Character_Size); Init_RM_Size (Any_Character, 8); - Set_Prim_Alignment (Any_Character); + Set_Elem_Alignment (Any_Character); Set_Scalar_Range (Any_Character, Scalar_Range (Standard_Character)); Make_Name (Any_Character, "a character type"); @@ -840,7 +840,7 @@ package body CStand is Set_Etype (Any_Boolean, Standard_Boolean); Init_Esize (Any_Boolean, Standard_Character_Size); Init_RM_Size (Any_Boolean, 1); - Set_Prim_Alignment (Any_Boolean); + Set_Elem_Alignment (Any_Boolean); Set_Is_Unsigned_Type (Any_Boolean); Set_Scalar_Range (Any_Boolean, Scalar_Range (Standard_Boolean)); Make_Name (Any_Boolean, "a boolean type"); @@ -859,7 +859,7 @@ package body CStand is Set_Scope (Any_Discrete, Standard_Standard); Set_Etype (Any_Discrete, Any_Discrete); Init_Size (Any_Discrete, Standard_Integer_Size); - Set_Prim_Alignment (Any_Discrete); + Set_Elem_Alignment (Any_Discrete); Make_Name (Any_Discrete, "a discrete type"); Any_Fixed := New_Standard_Entity; @@ -867,7 +867,7 @@ package body CStand is Set_Scope (Any_Fixed, Standard_Standard); Set_Etype (Any_Fixed, Any_Fixed); Init_Size (Any_Fixed, Standard_Integer_Size); - Set_Prim_Alignment (Any_Fixed); + Set_Elem_Alignment (Any_Fixed); Make_Name (Any_Fixed, "a fixed-point type"); Any_Integer := New_Standard_Entity; @@ -875,7 +875,7 @@ package body CStand is Set_Scope (Any_Integer, Standard_Standard); Set_Etype (Any_Integer, Standard_Long_Long_Integer); Init_Size (Any_Integer, Standard_Long_Long_Integer_Size); - Set_Prim_Alignment (Any_Integer); + Set_Elem_Alignment (Any_Integer); Set_Integer_Bounds (Any_Integer, @@ -889,7 +889,7 @@ package body CStand is Set_Scope (Any_Modular, Standard_Standard); Set_Etype (Any_Modular, Standard_Long_Long_Integer); Init_Size (Any_Modular, Standard_Long_Long_Integer_Size); - Set_Prim_Alignment (Any_Modular); + Set_Elem_Alignment (Any_Modular); Set_Is_Unsigned_Type (Any_Modular); Make_Name (Any_Modular, "a modular type"); @@ -898,7 +898,7 @@ package body CStand is Set_Scope (Any_Numeric, Standard_Standard); Set_Etype (Any_Numeric, Standard_Long_Long_Integer); Init_Size (Any_Numeric, Standard_Long_Long_Integer_Size); - Set_Prim_Alignment (Any_Numeric); + Set_Elem_Alignment (Any_Numeric); Make_Name (Any_Numeric, "a numeric type"); Any_Real := New_Standard_Entity; @@ -906,7 +906,7 @@ package body CStand is Set_Scope (Any_Real, Standard_Standard); Set_Etype (Any_Real, Standard_Long_Long_Float); Init_Size (Any_Real, Standard_Long_Long_Float_Size); - Set_Prim_Alignment (Any_Real); + Set_Elem_Alignment (Any_Real); Make_Name (Any_Real, "a real type"); Any_Scalar := New_Standard_Entity; @@ -914,7 +914,7 @@ package body CStand is Set_Scope (Any_Scalar, Standard_Standard); Set_Etype (Any_Scalar, Any_Scalar); Init_Size (Any_Scalar, Standard_Integer_Size); - Set_Prim_Alignment (Any_Scalar); + Set_Elem_Alignment (Any_Scalar); Make_Name (Any_Scalar, "a scalar type"); Any_String := New_Standard_Entity; @@ -974,7 +974,7 @@ package body CStand is Set_Scope (Standard_Unsigned, Standard_Standard); Set_Etype (Standard_Unsigned, Standard_Unsigned); Init_Size (Standard_Unsigned, Standard_Integer_Size); - Set_Prim_Alignment (Standard_Unsigned); + Set_Elem_Alignment (Standard_Unsigned); Set_Modulus (Standard_Unsigned, Uint_2 ** Standard_Integer_Size); Set_Is_Unsigned_Type (Standard_Unsigned); @@ -1023,7 +1023,7 @@ package body CStand is Set_Etype (Universal_Fixed, Universal_Fixed); Set_Scope (Universal_Fixed, Standard_Standard); Init_Size (Universal_Fixed, Standard_Long_Long_Integer_Size); - Set_Prim_Alignment (Universal_Fixed); + Set_Elem_Alignment (Universal_Fixed); Set_Size_Known_At_Compile_Time (Universal_Fixed); @@ -1073,7 +1073,7 @@ package body CStand is Init_Size (Standard_Duration, 64); end if; - Set_Prim_Alignment (Standard_Duration); + Set_Elem_Alignment (Standard_Duration); Set_Delta_Value (Standard_Duration, Delta_Val); Set_Small_Value (Standard_Duration, Delta_Val); Set_Scalar_Range (Standard_Duration, diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index ca5d69d7d40..289bdabb89f 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2922,7 +2922,7 @@ package Einfo is -- is needed, since returns an invalid value in this case! -- Sec_Stack_Needed_For_Return (Flag167) --- Present in scope entities (blocks,functions, procedures, tasks, +-- Present in scope entities (blocks, functions, procedures, tasks, -- entries). Set to True when secondary stack is used to hold -- the returned value of a function and thus should not be -- released on scope exit. @@ -4967,9 +4967,9 @@ package Einfo is subtype L is Elist_Id; subtype S is List_Id; - --------------------------------- - -- Attribute Access Functions -- - --------------------------------- + -------------------------------- + -- Attribute Access Functions -- + -------------------------------- -- All attributes are manipulated through a procedural interface. This -- section contains the functions used to obtain attribute values which diff --git a/gcc/ada/elists.adb b/gcc/ada/elists.adb index 6d1b8ca4b29..9051b43b727 100644 --- a/gcc/ada/elists.adb +++ b/gcc/ada/elists.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2001 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -79,9 +79,9 @@ package body Elists is -- is the last item in the list. The Node field points to the node which -- is referenced by the corresponding list entry. - -------------------------- - -- Element List Tables -- - -------------------------- + ------------------------- + -- Element List Tables -- + ------------------------- type Elist_Header is record First : Elmt_Id; diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 7b500d5276b..defbdd05526 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -4035,6 +4035,7 @@ package body Exp_Attr is Attribute_Digits | Attribute_Emax | Attribute_Epsilon | + Attribute_Has_Access_Values | Attribute_Has_Discriminants | Attribute_Large | Attribute_Machine_Emax | diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index e0d5f7cb585..a9d26bda986 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -66,9 +66,9 @@ with Validsw; use Validsw; package body Exp_Ch4 is - ------------------------ - -- Local Subprograms -- - ------------------------ + ----------------------- + -- Local Subprograms -- + ----------------------- procedure Binary_Op_Validity_Checks (N : Node_Id); pragma Inline (Binary_Op_Validity_Checks); diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 426658564e2..a6567aa4cda 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -130,8 +130,7 @@ package body Exp_Ch7 is Is_Master : Boolean; Is_Protected_Subprogram : Boolean; Is_Task_Allocation_Block : Boolean; - Is_Asynchronous_Call_Block : Boolean) - return Node_Id; + Is_Asynchronous_Call_Block : Boolean) return Node_Id; -- Expand a the clean-up procedure for controlled and/or transient -- block, and/or task master or task body, or blocks used to -- implement task allocation or asynchronous entry calls, or @@ -153,8 +152,7 @@ package body Exp_Ch7 is function Make_Transient_Block (Loc : Source_Ptr; - Action : Node_Id) - return Node_Id; + Action : Node_Id) return Node_Id; -- Create a transient block whose name is Scope, which is also a -- controlled block if Flist is not empty and whose only code is -- Action (either a single statement or single declaration). @@ -184,8 +182,7 @@ package body Exp_Ch7 is function Make_Deep_Proc (Prim : Final_Primitives; Typ : Entity_Id; - Stmts : List_Id) - return Node_Id; + Stmts : List_Id) return Node_Id; -- This function generates the tree for Deep_Initialize, Deep_Adjust -- or Deep_Finalize procedures according to the first parameter, -- these procedures operate on the type Typ. The Stmts parameter @@ -193,8 +190,7 @@ package body Exp_Ch7 is function Make_Deep_Array_Body (Prim : Final_Primitives; - Typ : Entity_Id) - return List_Id; + Typ : Entity_Id) return List_Id; -- This function generates the list of statements for implementing -- Deep_Initialize, Deep_Adjust or Deep_Finalize procedures -- according to the first parameter, these procedures operate on the @@ -202,8 +198,7 @@ package body Exp_Ch7 is function Make_Deep_Record_Body (Prim : Final_Primitives; - Typ : Entity_Id) - return List_Id; + Typ : Entity_Id) return List_Id; -- This function generates the list of statements for implementing -- Deep_Initialize, Deep_Adjust or Deep_Finalize procedures -- according to the first parameter, these procedures operate on the @@ -230,8 +225,7 @@ package body Exp_Ch7 is function Convert_View (Proc : Entity_Id; Arg : Node_Id; - Ind : Pos := 1) - return Node_Id; + Ind : Pos := 1) return Node_Id; -- Proc is one of the Initialize/Adjust/Finalize operations, and -- Arg is the argument being passed to it. Ind indicates which -- formal of procedure Proc we are trying to match. This function @@ -503,8 +497,7 @@ package body Exp_Ch7 is function Cleanup_Array (N : Node_Id; Obj : Node_Id; - Typ : Entity_Id) - return List_Id + Typ : Entity_Id) return List_Id is Loc : constant Source_Ptr := Sloc (N); Index_List : constant List_Id := New_List; @@ -601,8 +594,7 @@ package body Exp_Ch7 is function Cleanup_Record (N : Node_Id; Obj : Node_Id; - Typ : Entity_Id) - return List_Id + Typ : Entity_Id) return List_Id is Loc : constant Source_Ptr := Sloc (N); Tsk : Node_Id; @@ -671,14 +663,13 @@ package body Exp_Ch7 is return Stmts; end Cleanup_Record; - ------------------------------- - -- Cleanup_Protected_Object -- - ------------------------------- + ------------------------------ + -- Cleanup_Protected_Object -- + ------------------------------ function Cleanup_Protected_Object - (N : Node_Id; - Ref : Node_Id) - return Node_Id + (N : Node_Id; + Ref : Node_Id) return Node_Id is Loc : constant Source_Ptr := Sloc (N); @@ -747,9 +738,8 @@ package body Exp_Ch7 is ------------------ function Cleanup_Task - (N : Node_Id; - Ref : Node_Id) - return Node_Id + (N : Node_Id; + Ref : Node_Id) return Node_Id is Loc : constant Source_Ptr := Sloc (N); begin @@ -852,12 +842,12 @@ package body Exp_Ch7 is -- If type is not frozen yet, check explicitly among its components, -- because flag is not necessarily set. - ------------------------------------ - -- Has_Some_Controlled_Component -- - ------------------------------------ + ----------------------------------- + -- Has_Some_Controlled_Component -- + ----------------------------------- - function Has_Some_Controlled_Component (Rec : Entity_Id) - return Boolean + function Has_Some_Controlled_Component + (Rec : Entity_Id) return Boolean is Comp : Entity_Id; @@ -966,8 +956,7 @@ package body Exp_Ch7 is function Convert_View (Proc : Entity_Id; Arg : Node_Id; - Ind : Pos := 1) - return Node_Id + Ind : Pos := 1) return Node_Id is Fent : Entity_Id := First_Entity (Proc); Ftyp : Entity_Id; @@ -1424,9 +1413,8 @@ package body Exp_Ch7 is Len_Ref : Node_Id := Empty; function Last_Array_Component - (Ref : Node_Id; - Typ : Entity_Id) - return Node_Id; + (Ref : Node_Id; + Typ : Entity_Id) return Node_Id; -- Creates a reference to the last component of the array object -- designated by Ref whose type is Typ. @@ -1435,9 +1423,8 @@ package body Exp_Ch7 is -------------------------- function Last_Array_Component - (Ref : Node_Id; - Typ : Entity_Id) - return Node_Id + (Ref : Node_Id; + Typ : Entity_Id) return Node_Id is Index_List : constant List_Id := New_List; @@ -1685,9 +1672,8 @@ package body Exp_Ch7 is --------------------- function Find_Final_List - (E : Entity_Id; - Ref : Node_Id := Empty) - return Node_Id + (E : Entity_Id; + Ref : Node_Id := Empty) return Node_Id is Loc : constant Source_Ptr := Sloc (Ref); S : Entity_Id; @@ -2020,8 +2006,7 @@ package body Exp_Ch7 is (Ref : Node_Id; Typ : Entity_Id; Flist_Ref : Node_Id; - With_Attach : Node_Id) - return List_Id + With_Attach : Node_Id) return List_Id is Loc : constant Source_Ptr := Sloc (Ref); Res : constant List_Id := New_List; @@ -2131,10 +2116,9 @@ package body Exp_Ch7 is -- System.FI.Attach_To_Final_List (Flist, Ref, Nb_Link) function Make_Attach_Call - (Obj_Ref : Node_Id; - Flist_Ref : Node_Id; - With_Attach : Node_Id) - return Node_Id + (Obj_Ref : Node_Id; + Flist_Ref : Node_Id; + With_Attach : Node_Id) return Node_Id is Loc : constant Source_Ptr := Sloc (Obj_Ref); @@ -2170,8 +2154,7 @@ package body Exp_Ch7 is Is_Master : Boolean; Is_Protected_Subprogram : Boolean; Is_Task_Allocation_Block : Boolean; - Is_Asynchronous_Call_Block : Boolean) - return Node_Id + Is_Asynchronous_Call_Block : Boolean) return Node_Id is Loc : constant Source_Ptr := Sloc (Clean); Stmt : constant List_Id := New_List; @@ -2477,8 +2460,7 @@ package body Exp_Ch7 is function Make_Deep_Array_Body (Prim : Final_Primitives; - Typ : Entity_Id) - return List_Id + Typ : Entity_Id) return List_Id is Loc : constant Source_Ptr := Sloc (Typ); @@ -2588,8 +2570,7 @@ package body Exp_Ch7 is function Make_Deep_Proc (Prim : Final_Primitives; Typ : Entity_Id; - Stmts : List_Id) - return Entity_Id + Stmts : List_Id) return Entity_Id is Loc : constant Source_Ptr := Sloc (Typ); Formals : List_Id; @@ -2664,8 +2645,7 @@ package body Exp_Ch7 is function Make_Deep_Record_Body (Prim : Final_Primitives; - Typ : Entity_Id) - return List_Id + Typ : Entity_Id) return List_Id is Loc : constant Source_Ptr := Sloc (Typ); Controller_Typ : Entity_Id; @@ -2767,8 +2747,7 @@ package body Exp_Ch7 is function Make_Final_Call (Ref : Node_Id; Typ : Entity_Id; - With_Detach : Node_Id) - return List_Id + With_Detach : Node_Id) return List_Id is Loc : constant Source_Ptr := Sloc (Ref); Res : constant List_Id := New_List; @@ -2893,8 +2872,7 @@ package body Exp_Ch7 is (Ref : Node_Id; Typ : Entity_Id; Flist_Ref : Node_Id; - With_Attach : Node_Id) - return List_Id + With_Attach : Node_Id) return List_Id is Loc : constant Source_Ptr := Sloc (Ref); Is_Conc : Boolean; @@ -3012,8 +2990,7 @@ package body Exp_Ch7 is function Make_Transient_Block (Loc : Source_Ptr; - Action : Node_Id) - return Node_Id + Action : Node_Id) return Node_Id is Flist : constant Entity_Id := Finalization_Chain_Entity (Current_Scope); Decls : constant List_Id := New_List; diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index dd8b095822a..e3c176ad178 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -538,14 +538,14 @@ package body Exp_Dist is end if; end Add_RACW_Features; - ------------------------------------------------- - -- Add_RACW_Primitive_Declarations_And_Bodies -- - ------------------------------------------------- + ------------------------------------------------ + -- Add_RACW_Primitive_Declarations_And_Bodies -- + ------------------------------------------------ procedure Add_RACW_Primitive_Declarations_And_Bodies - (Designated_Type : in Entity_Id; - Insertion_Node : in Node_Id; - Decls : in List_Id) + (Designated_Type : Entity_Id; + Insertion_Node : Node_Id; + Decls : List_Id) is -- Set sloc of generated declaration to be that of the -- insertion node, so the declarations are recognized as diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 9e1a7ec1c5f..9d1c78bbe1e 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -327,9 +327,9 @@ package body Exp_Util is end if; end Build_Runtime_Call; - ----------------------------- - -- Build_Task_Array_Image -- - ----------------------------- + ---------------------------- + -- Build_Task_Array_Image -- + ---------------------------- -- This function generates the body for a function that constructs the -- image string for a task that is an array component. The function is diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 2382207831b..02c6011113d 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -320,7 +320,7 @@ package Exp_Util is -- Empty, then simply returns Cond1 (this allows the use of Empty to -- initialize a series of checks evolved by this routine, with a final -- result of Empty indicating that no checks were required). The Sloc - -- field of the constructed N_And_Then node is copied from Cond1. + -- field of the constructed N_Or_Else node is copied from Cond1. procedure Expand_Subtype_From_Expr (N : Node_Id; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 6e2d1267637..2438d3fbc53 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -4398,9 +4398,9 @@ package body Freeze is end if; end Freeze_Subprogram; - ----------------------- - -- Is_Fully_Defined -- - ----------------------- + ---------------------- + -- Is_Fully_Defined -- + ---------------------- function Is_Fully_Defined (T : Entity_Id) return Boolean is begin diff --git a/gcc/ada/g-dynhta.adb b/gcc/ada/g-dynhta.adb index 154d20516c4..5e95a9a56aa 100644 --- a/gcc/ada/g-dynhta.adb +++ b/gcc/ada/g-dynhta.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2003 Ada Core Technologies, Inc. -- +-- Copyright (C) 2002-2004 Ada Core Technologies, 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- -- @@ -34,9 +34,9 @@ with Ada.Unchecked_Deallocation; package body GNAT.Dynamic_HTables is - -------------------- - -- Static_HTable -- - -------------------- + ------------------- + -- Static_HTable -- + ------------------- package body Static_HTable is @@ -207,9 +207,9 @@ package body GNAT.Dynamic_HTables is end Set; end Static_HTable; - -------------------- - -- Simple_HTable -- - -------------------- + ------------------- + -- Simple_HTable -- + ------------------- package body Simple_HTable is diff --git a/gcc/ada/g-regexp.adb b/gcc/ada/g-regexp.adb index ab63d731c49..0fed7690c5f 100644 --- a/gcc/ada/g-regexp.adb +++ b/gcc/ada/g-regexp.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2002 Ada Core Technologies, Inc. -- +-- Copyright (C) 1999-2004 Ada Core Technologies, 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- -- @@ -191,9 +191,9 @@ package body GNAT.Regexp is procedure Add_In_Map (C : Character); -- Add a character in the mapping, if it is not already defined - ----------------- - -- Add_In_Map -- - ----------------- + ---------------- + -- Add_In_Map -- + ---------------- procedure Add_In_Map (C : Character) is begin @@ -419,7 +419,7 @@ package body GNAT.Regexp is -- end-state) : -- -- regexp state_num | a b * empty_string - -- ------- --------------------------------------- + -- ------- ------------------------------ -- a 1 (s) | 2 - - - -- 2 (e) | - - - - -- diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index bea61efccc4..75a1c300fef 100644 --- a/gcc/ada/g-socket.adb +++ b/gcc/ada/g-socket.adb @@ -2130,8 +2130,18 @@ package body GNAT.Sockets is MS : Timeval_Unit; begin - S := Timeval_Unit (Val - 0.5); - MS := Timeval_Unit (1_000_000 * (Val - Selector_Duration (S))); + -- If zero, set result as zero (otherwise it gets rounded down to -1) + + if Val = 0.0 then + S := 0; + MS := 0; + + -- Normal case where we do round down + else + S := Timeval_Unit (Val - 0.5); + MS := Timeval_Unit (1_000_000 * (Val - Selector_Duration (S))); + end if; + return (S, MS); end To_Timeval; diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 575e85ef602..b47abe1e75e 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -8390,7 +8390,7 @@ Similarly, the size of type @code{Rec} is 40 bits (@code{Rec'Size} = @code{Rec'Value_Size} = 40), but the alignment is 4, so objects of this type will have their size increased to 64 bits so that it is a multiple -of the alignment (in bits). The reason for this decision, which is +of the alignment (in bits). This decision is in accordance with the specific Implementation Advice in RM 13.3(43): @quotation diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 4567533b6ae..8c358847036 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -13234,8 +13234,21 @@ XREF to invoke @command{^gnatxref^gnatxref^} @end itemize @noindent -Note that the compiler is invoked using the command -@command{^gnatmake -f -u -c^gnatmake -f -u -c^}. +(note that the compiler is invoked using the command +@command{^gnatmake -f -u -c^gnatmake -f -u -c^}). + +@noindent +On non VMS platforms, between @command{gnat} and the command, two +special switches may be used: + +@itemize @bullet +@item +@command{-v} to display the invocation of the tool. +@item +@command{-dn} to prevent the @command{gnat} driver from removing +the temporary files it has created. These temporary files are +configuration files and temporary file list files. +@end itemize @noindent The command may be followed by switches and arguments for the invoked diff --git a/gcc/ada/gnatchop.adb b/gcc/ada/gnatchop.adb index 509a6f3b237..29bb2e9225f 100644 --- a/gcc/ada/gnatchop.adb +++ b/gcc/ada/gnatchop.adb @@ -1672,6 +1672,38 @@ procedure Gnatchop is -- Start of processing for gnatchop begin + -- Add the directory where gnatchop is invoked in front of the + -- path, if gnatchop is invoked with directory information. + -- Only do this if the platform is not VMS, where the notion of path + -- does not really exist. + + if not Hostparm.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)); + + PATH : constant String := + Absolute_Dir & + Path_Separator & + Getenv ("PATH").all; + + begin + Setenv ("PATH", PATH); + end; + + exit; + end if; + end loop; + end; + end if; + -- Process command line options and initialize global variables if not Scan_Arguments then diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 3a0e5e4a7f1..fe29ca4e578 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -30,7 +30,7 @@ with Csets; with MLib.Tgt; use MLib.Tgt; with MLib.Utl; with Namet; use Namet; -with Opt; +with Opt; use Opt; with Osint; use Osint; with Output; with Prj; use Prj; @@ -470,29 +470,32 @@ procedure GNATCmd is Success : Boolean; begin - if Project /= No_Project then - for Prj in 1 .. Projects.Last loop - if Projects.Table (Prj).Config_File_Temp then - if Opt.Verbose_Mode then - Output.Write_Str ("Deleting temp configuration file """); - Output.Write_Str (Get_Name_String - (Projects.Table (Prj).Config_File_Name)); - Output.Write_Line (""""); - end if; + if not Keep_Temporary_Files then + if Project /= No_Project then + for Prj in 1 .. Projects.Last loop + if Projects.Table (Prj).Config_File_Temp then + if Verbose_Mode then + Output.Write_Str ("Deleting temp configuration file """); + Output.Write_Str + (Get_Name_String + (Projects.Table (Prj).Config_File_Name)); + Output.Write_Line (""""); + end if; - Delete_File - (Name => Get_Name_String - (Projects.Table (Prj).Config_File_Name), - Success => Success); - end if; - end loop; - end if; + Delete_File + (Name => Get_Name_String + (Projects.Table (Prj).Config_File_Name), + Success => Success); + end if; + end loop; + end if; - -- If a temporary text file that contains a list of files for a tool - -- has been created, delete this temporary file. + -- If a temporary text file that contains a list of files for a tool + -- has been created, delete this temporary file. - if Temp_File_Name /= null then - Delete_File (Temp_File_Name.all, Success); + if Temp_File_Name /= null then + Delete_File (Temp_File_Name.all, Success); + end if; end if; end Delete_Temp_Config_Files; @@ -919,7 +922,7 @@ procedure GNATCmd is for C in Command_List'Range loop if not Command_List (C).VMS_Only then - Put ("GNAT " & Command_List (C).Cname.all); + Put ("gnat " & To_Lower (Command_List (C).Cname.all)); Set_Col (25); Put (Command_List (C).Unixcmd.all); @@ -939,7 +942,7 @@ procedure GNATCmd is end loop; New_Line; - Put_Line ("Commands FIND, LIST, PRETTY, STUB, NETRIC and XREF accept " & + Put_Line ("Commands find, list, metric, pretty, stub and xref accept " & "project file switches -vPx, -Pprj and -Xnam=val"); New_Line; end Non_VMS_Usage; @@ -966,6 +969,38 @@ begin VMS_Conv.Initialize; + -- Add the directory where the GNAT driver is invoked in front of the + -- path, if the GNAT driver is invoked with directory information. + -- Only do this if the platform is not VMS, where the notion of path + -- does not really exist. + + 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)); + + PATH : constant String := + Absolute_Dir & + Path_Separator & + Getenv ("PATH").all; + + begin + Setenv ("PATH", PATH); + end; + + exit; + end if; + end loop; + end; + end if; + -- If on VMS, or if VMS emulation is on, convert VMS style /qualifiers, -- filenames and pathnames to Unix style. @@ -982,10 +1017,23 @@ begin return; else begin - if Argument_Count > 1 and then Argument (1) = "-v" then - Opt.Verbose_Mode := True; - Command_Arg := 2; - end if; + loop + if Argument_Count > Command_Arg + and then Argument (Command_Arg) = "-v" + then + Verbose_Mode := True; + Command_Arg := Command_Arg + 1; + + elsif Argument_Count > Command_Arg + and then Argument (Command_Arg) = "-dn" + then + Keep_Temporary_Files := True; + Command_Arg := Command_Arg + 1; + + else + exit; + end if; + end loop; The_Command := Real_Command_Type'Value (Argument (Command_Arg)); @@ -1623,7 +1671,7 @@ begin raise Normal_Exit; end if; - if Opt.Verbose_Mode then + if Verbose_Mode then Output.Write_Str (Exec_Path.all); for Arg in The_Args'Range loop diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index ef35b931f13..fc1996f41ab 100644 --- a/gcc/ada/gnatlink.adb +++ b/gcc/ada/gnatlink.adb @@ -1297,6 +1297,38 @@ procedure Gnatlink is -- Start of processing for Gnatlink begin + -- Add the directory where gnatlink is invoked in front of the + -- path, if gnatlink is invoked with directory information. + -- Only do this if the platform is not VMS, where the notion of path + -- does not really exist. + + if not Hostparm.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)); + + PATH : constant String := + Absolute_Dir & + Path_Separator & + Getenv ("PATH").all; + + begin + Setenv ("PATH", PATH); + end; + + exit; + end if; + end loop; + end; + end if; + Process_Args; if Argument_Count = 0 diff --git a/gcc/ada/gnatmem.adb b/gcc/ada/gnatmem.adb index 21246b05f10..1b69183ec18 100644 --- a/gcc/ada/gnatmem.adb +++ b/gcc/ada/gnatmem.adb @@ -147,9 +147,9 @@ procedure Gnatmem is Tmp_Alloc : Allocation; Quiet_Mode : Boolean := False; - ------------------------------- - -- Allocation roots sorting -- - ------------------------------- + ------------------------------ + -- Allocation Roots Sorting -- + ------------------------------ Sort_Order : String (1 .. 3) := "nwh"; -- This is the default order in which sorting criteria will be applied diff --git a/gcc/ada/gnatname.adb b/gcc/ada/gnatname.adb index fb35abb388a..b38fac06f61 100644 --- a/gcc/ada/gnatname.adb +++ b/gcc/ada/gnatname.adb @@ -25,12 +25,14 @@ ------------------------------------------------------------------------------ with Gnatvsn; +with Hostparm; with Opt; with Osint; use Osint; with Output; use Output; with Prj.Makr; with Table; +with Ada.Command_Line; use Ada.Command_Line; with Ada.Text_IO; use Ada.Text_IO; with GNAT.Command_Line; use GNAT.Command_Line; with GNAT.OS_Lib; use GNAT.OS_Lib; @@ -296,6 +298,38 @@ procedure Gnatname is -- Start of processing for Gnatname begin + -- Add the directory where gnatname is invoked in front of the + -- path, if gnatname is invoked with directory information. + -- Only do this if the platform is not VMS, where the notion of path + -- does not really exist. + + if not Hostparm.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)); + + PATH : constant String := + Absolute_Dir & + Path_Separator & + Getenv ("PATH").all; + + begin + Setenv ("PATH", PATH); + end; + + exit; + end if; + end loop; + end; + end if; + -- Initialize tables Excluded_Patterns.Set_Last (0); diff --git a/gcc/ada/i-os2thr.ads b/gcc/ada/i-os2thr.ads index 7958a394f63..0c3f3aa5503 100644 --- a/gcc/ada/i-os2thr.ads +++ b/gcc/ada/i-os2thr.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1993-1997 Free Software Foundation, Inc. -- +-- Copyright (C) 1993-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- -- @@ -63,8 +63,7 @@ pragma Preelaborate (Threads); pfn : PFNTHREAD; param : PVOID; flag : ULONG; - cbStack : ULONG) - return APIRET; + cbStack : ULONG) return APIRET; pragma Import (C, DosCreateThread, "DosCreateThread"); Block_Child : constant := 1; @@ -152,8 +151,7 @@ pragma Preelaborate (Threads); function DosGetInfoBlocks (Pptib : access PTIB; - Pppib : access PPIB) - return APIRET; + Pppib : access PPIB) return APIRET; pragma Import (C, DosGetInfoBlocks, "DosGetInfoBlocks"); -- Thread local memory @@ -164,23 +162,21 @@ pragma Preelaborate (Threads); function DosAllocThreadLocalMemory (cb : ULONG; -- Number of 4-byte DWORDs to allocate p : access PVOID) -- Address of the memory block - return - APIRET; -- Return Code (rc) + return APIRET; -- Return Code (rc) pragma Import (Convention => C, Entity => DosAllocThreadLocalMemory, Link_Name => "_DosAllocThreadLocalMemory"); - ----------------- - -- Priorities -- - ----------------- + ---------------- + -- Priorities -- + ---------------- function DosSetPriority (Scope : ULONG; Class : ULONG; Delta_P : IC.long; - PorTid : TID) - return APIRET; + PorTid : TID) return APIRET; pragma Import (C, DosSetPriority, "DosSetPriority"); PRTYS_PROCESS : constant := 0; diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 7ca0e31d7e1..ab12d842548 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -701,9 +701,9 @@ package body Inline is end if; end Analyze_Inlined_Bodies; - -------------------------------- - -- Check_Body_For_Inlining -- - -------------------------------- + ----------------------------- + -- Check_Body_For_Inlining -- + ----------------------------- procedure Check_Body_For_Inlining (N : Node_Id; P : Entity_Id) is Bname : Unit_Name_Type; diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index e1757666545..212dd3cd751 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -2347,7 +2347,7 @@ package body Layout is end; end if; - Set_Prim_Alignment (E); + Set_Elem_Alignment (E); -- Scalar types: set size and alignment @@ -2412,9 +2412,9 @@ package body Layout is end if; end if; - Set_Prim_Alignment (E); + Set_Elem_Alignment (E); - -- Non-primitive types + -- Non-elementary (composite) types else -- If RM_Size is known, set Esize if not known @@ -2864,10 +2864,10 @@ package body Layout is end Set_Discrete_RM_Size; ------------------------ - -- Set_Prim_Alignment -- + -- Set_Elem_Alignment -- ------------------------ - procedure Set_Prim_Alignment (E : Entity_Id) is + procedure Set_Elem_Alignment (E : Entity_Id) is begin -- Do not set alignment for packed array types, unless we are doing -- front end layout, because otherwise this is always handled in the @@ -2930,7 +2930,7 @@ package body Layout is Init_Alignment (E, A); end if; end; - end Set_Prim_Alignment; + end Set_Elem_Alignment; ---------------------- -- SO_Ref_From_Expr -- diff --git a/gcc/ada/layout.ads b/gcc/ada/layout.ads index 02d2a139477..312547390ff 100644 --- a/gcc/ada/layout.ads +++ b/gcc/ada/layout.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2001 Free Software Foundation, Inc. -- +-- Copyright (C) 2000-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- -- @@ -68,10 +68,10 @@ package Layout is -- types, the RM_Size is simply set to zero. This routine also sets -- the Is_Constrained flag in Def_Id. - procedure Set_Prim_Alignment (E : Entity_Id); - -- The front end always sets alignments for primitive types by calling this - -- procedure. Note that we have to do this for discrete types (since the - -- Alignment attribute is static), so we might as well do it for all - -- scalar types, since the processing is the same. + procedure Set_Elem_Alignment (E : Entity_Id); + -- The front end always sets alignments for elementary types by calling + -- this procedure. Note that we have to do this for discrete types (since + -- the Alignment attribute is static), so we might as well do it for all + -- elementary types, since the processing is the same. end Layout; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index eb24af280ce..a931f14234b 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -5626,7 +5626,7 @@ package body Make is Mains.Delete; - -- Add the directory where gnatmake is invoked in the front of the + -- Add the directory where gnatmake is invoked in front of the -- path, if gnatmake is invoked with directory information. -- Only do this if the platform is not VMS, where the notion of path -- does not really exist. diff --git a/gcc/ada/makegpr.adb b/gcc/ada/makegpr.adb index ea504884910..61f96f251ff 100644 --- a/gcc/ada/makegpr.adb +++ b/gcc/ada/makegpr.adb @@ -212,6 +212,15 @@ package body Makegpr is Hash => Hash, Equal => "="); + package X_Switches is new Table.Table + (Table_Component_Type => String_Access, + Table_Index_Type => Integer, + Table_Low_Bound => 1, + Table_Initial => 2, + Table_Increment => 100, + Table_Name => "Makegpr.X_Switches"); + -- Table to store the -X switches to be passed to gnatmake + Initial_Argument_Count : constant Positive := 20; type Boolean_Array is array (Positive range <>) of Boolean; type Booleans is access Boolean_Array; @@ -305,6 +314,10 @@ package body Makegpr is Need_To_Relink : Boolean := False; -- True when an executable of a language other than Ada need to be linked + Global_Archive_Exists : Boolean := False; + -- True if there is a non empty global archive, to prevent creation + -- of such archives. + Path_Option : String_Access; -- The path option switch, when supported @@ -567,9 +580,9 @@ package body Makegpr is end if; -- For a non-library project, the only archive needed - -- is the one for the main project. + -- is the one for the main project, if there is one. - elsif Project = Main_Project then + elsif Project = Main_Project and then Global_Archive_Exists then Add_Argument (Get_Name_String (Data.Object_Directory) & Directory_Separator & @@ -1157,11 +1170,6 @@ package body Makegpr is -- Archive needs to be rebuilt else - -- If the archive is built, then linking will need to occur - -- unconditionally. - - Need_To_Relink := True; - -- If archive already exists, first delete it -- Comment needed on why we discard result??? @@ -1208,86 +1216,100 @@ package body Makegpr is end if; end loop; - -- Spawn the archive builder (ar) + -- No need to create a global archive, if there is no object + -- file to put into. - Saved_Last_Argument := Last_Argument; + Global_Archive_Exists := Last_Argument > First_Object; - Last_Argument := First_Object + Max_In_Archives; + if Global_Archive_Exists then + -- If the archive is built, then linking will need to occur + -- unconditionally. - loop - if Last_Argument > Saved_Last_Argument then - Last_Argument := Saved_Last_Argument; - end if; + Need_To_Relink := True; - Display_Command (Archive_Builder, Archive_Builder_Path); + -- Spawn the archive builder (ar) - Spawn - (Archive_Builder_Path.all, - Arguments (1 .. Last_Argument), - Success); + Saved_Last_Argument := Last_Argument; - exit when not Success; + Last_Argument := First_Object + Max_In_Archives; - exit when Last_Argument = Saved_Last_Argument; + loop + if Last_Argument > Saved_Last_Argument then + Last_Argument := Saved_Last_Argument; + end if; - Arguments (1) := r; - Arguments (3 .. Saved_Last_Argument - Last_Argument + 2) := - Arguments (Last_Argument + 1 .. Saved_Last_Argument); - Saved_Last_Argument := Saved_Last_Argument - Last_Argument + 2; - end loop; + Display_Command (Archive_Builder, Archive_Builder_Path); - -- If the archive was built, run the archive indexer (ranlib) - -- if there is one. + Spawn + (Archive_Builder_Path.all, + Arguments (1 .. Last_Argument), + Success); - if Success then + exit when not Success; - -- If the archive was built, run the archive indexer (ranlib), + exit when Last_Argument = Saved_Last_Argument; + + Arguments (1) := r; + Arguments (3 .. Saved_Last_Argument - Last_Argument + 2) := + Arguments (Last_Argument + 1 .. Saved_Last_Argument); + Saved_Last_Argument := Saved_Last_Argument - Last_Argument + 2; + end loop; + + -- If the archive was built, run the archive indexer (ranlib) -- if there is one. - if Archive_Indexer_Path /= null then - Last_Argument := 0; - Add_Argument (Archive_Name, True); + if Success then - Display_Command (Archive_Indexer, Archive_Indexer_Path); + -- If the archive was built, run the archive indexer (ranlib), + -- if there is one. - Spawn (Archive_Indexer_Path.all, Arguments (1 .. 1), Success); + if Archive_Indexer_Path /= null then + Last_Argument := 0; + Add_Argument (Archive_Name, True); - if not Success then + Display_Command (Archive_Indexer, Archive_Indexer_Path); - -- Running ranlib failed, delete the dependency file, - -- if it exists. + Spawn + (Archive_Indexer_Path.all, Arguments (1 .. 1), Success); - if Is_Regular_File (Archive_Dep_Name) then - Delete_File (Archive_Dep_Name, Success); - end if; + if not Success then + + -- Running ranlib failed, delete the dependency file, + -- if it exists. + + if Is_Regular_File (Archive_Dep_Name) then + Delete_File (Archive_Dep_Name, Success); + end if; - -- And report the error + -- And report the error - Report_Error - ("running" & Archive_Indexer & " for project """, - Get_Name_String (Data.Name), - """ failed"); - return; + Report_Error + ("running" & Archive_Indexer & " for project """, + Get_Name_String (Data.Name), + """ failed"); + return; + end if; end if; - end if; - -- The archive was correctly built, create its dependency file + -- The archive was correctly built, create its dependency file - Create_Global_Archive_Dependency_File (Archive_Dep_Name); + Create_Global_Archive_Dependency_File (Archive_Dep_Name); - -- Building the archive failed, delete dependency file if one exists + -- Building the archive failed, delete dependency file if one + -- exists. - else - if Is_Regular_File (Archive_Dep_Name) then - Delete_File (Archive_Dep_Name, Success); - end if; + else + if Is_Regular_File (Archive_Dep_Name) then + Delete_File (Archive_Dep_Name, Success); + end if; - -- And report the error + -- And report the error - Report_Error - ("building archive for project """, - Get_Name_String (Data.Name), - """ failed"); + Report_Error + ("building archive for project """, + Get_Name_String (Data.Name), + """ failed"); + end if; end if; end if; end Build_Global_Archive; @@ -2316,6 +2338,12 @@ package body Makegpr is Add_Argument (Dash_P, True); Add_Argument (Get_Name_String (Data.Path_Name), True); + -- Add the -X switches, if any + + for Index in 1 .. X_Switches.Last loop + Add_Argument (X_Switches.Table (Index), True); + end loop; + -- If Mains_Specified is True, find the mains in package Mains if Mains_Specified then @@ -3008,6 +3036,10 @@ package body Makegpr is Add_Str_To_Name_Buffer ("compiler_command"); Name_Compiler_Command := Name_Find; + -- Make sure the -X switch table is empty + + X_Switches.Set_Last (0); + -- Get the command line arguments Scan_Args : for Next_Arg in 1 .. Argument_Count loop @@ -3807,7 +3839,7 @@ package body Makegpr is Osint.Fail ("switch -o not allowed within a -largs. Use -o directly."); - -- If current processor is not gprmake dirrectly, store the option in + -- If current processor is not gprmake directly, store the option in -- the appropriate table. elsif Current_Processor /= None then @@ -3877,7 +3909,11 @@ package body Makegpr is then -- Is_External_Assignment has side effects when it returns True - null; + -- Record the -X switch, so that they can be passed to gnatmake, + -- if gnatmake is called. + + X_Switches.Increment_Last; + X_Switches.Table (X_Switches.Last) := new String'(Arg); else Osint.Fail ("illegal option """, Arg, """"); diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 0e9f7c4778f..f7ca5e2d849 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -560,6 +560,11 @@ package Opt is -- When True signals gnatmake to ignore compilation errors and keep -- processing sources until there is no more work. + Keep_Temporary_Files : Boolean := False; + -- GNATCMD + -- When True the temporary files created by the GNAT driver are not + -- deleted. Set by switch -dn or qualifier /KEEP_TEMPORARY_FILES. + Link_Only : Boolean := False; -- GNATMAKE -- Set to True to skip compile and bind steps diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index aa45a7a03b4..48da30759de 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -1176,9 +1176,9 @@ package body Osint is return Src_Search_Directories.Table (Primary_Directory); end Get_Primary_Src_Search_Directory; - ------------------------- - -- Get_RTS_Search_Dir -- - ------------------------- + ------------------------ + -- Get_RTS_Search_Dir -- + ------------------------ function Get_RTS_Search_Dir (Search_Dir : String; diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 8514f2dc4f1..6fbec9fb2c4 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -376,9 +376,9 @@ package body Prj is end if; end Register_Default_Naming_Scheme; - ------------ - -- Reset -- - ------------ + ----------- + -- Reset -- + ----------- procedure Reset is begin diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index ce97924386a..7af5adcb1a7 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -1012,6 +1012,8 @@ package Rtsfind is RE_Get_Unique_Remote_Pointer, -- System.Partition_Interface RE_RACW_Stub_Type, -- System.Partition_Interface RE_RACW_Stub_Type_Access, -- System.Partition_Interface + RE_RAS_Proxy_Type, -- System.Partition_Interface + RE_RAS_Proxy_Type_Access, -- System.Partition_Interface RE_Raise_Program_Error_Unknown_Tag, -- System.Partition_Interface RE_Register_Passive_Package, -- System.Partition_Interface RE_Register_Receiving_Stub, -- System.Partition_Interface @@ -1158,6 +1160,7 @@ package Rtsfind is RE_TC_String, -- System.PolyORB_Interface, RE_TC_Struct, -- System.PolyORB_Interface, RE_TC_Union, -- System.PolyORB_Interface, + RE_TC_Object, -- System.PolyORB_Interface, RE_IS_Is1, -- System.Scalar_Values RE_IS_Is2, -- System.Scalar_Values @@ -2089,6 +2092,8 @@ package Rtsfind is RE_Get_Unique_Remote_Pointer => System_Partition_Interface, RE_RACW_Stub_Type => System_Partition_Interface, RE_RACW_Stub_Type_Access => System_Partition_Interface, + RE_RAS_Proxy_Type => System_Partition_Interface, + RE_RAS_Proxy_Type_Access => System_Partition_Interface, RE_Raise_Program_Error_Unknown_Tag => System_Partition_Interface, RE_Register_Passive_Package => System_Partition_Interface, RE_Register_Receiving_Stub => System_Partition_Interface, @@ -2223,6 +2228,7 @@ package Rtsfind is RE_TC_String => System_PolyORB_Interface, RE_TC_Struct => System_PolyORB_Interface, RE_TC_Union => System_PolyORB_Interface, + RE_TC_Object => System_PolyORB_Interface, RE_Global_Pool_Object => System_Pool_Global, diff --git a/gcc/ada/s-ficobl.ads b/gcc/ada/s-ficobl.ads index 181755960d2..fd8f2baf0e0 100644 --- a/gcc/ada/s-ficobl.ads +++ b/gcc/ada/s-ficobl.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2000 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -42,9 +42,9 @@ with Interfaces.C_Streams; package System.File_Control_Block is - ----------------------------- - -- Ada File Control Block -- - ----------------------------- + ---------------------------- + -- Ada File Control Block -- + ---------------------------- -- The Ada file control block is an abstract extension of the root -- stream type. This allows a file to be treated directly as a stream diff --git a/gcc/ada/s-finimp.adb b/gcc/ada/s-finimp.adb index 41245373d59..dfeda6398af 100644 --- a/gcc/ada/s-finimp.adb +++ b/gcc/ada/s-finimp.adb @@ -91,9 +91,9 @@ package body System.Finalization_Implementation is -- Given the address (obj) of a tagged object, return a -- pointer to the record controller of this object. - ------------- - -- Adjust -- - ------------- + ------------ + -- Adjust -- + ------------ procedure Adjust (Object : in out Record_Controller) is diff --git a/gcc/ada/s-htable.adb b/gcc/ada/s-htable.adb index 5e3675a1e8c..bf76624e037 100644 --- a/gcc/ada/s-htable.adb +++ b/gcc/ada/s-htable.adb @@ -35,9 +35,9 @@ with Ada.Unchecked_Deallocation; package body System.HTable is - -------------------- - -- Static_HTable -- - -------------------- + ------------------- + -- Static_HTable -- + ------------------- package body Static_HTable is diff --git a/gcc/ada/s-interr-sigaction.adb b/gcc/ada/s-interr-sigaction.adb index dc0fffd048a..4a7610c8018 100644 --- a/gcc/ada/s-interr-sigaction.adb +++ b/gcc/ada/s-interr-sigaction.adb @@ -255,9 +255,9 @@ package body System.Interrupts is return True; end Has_Interrupt_Or_Attach_Handler; - ---------------- - -- Finalize -- - ---------------- + -------------- + -- Finalize -- + -------------- procedure Finalize (Object : in out Static_Interrupt_Protection) is begin diff --git a/gcc/ada/s-interr-vms.adb b/gcc/ada/s-interr-vms.adb index 9570c2c8367..3d4b7fc2e9d 100644 --- a/gcc/ada/s-interr-vms.adb +++ b/gcc/ada/s-interr-vms.adb @@ -192,9 +192,9 @@ package body System.Interrupts is type Server_Task_Access is access Server_Task; - -------------------------------- - -- Local Types and Variables -- - -------------------------------- + ------------------------------- + -- Local Types and Variables -- + ------------------------------- type Entry_Assoc is record T : Task_Id; @@ -406,8 +406,9 @@ package body System.Interrupts is -- Current_Handler -- --------------------- - function Current_Handler (Interrupt : Interrupt_ID) - return Parameterless_Handler is + function Current_Handler + (Interrupt : Interrupt_ID) return Parameterless_Handler + is begin if Is_Reserved (Interrupt) then Raise_Exception (Program_Error'Identity, "Interrupt" & @@ -626,9 +627,9 @@ package body System.Interrupts is task body Interrupt_Manager is - --------------------- - -- Local Routines -- - --------------------- + -------------------- + -- Local Routines -- + -------------------- procedure Unprotected_Exchange_Handler (Old_Handler : out Parameterless_Handler; @@ -1079,8 +1080,7 @@ package body System.Interrupts is ------------------------------------- function Has_Interrupt_Or_Attach_Handler - (Object : access Dynamic_Interrupt_Protection) - return Boolean + (Object : access Dynamic_Interrupt_Protection) return Boolean is pragma Warnings (Off, Object); @@ -1088,14 +1088,15 @@ package body System.Interrupts is return True; end Has_Interrupt_Or_Attach_Handler; - ---------------- - -- Finalize -- - ---------------- + -------------- + -- Finalize -- + -------------- procedure Finalize (Object : in out Static_Interrupt_Protection) is begin -- ??? loop to be executed only when we're not doing library level -- finalization, since in this case all interrupt tasks are gone. + if not Interrupt_Manager'Terminated then for N in reverse Object.Previous_Handlers'Range loop Interrupt_Manager.Attach_Handler @@ -1115,8 +1116,7 @@ package body System.Interrupts is ------------------------------------- function Has_Interrupt_Or_Attach_Handler - (Object : access Static_Interrupt_Protection) - return Boolean + (Object : access Static_Interrupt_Protection) return Boolean is pragma Warnings (Off, Object); begin diff --git a/gcc/ada/s-interr.adb b/gcc/ada/s-interr.adb index 5210c9eee7a..6844e883a52 100644 --- a/gcc/ada/s-interr.adb +++ b/gcc/ada/s-interr.adb @@ -707,18 +707,18 @@ package body System.Interrupts is task body Interrupt_Manager is - ---------------------- - -- Local Variables -- - ---------------------- + --------------------- + -- Local Variables -- + --------------------- Intwait_Mask : aliased IMNG.Interrupt_Mask; Ret_Interrupt : Interrupt_ID; Old_Mask : aliased IMNG.Interrupt_Mask; Old_Handler : Parameterless_Handler; - --------------------- - -- Local Routines -- - --------------------- + -------------------- + -- Local Routines -- + -------------------- procedure Bind_Handler (Interrupt : Interrupt_ID); -- This procedure does not do anything if the Interrupt is blocked. diff --git a/gcc/ada/s-interr.ads b/gcc/ada/s-interr.ads index 8e7362fd041..2377249203a 100644 --- a/gcc/ada/s-interr.ads +++ b/gcc/ada/s-interr.ads @@ -122,25 +122,25 @@ package System.Interrupts is (Interrupt : Interrupt_ID) return System.Address; - --------------------------------- - -- Interrupt entries services -- - --------------------------------- + -------------------------------- + -- Interrupt Entries Services -- + -------------------------------- -- Routines needed for Interrupt Entries - -- Attempt to bind an Entry to an Interrupt to which a Handler is - -- already attached will raise a Program_Error. procedure Bind_Interrupt_To_Entry (T : System.Tasking.Task_Id; E : System.Tasking.Task_Entry_Index; Int_Ref : System.Address); + -- Bind the given interrupt to the given entry. If the interrupt is + -- already bound to another entry, Program_Error will be raised. procedure Detach_Interrupt_Entries (T : System.Tasking.Task_Id); -- This procedure detaches all the Interrupt Entries bound to a task. - ------------------------------- - -- POSIX.5 signals services -- - ------------------------------- + ------------------------------ + -- POSIX.5 Signals Services -- + ------------------------------ -- Routines needed for POSIX dot5 POSIX_Signals @@ -177,7 +177,7 @@ package System.Interrupts is -- This will make all the tasks in RTS blocked for the Interrupt. ---------------------- - -- Protection types -- + -- Protection Types -- ---------------------- -- Routines and types needed to implement Interrupt_Handler and diff --git a/gcc/ada/s-osinte-aix.ads b/gcc/ada/s-osinte-aix.ads index c761eb8a048..c6e8213c7ca 100644 --- a/gcc/ada/s-osinte-aix.ads +++ b/gcc/ada/s-osinte-aix.ads @@ -391,9 +391,9 @@ package System.OS_Interface is Relative_Timed_Wait : constant Boolean := False; -- pthread_cond_timedwait requires an absolute delay time - ---------------------------- - -- POSIX.1c Section 13 -- - ---------------------------- + -------------------------- + -- POSIX.1c Section 13 -- + -------------------------- PTHREAD_PRIO_NONE : constant := 0; PTHREAD_PRIO_PROTECT : constant := 0; @@ -445,9 +445,9 @@ package System.OS_Interface is function sched_yield return int; -- AiX have a nonstandard sched_yield. - --------------------------- - -- P1003.1c - Section 16 -- - --------------------------- + -------------------------- + -- P1003.1c Section 16 -- + -------------------------- function pthread_attr_init (attributes : access pthread_attr_t) return int; pragma Import (C, pthread_attr_init, "pthread_attr_init"); diff --git a/gcc/ada/s-osinte-freebsd.ads b/gcc/ada/s-osinte-freebsd.ads index 13e545871c1..000eb1c9ae5 100644 --- a/gcc/ada/s-osinte-freebsd.ads +++ b/gcc/ada/s-osinte-freebsd.ads @@ -328,18 +328,20 @@ package System.OS_Interface is (addr : Address; len : size_t; prot : int) return int; pragma Import (C, mprotect); - ----------------------------------------- - -- Nonstandard Thread Initialization -- - ----------------------------------------- - -- FSU_THREADS requires pthread_init, which is nonstandard - -- and this should be invoked during the elaboration of s-taprop.adb - -- - -- FreeBSD does not require this so we provide an empty Ada body. + --------------------------------------- + -- Nonstandard Thread Initialization -- + --------------------------------------- + + -- FSU_THREADS requires pthread_init, which is nonstandard and + -- this should be invoked during the elaboration of s-taprop.adb + + -- FreeBSD does not require this so we provide an empty Ada body + procedure pthread_init; - --------------------------- - -- POSIX.1c Section 3 -- - --------------------------- + ------------------------- + -- POSIX.1c Section 3 -- + ------------------------- function sigwait (set : access sigset_t; @@ -348,7 +350,7 @@ package System.OS_Interface is function pthread_kill (thread : pthread_t; - sig : Signal) return int; + sig : Signal) return int; pragma Import (C, pthread_kill, "pthread_kill"); type sigset_t_ptr is access all sigset_t; @@ -359,9 +361,9 @@ package System.OS_Interface is oset : sigset_t_ptr) return int; pragma Import (C, pthread_sigmask, "pthread_sigmask"); - ---------------------------- - -- POSIX.1c Section 11 -- - ---------------------------- + -------------------------- + -- POSIX.1c Section 11 -- + -------------------------- function pthread_mutexattr_init (attr : access pthread_mutexattr_t) return int; @@ -418,9 +420,9 @@ package System.OS_Interface is Relative_Timed_Wait : constant Boolean := False; -- pthread_cond_timedwait requires an absolute delay time - ---------------------------- - -- POSIX.1c Section 13 -- - ---------------------------- + -------------------------- + -- POSIX.1c Section 13 -- + -------------------------- PTHREAD_PRIO_NONE : constant := 0; PTHREAD_PRIO_PROTECT : constant := 2; @@ -516,9 +518,9 @@ package System.OS_Interface is function sched_yield return int; pragma Import (C, sched_yield, "pthread_yield"); - ----------------------------- - -- P1003.1c - Section 16 -- - ----------------------------- + -------------------------- + -- P1003.1c Section 16 -- + -------------------------- function pthread_attr_init (attributes : access pthread_attr_t) return int; pragma Import (C, pthread_attr_init, "pthread_attr_init"); @@ -567,9 +569,9 @@ package System.OS_Interface is function pthread_self return pthread_t; pragma Import (C, pthread_self, "pthread_self"); - ---------------------------- - -- POSIX.1c Section 17 -- - ---------------------------- + -------------------------- + -- POSIX.1c Section 17 -- + -------------------------- function pthread_setspecific (key : pthread_key_t; @@ -587,9 +589,9 @@ package System.OS_Interface is destructor : destructor_pointer) return int; pragma Import (C, pthread_key_create, "pthread_key_create"); - -------------------------------------- - -- Non-portable pthread functions -- - -------------------------------------- + ------------------------------------ + -- Non-portable Pthread Functions -- + ------------------------------------ function pthread_set_name_np (thread : pthread_t; @@ -605,11 +607,12 @@ private -- #define sa_handler __sigaction_u._handler -- #define sa_sigaction __sigaction_u._sigaction - -- Should we add a signal_context type here ? - -- How could it be done independent of the CPU architecture ? + -- Should we add a signal_context type here ??? + -- How could it be done independent of the CPU architecture ??? -- sigcontext type is opaque, so it is architecturally neutral. -- It is always passed as an access type, so define it as an empty record -- since the contents are not used anywhere. + type struct_sigcontext is null record; pragma Convention (C, struct_sigcontext); diff --git a/gcc/ada/s-osinte-hpux-dce.adb b/gcc/ada/s-osinte-hpux-dce.adb index dcd169ccf62..ab0b0775e88 100644 --- a/gcc/ada/s-osinte-hpux-dce.adb +++ b/gcc/ada/s-osinte-hpux-dce.adb @@ -7,7 +7,7 @@ -- B o d y -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2003, Ada Core Technologies -- +-- Copyright (C) 1995-2004, Ada Core Technologies -- -- -- -- GNARL 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- -- @@ -104,14 +104,13 @@ package body System.OS_Interface is tv_usec => time_t (Long_Long_Integer (F * 10#1#E6))); end To_Timeval; - --------------------------- - -- POSIX.1c Section 3 -- - --------------------------- + ------------------------- + -- POSIX.1c Section 3 -- + ------------------------- function sigwait (set : access sigset_t; - sig : access Signal) - return int + sig : access Signal) return int is Result : int; @@ -135,21 +134,18 @@ package body System.OS_Interface is return 0; end pthread_kill; - ---------------------------- - -- POSIX.1c Section 11 -- - ---------------------------- + -------------------------- + -- POSIX.1c Section 11 -- + -------------------------- - -- For all the following functions, DCE Threads has a non standard - -- behavior: it sets errno but the standard Posix requires it to be - -- returned. + -- For all following functions, DCE Threads has a non standard behavior. + -- It sets errno but the standard Posix requires it to be returned. function pthread_mutexattr_init - (attr : access pthread_mutexattr_t) - return int + (attr : access pthread_mutexattr_t) return int is function pthread_mutexattr_create - (attr : access pthread_mutexattr_t) - return int; + (attr : access pthread_mutexattr_t) return int; pragma Import (C, pthread_mutexattr_create, "pthread_mutexattr_create"); begin @@ -161,12 +157,10 @@ package body System.OS_Interface is end pthread_mutexattr_init; function pthread_mutexattr_destroy - (attr : access pthread_mutexattr_t) - return int + (attr : access pthread_mutexattr_t) return int is function pthread_mutexattr_delete - (attr : access pthread_mutexattr_t) - return int; + (attr : access pthread_mutexattr_t) return int; pragma Import (C, pthread_mutexattr_delete, "pthread_mutexattr_delete"); begin @@ -179,13 +173,11 @@ package body System.OS_Interface is function pthread_mutex_init (mutex : access pthread_mutex_t; - attr : access pthread_mutexattr_t) - return int + attr : access pthread_mutexattr_t) return int is function pthread_mutex_init_base (mutex : access pthread_mutex_t; - attr : pthread_mutexattr_t) - return int; + attr : pthread_mutexattr_t) return int; pragma Import (C, pthread_mutex_init_base, "pthread_mutex_init"); begin @@ -197,12 +189,10 @@ package body System.OS_Interface is end pthread_mutex_init; function pthread_mutex_destroy - (mutex : access pthread_mutex_t) - return int + (mutex : access pthread_mutex_t) return int is function pthread_mutex_destroy_base - (mutex : access pthread_mutex_t) - return int; + (mutex : access pthread_mutex_t) return int; pragma Import (C, pthread_mutex_destroy_base, "pthread_mutex_destroy"); begin @@ -214,12 +204,10 @@ package body System.OS_Interface is end pthread_mutex_destroy; function pthread_mutex_lock - (mutex : access pthread_mutex_t) - return int + (mutex : access pthread_mutex_t) return int is function pthread_mutex_lock_base - (mutex : access pthread_mutex_t) - return int; + (mutex : access pthread_mutex_t) return int; pragma Import (C, pthread_mutex_lock_base, "pthread_mutex_lock"); begin @@ -231,12 +219,10 @@ package body System.OS_Interface is end pthread_mutex_lock; function pthread_mutex_unlock - (mutex : access pthread_mutex_t) - return int + (mutex : access pthread_mutex_t) return int is function pthread_mutex_unlock_base - (mutex : access pthread_mutex_t) - return int; + (mutex : access pthread_mutex_t) return int; pragma Import (C, pthread_mutex_unlock_base, "pthread_mutex_unlock"); begin @@ -248,12 +234,10 @@ package body System.OS_Interface is end pthread_mutex_unlock; function pthread_condattr_init - (attr : access pthread_condattr_t) - return int + (attr : access pthread_condattr_t) return int is function pthread_condattr_create - (attr : access pthread_condattr_t) - return int; + (attr : access pthread_condattr_t) return int; pragma Import (C, pthread_condattr_create, "pthread_condattr_create"); begin @@ -265,12 +249,10 @@ package body System.OS_Interface is end pthread_condattr_init; function pthread_condattr_destroy - (attr : access pthread_condattr_t) - return int + (attr : access pthread_condattr_t) return int is function pthread_condattr_delete - (attr : access pthread_condattr_t) - return int; + (attr : access pthread_condattr_t) return int; pragma Import (C, pthread_condattr_delete, "pthread_condattr_delete"); begin @@ -283,13 +265,11 @@ package body System.OS_Interface is function pthread_cond_init (cond : access pthread_cond_t; - attr : access pthread_condattr_t) - return int + attr : access pthread_condattr_t) return int is function pthread_cond_init_base (cond : access pthread_cond_t; - attr : pthread_condattr_t) - return int; + attr : pthread_condattr_t) return int; pragma Import (C, pthread_cond_init_base, "pthread_cond_init"); begin @@ -301,12 +281,10 @@ package body System.OS_Interface is end pthread_cond_init; function pthread_cond_destroy - (cond : access pthread_cond_t) - return int + (cond : access pthread_cond_t) return int is function pthread_cond_destroy_base - (cond : access pthread_cond_t) - return int; + (cond : access pthread_cond_t) return int; pragma Import (C, pthread_cond_destroy_base, "pthread_cond_destroy"); begin @@ -318,12 +296,10 @@ package body System.OS_Interface is end pthread_cond_destroy; function pthread_cond_signal - (cond : access pthread_cond_t) - return int + (cond : access pthread_cond_t) return int is function pthread_cond_signal_base - (cond : access pthread_cond_t) - return int; + (cond : access pthread_cond_t) return int; pragma Import (C, pthread_cond_signal_base, "pthread_cond_signal"); begin @@ -336,13 +312,11 @@ package body System.OS_Interface is function pthread_cond_wait (cond : access pthread_cond_t; - mutex : access pthread_mutex_t) - return int + mutex : access pthread_mutex_t) return int is function pthread_cond_wait_base (cond : access pthread_cond_t; - mutex : access pthread_mutex_t) - return int; + mutex : access pthread_mutex_t) return int; pragma Import (C, pthread_cond_wait_base, "pthread_cond_wait"); begin @@ -356,14 +330,12 @@ package body System.OS_Interface is function pthread_cond_timedwait (cond : access pthread_cond_t; mutex : access pthread_mutex_t; - abstime : access timespec) - return int + abstime : access timespec) return int is function pthread_cond_timedwait_base (cond : access pthread_cond_t; mutex : access pthread_mutex_t; - abstime : access timespec) - return int; + abstime : access timespec) return int; pragma Import (C, pthread_cond_timedwait_base, "pthread_cond_timedwait"); begin @@ -390,8 +362,7 @@ package body System.OS_Interface is function pthread_setscheduler (thread : pthread_t; policy : int; - priority : int) - return int; + priority : int) return int; pragma Import (C, pthread_setscheduler, "pthread_setscheduler"); begin @@ -414,11 +385,11 @@ package body System.OS_Interface is -- P1003.1c - Section 16 -- ----------------------------- - function pthread_attr_init (attributes : access pthread_attr_t) return int + function pthread_attr_init + (attributes : access pthread_attr_t) return int is function pthread_attr_create - (attributes : access pthread_attr_t) - return int; + (attributes : access pthread_attr_t) return int; pragma Import (C, pthread_attr_create, "pthread_attr_create"); begin @@ -433,8 +404,7 @@ package body System.OS_Interface is (attributes : access pthread_attr_t) return int is function pthread_attr_delete - (attributes : access pthread_attr_t) - return int; + (attributes : access pthread_attr_t) return int; pragma Import (C, pthread_attr_delete, "pthread_attr_delete"); begin @@ -451,8 +421,7 @@ package body System.OS_Interface is is function pthread_attr_setstacksize_base (attr : access pthread_attr_t; - stacksize : size_t) - return int; + stacksize : size_t) return int; pragma Import (C, pthread_attr_setstacksize_base, "pthread_attr_setstacksize"); @@ -474,8 +443,7 @@ package body System.OS_Interface is (thread : access pthread_t; attributes : pthread_attr_t; start_routine : Thread_Body; - arg : System.Address) - return int; + arg : System.Address) return int; pragma Import (C, pthread_create_base, "pthread_create"); begin @@ -488,9 +456,9 @@ package body System.OS_Interface is end if; end pthread_create; - ---------------------------- - -- POSIX.1c Section 17 -- - ---------------------------- + -------------------------- + -- POSIX.1c Section 17 -- + -------------------------- function pthread_setspecific (key : pthread_key_t; @@ -543,7 +511,6 @@ package body System.OS_Interface is function Get_Stack_Base (thread : pthread_t) return Address is pragma Warnings (Off, thread); - begin return Null_Address; end Get_Stack_Base; @@ -556,7 +523,6 @@ package body System.OS_Interface is function intr_attach (sig : int; handler : isr_address) return long is function c_signal (sig : int; handler : isr_address) return long; pragma Import (C, c_signal, "signal"); - begin return c_signal (sig, handler); end intr_attach; diff --git a/gcc/ada/s-osinte-hpux.ads b/gcc/ada/s-osinte-hpux.ads index 95b093ae7fa..1aea8734223 100644 --- a/gcc/ada/s-osinte-hpux.ads +++ b/gcc/ada/s-osinte-hpux.ads @@ -387,9 +387,9 @@ package System.OS_Interface is Relative_Timed_Wait : constant Boolean := False; -- pthread_cond_timedwait requires an absolute delay time - ---------------------------- - -- POSIX.1c Section 13 -- - ---------------------------- + -------------------------- + -- POSIX.1c Section 13 -- + -------------------------- PTHREAD_PRIO_NONE : constant := 16#100#; PTHREAD_PRIO_PROTECT : constant := 16#200#; @@ -436,9 +436,9 @@ package System.OS_Interface is function sched_yield return int; pragma Import (C, sched_yield, "sched_yield"); - --------------------------- - -- P1003.1c - Section 16 -- - --------------------------- + -------------------------- + -- P1003.1c Section 16 -- + -------------------------- function pthread_attr_init (attributes : access pthread_attr_t) return int; diff --git a/gcc/ada/s-osinte-irix.ads b/gcc/ada/s-osinte-irix.ads index 92c11070dad..56c852614e8 100644 --- a/gcc/ada/s-osinte-irix.ads +++ b/gcc/ada/s-osinte-irix.ads @@ -452,11 +452,12 @@ package System.OS_Interface is destructor : destructor_pointer) return int; pragma Import (C, pthread_key_create, "pthread_key_create"); - --------------------------------------------------------------- - -- Non portable SGI 6.5 additions to the pthread interface -- - -- must be executed from within the context of a system -- - -- scope task -- - --------------------------------------------------------------- + ------------------- + -- SGI Additions -- + ------------------- + + -- Non portable SGI 6.5 additions to the pthread interface must be + -- executed from within the context of a system scope task. function pthread_setrunon_np (cpu : int) return int; pragma Import (C, pthread_setrunon_np, "pthread_setrunon_np"); diff --git a/gcc/ada/s-osinte-lynxos.ads b/gcc/ada/s-osinte-lynxos.ads index 8b6b33885d1..7b9d640efb2 100644 --- a/gcc/ada/s-osinte-lynxos.ads +++ b/gcc/ada/s-osinte-lynxos.ads @@ -310,16 +310,16 @@ package System.OS_Interface is function mprotect (addr : Address; len : size_t; prot : int) return int; pragma Import (C, mprotect); - ----------------------------------------- - -- Nonstandard Thread Initialization -- - ----------------------------------------- + --------------------------------------- + -- Nonstandard Thread Initialization -- + --------------------------------------- procedure pthread_init; -- This is a dummy procedure to share some GNULLI files - --------------------------- - -- POSIX.1c Section 3 -- - --------------------------- + ------------------------- + -- POSIX.1c Section 3 -- + ------------------------- function sigwait (set : access sigset_t; @@ -447,9 +447,9 @@ package System.OS_Interface is function sched_yield return int; pragma Import (C, sched_yield, "sched_yield"); - --------------------------- - -- P1003.1c - Section 16 -- - --------------------------- + -------------------------- + -- P1003.1c Section 16 -- + -------------------------- function pthread_attr_init (attributes : access pthread_attr_t) return int; pragma Import (C, pthread_attr_init, "pthread_attr_init"); diff --git a/gcc/ada/s-osinte-tru64.ads b/gcc/ada/s-osinte-tru64.ads index dc01b058343..8723f2db857 100644 --- a/gcc/ada/s-osinte-tru64.ads +++ b/gcc/ada/s-osinte-tru64.ads @@ -285,9 +285,9 @@ package System.OS_Interface is pragma Inline (pthread_init); -- This is a dummy procedure to share some GNULLI files - --------------------------- - -- POSIX.1c Section 3 -- - --------------------------- + ------------------------- + -- POSIX.1c Section 3 -- + ------------------------- function sigwait (set : access sigset_t; @@ -307,9 +307,9 @@ package System.OS_Interface is oset : sigset_t_ptr) return int; pragma Import (C, pthread_sigmask); - ---------------------------- - -- POSIX.1c Section 11 -- - ---------------------------- + -------------------------- + -- POSIX.1c Section 11 -- + -------------------------- function pthread_mutexattr_init (attr : access pthread_mutexattr_t) return int; @@ -363,9 +363,9 @@ package System.OS_Interface is abstime : access timespec) return int; pragma Import (C, pthread_cond_timedwait, "__pthread_cond_timedwait"); - ---------------------------- - -- POSIX.1c Section 13 -- - ---------------------------- + -------------------------- + -- POSIX.1c Section 13 -- + -------------------------- function pthread_mutexattr_setprotocol (attr : access pthread_mutexattr_t; @@ -410,9 +410,9 @@ package System.OS_Interface is function sched_yield return int; pragma Import (C, sched_yield); - --------------------------- - -- P1003.1c - Section 16 -- - --------------------------- + -------------------------- + -- P1003.1c Section 16 -- + -------------------------- function pthread_attr_init (attributes : access pthread_attr_t) return int; diff --git a/gcc/ada/s-osinte-vms.ads b/gcc/ada/s-osinte-vms.ads index 333e02a37b8..d96a5ed4a54 100644 --- a/gcc/ada/s-osinte-vms.ads +++ b/gcc/ada/s-osinte-vms.ads @@ -407,9 +407,9 @@ package System.OS_Interface is (newtype : int; oldtype : access int) return int; pragma Import (C, pthread_setcanceltype, "PTHREAD_SETCANCELTYPE"); - --------------------------- - -- POSIX.1c Section 3 -- - --------------------------- + ------------------------- + -- POSIX.1c Section 3 -- + ------------------------- function pthread_lock_global_np return int; pragma Import (C, pthread_lock_global_np, "PTHREAD_LOCK_GLOBAL_NP"); @@ -417,9 +417,9 @@ package System.OS_Interface is function pthread_unlock_global_np return int; pragma Import (C, pthread_unlock_global_np, "PTHREAD_UNLOCK_GLOBAL_NP"); - ---------------------------- - -- POSIX.1c Section 11 -- - ---------------------------- + -------------------------- + -- POSIX.1c Section 11 -- + -------------------------- function pthread_mutexattr_init (attr : access pthread_mutexattr_t) return int; @@ -522,9 +522,9 @@ package System.OS_Interface is function sched_yield return int; - ----------------------------- - -- P1003.1c - Section 16 -- - ----------------------------- + -------------------------- + -- P1003.1c Section 16 -- + -------------------------- function pthread_attr_init (attributes : access pthread_attr_t) return int; pragma Import (C, pthread_attr_init, "PTHREAD_ATTR_INIT"); diff --git a/gcc/ada/s-osinte-vxworks.ads b/gcc/ada/s-osinte-vxworks.ads index 7888cc18e68..09ace65013a 100644 --- a/gcc/ada/s-osinte-vxworks.ads +++ b/gcc/ada/s-osinte-vxworks.ads @@ -197,13 +197,13 @@ package System.OS_Interface is function tickGet return ULONG; pragma Import (C, tickGet, "tickGet"); - ----------------------------------------------------- - -- Convenience routine to convert between VxWorks -- - -- priority and Ada priority. -- - ----------------------------------------------------- + ---------------------- + -- Utility Routines -- + ---------------------- function To_VxWorks_Priority (Priority : in int) return int; pragma Inline (To_VxWorks_Priority); + -- Convenience routine to convert between VxWorks priority and Ada priority -------------------------- -- VxWorks specific API -- diff --git a/gcc/ada/s-osprim-vxworks.adb b/gcc/ada/s-osprim-vxworks.adb index 0f32bbe6dce..9ee6648c6c9 100644 --- a/gcc/ada/s-osprim-vxworks.adb +++ b/gcc/ada/s-osprim-vxworks.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2002 Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2004 Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -47,9 +47,9 @@ package body System.OS_Primitives is use System.OS_Interface; use type Interfaces.C.int; - -------------------------- - -- Internal functions -- - -------------------------- + ------------------------ + -- Internal functions -- + ------------------------ function To_Clock_Ticks (D : Duration) return int; -- Convert a duration value (in seconds) into clock ticks. diff --git a/gcc/ada/s-taprop-dummy.adb b/gcc/ada/s-taprop-dummy.adb index bd5d05800f5..c6d4ba07c7c 100644 --- a/gcc/ada/s-taprop-dummy.adb +++ b/gcc/ada/s-taprop-dummy.adb @@ -55,49 +55,79 @@ package body System.Task_Primitives.Operations is pragma Warnings (Off); -- Turn off warnings since so many unreferenced parameters - ----------------- - -- Stack_Guard -- - ----------------- + No_Tasking : Boolean; + -- Comment required here ??? - procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is + ---------------- + -- Abort_Task -- + ---------------- + + procedure Abort_Task (T : Task_Id) is begin null; - end Stack_Guard; + end Abort_Task; + + ---------------- + -- Check_Exit -- + ---------------- + + -- Dummy version + + function Check_Exit (Self_ID : ST.Task_Id) return Boolean is + begin + return True; + end Check_Exit; -------------------- - -- Get_Thread_Id -- + -- Check_No_Locks -- -------------------- - function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is + function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is begin - return OSI.Thread_Id (T.Common.LL.Thread); - end Get_Thread_Id; + return True; + end Check_No_Locks; - ---------- - -- Self -- - ---------- + ---------------------- + -- Environment_Task -- + ---------------------- - function Self return Task_Id is + function Environment_Task return Task_Id is begin - return Null_Task; - end Self; + return null; + end Environment_Task; - --------------------- - -- Initialize_Lock -- - --------------------- + ----------------- + -- Create_Task -- + ----------------- - procedure Initialize_Lock - (Prio : System.Any_Priority; - L : access Lock) + procedure Create_Task + (T : Task_Id; + Wrapper : System.Address; + Stack_Size : System.Parameters.Size_Type; + Priority : System.Any_Priority; + Succeeded : out Boolean) is begin + Succeeded := False; + end Create_Task; + + ---------------- + -- Enter_Task -- + ---------------- + + procedure Enter_Task (Self_ID : Task_Id) is + begin null; - end Initialize_Lock; + end Enter_Task; - procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level) is + --------------- + -- Exit_Task -- + --------------- + + procedure Exit_Task is begin null; - end Initialize_Lock; + end Exit_Task; ------------------- -- Finalize_Lock -- @@ -113,92 +143,85 @@ package body System.Task_Primitives.Operations is null; end Finalize_Lock; - ---------------- - -- Write_Lock -- - ---------------- - - procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is - begin - Ceiling_Violation := False; - end Write_Lock; + ------------------ + -- Finalize_TCB -- + ------------------ - procedure Write_Lock - (L : access RTS_Lock; - Global_Lock : Boolean := False) - is + procedure Finalize_TCB (T : Task_Id) is begin null; - end Write_Lock; + end Finalize_TCB; - procedure Write_Lock (T : Task_Id) is + ------------------ + -- Get_Priority -- + ------------------ + + function Get_Priority (T : Task_Id) return System.Any_Priority is begin - null; - end Write_Lock; + return 0; + end Get_Priority; - --------------- - -- Read_Lock -- - --------------- + -------------------- + -- Get_Thread_Id -- + -------------------- - procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean) is + function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is begin - Ceiling_Violation := False; - end Read_Lock; + return OSI.Thread_Id (T.Common.LL.Thread); + end Get_Thread_Id; - ------------ - -- Unlock -- - ------------ + ---------------- + -- Initialize -- + ---------------- - procedure Unlock (L : access Lock) is + procedure Initialize (Environment_Task : Task_Id) is begin null; - end Unlock; + end Initialize; - procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is + --------------------- + -- Initialize_Lock -- + --------------------- + + procedure Initialize_Lock + (Prio : System.Any_Priority; + L : access Lock) + is begin null; - end Unlock; + end Initialize_Lock; - procedure Unlock (T : Task_Id) is + procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level) is begin null; - end Unlock; + end Initialize_Lock; - ----------- - -- Sleep -- - ----------- + -------------------- + -- Initialize_TCB -- + -------------------- - procedure Sleep (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is + procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is begin - null; - end Sleep; + Succeeded := False; + end Initialize_TCB; - ----------------- - -- Timed_Sleep -- - ----------------- + ------------------- + -- Is_Valid_Task -- + ------------------- - procedure Timed_Sleep - (Self_ID : Task_Id; - Time : Duration; - Mode : ST.Delay_Modes; - Reason : System.Tasking.Task_States; - Timedout : out Boolean; - Yielded : out Boolean) is + function Is_Valid_Task return Boolean is begin - Timedout := False; - Yielded := False; - end Timed_Sleep; + return False; + end Is_Valid_Task; - ----------------- - -- Timed_Delay -- - ----------------- + -------------- + -- Lock_RTS -- + -------------- - procedure Timed_Delay - (Self_ID : Task_Id; - Time : Duration; - Mode : ST.Delay_Modes) is + procedure Lock_RTS is begin null; - end Timed_Delay; + end Lock_RTS; --------------------- -- Monotonic_Clock -- @@ -209,54 +232,6 @@ package body System.Task_Primitives.Operations is return 0.0; end Monotonic_Clock; - ------------------- - -- RT_Resolution -- - ------------------- - - function RT_Resolution return Duration is - begin - return 10#1.0#E-6; - end RT_Resolution; - - ------------ - -- Wakeup -- - ------------ - - procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is - begin - null; - end Wakeup; - - ------------------ - -- Set_Priority -- - ------------------ - - procedure Set_Priority - (T : Task_Id; - Prio : System.Any_Priority; - Loss_Of_Inheritance : Boolean := False) is - begin - null; - end Set_Priority; - - ------------------ - -- Get_Priority -- - ------------------ - - function Get_Priority (T : Task_Id) return System.Any_Priority is - begin - return 0; - end Get_Priority; - - ---------------- - -- Enter_Task -- - ---------------- - - procedure Enter_Task (Self_ID : Task_Id) is - begin - null; - end Enter_Task; - -------------- -- New_ATCB -- -------------- @@ -266,14 +241,14 @@ package body System.Task_Primitives.Operations is return new Ada_Task_Control_Block (Entry_Num); end New_ATCB; - ------------------- - -- Is_Valid_Task -- - ------------------- + --------------- + -- Read_Lock -- + --------------- - function Is_Valid_Task return Boolean is + procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean) is begin - return False; - end Is_Valid_Task; + Ceiling_Violation := False; + end Read_Lock; ----------------------------- -- Register_Foreign_Thread -- @@ -284,103 +259,127 @@ package body System.Task_Primitives.Operations is return null; end Register_Foreign_Thread; - ---------------------- - -- Initialize_TCB -- - ---------------------- + ----------------- + -- Resume_Task -- + ----------------- - procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is + function Resume_Task + (T : ST.Task_Id; + Thread_Self : OSI.Thread_Id) return Boolean + is begin - Succeeded := False; - end Initialize_TCB; + return False; + end Resume_Task; - ----------------- - -- Create_Task -- - ----------------- + ------------------- + -- RT_Resolution -- + ------------------- - procedure Create_Task - (T : Task_Id; - Wrapper : System.Address; - Stack_Size : System.Parameters.Size_Type; - Priority : System.Any_Priority; - Succeeded : out Boolean) is + function RT_Resolution return Duration is begin - Succeeded := False; - end Create_Task; + return 10#1.0#E-6; + end RT_Resolution; + + ---------- + -- Self -- + ---------- + + function Self return Task_Id is + begin + return Null_Task; + end Self; ------------------ - -- Finalize_TCB -- + -- Set_Priority -- ------------------ - procedure Finalize_TCB (T : Task_Id) is + procedure Set_Priority + (T : Task_Id; + Prio : System.Any_Priority; + Loss_Of_Inheritance : Boolean := False) + is begin null; - end Finalize_TCB; + end Set_Priority; - --------------- - -- Exit_Task -- - --------------- + ----------- + -- Sleep -- + ----------- - procedure Exit_Task is + procedure Sleep (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is begin null; - end Exit_Task; + end Sleep; - ---------------- - -- Abort_Task -- - ---------------- + ----------------- + -- Stack_Guard -- + ----------------- - procedure Abort_Task (T : Task_Id) is + procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is begin null; - end Abort_Task; + end Stack_Guard; - ----------- - -- Yield -- - ----------- + ------------------ + -- Suspend_Task -- + ------------------ - procedure Yield (Do_Yield : Boolean := True) is + function Suspend_Task + (T : ST.Task_Id; + Thread_Self : OSI.Thread_Id) return Boolean + is begin - null; - end Yield; - - ---------------- - -- Check_Exit -- - ---------------- + return False; + end Suspend_Task; - -- Dummy versions. The only currently working versions is for solaris - -- (native). + ----------------- + -- Timed_Delay -- + ----------------- - function Check_Exit (Self_ID : ST.Task_Id) return Boolean is + procedure Timed_Delay + (Self_ID : Task_Id; + Time : Duration; + Mode : ST.Delay_Modes) + is begin - return True; - end Check_Exit; + null; + end Timed_Delay; - -------------------- - -- Check_No_Locks -- - -------------------- + ----------------- + -- Timed_Sleep -- + ----------------- - function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is + procedure Timed_Sleep + (Self_ID : Task_Id; + Time : Duration; + Mode : ST.Delay_Modes; + Reason : System.Tasking.Task_States; + Timedout : out Boolean; + Yielded : out Boolean) + is begin - return True; - end Check_No_Locks; + Timedout := False; + Yielded := False; + end Timed_Sleep; - ---------------------- - -- Environment_Task -- - ---------------------- + ------------ + -- Unlock -- + ------------ - function Environment_Task return Task_Id is + procedure Unlock (L : access Lock) is begin - return null; - end Environment_Task; + null; + end Unlock; - -------------- - -- Lock_RTS -- - -------------- + procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is + begin + null; + end Unlock; - procedure Lock_RTS is + procedure Unlock (T : Task_Id) is begin null; - end Lock_RTS; + end Unlock; ---------------- -- Unlock_RTS -- @@ -390,41 +389,45 @@ package body System.Task_Primitives.Operations is begin null; end Unlock_RTS; + ------------ + -- Wakeup -- + ------------ - ------------------ - -- Suspend_Task -- - ------------------ - - function Suspend_Task - (T : ST.Task_Id; - Thread_Self : OSI.Thread_Id) return Boolean - is + procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is begin - return False; - end Suspend_Task; + null; + end Wakeup; - ----------------- - -- Resume_Task -- - ----------------- + ---------------- + -- Write_Lock -- + ---------------- - function Resume_Task - (T : ST.Task_Id; - Thread_Self : OSI.Thread_Id) return Boolean - is + procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is begin - return False; - end Resume_Task; + Ceiling_Violation := False; + end Write_Lock; - ---------------- - -- Initialize -- - ---------------- + procedure Write_Lock + (L : access RTS_Lock; + Global_Lock : Boolean := False) + is + begin + null; + end Write_Lock; - procedure Initialize (Environment_Task : Task_Id) is + procedure Write_Lock (T : Task_Id) is begin null; - end Initialize; + end Write_Lock; - No_Tasking : Boolean; + ----------- + -- Yield -- + ----------- + + procedure Yield (Do_Yield : Boolean := True) is + begin + null; + end Yield; begin -- Can't raise an exception because target independent packages try to diff --git a/gcc/ada/s-taprop-hpux-dce.adb b/gcc/ada/s-taprop-hpux-dce.adb index 1789635f685..c5a13d03951 100644 --- a/gcc/ada/s-taprop-hpux-dce.adb +++ b/gcc/ada/s-taprop-hpux-dce.adb @@ -73,7 +73,7 @@ with System.Soft_Links; -- Note that we do not use System.Tasking.Initialization directly since -- this is a higher level package that we shouldn't depend on. For example -- when using the restricted run time, it is replaced by --- System.Tasking.Restricted.Initialization +-- System.Tasking.Restricted.Stages. with System.OS_Primitives; -- used for Delay_Modes @@ -93,9 +93,9 @@ package body System.Task_Primitives.Operations is package PIO renames System.Task_Primitives.Interrupt_Operations; package SSL renames System.Soft_Links; - ------------------ - -- Local Data -- - ------------------ + ---------------- + -- Local Data -- + ---------------- -- The followings are logically constants, but need to be initialized -- at run time. @@ -109,7 +109,7 @@ package body System.Task_Primitives.Operations is -- Key used to find the Ada Task_Id associated with a thread Environment_Task_Id : Task_Id; - -- A variable to hold Task_Id for the environment task. + -- A variable to hold Task_Id for the environment task Unblocked_Signal_Mask : aliased sigset_t; -- The set of signals that should unblocked in all tasks @@ -125,10 +125,10 @@ package body System.Task_Primitives.Operations is -- stage considered dead, and no further work is planned on it. FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F'; - -- Indicates whether FIFO_Within_Priorities is set. + -- Indicates whether FIFO_Within_Priorities is set Foreign_Task_Elaborated : aliased Boolean := True; - -- Used to identified fake tasks (i.e., non-Ada Threads). + -- Used to identified fake tasks (i.e., non-Ada Threads) -------------------- -- Local Packages -- @@ -138,7 +138,7 @@ package body System.Task_Primitives.Operations is procedure Initialize (Environment_Task : Task_Id); pragma Inline (Initialize); - -- Initialize various data needed by this package. + -- Initialize various data needed by this package function Is_Valid_Task return Boolean; pragma Inline (Is_Valid_Task); @@ -146,23 +146,23 @@ package body System.Task_Primitives.Operations is procedure Set (Self_Id : Task_Id); pragma Inline (Set); - -- Set the self id for the current task. + -- Set the self id for the current task function Self return Task_Id; pragma Inline (Self); - -- Return a pointer to the Ada Task Control Block of the calling task. + -- Return a pointer to the Ada Task Control Block of the calling task end Specific; package body Specific is separate; - -- The body of this package is target specific. + -- The body of this package is target specific --------------------------------- -- Support for foreign threads -- --------------------------------- function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; - -- Allocate and Initialize a new ATCB for the current Thread. + -- Allocate and Initialize a new ATCB for the current Thread function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id is separate; @@ -339,7 +339,6 @@ package body System.Task_Primitives.Operations is (L : access RTS_Lock; Global_Lock : Boolean := False) is Result : Interfaces.C.int; - begin if not Single_Lock or else Global_Lock then Result := pthread_mutex_lock (L); @@ -349,7 +348,6 @@ package body System.Task_Primitives.Operations is procedure Write_Lock (T : Task_Id) is Result : Interfaces.C.int; - begin if not Single_Lock then Result := pthread_mutex_lock (T.Common.LL.L'Access); @@ -372,7 +370,6 @@ package body System.Task_Primitives.Operations is procedure Unlock (L : access Lock) is Result : Interfaces.C.int; - begin Result := pthread_mutex_unlock (L.L'Access); pragma Assert (Result = 0); @@ -389,7 +386,6 @@ package body System.Task_Primitives.Operations is procedure Unlock (T : Task_Id) is Result : Interfaces.C.int; - begin if not Single_Lock then Result := pthread_mutex_unlock (T.Common.LL.L'Access); @@ -417,7 +413,8 @@ package body System.Task_Primitives.Operations is (Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access); end if; - -- EINTR is not considered a failure. + -- EINTR is not considered a failure + pragma Assert (Result = 0 or else Result = EINTR); end Sleep; @@ -498,9 +495,8 @@ package body System.Task_Primitives.Operations is Result : Interfaces.C.int; begin - -- Only the little window between deferring abort and - -- locking Self_ID is the reason we need to - -- check for pending abort and priority change below! :( + -- The little window between deferring abort and locking Self_ID is the + -- only reason to check for pending abort and priority change below! SSL.Abort_Defer.all; @@ -564,7 +560,6 @@ package body System.Task_Primitives.Operations is function Monotonic_Clock return Duration is TS : aliased timespec; Result : Interfaces.C.int; - begin Result := Clock_Gettime (CLOCK_REALTIME, TS'Unchecked_Access); pragma Assert (Result = 0); @@ -918,8 +913,7 @@ package body System.Task_Primitives.Operations is -- Check_Exit -- ---------------- - -- Dummy versions. The only currently working versions is for solaris - -- (native). + -- Dummy version function Check_Exit (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); @@ -974,7 +968,6 @@ package body System.Task_Primitives.Operations is is pragma Unreferenced (T); pragma Unreferenced (Thread_Self); - begin return False; end Suspend_Task; @@ -989,7 +982,6 @@ package body System.Task_Primitives.Operations is is pragma Unreferenced (T); pragma Unreferenced (Thread_Self); - begin return False; end Resume_Task; @@ -1007,9 +999,8 @@ package body System.Task_Primitives.Operations is function State (Int : System.Interrupt_Management.Interrupt_ID) return Character; pragma Import (C, State, "__gnat_get_interrupt_state"); - -- Get interrupt state. Defined in a-init.c - -- The input argument is the interrupt number, - -- and the result is one of the following: + -- Get interrupt state. Defined in a-init.c. The input argument is + -- the interrupt number, and the result is one of the following: Default : constant Character := 's'; -- 'n' this interrupt not set by any Interrupt_State pragma @@ -1021,7 +1012,7 @@ package body System.Task_Primitives.Operations is begin Environment_Task_Id := Environment_Task; - -- Initialize the lock used to synchronize chain of all ATCBs. + -- Initialize the lock used to synchronize chain of all ATCBs Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level); diff --git a/gcc/ada/s-taprop-irix-athread.adb b/gcc/ada/s-taprop-irix-athread.adb index 31965743c52..78580ac5558 100644 --- a/gcc/ada/s-taprop-irix-athread.adb +++ b/gcc/ada/s-taprop-irix-athread.adb @@ -74,7 +74,7 @@ with System.Soft_Links; -- Note that we do not use System.Tasking.Initialization directly since -- this is a higher level package that we shouldn't depend on. For example -- when using the restricted run time, it is replaced by --- System.Tasking.Restricted.Initialization +-- System.Tasking.Restricted.Stages. with System.OS_Primitives; -- used for Delay_Modes @@ -129,9 +129,9 @@ package body System.Task_Primitives.Operations is function To_Task_Id is new Unchecked_Conversion (System.Address, Task_Id); function To_Address is new Unchecked_Conversion (Task_Id, System.Address); - ------------------- - -- Stack_Guard -- - ------------------- + ----------------- + -- Stack_Guard -- + ----------------- -- The underlying thread system sets a guard page at the -- bottom of a thread stack, so nothing is needed. @@ -566,7 +566,6 @@ package body System.Task_Primitives.Operations is T.Common.Current_Priority := Prio; Result := pthread_setprio (T.Common.LL.Thread, Interfaces.C.int (Prio)); pragma Assert (Result /= FUNC_ERR); - end Set_Priority; ------------------ @@ -634,9 +633,9 @@ package body System.Task_Primitives.Operations is return null; end Register_Foreign_Thread; - ---------------------- - -- Initialize_TCB -- - ---------------------- + -------------------- + -- Initialize_TCB -- + -------------------- procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is Result : Interfaces.C.int; @@ -942,7 +941,7 @@ package body System.Task_Primitives.Operations is pragma Assert (Result /= FUNC_ERR); if Result = FUNC_ERR then - raise Storage_Error; -- Insufficient resources. + raise Storage_Error; -- Insufficient resources end if; end Initialize_Athread_Library; diff --git a/gcc/ada/s-taprop-irix.adb b/gcc/ada/s-taprop-irix.adb index 83fb530e7a2..21b330182d5 100644 --- a/gcc/ada/s-taprop-irix.adb +++ b/gcc/ada/s-taprop-irix.adb @@ -75,7 +75,7 @@ with System.Soft_Links; -- Note that we do not use System.Tasking.Initialization directly since -- this is a higher level package that we shouldn't depend on. For example -- when using the restricted run time, it is replaced by --- System.Tasking.Restricted.Initialization +-- System.Tasking.Restricted.Stages. with System.Program_Info; -- used for Default_Task_Stack @@ -104,9 +104,9 @@ package body System.Task_Primitives.Operations is package SSL renames System.Soft_Links; - ------------------ - -- Local Data -- - ------------------ + ---------------- + -- Local Data -- + ---------------- -- The followings are logically constants, but need to be initialized -- at run time. @@ -120,7 +120,7 @@ package body System.Task_Primitives.Operations is -- Key used to find the Ada Task_Id associated with a thread Environment_Task_Id : Task_Id; - -- A variable to hold Task_Id for the environment task. + -- A variable to hold Task_Id for the environment task Locking_Policy : Character; pragma Import (C, Locking_Policy, "__gl_locking_policy"); @@ -130,7 +130,7 @@ package body System.Task_Primitives.Operations is Unblocked_Signal_Mask : aliased sigset_t; Foreign_Task_Elaborated : aliased Boolean := True; - -- Used to identified fake tasks (i.e., non-Ada Threads). + -- Used to identified fake tasks (i.e., non-Ada Threads) -------------------- -- Local Packages -- @@ -140,7 +140,7 @@ package body System.Task_Primitives.Operations is procedure Initialize (Environment_Task : Task_Id); pragma Inline (Initialize); - -- Initialize various data needed by this package. + -- Initialize various data needed by this package function Is_Valid_Task return Boolean; pragma Inline (Is_Valid_Task); @@ -148,23 +148,23 @@ package body System.Task_Primitives.Operations is procedure Set (Self_Id : Task_Id); pragma Inline (Set); - -- Set the self id for the current task. + -- Set the self id for the current task function Self return Task_Id; pragma Inline (Self); - -- Return a pointer to the Ada Task Control Block of the calling task. + -- Return a pointer to the Ada Task Control Block of the calling task end Specific; package body Specific is separate; - -- The body of this package is target specific. + -- The body of this package is target specific --------------------------------- -- Support for foreign threads -- --------------------------------- function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; - -- Allocate and Initialize a new ATCB for the current Thread. + -- Allocate and Initialize a new ATCB for the current Thread function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id is separate; @@ -176,7 +176,7 @@ package body System.Task_Primitives.Operations is function To_Address is new Unchecked_Conversion (Task_Id, System.Address); procedure Abort_Handler (Sig : Signal); - -- Signal handler used to implement asynchronous abort. + -- Signal handler used to implement asynchronous abort ------------------- -- Abort_Handler -- @@ -440,7 +440,7 @@ package body System.Task_Primitives.Operations is (Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access); end if; - -- EINTR is not considered a failure. + -- EINTR is not considered a failure pragma Assert (Result = 0 or else Result = EINTR); end Sleep; @@ -506,9 +506,8 @@ package body System.Task_Primitives.Operations is -- Timed_Delay -- ----------------- - -- This is for use in implementing delay statements, so - -- we assume the caller is abort-deferred but is holding - -- no locks. + -- This is for use in implementing delay statements, so we assume + -- the caller is abort-deferred but is holding no locks. procedure Timed_Delay (Self_ID : Task_Id; @@ -521,9 +520,9 @@ package body System.Task_Primitives.Operations is Result : Interfaces.C.int; begin - -- Only the little window between deferring abort and - -- locking Self_ID is the reason we need to - -- check for pending abort and priority change below! :( + -- The little window between deferring abort and locking Self_ID is + -- the only reason we need to check for pending abort and priority + -- change below! SSL.Abort_Defer.all; @@ -598,10 +597,11 @@ package body System.Task_Primitives.Operations is -- resolution of reading the clock. Even though this last value is -- only guaranteed to be 100 Hz, at least the Origin 200 appears to -- have a microsecond resolution or better. + -- ??? We should figure out a method to return the right value on -- all SGI hardware. - return 0.000_001; -- Assume microsecond resolution of clock + return 0.000_001; end RT_Resolution; ------------ @@ -1121,8 +1121,9 @@ begin end loop; -- Pick the highest resolution Clock for Clock_Realtime + -- ??? This code currently doesn't work (see c94007[ab] for example) - -- + -- if syssgi (SGI_CYCLECNTR_SIZE) = 64 then -- Real_Time_Clock_Id := CLOCK_SGI_CYCLE; -- else diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb index 250bd8de779..e2aab2e2c0e 100644 --- a/gcc/ada/s-taprop-linux.adb +++ b/gcc/ada/s-taprop-linux.adb @@ -75,7 +75,7 @@ with System.Soft_Links; -- Note that we do not use System.Tasking.Initialization directly since -- this is a higher level package that we shouldn't depend on. For example -- when using the restricted run time, it is replaced by --- System.Tasking.Restricted.Initialization +-- System.Tasking.Restricted.Stages. with System.OS_Primitives; -- used for Delay_Modes @@ -97,9 +97,9 @@ package body System.Task_Primitives.Operations is package SSL renames System.Soft_Links; - ------------------ - -- Local Data -- - ------------------ + ---------------- + -- Local Data -- + ---------------- -- The followings are logically constants, but need to be initialized -- at run time. @@ -113,18 +113,18 @@ package body System.Task_Primitives.Operations is -- Key used to find the Ada Task_Id associated with a thread Environment_Task_Id : Task_Id; - -- A variable to hold Task_Id for the environment task. + -- A variable to hold Task_Id for the environment task Unblocked_Signal_Mask : aliased sigset_t; -- The set of signals that should unblocked in all tasks - -- The followings are internal configuration constants needed. + -- The followings are internal configuration constants needed + Priority_Ceiling_Emulation : constant Boolean := True; Next_Serial_Number : Task_Serial_Number := 100; -- We start at 100, to reserve some special values for -- using in error checking. - -- The following are internal configuration constants needed. Time_Slice_Val : Integer; pragma Import (C, Time_Slice_Val, "__gl_time_slice_val"); @@ -133,7 +133,7 @@ package body System.Task_Primitives.Operations is pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy"); FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F'; - -- Indicates whether FIFO_Within_Priorities is set. + -- Indicates whether FIFO_Within_Priorities is set -- The following are effectively constants, but they need to -- be initialized by calling a pthread_ function. @@ -142,7 +142,7 @@ package body System.Task_Primitives.Operations is Cond_Attr : aliased pthread_condattr_t; Foreign_Task_Elaborated : aliased Boolean := True; - -- Used to identified fake tasks (i.e., non-Ada Threads). + -- Used to identified fake tasks (i.e., non-Ada Threads) -------------------- -- Local Packages -- @@ -152,7 +152,7 @@ package body System.Task_Primitives.Operations is procedure Initialize (Environment_Task : Task_Id); pragma Inline (Initialize); - -- Initialize various data needed by this package. + -- Initialize various data needed by this package function Is_Valid_Task return Boolean; pragma Inline (Is_Valid_Task); @@ -160,7 +160,7 @@ package body System.Task_Primitives.Operations is procedure Set (Self_Id : Task_Id); pragma Inline (Set); - -- Set the self id for the current task. + -- Set the self id for the current task function Self return Task_Id; pragma Inline (Self); @@ -169,14 +169,14 @@ package body System.Task_Primitives.Operations is end Specific; package body Specific is separate; - -- The body of this package is target specific. + -- The body of this package is target specific --------------------------------- -- Support for foreign threads -- --------------------------------- function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; - -- Allocate and Initialize a new ATCB for the current Thread. + -- Allocate and Initialize a new ATCB for the current Thread function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id is separate; @@ -323,7 +323,6 @@ package body System.Task_Primitives.Operations is procedure Finalize_Lock (L : access Lock) is Result : Interfaces.C.int; - begin Result := pthread_mutex_destroy (L.L'Access); pragma Assert (Result = 0); @@ -331,7 +330,6 @@ package body System.Task_Primitives.Operations is procedure Finalize_Lock (L : access RTS_Lock) is Result : Interfaces.C.int; - begin Result := pthread_mutex_destroy (L); pragma Assert (Result = 0); @@ -381,7 +379,6 @@ package body System.Task_Primitives.Operations is Global_Lock : Boolean := False) is Result : Interfaces.C.int; - begin if not Single_Lock or else Global_Lock then Result := pthread_mutex_lock (L); @@ -391,7 +388,6 @@ package body System.Task_Primitives.Operations is procedure Write_Lock (T : Task_Id) is Result : Interfaces.C.int; - begin if not Single_Lock then Result := pthread_mutex_lock (T.Common.LL.L'Access); @@ -437,7 +433,6 @@ package body System.Task_Primitives.Operations is procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is Result : Interfaces.C.int; - begin if not Single_Lock or else Global_Lock then Result := pthread_mutex_unlock (L); @@ -447,7 +442,6 @@ package body System.Task_Primitives.Operations is procedure Unlock (T : Task_Id) is Result : Interfaces.C.int; - begin if not Single_Lock then Result := pthread_mutex_unlock (T.Common.LL.L'Access); @@ -478,7 +472,8 @@ package body System.Task_Primitives.Operations is (Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access); end if; - -- EINTR is not considered a failure. + -- EINTR is not considered a failure + pragma Assert (Result = 0 or else Result = EINTR); end Sleep; @@ -631,7 +626,6 @@ package body System.Task_Primitives.Operations is function Monotonic_Clock return Duration is TV : aliased struct_timeval; Result : Interfaces.C.int; - begin Result := gettimeofday (TV'Access, System.Null_Address); pragma Assert (Result = 0); @@ -785,7 +779,7 @@ package body System.Task_Primitives.Operations is Result : Interfaces.C.int; begin - -- Give the task a unique serial number. + -- Give the task a unique serial number Self_ID.Serial_Number := Next_Serial_Number; Next_Serial_Number := Next_Serial_Number + 1; @@ -932,7 +926,6 @@ package body System.Task_Primitives.Operations is procedure Abort_Task (T : Task_Id) is Result : Interfaces.C.int; - begin Result := pthread_kill (T.Common.LL.Thread, Signal (System.Interrupt_Management.Abort_Task_Interrupt)); diff --git a/gcc/ada/s-taprop-lynxos.adb b/gcc/ada/s-taprop-lynxos.adb index 2b2af90ca5e..ec50bae835b 100644 --- a/gcc/ada/s-taprop-lynxos.adb +++ b/gcc/ada/s-taprop-lynxos.adb @@ -74,7 +74,7 @@ with System.Soft_Links; -- Note that we do not use System.Tasking.Initialization directly since -- this is a higher level package that we shouldn't depend on. For example -- when using the restricted run time, it is replaced by --- System.Tasking.Restricted.Initialization +-- System.Tasking.Restricted.Stages. with System.OS_Primitives; -- used for Delay_Modes @@ -821,9 +821,9 @@ package body System.Task_Primitives.Operations is end if; end Register_Foreign_Thread; - ---------------------- - -- Initialize_TCB -- - ---------------------- + -------------------- + -- Initialize_TCB -- + -------------------- procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is Mutex_Attr : aliased pthread_mutexattr_t; @@ -831,7 +831,7 @@ package body System.Task_Primitives.Operations is Cond_Attr : aliased pthread_condattr_t; begin - -- Give the task a unique serial number. + -- Give the task a unique serial number Self_ID.Serial_Number := Next_Serial_Number; Next_Serial_Number := Next_Serial_Number + 1; @@ -1016,8 +1016,10 @@ package body System.Task_Primitives.Operations is procedure Abort_Task (T : Task_Id) is Result : Interfaces.C.int; begin - Result := pthread_kill (T.Common.LL.Thread, - Signal (System.Interrupt_Management.Abort_Task_Interrupt)); + Result := + pthread_kill + (T.Common.LL.Thread, + Signal (System.Interrupt_Management.Abort_Task_Interrupt)); pragma Assert (Result = 0); end Abort_Task; diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb index 049a63d42a5..5656661f8ca 100644 --- a/gcc/ada/s-taprop-mingw.adb +++ b/gcc/ada/s-taprop-mingw.adb @@ -67,7 +67,7 @@ with System.Soft_Links; -- Note that we do not use System.Tasking.Initialization directly since -- this is a higher level package that we shouldn't depend on. For example -- when using the restricted run time, it is replaced by --- System.Tasking.Restricted.Initialization +-- System.Tasking.Restricted.Stages. with System.OS_Primitives; -- used for Delay_Modes diff --git a/gcc/ada/s-taprop-os2.adb b/gcc/ada/s-taprop-os2.adb index 7556af3d025..c53a05e122c 100644 --- a/gcc/ada/s-taprop-os2.adb +++ b/gcc/ada/s-taprop-os2.adb @@ -68,7 +68,7 @@ with System.Soft_Links; -- Note that we do not use System.Tasking.Initialization directly since -- this is a higher level package that we shouldn't depend on. For example -- when using the restricted run time, it is replaced by --- System.Tasking.Restricted.Initialization +-- System.Tasking.Restricted.Stages. with System.OS_Primitives; -- used for Delay_Modes diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb index 0e84a75891b..4d8057dc3d2 100644 --- a/gcc/ada/s-taprop-posix.adb +++ b/gcc/ada/s-taprop-posix.adb @@ -79,7 +79,7 @@ with System.Soft_Links; -- Note that we do not use System.Tasking.Initialization directly since -- this is a higher level package that we shouldn't depend on. For example -- when using the restricted run time, it is replaced by --- System.Tasking.Restricted.Initialization +-- System.Tasking.Restricted.Stages. with System.OS_Primitives; -- used for Delay_Modes diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb index 941e34a65cd..69db09f7e47 100644 --- a/gcc/ada/s-taprop-solaris.adb +++ b/gcc/ada/s-taprop-solaris.adb @@ -81,7 +81,7 @@ with System.Soft_Links; -- Note that we do not use System.Tasking.Initialization directly since -- this is a higher level package that we shouldn't depend on. For example -- when using the restricted run time, it is replaced by --- System.Tasking.Restricted.Initialization +-- System.Tasking.Restricted.Stages. with System.OS_Primitives; -- used for Delay_Modes @@ -311,9 +311,9 @@ package body System.Task_Primitives.Operations is end if; end Abort_Handler; - ------------------- - -- Stack_Guard -- - ------------------- + ----------------- + -- Stack_Guard -- + ----------------- -- The underlying thread system sets a guard page at the -- bottom of a thread stack, so nothing is needed. @@ -325,9 +325,9 @@ package body System.Task_Primitives.Operations is null; end Stack_Guard; - -------------------- - -- Get_Thread_Id -- - -------------------- + ------------------- + -- Get_Thread_Id -- + ------------------- function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is begin @@ -506,7 +506,7 @@ package body System.Task_Primitives.Operations is end Initialize_Lock; procedure Initialize_Lock - (L : access RTS_Lock; + (L : access RTS_Lock; Level : Lock_Level) is Result : Interfaces.C.int; diff --git a/gcc/ada/s-taprop-tru64.adb b/gcc/ada/s-taprop-tru64.adb index 88b4636204c..d569831f87e 100644 --- a/gcc/ada/s-taprop-tru64.adb +++ b/gcc/ada/s-taprop-tru64.adb @@ -77,7 +77,7 @@ with System.Soft_Links; -- Note that we do not use System.Tasking.Initialization directly since -- this is a higher level package that we shouldn't depend on. For example -- when using the restricted run time, it is replaced by --- System.Tasking.Restricted.Initialization +-- System.Tasking.Restricted.Stages. with System.OS_Primitives; -- used for Delay_Modes diff --git a/gcc/ada/s-taprop-vms.adb b/gcc/ada/s-taprop-vms.adb index c7c9839a07f..41612d49e30 100644 --- a/gcc/ada/s-taprop-vms.adb +++ b/gcc/ada/s-taprop-vms.adb @@ -61,7 +61,7 @@ with System.Soft_Links; -- Note that we do not use System.Tasking.Initialization directly since -- this is a higher level package that we shouldn't depend on. For example -- when using the restricted run time, it is replaced by --- System.Tasking.Restricted.Initialization +-- System.Tasking.Restricted.Stages. with System.OS_Primitives; -- used for Delay_Modes @@ -81,9 +81,9 @@ package body System.Task_Primitives.Operations is package SSL renames System.Soft_Links; - ------------------ - -- Local Data -- - ------------------ + ---------------- + -- Local Data -- + ---------------- -- The followings are logically constants, but need to be initialized -- at run time. @@ -706,9 +706,9 @@ package body System.Task_Primitives.Operations is end if; end Register_Foreign_Thread; - ---------------------- - -- Initialize_TCB -- - ---------------------- + -------------------- + -- Initialize_TCB -- + -------------------- procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is Mutex_Attr : aliased pthread_mutexattr_t; diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb index f83fc02e495..a3340a6f615 100644 --- a/gcc/ada/s-taprop-vxworks.adb +++ b/gcc/ada/s-taprop-vxworks.adb @@ -55,7 +55,7 @@ with System.Soft_Links; -- Note that we do not use System.Tasking.Initialization directly since -- this is a higher level package that we shouldn't depend on. For example -- when using the restricted run time, it is replaced by --- System.Tasking.Restricted.Initialization +-- System.Tasking.Restricted.Stages. with System.OS_Interface; -- used for various type, constant, and operations diff --git a/gcc/ada/s-tarest.adb b/gcc/ada/s-tarest.adb index 6b298a812a6..3d4a0fdb892 100644 --- a/gcc/ada/s-tarest.adb +++ b/gcc/ada/s-tarest.adb @@ -120,9 +120,9 @@ package body System.Tasking.Restricted.Stages is procedure Timed_Delay_T (Time : Duration; Mode : Integer); - ------------------------ - -- Local Subprograms -- - ------------------------ + ----------------------- + -- Local Subprograms -- + ----------------------- procedure Task_Wrapper (Self_ID : Task_Id); -- This is the procedure that is called by the GNULL from the diff --git a/gcc/ada/s-tasini.ads b/gcc/ada/s-tasini.ads index e44072c4efd..ca58df61e59 100644 --- a/gcc/ada/s-tasini.ads +++ b/gcc/ada/s-tasini.ads @@ -106,7 +106,7 @@ package System.Tasking.Initialization is -- For the sake of efficiency, the version with Self_ID as parameter -- should used wherever possible. These are all nestable. - -- Non-nestable inline versions -- + -- Non-nestable inline versions procedure Defer_Abort (Self_ID : Task_Id); pragma Inline (Defer_Abort); @@ -114,7 +114,7 @@ package System.Tasking.Initialization is procedure Undefer_Abort (Self_ID : Task_Id); pragma Inline (Undefer_Abort); - -- Nestable inline versions -- + -- Nestable inline versions procedure Defer_Abort_Nestable (Self_ID : Task_Id); pragma Inline (Defer_Abort_Nestable); @@ -135,9 +135,9 @@ package System.Tasking.Initialization is -- Returns Boolean'Pos (True) iff abort signal should raise -- Standard.Abort_Signal. Only used by IRIX currently. - --------------------------- - -- Change Base Priority -- - --------------------------- + -------------------------- + -- Change Base Priority -- + -------------------------- procedure Change_Base_Priority (T : Task_Id); -- Change the base priority of T. diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads index 0e08ffd3981..8e5616bf85f 100644 --- a/gcc/ada/s-taskin.ads +++ b/gcc/ada/s-taskin.ads @@ -55,21 +55,21 @@ with Unchecked_Conversion; package System.Tasking is - -- ------------------- - -- -- Locking Rules -- - -- ------------------- - -- + ------------------- + -- Locking Rules -- + ------------------- + -- The following rules must be followed at all times, to prevent -- deadlock and generally ensure correct operation of locking. - -- + -- . Never lock a lock unless abort is deferred. - -- + -- . Never undefer abort while holding a lock. - -- + -- . Overlapping critical sections must be properly nested, -- and locks must be released in LIFO order. -- e.g., the following is not allowed: - -- + -- Lock (X); -- ... -- Lock (Y); @@ -77,31 +77,31 @@ package System.Tasking is -- Unlock (X); -- ... -- Unlock (Y); - -- + -- Locks with lower (smaller) level number cannot be locked -- while holding a lock with a higher level number. (The level -- number is the number at the left.) - -- + -- 1. System.Tasking.PO_Simple.Protection.L (any PO lock) -- 2. System.Tasking.Initialization.Global_Task_Lock (in body) -- 3. System.Task_Primitives.Operations.Single_RTS_Lock -- 4. System.Tasking.Ada_Task_Control_Block.LL.L (any TCB lock) - -- + -- Clearly, there can be no circular chain of hold-and-wait -- relationships involving locks in different ordering levels. - -- + -- We used to have Global_Task_Lock before Protection.L but this was -- clearly wrong since there can be calls to "new" inside protected -- operations. The new ordering prevents these failures. - -- + -- Sometimes we need to hold two ATCB locks at the same time. To allow -- us to order the locking, each ATCB is given a unique serial -- number. If one needs to hold locks on several ATCBs at once, -- the locks with lower serial numbers must be locked first. - -- + -- We don't always need to check the serial numbers, since -- the serial numbers are assigned sequentially, and so: - -- + -- . The parent of a task always has a lower serial number. -- . The activator of a task always has a lower serial number. -- . The environment task has a lower serial number than any other task. @@ -360,25 +360,24 @@ package System.Tasking is -- Some protection is described in terms of tasks related to the -- ATCB being protected. These are: - -- Self: The task which is controlled by this ATCB. - -- Acceptor: A task accepting a call from Self. - -- Caller: A task calling an entry of Self. - -- Parent: The task executing the master on which Self depends. - -- Dependent: A task dependent on Self. - -- Activator: The task that created Self and initiated its activation. - -- Created: A task created and activated by Self. + -- Self: The task which is controlled by this ATCB + -- Acceptor: A task accepting a call from Self + -- Caller: A task calling an entry of Self + -- Parent: The task executing the master on which Self depends + -- Dependent: A task dependent on Self + -- Activator: The task that created Self and initiated its activation + -- Created: A task created and activated by Self -- Note: The order of the fields is important to implement efficiently -- tasking support under gdb. -- Currently gdb relies on the order of the State, Parent, Base_Priority, -- Task_Image, Task_Image_Len, Call and LL fields. - ---------------------------------------------------------------------- - -- Common ATCB section -- - -- -- - -- This section is used by all GNARL implementations (regular and -- - -- restricted) -- - ---------------------------------------------------------------------- + ------------------------- + -- Common ATCB section -- + ------------------------- + + -- Section used by all GNARL implementations (regular and restricted) type Common_ATCB is record State : Task_States; diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb index 3cbe7cc7b7f..9f363593eea 100644 --- a/gcc/ada/scng.adb +++ b/gcc/ada/scng.adb @@ -443,9 +443,9 @@ package body Scng is Error_Msg_S ("digit expected"); end Error_Digit_Expected; - ------------------- - -- Scan_Integer -- - ------------------- + ------------------ + -- Scan_Integer -- + ------------------ procedure Scan_Integer is C : Character; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 4e04afc3277..c1b018dc753 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -250,7 +250,8 @@ package body Sem_Attr is -- two attribute expressions are present procedure Legal_Formal_Attribute; - -- Common processing for attributes Definite, and Has_Discriminants + -- Common processing for attributes Definite, Has_Access_Values, + -- and Has_Discriminants procedure Check_Integer_Type; -- Verify that prefix of attribute N is an integer type @@ -2603,6 +2604,15 @@ package body Sem_Attr is Resolve (E1, P_Base_Type); ----------------------- + -- Has_Access_Values -- + ----------------------- + + when Attribute_Has_Access_Values => + Check_Type; + Check_E0; + Set_Etype (N, Standard_Boolean); + + ----------------------- -- Has_Discriminants -- ----------------------- @@ -4434,6 +4444,8 @@ package body Sem_Attr is elsif (Id = Attribute_Definite or else + Id = Attribute_Has_Access_Values + or else Id = Attribute_Has_Discriminants or else Id = Attribute_Type_Class @@ -4541,11 +4553,14 @@ package body Sem_Attr is -- In addition Component_Size is possibly foldable, even though it -- can never be static. - -- Definite, Has_Discriminants, Type_Class and Unconstrained_Array are - -- again exceptions, because they apply as well to unconstrained types. + -- Definite, Has_Access_Values, Has_Discriminants, Type_Class, and + -- Unconstrained_Array are again exceptions, because they apply as + -- well to unconstrained types. elsif Id = Attribute_Definite or else + Id = Attribute_Has_Access_Values + or else Id = Attribute_Has_Discriminants or else Id = Attribute_Type_Class @@ -4948,6 +4963,15 @@ package body Sem_Attr is Eval_Fat.Fraction (P_Root_Type, Expr_Value_R (E1)), Static); ----------------------- + -- Has_Access_Values -- + ----------------------- + + when Attribute_Has_Access_Values => + Rewrite (N, New_Occurrence_Of + (Boolean_Literals (Has_Access_Values (P_Root_Type)), Loc)); + Analyze_And_Resolve (N, Standard_Boolean); + + ----------------------- -- Has_Discriminants -- ----------------------- diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb index 1ad1baa6ac5..ea2f4ecccb1 100644 --- a/gcc/ada/sem_cat.adb +++ b/gcc/ada/sem_cat.adb @@ -1088,9 +1088,9 @@ package body Sem_Cat is end Validate_Object_Declaration; - -------------------------------- - -- Validate_RCI_Declarations -- - -------------------------------- + ------------------------------- + -- Validate_RCI_Declarations -- + ------------------------------- procedure Validate_RCI_Declarations (P : Entity_Id) is E : Entity_Id; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 0dca2b5bbaf..444c0836975 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -1311,9 +1311,9 @@ package body Sem_Ch10 is -- Remove current scope from scope stack, and preserve the list -- of use clauses in it, to be reinstalled after context is analyzed. - ------------------------------ - -- Analyze_Subunit_Context -- - ------------------------------ + ----------------------------- + -- Analyze_Subunit_Context -- + ----------------------------- procedure Analyze_Subunit_Context is Item : Node_Id; @@ -2868,9 +2868,9 @@ package body Sem_Ch10 is -- context_clause as a nonlimited with_clause that mentions -- the same library. - -------------------- - -- Check_Parent -- - -------------------- + ------------------ + -- Check_Parent -- + ------------------ procedure Check_Parent (P : Node_Id; W : Node_Id) is Item : Node_Id; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 9449c607f5b..4e05bd4fb87 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -2549,6 +2549,12 @@ package body Sem_Ch12 is if Unit_Requires_Body (Scop) then Enclosing_Body_Present := True; exit; + + elsif In_Open_Scopes (Scop) + and then In_Package_Body (Scop) + then + Enclosing_Body_Present := True; + exit; end if; exit when Is_Compilation_Unit (Scop); @@ -2847,9 +2853,9 @@ package body Sem_Ch12 is end if; end Analyze_Package_Instantiation; - --------------------------- - -- Inline_Instance_Body -- - --------------------------- + -------------------------- + -- Inline_Instance_Body -- + -------------------------- procedure Inline_Instance_Body (N : Node_Id; @@ -4583,9 +4589,9 @@ package body Sem_Ch12 is -- (for ASIS use) even though as the name of an enclosing generic -- it would otherwise not be preserved in the generic tree. - ----------------------- - -- Copy_Descendants -- - ----------------------- + ---------------------- + -- Copy_Descendants -- + ---------------------- procedure Copy_Descendants is diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 2030b3020a3..9b8518d966a 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1110,8 +1110,10 @@ package body Sem_Ch13 is and then Size /= System_Storage_Unit * 8 then + Error_Msg_Uint_1 := UI_From_Int (System_Storage_Unit); Error_Msg_N - ("size for primitive object must be power of 2", N); + ("size for primitive object must be a power of 2" + & " and at least ^", N); end if; end if; diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads index cc573ef154a..bfcade0e783 100644 --- a/gcc/ada/sem_ch13.ads +++ b/gcc/ada/sem_ch13.ads @@ -47,7 +47,7 @@ package Sem_Ch13 is function Minimum_Size (T : Entity_Id; Biased : Boolean := False) return Nat; - -- Given a primitive type, determines the minimum number of bits required + -- Given an elementary type, determines the minimum number of bits required -- to represent all values of the type. This function may not be called -- with any other types. If the flag Biased is set True, then the minimum -- size calculation that biased representation is used in the case of a diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index e84044e74c0..4e5b6cab027 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -1847,9 +1847,9 @@ package body Sem_Ch4 is Operator_Check (N); end Analyze_Negation; - ------------------- - -- Analyze_Null -- - ------------------- + ------------------ + -- Analyze_Null -- + ------------------ procedure Analyze_Null (N : Node_Id) is begin @@ -2134,9 +2134,9 @@ package body Sem_Ch4 is end if; end Analyze_One_Call; - ---------------------------- - -- Analyze_Operator_Call -- - ---------------------------- + --------------------------- + -- Analyze_Operator_Call -- + --------------------------- procedure Analyze_Operator_Call (N : Node_Id; Op_Id : Entity_Id) is Op_Name : constant Name_Id := Chars (Op_Id); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 8d2b53c50d5..3e4c4b332ea 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -4480,6 +4480,12 @@ package body Sem_Ch6 is if not Comes_From_Source (S) then null; + -- If the subprogram is at library level, it is not a + -- primitive operation. + + elsif Current_Scope = Standard_Standard then + null; + elsif (Ekind (Current_Scope) = E_Package and then not In_Package_Body (Current_Scope)) or else Overriding diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 2331802c62c..01c28d3315a 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -799,9 +799,9 @@ package body Sem_Ch7 is end if; end Is_Public_Child; - -------------------------------------------- - -- Inspect_Deferred_Constant_Completion -- - -------------------------------------------- + ------------------------------------------ + -- Inspect_Deferred_Constant_Completion -- + ------------------------------------------ procedure Inspect_Deferred_Constant_Completion is Decl : Node_Id; @@ -1935,7 +1935,7 @@ package body Sem_Ch7 is end; end if; - -- Otherwise search entity chain for entity requiring completion. + -- Otherwise search entity chain for entity requiring completion E := First_Entity (P); while Present (E) loop @@ -1947,6 +1947,14 @@ package body Sem_Ch7 is if Is_Child_Unit (E) then null; + -- Ignore formal packages and their renamings + + elsif Ekind (E) = E_Package + and then Nkind (Original_Node (Unit_Declaration_Node (E))) = + N_Formal_Package_Declaration + then + null; + -- Otherwise test to see if entity requires a completion elsif (Is_Overloadable (E) diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index ea64e37a592..55806aa7bb0 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -549,18 +549,18 @@ package body Sem_Ch8 is end if; end Analyze_Expanded_Name; - ---------------------------------------- - -- Analyze_Generic_Function_Renaming -- - ---------------------------------------- + --------------------------------------- + -- Analyze_Generic_Function_Renaming -- + --------------------------------------- procedure Analyze_Generic_Function_Renaming (N : Node_Id) is begin Analyze_Generic_Renaming (N, E_Generic_Function); end Analyze_Generic_Function_Renaming; - --------------------------------------- - -- Analyze_Generic_Package_Renaming -- - --------------------------------------- + -------------------------------------- + -- Analyze_Generic_Package_Renaming -- + -------------------------------------- procedure Analyze_Generic_Package_Renaming (N : Node_Id) is begin @@ -572,9 +572,9 @@ package body Sem_Ch8 is Analyze_Generic_Renaming (N, E_Generic_Package); end Analyze_Generic_Package_Renaming; - ----------------------------------------- - -- Analyze_Generic_Procedure_Renaming -- - ----------------------------------------- + ---------------------------------------- + -- Analyze_Generic_Procedure_Renaming -- + ---------------------------------------- procedure Analyze_Generic_Procedure_Renaming (N : Node_Id) is begin @@ -1941,9 +1941,9 @@ package body Sem_Ch8 is Scope_Stack.Table (Scope_Stack.Last).First_Use_Clause := N; end Chain_Use_Clause; - ---------------------------- - -- Check_Frozen_Renaming -- - ---------------------------- + --------------------------- + -- Check_Frozen_Renaming -- + --------------------------- procedure Check_Frozen_Renaming (N : Node_Id; Subp : Entity_Id) is B_Node : Node_Id; diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 5c85af2d600..183118f3225 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -66,21 +66,19 @@ package body Sem_Disp is function Check_Controlling_Type (T : Entity_Id; - Subp : Entity_Id) - return Entity_Id; + Subp : Entity_Id) return Entity_Id; -- T is the type of a formal parameter of subp. Returns the tagged -- if the parameter can be a controlling argument, empty otherwise - -------------------------------- - -- Add_Dispatching_Operation -- - -------------------------------- + ------------------------------- + -- Add_Dispatching_Operation -- + ------------------------------- procedure Add_Dispatching_Operation (Tagged_Type : Entity_Id; New_Op : Entity_Id) is List : constant Elist_Id := Primitive_Operations (Tagged_Type); - begin Append_Elmt (New_Op, List); end Add_Dispatching_Operation; @@ -200,8 +198,7 @@ package body Sem_Disp is function Check_Controlling_Type (T : Entity_Id; - Subp : Entity_Id) - return Entity_Id + Subp : Entity_Id) return Entity_Id is Tagged_Type : Entity_Id := Empty; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index e4689a67e35..0434d67ae74 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -5658,9 +5658,9 @@ package body Sem_Prag is Source_Location); end Eliminate; - -------------------------- - -- Explicit_Overriding -- - -------------------------- + ------------------------- + -- Explicit_Overriding -- + ------------------------- when Pragma_Explicit_Overriding => Check_Valid_Configuration_Pragma; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 53574d60673..23903e42ecb 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -4974,9 +4974,9 @@ package body Sem_Res is Eval_Integer_Literal (N); end Resolve_Integer_Literal; - --------------------------------- - -- Resolve_Intrinsic_Operator -- - --------------------------------- + -------------------------------- + -- Resolve_Intrinsic_Operator -- + -------------------------------- procedure Resolve_Intrinsic_Operator (N : Node_Id; Typ : Entity_Id) is Btyp : constant Entity_Id := Base_Type (Underlying_Type (Typ)); diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index cc3f63f65f5..8f2ccad2350 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -59,14 +59,14 @@ package body Sem_Type is -- of clash lists are stored in array Headers. -- Headers Interp_Map All_Interp - -- - -- _ ------- ---------- + + -- _ +-----+ +--------+ -- |_| |_____| --->|interp1 | -- |_|---------->|node | | |interp2 | -- |_| |index|---------| |nointerp| -- |_| |next | | | -- |-----| | | - -- ------- ---------- + -- +-----+ +--------+ -- This scheme does not currently reclaim interpretations. In principle, -- after a unit is compiled, all overloadings have been resolved, and the @@ -1559,9 +1559,9 @@ package body Sem_Type is raise Program_Error; end Get_First_Interp; - ---------------------- - -- Get_Next_Interp -- - ---------------------- + --------------------- + -- Get_Next_Interp -- + --------------------- procedure Get_Next_Interp (I : in out Interp_Index; It : out Interp) is begin @@ -2365,9 +2365,9 @@ package body Sem_Type is end if; end Write_Overloads; - ----------------------- - -- Write_Interp_Ref -- - ----------------------- + ---------------------- + -- Write_Interp_Ref -- + ---------------------- procedure Write_Interp_Ref (Map_Ptr : Int) is begin diff --git a/gcc/ada/sem_type.ads b/gcc/ada/sem_type.ads index b30791bc093..d4d3c472c86 100644 --- a/gcc/ada/sem_type.ads +++ b/gcc/ada/sem_type.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -72,9 +72,9 @@ package Sem_Type is subtype Interp_Index is Int; - ---------------------- - -- Error Reporting -- - ---------------------- + --------------------- + -- Error Reporting -- + --------------------- -- A common error is the use of an operator in infix notation on arguments -- of a type that is not directly visible. Rather than diagnosing a type diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index c1ef371672d..1f23ef3063f 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -2656,12 +2656,17 @@ package body Sem_Util is if Nkind (Decl) = N_Subprogram_Body then return Decl; + -- The below comment is bad, because it is possible for + -- Nkind (Decl) to be an N_Subprogram_Body_Stub ??? + else -- Nkind (Decl) = N_Subprogram_Declaration if Present (Corresponding_Body (Decl)) then return Unit_Declaration_Node (Corresponding_Body (Decl)); - else -- imported subprogram. + -- Imported subprogram case + + else return Empty; end if; end if; @@ -2676,6 +2681,55 @@ package body Sem_Util is return Task_Body_Procedure (Declaration_Node (Root_Type (E))); end Get_Task_Body_Procedure; + ----------------------- + -- Has_Access_Values -- + ----------------------- + + function Has_Access_Values (T : Entity_Id) return Boolean is + Typ : constant Entity_Id := Underlying_Type (T); + + begin + -- Case of a private type which is not completed yet. This can only + -- happen in the case of a generic format type appearing directly, or + -- as a component of the type to which this function is being applied + -- at the top level. Return False in this case, since we certainly do + -- not know that the type contains access types. + + if No (Typ) then + return False; + + elsif Is_Access_Type (Typ) then + return True; + + elsif Is_Array_Type (Typ) then + return Has_Access_Values (Component_Type (Typ)); + + elsif Is_Record_Type (Typ) then + declare + Comp : Entity_Id; + + begin + Comp := First_Entity (Typ); + while Present (Comp) loop + if (Ekind (Comp) = E_Component + or else + Ekind (Comp) = E_Discriminant) + and then Has_Access_Values (Etype (Comp)) + then + return True; + end if; + + Next_Entity (Comp); + end loop; + end; + + return False; + + else + return False; + end if; + end Has_Access_Values; + ---------------------- -- Has_Declarations -- ---------------------- @@ -4654,9 +4708,9 @@ package body Sem_Util is procedure Kill_Current_Values_For_Entity_Chain (E : Entity_Id); -- Clear current value for entity E and all entities chained to E - ------------------------------------------- - -- Kill_Current_Values_For_Entity_Chain -- - ------------------------------------------- + ------------------------------------------ + -- Kill_Current_Values_For_Entity_Chain -- + ------------------------------------------ procedure Kill_Current_Values_For_Entity_Chain (E : Entity_Id) is Ent : Entity_Id; @@ -4992,7 +5046,6 @@ package body Sem_Util is end if; Formal := First_Formal (S); - while Present (Formal) loop -- Match the formals in order. If the corresponding actual @@ -5094,7 +5147,6 @@ package body Sem_Util is Actual := First (Actuals); while Present (Actual) loop - if Nkind (Actual) = N_Parameter_Association and then Actual /= Last and then No (Next_Named_Actual (Actual)) @@ -5669,11 +5721,13 @@ package body Sem_Util is -- A transient scope is required when variable-sized temporaries are -- allocated in the primary or secondary stack, or when finalization - -- actions must be generated before the next instruction + -- actions must be generated before the next instruction. function Requires_Transient_Scope (Id : Entity_Id) return Boolean is Typ : constant Entity_Id := Underlying_Type (Id); + -- Start of processing for Requires_Transient_Scope + begin -- This is a private type which is not completed yet. This can only -- happen in a default expression (of a formal parameter or of a @@ -5682,23 +5736,22 @@ package body Sem_Util is if No (Typ) then return False; + -- Do not expand transient scope for non-existent procedure return + elsif Typ = Standard_Void_Type then return False; - -- The back-end has trouble allocating variable-size temporaries so - -- we generate them in the front-end and need a transient scope to - -- reclaim them properly + -- Elementary types do not require a transient scope - elsif not Size_Known_At_Compile_Time (Typ) then - return True; + elsif Is_Elementary_Type (Typ) then + return False; - -- Unconstrained discriminated records always require a variable - -- length temporary, since the length may depend on the variant. + -- Generally, indefinite subtypes require a transient scope, since the + -- back end cannot generate temporaries, since this is not a valid type + -- for declaring an object. It might be possible to relax this in the + -- future, e.g. by declaring the maximum possible space for the type. - elsif Is_Record_Type (Typ) - and then Has_Discriminants (Typ) - and then not Is_Constrained (Typ) - then + elsif Is_Indefinite_Subtype (Typ) then return True; -- Functions returning tagged types may dispatch on result so their @@ -5710,13 +5763,53 @@ package body Sem_Util is then return True; - -- Unconstrained array types are returned on the secondary stack + -- Record type. OK if none of the component types requires a transient + -- scope. Note that we already know that this is a definite type (i.e. + -- has discriminant defaults if it is a discriminated record). + + elsif Is_Record_Type (Typ) then + declare + Comp : Entity_Id; + begin + Comp := First_Entity (Typ); + while Present (Comp) loop + if Requires_Transient_Scope (Etype (Comp)) then + return True; + else + Next_Entity (Comp); + end if; + end loop; + end; + + return False; + + -- String literal types never require transient scope + + elsif Ekind (Typ) = E_String_Literal_Subtype then + return False; + + -- Array type. Note that we already know that this is a constrained + -- array, since unconstrained arrays will fail the indefinite test. elsif Is_Array_Type (Typ) then - return not Is_Constrained (Typ); - end if; - return False; + -- If component type requires a transient scope, the array does too + + if Requires_Transient_Scope (Component_Type (Typ)) then + return True; + + -- Otherwise, we only need a transient scope if the size is not + -- known at compile time. + + else + return not Size_Known_At_Compile_Time (Typ); + end if; + + -- All other cases do not require a transient scope + + else + return False; + end if; end Requires_Transient_Scope; -------------------------- @@ -6573,7 +6666,7 @@ package body Sem_Util is ("found function name, possibly missing Access attribute!", Expr); - -- catch common error: a prefix or infix operator which is not + -- Catch common error: a prefix or infix operator which is not -- directly visible because the type isn't. elsif Nkind (Expr) in N_Op diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index a32ddc09239..93e416535a4 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -357,6 +357,10 @@ package Sem_Util is -- Task_Body_Procedure field from the corresponding task type -- declaration. + function Has_Access_Values (T : Entity_Id) return Boolean; + -- Returns true if type or subtype T is an access type, or has a + -- component (at any recursive level) that is an access type. + function Has_Declarations (N : Node_Id) return Boolean; -- Determines if the node can have declarations diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 34561de049c..ba4c957327e 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -171,9 +171,9 @@ package body Sem_Warn is -- from another unit. This is true for entities in packages that are -- at the library level. - ----------------------- - -- Missing_Subunits -- - ----------------------- + ---------------------- + -- Missing_Subunits -- + ---------------------- function Missing_Subunits return Boolean is D : Node_Id; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 84f22c550aa..938e825515f 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -3065,9 +3065,9 @@ package Sinfo is -- node (which appears as a singleton list). Box_Present gives support -- to Ada 2005 (AI-287). - ------------------------------------ - -- 4.3.1 Commponent Choice List -- - ------------------------------------ + ----------------------------------- + -- 4.3.1 Commponent Choice List -- + ----------------------------------- -- COMPONENT_CHOICE_LIST ::= -- component_SELECTOR_NAME {| component_SELECTOR_NAME} diff --git a/gcc/ada/sinput-l.ads b/gcc/ada/sinput-l.ads index 3d71afd0dee..1b4e12860a5 100644 --- a/gcc/ada/sinput-l.ads +++ b/gcc/ada/sinput-l.ads @@ -34,9 +34,9 @@ with Types; use Types; package Sinput.L is - ------------------------------------------- - -- Subprograms for Loading Source Files -- - ------------------------------------------- + ------------------------------------------ + -- Subprograms for Loading Source Files -- + ------------------------------------------ function Load_Source_File (N : File_Name_Type) return Source_File_Index; -- Given a source file name, returns the index of the corresponding entry diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb index 2e2aeb58a44..5fbfdcaf3c7 100644 --- a/gcc/ada/snames.adb +++ b/gcc/ada/snames.adb @@ -145,6 +145,7 @@ package body Snames is "target#" & "req#" & "obj_typecode#" & + "stub#" & "Oabs#" & "Oand#" & "Omod#" & @@ -425,6 +426,7 @@ package body Snames is "first_bit#" & "fixed_value#" & "fore#" & + "has_access_values#" & "has_discriminants#" & "identity#" & "img#" & diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads index bcd57939ea5..545a3d0f39b 100644 --- a/gcc/ada/snames.ads +++ b/gcc/ada/snames.ads @@ -264,32 +264,33 @@ package Snames is Name_Target : constant Name_Id := N + 085; Name_Req : constant Name_Id := N + 086; Name_Obj_TypeCode : constant Name_Id := N + 087; + Name_Stub : constant Name_Id := N + 088; -- Operator Symbol entries. The actual names have an upper case O at -- the start in place of the Op_ prefix (e.g. the actual name that -- corresponds to Name_Op_Abs is "Oabs". - First_Operator_Name : constant Name_Id := N + 088; - Name_Op_Abs : constant Name_Id := N + 088; -- "abs" - Name_Op_And : constant Name_Id := N + 089; -- "and" - Name_Op_Mod : constant Name_Id := N + 090; -- "mod" - Name_Op_Not : constant Name_Id := N + 091; -- "not" - Name_Op_Or : constant Name_Id := N + 092; -- "or" - Name_Op_Rem : constant Name_Id := N + 093; -- "rem" - Name_Op_Xor : constant Name_Id := N + 094; -- "xor" - Name_Op_Eq : constant Name_Id := N + 095; -- "=" - Name_Op_Ne : constant Name_Id := N + 096; -- "/=" - Name_Op_Lt : constant Name_Id := N + 097; -- "<" - Name_Op_Le : constant Name_Id := N + 098; -- "<=" - Name_Op_Gt : constant Name_Id := N + 099; -- ">" - Name_Op_Ge : constant Name_Id := N + 100; -- ">=" - Name_Op_Add : constant Name_Id := N + 101; -- "+" - Name_Op_Subtract : constant Name_Id := N + 102; -- "-" - Name_Op_Concat : constant Name_Id := N + 103; -- "&" - Name_Op_Multiply : constant Name_Id := N + 104; -- "*" - Name_Op_Divide : constant Name_Id := N + 105; -- "/" - Name_Op_Expon : constant Name_Id := N + 106; -- "**" - Last_Operator_Name : constant Name_Id := N + 106; + First_Operator_Name : constant Name_Id := N + 089; + Name_Op_Abs : constant Name_Id := N + 089; -- "abs" + Name_Op_And : constant Name_Id := N + 090; -- "and" + Name_Op_Mod : constant Name_Id := N + 091; -- "mod" + Name_Op_Not : constant Name_Id := N + 092; -- "not" + Name_Op_Or : constant Name_Id := N + 093; -- "or" + Name_Op_Rem : constant Name_Id := N + 094; -- "rem" + Name_Op_Xor : constant Name_Id := N + 095; -- "xor" + Name_Op_Eq : constant Name_Id := N + 096; -- "=" + Name_Op_Ne : constant Name_Id := N + 097; -- "/=" + Name_Op_Lt : constant Name_Id := N + 098; -- "<" + Name_Op_Le : constant Name_Id := N + 099; -- "<=" + Name_Op_Gt : constant Name_Id := N + 100; -- ">" + Name_Op_Ge : constant Name_Id := N + 101; -- ">=" + Name_Op_Add : constant Name_Id := N + 102; -- "+" + Name_Op_Subtract : constant Name_Id := N + 103; -- "-" + Name_Op_Concat : constant Name_Id := N + 104; -- "&" + Name_Op_Multiply : constant Name_Id := N + 105; -- "*" + Name_Op_Divide : constant Name_Id := N + 106; -- "/" + Name_Op_Expon : constant Name_Id := N + 107; -- "**" + Last_Operator_Name : constant Name_Id := N + 107; -- Names for all pragmas recognized by GNAT. The entries with the comment -- "Ada 83" are pragmas that are defined in Ada 83, but not in Ada 95. @@ -312,64 +313,64 @@ package Snames is -- only in GNAT for the AAMP. They are ignored in other versions with -- appropriate warnings. - First_Pragma_Name : constant Name_Id := N + 107; + First_Pragma_Name : constant Name_Id := N + 108; -- Configuration pragmas are grouped at start - Name_Ada_83 : constant Name_Id := N + 107; -- GNAT - Name_Ada_95 : constant Name_Id := N + 108; -- GNAT - Name_Ada_05 : constant Name_Id := N + 109; -- GNAT - Name_C_Pass_By_Copy : constant Name_Id := N + 110; -- GNAT - Name_Compile_Time_Warning : constant Name_Id := N + 111; -- GNAT - Name_Component_Alignment : constant Name_Id := N + 112; -- GNAT - Name_Convention_Identifier : constant Name_Id := N + 113; -- GNAT - Name_Detect_Blocking : constant Name_Id := N + 114; -- Ada05 - Name_Discard_Names : constant Name_Id := N + 115; - Name_Elaboration_Checks : constant Name_Id := N + 116; -- GNAT - Name_Eliminate : constant Name_Id := N + 117; -- GNAT - Name_Explicit_Overriding : constant Name_Id := N + 118; - Name_Extend_System : constant Name_Id := N + 119; -- GNAT - Name_Extensions_Allowed : constant Name_Id := N + 120; -- GNAT - Name_External_Name_Casing : constant Name_Id := N + 121; -- GNAT - Name_Float_Representation : constant Name_Id := N + 122; -- GNAT - Name_Initialize_Scalars : constant Name_Id := N + 123; -- GNAT - Name_Interrupt_State : constant Name_Id := N + 124; -- GNAT - Name_License : constant Name_Id := N + 125; -- GNAT - Name_Locking_Policy : constant Name_Id := N + 126; - Name_Long_Float : constant Name_Id := N + 127; -- VMS - Name_No_Run_Time : constant Name_Id := N + 128; -- GNAT - Name_No_Strict_Aliasing : constant Name_Id := N + 129; -- GNAT - Name_Normalize_Scalars : constant Name_Id := N + 130; - Name_Polling : constant Name_Id := N + 131; -- GNAT - Name_Persistent_Data : constant Name_Id := N + 132; -- GNAT - Name_Persistent_Object : constant Name_Id := N + 133; -- GNAT - Name_Profile : constant Name_Id := N + 134; -- Ada05 - Name_Profile_Warnings : constant Name_Id := N + 135; -- GNAT - Name_Propagate_Exceptions : constant Name_Id := N + 136; -- GNAT - Name_Queuing_Policy : constant Name_Id := N + 137; - Name_Ravenscar : constant Name_Id := N + 138; - Name_Restricted_Run_Time : constant Name_Id := N + 139; - Name_Restrictions : constant Name_Id := N + 140; - Name_Restriction_Warnings : constant Name_Id := N + 141; -- GNAT - Name_Reviewable : constant Name_Id := N + 142; - Name_Source_File_Name : constant Name_Id := N + 143; -- GNAT - Name_Source_File_Name_Project : constant Name_Id := N + 144; -- GNAT - Name_Style_Checks : constant Name_Id := N + 145; -- GNAT - Name_Suppress : constant Name_Id := N + 146; - Name_Suppress_Exception_Locations : constant Name_Id := N + 147; -- GNAT - Name_Task_Dispatching_Policy : constant Name_Id := N + 148; - Name_Universal_Data : constant Name_Id := N + 149; -- AAMP - Name_Unsuppress : constant Name_Id := N + 150; -- GNAT - Name_Use_VADS_Size : constant Name_Id := N + 151; -- GNAT - Name_Validity_Checks : constant Name_Id := N + 152; -- GNAT - Name_Warnings : constant Name_Id := N + 153; -- GNAT - Last_Configuration_Pragma_Name : constant Name_Id := N + 153; + Name_Ada_83 : constant Name_Id := N + 108; -- GNAT + Name_Ada_95 : constant Name_Id := N + 109; -- GNAT + Name_Ada_05 : constant Name_Id := N + 110; -- GNAT + Name_C_Pass_By_Copy : constant Name_Id := N + 111; -- GNAT + Name_Compile_Time_Warning : constant Name_Id := N + 112; -- GNAT + Name_Component_Alignment : constant Name_Id := N + 113; -- GNAT + Name_Convention_Identifier : constant Name_Id := N + 114; -- GNAT + Name_Detect_Blocking : constant Name_Id := N + 115; -- Ada05 + Name_Discard_Names : constant Name_Id := N + 116; + Name_Elaboration_Checks : constant Name_Id := N + 117; -- GNAT + Name_Eliminate : constant Name_Id := N + 118; -- GNAT + Name_Explicit_Overriding : constant Name_Id := N + 119; + Name_Extend_System : constant Name_Id := N + 120; -- GNAT + Name_Extensions_Allowed : constant Name_Id := N + 121; -- GNAT + Name_External_Name_Casing : constant Name_Id := N + 122; -- GNAT + Name_Float_Representation : constant Name_Id := N + 123; -- GNAT + Name_Initialize_Scalars : constant Name_Id := N + 124; -- GNAT + Name_Interrupt_State : constant Name_Id := N + 125; -- GNAT + Name_License : constant Name_Id := N + 126; -- GNAT + Name_Locking_Policy : constant Name_Id := N + 127; + Name_Long_Float : constant Name_Id := N + 128; -- VMS + Name_No_Run_Time : constant Name_Id := N + 129; -- GNAT + Name_No_Strict_Aliasing : constant Name_Id := N + 130; -- GNAT + Name_Normalize_Scalars : constant Name_Id := N + 131; + Name_Polling : constant Name_Id := N + 132; -- GNAT + Name_Persistent_Data : constant Name_Id := N + 133; -- GNAT + Name_Persistent_Object : constant Name_Id := N + 134; -- GNAT + Name_Profile : constant Name_Id := N + 135; -- Ada05 + Name_Profile_Warnings : constant Name_Id := N + 136; -- GNAT + Name_Propagate_Exceptions : constant Name_Id := N + 137; -- GNAT + Name_Queuing_Policy : constant Name_Id := N + 138; + Name_Ravenscar : constant Name_Id := N + 139; + Name_Restricted_Run_Time : constant Name_Id := N + 140; + Name_Restrictions : constant Name_Id := N + 141; + Name_Restriction_Warnings : constant Name_Id := N + 142; -- GNAT + Name_Reviewable : constant Name_Id := N + 143; + Name_Source_File_Name : constant Name_Id := N + 144; -- GNAT + Name_Source_File_Name_Project : constant Name_Id := N + 145; -- GNAT + Name_Style_Checks : constant Name_Id := N + 146; -- GNAT + Name_Suppress : constant Name_Id := N + 147; + Name_Suppress_Exception_Locations : constant Name_Id := N + 148; -- GNAT + Name_Task_Dispatching_Policy : constant Name_Id := N + 149; + Name_Universal_Data : constant Name_Id := N + 150; -- AAMP + Name_Unsuppress : constant Name_Id := N + 151; -- GNAT + Name_Use_VADS_Size : constant Name_Id := N + 152; -- GNAT + Name_Validity_Checks : constant Name_Id := N + 153; -- GNAT + Name_Warnings : constant Name_Id := N + 154; -- GNAT + Last_Configuration_Pragma_Name : constant Name_Id := N + 154; -- Remaining pragma names - Name_Abort_Defer : constant Name_Id := N + 154; -- GNAT - Name_All_Calls_Remote : constant Name_Id := N + 155; - Name_Annotate : constant Name_Id := N + 156; -- GNAT + Name_Abort_Defer : constant Name_Id := N + 155; -- GNAT + Name_All_Calls_Remote : constant Name_Id := N + 156; + Name_Annotate : constant Name_Id := N + 157; -- 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 @@ -377,78 +378,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 + 157; -- GNAT - Name_Asynchronous : constant Name_Id := N + 158; - Name_Atomic : constant Name_Id := N + 159; - Name_Atomic_Components : constant Name_Id := N + 160; - Name_Attach_Handler : constant Name_Id := N + 161; - Name_Comment : constant Name_Id := N + 162; -- GNAT - Name_Common_Object : constant Name_Id := N + 163; -- GNAT - Name_Complex_Representation : constant Name_Id := N + 164; -- GNAT - Name_Controlled : constant Name_Id := N + 165; - Name_Convention : constant Name_Id := N + 166; - Name_CPP_Class : constant Name_Id := N + 167; -- GNAT - Name_CPP_Constructor : constant Name_Id := N + 168; -- GNAT - Name_CPP_Virtual : constant Name_Id := N + 169; -- GNAT - Name_CPP_Vtable : constant Name_Id := N + 170; -- GNAT - Name_Debug : constant Name_Id := N + 171; -- GNAT - Name_Elaborate : constant Name_Id := N + 172; -- Ada 83 - Name_Elaborate_All : constant Name_Id := N + 173; - Name_Elaborate_Body : constant Name_Id := N + 174; - Name_Export : constant Name_Id := N + 175; - Name_Export_Exception : constant Name_Id := N + 176; -- VMS - Name_Export_Function : constant Name_Id := N + 177; -- GNAT - Name_Export_Object : constant Name_Id := N + 178; -- GNAT - Name_Export_Procedure : constant Name_Id := N + 179; -- GNAT - Name_Export_Value : constant Name_Id := N + 180; -- GNAT - Name_Export_Valued_Procedure : constant Name_Id := N + 181; -- GNAT - Name_External : constant Name_Id := N + 182; -- GNAT - Name_Finalize_Storage_Only : constant Name_Id := N + 183; -- GNAT - Name_Ident : constant Name_Id := N + 184; -- VMS - Name_Import : constant Name_Id := N + 185; - Name_Import_Exception : constant Name_Id := N + 186; -- VMS - Name_Import_Function : constant Name_Id := N + 187; -- GNAT - Name_Import_Object : constant Name_Id := N + 188; -- GNAT - Name_Import_Procedure : constant Name_Id := N + 189; -- GNAT - Name_Import_Valued_Procedure : constant Name_Id := N + 190; -- GNAT - Name_Inline : constant Name_Id := N + 191; - Name_Inline_Always : constant Name_Id := N + 192; -- GNAT - Name_Inline_Generic : constant Name_Id := N + 193; -- GNAT - Name_Inspection_Point : constant Name_Id := N + 194; - Name_Interface : constant Name_Id := N + 195; -- Ada 83 - Name_Interface_Name : constant Name_Id := N + 196; -- GNAT - Name_Interrupt_Handler : constant Name_Id := N + 197; - Name_Interrupt_Priority : constant Name_Id := N + 198; - Name_Java_Constructor : constant Name_Id := N + 199; -- GNAT - Name_Java_Interface : constant Name_Id := N + 200; -- GNAT - Name_Keep_Names : constant Name_Id := N + 201; -- GNAT - Name_Link_With : constant Name_Id := N + 202; -- GNAT - Name_Linker_Alias : constant Name_Id := N + 203; -- GNAT - Name_Linker_Options : constant Name_Id := N + 204; - Name_Linker_Section : constant Name_Id := N + 205; -- GNAT - Name_List : constant Name_Id := N + 206; - Name_Machine_Attribute : constant Name_Id := N + 207; -- GNAT - Name_Main : constant Name_Id := N + 208; -- GNAT - Name_Main_Storage : constant Name_Id := N + 209; -- GNAT - Name_Memory_Size : constant Name_Id := N + 210; -- Ada 83 - Name_No_Return : constant Name_Id := N + 211; -- GNAT - Name_Obsolescent : constant Name_Id := N + 212; -- GNAT - Name_Optimize : constant Name_Id := N + 213; - Name_Optional_Overriding : constant Name_Id := N + 214; - Name_Overriding : constant Name_Id := N + 215; - Name_Pack : constant Name_Id := N + 216; - Name_Page : constant Name_Id := N + 217; - Name_Passive : constant Name_Id := N + 218; -- GNAT - Name_Preelaborate : constant Name_Id := N + 219; - Name_Priority : constant Name_Id := N + 220; - Name_Psect_Object : constant Name_Id := N + 221; -- VMS - Name_Pure : constant Name_Id := N + 222; - Name_Pure_Function : constant Name_Id := N + 223; -- GNAT - Name_Remote_Call_Interface : constant Name_Id := N + 224; - Name_Remote_Types : constant Name_Id := N + 225; - Name_Share_Generic : constant Name_Id := N + 226; -- GNAT - Name_Shared : constant Name_Id := N + 227; -- Ada 83 - Name_Shared_Passive : constant Name_Id := N + 228; + Name_Assert : constant Name_Id := N + 158; -- GNAT + Name_Asynchronous : constant Name_Id := N + 159; + Name_Atomic : constant Name_Id := N + 160; + Name_Atomic_Components : constant Name_Id := N + 161; + Name_Attach_Handler : constant Name_Id := N + 162; + Name_Comment : constant Name_Id := N + 163; -- GNAT + Name_Common_Object : constant Name_Id := N + 164; -- GNAT + Name_Complex_Representation : constant Name_Id := N + 165; -- GNAT + Name_Controlled : constant Name_Id := N + 166; + Name_Convention : constant Name_Id := N + 167; + Name_CPP_Class : constant Name_Id := N + 168; -- GNAT + Name_CPP_Constructor : constant Name_Id := N + 169; -- GNAT + Name_CPP_Virtual : constant Name_Id := N + 170; -- GNAT + Name_CPP_Vtable : constant Name_Id := N + 171; -- GNAT + Name_Debug : constant Name_Id := N + 172; -- GNAT + Name_Elaborate : constant Name_Id := N + 173; -- Ada 83 + Name_Elaborate_All : constant Name_Id := N + 174; + Name_Elaborate_Body : constant Name_Id := N + 175; + Name_Export : constant Name_Id := N + 176; + Name_Export_Exception : constant Name_Id := N + 177; -- VMS + Name_Export_Function : constant Name_Id := N + 178; -- GNAT + Name_Export_Object : constant Name_Id := N + 179; -- GNAT + Name_Export_Procedure : constant Name_Id := N + 180; -- GNAT + Name_Export_Value : constant Name_Id := N + 181; -- GNAT + Name_Export_Valued_Procedure : constant Name_Id := N + 182; -- GNAT + Name_External : constant Name_Id := N + 183; -- GNAT + Name_Finalize_Storage_Only : constant Name_Id := N + 184; -- GNAT + Name_Ident : constant Name_Id := N + 185; -- VMS + Name_Import : constant Name_Id := N + 186; + Name_Import_Exception : constant Name_Id := N + 187; -- VMS + Name_Import_Function : constant Name_Id := N + 188; -- GNAT + Name_Import_Object : constant Name_Id := N + 189; -- GNAT + Name_Import_Procedure : constant Name_Id := N + 190; -- GNAT + Name_Import_Valued_Procedure : constant Name_Id := N + 191; -- GNAT + Name_Inline : constant Name_Id := N + 192; + Name_Inline_Always : constant Name_Id := N + 193; -- GNAT + Name_Inline_Generic : constant Name_Id := N + 194; -- GNAT + Name_Inspection_Point : constant Name_Id := N + 195; + Name_Interface : constant Name_Id := N + 196; -- Ada 83 + Name_Interface_Name : constant Name_Id := N + 197; -- GNAT + Name_Interrupt_Handler : constant Name_Id := N + 198; + Name_Interrupt_Priority : constant Name_Id := N + 199; + Name_Java_Constructor : constant Name_Id := N + 200; -- GNAT + Name_Java_Interface : constant Name_Id := N + 201; -- GNAT + Name_Keep_Names : constant Name_Id := N + 202; -- GNAT + Name_Link_With : constant Name_Id := N + 203; -- GNAT + Name_Linker_Alias : constant Name_Id := N + 204; -- GNAT + Name_Linker_Options : constant Name_Id := N + 205; + Name_Linker_Section : constant Name_Id := N + 206; -- GNAT + Name_List : constant Name_Id := N + 207; + Name_Machine_Attribute : constant Name_Id := N + 208; -- GNAT + Name_Main : constant Name_Id := N + 209; -- GNAT + Name_Main_Storage : constant Name_Id := N + 210; -- GNAT + Name_Memory_Size : constant Name_Id := N + 211; -- Ada 83 + Name_No_Return : constant Name_Id := N + 212; -- GNAT + Name_Obsolescent : constant Name_Id := N + 213; -- GNAT + Name_Optimize : constant Name_Id := N + 214; + Name_Optional_Overriding : constant Name_Id := N + 215; + Name_Overriding : constant Name_Id := N + 216; + Name_Pack : constant Name_Id := N + 217; + Name_Page : constant Name_Id := N + 218; + Name_Passive : constant Name_Id := N + 219; -- GNAT + Name_Preelaborate : constant Name_Id := N + 220; + Name_Priority : constant Name_Id := N + 221; + Name_Psect_Object : constant Name_Id := N + 222; -- VMS + Name_Pure : constant Name_Id := N + 223; + Name_Pure_Function : constant Name_Id := N + 224; -- GNAT + Name_Remote_Call_Interface : constant Name_Id := N + 225; + Name_Remote_Types : constant Name_Id := N + 226; + Name_Share_Generic : constant Name_Id := N + 227; -- GNAT + Name_Shared : constant Name_Id := N + 228; -- Ada 83 + Name_Shared_Passive : constant Name_Id := N + 229; -- Note: Storage_Size is not in this list because its name matches the -- name of the corresponding attribute. However, it is included in the @@ -458,27 +459,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 + 229; -- GNAT - Name_Stream_Convert : constant Name_Id := N + 230; -- GNAT - Name_Subtitle : constant Name_Id := N + 231; -- GNAT - Name_Suppress_All : constant Name_Id := N + 232; -- GNAT - Name_Suppress_Debug_Info : constant Name_Id := N + 233; -- GNAT - Name_Suppress_Initialization : constant Name_Id := N + 234; -- GNAT - Name_System_Name : constant Name_Id := N + 235; -- Ada 83 - Name_Task_Info : constant Name_Id := N + 236; -- GNAT - Name_Task_Name : constant Name_Id := N + 237; -- GNAT - Name_Task_Storage : constant Name_Id := N + 238; -- VMS - Name_Thread_Body : constant Name_Id := N + 239; -- GNAT - Name_Time_Slice : constant Name_Id := N + 240; -- GNAT - Name_Title : constant Name_Id := N + 241; -- GNAT - Name_Unchecked_Union : constant Name_Id := N + 242; -- GNAT - Name_Unimplemented_Unit : constant Name_Id := N + 243; -- GNAT - Name_Unreferenced : constant Name_Id := N + 244; -- GNAT - Name_Unreserve_All_Interrupts : constant Name_Id := N + 245; -- GNAT - Name_Volatile : constant Name_Id := N + 246; - Name_Volatile_Components : constant Name_Id := N + 247; - Name_Weak_External : constant Name_Id := N + 248; -- GNAT - Last_Pragma_Name : constant Name_Id := N + 248; + Name_Source_Reference : constant Name_Id := N + 230; -- GNAT + Name_Stream_Convert : constant Name_Id := N + 231; -- GNAT + Name_Subtitle : constant Name_Id := N + 232; -- GNAT + Name_Suppress_All : constant Name_Id := N + 233; -- GNAT + Name_Suppress_Debug_Info : constant Name_Id := N + 234; -- GNAT + Name_Suppress_Initialization : constant Name_Id := N + 235; -- GNAT + Name_System_Name : constant Name_Id := N + 236; -- Ada 83 + Name_Task_Info : constant Name_Id := N + 237; -- GNAT + Name_Task_Name : constant Name_Id := N + 238; -- GNAT + Name_Task_Storage : constant Name_Id := N + 239; -- VMS + Name_Thread_Body : constant Name_Id := N + 240; -- GNAT + Name_Time_Slice : constant Name_Id := N + 241; -- GNAT + Name_Title : constant Name_Id := N + 242; -- GNAT + Name_Unchecked_Union : constant Name_Id := N + 243; -- GNAT + Name_Unimplemented_Unit : constant Name_Id := N + 244; -- GNAT + Name_Unreferenced : constant Name_Id := N + 245; -- GNAT + Name_Unreserve_All_Interrupts : constant Name_Id := N + 246; -- GNAT + Name_Volatile : constant Name_Id := N + 247; + Name_Volatile_Components : constant Name_Id := N + 248; + Name_Weak_External : constant Name_Id := N + 249; -- GNAT + Last_Pragma_Name : constant Name_Id := N + 249; -- Language convention names for pragma Convention/Export/Import/Interface -- Note that Name_C is not included in this list, since it was already @@ -489,105 +490,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 + 249; - Name_Ada : constant Name_Id := N + 249; - Name_Assembler : constant Name_Id := N + 250; - Name_COBOL : constant Name_Id := N + 251; - Name_CPP : constant Name_Id := N + 252; - Name_Fortran : constant Name_Id := N + 253; - Name_Intrinsic : constant Name_Id := N + 254; - Name_Java : constant Name_Id := N + 255; - Name_Stdcall : constant Name_Id := N + 256; - Name_Stubbed : constant Name_Id := N + 257; - Last_Convention_Name : constant Name_Id := N + 257; + First_Convention_Name : constant Name_Id := N + 250; + Name_Ada : constant Name_Id := N + 250; + Name_Assembler : constant Name_Id := N + 251; + Name_COBOL : constant Name_Id := N + 252; + Name_CPP : constant Name_Id := N + 253; + Name_Fortran : constant Name_Id := N + 254; + Name_Intrinsic : constant Name_Id := N + 255; + Name_Java : constant Name_Id := N + 256; + Name_Stdcall : constant Name_Id := N + 257; + Name_Stubbed : constant Name_Id := N + 258; + Last_Convention_Name : constant Name_Id := N + 258; -- The following names are preset as synonyms for Assembler - Name_Asm : constant Name_Id := N + 258; - Name_Assembly : constant Name_Id := N + 259; + Name_Asm : constant Name_Id := N + 259; + Name_Assembly : constant Name_Id := N + 260; -- The following names are preset as synonyms for C - Name_Default : constant Name_Id := N + 260; + Name_Default : constant Name_Id := N + 261; -- Name_Exernal (previously defined as pragma) -- The following names are present as synonyms for Stdcall - Name_DLL : constant Name_Id := N + 261; - Name_Win32 : constant Name_Id := N + 262; + Name_DLL : constant Name_Id := N + 262; + Name_Win32 : constant Name_Id := N + 263; -- Other special names used in processing pragmas - Name_As_Is : constant Name_Id := N + 263; - Name_Body_File_Name : constant Name_Id := N + 264; - Name_Boolean_Entry_Barriers : constant Name_Id := N + 265; - Name_Casing : constant Name_Id := N + 266; - Name_Code : constant Name_Id := N + 267; - Name_Component : constant Name_Id := N + 268; - Name_Component_Size_4 : constant Name_Id := N + 269; - Name_Copy : constant Name_Id := N + 270; - Name_D_Float : constant Name_Id := N + 271; - Name_Descriptor : constant Name_Id := N + 272; - Name_Dot_Replacement : constant Name_Id := N + 273; - Name_Dynamic : constant Name_Id := N + 274; - Name_Entity : constant Name_Id := N + 275; - Name_External_Name : constant Name_Id := N + 276; - Name_First_Optional_Parameter : constant Name_Id := N + 277; - Name_Form : constant Name_Id := N + 278; - Name_G_Float : constant Name_Id := N + 279; - Name_Gcc : constant Name_Id := N + 280; - Name_Gnat : constant Name_Id := N + 281; - Name_GPL : constant Name_Id := N + 282; - Name_IEEE_Float : constant Name_Id := N + 283; - Name_Internal : constant Name_Id := N + 284; - Name_Link_Name : constant Name_Id := N + 285; - Name_Lowercase : constant Name_Id := N + 286; - Name_Max_Entry_Queue_Depth : constant Name_Id := N + 287; - Name_Max_Entry_Queue_Length : constant Name_Id := N + 288; - Name_Max_Size : constant Name_Id := N + 289; - Name_Mechanism : constant Name_Id := N + 290; - Name_Mixedcase : constant Name_Id := N + 291; - Name_Modified_GPL : constant Name_Id := N + 292; - Name_Name : constant Name_Id := N + 293; - Name_NCA : constant Name_Id := N + 294; - Name_No : constant Name_Id := N + 295; - Name_On : constant Name_Id := N + 296; - Name_Parameter_Types : constant Name_Id := N + 297; - Name_Reference : constant Name_Id := N + 298; - Name_No_Dynamic_Attachment : constant Name_Id := N + 299; - Name_No_Dynamic_Interrupts : constant Name_Id := N + 300; - Name_No_Requeue : constant Name_Id := N + 301; - Name_No_Requeue_Statements : constant Name_Id := N + 302; - Name_No_Task_Attributes : constant Name_Id := N + 303; - Name_No_Task_Attributes_Package : constant Name_Id := N + 304; - Name_Restricted : constant Name_Id := N + 305; - Name_Result_Mechanism : constant Name_Id := N + 306; - Name_Result_Type : constant Name_Id := N + 307; - Name_Runtime : constant Name_Id := N + 308; - Name_SB : constant Name_Id := N + 309; - Name_Secondary_Stack_Size : constant Name_Id := N + 310; - Name_Section : constant Name_Id := N + 311; - Name_Semaphore : constant Name_Id := N + 312; - Name_Simple_Barriers : constant Name_Id := N + 313; - Name_Spec_File_Name : constant Name_Id := N + 314; - Name_Static : constant Name_Id := N + 315; - Name_Stack_Size : constant Name_Id := N + 316; - Name_Subunit_File_Name : constant Name_Id := N + 317; - Name_Task_Stack_Size_Default : constant Name_Id := N + 318; - Name_Task_Type : constant Name_Id := N + 319; - Name_Time_Slicing_Enabled : constant Name_Id := N + 320; - Name_Top_Guard : constant Name_Id := N + 321; - Name_UBA : constant Name_Id := N + 322; - Name_UBS : constant Name_Id := N + 323; - Name_UBSB : constant Name_Id := N + 324; - Name_Unit_Name : constant Name_Id := N + 325; - Name_Unknown : constant Name_Id := N + 326; - Name_Unrestricted : constant Name_Id := N + 327; - Name_Uppercase : constant Name_Id := N + 328; - Name_User : constant Name_Id := N + 329; - Name_VAX_Float : constant Name_Id := N + 330; - Name_VMS : constant Name_Id := N + 331; - Name_Working_Storage : constant Name_Id := N + 332; + Name_As_Is : constant Name_Id := N + 264; + Name_Body_File_Name : constant Name_Id := N + 265; + Name_Boolean_Entry_Barriers : constant Name_Id := N + 266; + Name_Casing : constant Name_Id := N + 267; + Name_Code : constant Name_Id := N + 268; + Name_Component : constant Name_Id := N + 269; + Name_Component_Size_4 : constant Name_Id := N + 270; + Name_Copy : constant Name_Id := N + 271; + Name_D_Float : constant Name_Id := N + 272; + Name_Descriptor : constant Name_Id := N + 273; + Name_Dot_Replacement : constant Name_Id := N + 274; + Name_Dynamic : constant Name_Id := N + 275; + Name_Entity : constant Name_Id := N + 276; + Name_External_Name : constant Name_Id := N + 277; + Name_First_Optional_Parameter : constant Name_Id := N + 278; + Name_Form : constant Name_Id := N + 279; + Name_G_Float : constant Name_Id := N + 280; + Name_Gcc : constant Name_Id := N + 281; + Name_Gnat : constant Name_Id := N + 282; + Name_GPL : constant Name_Id := N + 283; + Name_IEEE_Float : constant Name_Id := N + 284; + Name_Internal : constant Name_Id := N + 285; + Name_Link_Name : constant Name_Id := N + 286; + Name_Lowercase : constant Name_Id := N + 287; + Name_Max_Entry_Queue_Depth : constant Name_Id := N + 288; + Name_Max_Entry_Queue_Length : constant Name_Id := N + 289; + Name_Max_Size : constant Name_Id := N + 290; + Name_Mechanism : constant Name_Id := N + 291; + Name_Mixedcase : constant Name_Id := N + 292; + Name_Modified_GPL : constant Name_Id := N + 293; + Name_Name : constant Name_Id := N + 294; + Name_NCA : constant Name_Id := N + 295; + Name_No : constant Name_Id := N + 296; + Name_On : constant Name_Id := N + 297; + Name_Parameter_Types : constant Name_Id := N + 298; + Name_Reference : constant Name_Id := N + 299; + Name_No_Dynamic_Attachment : constant Name_Id := N + 300; + Name_No_Dynamic_Interrupts : constant Name_Id := N + 301; + Name_No_Requeue : constant Name_Id := N + 302; + Name_No_Requeue_Statements : constant Name_Id := N + 303; + Name_No_Task_Attributes : constant Name_Id := N + 304; + Name_No_Task_Attributes_Package : constant Name_Id := N + 305; + Name_Restricted : constant Name_Id := N + 306; + Name_Result_Mechanism : constant Name_Id := N + 307; + Name_Result_Type : constant Name_Id := N + 308; + Name_Runtime : constant Name_Id := N + 309; + Name_SB : constant Name_Id := N + 310; + Name_Secondary_Stack_Size : constant Name_Id := N + 311; + Name_Section : constant Name_Id := N + 312; + Name_Semaphore : constant Name_Id := N + 313; + Name_Simple_Barriers : constant Name_Id := N + 314; + Name_Spec_File_Name : constant Name_Id := N + 315; + Name_Static : constant Name_Id := N + 316; + Name_Stack_Size : constant Name_Id := N + 317; + Name_Subunit_File_Name : constant Name_Id := N + 318; + Name_Task_Stack_Size_Default : constant Name_Id := N + 319; + Name_Task_Type : constant Name_Id := N + 320; + Name_Time_Slicing_Enabled : constant Name_Id := N + 321; + Name_Top_Guard : constant Name_Id := N + 322; + Name_UBA : constant Name_Id := N + 323; + Name_UBS : constant Name_Id := N + 324; + Name_UBSB : constant Name_Id := N + 325; + Name_Unit_Name : constant Name_Id := N + 326; + Name_Unknown : constant Name_Id := N + 327; + Name_Unrestricted : constant Name_Id := N + 328; + Name_Uppercase : constant Name_Id := N + 329; + Name_User : constant Name_Id := N + 330; + Name_VAX_Float : constant Name_Id := N + 331; + Name_VMS : constant Name_Id := N + 332; + Name_Working_Storage : constant Name_Id := N + 333; -- 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 @@ -601,158 +602,159 @@ 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 + 333; - Name_Abort_Signal : constant Name_Id := N + 333; -- GNAT - Name_Access : constant Name_Id := N + 334; - Name_Address : constant Name_Id := N + 335; - Name_Address_Size : constant Name_Id := N + 336; -- GNAT - Name_Aft : constant Name_Id := N + 337; - Name_Alignment : constant Name_Id := N + 338; - Name_Asm_Input : constant Name_Id := N + 339; -- GNAT - Name_Asm_Output : constant Name_Id := N + 340; -- GNAT - Name_AST_Entry : constant Name_Id := N + 341; -- VMS - Name_Bit : constant Name_Id := N + 342; -- GNAT - Name_Bit_Order : constant Name_Id := N + 343; - Name_Bit_Position : constant Name_Id := N + 344; -- GNAT - Name_Body_Version : constant Name_Id := N + 345; - Name_Callable : constant Name_Id := N + 346; - Name_Caller : constant Name_Id := N + 347; - Name_Code_Address : constant Name_Id := N + 348; -- GNAT - Name_Component_Size : constant Name_Id := N + 349; - Name_Compose : constant Name_Id := N + 350; - Name_Constrained : constant Name_Id := N + 351; - Name_Count : constant Name_Id := N + 352; - Name_Default_Bit_Order : constant Name_Id := N + 353; -- GNAT - Name_Definite : constant Name_Id := N + 354; - Name_Delta : constant Name_Id := N + 355; - Name_Denorm : constant Name_Id := N + 356; - Name_Digits : constant Name_Id := N + 357; - Name_Elaborated : constant Name_Id := N + 358; -- GNAT - Name_Emax : constant Name_Id := N + 359; -- Ada 83 - Name_Enum_Rep : constant Name_Id := N + 360; -- GNAT - Name_Epsilon : constant Name_Id := N + 361; -- Ada 83 - Name_Exponent : constant Name_Id := N + 362; - Name_External_Tag : constant Name_Id := N + 363; - Name_First : constant Name_Id := N + 364; - Name_First_Bit : constant Name_Id := N + 365; - Name_Fixed_Value : constant Name_Id := N + 366; -- GNAT - Name_Fore : constant Name_Id := N + 367; - Name_Has_Discriminants : constant Name_Id := N + 368; -- GNAT - Name_Identity : constant Name_Id := N + 369; - Name_Img : constant Name_Id := N + 370; -- GNAT - Name_Integer_Value : constant Name_Id := N + 371; -- GNAT - Name_Large : constant Name_Id := N + 372; -- Ada 83 - Name_Last : constant Name_Id := N + 373; - Name_Last_Bit : constant Name_Id := N + 374; - Name_Leading_Part : constant Name_Id := N + 375; - Name_Length : constant Name_Id := N + 376; - Name_Machine_Emax : constant Name_Id := N + 377; - Name_Machine_Emin : constant Name_Id := N + 378; - Name_Machine_Mantissa : constant Name_Id := N + 379; - Name_Machine_Overflows : constant Name_Id := N + 380; - Name_Machine_Radix : constant Name_Id := N + 381; - Name_Machine_Rounds : constant Name_Id := N + 382; - Name_Machine_Size : constant Name_Id := N + 383; -- GNAT - Name_Mantissa : constant Name_Id := N + 384; -- Ada 83 - Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 385; - Name_Maximum_Alignment : constant Name_Id := N + 386; -- GNAT - Name_Mechanism_Code : constant Name_Id := N + 387; -- GNAT - Name_Model_Emin : constant Name_Id := N + 388; - Name_Model_Epsilon : constant Name_Id := N + 389; - Name_Model_Mantissa : constant Name_Id := N + 390; - Name_Model_Small : constant Name_Id := N + 391; - Name_Modulus : constant Name_Id := N + 392; - Name_Null_Parameter : constant Name_Id := N + 393; -- GNAT - Name_Object_Size : constant Name_Id := N + 394; -- GNAT - Name_Partition_ID : constant Name_Id := N + 395; - Name_Passed_By_Reference : constant Name_Id := N + 396; -- GNAT - Name_Pool_Address : constant Name_Id := N + 397; - Name_Pos : constant Name_Id := N + 398; - Name_Position : constant Name_Id := N + 399; - Name_Range : constant Name_Id := N + 400; - Name_Range_Length : constant Name_Id := N + 401; -- GNAT - Name_Round : constant Name_Id := N + 402; - Name_Safe_Emax : constant Name_Id := N + 403; -- Ada 83 - Name_Safe_First : constant Name_Id := N + 404; - Name_Safe_Large : constant Name_Id := N + 405; -- Ada 83 - Name_Safe_Last : constant Name_Id := N + 406; - Name_Safe_Small : constant Name_Id := N + 407; -- Ada 83 - Name_Scale : constant Name_Id := N + 408; - Name_Scaling : constant Name_Id := N + 409; - Name_Signed_Zeros : constant Name_Id := N + 410; - Name_Size : constant Name_Id := N + 411; - Name_Small : constant Name_Id := N + 412; - Name_Storage_Size : constant Name_Id := N + 413; - Name_Storage_Unit : constant Name_Id := N + 414; -- GNAT - Name_Tag : constant Name_Id := N + 415; - Name_Target_Name : constant Name_Id := N + 416; -- GNAT - Name_Terminated : constant Name_Id := N + 417; - Name_To_Address : constant Name_Id := N + 418; -- GNAT - Name_Type_Class : constant Name_Id := N + 419; -- GNAT - Name_UET_Address : constant Name_Id := N + 420; -- GNAT - Name_Unbiased_Rounding : constant Name_Id := N + 421; - Name_Unchecked_Access : constant Name_Id := N + 422; - Name_Unconstrained_Array : constant Name_Id := N + 423; - Name_Universal_Literal_String : constant Name_Id := N + 424; -- GNAT - Name_Unrestricted_Access : constant Name_Id := N + 425; -- GNAT - Name_VADS_Size : constant Name_Id := N + 426; -- GNAT - Name_Val : constant Name_Id := N + 427; - Name_Valid : constant Name_Id := N + 428; - Name_Value_Size : constant Name_Id := N + 429; -- GNAT - Name_Version : constant Name_Id := N + 430; - Name_Wchar_T_Size : constant Name_Id := N + 431; -- GNAT - Name_Wide_Width : constant Name_Id := N + 432; - Name_Width : constant Name_Id := N + 433; - Name_Word_Size : constant Name_Id := N + 434; -- GNAT + First_Attribute_Name : constant Name_Id := N + 334; + Name_Abort_Signal : constant Name_Id := N + 334; -- GNAT + Name_Access : constant Name_Id := N + 335; + Name_Address : constant Name_Id := N + 336; + Name_Address_Size : constant Name_Id := N + 337; -- GNAT + Name_Aft : constant Name_Id := N + 338; + Name_Alignment : constant Name_Id := N + 339; + Name_Asm_Input : constant Name_Id := N + 340; -- GNAT + Name_Asm_Output : constant Name_Id := N + 341; -- GNAT + Name_AST_Entry : constant Name_Id := N + 342; -- VMS + Name_Bit : constant Name_Id := N + 343; -- GNAT + Name_Bit_Order : constant Name_Id := N + 344; + Name_Bit_Position : constant Name_Id := N + 345; -- GNAT + Name_Body_Version : constant Name_Id := N + 346; + Name_Callable : constant Name_Id := N + 347; + Name_Caller : constant Name_Id := N + 348; + Name_Code_Address : constant Name_Id := N + 349; -- GNAT + Name_Component_Size : constant Name_Id := N + 350; + Name_Compose : constant Name_Id := N + 351; + Name_Constrained : constant Name_Id := N + 352; + Name_Count : constant Name_Id := N + 353; + Name_Default_Bit_Order : constant Name_Id := N + 354; -- GNAT + Name_Definite : constant Name_Id := N + 355; + Name_Delta : constant Name_Id := N + 356; + Name_Denorm : constant Name_Id := N + 357; + Name_Digits : constant Name_Id := N + 358; + Name_Elaborated : constant Name_Id := N + 359; -- GNAT + Name_Emax : constant Name_Id := N + 360; -- Ada 83 + Name_Enum_Rep : constant Name_Id := N + 361; -- GNAT + Name_Epsilon : constant Name_Id := N + 362; -- Ada 83 + Name_Exponent : constant Name_Id := N + 363; + Name_External_Tag : constant Name_Id := N + 364; + Name_First : constant Name_Id := N + 365; + Name_First_Bit : constant Name_Id := N + 366; + Name_Fixed_Value : constant Name_Id := N + 367; -- GNAT + Name_Fore : constant Name_Id := N + 368; + Name_Has_Access_Values : constant Name_Id := N + 369; -- GNAT + Name_Has_Discriminants : constant Name_Id := N + 370; -- GNAT + Name_Identity : constant Name_Id := N + 371; + Name_Img : constant Name_Id := N + 372; -- GNAT + Name_Integer_Value : constant Name_Id := N + 373; -- GNAT + Name_Large : constant Name_Id := N + 374; -- Ada 83 + Name_Last : constant Name_Id := N + 375; + Name_Last_Bit : constant Name_Id := N + 376; + Name_Leading_Part : constant Name_Id := N + 377; + Name_Length : constant Name_Id := N + 378; + Name_Machine_Emax : constant Name_Id := N + 379; + Name_Machine_Emin : constant Name_Id := N + 380; + Name_Machine_Mantissa : constant Name_Id := N + 381; + Name_Machine_Overflows : constant Name_Id := N + 382; + Name_Machine_Radix : constant Name_Id := N + 383; + Name_Machine_Rounds : constant Name_Id := N + 384; + Name_Machine_Size : constant Name_Id := N + 385; -- GNAT + Name_Mantissa : constant Name_Id := N + 386; -- Ada 83 + Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 387; + Name_Maximum_Alignment : constant Name_Id := N + 388; -- GNAT + Name_Mechanism_Code : constant Name_Id := N + 389; -- GNAT + Name_Model_Emin : constant Name_Id := N + 390; + Name_Model_Epsilon : constant Name_Id := N + 391; + Name_Model_Mantissa : constant Name_Id := N + 392; + Name_Model_Small : constant Name_Id := N + 393; + Name_Modulus : constant Name_Id := N + 394; + Name_Null_Parameter : constant Name_Id := N + 395; -- GNAT + Name_Object_Size : constant Name_Id := N + 396; -- GNAT + Name_Partition_ID : constant Name_Id := N + 397; + Name_Passed_By_Reference : constant Name_Id := N + 398; -- GNAT + Name_Pool_Address : constant Name_Id := N + 399; + Name_Pos : constant Name_Id := N + 400; + Name_Position : constant Name_Id := N + 401; + Name_Range : constant Name_Id := N + 402; + Name_Range_Length : constant Name_Id := N + 403; -- GNAT + Name_Round : constant Name_Id := N + 404; + Name_Safe_Emax : constant Name_Id := N + 405; -- Ada 83 + Name_Safe_First : constant Name_Id := N + 406; + Name_Safe_Large : constant Name_Id := N + 407; -- Ada 83 + Name_Safe_Last : constant Name_Id := N + 408; + Name_Safe_Small : constant Name_Id := N + 409; -- Ada 83 + Name_Scale : constant Name_Id := N + 410; + Name_Scaling : constant Name_Id := N + 411; + Name_Signed_Zeros : constant Name_Id := N + 412; + Name_Size : constant Name_Id := N + 413; + Name_Small : constant Name_Id := N + 414; + Name_Storage_Size : constant Name_Id := N + 415; + Name_Storage_Unit : constant Name_Id := N + 416; -- GNAT + Name_Tag : constant Name_Id := N + 417; + Name_Target_Name : constant Name_Id := N + 418; -- GNAT + Name_Terminated : constant Name_Id := N + 419; + Name_To_Address : constant Name_Id := N + 420; -- GNAT + Name_Type_Class : constant Name_Id := N + 421; -- GNAT + Name_UET_Address : constant Name_Id := N + 422; -- GNAT + Name_Unbiased_Rounding : constant Name_Id := N + 423; + Name_Unchecked_Access : constant Name_Id := N + 424; + Name_Unconstrained_Array : constant Name_Id := N + 425; + Name_Universal_Literal_String : constant Name_Id := N + 426; -- GNAT + Name_Unrestricted_Access : constant Name_Id := N + 427; -- GNAT + Name_VADS_Size : constant Name_Id := N + 428; -- GNAT + Name_Val : constant Name_Id := N + 429; + Name_Valid : constant Name_Id := N + 430; + Name_Value_Size : constant Name_Id := N + 431; -- GNAT + Name_Version : constant Name_Id := N + 432; + Name_Wchar_T_Size : constant Name_Id := N + 433; -- GNAT + Name_Wide_Width : constant Name_Id := N + 434; + Name_Width : constant Name_Id := N + 435; + Name_Word_Size : constant Name_Id := N + 436; -- 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 + 435; - Name_Adjacent : constant Name_Id := N + 435; - Name_Ceiling : constant Name_Id := N + 436; - Name_Copy_Sign : constant Name_Id := N + 437; - Name_Floor : constant Name_Id := N + 438; - Name_Fraction : constant Name_Id := N + 439; - Name_Image : constant Name_Id := N + 440; - Name_Input : constant Name_Id := N + 441; - Name_Machine : constant Name_Id := N + 442; - Name_Max : constant Name_Id := N + 443; - Name_Min : constant Name_Id := N + 444; - Name_Model : constant Name_Id := N + 445; - Name_Pred : constant Name_Id := N + 446; - Name_Remainder : constant Name_Id := N + 447; - Name_Rounding : constant Name_Id := N + 448; - Name_Succ : constant Name_Id := N + 449; - Name_Truncation : constant Name_Id := N + 450; - Name_Value : constant Name_Id := N + 451; - Name_Wide_Image : constant Name_Id := N + 452; - Name_Wide_Value : constant Name_Id := N + 453; - Last_Renamable_Function_Attribute : constant Name_Id := N + 453; + First_Renamable_Function_Attribute : constant Name_Id := N + 437; + Name_Adjacent : constant Name_Id := N + 437; + Name_Ceiling : constant Name_Id := N + 438; + Name_Copy_Sign : constant Name_Id := N + 439; + Name_Floor : constant Name_Id := N + 440; + Name_Fraction : constant Name_Id := N + 441; + Name_Image : constant Name_Id := N + 442; + Name_Input : constant Name_Id := N + 443; + Name_Machine : constant Name_Id := N + 444; + Name_Max : constant Name_Id := N + 445; + Name_Min : constant Name_Id := N + 446; + Name_Model : constant Name_Id := N + 447; + Name_Pred : constant Name_Id := N + 448; + Name_Remainder : constant Name_Id := N + 449; + Name_Rounding : constant Name_Id := N + 450; + Name_Succ : constant Name_Id := N + 451; + Name_Truncation : constant Name_Id := N + 452; + Name_Value : constant Name_Id := N + 453; + Name_Wide_Image : constant Name_Id := N + 454; + Name_Wide_Value : constant Name_Id := N + 455; + Last_Renamable_Function_Attribute : constant Name_Id := N + 455; -- Attributes that designate procedures - First_Procedure_Attribute : constant Name_Id := N + 454; - Name_Output : constant Name_Id := N + 454; - Name_Read : constant Name_Id := N + 455; - Name_Write : constant Name_Id := N + 456; - Last_Procedure_Attribute : constant Name_Id := N + 456; + First_Procedure_Attribute : constant Name_Id := N + 456; + Name_Output : constant Name_Id := N + 456; + Name_Read : constant Name_Id := N + 457; + Name_Write : constant Name_Id := N + 458; + Last_Procedure_Attribute : constant Name_Id := N + 458; -- Remaining attributes are ones that return entities - First_Entity_Attribute_Name : constant Name_Id := N + 457; - Name_Elab_Body : constant Name_Id := N + 457; -- GNAT - Name_Elab_Spec : constant Name_Id := N + 458; -- GNAT - Name_Storage_Pool : constant Name_Id := N + 459; + First_Entity_Attribute_Name : constant Name_Id := N + 459; + Name_Elab_Body : constant Name_Id := N + 459; -- GNAT + Name_Elab_Spec : constant Name_Id := N + 460; -- GNAT + Name_Storage_Pool : constant Name_Id := N + 461; -- These attributes are the ones that return types - First_Type_Attribute_Name : constant Name_Id := N + 460; - Name_Base : constant Name_Id := N + 460; - Name_Class : constant Name_Id := N + 461; - Last_Type_Attribute_Name : constant Name_Id := N + 461; - Last_Entity_Attribute_Name : constant Name_Id := N + 461; - Last_Attribute_Name : constant Name_Id := N + 461; + First_Type_Attribute_Name : constant Name_Id := N + 462; + Name_Base : constant Name_Id := N + 462; + Name_Class : constant Name_Id := N + 463; + Last_Type_Attribute_Name : constant Name_Id := N + 463; + Last_Entity_Attribute_Name : constant Name_Id := N + 463; + Last_Attribute_Name : constant Name_Id := N + 463; -- Names of recognized locking policy identifiers @@ -760,10 +762,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 + 462; - Name_Ceiling_Locking : constant Name_Id := N + 462; - Name_Inheritance_Locking : constant Name_Id := N + 463; - Last_Locking_Policy_Name : constant Name_Id := N + 463; + First_Locking_Policy_Name : constant Name_Id := N + 464; + Name_Ceiling_Locking : constant Name_Id := N + 464; + Name_Inheritance_Locking : constant Name_Id := N + 465; + Last_Locking_Policy_Name : constant Name_Id := N + 465; -- Names of recognized queuing policy identifiers. @@ -771,10 +773,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 + 464; - Name_FIFO_Queuing : constant Name_Id := N + 464; - Name_Priority_Queuing : constant Name_Id := N + 465; - Last_Queuing_Policy_Name : constant Name_Id := N + 465; + First_Queuing_Policy_Name : constant Name_Id := N + 466; + Name_FIFO_Queuing : constant Name_Id := N + 466; + Name_Priority_Queuing : constant Name_Id := N + 467; + Last_Queuing_Policy_Name : constant Name_Id := N + 467; -- Names of recognized task dispatching policy identifiers @@ -782,194 +784,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 + 466; - Name_FIFO_Within_Priorities : constant Name_Id := N + 466; - Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 466; + First_Task_Dispatching_Policy_Name : constant Name_Id := N + 468; + Name_FIFO_Within_Priorities : constant Name_Id := N + 468; + Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 468; -- Names of recognized checks for pragma Suppress - First_Check_Name : constant Name_Id := N + 467; - Name_Access_Check : constant Name_Id := N + 467; - Name_Accessibility_Check : constant Name_Id := N + 468; - Name_Discriminant_Check : constant Name_Id := N + 469; - Name_Division_Check : constant Name_Id := N + 470; - Name_Elaboration_Check : constant Name_Id := N + 471; - Name_Index_Check : constant Name_Id := N + 472; - Name_Length_Check : constant Name_Id := N + 473; - Name_Overflow_Check : constant Name_Id := N + 474; - Name_Range_Check : constant Name_Id := N + 475; - Name_Storage_Check : constant Name_Id := N + 476; - Name_Tag_Check : constant Name_Id := N + 477; - Name_All_Checks : constant Name_Id := N + 478; - Last_Check_Name : constant Name_Id := N + 478; + First_Check_Name : constant Name_Id := N + 469; + Name_Access_Check : constant Name_Id := N + 469; + Name_Accessibility_Check : constant Name_Id := N + 470; + Name_Discriminant_Check : constant Name_Id := N + 471; + Name_Division_Check : constant Name_Id := N + 472; + Name_Elaboration_Check : constant Name_Id := N + 473; + Name_Index_Check : constant Name_Id := N + 474; + Name_Length_Check : constant Name_Id := N + 475; + Name_Overflow_Check : constant Name_Id := N + 476; + Name_Range_Check : constant Name_Id := N + 477; + Name_Storage_Check : constant Name_Id := N + 478; + Name_Tag_Check : constant Name_Id := N + 479; + Name_All_Checks : constant Name_Id := N + 480; + Last_Check_Name : constant Name_Id := N + 480; -- Names corresponding to reserved keywords, excluding those already -- declared in the attribute list (Access, Delta, Digits, Range). - Name_Abort : constant Name_Id := N + 479; - Name_Abs : constant Name_Id := N + 480; - Name_Accept : constant Name_Id := N + 481; - Name_And : constant Name_Id := N + 482; - Name_All : constant Name_Id := N + 483; - Name_Array : constant Name_Id := N + 484; - Name_At : constant Name_Id := N + 485; - Name_Begin : constant Name_Id := N + 486; - Name_Body : constant Name_Id := N + 487; - Name_Case : constant Name_Id := N + 488; - Name_Constant : constant Name_Id := N + 489; - Name_Declare : constant Name_Id := N + 490; - Name_Delay : constant Name_Id := N + 491; - Name_Do : constant Name_Id := N + 492; - Name_Else : constant Name_Id := N + 493; - Name_Elsif : constant Name_Id := N + 494; - Name_End : constant Name_Id := N + 495; - Name_Entry : constant Name_Id := N + 496; - Name_Exception : constant Name_Id := N + 497; - Name_Exit : constant Name_Id := N + 498; - Name_For : constant Name_Id := N + 499; - Name_Function : constant Name_Id := N + 500; - Name_Generic : constant Name_Id := N + 501; - Name_Goto : constant Name_Id := N + 502; - Name_If : constant Name_Id := N + 503; - Name_In : constant Name_Id := N + 504; - Name_Is : constant Name_Id := N + 505; - Name_Limited : constant Name_Id := N + 506; - Name_Loop : constant Name_Id := N + 507; - Name_Mod : constant Name_Id := N + 508; - Name_New : constant Name_Id := N + 509; - Name_Not : constant Name_Id := N + 510; - Name_Null : constant Name_Id := N + 511; - Name_Of : constant Name_Id := N + 512; - Name_Or : constant Name_Id := N + 513; - Name_Others : constant Name_Id := N + 514; - Name_Out : constant Name_Id := N + 515; - Name_Package : constant Name_Id := N + 516; - Name_Pragma : constant Name_Id := N + 517; - Name_Private : constant Name_Id := N + 518; - Name_Procedure : constant Name_Id := N + 519; - Name_Raise : constant Name_Id := N + 520; - Name_Record : constant Name_Id := N + 521; - Name_Rem : constant Name_Id := N + 522; - Name_Renames : constant Name_Id := N + 523; - Name_Return : constant Name_Id := N + 524; - Name_Reverse : constant Name_Id := N + 525; - Name_Select : constant Name_Id := N + 526; - Name_Separate : constant Name_Id := N + 527; - Name_Subtype : constant Name_Id := N + 528; - Name_Task : constant Name_Id := N + 529; - Name_Terminate : constant Name_Id := N + 530; - Name_Then : constant Name_Id := N + 531; - Name_Type : constant Name_Id := N + 532; - Name_Use : constant Name_Id := N + 533; - Name_When : constant Name_Id := N + 534; - Name_While : constant Name_Id := N + 535; - Name_With : constant Name_Id := N + 536; - Name_Xor : constant Name_Id := N + 537; + Name_Abort : constant Name_Id := N + 481; + Name_Abs : constant Name_Id := N + 482; + Name_Accept : constant Name_Id := N + 483; + Name_And : constant Name_Id := N + 484; + Name_All : constant Name_Id := N + 485; + Name_Array : constant Name_Id := N + 486; + Name_At : constant Name_Id := N + 487; + Name_Begin : constant Name_Id := N + 488; + Name_Body : constant Name_Id := N + 489; + Name_Case : constant Name_Id := N + 490; + Name_Constant : constant Name_Id := N + 491; + Name_Declare : constant Name_Id := N + 492; + Name_Delay : constant Name_Id := N + 493; + Name_Do : constant Name_Id := N + 494; + Name_Else : constant Name_Id := N + 495; + Name_Elsif : constant Name_Id := N + 496; + Name_End : constant Name_Id := N + 497; + Name_Entry : constant Name_Id := N + 498; + Name_Exception : constant Name_Id := N + 499; + Name_Exit : constant Name_Id := N + 500; + Name_For : constant Name_Id := N + 501; + Name_Function : constant Name_Id := N + 502; + Name_Generic : constant Name_Id := N + 503; + Name_Goto : constant Name_Id := N + 504; + Name_If : constant Name_Id := N + 505; + Name_In : constant Name_Id := N + 506; + Name_Is : constant Name_Id := N + 507; + Name_Limited : constant Name_Id := N + 508; + Name_Loop : constant Name_Id := N + 509; + Name_Mod : constant Name_Id := N + 510; + Name_New : constant Name_Id := N + 511; + Name_Not : constant Name_Id := N + 512; + Name_Null : constant Name_Id := N + 513; + Name_Of : constant Name_Id := N + 514; + Name_Or : constant Name_Id := N + 515; + Name_Others : constant Name_Id := N + 516; + Name_Out : constant Name_Id := N + 517; + Name_Package : constant Name_Id := N + 518; + Name_Pragma : constant Name_Id := N + 519; + Name_Private : constant Name_Id := N + 520; + Name_Procedure : constant Name_Id := N + 521; + Name_Raise : constant Name_Id := N + 522; + Name_Record : constant Name_Id := N + 523; + Name_Rem : constant Name_Id := N + 524; + Name_Renames : constant Name_Id := N + 525; + Name_Return : constant Name_Id := N + 526; + Name_Reverse : constant Name_Id := N + 527; + Name_Select : constant Name_Id := N + 528; + Name_Separate : constant Name_Id := N + 529; + Name_Subtype : constant Name_Id := N + 530; + Name_Task : constant Name_Id := N + 531; + Name_Terminate : constant Name_Id := N + 532; + Name_Then : constant Name_Id := N + 533; + Name_Type : constant Name_Id := N + 534; + Name_Use : constant Name_Id := N + 535; + Name_When : constant Name_Id := N + 536; + Name_While : constant Name_Id := N + 537; + Name_With : constant Name_Id := N + 538; + Name_Xor : constant Name_Id := N + 539; -- 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 + 538; - Name_Divide : constant Name_Id := N + 538; - Name_Enclosing_Entity : constant Name_Id := N + 539; - Name_Exception_Information : constant Name_Id := N + 540; - Name_Exception_Message : constant Name_Id := N + 541; - Name_Exception_Name : constant Name_Id := N + 542; - Name_File : constant Name_Id := N + 543; - Name_Import_Address : constant Name_Id := N + 544; - Name_Import_Largest_Value : constant Name_Id := N + 545; - Name_Import_Value : constant Name_Id := N + 546; - Name_Is_Negative : constant Name_Id := N + 547; - Name_Line : constant Name_Id := N + 548; - Name_Rotate_Left : constant Name_Id := N + 549; - Name_Rotate_Right : constant Name_Id := N + 550; - Name_Shift_Left : constant Name_Id := N + 551; - Name_Shift_Right : constant Name_Id := N + 552; - Name_Shift_Right_Arithmetic : constant Name_Id := N + 553; - Name_Source_Location : constant Name_Id := N + 554; - Name_Unchecked_Conversion : constant Name_Id := N + 555; - Name_Unchecked_Deallocation : constant Name_Id := N + 556; - Name_To_Pointer : constant Name_Id := N + 557; - Last_Intrinsic_Name : constant Name_Id := N + 557; + First_Intrinsic_Name : constant Name_Id := N + 540; + Name_Divide : constant Name_Id := N + 540; + Name_Enclosing_Entity : constant Name_Id := N + 541; + Name_Exception_Information : constant Name_Id := N + 542; + Name_Exception_Message : constant Name_Id := N + 543; + Name_Exception_Name : constant Name_Id := N + 544; + Name_File : constant Name_Id := N + 545; + Name_Import_Address : constant Name_Id := N + 546; + Name_Import_Largest_Value : constant Name_Id := N + 547; + Name_Import_Value : constant Name_Id := N + 548; + Name_Is_Negative : constant Name_Id := N + 549; + Name_Line : constant Name_Id := N + 550; + Name_Rotate_Left : constant Name_Id := N + 551; + Name_Rotate_Right : constant Name_Id := N + 552; + Name_Shift_Left : constant Name_Id := N + 553; + Name_Shift_Right : constant Name_Id := N + 554; + Name_Shift_Right_Arithmetic : constant Name_Id := N + 555; + Name_Source_Location : constant Name_Id := N + 556; + Name_Unchecked_Conversion : constant Name_Id := N + 557; + Name_Unchecked_Deallocation : constant Name_Id := N + 558; + Name_To_Pointer : constant Name_Id := N + 559; + Last_Intrinsic_Name : constant Name_Id := N + 559; -- Reserved words used only in Ada 95 - First_95_Reserved_Word : constant Name_Id := N + 558; - Name_Abstract : constant Name_Id := N + 558; - Name_Aliased : constant Name_Id := N + 559; - Name_Protected : constant Name_Id := N + 560; - Name_Until : constant Name_Id := N + 561; - Name_Requeue : constant Name_Id := N + 562; - Name_Tagged : constant Name_Id := N + 563; - Last_95_Reserved_Word : constant Name_Id := N + 563; + First_95_Reserved_Word : constant Name_Id := N + 560; + Name_Abstract : constant Name_Id := N + 560; + Name_Aliased : constant Name_Id := N + 561; + Name_Protected : constant Name_Id := N + 562; + Name_Until : constant Name_Id := N + 563; + Name_Requeue : constant Name_Id := N + 564; + Name_Tagged : constant Name_Id := N + 565; + Last_95_Reserved_Word : constant Name_Id := N + 565; 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 + 564; + Name_Raise_Exception : constant Name_Id := N + 566; -- Additional reserved words in GNAT Project Files -- Note that Name_External is already previously declared - Name_Binder : constant Name_Id := N + 565; - Name_Body_Suffix : constant Name_Id := N + 566; - Name_Builder : constant Name_Id := N + 567; - Name_Compiler : constant Name_Id := N + 568; - Name_Cross_Reference : constant Name_Id := N + 569; - Name_Default_Switches : constant Name_Id := N + 570; - Name_Exec_Dir : constant Name_Id := N + 571; - Name_Executable : constant Name_Id := N + 572; - Name_Executable_Suffix : constant Name_Id := N + 573; - Name_Extends : constant Name_Id := N + 574; - Name_Finder : constant Name_Id := N + 575; - Name_Global_Configuration_Pragmas : constant Name_Id := N + 576; - Name_Gnatls : constant Name_Id := N + 577; - Name_Gnatstub : constant Name_Id := N + 578; - Name_Implementation : constant Name_Id := N + 579; - Name_Implementation_Exceptions : constant Name_Id := N + 580; - Name_Implementation_Suffix : constant Name_Id := N + 581; - Name_Languages : constant Name_Id := N + 582; - Name_Library_Dir : constant Name_Id := N + 583; - Name_Library_Auto_Init : constant Name_Id := N + 584; - Name_Library_GCC : constant Name_Id := N + 585; - Name_Library_Interface : constant Name_Id := N + 586; - Name_Library_Kind : constant Name_Id := N + 587; - Name_Library_Name : constant Name_Id := N + 588; - Name_Library_Options : constant Name_Id := N + 589; - Name_Library_Reference_Symbol_File : constant Name_Id := N + 590; - Name_Library_Src_Dir : constant Name_Id := N + 591; - Name_Library_Symbol_File : constant Name_Id := N + 592; - Name_Library_Symbol_Policy : constant Name_Id := N + 593; - Name_Library_Version : constant Name_Id := N + 594; - Name_Linker : constant Name_Id := N + 595; - Name_Local_Configuration_Pragmas : constant Name_Id := N + 596; - Name_Locally_Removed_Files : constant Name_Id := N + 597; - Name_Metrics : constant Name_Id := N + 598; - Name_Naming : constant Name_Id := N + 599; - Name_Object_Dir : constant Name_Id := N + 600; - Name_Pretty_Printer : constant Name_Id := N + 601; - Name_Project : constant Name_Id := N + 602; - Name_Separate_Suffix : constant Name_Id := N + 603; - Name_Source_Dirs : constant Name_Id := N + 604; - Name_Source_Files : constant Name_Id := N + 605; - Name_Source_List_File : constant Name_Id := N + 606; - Name_Spec : constant Name_Id := N + 607; - Name_Spec_Suffix : constant Name_Id := N + 608; - Name_Specification : constant Name_Id := N + 609; - Name_Specification_Exceptions : constant Name_Id := N + 610; - Name_Specification_Suffix : constant Name_Id := N + 611; - Name_Switches : constant Name_Id := N + 612; + Name_Binder : constant Name_Id := N + 567; + Name_Body_Suffix : constant Name_Id := N + 568; + Name_Builder : constant Name_Id := N + 569; + Name_Compiler : constant Name_Id := N + 570; + Name_Cross_Reference : constant Name_Id := N + 571; + Name_Default_Switches : constant Name_Id := N + 572; + Name_Exec_Dir : constant Name_Id := N + 573; + Name_Executable : constant Name_Id := N + 574; + Name_Executable_Suffix : constant Name_Id := N + 575; + Name_Extends : constant Name_Id := N + 576; + Name_Finder : constant Name_Id := N + 577; + Name_Global_Configuration_Pragmas : constant Name_Id := N + 578; + Name_Gnatls : constant Name_Id := N + 579; + Name_Gnatstub : constant Name_Id := N + 580; + Name_Implementation : constant Name_Id := N + 581; + Name_Implementation_Exceptions : constant Name_Id := N + 582; + Name_Implementation_Suffix : constant Name_Id := N + 583; + Name_Languages : constant Name_Id := N + 584; + Name_Library_Dir : constant Name_Id := N + 585; + Name_Library_Auto_Init : constant Name_Id := N + 586; + Name_Library_GCC : constant Name_Id := N + 587; + Name_Library_Interface : constant Name_Id := N + 588; + Name_Library_Kind : constant Name_Id := N + 589; + Name_Library_Name : constant Name_Id := N + 590; + Name_Library_Options : constant Name_Id := N + 591; + Name_Library_Reference_Symbol_File : constant Name_Id := N + 592; + Name_Library_Src_Dir : constant Name_Id := N + 593; + Name_Library_Symbol_File : constant Name_Id := N + 594; + Name_Library_Symbol_Policy : constant Name_Id := N + 595; + Name_Library_Version : constant Name_Id := N + 596; + Name_Linker : constant Name_Id := N + 597; + Name_Local_Configuration_Pragmas : constant Name_Id := N + 598; + Name_Locally_Removed_Files : constant Name_Id := N + 599; + Name_Metrics : constant Name_Id := N + 600; + Name_Naming : constant Name_Id := N + 601; + Name_Object_Dir : constant Name_Id := N + 602; + Name_Pretty_Printer : constant Name_Id := N + 603; + Name_Project : constant Name_Id := N + 604; + Name_Separate_Suffix : constant Name_Id := N + 605; + Name_Source_Dirs : constant Name_Id := N + 606; + Name_Source_Files : constant Name_Id := N + 607; + Name_Source_List_File : constant Name_Id := N + 608; + Name_Spec : constant Name_Id := N + 609; + Name_Spec_Suffix : constant Name_Id := N + 610; + Name_Specification : constant Name_Id := N + 611; + Name_Specification_Exceptions : constant Name_Id := N + 612; + Name_Specification_Suffix : constant Name_Id := N + 613; + Name_Switches : constant Name_Id := N + 614; -- Other miscellaneous names used in front end - Name_Unaligned_Valid : constant Name_Id := N + 613; + Name_Unaligned_Valid : constant Name_Id := N + 615; -- Mark last defined name for consistency check in Snames body - Last_Predefined_Name : constant Name_Id := N + 613; + Last_Predefined_Name : constant Name_Id := N + 615; subtype Any_Operator_Name is Name_Id range First_Operator_Name .. Last_Operator_Name; @@ -1014,6 +1016,7 @@ package Snames is Attribute_First_Bit, Attribute_Fixed_Value, Attribute_Fore, + Attribute_Has_Access_Values, Attribute_Has_Discriminants, Attribute_Identity, Attribute_Img, diff --git a/gcc/ada/snames.h b/gcc/ada/snames.h index d14d9279ed3..08a9b887f17 100644 --- a/gcc/ada/snames.h +++ b/gcc/ada/snames.h @@ -80,104 +80,105 @@ extern unsigned char Get_Attribute_Id (int); #define Attr_First_Bit 32 #define Attr_Fixed_Value 33 #define Attr_Fore 34 -#define Attr_Has_Discriminants 35 -#define Attr_Identity 36 -#define Attr_Img 37 -#define Attr_Integer_Value 38 -#define Attr_Large 39 -#define Attr_Last 40 -#define Attr_Last_Bit 41 -#define Attr_Leading_Part 42 -#define Attr_Length 43 -#define Attr_Machine_Emax 44 -#define Attr_Machine_Emin 45 -#define Attr_Machine_Mantissa 46 -#define Attr_Machine_Overflows 47 -#define Attr_Machine_Radix 48 -#define Attr_Machine_Rounds 49 -#define Attr_Machine_Size 50 -#define Attr_Mantissa 51 -#define Attr_Max_Size_In_Storage_Elements 52 -#define Attr_Maximum_Alignment 53 -#define Attr_Mechanism_Code 54 -#define Attr_Model_Emin 55 -#define Attr_Model_Epsilon 56 -#define Attr_Model_Mantissa 57 -#define Attr_Model_Small 58 -#define Attr_Modulus 59 -#define Attr_Null_Parameter 60 -#define Attr_Object_Size 61 -#define Attr_Partition_ID 62 -#define Attr_Passed_By_Reference 63 -#define Attr_Pool_Address 64 -#define Attr_Pos 65 -#define Attr_Position 66 -#define Attr_Range 67 -#define Attr_Range_Length 68 -#define Attr_Round 69 -#define Attr_Safe_Emax 70 -#define Attr_Safe_First 71 -#define Attr_Safe_Large 72 -#define Attr_Safe_Last 73 -#define Attr_Safe_Small 74 -#define Attr_Scale 75 -#define Attr_Scaling 76 -#define Attr_Signed_Zeros 77 -#define Attr_Size 78 -#define Attr_Small 79 -#define Attr_Storage_Size 80 -#define Attr_Storage_Unit 81 -#define Attr_Tag 82 -#define Attr_Target_Name 83 -#define Attr_Terminated 84 -#define Attr_To_Address 85 -#define Attr_Type_Class 86 -#define Attr_UET_Address 87 -#define Attr_Unbiased_Rounding 88 -#define Attr_Unchecked_Access 89 -#define Attr_Unconstrained_Array 90 -#define Attr_Universal_Literal_String 91 -#define Attr_Unrestricted_Access 92 -#define Attr_VADS_Size 93 -#define Attr_Val 94 -#define Attr_Valid 95 -#define Attr_Value_Size 96 -#define Attr_Version 97 -#define Attr_Wide_Character_Size 98 -#define Attr_Wide_Width 99 -#define Attr_Width 100 +#define Attr_Has_Access_Values 35 +#define Attr_Has_Discriminants 36 +#define Attr_Identity 37 +#define Attr_Img 38 +#define Attr_Integer_Value 39 +#define Attr_Large 40 +#define Attr_Last 41 +#define Attr_Last_Bit 42 +#define Attr_Leading_Part 43 +#define Attr_Length 44 +#define Attr_Machine_Emax 45 +#define Attr_Machine_Emin 46 +#define Attr_Machine_Mantissa 47 +#define Attr_Machine_Overflows 48 +#define Attr_Machine_Radix 49 +#define Attr_Machine_Rounds 50 +#define Attr_Machine_Size 51 +#define Attr_Mantissa 52 +#define Attr_Max_Size_In_Storage_Elements 53 +#define Attr_Maximum_Alignment 54 +#define Attr_Mechanism_Code 55 +#define Attr_Model_Emin 56 +#define Attr_Model_Epsilon 57 +#define Attr_Model_Mantissa 58 +#define Attr_Model_Small 59 +#define Attr_Modulus 60 +#define Attr_Null_Parameter 61 +#define Attr_Object_Size 62 +#define Attr_Partition_ID 63 +#define Attr_Passed_By_Reference 64 +#define Attr_Pool_Address 65 +#define Attr_Pos 66 +#define Attr_Position 67 +#define Attr_Range 68 +#define Attr_Range_Length 69 +#define Attr_Round 70 +#define Attr_Safe_Emax 71 +#define Attr_Safe_First 72 +#define Attr_Safe_Large 73 +#define Attr_Safe_Last 74 +#define Attr_Safe_Small 75 +#define Attr_Scale 76 +#define Attr_Scaling 77 +#define Attr_Signed_Zeros 78 +#define Attr_Size 79 +#define Attr_Small 80 +#define Attr_Storage_Size 81 +#define Attr_Storage_Unit 82 +#define Attr_Tag 83 +#define Attr_Target_Name 84 +#define Attr_Terminated 85 +#define Attr_To_Address 86 +#define Attr_Type_Class 87 +#define Attr_UET_Address 88 +#define Attr_Unbiased_Rounding 89 +#define Attr_Unchecked_Access 90 +#define Attr_Unconstrained_Array 91 +#define Attr_Universal_Literal_String 92 +#define Attr_Unrestricted_Access 93 +#define Attr_VADS_Size 94 +#define Attr_Val 95 +#define Attr_Valid 96 +#define Attr_Value_Size 97 +#define Attr_Version 98 +#define Attr_Wide_Character_Size 99 +#define Attr_Wide_Width 100 +#define Attr_Width 101 +#define Attr_Word_Size 102 -#define Attr_Word_Size 101 -#define Attr_Adjacent 102 -#define Attr_Ceiling 103 -#define Attr_Copy_Sign 104 -#define Attr_Floor 105 -#define Attr_Fraction 106 -#define Attr_Image 107 -#define Attr_Input 108 -#define Attr_Machine 109 -#define Attr_Max 110 -#define Attr_Min 111 -#define Attr_Model 112 -#define Attr_Pred 113 -#define Attr_Remainder 114 -#define Attr_Rounding 115 -#define Attr_Succ 116 -#define Attr_Truncation 117 -#define Attr_Value 118 -#define Attr_Wide_Image 119 -#define Attr_Wide_Value 120 +#define Attr_Adjacent 103 +#define Attr_Ceiling 104 +#define Attr_Copy_Sign 105 +#define Attr_Floor 106 +#define Attr_Fraction 107 +#define Attr_Image 108 +#define Attr_Input 109 +#define Attr_Machine 110 +#define Attr_Max 111 +#define Attr_Min 112 +#define Attr_Model 113 +#define Attr_Pred 114 +#define Attr_Remainder 115 +#define Attr_Rounding 116 +#define Attr_Succ 117 +#define Attr_Truncation 118 +#define Attr_Value 119 +#define Attr_Wide_Image 120 +#define Attr_Wide_Value 121 -#define Attr_Output 121 -#define Attr_Read 122 -#define Attr_Write 123 +#define Attr_Output 122 +#define Attr_Read 123 +#define Attr_Write 124 -#define Attr_Elab_Body 124 -#define Attr_Elab_Spec 125 -#define Attr_Storage_Pool 126 +#define Attr_Elab_Body 125 +#define Attr_Elab_Spec 126 +#define Attr_Storage_Pool 127 -#define Attr_Base 127 -#define Attr_Class 128 +#define Attr_Base 128 +#define Attr_Class 129 /* Define the function to check if a Name_Id value is a valid pragma */ diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index 13724f06114..0d814441c49 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -2817,13 +2817,13 @@ package body Sprint is Write_Str ("""]"); end Write_Condition_And_Reason; - ------------------------ - -- Write_Discr_Specs -- - ------------------------ + ----------------------- + -- Write_Discr_Specs -- + ----------------------- procedure Write_Discr_Specs (N : Node_Id) is - Specs : List_Id; - Spec : Node_Id; + Specs : List_Id; + Spec : Node_Id; begin Specs := Discriminant_Specifications (N); diff --git a/gcc/ada/uname.adb b/gcc/ada/uname.adb index 4675a013688..7353c9fcff4 100644 --- a/gcc/ada/uname.adb +++ b/gcc/ada/uname.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2002, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -352,9 +352,9 @@ package body Uname is return N; end Get_Parent; - -------------------------------------------- - -- Start of Processing for Get_Unit_Name -- - -------------------------------------------- + ------------------------------------------- + -- Start of Processing for Get_Unit_Name -- + ------------------------------------------- begin Node := N; diff --git a/gcc/ada/vms_conv.adb b/gcc/ada/vms_conv.adb index 1966d96c254..2ccafffb832 100644 --- a/gcc/ada/vms_conv.adb +++ b/gcc/ada/vms_conv.adb @@ -26,6 +26,7 @@ with Gnatvsn; with Hostparm; +with Opt; with Osint; use Osint; with Ada.Characters.Handling; use Ada.Characters.Handling; @@ -34,6 +35,15 @@ with Ada.Text_IO; use Ada.Text_IO; package body VMS_Conv is + Keep_Temps_Option : constant Item_Ptr := + new Item' + (Id => Id_Option, + Name => + new String'("/KEEP_TEMPORARY_FILES"), + Next => null, + Command => Undefined, + Unix_String => null); + Param_Count : Natural := 0; -- Number of parameter arguments so far @@ -1288,13 +1298,21 @@ package body VMS_Conv is raise Normal_Exit; end if; - -- Special handling for internal debugging switch /? + -- Special handling for internal debugging switch /? elsif Arg.all = "/?" then Display_Command := True; Output_File_Expected := False; - -- Copy -switch unchanged + -- Special handling of internal option /KEEP_TEMPORARY_FILES + + elsif Arg'Length >= 7 + and then Matching_Name + (Arg.all, Keep_Temps_Option, True) /= null + then + Opt.Keep_Temporary_Files := True; + + -- Copy -switch unchanged elsif Arg (Arg'First) = '-' then Place (' '); diff --git a/gcc/ada/vms_conv.ads b/gcc/ada/vms_conv.ads index 8ce7cfe4e5b..3bd22fab4a5 100644 --- a/gcc/ada/vms_conv.ads +++ b/gcc/ada/vms_conv.ads @@ -97,7 +97,7 @@ package VMS_Conv is type Command_Type is (Bind, Chop, Clean, Compile, Elim, Find, Krunch, Library, Link, List, - Make, Name, Preprocess, Pretty, Shared, Stub, Metric, Xref, Undefined); + Make, Metric, Name, Preprocess, Pretty, Shared, Stub, Xref, Undefined); type Alternate_Command is (Comp, Ls, Kr, Pp, Prep); -- Alternate command libel for non VMS system diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index bf236aebca7..de1512ca76d 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -1893,11 +1893,9 @@ package VMS_Data is -- construction of box comments, as shown in -- the following example: -- - -- - -- --------------------------- - -- -- This is a box comment -- - -- -- with two text lines. -- - -- --------------------------- + -- --------------------------- + -- -- This is a box comment -- + -- --------------------------- -- -- END Check end/exit labels. -- Optional labels on end statements ending |