ada-tree.h (TREE_THIS_NOTRAP): Redefine.

	* gcc-interface/ada-tree.h (TREE_THIS_NOTRAP): Redefine.
	* gcc-interface/trans.c (Identifier_to_gnu): Factor out common code in
	the by-ref case.  Do not set TREE_READONLY on a renamed object.  Set
	TREE_THIS_NOTRAP on UNCONSTRAINED_ARRAY_REF nodes.
	(Attribute_to_gnu) <Attr_Length>: Expand the use of the parameter cache
	to the indirect case.
	* gcc-interface/utils.c (convert) <UNCONSTRAINED_ARRAY_REF>: Preserve
	the TREE_THIS_NOTRAP flag.

From-SVN: r179171

gcc/ada/ChangeLog

 2011-09-25  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* gcc-interface/ada-tree.h (TREE_THIS_NOTRAP): Redefine.
+	* gcc-interface/trans.c (Identifier_to_gnu): Factor out common code in
+	the by-ref case.  Do not set TREE_READONLY on a renamed object.  Set
+	TREE_THIS_NOTRAP on UNCONSTRAINED_ARRAY_REF nodes.
+	(Attribute_to_gnu) <Attr_Length>: Expand the use of the parameter cache
+	to the indirect case.
+	* gcc-interface/utils.c (convert) <UNCONSTRAINED_ARRAY_REF>: Preserve
+	the TREE_THIS_NOTRAP flag.
+
+2011-09-25  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gcc-interface/trans.c (Loop_Statement_to_gnu): In the case of an
 	iteration scheme, always generate the do-while form if optimization
 	is enabled.  Use more straightforward test at the end.

gcc/ada/gcc-interface/ada-tree.h

@@ -426,6 +426,15 @@ do {						   \
   SET_DECL_LANG_SPECIFIC (PARM_DECL_CHECK (NODE), X)
 
 
+/* Flags added to ref nodes.  */
+
+/* Nonzero means this node will not trap.  */
+#undef TREE_THIS_NOTRAP
+#define TREE_THIS_NOTRAP(NODE) \
+  (TREE_CHECK4 (NODE, INDIRECT_REF, ARRAY_REF, UNCONSTRAINED_ARRAY_REF, \
+		ARRAY_RANGE_REF)->base.nothrow_flag)
+
+
 /* Fields and macros for statements.  */
 #define IS_ADA_STMT(NODE) \
   (STATEMENT_CLASS_P (NODE) && TREE_CODE (NODE) >= STMT_STMT)

gcc/ada/gcc-interface/trans.c

@@ -989,8 +989,8 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
 	      && DECL_BY_COMPONENT_PTR_P (gnu_result))))
     {
       const bool read_only = DECL_POINTS_TO_READONLY_P (gnu_result);
-      tree renamed_obj;
 
+      /* First do the first dereference if needed.  */
       if (TREE_CODE (gnu_result) == PARM_DECL
 	  && DECL_BY_DOUBLE_REF_P (gnu_result))
 	{
@@ -999,42 +999,37 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
 	    TREE_THIS_NOTRAP (gnu_result) = 1;
 	}
 
+      /* If it's a PARM_DECL to foreign convention subprogram, convert it.  */
       if (TREE_CODE (gnu_result) == PARM_DECL
 	  && DECL_BY_COMPONENT_PTR_P (gnu_result))
-	{
-	  gnu_result
-	    = build_unary_op (INDIRECT_REF, NULL_TREE,
-			      convert (build_pointer_type (gnu_result_type),
-				       gnu_result));
-	  if (TREE_CODE (gnu_result) == INDIRECT_REF)
-	    TREE_THIS_NOTRAP (gnu_result) = 1;
-	}
+	gnu_result
+	  = convert (build_pointer_type (gnu_result_type), gnu_result);
+
+      /* If it's a CONST_DECL, return the underlying constant like below.  */
+      else if (TREE_CODE (gnu_result) == CONST_DECL)
+	gnu_result = DECL_INITIAL (gnu_result);
 
       /* If it's a renaming pointer and we are at the right binding level,
 	 we can reference the renamed object directly, since the renamed
 	 expression has been protected against multiple evaluations.  */
-      else if (TREE_CODE (gnu_result) == VAR_DECL
-	       && (renamed_obj = DECL_RENAMED_OBJECT (gnu_result))
-	       && (!DECL_RENAMING_GLOBAL_P (gnu_result)
-		   || global_bindings_p ()))
-	gnu_result = renamed_obj;
-
-      /* Return the underlying CST for a CONST_DECL like a few lines below,
-	 after dereferencing in this case.  */
-      else if (TREE_CODE (gnu_result) == CONST_DECL)
-	gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE,
-				     DECL_INITIAL (gnu_result));
+      if (TREE_CODE (gnu_result) == VAR_DECL
+	  && DECL_RENAMED_OBJECT (gnu_result)
+	  && (!DECL_RENAMING_GLOBAL_P (gnu_result) || global_bindings_p ()))
+	gnu_result = DECL_RENAMED_OBJECT (gnu_result);
 
+      /* Otherwise, do the final dereference.  */
       else
 	{
 	  gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result);
-	  if (TREE_CODE (gnu_result) == INDIRECT_REF
+
+	  if ((TREE_CODE (gnu_result) == INDIRECT_REF
+	       || TREE_CODE (gnu_result) == UNCONSTRAINED_ARRAY_REF)
 	      && No (Address_Clause (gnat_temp)))
 	    TREE_THIS_NOTRAP (gnu_result) = 1;
-	}
 
-      if (read_only)
-	TREE_READONLY (gnu_result) = 1;
+	  if (read_only)
+	    TREE_READONLY (gnu_result) = 1;
+	}
     }
 
   /* The GNAT tree has the type of a function as the type of its result.  Also
@@ -1597,11 +1592,26 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
 	/* Make sure any implicit dereference gets done.  */
 	gnu_prefix = maybe_implicit_deref (gnu_prefix);
 	gnu_prefix = maybe_unconstrained_array (gnu_prefix);
+
 	/* We treat unconstrained array In parameters specially.  */
-	if (Nkind (Prefix (gnat_node)) == N_Identifier
-	    && !Is_Constrained (Etype (Prefix (gnat_node)))
-	    && Ekind (Entity (Prefix (gnat_node))) == E_In_Parameter)
-	  gnat_param = Entity (Prefix (gnat_node));
+	if (!Is_Constrained (Etype (Prefix (gnat_node))))
+	  {
+	    Node_Id gnat_prefix = Prefix (gnat_node);
+
+	    /* This is the direct case.  */
+	    if (Nkind (gnat_prefix) == N_Identifier
+		&& Ekind (Entity (gnat_prefix)) == E_In_Parameter)
+	      gnat_param = Entity (gnat_prefix);
+
+	    /* This is the indirect case.  Note that we need to be sure that
+	       the access value cannot be null as we'll hoist the load.  */
+	    if (Nkind (gnat_prefix) == N_Explicit_Dereference
+		&& Nkind (Prefix (gnat_prefix)) == N_Identifier
+		&& Ekind (Entity (Prefix (gnat_prefix))) == E_In_Parameter
+		&& Can_Never_Be_Null (Entity (Prefix (gnat_prefix))))
+	      gnat_param = Entity (Prefix (gnat_prefix));
+	  }
+
 	gnu_type = TREE_TYPE (gnu_prefix);
 	prefix_unused = true;
 	gnu_result_type = get_unpadded_type (Etype (gnat_node));

gcc/ada/gcc-interface/utils.c

@@ -3947,17 +3947,21 @@ convert (tree type, tree expr)
       break;
 
     case UNCONSTRAINED_ARRAY_REF:
-      /* Convert this to the type of the inner array by getting the address of
-	 the array from the template.  */
-      expr = TREE_OPERAND (expr, 0);
-      expr = build_unary_op (INDIRECT_REF, NULL_TREE,
-			     build_component_ref (expr, NULL_TREE,
-						  TYPE_FIELDS
-						  (TREE_TYPE (expr)),
-						  false));
-      etype = TREE_TYPE (expr);
-      ecode = TREE_CODE (etype);
-      break;
+      {
+	/* Convert this to the type of the inner array by getting the address
+	   of the array from the template.  */
+	const bool no_trap = TREE_THIS_NOTRAP (expr);
+	expr = TREE_OPERAND (expr, 0);
+	expr = build_unary_op (INDIRECT_REF, NULL_TREE,
+			       build_component_ref (expr, NULL_TREE,
+						    TYPE_FIELDS
+						    (TREE_TYPE (expr)),
+						    false));
+	TREE_THIS_NOTRAP (expr) = no_trap;
+	etype = TREE_TYPE (expr);
+	ecode = TREE_CODE (etype);
+	break;
+      }
 
     case VIEW_CONVERT_EXPR:
       {
@@ -3992,8 +3996,9 @@ convert (tree type, tree expr)
 		     && !TYPE_IS_FAT_POINTER_P (etype))
 	      return convert (type, op0);
 	  }
+
+	break;
       }
-      break;
 
     default:
       break;