* [Ada] Optimization of array aggregates
@ 2010-10-21 10:24 Arnaud Charlet
2010-10-21 11:44 ` Duncan Sands
0 siblings, 1 reply; 4+ messages in thread
From: Arnaud Charlet @ 2010-10-21 10:24 UTC (permalink / raw)
To: gcc-patches; +Cc: Ed Schonberg
[-- Attachment #1: Type: text/plain, Size: 795 bytes --]
This patch improves the handling of array aggregates with static components.
It allows constant folding of aggregates with a single association given by
an expanded name, and it allows in-place assignments for aggregates when the
array type has an index type that has a non-standard representation.
Tested on x86_64-pc-linux-gnu, committed on trunk
2010-10-21 Ed Schonberg <schonberg@adacore.com>
* exp_aggr.adb (Flatten): An association for a subtype may be an
expanded name.
(Safe_Left_Hand_Side): An unchecked conversion is part of a safe
left-hand side if the expression is.
(Is_Safe_Index): new predicate
Minor clean up in identier names (Indices -> Indexes).
* exp_ch3.adb (Expand_Freeze_Enumeration_Type): Indicate that the
generated Rep_To_Pos function is a Pure_Function.
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 9212 bytes --]
Index: exp_aggr.adb
===================================================================
--- exp_aggr.adb (revision 165755)
+++ exp_aggr.adb (working copy)
@@ -227,7 +227,7 @@ package body Exp_Aggr is
Index : Node_Id;
Into : Node_Id;
Scalar_Comp : Boolean;
- Indices : List_Id := No_List;
+ Indexes : List_Id := No_List;
Flist : Node_Id := Empty) return List_Id;
-- This recursive routine returns a list of statements containing the
-- loops and assignments that are needed for the expansion of the array
@@ -244,7 +244,7 @@ package body Exp_Aggr is
--
-- Scalar_Comp is True if the component type of the aggregate is scalar.
--
- -- Indices is the current list of expressions used to index the
+ -- Indexes is the current list of expressions used to index the
-- object we are writing into.
--
-- Flist is an expression representing the finalization list on which
@@ -701,7 +701,7 @@ package body Exp_Aggr is
Index : Node_Id;
Into : Node_Id;
Scalar_Comp : Boolean;
- Indices : List_Id := No_List;
+ Indexes : List_Id := No_List;
Flist : Node_Id := Empty) return List_Id
is
Loc : constant Source_Ptr := Sloc (N);
@@ -728,7 +728,7 @@ package body Exp_Aggr is
-- N to Build_Loop contains no sub-aggregates, then this function
-- returns the assignment statement:
--
- -- Into (Indices, Ind) := Expr;
+ -- Into (Indexes, Ind) := Expr;
--
-- Otherwise we call Build_Code recursively
--
@@ -741,7 +741,7 @@ package body Exp_Aggr is
-- This routine returns the for loop statement
--
-- for J in Index_Base'(L) .. Index_Base'(H) loop
- -- Into (Indices, J) := Expr;
+ -- Into (Indexes, J) := Expr;
-- end loop;
--
-- Otherwise we call Build_Code recursively.
@@ -756,7 +756,7 @@ package body Exp_Aggr is
-- J : Index_Base := L;
-- while J < H loop
-- J := Index_Base'Succ (J);
- -- Into (Indices, J) := Expr;
+ -- Into (Indexes, J) := Expr;
-- end loop;
--
-- Otherwise we call Build_Code recursively
@@ -942,7 +942,7 @@ package body Exp_Aggr is
F : Entity_Id;
A : Node_Id;
- New_Indices : List_Id;
+ New_Indexes : List_Id;
Indexed_Comp : Node_Id;
Expr_Q : Node_Id;
Comp_Type : Entity_Id := Empty;
@@ -982,13 +982,13 @@ package body Exp_Aggr is
-- Start of processing for Gen_Assign
begin
- if No (Indices) then
- New_Indices := New_List;
+ if No (Indexes) then
+ New_Indexes := New_List;
else
- New_Indices := New_Copy_List_Tree (Indices);
+ New_Indexes := New_Copy_List_Tree (Indexes);
end if;
- Append_To (New_Indices, Ind);
+ Append_To (New_Indexes, Ind);
if Present (Flist) then
F := New_Copy_Tree (Flist);
@@ -1014,7 +1014,7 @@ package body Exp_Aggr is
Index => Next_Index (Index),
Into => Into,
Scalar_Comp => Scalar_Comp,
- Indices => New_Indices,
+ Indexes => New_Indexes,
Flist => F));
end if;
@@ -1024,7 +1024,7 @@ package body Exp_Aggr is
Checks_Off
(Make_Indexed_Component (Loc,
Prefix => New_Copy_Tree (Into),
- Expressions => New_Indices));
+ Expressions => New_Indexes));
Set_Assignment_OK (Indexed_Comp);
@@ -1045,7 +1045,7 @@ package body Exp_Aggr is
Comp_Type := Component_Type (Etype (N));
pragma Assert (Comp_Type = Ctype); -- AI-287
- elsif Present (Next (First (New_Indices))) then
+ elsif Present (Next (First (New_Indexes))) then
-- Ada 2005 (AI-287): Do nothing in case of default initialized
-- component because we have received the component type in
@@ -3946,9 +3946,9 @@ package body Exp_Aggr is
exit Component_Loop;
- -- Case of a subtype mark
+ -- Case of a subtype mark, identifier or expanded name
- elsif Nkind (Choice) = N_Identifier
+ elsif Is_Entity_Name (Choice)
and then Is_Type (Entity (Choice))
then
Lo := Type_Low_Bound (Etype (Choice));
@@ -4217,7 +4217,7 @@ package body Exp_Aggr is
Comp : Node_Id;
Decl : Node_Id;
Typ : constant Entity_Id := Etype (N);
- Indices : constant List_Id := New_List;
+ Indexes : constant List_Id := New_List;
Num : Int;
Sub_Agg : Node_Id;
@@ -4239,7 +4239,7 @@ package body Exp_Aggr is
Next (Comp);
end loop;
- Append_To (Indices,
+ Append_To (Indexes,
Make_Range (Loc,
Low_Bound => Make_Integer_Literal (Loc, 1),
High_Bound => Make_Integer_Literal (Loc, Num)));
@@ -4255,7 +4255,7 @@ package body Exp_Aggr is
Make_Range (Loc,
Low_Bound => Aggr_Low (D),
High_Bound => Aggr_High (D)),
- Indices);
+ Indexes);
end loop;
end if;
@@ -4264,10 +4264,10 @@ package body Exp_Aggr is
Defining_Identifier => Agg_Type,
Type_Definition =>
Make_Constrained_Array_Definition (Loc,
- Discrete_Subtype_Definitions => Indices,
- Component_Definition =>
+ Discrete_Subtype_Definitions => Indexes,
+ Component_Definition =>
Make_Component_Definition (Loc,
- Aliased_Present => False,
+ Aliased_Present => False,
Subtype_Indication =>
New_Occurrence_Of (Component_Type (Typ), Loc))));
@@ -4940,6 +4940,41 @@ package body Exp_Aggr is
-------------------------
function Safe_Left_Hand_Side (N : Node_Id) return Boolean is
+ function Is_Safe_Index (Indx : Node_Id) return Boolean;
+ -- If the left-hand side includes an indexed component, check that
+ -- the indexes are free of side-effect.
+
+ -------------------
+ -- Is_Safe_Index --
+ -------------------
+
+ function Is_Safe_Index (Indx : Node_Id) return Boolean is
+ begin
+ if Is_Entity_Name (Indx) then
+ return True;
+
+ elsif Nkind (Indx) = N_Integer_Literal then
+ return True;
+
+ elsif Nkind (Indx) = N_Function_Call
+ and then Is_Entity_Name (Name (Indx))
+ and then
+ Has_Pragma_Pure_Function (Entity (Name (Indx)))
+ then
+ return True;
+
+ elsif Nkind (Indx) = N_Type_Conversion
+ and then Is_Safe_Index (Expression (Indx))
+ then
+ return True;
+
+ else
+ return False;
+ end if;
+ end Is_Safe_Index;
+
+ -- Start of processing for Safe_Left_Hand_Side
+
begin
if Is_Entity_Name (N) then
return True;
@@ -4952,10 +4987,13 @@ package body Exp_Aggr is
elsif Nkind (N) = N_Indexed_Component
and then Safe_Left_Hand_Side (Prefix (N))
and then
- (Is_Entity_Name (First (Expressions (N)))
- or else Nkind (First (Expressions (N))) = N_Integer_Literal)
+ Is_Safe_Index (First (Expressions (N)))
then
return True;
+
+ elsif Nkind (N) = N_Unchecked_Type_Conversion then
+ return Safe_Left_Hand_Side (Expression (N));
+
else
return False;
end if;
@@ -6101,7 +6139,7 @@ package body Exp_Aggr is
Index => First_Index (Typ),
Into => Target,
Scalar_Comp => Is_Scalar_Type (Component_Type (Typ)),
- Indices => No_List,
+ Indexes => No_List,
Flist => Flist);
end if;
end Late_Expansion;
Index: exp_ch3.adb
===================================================================
--- exp_ch3.adb (revision 165755)
+++ exp_ch3.adb (working copy)
@@ -5858,6 +5858,11 @@ package body Exp_Ch3 is
Set_TSS (Typ, Fent);
Set_Is_Pure (Fent);
+ -- The Pure flag will be reset is the current context is not pure.
+ -- For optimization purposes and constant-folding, indicate that the
+ -- Rep_To_Pos function can be considered free of side effects.
+
+ Set_Has_Pragma_Pure_Function (Fent);
if not Debug_Generated_Code then
Set_Debug_Info_Off (Fent);
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Ada] Optimization of array aggregates
2010-10-21 10:24 [Ada] Optimization of array aggregates Arnaud Charlet
@ 2010-10-21 11:44 ` Duncan Sands
2010-10-21 13:20 ` Robert Dewar
0 siblings, 1 reply; 4+ messages in thread
From: Duncan Sands @ 2010-10-21 11:44 UTC (permalink / raw)
To: gcc-patches
Hi Arnaud,
> + -- The Pure flag will be reset is the current context is not pure.
is the current context -> if the current context
> + -- For optimization purposes and constant-folding, indicate that the
> + -- Rep_To_Pos function can be considered free of side effects.
Ciao,
Duncan.
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Ada] Optimization of array aggregates
2010-10-21 11:44 ` Duncan Sands
@ 2010-10-21 13:20 ` Robert Dewar
0 siblings, 0 replies; 4+ messages in thread
From: Robert Dewar @ 2010-10-21 13:20 UTC (permalink / raw)
To: Duncan Sands; +Cc: gcc-patches
On 10/21/2010 7:12 AM, Duncan Sands wrote:
> Hi Arnaud,
>
>> + -- The Pure flag will be reset is the current context is not pure.
>
> is the current context -> if the current context
>
>> + -- For optimization purposes and constant-folding, indicate that the
>> + -- Rep_To_Pos function can be considered free of side effects.
>
>
> Ciao,
>
> Duncan.
thanks for note, I actually did a bit more extensive surgery on
the comments in that area, we will check in patch later.
^ permalink raw reply [flat|nested] 4+ messages in thread
* [Ada] Optimization of array aggregates
@ 2010-10-07 13:07 Arnaud Charlet
0 siblings, 0 replies; 4+ messages in thread
From: Arnaud Charlet @ 2010-10-07 13:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Ed Schonberg
[-- Attachment #1: Type: text/plain, Size: 1185 bytes --]
This patch recognizes additional cases of aggregates in assignment statements
that can be built in place and do not require the creation of temporaries.
This optimization prevents stack overflows. The patch covers aggregates for
arrays of arrays and multidimensional arrays whose components are static and
where the target of the assignment is a selected component or an indexed
component that is side-effect free.
Given the following:
with ess; use ess;
procedure P is
begin
This_Ptr.Data_Pool := (others => (others => 0));
for I in 1 .. 5 loop
for J in Data_Buffer_Type'range loop
This_Ptr.Data_Pool (I) (J) := 0;
end loop;
end loop;
This_Ptr.all := Empty_R;
end P;
Compiling p.adb with stack usage:
gcc -S -gnatp -O2 -fstack-usage p.adb
Must produce a file p.su containing:
p.adb:6:1:P 32 static
Tested on x86_64-pc-linux-gnu, committed on trunk
2010-10-07 Ed Schonberg <schonberg@adacore.com>
* exp_aggr.adb (Expand_Array_Aggregate): Recognize additional cases
where an aggregate in an assignment can be built directly into the
target, and does not require the creation of a temporary that may
overflow the stack.
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 3505 bytes --]
Index: exp_aggr.adb
===================================================================
--- exp_aggr.adb (revision 165080)
+++ exp_aggr.adb (working copy)
@@ -3768,12 +3768,13 @@ package body Exp_Aggr is
then
Expr := First (Component_Associations (N));
while Present (Expr) loop
- if Nkind (Expression (Expr)) = N_Integer_Literal then
+ if Nkind_In (Expression (Expr), N_Integer_Literal,
+ N_Real_Literal)
+ then
null;
elsif Nkind (Expression (Expr)) /= N_Aggregate
- or else
- not Compile_Time_Known_Aggregate (Expression (Expr))
+ or else not Compile_Time_Known_Aggregate (Expression (Expr))
or else Expansion_Delayed (Expression (Expr))
then
Static_Components := False;
@@ -4194,6 +4195,11 @@ package body Exp_Aggr is
-- Sub_Aggr is an array sub-aggregate. Dim is the dimension
-- corresponding to the sub-aggregate.
+ function Safe_Left_Hand_Side (N : Node_Id) return Boolean;
+ -- In addition to Maybe_In_Place_OK, in order for an aggregate to be
+ -- built directly into the target of the assignment it must be free
+ -- of side-effects.
+
----------------------------
-- Build_Constrained_Type --
----------------------------
@@ -4922,7 +4928,33 @@ package body Exp_Aggr is
end if;
end Others_Check;
- -- Remaining Expand_Array_Aggregate variables
+ -------------------------
+ -- Safe_Left_Hand_Side --
+ -------------------------
+
+ function Safe_Left_Hand_Side (N : Node_Id) return Boolean is
+ begin
+ if Is_Entity_Name (N) then
+ return True;
+
+ elsif Nkind_In (N, N_Explicit_Dereference, N_Selected_Component)
+ and then Safe_Left_Hand_Side (Prefix (N))
+ then
+ return True;
+
+ elsif Nkind (N) = N_Indexed_Component
+ and then Safe_Left_Hand_Side (Prefix (N))
+ and then
+ (Is_Entity_Name (First (Expressions (N)))
+ or else Nkind (First (Expressions (N))) = N_Integer_Literal)
+ then
+ return True;
+ else
+ return False;
+ end if;
+ end Safe_Left_Hand_Side;
+
+ -- Local variables
Tmp : Entity_Id;
-- Holds the temporary aggregate value
@@ -5230,9 +5262,9 @@ package body Exp_Aggr is
-- In the remaining cases the aggregate is the RHS of an assignment
elsif Maybe_In_Place_OK
- and then Is_Entity_Name (Name (Parent (N)))
+ and then Safe_Left_Hand_Side (Name (Parent (N)))
then
- Tmp := Entity (Name (Parent (N)));
+ Tmp := Name (Parent (N));
if Etype (Tmp) /= Etype (N) then
Apply_Length_Check (N, Etype (Tmp));
@@ -5246,16 +5278,6 @@ package body Exp_Aggr is
end if;
elsif Maybe_In_Place_OK
- and then Nkind (Name (Parent (N))) = N_Explicit_Dereference
- and then Is_Entity_Name (Prefix (Name (Parent (N))))
- then
- Tmp := Name (Parent (N));
-
- if Etype (Tmp) /= Etype (N) then
- Apply_Length_Check (N, Etype (Tmp));
- end if;
-
- elsif Maybe_In_Place_OK
and then Nkind (Name (Parent (N))) = N_Slice
and then Safe_Slice_Assignment (N)
then
^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2010-10-21 12:52 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2010-10-21 10:24 [Ada] Optimization of array aggregates Arnaud Charlet
2010-10-21 11:44 ` Duncan Sands
2010-10-21 13:20 ` Robert Dewar
-- strict thread matches above, loose matches on Subject: below --
2010-10-07 13:07 Arnaud Charlet
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).