This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: [Ada] Lift restriction on renaming with Volatile_Full_Access


> An arbitrary restriction was imposed on renaming in conjunction with the new
> Aspect/Pragma Volatile_Full_Access for implementation reasons: the compiler
> was rejecting renamings of components of Volatile_Full_Access objects.

The reason was that supporting Volatile_Full_Access requires an overhaul of 
the implementation of renaming is gigi because the current approach falls back 
to references in some cases and these are not compatible with VFA.

This is the first part of this overhaul, tested on x86_64-suse-linux, applied 
on the mainline.


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.


-- 
Eric Botcazou
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 223704)
+++ gcc-interface/decl.c	(working copy)
@@ -955,13 +955,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
 	  }
 
 	/* 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,96 +980,76 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
 		     && 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;
-	      }
+	    /* 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))
+	      ;
 
-	    /* 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)
+	    /* 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))))
 	      {
-		tree maybe_stable_expr = NULL_TREE;
-		bool stable = false;
+		gnu_decl = gnat_stabilize_reference (gnu_expr, true);
 
-		/* 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 ())
-			|| (staticp (gnu_expr)
-			    && !TREE_SIDE_EFFECTS (gnu_expr))))
+		/* ??? No DECL_EXPR is created so we need to mark
+		   the expression manually lest it is shared.  */
+		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)
 		  {
-		    maybe_stable_expr
-		      = gnat_stabilize_reference (gnu_expr, true, &stable);
-
-		    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 (align)
-			  {
-			    unsigned int renamed_align
-			      = DECL_P (gnu_decl)
-				? DECL_ALIGN (gnu_decl)
-				: TYPE_ALIGN (TREE_TYPE (gnu_decl));
-			    gcc_assert (renamed_align >= align);
-			  }
-			break;
-		      }
-
-		    /* The stabilization failed.  Keep maybe_stable_expr
-		       untouched here to let the pointer case below know
-		       about that failure.  */
+		    unsigned int ralign = DECL_P (gnu_decl)
+					  ? DECL_ALIGN (gnu_decl)
+					  : TYPE_ALIGN (TREE_TYPE (gnu_decl));
+		    gcc_assert (ralign >= align);
 		  }
 
-		/* 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.
-
-		   From the proper scope, attached objects will be referenced
-		   directly instead of indirectly via the pointer to avoid
-		   subtle aliasing problems with non-addressable entities.
-		   They have to be stable because we must not evaluate the
-		   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.
+		save_gnu_tree (gnat_entity, gnu_decl, true);
+		saved = true;
+		annotate_object (gnat_entity, gnu_type, NULL_TREE, false);
+		break;
+	      }
+
+	    /* 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
+	       subtle aliasing problems with non-addressable entities.
+	       They have to be stable because we must not evaluate the
+	       variables in the expression every time the renaming is used.
+	       The pointer is called a "renaming" pointer in this case.
 
-		   Note that we need to preserve the volatility of the renamed
-		   object through the indirection.  */
+	       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_entit
 		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_entit
 		   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_entit
 
 	/* 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, E
   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, E
      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);
Index: gcc-interface/utils2.c
===================================================================
--- gcc-interface/utils2.c	(revision 223704)
+++ gcc-interface/utils2.c	(working copy)
@@ -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
   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
       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
       /* 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
 
     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;
-
-    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;
-	}
+      {
+	/* 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);
+
+	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
Index: gcc-interface/gigi.h
===================================================================
--- gcc-interface/gigi.h	(revision 223704)
+++ gcc-interface/gigi.h	(working copy)
@@ -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,
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 223704)
+++ gcc-interface/trans.c	(working copy)
@@ -4241,11 +4241,11 @@ Call_to_gnu (Node_Id gnat_node, tree *gn
 
       /* 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:

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]