This started as an attempt to remove this annoying usage of
gfc_conv_descriptor_rank in trans-array.cc(gfc_conv_array_parameter):
9278 tree idx = gfc_create_var (TREE_TYPE
(gfc_conv_descriptor_rank
9279 (old_desc)),
9280 "idx");
That snippet was creating a data reference, and then throwing it away to
only keep the type, which is the type of array descriptors' rank field.
I could have used just the rank field type directly, but I eventually
convinced myself that the snippet above showed a lack of a type readily
available to represent ranks and array dimensions. This patchs adds
such a type.
As usual, I wasn't very inspired when choosing the name for it. Feel
free to propose better.
Regression tested on powerpc64le-unknown-linux-gnu. OK for master?From 437b13a067ab64902618515b67d0727094385c38 Mon Sep 17 00:00:00 2001
From: Mikael Morin <[email protected]>
Date: Mon, 22 Jun 2026 16:53:30 +0200
Subject: [PATCH] fortran: Create a dedicated type for ranks and array
dimensions
This patch adds a type to represent ranks and array dimension, using the
same base type as originally used for the rank in array descriptors
(signed char), but with the stricter bounds (0 to GFC_MAX_DIMENSIONS)
brought to the knowledge of the middle-end. The new type is used for
the rank in array descriptors, and in various places in the compiler as
well, such as loops on array dimensions. Conversions to signed char
are added in places where negative intermediary results were possible,
and loops on array dimensions where the new type is used have been
double-checked to not step backwards (in which case the iteration index
would reach -1 after the last iteration).
gcc/fortran/ChangeLog:
* trans-types.h (gfc_array_dim_rank_type): New type node
declaration.
* trans-types.cc (gfc_array_dim_rank_type): Likewise.
(gfc_init_types) : Initialize the new type node.
(get_dtype_type_node): Use the new type for the rank field.
* trans-descriptor.cc (gfc_conv_descriptor_rank): Likewise.
* trans-const.h (gfc_index_zero_node, gfc_index_one_node): Make
each macro a separate node declaration.
* trans-const.cc (gfc_index_zero_node, gfc_index_one_node):
Declare new nodes.
(gfc_init_constants): Initialize them. Use the new type for the
constants of the gfc_rank_cst array.
* trans-array.cc (gfc_tree_array_size): Use the new type for the
RANK, IDX and DIM variables. Avoid negative intermediary value
in comparison using the new type.
(gfc_conv_array_parameter): Use the new type when assigning a
value to the descriptor's rank. Use the new type for the IDX
variable.
* trans-decl.cc (gfc_conv_cfi_to_gfc): Use the new type for the
rank, and the dimension index variable (including loop initial
value and step).
* trans-expr.cc (gfc_conv_gfc_desc_to_cfi_desc): Likewise.
(gfc_conv_variable): Use the new type for the rank variable.
(gfc_trans_structure_assign): Use the new type when assigning a
value to the descriptor's rank.
* trans-openmp.cc (gfc_omp_get_array_size): Use the new type
for the dimension index variable and the loop initialization,
bound and step.
* trans-intrinsic.cc (gfc_conv_intrinsic_bound): Use the new
type for the DIM argument and the rank.
(conv_intrinsic_cobound): Likewise.
(trans_this_image): Likewise. Use the new type for the loop
variable, initialization, bound and step.
(gfc_conv_intrinsic_sizeof): Likewise.
* trans-stmt.cc (gfc_trans_select_rank_cases): Use signed char
as type for the select value.
---
gcc/fortran/trans-array.cc | 35 ++++++-----
gcc/fortran/trans-const.cc | 7 ++-
gcc/fortran/trans-const.h | 5 +-
gcc/fortran/trans-decl.cc | 38 ++++++------
gcc/fortran/trans-descriptor.cc | 2 +-
gcc/fortran/trans-expr.cc | 29 +++++----
gcc/fortran/trans-intrinsic.cc | 100 +++++++++++++++++---------------
gcc/fortran/trans-openmp.cc | 9 ++-
gcc/fortran/trans-stmt.cc | 13 +++--
gcc/fortran/trans-types.cc | 9 ++-
gcc/fortran/trans-types.h | 3 +
11 files changed, 134 insertions(+), 116 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index d1153f5565c..28e356bc287 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8677,15 +8677,16 @@ gfc_tree_array_size (stmtblock_t *block, tree desc, gfc_expr *expr, tree dim)
gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)));
enum gfc_array_kind akind = GFC_TYPE_ARRAY_AKIND (TREE_TYPE (desc));
if (expr == NULL || expr->rank < 0)
- rank = fold_convert (signed_char_type_node,
- gfc_conv_descriptor_rank (desc));
+ rank = gfc_conv_descriptor_rank (desc);
else
- rank = build_int_cst (signed_char_type_node, expr->rank);
+ rank = gfc_rank_cst[expr->rank];
if (dim || (expr && expr->rank == 1))
{
- if (!dim)
- dim = gfc_index_zero_node;
+ if (dim)
+ dim = fold_convert_loc (input_location, gfc_array_dim_rank_type, dim);
+ else
+ dim = gfc_rank_cst[0];
tree ubound = gfc_conv_descriptor_ubound_get (desc, dim);
tree lbound = gfc_conv_descriptor_lbound_get (desc, dim);
@@ -8702,11 +8703,11 @@ gfc_tree_array_size (stmtblock_t *block, tree desc, gfc_expr *expr, tree dim)
if (akind == GFC_ARRAY_ASSUMED_RANK_CONT
|| akind == GFC_ARRAY_ASSUMED_RANK)
{
- tmp = fold_build2_loc (input_location, MINUS_EXPR, signed_char_type_node,
- rank, build_int_cst (signed_char_type_node, 1));
+ tmp = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_dim_rank_type, rank,
+ gfc_rank_cst[1]);
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
- fold_convert (signed_char_type_node, dim),
- tmp);
+ dim, tmp);
tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
gfc_conv_descriptor_ubound_get (desc, dim),
build_int_cst (gfc_array_index_type, -1));
@@ -8729,10 +8730,10 @@ gfc_tree_array_size (stmtblock_t *block, tree desc, gfc_expr *expr, tree dim)
gfc_init_block (&loop_body);
/* Loop: for (i = 0; i < rank; ++i). */
- tree idx = gfc_create_var (signed_char_type_node, "idx");
+ tree idx = gfc_create_var (gfc_array_dim_rank_type, "idx");
/* Loop body. */
/* #if (assumed-rank + !allocatable && !pointer)
- if (idx == rank - 1 && dim[idx].ubound == -1)
+ if (idx + 1 == rank && dim[idx].ubound == -1)
extent = -1;
else
#endif
@@ -8743,10 +8744,10 @@ gfc_tree_array_size (stmtblock_t *block, tree desc, gfc_expr *expr, tree dim)
cond = NULL_TREE;
if (akind == GFC_ARRAY_ASSUMED_RANK_CONT || akind == GFC_ARRAY_ASSUMED_RANK)
{
- tmp = fold_build2_loc (input_location, MINUS_EXPR, signed_char_type_node,
- rank, build_int_cst (signed_char_type_node, 1));
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_dim_rank_type, idx, gfc_rank_cst[1]);
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
- idx, tmp);
+ tmp, rank);
tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
gfc_conv_descriptor_ubound_get (desc, idx),
build_int_cst (gfc_array_index_type, -1));
@@ -9112,7 +9113,7 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77,
gfc_add_modify (&block, gfc_conv_descriptor_dtype (arr),
gfc_conv_descriptor_dtype (se->expr));
gfc_add_modify (&block, gfc_conv_descriptor_rank (arr),
- build_int_cst (signed_char_type_node, 1));
+ gfc_rank_cst[1]);
gfc_conv_descriptor_span_set (&block, arr,
gfc_conv_descriptor_span_get (arr));
gfc_conv_descriptor_offset_set (&block, arr, gfc_index_zero_node);
@@ -9275,9 +9276,7 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77,
if (expr->rank == -1)
{
- tree idx = gfc_create_var (TREE_TYPE (gfc_conv_descriptor_rank
- (old_desc)),
- "idx");
+ tree idx = gfc_create_var (gfc_array_dim_rank_type, "idx");
tree stride = gfc_create_var (gfc_array_index_type, "stride");
stmtblock_t loop_body;
diff --git a/gcc/fortran/trans-const.cc b/gcc/fortran/trans-const.cc
index e21bcf68c0c..41848921315 100644
--- a/gcc/fortran/trans-const.cc
+++ b/gcc/fortran/trans-const.cc
@@ -35,6 +35,8 @@ along with GCC; see the file COPYING3. If not see
#include "target-memory.h"
tree gfc_rank_cst[GFC_MAX_DIMENSIONS + 1];
+tree gfc_index_zero_node;
+tree gfc_index_one_node;
/* Build a constant with given type from an int_cst. */
@@ -194,7 +196,10 @@ gfc_init_constants (void)
int n;
for (n = 0; n <= GFC_MAX_DIMENSIONS; n++)
- gfc_rank_cst[n] = build_int_cst (gfc_array_index_type, n);
+ gfc_rank_cst[n] = build_int_cst (gfc_array_dim_rank_type, n);
+
+ gfc_index_zero_node = build_zero_cst (gfc_array_index_type);
+ gfc_index_one_node = build_one_cst (gfc_array_index_type);
}
/* Converts a GMP integer into a backend tree node. */
diff --git a/gcc/fortran/trans-const.h b/gcc/fortran/trans-const.h
index eb268cced40..abd7d769451 100644
--- a/gcc/fortran/trans-const.h
+++ b/gcc/fortran/trans-const.h
@@ -65,5 +65,6 @@ tree gfc_build_const (tree, tree);
/* Integer constants 0..GFC_MAX_DIMENSIONS. */
extern GTY(()) tree gfc_rank_cst[GFC_MAX_DIMENSIONS + 1];
-#define gfc_index_zero_node gfc_rank_cst[0]
-#define gfc_index_one_node gfc_rank_cst[1]
+/* Integer constants 0 and 1, of array index type. */
+extern GTY(()) tree gfc_index_zero_node;
+extern GTY(()) tree gfc_index_one_node;
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index eb957472920..91b2bbf37af 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7602,14 +7602,16 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally,
if (sym->as->rank < 0)
{
/* Set gfc->dtype.rank, if assumed-rank. */
- rank = gfc_get_cfi_desc_rank (cfi);
+ rank = fold_convert_loc (input_location, gfc_array_dim_rank_type,
+ gfc_get_cfi_desc_rank (cfi));
gfc_add_modify (&block, gfc_conv_descriptor_rank (gfc_desc), rank);
}
else if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (gfc_desc)))
/* In that case, the CFI rank and the declared rank can differ. */
- rank = gfc_get_cfi_desc_rank (cfi);
+ rank = fold_convert_loc (input_location, gfc_array_dim_rank_type,
+ gfc_get_cfi_desc_rank (cfi));
else
- rank = build_int_cst (signed_char_type_node, sym->as->rank);
+ rank = gfc_rank_cst[sym->as->rank];
/* With bind(C), the standard requires that both Fortran callers and callees
handle noncontiguous arrays passed to an dummy with 'contiguous' attribute
@@ -7656,7 +7658,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally,
/* for (i = 1; i < rank; ++i)
cond &&= dim[i].sm != (dv->dim[i - 1].sm * dv->dim[i - 1].extent) */
- idx = gfc_create_var (TREE_TYPE (rank), "idx");
+ idx = gfc_create_var (gfc_array_dim_rank_type, "idx");
stmtblock_t loop_body;
gfc_init_block (&loop_body);
tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (idx),
@@ -7706,7 +7708,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally,
{
shift = 0;
tmpidx = idx
- for (dim = 0; dim < rank; ++dim)
+ for (d = 0; d < rank; ++d)
{
shift += (tmpidx % extent[d]) * sm[d]
tmpidx = tmpidx / extend[d]
@@ -7721,7 +7723,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally,
gfc_add_modify (&loop_body, tmpidx, idx);
stmtblock_t inner_loop;
gfc_init_block (&inner_loop);
- tree dim = gfc_create_var (TREE_TYPE (rank), "dim");
+ tree dim = gfc_create_var (gfc_array_dim_rank_type, "dim");
/* shift += (tmpidx % extent[d]) * sm[d] */
tmp = fold_build2_loc (input_location, TRUNC_MOD_EXPR,
size_type_node, tmpidx,
@@ -7739,9 +7741,8 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally,
gfc_add_modify (&inner_loop, tmpidx,
fold_build2_loc (input_location, TRUNC_DIV_EXPR,
size_type_node, tmpidx, tmp));
- gfc_simple_for_loop (&loop_body, dim, build_zero_cst (TREE_TYPE (rank)),
- rank, LT_EXPR, build_int_cst (TREE_TYPE (dim), 1),
- gfc_finish_block (&inner_loop));
+ gfc_simple_for_loop (&loop_body, dim, gfc_rank_cst[0], rank, LT_EXPR,
+ gfc_rank_cst[1], gfc_finish_block (&inner_loop));
/* Assign. */
tmp = fold_convert (pchar_type_node, gfc_get_cfi_desc_base_addr (cfi));
tmp = fold_build2 (POINTER_PLUS_EXPR, pchar_type_node, tmp, shift);
@@ -7824,7 +7825,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally,
}
/* Loop: for (i = 0; i < rank; ++i). */
- idx = gfc_create_var (TREE_TYPE (rank), "idx");
+ idx = gfc_create_var (gfc_array_dim_rank_type, "idx");
/* Loop body. */
stmtblock_t loop_body;
@@ -7943,7 +7944,7 @@ done:
{
shift = 0;
tmpidx = idx
- for (dim = 0; dim < rank; ++dim)
+ for (d = 0; d < rank; ++d)
{
shift += (tmpidx % extent[d]) * sm[d]
tmpidx = tmpidx / extend[d]
@@ -7960,7 +7961,7 @@ done:
gfc_add_modify (&loop_body, tmpidx, idx);
stmtblock_t inner_loop;
gfc_init_block (&inner_loop);
- tree dim = gfc_create_var (TREE_TYPE (rank), "dim");
+ tree dim = gfc_create_var (gfc_array_dim_rank_type, "dim");
/* shift += (tmpidx % extent[d]) * sm[d] */
tmp = fold_convert (size_type_node,
gfc_get_cfi_dim_extent (cfi, dim));
@@ -7979,10 +7980,8 @@ done:
gfc_add_modify (&inner_loop, tmpidx,
fold_build2_loc (input_location, TRUNC_DIV_EXPR,
size_type_node, tmpidx, tmp));
- gfc_simple_for_loop (&loop_body, dim,
- build_zero_cst (TREE_TYPE (rank)), rank, LT_EXPR,
- build_int_cst (TREE_TYPE (dim), 1),
- gfc_finish_block (&inner_loop));
+ gfc_simple_for_loop (&loop_body, dim, gfc_rank_cst[0], rank, LT_EXPR,
+ gfc_rank_cst[1], gfc_finish_block (&inner_loop));
/* Assign. */
tree rhs;
tmp = fold_convert (pchar_type_node,
@@ -8049,7 +8048,7 @@ done:
gfc_init_block (&block2);
/* Loop: for (i = 0; i < rank; ++i). */
- idx = gfc_create_var (TREE_TYPE (rank), "idx");
+ idx = gfc_create_var (gfc_array_dim_rank_type, "idx");
/* Loop body. */
gfc_init_block (&loop_body);
@@ -8070,9 +8069,8 @@ done:
gfc_add_modify (&loop_body, gfc_get_cfi_dim_sm (cfi, idx), tmp);
/* Generate loop. */
- gfc_simple_for_loop (&block2, idx, build_zero_cst (TREE_TYPE (idx)),
- rank, LT_EXPR, build_int_cst (TREE_TYPE (idx), 1),
- gfc_finish_block (&loop_body));
+ gfc_simple_for_loop (&block2, idx, gfc_rank_cst[0], rank, LT_EXPR,
+ gfc_rank_cst[1], gfc_finish_block (&loop_body));
/* if (gfc->data != NULL) { block2 }. */
tmp = gfc_get_cfi_desc_base_addr (cfi),
tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index fe2fe005992..79c6439c08f 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -159,7 +159,7 @@ gfc_conv_descriptor_rank (tree desc)
dtype = gfc_conv_descriptor_dtype (desc);
tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_RANK);
gcc_assert (tmp != NULL_TREE
- && TREE_TYPE (tmp) == signed_char_type_node);
+ && TREE_TYPE (tmp) == gfc_array_dim_rank_type);
return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
dtype, tmp, NULL_TREE);
}
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 4027c867c69..8a96d6e1394 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -3405,10 +3405,10 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
tree dim, lower, upper, cond;
char *msg;
- dim = fold_convert (signed_char_type_node,
+ dim = fold_convert (gfc_array_dim_rank_type,
gfc_conv_descriptor_rank (se->expr));
- dim = fold_build2_loc (input_location, MINUS_EXPR, signed_char_type_node,
- dim, build_int_cst (signed_char_type_node, 1));
+ dim = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_dim_rank_type, dim, gfc_rank_cst[1]);
lower = gfc_conv_descriptor_lbound_get (se->expr, dim);
upper = gfc_conv_descriptor_ubound_get (se->expr, dim);
@@ -6277,11 +6277,12 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
gfc_add_modify (&block, tmp,
build_int_cst (TREE_TYPE (tmp), CFI_VERSION));
if (e->rank < 0)
- rank = fold_convert (signed_char_type_node, gfc_conv_descriptor_rank (gfc));
+ rank = gfc_conv_descriptor_rank (gfc);
else
- rank = build_int_cst (signed_char_type_node, e->rank);
+ rank = gfc_rank_cst[e->rank];
tmp = gfc_get_cfi_desc_rank (cfi);
- gfc_add_modify (&block, tmp, rank);
+ gfc_add_modify (&block, tmp,
+ fold_convert (TREE_TYPE (tmp), rank));
int itype = CFI_type_other;
if (e->ts.f90_type == BT_VOID)
itype = (e->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR
@@ -6491,7 +6492,7 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
if (e->rank != 0)
{
/* Loop: for (i = 0; i < rank; ++i). */
- tree idx = gfc_create_var (TREE_TYPE (rank), "idx");
+ tree idx = gfc_create_var (gfc_array_dim_rank_type, "idx");
/* Loop body. */
stmtblock_t loop_body;
gfc_init_block (&loop_body);
@@ -6516,9 +6517,8 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
gfc_add_modify (&loop_body, gfc_get_cfi_dim_sm (cfi, idx), tmp);
/* Generate loop. */
- gfc_simple_for_loop (&block2, idx, build_int_cst (TREE_TYPE (idx), 0),
- rank, LT_EXPR, build_int_cst (TREE_TYPE (idx), 1),
- gfc_finish_block (&loop_body));
+ gfc_simple_for_loop (&block2, idx, gfc_rank_cst[0], rank, LT_EXPR,
+ gfc_rank_cst[1], gfc_finish_block (&loop_body));
if (e->expr_type == EXPR_VARIABLE
&& e->ref
@@ -6600,7 +6600,7 @@ done:
/* Calculate offset + set lbound, ubound and stride. */
gfc_conv_descriptor_offset_set (&block2, gfc, gfc_index_zero_node);
/* Loop: for (i = 0; i < rank; ++i). */
- tree idx = gfc_create_var (TREE_TYPE (rank), "idx");
+ tree idx = gfc_create_var (gfc_array_dim_rank_type, "idx");
/* Loop body. */
stmtblock_t loop_body;
gfc_init_block (&loop_body);
@@ -6632,9 +6632,8 @@ done:
gfc_conv_descriptor_offset_get (gfc), tmp);
gfc_conv_descriptor_offset_set (&loop_body, gfc, tmp);
/* Generate loop. */
- gfc_simple_for_loop (&block2, idx, build_int_cst (TREE_TYPE (idx), 0),
- rank, LT_EXPR, build_int_cst (TREE_TYPE (idx), 1),
- gfc_finish_block (&loop_body));
+ gfc_simple_for_loop (&block2, idx, gfc_rank_cst[0], rank, LT_EXPR,
+ gfc_rank_cst[1], gfc_finish_block (&loop_body));
}
if (e->ts.type == BT_CHARACTER && !e->ts.u.cl->length)
@@ -10472,7 +10471,7 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init, bool coarray)
size = build_zero_cst (size_type_node);
desc = field;
gfc_add_modify (&block, gfc_conv_descriptor_rank (desc),
- build_int_cst (signed_char_type_node, rank));
+ gfc_rank_cst[rank]);
}
else
{
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 83f25fe0f96..f7bce965b73 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -1876,10 +1876,11 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
gcc_assert (se->loop->dimen == 1);
gcc_assert (se->ss->info->expr == expr);
- dim_arg = se->loop->loopvar[0];
+ dim_arg = fold_convert_loc (input_location, gfc_array_dim_rank_type,
+ se->loop->loopvar[0]);
dim_arg = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type, dim_arg,
- build_int_cst (TREE_TYPE (dim_arg), 1));
+ gfc_array_dim_rank_type, dim_arg,
+ gfc_rank_cst[1]);
gfc_advance_se_ss_chain (se);
}
else
@@ -1888,7 +1889,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
gcc_assert (expr->value.function.actual->next->expr);
gfc_init_se (&argse, NULL);
gfc_conv_expr_type (&argse, expr->value.function.actual->next->expr,
- gfc_array_index_type);
+ gfc_array_dim_rank_type);
gfc_add_block_to_block (&se->pre, &argse.pre);
dim_arg = argse.expr;
@@ -1905,8 +1906,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
{
dim_arg = gfc_evaluate_now (dim_arg, &se->pre);
cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
- dim_arg,
- build_int_cst (TREE_TYPE (dim_arg), 1));
+ dim_arg, gfc_rank_cst[1]);
tmp = gfc_rank_cst[GFC_TYPE_ARRAY_CORANK (TREE_TYPE (desc))];
tmp = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
dim_arg, tmp);
@@ -1962,23 +1962,24 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
m = gfc_create_var (type, NULL);
ml = gfc_create_var (type, NULL);
- loop_var = gfc_create_var (integer_type_node, NULL);
- min_var = gfc_create_var (integer_type_node, NULL);
+ loop_var = gfc_create_var (gfc_array_dim_rank_type, NULL);
+ min_var = gfc_create_var (gfc_array_dim_rank_type, NULL);
/* m = this_image () - 1. */
gfc_add_modify (&se->pre, m, tmp);
/* min_var = min (rank + corank-2, rank + dim_arg - 1). */
- tmp = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
- fold_convert (integer_type_node, dim_arg),
- build_int_cst (integer_type_node, rank - 1));
- tmp = fold_build2_loc (input_location, MIN_EXPR, integer_type_node,
- build_int_cst (integer_type_node, rank + corank - 2),
- tmp);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, signed_char_type_node,
+ fold_convert_loc (input_location,
+ signed_char_type_node, dim_arg),
+ build_int_cst (signed_char_type_node, rank - 1));
+ tmp = fold_convert_loc (input_location, gfc_array_dim_rank_type, tmp);
+ tmp = fold_build2_loc (input_location, MIN_EXPR, gfc_array_dim_rank_type,
+ gfc_rank_cst[rank + corank - 2], tmp);
gfc_add_modify (&se->pre, min_var, tmp);
/* i = rank. */
- tmp = build_int_cst (integer_type_node, rank);
+ tmp = gfc_rank_cst[rank];
gfc_add_modify (&se->pre, loop_var, tmp);
exit_label = gfc_build_label_decl (NULL_TREE);
@@ -2011,9 +2012,9 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
/* Increment loop variable: i++. */
gfc_add_modify (&loop, loop_var,
- fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
- loop_var,
- integer_one_node));
+ fold_build2_loc (input_location, PLUS_EXPR,
+ TREE_TYPE (loop_var), loop_var,
+ gfc_rank_cst[1]));
/* Making the loop... actually loop! */
tmp = gfc_finish_block (&loop);
@@ -2032,7 +2033,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
lbound = gfc_conv_descriptor_lbound_get (desc,
fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type, dim_arg,
+ TREE_TYPE (dim_arg), dim_arg,
build_int_cst (TREE_TYPE (dim_arg), rank-1)));
lbound = fold_convert (type, lbound);
@@ -2436,19 +2437,21 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, enum gfc_isym_id op)
bound = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, bound,
se->loop->from[0]);
+ bound = fold_convert_loc (input_location, gfc_array_dim_rank_type,
+ bound);
}
else
{
/* use the passed argument. */
gcc_assert (arg2->expr);
gfc_init_se (&argse, NULL);
- gfc_conv_expr_type (&argse, arg2->expr, gfc_array_index_type);
+ gfc_conv_expr_type (&argse, arg2->expr, gfc_array_dim_rank_type);
gfc_add_block_to_block (&se->pre, &argse.pre);
bound = argse.expr;
/* Convert from one based to zero based. */
bound = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type, bound,
- gfc_index_one_node);
+ gfc_array_dim_rank_type, bound,
+ gfc_rank_cst[1]);
}
/* TODO: don't re-evaluate the descriptor on each iteration. */
@@ -2481,13 +2484,13 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, enum gfc_isym_id op)
{
bound = gfc_evaluate_now (bound, &se->pre);
cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
- bound, build_int_cst (TREE_TYPE (bound), 0));
+ bound, gfc_rank_cst[0]);
if (as && as->type == AS_ASSUMED_RANK)
tmp = gfc_conv_descriptor_rank (desc);
else
tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))];
tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
- bound, fold_convert(TREE_TYPE (bound), tmp));
+ bound, tmp);
cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
logical_type_node, cond, tmp);
gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where,
@@ -2577,10 +2580,10 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, enum gfc_isym_id op)
if (op != GFC_ISYM_LBOUND && assumed_rank_lb_one)
{
tree minus_one = build_int_cst (gfc_array_index_type, -1);
- tree rank = fold_convert (gfc_array_index_type,
- gfc_conv_descriptor_rank (desc));
- rank = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type, rank, minus_one);
+ tree rank = gfc_conv_descriptor_rank (desc);
+ rank = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_dim_rank_type, rank,
+ gfc_rank_cst[1]);
/* Fix the expression to stop it from becoming even more
complicated. */
@@ -2655,18 +2658,20 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
gcc_assert (se->loop->dimen == 1);
gcc_assert (se->ss->info->expr == expr);
- bound = se->loop->loopvar[0];
- bound = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
- bound, gfc_rank_cst[arg->expr->rank]);
+ bound = fold_convert_loc (input_location, gfc_array_dim_rank_type,
+ se->loop->loopvar[0]);
+ tree rank = gfc_rank_cst[arg->expr->rank];
+ bound = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_dim_rank_type, bound, rank);
gfc_advance_se_ss_chain (se);
}
else if (expr->value.function.isym->id == GFC_ISYM_COSHAPE)
- bound = gfc_index_zero_node;
+ bound = gfc_rank_cst[1];
else
{
gcc_assert (arg2->expr);
gfc_init_se (&argse, NULL);
- gfc_conv_expr_type (&argse, arg2->expr, gfc_array_index_type);
+ gfc_conv_expr_type (&argse, arg2->expr, gfc_array_dim_rank_type);
gfc_add_block_to_block (&se->pre, &argse.pre);
bound = argse.expr;
@@ -2683,10 +2688,10 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
{
bound = gfc_evaluate_now (bound, &se->pre);
cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
- bound, build_int_cst (TREE_TYPE (bound), 1));
- tmp = gfc_rank_cst[GFC_TYPE_ARRAY_CORANK (TREE_TYPE (desc))];
+ bound, gfc_rank_cst[1]);
+ tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_CORANK (TREE_TYPE (desc))];
tmp = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
- bound, tmp);
+ bound, rank);
cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
logical_type_node, cond, tmp);
gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where,
@@ -2699,14 +2704,16 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
{
case 0:
bound = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type, bound,
- gfc_index_one_node);
+ gfc_array_dim_rank_type, bound,
+ gfc_rank_cst[1]);
case 1:
break;
default:
- bound = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type, bound,
- gfc_rank_cst[arg->expr->rank - 1]);
+ {
+ tree rank = gfc_rank_cst[arg->expr->rank - 1];
+ bound = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_dim_rank_type, bound, rank);
+ }
}
}
@@ -8478,10 +8485,9 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
tree cond, loop_var, exit_label;
stmtblock_t body;
- tmp = fold_convert (gfc_array_index_type,
- gfc_conv_descriptor_rank (argse.expr));
- loop_var = gfc_create_var (gfc_array_index_type, "i");
- gfc_add_modify (&argse.pre, loop_var, gfc_index_zero_node);
+ tmp = gfc_conv_descriptor_rank (argse.expr);
+ loop_var = gfc_create_var (gfc_array_dim_rank_type, "i");
+ gfc_add_modify (&argse.pre, loop_var, gfc_rank_cst[0]);
exit_label = gfc_build_label_decl (NULL_TREE);
/* Create loop:
@@ -8509,8 +8515,8 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
gfc_add_modify (&body, source_bytes, tmp);
tmp = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type, loop_var,
- gfc_index_one_node);
+ gfc_array_dim_rank_type, loop_var,
+ gfc_rank_cst[1]);
gfc_add_modify_loc (input_location, &body, loop_var, tmp);
tmp = gfc_finish_block (&body);
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index eb001271497..7243301cae0 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -2123,17 +2123,16 @@ gfc_omp_get_array_size (location_t loc, tree desc, gimple_seq *seq)
tree extent = build_decl (loc, VAR_DECL, create_tmp_var_name ("extent"),
gfc_array_index_type);
tree idx = build_decl (loc, VAR_DECL, create_tmp_var_name ("idx"),
- signed_char_type_node);
+ gfc_array_dim_rank_type);
- tree begin = build_zero_cst (signed_char_type_node);
+ tree begin = gfc_rank_cst[0];
tree end;
if (GFC_TYPE_ARRAY_AKIND (TREE_TYPE (desc)) == GFC_ARRAY_ASSUMED_SHAPE_CONT
|| GFC_TYPE_ARRAY_AKIND (TREE_TYPE (desc)) == GFC_ARRAY_ASSUMED_SHAPE)
end = gfc_conv_descriptor_rank (desc);
else
- end = build_int_cst (signed_char_type_node,
- GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc)));
- tree step = build_int_cst (signed_char_type_node, 1);
+ end = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))];
+ tree step = gfc_rank_cst[1];
/* size = 0
for (idx = 0; idx < rank; idx++)
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 90ac572dd72..526f42febf7 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -3974,7 +3974,8 @@ gfc_trans_select_rank_cases (gfc_code * code)
/* Calculate the switch expression. */
gfc_init_se (&se, NULL);
gfc_conv_expr_descriptor (&se, code->expr1);
- rank = gfc_conv_descriptor_rank (se.expr);
+ rank = fold_convert_loc (input_location, signed_char_type_node,
+ gfc_conv_descriptor_rank (se.expr));
rank = gfc_evaluate_now (rank, &block);
symbol_attribute attr = gfc_expr_attr (code->expr1);
if (!attr.pointer && !attr.allocatable)
@@ -3983,16 +3984,16 @@ gfc_trans_select_rank_cases (gfc_code * code)
rank = (rank == 0 || ubound[rank-1] != -1) ? rank : -1. */
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
rank, build_int_cst (TREE_TYPE (rank), 0));
- tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- fold_convert (gfc_array_index_type, rank),
- gfc_index_one_node);
+ tmp = fold_build2_loc (input_location, MINUS_EXPR, signed_char_type_node,
+ rank, build_one_cst (signed_char_type_node));
tmp = gfc_conv_descriptor_ubound_get (se.expr, tmp);
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
tmp, build_int_cst (TREE_TYPE (tmp), -1));
cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
logical_type_node, cond, tmp);
- tmp = fold_build3_loc (input_location, COND_EXPR, TREE_TYPE (rank),
- cond, rank, build_int_cst (TREE_TYPE (rank), -1));
+ tmp = fold_build3_loc (input_location, COND_EXPR, signed_char_type_node,
+ cond, rank,
+ build_minus_one_cst (signed_char_type_node));
rank = gfc_evaluate_now (tmp, &block);
}
TREE_USED (code->exit_label) = 0;
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index bb33cddbfa0..ea4395c67dd 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -55,6 +55,7 @@ along with GCC; see the file COPYING3. If not see
/* array of structs so we don't have to worry about xmalloc or free */
CInteropKind_t c_interop_kinds_table[ISOCBINDING_NUMBER];
+tree gfc_array_dim_rank_type;
tree gfc_array_index_type;
tree gfc_array_range_type;
tree gfc_character1_type_node;
@@ -164,7 +165,7 @@ tree get_dtype_type_node (void)
suppress_warning (field);
field = gfc_add_field_to_struct_1 (dtype_node,
get_identifier ("rank"),
- signed_char_type_node, &dtype_chain);
+ gfc_array_dim_rank_type, &dtype_chain);
suppress_warning (field);
field = gfc_add_field_to_struct_1 (dtype_node,
get_identifier ("type"),
@@ -1226,6 +1227,12 @@ gfc_init_types (void)
gfc_charlen_int_kind = get_int_kind_from_node (size_type_node);
gfc_charlen_type_node = gfc_get_int_type (gfc_charlen_int_kind);
+ gfc_array_dim_rank_type
+ = build_range_type (signed_char_type_node,
+ build_zero_cst (signed_char_type_node),
+ build_int_cst (signed_char_type_node,
+ GFC_MAX_DIMENSIONS));
+
/* Fortran kind number of size_type_node (size_t). This is used for
the _size member in vtables. */
gfc_size_kind = get_int_kind_from_node (size_type_node);
diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h
index 94fa6761e90..a2169e436c8 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -52,6 +52,9 @@ extern GTY(()) tree logical_false_node;
It must be the same as the corresponding definition in gfortran.h. */
extern GTY(()) tree gfc_charlen_type_node;
+/* An integral type with bounds [0, GFC_MAX_DIMENSIONS] suitable to hold an
+ array rank, or an array dimension index. */
+extern GTY(()) tree gfc_array_dim_rank_type;
/* The following flags give us information on the correspondence of
real (and complex) kinds with C floating-point types long double
--
2.53.0
