From 73a1a803087a914aea66321618595bf6c9614d67 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 1 Jun 2015 07:43:09 +0000 Subject: [PATCH] gigi.h (build_simple_component_ref): Declare. * gcc-interface/gigi.h (build_simple_component_ref): Declare. * gcc-interface/decl.c (gnat_to_gnu_entity) : 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) : Deal with the pattern built for aligning types. : 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. From-SVN: r223912 --- gcc/ada/ChangeLog | 17 +++++++ gcc/ada/gcc-interface/decl.c | 85 ++++++++++++++++++++++--------- gcc/ada/gcc-interface/gigi.h | 5 ++ gcc/ada/gcc-interface/utils.c | 16 +++--- gcc/ada/gcc-interface/utils2.c | 54 +++++++++++++------- gcc/testsuite/ChangeLog | 7 +++ gcc/testsuite/gnat.dg/addr9_1.adb | 40 +++++++++++++++ gcc/testsuite/gnat.dg/addr9_2.adb | 40 +++++++++++++++ gcc/testsuite/gnat.dg/addr9_3.adb | 40 +++++++++++++++ gcc/testsuite/gnat.dg/addr9_4.adb | 40 +++++++++++++++ 10 files changed, 295 insertions(+), 49 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/addr9_1.adb create mode 100644 gcc/testsuite/gnat.dg/addr9_2.adb create mode 100644 gcc/testsuite/gnat.dg/addr9_3.adb create mode 100644 gcc/testsuite/gnat.dg/addr9_4.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ca8f0f3f073..a2887e88b0e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +2015-06-01 Eric Botcazou + + * gcc-interface/gigi.h (build_simple_component_ref): Declare. + * gcc-interface/decl.c (gnat_to_gnu_entity) : 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) : Deal + with the pattern built for aligning types. + : 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 * s-oscons-tmplt.c: Add explicit tests for Android alongside Linux. diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 0142e8e56b3..966bf8e1309 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)); } diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index 65f871bf895..91d9f9cfb58 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -914,6 +914,11 @@ extern tree gnat_build_constructor (tree type, vec *v); /* 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); diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 0871c3cbe3b..31bb3d254ed 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -4092,8 +4092,9 @@ convert (tree type, tree expr) 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); } @@ -4699,14 +4700,13 @@ maybe_unconstrained_array (tree exp) 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; diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c index cc2c645ff48..12d9ea95d7c 100644 --- a/gcc/ada/gcc-interface/utils2.c +++ b/gcc/ada/gcc-interface/utils2.c @@ -78,9 +78,9 @@ get_base_type (tree type) return type; } -/* 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) @@ -99,13 +99,13 @@ 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)); @@ -113,10 +113,20 @@ known_alignment (tree exp) 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 @@ -124,7 +134,7 @@ known_alignment (tree exp) 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); @@ -135,7 +145,7 @@ known_alignment (tree exp) 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; @@ -172,7 +182,7 @@ known_alignment (tree exp) return known_alignment (t); } - /* Fall through... */ + /* ... fall through ... */ default: /* For other pointer expressions, we assume that the pointed-to object @@ -1990,7 +2000,7 @@ gnat_build_constructor (tree type, vec *v) 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) { @@ -2128,18 +2138,26 @@ build_simple_component_ref (tree record_variable, tree component, tree field, if (TREE_CODE (base) == CONSTRUCTOR && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (base))) { - vec *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); } - + /* Likewise, but generate a Constraint_Error if the reference could not be found. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7d9e46da773..3cafd133bc5 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2015-06-01 Eric Botcazou + + * 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 * g++.dg/other/dump-ada-spec-4.C: New test. diff --git a/gcc/testsuite/gnat.dg/addr9_1.adb b/gcc/testsuite/gnat.dg/addr9_1.adb new file mode 100644 index 00000000000..d3fc335b982 --- /dev/null +++ b/gcc/testsuite/gnat.dg/addr9_1.adb @@ -0,0 +1,40 @@ +-- { dg-do compile } + +with Ada.Streams; use Ada.Streams; + +procedure Addr9_1 is + + type Signal_Type is mod 2 ** 16; + + type A_Item is record + I : Signal_Type; + Q : Signal_Type; + end record + with Size => 32; + + for A_Item use record + I at 0 range 0 .. 15; + Q at 2 range 0 .. 15; + end record; + + type A_Array_Type is + array (Positive range <>) + of A_Item + with Alignment => 16; + + pragma Pack (A_Array_Type); + + type B_Array_Type is new Ada.Streams.Stream_Element_Array + with Alignment => 16; + + Ct_Count : constant := 7_000; + + package Set is + A : aliased A_Array_Type := (1 .. Ct_Count => <>); + B : aliased B_Array_Type := (1 .. Ct_Count * A_Item'Size / 8 => <>); + for B'Address use A'Address; + end Set; + +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/addr9_2.adb b/gcc/testsuite/gnat.dg/addr9_2.adb new file mode 100644 index 00000000000..64130e264c9 --- /dev/null +++ b/gcc/testsuite/gnat.dg/addr9_2.adb @@ -0,0 +1,40 @@ +-- { dg-do compile } + +with Ada.Streams; use Ada.Streams; + +procedure Addr9_2 is + + type Signal_Type is mod 2 ** 16; + + type A_Item is record + I : Signal_Type; + Q : Signal_Type; + end record + with Size => 32; + + for A_Item use record + I at 0 range 0 .. 15; + Q at 2 range 0 .. 15; + end record; + + type A_Array_Type is + array (Positive range <>) + of A_Item + with Alignment => 16; + + pragma Pack (A_Array_Type); + + type B_Array_Type is new Ada.Streams.Stream_Element_Array + with Alignment => 16; + + Ct_Count : constant := 7_000; + + package Set is + A : A_Array_Type := (1 .. Ct_Count => <>); + B : aliased B_Array_Type := (1 .. Ct_Count * A_Item'Size / 8 => <>); + for B'Address use A'Address; -- { dg-warning "aliased object" } + end Set; + +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/addr9_3.adb b/gcc/testsuite/gnat.dg/addr9_3.adb new file mode 100644 index 00000000000..f7e31621551 --- /dev/null +++ b/gcc/testsuite/gnat.dg/addr9_3.adb @@ -0,0 +1,40 @@ +-- { dg-do compile } + +with Ada.Streams; use Ada.Streams; + +procedure Addr9_3 is + + type Signal_Type is mod 2 ** 16; + + type A_Item is record + I : Signal_Type; + Q : Signal_Type; + end record + with Size => 32; + + for A_Item use record + I at 0 range 0 .. 15; + Q at 2 range 0 .. 15; + end record; + + type A_Array_Type is + array (Positive range <>) + of A_Item + with Alignment => 16; + + pragma Pack (A_Array_Type); + + type B_Array_Type is new Ada.Streams.Stream_Element_Array + with Alignment => 16; + + Ct_Count : constant := 7_000; + + package Set is + A : aliased A_Array_Type := (1 .. Ct_Count => <>); + B : B_Array_Type := (1 .. Ct_Count * A_Item'Size / 8 => <>); + for B'Address use A'Address; + end Set; + +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/addr9_4.adb b/gcc/testsuite/gnat.dg/addr9_4.adb new file mode 100644 index 00000000000..526d2a01514 --- /dev/null +++ b/gcc/testsuite/gnat.dg/addr9_4.adb @@ -0,0 +1,40 @@ +-- { dg-do compile } + +with Ada.Streams; use Ada.Streams; + +procedure Addr9_4 is + + type Signal_Type is mod 2 ** 16; + + type A_Item is record + I : Signal_Type; + Q : Signal_Type; + end record + with Size => 32; + + for A_Item use record + I at 0 range 0 .. 15; + Q at 2 range 0 .. 15; + end record; + + type A_Array_Type is + array (Positive range <>) + of A_Item + with Alignment => 16; + + pragma Pack (A_Array_Type); + + type B_Array_Type is new Ada.Streams.Stream_Element_Array + with Alignment => 16; + + Ct_Count : constant := 7_000; + + package Set is + A : A_Array_Type := (1 .. Ct_Count => <>); + B : B_Array_Type := (1 .. Ct_Count * A_Item'Size / 8 => <>); + for B'Address use A'Address; + end Set; + +begin + null; +end; -- 2.30.2