Skip to content

R
riscv-gcc-1
Commit 577ad216 by Richard Kenner Committed by Pierre-Marie de Rodat
Options

[Ada] Improve unnesting of indexed references 

2018-05-28  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

gcc/ada/

	* exp_unst.adb (Check_Static_Type): Add argument to indicate node to be
	replaced, if any; all callers changed.
	(Note_Uplevel_Ref): Likewise.  Also replace reference to deferred
	constant with private view so we take the address of that entity.
	(Note_Uplevel_Bound): Add argument to indicate node to be replaced, if
	any; all callers changed.  Handle N_Indexed_Component like
	N_Attribute_Reference.  Add N_Type_Conversion case.
	(Visit_Node): Indexed references can be uplevel if the type isn't
	static.
	(Unnest_Subprograms): Don't rewrite if no reference given.  If call has
	been relocated, set first_named pointer in original node as well.

From-SVN: r260830
parent 1541ede1
Showing with 93 additions and 31 deletions
gcc/ada/ChangeLog
2018-05-28 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
* exp_unst.adb (Check_Static_Type): Add argument to indicate node to be
replaced, if any; all callers changed.
(Note_Uplevel_Ref): Likewise. Also replace reference to deferred
constant with private view so we take the address of that entity.
(Note_Uplevel_Bound): Add argument to indicate node to be replaced, if
any; all callers changed. Handle N_Indexed_Component like
N_Attribute_Reference. Add N_Type_Conversion case.
(Visit_Node): Indexed references can be uplevel if the type isn't
static.
(Unnest_Subprograms): Don't rewrite if no reference given. If call has
been relocated, set first_named pointer in original node as well.
2018-05-28 Ed Schonberg <schonberg@adacore.com>
* exp_aggr.adb (Flatten): Copy tree of expression in a component
......
gcc/ada/exp_unst.adb
......@@ -366,16 +366,20 @@ package body Exp_Unst is
Caller : Entity_Id;
Callee : Entity_Id;
procedure Check_Static_Type (T : Entity_Id; DT : in out Boolean);
procedure Check_Static_Type
(T : Entity_Id; N : Node_Id; DT : in out Boolean);
-- Given a type T, checks if it is a static type defined as a type
-- with no dynamic bounds in sight. If so, the only action is to
-- set Is_Static_Type True for T. If T is not a static type, then
-- all types with dynamic bounds associated with T are detected,
-- and their bounds are marked as uplevel referenced if not at the
-- library level, and DT is set True.
-- library level, and DT is set True. If N is specified, it's the
-- node that will need to be replaced. If not specified, it means
-- we can't do a replacement because the bound is implicit.
procedure Note_Uplevel_Ref
(E : Entity_Id;
N : Node_Id;
Caller : Entity_Id;
Callee : Entity_Id);
-- Called when we detect an explicit or implicit uplevel reference
......@@ -386,19 +390,23 @@ package body Exp_Unst is
-- Check_Static_Type --
-----------------------
procedure Check_Static_Type (T : Entity_Id; DT : in out Boolean) is
procedure Note_Uplevel_Bound (N : Node_Id);
procedure Check_Static_Type
(T : Entity_Id; N : Node_Id; DT : in out Boolean)
is
procedure Note_Uplevel_Bound (N : Node_Id; Ref : Node_Id);
-- N is the bound of a dynamic type. This procedure notes that
-- this bound is uplevel referenced, it can handle references
-- to entities (typically _FIRST and _LAST entities), and also
-- attribute references of the form T'name (name is typically
-- FIRST or LAST) where T is the uplevel referenced bound.
-- Ref, if Present, is the location of the reference to
-- replace.
------------------------
-- Note_Uplevel_Bound --
------------------------
procedure Note_Uplevel_Bound (N : Node_Id) is
procedure Note_Uplevel_Bound (N : Node_Id; Ref : Node_Id) is
begin
-- Entity name case. Make sure that the entity is declared
-- in a subprogram. This may not be the case for for a type
......@@ -410,14 +418,22 @@ package body Exp_Unst is
then
Note_Uplevel_Ref
(E => Entity (N),
N => Ref,
Caller => Current_Subprogram,
Callee => Enclosing_Subprogram (Entity (N)));
end if;
-- Attribute case
-- Attribute or indexed component case
elsif Nkind (N) = N_Attribute_Reference then
Note_Uplevel_Bound (Prefix (N));
elsif Nkind_In (N, N_Attribute_Reference,
N_Indexed_Component)
then
Note_Uplevel_Bound (Prefix (N), Ref);
-- Conversion case
elsif Nkind (N) = N_Type_Conversion then
Note_Uplevel_Bound (Expression (N), Ref);
end if;
end Note_Uplevel_Bound;
......@@ -452,12 +468,12 @@ package body Exp_Unst is
begin
if not Is_Static_Expression (LB) then
Note_Uplevel_Bound (LB);
Note_Uplevel_Bound (LB, N);
DT := True;
end if;
if not Is_Static_Expression (UB) then
Note_Uplevel_Bound (UB);
Note_Uplevel_Bound (UB, N);
DT := True;
end if;
end;
......@@ -470,7 +486,7 @@ package body Exp_Unst is
begin
C := First_Component_Or_Discriminant (T);
while Present (C) loop
Check_Static_Type (Etype (C), DT);
Check_Static_Type (Etype (C), N, DT);
Next_Component_Or_Discriminant (C);
end loop;
end;
......@@ -481,11 +497,11 @@ package body Exp_Unst is
declare
IX : Node_Id;
begin
Check_Static_Type (Component_Type (T), DT);
Check_Static_Type (Component_Type (T), N, DT);
IX := First_Index (T);
while Present (IX) loop
Check_Static_Type (Etype (IX), DT);
Check_Static_Type (Etype (IX), N, DT);
Next_Index (IX);
end loop;
end;
......@@ -493,7 +509,7 @@ package body Exp_Unst is
-- For private type, examine whether full view is static
elsif Is_Private_Type (T) and then Present (Full_View (T)) then
Check_Static_Type (Full_View (T), DT);
Check_Static_Type (Full_View (T), N, DT);
if Is_Static_Type (Full_View (T)) then
Set_Is_Static_Type (T);
......@@ -516,9 +532,11 @@ package body Exp_Unst is
procedure Note_Uplevel_Ref
(E : Entity_Id;
N : Node_Id;
Caller : Entity_Id;
Callee : Entity_Id)
is
Full_E : Entity_Id := E;
begin
-- Nothing to do for static type
......@@ -544,12 +562,16 @@ package body Exp_Unst is
-- We have a new uplevel referenced entity
if Ekind (E) = E_Constant and then Present (Full_View (E)) then
Full_E := Full_View (E);
end if;
-- All we do at this stage is to add the uplevel reference to
-- the table. It's too early to do anything else, since this
-- uplevel reference may come from an unreachable subprogram
-- in which case the entry will be deleted.
Urefs.Append ((N, E, Caller, Callee));
Urefs.Append ((N, Full_E, Caller, Callee));
end Note_Uplevel_Ref;
-- Start of processing for Visit_Node
......@@ -617,25 +639,26 @@ package body Exp_Unst is
end if;
end if;
-- References to bounds can be uplevel references if
-- the type isn't static.
when Attribute_First
| Attribute_Last
| Attribute_Length
=>
-- Special-case attributes of array objects whose
-- bounds may be uplevel references. More complex
-- prefixes are handled during full traversal. Note
-- that if the nominal subtype of the prefix is
-- unconstrained, the bound must be obtained from
-- the object, not from the (possibly) uplevel
-- reference.
if Is_Entity_Name (Prefix (N))
and then Is_Constrained (Etype (Prefix (N)))
then
-- Special-case attributes of objects whose bounds
-- may be uplevel references. More complex prefixes
-- handled during full traversal. Note that if the
-- nominal subtype of the prefix is unconstrained,
-- the bound must be obtained from the object, not
-- from the (possibly) uplevel reference.
if Is_Constrained (Etype (Prefix (N))) then
declare
DT : Boolean := False;
begin
Check_Static_Type (Etype (Prefix (N)), DT);
Check_Static_Type (Etype (Prefix (N)),
Empty, DT);
end;
return OK;
......@@ -646,6 +669,19 @@ package body Exp_Unst is
end case;
end;
-- Indexed references can be uplevel if the type isn't static and
-- if the lower bound (or an inner bound for a multidimensional
-- array) is uplevel.
elsif Nkind_In (N, N_Indexed_Component, N_Slice)
and then Is_Constrained (Etype (Prefix (N)))
then
declare
DT : Boolean := False;
begin
Check_Static_Type (Etype (Prefix (N)), Empty, DT);
end;
-- Record a subprogram. We record a subprogram body that acts as
-- a spec. Otherwise we record a subprogram declaration, providing
-- that it has a corresponding body we can get hold of. The case
......@@ -755,7 +791,7 @@ package body Exp_Unst is
DT : Boolean := False;
begin
Check_Static_Type (Ent, DT);
Check_Static_Type (Ent, N, DT);
if Is_Static_Type (Ent) then
return OK;
......@@ -767,7 +803,7 @@ package body Exp_Unst is
Callee := Enclosing_Subprogram (Ent);
if Callee /= Caller and then not Is_Static_Type (Ent) then
Note_Uplevel_Ref (Ent, Caller, Callee);
Note_Uplevel_Ref (Ent, N, Caller, Callee);
end if;
end if;
......@@ -925,8 +961,12 @@ package body Exp_Unst is
-- to objects that will be referenced uplevel, and we use
-- the flag Is_Uplevel_Referenced_Entity to avoid making
-- duplicate entries in the list.
-- Discriminants are also excluded, only the enclosing
-- object can appear in the list.
if not Is_Uplevel_Referenced_Entity (URJ.Ent) then
if not Is_Uplevel_Referenced_Entity (URJ.Ent)
and then Ekind (URJ.Ent) /= E_Discriminant
then
Set_Is_Uplevel_Referenced_Entity (URJ.Ent);
if not Is_Type (URJ.Ent) then
......@@ -1520,8 +1560,9 @@ package body Exp_Unst is
begin
-- Ignore type references, these are implicit references that do
-- not need rewriting (e.g. the appearence in a conversion).
-- Also ignore if no reference was specified.
if Is_Type (UPJ.Ent) then
if Is_Type (UPJ.Ent) or else No (UPJ.Ref) then
goto Continue;
end if;
......@@ -1765,6 +1806,13 @@ package body Exp_Unst is
if No (Act) then
Set_First_Named_Actual (CTJ.N, Extra);
-- If call has been relocated (as with an expression in
-- an aggregate), set First_Named pointer in original node
-- as well, because that's the parent of the parameter list.
Set_First_Named_Actual
(Parent (List_Containing (ExtraP)), Extra);
-- Here we must follow the chain and append the new entry
else
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment