https://gcc.gnu.org/g:05fdf723e890f2fd15fd097a1cb07e1065bc7fcb
commit 05fdf723e890f2fd15fd097a1cb07e1065bc7fcb Author: Mikael Morin <[email protected]> Date: Mon Jun 22 16:53:30 2026 +0200 fortran: Create a dedicated type for ranks and array dimensions 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. My initial attempt was just using the field type directly, that is signed_char_type_node. Then I thought that the type used here actually had little to do with the rank of array descriptors. This was a sign of a missing dedicated type to hold ranks and descriptor dimension indexes throughout the compiler, independantly of the type in the descriptor. This patch adds the missing type, using the same base type as originally in the descriptor (signed char), but with the stricter bounds (from 0 to GFC_MAX_DIMENSIONS) brought to the knowledge of the middle-end. The new type is used as the descriptor rank's new type, and in various places in the compiler as well for array dimension index and rank variables. I have added conversions to signed char in places where negative intermediary results were possible, and double checked that for loops on array dimensions where the new type could be used, we don't create backwards loops (for which 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_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 and DIM variables. Add conversions to signed_char_type_node if the resulting value could be negative. (gfc_conv_array_parameter): Use the new type for the IDX variable. * trans-decl.cc (gfc_conv_cfi_to_gfc): Use the new type for rank and dimension index variables. * trans-expr.cc (gfc_conv_variable): Likewise. (gfc_conv_gfc_desc_to_cfi_desc): Likewise. * trans-openmp.cc (gfc_omp_get_array_size): Likewise. * trans-intrinsic.cc (trans_this_image): Likewise. (gfc_conv_intrinsic_bound): Likewise. (conv_intrinsic_cobound): Likewise. Diff: --- gcc/fortran/trans-array.cc | 30 ++++++++------ gcc/fortran/trans-const.cc | 7 +++- gcc/fortran/trans-const.h | 5 ++- gcc/fortran/trans-decl.cc | 28 +++++++------- gcc/fortran/trans-descriptor.cc | 2 +- gcc/fortran/trans-expr.cc | 21 +++++----- gcc/fortran/trans-intrinsic.cc | 86 ++++++++++++++++++++++++++--------------- gcc/fortran/trans-openmp.cc | 11 +++--- gcc/fortran/trans-types.cc | 9 ++++- gcc/fortran/trans-types.h | 3 ++ 10 files changed, 126 insertions(+), 76 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index d1153f5565cf..3447ced7f2d8 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -8677,15 +8677,15 @@ 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, + rank = fold_convert (gfc_array_dim_rank_type, gfc_conv_descriptor_rank (desc)); else - rank = build_int_cst (signed_char_type_node, expr->rank); + rank = build_int_cst (gfc_array_dim_rank_type, expr->rank); if (dim || (expr && expr->rank == 1)) { if (!dim) - dim = gfc_index_zero_node; + dim = gfc_rank_cst[0]; tree ubound = gfc_conv_descriptor_ubound_get (desc, dim); tree lbound = gfc_conv_descriptor_lbound_get (desc, dim); @@ -8702,8 +8702,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, + signed_char_type_node, + fold_convert_loc (input_location, + signed_char_type_node, rank), + build_one_cst (signed_char_type_node)); cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, fold_convert (signed_char_type_node, dim), tmp); @@ -8729,7 +8732,7 @@ 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) @@ -8743,10 +8746,15 @@ 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, MINUS_EXPR, + signed_char_type_node, + fold_convert_loc (input_location, + signed_char_type_node, rank), + build_one_cst (signed_char_type_node)); cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, - idx, tmp); + fold_convert_loc (input_location, + signed_char_type_node, idx), + tmp); 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)); @@ -9275,9 +9283,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 e21bcf68c0ce..418489213152 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 eb268cced40a..abd7d7694518 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 eb957472920e..fd9e9570eeb0 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -7357,7 +7357,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally, tmp3 = tmp2 = tmp = gfc_get_cfi_desc_rank (cfi); if (sym->as->rank != -1) tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, - tmp, build_int_cst (signed_char_type_node, + tmp, build_int_cst (TREE_TYPE (tmp), sym->as->rank)); else { @@ -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 = build_int_cst (gfc_array_dim_rank_type, 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,7 +7741,7 @@ 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)), + gfc_simple_for_loop (&loop_body, dim, build_zero_cst (TREE_TYPE (dim)), rank, LT_EXPR, build_int_cst (TREE_TYPE (dim), 1), gfc_finish_block (&inner_loop)); /* Assign. */ @@ -7824,7 +7826,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 +7945,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 +7962,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)); @@ -7980,7 +7982,7 @@ done: 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_zero_cst (TREE_TYPE (dim)), rank, LT_EXPR, build_int_cst (TREE_TYPE (dim), 1), gfc_finish_block (&inner_loop)); /* Assign. */ @@ -8049,7 +8051,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); diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index fe2fe0059929..79c6439c08fa 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 4027c867c694..fa53d903aac5 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -3405,10 +3405,11 @@ 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, + build_one_cst (gfc_array_dim_rank_type)); lower = gfc_conv_descriptor_lbound_get (se->expr, dim); upper = gfc_conv_descriptor_ubound_get (se->expr, dim); @@ -6277,11 +6278,13 @@ 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 = fold_convert (gfc_array_dim_rank_type, + gfc_conv_descriptor_rank (gfc)); else - rank = build_int_cst (signed_char_type_node, e->rank); + rank = build_int_cst (gfc_array_dim_rank_type, 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 +6494,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); @@ -6600,7 +6603,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); @@ -10472,7 +10475,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)); + build_int_cst (gfc_array_dim_rank_type, rank)); } else { diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index 83f25fe0f96f..98471c442aa6 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -1878,8 +1878,10 @@ trans_this_image (gfc_se * se, gfc_expr *expr) dim_arg = se->loop->loopvar[0]; dim_arg = 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), 1)); + dim_arg = fold_convert_loc (input_location, gfc_array_dim_rank_type, + dim_arg); gfc_advance_se_ss_chain (se); } else @@ -1888,7 +1890,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; @@ -1909,7 +1911,9 @@ trans_this_image (gfc_se * se, gfc_expr *expr) build_int_cst (TREE_TYPE (dim_arg), 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); + dim_arg, + fold_convert_loc (input_location, + TREE_TYPE (dim_arg), 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, @@ -1962,23 +1966,25 @@ 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 = 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, + build_int_cst (gfc_array_dim_rank_type, rank + corank - 2), tmp); gfc_add_modify (&se->pre, min_var, tmp); /* i = rank. */ - tmp = build_int_cst (integer_type_node, rank); + tmp = build_int_cst (TREE_TYPE (loop_var), rank); gfc_add_modify (&se->pre, loop_var, tmp); exit_label = gfc_build_label_decl (NULL_TREE); @@ -2011,9 +2017,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, + fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (loop_var), loop_var, - integer_one_node)); + build_one_cst (TREE_TYPE (loop_var)))); /* Making the loop... actually loop! */ tmp = gfc_finish_block (&loop); @@ -2032,7 +2038,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 +2442,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. */ @@ -2487,7 +2495,9 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, enum gfc_isym_id op) 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, + fold_convert_loc (input_location, + TREE_TYPE (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 +2587,11 @@ 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, + tree rank = fold_convert (gfc_array_dim_rank_type, gfc_conv_descriptor_rank (desc)); - rank = fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, rank, minus_one); + 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,13 +2666,17 @@ 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, + fold_convert_loc (input_location, + TREE_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); @@ -2684,9 +2699,11 @@ 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))]; + 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, + fold_convert_loc (input_location, + TREE_TYPE (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 +2716,19 @@ 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, + fold_convert_loc (input_location, + TREE_TYPE (bound), + rank)); + } } } diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index eb0012714970..339f0c99cb70 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -2123,17 +2123,18 @@ 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 = build_zero_cst (gfc_array_dim_rank_type); 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); + end = fold_convert (gfc_array_dim_rank_type, + gfc_conv_descriptor_rank (desc)); else - end = build_int_cst (signed_char_type_node, + end = build_int_cst (gfc_array_dim_rank_type, GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))); - tree step = build_int_cst (signed_char_type_node, 1); + tree step = build_int_cst (gfc_array_dim_rank_type, 1); /* size = 0 for (idx = 0; idx < rank; idx++) diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc index bb33cddbfa07..ea4395c67dd7 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 94fa6761e902..a2169e436c8b 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
