+2009-08-25 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gimplify.c (prepare_gimple_addressable): New static function.
+ (gimplify_modify_expr_to_memcpy): Invoke it on the RHS before marking
+ it addressable.
+ (gimplify_addr_expr): Invoke it similarly on the operand instead of
+ manually fiddling with it.
+
2009-08-25 Michael Matz <matz@suse.de>
* expr.h (jumpifnot_1, jumpif_1, do_jump_1): Declare.
+2009-08-25 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gcc-interface/trans.c (call_to_gnu): Tidy.
+ (gnat_to_gnu) <N_Slice>: Set TYPE_ARRAY_MAX_SIZE if the slice has
+ non-constant size but the array itself has constant size.
+ * gcc-interface/utils.c (convert_vms_descriptor64): Fix type
+ consistency error.
+ (convert_vms_descriptor32): Likewise.
+
2009-08-22 Aurelien Jarno <aurelien@aurel32.net>
* gcc-interface/Makefile.in: Add Ada support for
&& (gnu_name_type = gnat_to_gnu_type (Etype (gnat_name)))
&& !addressable_p (gnu_name, gnu_name_type))
{
- tree gnu_copy = gnu_name, gnu_temp;
+ tree gnu_copy = gnu_name;
/* If the type is by_reference, a copy is not allowed. */
if (Is_By_Reference_Type (Etype (gnat_formal)))
/* 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_node);
- append_to_statement_list (gnu_temp, &gnu_after_list);
+ tree stmt = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_copy,
+ gnu_name);
+ set_expr_location_from_node (stmt, gnat_node);
+ append_to_statement_list (stmt, &gnu_after_list);
}
}
case N_Slice:
{
- tree gnu_type;
Node_Id gnat_range_node = Discrete_Range (gnat_node);
+ tree gnu_type;
gnu_result = gnat_to_gnu (Prefix (gnat_node));
gnu_result_type = get_unpadded_type (Etype (gnat_node));
/* Simply return the naked low bound. */
gnu_expr = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_result_type));
+ /* If this is a slice with non-constant size of an array with constant
+ size, set the maximum size for the allocation of temporaries. */
+ if (!TREE_CONSTANT (TYPE_SIZE_UNIT (gnu_result_type))
+ && TREE_CONSTANT (TYPE_SIZE_UNIT (gnu_type)))
+ TYPE_ARRAY_MAX_SIZE (gnu_result_type) = TYPE_SIZE_UNIT (gnu_type);
+
gnu_result = build_binary_op (ARRAY_RANGE_REF, gnu_result_type,
gnu_result, gnu_expr);
}
tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)),
ufield, NULL_TREE));
template_tree = gnat_build_constructor (template_type, t);
- template_tree = build3 (COND_EXPR, p_bounds_type, u,
+ template_tree = build3 (COND_EXPR, template_type, u,
build_call_raise (CE_Length_Check_Failed, Empty,
N_Raise_Constraint_Error),
template_tree);
t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (t))));
template_tree
= build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
- template_tree = build3 (COND_EXPR, p_bounds_type, u,
+ template_tree = build3 (COND_EXPR, TREE_TYPE (t), u,
build_call_raise (CE_Length_Check_Failed, Empty,
N_Raise_Constraint_Error),
template_tree);
return ret;
}
+/* Prepare the node pointed to by EXPR_P, an is_gimple_addressable expression,
+ to be marked addressable.
+
+ We cannot rely on such an expression being directly markable if a temporary
+ has been created by the gimplification. In this case, we create another
+ temporary and initialize it with a copy, which will become a store after we
+ mark it addressable. This can happen if the front-end passed us something
+ that it could not mark addressable yet, like a Fortran pass-by-reference
+ parameter (int) floatvar. */
+
+static void
+prepare_gimple_addressable (tree *expr_p, gimple_seq *seq_p)
+{
+ while (handled_component_p (*expr_p))
+ expr_p = &TREE_OPERAND (*expr_p, 0);
+ if (is_gimple_reg (*expr_p))
+ *expr_p = get_initialized_tmp_var (*expr_p, seq_p, NULL);
+}
+
/* A subroutine of gimplify_modify_expr. Replace a MODIFY_EXPR with
a call to __builtin_memcpy. */
to = TREE_OPERAND (*expr_p, 0);
from = TREE_OPERAND (*expr_p, 1);
+ /* Mark the RHS addressable. Beware that it may not be possible to do so
+ directly if a temporary has been created by the gimplification. */
+ prepare_gimple_addressable (&from, seq_p);
+
mark_addressable (from);
from_ptr = build_fold_addr_expr_loc (loc, from);
gimplify_arg (&from_ptr, seq_p, loc);
gcc.dg/c99-array-lval-1.c. The gimplifier will correctly make
the implied temporary explicit. */
- /* Mark the RHS addressable. */
+ /* Make the operand addressable. */
ret = gimplify_expr (&TREE_OPERAND (expr, 0), pre_p, post_p,
is_gimple_addressable, fb_either);
if (ret == GS_ERROR)
break;
- /* We cannot rely on making the RHS addressable if it is
- a temporary created by gimplification. In this case create a
- new temporary that is initialized by a copy (which will
- become a store after we mark it addressable).
- This mostly happens if the frontend passed us something that
- it could not mark addressable yet, like a fortran
- pass-by-reference parameter (int) floatvar. */
- if (is_gimple_reg (TREE_OPERAND (expr, 0)))
- TREE_OPERAND (expr, 0)
- = get_initialized_tmp_var (TREE_OPERAND (expr, 0), pre_p, post_p);
+ /* Then mark it. Beware that it may not be possible to do so directly
+ if a temporary has been created by the gimplification. */
+ prepare_gimple_addressable (&TREE_OPERAND (expr, 0), pre_p);
op0 = TREE_OPERAND (expr, 0);
+2009-08-25 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gnat.dg/slice7.adb: New test.
+ * gnat.dg/slice7_pkg.ads: New helper.
+
2009-08-25 Janus Weil <janus@gcc.gnu.org>
PR fortran/41139
--- /dev/null
+-- { dg-do compile }
+-- { dg-options "-gnatws" }
+
+with System.Storage_Elements; use System.Storage_Elements;
+with Unchecked_Conversion;
+with Slice7_Pkg; use Slice7_Pkg;
+
+procedure Slice7 is
+
+ type Discrete_Type is range 1 .. 32;
+
+ Max_Byte_Count : constant := 4;
+ subtype Byte_Count_Type is Storage_Offset range 1..Max_Byte_Count;
+
+ subtype Buffer_Type is Storage_Array (Byte_Count_Type);
+ function Convert_Put is new Unchecked_Conversion (Integer, Buffer_Type);
+
+ function Set_Buffer_Size return Byte_Count_Type is
+ begin
+ return 4;
+ end;
+
+ Buffer_Size : constant Byte_Count_Type := Set_Buffer_Size;
+ Buffer_End : constant Byte_Count_Type := Max_Byte_Count;
+ Buffer_Start : constant Byte_Count_Type := Buffer_End - Buffer_Size + 1;
+
+ Obj : Discrete_Type;
+
+begin
+ Put (Convert_Put(Discrete_Type'Pos (Obj))
+ (Buffer_Start..Buffer_End));
+
+ Put (Convert_Put(Discrete_Type'Pos (Obj) -
+ Discrete_Type'Pos (Discrete_Type'First))
+ (Buffer_Start..Buffer_End));
+end;
--- /dev/null
+with System.Storage_Elements; use System.Storage_Elements;
+
+package Slice7_Pkg is
+
+ procedure Put (The_Object : in Storage_Array);
+
+end Slice7_Pkg;
OSDN Git Service
