NULL_TREE, false, true, true, NULL, Empty);
/* Avoid creating superfluous edges to __builtin_setjmp receivers. */
DECL_PURE_P (get_jmpbuf_decl) = 1;
+ DECL_IGNORED_P (get_jmpbuf_decl) = 1;
set_jmpbuf_decl
= create_subprog_decl
build_function_type (void_type_node,
tree_cons (NULL_TREE, jmpbuf_ptr_type, t)),
NULL_TREE, false, true, true, NULL, Empty);
+ DECL_IGNORED_P (set_jmpbuf_decl) = 1;
/* setjmp returns an integer and has one operand, which is a pointer to
a jmpbuf. */
build_function_type (integer_type_node,
tree_cons (NULL_TREE, jmpbuf_ptr_type, t)),
NULL_TREE, false, true, true, NULL, Empty);
-
DECL_BUILT_IN_CLASS (setjmp_decl) = BUILT_IN_NORMAL;
DECL_FUNCTION_CODE (setjmp_decl) = BUILT_IN_SETJMP;
build_function_type (void_type_node,
tree_cons (NULL_TREE, jmpbuf_ptr_type, t)),
NULL_TREE, false, true, true, NULL, Empty);
-
DECL_BUILT_IN_CLASS (update_setjmp_buf_decl) = BUILT_IN_NORMAL;
DECL_FUNCTION_CODE (update_setjmp_buf_decl) = BUILT_IN_UPDATE_SETJMP_BUF;
ptr_void_type_node,
t)),
NULL_TREE, false, true, true, NULL, Empty);
+ DECL_IGNORED_P (begin_handler_decl) = 1;
end_handler_decl
= create_subprog_decl (get_identifier ("__gnat_end_handler"), NULL_TREE,
ptr_void_type_node,
t)),
NULL_TREE, false, true, true, NULL, Empty);
+ DECL_IGNORED_P (end_handler_decl) = 1;
/* If in no exception handlers mode, all raise statements are redirected to
__gnat_last_chance_handler. No need to redefine raise_nodefer_decl since
case N_Parameter_Association:
case N_Function_Call:
case N_Procedure_Call_Statement:
- return (must_pass_by_ref (gnu_type) || default_pass_by_ref (gnu_type));
+ /* If the parameter is by reference, an lvalue is required. */
+ return (!constant
+ || must_pass_by_ref (gnu_type)
+ || default_pass_by_ref (gnu_type));
case N_Indexed_Component:
/* Only the array expression can require an lvalue. */
case N_Object_Declaration:
/* We cannot use a constructor if this is an atomic object because
the actual assignment might end up being done component-wise. */
- return ((Is_Composite_Type (Underlying_Type (Etype (gnat_node)))
- && Is_Atomic (Defining_Entity (gnat_parent)))
+ return (!constant
+ ||(Is_Composite_Type (Underlying_Type (Etype (gnat_node)))
+ && Is_Atomic (Defining_Entity (gnat_parent)))
/* We don't use a constructor if this is a class-wide object
because the effective type of the object is the equivalent
type of the class-wide subtype and it smashes most of the
case N_Assignment_Statement:
/* We cannot use a constructor if the LHS is an atomic object because
the actual assignment might end up being done component-wise. */
- return (Name (gnat_parent) == gnat_node
+ return (!constant
+ || Name (gnat_parent) == gnat_node
|| (Is_Composite_Type (Underlying_Type (Etype (gnat_node)))
&& Is_Atomic (Entity (Name (gnat_parent)))));
/* ... fall through ... */
case N_Unchecked_Type_Conversion:
- return lvalue_required_p (gnat_parent,
- get_unpadded_type (Etype (gnat_parent)),
- constant, address_of_constant, aliased);
+ return (!constant
+ || lvalue_required_p (gnat_parent,
+ get_unpadded_type (Etype (gnat_parent)),
+ constant, address_of_constant, aliased));
case N_Allocator:
/* We should only reach here through the N_Qualified_Expression case
gnu_result = convert (TREE_TYPE (gnu_actual), gnu_result);
}
- /* Undo wrapping of boolean rvalues. */
- if (TREE_CODE (gnu_actual) == NE_EXPR
- && TREE_CODE (get_base_type (TREE_TYPE (gnu_actual)))
- == BOOLEAN_TYPE
- && integer_zerop (TREE_OPERAND (gnu_actual, 1)))
- gnu_actual = TREE_OPERAND (gnu_actual, 0);
gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE,
gnu_actual, gnu_result);
set_expr_location_from_node (gnu_result, gnat_node);
{
enum tree_code code = gnu_codes[kind];
bool ignore_lhs_overflow = false;
+ location_t saved_location = input_location;
tree gnu_type;
gnu_lhs = gnat_to_gnu (Left_Opnd (gnat_node));
gnu_result = build_binary_op_trapv (code, gnu_type,
gnu_lhs, gnu_rhs, gnat_node);
else
- gnu_result = build_binary_op (code, gnu_type, gnu_lhs, gnu_rhs);
+ {
+ /* Some operations, e.g. comparisons of arrays, generate complex
+ trees that need to be annotated while they are being built. */
+ input_location = saved_location;
+ gnu_result = build_binary_op (code, gnu_type, gnu_lhs, gnu_rhs);
+ }
/* If this is a logical shift with the shift count not verified,
we must return zero if it is too large. We cannot compensate
{
gnu_result = build1 (GOTO_EXPR, void_type_node,
TREE_VALUE (gnu_return_label_stack));
+ /* When not optimizing, make sure the return is preserved. */
+ if (!optimize && Comes_From_Source (gnat_node))
+ DECL_ARTIFICIAL (TREE_VALUE (gnu_return_label_stack)) = 0;
break;
}
if (went_into_elab_proc)
current_function_decl = NULL_TREE;
+ /* When not optimizing, turn boolean rvalues B into B != false tests
+ so that the code just below can put the location information of the
+ reference to B on the inequality operator for better debug info. */
+ if (!optimize
+ && (kind == N_Identifier
+ || kind == N_Expanded_Name
+ || kind == N_Explicit_Dereference
+ || kind == N_Function_Call
+ || kind == N_Indexed_Component
+ || kind == N_Selected_Component)
+ && TREE_CODE (get_base_type (gnu_result_type)) == BOOLEAN_TYPE
+ && !lvalue_required_p (gnat_node, gnu_result_type, false, false, false))
+ gnu_result = build_binary_op (NE_EXPR, gnu_result_type,
+ convert (gnu_result_type, gnu_result),
+ convert (gnu_result_type,
+ boolean_false_node));
+
/* Set the location information on the result if it is a real expression.
References can be reused for multiple GNAT nodes and they would get
the location information of their last use. Note that we may have
comparison = build_binary_op (LT_EXPR, result_type, ub, lb);
comparison = SUBSTITUTE_PLACEHOLDER_IN_EXPR (comparison, a1);
+ if (EXPR_P (comparison))
+ SET_EXPR_LOCATION (comparison, input_location);
+
length1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (length1, a1);
length_zero_p = true;
{
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));
= 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. */
-
comparison = SUBSTITUTE_PLACEHOLDER_IN_EXPR (comparison, a1);
+ if (EXPR_P (comparison))
+ SET_EXPR_LOCATION (comparison, input_location);
+
length1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (length1, a1);
this_a1_is_null = build_binary_op (LT_EXPR, result_type, ub1, lb1);
+ if (EXPR_P (this_a1_is_null))
+ SET_EXPR_LOCATION (this_a1_is_null, input_location);
this_a2_is_null = convert (result_type, integer_zero_node);
}
comparison
= build_binary_op (EQ_EXPR, result_type, length1, length2);
+ if (EXPR_P (comparison))
+ SET_EXPR_LOCATION (comparison, input_location);
this_a1_is_null
= build_binary_op (LT_EXPR, result_type, length1,
convert (bt, integer_zero_node));
+ if (EXPR_P (this_a1_is_null))
+ SET_EXPR_LOCATION (this_a1_is_null, input_location);
+
this_a2_is_null
= build_binary_op (LT_EXPR, result_type, length2,
convert (bt, integer_zero_node));
+ if (EXPR_P (this_a2_is_null))
+ SET_EXPR_LOCATION (this_a2_is_null, input_location);
}
result = build_binary_op (TRUTH_ANDIF_EXPR, result_type,
if (!length_zero_p)
{
tree type = find_common_type (TREE_TYPE (a1), TREE_TYPE (a2));
+ tree comparison;
if (type)
{
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. */
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)))
{
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));
}
OSDN Git Service
