[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Réduction utilisation stride pour allocation/initialisation
Mikael Morin
mikael@gcc.gnu.org
Wed Sep 17 16:53:24 GMT 2025
https://gcc.gnu.org/g:3f4ca32f209a076038998112b41260f7ddb3d34c
commit 3f4ca32f209a076038998112b41260f7ddb3d34c
Author: Mikael Morin <mikael@gcc.gnu.org>
Date: Sun Sep 14 18:44:25 2025 +0200
Réduction utilisation stride pour allocation/initialisation
Diff:
---
libgfortran/intrinsics/cshift0.c | 12 ++++------
libgfortran/intrinsics/eoshift2.c | 12 ++++------
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 +++++--------
10 files changed, 102 insertions(+), 161 deletions(-)
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/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/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
More information about the Gcc-cvs
mailing list