trans.c (Call_to_gnu): For an Out parameter passed by copy and that don't need to be copied in...

* gcc-interface/trans.c (Call_to_gnu): For an Out parameter passed by
	copy and that don't need to be  copied in, only evaluate its address.

From-SVN: r204943
This commit is contained in:
Eric Botcazou 2013-11-18 10:09:10 +00:00 committed by Eric Botcazou
parent 9adcf5b40a
commit 96540b24aa
6 changed files with 108 additions and 5 deletions

View File

@ -1,3 +1,8 @@
2013-11-18 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (Call_to_gnu): For an Out parameter passed by
copy and that don't need to be copied in, only evaluate its address.
2013-11-18 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Deal with an

View File

@ -4130,9 +4130,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
gnu_name
= convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_name))), gnu_name);
/* If we have not saved a GCC object for the formal, it means it is an
Out parameter not passed by reference and that need not be copied in.
Otherwise, first see if the parameter is passed by reference. */
/* First see if the parameter is passed by reference. */
if (is_true_formal_parm && DECL_BY_REF_P (gnu_formal))
{
if (Ekind (gnat_formal) != E_In_Parameter)
@ -4178,6 +4176,9 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
gnu_formal_type = TREE_TYPE (gnu_formal);
gnu_actual = build_unary_op (ADDR_EXPR, gnu_formal_type, gnu_actual);
}
/* Then see if the parameter is an array passed to a foreign convention
subprogram. */
else if (is_true_formal_parm && DECL_BY_COMPONENT_PTR_P (gnu_formal))
{
gnu_formal_type = TREE_TYPE (gnu_formal);
@ -4198,6 +4199,8 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
but this is the most likely to work in all cases. */
gnu_actual = build_unary_op (ADDR_EXPR, gnu_formal_type, gnu_actual);
}
/* Then see if the parameter is passed by descriptor. */
else if (is_true_formal_parm && DECL_BY_DESCRIPTOR_P (gnu_formal))
{
gnu_actual = convert (gnu_formal_type, gnu_actual);
@ -4214,6 +4217,8 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
(TREE_TYPE (TREE_TYPE (gnu_formal)),
gnu_actual, gnat_actual));
}
/* Otherwise the parameter is passed by copy. */
else
{
tree gnu_size;
@ -4221,11 +4226,18 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
if (Ekind (gnat_formal) != E_In_Parameter)
gnu_name_list = tree_cons (NULL_TREE, gnu_name, gnu_name_list);
/* If we didn't create a PARM_DECL for the formal, this means that
it is an Out parameter not passed by reference and that need not
be copied in. In this case, the value of the actual need not be
read. However, we still need to make sure that its side-effects
are evaluated before the call, so we evaluate its address. */
if (!is_true_formal_parm)
{
/* Make sure side-effects are evaluated before the call. */
if (TREE_SIDE_EFFECTS (gnu_name))
append_to_statement_list (gnu_name, &gnu_stmt_list);
{
tree addr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_name);
append_to_statement_list (addr, &gnu_stmt_list);
}
continue;
}

View File

@ -1,3 +1,8 @@
2013-11-18 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/volatile11.adb: New test.
* gnat.dg/volatile11_pkg.ad[sb]: New helper.
2013-11-18 Yury Gribov <y.gribov@samsung.com>
PR sanitizer/59106

View File

@ -0,0 +1,41 @@
-- { dg-do run }
-- { dg-options "-O -gnatp" }
with Volatile11_Pkg; use Volatile11_Pkg;
procedure Volatile11 is
Value : Integer := 1;
Bit1 : Boolean := false;
pragma Volatile (Bit1);
Bit2 : Boolean := false;
pragma Volatile (Bit2);
Bit3 : Boolean := false;
pragma Volatile (Bit3);
Bit4 : Boolean := false;
pragma Volatile (Bit4);
Bit5 : Boolean := false;
pragma Volatile (Bit5);
Bit6 : Boolean := false;
pragma Volatile (Bit6);
Bit7 : Boolean := false;
pragma Volatile (Bit7);
Bit8 : Boolean := false;
pragma Volatile (Bit8);
begin
Bit_Test(Input => Value,
Output1 => Bit1,
Output2 => Bit2,
Output3 => Bit3,
Output4 => Bit4,
Output5 => Bit5,
Output6 => Bit6,
Output7 => Bit7,
Output8 => F.all);
-- Check that F is invoked before Bit_Test
if B /= True then
raise Program_Error;
end if;
end;

View File

@ -0,0 +1,25 @@
package body Volatile11_Pkg is
procedure Bit_Test(Input : in Integer;
Output1 : out Boolean; Output2 : out Boolean;
Output3 : out Boolean; Output4 : out Boolean;
Output5 : out Boolean; Output6 : out Boolean;
Output7 : out Boolean; Output8 : out Boolean) is
begin
Output8 := B;
Output7 := Input = 7;
Output6 := Input = 6;
Output5 := Input = 5;
Output4 := Input = 4;
Output3 := Input = 3;
Output2 := Input = 2;
Output1 := Input = 1;
end Bit_Test;
function F return Ptr is
begin
B := True;
return B'Access;
end;
end Volatile11_Pkg;

View File

@ -0,0 +1,15 @@
package Volatile11_Pkg is
procedure Bit_Test(Input : in Integer;
Output1 : out Boolean; Output2 : out Boolean;
Output3 : out Boolean; Output4 : out Boolean;
Output5 : out Boolean; Output6 : out Boolean;
Output7 : out Boolean; Output8 : out Boolean);
type Ptr is access all Boolean;
B : aliased Boolean := False;
function F return Ptr;
end Volatile11_Pkg;