* *
* 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, boolean_true_node);
+ tree a1_is_null = convert (result_type, boolean_false_node);
+ tree a2_is_null = convert (result_type, boolean_false_node);
tree t1 = TREE_TYPE (a1);
tree t2 = TREE_TYPE (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 = gnat_protect_expr (a1);
+
+ if (a2_side_effects_p)
+ a2 = gnat_protect_expr (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. */
+ dimension has a length known to be zero, set LENGTH_ZERO_P to true
+ in order to suppress the comparison of the data at the end. */
while (TREE_CODE (t1) == ARRAY_TYPE && TREE_CODE (t2) == ARRAY_TYPE)
{
tree lb1 = TYPE_MIN_VALUE (TYPE_DOMAIN (t1));
tree ub1 = TYPE_MAX_VALUE (TYPE_DOMAIN (t1));
tree lb2 = TYPE_MIN_VALUE (TYPE_DOMAIN (t2));
tree ub2 = TYPE_MAX_VALUE (TYPE_DOMAIN (t2));
- 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 length1 = size_binop (PLUS_EXPR, size_binop (MINUS_EXPR, ub1, lb1),
+ size_one_node);
+ tree length2 = size_binop (PLUS_EXPR, size_binop (MINUS_EXPR, ub2, lb2),
+ size_one_node);
tree comparison, this_a1_is_null, this_a2_is_null;
/* If the length of the first array is a constant, swap our operands
- unless the length of the second array is the constant zero.
- Note that we have set the `length' values to the length - 1. */
- if (TREE_CODE (length1) == INTEGER_CST
- && !integer_zerop (fold_build2 (PLUS_EXPR, bt, length2,
- convert (bt, integer_one_node))))
+ unless the length of the second array is the constant zero. */
+ if (TREE_CODE (length1) == INTEGER_CST && !integer_zerop (length2))
{
+ tree tem;
+ bool btem;
+
tem = a1, a1 = a2, a2 = tem;
tem = t1, t1 = t2, t2 = tem;
tem = lb1, lb1 = lb2, lb2 = tem;
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
- zero, we can just go inside the original bounds for the first
- array and see if last < first. */
- if (integer_zerop (fold_build2 (PLUS_EXPR, bt, length2,
- convert (bt, integer_one_node))))
+ /* If the length of the second array is the constant zero, we can just
+ use the original stored bounds for the first array and see whether
+ last < first holds. */
+ if (integer_zerop (length2))
{
- tree ub = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
- tree lb = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
+ length_zero_p = true;
+
+ ub1 = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
+ lb1 = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
- comparison = build_binary_op (LT_EXPR, result_type, ub, lb);
+ comparison = build_binary_op (LT_EXPR, result_type, ub1, lb1);
comparison = SUBSTITUTE_PLACEHOLDER_IN_EXPR (comparison, a1);
- length1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (length1, a1);
+ if (EXPR_P (comparison))
+ SET_EXPR_LOCATION (comparison, input_location);
- length_zero_p = true;
this_a1_is_null = comparison;
- this_a2_is_null = convert (result_type, integer_one_node);
+ this_a2_is_null = convert (result_type, boolean_true_node);
}
- /* If the length is some other constant value, we know that the
- this dimension in the first array cannot be superflat, so we
- can just use its length from the actual stored bounds. */
+ /* Otherwise, if the length is some other constant value, we know that
+ this dimension in the second array cannot be superflat, so we can
+ just use its length computed from the actual stored bounds. */
else if (TREE_CODE (length2) == INTEGER_CST)
{
+ tree bt;
+
ub1 = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
lb1 = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
+ /* Note that we know that UB2 and LB2 are constant and hence
+ cannot contain a PLACEHOLDER_EXPR. */
ub2 = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t2)));
lb2 = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t2)));
- nbt = get_base_type (TREE_TYPE (ub1));
+ bt = get_base_type (TREE_TYPE (ub1));
comparison
= build_binary_op (EQ_EXPR, result_type,
- build_binary_op (MINUS_EXPR, nbt, ub1, lb1),
- build_binary_op (MINUS_EXPR, nbt, ub2, lb2));
-
- /* Note that we know that UB2 and LB2 are constant and hence
- cannot contain a PLACEHOLDER_EXPR. */
-
+ build_binary_op (MINUS_EXPR, bt, ub1, lb1),
+ build_binary_op (MINUS_EXPR, bt, ub2, lb2));
comparison = SUBSTITUTE_PLACEHOLDER_IN_EXPR (comparison, a1);
- length1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (length1, a1);
+ if (EXPR_P (comparison))
+ SET_EXPR_LOCATION (comparison, input_location);
this_a1_is_null = build_binary_op (LT_EXPR, result_type, ub1, lb1);
- this_a2_is_null = convert (result_type, integer_zero_node);
+ if (EXPR_P (this_a1_is_null))
+ SET_EXPR_LOCATION (this_a1_is_null, input_location);
+
+ this_a2_is_null = convert (result_type, boolean_false_node);
}
- /* Otherwise compare the computed lengths. */
+ /* Otherwise, compare the computed lengths. */
else
{
length1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (length1, a1);
comparison
= build_binary_op (EQ_EXPR, result_type, length1, length2);
-
- this_a1_is_null
- = build_binary_op (LT_EXPR, result_type, length1,
- convert (bt, integer_zero_node));
- this_a2_is_null
- = build_binary_op (LT_EXPR, result_type, length2,
- convert (bt, integer_zero_node));
+ if (EXPR_P (comparison))
+ SET_EXPR_LOCATION (comparison, input_location);
+
+ /* If the length expression is of the form (cond ? val : 0), assume
+ that cond is equivalent to (length != 0). That's guaranteed by
+ construction of the array types in gnat_to_gnu_entity. */
+ if (TREE_CODE (length1) == COND_EXPR
+ && integer_zerop (TREE_OPERAND (length1, 2)))
+ this_a1_is_null = invert_truthvalue (TREE_OPERAND (length1, 0));
+ else
+ this_a1_is_null = build_binary_op (EQ_EXPR, result_type, length1,
+ size_zero_node);
+ if (EXPR_P (this_a1_is_null))
+ SET_EXPR_LOCATION (this_a1_is_null, input_location);
+
+ /* Likewise for the second array. */
+ if (TREE_CODE (length2) == COND_EXPR
+ && integer_zerop (TREE_OPERAND (length2, 2)))
+ this_a2_is_null = invert_truthvalue (TREE_OPERAND (length2, 0));
+ else
+ this_a2_is_null = build_binary_op (EQ_EXPR, result_type, length2,
+ size_zero_node);
+ if (EXPR_P (this_a2_is_null))
+ SET_EXPR_LOCATION (this_a2_is_null, input_location);
}
+ /* Append expressions for this dimension to the final expressions. */
result = build_binary_op (TRUTH_ANDIF_EXPR, result_type,
result, comparison);
a1_is_null = build_binary_op (TRUTH_ORIF_EXPR, result_type,
this_a1_is_null, a1_is_null);
+
a2_is_null = build_binary_op (TRUTH_ORIF_EXPR, result_type,
this_a2_is_null, a2_is_null);
t2 = TREE_TYPE (t2);
}
- /* Unless the size of some bound is known to be zero, compare the
+ /* Unless the length of some dimension is known to be zero, compare the
data in the array. */
if (!length_zero_p)
{
tree type = find_common_type (TREE_TYPE (a1), TREE_TYPE (a2));
+ tree comparison;
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));
+ comparison = fold_build2 (EQ_EXPR, result_type, a1, a2);
+ if (EXPR_P (comparison))
+ SET_EXPR_LOCATION (comparison, input_location);
+ result
+ = build_binary_op (TRUTH_ANDIF_EXPR, result_type, result, comparison);
}
/* 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 = gnat_protect_expr (result);
result = fold_build3 (COND_EXPR, op_type,
- fold_build2 (LT_EXPR, integer_type_node, result,
+ fold_build2 (LT_EXPR, boolean_type_node, result,
convert (op_type, integer_zero_node)),
fold_build2 (PLUS_EXPR, op_type, result, modulus),
result);
/* For the other operations, subtract the modulus if we are >= it. */
else
{
- result = save_expr (result);
+ result = gnat_protect_expr (result);
result = fold_build3 (COND_EXPR, op_type,
- fold_build2 (GE_EXPR, integer_type_node,
+ fold_build2 (GE_EXPR, boolean_type_node,
result, modulus),
fold_build2 (MINUS_EXPR, op_type,
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
modulus = NULL_TREE;
break;
+ case TRUTH_ANDIF_EXPR:
+ case TRUTH_ORIF_EXPR:
+ case TRUTH_AND_EXPR:
+ case TRUTH_OR_EXPR:
+ case TRUTH_XOR_EXPR:
+#ifdef ENABLE_CHECKING
+ gcc_assert (TREE_CODE (get_base_type (result_type)) == BOOLEAN_TYPE);
+#endif
+ operation_type = left_base_type;
+ left_operand = convert (operation_type, left_operand);
+ right_operand = convert (operation_type, right_operand);
+ break;
+
case GE_EXPR:
case LE_EXPR:
case GT_EXPR:
case LT_EXPR:
- gcc_assert (!POINTER_TYPE_P (left_type));
-
- /* ... fall through ... */
-
case EQ_EXPR:
case NE_EXPR:
+#ifdef ENABLE_CHECKING
+ gcc_assert (TREE_CODE (get_base_type (result_type)) == BOOLEAN_TYPE);
+#endif
/* If either operand is a NULL_EXPR, just return a new one. */
if (TREE_CODE (left_operand) == NULL_EXPR)
return build2 (op_code, result_type,
modulus = NULL_TREE;
break;
- case PREINCREMENT_EXPR:
- case PREDECREMENT_EXPR:
- case POSTINCREMENT_EXPR:
- case POSTDECREMENT_EXPR:
- /* These operations are not used anymore. */
- gcc_unreachable ();
-
case LSHIFT_EXPR:
case RSHIFT_EXPR:
case LROTATE_EXPR:
break;
case TRUTH_NOT_EXPR:
- gcc_assert (result_type == base_type);
+#ifdef ENABLE_CHECKING
+ gcc_assert (TREE_CODE (get_base_type (result_type)) == BOOLEAN_TYPE);
+#endif
result = invert_truthvalue (operand);
break;
TREE_TYPE (result) = type = build_pointer_type (type);
break;
+ case COMPOUND_EXPR:
+ /* Fold a compound expression if it has unconstrained array type
+ since the middle-end cannot handle it. But we don't it in the
+ general case because it may introduce aliasing issues if the
+ first operand is an indirect assignment and the second operand
+ the corresponding address, e.g. for an allocator. */
+ if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
+ {
+ result = build_unary_op (ADDR_EXPR, result_type,
+ TREE_OPERAND (operand, 1));
+ result = build2 (COMPOUND_EXPR, TREE_TYPE (result),
+ TREE_OPERAND (operand, 0), result);
+ break;
+ }
+ goto common;
+
case ARRAY_REF:
case ARRAY_RANGE_REF:
case COMPONENT_REF:
case BIT_FIELD_REF:
- /* If this is for 'Address, find the address of the prefix and
- add the offset to the field. Otherwise, do this the normal
- way. */
+ /* If this is for 'Address, find the address of the prefix and add
+ the offset to the field. Otherwise, do this the normal way. */
if (op_code == ATTR_ADDR_EXPR)
{
HOST_WIDE_INT bitsize;
if (!offset)
offset = size_zero_node;
- if (bitpos % BITS_PER_UNIT != 0)
- post_error
- ("taking address of object not aligned on storage unit?",
- error_gnat_node);
-
offset = size_binop (PLUS_EXPR, offset,
size_int (bitpos / BITS_PER_UNIT));
operand = convert (type, operand);
}
- if (type != error_mark_node)
- operation_type = build_pointer_type (type);
-
gnat_mark_addressable (operand);
- result = fold_build1 (ADDR_EXPR, operation_type, operand);
+ result = build_fold_addr_expr (operand);
}
TREE_CONSTANT (result) = staticp (operand) || TREE_CONSTANT (operand);
break;
case INDIRECT_REF:
- /* If we want to refer to an entire unconstrained array,
- make up an expression to do so. This will never survive to
- the backend. If TYPE is a thin pointer, first convert the
- operand to a fat pointer. */
+ /* If we want to refer to an unconstrained array, use the appropriate
+ expression to do so. This will never survive down to the back-end.
+ But if TYPE is a thin pointer, first convert to a fat pointer. */
if (TYPE_IS_THIN_POINTER_P (type)
&& TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (type)))
{
{
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));
}
+
+ /* If we are dereferencing an ADDR_EXPR, return its operand. */
else if (TREE_CODE (operand) == ADDR_EXPR)
result = TREE_OPERAND (operand, 0);
+ /* Otherwise, build and fold the indirect reference. */
else
{
- result = fold_build1 (op_code, TREE_TYPE (type), operand);
+ result = build_fold_indirect_ref (operand);
TREE_READONLY (result) = TYPE_READONLY (TREE_TYPE (type));
}
result = fold_build3 (COND_EXPR, operation_type,
fold_build2 (NE_EXPR,
- integer_type_node,
+ boolean_type_node,
operand,
convert
(operation_type,
true_operand = convert (result_type, true_operand);
false_operand = convert (result_type, false_operand);
- /* If the result type is unconstrained, take the address of the operands
- and then dereference our result. */
+ /* If the result type is unconstrained, take the address of the operands and
+ then dereference the result. Likewise if the result type is passed by
+ reference, but this is natively handled in the gimplifier. */
if (TREE_CODE (result_type) == UNCONSTRAINED_ARRAY_TYPE
|| CONTAINS_PLACEHOLDER_P (TYPE_SIZE (result_type)))
{
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);
}
= (gnat_node != Empty && Sloc (gnat_node) != No_Location)
? Get_Logical_Line_Number (Sloc(gnat_node)) : input_line;
- TREE_TYPE (filename)
- = build_array_type (char_type_node, build_index_type (size_int (len)));
+ TREE_TYPE (filename) = build_array_type (unsigned_char_type_node,
+ build_index_type (size_int (len)));
return
build_call_2_expr (fndecl,
- build1 (ADDR_EXPR, build_pointer_type (char_type_node),
+ build1 (ADDR_EXPR,
+ build_pointer_type (unsigned_char_type_node),
filename),
build_int_cst (NULL_TREE, line_number));
}
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
tree new_field;
/* First loop thru normal components. */
-
for (new_field = TYPE_FIELDS (record_type); new_field;
new_field = TREE_CHAIN (new_field))
- if (field == new_field
- || DECL_ORIGINAL_FIELD (new_field) == field
- || new_field == DECL_ORIGINAL_FIELD (field)
- || (DECL_ORIGINAL_FIELD (field)
- && (DECL_ORIGINAL_FIELD (field)
- == DECL_ORIGINAL_FIELD (new_field))))
+ if (SAME_FIELD_P (field, new_field))
break;
/* Next, loop thru DECL_INTERNAL_P components if we haven't found
the component in the first search. Doing this search in 2 steps
is required to avoiding hidden homonymous fields in the
_Parent field. */
-
if (!new_field)
for (new_field = TYPE_FIELDS (record_type); new_field;
new_field = TREE_CHAIN (new_field))
{
/* Latch malloc's return value and get a pointer to the aligning field
first. */
- tree storage_ptr = save_expr (malloc_ptr);
+ tree storage_ptr = gnat_protect_expr (malloc_ptr);
tree aligning_record_addr
= convert (build_pointer_type (aligning_type), storage_ptr);
tree aligning_field
= build_component_ref (aligning_record, NULL_TREE,
- TYPE_FIELDS (aligning_type), 0);
+ TYPE_FIELDS (aligning_type), false);
tree aligning_field_addr
= build_unary_op (ADDR_EXPR, NULL_TREE, aligning_field);
storage = build_call_alloc_dealloc (NULL_TREE, size, storage_type,
gnat_proc, gnat_pool, gnat_node);
- storage = convert (storage_ptr_type, protect_multiple_eval (storage));
+ storage = convert (storage_ptr_type, gnat_protect_expr (storage));
if (TYPE_IS_PADDING_P (type))
{
build_component_ref
(build_unary_op (INDIRECT_REF, NULL_TREE,
convert (storage_ptr_type, storage)),
- NULL_TREE, TYPE_FIELDS (storage_type), 0),
+ NULL_TREE, TYPE_FIELDS (storage_type), false),
build_template (template_type, type, NULL_TREE)),
convert (result_type, convert (storage_ptr_type, storage)));
}
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 = gnat_protect_expr (result);
result
= build2 (COMPOUND_EXPR, TREE_TYPE (result),
build_binary_op
tree
fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual)
{
- tree field;
tree parm_decl = get_gnu_tree (gnat_formal);
- tree const_list = NULL_TREE;
tree record_type = TREE_TYPE (TREE_TYPE (parm_decl));
- int do_range_check =
- strcmp ("MBO",
+ tree const_list = NULL_TREE, field;
+ const bool do_range_check
+ = strcmp ("MBO",
IDENTIFIER_POINTER (DECL_NAME (TYPE_FIELDS (record_type))));
expr = maybe_unconstrained_array (expr);
SUBSTITUTE_PLACEHOLDER_IN_EXPR
(DECL_INITIAL (field), expr));
- /* Check to ensure that only 32bit pointers are passed in
- 32bit descriptors */
- if (do_range_check &&
- strcmp (IDENTIFIER_POINTER (DECL_NAME (field)), "POINTER") == 0)
+ /* Check to ensure that only 32-bit pointers are passed in
+ 32-bit descriptors */
+ if (do_range_check
+ && strcmp (IDENTIFIER_POINTER (DECL_NAME (field)), "POINTER") == 0)
{
- tree pointer64type =
- build_pointer_type_for_mode (void_type_node, DImode, false);
+ tree pointer64type
+ = build_pointer_type_for_mode (void_type_node, DImode, false);
tree addr64expr = build_unary_op (ADDR_EXPR, pointer64type, expr);
- tree malloc64low =
- build_int_cstu (long_integer_type_node, 0x80000000);
+ tree malloc64low
+ = build_int_cstu (long_integer_type_node, 0x80000000);
add_stmt (build3 (COND_EXPR, void_type_node,
- build_binary_op (GE_EXPR, long_integer_type_node,
+ build_binary_op (GE_EXPR, boolean_type_node,
convert (long_integer_type_node,
addr64expr),
malloc64low),
- build_call_raise (CE_Range_Check_Failed, gnat_actual,
+ build_call_raise (CE_Range_Check_Failed,
+ gnat_actual,
N_Raise_Constraint_Error),
NULL_TREE));
}
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 COMPOUND_EXPR:
+ t = TREE_OPERAND (t, 1);
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;
}
}
+\f
+/* Save EXP for later use or reuse. This is equivalent to save_expr in tree.c
+ but we know how to handle our own nodes. */
+
+tree
+gnat_save_expr (tree exp)
+{
+ tree type = TREE_TYPE (exp);
+ enum tree_code code = TREE_CODE (exp);
+
+ if (TREE_CONSTANT (exp) || code == SAVE_EXPR || code == NULL_EXPR)
+ return exp;
+
+ if (code == UNCONSTRAINED_ARRAY_REF)
+ {
+ tree t = build1 (code, type, gnat_save_expr (TREE_OPERAND (exp, 0)));
+ TREE_READONLY (t) = TYPE_READONLY (type);
+ return t;
+ }
+
+ /* If this is a COMPONENT_REF of a fat pointer, save the entire fat pointer.
+ This may be more efficient, but will also allow us to more easily find
+ the match for the PLACEHOLDER_EXPR. */
+ if (code == COMPONENT_REF
+ && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (exp, 0))))
+ return build3 (code, type, gnat_save_expr (TREE_OPERAND (exp, 0)),
+ TREE_OPERAND (exp, 1), TREE_OPERAND (exp, 2));
+
+ return save_expr (exp);
+}
+
+/* Protect EXP for immediate reuse. This is a variant of gnat_save_expr that
+ is optimized under the assumption that EXP's value doesn't change before
+ its subsequent reuse(s) except through its potential reevaluation. */
+
+tree
+gnat_protect_expr (tree exp)
+{
+ tree type = TREE_TYPE (exp);
+ enum tree_code code = TREE_CODE (exp);
+
+ if (TREE_CONSTANT (exp) || code == SAVE_EXPR || code == NULL_EXPR)
+ return exp;
+
+ /* If EXP has no side effects, we theoritically don't need to do anything.
+ However, we may be recursively passed more and more complex expressions
+ involving checks which will be reused multiple times and eventually be
+ unshared for gimplification; in order to avoid a complexity explosion
+ at that point, we protect any expressions more complex than a simple
+ arithmetic expression. */
+ if (!TREE_SIDE_EFFECTS (exp))
+ {
+ tree inner = skip_simple_arithmetic (exp);
+ if (!EXPR_P (inner) || REFERENCE_CLASS_P (inner))
+ return exp;
+ }
+
+ /* If this is a conversion, protect what's inside the conversion. */
+ if (code == NON_LVALUE_EXPR
+ || CONVERT_EXPR_CODE_P (code)
+ || code == VIEW_CONVERT_EXPR)
+ return build1 (code, type, gnat_protect_expr (TREE_OPERAND (exp, 0)));
+
+ /* If we're indirectly referencing something, we only need to protect the
+ address since the data itself can't change in these situations. */
+ if (code == INDIRECT_REF || code == UNCONSTRAINED_ARRAY_REF)
+ {
+ tree t = build1 (code, type, gnat_protect_expr (TREE_OPERAND (exp, 0)));
+ TREE_READONLY (t) = TYPE_READONLY (type);
+ return t;
+ }
+
+ /* If this is a COMPONENT_REF of a fat pointer, save the entire fat pointer.
+ This may be more efficient, but will also allow us to more easily find
+ the match for the PLACEHOLDER_EXPR. */
+ if (code == COMPONENT_REF
+ && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (exp, 0))))
+ return build3 (code, type, gnat_protect_expr (TREE_OPERAND (exp, 0)),
+ TREE_OPERAND (exp, 1), TREE_OPERAND (exp, 2));
+
+ /* If this is a fat pointer or something that can be placed in a register,
+ just make a SAVE_EXPR. Likewise for a CALL_EXPR as large objects are
+ returned via invisible reference in most ABIs so the temporary will
+ directly be filled by the callee. */
+ if (TYPE_IS_FAT_POINTER_P (type)
+ || TYPE_MODE (type) != BLKmode
+ || code == CALL_EXPR)
+ return save_expr (exp);
+
+ /* Otherwise reference, protect the address and dereference. */
+ return
+ build_unary_op (INDIRECT_REF, type,
+ save_expr (build_unary_op (ADDR_EXPR,
+ build_reference_type (type),
+ exp)));
+}
+
+/* This is equivalent to stabilize_reference_1 in tree.c but we take an extra
+ argument to force evaluation of everything. */
+
+static tree
+gnat_stabilize_reference_1 (tree e, bool force)
+{
+ enum tree_code code = TREE_CODE (e);
+ tree type = TREE_TYPE (e);
+ tree result;
+
+ /* We cannot ignore const expressions because it might be a reference
+ to a const array but whose index contains side-effects. But we can
+ ignore things that are actual constant or that already have been
+ handled by this function. */
+ if (TREE_CONSTANT (e) || code == SAVE_EXPR)
+ return e;
+
+ switch (TREE_CODE_CLASS (code))
+ {
+ case tcc_exceptional:
+ case tcc_declaration:
+ case tcc_comparison:
+ case tcc_expression:
+ case tcc_reference:
+ case tcc_vl_exp:
+ /* If this is a COMPONENT_REF of a fat pointer, save the entire
+ fat pointer. This may be more efficient, but will also allow
+ us to more easily find the match for the PLACEHOLDER_EXPR. */
+ if (code == COMPONENT_REF
+ && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (e, 0))))
+ result
+ = build3 (code, type,
+ gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
+ TREE_OPERAND (e, 1), TREE_OPERAND (e, 2));
+ /* If the expression has side-effects, then encase it in a SAVE_EXPR
+ so that it will only be evaluated once. */
+ /* The tcc_reference and tcc_comparison classes could be handled as
+ below, but it is generally faster to only evaluate them once. */
+ else if (TREE_SIDE_EFFECTS (e) || force)
+ return save_expr (e);
+ else
+ return e;
+ break;
+
+ case tcc_binary:
+ /* Recursively stabilize each operand. */
+ result
+ = build2 (code, type,
+ gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
+ gnat_stabilize_reference_1 (TREE_OPERAND (e, 1), force));
+ break;
+
+ case tcc_unary:
+ /* Recursively stabilize each operand. */
+ result
+ = build1 (code, type,
+ gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force));
+ break;
+
+ default:
+ gcc_unreachable ();
+ }
+
+ /* See similar handling in gnat_stabilize_reference. */
+ TREE_READONLY (result) = TREE_READONLY (e);
+ TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (e);
+ TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
+
+ return result;
+}
+
+/* This is equivalent to stabilize_reference in tree.c but we know how to
+ handle our own nodes and we take extra arguments. FORCE says whether to
+ force evaluation of everything. We set SUCCESS to true unless we walk
+ through something we don't know how to stabilize. */
+
+tree
+gnat_stabilize_reference (tree ref, bool force, bool *success)
+{
+ tree type = TREE_TYPE (ref);
+ enum tree_code code = TREE_CODE (ref);
+ tree result;
+
+ /* Assume we'll success unless proven otherwise. */
+ if (success)
+ *success = true;
+
+ switch (code)
+ {
+ case CONST_DECL:
+ case VAR_DECL:
+ case PARM_DECL:
+ case RESULT_DECL:
+ /* No action is needed in this case. */
+ return ref;
+
+ case ADDR_EXPR:
+ CASE_CONVERT:
+ case FLOAT_EXPR:
+ case FIX_TRUNC_EXPR:
+ case VIEW_CONVERT_EXPR:
+ result
+ = build1 (code, type,
+ gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
+ success));
+ break;
+
+ case INDIRECT_REF:
+ case UNCONSTRAINED_ARRAY_REF:
+ result = build1 (code, type,
+ gnat_stabilize_reference_1 (TREE_OPERAND (ref, 0),
+ force));
+ break;
+
+ case COMPONENT_REF:
+ result = build3 (COMPONENT_REF, type,
+ gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
+ success),
+ TREE_OPERAND (ref, 1), NULL_TREE);
+ break;
+
+ case BIT_FIELD_REF:
+ result = build3 (BIT_FIELD_REF, type,
+ gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
+ success),
+ gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
+ force),
+ gnat_stabilize_reference_1 (TREE_OPERAND (ref, 2),
+ force));
+ break;
+
+ case ARRAY_REF:
+ case ARRAY_RANGE_REF:
+ result = build4 (code, type,
+ gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
+ success),
+ gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
+ force),
+ NULL_TREE, NULL_TREE);
+ break;
+
+ case CALL_EXPR:
+ result = gnat_stabilize_reference_1 (ref, force);
+ break;
+
+ case COMPOUND_EXPR:
+ result = build2 (COMPOUND_EXPR, type,
+ gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
+ success),
+ gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
+ force));
+ break;
+
+ case CONSTRUCTOR:
+ /* Constructors with 1 element are used extensively to formally
+ convert objects to special wrapping types. */
+ if (TREE_CODE (type) == RECORD_TYPE
+ && VEC_length (constructor_elt, CONSTRUCTOR_ELTS (ref)) == 1)
+ {
+ tree index
+ = VEC_index (constructor_elt, CONSTRUCTOR_ELTS (ref), 0)->index;
+ tree value
+ = VEC_index (constructor_elt, CONSTRUCTOR_ELTS (ref), 0)->value;
+ result
+ = build_constructor_single (type, index,
+ gnat_stabilize_reference_1 (value,
+ force));
+ }
+ else
+ {
+ if (success)
+ *success = false;
+ return ref;
+ }
+ break;
+
+ case ERROR_MARK:
+ ref = error_mark_node;
+
+ /* ... fall through to failure ... */
+
+ /* If arg isn't a kind of lvalue we recognize, make no change.
+ Caller should recognize the error for an invalid lvalue. */
+ default:
+ if (success)
+ *success = false;
+ return ref;
+ }
+
+ /* TREE_THIS_VOLATILE and TREE_SIDE_EFFECTS set on the initial expression
+ may not be sustained across some paths, such as the way via build1 for
+ INDIRECT_REF. We reset those flags here in the general case, which is
+ consistent with the GCC version of this routine.
+
+ Special care should be taken regarding TREE_SIDE_EFFECTS, because some
+ paths introduce side-effects where there was none initially (e.g. if a
+ SAVE_EXPR is built) and we also want to keep track of that. */
+ TREE_READONLY (result) = TREE_READONLY (ref);
+ TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (ref);
+ TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
+
+ return result;
+}