* *
* C Implementation File *
* *
- * Copyright (C) 1992-2009, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2010, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
#include "gigi.h"
static tree find_common_type (tree, tree);
-static bool contains_save_expr_p (tree);
-static tree contains_null_expr (tree);
static tree compare_arrays (tree, tree, tree);
static tree nonbinary_modular_operation (enum tree_code, tree, tree, tree);
static tree build_simple_component_ref (tree, tree, tree, bool);
return NULL_TREE;
}
\f
-/* See if EXP contains a SAVE_EXPR in a position where we would
- normally put it.
+/* Return an expression tree representing an equality comparison of A1 and A2,
+ two objects of type ARRAY_TYPE. The result should be of type RESULT_TYPE.
- ??? This is a real kludge, but is probably the best approach short
- of some very general solution. */
-
-static bool
-contains_save_expr_p (tree exp)
-{
- switch (TREE_CODE (exp))
- {
- case SAVE_EXPR:
- return true;
-
- case ADDR_EXPR: case INDIRECT_REF:
- case COMPONENT_REF:
- CASE_CONVERT: case VIEW_CONVERT_EXPR:
- return contains_save_expr_p (TREE_OPERAND (exp, 0));
-
- case CONSTRUCTOR:
- {
- tree value;
- unsigned HOST_WIDE_INT ix;
-
- FOR_EACH_CONSTRUCTOR_VALUE (CONSTRUCTOR_ELTS (exp), ix, value)
- if (contains_save_expr_p (value))
- return true;
- return false;
- }
-
- default:
- return false;
- }
-}
-\f
-/* See if EXP contains a NULL_EXPR in an expression we use for sizes. Return
- it if so. This is used to detect types whose sizes involve computations
- that are known to raise Constraint_Error. */
-
-static tree
-contains_null_expr (tree exp)
-{
- tree tem;
-
- if (TREE_CODE (exp) == NULL_EXPR)
- return exp;
-
- switch (TREE_CODE_CLASS (TREE_CODE (exp)))
- {
- case tcc_unary:
- return contains_null_expr (TREE_OPERAND (exp, 0));
-
- case tcc_comparison:
- case tcc_binary:
- tem = contains_null_expr (TREE_OPERAND (exp, 0));
- if (tem)
- return tem;
-
- return contains_null_expr (TREE_OPERAND (exp, 1));
-
- case tcc_expression:
- switch (TREE_CODE (exp))
- {
- case SAVE_EXPR:
- return contains_null_expr (TREE_OPERAND (exp, 0));
-
- case COND_EXPR:
- tem = contains_null_expr (TREE_OPERAND (exp, 0));
- if (tem)
- return tem;
-
- tem = contains_null_expr (TREE_OPERAND (exp, 1));
- if (tem)
- return tem;
-
- return contains_null_expr (TREE_OPERAND (exp, 2));
-
- default:
- return 0;
- }
-
- default:
- return 0;
- }
-}
-\f
-/* Return an expression tree representing an equality comparison of
- A1 and A2, two objects of ARRAY_TYPE. The returned expression should
- be of type RESULT_TYPE
-
- Two arrays are equal in one of two ways: (1) if both have zero length
- in some dimension (not necessarily the same dimension) or (2) if the
- lengths in each dimension are equal and the data is equal. We perform the
- length tests in as efficient a manner as possible. */
+ Two arrays are equal in one of two ways: (1) if both have zero length in
+ some dimension (not necessarily the same dimension) or (2) if the lengths
+ in each dimension are equal and the data is equal. We perform the length
+ tests in as efficient a manner as possible. */
static tree
compare_arrays (tree result_type, tree a1, tree a2)
tree result = convert (result_type, integer_one_node);
tree a1_is_null = convert (result_type, integer_zero_node);
tree a2_is_null = convert (result_type, integer_zero_node);
+ bool a1_side_effects_p = TREE_SIDE_EFFECTS (a1);
+ bool a2_side_effects_p = TREE_SIDE_EFFECTS (a2);
bool length_zero_p = false;
+ /* If either operand has side-effects, they have to be evaluated only once
+ in spite of the multiple references to the operand in the comparison. */
+ if (a1_side_effects_p)
+ a1 = protect_multiple_eval (a1);
+
+ if (a2_side_effects_p)
+ a2 = protect_multiple_eval (a2);
+
/* Process each dimension separately and compare the lengths. If any
dimension has a size known to be zero, set SIZE_ZERO_P to 1 to
suppress the comparison of the data. */
tree bt = get_base_type (TREE_TYPE (lb1));
tree length1 = fold_build2 (MINUS_EXPR, bt, ub1, lb1);
tree length2 = fold_build2 (MINUS_EXPR, bt, ub2, lb2);
- tree nbt;
- tree tem;
tree comparison, this_a1_is_null, this_a2_is_null;
+ tree nbt, tem;
+ bool btem;
/* If the length of the first array is a constant, swap our operands
unless the length of the second array is the constant zero.
tem = ub1, ub1 = ub2, ub2 = tem;
tem = length1, length1 = length2, length2 = tem;
tem = a1_is_null, a1_is_null = a2_is_null, a2_is_null = tem;
+ btem = a1_side_effects_p, a1_side_effects_p = a2_side_effects_p,
+ a2_side_effects_p = btem;
}
/* If the length of this dimension in the second array is the constant
tree type = find_common_type (TREE_TYPE (a1), TREE_TYPE (a2));
if (type)
- a1 = convert (type, a1), a2 = convert (type, a2);
+ {
+ a1 = convert (type, a1),
+ a2 = convert (type, a2);
+ }
result = build_binary_op (TRUTH_ANDIF_EXPR, result_type, result,
fold_build2 (EQ_EXPR, result_type, a1, a2));
-
}
/* The result is also true if both sizes are zero. */
a1_is_null, a2_is_null),
result);
- /* If either operand contains SAVE_EXPRs, they have to be evaluated before
- starting the comparison above since the place it would be otherwise
- evaluated would be wrong. */
-
- if (contains_save_expr_p (a1))
+ /* If either operand has side-effects, they have to be evaluated before
+ starting the comparison above since the place they would be otherwise
+ evaluated could be wrong. */
+ if (a1_side_effects_p)
result = build2 (COMPOUND_EXPR, result_type, a1, result);
- if (contains_save_expr_p (a2))
+ if (a2_side_effects_p)
result = build2 (COMPOUND_EXPR, result_type, a2, result);
return result;
/* For subtraction, add the modulus back if we are negative. */
else if (op_code == MINUS_EXPR)
{
- result = save_expr (result);
+ result = protect_multiple_eval (result);
result = fold_build3 (COND_EXPR, op_type,
fold_build2 (LT_EXPR, integer_type_node, result,
convert (op_type, integer_zero_node)),
/* For the other operations, subtract the modulus if we are >= it. */
else
{
- result = save_expr (result);
+ result = protect_multiple_eval (result);
result = fold_build3 (COND_EXPR, op_type,
fold_build2 (GE_EXPR, integer_type_node,
result, modulus),
switch (op_code)
{
+ case INIT_EXPR:
case MODIFY_EXPR:
/* If there were integral or pointer conversions on the LHS, remove
them; we'll be putting them back below if needed. Likewise for
left_type = TREE_TYPE (left_operand);
}
+ /* For a range, make sure the element type is consistent. */
+ if (op_code == ARRAY_RANGE_REF
+ && TREE_TYPE (operation_type) != TREE_TYPE (left_type))
+ operation_type = build_array_type (TREE_TYPE (left_type),
+ TYPE_DOMAIN (operation_type));
+
/* Then convert the right operand to its base type. This will prevent
unneeded sign conversions when sizetype is wider than integer. */
right_operand = convert (right_base_type, right_operand);
return result;
}
- /* Otherwise, the base types must be the same unless the objects are
- fat pointers or records. If we have records, use the best type and
- convert both operands to that type. */
+ /* Otherwise, the base types must be the same, unless they are both fat
+ pointer types or record types. In the latter case, use the best type
+ and convert both operands to that type. */
if (left_base_type != right_base_type)
{
if (TYPE_IS_FAT_POINTER_P (left_base_type)
- && TYPE_IS_FAT_POINTER_P (right_base_type)
- && TYPE_MAIN_VARIANT (left_base_type)
- == TYPE_MAIN_VARIANT (right_base_type))
- best_type = left_base_type;
+ && TYPE_IS_FAT_POINTER_P (right_base_type))
+ {
+ gcc_assert (TYPE_MAIN_VARIANT (left_base_type)
+ == TYPE_MAIN_VARIANT (right_base_type));
+ best_type = left_base_type;
+ }
+
else if (TREE_CODE (left_base_type) == RECORD_TYPE
&& TREE_CODE (right_base_type) == RECORD_TYPE)
{
- /* The only way these are permitted to be the same is if both
- types have the same name. In that case, one of them must
- not be self-referential. Use that one as the best type.
- Even better is if one is of fixed size. */
+ /* The only way this is permitted is if both types have the same
+ name. In that case, one of them must not be self-referential.
+ Use it as the best type. Even better with a fixed size. */
gcc_assert (TYPE_NAME (left_base_type)
- && (TYPE_NAME (left_base_type)
- == TYPE_NAME (right_base_type)));
+ && TYPE_NAME (left_base_type)
+ == TYPE_NAME (right_base_type));
if (TREE_CONSTANT (TYPE_SIZE (left_base_type)))
best_type = left_base_type;
else
gcc_unreachable ();
}
+
else
gcc_unreachable ();
left_operand = convert (best_type, left_operand);
right_operand = convert (best_type, right_operand);
}
-
- /* If we are comparing a fat pointer against zero, we need to
- just compare the data pointer. */
- else if (TYPE_IS_FAT_POINTER_P (left_base_type)
- && TREE_CODE (right_operand) == CONSTRUCTOR
- && integer_zerop (VEC_index (constructor_elt,
- CONSTRUCTOR_ELTS (right_operand),
- 0)
- ->value))
- {
- right_operand = build_component_ref (left_operand, NULL_TREE,
- TYPE_FIELDS (left_base_type),
- false);
- left_operand = convert (TREE_TYPE (right_operand),
- integer_zero_node);
- }
else
{
left_operand = convert (left_base_type, left_operand);
right_operand = convert (right_base_type, right_operand);
}
+ /* If we are comparing a fat pointer against zero, we just need to
+ compare the data pointer. */
+ if (TYPE_IS_FAT_POINTER_P (left_base_type)
+ && TREE_CODE (right_operand) == CONSTRUCTOR
+ && integer_zerop (VEC_index (constructor_elt,
+ CONSTRUCTOR_ELTS (right_operand),
+ 0)->value))
+ {
+ left_operand
+ = build_component_ref (left_operand, NULL_TREE,
+ TYPE_FIELDS (left_base_type), false);
+ right_operand
+ = convert (TREE_TYPE (left_operand), integer_zero_node);
+ }
+
modulus = NULL_TREE;
break;
{
result = build1 (UNCONSTRAINED_ARRAY_REF,
TYPE_UNCONSTRAINED_ARRAY (type), operand);
- TREE_READONLY (result) = TREE_STATIC (result)
+ TREE_READONLY (result)
= TYPE_READONLY (TYPE_UNCONSTRAINED_ARRAY (type));
}
else if (TREE_CODE (operand) == ADDR_EXPR)
return result;
}
-/* Similar, but for RETURN_EXPR. If RESULT_DECL is non-zero, build
- a RETURN_EXPR around the assignment of RET_VAL to RESULT_DECL.
- If RESULT_DECL is zero, build a bare RETURN_EXPR. */
+/* Similar, but for RETURN_EXPR. If RET_VAL is non-null, build a RETURN_EXPR
+ around the assignment of RET_VAL to RET_OBJ. Otherwise just build a bare
+ RETURN_EXPR around RESULT_OBJ, which may be null in this case. */
tree
-build_return_expr (tree result_decl, tree ret_val)
+build_return_expr (tree ret_obj, tree ret_val)
{
tree result_expr;
- if (result_decl)
+ if (ret_val)
{
/* The gimplifier explicitly enforces the following invariant:
- RETURN_EXPR
- |
- MODIFY_EXPR
- / \
- / \
- RESULT_DECL ...
-
- As a consequence, type-homogeneity dictates that we use the type
- of the RESULT_DECL as the operation type. */
-
- tree operation_type = TREE_TYPE (result_decl);
+ RETURN_EXPR
+ |
+ MODIFY_EXPR
+ / \
+ / \
+ RET_OBJ ...
- /* Convert the right operand to the operation type. Note that
- it's the same transformation as in the MODIFY_EXPR case of
- build_binary_op with the additional guarantee that the type
- cannot involve a placeholder, since otherwise the function
- would use the "target pointer" return mechanism. */
+ As a consequence, type consistency dictates that we use the type
+ of the RET_OBJ as the operation type. */
+ tree operation_type = TREE_TYPE (ret_obj);
+ /* Convert the right operand to the operation type. Note that it's the
+ same transformation as in the MODIFY_EXPR case of build_binary_op,
+ with the assumption that the type cannot involve a placeholder. */
if (operation_type != TREE_TYPE (ret_val))
ret_val = convert (operation_type, ret_val);
- result_expr
- = build2 (MODIFY_EXPR, operation_type, result_decl, ret_val);
+ result_expr = build2 (MODIFY_EXPR, operation_type, ret_obj, ret_val);
}
else
- result_expr = NULL_TREE;
+ result_expr = ret_obj;
return build1 (RETURN_EXPR, void_type_node, result_expr);
}
if (TREE_SIDE_EFFECTS (val))
side_effects = true;
-
- /* Propagate an NULL_EXPR from the size of the type. We won't ever
- be executing the code we generate here in that case, but handle it
- specially to avoid the compiler blowing up. */
- if (TREE_CODE (type) == RECORD_TYPE
- && (result = contains_null_expr (DECL_SIZE (obj))) != NULL_TREE)
- return build1 (NULL_EXPR, type, TREE_OPERAND (result, 0));
}
/* For record types with constant components only, sort field list
{
/* Latch malloc's return value and get a pointer to the aligning field
first. */
- tree storage_ptr = save_expr (malloc_ptr);
+ tree storage_ptr = protect_multiple_eval (malloc_ptr);
tree aligning_record_addr
= convert (build_pointer_type (aligning_type), storage_ptr);
gnat_proc, gnat_pool,
gnat_node));
- /* If we have an initial value, put the new address into a SAVE_EXPR, assign
- the value, and return the address. Do this with a COMPOUND_EXPR. */
-
+ /* If we have an initial value, protect the new address, assign the value
+ and return the address with a COMPOUND_EXPR. */
if (init)
{
- result = save_expr (result);
+ result = protect_multiple_eval (result);
result
= build2 (COMPOUND_EXPR, TREE_TYPE (result),
build_binary_op
return gnat_build_constructor (record_type, nreverse (const_list));
}
-/* Indicate that we need to make the address of EXPR_NODE and it therefore
+/* Indicate that we need to take the address of T and that it therefore
should not be allocated in a register. Returns true if successful. */
bool
-gnat_mark_addressable (tree expr_node)
+gnat_mark_addressable (tree t)
{
- while (1)
- switch (TREE_CODE (expr_node))
+ while (true)
+ switch (TREE_CODE (t))
{
case ADDR_EXPR:
case COMPONENT_REF:
case VIEW_CONVERT_EXPR:
case NON_LVALUE_EXPR:
CASE_CONVERT:
- expr_node = TREE_OPERAND (expr_node, 0);
+ t = TREE_OPERAND (t, 0);
break;
case CONSTRUCTOR:
- TREE_ADDRESSABLE (expr_node) = 1;
+ TREE_ADDRESSABLE (t) = 1;
return true;
case VAR_DECL:
case PARM_DECL:
case RESULT_DECL:
- TREE_ADDRESSABLE (expr_node) = 1;
+ TREE_ADDRESSABLE (t) = 1;
return true;
case FUNCTION_DECL:
- TREE_ADDRESSABLE (expr_node) = 1;
+ TREE_ADDRESSABLE (t) = 1;
return true;
case CONST_DECL:
- return (DECL_CONST_CORRESPONDING_VAR (expr_node)
- && (gnat_mark_addressable
- (DECL_CONST_CORRESPONDING_VAR (expr_node))));
+ return DECL_CONST_CORRESPONDING_VAR (t)
+ && gnat_mark_addressable (DECL_CONST_CORRESPONDING_VAR (t));
+
default:
return true;
}
OSDN Git Service
