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

gcc/ada/ChangeLog

+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

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,7 +784,8 @@ 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)))
+      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
@@ -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,
+      return (!constant
+	      || lvalue_required_p (gnat_parent,
 				    get_unpadded_type (Etype (gnat_parent)),
-				constant, address_of_constant, aliased);
+				    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
+	  {
+	    /* 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

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));
 	}