https://gcc.gnu.org/g:8734059a1ec09f9c9865ccc710cb5e1c69d52ba2
commit 8734059a1ec09f9c9865ccc710cb5e1c69d52ba2 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 patch adds a type to represent ranks and array dimension, using the same base type as originally used for the rank 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 for the rank in array descriptors, and in various places in the compiler as well for array dimension index and rank variables. 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. Diff: --- gcc/fortran/trans-array.cc | 34 +++++++------- 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, 133 insertions(+), 116 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index d1153f5565cf..e9ab89d5c884 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,10 @@ 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 +8729,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 +8743,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 +9112,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 +9275,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..91b2bbf37afb 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 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..8a96d6e13949 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 83f25fe0f96f..f7bce965b731 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 eb0012714970..7243301cae0b 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 90ac572dd725..526f42febf7c 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 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
