OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[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
This commit is contained in:
Arnaud Charlet 2011-08-04 09:45:20 +02:00
parent 316d9d4f9f
commit 824e932015
19 changed files with 659 additions and 410 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
gcc/ada/ChangeLog
View File

@ -1,3 +1,66 @@
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,

7
gcc/ada/a-cofove.ads
View File

@ -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;

22
gcc/ada/alfa.adb
View File

@ -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 --
-----------

8
gcc/ada/alfa.ads
View File

@ -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.

659
gcc/ada/bindgen.adb
View File

@ -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 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
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
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 (" Finalize_Library_Objects := null;");
end if;
Write_Statement_Buffer;
-- 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
Set_String
(" System.Soft_Links.Finalize_Library_Objects");
Set_String (" := null;");
end if;
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++;
-- 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 @@ 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
@ -1803,6 +1888,34 @@ package body Bindgen is
Uspec := U;
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;

2
gcc/ada/checks.adb
View File

@ -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;

38
gcc/ada/einfo.ads
View File

@ -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

7
gcc/ada/exp_attr.adb
View File

@ -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;

7
gcc/ada/exp_ch12.adb
View File

@ -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;

150
gcc/ada/exp_ch7.adb
View File

@ -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,36 +2908,86 @@ 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;
@ -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 (
Append_To (Result, E_Decl);
-- Abort_Id
-- Generate:
-- Raised_Id : Boolean := False;
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,
Make_Object_Declaration (Loc,
Defining_Identifier => Raised_Id,
Object_Definition =>
New_Reference_To (Standard_Boolean, Loc),
Expression =>
New_Reference_To (Standard_False, Loc)));
-- E_Id
E_Decl,
-- Raised_Id
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;

2
gcc/ada/exp_util.adb
View File

@ -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);

5
gcc/ada/prj-env.adb
View File

@ -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;
--------------------

23
gcc/ada/prj-nmsc.adb
View File

@ -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;

31
gcc/ada/prj-proc.adb
View File

@ -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;
------------------------

2
gcc/ada/rtsfind.ads
View File

@ -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,

24
gcc/ada/sem_attr.adb
View File

@ -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);
----------

13
gcc/ada/sem_elab.adb
View File

@ -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,

4
gcc/ada/sem_util.adb
View File

@ -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);

2
gcc/ada/sem_util.ads
View File

@ -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.