[Ada] Unnesting: refactor handling of uplevel refs. for unconstrained arrays

2018-06-11  Ed Schonberg  <schonberg@adacore.com>

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

+2018-06-11  Ed Schonberg  <schonberg@adacore.com>
+
+	* 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  <duff@adacore.com>
 
 	* libgnat/a-ciorma.adb, libgnat/a-ciormu.adb, libgnat/a-ciorse.adb,

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
@@ -1535,6 +1606,7 @@ package body Exp_Unst is
                      if Present (STJ.Uents) then
                         declare
                            Elmt     : Elmt_Id;
+                           Ptr_Decl : Node_Id;
                            Uent     : Entity_Id;
 
                            Indx : Nat;
@@ -1555,6 +1627,28 @@ package body Exp_Unst is
                               Set_Activation_Record_Component
                                 (Uent, Comp);
 
+                              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,
@@ -1562,14 +1656,13 @@ package body Exp_Unst is
                                        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;
 
@@ -1695,6 +1788,7 @@ package body Exp_Unst is
                                          Declaration_Node (Ent);
                                  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,8 +1990,21 @@ package body Exp_Unst is
                Comp := Activation_Record_Component (UPJ.Ent);
                pragma Assert (Present (Comp));
 
-               --  Do the replacement
+               --  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),
@@ -1901,6 +2014,7 @@ package body Exp_Unst is
                           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

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