This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Fix misaligned In argument passing
- From: Eric Botcazou <ebotcazou at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Sun, 23 Dec 2007 00:07:59 +0100
- Subject: [Ada] Fix misaligned In argument passing
In Ada, a pragma Pack applied to an aggregate type causes it to be bit-packed
(instead of only byte-packed in C) and this aggregate type can contain fields
whose type is also an aggregate type.
When such misaligned fields are passed to functions, depending on the ABI, an
address can be requested and, in this case, the compiler has no other choice
than making a temporary.
This was working fine for Out and In/Out parameters but not for In parameters.
Fixed by extending the existing code to this latter case.
Bootstrapped/regtested on i586-suse-linux, applied on the mainline.
2007-12-23 Eric Botcazou <ebotcazou@adacore.com>
* trans.c (call_to_gnu): Make the temporary for non-addressable
IN parameters passed by reference.
(addressable_p): Return true for STRING_CST and CALL_EXPR.
2007-12-23 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/pack2.adb: New test.
--
Eric Botcazou
Index: trans.c
===================================================================
--- trans.c (revision 131103)
+++ trans.c (working copy)
@@ -2089,80 +2089,77 @@ call_to_gnu (Node_Id gnat_node, tree *gn
tree gnu_actual;
/* If it's possible we may need to use this expression twice, make sure
- than any side-effects are handled via SAVE_EXPRs. Likewise if we need
+ that any side-effects are handled via SAVE_EXPRs. Likewise if we need
to force side-effects before the call.
??? This is more conservative than we need since we don't need to do
- this for pass-by-ref with no conversion. If we are passing a
- non-addressable Out or In Out parameter by reference, pass the address
- of a copy and set up to copy back out after the call. */
+ this for pass-by-ref with no conversion. */
if (Ekind (gnat_formal) != E_In_Parameter)
- {
- gnu_name = gnat_stabilize_reference (gnu_name, true);
+ gnu_name = gnat_stabilize_reference (gnu_name, true);
- if (!addressable_p (gnu_name)
- && gnu_formal
- && (DECL_BY_REF_P (gnu_formal)
- || (TREE_CODE (gnu_formal) == PARM_DECL
- && (DECL_BY_COMPONENT_PTR_P (gnu_formal)
- || (DECL_BY_DESCRIPTOR_P (gnu_formal))))))
- {
- tree gnu_copy = gnu_name;
- tree gnu_temp;
+ /* If we are passing a non-addressable parameter by reference, pass the
+ address of a copy. In the Out or In Out case, set up to copy back
+ out after the call. */
+ if (!addressable_p (gnu_name)
+ && gnu_formal
+ && (DECL_BY_REF_P (gnu_formal)
+ || (TREE_CODE (gnu_formal) == PARM_DECL
+ && (DECL_BY_COMPONENT_PTR_P (gnu_formal)
+ || (DECL_BY_DESCRIPTOR_P (gnu_formal))))))
+ {
+ tree gnu_copy = gnu_name, gnu_temp;
- /* If the type is by_reference, a copy is not allowed. */
- if (Is_By_Reference_Type (Etype (gnat_formal)))
- post_error
- ("misaligned & cannot be passed by reference", gnat_actual);
+ /* If the type is by_reference, a copy is not allowed. */
+ if (Is_By_Reference_Type (Etype (gnat_formal)))
+ post_error
+ ("misaligned & cannot be passed by reference", gnat_actual);
- /* For users of Starlet we issue a warning because the
- interface apparently assumes that by-ref parameters
- outlive the procedure invocation. The code still
- will not work as intended, but we cannot do much
- better since other low-level parts of the back-end
- would allocate temporaries at will because of the
- misalignment if we did not do so here. */
+ /* For users of Starlet we issue a warning because the
+ interface apparently assumes that by-ref parameters
+ outlive the procedure invocation. The code still
+ will not work as intended, but we cannot do much
+ better since other low-level parts of the back-end
+ would allocate temporaries at will because of the
+ misalignment if we did not do so here. */
+ else if (Is_Valued_Procedure (Entity (Name (gnat_node))))
+ {
+ post_error
+ ("?possible violation of implicit assumption", gnat_actual);
+ post_error_ne
+ ("?made by pragma Import_Valued_Procedure on &", gnat_actual,
+ Entity (Name (gnat_node)));
+ post_error_ne ("?because of misalignment of &", gnat_actual,
+ gnat_formal);
+ }
- else if (Is_Valued_Procedure (Entity (Name (gnat_node))))
- {
- post_error
- ("?possible violation of implicit assumption",
- gnat_actual);
- post_error_ne
- ("?made by pragma Import_Valued_Procedure on &",
- gnat_actual, Entity (Name (gnat_node)));
- post_error_ne
- ("?because of misalignment of &",
- gnat_actual, gnat_formal);
- }
+ /* Remove any unpadding on the actual and make a copy. But if
+ the actual is a justified modular type, first convert to it. */
+ if (TREE_CODE (gnu_name) == COMPONENT_REF
+ && ((TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_name, 0)))
+ == RECORD_TYPE)
+ && (TYPE_IS_PADDING_P
+ (TREE_TYPE (TREE_OPERAND (gnu_name, 0))))))
+ gnu_name = gnu_copy = TREE_OPERAND (gnu_name, 0);
+
+ else if (TREE_CODE (gnu_name_type) == RECORD_TYPE
+ && (TYPE_JUSTIFIED_MODULAR_P (gnu_name_type)))
+ gnu_name = convert (gnu_name_type, gnu_name);
+
+ /* Make a SAVE_EXPR to both properly account for potential side
+ effects and handle the creation of a temporary copy. Special
+ code in gnat_gimplify_expr ensures that the same temporary is
+ used as the actual and copied back after the call if needed. */
+ gnu_name = build1 (SAVE_EXPR, TREE_TYPE (gnu_name), gnu_name);
+ TREE_SIDE_EFFECTS (gnu_name) = 1;
+ TREE_INVARIANT (gnu_name) = 1;
- /* Remove any unpadding on the actual and make a copy. But if
- the actual is a justified modular type, first convert
- to it. */
- if (TREE_CODE (gnu_name) == COMPONENT_REF
- && ((TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_name, 0)))
- == RECORD_TYPE)
- && (TYPE_IS_PADDING_P
- (TREE_TYPE (TREE_OPERAND (gnu_name, 0))))))
- gnu_name = gnu_copy = TREE_OPERAND (gnu_name, 0);
- else if (TREE_CODE (gnu_name_type) == RECORD_TYPE
- && (TYPE_JUSTIFIED_MODULAR_P (gnu_name_type)))
- gnu_name = convert (gnu_name_type, gnu_name);
-
- /* Make a SAVE_EXPR to both properly account for potential side
- effects and handle the creation of a temporary copy. Special
- code in gnat_gimplify_expr ensures that the same temporary is
- used as the actual and copied back after the call. */
- gnu_actual = save_expr (gnu_name);
-
- /* Set up to move the copy back to the original. */
- gnu_temp = build_binary_op (MODIFY_EXPR, NULL_TREE,
- gnu_copy, gnu_actual);
+ /* Set up to move the copy back to the original. */
+ if (Ekind (gnat_formal) != E_In_Parameter)
+ {
+ gnu_temp = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_copy,
+ gnu_name);
set_expr_location_from_node (gnu_temp, gnat_actual);
append_to_statement_list (gnu_temp, &gnu_after_list);
-
- /* Account for next statement just below. */
- gnu_name = gnu_actual;
}
}
@@ -2222,7 +2219,8 @@ call_to_gnu (Node_Id gnat_node, tree *gn
copied in. Otherwise, look at the PARM_DECL to see if it is passed by
reference. */
if (gnu_formal
- && TREE_CODE (gnu_formal) == PARM_DECL && DECL_BY_REF_P (gnu_formal))
+ && TREE_CODE (gnu_formal) == PARM_DECL
+ && DECL_BY_REF_P (gnu_formal))
{
if (Ekind (gnat_formal) != E_In_Parameter)
{
@@ -2250,32 +2248,13 @@ call_to_gnu (Node_Id gnat_node, tree *gn
gnu_actual);
}
- /* Otherwise, if we have a non-addressable COMPONENT_REF of a
- variable-size type see if it's doing a unpadding operation. If
- so, remove that operation since we have no way of allocating the
- required temporary. */
- if (TREE_CODE (gnu_actual) == COMPONENT_REF
- && !TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_actual)))
- && (TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_actual, 0)))
- == RECORD_TYPE)
- && TYPE_IS_PADDING_P (TREE_TYPE
- (TREE_OPERAND (gnu_actual, 0)))
- && !addressable_p (gnu_actual))
- gnu_actual = TREE_OPERAND (gnu_actual, 0);
-
- /* For In parameters, gnu_actual might still not be addressable at
- this point and we need the creation of a temporary copy since
- this is to be passed by ref. Resorting to save_expr to force a
- SAVE_EXPR temporary creation here is not guaranteed to work
- because the actual might be invariant or readonly without side
- effects, so we let the gimplifier process this case. */
-
/* The symmetry of the paths to the type of an entity is broken here
since arguments don't know that they will be passed by ref. */
gnu_formal_type = TREE_TYPE (get_gnu_tree (gnat_formal));
gnu_actual = build_unary_op (ADDR_EXPR, gnu_formal_type, gnu_actual);
}
- else if (gnu_formal && TREE_CODE (gnu_formal) == PARM_DECL
+ else if (gnu_formal
+ && TREE_CODE (gnu_formal) == PARM_DECL
&& DECL_BY_COMPONENT_PTR_P (gnu_formal))
{
gnu_formal_type = TREE_TYPE (get_gnu_tree (gnat_formal));
@@ -2299,7 +2278,8 @@ call_to_gnu (Node_Id gnat_node, tree *gn
build_unary_op (ADDR_EXPR, NULL_TREE,
gnu_actual));
}
- else if (gnu_formal && TREE_CODE (gnu_formal) == PARM_DECL
+ else if (gnu_formal
+ && TREE_CODE (gnu_formal) == PARM_DECL
&& DECL_BY_DESCRIPTOR_P (gnu_formal))
{
/* If arg is 'Null_Parameter, pass zero descriptor. */
@@ -6077,8 +6057,10 @@ addressable_p (tree gnu_expr)
case UNCONSTRAINED_ARRAY_REF:
case INDIRECT_REF:
case CONSTRUCTOR:
+ case STRING_CST:
case NULL_EXPR:
case SAVE_EXPR:
+ case CALL_EXPR:
return true;
case COMPONENT_REF:
-- { dg-do compile }
-- { dg-options "-gnatws" }
procedure Pack2 is
type Bits_T is record
B0, B1, B2: Boolean;
end record;
type State_T is record
Valid : Boolean;
Value : Bits_T;
end record;
pragma Pack (State_T);
procedure Process (Bits : Bits_T) is begin null; end;
State : State_T;
begin
Process (State.Value);
end;