* [COMMITTED] ada: Adjust semantics and implementation of storage models
@ 2023-05-16 8:40 Marc Poulhiès
0 siblings, 0 replies; only message in thread
From: Marc Poulhiès @ 2023-05-16 8:40 UTC (permalink / raw)
To: gcc-patches; +Cc: Eric Botcazou
From: Eric Botcazou <ebotcazou@adacore.com>
This makes the following adjustments to the semantics and implementation of
storage models in the compiler:
1. By-copy semantics in subprogram calls: when an object accessed with a
nonnative storage model is passed as an actual parameter in a call to
a subprogram, an intermediate copy made on the host is passed instead.
2. More generally, any additional temporary required on the host by the
semantics of nonnative storage models is now created by the front-end
instead of the code generator.
3. All the temporaries created on the host for nonnative storage models
are allocated on the secondary stack instead of the primary stack.
As a result, this should simplify the implementation in code generators.
gcc/ada/
* exp_aggr.adb (Build_Assignment_With_Temporary): Adjust comment
and fix type of second parameter. Create the temporary on the
secondary stack by calling Build_Temporary_On_Secondary_Stack.
(Convert_Array_Aggr_In_Allocator): Adjust formatting.
(Expand_Array_Aggregate): Likewise.
* exp_ch4.adb (Expand_N_Allocator): Set Actual_Designated_Subtype
on the dereference in the initialization for all composite types.
* exp_ch5.adb (Expand_N_Assignment_Statement): Create a temporary
on the host for an assignment between nonnative storage models.
Suppress more checks when Suppress_Assignment_Checks is set.
* exp_ch6.adb (Add_Simple_Call_By_Copy_Code): Deal with actuals
that are dereferences with an Actual_Designated_Subtype. Add
support for nonnative storage models.
(Expand_Actuals): Create a copy if the actual is a dereference
with a nonnative storage model.
* exp_util.ads (Build_Temporary_On_Secondary_Stack): Declare.
* exp_util.adb (Build_Temporary_On_Secondary_Stack): New function.
* sem_ch5.adb (Analyze_Assignment.Set_Assignment_Type): Do not
build an actual subtype for dereferences with an
Actual_Designated_Subtype
* sinfo.ads (Actual_Designated_Subtype): Adjust documentation.
(Suppress_Assignment_Checks): Likewise.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_aggr.adb | 51 +++++++++---------
gcc/ada/exp_ch4.adb | 52 +++++++++----------
gcc/ada/exp_ch5.adb | 58 +++++++++++++++++++--
gcc/ada/exp_ch6.adb | 121 ++++++++++++++++++++++++++++++++++++-------
gcc/ada/exp_util.adb | 49 ++++++++++++++++++
gcc/ada/exp_util.ads | 12 +++++
gcc/ada/sem_ch5.adb | 9 ++--
gcc/ada/sinfo.ads | 4 +-
8 files changed, 274 insertions(+), 82 deletions(-)
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index f1cbbfc3155..cf8bac0f4bf 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -62,7 +62,7 @@ with Sem_Eval; use Sem_Eval;
with Sem_Mech; use Sem_Mech;
with Sem_Res; use Sem_Res;
with Sem_Util; use Sem_Util;
-use Sem_Util.Storage_Model_Support;
+ use Sem_Util.Storage_Model_Support;
with Sinfo; use Sinfo;
with Sinfo.Nodes; use Sinfo.Nodes;
with Sinfo.Utils; use Sinfo.Utils;
@@ -78,12 +78,10 @@ package body Exp_Aggr is
function Build_Assignment_With_Temporary
(Target : Node_Id;
- Typ : Node_Id;
+ Typ : Entity_Id;
Source : Node_Id) return List_Id;
-- Returns a list of actions to assign Source to Target of type Typ using
- -- an extra temporary:
- -- Tmp := Source;
- -- Target := Tmp;
+ -- an extra temporary, which can potentially be large.
type Case_Bounds is record
Choice_Lo : Node_Id;
@@ -2524,33 +2522,33 @@ package body Exp_Aggr is
function Build_Assignment_With_Temporary
(Target : Node_Id;
- Typ : Node_Id;
+ Typ : Entity_Id;
Source : Node_Id) return List_Id
is
Loc : constant Source_Ptr := Sloc (Source);
Aggr_Code : List_Id;
Tmp : Entity_Id;
- Tmp_Decl : Node_Id;
begin
- Tmp := Make_Temporary (Loc, 'A', Source);
- Tmp_Decl :=
- Make_Object_Declaration (Loc,
- Defining_Identifier => Tmp,
- Object_Definition => New_Occurrence_Of (Typ, Loc));
- Set_No_Initialization (Tmp_Decl, True);
+ Aggr_Code := New_List;
+
+ Tmp := Build_Temporary_On_Secondary_Stack (Loc, Typ, Aggr_Code);
- Aggr_Code := New_List (Tmp_Decl);
Append_To (Aggr_Code,
Make_OK_Assignment_Statement (Loc,
- Name => New_Occurrence_Of (Tmp, Loc),
+ Name =>
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Occurrence_Of (Tmp, Loc)),
Expression => Source));
Append_To (Aggr_Code,
Make_OK_Assignment_Statement (Loc,
Name => Target,
- Expression => New_Occurrence_Of (Tmp, Loc)));
+ Expression =>
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Occurrence_Of (Tmp, Loc))));
+
return Aggr_Code;
end Build_Assignment_With_Temporary;
@@ -4571,8 +4569,9 @@ package body Exp_Aggr is
(Storage_Model_Object
(Etype (Prefix (Expression (Target))))))
then
- Aggr_Code := Build_Assignment_With_Temporary (Target,
- Typ, New_Aggr);
+ Aggr_Code :=
+ Build_Assignment_With_Temporary (Target, Typ, New_Aggr);
+
else
Aggr_Code :=
New_List (
@@ -7139,20 +7138,20 @@ package body Exp_Aggr is
(Storage_Model_Object
(Etype (Prefix (Name (Parent_Node))))))
then
- Aggr_Code := Build_Assignment_With_Temporary (Target,
- Typ, New_Copy_Tree (N));
+ Aggr_Code := Build_Assignment_With_Temporary
+ (Target, Typ, New_Copy_Tree (N));
+
else
if Maybe_In_Place_OK then
return;
end if;
- Aggr_Code :=
- New_List (
- Make_Assignment_Statement (Loc,
- Name => Target,
- Expression => New_Copy_Tree (N)));
-
+ Aggr_Code := New_List (
+ Make_Assignment_Statement (Loc,
+ Name => Target,
+ Expression => New_Copy_Tree (N)));
end if;
+
else
Aggr_Code :=
Build_Array_Aggr_Code (N,
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 9558596ffa0..95b81fb8e53 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -5066,13 +5066,12 @@ package body Exp_Ch4 is
-- Add discriminants if discriminated type
declare
- Dis : Boolean := False;
- Typ : Entity_Id := Empty;
+ Dis : Boolean := False;
+ Typ : Entity_Id := T;
begin
if Has_Discriminants (T) then
Dis := True;
- Typ := T;
-- Type may be a private type with no visible discriminants
-- in which case check full view if in scope, or the
@@ -5115,30 +5114,6 @@ package body Exp_Ch4 is
Set_Expression (N, New_Occurrence_Of (Typ, Loc));
end if;
- -- When the designated subtype is unconstrained and
- -- the allocator specifies a constrained subtype (or
- -- such a subtype has been created, such as above by
- -- Build_Default_Subtype), associate that subtype with
- -- the dereference of the allocator's access value.
- -- This is needed by the back end for cases where
- -- the access type has a Designated_Storage_Model,
- -- to support allocation of a host object of the right
- -- size for passing to the initialization procedure.
-
- if not Is_Constrained (Dtyp)
- and then Is_Constrained (Typ)
- then
- declare
- Init_Deref : constant Node_Id :=
- Unqual_Conv (Init_Arg1);
- begin
- pragma Assert
- (Nkind (Init_Deref) = N_Explicit_Dereference);
-
- Set_Actual_Designated_Subtype (Init_Deref, Typ);
- end;
- end if;
-
Discr := First_Elmt (Discriminant_Constraint (Typ));
while Present (Discr) loop
Nod := Node (Discr);
@@ -5161,6 +5136,29 @@ package body Exp_Ch4 is
Next_Elmt (Discr);
end loop;
end if;
+
+ -- When the designated subtype is unconstrained and
+ -- the allocator specifies a constrained subtype (or
+ -- such a subtype has been created, such as above by
+ -- Build_Default_Subtype), associate that subtype with
+ -- the dereference of the allocator's access value.
+ -- This is needed by the expander for cases where the
+ -- access type has a Designated_Storage_Model in order
+ -- to support allocation of a host object of the right
+ -- size for passing to the initialization procedure.
+
+ if not Is_Constrained (Dtyp)
+ and then Is_Constrained (Typ)
+ then
+ declare
+ Deref : constant Node_Id := Unqual_Conv (Init_Arg1);
+
+ begin
+ pragma Assert (Nkind (Deref) = N_Explicit_Dereference);
+
+ Set_Actual_Designated_Subtype (Deref, Typ);
+ end;
+ end if;
end;
-- We set the allocator as analyzed so that when we analyze
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 0dbf2d55192..0c89856b58b 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -59,6 +59,7 @@ with Sem_Ch13; use Sem_Ch13;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;
with Sem_Util; use Sem_Util;
+ use Sem_Util.Storage_Model_Support;
with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
@@ -2658,10 +2659,50 @@ package body Exp_Ch5 is
Convert_Aggr_In_Assignment (N);
Rewrite (N, Make_Null_Statement (Loc));
Analyze (N);
-
return;
end if;
+ -- An assignment between nonnative storage models requires creating an
+ -- intermediate temporary on the host, which can potentially be large.
+
+ if Nkind (Lhs) = N_Explicit_Dereference
+ and then Has_Designated_Storage_Model_Aspect (Etype (Prefix (Lhs)))
+ and then Present (Storage_Model_Copy_To
+ (Storage_Model_Object (Etype (Prefix (Lhs)))))
+ and then Nkind (Rhs) = N_Explicit_Dereference
+ and then Has_Designated_Storage_Model_Aspect (Etype (Prefix (Rhs)))
+ and then Present (Storage_Model_Copy_From
+ (Storage_Model_Object (Etype (Prefix (Rhs)))))
+ then
+ declare
+ Assign_Code : List_Id;
+ Tmp : Entity_Id;
+
+ begin
+ Assign_Code := New_List;
+
+ Tmp := Build_Temporary_On_Secondary_Stack (Loc, Typ, Assign_Code);
+
+ Append_To (Assign_Code,
+ Make_Assignment_Statement (Loc,
+ Name =>
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Occurrence_Of (Tmp, Loc)),
+ Expression => Relocate_Node (Rhs)));
+
+ Append_To (Assign_Code,
+ Make_Assignment_Statement (Loc,
+ Name => Relocate_Node (Lhs),
+ Expression =>
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Occurrence_Of (Tmp, Loc))));
+
+ Insert_Actions (N, Assign_Code);
+ Rewrite (N, Make_Null_Statement (Loc));
+ return;
+ end;
+ end if;
+
-- Apply discriminant check if required. If Lhs is an access type to a
-- designated type with discriminants, we must always check. If the
-- type has unknown discriminants, more elaborate processing below.
@@ -2672,7 +2713,7 @@ package body Exp_Ch5 is
-- Skip discriminant check if change of representation. Will be
-- done when the change of representation is expanded out.
- if not Crep then
+ if not Crep and then not Suppress_Assignment_Checks (N) then
Apply_Discriminant_Check (Rhs, Etype (Lhs), Lhs);
end if;
@@ -2712,7 +2753,9 @@ package body Exp_Ch5 is
Set_Etype (Lhs, Ubt);
Rewrite (Rhs, OK_Convert_To (Base_Type (Ubt), Rhs));
- Apply_Discriminant_Check (Rhs, Ubt, Lhs);
+ if not Suppress_Assignment_Checks (N) then
+ Apply_Discriminant_Check (Rhs, Ubt, Lhs);
+ end if;
Set_Etype (Lhs, Lt);
end;
@@ -2732,12 +2775,16 @@ package body Exp_Ch5 is
then
Rewrite (Rhs, OK_Convert_To (Base_Type (Typ), Rhs));
Rewrite (Lhs, OK_Convert_To (Base_Type (Typ), Lhs));
- Apply_Discriminant_Check (Rhs, Typ, Lhs);
+ if not Suppress_Assignment_Checks (N) then
+ Apply_Discriminant_Check (Rhs, Typ, Lhs);
+ end if;
elsif Is_Array_Type (Typ) and then Is_Constrained (Typ) then
Rewrite (Rhs, OK_Convert_To (Base_Type (Typ), Rhs));
Rewrite (Lhs, OK_Convert_To (Base_Type (Typ), Lhs));
- Apply_Length_Check (Rhs, Typ);
+ if not Suppress_Assignment_Checks (N) then
+ Apply_Length_Check (Rhs, Typ);
+ end if;
end if;
-- In the access type case, we need the same discriminant check, and
@@ -2745,6 +2792,7 @@ package body Exp_Ch5 is
elsif Is_Access_Type (Etype (Lhs))
and then Is_Constrained (Designated_Type (Etype (Lhs)))
+ and then not Suppress_Assignment_Checks (N)
then
if Has_Discriminants (Designated_Type (Etype (Lhs))) then
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 7abf25e3859..af7f75342fa 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -70,6 +70,7 @@ with Sem_Mech; use Sem_Mech;
with Sem_Res; use Sem_Res;
with Sem_SCIL; use Sem_SCIL;
with Sem_Util; use Sem_Util;
+ use Sem_Util.Storage_Model_Support;
with Sinfo; use Sinfo;
with Sinfo.Nodes; use Sinfo.Nodes;
with Sinfo.Utils; use Sinfo.Utils;
@@ -1936,8 +1937,14 @@ package body Exp_Ch6 is
----------------------------------
procedure Add_Simple_Call_By_Copy_Code (Force : Boolean) is
+ With_Storage_Model : constant Boolean :=
+ Nkind (Actual) = N_Explicit_Dereference
+ and then
+ Has_Designated_Storage_Model_Aspect (Etype (Prefix (Actual)));
+
+ Cpcod : List_Id;
Decl : Node_Id;
- F_Typ : Entity_Id := Etype (Formal);
+ F_Typ : Entity_Id;
Incod : Node_Id;
Indic : Node_Id;
Lhs : Node_Id;
@@ -1952,6 +1959,8 @@ package body Exp_Ch6 is
return;
end if;
+ F_Typ := Etype (Formal);
+
-- Handle formals whose type comes from the limited view
if From_Limited_With (F_Typ)
@@ -1960,12 +1969,21 @@ package body Exp_Ch6 is
F_Typ := Non_Limited_View (F_Typ);
end if;
+ -- Use the actual designated subtype for a dereference, if any
+
+ if Nkind (Actual) = N_Explicit_Dereference
+ and then Present (Actual_Designated_Subtype (Actual))
+ then
+ Indic :=
+ New_Occurrence_Of (Actual_Designated_Subtype (Actual), Loc);
+
-- Use formal type for temp, unless formal type is an unconstrained
-- array, in which case we don't have to worry about bounds checks,
-- and we use the actual type, since that has appropriate bounds.
- if Is_Array_Type (F_Typ) and then not Is_Constrained (F_Typ) then
+ elsif Is_Array_Type (F_Typ) and then not Is_Constrained (F_Typ) then
Indic := New_Occurrence_Of (Etype (Actual), Loc);
+
else
Indic := New_Occurrence_Of (F_Typ, Loc);
end if;
@@ -1974,7 +1992,6 @@ package body Exp_Ch6 is
Reset_Packed_Prefix;
- Temp := Make_Temporary (Loc, 'T', Actual);
Incod := Relocate_Node (Actual);
Outcod := New_Copy_Tree (Incod);
@@ -1990,7 +2007,10 @@ package body Exp_Ch6 is
if Ekind (Formal) = E_Out_Parameter then
Incod := Empty;
- if Has_Discriminants (F_Typ) then
+ if Has_Discriminants (F_Typ)
+ and then (Nkind (Actual) /= N_Explicit_Dereference
+ or else No (Actual_Designated_Subtype (Actual)))
+ then
Indic := New_Occurrence_Of (Etype (Actual), Loc);
end if;
@@ -2017,15 +2037,31 @@ package body Exp_Ch6 is
end if;
end if;
- Decl :=
- Make_Object_Declaration (Loc,
- Defining_Identifier => Temp,
- Object_Definition => Indic,
- Expression => Incod);
+ Cpcod := New_List;
+
+ if With_Storage_Model then
+ Temp :=
+ Build_Temporary_On_Secondary_Stack (Loc, Entity (Indic), Cpcod);
+
+ if Present (Incod) then
+ Append_To (Cpcod,
+ Make_Assignment_Statement (Loc,
+ Name =>
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Occurrence_Of (Temp, Loc)),
+ Expression => Incod));
+ Set_Suppress_Assignment_Checks (Last (Cpcod));
+ end if;
+
+ else
+ Temp := Make_Temporary (Loc, 'T', Actual);
+
+ Decl :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Temp,
+ Object_Definition => Indic,
+ Expression => Incod);
- if Inside_Init_Proc
- and then No (Incod)
- then
-- If the call is to initialize a component of a composite type,
-- and the component does not depend on discriminants, use the
-- actual type of the component. This is required in case the
@@ -2035,23 +2071,42 @@ package body Exp_Ch6 is
-- discriminant, the presence of the initialization in the
-- declaration will generate an expression for the actual subtype.
- Set_No_Initialization (Decl);
- Set_Object_Definition (Decl,
- New_Occurrence_Of (Etype (Actual), Loc));
+ if Inside_Init_Proc and then No (Incod) then
+ Set_No_Initialization (Decl);
+ Set_Object_Definition (Decl,
+ New_Occurrence_Of (Etype (Actual), Loc));
+ end if;
+
+ Append_To (Cpcod, Decl);
end if;
- Insert_Action (N, Decl);
+ Insert_Actions (N, Cpcod);
-- The actual is simply a reference to the temporary
- Rewrite (Actual, New_Occurrence_Of (Temp, Loc));
+ if With_Storage_Model then
+ Rewrite (Actual,
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Occurrence_Of (Temp, Loc)));
+ else
+ Rewrite (Actual, New_Occurrence_Of (Temp, Loc));
+ end if;
+
+ Analyze (Actual);
-- Generate copy out if OUT or IN OUT parameter
if Ekind (Formal) /= E_In_Parameter then
Lhs := Outcod;
- Rhs := New_Occurrence_Of (Temp, Loc);
- Set_Is_True_Constant (Temp, False);
+
+ if With_Storage_Model then
+ Rhs :=
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Occurrence_Of (Temp, Loc));
+ else
+ Rhs := New_Occurrence_Of (Temp, Loc);
+ Set_Is_True_Constant (Temp, False);
+ end if;
-- Deal with conversion
@@ -2064,6 +2119,7 @@ package body Exp_Ch6 is
Make_Assignment_Statement (Loc,
Name => Lhs,
Expression => Rhs));
+ Set_Suppress_Assignment_Checks (Last (Post_Call));
Set_Assignment_OK (Name (Last (Post_Call)));
end if;
end Add_Simple_Call_By_Copy_Code;
@@ -2452,6 +2508,22 @@ package body Exp_Ch6 is
elsif Is_Ref_To_Bit_Packed_Array (Actual) then
Add_Simple_Call_By_Copy_Code (Force => True);
+ -- If the actual has a nonnative storage model, we need a copy
+
+ elsif Nkind (Actual) = N_Explicit_Dereference
+ and then
+ Has_Designated_Storage_Model_Aspect (Etype (Prefix (Actual)))
+ and then
+ (Present (Storage_Model_Copy_To
+ (Storage_Model_Object (Etype (Prefix (Actual)))))
+ or else
+ (Ekind (Formal) = E_In_Out_Parameter
+ and then
+ (Present (Storage_Model_Copy_From
+ (Storage_Model_Object (Etype (Prefix (Actual))))))))
+ then
+ Add_Simple_Call_By_Copy_Code (Force => True);
+
-- If a nonscalar actual is possibly bit-aligned, we need a copy
-- because the back-end cannot cope with such objects. In other
-- cases where alignment forces a copy, the back-end generates
@@ -2598,6 +2670,17 @@ package body Exp_Ch6 is
elsif Is_Ref_To_Bit_Packed_Array (Actual) then
Add_Simple_Call_By_Copy_Code (Force => True);
+ -- If the actual has a nonnative storage model, we need a copy
+
+ elsif Nkind (Actual) = N_Explicit_Dereference
+ and then
+ Has_Designated_Storage_Model_Aspect (Etype (Prefix (Actual)))
+ and then
+ Present (Storage_Model_Copy_From
+ (Storage_Model_Object (Etype (Prefix (Actual)))))
+ then
+ Add_Simple_Call_By_Copy_Code (Force => True);
+
-- If we have a C++ constructor call, we need to create the object
elsif Is_CPP_Constructor_Call (Actual) then
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 80c01bf40fd..f010dac4978 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -4699,6 +4699,55 @@ package body Exp_Util is
return Build_Task_Image_Function (Loc, Decls, Stats, Res);
end Build_Task_Record_Image;
+ ----------------------------------------
+ -- Build_Temporary_On_Secondary_Stack --
+ ----------------------------------------
+
+ function Build_Temporary_On_Secondary_Stack
+ (Loc : Source_Ptr;
+ Typ : Entity_Id;
+ Code : List_Id) return Entity_Id
+ is
+ Acc_Typ : Entity_Id;
+ Alloc : Node_Id;
+ Alloc_Obj : Entity_Id;
+
+ begin
+ pragma Assert (RTE_Available (RE_SS_Pool)
+ and then not Needs_Finalization (Typ));
+
+ Acc_Typ := Make_Temporary (Loc, 'A');
+ Mutate_Ekind (Acc_Typ, E_Access_Type);
+ Set_Associated_Storage_Pool (Acc_Typ, RTE (RE_SS_Pool));
+
+ Append_To (Code,
+ Make_Full_Type_Declaration (Loc,
+ Defining_Identifier => Acc_Typ,
+ Type_Definition =>
+ Make_Access_To_Object_Definition (Loc,
+ All_Present => True,
+ Subtype_Indication =>
+ New_Occurrence_Of (Typ, Loc))));
+
+ Alloc :=
+ Make_Allocator (Loc, Expression => New_Occurrence_Of (Typ, Loc));
+ Set_No_Initialization (Alloc);
+
+ Alloc_Obj := Make_Temporary (Loc, 'R');
+
+ Append_To (Code,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Alloc_Obj,
+ Constant_Present => True,
+ Object_Definition =>
+ New_Occurrence_Of (Acc_Typ, Loc),
+ Expression => Alloc));
+
+ Set_Uses_Sec_Stack (Current_Scope);
+
+ return Alloc_Obj;
+ end Build_Temporary_On_Secondary_Stack;
+
---------------------------------------
-- Build_Transient_Object_Statements --
---------------------------------------
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index 3dd10d77cea..eef6800f371 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -351,6 +351,18 @@ package Exp_Util is
-- is false, the call is for a stand-alone object, and the generated
-- function itself must do its own cleanups.
+ function Build_Temporary_On_Secondary_Stack
+ (Loc : Source_Ptr;
+ Typ : Entity_Id;
+ Code : List_Id) return Entity_Id;
+ -- Build a temporary of type Typ on the secondary stack, appending the
+ -- necessary actions to Code, and return a constant holding the access
+ -- value designating this temporary, under the assumption that Typ does
+ -- not need finalization.
+
+ -- This should be used when Typ can potentially be large, to avoid putting
+ -- too much pressure on the primary stack, for example with storage models.
+
procedure Build_Transient_Object_Statements
(Obj_Decl : Node_Id;
Fin_Call : out Node_Id;
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index ab5a2083a00..27ab0b738cd 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -324,10 +324,13 @@ package body Sem_Ch5 is
then
Opnd_Type := Get_Actual_Subtype (Opnd);
- -- If assignment operand is a component reference, then we get the
- -- actual subtype of the component for the unconstrained case.
+ -- If the assignment operand is a component reference, then we build
+ -- the actual subtype of the component for the unconstrained case,
+ -- unless there is already one or the type is an unchecked union.
- elsif Nkind (Opnd) in N_Selected_Component | N_Explicit_Dereference
+ elsif (Nkind (Opnd) = N_Selected_Component
+ or else (Nkind (Opnd) = N_Explicit_Dereference
+ and then No (Actual_Designated_Subtype (Opnd))))
and then not Is_Unchecked_Union (Opnd_Type)
then
Decl := Build_Actual_Subtype_Of_Component (Opnd_Type, Opnd);
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 6cacebe7775..ce54dd3fb91 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -830,7 +830,7 @@ package Sinfo is
-- an unconstrained packed array and the dereference is the prefix of
-- a 'Size attribute reference, or 2) when the dereference node is
-- created for the expansion of an allocator with a subtype_indication
- -- and the designated subtype is an unconstrained discriminated type.
+ -- and the designated subtype is an unconstrained composite type.
-- Address_Warning_Posted
-- Present in N_Attribute_Definition nodes. Set to indicate that we have
@@ -2311,7 +2311,7 @@ package Sinfo is
-- can be set in N_Object_Declaration nodes, to similarly suppress any
-- checks on the initializing value. In assignment statements it also
-- suppresses access checks in the generated code for out- and in-out
- -- parameters in entry calls, as well as length checks.
+ -- parameters in entry calls, as well as discriminant and length checks.
-- Suppress_Loop_Warnings
-- Used in N_Loop_Statement node to indicate that warnings within the
--
2.40.0
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-05-16 8:40 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-05-16 8:40 [COMMITTED] ada: Adjust semantics and implementation of storage models Marc Poulhiès
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).