* [COMMITTED] ada: Further optimize interface objects initialized with function calls
@ 2023-01-16 14:48 Marc Poulhiès
0 siblings, 0 replies; only message in thread
From: Marc Poulhiès @ 2023-01-16 14:48 UTC (permalink / raw)
To: gcc-patches; +Cc: Eric Botcazou
From: Eric Botcazou <ebotcazou@adacore.com>
This further optimizes the usual case of (class-wide) interface objects that
are initialized with calls to functions whose result type is the type of the
objects (this is not necessary as any result type implementing the interface
would do) by avoiding a back-and-forth displacement of the objects' address.
This exposed a latent issue whereby the displacement was missing in the case
of a simple return statement whose expression is a call to a function whose
result type is a specific tagged type that needs finalization.
And, in order to avoid pessimizing the expanded code, this in turn required
avoiding to create temporaries for allocators by calling Remove_Side_Effects
up front, in the common cases when they are not necessary.
gcc/ada/
* exp_ch3.adb (Expand_N_Object_Declaration): Do not generate a back-
and-forth displacement of the object's address when using a renaming
for an interface object with an expression of the same type.
* exp_ch4.adb (Expand_Allocator_Expression): Do not remove the side
effects of the expression up front for the simple allocators. Do not
call the Adjust primitive if the expression is a function call.
* exp_ch6.adb (Expand_Ctrl_Function_Call): Do not expand the call
unnecessarily for a special return object.
(Expand_Simple_Function_Return): Restore the displacement of the
return object's address in the case where the expression is the call
to a function whose result type is a type that needs finalization.
* exp_util.adb (Expand_Subtype_From_Expr): Do not remove the side
effects of the expression before calling Make_Subtype_From_Expr.
(Make_CW_Equivalent_Type): If the expression has the tag of its type
and this type has a uniform size, use 'Object_Size of this type in
lieu of 'Size of the expression to compute the expression's size.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch3.adb | 7 +++++++
gcc/ada/exp_ch4.adb | 18 +++++++++++-------
gcc/ada/exp_ch6.adb | 22 ++++++++++------------
gcc/ada/exp_util.adb | 36 +++++++++++++++++++++++-------------
4 files changed, 51 insertions(+), 32 deletions(-)
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 84594ed106b..bbb53fc6e49 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -7589,6 +7589,13 @@ package body Exp_Ch3 is
Typ => Base_Typ);
end if;
+ -- Renaming an expression of the object's type is immediate
+
+ elsif Rewrite_As_Renaming
+ and then Base_Type (Etype (Expr_Q)) = Base_Type (Typ)
+ then
+ null;
+
elsif Tagged_Type_Expansion then
declare
Iface : constant Entity_Id := Root_Type (Typ);
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index d3a4f574866..31823eaeca7 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -698,11 +698,14 @@ package body Exp_Ch4 is
-- recursion and inappropriate call to Initialize.
-- We don't want to remove side effects when the expression must be
- -- built in place. In the case of a build-in-place function call,
- -- that could lead to a duplication of the call, which was already
- -- substituted for the allocator.
+ -- 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 then
+ if not Aggr_In_Place
+ 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;
@@ -747,7 +750,7 @@ package body Exp_Ch4 is
-- Processing for allocators returning non-interface types
- if not Is_Interface (Directly_Designated_Type (PtrT)) then
+ if not Is_Interface (DesigT) then
if Aggr_In_Place then
Temp_Decl :=
Make_Object_Declaration (Loc,
@@ -960,8 +963,9 @@ package body Exp_Ch4 is
if Needs_Finalization (DesigT)
and then Needs_Finalization (T)
- and then not Aggr_In_Place
and then not Is_Limited_View (T)
+ and then not Aggr_In_Place
+ and then Nkind (Exp) /= N_Function_Call
and then not For_Special_Return_Object (N)
then
-- An unchecked conversion is needed in the classwide case because
@@ -993,7 +997,7 @@ package body Exp_Ch4 is
-- component containing the secondary dispatch table of the interface
-- type.
- if Is_Interface (Directly_Designated_Type (PtrT)) then
+ if Is_Interface (DesigT) then
Displace_Allocator_Pointer (N);
end if;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 503fdc1ee6b..7abf25e3859 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5133,14 +5133,11 @@ package body Exp_Ch6 is
-- Another optimization: if the returned value is used to initialize an
-- object, then no need to copy/readjust/finalize, we can initialize it
- -- in place. However, if the call returns on the secondary stack or this
- -- is a special return object, then we need the expansion because we'll
- -- be renaming the temporary as the (permanent) object.
+ -- in place. However, if the call returns on the secondary stack, then
+ -- we need the expansion because we'll be renaming the temporary as the
+ -- (permanent) object.
- if Nkind (Par) = N_Object_Declaration
- and then not Use_Sec_Stack
- and then not Is_Special_Return_Object (Defining_Entity (Par))
- then
+ if Nkind (Par) = N_Object_Declaration and then not Use_Sec_Stack then
return;
end if;
@@ -6745,7 +6742,7 @@ package body Exp_Ch6 is
null;
-- Optimize the case where the result is a function call that also
- -- returns on the secondary stack. In this case the result is already
+ -- returns on the secondary stack; in this case the result is already
-- on the secondary stack and no further processing is required.
elsif Exp_Is_Function_Call
@@ -6781,13 +6778,14 @@ package body Exp_Ch6 is
-- gigi is not able to properly allocate class-wide types.
-- But optimize the case where the result is a function call that
- -- also needs finalization. In this case the result can directly be
+ -- also needs finalization; in this case the result can directly be
-- allocated on the secondary stack and no further processing is
- -- required.
+ -- required, unless the returned object is an interface.
elsif CW_Or_Needs_Finalization (Utyp)
- and then not (Exp_Is_Function_Call
- and then Needs_Finalization (Exp_Typ))
+ and then (Is_Interface (R_Type)
+ or else not (Exp_Is_Function_Call
+ and then Needs_Finalization (Exp_Typ)))
then
declare
Acc_Typ : constant Entity_Id := Make_Temporary (Loc, 'A');
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index cac0d84e453..f86b93819ac 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -5820,7 +5820,6 @@ package body Exp_Util is
-- discriminants.
else
- Remove_Side_Effects (Exp);
Rewrite (Subtype_Indic,
Make_Subtype_From_Expr (Exp, Underlying_Record_View (Unc_Type)));
end if;
@@ -5885,7 +5884,6 @@ package body Exp_Util is
end if;
else
- Remove_Side_Effects (Exp);
Rewrite (Subtype_Indic,
Make_Subtype_From_Expr (Exp, Unc_Type, Related_Id));
end if;
@@ -9496,12 +9494,13 @@ package body Exp_Util is
Root_Utyp : constant Entity_Id := Underlying_Type (Root_Typ);
List_Def : constant List_Id := Empty_List;
Comp_List : constant List_Id := New_List;
+
Equiv_Type : Entity_Id;
Range_Type : Entity_Id;
Str_Type : Entity_Id;
Constr_Root : Entity_Id;
+ Size_Attr : Node_Id;
Size_Expr : Node_Id;
- Size_Pref : Node_Id;
function Has_Tag_Of_Type (Exp : Node_Id) return Boolean;
-- Return True if expression Exp of a tagged type is known to statically
@@ -9597,9 +9596,26 @@ package body Exp_Util is
-- the _Size primitive operation.
if Has_Tag_Of_Type (E) then
- Size_Pref := Duplicate_Subexpr_No_Checks (E);
+ if not Has_Discriminants (Etype (E))
+ or else Is_Constrained (Etype (E))
+ then
+ Size_Attr :=
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Etype (E), Loc),
+ Attribute_Name => Name_Object_Size);
+
+ else
+ Size_Attr :=
+ Make_Attribute_Reference (Loc,
+ Prefix => Duplicate_Subexpr_No_Checks (E),
+ Attribute_Name => Name_Size);
+ end if;
+
else
- Size_Pref := OK_Convert_To (T, Duplicate_Subexpr_No_Checks (E));
+ Size_Attr :=
+ Make_Attribute_Reference (Loc,
+ Prefix => OK_Convert_To (T, Duplicate_Subexpr_No_Checks (E)),
+ Attribute_Name => Name_Size);
end if;
if not Is_Interface (Root_Typ) then
@@ -9610,10 +9626,7 @@ package body Exp_Util is
Size_Expr :=
Make_Op_Subtract (Loc,
- Left_Opnd =>
- Make_Attribute_Reference (Loc,
- Prefix => Size_Pref,
- Attribute_Name => Name_Size),
+ Left_Opnd => Size_Attr,
Right_Opnd =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Constr_Root, Loc),
@@ -9625,10 +9638,7 @@ package body Exp_Util is
Size_Expr :=
Make_Op_Subtract (Loc,
- Left_Opnd =>
- Make_Attribute_Reference (Loc,
- Prefix => Size_Pref,
- Attribute_Name => Name_Size),
+ Left_Opnd => Size_Attr,
Right_Opnd =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (RTE (RE_Tag), Loc),
--
2.34.1
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-01-16 14:48 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-01-16 14:48 [COMMITTED] ada: Further optimize interface objects initialized with function calls 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).