gigi.h (gnat_stabilize_reference): Adjust prototype.

	* gcc-interface/gigi.h (gnat_stabilize_reference): Adjust prototype.
	* gcc-interface/decl.c (gnat_to_gnu_entity): Do not rely on const_flag
 	to detect constant renamings.  Be prepared for specific pattern of
	renamed object based on function calls.  Create a constant object
	for the renaming of a NULL_EXPR or of a CONSTRUCTOR.  Adjust calls
	to gnat_stabilize_reference and tidy up.  Remove redundant tests.
	(elaborate_expression_1): Remove obsolete test and tidy up.
	* gcc-interface/trans.c (Call_to_gnu): Do not stabilize In/Out or Out
	parameters passed by reference.
	(gnat_to_gnu) <N_Selected_Component>: Remove redundant protection again
	side-effects.
	Use gnat_protect_expr instead of gnat_stabilize_reference for general
	protection against side-effects.
	* gcc-interface/utils2.c (gnat_stable_expr_p): New predicate.
	(gnat_save_expr): Invoke it.
	(gnat_protect_expr): Likewise.
	(gnat_stabilize_reference_1): Likewise.  Remove useless propagation
	of TREE_THIS_NOTRAP.
	(gnat_stabilize_reference): Remove parameter and adjust throughout.
	Delete ADDR_EXDR, COMPOUND_EXPR and CONSTRUCTOR cases.
	Restrict CALL_EXPR case to atomic loads and tweak ERROR_MARK case.

From-SVN: r223708

gcc/ada/ChangeLog

+2015-05-26  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/gigi.h (gnat_stabilize_reference): Adjust prototype.
+	* gcc-interface/decl.c (gnat_to_gnu_entity): Do not rely on const_flag
+ 	to detect constant renamings.  Be prepared for specific pattern of
+	renamed object based on function calls.  Create a constant object
+	for the renaming of a NULL_EXPR or of a CONSTRUCTOR.  Adjust calls
+	to gnat_stabilize_reference and tidy up.  Remove redundant tests.
+	(elaborate_expression_1): Remove obsolete test and tidy up.
+	* gcc-interface/trans.c (Call_to_gnu): Do not stabilize In/Out or Out
+	parameters passed by reference.
+	(gnat_to_gnu) <N_Selected_Component>: Remove redundant protection again
+	side-effects.
+	Use gnat_protect_expr instead of gnat_stabilize_reference for general
+	protection against side-effects.
+	* gcc-interface/utils2.c (gnat_stable_expr_p): New predicate.
+	(gnat_save_expr): Invoke it.
+	(gnat_protect_expr): Likewise.
+	(gnat_stabilize_reference_1): Likewise.  Remove useless propagation
+	of TREE_THIS_NOTRAP.
+	(gnat_stabilize_reference): Remove parameter and adjust throughout.
+	Delete ADDR_EXDR, COMPOUND_EXPR and CONSTRUCTOR cases.
+	Restrict CALL_EXPR case to atomic loads and tweak ERROR_MARK case.
+
 2015-05-26  Ed Schonberg  <schonberg@adacore.com>
 
 	* sinfo.ads: Minor reformatting.

gcc/ada/gcc-interface/gigi.h

@@ -965,9 +965,8 @@ extern tree gnat_protect_expr (tree exp);
 
 /* This is equivalent to stabilize_reference in tree.c but we know how to
    handle our own nodes and we take extra arguments.  FORCE says whether to
-   force evaluation of everything.  We set SUCCESS to true unless we walk
-   through something we don't know how to stabilize.  */
-extern tree gnat_stabilize_reference (tree ref, bool force, bool *success);
+   force evaluation of everything.  */
+extern tree gnat_stabilize_reference (tree ref, bool force);
 
 /* This is equivalent to get_inner_reference in expr.c but it returns the
    ultimate containing object only if the reference (lvalue) is constant,

gcc/ada/gcc-interface/trans.c

@@ -4241,11 +4241,11 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
 
       /* If it's possible we may need to use this expression twice, make sure
 	 that any side-effects are handled via SAVE_EXPRs; likewise if we need
-	 to force side-effects before the call.
-	 ??? This is more conservative than we need since we don't need to do
-	 this for pass-by-ref with no conversion.  */
-      if (Ekind (gnat_formal) != E_In_Parameter)
-	gnu_name = gnat_stabilize_reference (gnu_name, true, NULL);
+	 to force side-effects before the call.  */
+      if (Ekind (gnat_formal) != E_In_Parameter
+	  && !is_by_ref_formal_parm
+	  && TREE_CODE (gnu_name) != NULL_EXPR)
+	gnu_name = gnat_stabilize_reference (gnu_name, true);
 
       /* If we are passing a non-addressable parameter by reference, pass the
 	 address of a copy.  In the Out or In Out case, set up to copy back
@@ -6099,14 +6099,6 @@ gnat_to_gnu (Node_Id gnat_node)
 	  {
 	    gnu_field = gnat_to_gnu_field_decl (gnat_field);
 
-	    /* If there are discriminants, the prefix might be evaluated more
-	       than once, which is a problem if it has side-effects.  */
-	    if (Has_Discriminants (Is_Access_Type (Etype (Prefix (gnat_node)))
-				   ? Designated_Type (Etype
-						      (Prefix (gnat_node)))
-				   : Etype (Prefix (gnat_node))))
-	      gnu_prefix = gnat_stabilize_reference (gnu_prefix, false, NULL);
-
 	    gnu_result
 	      = build_component_ref (gnu_prefix, NULL_TREE, gnu_field,
 				     (Nkind (Parent (gnat_node))
@@ -7313,7 +7305,6 @@ gnat_to_gnu (Node_Id gnat_node)
 	 gets inserted there as well.  This ensures that the type elaboration
 	 code is issued past the actions computing values on which it might
 	 depend.  */
-
       start_stmt_group ();
       add_stmt_list (Actions (gnat_node));
       gnu_expr = gnat_to_gnu (Expression (gnat_node));
@@ -7498,7 +7489,7 @@ gnat_to_gnu (Node_Id gnat_node)
 	   && TYPE_IS_PADDING_P (TREE_TYPE (gnu_result)))
       && (TREE_CODE (gnu_result_type) == UNCONSTRAINED_ARRAY_TYPE
 	  || CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type))))
-    gnu_result = gnat_stabilize_reference (gnu_result, false, NULL);
+    gnu_result = gnat_protect_expr (gnu_result);
 
   /* Now convert the result to the result type, unless we are in one of the
      following cases:

gcc/ada/gcc-interface/utils2.c

@@ -2563,6 +2563,17 @@ gnat_mark_addressable (tree t)
     }
 }
 
+/* Return true if EXP is a stable expression for the purpose of the functions
+   below and, therefore, can be returned unmodified by them.  We accept things
+   that are actual constants or that have already been handled.  */
+
+static bool
+gnat_stable_expr_p (tree exp)
+{
+  enum tree_code code = TREE_CODE (exp);
+  return TREE_CONSTANT (exp) || code == NULL_EXPR || code == SAVE_EXPR;
+}
+
 /* Save EXP for later use or reuse.  This is equivalent to save_expr in tree.c
    but we know how to handle our own nodes.  */
 
@@ -2572,7 +2583,7 @@ gnat_save_expr (tree exp)
   tree type = TREE_TYPE (exp);
   enum tree_code code = TREE_CODE (exp);
 
-  if (TREE_CONSTANT (exp) || code == SAVE_EXPR || code == NULL_EXPR)
+  if (gnat_stable_expr_p (exp))
     return exp;
 
   if (code == UNCONSTRAINED_ARRAY_REF)
@@ -2603,7 +2614,7 @@ gnat_protect_expr (tree exp)
   tree type = TREE_TYPE (exp);
   enum tree_code code = TREE_CODE (exp);
 
-  if (TREE_CONSTANT (exp) || code == SAVE_EXPR || code == NULL_EXPR)
+  if (gnat_stable_expr_p (exp))
     return exp;
 
   /* If EXP has no side effects, we theoretically don't need to do anything.
@@ -2669,11 +2680,7 @@ gnat_stabilize_reference_1 (tree e, bool force)
   tree type = TREE_TYPE (e);
   tree result;
 
-  /* We cannot ignore const expressions because it might be a reference
-     to a const array but whose index contains side-effects.  But we can
-     ignore things that are actual constant or that already have been
-     handled by this function.  */
-  if (TREE_CONSTANT (e) || code == SAVE_EXPR)
+  if (gnat_stable_expr_p (e))
     return e;
 
   switch (TREE_CODE_CLASS (code))
@@ -2722,36 +2729,24 @@ gnat_stabilize_reference_1 (tree e, bool force)
       gcc_unreachable ();
     }
 
-  /* See similar handling in gnat_stabilize_reference.  */
   TREE_READONLY (result) = TREE_READONLY (e);
   TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (e);
   TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
 
-  if (code == INDIRECT_REF
-      || code == UNCONSTRAINED_ARRAY_REF
-      || code == ARRAY_REF
-      || code == ARRAY_RANGE_REF)
-    TREE_THIS_NOTRAP (result) = TREE_THIS_NOTRAP (e);
-
   return result;
 }
 
 /* This is equivalent to stabilize_reference in tree.c but we know how to
    handle our own nodes and we take extra arguments.  FORCE says whether to
-   force evaluation of everything.  We set SUCCESS to true unless we walk
-   through something we don't know how to stabilize.  */
+   force evaluation of everything.  */
 
 tree
-gnat_stabilize_reference (tree ref, bool force, bool *success)
+gnat_stabilize_reference (tree ref, bool force)
 {
   tree type = TREE_TYPE (ref);
   enum tree_code code = TREE_CODE (ref);
   tree result;
 
-  /* Assume we'll success unless proven otherwise.  */
-  if (success)
-    *success = true;
-
   switch (code)
     {
     case CONST_DECL:
@@ -2761,15 +2756,13 @@ gnat_stabilize_reference (tree ref, bool force, bool *success)
       /* No action is needed in this case.  */
       return ref;
 
-    case ADDR_EXPR:
     CASE_CONVERT:
     case FLOAT_EXPR:
     case FIX_TRUNC_EXPR:
     case VIEW_CONVERT_EXPR:
       result
 	= build1 (code, type,
-		  gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
-					    success));
+		  gnat_stabilize_reference (TREE_OPERAND (ref, 0), force));
       break;
 
     case INDIRECT_REF:
@@ -2781,79 +2774,51 @@ gnat_stabilize_reference (tree ref, bool force, bool *success)
 
     case COMPONENT_REF:
       result = build3 (COMPONENT_REF, type,
-		       gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
-						 success),
+		       gnat_stabilize_reference (TREE_OPERAND (ref, 0), force),
 		       TREE_OPERAND (ref, 1), NULL_TREE);
       break;
 
     case BIT_FIELD_REF:
       result = build3 (BIT_FIELD_REF, type,
-		       gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
-						 success),
+		       gnat_stabilize_reference (TREE_OPERAND (ref, 0), force),
 		       TREE_OPERAND (ref, 1), TREE_OPERAND (ref, 2));
       break;
 
     case ARRAY_REF:
     case ARRAY_RANGE_REF:
-      result = build4 (code, type,
-		       gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
-						 success),
-		       gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
-						   force),
-		       NULL_TREE, NULL_TREE);
+      result
+	= build4 (code, type,
+		  gnat_stabilize_reference (TREE_OPERAND (ref, 0), force),
+		  gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1), force),
+		  TREE_OPERAND (ref, 2), TREE_OPERAND (ref, 3));
       break;
 
     case CALL_EXPR:
-      if (call_is_atomic_load (ref))
-	result
-	  = build_call_expr (TREE_OPERAND (CALL_EXPR_FN (ref), 0), 2,
-			     gnat_stabilize_reference (CALL_EXPR_ARG (ref, 0),
-						       force, success),
-			     CALL_EXPR_ARG (ref, 1));
-      else
-	result = gnat_stabilize_reference_1 (ref, force);
-      break;
-
-    case COMPOUND_EXPR:
-      result = build2 (COMPOUND_EXPR, type,
-		       gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
-						 success),
-		       gnat_stabilize_reference (TREE_OPERAND (ref, 1), force,
-						 success));
-      break;
+      {
+	/* This can only be an atomic load.  */
+	gcc_assert (call_is_atomic_load (ref));
+
+	/* An atomic load is an INDIRECT_REF of its first argument.  */
+	tree t = CALL_EXPR_ARG (ref, 0);
+	if (TREE_CODE (t) == NOP_EXPR)
+	  t = TREE_OPERAND (t, 0);
+	if (TREE_CODE (t) == ADDR_EXPR)
+	  t = build1 (ADDR_EXPR, TREE_TYPE (t),
+		      gnat_stabilize_reference (TREE_OPERAND (t, 0), force));
+	else
+	  t = gnat_stabilize_reference_1 (t, force);
+	t = fold_convert (TREE_TYPE (CALL_EXPR_ARG (ref, 0)), t);
 
-    case CONSTRUCTOR:
-      /* Constructors with 1 element are used extensively to formally
-	 convert objects to special wrapping types.  */
-      if (TREE_CODE (type) == RECORD_TYPE
-	  && vec_safe_length (CONSTRUCTOR_ELTS (ref)) == 1)
-	{
-	  tree index = (*CONSTRUCTOR_ELTS (ref))[0].index;
-	  tree value = (*CONSTRUCTOR_ELTS (ref))[0].value;
-	  result
-	    = build_constructor_single (type, index,
-					gnat_stabilize_reference_1 (value,
-								    force));
-	}
-      else
-	{
-	  if (success)
-	    *success = false;
-	  return ref;
-	}
+	result = build_call_expr (TREE_OPERAND (CALL_EXPR_FN (ref), 0), 2,
+				  t, CALL_EXPR_ARG (ref, 1));
+      }
       break;
 
     case ERROR_MARK:
-      ref = error_mark_node;
-
-      /* ...  fall through to failure ... */
+      return error_mark_node;
 
-      /* If arg isn't a kind of lvalue we recognize, make no change.
-	 Caller should recognize the error for an invalid lvalue.  */
     default:
-      if (success)
-	*success = false;
-      return ref;
+      gcc_unreachable ();
     }
 
   /* TREE_THIS_VOLATILE and TREE_SIDE_EFFECTS set on the initial expression