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/decl.c

@@ -955,13 +955,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	  }
 
 	/* If this is a renaming, avoid as much as possible to create a new
-	   object.  However, in several cases, creating it is required.
-	   This processing needs to be applied to the raw expression so
-	   as to make it more likely to rename the underlying object.  */
+	   object.  However, in some cases, creating it is required because
+	   renaming can be applied to objects that are not names in Ada.
+	   This processing needs to be applied to the raw expression so as
+	   to make it more likely to rename the underlying object.  */
 	if (Present (Renamed_Object (gnat_entity)))
 	  {
-	    bool create_normal_object = false;
-
 	    /* If the renamed object had padding, strip off the reference
 	       to the inner object and reset our type.  */
 	    if ((TREE_CODE (gnu_expr) == COMPONENT_REF
@@ -981,82 +980,64 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		     && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
 	      gnu_type = TREE_TYPE (gnu_expr);
 
-	    /* Case 1: If this is a constant renaming stemming from a function
-	       call, treat it as a normal object whose initial value is what is
-	       being renamed.  RM 3.3 says that the result of evaluating a
-	       function call is a constant object.  Treat constant literals
-	       the same way.  As a consequence, it can be the inner object of
-	       a constant renaming.  In this case, the renaming must be fully
-	       instantiated, i.e. it cannot be a mere reference to (part of) an
-	       existing object.  */
-	    if (const_flag)
-	      {
-	        tree inner_object = gnu_expr;
-		while (handled_component_p (inner_object))
-		  inner_object = TREE_OPERAND (inner_object, 0);
-		if (TREE_CODE (inner_object) == CALL_EXPR
-		    || CONSTANT_CLASS_P (inner_object))
-		  create_normal_object = true;
-	      }
-
-	    /* Otherwise, see if we can proceed with a stabilized version of
-	       the renamed entity or if we need to make a new object.  */
-	    if (!create_normal_object)
-	      {
-		tree maybe_stable_expr = NULL_TREE;
-		bool stable = false;
-
-		/* Case 2: If the renaming entity need not be materialized and
-		   the renamed expression is something we can stabilize, use
-		   that for the renaming.  At the global level, we can only do
-		   this if we know no SAVE_EXPRs need be made, because the
-		   expression we return might be used in arbitrary conditional
-		   branches so we must force the evaluation of the SAVE_EXPRs
-		   immediately and this requires a proper function context.
-		   Note that an external constant is at the global level.  */
-		if (!Materialize_Entity (gnat_entity)
-		    && (!((!definition && kind == E_Constant)
-			  || global_bindings_p ())
+	    /* Case 1: if this is a constant renaming stemming from a function
+	       call, treat it as a normal object whose initial value is what
+	       is being renamed.  RM 3.3 says that the result of evaluating a
+	       function call is a constant object.  Therefore, it can be the
+	       inner object of a constant renaming and the renaming must be
+	       fully instantiated, i.e. it cannot be a reference to (part of)
+	       an existing object.  And treat null expressions, constructors
+	       and literals the same way.  */
+	    tree inner = gnu_expr;
+	    while (handled_component_p (inner) || CONVERT_EXPR_P (inner))
+	      inner = TREE_OPERAND (inner, 0);
+	    /* Expand_Dispatching_Call can prepend a comparison of the tags
+	       before the call to "=".  */
+	    if (TREE_CODE (inner) == TRUTH_ANDIF_EXPR)
+	      inner = TREE_OPERAND (inner, 1);
+	    if (TREE_CODE (inner) == CALL_EXPR
+	        || TREE_CODE (inner) == NULL_EXPR
+	        || TREE_CODE (inner) == CONSTRUCTOR
+		|| CONSTANT_CLASS_P (inner))
+	      ;
+
+	    /* Case 2: if the renaming entity need not be materialized, use
+	       the stabilized renamed expression for the renaming.  At the
+	       global level, we can do this only if we know no SAVE_EXPRs
+	       need be made, because otherwise the expression would be tied
+	       to a specific elaboration routine.  */
+	    else if (!Materialize_Entity (gnat_entity)
+		     && (!global_bindings_p ()
 			 || (staticp (gnu_expr)
 			     && !TREE_SIDE_EFFECTS (gnu_expr))))
 	      {
-		    maybe_stable_expr
-		      = gnat_stabilize_reference (gnu_expr, true, &stable);
+		gnu_decl = gnat_stabilize_reference (gnu_expr, true);
 
-		    if (stable)
-		      {
 		/* ??? No DECL_EXPR is created so we need to mark
 		   the expression manually lest it is shared.  */
-			if ((!definition && kind == E_Constant)
-			    || global_bindings_p ())
-			  MARK_VISITED (maybe_stable_expr);
-			gnu_decl = maybe_stable_expr;
-			save_gnu_tree (gnat_entity, gnu_decl, true);
-			saved = true;
-			annotate_object (gnat_entity, gnu_type, NULL_TREE,
-					 false);
-			/* This assertion will fail if the renamed object
-			   isn't aligned enough as to make it possible to
-			   honor the alignment set on the renaming.  */
+		if (global_bindings_p ())
+		  MARK_VISITED (gnu_decl);
+
+		/* This assertion will fail if the renamed object isn't
+		   aligned enough as to make it possible to honor the
+		   alignment set on the renaming.  */
 		if (align)
 		  {
-			    unsigned int renamed_align
-			      = DECL_P (gnu_decl)
+		    unsigned int ralign = DECL_P (gnu_decl)
 					  ? DECL_ALIGN (gnu_decl)
 					  : TYPE_ALIGN (TREE_TYPE (gnu_decl));
-			    gcc_assert (renamed_align >= align);
-			  }
-			break;
+		    gcc_assert (ralign >= align);
 		  }
 
-		    /* The stabilization failed.  Keep maybe_stable_expr
-		       untouched here to let the pointer case below know
-		       about that failure.  */
+		save_gnu_tree (gnat_entity, gnu_decl, true);
+		saved = true;
+		annotate_object (gnat_entity, gnu_type, NULL_TREE, false);
+		break;
 	      }
 
-		/* Case 3: Make this into a constant pointer to the object we
-		   are to rename and attach the object to the pointer if it is
-		   something we can stabilize.
+	    /* Case 3: otherwise, make a constant pointer to the object we
+	       are to rename and attach the object to the pointer after it
+	       is stabilized.
 
 	       From the proper scope, attached objects will be referenced
 	       directly instead of indirectly via the pointer to avoid
@@ -1065,12 +1046,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	       variables in the expression every time the renaming is used.
 	       The pointer is called a "renaming" pointer in this case.
 
-		   In the rare cases where we cannot stabilize the renamed
-		   object, we just make a "bare" pointer and the renamed
-		   object will always be accessed indirectly through it.
-
 	       Note that we need to preserve the volatility of the renamed
 	       object through the indirection.  */
+	    else
+	      {
 		if (TREE_THIS_VOLATILE (gnu_expr) && !TYPE_VOLATILE (gnu_type))
 		  gnu_type
 		    = change_qualified_type (gnu_type, TYPE_QUAL_VOLATILE);
@@ -1078,15 +1057,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		inner_const_flag = TREE_READONLY (gnu_expr);
 		const_flag = true;
 
-		/* If the previous attempt at stabilizing failed, there is
-		   no point in trying again and we reuse the result without
-		   attaching it to the pointer.  In this case it will only
-		   be used as the initializing expression of the pointer and
-		   thus needs no special treatment with regard to multiple
-		   evaluations.
-
-		   Otherwise, try to stabilize and attach the expression to
-		   the pointer if the stabilization succeeds.
+		/* Stabilize and attach the expression to the pointer.
 
 		   Note that this might introduce SAVE_EXPRs and we don't
 		   check whether we are at the global level or not.  This
@@ -1100,21 +1071,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		   non-global case or the elaboration code for the global
 		   case, and will be attached to the elaboration procedure
 		   in the latter case.  */
-		if (!maybe_stable_expr)
-		  {
-		    maybe_stable_expr
-		      = gnat_stabilize_reference (gnu_expr, true, &stable);
-
-		    if (stable)
-		      renamed_obj = maybe_stable_expr;
-		  }
+		renamed_obj = gnat_stabilize_reference (gnu_expr, true);
 
 		if (type_annotate_only
- 		    && TREE_CODE (maybe_stable_expr) == ERROR_MARK)
+ 		    && TREE_CODE (renamed_obj) == ERROR_MARK)
 		  gnu_expr = NULL_TREE;
 		else
 		  gnu_expr
-		    = build_unary_op (ADDR_EXPR, gnu_type, maybe_stable_expr);
+		    = build_unary_op (ADDR_EXPR, gnu_type, renamed_obj);
 
 		gnu_size = NULL_TREE;
 		used_by_ref = true;
@@ -1519,13 +1483,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
 	/* If this is a renaming pointer, attach the renamed object to it and
 	   register it if we are at the global level and the renamed object
-	   is a non-constant reference.  Note that an external constant is at
-	   the global level.  */
+	   is a non-constant reference.  */
 	if (renamed_obj)
 	  {
 	    SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj);
 
-	    if (((!definition && kind == E_Constant) || global_bindings_p ())
+	    if (global_bindings_p ()
 		&& !gnat_constant_reference_p (renamed_obj))
 	      {
 		DECL_GLOBAL_NONCONSTANT_RENAMING_P (gnu_decl) = 1;
@@ -6197,16 +6160,6 @@ elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, const char *s,
   const bool expr_global_p = expr_public_p || global_bindings_p ();
   bool expr_variable_p, use_variable;
 
-  /* In most cases, we won't see a naked FIELD_DECL because a discriminant
-     reference will have been replaced with a COMPONENT_REF when the type
-     is being elaborated.  However, there are some cases involving child
-     types where we will.  So convert it to a COMPONENT_REF.  We hope it
-     will be at the highest level of the expression in these cases.  */
-  if (TREE_CODE (gnu_expr) == FIELD_DECL)
-    gnu_expr = build3 (COMPONENT_REF, TREE_TYPE (gnu_expr),
-		       build0 (PLACEHOLDER_EXPR, DECL_CONTEXT (gnu_expr)),
-		       gnu_expr, NULL_TREE);
-
   /* If GNU_EXPR contains a placeholder, just return it.  We rely on the fact
      that an expression cannot contain both a discriminant and a variable.  */
   if (CONTAINS_PLACEHOLDER_P (gnu_expr))
@@ -6217,14 +6170,12 @@ elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, const char *s,
      containing the definition is elaborated.  If this entity is defined at top
      level, replace the expression by the variable; otherwise use a SAVE_EXPR
      if this is necessary.  */
-  if (CONSTANT_CLASS_P (gnu_expr))
+  if (TREE_CONSTANT (gnu_expr))
     expr_variable_p = false;
   else
     {
       /* Skip any conversions and simple constant arithmetics to see if the
-	 expression is based on a read-only variable.
-	 ??? This really should remain read-only, but we have to think about
-	 the typing of the tree here.  */
+	 expression is based on a read-only variable.  */
       tree inner = remove_conversions (gnu_expr, true);
 
       inner = skip_simple_constant_arithmetic (inner);

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);
-      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));
+	= 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 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)
+    case CALL_EXPR:
       {
-	  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));
-	}
+	/* 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
-	{
-	  if (success)
-	    *success = false;
-	  return ref;
+	  t = gnat_stabilize_reference_1 (t, force);
+	t = fold_convert (TREE_TYPE (CALL_EXPR_ARG (ref, 0)), t);
+
+	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