aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/gcc-interface/decl.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/ada/gcc-interface/decl.c')
-rw-r--r--gcc/ada/gcc-interface/decl.c85
1 files changed, 62 insertions, 23 deletions
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 0142e8e..966bf8e 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -882,8 +882,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
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)
@@ -1149,7 +1150,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
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);
@@ -1167,6 +1169,40 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|| 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)))
@@ -1183,11 +1219,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
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);
}
@@ -1302,8 +1338,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* 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. */
@@ -1315,11 +1354,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
= 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),
@@ -1330,28 +1370,26 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
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))
@@ -1362,8 +1400,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
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;
@@ -1372,6 +1409,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
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));
}
generated by cgit v1.1 at 2025-05-02 22:01:41 +0000