FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2015-05-12  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb: Minor reformatting.

2015-05-12  Vincent Celier  <celier@adacore.com>

	* gnatcmd.adb: If we want to invoke gnatmake (gnatclean) with
	-P, then check if gprbuild (gprclean) is available; if it is,
	use gprbuild (gprclean) instead of gnatmake (gnatclean).

2015-05-12  Robert Dewar  <dewar@adacore.com>

	* debug.adb: Add flag -gnatd.3 to output diagnostic info from
	Exp_Unst.
	* einfo.ad, einfo.adb: Reorganize (and remove most of) flags used by
	Exp_Unst.
	* exp_ch6.adb (Unest_Bodies): Table for delayed calls to
	Unnest_Subprogram (Expand_N_Subprogram_Body): Add entry to table
	for later call instead of calling Unnest_Subprogram directly
	(Initialize): New procedure (Unnest_Subprograms): New procedure
	* exp_ch6.ads (Add_Extra_Actual_To_Call): Move into proper
	alpha order.
	(Initialize): New procedure.
	(Unnest_Subprograms): New procedure.
	* exp_unst.adb (Unnest_Subprogram): Major rewrite, moving
	all processing to this routine which is now called late
	after instantiating bodies. Fully handles the case of generic
	instantiations now.
	* exp_unst.ads: Major rewrite, moving all processing to
	Unnest_Subprogram.
	* frontend.adb (Frontend): Add call to Exp_Ch6.Initialize.
	(Frontend): Add call to Unnest_Subprograms.
	* sem_ch8.adb (Find_Direct_Name): Back to old calling sequence
	for Check_Nested_Access.
	* sem_util.adb (Build_Default_Subtype): Minor reformatting
	(Check_Nested_Access): Back to original VM-only form (we
	now do all the processing for Unnest_Subprogram at the time
	it is called.
	(Denotes_Same_Object): Minor reformatting
	(Note_Possible_Modification): Old calling sequence for
	Check_Nested_Access.
	* sem_util.ads (Check_Nested_Access): Back to original VM-only
	form (we now do all the processing for Unnest_Subprogram at the
	time it is called.

From-SVN: r223043
This commit is contained in:
Arnaud Charlet 2015-05-12 10:36:45 +02:00
parent 73cc8f6230
commit f8dae9bb29
14 changed files with 1225 additions and 909 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

45
gcc/ada/ChangeLog
View file

@ -1,3 +1,48 @@
2015-05-12 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb: Minor reformatting.
2015-05-12 Vincent Celier <celier@adacore.com>
* gnatcmd.adb: If we want to invoke gnatmake (gnatclean) with
-P, then check if gprbuild (gprclean) is available; if it is,
use gprbuild (gprclean) instead of gnatmake (gnatclean).
2015-05-12 Robert Dewar <dewar@adacore.com>
* debug.adb: Add flag -gnatd.3 to output diagnostic info from
Exp_Unst.
* einfo.ad, einfo.adb: Reorganize (and remove most of) flags used by
Exp_Unst.
* exp_ch6.adb (Unest_Bodies): Table for delayed calls to
Unnest_Subprogram (Expand_N_Subprogram_Body): Add entry to table
for later call instead of calling Unnest_Subprogram directly
(Initialize): New procedure (Unnest_Subprograms): New procedure
* exp_ch6.ads (Add_Extra_Actual_To_Call): Move into proper
alpha order.
(Initialize): New procedure.
(Unnest_Subprograms): New procedure.
* exp_unst.adb (Unnest_Subprogram): Major rewrite, moving
all processing to this routine which is now called late
after instantiating bodies. Fully handles the case of generic
instantiations now.
* exp_unst.ads: Major rewrite, moving all processing to
Unnest_Subprogram.
* frontend.adb (Frontend): Add call to Exp_Ch6.Initialize.
(Frontend): Add call to Unnest_Subprograms.
* sem_ch8.adb (Find_Direct_Name): Back to old calling sequence
for Check_Nested_Access.
* sem_util.adb (Build_Default_Subtype): Minor reformatting
(Check_Nested_Access): Back to original VM-only form (we
now do all the processing for Unnest_Subprogram at the time
it is called.
(Denotes_Same_Object): Minor reformatting
(Note_Possible_Modification): Old calling sequence for
Check_Nested_Access.
* sem_util.ads (Check_Nested_Access): Back to original VM-only
form (we now do all the processing for Unnest_Subprogram at the
time it is called.
2015-05-12 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, freeze.adb, sem_ch6.adb: Minor reformatting.

5
gcc/ada/debug.adb
View file

@ -157,7 +157,7 @@ package body Debug is
-- d.1 Enable unnesting of nested procedures
-- d.2 Allow statements in declarative part
-- d.3
-- d.3 Output debugging information from Exp_Unst
-- d.4
-- d.5
-- d.6
@ -755,6 +755,9 @@ package body Debug is
-- allowed, but in some debugging contexts (e.g. testing the circuit
-- for unnesting of procedures), it is useful to allow this.
-- d.3 Output debugging information from Exp_Unst, including the name of
-- any unreachable subprograms that get deleted.
------------------------------------------
-- Documentation for Binder Debug Flags --
------------------------------------------

71
gcc/ada/einfo.adb
View file

@ -213,7 +213,6 @@ package body Einfo is
-- Stored_Constraint Elist23
-- Related_Expression Node24
-- Uplevel_References Elist24
-- Subps_Index Uint24
-- Interface_Alias Node25
@ -590,7 +589,7 @@ package body Einfo is
-- Is_Static_Type Flag281
-- Has_Nested_Subprogram Flag282
-- Uplevel_Reference_Noted Flag283
-- Is_Uplevel_Referenced_Entity Flag283
-- Is_Unimplemented Flag284
-- (unused) Flag285
@ -2418,7 +2417,6 @@ package body Einfo is
function Is_Static_Type (Id : E) return B is
begin
pragma Assert (Is_Type (Id));
return Flag281 (Id);
end Is_Static_Type;
@ -2474,6 +2472,11 @@ package body Einfo is
return Flag144 (Id);
end Is_Unsigned_Type;
function Is_Uplevel_Referenced_Entity (Id : E) return B is
begin
return Flag283 (Id);
end Is_Uplevel_Referenced_Entity;
function Is_Valued_Procedure (Id : E) return B is
begin
pragma Assert (Ekind (Id) = E_Procedure);
@ -2684,8 +2687,10 @@ package body Einfo is
begin
pragma Assert
(Ekind (Id) in Incomplete_Kind
or else Ekind (Id) in Class_Wide_Kind
or else Ekind (Id) = E_Abstract_State);
or else
Ekind (Id) in Class_Wide_Kind
or else
Ekind (Id) = E_Abstract_State);
return Node19 (Id);
end Non_Limited_View;
@ -3247,17 +3252,6 @@ package body Einfo is
return Node16 (Id);
end Unset_Reference;
function Uplevel_Reference_Noted (Id : E) return B is
begin
return Flag283 (Id);
end Uplevel_Reference_Noted;
function Uplevel_References (Id : E) return L is
begin
pragma Assert (Is_Subprogram (Id));
return Elist24 (Id);
end Uplevel_References;
function Used_As_Generic_Actual (Id : E) return B is
begin
return Flag222 (Id);
@ -4458,11 +4452,6 @@ package body Einfo is
Set_Flag282 (Id, V);
end Set_Has_Nested_Subprogram;
procedure Set_Has_Uplevel_Reference (Id : E; V : B := True) is
begin
Set_Flag215 (Id, V);
end Set_Has_Uplevel_Reference;
procedure Set_Has_Non_Standard_Rep (Id : E; V : B := True) is
begin
pragma Assert (Id = Base_Type (Id));
@ -4713,6 +4702,11 @@ package body Einfo is
Set_Flag72 (Id, V);
end Set_Has_Unknown_Discriminants;
procedure Set_Has_Uplevel_Reference (Id : E; V : B := True) is
begin
Set_Flag215 (Id, V);
end Set_Has_Uplevel_Reference;
procedure Set_Has_Visible_Refinement (Id : E; V : B := True) is
begin
pragma Assert (Ekind (Id) = E_Abstract_State);
@ -5423,6 +5417,15 @@ package body Einfo is
Set_Flag144 (Id, V);
end Set_Is_Unsigned_Type;
procedure Set_Is_Uplevel_Referenced_Entity (Id : E; V : B := True) is
begin
pragma Assert
(Ekind_In (Id, E_Constant, E_Variable)
or else Is_Formal (Id)
or else Is_Type (Id));
Set_Flag283 (Id, V);
end Set_Is_Uplevel_Referenced_Entity;
procedure Set_Is_Valued_Procedure (Id : E; V : B := True) is
begin
pragma Assert (Ekind (Id) = E_Procedure);
@ -5632,8 +5635,7 @@ package body Einfo is
begin
pragma Assert
(Ekind (Id) in Incomplete_Kind
or else Ekind (Id) = E_Abstract_State
or else Ekind (Id) = E_Class_Wide_Type);
or else Ekind_In (Id, E_Abstract_State, E_Class_Wide_Type));
Set_Node19 (Id, V);
end Set_Non_Limited_View;
@ -6224,17 +6226,6 @@ package body Einfo is
Set_Node16 (Id, V);
end Set_Unset_Reference;
procedure Set_Uplevel_Reference_Noted (Id : E; V : B := True) is
begin
Set_Flag283 (Id, V);
end Set_Uplevel_Reference_Noted;
procedure Set_Uplevel_References (Id : E; V : L) is
begin
pragma Assert (Is_Subprogram (Id));
Set_Elist24 (Id, V);
end Set_Uplevel_References;
procedure Set_Used_As_Generic_Actual (Id : E; V : B := True) is
begin
Set_Flag222 (Id, V);
@ -7116,8 +7107,8 @@ package body Einfo is
function Has_Non_Limited_View (Id : E) return B is
begin
return (Ekind (Id) in Incomplete_Kind
or else Ekind (Id) in Class_Wide_Kind
or else Ekind (Id) = E_Abstract_State)
or else Ekind (Id) in Class_Wide_Kind
or else Ekind (Id) = E_Abstract_State)
and then Present (Non_Limited_View (Id));
end Has_Non_Limited_View;
@ -8802,6 +8793,7 @@ package body Einfo is
W ("Is_Underlying_Record_View", Flag246 (Id));
W ("Is_Unimplemented", Flag284 (Id));
W ("Is_Unsigned_Type", Flag144 (Id));
W ("Is_Uplevel_Referenced_Entity", Flag283 (Id));
W ("Is_Valued_Procedure", Flag127 (Id));
W ("Is_Visible_Formal", Flag206 (Id));
W ("Is_Visible_Lib_Unit", Flag116 (Id));
@ -8859,7 +8851,6 @@ package body Einfo is
W ("Suppress_Value_Tracking_On_Call", Flag217 (Id));
W ("Treat_As_Volatile", Flag41 (Id));
W ("Universal_Aliasing", Flag216 (Id));
W ("Uplevel_Reference_Noted", Flag283 (Id));
W ("Used_As_Generic_Actual", Flag222 (Id));
W ("Uses_Sec_Stack", Flag95 (Id));
W ("Warnings_Off", Flag96 (Id));
@ -9774,11 +9765,7 @@ package body Einfo is
when E_Function |
E_Operator |
E_Procedure =>
if Field24 (Id) in Uint_Range then
Write_Str ("Subps_Index");
else
Write_Str ("Uplevel_References");
end if;
Write_Str ("Subps_Index");
when others =>
Write_Str ("Field24???");

67
gcc/ada/einfo.ads
View file

@ -2009,11 +2009,10 @@ package Einfo is
-- Defined in all entities. Indicates that the entity is locally defined
-- within a subprogram P, and there is a reference to the entity within
-- a subprogram nested within P (at any depth). Set only for the VM case
-- (where it is set for variables, constants and loop parameters), and in
-- the case where we are unnesting nested subprograms (in which case it
-- is also set for types and subtypes which are not static types, and
-- that are referenced uplevel, as well as for subprograms that contain
-- uplevel references or call other subprograms (Exp_Unst has details).
-- (where it is set for variables, constants and loop parameters). Note
-- that this is similar in usage to Is_Uplevel_Referenced_Entity (which
-- is used when we are unnesting subprograms), but the usages are a bit
-- different and it is cleaner to leave the old VM usage unchanged.
-- Has_Visible_Refinement (Flag263)
-- Defined in E_Abstract_State entities. Set when a state has at least
@ -2988,8 +2987,8 @@ package Einfo is
-- Wide_Wide_String).
-- Is_Static_Type (Flag281)
-- Defined in all type and subtype entities. If set, indicates that the
-- type is known to be a static type (defined as a discrete type with
-- Defined in entities. Only set for (sub)types. If set, indicates that
-- the type is known to be a static type (defined as a discrete type with
-- static bounds, a record all of whose component types are static types,
-- or an array, all of whose bounds are of a static type, and also have
-- a component type that is a static type). See Set_Uplevel_Type for more
@ -3111,6 +3110,20 @@ package Einfo is
-- subtype is still unsigned, but this cannot be determined by looking
-- at its bounds or the bounds of the corresponding base type.
-- Is_Uplevel_Referenced_Entity (Flag283)
-- Defined in all entities. Used when unnesting subprograms to indicate
-- that an entity is locally defined within a subprogram P, and there is
-- a reference to the entity within a subprogram nested within P (at any
-- depth). Set for uplevel referenced objects (variables, constants and
-- loop parameters), and also for upreferenced dynamic types, including
-- the cases where the reference is implicit (e.g. the type of an array
-- used for computing the location of an element in an array. This is
-- used internally in Exp_Unst, see this package for further details.
-- Note that this is similar to the Has_Uplevel_Reference flag which
-- is used in the VM case but we prefer to keep the two cases entirely
-- separated, so that the VM usage is not disturbed by work on the
-- Unnesting_Subprograms mode.
-- Is_Valued_Procedure (Flag127)
-- Defined in procedure entities. Set if an Import_Valued_Procedure
-- or Export_Valued_Procedure pragma applies to the procedure entity.
@ -4142,8 +4155,6 @@ package Einfo is
-- Subps_Index (Uint24)
-- Used during Exp_Inst.Unnest_Subprogram to hold the index in the Subps
-- table for a subprogram. See processing in this procedure for details.
-- Note that this overlaps Uplevel_References, it is only set after the
-- latter field has been acquired.
-- Suppress_Elaboration_Warnings (Flag148)
-- Defined in all entities, can be set only for subprogram entities and
@ -4278,19 +4289,6 @@ package Einfo is
-- is identified. This field is used to generate a warning message if
-- necessary (see Sem_Warn.Check_Unset_Reference).
-- Uplevel_Reference_Noted (Flag283)
-- Defined in all entities, used in Exp_Unst processing to note that an
-- uplevel reference to the entity has been noted (to avoid processing a
-- given entity more than once).
-- Uplevel_References (Elist24)
-- Defined in subprogram entities. Set only if Has_Uplevel_Reference is
-- set and if we are Unnest_Subprogram_Mode, otherwise undefined. Points
-- to a list of explicit uplevel references to entities declared in
-- the subprogram which need rewriting. Each entry uses two elements of
-- the list, the first is the node that is the actual reference, the
-- second is the entity of the enclosing subprogram for the reference.
-- Used_As_Generic_Actual (Flag222)
-- Defined in all entities, set if the entity is used as an argument to
-- a generic instantiation. Used to tune certain warning messages.
@ -5255,6 +5253,7 @@ package Einfo is
-- Has_Qualified_Name (Flag161)
-- Has_Stream_Size_Clause (Flag184)
-- Has_Unknown_Discriminants (Flag72)
-- Has_Uplevel_Reference (Flag215)
-- Has_Xref_Entry (Flag182)
-- In_Private_Part (Flag45)
-- Is_Ada_2005_Only (Flag185)
@ -5304,6 +5303,7 @@ package Einfo is
-- Is_Renaming_Of_Object (Flag112)
-- Is_Shared_Passive (Flag60)
-- Is_Statically_Allocated (Flag28)
-- Is_Static_Type (Flag281)
-- Is_Tagged_Type (Flag55)
-- Is_Thunk (Flag225)
-- Is_Trivial_Subprogram (Flag235)
@ -5324,7 +5324,6 @@ package Einfo is
-- Suppress_Elaboration_Warnings (Flag148)
-- Suppress_Style_Checks (Flag165)
-- Suppress_Value_Tracking_On_Call (Flag217)
-- Uplevel_Reference_Noted (Flag283)
-- Used_As_Generic_Actual (Flag222)
-- Warnings_Off (Flag96)
-- Warnings_Off_Used (Flag236)
@ -5395,7 +5394,6 @@ package Einfo is
-- Has_Static_Predicate_Aspect (Flag259)
-- Has_Task (Flag30) (base type only)
-- Has_Unchecked_Union (Flag123) (base type only)
-- Has_Uplevel_Reference (Flag215)
-- Has_Volatile_Components (Flag87) (base type only)
-- In_Use (Flag8)
-- Is_Abstract_Type (Flag146)
@ -5412,7 +5410,6 @@ package Einfo is
-- Is_Non_Static_Subtype (Flag109)
-- Is_Packed (Flag51) (base type only)
-- Is_Private_Composite (Flag107)
-- Is_Static_Type (Flag281)
-- Is_Unsigned_Type (Flag144)
-- Is_Volatile (Flag16)
-- Itype_Printed (Flag202) (itypes only)
@ -5617,7 +5614,6 @@ package Einfo is
-- Has_Independent_Components (Flag34)
-- Has_Size_Clause (Flag29)
-- Has_Thunks (Flag228) (constants only)
-- Has_Uplevel_Reference (Flag215)
-- Has_Volatile_Components (Flag87)
-- Is_Atomic (Flag85)
-- Is_Eliminated (Flag124)
@ -5625,6 +5621,7 @@ package Einfo is
-- Is_Processed_Transient (Flag252) (constants only)
-- Is_Return_Object (Flag209)
-- Is_True_Constant (Flag163)
-- Is_Uplevel_Referenced_Entity (Flag283)
-- Is_Volatile (Flag16)
-- Stores_Attribute_Old_Prefix (Flag270) (constants only)
-- Optimize_Alignment_Space (Flag241) (constants only)
@ -5785,7 +5782,6 @@ package Einfo is
-- Generic_Renamings (Elist23) (for an instance)
-- Inner_Instances (Elist23) (generic case only)
-- Protection_Object (Node23) (for concurrent kind)
-- Uplevel_References (Elist24) (non-generic case only)
-- Subps_Index (Uint24) (non-generic case only)
-- Interface_Alias (Node25)
-- Overridden_Operation (Node26)
@ -5960,7 +5956,6 @@ package Einfo is
-- Extra_Accessibility_Of_Result (Node19)
-- Last_Entity (Node20)
-- Has_Nested_Subprogram (Flag282)
-- Uplevel_References (Elist24)
-- Subps_Index (Uint24)
-- Overridden_Operation (Node26)
-- Subprograms_For_Type (Node29)
@ -6094,7 +6089,6 @@ package Einfo is
-- Generic_Renamings (Elist23) (for an instance)
-- Inner_Instances (Elist23) (generic case only)
-- Protection_Object (Node23) (for concurrent kind)
-- Uplevel_References (Elist24) (non-generic case only)
-- Subps_Index (Uint24) (non-generic case only)
-- Interface_Alias (Node25)
-- Overridden_Operation (Node26) (never for init proc)
@ -6351,7 +6345,6 @@ package Einfo is
-- Has_Independent_Components (Flag34)
-- Has_Initial_Value (Flag219)
-- Has_Size_Clause (Flag29)
-- Has_Uplevel_Reference (Flag215)
-- Has_Volatile_Components (Flag87)
-- Is_Atomic (Flag85)
-- Is_Eliminated (Flag124)
@ -6362,6 +6355,7 @@ package Einfo is
-- Is_True_Constant (Flag163)
-- Is_Volatile (Flag16)
-- Is_Return_Object (Flag209)
-- Is_Uplevel_Referenced_Entity (Flag283)
-- OK_To_Rename (Flag247)
-- Optimize_Alignment_Space (Flag241)
-- Optimize_Alignment_Time (Flag242)
@ -6913,6 +6907,7 @@ package Einfo is
function Is_Underlying_Record_View (Id : E) return B;
function Is_Unimplemented (Id : E) return B;
function Is_Unsigned_Type (Id : E) return B;
function Is_Uplevel_Referenced_Entity (Id : E) return B;
function Is_Valued_Procedure (Id : E) return B;
function Is_Visible_Formal (Id : E) return B;
function Is_Visible_Lib_Unit (Id : E) return B;
@ -7041,8 +7036,6 @@ package Einfo is
function Underlying_Record_View (Id : E) return E;
function Universal_Aliasing (Id : E) return B;
function Unset_Reference (Id : E) return N;
function Uplevel_Reference_Noted (Id : E) return B;
function Uplevel_References (Id : E) return L;
function Used_As_Generic_Actual (Id : E) return B;
function Uses_Lock_Free (Id : E) return B;
function Uses_Sec_Stack (Id : E) return B;
@ -7569,6 +7562,7 @@ package Einfo is
procedure Set_Is_Underlying_Record_View (Id : E; V : B := True);
procedure Set_Is_Unimplemented (Id : E; V : B := True);
procedure Set_Is_Unsigned_Type (Id : E; V : B := True);
procedure Set_Is_Uplevel_Referenced_Entity (Id : E; V : B := True);
procedure Set_Is_Valued_Procedure (Id : E; V : B := True);
procedure Set_Is_Visible_Formal (Id : E; V : B := True);
procedure Set_Is_Visible_Lib_Unit (Id : E; V : B := True);
@ -7697,8 +7691,6 @@ package Einfo is
procedure Set_Underlying_Record_View (Id : E; V : E);
procedure Set_Universal_Aliasing (Id : E; V : B := True);
procedure Set_Unset_Reference (Id : E; V : N);
procedure Set_Uplevel_Reference_Noted (Id : E; V : B := True);
procedure Set_Uplevel_References (Id : E; V : L);
procedure Set_Used_As_Generic_Actual (Id : E; V : B := True);
procedure Set_Uses_Lock_Free (Id : E; V : B := True);
procedure Set_Uses_Sec_Stack (Id : E; V : B := True);
@ -8380,6 +8372,7 @@ package Einfo is
pragma Inline (Is_Underlying_Record_View);
pragma Inline (Is_Unimplemented);
pragma Inline (Is_Unsigned_Type);
pragma Inline (Is_Uplevel_Referenced_Entity);
pragma Inline (Is_Valued_Procedure);
pragma Inline (Is_Visible_Formal);
pragma Inline (Is_Visible_Lib_Unit);
@ -8510,8 +8503,6 @@ package Einfo is
pragma Inline (Underlying_Record_View);
pragma Inline (Universal_Aliasing);
pragma Inline (Unset_Reference);
pragma Inline (Uplevel_Reference_Noted);
pragma Inline (Uplevel_References);
pragma Inline (Used_As_Generic_Actual);
pragma Inline (Uses_Lock_Free);
pragma Inline (Uses_Sec_Stack);
@ -8717,7 +8708,6 @@ package Einfo is
pragma Inline (Set_Has_Thunks);
pragma Inline (Set_Has_Unchecked_Union);
pragma Inline (Set_Has_Unknown_Discriminants);
pragma Inline (Set_Has_Uplevel_Reference);
pragma Inline (Set_Has_Visible_Refinement);
pragma Inline (Set_Has_Volatile_Components);
pragma Inline (Set_Has_Xref_Entry);
@ -8836,6 +8826,7 @@ package Einfo is
pragma Inline (Set_Is_Underlying_Record_View);
pragma Inline (Set_Is_Unimplemented);
pragma Inline (Set_Is_Unsigned_Type);
pragma Inline (Set_Is_Uplevel_Referenced_Entity);
pragma Inline (Set_Is_Valued_Procedure);
pragma Inline (Set_Is_Visible_Formal);
pragma Inline (Set_Is_Visible_Lib_Unit);
@ -8963,8 +8954,6 @@ package Einfo is
pragma Inline (Set_Underlying_Full_View);
pragma Inline (Set_Underlying_Record_View);
pragma Inline (Set_Universal_Aliasing);
pragma Inline (Set_Uplevel_Reference_Noted);
pragma Inline (Set_Uplevel_References);
pragma Inline (Set_Unset_Reference);
pragma Inline (Set_Used_As_Generic_Actual);
pragma Inline (Set_Uses_Lock_Free);

106
gcc/ada/exp_ch6.adb
View file

@ -71,6 +71,7 @@ with Sinfo; use Sinfo;
with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
with Table;
with Targparm; use Targparm;
with Tbuild; use Tbuild;
with Uintp; use Uintp;
@ -78,6 +79,33 @@ with Validsw; use Validsw;
package body Exp_Ch6 is
-------------------------------------
-- Table for Unnesting Subprograms --
-------------------------------------
-- When we expand a subprogram body, if it has nested subprograms and if
-- we are in Unnest_Subprogram_Mode, then we record the subprogram entity
-- and the body in this table, to later be passed to Unnest_Subprogram.
-- We need this delaying mechanism, because we have to wait untiil all
-- instantiated bodies have been inserted before doing the unnesting.
type Unest_Entry is record
Ent : Entity_Id;
-- Entity for subprogram to be unnested
Bod : Node_Id;
-- Subprogram body to be unnested
end record;
package Unest_Bodies is new Table.Table (
Table_Component_Type => Unest_Entry,
Table_Index_Type => Nat,
Table_Low_Bound => 1,
Table_Initial => 100,
Table_Increment => 200,
Table_Name => "Unest_Bodies");
-----------------------
-- Local Subprograms --
-----------------------
@ -5360,7 +5388,7 @@ package body Exp_Ch6 is
and then Has_Nested_Subprogram (Spec_Id)
then
Unnest_Subprogram (Spec_Id, N);
Unest_Bodies.Append ((Spec_Id, N));
end if;
end Expand_N_Subprogram_Body;
@ -5788,32 +5816,6 @@ package body Exp_Ch6 is
end if;
end Expand_Protected_Subprogram_Call;
--------------------------------------------
-- Has_Unconstrained_Access_Discriminants --
--------------------------------------------
function Has_Unconstrained_Access_Discriminants
(Subtyp : Entity_Id) return Boolean
is
Discr : Entity_Id;
begin
if Has_Discriminants (Subtyp)
and then not Is_Constrained (Subtyp)
then
Discr := First_Discriminant (Subtyp);
while Present (Discr) loop
if Ekind (Etype (Discr)) = E_Anonymous_Access_Type then
return True;
end if;
Next_Discriminant (Discr);
end loop;
end if;
return False;
end Has_Unconstrained_Access_Discriminants;
-----------------------------------
-- Expand_Simple_Function_Return --
-----------------------------------
@ -7999,6 +8001,41 @@ package body Exp_Ch6 is
end if;
end Expand_Subprogram_Contract;
--------------------------------------------
-- Has_Unconstrained_Access_Discriminants --
--------------------------------------------
function Has_Unconstrained_Access_Discriminants
(Subtyp : Entity_Id) return Boolean
is
Discr : Entity_Id;
begin
if Has_Discriminants (Subtyp)
and then not Is_Constrained (Subtyp)
then
Discr := First_Discriminant (Subtyp);
while Present (Discr) loop
if Ekind (Etype (Discr)) = E_Anonymous_Access_Type then
return True;
end if;
Next_Discriminant (Discr);
end loop;
end if;
return False;
end Has_Unconstrained_Access_Discriminants;
----------------
-- Initialize --
----------------
procedure Initialize is
begin
Unest_Bodies.Init;
end Initialize;
--------------------------------
-- Is_Build_In_Place_Function --
--------------------------------
@ -9489,4 +9526,19 @@ package body Exp_Ch6 is
end if;
end Needs_Result_Accessibility_Level;
------------------------
-- Unnest_Subprograms --
------------------------
procedure Unnest_Subprograms is
begin
for J in Unest_Bodies.First .. Unest_Bodies.Last loop
declare
UBJ : Unest_Entry renames Unest_Bodies.Table (J);
begin
Unnest_Subprogram (UBJ.Ent, UBJ.Bod);
end;
end loop;
end Unnest_Subprograms;
end Exp_Ch6;

20
gcc/ada/exp_ch6.ads
View file

@ -97,6 +97,13 @@ package Exp_Ch6 is
--
-- ??? We might also need to be able to pass in a constrained flag.
procedure Add_Extra_Actual_To_Call
(Subprogram_Call : Node_Id;
Extra_Formal : Entity_Id;
Extra_Actual : Node_Id);
-- Adds Extra_Actual as a named parameter association for the formal
-- Extra_Formal in Subprogram_Call.
function BIP_Formal_Suffix (Kind : BIP_Formal_Kind) return String;
-- Ada 2005 (AI-318-02): Returns a string to be used as the suffix of names
-- for build-in-place formal parameters of the given kind.
@ -109,6 +116,9 @@ package Exp_Ch6 is
-- function Func, and returns its Entity_Id. It is a bug if not found; the
-- caller should ensure this is called only when the extra formal exists.
procedure Initialize;
-- Initialize internal tables
function Is_Build_In_Place_Function (E : Entity_Id) return Boolean;
-- Ada 2005 (AI-318-02): Returns True if E denotes a function, generic
-- function, or access-to-function type whose result must be built in
@ -201,11 +211,9 @@ package Exp_Ch6 is
-- parameter to identify the accessibility level of the function result
-- "determined by the point of call".
procedure Add_Extra_Actual_To_Call
(Subprogram_Call : Node_Id;
Extra_Formal : Entity_Id;
Extra_Actual : Node_Id);
-- Adds Extra_Actual as a named parameter association for the formal
-- Extra_Formal in Subprogram_Call.
procedure Unnest_Subprograms;
-- Called to unnest subprograms. If we are in unnest subprogram mode, and
-- subprograms have been gathered in the Unest_Bodies table, this is the
-- call that causes them to be processed for unnesting.
end Exp_Ch6;

1684
gcc/ada/exp_unst.adb
View file

File diff suppressed because it is too large Load diff

17
gcc/ada/exp_unst.ads
View file

@ -529,23 +529,6 @@ package Exp_Unst is
-- Subprograms --
-----------------
procedure Check_Uplevel_Reference_To_Type (Typ : Entity_Id);
-- This procedure is called if Sem_Util.Check_Nested_Access detects an
-- uplevel reference to a type or subtype entity Typ. On return there are
-- two cases, if Typ is a static type (defined as a discrete type with
-- static bounds, or a record all of whose components are of a static type,
-- or an array whose index and component types are all static types), then
-- the flag Is_Static_Type (Typ) will be set True, and in this case the
-- flag Has_Uplevel_Reference is not set since we don't need to worry about
-- uplevel references to static types. If on the other hand Typ is not a
-- static type, then the flag Has_Uplevel_Reference will be set, and any
-- non-static bounds referenced by the type will also be marked as having
-- uplevel references (by setting Has_Uplevel_Reference for these bounds).
procedure Note_Uplevel_Reference (N : Node_Id; Subp : Entity_Id);
-- Called in Unnest_Subprogram_Mode when we detect an explicit uplevel
-- reference (node N) to an enclosing subprogram Subp.
procedure Unnest_Subprogram (Subp : Entity_Id; Subp_Body : Node_Id);
-- Subp is a library level subprogram which has nested subprograms, and
-- Subp_Body is the corresponding N_Subprogram_Body node. This procedure

13
gcc/ada/frontend.adb
View file

@ -30,6 +30,7 @@ with Checks;
with CStand;
with Debug; use Debug;
with Elists;
with Exp_Ch6;
with Exp_Dbug;
with Fmap;
with Fname.UF;
@ -90,6 +91,7 @@ begin
Checks.Initialize;
Sem_Warn.Initialize;
Prep.Initialize;
Exp_Ch6.Initialize;
if Generate_SCIL then
SCIL_LL.Initialize;
@ -408,13 +410,6 @@ begin
-- Cleanup processing after completing main analysis
-- Turn off unnesting of subprograms mode. This is not right
-- with respect to instantiations. What needs to happen is that
-- we do the unnesting AFTER the call to Instantiate_Bodies. We
-- will take care of that later ???
Opt.Unnest_Subprogram_Mode := False;
-- Comment needed for ASIS mode test and GNATprove mode test???
if Operating_Mode = Generate_Code
@ -444,6 +439,10 @@ begin
Remove_Ignored_Ghost_Code;
end if;
-- At this stage we can unnest subprogram bodies if required
Exp_Ch6.Unnest_Subprograms;
-- List library units if requested
if List_Units then

43
gcc/ada/gnatcmd.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1996-2015, 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- --
@ -57,6 +57,12 @@ with Ada.Text_IO; use Ada.Text_IO;
with GNAT.OS_Lib; use GNAT.OS_Lib;
procedure GNATCmd is
Gprbuild : constant String := "gprbuild";
Gnatmake : constant String := "gnatmake";
Gprclean : constant String := "gprclean";
Gnatclean : constant String := "gnatclean";
Normal_Exit : exception;
-- Raise this exception for normal program termination
@ -1166,7 +1172,6 @@ begin
begin
if The_Command = Stack then
-- Never call gnatstack with a prefix
Program := new String'(Command_List (The_Command).Unixcmd.all);
@ -1174,6 +1179,40 @@ begin
else
Program :=
Program_Name (Command_List (The_Command).Unixcmd.all, "gnat");
-- If we want to invoke gnatmake/gnatclean with -P, then check if
-- gprbuild/gprclean is available; if it is, use gprbuild/gprclean
-- instead of gnatmake/gnatclean.
if Program.all = Gnatmake or else Program.all = Gnatclean then
declare
Project_File_Used : Boolean := False;
Switch : String_Access;
begin
for J in 1 .. Last_Switches.Last loop
Switch := Last_Switches.Table (J);
if Switch'Length >= 2 and then
Switch (Switch'First .. Switch'First + 1) = "-P"
then
Project_File_Used := True;
exit;
end if;
end loop;
if Project_File_Used then
if Program.all = Gnatmake
and then Locate_Exec_On_Path (Gprbuild) /= null
then
Program := new String'(Gprbuild);
elsif Program.all = Gnatclean
and then Locate_Exec_On_Path (Gprclean) /= null
then
Program := new String'(Gprclean);
end if;
end if;
end;
end if;
end if;
-- For the tools where the GNAT driver processes the project files,

2
gcc/ada/sem_ch3.adb
View file

@ -1160,7 +1160,7 @@ package body Sem_Ch3 is
if Is_Access_Type (Typ)
and then Null_Exclusion_In_Return_Present (T_Def)
then
Set_Etype (Desig_Type,
Set_Etype (Desig_Type,
Create_Null_Excluding_Itype
(T => Typ,
Related_Nod => T_Def,

2
gcc/ada/sem_ch8.adb
View file

@ -5633,7 +5633,7 @@ package body Sem_Ch8 is
end if;
end if;
Check_Nested_Access (N, E);
Check_Nested_Access (E);
end if;
Set_Entity_Or_Discriminal (N, E);

51
gcc/ada/sem_util.adb
View file

@ -32,7 +32,6 @@ with Elists; use Elists;
with Errout; use Errout;
with Exp_Ch11; use Exp_Ch11;
with Exp_Disp; use Exp_Disp;
with Exp_Unst; use Exp_Unst;
with Exp_Util; use Exp_Util;
with Fname; use Fname;
with Freeze; use Freeze;
@ -1547,9 +1546,9 @@ package body Sem_Util is
Insert_Action (N, Decl);
-- If the context is a component declaration the subtype
-- declaration will be analyzed when the enclosing type is
-- frozen, otherwise do it now.
-- If the context is a component declaration the subtype declaration
-- will be analyzed when the enclosing type is frozen, otherwise do
-- it now.
if Ekind (Current_Scope) /= E_Record_Type then
Analyze (Decl);
@ -2872,18 +2871,16 @@ package body Sem_Util is
-- Check_Nested_Access --
-------------------------
procedure Check_Nested_Access (N : Node_Id; Ent : Entity_Id) is
procedure Check_Nested_Access (Ent : Entity_Id) is
Scop : constant Entity_Id := Current_Scope;
Current_Subp : Entity_Id;
Enclosing : Entity_Id;
begin
-- Currently only enabled for VM back-ends for efficiency, should we
-- enable it more systematically? Probably not unless someone actually
-- needs it. It will be needed for C generation and is activated if the
-- Opt.Unnest_Subprogram_Mode flag is set True.
-- Currently only enabled for VM back-ends for efficiency
if (VM_Target /= No_VM or else Unnest_Subprogram_Mode)
if VM_Target /= No_VM
and then Ekind_In (Ent, E_Variable, E_Constant, E_Loop_Parameter)
and then Scope (Ent) /= Empty
and then not Is_Library_Level_Entity (Ent)
@ -2891,25 +2888,6 @@ package body Sem_Util is
and then not Is_Imported (Ent)
then
-- In both the VM case and in Unnest_Subprogram_Mode, we mark
-- variables, constants, and loop parameters.
if Ekind_In (Ent, E_Variable, E_Constant, E_Loop_Parameter) then
null;
-- In Unnest_Subprogram_Mode, we also mark types and formals
elsif Unnest_Subprogram_Mode
and then (Is_Type (Ent) or else Is_Formal (Ent))
then
null;
-- All other cases, do not mark
else
return;
end if;
-- Get current subprogram that is relevant
if Is_Subprogram (Scop)
@ -2926,16 +2904,7 @@ package body Sem_Util is
-- Set flag if uplevel reference
if Enclosing /= Empty and then Enclosing /= Current_Subp then
if Is_Type (Ent) then
Check_Uplevel_Reference_To_Type (Ent);
else
Set_Has_Uplevel_Reference (Ent, True);
if Unnest_Subprogram_Mode then
Set_Has_Uplevel_Reference (Current_Subp, True);
Note_Uplevel_Reference (N, Enclosing);
end if;
end if;
Set_Has_Uplevel_Reference (Ent, True);
end if;
end if;
end Check_Nested_Access;
@ -4949,7 +4918,7 @@ package body Sem_Util is
-- Both names are selected_components, their prefixes are known to
-- denote the same object, and their selector_names denote the same
-- component (RM 6.4.1(6.6/3))
-- component (RM 6.4.1(6.6/3)).
elsif Nkind (Obj1) = N_Selected_Component then
return Denotes_Same_Object (Prefix (Obj1), Prefix (Obj2))
@ -15223,7 +15192,7 @@ package body Sem_Util is
end if;
end if;
Check_Nested_Access (N, Ent);
Check_Nested_Access (Ent);
end if;
Kill_Checks (Ent);

8
gcc/ada/sem_util.ads
View file

@ -308,12 +308,10 @@ package Sem_Util is
-- remains in the Examiner (JB01-005). Note that the Examiner does not
-- count package declarations in later declarative items.
procedure Check_Nested_Access (N : Node_Id; Ent : Entity_Id);
procedure Check_Nested_Access (Ent : Entity_Id);
-- Check whether Ent denotes an entity declared in an uplevel scope, which
-- is accessed inside a nested procedure, and set the Has_Uplevel_Reference
-- flag accordingly. This is currently only enabled for if on a VM target,
-- or if Opt.Unnest_Subprogram_Mode is active. N is the node for the
-- possible uplevel reference.
-- is accessed inside a nested procedure, and set Has_Uplevel_Reference
-- flag accordingly. This is currently only enabled for if on a VM target.
procedure Check_No_Hidden_State (Id : Entity_Id);
-- Determine whether object or state Id introduces a hidden state. If this