https://gcc.gnu.org/g:6c8b9940ddfaa29c0488720d1396d91df1610d46
commit 6c8b9940ddfaa29c0488720d1396d91df1610d46
Author: Mikael Morin <mik...@gcc.gnu.org>
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
Correction cshift0.m4
Retour en arrière cshift0
Remodif cshift0.m4
Réapplication modifs cshift0
Correction cshift0.m4
Correction cshift0.m4
Correction cshift0.m4
Retour en arrière partiel eoshift0.c
Correction matmull.m4
Retour en arrière code allocation
Retour en arrière partiel random.c et reshape.m4
Retour en arrière partiel matmull.m4
Diff:
---
libgfortran/intrinsics/associated.c | 4 +++-
libgfortran/intrinsics/eoshift0.c | 6 +++---
libgfortran/intrinsics/is_contiguous.c | 10 +++++-----
libgfortran/intrinsics/random.c | 2 +-
libgfortran/intrinsics/spread_generic.c | 3 +--
libgfortran/m4/cshift0.m4 | 14 ++++++-------
libgfortran/m4/matmul_internal.m4 | 33 +++++++++++++++++++------------
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 +++++------
13 files changed, 66 insertions(+), 61 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/eoshift0.c
b/libgfortran/intrinsics/eoshift0.c
index 251971ecfb59..3baa966398cb 100644
--- a/libgfortran/intrinsics/eoshift0.c
+++ b/libgfortran/intrinsics/eoshift0.c
@@ -147,9 +147,9 @@ 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);
+ index_type count_low = GFC_DESCRIPTOR_STRIDE(array, which);
+ len = count_low * GFC_DESCRIPTOR_EXTENT(array, which);
+ shift *= count_low;
roffset = size;
soffset = size;
for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
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 c5e86dc45051..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;
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..2725025182ba 100644
--- a/libgfortran/m4/cshift0.m4
+++ b/libgfortran/m4/cshift0.m4
@@ -67,8 +67,8 @@ 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)
{
@@ -78,13 +78,13 @@ cshift0_'rtype_code` ('rtype` *ret, const 'rtype` *array,
ptrdiff_t shift,
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;
@@ -116,9 +116,9 @@ 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);
+ index_type count_low = GFC_DESCRIPTOR_STRIDE(array, which);
+ len = count_low * GFC_DESCRIPTOR_EXTENT(array, which);
+ shift *= count_low;
for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
{
count[n] = 0;
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/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];
}
}
}
