https://gcc.gnu.org/g:73a971c845e3efbbe5db2b6260508a072acf289c
commit r15-6197-g73a971c845e3efbbe5db2b6260508a072acf289c
Author: Eric Botcazou <ebotca...@adacore.com>
Date: Fri Nov 29 09:21:09 2024 +0100
ada: Elide copy for calls in allocators for nonlimited by-reference types
This prevents a temporary from being created on the primary stack to hold
the result of the function calls before it is copied to the newly allocated
memory in the nonlimited by-reference case.
That's already not done in the nonlimited non-by-reference case and there is
no reason to do it in the former case either. The main issue is the call to
Remove_Side_Effects in Expand_Allocator_Expression, but its only purpose is
to cover the problematic processing done in Build_Allocate_Deallocate_Proc
on (part of) the expression; once this is fixed, the call is unnecessary.
The change also contains another small fix to deal with the corner case of
allocators for access-to-access types.
gcc/ada/ChangeLog:
* exp_ch4.adb (Expand_Allocator_Expression): Do not preventively
call Remove_Side_Effects on the expression in the nonlimited
by-reference case. Always call Build_Allocate_Deallocate_Proc
in the default case.
* exp_ch6.adb (Expand_Ctrl_Function_Call): Bail out if the call
is the qualified expression of an allocator.
* exp_util.adb (Build_Allocate_Deallocate_Proc): Replace all the
calls to Relocate_Node by calls to Duplicate_Subexpr_No_Checks.
Diff:
---
gcc/ada/exp_ch4.adb | 44 ++++++++++++++++++--------------------------
gcc/ada/exp_ch6.adb | 10 ++++++++++
gcc/ada/exp_util.adb | 18 ++++++++----------
3 files changed, 36 insertions(+), 36 deletions(-)
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 8c1faf415e13..6d8aa0e6eeb0 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -820,19 +820,6 @@ package body Exp_Ch4 is
-- We analyze by hand the new internal allocator to avoid any
-- recursion and inappropriate call to Initialize.
- -- We don't want to remove side effects when the expression must be
- -- built in place and we don't need it when there is no storage pool
- -- or this is a return/secondary stack allocation.
-
- if not Aggr_In_Place
- and then not Delayed_Cond_Expr
- and then Present (Storage_Pool (N))
- and then not Is_RTE (Storage_Pool (N), RE_RS_Pool)
- and then not Is_RTE (Storage_Pool (N), RE_SS_Pool)
- then
- Remove_Side_Effects (Exp);
- end if;
-
Temp := Make_Temporary (Loc, 'P', N);
-- For a class wide allocation generate the following code:
@@ -1079,6 +1066,8 @@ package body Exp_Ch4 is
Displace_Allocator_Pointer (N);
end if;
+ -- Case of aggregate built in place
+
elsif Aggr_In_Place then
Temp := Make_Temporary (Loc, 'P', N);
Build_Aggregate_In_Place (Temp, PtrT);
@@ -1099,26 +1088,29 @@ package body Exp_Ch4 is
Analyze_And_Resolve (N, PtrT);
Apply_Predicate_Check (N, T, Deref => True);
- elsif Is_Access_Type (T) and then Can_Never_Be_Null (T) then
- Install_Null_Excluding_Check (Exp);
+ -- Default case
- elsif Is_Access_Type (DesigT)
- and then Nkind (Exp) = N_Allocator
- and then Nkind (Expression (Exp)) /= N_Qualified_Expression
- then
- -- Apply constraint to designated subtype indication
+ else
+ if Is_Access_Type (T) and then Can_Never_Be_Null (T) then
+ Install_Null_Excluding_Check (Exp);
+ end if;
- Apply_Constraint_Check
- (Expression (Exp), Designated_Type (DesigT), No_Sliding => True);
+ if Is_Access_Type (DesigT)
+ and then Nkind (Exp) = N_Allocator
+ and then Nkind (Expression (Exp)) /= N_Qualified_Expression
+ then
+ -- Apply constraint to designated subtype indication
- if Nkind (Expression (Exp)) = N_Raise_Constraint_Error then
+ Apply_Constraint_Check
+ (Expression (Exp), Designated_Type (DesigT), No_Sliding => True);
- -- Propagate constraint_error to enclosing allocator
+ -- Propagate Constraint_Error to enclosing allocator
- Rewrite (Exp, New_Copy (Expression (Exp)));
+ if Nkind (Expression (Exp)) = N_Raise_Constraint_Error then
+ Rewrite (Exp, New_Copy (Expression (Exp)));
+ end if;
end if;
- else
Build_Allocate_Deallocate_Proc (N);
-- For an access-to-unconstrained-packed-array type, build an
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 945f44630d1b..751c5f4b5cdd 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5392,6 +5392,16 @@ package body Exp_Ch6 is
return;
end if;
+ -- The same optimization: if the returned value is used to initialize a
+ -- dynamically allocated object, then no need to copy/readjust/finalize,
+ -- we can initialize it in place.
+
+ if Nkind (Par) = N_Qualified_Expression
+ and then Nkind (Parent (Par)) = N_Allocator
+ then
+ return;
+ end if;
+
-- Avoid expansions to catch an error when the function call is on the
-- left-hand side of an assignment.
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index e9a683f82550..2417700493cc 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -1079,10 +1079,11 @@ package body Exp_Util is
Unchecked_Convert_To (RTE (RE_Storage_Offset),
Make_Attribute_Reference (Loc,
Prefix =>
- (if No (Alloc_Expr) then
- Make_Explicit_Dereference (Loc, Relocate_Node (Expr))
+ (if Is_Allocate then
+ Duplicate_Subexpr_No_Checks (Expression (Alloc_Expr))
else
- Relocate_Node (Expression (Alloc_Expr))),
+ Make_Explicit_Dereference (Loc,
+ Duplicate_Subexpr_No_Checks (Expr))),
Attribute_Name => Name_Alignment)));
end if;
@@ -1094,7 +1095,6 @@ package body Exp_Util is
Flag_Expr : Node_Id;
Param : Node_Id;
- Pref : Node_Id;
Temp : Node_Id;
begin
@@ -1136,7 +1136,7 @@ package body Exp_Util is
if Is_RTE (Etype (Temp), RE_Tag_Ptr) then
Param :=
Make_Explicit_Dereference (Loc,
- Prefix => Relocate_Node (Temp));
+ Prefix => Duplicate_Subexpr_No_Checks (Temp));
-- In the default case, obtain the tag of the object about
-- to be allocated / deallocated. Generate:
@@ -1149,16 +1149,14 @@ package body Exp_Util is
-- in the code that follows.
else
- Pref := Temp;
-
- if Nkind (Parent (Pref)) = N_Unchecked_Type_Conversion
+ if Nkind (Parent (Temp)) = N_Unchecked_Type_Conversion
then
- Pref := Parent (Pref);
+ Temp := Parent (Temp);
end if;
Param :=
Make_Attribute_Reference (Loc,
- Prefix => Relocate_Node (Pref),
+ Prefix => Duplicate_Subexpr_No_Checks (Temp),
Attribute_Name => Name_Tag);
end if;
