From 577ad216dc16802d1eeed14a3948ed3bacac30e6 Mon Sep 17 00:00:00 2001 From: Richard Kenner Date: Mon, 28 May 2018 08:54:27 +0000 Subject: [PATCH] [Ada] Improve unnesting of indexed references 2018-05-28 Richard Kenner 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 --- gcc/ada/ChangeLog | 14 ++++++ gcc/ada/exp_unst.adb | 110 +++++++++++++++++++++++++++++++------------ 2 files changed, 93 insertions(+), 31 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 95e4822412f..d724ee9f933 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2018-05-28 Richard Kenner + + * 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 * exp_aggr.adb (Flatten): Copy tree of expression in a component diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index 3827bc88ed4..fbc52b79f4a 100644 --- a/gcc/ada/exp_unst.adb +++ b/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_In (N, N_Attribute_Reference, + N_Indexed_Component) + then + Note_Uplevel_Bound (Prefix (N), Ref); + + -- Conversion case - elsif Nkind (N) = N_Attribute_Reference then - Note_Uplevel_Bound (Prefix (N)); + 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 -- 2.30.2