From: Eric Botcazou Date: Wed, 2 Sep 2009 10:43:10 +0000 (+0000) Subject: trans.c (gnat_gimplify_expr): Gimplify the SAVE_EXPR built for misaligned arguments. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=42c089971e4987c1fc1338d7ff659f2be9c9b7e5;p=gcc.git trans.c (gnat_gimplify_expr): Gimplify the SAVE_EXPR built for misaligned arguments. * gcc-interface/trans.c (gnat_gimplify_expr) : Gimplify the SAVE_EXPR built for misaligned arguments. Remove redundant stuff. (addressable_p): Return true for more rvalues. Co-Authored-By: Olivier Hainque From-SVN: r151319 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 49d372cb4b5..a37d1c06ce5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2009-09-02 Eric Botcazou + + * gcc-interface/trans.c (gnat_gimplify_expr) : Gimplify the + SAVE_EXPR built for misaligned arguments. Remove redundant stuff. + (addressable_p): Return true for more rvalues. + 2009-09-01 Jakub Jelinek * gcc-interface/utils2.c (maybe_wrap_malloc, maybe_wrap_free): Cast diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 7333f8c7b4b..29ab72a365f 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -5794,17 +5794,17 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p, case ADDR_EXPR: op = TREE_OPERAND (expr, 0); - /* If we're taking the address of a constant CONSTRUCTOR, force it to + /* If we are taking the address of a constant CONSTRUCTOR, force it to be put into static memory. We know it's going to be readonly given - the semantics we have and it's required to be static memory in - the case when the reference is in an elaboration procedure. */ + the semantics we have and it's required to be in static memory when + the reference is in an elaboration procedure. */ if (TREE_CODE (op) == CONSTRUCTOR && TREE_CONSTANT (op)) { tree new_var = create_tmp_var (TREE_TYPE (op), "C"); + TREE_ADDRESSABLE (new_var) = 1; TREE_READONLY (new_var) = 1; TREE_STATIC (new_var) = 1; - TREE_ADDRESSABLE (new_var) = 1; DECL_INITIAL (new_var) = op; TREE_OPERAND (expr, 0) = new_var; @@ -5812,44 +5812,28 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p, return GS_ALL_DONE; } - /* If we are taking the address of a SAVE_EXPR, we are typically - processing a misaligned argument to be passed by reference in a - procedure call. We just mark the operand as addressable + not - readonly here and let the common gimplifier code perform the - temporary creation, initialization, and "instantiation" in place of - the SAVE_EXPR in further operands, in particular in the copy back - code inserted after the call. */ - else if (TREE_CODE (op) == SAVE_EXPR) - { - TREE_ADDRESSABLE (op) = 1; - TREE_READONLY (op) = 0; - } - - /* We let the gimplifier process &COND_EXPR and expect it to yield the - address of the selected operand when it is addressable. Besides, we - also expect addressable_p to only let COND_EXPRs where both arms are - addressable reach here. */ - else if (TREE_CODE (op) == COND_EXPR) - ; - - /* Otherwise, if we are taking the address of something that is neither - reference, declaration, or constant, make a variable for the operand - here and then take its address. If we don't do it this way, we may - confuse the gimplifier because it needs to know the variable is - addressable at this point. This duplicates code in - internal_get_tmp_var, which is unfortunate. */ - else if (TREE_CODE_CLASS (TREE_CODE (op)) != tcc_reference - && TREE_CODE_CLASS (TREE_CODE (op)) != tcc_declaration - && TREE_CODE_CLASS (TREE_CODE (op)) != tcc_constant) + /* If we are taking the address of a SAVE_EXPR, we are typically dealing + with a misaligned argument to be passed by reference in a subprogram + call. We cannot let the common gimplifier code perform the creation + of the temporary and its initialization because, in order to ensure + that the final copy operation is a store and since the temporary made + for a SAVE_EXPR is not addressable, it may create another temporary, + addressable this time, which would break the back copy mechanism for + an IN OUT parameter. */ + if (TREE_CODE (op) == SAVE_EXPR && !SAVE_EXPR_RESOLVED_P (op)) { - tree new_var = create_tmp_var (TREE_TYPE (op), "A"); - gimple stmt; - + tree mod, val = TREE_OPERAND (op, 0); + tree new_var = create_tmp_var (TREE_TYPE (op), "S"); TREE_ADDRESSABLE (new_var) = 1; - stmt = gimplify_assign (new_var, op, pre_p); - if (EXPR_HAS_LOCATION (op)) - gimple_set_location (stmt, EXPR_LOCATION (op)); + mod = build2 (INIT_EXPR, TREE_TYPE (new_var), new_var, val); + if (EXPR_HAS_LOCATION (val)) + SET_EXPR_LOCATION (mod, EXPR_LOCATION (val)); + gimplify_and_add (mod, pre_p); + ggc_free (mod); + + TREE_OPERAND (op, 0) = new_var; + SAVE_EXPR_RESOLVED_P (op) = 1; TREE_OPERAND (expr, 0) = new_var; recompute_tree_invariant_for_addr_expr (expr); @@ -5866,7 +5850,7 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p, if ((TREE_CODE (op) == TYPE_DECL || TREE_CODE (op) == VAR_DECL) && !TYPE_SIZES_GIMPLIFIED (TREE_TYPE (op))) switch (TREE_CODE (TREE_TYPE (op))) - { + { case INTEGER_TYPE: case ENUMERAL_TYPE: case BOOLEAN_TYPE: @@ -5895,7 +5879,7 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p, default: break; - } + } /* ... fall through ... */ @@ -6942,12 +6926,18 @@ addressable_p (tree gnu_expr, tree gnu_type) case UNCONSTRAINED_ARRAY_REF: case INDIRECT_REF: + return true; + case CONSTRUCTOR: case STRING_CST: case INTEGER_CST: case NULL_EXPR: case SAVE_EXPR: case CALL_EXPR: + case PLUS_EXPR: + case MINUS_EXPR: + /* All rvalues are deemed addressable since taking their address will + force a temporary to be created by the middle-end. */ return true; case COND_EXPR: diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e86840c2915..1d1679002f7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2009-09-02 Eric Botcazou + Olivier Hainque + + * gnat.dg/misaligned_param.adb: New test. + * gnat.dg/misaligned_param_pkg.ad[sb]: New helper. + * gnat.dg/slice7.adb: Add 1 more related case. + 2009-09-01 Alexandre Oliva * gcc.dg/guality/guality.c: Expect to fail for now. diff --git a/gcc/testsuite/gnat.dg/misaligned_param.adb b/gcc/testsuite/gnat.dg/misaligned_param.adb new file mode 100644 index 00000000000..dd591d06a83 --- /dev/null +++ b/gcc/testsuite/gnat.dg/misaligned_param.adb @@ -0,0 +1,30 @@ +-- { dg-do run } +-- { dg-options "-gnatws" } + +with Misaligned_Param_Pkg; + +procedure Misaligned_Param is + + procedure Channel_Eth (Status : out Integer; Kind : out Integer); + + pragma Import (External, Channel_Eth); + pragma Import_Valued_Procedure + (Channel_Eth, "channel_eth", (Integer, Integer), (VALUE, REFERENCE)); + + type Channel is record + B : Boolean; + Kind : Integer; + end record; + pragma Pack (Channel); + + MyChan : Channel; + Status : Integer; + +begin + MyChan.Kind := 0; + Channel_Eth (Status => Status, Kind => MyChan.Kind); + + if Mychan.Kind = 0 then + raise Program_Error; + end if; +end; diff --git a/gcc/testsuite/gnat.dg/misaligned_param_pkg.adb b/gcc/testsuite/gnat.dg/misaligned_param_pkg.adb new file mode 100644 index 00000000000..888ed18c3ae --- /dev/null +++ b/gcc/testsuite/gnat.dg/misaligned_param_pkg.adb @@ -0,0 +1,14 @@ +package body Misaligned_Param_Pkg is + + type IP is access all Integer; + + function Channel_Eth (Kind : IP) return Integer; + pragma Export (Ada, Channel_Eth, "channel_eth"); + + function Channel_Eth (Kind : IP) return Integer is + begin + Kind.all := 111; + return 0; + end; + +end Misaligned_Param_Pkg; diff --git a/gcc/testsuite/gnat.dg/misaligned_param_pkg.ads b/gcc/testsuite/gnat.dg/misaligned_param_pkg.ads new file mode 100644 index 00000000000..7934c3f343e --- /dev/null +++ b/gcc/testsuite/gnat.dg/misaligned_param_pkg.ads @@ -0,0 +1,5 @@ +package Misaligned_Param_Pkg is + + pragma Elaborate_Body (Misaligned_Param_Pkg); + +end Misaligned_Param_Pkg; diff --git a/gcc/testsuite/gnat.dg/slice7.adb b/gcc/testsuite/gnat.dg/slice7.adb index 3f0d3f5b3fc..bb68c1f0f17 100644 --- a/gcc/testsuite/gnat.dg/slice7.adb +++ b/gcc/testsuite/gnat.dg/slice7.adb @@ -27,6 +27,8 @@ procedure Slice7 is Obj : Discrete_Type; begin + Put (Convert_Put(Discrete_Type'Pos (Obj))); + Put (Convert_Put(Discrete_Type'Pos (Obj)) (Buffer_Start..Buffer_End));