-- 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 --
-----------
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 --
---------------
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.
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);
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
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
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);
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;
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
-- 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,
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
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
-- 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 --
-----------