aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2011-08-04 09:45:20 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2011-08-04 09:45:20 +0200
commit824e9320157031e3969aabe742cfddd38a0513cd (patch)
treec99f88092f5c194ff8b0d6bd08570d448e0d0837 /gcc/ada
parent316d9d4f9f86acf8fd0e4b22a80d0134c876502a (diff)
downloadgcc-824e9320157031e3969aabe742cfddd38a0513cd.zip
gcc-824e9320157031e3969aabe742cfddd38a0513cd.tar.gz
gcc-824e9320157031e3969aabe742cfddd38a0513cd.tar.bz2
[multiple changes]
2011-08-04 Emmanuel Briot <briot@adacore.com> * prj-proc.adb, prj-nmsc.adb, prj-env.adb (Process_Declarative_Items): Add support for overriding the Project_Path in aggregate projects. 2011-08-04 Robert Dewar <dewar@adacore.com> * a-cofove.ads: Minor reformatting. 2011-08-04 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch7.adb (Build_Adjust_Or_Finalize_Statements): Update the comment on the generated code. (Build_Finalize_Statements): Update the comment on the generated code. (Build_Initialize_Statements): Update the comment on the generated code. (Build_Object_Declarations): Add local variable Result. The object declarations are now built in sequence. * rtsfind.ads: Add RE_Exception_Occurrence_Access to tables RE_Id and RE_Unit_Table. 2011-08-04 Robert Dewar <dewar@adacore.com> * checks.adb, alfa.adb, alfa.ads: Minor reformatting. 2011-08-04 Eric Botcazou <ebotcazou@adacore.com> * einfo.ads (Elaboration_Entity): Document new definition and use. (Elaboration_Entity_Required): Adjust to above change. * exp_attr.adb (Expand_N_Attribute_Reference): Likewise. * exp_ch12.adb: And with and use for Snames. (Expand_N_Generic_Instantiation): Test 'Elaborated attribute. * exp_util.adb (Set_Elaboration_Flag): Likewise. * sem_attr.adb (Analyze_Attribute) <Check_Library_Unit>: Delete. <Check_Unit_Name>: Deal with N_Expanded_Name. <Attribute_Elaborated>: Extend to all unit names. * sem_elab.adb: And with and use for Uintp. (Check_Internal_Call_Continue): Adjust to Elaboration_Entity change. * sem_util.ads (Build_Elaboration_Entity): Adjust comment. * sem_util.adb (Build_Elaboration_Entity): Change type to Integer. * bindgen.adb (Gen_Elab_Externals_Ada): New local subprogram taken from Gen_Adainit_Ada. (Gen_Elab_Externals_C): Likewise, but taken from Gen_Adainit_C. (Gen_Adafinal_Ada): Remove redundant test. In the non-main program case, do not call System.Standard_Library.Adafinal; instead call finalize_library if needed. (Gen_Adafinal_C): Likewise. (Gen_Adainit_Ada): Do not set SSL.Finalize_Library_Objects in the non-main program case. (Gen_Adainit_C): Generate a couple of external declarations here. In the main program case, set SSL.Finalize_Library_Objects. (Gen_Elab_Calls_Ada): Adjust to Elaboration_Entity change. (Gen_Elab_Calls_C): Likewise. (Gen_Finalize_Library_Ada): Likewise. Skip SAL interface units. (Gen_Finalize_Library_C): Likewise. Generate a full function. (Gen_Main_C): Put back call to Ada_Final and don't finalize library objects here. (Gen_Output_File_Ada): Generate pragma Linker_Destructor for Ada_Final if -a is specified. Call Gen_Elab_Externals_Ada. Move around call to Gen_Adafinal_Ada. (Gen_Output_File_C): Generate __attribute__((destructor)) for Ada_Final if -a is specified. Call Gen_Elab_Externals_C. Remove useless couple of external declarations.  Call Gen_Finalize_Library_C. From-SVN: r177318
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog63
-rw-r--r--gcc/ada/a-cofove.ads7
-rw-r--r--gcc/ada/alfa.adb22
-rw-r--r--gcc/ada/alfa.ads8
-rw-r--r--gcc/ada/bindgen.adb657
-rw-r--r--gcc/ada/checks.adb2
-rw-r--r--gcc/ada/einfo.ads38
-rw-r--r--gcc/ada/exp_attr.adb7
-rw-r--r--gcc/ada/exp_ch12.adb7
-rw-r--r--gcc/ada/exp_ch7.adb150
-rw-r--r--gcc/ada/exp_util.adb2
-rw-r--r--gcc/ada/prj-env.adb5
-rw-r--r--gcc/ada/prj-nmsc.adb23
-rw-r--r--gcc/ada/prj-proc.adb31
-rw-r--r--gcc/ada/rtsfind.ads2
-rw-r--r--gcc/ada/sem_attr.adb24
-rw-r--r--gcc/ada/sem_elab.adb13
-rw-r--r--gcc/ada/sem_util.adb4
-rw-r--r--gcc/ada/sem_util.ads2
19 files changed, 658 insertions, 409 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 40ffac4..e318a94 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,68 @@
2011-08-04 Emmanuel Briot <briot@adacore.com>
+ * prj-proc.adb, prj-nmsc.adb, prj-env.adb (Process_Declarative_Items):
+ Add support for overriding the Project_Path in aggregate projects.
+
+2011-08-04 Robert Dewar <dewar@adacore.com>
+
+ * a-cofove.ads: Minor reformatting.
+
+2011-08-04 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch7.adb (Build_Adjust_Or_Finalize_Statements): Update the comment
+ on the generated code.
+ (Build_Finalize_Statements): Update the comment on the generated code.
+ (Build_Initialize_Statements): Update the comment on the generated code.
+ (Build_Object_Declarations): Add local variable Result. The object
+ declarations are now built in sequence.
+ * rtsfind.ads: Add RE_Exception_Occurrence_Access to tables RE_Id and
+ RE_Unit_Table.
+
+2011-08-04 Robert Dewar <dewar@adacore.com>
+
+ * checks.adb, alfa.adb, alfa.ads: Minor reformatting.
+
+2011-08-04 Eric Botcazou <ebotcazou@adacore.com>
+
+ * einfo.ads (Elaboration_Entity): Document new definition and use.
+ (Elaboration_Entity_Required): Adjust to above change.
+ * exp_attr.adb (Expand_N_Attribute_Reference): Likewise.
+ * exp_ch12.adb: And with and use for Snames.
+ (Expand_N_Generic_Instantiation): Test 'Elaborated attribute.
+ * exp_util.adb (Set_Elaboration_Flag): Likewise.
+ * sem_attr.adb (Analyze_Attribute) <Check_Library_Unit>: Delete.
+ <Check_Unit_Name>: Deal with N_Expanded_Name.
+ <Attribute_Elaborated>: Extend to all unit names.
+ * sem_elab.adb: And with and use for Uintp.
+ (Check_Internal_Call_Continue): Adjust to Elaboration_Entity change.
+ * sem_util.ads (Build_Elaboration_Entity): Adjust comment.
+ * sem_util.adb (Build_Elaboration_Entity): Change type to Integer.
+ * bindgen.adb (Gen_Elab_Externals_Ada): New local subprogram taken
+ from Gen_Adainit_Ada.
+ (Gen_Elab_Externals_C): Likewise, but taken from Gen_Adainit_C.
+ (Gen_Adafinal_Ada): Remove redundant test. In the non-main program
+ case, do not call System.Standard_Library.Adafinal; instead call
+ finalize_library if needed.
+ (Gen_Adafinal_C): Likewise.
+ (Gen_Adainit_Ada): Do not set SSL.Finalize_Library_Objects in the
+ non-main program case.
+ (Gen_Adainit_C): Generate a couple of external declarations here.
+ In the main program case, set SSL.Finalize_Library_Objects.
+ (Gen_Elab_Calls_Ada): Adjust to Elaboration_Entity change.
+ (Gen_Elab_Calls_C): Likewise.
+ (Gen_Finalize_Library_Ada): Likewise. Skip SAL interface units.
+ (Gen_Finalize_Library_C): Likewise. Generate a full function.
+ (Gen_Main_C): Put back call to Ada_Final and don't finalize library
+ objects here.
+ (Gen_Output_File_Ada): Generate pragma Linker_Destructor for Ada_Final
+ if -a is specified. Call Gen_Elab_Externals_Ada. Move around call to
+ Gen_Adafinal_Ada.
+ (Gen_Output_File_C): Generate __attribute__((destructor)) for Ada_Final
+ if -a is specified. Call Gen_Elab_Externals_C. Remove useless couple
+ of external declarations.  Call Gen_Finalize_Library_C.
+
+2011-08-04 Emmanuel Briot <briot@adacore.com>
+
* prj.adb, prj.ads, makeutl.adb, makeutl.ads (Complete_Mains,
Compute_Compilation_Phases): new subprogram.
(Builder_Data, Builder_Project_Tree_Data): new subprogram and type
diff --git a/gcc/ada/a-cofove.ads b/gcc/ada/a-cofove.ads
index 8dcb747..24e2944 100644
--- a/gcc/ada/a-cofove.ads
+++ b/gcc/ada/a-cofove.ads
@@ -143,8 +143,9 @@ package Ada.Containers.Formal_Vectors is
(Container : Vector;
Index : Index_Type) return Element_Type;
- function Element (Container : Vector; Position : Cursor)
- return Element_Type;
+ function Element
+ (Container : Vector;
+ Position : Cursor) return Element_Type;
procedure Replace_Element
(Container : in out Vector;
@@ -388,7 +389,7 @@ private
for Vector'Read use Read;
type Cursor is record
- Valid : Boolean := True;
+ Valid : Boolean := True;
Index : Index_Type := Index_Type'First;
end record;
diff --git a/gcc/ada/alfa.adb b/gcc/ada/alfa.adb
index 9030d00..065b7d8 100644
--- a/gcc/ada/alfa.adb
+++ b/gcc/ada/alfa.adb
@@ -144,17 +144,6 @@ package body ALFA is
end loop;
end dalfa;
- ----------------
- -- Initialize --
- ----------------
-
- procedure Initialize_ALFA_Tables is
- begin
- ALFA_File_Table.Init;
- ALFA_Scope_Table.Init;
- ALFA_Xref_Table.Init;
- end Initialize_ALFA_Tables;
-
-------------------------
-- Get_Entity_For_Decl --
-------------------------
@@ -223,6 +212,17 @@ package body ALFA is
return E;
end Get_Unique_Entity_For_Decl;
+ ----------------
+ -- Initialize --
+ ----------------
+
+ procedure Initialize_ALFA_Tables is
+ begin
+ ALFA_File_Table.Init;
+ ALFA_Scope_Table.Init;
+ ALFA_Xref_Table.Init;
+ end Initialize_ALFA_Tables;
+
-----------
-- palfa --
-----------
diff --git a/gcc/ada/alfa.ads b/gcc/ada/alfa.ads
index 1813a79..5ad7c61 100644
--- a/gcc/ada/alfa.ads
+++ b/gcc/ada/alfa.ads
@@ -316,10 +316,6 @@ package ALFA is
-- Subprograms --
-----------------
- procedure dalfa;
- -- Debug routine to dump internal ALFA tables. This is a raw format dump
- -- showing exactly what the tables contain.
-
procedure Initialize_ALFA_Tables;
-- Reset tables for a new compilation
@@ -330,6 +326,10 @@ package ALFA is
-- Return the entity which represents declaration N, so that matching
-- declaration and body have the same entity.
+ procedure dalfa;
+ -- Debug routine to dump internal ALFA tables. This is a raw format dump
+ -- showing exactly what the tables contain.
+
procedure palfa;
-- Debugging procedure to output contents of ALFA binary tables in the
-- format in which they appear in an ALI file.
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index b88ed00..9072e36 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -72,6 +72,7 @@ package body Bindgen is
-- unit unconditionally, which is unpleasand, especially for ZFP etc.)
Lib_Final_Built : Boolean := False;
+ -- Flag indicating whether the finalize_library rountine has been built
----------------------------------
-- Interface_State Pragma Table --
@@ -244,6 +245,12 @@ package body Bindgen is
procedure Gen_Adafinal_C;
-- Generate the Adafinal procedure (C code case)
+ procedure Gen_Elab_Externals_Ada;
+ -- Generate sequence of external declarations for elaboration (Ada)
+
+ procedure Gen_Elab_Externals_C;
+ -- Generate sequence of external declarations for elaboration (C)
+
procedure Gen_Elab_Calls_Ada;
-- Generate sequence of elaboration calls (Ada code case)
@@ -421,13 +428,15 @@ package body Bindgen is
begin
WBI (" procedure " & Ada_Final_Name.all & " is");
- -- Do nothing if finalization is disabled
-
- if Cumulative_Restrictions.Set (No_Finalization) then
+ if not Bind_Main_Program then
WBI (" begin");
- WBI (" null;");
+ if Lib_Final_Built then
+ WBI (" finalize_library;");
+ else
+ WBI (" null;");
+ end if;
- -- General case
+ -- Main program case
elsif VM_Target = No_VM then
WBI (" procedure s_stalib_adafinal;");
@@ -455,7 +464,17 @@ package body Bindgen is
procedure Gen_Adafinal_C is
begin
WBI ("void " & Ada_Final_Name.all & " (void) {");
- WBI (" system__standard_library__adafinal ();");
+
+ if not Bind_Main_Program then
+ if Lib_Final_Built then
+ WBI (" finalize_library ();");
+ end if;
+
+ -- Main program case
+
+ else
+ WBI (" system__standard_library__adafinal ();");
+ end if;
WBI ("}");
WBI ("");
end Gen_Adafinal_C;
@@ -471,86 +490,6 @@ package body Bindgen is
begin
WBI (" procedure " & Ada_Init_Name.all & " is");
- -- Generate externals for elaboration entities
-
- for E in Elab_Order.First .. Elab_Order.Last loop
- declare
- Unum : constant Unit_Id := Elab_Order.Table (E);
- U : Unit_Record renames Units.Table (Unum);
-
- begin
- -- Check for Elab_Entity to be set for this unit
-
- if U.Set_Elab_Entity
-
- -- Don't generate reference for stand alone library
-
- and then not U.SAL_Interface
-
- -- Don't generate reference for predefined file in No_Run_Time
- -- mode, since we don't include the object files in this case
-
- and then not
- (No_Run_Time_Mode
- and then Is_Predefined_File_Name (U.Sfile))
- then
- Set_String (" ");
- Set_String ("E");
- Set_Unit_Number (Unum);
-
- case VM_Target is
- when No_VM | JVM_Target =>
- Set_String (" : Boolean; pragma Import (Ada, ");
- when CLI_Target =>
- Set_String (" : Boolean; pragma Import (CIL, ");
- end case;
-
- Set_String ("E");
- Set_Unit_Number (Unum);
- Set_String (", """);
- Get_Name_String (U.Uname);
-
- -- In the case of JGNAT we need to emit an Import name that
- -- includes the class name (using '$' separators in the case
- -- of a child unit name).
-
- if VM_Target /= No_VM then
- for J in 1 .. Name_Len - 2 loop
- if VM_Target = CLI_Target
- or else Name_Buffer (J) /= '.'
- then
- Set_Char (Name_Buffer (J));
- else
- Set_String ("$");
- end if;
- end loop;
-
- if VM_Target /= CLI_Target or else U.Unit_Kind = 's' then
- Set_String (".");
- else
- Set_String ("_pkg.");
- end if;
-
- -- If the unit name is very long, then split the
- -- Import link name across lines using "&" (occurs
- -- in some C2 tests).
-
- if 2 * Name_Len + 60 > Hostparm.Max_Line_Length then
- Set_String (""" &");
- Write_Statement_Buffer;
- Set_String (" """);
- end if;
- end if;
-
- Set_Unit_Name;
- Set_String ("_E"");");
- Write_Statement_Buffer;
- end if;
- end;
- end loop;
-
- Write_Statement_Buffer;
-
-- If the standard library is suppressed, then the only global variables
-- that might be needed (by the Ravenscar profile) are the priority and
-- the processor for the environment task.
@@ -927,38 +866,39 @@ package body Bindgen is
WBI (" Initialize_Stack_Limit;");
end if;
- -- Attach Finalize_Library to the right soft link. Do it only when not
- -- using a restricted run time, in which case tasks are
- -- non-terminating, so we do not want library-level finalization.
+ -- In the main program case, attach finalize_library to the soft link.
+ -- Do it only when not using a restricted run time, in which case tasks
+ -- are non-terminating, so we do not want library-level finalization.
- if not Configurable_Run_Time_On_Target then
- if not Suppress_Standard_Library_On_Target then
- WBI ("");
+ if Bind_Main_Program
+ and then not Configurable_Run_Time_On_Target
+ and then not Suppress_Standard_Library_On_Target
+ then
+ WBI ("");
- if VM_Target = No_VM then
- if Lib_Final_Built then
- Set_String (" Finalize_Library_Objects := ");
- Set_String ("Finalize_Library'access;");
- else
- Set_String (" Finalize_Library_Objects := null;");
- end if;
+ if VM_Target = No_VM then
+ if Lib_Final_Built then
+ Set_String (" Finalize_Library_Objects := ");
+ Set_String ("finalize_library'access;");
+ else
+ Set_String (" Finalize_Library_Objects := null;");
+ end if;
- -- On VM targets use regular Ada to set the soft link
+ -- On VM targets use regular Ada to set the soft link
+ else
+ if Lib_Final_Built then
+ Set_String
+ (" System.Soft_Links.Finalize_Library_Objects");
+ Set_String (" := finalize_library'access;");
else
- if Lib_Final_Built then
- Set_String
- (" System.Soft_Links.Finalize_Library_Objects");
- Set_String (" := Finalize_Library'access;");
- else
- Set_String
- (" System.Soft_Links.Finalize_Library_Objects");
- Set_String (" := null;");
- end if;
+ Set_String
+ (" System.Soft_Links.Finalize_Library_Objects");
+ Set_String (" := null;");
end if;
-
- Write_Statement_Buffer;
end if;
+
+ Write_Statement_Buffer;
end if;
-- Generate elaboration calls
@@ -1001,40 +941,6 @@ package body Bindgen is
WBI ("void " & Ada_Init_Name.all & " (void)");
WBI ("{");
- -- Generate externals for elaboration entities
-
- for E in Elab_Order.First .. Elab_Order.Last loop
- declare
- Unum : constant Unit_Id := Elab_Order.Table (E);
- U : Unit_Record renames Units.Table (Unum);
-
- begin
- -- Check for Elab entity to be set for this unit
-
- if U.Set_Elab_Entity
-
- -- Don't generate reference for stand alone library
-
- and then not U.SAL_Interface
-
- -- Don't generate reference for predefined file in No_Run_Time
- -- mode, since we don't include the object files in this case
-
- and then not
- (No_Run_Time_Mode
- and then Is_Predefined_File_Name (U.Sfile))
- then
- Set_String (" extern char ");
- Get_Name_String (U.Uname);
- Set_Unit_Name;
- Set_String ("_E;");
- Write_Statement_Buffer;
- end if;
- end;
- end loop;
-
- Write_Statement_Buffer;
-
-- Standard library suppressed
if Suppress_Standard_Library_On_Target then
@@ -1217,22 +1123,26 @@ package body Bindgen is
Set_String (";");
Write_Statement_Buffer;
+ -- Import entry point for elaboration time signal handler
+ -- installation, and indication of if it's been called previously.
+
+ WBI (" extern int __gnat_handler_installed;");
WBI ("");
-- Install elaboration time signal handler
WBI (" if (__gnat_handler_installed == 0)");
- WBI (" {");
- WBI (" __gnat_install_handler ();");
- WBI (" }");
+ WBI (" __gnat_install_handler ();");
- -- Call feature enable/disable routine
+ -- Import entry point for environment feature enable/disable
+ -- routine, and indication that it's been called previously.
if OpenVMS_On_Target then
+ WBI (" extern int __gnat_features_set;");
+ WBI ("");
+
WBI (" if (__gnat_features_set == 0)");
- WBI (" {");
- WBI (" __gnat_set_features ();");
- WBI (" }");
+ WBI (" __gnat_set_features ();");
end if;
end if;
@@ -1269,6 +1179,27 @@ package body Bindgen is
Write_Statement_Buffer;
end if;
+ -- In the main program case, attach finalize_library to the soft link.
+ -- Do it only when not using a restricted run time, in which case tasks
+ -- are non-terminating, so we do not want library-level finalization.
+
+ if Bind_Main_Program
+ and then not Configurable_Run_Time_On_Target
+ and then not Suppress_Standard_Library_On_Target
+ then
+ WBI ("");
+ WBI (" extern void (*__gnat_finalize_library_objects)(void);");
+
+ if Lib_Final_Built then
+ Set_String (" __gnat_finalize_library_objects = ");
+ Set_String ("&finalize_library;");
+ else
+ Set_String (" __gnat_finalize_library_objects = 0;");
+ end if;
+
+ Write_Statement_Buffer;
+ end if;
+
-- Generate elaboration calls
WBI ("");
@@ -1277,6 +1208,130 @@ package body Bindgen is
WBI ("");
end Gen_Adainit_C;
+ ----------------------------
+ -- Gen_Elab_Externals_Ada --
+ ----------------------------
+
+ procedure Gen_Elab_Externals_Ada is
+ begin
+ for E in Elab_Order.First .. Elab_Order.Last loop
+ declare
+ Unum : constant Unit_Id := Elab_Order.Table (E);
+ U : Unit_Record renames Units.Table (Unum);
+
+ begin
+ -- Check for Elab_Entity to be set for this unit
+
+ if U.Set_Elab_Entity
+
+ -- Don't generate reference for stand alone library
+
+ and then not U.SAL_Interface
+
+ -- Don't generate reference for predefined file in No_Run_Time
+ -- mode, since we don't include the object files in this case
+
+ and then not
+ (No_Run_Time_Mode
+ and then Is_Predefined_File_Name (U.Sfile))
+ then
+ Set_String (" ");
+ Set_String ("E");
+ Set_Unit_Number (Unum);
+
+ case VM_Target is
+ when No_VM | JVM_Target =>
+ Set_String (" : Integer; pragma Import (Ada, ");
+ when CLI_Target =>
+ Set_String (" : Integer; pragma Import (CIL, ");
+ end case;
+
+ Set_String ("E");
+ Set_Unit_Number (Unum);
+ Set_String (", """);
+ Get_Name_String (U.Uname);
+
+ -- In the case of JGNAT we need to emit an Import name that
+ -- includes the class name (using '$' separators in the case
+ -- of a child unit name).
+
+ if VM_Target /= No_VM then
+ for J in 1 .. Name_Len - 2 loop
+ if VM_Target = CLI_Target
+ or else Name_Buffer (J) /= '.'
+ then
+ Set_Char (Name_Buffer (J));
+ else
+ Set_String ("$");
+ end if;
+ end loop;
+
+ if VM_Target /= CLI_Target or else U.Unit_Kind = 's' then
+ Set_String (".");
+ else
+ Set_String ("_pkg.");
+ end if;
+
+ -- If the unit name is very long, then split the
+ -- Import link name across lines using "&" (occurs
+ -- in some C2 tests).
+
+ if 2 * Name_Len + 60 > Hostparm.Max_Line_Length then
+ Set_String (""" &");
+ Write_Statement_Buffer;
+ Set_String (" """);
+ end if;
+ end if;
+
+ Set_Unit_Name;
+ Set_String ("_E"");");
+ Write_Statement_Buffer;
+ end if;
+ end;
+ end loop;
+
+ WBI ("");
+ end Gen_Elab_Externals_Ada;
+
+ --------------------------
+ -- Gen_Elab_Externals_C --
+ --------------------------
+
+ procedure Gen_Elab_Externals_C is
+ begin
+ for E in Elab_Order.First .. Elab_Order.Last loop
+ declare
+ Unum : constant Unit_Id := Elab_Order.Table (E);
+ U : Unit_Record renames Units.Table (Unum);
+
+ begin
+ -- Check for Elab entity to be set for this unit
+
+ if U.Set_Elab_Entity
+
+ -- Don't generate reference for stand alone library
+
+ and then not U.SAL_Interface
+
+ -- Don't generate reference for predefined file in No_Run_Time
+ -- mode, since we don't include the object files in this case
+
+ and then not
+ (No_Run_Time_Mode
+ and then Is_Predefined_File_Name (U.Sfile))
+ then
+ Set_String ("extern int ");
+ Get_Name_String (U.Uname);
+ Set_Unit_Name;
+ Set_String ("_E;");
+ Write_Statement_Buffer;
+ end if;
+ end;
+ end loop;
+
+ WBI ("");
+ end Gen_Elab_Externals_C;
+
------------------------
-- Gen_Elab_Calls_Ada --
------------------------
@@ -1306,51 +1361,55 @@ package body Bindgen is
if No_Run_Time_Mode and then Is_Predefined_File_Name (U.Sfile) then
null;
+ -- Likewise if this is an interface to a stand alone library
+
+ elsif U.SAL_Interface then
+ null;
+
-- Case of no elaboration code
elsif U.No_Elab then
- -- The only case in which we have to do something is if
- -- this is a body, with a separate spec, where the separate
- -- spec has an elaboration entity defined.
+ -- The only case in which we have to do something is if this
+ -- is a body, with a separate spec, where the separate spec
+ -- has an elaboration entity defined. In that case, this is
+ -- where we increment the elaboration entity.
- -- In that case, this is where we set the elaboration entity
- -- to True, we do not need to test if this has already been
- -- done, since it is quicker to set the flag than to test it.
-
- if not U.SAL_Interface and then U.Utype = Is_Body
+ if U.Utype = Is_Body
and then Units.Table (Unum_Spec).Set_Elab_Entity
then
Set_String (" E");
Set_Unit_Number (Unum_Spec);
- Set_String (" := True;");
+ Set_String (" := E");
+ Set_Unit_Number (Unum_Spec);
+ Set_String (" + 1;");
Write_Statement_Buffer;
end if;
-- Here if elaboration code is present. If binding a library
-- or if there is a non-Ada main subprogram then we generate:
- -- if not uname_E then
+ -- if uname_E = 0 then
-- uname'elab_[spec|body];
- -- uname_E := True;
-- end if;
+ -- uname_E := uname_E + 1;
-- Otherwise, elaboration routines are called unconditionally:
-- uname'elab_[spec|body];
- -- uname_E := True;
+ -- uname_E := uname_E + 1;
- -- The uname_E assignment is skipped if this is a separate spec,
- -- since the assignment will be done when we process the body.
+ -- The uname_E increment is skipped if this is a separate spec,
+ -- since it will be done when we process the body.
- elsif not U.SAL_Interface then
+ else
if Force_Checking_Of_Elaboration_Flags or
Interface_Library_Unit or
(not Bind_Main_Program)
then
- Set_String (" if not E");
+ Set_String (" if E");
Set_Unit_Number (Unum_Spec);
- Set_String (" then");
+ Set_String (" = 0 then");
Write_Statement_Buffer;
Set_String (" ");
end if;
@@ -1386,26 +1445,21 @@ package body Bindgen is
Set_Char (';');
Write_Statement_Buffer;
- if U.Utype /= Is_Spec then
- if Force_Checking_Of_Elaboration_Flags or
- Interface_Library_Unit or
- (not Bind_Main_Program)
- then
- Set_String (" ");
- end if;
-
- Set_String (" E");
- Set_Unit_Number (Unum_Spec);
- Set_String (" := True;");
- Write_Statement_Buffer;
- end if;
-
if Force_Checking_Of_Elaboration_Flags or
Interface_Library_Unit or
(not Bind_Main_Program)
then
WBI (" end if;");
end if;
+
+ if U.Utype /= Is_Spec then
+ Set_String (" E");
+ Set_Unit_Number (Unum_Spec);
+ Set_String (" := E");
+ Set_Unit_Number (Unum_Spec);
+ Set_String (" + 1;");
+ Write_Statement_Buffer;
+ end if;
end if;
end;
end loop;
@@ -1440,40 +1494,47 @@ package body Bindgen is
if No_Run_Time_Mode and then Is_Predefined_File_Name (U.Sfile) then
null;
+ -- Likewise if this is an interface to a stand alone library
+
+ elsif U.SAL_Interface then
+ null;
+
-- Case of no elaboration code
elsif U.No_Elab then
- -- The only case in which we have to do something is if
- -- this is a body, with a separate spec, where the separate
- -- spec has an elaboration entity defined.
+ -- The only case in which we have to do something is if this
+ -- is a body, with a separate spec, where the separate spec
+ -- has an elaboration entity defined. In that case, this is
+ -- where we increment the elaboration entity.
- -- In that case, this is where we set the elaboration entity
- -- to True, we do not need to test if this has already been
- -- done, since it is quicker to set the flag than to test it.
-
- if not U.SAL_Interface and then U.Utype = Is_Body
+ if U.Utype = Is_Body
and then Units.Table (Unum_Spec).Set_Elab_Entity
then
- Set_String (" ");
Get_Name_String (U.Uname);
+
+ Set_String (" ");
Set_Unit_Name;
- Set_String ("_E = 1;");
+ Set_String ("_E++;");
Write_Statement_Buffer;
end if;
-- Here if elaboration code is present. If binding a library
-- or if there is a non-Ada main subprogram then we generate:
- -- if (uname_E == 0) {
+ -- if (uname_E == 0)
-- uname__elab[s|b] ();
- -- uname_E++;
- -- }
+ -- uname_E++;
+
+ -- Otherwise, elaboration routines are called unconditionally:
- -- The uname_E assignment is skipped if this is a separate spec,
- -- since the assignment will be done when we process the body.
+ -- uname__elab[s|b] ();
+ -- uname_E++;
- elsif not U.SAL_Interface then
+ -- The uname_E increment is skipped if this is a separate spec,
+ -- since it will be done when we process the body.
+
+ else
Get_Name_String (U.Uname);
if Force_Checking_Of_Elaboration_Flags or
@@ -1482,7 +1543,7 @@ package body Bindgen is
then
Set_String (" if (");
Set_Unit_Name;
- Set_String ("_E == 0) {");
+ Set_String ("_E == 0)");
Write_Statement_Buffer;
Set_String (" ");
end if;
@@ -1495,25 +1556,11 @@ package body Bindgen is
Write_Statement_Buffer;
if U.Utype /= Is_Spec then
- if Force_Checking_Of_Elaboration_Flags or
- Interface_Library_Unit or
- (not Bind_Main_Program)
- then
- Set_String (" ");
- end if;
-
Set_String (" ");
Set_Unit_Name;
Set_String ("_E++;");
Write_Statement_Buffer;
end if;
-
- if Force_Checking_Of_Elaboration_Flags or
- Interface_Library_Unit or
- (not Bind_Main_Program)
- then
- WBI (" }");
- end if;
end if;
end;
end loop;
@@ -1542,6 +1589,8 @@ package body Bindgen is
Write_Statement_Buffer;
end if;
end loop;
+
+ WBI ("/* END ELABORATION DEFINITIONS */");
WBI ("");
end Gen_Elab_Defs_C;
@@ -1602,12 +1651,13 @@ package body Bindgen is
if U.Unit_Kind = 'p'
and then U.Has_Finalizer
and then not U.Is_Generic
+ and then not U.SAL_Interface
and then not U.No_Elab
then
if not Lib_Final_Built then
Lib_Final_Built := True;
- WBI (" procedure Finalize_Library is");
+ WBI (" procedure finalize_library is");
-- The following flag is used to check for library-level
-- exceptions raised during finalization. The symbol comes
@@ -1708,16 +1758,48 @@ package body Bindgen is
Set_String (""");");
Write_Statement_Buffer;
- WBI (" begin");
+ -- If binding a library or if there is a non-Ada main subprogram
+ -- then we generate:
- -- Generate:
+ -- begin
+ -- uname_E := uname_E - 1;
+ -- if uname_E = 0 then
+ -- F<Count>;
+ -- end if;
+ -- end;
+
+ -- Otherwise, finalization routines are called unconditionally:
+
+ -- begin
+ -- uname_E := uname_E - 1;
-- F<Count>;
-- end;
+ WBI (" begin");
+ Set_String (" E");
+ Set_Unit_Number (Unum);
+ Set_String (" := E");
+ Set_Unit_Number (Unum);
+ Set_String (" - 1;");
+ Write_Statement_Buffer;
+
+ if Interface_Library_Unit or (not Bind_Main_Program) then
+ Set_String (" if E");
+ Set_Unit_Number (Unum);
+ Set_String (" = 0 then");
+ Write_Statement_Buffer;
+ Set_String (" ");
+ end if;
+
Set_String (" F");
Set_Int (Count);
Set_Char (';');
Write_Statement_Buffer;
+
+ if Interface_Library_Unit or (not Bind_Main_Program) then
+ WBI (" end if;");
+ end if;
+
WBI (" end;");
Count := Count + 1;
@@ -1762,7 +1844,7 @@ package body Bindgen is
end if;
WBI (" end if;");
- WBI (" end Finalize_Library;");
+ WBI (" end finalize_library;");
WBI ("");
end if;
end Gen_Finalize_Library_Ada;
@@ -1777,8 +1859,6 @@ package body Bindgen is
Unum : Unit_Id;
begin
- WBI (" /* BEGIN FINALIZE */");
-
for E in reverse Elab_Order.First .. Elab_Order.Last loop
Unum := Elab_Order.Table (E);
U := Units.Table (Unum);
@@ -1788,9 +1868,14 @@ package body Bindgen is
if U.Unit_Kind = 'p'
and then U.Has_Finalizer
and then not U.Is_Generic
+ and then not U.SAL_Interface
and then not U.No_Elab
then
- Set_String (" ");
+ if not Lib_Final_Built then
+ Lib_Final_Built := True;
+
+ WBI ("static void finalize_library(void) {");
+ end if;
-- Dealing with package bodies is a little complicated. In such
-- cases we must retrieve the package spec since it contains the
@@ -1804,6 +1889,34 @@ package body Bindgen is
end if;
Get_Name_String (Uspec.Uname);
+
+ -- If binding a library or if there is a non-Ada main subprogram
+ -- then we generate:
+
+ -- uname_E--;
+ -- if (uname_E == 0)
+ -- uname__finalize[S|B] ();
+
+ -- Otherwise, finalization routines are called unconditionally:
+
+ -- uname_E--;
+ -- uname__finalize[S|B] ();
+
+ Set_String (" ");
+ Set_Unit_Name;
+ Set_String ("_E--;");
+ Write_Statement_Buffer;
+
+ if Interface_Library_Unit or (not Bind_Main_Program) then
+ Set_String (" if (");
+ Set_Unit_Name;
+ Set_String ("_E == 0)");
+ Write_Statement_Buffer;
+ Set_String (" ");
+ end if;
+
+ Set_String (" ");
+ Get_Name_String (Uspec.Uname);
Set_Unit_Name;
Set_String ("__finalize");
@@ -1826,8 +1939,10 @@ package body Bindgen is
end if;
end loop;
- WBI (" /* END FINALIZE */");
- WBI ("");
+ if Lib_Final_Built then
+ WBI ("}");
+ WBI ("");
+ end if;
end Gen_Finalize_Library_C;
---------------------------------
@@ -2124,15 +2239,10 @@ package body Bindgen is
----------------
procedure Gen_Main_C is
- Needs_Library_Finalization : constant Boolean :=
- not Configurable_Run_Time_On_Target
- and then Has_Finalizer;
- -- For restricted run-time libraries (ZFP and Ravenscar) tasks are
- -- non-terminating, so we do not want library-level finalization.
-
begin
if Exit_Status_Supported_On_Target then
WBI ("#include <stdlib.h>");
+ WBI ("");
Set_String ("int ");
else
Set_String ("void ");
@@ -2190,7 +2300,7 @@ package body Bindgen is
WBI (" gnat_argc = argc;");
WBI (" gnat_argv = argv;");
WBI (" gnat_envp = envp;");
- WBI (" ");
+ WBI ("");
-- If configurable run-time, then nothing to do, since in this case
-- the gnat_argc/argv/envp variables are entirely suppressed.
@@ -2239,7 +2349,6 @@ package body Bindgen is
if not No_Main_Subprogram then
WBI (" __gnat_break_start ();");
- WBI (" ");
-- Output main program name
@@ -2266,10 +2375,8 @@ package body Bindgen is
-- Call adafinal if finalization active
- if not Cumulative_Restrictions.Set (No_Finalization)
- and then Needs_Library_Finalization
- then
- Gen_Finalize_Library_C;
+ if not Cumulative_Restrictions.Set (No_Finalization) then
+ WBI (" " & Ada_Final_Name.all & " ();");
end if;
-- Outputs the dynamic stack measurement if needed
@@ -2798,29 +2905,29 @@ package body Bindgen is
"""__gnat_ada_main_program_name"");");
end if;
- if not Cumulative_Restrictions.Set (No_Finalization) then
- WBI ("");
- WBI (" procedure " & Ada_Final_Name.all & ";");
- WBI (" pragma Export (C, " & Ada_Final_Name.all & ", """ &
- Ada_Final_Name.all & """);");
- end if;
-
WBI ("");
WBI (" procedure " & Ada_Init_Name.all & ";");
WBI (" pragma Export (C, " & Ada_Init_Name.all & ", """ &
Ada_Init_Name.all & """);");
-- If -a has been specified use pragma Linker_Constructor for the init
- -- procedure. No need to use a similar pragma for the final procedure as
- -- global finalization will occur when the executable finishes execution
- -- and for plugins (shared stand-alone libraries that can be
- -- "unloaded"), finalization should not occur automatically, otherwise
- -- the main executable may not continue to work properly.
+ -- procedure and pragma Linker_Destructor for the final procedure.
if Use_Pragma_Linker_Constructor then
WBI (" pragma Linker_Constructor (" & Ada_Init_Name.all & ");");
end if;
+ if not Cumulative_Restrictions.Set (No_Finalization) then
+ WBI ("");
+ WBI (" procedure " & Ada_Final_Name.all & ";");
+ WBI (" pragma Export (C, " & Ada_Final_Name.all & ", """ &
+ Ada_Final_Name.all & """);");
+
+ if Use_Pragma_Linker_Constructor then
+ WBI (" pragma Linker_Destructor (" & Ada_Final_Name.all & ");");
+ end if;
+ end if;
+
if Bind_Main_Program and then VM_Target = No_VM then
-- If we have the standard library, then Break_Start is defined
@@ -2933,6 +3040,10 @@ package body Bindgen is
WBI ("");
WBI ("package body " & Ada_Main & " is");
WBI (" pragma Warnings (Off);");
+ WBI ("");
+
+ -- Generate externals for elaboration entities
+ Gen_Elab_Externals_Ada;
if not Suppress_Standard_Library_On_Target then
@@ -2964,11 +3075,11 @@ package body Bindgen is
-- Generate the adafinal routine unless there is no finalization to do
if not Cumulative_Restrictions.Set (No_Finalization) then
- Gen_Adafinal_Ada;
-
if Needs_Library_Finalization then
Gen_Finalize_Library_Ada;
end if;
+
+ Gen_Adafinal_Ada;
end if;
Gen_Adainit_Ada;
@@ -3019,14 +3130,8 @@ package body Bindgen is
Resolve_Binder_Options;
- WBI ("extern void " & Ada_Final_Name.all & " (void);");
-
-- If -a has been specified use __attribute__((constructor)) for the
- -- init procedure. No need to use a similar featute for the final
- -- procedure as global finalization will occur when the executable
- -- finishes execution and for plugins (shared stand-alone libraries that
- -- can be "unloaded"), finalization should not occur automatically,
- -- otherwise the main executable may not continue to work properly.
+ -- init procedure and __attribute__((destructor)) for the final one.
if Use_Pragma_Linker_Constructor then
WBI ("extern void " & Ada_Init_Name.all &
@@ -3035,6 +3140,15 @@ package body Bindgen is
WBI ("extern void " & Ada_Init_Name.all & " (void);");
end if;
+ if not Cumulative_Restrictions.Set (No_Finalization) then
+ if Use_Pragma_Linker_Constructor then
+ WBI ("extern void " & Ada_Final_Name.all &
+ " (void) __attribute__((destructor));");
+ else
+ WBI ("extern void " & Ada_Final_Name.all & " (void);");
+ end if;
+ end if;
+
WBI ("extern void system__standard_library__adafinal (void);");
if not No_Main_Subprogram then
@@ -3099,29 +3213,15 @@ package body Bindgen is
WBI ("");
+ -- Generate externals for elaboration entities
+ Gen_Elab_Externals_C;
+
Gen_Elab_Defs_C;
if Needs_Library_Finalization then
Gen_Finalize_Library_Defs_C;
end if;
- -- Imported variables used only when we have a runtime
-
- if not Suppress_Standard_Library_On_Target then
-
- -- Track elaboration/finalization phase
-
- WBI ("extern int __gnat_handler_installed;");
- WBI ("");
-
- -- Track feature enable/disable on VMS
-
- if OpenVMS_On_Target then
- WBI ("extern int __gnat_features_set;");
- WBI ("");
- end if;
- end if;
-
-- Write argv/argc exit status stuff if main program case
if Bind_Main_Program then
@@ -3174,8 +3274,8 @@ package body Bindgen is
-- (for the debugger to get initial control) is defined in this file.
if Suppress_Standard_Library_On_Target then
- WBI ("");
WBI ("void __gnat_break_start (void) {}");
+ WBI ("");
end if;
-- Generate the __gnat_version and __gnat_ada_main_program_name info
@@ -3184,7 +3284,6 @@ package body Bindgen is
-- when a C program uses 2 Ada libraries)
if Bind_Main_Program then
- WBI ("");
WBI ("char __gnat_version[] = """ & Ver_Prefix &
Gnat_Version_String & """;");
@@ -3193,12 +3292,16 @@ package body Bindgen is
Set_Main_Program_Name;
Set_String (""";");
Write_Statement_Buffer;
+ WBI ("");
end if;
- -- Generate the adafinal routine. In no runtime mode, this is not
- -- needed, since there is no finalization to do.
+ -- Generate the adafinal routine unless there is no finalization to do
if not Cumulative_Restrictions.Set (No_Finalization) then
+ if Needs_Library_Finalization then
+ Gen_Finalize_Library_C;
+ end if;
+
Gen_Adafinal_C;
end if;
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index b915668..97bbf28 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -3463,7 +3463,7 @@ package body Checks is
if Enable_Overflow_Checks
and then not Is_Entity_Name (N)
- and then (Lor < Lo or else Hir > Hi)
+ and then (Lor < Lo or else Hir > Hi)
then
OK := False;
return;
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 0bc2e38..9a96e8c 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -934,32 +934,34 @@ package Einfo is
-- to the spec as possible.
-- Elaboration_Entity (Node13)
--- Present in generic and non-generic package and subprogram
--- entities. This is a boolean entity associated with the unit that
--- is initially set to False, and is set True when the unit is
--- elaborated. This is used for two purposes. First, it is used to
--- implement required access before elaboration checks (the flag
--- must be true to call a subprogram at elaboration time). Second,
--- it is used to guard against repeated execution of the generated
--- elaboration code.
+-- Present in generic and non-generic package and subprogram entities.
+-- This is a counter associated with the unit that is initially set to
+-- zero, is incremented when an elaboration request for the unit is
+-- made, and is decremented when a finalization request for the unit
+-- is made. This is used for three purposes. First, it is used to
+-- implement access before elaboration checks (the counter must be
+-- non-zero to call a subprogram at elaboration time). Second, it is
+-- used to guard against repeated execution of the elaboration code.
+-- Third, it is used to ensure that the finalization code is executed
+-- only after all clients have requested it.
--
--- Note that we always allocate this flag, and set this field, but
+-- Note that we always allocate this counter, and set this field, but
-- we do not always actually use it. It is only used if it is needed
--- for access-before-elaboration use (see Elaboration_Entity_Required
+-- for access before elaboration use (see Elaboration_Entity_Required
-- flag) or if either the spec or the body has elaboration code. If
-- neither of these two conditions holds, then the entity is still
-- allocated (since we don't know early enough whether or not there
-- is elaboration code), but is simply not used for any purpose.
-- Elaboration_Entity_Required (Flag174)
--- Present in generics and non-generic package and subprogram
--- entities. Set only if Elaboration_Entity is non-Empty to indicate
--- that the boolean is required to be set even if there is no other
--- elaboration code. This occurs when the Elaboration_Entity flag
--- is used for required access-before-elaboration checking. If the
--- flag is only for preventing multiple execution of the elaboration
--- code, then if there is no other elaboration code, obviously there
--- is no need to set the flag.
+-- Present in generic and non-generic package and subprogram entities.
+-- Set only if Elaboration_Entity is non-Empty to indicate that the
+-- counter is required to be non-zero even if there is no other
+-- elaboration code. This occurs when the Elaboration_Entity counter
+-- is used for access before elaboration checks. If the counter is
+-- only used to prevent multiple execution of the elaboration code,
+-- then if there is no other elaboration code, obviously there is no
+-- need to set the flag.
-- Enclosing_Scope (Node18)
-- Present in labels. Denotes the innermost enclosing construct that
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 686bf04..6131b23 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -1916,7 +1916,12 @@ package body Exp_Attr is
begin
if Present (Elaboration_Entity (Ent)) then
Rewrite (N,
- New_Occurrence_Of (Elaboration_Entity (Ent), Loc));
+ Make_Op_Ne (Loc,
+ Left_Opnd =>
+ New_Occurrence_Of (Elaboration_Entity (Ent), Loc),
+ Right_Opnd =>
+ Make_Integer_Literal (Loc, Uint_0)));
+ Analyze_And_Resolve (N, Typ);
else
Rewrite (N, New_Occurrence_Of (Standard_True, Loc));
end if;
diff --git a/gcc/ada/exp_ch12.adb b/gcc/ada/exp_ch12.adb
index 5ff2ee3..7c7f92c 100644
--- a/gcc/ada/exp_ch12.adb
+++ b/gcc/ada/exp_ch12.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1997-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1997-2011, 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- --
@@ -29,6 +29,7 @@ with Einfo; use Einfo;
with Exp_Util; use Exp_Util;
with Nmake; use Nmake;
with Sinfo; use Sinfo;
+with Snames; use Snames;
with Stand; use Stand;
with Tbuild; use Tbuild;
@@ -59,7 +60,9 @@ package body Exp_Ch12 is
Condition =>
Make_Op_Not (Loc,
Right_Opnd =>
- New_Occurrence_Of (Elaboration_Entity (Ent), Loc)),
+ Make_Attribute_Reference (Loc,
+ Attribute_Name => Name_Elaborated,
+ Prefix => New_Occurrence_Of (Ent, Loc))),
Reason => PE_Access_Before_Elaboration));
end if;
end Expand_N_Generic_Instantiation;
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index cfc58e2..c49cf25 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -2897,6 +2897,7 @@ package body Exp_Ch7 is
is
A_Expr : Node_Id;
E_Decl : Node_Id;
+ Result : List_Id;
begin
if Restriction_Active (No_Exception_Propagation) then
@@ -2907,37 +2908,87 @@ package body Exp_Ch7 is
pragma Assert (Present (E_Id));
pragma Assert (Present (Raised_Id));
- -- Generate:
- -- Exception_Identity (Get_Current_Excep.all.all) =
- -- Standard'Abort_Signal'Identity;
+ Result := New_List;
+
+ -- In certain scenarios, finalization can be triggered by an abort. If
+ -- the finalization itself fails and raises an exception, the resulting
+ -- Program_Error must be supressed and replaced by an abort signal. In
+ -- order to detect this scenario, save the state of entry into the
+ -- finalization code.
if Abort_Allowed then
- A_Expr :=
- Make_Op_Eq (Loc,
- Left_Opnd =>
- Make_Function_Call (Loc,
- Name =>
- New_Reference_To (RTE (RE_Exception_Identity), Loc),
- Parameter_Associations => New_List (
- Make_Explicit_Dereference (Loc,
- Prefix =>
- Make_Function_Call (Loc,
- Name =>
- Make_Explicit_Dereference (Loc,
- Prefix =>
- New_Reference_To
- (RTE (RE_Get_Current_Excep), Loc)))))),
+ declare
+ Temp_Id : constant Entity_Id := Make_Temporary (Loc, 'E');
+
+ begin
+ -- Generate:
+ -- Temp : constant Exception_Occurrence_Access :=
+ -- Get_Current_Excep.all;
+
+ Append_To (Result,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Temp_Id,
+ Constant_Present => True,
+ Object_Definition =>
+ New_Reference_To (RTE (RE_Exception_Occurrence_Access), Loc),
+ Expression =>
+ Make_Function_Call (Loc,
+ Name =>
+ Make_Explicit_Dereference (Loc,
+ Prefix =>
+ New_Reference_To
+ (RTE (RE_Get_Current_Excep), Loc)))));
+
+ -- Generate:
+ -- Temp /= null
+ -- and then Exception_Identity (Temp.all) =
+ -- Standard'Abort_Signal'Identity;
+
+ A_Expr :=
+ Make_And_Then (Loc,
+ Left_Opnd =>
+ Make_Op_Ne (Loc,
+ Left_Opnd =>
+ New_Reference_To (Temp_Id, Loc),
+ Right_Opnd =>
+ Make_Null (Loc)),
+
+ Right_Opnd =>
+ Make_Op_Eq (Loc,
+ Left_Opnd =>
+ Make_Function_Call (Loc,
+ Name =>
+ New_Reference_To (RTE (RE_Exception_Identity), Loc),
+ Parameter_Associations => New_List (
+ Make_Explicit_Dereference (Loc,
+ Prefix =>
+ New_Reference_To (Temp_Id, Loc)))),
+
+ Right_Opnd =>
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ New_Reference_To (Stand.Abort_Signal, Loc),
+ Attribute_Name => Name_Identity)));
+ end;
+
+ -- No abort
- Right_Opnd =>
- Make_Attribute_Reference (Loc,
- Prefix =>
- New_Reference_To (Stand.Abort_Signal, Loc),
- Attribute_Name => Name_Identity));
else
A_Expr := New_Reference_To (Standard_False, Loc);
end if;
-- Generate:
+ -- Abort_Id : constant Boolean := <A_Expr>;
+
+ Append_To (Result,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Abort_Id,
+ Constant_Present => True,
+ Object_Definition =>
+ New_Reference_To (Standard_Boolean, Loc),
+ Expression => A_Expr));
+
+ -- Generate:
-- E_Id : Exception_Occurrence;
E_Decl :=
@@ -2947,30 +2998,20 @@ package body Exp_Ch7 is
New_Reference_To (RTE (RE_Exception_Occurrence), Loc));
Set_No_Initialization (E_Decl);
- return
- New_List (
-
- -- Abort_Id
-
- Make_Object_Declaration (Loc,
- Defining_Identifier => Abort_Id,
- Constant_Present => True,
- Object_Definition =>
- New_Reference_To (Standard_Boolean, Loc),
- Expression => A_Expr),
+ Append_To (Result, E_Decl);
- -- E_Id
-
- E_Decl,
+ -- Generate:
+ -- Raised_Id : Boolean := False;
- -- Raised_Id
+ Append_To (Result,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Raised_Id,
+ Object_Definition =>
+ New_Reference_To (Standard_Boolean, Loc),
+ Expression =>
+ New_Reference_To (Standard_False, Loc)));
- Make_Object_Declaration (Loc,
- Defining_Identifier => Raised_Id,
- Object_Definition =>
- New_Reference_To (Standard_Boolean, Loc),
- Expression =>
- New_Reference_To (Standard_False, Loc)));
+ return Result;
end Build_Object_Declarations;
---------------------------
@@ -4600,9 +4641,12 @@ package body Exp_Ch7 is
-- controlled elements. Generate:
-- declare
+ -- Temp : constant Exception_Occurrence_Access :=
+ -- Get_Current_Excep.all;
-- Abort : constant Boolean :=
- -- Exception_Identity (Get_Current_Excep.all) =
- -- Standard'Abort_Signal'Identity;
+ -- Temp /= null
+ -- and then Exception_Identity (Temp_Id.all) =
+ -- Standard'Abort_Signal'Identity;
-- <or>
-- Abort : constant Boolean := False; -- no abort
@@ -4653,9 +4697,12 @@ package body Exp_Ch7 is
-- exception
-- when others =>
-- declare
+ -- Temp : constant Exception_Occurrence_Access :=
+ -- Get_Current_Excep.all;
-- Abort : constant Boolean :=
- -- Exception_Identity (Get_Current_Excep.all) =
- -- Standard'Abort_Signal'Identity;
+ -- Temp /= null
+ -- and then Exception_Identity (Temp_Id.all) =
+ -- Standard'Abort_Signal'Identity;
-- <or>
-- Abort : constant Boolean := False; -- no abort
-- E : Exception_Occurence;
@@ -5513,9 +5560,12 @@ package body Exp_Ch7 is
-- may have discriminants and contain variant parts. Generate:
-- declare
+ -- Temp : constant Exception_Occurrence_Access :=
+ -- Get_Current_Excep.all;
-- Abort : constant Boolean :=
- -- Exception_Identity (Get_Current_Excep.all) =
- -- Standard'Abort_Signal'Identity;
+ -- Temp /= null
+ -- and then Exception_Identity (Temp_Id.all) =
+ -- Standard'Abort_Signal'Identity;
-- <or>
-- Abort : constant Boolean := False; -- no abort
-- E : Exception_Occurence;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 5775103..cc4502e 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -6634,7 +6634,7 @@ package body Exp_Util is
Asn :=
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Ent, Loc),
- Expression => New_Occurrence_Of (Standard_True, Loc));
+ Expression => Make_Integer_Literal (Loc, Uint_1));
if Nkind (Parent (N)) = N_Subunit then
Insert_After (Corresponding_Stub (Parent (N)), Asn);
diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb
index e91bf61..eb8593a 100644
--- a/gcc/ada/prj-env.adb
+++ b/gcc/ada/prj-env.adb
@@ -1840,6 +1840,11 @@ package body Prj.Env is
Self.Path := new String'(Tmp.all & Path_Separator & Path);
Free (Tmp);
end if;
+
+ if Current_Verbosity = High then
+ Debug_Output ("Adding directories to Project_Path: """
+ & Path & '"');
+ end if;
end Add_Directories;
--------------------
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 6c79fde..d1b31f3 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -930,7 +930,9 @@ package body Prj.Nmsc is
Project_Path_For_Aggregate : Prj.Env.Project_Search_Path;
- procedure Found_Project_File (Path : Path_Information; Rank : Natural);
+ procedure Found_Project_File
+ (Path : Path_Information;
+ Rank : Natural);
-- Called for each project file aggregated by Project
procedure Expand_Project_Files is
@@ -942,7 +944,10 @@ package body Prj.Nmsc is
-- Found_Project_File --
------------------------
- procedure Found_Project_File (Path : Path_Information; Rank : Natural) is
+ procedure Found_Project_File
+ (Path : Path_Information;
+ Rank : Natural)
+ is
pragma Unreferenced (Rank);
begin
if Path.Name /= Project.Path.Name then
@@ -5041,8 +5046,8 @@ package body Prj.Nmsc is
Remove_Source_Dirs : Boolean := False;
procedure Add_To_Or_Remove_From_Source_Dirs
- (Path : Path_Information;
- Rank : Natural);
+ (Path : Path_Information;
+ Rank : Natural);
-- When Removed = False, the directory Path_Id to the list of
-- source_dirs if not already in the list. When Removed = True,
-- removed directory Path_Id if in the list.
@@ -5055,8 +5060,8 @@ package body Prj.Nmsc is
---------------------------------------
procedure Add_To_Or_Remove_From_Source_Dirs
- (Path : Path_Information;
- Rank : Natural)
+ (Path : Path_Information;
+ Rank : Natural)
is
List : String_List_Id;
Prev : String_List_Id;
@@ -5310,9 +5315,9 @@ package body Prj.Nmsc is
Remove_Source_Dirs := False;
Add_To_Or_Remove_From_Source_Dirs
- (Path => (Name => Project.Directory.Name,
- Display_Name => Project.Directory.Display_Name),
- Rank => 1);
+ (Path => (Name => Project.Directory.Name,
+ Display_Name => Project.Directory.Display_Name),
+ Rank => 1);
else
Remove_Source_Dirs := False;
diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb
index 366dfce..295ac40 100644
--- a/gcc/ada/prj-proc.adb
+++ b/gcc/ada/prj-proc.adb
@@ -28,6 +28,7 @@ with Opt; use Opt;
with Osint; use Osint;
with Output; use Output;
with Prj.Attr; use Prj.Attr;
+with Prj.Env;
with Prj.Err; use Prj.Err;
with Prj.Ext; use Prj.Ext;
with Prj.Nmsc; use Prj.Nmsc;
@@ -1971,10 +1972,6 @@ package body Prj.Proc is
& Get_Name_String (Index_Name) & ")", New_Value.Value);
end if;
end if;
-
- elsif Name = Snames.Name_Project_Path then
- Debug_Output
- ("Defined project path");
end if;
end Process_Expression_For_Associative_Array;
@@ -1987,11 +1984,10 @@ package body Prj.Proc is
New_Value : Variable_Value)
is
Name : constant Name_Id := Name_Of (Current_Item, Node_Tree);
- Var : Variable_Id := No_Variable;
-
Is_Attribute : constant Boolean :=
Kind_Of (Current_Item, Node_Tree) =
N_Attribute_Declaration;
+ Var : Variable_Id := No_Variable;
begin
-- First, find the list where to find the variable or attribute.
@@ -2056,6 +2052,29 @@ package body Prj.Proc is
else
Shared.Variable_Elements.Table (Var).Value := New_Value;
end if;
+
+ if Name = Snames.Name_Project_Path then
+ if In_Tree.Is_Root_Tree then
+ declare
+ Val : String_List_Id := New_Value.Values;
+ begin
+ while Val /= Nil_String loop
+ Prj.Env.Add_Directories
+ (Child_Env.Project_Path,
+ Get_Name_String
+ (Shared.String_Elements.Table (Val).Value));
+ Val := Shared.String_Elements.Table (Val).Next;
+ end loop;
+ end;
+
+ else
+ if Current_Verbosity = High then
+ Debug_Output
+ ("'for Project_Path' has no effect except in"
+ & " root aggregate");
+ end if;
+ end if;
+ end if;
end Process_Expression_Variable_Decl;
------------------------
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index df71ba5..985022c 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -504,6 +504,7 @@ package Rtsfind is
RE_Exception_Message, -- Ada.Exceptions
RE_Exception_Name_Simple, -- Ada.Exceptions
RE_Exception_Occurrence, -- Ada.Exceptions
+ RE_Exception_Occurrence_Access, -- Ada.Exceptions
RE_Null_Id, -- Ada.Exceptions
RE_Null_Occurrence, -- Ada.Exceptions
RE_Poll, -- Ada.Exceptions
@@ -1682,6 +1683,7 @@ package Rtsfind is
RE_Exception_Message => Ada_Exceptions,
RE_Exception_Name_Simple => Ada_Exceptions,
RE_Exception_Occurrence => Ada_Exceptions,
+ RE_Exception_Occurrence_Access => Ada_Exceptions,
RE_Null_Id => Ada_Exceptions,
RE_Null_Occurrence => Ada_Exceptions,
RE_Poll => Ada_Exceptions,
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 7ece583..de0b597 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -295,9 +295,6 @@ package body Sem_Attr is
procedure Check_Integer_Type;
-- Verify that prefix of attribute N is an integer type
- procedure Check_Library_Unit;
- -- Verify that prefix of attribute N is a library unit
-
procedure Check_Modular_Integer_Type;
-- Verify that prefix of attribute N is a modular integer type
@@ -344,8 +341,8 @@ package body Sem_Attr is
-- itself of the form of a library unit name. Note that this is
-- quite different from Check_Program_Unit, since it only checks
-- the syntactic form of the name, not the semantic identity. This
- -- is because it is used with attributes (Elab_Body, Elab_Spec, and
- -- UET_Address) which can refer to non-visible unit.
+ -- is because it is used with attributes (Elab_Body, Elab_Spec,
+ -- UET_Address and Elaborated) which can refer to non-visible unit.
procedure Error_Attr (Msg : String; Error_Node : Node_Id);
pragma No_Return (Error_Attr);
@@ -1302,17 +1299,6 @@ package body Sem_Attr is
end if;
end Check_Integer_Type;
- ------------------------
- -- Check_Library_Unit --
- ------------------------
-
- procedure Check_Library_Unit is
- begin
- if not Is_Compilation_Unit (Entity (P)) then
- Error_Attr_P ("prefix of % attribute must be library unit");
- end if;
- end Check_Library_Unit;
-
--------------------------------
-- Check_Modular_Integer_Type --
--------------------------------
@@ -1761,7 +1747,9 @@ package body Sem_Attr is
if Nkind (Nod) = N_Identifier then
return;
- elsif Nkind (Nod) = N_Selected_Component then
+ elsif Nkind (Nod) = N_Selected_Component
+ or else Nkind (Nod) = N_Expanded_Name
+ then
Check_Unit_Name (Prefix (Nod));
if Nkind (Selector_Name (Nod)) = N_Identifier then
@@ -3003,7 +2991,7 @@ package body Sem_Attr is
when Attribute_Elaborated =>
Check_E0;
- Check_Library_Unit;
+ Check_Unit_Name (P);
Set_Etype (N, Standard_Boolean);
----------
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index 0a676ef..87f31d8 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -55,6 +55,7 @@ with Snames; use Snames;
with Stand; use Stand;
with Table;
with Tbuild; use Tbuild;
+with Uintp; use Uintp;
with Uname; use Uname;
package body Sem_Elab is
@@ -2156,8 +2157,8 @@ package body Sem_Elab is
Make_Object_Declaration (Loce,
Defining_Identifier => Ent,
Object_Definition =>
- New_Occurrence_Of (Standard_Boolean, Loce),
- Expression => New_Occurrence_Of (Standard_False, Loce)));
+ New_Occurrence_Of (Standard_Integer, Loce),
+ Expression => Make_Integer_Literal (Loc, Uint_0)));
-- Set elaboration flag at the point of the body
@@ -2176,10 +2177,12 @@ package body Sem_Elab is
end;
end if;
- -- Generate check of the elaboration Boolean
+ -- Generate check of the elaboration counter
Insert_Elab_Check (N,
- New_Occurrence_Of (Elaboration_Entity (E), Loc));
+ Make_Attribute_Reference (Loc,
+ Attribute_Name => Name_Elaborated,
+ Prefix => New_Occurrence_Of (E, Loc)));
end if;
-- Generate the warning
@@ -2419,7 +2422,7 @@ package body Sem_Elab is
not Restriction_Active (No_Entry_Calls_In_Elaboration_Code)
then
-- Runtime elaboration check required. Generate check of the
- -- elaboration Boolean for the unit containing the entity.
+ -- elaboration counter for the unit containing the entity.
Insert_Elab_Check (N,
Make_Attribute_Reference (Loc,
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index f60aea0..7920d6d 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -964,9 +964,9 @@ package body Sem_Util is
Make_Object_Declaration (Loc,
Defining_Identifier => Elab_Ent,
Object_Definition =>
- New_Occurrence_Of (Standard_Boolean, Loc),
+ New_Occurrence_Of (Standard_Integer, Loc),
Expression =>
- New_Occurrence_Of (Standard_False, Loc));
+ Make_Integer_Literal (Loc, Uint_0));
Push_Scope (Standard_Standard);
Add_Global_Declaration (Decl);
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 954a11e..c8b1a1e 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -136,7 +136,7 @@ package Sem_Util is
-- discriminants, and build actual subtype for it if so.
procedure Build_Elaboration_Entity (N : Node_Id; Spec_Id : Entity_Id);
- -- Given a compilation unit node N, allocate an elaboration boolean for
+ -- Given a compilation unit node N, allocate an elaboration counter for
-- the compilation unit, and install it in the Elaboration_Entity field
-- of Spec_Id, the entity for the compilation unit.