From fc0e632a9972a43cd40daeacb2884beb421587dd Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 11 Jun 2018 09:19:17 +0000 Subject: [PATCH] [Ada] Unnesting: refactor handling of uplevel refs. for unconstrained arrays 2018-06-11 Ed Schonberg gcc/ada/ * exp_unst.ads, exp_unst.adb (Needs_Fat_Pointer, Build_Access_Type_Decl): New subprograms to handle uplevel references to formals of an unconstrained array type. The activation record component for these is an access type, and the reference is rewritten as an explicit derefenrence of that component. From-SVN: r261425 --- gcc/ada/ChangeLog | 8 +++ gcc/ada/exp_unst.adb | 170 ++++++++++++++++++++++++++++++++++++++++++--------- gcc/ada/exp_unst.ads | 36 +++++++++++ 3 files changed, 186 insertions(+), 28 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e032be3..de142bf 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2018-06-11 Ed Schonberg + + * exp_unst.ads, exp_unst.adb (Needs_Fat_Pointer, + Build_Access_Type_Decl): New subprograms to handle uplevel references + to formals of an unconstrained array type. The activation record + component for these is an access type, and the reference is rewritten + as an explicit derefenrence of that component. + 2018-06-11 Bob Duff * libgnat/a-ciorma.adb, libgnat/a-ciormu.adb, libgnat/a-ciorse.adb, diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index bcdbfe7..183a6a7 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -98,6 +98,23 @@ package body Exp_Unst is -- Append a call entry to the Calls table. A check is made to see if the -- table already contains this entry and if so it has no effect. + ---------------------------------- + -- subprograms for fat pointers -- + ---------------------------------- + + function Needs_Fat_Pointer (E : Entity_Id) return Boolean; + -- A formal parameter of an unconstrained array type that appears in + -- an uplevel reference requires the construction of an access type, + -- to be used in the corresponding component declaration. + + function Build_Access_Type_Decl + (E : Entity_Id; + Scop : Entity_Id) return Node_Id; + -- For an uplevel reference that involves an unconstrained array type, + -- build an access type declaration for the corresponding activation + -- record component. The relevant attributes of the access type are + -- set here to avoid a full analysis that would require a scope stack. + ----------- -- Urefs -- ----------- @@ -152,6 +169,44 @@ package body Exp_Unst is Calls.Append (Call); end Append_Unique_Call; + ----------------------- + -- Needs_Fat_Pointer -- + ----------------------- + + function Needs_Fat_Pointer (E : Entity_Id) return Boolean is + begin + return Is_Formal (E) + and then Is_Array_Type (Etype (E)) + and then not Is_Constrained (Etype (E)); + end Needs_Fat_Pointer; + + ----------------------------- + -- Build_Access_Type_Decl -- + ----------------------------- + + function Build_Access_Type_Decl + (E : Entity_Id; + Scop : Entity_Id) return Node_Id + is + Loc : constant Source_Ptr := Sloc (E); + Decl : Node_Id; + Typ : Entity_Id; + + begin + Typ := Make_Temporary (Loc, 'S'); + Set_Ekind (Typ, E_General_Access_Type); + Set_Etype (Typ, Typ); + Set_Scope (Typ, Scop); + Set_Directly_Designated_Type (Typ, Etype (E)); + + Decl := Make_Full_Type_Declaration (Loc, + Defining_Identifier => Typ, + Type_Definition => Make_Access_To_Object_Definition (Loc, + Subtype_Indication => New_Occurrence_Of (Etype (E), Loc))); + + return Decl; + end Build_Access_Type_Decl; + --------------- -- Get_Level -- --------------- @@ -755,6 +810,21 @@ package body Exp_Unst is end if; end; + -- For an allocator with a qualified expression, check + -- type of expression being qualified. The explicit type + -- name is handled as an entity reference.. + + if Nkind (N) = N_Allocator + and then Nkind (Expression (N)) = N_Qualified_Expression + then + declare + DT : Boolean := False; + begin + Check_Static_Type + (Etype (Expression (Expression (N))), Empty, DT); + end; + end if; + -- A 'Access reference is a (potential) call. Other attributes -- require special handling. @@ -1004,7 +1074,8 @@ package body Exp_Unst is Callee := Enclosing_Subprogram (Ent); if Callee /= Caller - and then not Is_Static_Type (Ent) + and then (not Is_Static_Type (Ent) + or else Needs_Fat_Pointer (Ent)) then Note_Uplevel_Ref (Ent, N, Caller, Callee); @@ -1501,7 +1572,7 @@ package body Exp_Unst is Decl_Assign : Node_Id; -- Assigment to set uplink, Empty if none - Decls : List_Id; + Decls : constant List_Id := New_List; -- List of new declarations we create begin @@ -1534,8 +1605,9 @@ package body Exp_Unst is if Present (STJ.Uents) then declare - Elmt : Elmt_Id; - Uent : Entity_Id; + Elmt : Elmt_Id; + Ptr_Decl : Node_Id; + Uent : Entity_Id; Indx : Nat; -- 1's origin of index in list of elements. This is @@ -1555,21 +1627,42 @@ package body Exp_Unst is Set_Activation_Record_Component (Uent, Comp); - Append_To (Clist, - Make_Component_Declaration (Loc, - Defining_Identifier => Comp, - Component_Definition => - Make_Component_Definition (Loc, - Subtype_Indication => - New_Occurrence_Of (Addr, Loc)))); + if Needs_Fat_Pointer (Uent) then + + -- Build corresponding access type + Ptr_Decl := + Build_Access_Type_Decl + (Etype (Uent), STJ.Ent); + Append_To (Decls, Ptr_Decl); + + -- And use its type in the corresponding + -- component. + + Append_To (Clist, + Make_Component_Declaration (Loc, + Defining_Identifier => Comp, + Component_Definition => + Make_Component_Definition (Loc, + Subtype_Indication => + New_Occurrence_Of + (Defining_Identifier (Ptr_Decl), + Loc)))); + else + Append_To (Clist, + Make_Component_Declaration (Loc, + Defining_Identifier => Comp, + Component_Definition => + Make_Component_Definition (Loc, + Subtype_Indication => + New_Occurrence_Of (Addr, Loc)))); + end if; Next_Elmt (Elmt); end loop; end; end if; -- Now we can insert the AREC declarations into the body - -- type ARECnT is record .. end record; -- pragma Suppress_Initialization (ARECnT); @@ -1584,7 +1677,7 @@ package body Exp_Unst is Component_List => Make_Component_List (Loc, Component_Items => Clist))); - Decls := New_List (Decl_ARECnT); + Append_To (Decls, Decl_ARECnT); -- type ARECnPT is access all ARECnT; @@ -1693,8 +1786,9 @@ package body Exp_Unst is Loc : constant Source_Ptr := Sloc (Ent); Dec : constant Node_Id := Declaration_Node (Ent); - Ins : Node_Id; - Asn : Node_Id; + Ins : Node_Id; + Asn : Node_Id; + Attr : Name_Id; begin -- For parameters, we insert the assignment @@ -1716,6 +1810,13 @@ package body Exp_Unst is -- Build and insert the assignment: -- ARECn.nam := nam'Address + -- or else 'Access for unconstrained array + + if Needs_Fat_Pointer (Ent) then + Attr := Name_Access; + else + Attr := Name_Address; + end if; Asn := Make_Assignment_Statement (Loc, @@ -1733,9 +1834,8 @@ package body Exp_Unst is Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Ent, Loc), - Attribute_Name => Name_Address)); + Attribute_Name => Attr)); - -- or else 'Access for unconstrained Insert_After (Ins, Asn); -- Analyze the assignment statement. We do @@ -1890,17 +1990,31 @@ package body Exp_Unst is Comp := Activation_Record_Component (UPJ.Ent); pragma Assert (Present (Comp)); - -- Do the replacement - - Rewrite (UPJ.Ref, - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Atyp, Loc), - Attribute_Name => Name_Deref, - Expressions => New_List ( - Make_Selected_Component (Loc, - Prefix => Pfx, - Selector_Name => - New_Occurrence_Of (Comp, Loc))))); + -- Do the replacement. If the component type is an + -- access type, this is an uplevel reference for an + -- entity that requires a fat pointer, so dereference + -- the component. + + if Is_Access_Type (Etype (Comp)) then + Rewrite (UPJ.Ref, + Make_Explicit_Dereference (Loc, + Prefix => + Make_Selected_Component (Loc, + Prefix => Pfx, + Selector_Name => + New_Occurrence_Of (Comp, Loc)))); + + else + Rewrite (UPJ.Ref, + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Atyp, Loc), + Attribute_Name => Name_Deref, + Expressions => New_List ( + Make_Selected_Component (Loc, + Prefix => Pfx, + Selector_Name => + New_Occurrence_Of (Comp, Loc))))); + end if; -- Analyze and resolve the new expression. We do not need to -- establish the relevant scope stack entries here, because we diff --git a/gcc/ada/exp_unst.ads b/gcc/ada/exp_unst.ads index 978e3d1..0cffd50 100644 --- a/gcc/ada/exp_unst.ads +++ b/gcc/ada/exp_unst.ads @@ -562,6 +562,42 @@ package Exp_Unst is -- uplevel call, a subprogram at level 5 can call one at level 2 or even -- the outer level subprogram at level 1. + ------------------------------------- + -- Handling of unconstrained types -- + ------------------------------------- + + -- Objects whose nominal subtype is an unconstrained array type present + -- additional complications for translation into LLVM. The address + -- attributes of such objects points to the first component of the + -- array, and the bounds are found elsewhere, typically ahead of the + -- components. In many cases the bounds of an object are stored ahead + -- of the components and can be retrieved from it. However, if the + -- object is an expression (.e.g a slice) the bounds are not adjacent + -- and thus must be conveyed explicitly by means of a so-called + -- fat pointer. This leads to the following enhancements to the + -- handling of uplevel references described so far. This applies only + -- to uplevel references to unconstrained formals of enclosing + -- subprograms: + -- + -- a) Uplevel references are detected as before during the tree traversal + -- in Visit_Node. For referenes to uplevel formals, we include those with + -- an unconstrained array type (e.g. String) even if suvh a type has + -- static bounds. + -- + -- b) references to unconstrained formals are recognized in the Subp + -- table by means of the predicate Needs_Fat_Pointer. + -- + -- c) When constructing the required activation record we also construct + -- a named access type whose designated type is the unconstrained array + -- type. The activation record of a subprogram that contains such an + -- uplevel reference includes a component of this access type. The + -- declaration for that access type is introduced and analyzed before + -- that of the activation record, so it appears in the subprogram that + -- has that formal. + -- + -- d) The uplevel reference is rewritten as an explicit dereference (.all) + -- of the corresponding pointer component. + -- ----------- -- Subps -- ----------- -- 2.7.4