ada-tree.h (TYPE_NULL_BOUNDS): New macro.

	* gcc-interface/ada-tree.h (TYPE_NULL_BOUNDS): New macro.
	(SET_TYPE_NULL_BOUNDS): Likewise.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Type>: Set again
	TREE_THIS_NOTRAP on the INDIRECT_REF node built for the template.
	* gcc-interface/trans.c (Identifier_to_gnu): Return initializers of fat
	pointer types.
	* gcc-interface/utils.c (create_var_decl_1): If the object is external,
	check that the initializer is a valid constant expression for use in
	initializing a static variable.  Add missing guard.
	(update_pointer_to): Adjust TYPE_NULL_BOUNDS if set.
	(convert_to_fat_pointer): In the null fat pointer case, build a valid
	pointer for the bounds.
	* gcc-interface/utils2.c (compare_fat_pointers): New function.
	(build_binary_op) <EQ_EXPR>: Call it to compare fat pointers.

From-SVN: r179180

gcc/ada/ChangeLog

+2011-09-26  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/ada-tree.h (TYPE_NULL_BOUNDS): New macro.
+	(SET_TYPE_NULL_BOUNDS): Likewise.
+	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Type>: Set again
+	TREE_THIS_NOTRAP on the INDIRECT_REF node built for the template.
+	* gcc-interface/trans.c (Identifier_to_gnu): Return initializers of fat
+	pointer types.
+	* gcc-interface/utils.c (create_var_decl_1): If the object is external,
+	check that the initializer is a valid constant expression for use in
+	initializing a static variable.  Add missing guard.
+	(update_pointer_to): Adjust TYPE_NULL_BOUNDS if set.
+	(convert_to_fat_pointer): In the null fat pointer case, build a valid
+	pointer for the bounds.
+	* gcc-interface/utils2.c (compare_fat_pointers): New function.
+	(build_binary_op) <EQ_EXPR>: Call it to compare fat pointers.
+
 2011-09-25  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/ada-tree.h (TREE_THIS_NOTRAP): Redefine.

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

@@ -275,7 +275,8 @@ do {						   \
 
 /* For an INTEGER_TYPE with TYPE_MODULAR_P, this is the value of the
    modulus. */
-#define TYPE_MODULUS(NODE) GET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))
+#define TYPE_MODULUS(NODE) \
+  GET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))
 #define SET_TYPE_MODULUS(NODE, X) \
   SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X)
 
@@ -301,6 +302,13 @@ do {						   \
 #define SET_TYPE_ACTUAL_BOUNDS(NODE, X) \
   SET_TYPE_LANG_SPECIFIC (TREE_CHECK2 (NODE, INTEGER_TYPE, ARRAY_TYPE), X)
 
+/* For a POINTER_TYPE that points to the template type of an unconstrained
+   array type, this is the address to be used in a null fat pointer.  */
+#define TYPE_NULL_BOUNDS(NODE) \
+  GET_TYPE_LANG_SPECIFIC (POINTER_TYPE_CHECK (NODE))
+#define SET_TYPE_NULL_BOUNDS(NODE, X) \
+  SET_TYPE_LANG_SPECIFIC (POINTER_TYPE_CHECK (NODE), X)
+
 /* For a RECORD_TYPE that is a fat pointer, this is the type for the
    unconstrained object.  Likewise for a RECORD_TYPE that is pointed
    to by a thin pointer.  */

gcc/ada/gcc-interface/decl.c

@@ -2009,6 +2009,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	gnu_template_reference
 	  = build_unary_op (INDIRECT_REF, gnu_template_type, tem);
 	TREE_READONLY (gnu_template_reference) = 1;
+	TREE_THIS_NOTRAP (gnu_template_reference) = 1;
 
 	/* Now create the GCC type for each index and add the fields for that
 	   index to the template.  */

gcc/ada/gcc-interface/trans.c

@@ -1052,6 +1052,7 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
       && DECL_P (gnu_result)
       && DECL_INITIAL (gnu_result)
       && !(AGGREGATE_TYPE_P (TREE_TYPE (gnu_result))
+	   && !TYPE_IS_FAT_POINTER_P (TREE_TYPE (gnu_result))
 	   && type_contains_placeholder_p (TREE_TYPE (gnu_result))))
     {
       bool constant_only = (TREE_CODE (gnu_result) == CONST_DECL

gcc/ada/gcc-interface/utils.c

@@ -1391,10 +1391,14 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init,
 		   bool static_flag, bool const_decl_allowed_p,
 		   struct attrib *attr_list, Node_Id gnat_node)
 {
+  /* Whether the initializer is a constant initializer.  At the global level
+     or for an external object or an object to be allocated in static memory,
+     we check that it is a valid constant expression for use in initializing
+     a static variable; otherwise, we only check that it is constant.  */
   bool init_const
     = (var_init != 0
        && gnat_types_compatible_p (type, TREE_TYPE (var_init))
-       && (global_bindings_p () || static_flag
+       && (global_bindings_p () || extern_flag || static_flag
 	   ? initializer_constant_valid_p (var_init, TREE_TYPE (var_init)) != 0
 	   : TREE_CONSTANT (var_init)));
 
@@ -1460,6 +1464,7 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init,
      section which runs afoul of the PE-COFF run-time relocation mechanism.  */
   if (extern_flag
       && constant_p
+      && var_init
       && initializer_constant_valid_p (var_init, TREE_TYPE (var_init))
 	   != null_pointer_node)
     DECL_IGNORED_P (var_decl) = 1;
@@ -3489,7 +3494,11 @@ update_pointer_to (tree old_type, tree new_type)
       /* Now adjust them.  */
       for (; ptr; ptr = TYPE_NEXT_PTR_TO (ptr))
 	for (t = TYPE_MAIN_VARIANT (ptr); t; t = TYPE_NEXT_VARIANT (t))
-	  TREE_TYPE (t) = new_type;
+	  {
+	    TREE_TYPE (t) = new_type;
+	    if (TYPE_NULL_BOUNDS (t))
+	      TREE_TYPE (TREE_OPERAND (TYPE_NULL_BOUNDS (t), 0)) = new_type;
+	  }
 
       /* If we have adjusted named types, finalize them.  This is necessary
 	 since we had forced a DWARF typedef for them in gnat_pushdecl.  */
@@ -3560,16 +3569,36 @@ convert_to_fat_pointer (tree type, tree expr)
   tree template_tree;
   VEC(constructor_elt,gc) *v = VEC_alloc (constructor_elt, gc, 2);
 
-  /* If EXPR is null, make a fat pointer that contains null pointers to the
-     template and array.  */
+  /* If EXPR is null, make a fat pointer that contains a null pointer to the
+     array (compare_fat_pointers ensures that this is the full discriminant)
+     and a valid pointer to the bounds.  This latter property is necessary
+     since the compiler can hoist the load of the bounds done through it.  */
   if (integer_zerop (expr))
     {
+      tree ptr_template_type = TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (type)));
+      tree null_bounds, t;
+
+      if (TYPE_NULL_BOUNDS (ptr_template_type))
+	null_bounds = TYPE_NULL_BOUNDS (ptr_template_type);
+      else
+	{
+	  /* The template type can still be dummy at this point so we build an
+	     empty constructor.  The middle-end will fill it in with zeros.  */
+	  t = build_constructor (template_type, NULL);
+	  TREE_CONSTANT (t) = TREE_STATIC (t) = 1;
+	  null_bounds = build_unary_op (ADDR_EXPR, NULL_TREE, t);
+	  SET_TYPE_NULL_BOUNDS (ptr_template_type, null_bounds);
+	}
+
       CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (type),
-			      convert (p_array_type, expr));
-      CONSTRUCTOR_APPEND_ELT (v, DECL_CHAIN (TYPE_FIELDS (type)),
-			      convert (build_pointer_type (template_type),
-				       expr));
-      return gnat_build_constructor (type, v);
+			      fold_convert (p_array_type, null_pointer_node));
+      CONSTRUCTOR_APPEND_ELT (v, DECL_CHAIN (TYPE_FIELDS (type)), null_bounds);
+      t = build_constructor (type, v);
+      /* Do not set TREE_CONSTANT so as to force T to static memory.  */
+      TREE_CONSTANT (t) = 0;
+      TREE_STATIC (t) = 1;
+
+      return t;
     }
 
   /* If EXPR is a thin pointer, make template and data from the record..  */

gcc/ada/gcc-interface/utils2.c

@@ -420,6 +420,80 @@ compare_arrays (location_t loc, tree result_type, tree a1, tree a2)
 
   return result;
 }
+
+/* Return an expression tree representing an equality comparison of P1 and P2,
+   two objects of fat pointer type.  The result should be of type RESULT_TYPE.
+
+   Two fat pointers are equal in one of two ways: (1) if both have a null
+   pointer to the array or (2) if they contain the same couple of pointers.
+   We perform the comparison in as efficient a manner as possible.  */
+
+static tree
+compare_fat_pointers (location_t loc, tree result_type, tree p1, tree p2)
+{
+  tree p1_array, p2_array, p1_bounds, p2_bounds, same_array, same_bounds;
+  tree p1_array_is_null, p2_array_is_null;
+
+  /* If either operand has side-effects, they have to be evaluated only once
+     in spite of the multiple references to the operand in the comparison.  */
+  p1 = gnat_protect_expr (p1);
+  p2 = gnat_protect_expr (p2);
+
+  /* The constant folder doesn't fold fat pointer types so we do it here.  */
+  if (TREE_CODE (p1) == CONSTRUCTOR)
+    p1_array = VEC_index (constructor_elt, CONSTRUCTOR_ELTS (p1), 0)->value;
+  else
+    p1_array = build_component_ref (p1, NULL_TREE,
+				    TYPE_FIELDS (TREE_TYPE (p1)), true);
+
+  p1_array_is_null
+    = fold_build2_loc (loc, EQ_EXPR, result_type, p1_array,
+		       fold_convert_loc (loc, TREE_TYPE (p1_array),
+					 null_pointer_node));
+
+  if (TREE_CODE (p2) == CONSTRUCTOR)
+    p2_array = VEC_index (constructor_elt, CONSTRUCTOR_ELTS (p2), 0)->value;
+  else
+    p2_array = build_component_ref (p2, NULL_TREE,
+				    TYPE_FIELDS (TREE_TYPE (p2)), true);
+
+  p2_array_is_null
+    = fold_build2_loc (loc, EQ_EXPR, result_type, p2_array,
+		       fold_convert_loc (loc, TREE_TYPE (p2_array),
+					 null_pointer_node));
+
+  /* If one of the pointers to the array is null, just compare the other.  */
+  if (integer_zerop (p1_array))
+    return p2_array_is_null;
+  else if (integer_zerop (p2_array))
+    return p1_array_is_null;
+
+  /* Otherwise, do the fully-fledged comparison.  */
+  same_array
+    = fold_build2_loc (loc, EQ_EXPR, result_type, p1_array, p2_array);
+
+  if (TREE_CODE (p1) == CONSTRUCTOR)
+    p1_bounds = VEC_index (constructor_elt, CONSTRUCTOR_ELTS (p1), 1)->value;
+  else
+    p1_bounds
+      = build_component_ref (p1, NULL_TREE,
+			     DECL_CHAIN (TYPE_FIELDS (TREE_TYPE (p1))), true);
+
+  if (TREE_CODE (p2) == CONSTRUCTOR)
+    p2_bounds = VEC_index (constructor_elt, CONSTRUCTOR_ELTS (p2), 1)->value;
+  else
+    p2_bounds
+      = build_component_ref (p2, NULL_TREE,
+			     DECL_CHAIN (TYPE_FIELDS (TREE_TYPE (p2))), true);
+
+  same_bounds
+    = fold_build2_loc (loc, EQ_EXPR, result_type, p1_bounds, p2_bounds);
+
+  /* P1_ARRAY == P2_ARRAY && (P1_ARRAY == NULL || P1_BOUNDS == P2_BOUNDS).  */
+  return build_binary_op (TRUTH_ANDIF_EXPR, result_type, same_array,
+			  build_binary_op (TRUTH_ORIF_EXPR, result_type,
+					   p1_array_is_null, same_bounds));
+}
 
 /* Compute the result of applying OP_CODE to LHS and RHS, where both are of
    type TYPE.  We know that TYPE is a modular type with a nonbinary
@@ -848,19 +922,18 @@ build_binary_op (enum tree_code op_code, tree result_type,
 	  right_operand = convert (right_base_type, right_operand);
 	}
 
-      /* If we are comparing a fat pointer against zero, we just need to
-	 compare the data pointer.  */
-      if (TYPE_IS_FAT_POINTER_P (left_base_type)
-	  && TREE_CODE (right_operand) == CONSTRUCTOR
-	  && integer_zerop (VEC_index (constructor_elt,
-				       CONSTRUCTOR_ELTS (right_operand),
-				       0)->value))
+      /* If both objects are fat pointers, compare them specially.  */
+      if (TYPE_IS_FAT_POINTER_P (left_base_type))
 	{
-	  left_operand
-	    = build_component_ref (left_operand, NULL_TREE,
-				   TYPE_FIELDS (left_base_type), false);
-	  right_operand
-	    = convert (TREE_TYPE (left_operand), integer_zero_node);
+	  result
+	    = compare_fat_pointers (input_location,
+				    result_type, left_operand, right_operand);
+	  if (op_code == NE_EXPR)
+	    result = invert_truthvalue_loc (EXPR_LOCATION (result), result);
+	  else
+	    gcc_assert (op_code == EQ_EXPR);
+
+	  return result;
 	}
 
       modulus = NULL_TREE;