https://gcc.gnu.org/g:af34812328e4ff62c4ba7a04104740c6297b9846
commit af34812328e4ff62c4ba7a04104740c6297b9846 Author: Mikael Morin <[email protected]> Date: Sat Sep 13 16:36:23 2025 +0200 Réduction utilisations macro GFC_DESCRIPTOR_STRIDE Retour en arrière list_read.c Correction eoshift0 Diff: --- libgfortran/intrinsics/associated.c | 4 ++- libgfortran/intrinsics/cshift0.c | 12 ++++---- libgfortran/intrinsics/eoshift0.c | 33 ++++++++++----------- libgfortran/intrinsics/eoshift2.c | 12 ++++---- libgfortran/intrinsics/is_contiguous.c | 10 +++---- libgfortran/intrinsics/random.c | 12 ++++---- libgfortran/intrinsics/spread_generic.c | 3 +- libgfortran/m4/cshift0.m4 | 19 ++++++------ libgfortran/m4/cshift1.m4 | 12 ++++---- libgfortran/m4/eoshift1.m4 | 13 ++++----- libgfortran/m4/eoshift3.m4 | 13 ++++----- libgfortran/m4/ifindloc1.m4 | 48 ++++++++++++------------------- libgfortran/m4/ifunction-s.m4 | 48 ++++++++++++------------------- libgfortran/m4/ifunction-s2.m4 | 41 +++++++++++--------------- libgfortran/m4/ifunction.m4 | 48 ++++++++++++------------------- libgfortran/m4/ifunction_logical.m4 | 16 ++++------- libgfortran/m4/matmul_internal.m4 | 33 ++++++++++++--------- libgfortran/m4/matmull.m4 | 6 ++-- libgfortran/m4/reshape.m4 | 2 +- libgfortran/m4/spread.m4 | 3 +- libgfortran/runtime/ISO_Fortran_binding.c | 2 +- libgfortran/runtime/in_pack_class.c | 16 +++++------ libgfortran/runtime/in_pack_generic.c | 12 ++++---- libgfortran/runtime/in_unpack_class.c | 10 +++---- libgfortran/runtime/in_unpack_generic.c | 12 ++++---- 25 files changed, 194 insertions(+), 246 deletions(-) diff --git a/libgfortran/intrinsics/associated.c b/libgfortran/intrinsics/associated.c index 592c84c097af..182364543a0b 100644 --- a/libgfortran/intrinsics/associated.c +++ b/libgfortran/intrinsics/associated.c @@ -51,7 +51,9 @@ associated (const gfc_array_void *pointer, const gfc_array_void *target) if (extent != GFC_DESCRIPTOR_EXTENT(target,n)) return 0; - if (GFC_DESCRIPTOR_STRIDE(pointer,n) != GFC_DESCRIPTOR_STRIDE(target,n) && extent != 1) + if ((GFC_DESCRIPTOR_STRIDE_BYTES(pointer,n) + != GFC_DESCRIPTOR_STRIDE_BYTES(target,n)) + && extent != 1) return 0; if (extent <= 0) return 0; diff --git a/libgfortran/intrinsics/cshift0.c b/libgfortran/intrinsics/cshift0.c index a490f81b8aee..a94dade9145c 100644 --- a/libgfortran/intrinsics/cshift0.c +++ b/libgfortran/intrinsics/cshift0.c @@ -58,23 +58,21 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array, if (ret->base_addr == NULL) { + index_type cnt; int i; ret->offset = 0; GFC_DTYPE_COPY(ret,array); + cnt = 1; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { - index_type ub, str; + index_type ub; ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; - if (i == 0) - str = 1; - else - str = GFC_DESCRIPTOR_EXTENT(ret,i-1) * - GFC_DESCRIPTOR_STRIDE(ret,i-1); + GFC_DESCRIPTOR_DIMENSION_SET(ret, i, 0, ub, cnt); - GFC_DESCRIPTOR_DIMENSION_SET(ret, i, 0, ub, str); + cnt = cnt * GFC_DESCRIPTOR_EXTENT(ret,i); } /* xmallocarray allocates a single byte for zero size. */ diff --git a/libgfortran/intrinsics/eoshift0.c b/libgfortran/intrinsics/eoshift0.c index 251971ecfb59..00f75f9a4b1a 100644 --- a/libgfortran/intrinsics/eoshift0.c +++ b/libgfortran/intrinsics/eoshift0.c @@ -63,24 +63,21 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, if (ret->base_addr == NULL) { + index_type cnt; int i; ret->offset = 0; GFC_DTYPE_COPY(ret,array); + cnt = 1; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { - index_type ub, str; + index_type ub; ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; - if (i == 0) - str = 1; - else - str = GFC_DESCRIPTOR_EXTENT(ret,i-1) - * GFC_DESCRIPTOR_STRIDE(ret,i-1); - - GFC_DESCRIPTOR_DIMENSION_SET(ret, i, 0, ub, str); + GFC_DESCRIPTOR_DIMENSION_SET(ret, i, 0, ub, cnt); + cnt = cnt * GFC_DESCRIPTOR_EXTENT(ret,i); } /* xmallocarray allocates a single byte for zero size. */ @@ -102,31 +99,36 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, sstride[0] = -1; rstride[0] = -1; + index_type contiguous_extent; if (which > 0) { /* Test if both ret and array are contiguous. */ index_type r_ex, a_ex; - r_ex = 1; - a_ex = 1; + r_ex = GFC_DESCRIPTOR_SIZE (ret); + a_ex = GFC_DESCRIPTOR_SIZE (array); do_blocked = true; + contiguous_extent = 1; 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; break; } r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n); - a_ex *= GFC_DESCRIPTOR_EXTENT (array, n); + + index_type extent = GFC_DESCRIPTOR_EXTENT (array, n); + a_ex *= extent; + contiguous_extent *= extent; } } else @@ -147,9 +149,8 @@ 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. */ - len = GFC_DESCRIPTOR_STRIDE(array, which) - * GFC_DESCRIPTOR_EXTENT(array, which); - shift *= GFC_DESCRIPTOR_STRIDE(array, which); + len = contiguous_extent * GFC_DESCRIPTOR_EXTENT(array, which); + shift *= contiguous_extent; roffset = size; soffset = size; for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++) diff --git a/libgfortran/intrinsics/eoshift2.c b/libgfortran/intrinsics/eoshift2.c index 2ebd1d5164f4..7752614cffd8 100644 --- a/libgfortran/intrinsics/eoshift2.c +++ b/libgfortran/intrinsics/eoshift2.c @@ -69,6 +69,7 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, if (ret->base_addr == NULL) { + index_type cnt; int i; ret->offset = 0; @@ -77,19 +78,16 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, /* xmallocarray allocates a single byte for zero size. */ ret->base_addr = xmallocarray (arraysize, size); + cnt = 1; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { - index_type ub, str; + index_type ub; ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; - if (i == 0) - str = 1; - else - str = GFC_DESCRIPTOR_EXTENT(ret,i-1) - * GFC_DESCRIPTOR_STRIDE(ret,i-1); + GFC_DESCRIPTOR_DIMENSION_SET(ret, i, 0, ub, cnt); - GFC_DESCRIPTOR_DIMENSION_SET(ret, i, 0, ub, str); + cnt = cnt * GFC_DESCRIPTOR_EXTENT(ret,i); } } else if (unlikely (compile_options.bounds_check)) diff --git a/libgfortran/intrinsics/is_contiguous.c b/libgfortran/intrinsics/is_contiguous.c index 965911ac8f7f..b2c960722e00 100644 --- a/libgfortran/intrinsics/is_contiguous.c +++ b/libgfortran/intrinsics/is_contiguous.c @@ -30,18 +30,18 @@ is_contiguous0 (const array_t * const restrict array) { index_type dim; index_type n; - index_type extent, stride; + index_type size, stride; dim = GFC_DESCRIPTOR_RANK (array); - extent = 1; + size = GFC_DESCRIPTOR_SIZE (array); for (n = 0; n < dim; n++) { - stride = GFC_DESCRIPTOR_STRIDE (array, n); - if (stride != extent) + stride = GFC_DESCRIPTOR_STRIDE_BYTES (array, n); + if (stride != size) return 0; - extent *= GFC_DESCRIPTOR_EXTENT (array, n); + size *= GFC_DESCRIPTOR_EXTENT (array, n); } return 1; diff --git a/libgfortran/intrinsics/random.c b/libgfortran/intrinsics/random.c index b0b08638f8b4..f102651fa441 100644 --- a/libgfortran/intrinsics/random.c +++ b/libgfortran/intrinsics/random.c @@ -975,7 +975,7 @@ arandom_m1 (gfc_array_m1 *x) for (index_type n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(x,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(x,n); extent[n] = GFC_DESCRIPTOR_EXTENT(x,n); if (extent[n] <= 0) return; @@ -1347,8 +1347,7 @@ random_seed_i4 (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get) /* Then copy it back to the user variable. */ for (size_t i = 0; i < SZ_IN_INT_4 ; i++) - memcpy (&(get->base_addr[(SZ_IN_INT_4 - 1 - i) * - GFC_DESCRIPTOR_STRIDE(get,0)]), + memcpy (GFC_DESCRIPTOR1_ELEM_ADDRESS (get, SZ_IN_INT_4 - 1 - i), (unsigned char*) seed + i * sizeof(GFC_UINTEGER_4), sizeof(GFC_UINTEGER_4)); } @@ -1378,8 +1377,7 @@ random_seed_i4 (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get) /* We copy the seed given by the user. */ for (size_t i = 0; i < SZ_IN_INT_4; i++) memcpy ((unsigned char*) seed + i * sizeof(GFC_UINTEGER_4), - &(put->base_addr[(SZ_IN_INT_4 - 1 - i) * - GFC_DESCRIPTOR_STRIDE(put,0)]), + GFC_DESCRIPTOR1_ELEM_ADDRESS (put, SZ_IN_INT_4 - 1 - i), sizeof(GFC_UINTEGER_4)); /* We put it after scrambling the bytes, to paper around users who @@ -1428,7 +1426,7 @@ random_seed_i8 (GFC_INTEGER_8 *size, gfc_array_i8 *put, gfc_array_i8 *get) /* This code now should do correct strides. */ for (size_t i = 0; i < SZ_IN_INT_8; i++) - memcpy (&(get->base_addr[i * GFC_DESCRIPTOR_STRIDE(get,0)]), &seed[i], + memcpy (GFC_DESCRIPTOR1_ELEM_ADDRESS (get, i), &seed[i], sizeof (GFC_UINTEGER_8)); } @@ -1456,7 +1454,7 @@ random_seed_i8 (GFC_INTEGER_8 *size, gfc_array_i8 *put, gfc_array_i8 *get) /* This code now should do correct strides. */ for (size_t i = 0; i < SZ_IN_INT_8; i++) - memcpy (&seed[i], &(put->base_addr[i * GFC_DESCRIPTOR_STRIDE(put,0)]), + memcpy (&seed[i], GFC_DESCRIPTOR1_ELEM_ADDRESS (put, i), sizeof (GFC_UINTEGER_8)); scramble_seed (master_state.s, seed); diff --git a/libgfortran/intrinsics/spread_generic.c b/libgfortran/intrinsics/spread_generic.c index d59533e97757..7fe818faedea 100644 --- a/libgfortran/intrinsics/spread_generic.c +++ b/libgfortran/intrinsics/spread_generic.c @@ -252,8 +252,7 @@ spread_internal_scalar (gfc_array_char *ret, const char *source, } else { - if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) - / GFC_DESCRIPTOR_STRIDE(ret,0)) + if (ncopies > GFC_DESCRIPTOR_EXTENT(ret,0)) runtime_error ("dim too large in spread()"); } diff --git a/libgfortran/m4/cshift0.m4 b/libgfortran/m4/cshift0.m4 index 39cdeb966303..674407c69771 100644 --- a/libgfortran/m4/cshift0.m4 +++ b/libgfortran/m4/cshift0.m4 @@ -48,6 +48,7 @@ cshift0_'rtype_code` ('rtype` *ret, const 'rtype` *array, ptrdiff_t shift, index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; + index_type contiguous_extent; index_type dim; index_type len; index_type n; @@ -67,31 +68,34 @@ cshift0_'rtype_code` ('rtype` *ret, const 'rtype` *array, ptrdiff_t shift, soffset = 1; len = 0; - r_ex = 1; - a_ex = 1; + r_ex = sizeof ('rtype_name`); + a_ex = sizeof ('rtype_name`); if (which > 0) { /* Test if both ret and array are contiguous. */ do_blocked = true; + contiguous_extent = 1; 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; break; } + index_type extent = GFC_DESCRIPTOR_EXTENT (array, n); r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n); - a_ex *= GFC_DESCRIPTOR_EXTENT (array, n); + a_ex *= extent; + contiguous_extent = extent; } } else @@ -116,9 +120,8 @@ cshift0_'rtype_code` ('rtype` *ret, const 'rtype` *array, ptrdiff_t shift, rstride[0] = sizeof ('rtype_name`); roffset = sizeof ('rtype_name`); soffset = sizeof ('rtype_name`); - len = GFC_DESCRIPTOR_STRIDE(array, which) - * GFC_DESCRIPTOR_EXTENT(array, which); - shift *= GFC_DESCRIPTOR_STRIDE(array, which); + len = contiguous_extent * GFC_DESCRIPTOR_EXTENT(array, which); + shift *= contiguous_extent; for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++) { count[n] = 0; diff --git a/libgfortran/m4/cshift1.m4 b/libgfortran/m4/cshift1.m4 index e35c5aa0f563..b368029dd729 100644 --- a/libgfortran/m4/cshift1.m4 +++ b/libgfortran/m4/cshift1.m4 @@ -78,22 +78,20 @@ cshift1 (gfc_array_char * const restrict ret, if (ret->base_addr == NULL) { + index_type cnt; ret->base_addr = xmallocarray (arraysize, size); ret->offset = 0; GFC_DTYPE_COPY(ret,array); + cnt = 1; for (index_type i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { - index_type ub, str; + index_type ub; ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; - if (i == 0) - str = 1; - else - str = GFC_DESCRIPTOR_EXTENT(ret,i-1) * - GFC_DESCRIPTOR_STRIDE(ret,i-1); + GFC_DESCRIPTOR_DIMENSION_SET(ret, i, 0, ub, cnt); - GFC_DESCRIPTOR_DIMENSION_SET(ret, i, 0, ub, str); + cnt = cnt * GFC_DESCRIPTOR_EXTENT(ret,i); } } else if (unlikely (compile_options.bounds_check)) diff --git a/libgfortran/m4/eoshift1.m4 b/libgfortran/m4/eoshift1.m4 index 7de92f2054e2..90db7b5df9b2 100644 --- a/libgfortran/m4/eoshift1.m4 +++ b/libgfortran/m4/eoshift1.m4 @@ -85,21 +85,20 @@ eoshift1 (gfc_array_char * const restrict ret, arraysize = size0 ((array_t *) array); if (ret->base_addr == NULL) { + index_type cnt; + ret->offset = 0; GFC_DTYPE_COPY(ret,array); + cnt = 1; for (index_type i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { - index_type ub, str; + index_type ub; ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; - if (i == 0) - str = 1; - else - str = GFC_DESCRIPTOR_EXTENT(ret,i-1) - * GFC_DESCRIPTOR_STRIDE(ret,i-1); + GFC_DESCRIPTOR_DIMENSION_SET(ret, i, 0, ub, cnt); - GFC_DESCRIPTOR_DIMENSION_SET(ret, i, 0, ub, str); + cnt = cnt * GFC_DESCRIPTOR_EXTENT(ret,i); } /* xmallocarray allocates a single byte for zero size. */ ret->base_addr = xmallocarray (arraysize, size); diff --git a/libgfortran/m4/eoshift3.m4 b/libgfortran/m4/eoshift3.m4 index 28706a998194..6c5965db5929 100644 --- a/libgfortran/m4/eoshift3.m4 +++ b/libgfortran/m4/eoshift3.m4 @@ -86,26 +86,23 @@ eoshift3 (gfc_array_char * const restrict ret, if (ret->base_addr == NULL) { + index_type cnt; ret->base_addr = xmallocarray (arraysize, size); ret->offset = 0; GFC_DTYPE_COPY(ret,array); + cnt = 1; for (index_type i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { - index_type ub, str; + index_type ub; ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; - if (i == 0) - str = 1; - else - str = GFC_DESCRIPTOR_EXTENT(ret,i-1) - * GFC_DESCRIPTOR_STRIDE(ret,i-1); + GFC_DESCRIPTOR_DIMENSION_SET(ret, i, 0, ub, cnt); - GFC_DESCRIPTOR_DIMENSION_SET(ret, i, 0, ub, str); + cnt = cnt * GFC_DESCRIPTOR_EXTENT(ret,i); } /* xmallocarray allocates a single byte for zero size. */ ret->base_addr = xmallocarray (arraysize, size); - } else if (unlikely (compile_options.bounds_check)) { diff --git a/libgfortran/m4/ifindloc1.m4 b/libgfortran/m4/ifindloc1.m4 index 7d4ba327ca08..ec19bc7d220b 100644 --- a/libgfortran/m4/ifindloc1.m4 +++ b/libgfortran/m4/ifindloc1.m4 @@ -77,25 +77,21 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t cnt; + cnt = 1; for (n = 0; n < rank; n++) { - if (n == 0) - str = 1; - else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); - GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, str); + cnt = cnt * extent[n]; } retarray->offset = 0; retarray->dtype.rank = rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; - - retarray->base_addr = xmallocarray (alloc_size, sizeof (index_type)); - if (alloc_size == 0) + retarray->base_addr = xmallocarray (cnt, sizeof (index_type)); + if (cnt == 0) return; } else @@ -252,25 +248,21 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t cnt; + cnt = 1; for (n = 0; n < rank; n++) { - if (n == 0) - str = 1; - else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); - GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, str); + cnt = cnt * extent[n]; } retarray->offset = 0; retarray->dtype.rank = rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; - - retarray->base_addr = xmallocarray (alloc_size, sizeof (index_type)); - if (alloc_size == 0) + retarray->base_addr = xmallocarray (cnt, sizeof (index_type)); + if (cnt == 0) return; } else @@ -415,25 +407,21 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t cnt; + cnt = 1; for (n = 0; n < rank; n++) { - if (n == 0) - str = 1; - else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); - GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, str); + cnt = cnt * extent[n]; } retarray->offset = 0; retarray->dtype.rank = rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; - - retarray->base_addr = xmallocarray (alloc_size, sizeof (index_type)); - if (alloc_size == 0) + retarray->base_addr = xmallocarray (cnt, sizeof (index_type)); + if (cnt == 0) return; } else diff --git a/libgfortran/m4/ifunction-s.m4 b/libgfortran/m4/ifunction-s.m4 index e5a4d6e3a829..415ffd130bfc 100644 --- a/libgfortran/m4/ifunction-s.m4 +++ b/libgfortran/m4/ifunction-s.m4 @@ -89,25 +89,21 @@ void if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t cnt; + cnt = 1; for (n = 0; n < rank; n++) { - if (n == 0) - str = 1; - else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); - GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, str); + cnt = cnt * extent[n]; } retarray->offset = 0; retarray->dtype.rank = rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; - - retarray->base_addr = xmallocarray (alloc_size, sizeof ('rtype_name`)); - if (alloc_size == 0) + retarray->base_addr = xmallocarray (cnt, sizeof ('rtype_name`)); + if (cnt == 0) return; } else @@ -280,25 +276,21 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t cnt; + cnt = 1; for (n = 0; n < rank; n++) { - if (n == 0) - str = 1; - else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); - GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, str); + cnt = cnt * extent[n]; } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; - retarray->offset = 0; retarray->dtype.rank = rank; - retarray->base_addr = xmallocarray (alloc_size, sizeof ('rtype_name`)); - if (alloc_size == 0) + retarray->base_addr = xmallocarray (cnt, sizeof ('rtype_name`)); + if (cnt == 0) return; } else @@ -438,25 +430,21 @@ s'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t cnt; + cnt = 1; for (n = 0; n < rank; n++) { - if (n == 0) - str = 1; - else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); - GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, str); + cnt = cnt * extent[n]; } retarray->offset = 0; retarray->dtype.rank = rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; - - retarray->base_addr = xmallocarray (alloc_size, sizeof ('rtype_name`)); - if (alloc_size == 0) + retarray->base_addr = xmallocarray (cnt, sizeof ('rtype_name`)); + if (cnt == 0) return; } else diff --git a/libgfortran/m4/ifunction-s2.m4 b/libgfortran/m4/ifunction-s2.m4 index c5bc2ef590e7..2e42c15c3f6a 100644 --- a/libgfortran/m4/ifunction-s2.m4 +++ b/libgfortran/m4/ifunction-s2.m4 @@ -90,25 +90,22 @@ void if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, cnt; + cnt = 1; for (n = 0; n < rank; n++) { - if (n == 0) - str = 1; - else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); - GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, str); + cnt = cnt * extent[n]; } retarray->offset = 0; retarray->dtype.rank = rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1] - * string_len; + alloc_size = cnt * string_len; - retarray->base_addr = xmallocarray (alloc_size, sizeof (rtype_name)); + retarray->base_addr = xmallocarray (alloc_size, sizeof ('rtype_name`)); if (alloc_size == 0) return; } @@ -280,20 +277,17 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, cnt; + cnt = 1; for (n = 0; n < rank; n++) { - if (n == 0) - str = 1; - else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); - GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, str); + cnt = cnt * extent[n]; } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1] - * string_len; + alloc_size = cnt * string_len; retarray->offset = 0; retarray->dtype.rank = rank; @@ -439,23 +433,20 @@ s'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, cnt; + cnt = 1; for (n = 0; n < rank; n++) { - if (n == 0) - str = 1; - else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); - GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, str); + cnt = cnt * extent[n]; } retarray->offset = 0; retarray->dtype.rank = rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1] - * string_len; + alloc_size = cnt * string_len; retarray->base_addr = xmallocarray (alloc_size, sizeof ('rtype_name`)); if (alloc_size == 0) diff --git a/libgfortran/m4/ifunction.m4 b/libgfortran/m4/ifunction.m4 index 079e3f1ef99e..073b0da217ae 100644 --- a/libgfortran/m4/ifunction.m4 +++ b/libgfortran/m4/ifunction.m4 @@ -76,16 +76,14 @@ void if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t cnt; + cnt = 1; for (n = 0; n < rank; n++) { - if (n == 0) - str = 1; - else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); - GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, str); + cnt = cnt * extent[n]; } retarray->offset = 0; @@ -93,10 +91,8 @@ void retarray->dtype.elem_len = sizeof ('rtype_name`); retarray->span = sizeof ('rtype_name`); - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; - - retarray->base_addr = xmallocarray (alloc_size, sizeof (rtype_name)); - if (alloc_size == 0) + retarray->base_addr = xmallocarray (cnt, sizeof ('rtype_name`)); + if (cnt == 0) return; } else @@ -270,27 +266,23 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t cnt; + cnt = 1; for (n = 0; n < rank; n++) { - if (n == 0) - str = 1; - else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); - GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, str); + cnt = cnt * extent[n]; } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; - retarray->offset = 0; retarray->dtype.rank = rank; retarray->dtype.elem_len = sizeof ('rtype_name`); retarray->span = sizeof ('rtype_name`); - retarray->base_addr = xmallocarray (alloc_size, sizeof (rtype_name)); - if (alloc_size == 0) + retarray->base_addr = xmallocarray (cnt, sizeof ('rtype_name`)); + if (cnt == 0) return; } else @@ -431,25 +423,21 @@ s'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t cnt; + cnt = 1; for (n = 0; n < rank; n++) { - if (n == 0) - str = 1; - else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); - GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, str); + cnt = cnt * extent[n]; } retarray->offset = 0; retarray->dtype.rank = rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; - - retarray->base_addr = xmallocarray (alloc_size, sizeof (rtype_name)); - if (alloc_size == 0) + retarray->base_addr = xmallocarray (cnt, sizeof ('rtype_name`)); + if (cnt == 0) return; } else diff --git a/libgfortran/m4/ifunction_logical.m4 b/libgfortran/m4/ifunction_logical.m4 index b6d7e616d546..bdd7913e60ff 100644 --- a/libgfortran/m4/ifunction_logical.m4 +++ b/libgfortran/m4/ifunction_logical.m4 @@ -73,25 +73,21 @@ void if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t cnt; + cnt = 1; for (n = 0; n < rank; n++) { - if (n == 0) - str = 1; - else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); - GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, str); + cnt = cnt * extent[n]; } retarray->offset = 0; retarray->dtype.rank = rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; - - retarray->base_addr = xmallocarray (alloc_size, sizeof (rtype_name)); - if (alloc_size == 0) + retarray->base_addr = xmallocarray (cnt, sizeof ('rtype_name`)); + if (cnt == 0) return; } else diff --git a/libgfortran/m4/matmul_internal.m4 b/libgfortran/m4/matmul_internal.m4 index c013a6b60078..6700632a550b 100644 --- a/libgfortran/m4/matmul_internal.m4 +++ b/libgfortran/m4/matmul_internal.m4 @@ -7,7 +7,7 @@ const 'rtype_name` * restrict bbase; 'rtype_name` * restrict dest; - index_type rxstride, rystride, axstride, aystride, bxstride, bystride; + index_type rystride, axstride, aystride, bxstride, bystride; index_type x, y, n, count, xcount, ycount; index_type axstride_bytes, aystride_bytes, bxstride_bytes, bystride_bytes, rxstride_bytes, rystride_bytes; @@ -99,12 +99,11 @@ 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. */ - rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); rxstride_bytes = rystride_bytes = GFC_DESCRIPTOR_STRIDE_BYTES(retarray,0); } else { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); rxstride_bytes = GFC_DESCRIPTOR_STRIDE_BYTES(retarray,0); rystride_bytes = GFC_DESCRIPTOR_STRIDE_BYTES(retarray,1); @@ -173,15 +172,19 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl #define min(a,b) ((a) <= (b) ? (a) : (b)) #define max(a,b) ((a) >= (b) ? (a) : (b)) - if (try_blas && rxstride == 1 && (axstride == 1 || aystride == 1) - && (bxstride == 1 || bystride == 1) + if (try_blas + && rxstride_bytes == sizeof ('rtype_name`) + && (axstride_bytes == sizeof ('rtype_name`) + || aystride_bytes == sizeof ('rtype_name`)) + && (bxstride_bytes == sizeof ('rtype_name`) + || bystride_bytes == sizeof ('rtype_name`)) && (((float) xcount) * ((float) ycount) * ((float) count) > POW3(blas_limit))) { const int m = xcount, n = ycount, k = count, ldc = rystride; const 'rtype_name` one = 1, zero = 0; - const int lda = (axstride == 1) ? aystride : axstride, - ldb = (bxstride == 1) ? bystride : bxstride; + const int lda = (axstride_bytes == sizeof ('rtype_name`)) ? aystride : axstride, + ldb = (bxstride_bytes == sizeof ('rtype_name`)) ? bystride : bxstride; if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) { @@ -190,12 +193,12 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl if (try_blas & 2) transa = "C"; else - transa = axstride == 1 ? "N" : "T"; + transa = axstride_bytes == sizeof ('rtype_name`) ? "N" : "T"; if (try_blas & 4) transb = "C"; else - transb = bxstride == 1 ? "N" : "T"; + transb = bxstride_bytes == sizeof ('rtype_name`) ? "N" : "T"; gemm (transa, transb , &m, &n, &k, &one, abase, &lda, bbase, &ldb, &zero, dest, @@ -204,7 +207,9 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl } } - if (rxstride == 1 && axstride == 1 && bxstride == 1 + if (rxstride_bytes == sizeof ('rtype_name`) + && axstride_bytes == sizeof ('rtype_name`) + && bxstride_bytes == sizeof ('rtype_name`) && GFC_DESCRIPTOR_RANK (b) != 1) { /* This block of code implements a tuned matmul, derived from @@ -257,7 +262,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl /* Adjust size of t1 to what is needed. */ index_type t1_dim, a_sz; - if (aystride == 1) + if (aystride_bytes == sizeof ('rtype_name`)) a_sz = rystride; else a_sz = a_dim1; @@ -483,7 +488,9 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl #undef B_ARRAY_ELEM #undef C_ARRAY_ELEM } - else if (rxstride == 1 && aystride == 1 && bxstride == 1) + else if (rxstride_bytes == sizeof ('rtype_name`) + && aystride_bytes == sizeof ('rtype_name`) + && bxstride_bytes == sizeof ('rtype_name`)) { if (GFC_DESCRIPTOR_RANK (a) != 1) { @@ -536,7 +543,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl GFC_DESCRIPTOR1_ELEM (retarray, y) = s; } } - else if (axstride < aystride) + else if (axstride_bytes < aystride_bytes) { for (y = 0; y < ycount; y++) for (x = 0; x < xcount; x++) diff --git a/libgfortran/m4/matmull.m4 b/libgfortran/m4/matmull.m4 index 8470742bccd5..9a09922b8689 100644 --- a/libgfortran/m4/matmull.m4 +++ b/libgfortran/m4/matmull.m4 @@ -163,13 +163,13 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl ` if (GFC_DESCRIPTOR_RANK (retarray) == 1) { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rxstride = GFC_DESCRIPTOR_STRIDE_BYTES(retarray,0); rystride = rxstride; } else { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); - rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + rxstride = GFC_DESCRIPTOR_STRIDE_BYTES(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE_BYTES(retarray,1); } /* If we have rank 1 parameters, zero the absent stride, and set the size to diff --git a/libgfortran/m4/reshape.m4 b/libgfortran/m4/reshape.m4 index acf3df3fcba2..10bc787b6074 100644 --- a/libgfortran/m4/reshape.m4 +++ b/libgfortran/m4/reshape.m4 @@ -197,7 +197,7 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, for (index_type n = 0; n < rdim; n++) { - v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + v = GFC_DESCRIPTOR1_ELEM (order, n) - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" diff --git a/libgfortran/m4/spread.m4 b/libgfortran/m4/spread.m4 index fbf26958cae0..cd70bab57dde 100644 --- a/libgfortran/m4/spread.m4 +++ b/libgfortran/m4/spread.m4 @@ -250,8 +250,7 @@ spread_scalar_'rtype_code` ('rtype` *ret, const 'rtype_name` *source, } else { - if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) - / GFC_DESCRIPTOR_STRIDE(ret,0)) + if (ncopies > GFC_DESCRIPTOR_EXTENT(ret,0)) runtime_error ("dim too large in spread()"); } diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c index 1057f37b7d42..3c6822ca6ddf 100644 --- a/libgfortran/runtime/ISO_Fortran_binding.c +++ b/libgfortran/runtime/ISO_Fortran_binding.c @@ -146,7 +146,7 @@ gfc_desc_to_cfi_desc (CFI_cdesc_t **d_ptr, const gfc_array_void *s) else d->dim[n].extent = (CFI_index_t)GFC_DESCRIPTOR_UBOUND(s, n) - (CFI_index_t)GFC_DESCRIPTOR_LBOUND(s, n) + 1; - d->dim[n].sm = (CFI_index_t)(GFC_DESCRIPTOR_STRIDE(s, n) * s->span); + d->dim[n].sm = (CFI_index_t)(GFC_DESCRIPTOR_STRIDE_BYTES(s, n)); } if (*d_ptr == NULL) diff --git a/libgfortran/runtime/in_pack_class.c b/libgfortran/runtime/in_pack_class.c index 101f6884d158..1eea5fe83adb 100644 --- a/libgfortran/runtime/in_pack_class.c +++ b/libgfortran/runtime/in_pack_class.c @@ -68,12 +68,12 @@ internal_pack_class (gfc_class_array_t *dest_class, source_arr = (gfc_array_void *) &(source_class->_data); size = GFC_DESCRIPTOR_SIZE (source_arr); dim = GFC_DESCRIPTOR_RANK (source_arr); - ssize = 1; + ssize = size; packed = 1; for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE (source_arr, n); + stride[n] = GFC_DESCRIPTOR_STRIDE_BYTES (source_arr, n); extent[n] = GFC_DESCRIPTOR_EXTENT (source_arr, n); if (extent[n] <= 0) { @@ -100,17 +100,15 @@ internal_pack_class (gfc_class_array_t *dest_class, dest_offset = 0; for (n = 0; n < dim; ++n) { - GFC_DESCRIPTOR_LBOUND (dest_arr, n) = 1; - GFC_DESCRIPTOR_UBOUND (dest_arr, n) = extent[n]; - GFC_DESCRIPTOR_STRIDE (dest_arr, n) = dest_stride; + GFC_DESCRIPTOR_DIMENSION_SET (dest_arr, n, 1, extent[n], dest_stride); dest_offset -= dest_stride * 1 /* GFC_DESCRIPTOR_LBOUND (dest_arr, n) */; dest_stride *= GFC_DESCRIPTOR_EXTENT (dest_arr, n); } dest_arr->offset = dest_offset; - dest_arr->base_addr = xmallocarray (ssize, size); + dest_arr->base_addr = xmalloc (ssize); dest = (void *) dest_arr->base_addr; src = source_arr->base_addr; - stride0 = stride[0] * size; + stride0 = stride[0]; /* Can not use the dimension here, because the class may be allocated for a higher dimensional array, but only a smaller amount is present. */ vtab = *(gfc_vtype_generic_t **) (((void *) source_class) + size_class @@ -135,7 +133,7 @@ internal_pack_class (gfc_class_array_t *dest_class, count[n] = 0; /* We could precalculate these products, but this is a less frequently used path so probably not worth it. */ - src -= stride[n] * extent[n] * size; + src -= stride[n] * extent[n]; n++; if (n == dim) { @@ -145,7 +143,7 @@ internal_pack_class (gfc_class_array_t *dest_class, else { count[n]++; - src += stride[n] * size; + src += stride[n]; } } } diff --git a/libgfortran/runtime/in_pack_generic.c b/libgfortran/runtime/in_pack_generic.c index 6285f13bdfd5..de004f360953 100644 --- a/libgfortran/runtime/in_pack_generic.c +++ b/libgfortran/runtime/in_pack_generic.c @@ -160,12 +160,12 @@ internal_pack (gfc_array_char * source) } dim = GFC_DESCRIPTOR_RANK (source); - ssize = 1; + ssize = GFC_DESCRIPTOR_SIZE (source); packed = 1; for (index_type n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(source,n); extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { @@ -184,10 +184,10 @@ internal_pack (gfc_array_char * source) return source->base_addr; /* Allocate storage for the destination. */ - destptr = xmallocarray (ssize, size); + destptr = xmalloc (ssize); dest = (char *)destptr; src = source->base_addr; - stride0 = stride[0] * size; + stride0 = stride[0]; while (src) { @@ -206,7 +206,7 @@ internal_pack (gfc_array_char * source) count[n] = 0; /* We could precalculate these products, but this is a less frequently used path so probably not worth it. */ - src -= stride[n] * extent[n] * size; + src -= stride[n] * extent[n]; n++; if (n == dim) { @@ -216,7 +216,7 @@ internal_pack (gfc_array_char * source) else { count[n]++; - src += stride[n] * size; + src += stride[n]; } } } diff --git a/libgfortran/runtime/in_unpack_class.c b/libgfortran/runtime/in_unpack_class.c index cf53ae8515a2..88dd56df6f1a 100644 --- a/libgfortran/runtime/in_unpack_class.c +++ b/libgfortran/runtime/in_unpack_class.c @@ -66,12 +66,12 @@ internal_unpack_class (gfc_class_array_t *dest_class, for (index_type n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE (dest_arr, n); + stride[n] = GFC_DESCRIPTOR_STRIDE_BYTES (dest_arr, n); extent[n] = GFC_DESCRIPTOR_EXTENT (dest_arr, n); if (extent[n] <= 0) return; - if (dsize == stride[n]) + if (dsize * size == stride[n]) dsize *= extent[n]; else dsize = 0; @@ -97,7 +97,7 @@ internal_unpack_class (gfc_class_array_t *dest_class, return; } - stride0 = stride[0] * size; + stride0 = stride[0]; while (dest) { @@ -116,7 +116,7 @@ internal_unpack_class (gfc_class_array_t *dest_class, count[n] = 0; /* We could precalculate these products, but this is a less frequently used path so probably not worth it. */ - dest -= stride[n] * extent[n] * size; + dest -= stride[n] * extent[n]; n++; if (n == dim) { @@ -126,7 +126,7 @@ internal_unpack_class (gfc_class_array_t *dest_class, else { count[n]++; - dest += stride[n] * size; + dest += stride[n]; } } } diff --git a/libgfortran/runtime/in_unpack_generic.c b/libgfortran/runtime/in_unpack_generic.c index b6be7585c0a3..f89ede6b8063 100644 --- a/libgfortran/runtime/in_unpack_generic.c +++ b/libgfortran/runtime/in_unpack_generic.c @@ -188,11 +188,11 @@ internal_unpack (gfc_array_char * d, const void * s) size = GFC_DESCRIPTOR_SIZE (d); dim = GFC_DESCRIPTOR_RANK (d); - dsize = 1; + dsize = size; for (index_type n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(d,n); extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; @@ -207,11 +207,11 @@ internal_unpack (gfc_array_char * d, const void * s) if (dsize != 0) { - memcpy (dest, src, dsize * size); + memcpy (dest, src, dsize); return; } - stride0 = stride[0] * size; + stride0 = stride[0]; while (dest) { @@ -230,7 +230,7 @@ internal_unpack (gfc_array_char * d, const void * s) count[n] = 0; /* We could precalculate these products, but this is a less frequently used path so probably not worth it. */ - dest -= stride[n] * extent[n] * size; + dest -= stride[n] * extent[n]; n++; if (n == dim) { @@ -240,7 +240,7 @@ internal_unpack (gfc_array_char * d, const void * s) else { count[n]++; - dest += stride[n] * size; + dest += stride[n]; } } }
