aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog22
-rw-r--r--gcc/ada/gcc-interface/trans.c60
-rw-r--r--gcc/ada/gcc-interface/utils2.c47
3 files changed, 96 insertions, 33 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0d75627..aaec1a4 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index b404ccd..3d802c4 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -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
diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c
index 8257507..3a5b962 100644
--- a/gcc/ada/gcc-interface/utils2.c
+++ b/gcc/ada/gcc-interface/utils2.c
@@ -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));
}
generated by cgit v1.1 at 2025-05-30 03:09:55 +0000