Commit 7037d2bb by Ed Schonberg Committed by Pierre-Marie de Rodat

[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
parent d72ba19f
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> 2018-05-24 Yannick Moy <moy@adacore.com>
* pprint.adb (Expression_Image): Improve the printing of expressions, * pprint.adb (Expression_Image): Improve the printing of expressions,
......
...@@ -630,8 +630,8 @@ package body Einfo is ...@@ -630,8 +630,8 @@ package body Einfo is
-- Is_Initial_Condition_Procedure Flag302 -- Is_Initial_Condition_Procedure Flag302
-- Suppress_Elaboration_Warnings Flag303 -- Suppress_Elaboration_Warnings Flag303
-- Is_Elaboration_Warnings_OK_Id Flag304 -- Is_Elaboration_Warnings_OK_Id Flag304
-- Is_Activation_Record Flag305
-- (unused) Flag305
-- (unused) Flag306 -- (unused) Flag306
-- (unused) Flag307 -- (unused) Flag307
-- (unused) Flag308 -- (unused) Flag308
...@@ -2100,6 +2100,12 @@ package body Einfo is ...@@ -2100,6 +2100,12 @@ package body Einfo is
return Flag69 (Id); return Flag69 (Id);
end Is_Access_Constant; 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 function Is_Actual_Subtype (Id : E) return B is
begin begin
pragma Assert (Is_Type (Id)); pragma Assert (Is_Type (Id));
...@@ -5304,6 +5310,12 @@ package body Einfo is ...@@ -5304,6 +5310,12 @@ package body Einfo is
Set_Flag69 (Id, V); Set_Flag69 (Id, V);
end Set_Is_Access_Constant; 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 procedure Set_Is_Actual_Subtype (Id : E; V : B := True) is
begin begin
pragma Assert (Is_Type (Id)); pragma Assert (Is_Type (Id));
......
...@@ -2302,6 +2302,11 @@ package Einfo is ...@@ -2302,6 +2302,11 @@ package Einfo is
-- Is_Access_Type (synthesized) -- Is_Access_Type (synthesized)
-- Applies to all entities, true for access types and subtypes -- 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) -- Is_Actual_Subtype (Flag293)
-- Defined on all types, true for the generated constrained subtypes -- Defined on all types, true for the generated constrained subtypes
-- that are built for unconstrained composite actuals. -- that are built for unconstrained composite actuals.
...@@ -6275,6 +6280,7 @@ package Einfo is ...@@ -6275,6 +6280,7 @@ package Einfo is
-- Is_Only_Out_Parameter (Flag226) -- Is_Only_Out_Parameter (Flag226)
-- Low_Bound_Tested (Flag205) -- Low_Bound_Tested (Flag205)
-- Is_Return_Object (Flag209) -- Is_Return_Object (Flag209)
-- Is_Activation_Record (Flag305)
-- Parameter_Mode (synth) -- Parameter_Mode (synth)
-- E_Label -- E_Label
...@@ -7264,6 +7270,7 @@ package Einfo is ...@@ -7264,6 +7270,7 @@ package Einfo is
function Is_Abstract_Subprogram (Id : E) return B; function Is_Abstract_Subprogram (Id : E) return B;
function Is_Abstract_Type (Id : E) return B; function Is_Abstract_Type (Id : E) return B;
function Is_Access_Constant (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_Actual_Subtype (Id : E) return B;
function Is_Ada_2005_Only (Id : E) return B; function Is_Ada_2005_Only (Id : E) return B;
function Is_Ada_2012_Only (Id : E) return B; function Is_Ada_2012_Only (Id : E) return B;
...@@ -7963,6 +7970,7 @@ package Einfo is ...@@ -7963,6 +7970,7 @@ package Einfo is
procedure Set_Is_Abstract_Subprogram (Id : E; V : B := True); procedure Set_Is_Abstract_Subprogram (Id : E; V : B := True);
procedure Set_Is_Abstract_Type (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_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_Actual_Subtype (Id : E; V : B := True);
procedure Set_Is_Ada_2005_Only (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); procedure Set_Is_Ada_2012_Only (Id : E; V : B := True);
...@@ -8789,6 +8797,7 @@ package Einfo is ...@@ -8789,6 +8797,7 @@ package Einfo is
pragma Inline (Is_Abstract_Subprogram); pragma Inline (Is_Abstract_Subprogram);
pragma Inline (Is_Abstract_Type); pragma Inline (Is_Abstract_Type);
pragma Inline (Is_Access_Constant); pragma Inline (Is_Access_Constant);
pragma Inline (Is_Activation_Record);
pragma Inline (Is_Actual_Subtype); pragma Inline (Is_Actual_Subtype);
pragma Inline (Is_Access_Protected_Subprogram_Type); pragma Inline (Is_Access_Protected_Subprogram_Type);
pragma Inline (Is_Access_Subprogram_Type); pragma Inline (Is_Access_Subprogram_Type);
...@@ -9325,6 +9334,7 @@ package Einfo is ...@@ -9325,6 +9334,7 @@ package Einfo is
pragma Inline (Set_Is_Abstract_Subprogram); pragma Inline (Set_Is_Abstract_Subprogram);
pragma Inline (Set_Is_Abstract_Type); pragma Inline (Set_Is_Abstract_Type);
pragma Inline (Set_Is_Access_Constant); pragma Inline (Set_Is_Access_Constant);
pragma Inline (Set_Is_Activation_Record);
pragma Inline (Set_Is_Actual_Subtype); pragma Inline (Set_Is_Actual_Subtype);
pragma Inline (Set_Is_Ada_2005_Only); pragma Inline (Set_Is_Ada_2005_Only);
pragma Inline (Set_Is_Ada_2012_Only); pragma Inline (Set_Is_Ada_2012_Only);
......
...@@ -612,6 +612,15 @@ package body Exp_Unst is ...@@ -612,6 +612,15 @@ package body Exp_Unst is
end if; end if;
end if; 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 => when others =>
null; null;
...@@ -1178,13 +1187,14 @@ package body Exp_Unst is ...@@ -1178,13 +1187,14 @@ package body Exp_Unst is
begin begin
-- Decorate the new formal entity -- Decorate the new formal entity
Set_Scope (Form, STJ.Ent); Set_Scope (Form, STJ.Ent);
Set_Ekind (Form, E_In_Parameter); Set_Ekind (Form, E_In_Parameter);
Set_Etype (Form, STJE.ARECnPT); Set_Etype (Form, STJE.ARECnPT);
Set_Mechanism (Form, By_Copy); Set_Mechanism (Form, By_Copy);
Set_Never_Set_In_Source (Form, True); Set_Never_Set_In_Source (Form, True);
Set_Analyzed (Form, True); Set_Analyzed (Form, True);
Set_Comes_From_Source (Form, False); Set_Comes_From_Source (Form, False);
Set_Is_Activation_Record (Form, True);
-- Case of only body present -- Case of only body present
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment