trans.c (gnat_gimplify_expr): Gimplify the SAVE_EXPR built for misaligned arguments.
* gcc-interface/trans.c (gnat_gimplify_expr) <ADDR_EXPR>: Gimplify the SAVE_EXPR built for misaligned arguments. Remove redundant stuff. (addressable_p): Return true for more rvalues. Co-Authored-By: Olivier Hainque <hainque@adacore.com> From-SVN: r151319
This commit is contained in:
parent
c68e4eede1
commit
42c089971e
7 changed files with 95 additions and 41 deletions
|
@ -1,3 +1,9 @@
|
|||
2009-09-02 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gcc-interface/trans.c (gnat_gimplify_expr) <ADDR_EXPR>: Gimplify the
|
||||
SAVE_EXPR built for misaligned arguments. Remove redundant stuff.
|
||||
(addressable_p): Return true for more rvalues.
|
||||
|
||||
2009-09-01 Jakub Jelinek <jakub@redhat.com>
|
||||
|
||||
* gcc-interface/utils2.c (maybe_wrap_malloc, maybe_wrap_free): Cast
|
||||
|
|
|
@ -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)
|
||||
/* 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_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)
|
||||
{
|
||||
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:
|
||||
|
|
|
@ -1,3 +1,10 @@
|
|||
2009-09-02 Eric Botcazou <ebotcazou@adacore.com>
|
||||
Olivier Hainque <hainque@adacore.com>
|
||||
|
||||
* 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 <aoliva@redhat.com>
|
||||
|
||||
* gcc.dg/guality/guality.c: Expect to fail for now.
|
||||
|
|
30
gcc/testsuite/gnat.dg/misaligned_param.adb
Normal file
30
gcc/testsuite/gnat.dg/misaligned_param.adb
Normal file
|
@ -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;
|
14
gcc/testsuite/gnat.dg/misaligned_param_pkg.adb
Normal file
14
gcc/testsuite/gnat.dg/misaligned_param_pkg.adb
Normal file
|
@ -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;
|
5
gcc/testsuite/gnat.dg/misaligned_param_pkg.ads
Normal file
5
gcc/testsuite/gnat.dg/misaligned_param_pkg.ads
Normal file
|
@ -0,0 +1,5 @@
|
|||
package Misaligned_Param_Pkg is
|
||||
|
||||
pragma Elaborate_Body (Misaligned_Param_Pkg);
|
||||
|
||||
end Misaligned_Param_Pkg;
|
|
@ -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));
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue