https://gcc.gnu.org/g:ccfc446acbd97c12eaa1e42170ee5dcc118395fb
commit ccfc446acbd97c12eaa1e42170ee5dcc118395fb Author: Mikael Morin <[email protected]> Date: Fri Sep 26 14:28:59 2025 +0200 Sauvegarde modifs Diff: --- gcc/fortran/class.cc | 64 +++++++++---------- gcc/fortran/trans-array.cc | 48 ++++++++++++-- gcc/fortran/trans-decl.cc | 7 +- gcc/fortran/trans-descriptor.cc | 103 ++++++++++++++++++++++++++---- gcc/fortran/trans-descriptor.h | 4 ++ gcc/fortran/trans-expr.cc | 2 +- gcc/fortran/trans-intrinsic.cc | 8 ++- gcc/fortran/trans-io.cc | 13 ++-- gcc/fortran/trans-types.cc | 16 ++++- gcc/fortran/trans.h | 3 + libgfortran/intrinsics/eoshift0.c | 12 ++-- libgfortran/io/list_read.c | 4 +- libgfortran/io/transfer.c | 15 ++--- libgfortran/io/unit.c | 4 +- libgfortran/io/unix.c | 2 +- libgfortran/io/write.c | 2 - libgfortran/libgfortran.h | 8 ++- libgfortran/m4/cshift0.m4 | 2 +- libgfortran/m4/matmul_internal.m4 | 16 ++--- libgfortran/runtime/ISO_Fortran_binding.c | 4 +- 20 files changed, 235 insertions(+), 102 deletions(-) diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc index a1c6fafa75ef..ef714b8e7a7d 100644 --- a/gcc/fortran/class.cc +++ b/gcc/fortran/class.cc @@ -1320,13 +1320,11 @@ finalization_scalarizer (gfc_symbol *array, gfc_symbol *ptr, offset = 0 do idx2 = 1, rank offset = offset + mod (idx, sizes(idx2)) / sizes(idx2-1) * strides(idx2) - end do - offset = offset * byte_stride. */ + end do. */ static gfc_code* finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset, - gfc_symbol *strides, gfc_symbol *sizes, - gfc_symbol *byte_stride, gfc_expr *rank, + gfc_symbol *strides, gfc_symbol *sizes, gfc_expr *rank, gfc_code *block, gfc_namespace *sub_ns) { gfc_iterator *iter; @@ -1420,17 +1418,6 @@ finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset, block->block->next->expr2->ts = idx->ts; block->block->next->expr2->where = gfc_current_locus; - /* After the loop: offset = offset * byte_stride. */ - block->next = gfc_get_code (EXEC_ASSIGN); - block = block->next; - block->expr1 = gfc_lval_expr_from_sym (offset); - block->expr2 = gfc_get_expr (); - block->expr2->expr_type = EXPR_OP; - block->expr2->value.op.op = INTRINSIC_TIMES; - block->expr2->value.op.op1 = gfc_lval_expr_from_sym (offset); - block->expr2->value.op.op2 = gfc_lval_expr_from_sym (byte_stride); - block->expr2->ts = block->expr2->value.op.op1->ts; - block->expr2->where = gfc_current_locus; return block; } @@ -1646,7 +1633,7 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini, /* Offset calculation of "array". */ block2 = finalization_get_offset (idx, idx2, offset, strides, sizes, - byte_stride, rank, block->block, sub_ns); + rank, block->block, sub_ns); /* Create code for CALL C_F_POINTER (TRANSFER (TRANSFER (C_LOC (array, cptr), c_intptr) @@ -1691,7 +1678,7 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini, /* Offset calculation of "array". */ block2 = finalization_get_offset (idx, idx2, offset, strides, sizes, - byte_stride, rank, block->block, sub_ns); + rank, block->block, sub_ns); /* Create code for CALL C_F_POINTER (TRANSFER (TRANSFER (C_LOC (array, cptr), c_intptr) @@ -2077,7 +2064,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, block->block = gfc_get_code (EXEC_IF); block = block->block; - /* if condition: strides(idx) /= sizes(idx-1). */ + /* if condition: strides(idx) /= sizes(idx-1) * byte_stride. */ block->expr1 = gfc_get_expr (); block->expr1->ts.type = BT_LOGICAL; block->expr1->ts.kind = gfc_default_logical_kind; @@ -2094,23 +2081,30 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, block->expr1->value.op.op1->ref->u.ar.start[0] = gfc_lval_expr_from_sym (idx); block->expr1->value.op.op1->ref->u.ar.as = strides->as; - block->expr1->value.op.op2 = gfc_lval_expr_from_sym (sizes); - block->expr1->value.op.op2->ref = gfc_get_ref (); - block->expr1->value.op.op2->ref->type = REF_ARRAY; - block->expr1->value.op.op2->ref->u.ar.as = sizes->as; - block->expr1->value.op.op2->ref->u.ar.type = AR_ELEMENT; - block->expr1->value.op.op2->ref->u.ar.dimen = 1; - block->expr1->value.op.op2->ref->u.ar.dimen_type[0] = DIMEN_ELEMENT; - block->expr1->value.op.op2->ref->u.ar.start[0] = gfc_get_expr (); - block->expr1->value.op.op2->ref->u.ar.start[0]->expr_type = EXPR_OP; - block->expr1->value.op.op2->ref->u.ar.start[0]->where = gfc_current_locus; - block->expr1->value.op.op2->ref->u.ar.start[0]->value.op.op = INTRINSIC_MINUS; - block->expr1->value.op.op2->ref->u.ar.start[0]->value.op.op1 + block->expr1->value.op.op2 = gfc_get_expr (); + block->expr1->value.op.op2->ts.type = BT_INTEGER; + block->expr1->value.op.op2->ts.kind = gfc_index_integer_kind; + block->expr1->value.op.op2->expr_type = EXPR_OP; + block->expr1->value.op.op2->where = gfc_current_locus; + block->expr1->value.op.op2->value.op.op = INTRINSIC_TIMES; + block->expr1->value.op.op2->value.op.op1 = gfc_lval_expr_from_sym (sizes); + block->expr1->value.op.op2->value.op.op1->ref = gfc_get_ref (); + block->expr1->value.op.op2->value.op.op1->ref->type = REF_ARRAY; + block->expr1->value.op.op2->value.op.op1->ref->u.ar.as = sizes->as; + block->expr1->value.op.op2->value.op.op1->ref->u.ar.type = AR_ELEMENT; + block->expr1->value.op.op2->value.op.op1->ref->u.ar.dimen = 1; + block->expr1->value.op.op2->value.op.op1->ref->u.ar.dimen_type[0] = DIMEN_ELEMENT; + block->expr1->value.op.op2->value.op.op1->ref->u.ar.start[0] = gfc_get_expr (); + block->expr1->value.op.op2->value.op.op1->ref->u.ar.start[0]->expr_type = EXPR_OP; + block->expr1->value.op.op2->value.op.op1->ref->u.ar.start[0]->where = gfc_current_locus; + block->expr1->value.op.op2->value.op.op1->ref->u.ar.start[0]->value.op.op = INTRINSIC_MINUS; + block->expr1->value.op.op2->value.op.op1->ref->u.ar.start[0]->value.op.op1 = gfc_lval_expr_from_sym (idx); - block->expr1->value.op.op2->ref->u.ar.start[0]->value.op.op2 + block->expr1->value.op.op2->value.op.op1->ref->u.ar.start[0]->value.op.op2 = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1); - block->expr1->value.op.op2->ref->u.ar.start[0]->ts - = block->expr1->value.op.op2->ref->u.ar.start[0]->value.op.op1->ts; + block->expr1->value.op.op2->value.op.op1->ref->u.ar.start[0]->ts + = block->expr1->value.op.op2->value.op.op1->ref->u.ar.start[0]->value.op.op1->ts; + block->expr1->value.op.op2->value.op.op2 = gfc_lval_expr_from_sym (byte_stride); /* if body: is_contiguous = .false. */ block->next = gfc_get_code (EXEC_ASSIGN); @@ -2285,7 +2279,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, /* Offset calculation. */ block = finalization_get_offset (idx, idx2, offset, strides, sizes, - byte_stride, rank, block->block, + rank, block->block, sub_ns); /* Create code for @@ -2351,7 +2345,7 @@ finish_assumed_rank: /* Offset calculation. */ block = finalization_get_offset (idx, idx2, offset, strides, sizes, - byte_stride, rank, last_code->block, + rank, last_code->block, sub_ns); /* Create code for diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 6e8f9c3cb815..e65369a8388c 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -1090,7 +1090,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, gfc_get_array_type_bounds (eltype, total_dim, 0, from, to, packed, GFC_ARRAY_UNKNOWN, true); desc = gfc_create_var (type, "atmp"); - GFC_DECL_PACKED_ARRAY (desc) = 1; + GFC_DECL_PACKED_ARRAY (desc) = packed; /* Emit a DECL_EXPR for the variable sized array type in GFC_TYPE_ARRAY_DATAPTR_TYPE so the gimplification of its type @@ -3796,6 +3796,9 @@ enum gfc_array_ref_sort { /* A regular array reference. */ ARS_REGULAR_ARRAY_REF, + /* Pointer arithmetics, with the strides from the array descriptor used as + byte offsets. */ + ARS_BYTES_STRIDED_PTR_ARITH, /* Pointer arithmetics, with the element size picked from the class descriptor's _size field. */ ARS_CLASS_PTR_ARITH, @@ -3822,7 +3825,12 @@ classify_array_ref (gfc_se *se, tree array, tree ref_base, gfc_expr *expr, if (is_pointer_array (array) || (expr && expr->ts.deferred && array && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (array)))) - return ARS_SPANNED_PTR_ARITH; + { + if (GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (array))) + return ARS_BYTES_STRIDED_PTR_ARITH; + else + return ARS_SPANNED_PTR_ARITH; + } if (ar && ar->type == AR_ELEMENT) { @@ -3851,6 +3859,9 @@ classify_array_ref (gfc_se *se, tree array, tree ref_base, gfc_expr *expr, else if (is_class_array_ref (se, ref_base, expr, ar, nullptr)) return ARS_CLASS_PTR_ARITH; + if (GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (array))) + return ARS_BYTES_STRIDED_PTR_ARITH; + if (tmp_array || non_negative_strides_array_p (array)) return ARS_REGULAR_ARRAY_REF; @@ -3883,6 +3894,18 @@ build_array_ref (gfc_se *se, tree array, tree ref_base, gfc_expr *expr, } break; + case ARS_BYTES_STRIDED_PTR_ARITH: + { + tree offset = fold_convert_loc (input_location, size_type_node, + index); + tree p = fold_build2_loc (input_location, POINTER_PLUS_EXPR, + TREE_TYPE (p), ref_base, offset); + p = fold_convert_loc (input_location, + GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (array)), p); + se->expr = build_fold_indirect_ref_loc (input_location, p); + } + break; + case ARS_SPANNED_PTR_ARITH: { tree decl = NULL_TREE; @@ -6939,9 +6962,14 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, anything as we still don't know the array stride. */ partial = gfc_create_var (logical_type_node, "partial"); TREE_USED (partial) = 1; - tmp = gfc_conv_descriptor_stride_get (dumdesc, gfc_rank_cst[0]); - tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, tmp, - gfc_index_one_node); + tree packed_stride; + if (GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (dumdesc))) + packed_stride = gfc_conv_descriptor_elem_len_get (dumdesc); + else + packed_stride = gfc_index_one_node; + tree stride = gfc_conv_descriptor_stride_get (dumdesc, 0); + tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, stride, + packed_stride); gfc_add_modify (&init, partial, tmp); } else @@ -6957,8 +6985,13 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, stride, gfc_index_zero_node); + tree default_stride; + if (GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (dumdesc))) + default_stride = gfc_conv_descriptor_elem_len_get (dumdesc); + else + default_stride = gfc_index_one_node; tmp = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type, - tmp, gfc_index_one_node, stride); + tmp, default_stride, stride); stride = GFC_TYPE_ARRAY_STRIDE (type, 0); gfc_add_modify (&init, stride, tmp); @@ -8798,6 +8831,9 @@ gfc_full_array_size (stmtblock_t *block, tree decl, int rank) tree idx; tree nelems; tree tmp; + + gcc_assert (!GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (decl))); + if (rank < 0) idx = gfc_conv_descriptor_rank_get (decl); else diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index b9e308f95f36..8f1375dde3a5 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -7678,9 +7678,10 @@ done: tmp = gfc_conv_descriptor_extent_get (gfc_desc, idx); gfc_add_modify (&loop_body, gfc_get_cfi_dim_extent (cfi, idx), tmp); /* d->dim[n].sm = gfc->dim[i].stride * gfc->span); */ - tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - gfc_conv_descriptor_stride_get (gfc_desc, idx), - gfc_conv_descriptor_span_get (gfc_desc)); + tmp = gfc_conv_descriptor_stride_get (gfc_desc, idx); + if (!GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (gfc_desc))) + tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, + tmp, gfc_conv_descriptor_span_get (gfc_desc)); gfc_add_modify (&loop_body, gfc_get_cfi_dim_sm (cfi, idx), tmp); /* Generate loop. */ diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index f04bf69d237e..5b684cd0414e 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -15,7 +15,7 @@ for more details. You should have received a copy of the GNU General Public License along with GCC; see the file COPYING3. If not see <http://www.gnu.org/licenses/>. */ - + #include "config.h" #include "system.h" @@ -275,6 +275,29 @@ gfc_conv_descriptor_offset_get (tree desc) return non_lvalue_loc (input_location, get_descriptor_offset (desc)); } +tree +gfc_conv_descriptor_offset_units_get (tree desc) +{ + gcc_assert (!GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (desc))); + return gfc_conv_descriptor_offset_get (desc); +} + +static tree get_descriptor_elem_len (tree desc); + +tree +gfc_conv_descriptor_offset_bytes_get (tree desc) +{ + if (GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (desc))) + return gfc_conv_descriptor_offset_get (desc); + else + { + tree offset_units = gfc_conv_descriptor_offset_get (desc); + tree elem_len = get_descriptor_elem_len (desc); + return fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, + offset_units, elem_len); + } +} + void gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc, tree value) { @@ -541,6 +564,30 @@ gfc_conv_descriptor_stride_get (tree desc, tree dim) return non_lvalue_loc (input_location, get_descriptor_stride (desc, dim)); } + +tree +gfc_conv_descriptor_stride_units_get (tree desc, tree dim) +{ + gcc_assert (GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (desc))); + return gfc_conv_descriptor_stride_get (desc, dim); +} + + +tree +gfc_conv_descriptor_stride_bytes_get (tree desc, tree dim) +{ + if (GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (desc))) + return gfc_conv_descriptor_stride_get (desc, dim); + else + { + tree stride_units = gfc_conv_descriptor_stride_get (desc, dim); + tree element_len = get_descriptor_elem_len (desc); + return fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, + stride_units, element_len); + } +} + + void gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc, tree dim, tree value) @@ -589,9 +636,7 @@ gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree desc, tree gfc_conv_descriptor_sm_get (tree desc, tree dim) { - return fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - gfc_conv_descriptor_stride_get (desc, dim), - gfc_conv_descriptor_span_get (desc)); + return gfc_conv_descriptor_stride_bytes_get (desc, dim); } @@ -1433,6 +1478,9 @@ void gfc_conv_shift_descriptor (stmtblock_t *block, tree dest, tree src, int rank, tree zero_cond) { + gcc_assert (GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (dest)) + == GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (src))); + tree tmp = gfc_conv_descriptor_data_get (src); gfc_conv_descriptor_data_set (block, dest, tmp); @@ -1545,6 +1593,9 @@ gfc_shift_descriptor (stmtblock_t *block, tree descr, int rank, void gfc_copy_sequence_descriptor (stmtblock_t *block, tree dest, tree src, int rank) { + gcc_assert (GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (dest)) + == GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (src))); + gfc_conv_descriptor_data_set (block, dest, gfc_conv_descriptor_data_get (src)); gfc_conv_descriptor_lbound_set (block, dest, gfc_index_zero_node, @@ -1566,6 +1617,9 @@ void gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src, gfc_expr *src_expr, bool subref) { + gcc_assert (GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (dest)) + == GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (src))); + struct lang_type *dest_ls = TYPE_LANG_SPECIFIC (TREE_TYPE (dest)); struct lang_type *src_ls = TYPE_LANG_SPECIFIC (TREE_TYPE (src)); @@ -1598,6 +1652,9 @@ gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src, void gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src, bool lhs_type) { + gcc_assert (GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (dest)) + == GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (src))); + gfc_conv_descriptor_data_set (block, dest, gfc_conv_descriptor_data_get (src)); gfc_conv_descriptor_offset_set (block, dest, @@ -1632,6 +1689,9 @@ gfc_copy_descriptor (stmtblock_t *block, tree dst, tree src, int rank) tree size; tree offset; + gcc_assert (GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (dst)) + == GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (src))); + offset = gfc_index_zero_node; /* Use memcpy to copy the descriptor. The size is the minimum of @@ -1668,6 +1728,9 @@ void gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src, tree ptr, int rank, gfc_ss *ss) { + gcc_assert (GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (dest)) + == GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (src))); + gfc_conv_descriptor_dtype_set (block, dest, gfc_conv_descriptor_dtype_get (src)); @@ -1695,6 +1758,9 @@ void gfc_conv_remap_descriptor (stmtblock_t *block, tree dest, int dest_rank, tree src, bool contiguous_src, gfc_array_ref *ar) { + gcc_assert (GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (dest)) + == GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (src))); + /* Set dtype. */ gfc_conv_descriptor_dtype_set (block, dest, gfc_get_dtype (TREE_TYPE (dest))); @@ -1726,7 +1792,7 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree dest, int dest_rank, if (contiguous_src) stride = gfc_index_one_node; else - stride = gfc_conv_descriptor_stride_get (src, gfc_rank_cst[0]); + stride = gfc_conv_descriptor_stride_bytes_get (src, gfc_rank_cst[0]); for (int dim = 0; dim < dest_rank; ++dim) { @@ -1782,6 +1848,9 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree src, gfc_expr *src_expr, bool unlimited_polymorphic, bool data_needed, bool subref) { + gcc_assert (GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (dest)) + == GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (src))); + int ndim = info->ref ? info->ref->u.ar.dimen : rank; /* Set the span field. */ @@ -1971,6 +2040,7 @@ gfc_set_contiguous_descriptor (stmtblock_t *block, tree desc, tree size, gfc_conv_descriptor_lbound_set (block, desc, gfc_index_zero_node, gfc_index_one_node); + gcc_assert (!GFC_BYTES_STRIDES_ARRAY_TYPE_P (desc)); gfc_conv_descriptor_stride_set (block, desc, gfc_index_zero_node, gfc_index_one_node); @@ -1984,10 +2054,12 @@ void gfc_set_descriptor_with_shape (stmtblock_t *block, tree desc, tree ptr, gfc_expr *shape, gfc_expr *lower, locus *where) { + gcc_assert (GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (desc))); + /* Set the span field. */ tree tmp = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc))); - tmp = fold_convert (gfc_array_index_type, tmp); - gfc_conv_descriptor_span_set (block, desc, tmp); + tree elem_len = fold_convert (gfc_array_index_type, tmp); + gfc_conv_descriptor_span_set (block, desc, elem_len); /* Set data value, dtype, and offset. */ tmp = GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc)); @@ -2030,7 +2102,7 @@ gfc_set_descriptor_with_shape (stmtblock_t *block, tree desc, tree ptr, tree stride = gfc_create_var (gfc_array_index_type, "stride"); tree offset = gfc_create_var (gfc_array_index_type, "offset"); - gfc_add_modify (block, stride, gfc_index_one_node); + gfc_add_modify (block, stride, elem_len); gfc_add_modify (block, offset, gfc_index_zero_node); /* Loop body. */ @@ -2097,6 +2169,8 @@ set_gfc_dimension_from_cfi (stmtblock_t *block, tree gfc, tree cfi, tree idx, tree stride; if (contiguous) { + gcc_assert (!GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (gfc))); + /* gfc->dim[i].stride = idx == 0 ? 1 : gfc->dim[i-1].stride * cfi->dim[i-1].extent */ tree cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, @@ -2113,12 +2187,10 @@ set_gfc_dimension_from_cfi (stmtblock_t *block, tree gfc, tree cfi, tree idx, } else { + gcc_assert (GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (gfc))); + /* gfc->dim[i].stride = cfi->dim[i].sm / cfi>elem_len */ - tmp = gfc_get_cfi_dim_sm (cfi, idx); - stride = fold_build2_loc (input_location, TRUNC_DIV_EXPR, - gfc_array_index_type, tmp, - fold_convert (gfc_array_index_type, - gfc_get_cfi_desc_elem_len (cfi))); + stride = gfc_get_cfi_dim_sm (cfi, idx); } set_dimension_fields (block, gfc, idx, lbound, ubound, stride, offset_var); @@ -2502,6 +2574,8 @@ gfc_set_descriptor_for_assign_realloc (stmtblock_t *block, gfc_loopinfo *loop, tree desc, tree desc2, tree elemsize2, tree class_expr2, bool coarray) { + gcc_assert (!GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (desc))); + gfc_array_spec *as; /* Get arrayspec if expr is a full array. */ if (expr2 && expr2->expr_type == EXPR_FUNCTION @@ -2634,6 +2708,8 @@ gfc_set_pdt_array_descriptor (stmtblock_t *block, tree descr, tree offset = gfc_index_zero_node; gfc_expr *e; + gcc_assert (!GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (descr))); + /* This chunk takes the expressions for 'lower' and 'upper' in the arrayspec and substitutes in the expressions for the parameters from 'pdt_param_list'. The descriptor @@ -2771,6 +2847,7 @@ gfc_descriptor_init_count (tree descriptor, int rank, int corank, int n; type = TREE_TYPE (descriptor); + gcc_assert (!GFC_BYTES_STRIDES_ARRAY_TYPE_P (type)); stride = gfc_index_one_node; offset = gfc_index_zero_node; diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h index 8214a30e4ed3..c6e13941f367 100644 --- a/gcc/fortran/trans-descriptor.h +++ b/gcc/fortran/trans-descriptor.h @@ -45,6 +45,8 @@ tree gfc_conv_descriptor_token (tree desc); tree gfc_conv_descriptor_data_get (tree desc); tree gfc_conv_descriptor_offset_get (tree desc); +tree gfc_conv_descriptor_offset_units_get (tree desc); +tree gfc_conv_descriptor_offset_bytes_get (tree desc); tree gfc_conv_descriptor_dtype_get (tree desc); tree gfc_conv_descriptor_elem_len_get (tree desc); tree gfc_conv_descriptor_version_get (tree desc); @@ -55,6 +57,8 @@ tree gfc_conv_descriptor_span_get (tree desc); tree gfc_conv_descriptor_dimension_get (tree desc, tree dim); tree gfc_conv_descriptor_dimension_get (tree desc, int dim); tree gfc_conv_descriptor_stride_get (tree desc, tree dim); +tree gfc_conv_descriptor_stride_units_get (tree desc, tree dim); +tree gfc_conv_descriptor_stride_bytes_get (tree desc, tree dim); tree gfc_conv_descriptor_lbound_get (tree desc, tree dim); tree gfc_conv_descriptor_ubound_get (tree desc, tree dim); tree gfc_conv_descriptor_sm_get (tree desc, tree dim); diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index c2d5730a9d78..7920e1aa6fa1 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -10824,7 +10824,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) tmp = gfc_typenode_for_spec (&expr2->ts); tmp = gfc_get_array_type_bounds (tmp, expr2->rank, 0, bound, bound, 0, - GFC_ARRAY_POINTER_CONT, false); + GFC_ARRAY_POINTER, false); tmp = gfc_create_var (tmp, "ptrtemp"); rse.descriptor_only = 0; rse.expr = tmp; diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index 8810b398b37d..a86395bfc061 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -2347,9 +2347,15 @@ gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg) gfc_add_block_to_block (&se->post, &argse.post); desc = gfc_evaluate_now (argse.expr, &se->pre); + tree initial_stride; stride = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[0]); + if (GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (desc))) + initial_stride = fold_convert (TREE_TYPE (stride), + gfc_conv_descriptor_elem_len_get (desc)); + else + initial_stride = build_int_cst (TREE_TYPE (stride), 1); cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, - stride, build_int_cst (TREE_TYPE (stride), 1)); + stride, initial_stride); for (i = 0; i < arg->rank - 1; i++) { diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc index 5a710d5f3b92..fd40fdd3522b 100644 --- a/gcc/fortran/trans-io.cc +++ b/gcc/fortran/trans-io.cc @@ -788,6 +788,14 @@ gfc_convert_array_to_string (gfc_se * se, gfc_expr * e) elt_size = fold_convert (gfc_array_index_type, elt_size); tree size; + if (GFC_DESCRIPTOR_TYPE_P (type) + && GFC_BYTES_STRIDES_ARRAY_TYPE_P (type)) + /* The stride already accounts the element size. */ + size = elts_count; + else + size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, + elts_count, elt_size); + if (TREE_CODE (se->expr) == ARRAY_REF) { tree index = TREE_OPERAND (se->expr, 1); @@ -796,9 +804,6 @@ gfc_convert_array_to_string (gfc_se * se, gfc_expr * e) elts_count = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, elts_count, index); - - size = fold_build2_loc (input_location, MULT_EXPR, - gfc_array_index_type, elts_count, elt_size); } else { @@ -809,8 +814,6 @@ gfc_convert_array_to_string (gfc_se * se, gfc_expr * e) tree offset = fold_convert_loc (input_location, gfc_array_index_type, TREE_OPERAND (ptr, 1)); - size = fold_build2_loc (input_location, MULT_EXPR, - gfc_array_index_type, elts_count, elt_size); size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, size, offset); } diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc index 2a3668de0bcf..4cd4be538ee6 100644 --- a/gcc/fortran/trans-types.cc +++ b/gcc/fortran/trans-types.cc @@ -1645,9 +1645,19 @@ gfc_build_array_type (tree type, gfc_array_spec * as, akind = contiguous ? GFC_ARRAY_ASSUMED_RANK_CONT : GFC_ARRAY_ASSUMED_RANK; } + + bool packed = contiguous + || as->type == AS_EXPLICIT + || as->type == AS_ASSUMED_SIZE + || akind == GFC_ARRAY_ALLOCATABLE + || akind == GFC_ARRAY_POINTER_CONT + || akind == GFC_ARRAY_ASSUMED_SHAPE_CONT + || akind == GFC_ARRAY_ASSUMED_RANK_ALLOCATABLE + || akind == GFC_ARRAY_ASSUMED_RANK_CONT + || akind == GFC_ARRAY_ASSUMED_RANK_POINTER_CONT; return gfc_get_array_type_bounds (type, as->rank == -1 ? GFC_MAX_DIMENSIONS : as->rank, - corank, lbound, ubound, 0, akind, + corank, lbound, ubound, packed, akind, restricted); } @@ -2071,6 +2081,7 @@ gfc_get_array_type_bounds (tree etype, int dimen, int codimen, tree * lbound, GFC_TYPE_ARRAY_CORANK (fat_type) = codimen; GFC_TYPE_ARRAY_DTYPE (fat_type) = NULL_TREE; GFC_TYPE_ARRAY_AKIND (fat_type) = akind; + GFC_BYTES_STRIDES_ARRAY_TYPE_P (fat_type) = !packed; /* Build an array descriptor record type. */ if (packed != 0) @@ -3756,7 +3767,8 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info) size_binop (PLUS_EXPR, dim_off, stride_suboff)); t = build1 (INDIRECT_REF, gfc_array_index_type, t); - t = build2 (MULT_EXPR, gfc_array_index_type, t, elem_size); + if (!GFC_BYTES_STRIDES_ARRAY_TYPE_P (type)) + t = build2 (MULT_EXPR, gfc_array_index_type, t, elem_size); info->dimen[dim].stride = t; if (dim + 1 < rank) dim_off = size_binop (PLUS_EXPR, dim_off, dim_size); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 3dda2f2ecb96..a5821c4a65ba 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -1119,6 +1119,9 @@ struct GTY(()) lang_decl { #define GFC_ARRAY_TYPE_P(node) TYPE_LANG_FLAG_2(node) /* Fortran CLASS type. */ #define GFC_CLASS_TYPE_P(node) TYPE_LANG_FLAG_4(node) +/* If true, the strides represent an amount of bytes. If false they represent + an amount of units of the element type. */ +#define GFC_BYTES_STRIDES_ARRAY_TYPE_P(node) TYPE_LANG_FLAG_3(node) /* The GFC_TYPE_ARRAY_* members are present in both descriptor and descriptorless array types. */ #define GFC_TYPE_ARRAY_LBOUND(node, dim) \ diff --git a/libgfortran/intrinsics/eoshift0.c b/libgfortran/intrinsics/eoshift0.c index 3baa966398cb..02eb666c52dd 100644 --- a/libgfortran/intrinsics/eoshift0.c +++ b/libgfortran/intrinsics/eoshift0.c @@ -25,6 +25,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include "libgfortran.h" #include <string.h> +#include <assert.h> static void @@ -80,7 +81,6 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, * GFC_DESCRIPTOR_STRIDE(ret,i-1); GFC_DESCRIPTOR_DIMENSION_SET(ret, i, 0, ub, str); - } /* xmallocarray allocates a single byte for zero size. */ @@ -106,20 +106,20 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, { /* Test if both ret and array are contiguous. */ index_type r_ex, a_ex; - r_ex = 1; - a_ex = 1; + r_ex = size; + a_ex = size; do_blocked = true; dim = GFC_DESCRIPTOR_RANK (array); for (n = 0; n < dim; n ++) { index_type rs, as; - rs = GFC_DESCRIPTOR_STRIDE (ret, n); + rs = GFC_DESCRIPTOR_STRIDE_BYTES (ret, n); if (rs != r_ex) { do_blocked = false; break; } - as = GFC_DESCRIPTOR_STRIDE (array, n); + as = GFC_DESCRIPTOR_STRIDE_BYTES (array, n); if (as != a_ex) { do_blocked = false; @@ -147,7 +147,7 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, bn = eoshift(a,sh*n1*n2,1) so a block move can be used for dim>1. */ - index_type count_low = GFC_DESCRIPTOR_STRIDE(array, which); + index_type count_low = GFC_DESCRIPTOR_STRIDE_UNITS(array, which); len = count_low * GFC_DESCRIPTOR_EXTENT(array, which); shift *= count_low; roffset = size; diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index dcc5619d1324..e5012f0c7b7d 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -3130,7 +3130,7 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info *nl, index_type offset, for (dim = 0; dim < nl->var_rank; dim++) list_obj.data = list_obj.data + (nl->ls[dim].idx - GFC_DESCRIPTOR_LBOUND(nl,dim)) - * GFC_DESCRIPTOR_STRIDE(nl,dim) * nl->size; + * GFC_DESCRIPTOR_STRIDE_BYTES(nl,dim); } else { @@ -3138,7 +3138,7 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info *nl, index_type offset, for (dim = 0; dim < nl->var_rank; dim++) pdata = (void*)(pdata + (nl->ls[dim].idx - GFC_DESCRIPTOR_LBOUND(nl,dim)) - * GFC_DESCRIPTOR_STRIDE(nl,dim) * nl->size); + * GFC_DESCRIPTOR_STRIDE_BYTES(nl,dim)); } /* If we are finished with the repeat count, try to read next value. */ diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index a3573d0dad88..da3672462ba0 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -3744,7 +3744,7 @@ init_loop_spec (gfc_array_char *desc, array_loop_spec *ls, int empty; empty = 0; - index = 1; + index = 0; *start_record = 0; for (i=0; i<rank; i++) @@ -3752,21 +3752,21 @@ init_loop_spec (gfc_array_char *desc, array_loop_spec *ls, ls[i].idx = GFC_DESCRIPTOR_LBOUND(desc,i); ls[i].start = GFC_DESCRIPTOR_LBOUND(desc,i); ls[i].end = GFC_DESCRIPTOR_UBOUND(desc,i); - ls[i].step = GFC_DESCRIPTOR_STRIDE(desc,i); + ls[i].step = GFC_DESCRIPTOR_STRIDE_BYTES(desc,i); empty = empty || (GFC_DESCRIPTOR_UBOUND(desc,i) < GFC_DESCRIPTOR_LBOUND(desc,i)); - if (GFC_DESCRIPTOR_STRIDE(desc,i) > 0) + if (GFC_DESCRIPTOR_STRIDE_BYTES(desc,i) > 0) { index += (GFC_DESCRIPTOR_EXTENT(desc,i) - 1) - * GFC_DESCRIPTOR_STRIDE(desc,i); + * GFC_DESCRIPTOR_STRIDE_BYTES(desc,i); } else { index -= (GFC_DESCRIPTOR_EXTENT(desc,i) - 1) - * GFC_DESCRIPTOR_STRIDE(desc,i); + * GFC_DESCRIPTOR_STRIDE_BYTES(desc,i); *start_record -= (GFC_DESCRIPTOR_EXTENT(desc,i) - 1) - * GFC_DESCRIPTOR_STRIDE(desc,i); + * GFC_DESCRIPTOR_STRIDE_BYTES(desc,i); } } @@ -3935,7 +3935,6 @@ next_record_r (st_parameter_dt *dtp, int done) hit_eof (dtp); /* Now seek to this record. */ - record = record * dtp->u.p.current_unit->recl; if (sseek (dtp->u.p.current_unit->s, record, SEEK_SET) < 0) { generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); @@ -4272,8 +4271,6 @@ next_record_w (st_parameter_dt *dtp, int done) dtp->u.p.current_unit->endfile = AT_ENDFILE; /* Now seek to this record */ - record = record * dtp->u.p.current_unit->recl; - if (sseek (dtp->u.p.current_unit->s, record, SEEK_SET) < 0) { generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index 62a8c514c186..0180fe78257a 100644 --- a/libgfortran/io/unit.c +++ b/libgfortran/io/unit.c @@ -519,10 +519,8 @@ set_internal_unit (st_parameter_dt *dtp, gfc_unit *iunit, int kind) iunit->rank = GFC_DESCRIPTOR_RANK (dtp->internal_unit_desc); iunit->ls = (array_loop_spec *) xmallocarray (iunit->rank, sizeof (array_loop_spec)); - iunit->internal_unit_len *= + iunit->internal_unit_len = init_loop_spec (dtp->internal_unit_desc, iunit->ls, &start_record); - - start_record *= iunit->recl; } /* Set initial values for unit parameters. */ diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c index 129e2dbf0916..68afb0ad627c 100644 --- a/libgfortran/io/unix.c +++ b/libgfortran/io/unix.c @@ -1098,7 +1098,7 @@ open_internal4 (char *base, size_t length, gfc_offset offset) s->buffer = base; s->buffer_offset = offset; - s->active = s->file_length = length * sizeof (gfc_char4_t); + s->active = s->file_length = length; s->st.vptr = &mem4_vtable; diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index 9ffa8426f729..892a3e170bc3 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -2281,8 +2281,6 @@ namelist_write_newline (st_parameter_dt *dtp) else { /* Now seek to this record */ - record = record * dtp->u.p.current_unit->recl; - if (sseek (dtp->u.p.current_unit->s, record, SEEK_SET) < 0) { generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index 5937cac4c365..c4f7c4a30465 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -483,9 +483,13 @@ typedef GFC_FULL_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_full_a #define GFC_DESCRIPTOR_EXTENT_BYTES(desc,i) \ (GFC_DESCRIPTOR_EXTENT(desc,i) * GFC_DESCRIPTOR_SIZE(desc)) -#define GFC_DESCRIPTOR_STRIDE(desc,i) ((desc)->dim[i]._stride) +#define GFC_DESCRIPTOR_STRIDE(desc,i) \ + ((desc)->dim[i]._stride) +#define GFC_DESCRIPTOR_STRIDE_UNITS(desc,i) \ + ({assert (GFC_DESCRIPTOR_STRIDE_BYTES(desc,i) % GFC_DESCRIPTOR_SIZE(desc) == 0); \ + GFC_DESCRIPTOR_STRIDE_BYTES(desc,i) / GFC_DESCRIPTOR_SIZE(desc);}) #define GFC_DESCRIPTOR_STRIDE_BYTES(desc,i) \ - (GFC_DESCRIPTOR_STRIDE(desc,i) * GFC_DESCRIPTOR_SPAN(desc)) + (GFC_DESCRIPTOR_STRIDE((desc),(i))) /* Macros to get both the size and the type with a single masking operation */ diff --git a/libgfortran/m4/cshift0.m4 b/libgfortran/m4/cshift0.m4 index 2725025182ba..308a46fbe108 100644 --- a/libgfortran/m4/cshift0.m4 +++ b/libgfortran/m4/cshift0.m4 @@ -116,7 +116,7 @@ cshift0_'rtype_code` ('rtype` *ret, const 'rtype` *array, ptrdiff_t shift, rstride[0] = sizeof ('rtype_name`); roffset = sizeof ('rtype_name`); soffset = sizeof ('rtype_name`); - index_type count_low = GFC_DESCRIPTOR_STRIDE(array, which); + index_type count_low = GFC_DESCRIPTOR_STRIDE_UNITS(array, which); len = count_low * GFC_DESCRIPTOR_EXTENT(array, which); shift *= count_low; for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++) diff --git a/libgfortran/m4/matmul_internal.m4 b/libgfortran/m4/matmul_internal.m4 index 6700632a550b..9f597a05937a 100644 --- a/libgfortran/m4/matmul_internal.m4 +++ b/libgfortran/m4/matmul_internal.m4 @@ -99,12 +99,12 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl /* One-dimensional result may be addressed in the code below either as a row or a column matrix. We want both cases to work. */ - rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE_UNITS(retarray,0); rxstride_bytes = rystride_bytes = GFC_DESCRIPTOR_STRIDE_BYTES(retarray,0); } else { - rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + rystride = GFC_DESCRIPTOR_STRIDE_UNITS(retarray,1); rxstride_bytes = GFC_DESCRIPTOR_STRIDE_BYTES(retarray,0); rystride_bytes = GFC_DESCRIPTOR_STRIDE_BYTES(retarray,1); } @@ -112,7 +112,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = GFC_DESCRIPTOR_STRIDE(a,0); + axstride = GFC_DESCRIPTOR_STRIDE_UNITS(a,0); aystride = 1; axstride_bytes = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); aystride_bytes = sizeof ('rtype_name`); @@ -122,8 +122,8 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl } else { - axstride = GFC_DESCRIPTOR_STRIDE(a,0); - aystride = GFC_DESCRIPTOR_STRIDE(a,1); + axstride = GFC_DESCRIPTOR_STRIDE_UNITS(a,0); + aystride = GFC_DESCRIPTOR_STRIDE_UNITS(a,1); axstride_bytes = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); aystride_bytes = GFC_DESCRIPTOR_STRIDE_BYTES(a,1); @@ -142,7 +142,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bxstride = GFC_DESCRIPTOR_STRIDE_UNITS(b,0); bxstride_bytes = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); /* bystride should never be used for 1-dimensional b. @@ -154,8 +154,8 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl } else { - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); - bystride = GFC_DESCRIPTOR_STRIDE(b,1); + bxstride = GFC_DESCRIPTOR_STRIDE_UNITS(b,0); + bystride = GFC_DESCRIPTOR_STRIDE_UNITS(b,1); bxstride_bytes = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); bystride_bytes = GFC_DESCRIPTOR_STRIDE_BYTES(b,1); ycount = GFC_DESCRIPTOR_EXTENT(b,1); diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c index 3c6822ca6ddf..323c5e10d9e9 100644 --- a/libgfortran/runtime/ISO_Fortran_binding.c +++ b/libgfortran/runtime/ISO_Fortran_binding.c @@ -87,8 +87,8 @@ cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr) GFC_DESCRIPTOR_LBOUND(d, n) = (index_type)lb; GFC_DESCRIPTOR_UBOUND(d, n) = (index_type)(s->dim[n].extent + lb - 1); - GFC_DESCRIPTOR_STRIDE(d, n) = (index_type)(s->dim[n].sm / s->elem_len); - d->offset -= GFC_DESCRIPTOR_STRIDE(d, n) * GFC_DESCRIPTOR_LBOUND(d, n); + GFC_DESCRIPTOR_STRIDE_BYTES(d, n) = (index_type)(s->dim[n].sm / s->elem_len); + d->offset -= GFC_DESCRIPTOR_STRIDE_BYTES(d, n) * GFC_DESCRIPTOR_LBOUND(d, n); } }
