From: Gary Dismukes <dismukes@adacore.com>
Date: Fri, 13 Dec 2019 09:04:28 +0000 (+0000)
Subject: [Ada] Suppress Base_Address call on init of activation record components
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=47997d257aaaac802d5857c898a4a3ef38e9e65a;p=gcc.git

[Ada] Suppress Base_Address call on init of activation record components

2019-12-13  Gary Dismukes  <dismukes@adacore.com>

gcc/ada/

	* exp_attr.adb (Expand_N_Attribute_Reference,
	Attribute_Address): Suppress generation of a call to
	Base_Address in the case where the Address attribute is being
	used to initialize a corresponding component of an activation
	record.
	(Is_Unnested_Component_Init): New function to determine whether
	an attribute reference for Address is used to initialized a
	component of an activation record object that corresponds to the
	object denoted by the prefix of the attribute (an assignment
	used in support of unnesting for back ends like LLVM).

From-SVN: r279353
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9cb8f7951f1..9838e9b2111 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+2019-12-13  Gary Dismukes  <dismukes@adacore.com>
+
+	* exp_attr.adb (Expand_N_Attribute_Reference,
+	Attribute_Address): Suppress generation of a call to
+	Base_Address in the case where the Address attribute is being
+	used to initialize a corresponding component of an activation
+	record.
+	(Is_Unnested_Component_Init): New function to determine whether
+	an attribute reference for Address is used to initialized a
+	component of an activation record object that corresponds to the
+	object denoted by the prefix of the attribute (an assignment
+	used in support of unnesting for back ends like LLVM).
+
 2019-12-13  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_res.adb (Resolve): IF an entity reference is overloaded
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 7701d723717..8c5981a75e6 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -2316,6 +2316,24 @@ package body Exp_Attr is
       when Attribute_Address => Address : declare
          Task_Proc : Entity_Id;
 
+         function Is_Unnested_Component_Init (N : Node_Id) return Boolean;
+         --  Returns True if N is being used to initialize a component of
+         --  an activation record object where the component corresponds to
+         --  the object denoted by the prefix of the attribute N.
+
+         function Is_Unnested_Component_Init (N : Node_Id) return Boolean is
+         begin
+            return Present (Parent (N))
+              and then Nkind (Parent (N)) = N_Assignment_Statement
+              and then Is_Entity_Name (Pref)
+              and then Present (Activation_Record_Component (Entity (Pref)))
+              and then Nkind (Name (Parent (N))) = N_Selected_Component
+              and then Entity (Selector_Name (Name (Parent (N)))) =
+                         Activation_Record_Component (Entity (Pref));
+         end Is_Unnested_Component_Init;
+
+      --  Start of processing for Address
+
       begin
          --  If the prefix is a task or a task type, the useful address is that
          --  of the procedure for the task body, i.e. the actual program unit.
@@ -2379,13 +2397,19 @@ package body Exp_Attr is
          --  "displaced" to reference the tag associated with the interface
          --  type. In order to obtain the real address of such objects we
          --  generate a call to a run-time subprogram that returns the base
-         --  address of the object.
+         --  address of the object. This call is not generated in cases where
+         --  the attribute is being used to initialize a component of an
+         --  activation record object where the component corresponds to
+         --  prefix of the attribute (for back ends that require "unnesting"
+         --  of nested subprograms), since the address needs to be assigned
+         --  as-is to such components.
 
          elsif Is_Class_Wide_Type (Ptyp)
            and then Is_Interface (Underlying_Type (Ptyp))
            and then Tagged_Type_Expansion
            and then not (Nkind (Pref) in N_Has_Entity
                           and then Is_Subprogram (Entity (Pref)))
+           and then not Is_Unnested_Component_Init (N)
          then
             Rewrite (N,
               Make_Function_Call (Loc,