https://gcc.gnu.org/g:beb7097bc615eaf15718f9eb2edec241ae61a6bd
commit beb7097bc615eaf15718f9eb2edec241ae61a6bd Author: Mikael Morin <[email protected]> Date: Sat Sep 27 20:23:58 2025 +0200 Utilisation bytes_counted_strides pour initialisation descripteur résultat. Diff: --- libgfortran/intrinsics/cshift0.c | 5 ++++- libgfortran/intrinsics/eoshift0.c | 7 +++++- libgfortran/intrinsics/eoshift2.c | 5 ++++- libgfortran/intrinsics/pack_generic.c | 15 +++++++++++-- libgfortran/intrinsics/reduce.c | 6 +++++- libgfortran/intrinsics/reshape_generic.c | 10 +++++++-- libgfortran/intrinsics/spread_generic.c | 17 ++++++++++++--- libgfortran/intrinsics/unpack_generic.c | 10 +++++++-- libgfortran/io/list_read.c | 4 ++-- libgfortran/libgfortran.h | 28 ++++++++++++++++++------ libgfortran/m4/bessel.m4 | 16 ++++++++++++-- libgfortran/m4/cshift1.m4 | 5 ++++- libgfortran/m4/eoshift1.m4 | 5 ++++- libgfortran/m4/eoshift3.m4 | 6 ++++-- libgfortran/m4/ifindloc0.m4 | 24 ++++++++++++++++++--- libgfortran/m4/ifindloc1.m4 | 33 ++++++++++++++++++++++------ libgfortran/m4/iforeach-s.m4 | 24 ++++++++++++++++++--- libgfortran/m4/iforeach.m4 | 27 +++++++++++++++++------ libgfortran/m4/ifunction-s.m4 | 36 +++++++++++++++++++++++++------ libgfortran/m4/ifunction-s2.m4 | 36 +++++++++++++++++++++++++------ libgfortran/m4/ifunction.m4 | 33 ++++++++++++++++++++++------ libgfortran/m4/ifunction_logical.m4 | 11 ++++++++-- libgfortran/m4/matmul_internal.m4 | 15 +++++++++---- libgfortran/m4/matmull.m4 | 15 +++++++++---- libgfortran/m4/pack.m4 | 8 ++++++- libgfortran/m4/reshape.m4 | 12 +++++++++-- libgfortran/m4/shape.m4 | 8 ++++++- libgfortran/m4/spread.m4 | 23 ++++++++++++++++---- libgfortran/m4/unpack.m4 | 24 +++++++++++++++++---- libgfortran/runtime/ISO_Fortran_binding.c | 7 ++++-- 30 files changed, 388 insertions(+), 87 deletions(-) diff --git a/libgfortran/intrinsics/cshift0.c b/libgfortran/intrinsics/cshift0.c index a94dade9145c..3140b81a3c75 100644 --- a/libgfortran/intrinsics/cshift0.c +++ b/libgfortran/intrinsics/cshift0.c @@ -63,7 +63,10 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array, ret->offset = 0; GFC_DTYPE_COPY(ret,array); - cnt = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + cnt = size; + else + cnt = 1; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { index_type ub; diff --git a/libgfortran/intrinsics/eoshift0.c b/libgfortran/intrinsics/eoshift0.c index 02eb666c52dd..64d14bd37f5f 100644 --- a/libgfortran/intrinsics/eoshift0.c +++ b/libgfortran/intrinsics/eoshift0.c @@ -75,7 +75,12 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; if (i == 0) - str = 1; + { + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + str = size; + else + str = 1; + } else str = GFC_DESCRIPTOR_EXTENT(ret,i-1) * GFC_DESCRIPTOR_STRIDE(ret,i-1); diff --git a/libgfortran/intrinsics/eoshift2.c b/libgfortran/intrinsics/eoshift2.c index 7752614cffd8..e9ea3eb1afe5 100644 --- a/libgfortran/intrinsics/eoshift2.c +++ b/libgfortran/intrinsics/eoshift2.c @@ -78,7 +78,10 @@ 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; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + cnt = size; + else + cnt = 1; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { index_type ub; diff --git a/libgfortran/intrinsics/pack_generic.c b/libgfortran/intrinsics/pack_generic.c index 37cb52ecfa3a..c72a1eb34bd0 100644 --- a/libgfortran/intrinsics/pack_generic.c +++ b/libgfortran/intrinsics/pack_generic.c @@ -158,8 +158,13 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array, if (ret->base_addr == NULL) { + index_type stride; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + stride = size; + else + stride = 1; /* Setup the array descriptor. */ - GFC_DESCRIPTOR_DIMENSION_SET(ret, 0, 0, total-1, 1); + GFC_DESCRIPTOR_DIMENSION_SET(ret, 0, 0, total-1, stride); ret->offset = 0; /* xmallocarray allocates a single byte for zero size. */ @@ -534,8 +539,14 @@ pack_s_internal (gfc_array_char *ret, const gfc_array_char *array, total = 0; } + index_type stride; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + stride = size; + else + stride = 1; + /* Setup the array descriptor. */ - GFC_DESCRIPTOR_DIMENSION_SET(ret, 0, 0, total-1, 1); + GFC_DESCRIPTOR_DIMENSION_SET(ret, 0, 0, total-1, stride); ret->offset = 0; diff --git a/libgfortran/intrinsics/reduce.c b/libgfortran/intrinsics/reduce.c index 2895bd3dd587..11f2a69706c7 100644 --- a/libgfortran/intrinsics/reduce.c +++ b/libgfortran/intrinsics/reduce.c @@ -26,6 +26,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include "libgfortran.h" #include <string.h> #include <stdio.h> +#include <assert.h> typedef GFC_FULL_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, char) parray; @@ -129,7 +130,10 @@ reduce (parray *ret, /* The dimensions of the return array. */ if (i != (int)dimen_m1) { - str = GFC_DESCRIPTOR_STRIDE (array, j); + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES(ret)) + str = GFC_DESCRIPTOR_STRIDE_BYTES (array, j); + else + str = GFC_DESCRIPTOR_STRIDE_UNITS (array, j); GFC_DESCRIPTOR_DIMENSION_SET (ret, j, 0, ext - 1, str); j++; } diff --git a/libgfortran/intrinsics/reshape_generic.c b/libgfortran/intrinsics/reshape_generic.c index 046537a25fc3..35e3c6398489 100644 --- a/libgfortran/intrinsics/reshape_generic.c +++ b/libgfortran/intrinsics/reshape_generic.c @@ -89,7 +89,10 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, { index_type alloc_size; - rs = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES(ret)) + rs = size; + else + rs = 1; for (n = 0; n < rdim; n++) { rex = shape_data[n]; @@ -105,7 +108,10 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, else alloc_size = rs; - ret->base_addr = xmallocarray (alloc_size, size); + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES(ret)) + ret->base_addr = xmalloc (alloc_size); + else + ret->base_addr = xmallocarray (alloc_size, size); ret->dtype.rank = rdim; } diff --git a/libgfortran/intrinsics/spread_generic.c b/libgfortran/intrinsics/spread_generic.c index 7fe818faedea..2df871795944 100644 --- a/libgfortran/intrinsics/spread_generic.c +++ b/libgfortran/intrinsics/spread_generic.c @@ -76,7 +76,10 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, ret->dtype.rank = rrank; dim = 0; - rs = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + rs = size; + else + rs = 1; for (n = 0; n < rrank; n++) { stride = rs; @@ -101,7 +104,10 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, GFC_DESCRIPTOR_DIMENSION_SET(ret, n, 0, ub, stride); } ret->offset = 0; - ret->base_addr = xmallocarray (rs, size); + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + ret->base_addr = xmalloc (rs); + else + ret->base_addr = xmallocarray (rs, size); if (rs <= 0) return; @@ -248,7 +254,12 @@ spread_internal_scalar (gfc_array_char *ret, const char *source, { ret->base_addr = xmallocarray (ncopies, size); ret->offset = 0; - GFC_DESCRIPTOR_DIMENSION_SET(ret, 0, 0, ncopies - 1, 1); + index_type stride; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + stride = size; + else + stride = 1; + GFC_DESCRIPTOR_DIMENSION_SET(ret, 0, 0, ncopies - 1, stride); } else { diff --git a/libgfortran/intrinsics/unpack_generic.c b/libgfortran/intrinsics/unpack_generic.c index f830dc68377f..fe61466e5ec7 100644 --- a/libgfortran/intrinsics/unpack_generic.c +++ b/libgfortran/intrinsics/unpack_generic.c @@ -110,7 +110,10 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector, /* The front end has signalled that we need to populate the return array descriptor. */ dim = GFC_DESCRIPTOR_RANK (mask); - rs = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + rs = size; + else + rs = 1; for (n = 0; n < dim; n++) { count[n] = 0; @@ -124,7 +127,10 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector, rs *= extent[n]; } ret->offset = 0; - ret->base_addr = xmallocarray (rs, size); + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + ret->base_addr = xmalloc (rs); + else + ret->base_addr = xmallocarray (rs, size); } else { diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index e5012f0c7b7d..1915aee68ae4 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_BYTES(nl,dim); + * GFC_DESCRIPTOR_STRIDE(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_BYTES(nl,dim)); + * GFC_DESCRIPTOR_STRIDE(nl,dim)); } /* If we are finished with the repeat count, try to read next value. */ diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index c4f7c4a30465..120ce33d72de 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -379,7 +379,8 @@ typedef struct dtype_type int version; signed char rank; signed char type; - signed short attribute; + unsigned short attribute:15; + unsigned short bytes_counted_strides:1; } dtype_type; @@ -460,6 +461,7 @@ typedef GFC_FULL_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_full_a #define GFC_DESCRIPTOR_RANK(desc) ((desc)->dtype.rank) #define GFC_DESCRIPTOR_TYPE(desc) ((desc)->dtype.type) #define GFC_DESCRIPTOR_SIZE(desc) ((desc)->dtype.elem_len) +#define GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES(desc) ((desc)->dtype.bytes_counted_strides) #define GFC_DESCRIPTOR_DATA(desc) ((desc)->base_addr) #define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype) #define GFC_DESCRIPTOR_SPAN(desc) ((desc)->span) @@ -485,11 +487,20 @@ typedef GFC_FULL_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_full_a #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_UNITS_FROM_BYTES_DESCR(desc,i) \ + ({assert (GFC_DESCRIPTOR_STRIDE_BYTES((desc),(i)) % GFC_DESCRIPTOR_SPAN(desc) == 0); \ + assert (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES(desc)); \ + GFC_DESCRIPTOR_STRIDE_BYTES((desc),(i)) / ((index_type) GFC_DESCRIPTOR_SIZE(desc));}) +#define GFC_DESCRIPTOR_STRIDE_BYTES_FROM_UNITS_DESCR(desc,i) \ + (GFC_DESCRIPTOR_STRIDE((desc),(i))*GFC_DESCRIPTOR_SPAN(desc)) #define GFC_DESCRIPTOR_STRIDE_BYTES(desc,i) \ - (GFC_DESCRIPTOR_STRIDE((desc),(i))) + (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES(desc) \ + ? GFC_DESCRIPTOR_STRIDE((desc),(i)) \ + : GFC_DESCRIPTOR_STRIDE_BYTES_FROM_UNITS_DESCR((desc),(i))) +#define GFC_DESCRIPTOR_STRIDE_UNITS(desc,i) \ + (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES(desc) \ + ? GFC_DESCRIPTOR_STRIDE_UNITS_FROM_BYTES_DESCR((desc),(i)) \ + : GFC_DESCRIPTOR_STRIDE((desc),(i))) /* Macros to get both the size and the type with a single masking operation */ @@ -501,7 +512,12 @@ typedef GFC_FULL_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_full_a /* Macros to set size and type information. */ -#define GFC_DTYPE_COPY(a,b) do { (a)->dtype = (b)->dtype; } while(0) +#define GFC_DTYPE_COPY(a,b) \ + do { \ + bool sav = GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (a); \ + (a)->dtype = (b)->dtype; \ + GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (a) = sav; \ + } while(0) #define GFC_DTYPE_IS_UNSET(a) (unlikely((a)->dtype.elem_len == 0)) #define GFC_DTYPE_CLEAR(a) do { (a)->dtype.elem_len = 0; \ (a)->dtype.version = 0; \ diff --git a/libgfortran/m4/bessel.m4 b/libgfortran/m4/bessel.m4 index 92881dc0469a..5bf5488ed1bf 100644 --- a/libgfortran/m4/bessel.m4 +++ b/libgfortran/m4/bessel.m4 @@ -49,8 +49,14 @@ bessel_jn_r'rtype_kind` ('rtype` * const restrict ret, int n1, int n2, 'rtype_na if (ret->base_addr == NULL) { + index_type stride; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + stride = sizeof ('rtype_name`); + else + stride = 1; + size_t size = n2 < n1 ? 0 : n2-n1+1; - GFC_DESCRIPTOR_DIMENSION_SET(ret, 0, 0, size-1, 1); + GFC_DESCRIPTOR_DIMENSION_SET(ret, 0, 0, size-1, stride); ret->base_addr = xmallocarray (size, sizeof ('rtype_name`)); ret->offset = 0; } @@ -111,8 +117,14 @@ bessel_yn_r'rtype_kind` ('rtype` * const restrict ret, int n1, int n2, if (ret->base_addr == NULL) { + index_type stride; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + stride = sizeof ('rtype_name`); + else + stride = 1; + size_t size = n2 < n1 ? 0 : n2-n1+1; - GFC_DESCRIPTOR_DIMENSION_SET(ret, 0, 0, size-1, 1); + GFC_DESCRIPTOR_DIMENSION_SET(ret, 0, 0, size-1, stride); ret->base_addr = xmallocarray (size, sizeof ('rtype_name`)); ret->offset = 0; } diff --git a/libgfortran/m4/cshift1.m4 b/libgfortran/m4/cshift1.m4 index b368029dd729..bb22a9ec66d8 100644 --- a/libgfortran/m4/cshift1.m4 +++ b/libgfortran/m4/cshift1.m4 @@ -82,7 +82,10 @@ cshift1 (gfc_array_char * const restrict ret, ret->base_addr = xmallocarray (arraysize, size); ret->offset = 0; GFC_DTYPE_COPY(ret,array); - cnt = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + cnt = sizeof ('rtype_name`); + else + cnt = 1; for (index_type i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { index_type ub; diff --git a/libgfortran/m4/eoshift1.m4 b/libgfortran/m4/eoshift1.m4 index 90db7b5df9b2..02632e857233 100644 --- a/libgfortran/m4/eoshift1.m4 +++ b/libgfortran/m4/eoshift1.m4 @@ -89,7 +89,10 @@ eoshift1 (gfc_array_char * const restrict ret, ret->offset = 0; GFC_DTYPE_COPY(ret,array); - cnt = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + cnt = size; + else + cnt = 1; for (index_type i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { index_type ub; diff --git a/libgfortran/m4/eoshift3.m4 b/libgfortran/m4/eoshift3.m4 index 6c5965db5929..352c8b27f89c 100644 --- a/libgfortran/m4/eoshift3.m4 +++ b/libgfortran/m4/eoshift3.m4 @@ -87,10 +87,12 @@ 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; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + cnt = sizeof ('rtype_name`); + else + cnt = 1; for (index_type i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { index_type ub; diff --git a/libgfortran/m4/ifindloc0.m4 b/libgfortran/m4/ifindloc0.m4 index 1fb5f169fdc0..e9742d807fd2 100644 --- a/libgfortran/m4/ifindloc0.m4 +++ b/libgfortran/m4/ifindloc0.m4 @@ -43,7 +43,13 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see if (retarray->base_addr == NULL) { - GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, rank-1, 1); + index_type stride; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + stride = sizeof (index_type); + else + stride = 1; + + GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, rank-1, stride); retarray->dtype.rank = 1; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (index_type)); @@ -169,7 +175,13 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see if (retarray->base_addr == NULL) { - GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, rank-1, 1); + index_type stride; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + stride = sizeof (index_type); + else + stride = 1; + + GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, rank-1, stride); retarray->dtype.rank = 1; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (index_type)); @@ -318,7 +330,13 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see if (retarray->base_addr == NULL) { - GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, rank-1, 1); + index_type stride; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + stride = sizeof (index_type); + else + stride = 1; + + GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, rank-1, stride); retarray->dtype.rank = 1; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (index_type)); diff --git a/libgfortran/m4/ifindloc1.m4 b/libgfortran/m4/ifindloc1.m4 index ec19bc7d220b..3b1167549d50 100644 --- a/libgfortran/m4/ifindloc1.m4 +++ b/libgfortran/m4/ifindloc1.m4 @@ -79,7 +79,10 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see { size_t cnt; - cnt = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + cnt = sizeof (index_type); + else + cnt = 1; for (n = 0; n < rank; n++) { GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); @@ -90,7 +93,11 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see retarray->offset = 0; retarray->dtype.rank = rank; - retarray->base_addr = xmallocarray (cnt, sizeof (index_type)); + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + retarray->base_addr = xmalloc (cnt); + else + retarray->base_addr = xmallocarray (cnt, sizeof (index_type)); + if (cnt == 0) return; } @@ -250,7 +257,10 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see { size_t cnt; - cnt = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + cnt = sizeof (index_type); + else + cnt = 1; for (n = 0; n < rank; n++) { GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); @@ -261,7 +271,11 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see retarray->offset = 0; retarray->dtype.rank = rank; - retarray->base_addr = xmallocarray (cnt, sizeof (index_type)); + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + retarray->base_addr = xmalloc (cnt); + else + retarray->base_addr = xmallocarray (cnt, sizeof (index_type)); + if (cnt == 0) return; } @@ -409,7 +423,10 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see { size_t cnt; - cnt = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + cnt = sizeof (index_type); + else + cnt = 1; for (n = 0; n < rank; n++) { GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); @@ -420,7 +437,11 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see retarray->offset = 0; retarray->dtype.rank = rank; - retarray->base_addr = xmallocarray (cnt, sizeof (index_type)); + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + retarray->base_addr = xmalloc (cnt); + else + retarray->base_addr = xmallocarray (cnt, sizeof (index_type)); + if (cnt == 0) return; } diff --git a/libgfortran/m4/iforeach-s.m4 b/libgfortran/m4/iforeach-s.m4 index ae6cf656e269..ae1ecbab618a 100644 --- a/libgfortran/m4/iforeach-s.m4 +++ b/libgfortran/m4/iforeach-s.m4 @@ -34,7 +34,13 @@ void if (retarray->base_addr == NULL) { - GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, rank-1, 1); + index_type stride; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + stride = sizeof ('rtype_name`); + else + stride = 1; + + GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, rank-1, stride); retarray->dtype.rank = 1; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof ('rtype_name`)); @@ -145,7 +151,13 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, rank - 1, 1); + index_type stride; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + stride = sizeof ('rtype_name`); + else + stride = 1; + + GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, rank - 1, stride); retarray->dtype.rank = 1; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof ('rtype_name`)); @@ -278,7 +290,13 @@ s'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, rank-1, 1); + index_type stride; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + stride = sizeof ('rtype_name`); + else + stride = 1; + + GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, rank-1, stride); retarray->dtype.rank = 1; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof ('rtype_name`)); diff --git a/libgfortran/m4/iforeach.m4 b/libgfortran/m4/iforeach.m4 index 2a88bd3affad..f649c7e47fe6 100644 --- a/libgfortran/m4/iforeach.m4 +++ b/libgfortran/m4/iforeach.m4 @@ -25,10 +25,15 @@ void if (retarray->base_addr == NULL) { - GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, rank-1, 1); + index_type stride; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + stride = sizeof ('rtype_name`); + else + stride = 1; + GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, rank-1, stride); retarray->dtype.rank = 1; retarray->offset = 0; - retarray->base_addr = xmallocarray (rank, sizeof (rtype_name)); + retarray->base_addr = xmallocarray (rank, sizeof ('rtype_name`)); } else { @@ -130,10 +135,15 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, rank - 1, 1); + index_type stride; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + stride = sizeof ('rtype_name`); + else + stride = 1; + GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, rank - 1, stride); retarray->dtype.rank = 1; retarray->offset = 0; - retarray->base_addr = xmallocarray (rank, sizeof (rtype_name)); + retarray->base_addr = xmallocarray (rank, sizeof ('rtype_name`)); } else { @@ -257,10 +267,15 @@ s'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, rank-1, 1); + index_type stride; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + stride = sizeof ('rtype_name`); + else + stride = 1; + GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, rank-1, stride); retarray->dtype.rank = 1; retarray->offset = 0; - retarray->base_addr = xmallocarray (rank, sizeof (rtype_name)); + retarray->base_addr = xmallocarray (rank, sizeof ('rtype_name`)); } else if (unlikely (compile_options.bounds_check)) { diff --git a/libgfortran/m4/ifunction-s.m4 b/libgfortran/m4/ifunction-s.m4 index 415ffd130bfc..20486d37c761 100644 --- a/libgfortran/m4/ifunction-s.m4 +++ b/libgfortran/m4/ifunction-s.m4 @@ -91,7 +91,11 @@ void { size_t cnt; - cnt = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + cnt = sizeof ('rtype_name`); + else + cnt = 1; + for (n = 0; n < rank; n++) { GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); @@ -102,7 +106,11 @@ void retarray->offset = 0; retarray->dtype.rank = rank; - retarray->base_addr = xmallocarray (cnt, sizeof ('rtype_name`)); + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + retarray->base_addr = xmalloc (cnt); + else + retarray->base_addr = xmallocarray (cnt, sizeof ('rtype_name`)); + if (cnt == 0) return; } @@ -278,7 +286,11 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, { size_t cnt; - cnt = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + cnt = sizeof ('rtype_name`); + else + cnt = 1; + for (n = 0; n < rank; n++) { GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); @@ -289,7 +301,11 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, retarray->offset = 0; retarray->dtype.rank = rank; - retarray->base_addr = xmallocarray (cnt, sizeof ('rtype_name`)); + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + retarray->base_addr = xmalloc (cnt); + else + retarray->base_addr = xmallocarray (cnt, sizeof ('rtype_name`)); + if (cnt == 0) return; } @@ -432,7 +448,11 @@ s'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, { size_t cnt; - cnt = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + cnt = sizeof ('rtype_name`); + else + cnt = 1; + for (n = 0; n < rank; n++) { GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); @@ -443,7 +463,11 @@ s'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, retarray->offset = 0; retarray->dtype.rank = rank; - retarray->base_addr = xmallocarray (cnt, sizeof ('rtype_name`)); + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + retarray->base_addr = xmalloc (cnt); + else + retarray->base_addr = xmallocarray (cnt, sizeof ('rtype_name`)); + if (cnt == 0) return; } diff --git a/libgfortran/m4/ifunction-s2.m4 b/libgfortran/m4/ifunction-s2.m4 index 2e42c15c3f6a..ecdfeab36910 100644 --- a/libgfortran/m4/ifunction-s2.m4 +++ b/libgfortran/m4/ifunction-s2.m4 @@ -92,7 +92,11 @@ void { size_t alloc_size, cnt; - cnt = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + cnt = string_len * sizeof ('rtype_name`); + else + cnt = 1; + for (n = 0; n < rank; n++) { GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); @@ -105,7 +109,11 @@ void alloc_size = cnt * string_len; - retarray->base_addr = xmallocarray (alloc_size, sizeof ('rtype_name`)); + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + retarray->base_addr = xmalloc (cnt); + else + retarray->base_addr = xmallocarray (alloc_size, sizeof ('rtype_name`)); + if (alloc_size == 0) return; } @@ -279,7 +287,11 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, { size_t alloc_size, cnt; - cnt = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + cnt = string_len * sizeof ('rtype_name`); + else + cnt = 1; + for (n = 0; n < rank; n++) { GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); @@ -292,7 +304,11 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, retarray->offset = 0; retarray->dtype.rank = rank; - retarray->base_addr = xmallocarray (alloc_size, sizeof ('rtype_name`)); + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + retarray->base_addr = xmalloc (cnt); + else + retarray->base_addr = xmallocarray (alloc_size, sizeof ('rtype_name`)); + if (alloc_size == 0) return; } @@ -435,7 +451,11 @@ s'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, { size_t alloc_size, cnt; - cnt = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + cnt = string_len * sizeof ('rtype_name`); + else + cnt = 1; + for (n = 0; n < rank; n++) { GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); @@ -448,7 +468,11 @@ s'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, alloc_size = cnt * string_len; - retarray->base_addr = xmallocarray (alloc_size, sizeof ('rtype_name`)); + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + retarray->base_addr = xmalloc (cnt); + else + retarray->base_addr = xmallocarray (alloc_size, sizeof ('rtype_name`)); + if (alloc_size == 0) return; } diff --git a/libgfortran/m4/ifunction.m4 b/libgfortran/m4/ifunction.m4 index 073b0da217ae..e83d9fa31669 100644 --- a/libgfortran/m4/ifunction.m4 +++ b/libgfortran/m4/ifunction.m4 @@ -78,7 +78,10 @@ void { size_t cnt; - cnt = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + cnt = sizeof ('rtype_name`); + else + cnt = 1; for (n = 0; n < rank; n++) { GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); @@ -91,7 +94,11 @@ void retarray->dtype.elem_len = sizeof ('rtype_name`); retarray->span = sizeof ('rtype_name`); - retarray->base_addr = xmallocarray (cnt, sizeof ('rtype_name`)); + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + retarray->base_addr = xmalloc (cnt); + else + retarray->base_addr = xmallocarray (cnt, sizeof ('rtype_name`)); + if (cnt == 0) return; } @@ -268,7 +275,10 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, { size_t cnt; - cnt = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + cnt = sizeof ('rtype_name`); + else + cnt = 1; for (n = 0; n < rank; n++) { GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); @@ -281,7 +291,11 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, retarray->dtype.elem_len = sizeof ('rtype_name`); retarray->span = sizeof ('rtype_name`); - retarray->base_addr = xmallocarray (cnt, sizeof ('rtype_name`)); + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + retarray->base_addr = xmalloc (cnt); + else + retarray->base_addr = xmallocarray (cnt, sizeof ('rtype_name`)); + if (cnt == 0) return; } @@ -425,7 +439,10 @@ s'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, { size_t cnt; - cnt = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + cnt = sizeof ('rtype_name`); + else + cnt = 1; for (n = 0; n < rank; n++) { GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); @@ -436,7 +453,11 @@ s'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray, retarray->offset = 0; retarray->dtype.rank = rank; - retarray->base_addr = xmallocarray (cnt, sizeof ('rtype_name`)); + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + retarray->base_addr = xmalloc (cnt); + else + retarray->base_addr = xmallocarray (cnt, sizeof ('rtype_name`)); + if (cnt == 0) return; } diff --git a/libgfortran/m4/ifunction_logical.m4 b/libgfortran/m4/ifunction_logical.m4 index bdd7913e60ff..6f154d1977ee 100644 --- a/libgfortran/m4/ifunction_logical.m4 +++ b/libgfortran/m4/ifunction_logical.m4 @@ -75,7 +75,10 @@ void { size_t cnt; - cnt = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + cnt = sizeof ('rtype_name`); + else + cnt = 1; for (n = 0; n < rank; n++) { GFC_DESCRIPTOR_DIMENSION_SET(retarray, n, 0, extent[n] - 1, cnt); @@ -86,7 +89,11 @@ void retarray->offset = 0; retarray->dtype.rank = rank; - retarray->base_addr = xmallocarray (cnt, sizeof ('rtype_name`)); + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + retarray->base_addr = xmalloc (cnt); + else + retarray->base_addr = xmallocarray (cnt, sizeof ('rtype_name`)); + if (cnt == 0) return; } diff --git a/libgfortran/m4/matmul_internal.m4 b/libgfortran/m4/matmul_internal.m4 index 9f597a05937a..d53f622eb5f2 100644 --- a/libgfortran/m4/matmul_internal.m4 +++ b/libgfortran/m4/matmul_internal.m4 @@ -28,24 +28,31 @@ if (retarray->base_addr == NULL) { + index_type stride0; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + stride0 = sizeof ('rtype_name`); + else + stride0 = 1; + if (GFC_DESCRIPTOR_RANK (a) == 1) { GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + GFC_DESCRIPTOR_EXTENT(b,1) - 1, stride0); } else if (GFC_DESCRIPTOR_RANK (b) == 1) { GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0) - 1, stride0); } else { GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0) - 1, stride0); GFC_DESCRIPTOR_DIMENSION_SET(retarray, 1, 0, GFC_DESCRIPTOR_EXTENT(b,1) - 1, - GFC_DESCRIPTOR_EXTENT(retarray,0)); + GFC_DESCRIPTOR_EXTENT(retarray,0) + * stride0); } retarray->base_addr diff --git a/libgfortran/m4/matmull.m4 b/libgfortran/m4/matmull.m4 index 609d6c4d4ecd..8ca383bbc982 100644 --- a/libgfortran/m4/matmull.m4 +++ b/libgfortran/m4/matmull.m4 @@ -67,24 +67,31 @@ matmul_'rtype_code` ('rtype` * const restrict retarray, if (retarray->base_addr == NULL) { + index_type stride0; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (retarray)) + stride0 = sizeof ('rtype_name`); + else + stride0 = 1; + if (GFC_DESCRIPTOR_RANK (a) == 1) { GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + GFC_DESCRIPTOR_EXTENT(b,1) - 1, stride0); } else if (GFC_DESCRIPTOR_RANK (b) == 1) { GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0) - 1, stride0); } else { GFC_DESCRIPTOR_DIMENSION_SET(retarray, 0, 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0) - 1, stride0); GFC_DESCRIPTOR_DIMENSION_SET(retarray, 1, 0, GFC_DESCRIPTOR_EXTENT(b,1) - 1, - GFC_DESCRIPTOR_EXTENT(retarray,0)); + GFC_DESCRIPTOR_EXTENT(retarray,0) + * stride0); } retarray->base_addr diff --git a/libgfortran/m4/pack.m4 b/libgfortran/m4/pack.m4 index abbcd2e92700..c5f5164a0c0e 100644 --- a/libgfortran/m4/pack.m4 +++ b/libgfortran/m4/pack.m4 @@ -164,8 +164,14 @@ pack_'rtype_code` ('rtype` *ret, const 'rtype` *array, if (ret->base_addr == NULL) { + index_type stride; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + stride = sizeof ('rtype_name`); + else + stride = 1; + /* Setup the array descriptor. */ - GFC_DESCRIPTOR_DIMENSION_SET(ret, 0, 0, total-1, 1); + GFC_DESCRIPTOR_DIMENSION_SET(ret, 0, 0, total-1, stride); ret->offset = 0; diff --git a/libgfortran/m4/reshape.m4 b/libgfortran/m4/reshape.m4 index 10bc787b6074..b271fad485cc 100644 --- a/libgfortran/m4/reshape.m4 +++ b/libgfortran/m4/reshape.m4 @@ -103,7 +103,11 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, { index_type alloc_size; - rs = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + rs = sizeof ('rtype_name`); + else + rs = 1; + for (index_type n = 0; n < rdim; n++) { rex = shape_data[n]; @@ -119,7 +123,11 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, else alloc_size = rs; - ret->base_addr = xmallocarray (alloc_size, sizeof ('rtype_name`)); + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + ret->base_addr = xmalloc (alloc_size); + else + ret->base_addr = xmallocarray (alloc_size, sizeof ('rtype_name`)); + ret->dtype.rank = rdim; } diff --git a/libgfortran/m4/shape.m4 b/libgfortran/m4/shape.m4 index dc88035c53f0..e969ef685a04 100644 --- a/libgfortran/m4/shape.m4 +++ b/libgfortran/m4/shape.m4 @@ -43,7 +43,13 @@ shape_'rtype_kind` ('rtype` * const restrict ret, if (ret->base_addr == NULL) { - GFC_DESCRIPTOR_DIMENSION_SET(ret, 0, 0, rank - 1, 1); + index_type stride; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + stride = sizeof ('rtype_name`); + else + stride = 1; + + GFC_DESCRIPTOR_DIMENSION_SET(ret, 0, 0, rank - 1, stride); ret->offset = 0; ret->base_addr = xmallocarray (rank, sizeof ('rtype_name`)); } diff --git a/libgfortran/m4/spread.m4 b/libgfortran/m4/spread.m4 index cd70bab57dde..a79ee72c6c31 100644 --- a/libgfortran/m4/spread.m4 +++ b/libgfortran/m4/spread.m4 @@ -78,14 +78,20 @@ spread_'rtype_code` ('rtype` *ret, const 'rtype` *source, ret->dtype.rank = rrank; dim = 0; - rs = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + rs = sizeof ('rtype_name`); + else + rs = 1; for (n = 0; n < rrank; n++) { stride = rs; if (n == along - 1) { ub = ncopies - 1; - rdelta = rs * sizeof ('rtype_name`); + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + rdelta = rs; + else + rdelta = rs * sizeof ('rtype_name`); rs *= ncopies; } else @@ -104,7 +110,11 @@ spread_'rtype_code` ('rtype` *ret, const 'rtype` *source, ret->offset = 0; /* xmallocarray allocates a single byte for zero size. */ - ret->base_addr = xmallocarray (rs, sizeof('rtype_name`)); + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + ret->base_addr = xmalloc (rs); + else + ret->base_addr = xmallocarray (rs, sizeof('rtype_name`)); + if (rs <= 0) return; } @@ -246,7 +256,12 @@ spread_scalar_'rtype_code` ('rtype` *ret, const 'rtype_name` *source, { ret->base_addr = xmallocarray (ncopies, sizeof ('rtype_name`)); ret->offset = 0; - GFC_DESCRIPTOR_DIMENSION_SET(ret, 0, 0, ncopies - 1, 1); + index_type stride; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + stride = sizeof ('rtype_name`); + else + stride = 1; + GFC_DESCRIPTOR_DIMENSION_SET(ret, 0, 0, ncopies - 1, stride); } else { diff --git a/libgfortran/m4/unpack.m4 b/libgfortran/m4/unpack.m4 index 5aa923abadd7..5e011d9cc2ca 100644 --- a/libgfortran/m4/unpack.m4 +++ b/libgfortran/m4/unpack.m4 @@ -87,7 +87,10 @@ unpack0_'rtype_code` ('rtype` *ret, const 'rtype` *vector, /* The front end has signalled that we need to populate the return array descriptor. */ dim = GFC_DESCRIPTOR_RANK (mask); - rs = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + rs = sizeof ('rtype_name`); + else + rs = 1; for (n = 0; n < dim; n++) { count[n] = 0; @@ -99,8 +102,13 @@ unpack0_'rtype_code` ('rtype` *ret, const 'rtype` *vector, mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } + ret->offset = 0; - ret->base_addr = xmallocarray (rs, sizeof ('rtype_name`)); + + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + ret->base_addr = xmalloc (rs); + else + ret->base_addr = xmallocarray (rs, sizeof ('rtype_name`)); } else { @@ -233,7 +241,10 @@ unpack1_'rtype_code` ('rtype` *ret, const 'rtype` *vector, /* The front end has signalled that we need to populate the return array descriptor. */ dim = GFC_DESCRIPTOR_RANK (mask); - rs = 1; + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + rs = sizeof ('rtype_name`); + else + rs = 1; for (n = 0; n < dim; n++) { count[n] = 0; @@ -246,8 +257,13 @@ unpack1_'rtype_code` ('rtype` *ret, const 'rtype` *vector, mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); rs *= extent[n]; } + ret->offset = 0; - ret->base_addr = xmallocarray (rs, sizeof ('rtype_name`)); + + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (ret)) + ret->base_addr = xmalloc (rs); + else + ret->base_addr = xmallocarray (rs, sizeof ('rtype_name`)); } else { diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c index 323c5e10d9e9..09301891cf45 100644 --- a/libgfortran/runtime/ISO_Fortran_binding.c +++ b/libgfortran/runtime/ISO_Fortran_binding.c @@ -87,8 +87,11 @@ 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_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); + if (GFC_DESCRIPTOR_BYTES_COUNTED_STRIDES (d)) + GFC_DESCRIPTOR_STRIDE(d, n) = (index_type)s->dim[n].sm; + else + 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); } }
