===================================================================
@@ -1391,10 +1391,14 @@ create_var_decl_1 (tree var_name, tree a
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 a
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 n
/* 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
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.. */
===================================================================
@@ -2009,6 +2009,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
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. */
===================================================================
@@ -420,6 +420,80 @@ compare_arrays (location_t loc, tree res
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,
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;
===================================================================
@@ -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. */
===================================================================
@@ -1052,6 +1052,7 @@ Identifier_to_gnu (Node_Id gnat_node, tr
&& 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