summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gcc/ada/ChangeLog128
-rw-r--r--gcc/ada/a-except.adb6
-rw-r--r--gcc/ada/a-exexpr.adb6
-rw-r--r--gcc/ada/a-intsig.adb8
-rw-r--r--gcc/ada/a-numaux-x86.adb6
-rw-r--r--gcc/ada/a-tags.adb6
-rw-r--r--gcc/ada/a-tags.ads6
-rw-r--r--gcc/ada/bindgen.ads6
-rw-r--r--gcc/ada/checks.adb8
-rw-r--r--gcc/ada/csets.ads8
-rw-r--r--gcc/ada/cstand.adb42
-rw-r--r--gcc/ada/einfo.ads8
-rw-r--r--gcc/ada/elists.adb8
-rw-r--r--gcc/ada/exp_attr.adb1
-rw-r--r--gcc/ada/exp_ch4.adb6
-rw-r--r--gcc/ada/exp_ch7.adb99
-rw-r--r--gcc/ada/exp_dist.adb12
-rw-r--r--gcc/ada/exp_util.adb6
-rw-r--r--gcc/ada/exp_util.ads2
-rw-r--r--gcc/ada/freeze.adb6
-rw-r--r--gcc/ada/g-dynhta.adb14
-rw-r--r--gcc/ada/g-regexp.adb10
-rw-r--r--gcc/ada/g-socket.adb14
-rw-r--r--gcc/ada/gnat_rm.texi2
-rw-r--r--gcc/ada/gnat_ugn.texi17
-rw-r--r--gcc/ada/gnatchop.adb32
-rw-r--r--gcc/ada/gnatcmd.adb104
-rw-r--r--gcc/ada/gnatlink.adb32
-rw-r--r--gcc/ada/gnatmem.adb6
-rw-r--r--gcc/ada/gnatname.adb34
-rw-r--r--gcc/ada/i-os2thr.ads20
-rw-r--r--gcc/ada/inline.adb6
-rw-r--r--gcc/ada/layout.adb12
-rw-r--r--gcc/ada/layout.ads12
-rw-r--r--gcc/ada/make.adb2
-rw-r--r--gcc/ada/makegpr.adb160
-rw-r--r--gcc/ada/opt.ads5
-rw-r--r--gcc/ada/osint.adb6
-rw-r--r--gcc/ada/prj.adb6
-rw-r--r--gcc/ada/rtsfind.ads6
-rw-r--r--gcc/ada/s-ficobl.ads8
-rw-r--r--gcc/ada/s-finimp.adb6
-rw-r--r--gcc/ada/s-htable.adb6
-rw-r--r--gcc/ada/s-interr-sigaction.adb6
-rw-r--r--gcc/ada/s-interr-vms.adb30
-rw-r--r--gcc/ada/s-interr.adb12
-rw-r--r--gcc/ada/s-interr.ads18
-rw-r--r--gcc/ada/s-osinte-aix.ads12
-rw-r--r--gcc/ada/s-osinte-freebsd.ads59
-rw-r--r--gcc/ada/s-osinte-hpux-dce.adb126
-rw-r--r--gcc/ada/s-osinte-hpux.ads12
-rw-r--r--gcc/ada/s-osinte-irix.ads11
-rw-r--r--gcc/ada/s-osinte-lynxos.ads18
-rw-r--r--gcc/ada/s-osinte-tru64.ads24
-rw-r--r--gcc/ada/s-osinte-vms.ads18
-rw-r--r--gcc/ada/s-osinte-vxworks.ads8
-rw-r--r--gcc/ada/s-osprim-vxworks.adb8
-rw-r--r--gcc/ada/s-taprop-dummy.adb449
-rw-r--r--gcc/ada/s-taprop-hpux-dce.adb49
-rw-r--r--gcc/ada/s-taprop-irix-athread.adb17
-rw-r--r--gcc/ada/s-taprop-irix.adb43
-rw-r--r--gcc/ada/s-taprop-linux.adb39
-rw-r--r--gcc/ada/s-taprop-lynxos.adb16
-rw-r--r--gcc/ada/s-taprop-mingw.adb2
-rw-r--r--gcc/ada/s-taprop-os2.adb2
-rw-r--r--gcc/ada/s-taprop-posix.adb2
-rw-r--r--gcc/ada/s-taprop-solaris.adb16
-rw-r--r--gcc/ada/s-taprop-tru64.adb2
-rw-r--r--gcc/ada/s-taprop-vms.adb14
-rw-r--r--gcc/ada/s-taprop-vxworks.adb2
-rw-r--r--gcc/ada/s-tarest.adb6
-rw-r--r--gcc/ada/s-tasini.ads10
-rw-r--r--gcc/ada/s-taskin.ads55
-rw-r--r--gcc/ada/scng.adb6
-rw-r--r--gcc/ada/sem_attr.adb30
-rw-r--r--gcc/ada/sem_cat.adb6
-rw-r--r--gcc/ada/sem_ch10.adb12
-rw-r--r--gcc/ada/sem_ch12.adb18
-rw-r--r--gcc/ada/sem_ch13.adb4
-rw-r--r--gcc/ada/sem_ch13.ads2
-rw-r--r--gcc/ada/sem_ch4.adb12
-rw-r--r--gcc/ada/sem_ch6.adb6
-rw-r--r--gcc/ada/sem_ch7.adb16
-rw-r--r--gcc/ada/sem_ch8.adb24
-rw-r--r--gcc/ada/sem_disp.adb13
-rw-r--r--gcc/ada/sem_prag.adb6
-rw-r--r--gcc/ada/sem_res.adb6
-rw-r--r--gcc/ada/sem_type.adb18
-rw-r--r--gcc/ada/sem_type.ads8
-rw-r--r--gcc/ada/sem_util.adb139
-rw-r--r--gcc/ada/sem_util.ads4
-rw-r--r--gcc/ada/sem_warn.adb6
-rw-r--r--gcc/ada/sinfo.ads6
-rw-r--r--gcc/ada/sinput-l.ads6
-rw-r--r--gcc/ada/snames.adb2
-rw-r--r--gcc/ada/snames.ads1115
-rw-r--r--gcc/ada/snames.h189
-rw-r--r--gcc/ada/sprint.adb10
-rw-r--r--gcc/ada/uname.adb8
-rw-r--r--gcc/ada/vms_conv.adb22
-rw-r--r--gcc/ada/vms_conv.ads2
-rw-r--r--gcc/ada/vms_data.ads8
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