From: ebotcazou Date: Thu, 15 Apr 2010 20:21:08 +0000 (+0000) Subject: * gcc-interface/trans.c (gigi): Set DECL_IGNORED_P on EH functions. X-Git-Url: http://git.sourceforge.jp/view?a=commitdiff_plain;h=b723741839d17d69645823494adbb3f8ffefbf00;p=pf3gnuchains%2Fgcc-fork.git * gcc-interface/trans.c (gigi): Set DECL_IGNORED_P on EH functions. (gnat_to_gnu) : Restore the value of input_location before translating the top-level node. (lvalue_required_p) : Return 1 if !constant. : Likewise. : Likewise. : Likewise. (call_to_gnu): Remove kludge. (gnat_to_gnu) : 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) : Call build_fold_addr_expr. : Call build_fold_indirect_ref. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158388 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0d756273310..aaec1a4651d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,4 +1,22 @@ -2010-04-15 Joel Sherrill +2010-04-15 Eric Botcazou + + * gcc-interface/trans.c (gigi): Set DECL_IGNORED_P on EH functions. + (gnat_to_gnu) : Restore the value of input_location + before translating the top-level node. + (lvalue_required_p) : Return 1 if !constant. + : Likewise. + : Likewise. + : Likewise. + (call_to_gnu): Remove kludge. + (gnat_to_gnu) : 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) : Call build_fold_addr_expr. + : Call build_fold_indirect_ref. + +2010-04-15 Joel Sherrill * 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 +2010-04-13 Joel Sherrill * 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 b404ccdca39..3d802c43407 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 82575072852..3a5b9620586 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)); }