trans.c (gigi): Set DECL_IGNORED_P on EH functions.
* gcc-interface/trans.c (gigi): Set DECL_IGNORED_P on EH functions. (gnat_to_gnu) <N_Op_Eq>: Restore the value of input_location before translating the top-level node. (lvalue_required_p) <N_Function_Call>: Return 1 if !constant. <N_Object_Declaration>: Likewise. <N_Assignment_Statement>: Likewise. <N_Unchecked_Type_Conversion>: Likewise. (call_to_gnu): Remove kludge. (gnat_to_gnu) <N_Return_Statement>: When not optimizing, force labels associated with user returns to be preserved. (gnat_to_gnu): Add special code to deal with boolean rvalues. * gcc-interface/utils2.c (compare_arrays): Set input_location on all comparisons. (build_unary_op) <ADDR_EXPR>: Call build_fold_addr_expr. <INDIRECT_REF>: Call build_fold_indirect_ref. From-SVN: r158388
This commit is contained in:
Eric Botcazou
parent
bafaef55aa
commit
1fc24649bc
@ -1,4 +1,22 @@
|
||||
2010-04-15 Joel Sherrill <joel.sherrill@oarcorp.com>
|
||||
2010-04-15 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gcc-interface/trans.c (gigi): Set DECL_IGNORED_P on EH functions.
|
||||
(gnat_to_gnu) <N_Op_Eq>: Restore the value of input_location
|
||||
before translating the top-level node.
|
||||
(lvalue_required_p) <N_Function_Call>: Return 1 if !constant.
|
||||
<N_Object_Declaration>: Likewise.
|
||||
<N_Assignment_Statement>: Likewise.
|
||||
<N_Unchecked_Type_Conversion>: Likewise.
|
||||
(call_to_gnu): Remove kludge.
|
||||
(gnat_to_gnu) <N_Return_Statement>: When not optimizing, force labels
|
||||
associated with user returns to be preserved.
|
||||
(gnat_to_gnu): Add special code to deal with boolean rvalues.
|
||||
* gcc-interface/utils2.c (compare_arrays): Set input_location on all
|
||||
comparisons.
|
||||
(build_unary_op) <ADDR_EXPR>: Call build_fold_addr_expr.
|
||||
<INDIRECT_REF>: Call build_fold_indirect_ref.
|
||||
|
||||
2010-04-15 Joel Sherrill <joel.sherrill@oarcorp.com>
|
||||
|
||||
* g-socket.adb: A target can have multiple missing errno's. This
|
||||
will result in multiple errno's being defined as -1. Because of this
|
||||
@ -74,7 +92,7 @@
|
||||
unless necessary. Reuse the tree for an associated class-wide type
|
||||
only if processing its root type.
|
||||
|
||||
2010-04-13 Joel Sherrill <joel.sherrill@oarcorp.com>
|
||||
2010-04-13 Joel Sherrill <joel.sherrill@oarcorp.com>
|
||||
|
||||
* gsocket.h: Run-time can no longer be built without network
|
||||
OS headers available. Changing RTEMS GNAT build procedure to
|
||||
|
||||
@ -413,6 +413,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
|
||||
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
|
||||
@ -421,6 +422,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
|
||||
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. */
|
||||
@ -430,7 +432,6 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
|
||||
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;
|
||||
|
||||
@ -442,7 +443,6 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
|
||||
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;
|
||||
|
||||
@ -454,6 +454,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
|
||||
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,
|
||||
@ -462,6 +463,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
|
||||
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
|
||||
@ -730,7 +732,10 @@ lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant,
|
||||
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. */
|
||||
@ -779,8 +784,9 @@ lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant,
|
||||
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
|
||||
@ -791,7 +797,8 @@ lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant,
|
||||
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)))));
|
||||
|
||||
@ -808,9 +815,10 @@ lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant,
|
||||
/* ... 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
|
||||
@ -3000,12 +3008,6 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
|
||||
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);
|
||||
@ -4351,6 +4353,7 @@ gnat_to_gnu (Node_Id 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));
|
||||
@ -4442,7 +4445,12 @@ gnat_to_gnu (Node_Id 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
|
||||
@ -4723,6 +4731,9 @@ gnat_to_gnu (Node_Id gnat_node)
|
||||
{
|
||||
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;
|
||||
}
|
||||
|
||||
@ -5360,6 +5371,23 @@ gnat_to_gnu (Node_Id gnat_node)
|
||||
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
|
||||
|
||||
@ -303,6 +303,9 @@ compare_arrays (tree result_type, tree a1, tree a2)
|
||||
|
||||
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;
|
||||
@ -317,6 +320,8 @@ compare_arrays (tree result_type, tree a1, tree a2)
|
||||
{
|
||||
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));
|
||||
@ -325,14 +330,15 @@ compare_arrays (tree result_type, tree a1, tree a2)
|
||||
= 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);
|
||||
}
|
||||
|
||||
@ -344,13 +350,20 @@ compare_arrays (tree result_type, tree a1, tree a2)
|
||||
|
||||
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,
|
||||
@ -370,6 +383,7 @@ compare_arrays (tree result_type, tree a1, tree a2)
|
||||
if (!length_zero_p)
|
||||
{
|
||||
tree type = find_common_type (TREE_TYPE (a1), TREE_TYPE (a2));
|
||||
tree comparison;
|
||||
|
||||
if (type)
|
||||
{
|
||||
@ -377,8 +391,12 @@ compare_arrays (tree result_type, tree a1, tree a2)
|
||||
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. */
|
||||
@ -1153,21 +1171,17 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
|
||||
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)))
|
||||
{
|
||||
@ -1184,12 +1198,15 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
|
||||
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));
|
||||
}
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user