From 96540b24aa7048d4044d66e8a4225f769a72d65e Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 18 Nov 2013 10:09:10 +0000 Subject: [PATCH] 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 --- gcc/ada/ChangeLog | 5 ++++ gcc/ada/gcc-interface/trans.c | 22 +++++++++++++---- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gnat.dg/volatile11.adb | 41 ++++++++++++++++++++++++++++++++ gcc/testsuite/gnat.dg/volatile11_pkg.adb | 25 +++++++++++++++++++ gcc/testsuite/gnat.dg/volatile11_pkg.ads | 15 ++++++++++++ 6 files changed, 108 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/volatile11.adb create mode 100644 gcc/testsuite/gnat.dg/volatile11_pkg.adb create mode 100644 gcc/testsuite/gnat.dg/volatile11_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 86000b1..411eac6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2013-11-18 Eric Botcazou + * 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 + * gcc-interface/decl.c (gnat_to_gnu_entity) : Deal with an error mark as renamed object in type annotating mode. diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index b6a8be8..cbfb7e7 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -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; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 6092d9f..e5e9ecb 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2013-11-18 Eric Botcazou + + * gnat.dg/volatile11.adb: New test. + * gnat.dg/volatile11_pkg.ad[sb]: New helper. + 2013-11-18 Yury Gribov PR sanitizer/59106 diff --git a/gcc/testsuite/gnat.dg/volatile11.adb b/gcc/testsuite/gnat.dg/volatile11.adb new file mode 100644 index 0000000..54031d9 --- /dev/null +++ b/gcc/testsuite/gnat.dg/volatile11.adb @@ -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; diff --git a/gcc/testsuite/gnat.dg/volatile11_pkg.adb b/gcc/testsuite/gnat.dg/volatile11_pkg.adb new file mode 100644 index 0000000..f824840 --- /dev/null +++ b/gcc/testsuite/gnat.dg/volatile11_pkg.adb @@ -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; diff --git a/gcc/testsuite/gnat.dg/volatile11_pkg.ads b/gcc/testsuite/gnat.dg/volatile11_pkg.ads new file mode 100644 index 0000000..af6822d --- /dev/null +++ b/gcc/testsuite/gnat.dg/volatile11_pkg.ads @@ -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; -- 2.7.4