This patch is aimed at improving the finalization of global controlled objects.
It implements a ref-counting scheme for elaboration/finalization on a per-unit
basis and changes the way global objects are finalized in libraries.
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-08-04 Eric Botcazou <ebotca...@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.
Index: exp_ch12.adb
===================================================================
--- exp_ch12.adb (revision 177274)
+++ exp_ch12.adb (working copy)
@@ -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 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 @@
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;
Index: exp_util.adb
===================================================================
--- exp_util.adb (revision 177280)
+++ exp_util.adb (working copy)
@@ -6634,7 +6634,7 @@
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);
Index: exp_attr.adb
===================================================================
--- exp_attr.adb (revision 177274)
+++ exp_attr.adb (working copy)
@@ -1916,7 +1916,12 @@
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;
Index: bindgen.adb
===================================================================
--- bindgen.adb (revision 177281)
+++ bindgen.adb (working copy)
@@ -72,6 +72,7 @@
-- 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 @@
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 @@
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 @@
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 @@
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 @@
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;
+ end if;
- Write_Statement_Buffer;
- end if;
+ Write_Statement_Buffer;
end if;
-- Generate elaboration calls
@@ -1001,40 +941,6 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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
+ Get_Name_String (U.Uname);
+
Set_String (" ");
- Get_Name_String (U.Uname);
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++;
- -- The uname_E assignment is skipped if this is a separate spec,
- -- since the assignment will be done when we process the body.
+ -- Otherwise, elaboration routines are called unconditionally:
- elsif not U.SAL_Interface then
+ -- uname__elab[s|b] ();
+ -- uname_E++;
+
+ -- 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 @@
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 @@
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 @@
Write_Statement_Buffer;
end if;
end loop;
+
+ WBI ("/* END ELABORATION DEFINITIONS */");
WBI ("");
end Gen_Elab_Defs_C;
@@ -1602,12 +1651,13 @@
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 @@
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 @@
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 @@
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,10 +1868,15 @@
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
-- spec of the body finalizer.
@@ -1804,7 +1889,35 @@
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");
-- Package spec processing
@@ -1826,8 +1939,10 @@
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 @@
----------------
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 @@
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 @@
if not No_Main_Subprogram then
WBI (" __gnat_break_start ();");
- WBI (" ");
-- Output main program name
@@ -2266,10 +2375,8 @@
-- 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 @@
"""__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,7 +3040,11 @@
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
-- Generate Priority_Specific_Dispatching pragma string
@@ -2964,11 +3075,11 @@
-- 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 @@
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 @@
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 @@
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 @@
-- (for the debugger to get initial control) is defined in this file.
if Suppress_Standard_Library_On_Target then
+ WBI ("void __gnat_break_start (void) {}");
WBI ("");
- WBI ("void __gnat_break_start (void) {}");
end if;
-- Generate the __gnat_version and __gnat_ada_main_program_name info
@@ -3184,7 +3284,6 @@
-- 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 @@
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;
Index: einfo.ads
===================================================================
--- einfo.ads (revision 177284)
+++ einfo.ads (working copy)
@@ -934,32 +934,34 @@
-- 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
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 177275)
+++ sem_util.adb (working copy)
@@ -964,9 +964,9 @@
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);
Index: sem_util.ads
===================================================================
--- sem_util.ads (revision 177275)
+++ sem_util.ads (working copy)
@@ -136,7 +136,7 @@
-- 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.
Index: sem_attr.adb
===================================================================
--- sem_attr.adb (revision 177274)
+++ sem_attr.adb (working copy)
@@ -295,9 +295,6 @@
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 @@
-- 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 @@
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 @@
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 @@
when Attribute_Elaborated =>
Check_E0;
- Check_Library_Unit;
+ Check_Unit_Name (P);
Set_Etype (N, Standard_Boolean);
----------
Index: sem_elab.adb
===================================================================
--- sem_elab.adb (revision 177275)
+++ sem_elab.adb (working copy)
@@ -55,6 +55,7 @@
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 @@
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 @@
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 @@
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,
