+2015-06-01 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gcc-interface/gigi.h (build_simple_component_ref): Declare.
+ * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Variable>: Deal with
+ address clause on aliased object with unconstrained nominal subtype.
+ Mark the aligning variable as artificial, do not convert the address
+ expression immediately but mark it as constant instead.
+ * gcc-interface/utils.c (convert): If the target type contains a
+ template, be prepared for an empty array.
+ (maybe_unconstrained_array): Likewise.
+ * gcc-interface/utils2.c (known_alignment) <POINTER_PLUS_EXPR>: Deal
+ with the pattern built for aligning types.
+ <INTEGER_CST>: Do not cap the value at BIGGEST_ALIGNMENT.
+ (build_simple_component_ref): Make public.
+ If the base object is a constructor that contains a template, fold the
+ result field by field.
+
2015-05-31 Eric Botcazou <ebotcazou@adacore.com>
* s-oscons-tmplt.c: Add explicit tests for Android alongside Linux.
check_ok_for_atomic_type (gnu_inner, gnat_entity, true);
}
- /* If this is an aliased object with an unconstrained nominal subtype,
- make a type that includes the template. */
+ /* If this is an aliased object with an unconstrained array nominal
+ subtype, make a type that includes the template. We will either
+ allocate or create a variable of that type, see below. */
if (Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
&& Is_Array_Type (Underlying_Type (Etype (gnat_entity)))
&& !type_annotate_only)
effects in this case. */
if (definition && Present (Address_Clause (gnat_entity)))
{
- Node_Id gnat_expr = Expression (Address_Clause (gnat_entity));
+ const Node_Id gnat_clause = Address_Clause (gnat_entity);
+ Node_Id gnat_expr = Expression (gnat_clause);
tree gnu_address
= present_gnu_tree (gnat_entity)
? get_gnu_tree (gnat_entity) : gnat_to_gnu (gnat_expr);
|| compile_time_known_address_p (gnat_expr);
gnu_size = NULL_TREE;
+ /* If this is an aliased object with an unconstrained array nominal
+ subtype, then it can overlay only another aliased object with an
+ unconstrained array nominal subtype and compatible template. */
+ if (Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
+ && Is_Array_Type (Underlying_Type (Etype (gnat_entity)))
+ && !type_annotate_only)
+ {
+ tree rec_type = TREE_TYPE (gnu_type);
+ tree off = byte_position (DECL_CHAIN (TYPE_FIELDS (rec_type)));
+
+ /* This is the pattern built for a regular object. */
+ if (TREE_CODE (gnu_address) == POINTER_PLUS_EXPR
+ && TREE_OPERAND (gnu_address, 1) == off)
+ gnu_address = TREE_OPERAND (gnu_address, 0);
+ /* This is the pattern built for an overaligned object. */
+ else if (TREE_CODE (gnu_address) == POINTER_PLUS_EXPR
+ && TREE_CODE (TREE_OPERAND (gnu_address, 1))
+ == PLUS_EXPR
+ && TREE_OPERAND (TREE_OPERAND (gnu_address, 1), 1)
+ == off)
+ gnu_address
+ = build2 (POINTER_PLUS_EXPR, gnu_type,
+ TREE_OPERAND (gnu_address, 0),
+ TREE_OPERAND (TREE_OPERAND (gnu_address, 1), 0));
+ else
+ {
+ post_error_ne ("aliased object& with unconstrained array "
+ "nominal subtype", gnat_clause,
+ gnat_entity);
+ post_error ("\\can overlay only aliased object with "
+ "compatible subtype", gnat_clause);
+ }
+ }
+
/* If this is a deferred constant, the initializer is attached to
the full view. */
if (kind == E_Constant && Present (Full_View (gnat_entity)))
else
gnu_expr
= build2 (COMPOUND_EXPR, gnu_type,
- build_binary_op
- (MODIFY_EXPR, NULL_TREE,
- build_unary_op (INDIRECT_REF, NULL_TREE,
- gnu_address),
- gnu_expr),
+ build_binary_op (INIT_EXPR, NULL_TREE,
+ build_unary_op (INDIRECT_REF,
+ NULL_TREE,
+ gnu_address),
+ gnu_expr),
gnu_address);
}
/* If this object would go into the stack and has an alignment larger
than the largest stack alignment the back-end can honor, resort to
a variable of "aligning type". */
- if (!global_bindings_p () && !static_p && definition
- && !imported_p && TYPE_ALIGN (gnu_type) > BIGGEST_ALIGNMENT)
+ if (definition
+ && !global_bindings_p ()
+ && !static_p
+ && !imported_p
+ && TYPE_ALIGN (gnu_type) > BIGGEST_ALIGNMENT)
{
/* Create the new variable. No need for extra room before the
aligned field as this is in automatic storage. */
= create_var_decl (create_concat_name (gnat_entity, "ALIGN"),
NULL_TREE, gnu_new_type, NULL_TREE, false,
false, false, false, NULL, gnat_entity);
+ DECL_ARTIFICIAL (gnu_new_var) = 1;
/* Initialize the aligned field if we have an initializer. */
if (gnu_expr)
add_stmt_with_node
- (build_binary_op (MODIFY_EXPR, NULL_TREE,
+ (build_binary_op (INIT_EXPR, NULL_TREE,
build_component_ref
(gnu_new_var, NULL_TREE,
TYPE_FIELDS (gnu_new_type), false),
gnu_type = build_reference_type (gnu_type);
gnu_expr
= build_unary_op
- (ADDR_EXPR, gnu_type,
+ (ADDR_EXPR, NULL_TREE,
build_component_ref (gnu_new_var, NULL_TREE,
TYPE_FIELDS (gnu_new_type), false));
+ TREE_CONSTANT (gnu_expr) = 1;
used_by_ref = true;
const_flag = true;
gnu_size = NULL_TREE;
}
- /* If this is an aliased object with an unconstrained nominal subtype,
- we make its type a thin reference, i.e. the reference counterpart
- of a thin pointer, so that it points to the array part. This is
- aimed at making it easier for the debugger to decode the object.
- Note that we have to do that this late because of the couple of
- allocation adjustments that might be made just above. */
+ /* If this is an aliased object with an unconstrained array nominal
+ subtype, we make its type a thin reference, i.e. the reference
+ counterpart of a thin pointer, so it points to the array part.
+ This is aimed to make it easier for the debugger to decode the
+ object. Note that we have to do it this late because of the
+ couple of allocation adjustments that might be made above. */
if (Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
&& Is_Array_Type (Underlying_Type (Etype (gnat_entity)))
&& !type_annotate_only)
{
- tree gnu_array
- = gnat_to_gnu_type (Base_Type (Etype (gnat_entity)));
-
/* In case the object with the template has already been allocated
just above, we have nothing to do here. */
if (!TYPE_IS_THIN_POINTER_P (gnu_type))
const_flag, Is_Public (gnat_entity),
imported_p || !definition, static_p,
NULL, gnat_entity);
- gnu_expr
- = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_unc_var);
+ gnu_expr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_unc_var);
TREE_CONSTANT (gnu_expr) = 1;
used_by_ref = true;
gnu_size = NULL_TREE;
}
+ tree gnu_array
+ = gnat_to_gnu_type (Base_Type (Etype (gnat_entity)));
gnu_type
= build_reference_type (TYPE_OBJECT_RECORD_TYPE (gnu_array));
}
/* Return a COMPONENT_REF to access a field that is given by COMPONENT,
an IDENTIFIER_NODE giving the name of the field, FIELD, a FIELD_DECL,
for the field, or both. Don't fold the result if NO_FOLD_P. */
+extern tree build_simple_component_ref (tree record_variable, tree component,
+ tree field, bool no_fold_p);
+
+/* Likewise, but generate a Constraint_Error if the reference could not be
+ found. */
extern tree build_component_ref (tree record_variable, tree component,
tree field, bool no_fold_p);
CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (type),
build_template (TREE_TYPE (TYPE_FIELDS (type)),
obj_type, NULL_TREE));
- CONSTRUCTOR_APPEND_ELT (v, DECL_CHAIN (TYPE_FIELDS (type)),
- convert (obj_type, expr));
+ if (expr)
+ CONSTRUCTOR_APPEND_ELT (v, DECL_CHAIN (TYPE_FIELDS (type)),
+ convert (obj_type, expr));
return gnat_build_constructor (type, v);
}
if (TYPE_CONTAINS_TEMPLATE_P (type))
{
- exp = build_component_ref (exp, NULL_TREE,
- DECL_CHAIN (TYPE_FIELDS (type)),
- false);
- type = TREE_TYPE (exp);
+ exp = build_simple_component_ref (exp, NULL_TREE,
+ DECL_CHAIN (TYPE_FIELDS (type)),
+ false);
/* If the array type is padded, convert to the unpadded type. */
- if (TYPE_IS_PADDING_P (type))
- exp = convert (TREE_TYPE (TYPE_FIELDS (type)), exp);
+ if (exp && TYPE_IS_PADDING_P (TREE_TYPE (exp)))
+ exp = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (exp))), exp);
}
break;
return type;
}
\f
-/* EXP is a GCC tree representing an address. See if we can find how
- strictly the object at that address is aligned. Return that alignment
- in bits. If we don't know anything about the alignment, return 0. */
+/* EXP is a GCC tree representing an address. See if we can find how strictly
+ the object at this address is aligned and, if so, return the alignment of
+ the object in bits. Otherwise return 0. */
unsigned int
known_alignment (tree exp)
break;
case COMPOUND_EXPR:
- /* The value of a COMPOUND_EXPR is that of it's second operand. */
+ /* The value of a COMPOUND_EXPR is that of its second operand. */
this_alignment = known_alignment (TREE_OPERAND (exp, 1));
break;
case PLUS_EXPR:
case MINUS_EXPR:
- /* If two address are added, the alignment of the result is the
+ /* If two addresses are added, the alignment of the result is the
minimum of the two alignments. */
lhs = known_alignment (TREE_OPERAND (exp, 0));
rhs = known_alignment (TREE_OPERAND (exp, 1));
break;
case POINTER_PLUS_EXPR:
- lhs = known_alignment (TREE_OPERAND (exp, 0));
- rhs = known_alignment (TREE_OPERAND (exp, 1));
+ /* If this is the pattern built for aligning types, decode it. */
+ if (TREE_CODE (TREE_OPERAND (exp, 1)) == BIT_AND_EXPR
+ && TREE_CODE (TREE_OPERAND (TREE_OPERAND (exp, 1), 0)) == NEGATE_EXPR)
+ {
+ tree op = TREE_OPERAND (TREE_OPERAND (exp, 1), 1);
+ return
+ known_alignment (fold_build1 (BIT_NOT_EXPR, TREE_TYPE (op), op));
+ }
+
/* If we don't know the alignment of the offset, we assume that
of the base. */
+ lhs = known_alignment (TREE_OPERAND (exp, 0));
+ rhs = known_alignment (TREE_OPERAND (exp, 1));
+
if (rhs == 0)
this_alignment = lhs;
else
break;
case COND_EXPR:
- /* If there is a choice between two values, use the smallest one. */
+ /* If there is a choice between two values, use the smaller one. */
lhs = known_alignment (TREE_OPERAND (exp, 1));
rhs = known_alignment (TREE_OPERAND (exp, 2));
this_alignment = MIN (lhs, rhs);
unsigned HOST_WIDE_INT c = TREE_INT_CST_LOW (exp);
/* The first part of this represents the lowest bit in the constant,
but it is originally in bytes, not bits. */
- this_alignment = MIN (BITS_PER_UNIT * (c & -c), BIGGEST_ALIGNMENT);
+ this_alignment = (c & -c) * BITS_PER_UNIT;
}
break;
return known_alignment (t);
}
- /* Fall through... */
+ /* ... fall through ... */
default:
/* For other pointer expressions, we assume that the pointed-to object
We also handle the fact that we might have been passed a pointer to the
actual record and know how to look for fields in variant parts. */
-static tree
+tree
build_simple_component_ref (tree record_variable, tree component, tree field,
bool no_fold_p)
{
if (TREE_CODE (base) == CONSTRUCTOR
&& TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (base)))
{
- vec<constructor_elt, va_gc> *elts = CONSTRUCTOR_ELTS (base);
- unsigned HOST_WIDE_INT idx;
- tree index, value;
- FOR_EACH_CONSTRUCTOR_ELT (elts, idx, index, value)
- if (index == field)
- return value;
+ unsigned int len = CONSTRUCTOR_NELTS (base);
+ gcc_assert (len > 0);
+
+ if (field == CONSTRUCTOR_ELT (base, 0)->index)
+ return CONSTRUCTOR_ELT (base, 0)->value;
+
+ if (len > 1)
+ {
+ if (field == CONSTRUCTOR_ELT (base, 1)->index)
+ return CONSTRUCTOR_ELT (base, 1)->value;
+ }
+ else
+ return NULL_TREE;
+
return ref;
}
return fold (ref);
}
-\f
+
/* Likewise, but generate a Constraint_Error if the reference could not be
found. */
+2015-06-01 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gnat.dg/addr9_1.adb: New test.
+ * gnat.dg/addr9_2.adb: Likewise.
+ * gnat.dg/addr9_3.adb: Likewise.
+ * gnat.dg/addr9_4.adb: Likewise.
+
2015-05-31 Eric Botcazou <ebotcazou@adacore.com>
* g++.dg/other/dump-ada-spec-4.C: New test.
--- /dev/null
+-- { dg-do compile }\r
+\r
+with Ada.Streams; use Ada.Streams;\r
+\r
+procedure Addr9_1 is\r
+\r
+ type Signal_Type is mod 2 ** 16;\r
+\r
+ type A_Item is record\r
+ I : Signal_Type;\r
+ Q : Signal_Type;\r
+ end record\r
+ with Size => 32;\r
+\r
+ for A_Item use record\r
+ I at 0 range 0 .. 15;\r
+ Q at 2 range 0 .. 15;\r
+ end record;\r
+\r
+ type A_Array_Type is\r
+ array (Positive range <>)\r
+ of A_Item\r
+ with Alignment => 16;\r
+\r
+ pragma Pack (A_Array_Type);\r
+\r
+ type B_Array_Type is new Ada.Streams.Stream_Element_Array\r
+ with Alignment => 16;\r
+\r
+ Ct_Count : constant := 7_000;\r
+\r
+ package Set is\r
+ A : aliased A_Array_Type := (1 .. Ct_Count => <>);\r
+ B : aliased B_Array_Type := (1 .. Ct_Count * A_Item'Size / 8 => <>);\r
+ for B'Address use A'Address;\r
+ end Set;\r
+\r
+begin\r
+ null;\r
+end;\r
--- /dev/null
+-- { dg-do compile }\r
+\r
+with Ada.Streams; use Ada.Streams;\r
+\r
+procedure Addr9_2 is\r
+\r
+ type Signal_Type is mod 2 ** 16;\r
+\r
+ type A_Item is record\r
+ I : Signal_Type;\r
+ Q : Signal_Type;\r
+ end record\r
+ with Size => 32;\r
+\r
+ for A_Item use record\r
+ I at 0 range 0 .. 15;\r
+ Q at 2 range 0 .. 15;\r
+ end record;\r
+\r
+ type A_Array_Type is\r
+ array (Positive range <>)\r
+ of A_Item\r
+ with Alignment => 16;\r
+\r
+ pragma Pack (A_Array_Type);\r
+\r
+ type B_Array_Type is new Ada.Streams.Stream_Element_Array\r
+ with Alignment => 16;\r
+\r
+ Ct_Count : constant := 7_000;\r
+\r
+ package Set is\r
+ A : A_Array_Type := (1 .. Ct_Count => <>);\r
+ B : aliased B_Array_Type := (1 .. Ct_Count * A_Item'Size / 8 => <>);\r
+ for B'Address use A'Address; -- { dg-warning "aliased object" }\r
+ end Set;\r
+\r
+begin\r
+ null;\r
+end;\r
--- /dev/null
+-- { dg-do compile }\r
+\r
+with Ada.Streams; use Ada.Streams;\r
+\r
+procedure Addr9_3 is\r
+\r
+ type Signal_Type is mod 2 ** 16;\r
+\r
+ type A_Item is record\r
+ I : Signal_Type;\r
+ Q : Signal_Type;\r
+ end record\r
+ with Size => 32;\r
+\r
+ for A_Item use record\r
+ I at 0 range 0 .. 15;\r
+ Q at 2 range 0 .. 15;\r
+ end record;\r
+\r
+ type A_Array_Type is\r
+ array (Positive range <>)\r
+ of A_Item\r
+ with Alignment => 16;\r
+\r
+ pragma Pack (A_Array_Type);\r
+\r
+ type B_Array_Type is new Ada.Streams.Stream_Element_Array\r
+ with Alignment => 16;\r
+\r
+ Ct_Count : constant := 7_000;\r
+\r
+ package Set is\r
+ A : aliased A_Array_Type := (1 .. Ct_Count => <>);\r
+ B : B_Array_Type := (1 .. Ct_Count * A_Item'Size / 8 => <>);\r
+ for B'Address use A'Address;\r
+ end Set;\r
+\r
+begin\r
+ null;\r
+end;\r
--- /dev/null
+-- { dg-do compile }\r
+\r
+with Ada.Streams; use Ada.Streams;\r
+\r
+procedure Addr9_4 is\r
+\r
+ type Signal_Type is mod 2 ** 16;\r
+\r
+ type A_Item is record\r
+ I : Signal_Type;\r
+ Q : Signal_Type;\r
+ end record\r
+ with Size => 32;\r
+\r
+ for A_Item use record\r
+ I at 0 range 0 .. 15;\r
+ Q at 2 range 0 .. 15;\r
+ end record;\r
+\r
+ type A_Array_Type is\r
+ array (Positive range <>)\r
+ of A_Item\r
+ with Alignment => 16;\r
+\r
+ pragma Pack (A_Array_Type);\r
+\r
+ type B_Array_Type is new Ada.Streams.Stream_Element_Array\r
+ with Alignment => 16;\r
+\r
+ Ct_Count : constant := 7_000;\r
+\r
+ package Set is\r
+ A : A_Array_Type := (1 .. Ct_Count => <>);\r
+ B : B_Array_Type := (1 .. Ct_Count * A_Item'Size / 8 => <>);\r
+ for B'Address use A'Address;\r
+ end Set;\r
+\r
+begin\r
+ null;\r
+end;\r
projects / gcc.git / commitdiff