public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-2250] [Ada] Implement support for unconstrained array types with FLB
@ 2021-07-12 12:52 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-07-12 12:52 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:3ccd5d7192603e0ed6d0020658291b7c96f5651b
commit r12-2250-g3ccd5d7192603e0ed6d0020658291b7c96f5651b
Author: Eric Botcazou <ebotcazou@adacore.com>
Date: Tue Apr 27 21:18:12 2021 +0200
[Ada] Implement support for unconstrained array types with FLB
gcc/ada/
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Type>: Use a
fixed lower bound if the index subtype is marked so, as well as a
more efficient formula for the upper bound if the array cannot be
superflat.
(flb_cannot_be_superflat): New predicate.
(cannot_be_superflat): Rename into...
(range_cannot_be_superfla): ...this. Minor tweak.
Diff:
---
gcc/ada/gcc-interface/decl.c | 112 +++++++++++++++++++++++++++++++++----------
1 file changed, 88 insertions(+), 24 deletions(-)
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 83ca31acba5..8eb1e30d447 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -217,7 +217,8 @@ static void set_reverse_storage_order_on_array_type (tree);
static bool same_discriminant_p (Entity_Id, Entity_Id);
static bool array_type_has_nonaliased_component (tree, Entity_Id);
static bool compile_time_known_address_p (Node_Id);
-static bool cannot_be_superflat (Node_Id);
+static bool flb_cannot_be_superflat (Node_Id);
+static bool range_cannot_be_superflat (Node_Id);
static bool constructor_address_p (tree);
static bool allocatable_size_p (tree, bool);
static bool initial_value_needs_conversion (tree, tree);
@@ -2238,13 +2239,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
index += (convention_fortran_p ? - 1 : 1),
gnat_index = Next_Index (gnat_index))
{
- char field_name[16];
+ const bool is_flb
+ = Is_Fixed_Lower_Bound_Index_Subtype (Etype (gnat_index));
tree gnu_index_type = get_unpadded_type (Etype (gnat_index));
tree gnu_orig_min = TYPE_MIN_VALUE (gnu_index_type);
tree gnu_orig_max = TYPE_MAX_VALUE (gnu_index_type);
tree gnu_index_base_type = get_base_type (gnu_index_type);
tree gnu_lb_field, gnu_hb_field;
tree gnu_min, gnu_max, gnu_high;
+ char field_name[16];
/* Update the maximum size of the array in elements. */
if (gnu_max_size)
@@ -2278,25 +2281,38 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
/* We can't use build_component_ref here since the template type
isn't complete yet. */
- gnu_orig_min = build3 (COMPONENT_REF, TREE_TYPE (gnu_lb_field),
- gnu_template_reference, gnu_lb_field,
- NULL_TREE);
+ if (!is_flb)
+ {
+ gnu_orig_min = build3 (COMPONENT_REF, TREE_TYPE (gnu_lb_field),
+ gnu_template_reference, gnu_lb_field,
+ NULL_TREE);
+ TREE_READONLY (gnu_orig_min) = 1;
+ }
+
gnu_orig_max = build3 (COMPONENT_REF, TREE_TYPE (gnu_hb_field),
gnu_template_reference, gnu_hb_field,
NULL_TREE);
- TREE_READONLY (gnu_orig_min) = TREE_READONLY (gnu_orig_max) = 1;
+ TREE_READONLY (gnu_orig_max) = 1;
gnu_min = convert (sizetype, gnu_orig_min);
gnu_max = convert (sizetype, gnu_orig_max);
/* Compute the size of this dimension. See the E_Array_Subtype
case below for the rationale. */
- gnu_high
- = build3 (COND_EXPR, sizetype,
- build2 (GE_EXPR, boolean_type_node,
- gnu_orig_max, gnu_orig_min),
- gnu_max,
- size_binop (MINUS_EXPR, gnu_min, size_one_node));
+ if (is_flb
+ && Nkind (gnat_index) == N_Subtype_Indication
+ && flb_cannot_be_superflat (gnat_index))
+ gnu_high = gnu_max;
+
+ else
+ gnu_high
+ = build3 (COND_EXPR, sizetype,
+ build2 (GE_EXPR, boolean_type_node,
+ gnu_orig_max, gnu_orig_min),
+ gnu_max,
+ TREE_CODE (gnu_min) == INTEGER_CST
+ ? int_const_binop (MINUS_EXPR, gnu_min, size_one_node)
+ : size_binop (MINUS_EXPR, gnu_min, size_one_node));
/* Make a range type with the new range in the Ada base type.
Then make an index type with the size range in sizetype. */
@@ -2595,7 +2611,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
this. If we can prove that the array can never be superflat,
we can just use the high bound of the index type. */
else if ((Nkind (gnat_index) == N_Range
- && cannot_be_superflat (gnat_index))
+ && range_cannot_be_superflat (gnat_index))
/* Bit-Packed Array Impl. Types are never superflat. */
|| (Is_Packed_Array_Impl_Type (gnat_entity)
&& Is_Bit_Packed_Array
@@ -6414,33 +6430,81 @@ compile_time_known_address_p (Node_Id gnat_address)
return Compile_Time_Known_Value (gnat_address);
}
+/* Return true if GNAT_INDIC, a N_Subtype_Indication node for the index of a
+ FLB, cannot yield superflat objects, i.e. if the inequality HB >= LB - 1
+ is true for these objects. LB and HB are the low and high bounds. */
+
+static bool
+flb_cannot_be_superflat (Node_Id gnat_indic)
+{
+ const Entity_Id gnat_type = Entity (Subtype_Mark (gnat_indic));
+ const Entity_Id gnat_subtype = Etype (gnat_indic);
+ Node_Id gnat_scalar_range, gnat_lb, gnat_hb;
+ tree gnu_lb, gnu_hb, gnu_lb_minus_one;
+
+ /* This is a FLB so LB is fixed. */
+ if ((Ekind (gnat_subtype) == E_Signed_Integer_Subtype
+ || Ekind (gnat_subtype) == E_Modular_Integer_Subtype)
+ && (gnat_scalar_range = Scalar_Range (gnat_subtype)))
+ {
+ gnat_lb = Low_Bound (gnat_scalar_range);
+ gcc_assert (Nkind (gnat_lb) == N_Integer_Literal);
+ }
+ else
+ return false;
+
+ /* The low bound of the type is a lower bound for HB. */
+ if ((Ekind (gnat_type) == E_Signed_Integer_Subtype
+ || Ekind (gnat_type) == E_Modular_Integer_Subtype)
+ && (gnat_scalar_range = Scalar_Range (gnat_type)))
+ {
+ gnat_hb = Low_Bound (gnat_scalar_range);
+ gcc_assert (Nkind (gnat_hb) == N_Integer_Literal);
+ }
+ else
+ return false;
+
+ /* We need at least a signed 64-bit type to catch most cases. */
+ gnu_lb = UI_To_gnu (Intval (gnat_lb), sbitsizetype);
+ gnu_hb = UI_To_gnu (Intval (gnat_hb), sbitsizetype);
+ if (TREE_OVERFLOW (gnu_lb) || TREE_OVERFLOW (gnu_hb))
+ return false;
+
+ /* If the low bound is the smallest integer, nothing can be smaller. */
+ gnu_lb_minus_one = size_binop (MINUS_EXPR, gnu_lb, sbitsize_one_node);
+ if (TREE_OVERFLOW (gnu_lb_minus_one))
+ return true;
+
+ return !tree_int_cst_lt (gnu_hb, gnu_lb_minus_one);
+}
+
/* Return true if GNAT_RANGE, a N_Range node, cannot be superflat, i.e. if the
- inequality HB >= LB-1 is true. LB and HB are the low and high bounds. */
+ inequality HB >= LB - 1 is true. LB and HB are the low and high bounds. */
static bool
-cannot_be_superflat (Node_Id gnat_range)
+range_cannot_be_superflat (Node_Id gnat_range)
{
Node_Id gnat_lb = Low_Bound (gnat_range), gnat_hb = High_Bound (gnat_range);
- Node_Id scalar_range;
+ Node_Id gnat_scalar_range;
tree gnu_lb, gnu_hb, gnu_lb_minus_one;
/* If the low bound is not constant, try to find an upper bound. */
while (Nkind (gnat_lb) != N_Integer_Literal
&& (Ekind (Etype (gnat_lb)) == E_Signed_Integer_Subtype
|| Ekind (Etype (gnat_lb)) == E_Modular_Integer_Subtype)
- && (scalar_range = Scalar_Range (Etype (gnat_lb)))
- && (Nkind (scalar_range) == N_Signed_Integer_Type_Definition
- || Nkind (scalar_range) == N_Range))
- gnat_lb = High_Bound (scalar_range);
+ && (gnat_scalar_range = Scalar_Range (Etype (gnat_lb)))
+ && (Nkind (gnat_scalar_range) == N_Signed_Integer_Type_Definition
+ || Nkind (gnat_scalar_range) == N_Range))
+ gnat_lb = High_Bound (gnat_scalar_range);
/* If the high bound is not constant, try to find a lower bound. */
while (Nkind (gnat_hb) != N_Integer_Literal
&& (Ekind (Etype (gnat_hb)) == E_Signed_Integer_Subtype
|| Ekind (Etype (gnat_hb)) == E_Modular_Integer_Subtype)
- && (scalar_range = Scalar_Range (Etype (gnat_hb)))
- && (Nkind (scalar_range) == N_Signed_Integer_Type_Definition
- || Nkind (scalar_range) == N_Range))
- gnat_hb = Low_Bound (scalar_range);
+ && (gnat_scalar_range = Scalar_Range (Etype (gnat_hb)))
+ && (Nkind (gnat_scalar_range) == N_Signed_Integer_Type_Definition
+ || Nkind (gnat_scalar_range) == N_Range))
+ gnat_hb = Low_Bound (gnat_scalar_range);
/* If we have failed to find constant bounds, punt. */
if (Nkind (gnat_lb) != N_Integer_Literal
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-07-12 12:52 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-07-12 12:52 [gcc r12-2250] [Ada] Implement support for unconstrained array types with FLB Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).