[Ada] Inlining calls that return unconstrained arrays
Arnaud Charlet
charlet@adacore.com
Tue Sep 6 09:18:00 GMT 2011
This patch fixes a crash in the compiler when inlining a function call that
returns an unconstrained array in the context of an assignment created for an
extended return statement. The patch also optimizes the case where the target
of the assignment is a selected component, and avoid the use of an intermediate
temporary in the expansion.
The following must compile quietly:
with Types; use Types;
package body My_Simulink_Model is
procedure Compute (Input : Input_Type;
Output : out Output_Type) is
begin
Output.O := Sum (Input.M1, Input.M2);
end Compute;
procedure Compute_Ext_Return (Input : Input_Type;
Output : out Output_Type) is
begin
Output.O := Sum_Ext_Return (Input.M1, Input.M2);
end Compute_Ext_Return;
procedure Compute_Inline (Input : Input_Type;
Output : out Output_Type) is
begin
for I in Output.O'Range (1) loop
for J in Output.O'Range (2) loop
Output.O (I, J) := Input.M1 (I, J) + Input.M2 (I, J);
end loop;
end loop;
end Compute_Inline;
end My_Simulink_Model;
---
with Types;
package My_Simulink_Model is
subtype Range_1 is Integer range 1 .. 2;
subtype Range_2 is Integer range 1 .. 3;
subtype My_Matrix is Types.Integer_Matrix_2D
(Range_1, Range_2);
type Input_Type is record
M1 : My_Matrix;
M2 : My_Matrix;
end record;
type Output_Type is record
O : My_Matrix;
end record;
procedure Compute (Input : Input_Type;
Output : out Output_Type);
procedure Compute_Ext_Return (Input : Input_Type;
Output : out Output_Type);
procedure Compute_Inline (Input : Input_Type;
Output : out Output_Type);
end My_Simulink_Model;
---
package Types is
type Integer_Matrix_2D is array (Integer range <>, Integer range <>)
of Integer;
function Sum (Left, Right : Integer_Matrix_2D) return Integer_Matrix_2D;
pragma Precondition (Left'Length (1) = Right'Length (1)
and Left'Length (2) = Right'Length (2));
pragma Inline_Always (Sum);
function Sum_Ext_Return (Left, Right : Integer_Matrix_2D)
return Integer_Matrix_2D;
pragma Precondition (Left'Length (1) = Right'Length (1)
and Left'Length (2) = Right'Length (2));
pragma Inline_Always (Sum_Ext_Return);
end Types;
---
package body Types is
function Sum (Left, Right : Integer_Matrix_2D) return Integer_Matrix_2D is
Res : Integer_Matrix_2D (Left'Range (1), Left'Range (2));
begin
for I in Res'Range (1) loop
for J in Res'Range (2) loop
Res (I, J) := Left (I, J) + Right (I, J);
end loop;
end loop;
return Res;
end Sum;
function Sum_Ext_Return
(Left, Right : Integer_Matrix_2D)
return Integer_Matrix_2D
is
begin
return Res : Integer_Matrix_2D (Left'Range (1), Left'Range (2)) do
for I in Res'Range (1) loop
for J in Res'Range (2) loop
Res (I, J) := Left (I, J) + Right (I, J);
end loop;
end loop;
end return;
end Sum_Ext_Return;
end Types;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-09-06 Ed Schonberg <schonberg@adacore.com>
* exp_ch6.adb (Expand_Inlined_Call): Handle properly the case
where the return type is an unconstrained array and the context
is an assignment. Optimize the case when the target of the
assignment is a selected component.
-------------- next part --------------
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb (revision 178572)
+++ exp_ch6.adb (working copy)
@@ -4031,12 +4031,20 @@
Insert_After (Parent (Entity (N)), Blk);
+ -- If the context is an assignment, and the left-hand side is
+ -- free of side-effects, the replacement is also safe.
+ -- Can this be generalized further???
+
elsif Nkind (Parent (N)) = N_Assignment_Statement
and then
(Is_Entity_Name (Name (Parent (N)))
or else
(Nkind (Name (Parent (N))) = N_Explicit_Dereference
- and then Is_Entity_Name (Prefix (Name (Parent (N))))))
+ and then Is_Entity_Name (Prefix (Name (Parent (N)))))
+
+ or else
+ (Nkind (Name (Parent (N))) = N_Selected_Component
+ and then Is_Entity_Name (Prefix (Name (Parent (N))))))
then
-- Replace assignment with the block
@@ -4201,14 +4209,19 @@
Set_Declarations (Blk, New_List);
end if;
- -- For the unconstrained case, capture the name of the local
- -- variable that holds the result. This must be the first declaration
+ -- For the unconstrained case, capture the name of the local variable
+ -- that holds the result. This must be the first declaration
-- in the block, because its bounds cannot depend on local variables.
-- Otherwise there is no way to declare the result outside of the
-- block. Needless to say, in general the bounds will depend on the
-- actuals in the call.
+ -- If the context is an assignment statement, as is the case for the
+ -- expansion of an extended return, the left-hand side provides bounds
+ -- even if the return type is unconstrained.
- if Is_Unc then
+ if Is_Unc
+ and then Nkind (Parent (N)) /= N_Assignment_Statement
+ then
Targ1 := Defining_Identifier (First (Declarations (Blk)));
end if;
@@ -4372,6 +4385,12 @@
then
Targ := Name (Parent (N));
+ elsif Nkind (Parent (N)) = N_Assignment_Statement
+ and then Nkind (Name (Parent (N))) = N_Selected_Component
+ and then Is_Entity_Name (Prefix (Name (Parent (N))))
+ then
+ Targ := New_Copy_Tree (Name (Parent (N)));
+
elsif Nkind (Parent (N)) = N_Object_Declaration
and then Is_Limited_Type (Etype (Subp))
then
@@ -4388,7 +4407,9 @@
-- eventually be possible to remove that temporary and use the
-- result variable directly.
- if Is_Unc then
+ if Is_Unc
+ and then Nkind (Parent (N)) /= N_Assignment_Statement
+ then
Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Temp,
More information about the Gcc-patches
mailing list