[Ada] Add a new Is_Activation_Record flag on IN parameters

2018-05-24  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* einfo.ads, einfo.adb (Is_Activation_Record): New flag on
	in_parameters, used when unesting subprograms for LLVM, to indicate
	that a generated parameter carries the activation record from the
	enclosing subprogram.
	* exp_unst.adb (Check_Static_Type): Handle array attributes of types
	whose bounds may contain up-level references that need to be added to
	an activation recoord.
	(Add_Extra_Formal): Set Is_Activation_Record on new formal.

From-SVN: r260666

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2e1c794e0dc45867f49f4a000de18e7ca5b948c5..bf4645437dd54727aa519e37129901b8e25b21da 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2018-05-24  Ed Schonberg  <schonberg@adacore.com>
+
+       * einfo.ads, einfo.adb (Is_Activation_Record): New flag on
+       in_parameters, used when unesting subprograms for LLVM, to indicate
+       that a generated parameter carries the activation record from the
+       enclosing subprogram.
+       * exp_unst.adb (Check_Static_Type): Handle array attributes of types
+       whose bounds may contain up-level references that need to be added to
+       an activation recoord.
+       (Add_Extra_Formal): Set Is_Activation_Record on new formal.
+
 2018-05-24  Yannick Moy  <moy@adacore.com>
 
        * pprint.adb (Expression_Image): Improve the printing of expressions,

diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index c0cb261acdeb000ae08401e84254ad5b73c8a6ed..77e1eb32ef9051e98318c7c245b1e2cc7c21222a 100644 (file)
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -630,8 +630,8 @@ package body Einfo is
    --    Is_Initial_Condition_Procedure  Flag302
    --    Suppress_Elaboration_Warnings   Flag303
    --    Is_Elaboration_Warnings_OK_Id   Flag304
+   --    Is_Activation_Record            Flag305
 
-   --    (unused)                        Flag305
    --    (unused)                        Flag306
    --    (unused)                        Flag307
    --    (unused)                        Flag308
@@ -2100,6 +2100,12 @@ package body Einfo is
       return Flag69 (Id);
    end Is_Access_Constant;
 
+   function Is_Activation_Record (Id : E) return B is
+   begin
+      pragma Assert (Ekind (Id) = E_In_Parameter);
+      return Flag305 (Id);
+   end Is_Activation_Record;
+
    function Is_Actual_Subtype (Id : E) return B is
    begin
       pragma Assert (Is_Type (Id));
@@ -5304,6 +5310,12 @@ package body Einfo is
       Set_Flag69 (Id, V);
    end Set_Is_Access_Constant;
 
+   procedure Set_Is_Activation_Record (Id : E; V : B := True) is
+   begin
+      pragma Assert (Ekind (Id) = E_In_Parameter);
+      Set_Flag305 (Id, V);
+   end Set_Is_Activation_Record;
+
    procedure Set_Is_Actual_Subtype (Id : E; V : B := True) is
    begin
       pragma Assert (Is_Type (Id));

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index e6dea67ac314fe2b89822847bc99d6d8c3dbfeab..cd2875458427d5735031575df0fa493140073228 100644 (file)
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2302,6 +2302,11 @@ package Einfo is
 --    Is_Access_Type (synthesized)
 --       Applies to all entities, true for access types and subtypes
 
+--    Is_Activation_Record (Flag305)
+--       Applies to In_Parameters generated in Exp_Unst for nested
+--       subprograms, to mark the added formal that carries the activation
+--       record created in the enclosing subprogram.
+
 --    Is_Actual_Subtype (Flag293)
 --       Defined on all types, true for the generated constrained subtypes
 --       that are built for unconstrained composite actuals.
@@ -6275,6 +6280,7 @@ package Einfo is
    --    Is_Only_Out_Parameter               (Flag226)
    --    Low_Bound_Tested                    (Flag205)
    --    Is_Return_Object                    (Flag209)
+   --    Is_Activation_Record                (Flag305)
    --    Parameter_Mode                      (synth)
 
    --  E_Label
@@ -7264,6 +7270,7 @@ package Einfo is
    function Is_Abstract_Subprogram              (Id : E) return B;
    function Is_Abstract_Type                    (Id : E) return B;
    function Is_Access_Constant                  (Id : E) return B;
+   function Is_Activation_Record                (Id : E) return B;
    function Is_Actual_Subtype                   (Id : E) return B;
    function Is_Ada_2005_Only                    (Id : E) return B;
    function Is_Ada_2012_Only                    (Id : E) return B;
@@ -7963,6 +7970,7 @@ package Einfo is
    procedure Set_Is_Abstract_Subprogram          (Id : E; V : B := True);
    procedure Set_Is_Abstract_Type                (Id : E; V : B := True);
    procedure Set_Is_Access_Constant              (Id : E; V : B := True);
+   procedure Set_Is_Activation_Record            (Id : E; V : B := True);
    procedure Set_Is_Actual_Subtype               (Id : E; V : B := True);
    procedure Set_Is_Ada_2005_Only                (Id : E; V : B := True);
    procedure Set_Is_Ada_2012_Only                (Id : E; V : B := True);
@@ -8789,6 +8797,7 @@ package Einfo is
    pragma Inline (Is_Abstract_Subprogram);
    pragma Inline (Is_Abstract_Type);
    pragma Inline (Is_Access_Constant);
+   pragma Inline (Is_Activation_Record);
    pragma Inline (Is_Actual_Subtype);
    pragma Inline (Is_Access_Protected_Subprogram_Type);
    pragma Inline (Is_Access_Subprogram_Type);
@@ -9325,6 +9334,7 @@ package Einfo is
    pragma Inline (Set_Is_Abstract_Subprogram);
    pragma Inline (Set_Is_Abstract_Type);
    pragma Inline (Set_Is_Access_Constant);
+   pragma Inline (Set_Is_Activation_Record);
    pragma Inline (Set_Is_Actual_Subtype);
    pragma Inline (Set_Is_Ada_2005_Only);
    pragma Inline (Set_Is_Ada_2012_Only);

diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb
index c63d2281e20feac806281a80c8ee793dc96acdce..0e60c4998b547b20c9fdcee9a387c2fa4490f171 100644 (file)
--- a/gcc/ada/exp_unst.adb
+++ b/gcc/ada/exp_unst.adb
@@ -612,6 +612,15 @@ package body Exp_Unst is
                               end if;
                            end if;
                         end if;
+                     when Attribute_First
+                        | Attribute_Last
+                        | Attribute_Length
+                     =>
+                        declare
+                           DT : Boolean := False;
+                        begin
+                           Check_Static_Type (Etype (Prefix (N)), DT);
+                        end;
 
                      when others =>
                         null;
@@ -1178,13 +1187,14 @@ package body Exp_Unst is
                   begin
                      --  Decorate the new formal entity
 
-                     Set_Scope               (Form, STJ.Ent);
-                     Set_Ekind               (Form, E_In_Parameter);
-                     Set_Etype               (Form, STJE.ARECnPT);
-                     Set_Mechanism           (Form, By_Copy);
-                     Set_Never_Set_In_Source (Form, True);
-                     Set_Analyzed            (Form, True);
-                     Set_Comes_From_Source   (Form, False);
+                     Set_Scope                (Form, STJ.Ent);
+                     Set_Ekind                (Form, E_In_Parameter);
+                     Set_Etype                (Form, STJE.ARECnPT);
+                     Set_Mechanism            (Form, By_Copy);
+                     Set_Never_Set_In_Source  (Form, True);
+                     Set_Analyzed             (Form, True);
+                     Set_Comes_From_Source    (Form, False);
+                     Set_Is_Activation_Record (Form, True);
 
                      --  Case of only body present