https://gcc.gnu.org/g:36b23963083c1ffd1841542c950f798110c0366a
commit 36b23963083c1ffd1841542c950f798110c0366a
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Thu Sep 11 12:28:19 2025 +0200
Ajout macros GFC_DESCRIPTOR1_ELEM, etc
Ajout macros libgfortran.h
Correction matmul_bounds_12
Correction matmul_internal.m4
Correction matmul_internal.m4
Correction matmul_internal.m4
Correction reduce_4
Correction findloc1.m4
Modifications mineures
Revert partiel modif quotation
Utilisation GFC_DESCRIPTOR1_ELEM random.c et reshape.m4
Extraction PTR_ADD_OFFSET
Extraction ARRAY_ELEM_AT_OFFSET
Modification macros
Correction macro
Diff:
---
libgfortran/intrinsics/random.c | 10 +-
libgfortran/intrinsics/reshape_generic.c | 6 +-
libgfortran/intrinsics/spread_generic.c | 2 +-
libgfortran/intrinsics/stat.c | 132 ++++++++++-----------
libgfortran/libgfortran.h | 18 +++
libgfortran/m4/bessel.m4 | 34 ++----
libgfortran/m4/ifindloc0.m4 | 32 ++----
libgfortran/m4/ifindloc2.m4 | 4 +-
libgfortran/m4/iforeach-s.m4 | 22 +---
libgfortran/m4/iforeach.m4 | 22 +---
libgfortran/m4/matmul_internal.m4 | 192 ++++++++++++++++---------------
libgfortran/m4/maxloc0.m4 | 16 +--
libgfortran/m4/maxloc0s.m4 | 4 +-
libgfortran/m4/maxloc2s.m4 | 2 +-
libgfortran/m4/minloc0.m4 | 16 +--
libgfortran/m4/minloc0s.m4 | 4 +-
libgfortran/m4/minloc2s.m4 | 2 +-
libgfortran/m4/pack.m4 | 2 +-
libgfortran/m4/reshape.m4 | 6 +-
libgfortran/m4/shape.m4 | 5 +-
20 files changed, 250 insertions(+), 281 deletions(-)
diff --git a/libgfortran/intrinsics/random.c b/libgfortran/intrinsics/random.c
index 225eb60239ac..4ff57de9413e 100644
--- a/libgfortran/intrinsics/random.c
+++ b/libgfortran/intrinsics/random.c
@@ -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/reshape_generic.c
b/libgfortran/intrinsics/reshape_generic.c
index 1aa47bb9d8ee..4d15ce100fb8 100644
--- a/libgfortran/intrinsics/reshape_generic.c
+++ b/libgfortran/intrinsics/reshape_generic.c
@@ -77,7 +77,7 @@ reshape_internal (parray *ret, parray *source, shape_type
*shape,
for (n = 0; n < rdim; n++)
{
- shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE(shape,0)];
+ shape_data[n] = GFC_DESCRIPTOR1_ELEM(shape,n);
if (shape_data[n] <= 0)
{
shape_data[n] = 0;
@@ -187,7 +187,7 @@ reshape_internal (parray *ret, parray *source, shape_type
*shape,
for (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"
@@ -206,7 +206,7 @@ reshape_internal (parray *ret, parray *source, shape_type
*shape,
for (n = 0; n < rdim; n++)
{
if (order)
- dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
+ dim = GFC_DESCRIPTOR1_ELEM(order,n) - 1;
else
dim = n;
diff --git a/libgfortran/intrinsics/spread_generic.c
b/libgfortran/intrinsics/spread_generic.c
index 1b9275d9e8f0..d59533e97757 100644
--- a/libgfortran/intrinsics/spread_generic.c
+++ b/libgfortran/intrinsics/spread_generic.c
@@ -259,7 +259,7 @@ spread_internal_scalar (gfc_array_char *ret, const char
*source,
for (n = 0; n < ncopies; n++)
{
- dest = (char*)(ret->base_addr + n * GFC_DESCRIPTOR_STRIDE_BYTES(ret,0));
+ dest = GFC_DESCRIPTOR1_ELEM_ADDRESS(ret, n);
memcpy (dest , source, size);
}
}
diff --git a/libgfortran/intrinsics/stat.c b/libgfortran/intrinsics/stat.c
index 63a57cd05eec..e858cf055ee5 100644
--- a/libgfortran/intrinsics/stat.c
+++ b/libgfortran/intrinsics/stat.c
@@ -80,70 +80,68 @@ stat_i4_sub_0 (char *name, gfc_array_i4 *values,
GFC_INTEGER_4 *status,
if (val == 0)
{
- index_type stride = GFC_DESCRIPTOR_STRIDE(values,0);
-
/* Return -1 for any value overflowing INT32_MAX. */
for (int i = 0; i < 13; i++)
- values->base_addr[i * stride] = -1;
+ GFC_DESCRIPTOR1_ELEM (values, i) = -1;
/* Device ID */
if (sb.st_dev <= INT32_MAX)
- values->base_addr[0 * stride] = sb.st_dev;
+ GFC_DESCRIPTOR1_ELEM (values, 0) = sb.st_dev;
/* Inode number */
if (sb.st_ino <= INT32_MAX)
- values->base_addr[1 * stride] = sb.st_ino;
+ GFC_DESCRIPTOR1_ELEM (values, 1) = sb.st_ino;
/* File mode */
if (sb.st_mode <= INT32_MAX)
- values->base_addr[2 * stride] = sb.st_mode;
+ GFC_DESCRIPTOR1_ELEM (values, 2) = sb.st_mode;
/* Number of (hard) links */
if (sb.st_nlink <= INT32_MAX)
- values->base_addr[3 * stride] = sb.st_nlink;
+ GFC_DESCRIPTOR1_ELEM (values, 3) = sb.st_nlink;
/* Owner's uid */
if (sb.st_uid <= INT32_MAX)
- values->base_addr[4 * stride] = sb.st_uid;
+ GFC_DESCRIPTOR1_ELEM (values, 4) = sb.st_uid;
/* Owner's gid */
if (sb.st_gid <= INT32_MAX)
- values->base_addr[5 * stride] = sb.st_gid;
+ GFC_DESCRIPTOR1_ELEM (values, 5) = sb.st_gid;
/* ID of device containing directory entry for file (0 if not available)
*/
#if HAVE_STRUCT_STAT_ST_RDEV
if (sb.st_rdev <= INT32_MAX)
- values->base_addr[6 * stride] = sb.st_rdev;
+ GFC_DESCRIPTOR1_ELEM (values, 6) = sb.st_rdev;
#else
- values->base_addr[6 * stride] = 0;
+ GFC_DESCRIPTOR1_ELEM (values, 6) = 0;
#endif
/* File size (bytes) */
if (sb.st_size <= INT32_MAX)
- values->base_addr[7 * stride] = sb.st_size;
+ GFC_DESCRIPTOR1_ELEM (values, 7) = sb.st_size;
/* Last access time */
if (sb.st_atime <= INT32_MAX)
- values->base_addr[8 * stride] = sb.st_atime;
+ GFC_DESCRIPTOR1_ELEM (values, 8) = sb.st_atime;
/* Last modification time */
if (sb.st_mtime <= INT32_MAX)
- values->base_addr[9 * stride] = sb.st_mtime;
+ GFC_DESCRIPTOR1_ELEM (values, 9) = sb.st_mtime;
/* Last file status change time */
if (sb.st_ctime <= INT32_MAX)
- values->base_addr[10 * stride] = sb.st_ctime;
+ GFC_DESCRIPTOR1_ELEM (values, 10) = sb.st_ctime;
/* Preferred I/O block size (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLKSIZE
if (sb.st_blksize <= INT32_MAX)
- values->base_addr[11 * stride] = sb.st_blksize;
+ GFC_DESCRIPTOR1_ELEM (values, 11) = sb.st_blksize;
#endif
/* Number of blocks allocated (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLOCKS
if (sb.st_blocks <= INT32_MAX)
- values->base_addr[12 * stride] = sb.st_blocks;
+ GFC_DESCRIPTOR1_ELEM (values, 12) = sb.st_blocks;
#endif
}
@@ -210,57 +208,55 @@ stat_i8_sub_0 (char *name, gfc_array_i8 *values,
GFC_INTEGER_8 *status,
if (val == 0)
{
- index_type stride = GFC_DESCRIPTOR_STRIDE(values,0);
-
/* Device ID */
- values->base_addr[0] = sb.st_dev;
+ GFC_DESCRIPTOR1_ELEM (values, 0) = sb.st_dev;
/* Inode number */
- values->base_addr[stride] = sb.st_ino;
+ GFC_DESCRIPTOR1_ELEM (values, 1) = sb.st_ino;
/* File mode */
- values->base_addr[2 * stride] = sb.st_mode;
+ GFC_DESCRIPTOR1_ELEM (values, 2) = sb.st_mode;
/* Number of (hard) links */
- values->base_addr[3 * stride] = sb.st_nlink;
+ GFC_DESCRIPTOR1_ELEM (values, 3) = sb.st_nlink;
/* Owner's uid */
- values->base_addr[4 * stride] = sb.st_uid;
+ GFC_DESCRIPTOR1_ELEM (values, 4) = sb.st_uid;
/* Owner's gid */
- values->base_addr[5 * stride] = sb.st_gid;
+ GFC_DESCRIPTOR1_ELEM (values, 5) = sb.st_gid;
/* ID of device containing directory entry for file (0 if not available)
*/
#if HAVE_STRUCT_STAT_ST_RDEV
- values->base_addr[6 * stride] = sb.st_rdev;
+ GFC_DESCRIPTOR1_ELEM (values, 6) = sb.st_rdev;
#else
- values->base_addr[6 * stride] = 0;
+ GFC_DESCRIPTOR1_ELEM (values, 6) = 0;
#endif
/* File size (bytes) */
- values->base_addr[7 * stride] = sb.st_size;
+ GFC_DESCRIPTOR1_ELEM (values, 7) = sb.st_size;
/* Last access time */
- values->base_addr[8 * stride] = sb.st_atime;
+ GFC_DESCRIPTOR1_ELEM (values, 8) = sb.st_atime;
/* Last modification time */
- values->base_addr[9 * stride] = sb.st_mtime;
+ GFC_DESCRIPTOR1_ELEM (values, 9) = sb.st_mtime;
/* Last file status change time */
- values->base_addr[10 * stride] = sb.st_ctime;
+ GFC_DESCRIPTOR1_ELEM (values, 10) = sb.st_ctime;
/* Preferred I/O block size (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLKSIZE
- values->base_addr[11 * stride] = sb.st_blksize;
+ GFC_DESCRIPTOR1_ELEM (values, 11) = sb.st_blksize;
#else
- values->base_addr[11 * stride] = -1;
+ GFC_DESCRIPTOR1_ELEM (values, 11) = -1;
#endif
/* Number of blocks allocated (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLOCKS
- values->base_addr[12 * stride] = sb.st_blocks;
+ GFC_DESCRIPTOR1_ELEM (values, 12) = sb.st_blocks;
#else
- values->base_addr[12 * stride] = -1;
+ GFC_DESCRIPTOR1_ELEM (values, 12) = -1;
#endif
}
@@ -391,70 +387,68 @@ fstat_i4_sub (GFC_INTEGER_4 *unit, gfc_array_i4 *values,
GFC_INTEGER_4 *status)
if (val == 0)
{
- index_type stride = GFC_DESCRIPTOR_STRIDE(values,0);
-
/* Return -1 for any value overflowing INT32_MAX. */
for (int i = 0; i < 13; i++)
- values->base_addr[i * stride] = -1;
+ GFC_DESCRIPTOR1_ELEM (values, i) = -1;
/* Device ID */
if (sb.st_dev <= INT32_MAX)
- values->base_addr[0 * stride] = sb.st_dev;
+ GFC_DESCRIPTOR1_ELEM (values, 0) = sb.st_dev;
/* Inode number */
if (sb.st_ino <= INT32_MAX)
- values->base_addr[1 * stride] = sb.st_ino;
+ GFC_DESCRIPTOR1_ELEM (values, 1) = sb.st_ino;
/* File mode */
if (sb.st_mode <= INT32_MAX)
- values->base_addr[2 * stride] = sb.st_mode;
+ GFC_DESCRIPTOR1_ELEM (values, 2) = sb.st_mode;
/* Number of (hard) links */
if (sb.st_nlink <= INT32_MAX)
- values->base_addr[3 * stride] = sb.st_nlink;
+ GFC_DESCRIPTOR1_ELEM (values, 3) = sb.st_nlink;
/* Owner's uid */
if (sb.st_uid <= INT32_MAX)
- values->base_addr[4 * stride] = sb.st_uid;
+ GFC_DESCRIPTOR1_ELEM (values, 4) = sb.st_uid;
/* Owner's gid */
if (sb.st_gid <= INT32_MAX)
- values->base_addr[5 * stride] = sb.st_gid;
+ GFC_DESCRIPTOR1_ELEM (values, 5) = sb.st_gid;
/* ID of device containing directory entry for file (0 if not available)
*/
#if HAVE_STRUCT_STAT_ST_RDEV
if (sb.st_rdev <= INT32_MAX)
- values->base_addr[6 * stride] = sb.st_rdev;
+ GFC_DESCRIPTOR1_ELEM (values, 6) = sb.st_rdev;
#else
- values->base_addr[6 * stride] = 0;
+ GFC_DESCRIPTOR1_ELEM (values, 6) = 0;
#endif
/* File size (bytes) */
if (sb.st_size <= INT32_MAX)
- values->base_addr[7 * stride] = sb.st_size;
+ GFC_DESCRIPTOR1_ELEM (values, 7) = sb.st_size;
/* Last access time */
if (sb.st_atime <= INT32_MAX)
- values->base_addr[8 * stride] = sb.st_atime;
+ GFC_DESCRIPTOR1_ELEM (values, 8) = sb.st_atime;
/* Last modification time */
if (sb.st_mtime <= INT32_MAX)
- values->base_addr[9 * stride] = sb.st_mtime;
+ GFC_DESCRIPTOR1_ELEM (values, 9) = sb.st_mtime;
/* Last file status change time */
if (sb.st_ctime <= INT32_MAX)
- values->base_addr[10 * stride] = sb.st_ctime;
+ GFC_DESCRIPTOR1_ELEM (values, 10) = sb.st_ctime;
/* Preferred I/O block size (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLKSIZE
if (sb.st_blksize <= INT32_MAX)
- values->base_addr[11 * stride] = sb.st_blksize;
+ GFC_DESCRIPTOR1_ELEM (values, 11) = sb.st_blksize;
#endif
/* Number of blocks allocated (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLOCKS
if (sb.st_blocks <= INT32_MAX)
- values->base_addr[12 * stride] = sb.st_blocks;
+ GFC_DESCRIPTOR1_ELEM (values, 12) = sb.st_blocks;
#endif
}
@@ -487,57 +481,55 @@ fstat_i8_sub (GFC_INTEGER_8 *unit, gfc_array_i8 *values,
GFC_INTEGER_8 *status)
if (val == 0)
{
- index_type stride = GFC_DESCRIPTOR_STRIDE(values,0);
-
/* Device ID */
- values->base_addr[0] = sb.st_dev;
+ GFC_DESCRIPTOR1_ELEM (values, 0) = sb.st_dev;
/* Inode number */
- values->base_addr[stride] = sb.st_ino;
+ GFC_DESCRIPTOR1_ELEM (values, 1) = sb.st_ino;
/* File mode */
- values->base_addr[2 * stride] = sb.st_mode;
+ GFC_DESCRIPTOR1_ELEM (values, 2) = sb.st_mode;
/* Number of (hard) links */
- values->base_addr[3 * stride] = sb.st_nlink;
+ GFC_DESCRIPTOR1_ELEM (values, 3) = sb.st_nlink;
/* Owner's uid */
- values->base_addr[4 * stride] = sb.st_uid;
+ GFC_DESCRIPTOR1_ELEM (values, 4) = sb.st_uid;
/* Owner's gid */
- values->base_addr[5 * stride] = sb.st_gid;
+ GFC_DESCRIPTOR1_ELEM (values, 5) = sb.st_gid;
/* ID of device containing directory entry for file (0 if not available)
*/
#if HAVE_STRUCT_STAT_ST_RDEV
- values->base_addr[6 * stride] = sb.st_rdev;
+ GFC_DESCRIPTOR1_ELEM (values, 6) = sb.st_rdev;
#else
- values->base_addr[6 * stride] = 0;
+ GFC_DESCRIPTOR1_ELEM (values, 6) = 0;
#endif
/* File size (bytes) */
- values->base_addr[7 * stride] = sb.st_size;
+ GFC_DESCRIPTOR1_ELEM (values, 7) = sb.st_size;
/* Last access time */
- values->base_addr[8 * stride] = sb.st_atime;
+ GFC_DESCRIPTOR1_ELEM (values, 8) = sb.st_atime;
/* Last modification time */
- values->base_addr[9 * stride] = sb.st_mtime;
+ GFC_DESCRIPTOR1_ELEM (values, 9) = sb.st_mtime;
/* Last file status change time */
- values->base_addr[10 * stride] = sb.st_ctime;
+ GFC_DESCRIPTOR1_ELEM (values, 10) = sb.st_ctime;
/* Preferred I/O block size (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLKSIZE
- values->base_addr[11 * stride] = sb.st_blksize;
+ GFC_DESCRIPTOR1_ELEM (values, 11) = sb.st_blksize;
#else
- values->base_addr[11 * stride] = -1;
+ GFC_DESCRIPTOR1_ELEM (values, 11) = -1;
#endif
/* Number of blocks allocated (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLOCKS
- values->base_addr[12 * stride] = sb.st_blocks;
+ GFC_DESCRIPTOR1_ELEM (values, 12) = sb.st_blocks;
#else
- values->base_addr[12 * stride] = -1;
+ GFC_DESCRIPTOR1_ELEM (values, 12) = -1;
#endif
}
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index afa2cc43ecd6..fd6b57700a1b 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -585,6 +585,24 @@ typedef GFC_FULL_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS,
GFC_INTEGER_4) gfc_full_a
#define GFC_UNALIGNED_C8(x) (((uintptr_t)(x)) & \
(__alignof__(GFC_COMPLEX_8) - 1))
+
+#define PTR_ADD_OFFSET(ptr,bytes) ((typeof (ptr)) (((char*) ptr) + (bytes)))
+#define GFC_DESCRIPTOR_DIM_INDEX_OFFSET(descr, dim, idx) \
+ ((idx) * GFC_DESCRIPTOR_STRIDE ((descr), (dim)))
+#define GFC_DESCRIPTOR1_INDEX(descr, idx) \
+ (GFC_DESCRIPTOR_DIM_INDEX_OFFSET((descr), 0, (idx)))
+#define GFC_DESCRIPTOR1_ELEM(descr, idx) \
+ (descr)->base_addr[GFC_DESCRIPTOR1_INDEX((descr), (idx))]
+#define GFC_DESCRIPTOR1_ELEM_ADDRESS(descr, idx) \
+ (&GFC_DESCRIPTOR1_ELEM((descr), (idx)))
+#define GFC_DESCRIPTOR2_INDEX(descr, idx1, idx2) \
+ (GFC_DESCRIPTOR_DIM_INDEX_OFFSET((descr), 0, (idx1)) \
+ + GFC_DESCRIPTOR_DIM_INDEX_OFFSET((descr), 1, (idx2)))
+#define GFC_DESCRIPTOR2_ELEM(descr, idx1, idx2) \
+ (descr)->base_addr[GFC_DESCRIPTOR2_INDEX((descr),(idx1),(idx2))]
+#define GFC_DESCRIPTOR2_ELEM_ADDRESS(descr, idx1, idx2) \
+ (&GFC_DESCRIPTOR2_ELEM((descr),(idx1),(idx2))
+
/* Generic vtab structure. */
typedef struct
{
diff --git a/libgfortran/m4/bessel.m4 b/libgfortran/m4/bessel.m4
index 39da523884af..92881dc0469a 100644
--- a/libgfortran/m4/bessel.m4
+++ b/libgfortran/m4/bessel.m4
@@ -44,12 +44,9 @@ void
bessel_jn_r'rtype_kind` ('rtype` * const restrict ret, int n1, int n2,
'rtype_name` x)
{
int i;
- index_type stride;
'rtype_name` last1, last2, x2rev;
- stride = GFC_DESCRIPTOR_STRIDE(ret,0);
-
if (ret->base_addr == NULL)
{
size_t size = n2 < n1 ? 0 : n2-n1+1;
@@ -67,24 +64,22 @@ bessel_jn_r'rtype_kind` ('rtype` * const restrict ret, int
n1, int n2, 'rtype_na
"(%ld vs. %ld)", (long int) n2-n1,
(long int) GFC_DESCRIPTOR_EXTENT(ret,0));
- stride = GFC_DESCRIPTOR_STRIDE(ret,0);
-
if (unlikely (x == 0))
{
ret->base_addr[0] = 1;
for (i = 1; i <= n2-n1; i++)
- ret->base_addr[i*stride] = 0;
+ GFC_DESCRIPTOR1_ELEM (ret, i) = 0;
return;
}
last1 = MATHFUNC(jn) (n2, x);
- ret->base_addr[(n2-n1)*stride] = last1;
+ GFC_DESCRIPTOR1_ELEM (ret, n2-n1) = last1;
if (n1 == n2)
return;
last2 = MATHFUNC(jn) (n2 - 1, x);
- ret->base_addr[(n2-n1-1)*stride] = last2;
+ GFC_DESCRIPTOR1_ELEM (ret, n2-n1-1) = last2;
if (n1 + 1 == n2)
return;
@@ -93,9 +88,9 @@ bessel_jn_r'rtype_kind` ('rtype` * const restrict ret, int
n1, int n2, 'rtype_na
for (i = n2-n1-2; i >= 0; i--)
{
- ret->base_addr[i*stride] = x2rev * (i+1+n1) * last2 - last1;
+ GFC_DESCRIPTOR1_ELEM (ret, i) = x2rev * (i+1+n1) * last2 - last1;
last1 = last2;
- last2 = ret->base_addr[i*stride];
+ last2 = GFC_DESCRIPTOR1_ELEM (ret, i);
}
}
@@ -111,12 +106,9 @@ bessel_yn_r'rtype_kind` ('rtype` * const restrict ret, int
n1, int n2,
'rtype_name` x)
{
int i;
- index_type stride;
'rtype_name` last1, last2, x2rev;
- stride = GFC_DESCRIPTOR_STRIDE(ret,0);
-
if (ret->base_addr == NULL)
{
size_t size = n2 < n1 ? 0 : n2-n1+1;
@@ -134,27 +126,25 @@ bessel_yn_r'rtype_kind` ('rtype` * const restrict ret,
int n1, int n2,
"(%ld vs. %ld)", (long int) n2-n1,
(long int) GFC_DESCRIPTOR_EXTENT(ret,0));
- stride = GFC_DESCRIPTOR_STRIDE(ret,0);
-
if (unlikely (x == 0))
{
for (i = 0; i <= n2-n1; i++)
#if defined('rtype_name`_INFINITY)
- ret->base_addr[i*stride] = -'rtype_name`_INFINITY;
+ GFC_DESCRIPTOR1_ELEM (ret, i) = -'rtype_name`_INFINITY;
#else
- ret->base_addr[i*stride] = -'rtype_name`_HUGE;
+ GFC_DESCRIPTOR1_ELEM (ret, i) = -'rtype_name`_HUGE;
#endif
return;
}
last1 = MATHFUNC(yn) (n1, x);
- ret->base_addr[0] = last1;
+ GFC_DESCRIPTOR1_ELEM (ret, 0) = last1;
if (n1 == n2)
return;
last2 = MATHFUNC(yn) (n1 + 1, x);
- ret->base_addr[1*stride] = last2;
+ GFC_DESCRIPTOR1_ELEM (ret, 1) = last2;
if (n1 + 1 == n2)
return;
@@ -166,14 +156,14 @@ bessel_yn_r'rtype_kind` ('rtype` * const restrict ret,
int n1, int n2,
#if defined('rtype_name`_INFINITY)
if (unlikely (last2 == -'rtype_name`_INFINITY))
{
- ret->base_addr[i*stride] = -'rtype_name`_INFINITY;
+ GFC_DESCRIPTOR1_ELEM (ret, i) = -'rtype_name`_INFINITY;
}
else
#endif
{
- ret->base_addr[i*stride] = x2rev * (i-1+n1) * last2 - last1;
+ GFC_DESCRIPTOR1_ELEM (ret, i) = x2rev * (i-1+n1) * last2 - last1;
last1 = last2;
- last2 = ret->base_addr[i*stride];
+ last2 = GFC_DESCRIPTOR1_ELEM (ret, i);
}
}
}
diff --git a/libgfortran/m4/ifindloc0.m4 b/libgfortran/m4/ifindloc0.m4
index c484342f3cb9..d47c1c8f7a02 100644
--- a/libgfortran/m4/ifindloc0.m4
+++ b/libgfortran/m4/ifindloc0.m4
@@ -32,9 +32,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If
not, see
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
- index_type dstride;
const 'atype_name` *base;
- index_type * restrict dest;
index_type rank;
index_type n;
index_type sz;
@@ -57,12 +55,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If
not, see
"FINDLOC");
}
- dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
- dest = retarray->base_addr;
-
/* Set the return value. */
for (n = 0; n < rank; n++)
- dest[n * dstride] = 0;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = 0;
sz = 1;
for (n = 0; n < rank; n++)
@@ -79,7 +74,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If
not, see
if (back)
{
- base = array->base_addr + (sz - 1) * 'base_mult`;
+ base = GFC_DESCRIPTOR1_ELEM_ADDRESS (array, sz - 1);
while (1)
{
@@ -88,7 +83,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If
not, see
if (unlikely('comparison`))
{
for (n = 0; n < rank; n++)
- dest[n * dstride] = extent[n] - count[n];
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = extent[n] - count[n];
return;
}
@@ -125,7 +120,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.
If not, see
if (unlikely('comparison`))
{
for (n = 0; n < rank; n++)
- dest[n * dstride] = count[n] + 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = count[n] + 1;
return;
}
@@ -161,9 +156,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.
If not, see
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
- index_type dstride;
const 'atype_name` *base;
- index_type * restrict dest;
GFC_LOGICAL_1 *mbase;
index_type rank;
index_type n;
@@ -205,12 +198,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively.
If not, see
else
internal_error (NULL, "Funny sized logical array");
- dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
- dest = retarray->base_addr;
-
/* Set the return value. */
for (n = 0; n < rank; n++)
- dest[n * dstride] = 0;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = 0;
sz = 1;
for (n = 0; n < rank; n++)
@@ -228,7 +218,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.
If not, see
if (back)
{
- base = array->base_addr + (sz - 1) * 'base_mult`;
+ base = GFC_DESCRIPTOR1_ELEM_ADDRESS (array, sz - 1);
mbase = mbase + (sz - 1) * mask_kind;
while (1)
{
@@ -237,7 +227,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.
If not, see
if (unlikely(*mbase && 'comparison`))
{
for (n = 0; n < rank; n++)
- dest[n * dstride] = extent[n] - count[n];
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = extent[n] - count[n];
return;
}
@@ -277,7 +267,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.
If not, see
if (unlikely(*mbase && 'comparison`))
{
for (n = 0; n < rank; n++)
- dest[n * dstride] = count[n] + 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = count[n] + 1;
return;
}
@@ -313,8 +303,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively.
If not, see
'header3`
{
index_type rank;
- index_type dstride;
- index_type * restrict dest;
index_type n;
if (mask == NULL || *mask)
@@ -341,10 +329,8 @@ see the files COPYING3 and COPYING.RUNTIME respectively.
If not, see
"FINDLOC");
}
- dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
- dest = retarray->base_addr;
for (n = 0; n<rank; n++)
- dest[n * dstride] = 0 ;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = 0 ;
}
#endif'
diff --git a/libgfortran/m4/ifindloc2.m4 b/libgfortran/m4/ifindloc2.m4
index dfdffc131817..35bdc43babff 100644
--- a/libgfortran/m4/ifindloc2.m4
+++ b/libgfortran/m4/ifindloc2.m4
@@ -40,7 +40,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If
not, see
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * 'base_mult`;
if (back)
{
- src = array->base_addr + (extent - 1) * sstride;
+ src = GFC_DESCRIPTOR1_ELEM_ADDRESS (array, extent - 1);
for (i = extent; i > 0; i--)
{
if ('comparison`)
@@ -92,7 +92,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If
not, see
if (back)
{
- src = array->base_addr + (extent - 1) * sstride;
+ src = GFC_DESCRIPTOR1_ELEM_ADDRESS (array, extent - 1);
mbase += (extent - 1) * mstride;
for (i = extent; i > 0; i--)
{
diff --git a/libgfortran/m4/iforeach-s.m4 b/libgfortran/m4/iforeach-s.m4
index cb0117fbea4a..22db8306bdc6 100644
--- a/libgfortran/m4/iforeach-s.m4
+++ b/libgfortran/m4/iforeach-s.m4
@@ -24,9 +24,7 @@ void
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
- index_type dstride;
const 'atype_name` *base;
- 'rtype_name` * restrict dest;
index_type rank;
index_type n;
@@ -48,8 +46,6 @@ void
"u_name");
}
- dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
- dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
@@ -59,7 +55,7 @@ void
{
/* Set the return value. */
for (n = 0; n < rank; n++)
- dest[n * dstride] = 0;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = 0;
return;
}
}
@@ -68,7 +64,7 @@ void
/* Initialize the return value. */
for (n = 0; n < rank; n++)
- dest[n * dstride] = 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = 1;
{
')dnl
define(START_FOREACH_BLOCK,
@@ -127,8 +123,6 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict
retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
- index_type dstride;
- 'rtype_name` *dest;
const 'atype_name` *base;
GFC_LOGICAL_1 *mbase;
int rank;
@@ -181,8 +175,6 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict
retarray,
else
runtime_error ("Funny sized logical array");
- dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
- dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
@@ -193,7 +185,7 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict
retarray,
{
/* Set the return value. */
for (n = 0; n < rank; n++)
- dest[n * dstride] = 0;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = 0;
return;
}
}
@@ -202,7 +194,7 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict
retarray,
/* Initialize the return value. */
for (n = 0; n < rank; n++)
- dest[n * dstride] = 0;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = 0;
{
')dnl
define(START_MASKED_FOREACH_BLOCK, `START_FOREACH_BLOCK')dnl
@@ -267,9 +259,7 @@ s'name`'rtype_qual`_'atype_code` ('rtype` * const restrict
retarray,
gfc_charlen_type len)
{
index_type rank;
- index_type dstride;
index_type n;
- 'rtype_name` *dest;
if (mask == NULL || *mask)
{
@@ -299,8 +289,6 @@ s'name`'rtype_qual`_'atype_code` ('rtype` * const restrict
retarray,
"u_name");
}
- dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
- dest = retarray->base_addr;
for (n = 0; n<rank; n++)
- dest[n * dstride] = $1 ;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = $1 ;
}')dnl
diff --git a/libgfortran/m4/iforeach.m4 b/libgfortran/m4/iforeach.m4
index 04ca0302e5f4..65461df66aed 100644
--- a/libgfortran/m4/iforeach.m4
+++ b/libgfortran/m4/iforeach.m4
@@ -15,9 +15,7 @@ void
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
- index_type dstride;
const 'atype_name` *base;
- 'rtype_name` * restrict dest;
index_type rank;
index_type n;
@@ -39,8 +37,6 @@ void
"u_name");
}
- dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
- dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
@@ -50,7 +46,7 @@ void
{
/* Set the return value. */
for (n = 0; n < rank; n++)
- dest[n * dstride] = 0;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = 0;
return;
}
}
@@ -59,7 +55,7 @@ void
/* Initialize the return value. */
for (n = 0; n < rank; n++)
- dest[n * dstride] = 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = 1;
{
')dnl
define(START_FOREACH_BLOCK,
@@ -115,8 +111,6 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict
retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
- index_type dstride;
- 'rtype_name` *dest;
const 'atype_name` *base;
GFC_LOGICAL_1 *mbase;
int rank;
@@ -166,8 +160,6 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict
retarray,
else
runtime_error ("Funny sized logical array");
- dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
- dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
@@ -178,7 +170,7 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict
retarray,
{
/* Set the return value. */
for (n = 0; n < rank; n++)
- dest[n * dstride] = 0;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = 0;
return;
}
}
@@ -187,7 +179,7 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict
retarray,
/* Initialize the return value. */
for (n = 0; n < rank; n++)
- dest[n * dstride] = 0;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = 0;
{
')dnl
define(START_MASKED_FOREACH_BLOCK, `START_FOREACH_BLOCK')dnl
@@ -250,9 +242,7 @@ s'name`'rtype_qual`_'atype_code` ('rtype` * const restrict
retarray,
GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
{
index_type rank;
- index_type dstride;
index_type n;
- rtype_name *dest;
if (mask == NULL || *mask)
{
@@ -278,8 +268,6 @@ s'name`'rtype_qual`_'atype_code` ('rtype` * const restrict
retarray,
"u_name");
}
- dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
- dest = retarray->base_addr;
for (n = 0; n<rank; n++)
- dest[n * dstride] = $1 ;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = $1 ;
}')dnl
diff --git a/libgfortran/m4/matmul_internal.m4
b/libgfortran/m4/matmul_internal.m4
index 5865d2584338..e0d91a70de8e 100644
--- a/libgfortran/m4/matmul_internal.m4
+++ b/libgfortran/m4/matmul_internal.m4
@@ -229,10 +229,19 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
a_dim1 = aystride;
b_dim1 = bystride;
+#define A_ARRAY_ELEM(i,j) \
+ a[(i) + (j) * a_dim1]
+
+#define B_ARRAY_ELEM(i,j) \
+ b[(i) + (j) * b_dim1]
+
+#define C_ARRAY_ELEM(i,j) \
+ c[(i) + (j) * c_dim1]
+
/* Empty c first. */
for (j=0; j<n; j++)
for (i=0; i<m; i++)
- c[i + j * c_dim1] = ('rtype_name`)0;
+ C_ARRAY_ELEM (i, j) = ('rtype_name`)0;
/* Early exit if possible */
if (m == 0 || n == 0 || k == 0)
@@ -284,20 +293,20 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
for (i = ii; i < i5; i += 2)
{
t1[l - ll + 1 + ((i - ii + 1) << 8) - 257] =
- a[i + l * a_dim1];
+ A_ARRAY_ELEM (i, l);
t1[l - ll + 2 + ((i - ii + 1) << 8) - 257] =
- a[i + (l + 1) * a_dim1];
+ A_ARRAY_ELEM (i, l + 1);
t1[l - ll + 1 + ((i - ii + 2) << 8) - 257] =
- a[i + 1 + l * a_dim1];
+ A_ARRAY_ELEM (i + 1, l);
t1[l - ll + 2 + ((i - ii + 2) << 8) - 257] =
- a[i + 1 + (l + 1) * a_dim1];
+ A_ARRAY_ELEM (i + 1, l + 1);
}
if (uisec < isec)
{
t1[l - ll + 1 + (isec << 8) - 257] =
- a[ii + isec - 1 + l * a_dim1];
+ A_ARRAY_ELEM (ii + isec - 1, l);
t1[l - ll + 2 + (isec << 8) - 257] =
- a[ii + isec - 1 + (l + 1) * a_dim1];
+ A_ARRAY_ELEM (ii + isec - 1, l + 1);
}
}
if (ulsec < lsec)
@@ -306,7 +315,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
for (i = ii; i< i4; ++i)
{
t1[lsec + ((i - ii + 1) << 8) - 257] =
- a[i + (ll + lsec - 1) * a_dim1];
+ A_ARRAY_ELEM (i, ll + lsec - 1);
}
}
@@ -317,100 +326,100 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
i5 = ii + uisec;
for (i = ii; i < i5; i += 4)
{
- f11 = c[i + j * c_dim1];
- f21 = c[i + 1 + j * c_dim1];
- f12 = c[i + (j + 1) * c_dim1];
- f22 = c[i + 1 + (j + 1) * c_dim1];
- f13 = c[i + (j + 2) * c_dim1];
- f23 = c[i + 1 + (j + 2) * c_dim1];
- f14 = c[i + (j + 3) * c_dim1];
- f24 = c[i + 1 + (j + 3) * c_dim1];
- f31 = c[i + 2 + j * c_dim1];
- f41 = c[i + 3 + j * c_dim1];
- f32 = c[i + 2 + (j + 1) * c_dim1];
- f42 = c[i + 3 + (j + 1) * c_dim1];
- f33 = c[i + 2 + (j + 2) * c_dim1];
- f43 = c[i + 3 + (j + 2) * c_dim1];
- f34 = c[i + 2 + (j + 3) * c_dim1];
- f44 = c[i + 3 + (j + 3) * c_dim1];
+ f11 = C_ARRAY_ELEM (i, j);
+ f21 = C_ARRAY_ELEM (i + 1, j);
+ f12 = C_ARRAY_ELEM (i, j + 1);
+ f22 = C_ARRAY_ELEM (i + 1, j + 1);
+ f13 = C_ARRAY_ELEM (i, j + 2);
+ f23 = C_ARRAY_ELEM (i + 1, j + 2);
+ f14 = C_ARRAY_ELEM (i, j + 3);
+ f24 = C_ARRAY_ELEM (i + 1, j + 3);
+ f31 = C_ARRAY_ELEM (i + 2, j);
+ f41 = C_ARRAY_ELEM (i + 3, j);
+ f32 = C_ARRAY_ELEM (i + 2, j + 1);
+ f42 = C_ARRAY_ELEM (i + 3, j + 1);
+ f33 = C_ARRAY_ELEM (i + 2, j + 2);
+ f43 = C_ARRAY_ELEM (i + 3, j + 2);
+ f34 = C_ARRAY_ELEM (i + 2, j + 3);
+ f44 = C_ARRAY_ELEM (i + 3, j + 3);
i6 = ll + lsec;
for (l = ll; l < i6; ++l)
{
f11 += t1[l - ll + 1 + ((i - ii + 1) << 8) - 257]
- * b[l + j * b_dim1];
+ * B_ARRAY_ELEM (l, j);
f21 += t1[l - ll + 1 + ((i - ii + 2) << 8) - 257]
- * b[l + j * b_dim1];
+ * B_ARRAY_ELEM (l, j);
f12 += t1[l - ll + 1 + ((i - ii + 1) << 8) - 257]
- * b[l + (j + 1) * b_dim1];
+ * B_ARRAY_ELEM (l, j + 1);
f22 += t1[l - ll + 1 + ((i - ii + 2) << 8) - 257]
- * b[l + (j + 1) * b_dim1];
+ * B_ARRAY_ELEM (l, j + 1);
f13 += t1[l - ll + 1 + ((i - ii + 1) << 8) - 257]
- * b[l + (j + 2) * b_dim1];
+ * B_ARRAY_ELEM (l, j + 2);
f23 += t1[l - ll + 1 + ((i - ii + 2) << 8) - 257]
- * b[l + (j + 2) * b_dim1];
+ * B_ARRAY_ELEM (l, j + 2);
f14 += t1[l - ll + 1 + ((i - ii + 1) << 8) - 257]
- * b[l + (j + 3) * b_dim1];
+ * B_ARRAY_ELEM (l, j + 3);
f24 += t1[l - ll + 1 + ((i - ii + 2) << 8) - 257]
- * b[l + (j + 3) * b_dim1];
+ * B_ARRAY_ELEM (l, j + 3);
f31 += t1[l - ll + 1 + ((i - ii + 3) << 8) - 257]
- * b[l + j * b_dim1];
+ * B_ARRAY_ELEM (l, j);
f41 += t1[l - ll + 1 + ((i - ii + 4) << 8) - 257]
- * b[l + j * b_dim1];
+ * B_ARRAY_ELEM (l, j);
f32 += t1[l - ll + 1 + ((i - ii + 3) << 8) - 257]
- * b[l + (j + 1) * b_dim1];
+ * B_ARRAY_ELEM (l, j + 1);
f42 += t1[l - ll + 1 + ((i - ii + 4) << 8) - 257]
- * b[l + (j + 1) * b_dim1];
+ * B_ARRAY_ELEM (l, j + 1);
f33 += t1[l - ll + 1 + ((i - ii + 3) << 8) - 257]
- * b[l + (j + 2) * b_dim1];
+ * B_ARRAY_ELEM (l, j + 2);
f43 += t1[l - ll + 1 + ((i - ii + 4) << 8) - 257]
- * b[l + (j + 2) * b_dim1];
+ * B_ARRAY_ELEM (l, j + 2);
f34 += t1[l - ll + 1 + ((i - ii + 3) << 8) - 257]
- * b[l + (j + 3) * b_dim1];
+ * B_ARRAY_ELEM (l, j + 3);
f44 += t1[l - ll + 1 + ((i - ii + 4) << 8) - 257]
- * b[l + (j + 3) * b_dim1];
+ * B_ARRAY_ELEM (l, j + 3);
}
- c[i + j * c_dim1] = f11;
- c[i + 1 + j * c_dim1] = f21;
- c[i + (j + 1) * c_dim1] = f12;
- c[i + 1 + (j + 1) * c_dim1] = f22;
- c[i + (j + 2) * c_dim1] = f13;
- c[i + 1 + (j + 2) * c_dim1] = f23;
- c[i + (j + 3) * c_dim1] = f14;
- c[i + 1 + (j + 3) * c_dim1] = f24;
- c[i + 2 + j * c_dim1] = f31;
- c[i + 3 + j * c_dim1] = f41;
- c[i + 2 + (j + 1) * c_dim1] = f32;
- c[i + 3 + (j + 1) * c_dim1] = f42;
- c[i + 2 + (j + 2) * c_dim1] = f33;
- c[i + 3 + (j + 2) * c_dim1] = f43;
- c[i + 2 + (j + 3) * c_dim1] = f34;
- c[i + 3 + (j + 3) * c_dim1] = f44;
+ C_ARRAY_ELEM (i, j) = f11;
+ C_ARRAY_ELEM (i + 1, j) = f21;
+ C_ARRAY_ELEM (i, j + 1) = f12;
+ C_ARRAY_ELEM (i + 1, j + 1) = f22;
+ C_ARRAY_ELEM (i, j + 2) = f13;
+ C_ARRAY_ELEM (i + 1, j + 2) = f23;
+ C_ARRAY_ELEM (i, j + 3) = f14;
+ C_ARRAY_ELEM (i + 1, j + 3) = f24;
+ C_ARRAY_ELEM (i + 2, j) = f31;
+ C_ARRAY_ELEM (i + 3, j) = f41;
+ C_ARRAY_ELEM (i + 2, j + 1) = f32;
+ C_ARRAY_ELEM (i + 3, j + 1) = f42;
+ C_ARRAY_ELEM (i + 2, j + 2) = f33;
+ C_ARRAY_ELEM (i + 3, j + 2) = f43;
+ C_ARRAY_ELEM (i + 2, j + 3) = f34;
+ C_ARRAY_ELEM (i + 3, j + 3) = f44;
}
if (uisec < isec)
{
i5 = ii + isec;
for (i = ii + uisec; i < i5; ++i)
{
- f11 = c[i + j * c_dim1];
- f12 = c[i + (j + 1) * c_dim1];
- f13 = c[i + (j + 2) * c_dim1];
- f14 = c[i + (j + 3) * c_dim1];
+ f11 = C_ARRAY_ELEM (i, j);
+ f12 = C_ARRAY_ELEM (i, j + 1);
+ f13 = C_ARRAY_ELEM (i, j + 2);
+ f14 = C_ARRAY_ELEM (i, j + 3);
i6 = ll + lsec;
for (l = ll; l < i6; ++l)
{
f11 += t1[l - ll + 1 + ((i - ii + 1) << 8) -
- 257] * b[l + j * b_dim1];
+ 257] * B_ARRAY_ELEM (l, j);
f12 += t1[l - ll + 1 + ((i - ii + 1) << 8) -
- 257] * b[l + (j + 1) * b_dim1];
+ 257] * B_ARRAY_ELEM (l, j + 1);
f13 += t1[l - ll + 1 + ((i - ii + 1) << 8) -
- 257] * b[l + (j + 2) * b_dim1];
+ 257] * B_ARRAY_ELEM (l, j + 2);
f14 += t1[l - ll + 1 + ((i - ii + 1) << 8) -
- 257] * b[l + (j + 3) * b_dim1];
+ 257] * B_ARRAY_ELEM (l, j + 3);
}
- c[i + j * c_dim1] = f11;
- c[i + (j + 1) * c_dim1] = f12;
- c[i + (j + 2) * c_dim1] = f13;
- c[i + (j + 3) * c_dim1] = f14;
+ C_ARRAY_ELEM (i, j) = f11;
+ C_ARRAY_ELEM (i, j + 1) = f12;
+ C_ARRAY_ELEM (i, j + 2) = f13;
+ C_ARRAY_ELEM (i, j + 3) = f14;
}
}
}
@@ -422,38 +431,38 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
i5 = ii + uisec;
for (i = ii; i < i5; i += 4)
{
- f11 = c[i + j * c_dim1];
- f21 = c[i + 1 + j * c_dim1];
- f31 = c[i + 2 + j * c_dim1];
- f41 = c[i + 3 + j * c_dim1];
+ f11 = C_ARRAY_ELEM (i, j);
+ f21 = C_ARRAY_ELEM (i + 1, j);
+ f31 = C_ARRAY_ELEM (i + 2, j);
+ f41 = C_ARRAY_ELEM (i + 3, j);
i6 = ll + lsec;
for (l = ll; l < i6; ++l)
{
f11 += t1[l - ll + 1 + ((i - ii + 1) << 8) -
- 257] * b[l + j * b_dim1];
+ 257] * B_ARRAY_ELEM (l, j);
f21 += t1[l - ll + 1 + ((i - ii + 2) << 8) -
- 257] * b[l + j * b_dim1];
+ 257] * B_ARRAY_ELEM (l, j);
f31 += t1[l - ll + 1 + ((i - ii + 3) << 8) -
- 257] * b[l + j * b_dim1];
+ 257] * B_ARRAY_ELEM (l, j);
f41 += t1[l - ll + 1 + ((i - ii + 4) << 8) -
- 257] * b[l + j * b_dim1];
+ 257] * B_ARRAY_ELEM (l, j);
}
- c[i + j * c_dim1] = f11;
- c[i + 1 + j * c_dim1] = f21;
- c[i + 2 + j * c_dim1] = f31;
- c[i + 3 + j * c_dim1] = f41;
+ C_ARRAY_ELEM (i, j) = f11;
+ C_ARRAY_ELEM (i + 1, j) = f21;
+ C_ARRAY_ELEM (i + 2, j) = f31;
+ C_ARRAY_ELEM (i + 3, j) = f41;
}
i5 = ii + isec;
for (i = ii + uisec; i < i5; ++i)
{
- f11 = c[i + j * c_dim1];
+ f11 = C_ARRAY_ELEM (i, j);
i6 = ll + lsec;
for (l = ll; l < i6; ++l)
{
f11 += t1[l - ll + 1 + ((i - ii + 1) << 8) -
- 257] * b[l + j * b_dim1];
+ 257] * B_ARRAY_ELEM (l, j);
}
- c[i + j * c_dim1] = f11;
+ C_ARRAY_ELEM (i, j) = f11;
}
}
}
@@ -462,6 +471,9 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
}
free(t1);
return;
+#undef A_ARRAY_ELEM
+#undef B_ARRAY_ELEM
+#undef C_ARRAY_ELEM
}
else if (rxstride == 1 && aystride == 1 && bxstride == 1)
{
@@ -496,7 +508,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
bbase_y = &bbase[y*bystride];
s = ('rtype_name`) 0;
for (n = 0; n < count; n++)
- s += abase[n*axstride] * bbase_y[n];
+ s += GFC_DESCRIPTOR1_ELEM (a, n) * bbase_y[n];
dest[y*rystride] = s;
}
}
@@ -511,23 +523,23 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
bbase_y = &bbase[y*bystride];
s = ('rtype_name`) 0;
for (n = 0; n < count; n++)
- s += abase[n*axstride] * bbase_y[n*bxstride];
- dest[y*rxstride] = s;
+ s += GFC_DESCRIPTOR1_ELEM (a, n) * bbase_y[n*bxstride];
+ GFC_DESCRIPTOR1_ELEM (retarray, y) = s;
}
}
else if (axstride < aystride)
{
for (y = 0; y < ycount; y++)
for (x = 0; x < xcount; x++)
- dest[x*rxstride + y*rystride] = ('rtype_name`)0;
+ GFC_DESCRIPTOR2_ELEM (retarray, x, y) = ('rtype_name`)0;
for (y = 0; y < ycount; y++)
for (n = 0; n < count; n++)
for (x = 0; x < xcount; x++)
/* dest[x,y] += a[x,n] * b[n,y] */
- dest[x*rxstride + y*rystride] +=
- abase[x*axstride + n*aystride] *
- bbase[n*bxstride + y*bystride];
+ GFC_DESCRIPTOR2_ELEM (retarray, x, y)
+ += GFC_DESCRIPTOR2_ELEM (a, x, n)
+ * GFC_DESCRIPTOR2_ELEM (b, n, y);
}
else
{
diff --git a/libgfortran/m4/maxloc0.m4 b/libgfortran/m4/maxloc0.m4
index f60580f063e2..5aef384bb8db 100644
--- a/libgfortran/m4/maxloc0.m4
+++ b/libgfortran/m4/maxloc0.m4
@@ -52,7 +52,7 @@ FOREACH_FUNCTION(
fast = 1;
maxval = *base;
for (n = 0; n < rank; n++)
- dest[n * dstride] = count[n] + 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = count[n] + 1;
break;
}
base += sstride[0];
@@ -70,7 +70,7 @@ FOREACH_FUNCTION(
{
maxval = *base;
for (n = 0; n < rank; n++)
- dest[n * dstride] = count[n] + 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = count[n] + 1;
}
base += sstride[0];
}
@@ -82,7 +82,7 @@ FOREACH_FUNCTION(
{
maxval = *base;
for (n = 0; n < rank; n++)
- dest[n * dstride] = count[n] + 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = count[n] + 1;
}')
MASKED_FOREACH_FUNCTION(
` 'atype_name` maxval;
@@ -100,16 +100,16 @@ MASKED_FOREACH_FUNCTION(
if (*mbase)
{
#if defined('atype_nan`)
- if (unlikely (dest[0] == 0))
+ if (unlikely (GFC_DESCRIPTOR1_ELEM (retarray, 0) == 0))
for (n = 0; n < rank; n++)
- dest[n * dstride] = count[n] + 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = count[n] + 1;
if (*base >= maxval)
#endif
{
fast = 1;
maxval = *base;
for (n = 0; n < rank; n++)
- dest[n * dstride] = count[n] + 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = count[n] + 1;
break;
}
}
@@ -128,7 +128,7 @@ MASKED_FOREACH_FUNCTION(
{
maxval = *base;
for (n = 0; n < rank; n++)
- dest[n * dstride] = count[n] + 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = count[n] + 1;
}
base += sstride[0];
}
@@ -140,7 +140,7 @@ MASKED_FOREACH_FUNCTION(
{
maxval = *base;
for (n = 0; n < rank; n++)
- dest[n * dstride] = count[n] + 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = count[n] + 1;
}')
SCALAR_FOREACH_FUNCTION(`0')
diff --git a/libgfortran/m4/maxloc0s.m4 b/libgfortran/m4/maxloc0s.m4
index 610954ad3826..513519b5b369 100644
--- a/libgfortran/m4/maxloc0s.m4
+++ b/libgfortran/m4/maxloc0s.m4
@@ -45,7 +45,7 @@ FOREACH_FUNCTION(
{
maxval = base;
for (n = 0; n < rank; n++)
- dest[n * dstride] = count[n] + 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = count[n] + 1;
}')
MASKED_FOREACH_FUNCTION(
@@ -59,7 +59,7 @@ MASKED_FOREACH_FUNCTION(
{
maxval = base;
for (n = 0; n < rank; n++)
- dest[n * dstride] = count[n] + 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = count[n] + 1;
}')
SCALAR_FOREACH_FUNCTION(`0')
diff --git a/libgfortran/m4/maxloc2s.m4 b/libgfortran/m4/maxloc2s.m4
index b6070b41d26f..a0359dfeb86f 100644
--- a/libgfortran/m4/maxloc2s.m4
+++ b/libgfortran/m4/maxloc2s.m4
@@ -128,7 +128,7 @@ m'name`'rtype_qual`_'atype_code` ('atype` * const restrict
array,
return 0;
ret = j + 1;
- src = array->base_addr + j * sstride;
+ src = GFC_DESCRIPTOR1_ELEM_ADDRESS (array, j);
maxval = src;
for (i=j+1; i<=extent; i++)
diff --git a/libgfortran/m4/minloc0.m4 b/libgfortran/m4/minloc0.m4
index 0e1bb3b2f86c..e4a53331ab6f 100644
--- a/libgfortran/m4/minloc0.m4
+++ b/libgfortran/m4/minloc0.m4
@@ -52,7 +52,7 @@ FOREACH_FUNCTION(
fast = 1;
minval = *base;
for (n = 0; n < rank; n++)
- dest[n * dstride] = count[n] + 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = count[n] + 1;
break;
}
base += sstride[0];
@@ -70,7 +70,7 @@ FOREACH_FUNCTION(
{
minval = *base;
for (n = 0; n < rank; n++)
- dest[n * dstride] = count[n] + 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = count[n] + 1;
}
base += sstride[0];
}
@@ -82,7 +82,7 @@ FOREACH_FUNCTION(
{
minval = *base;
for (n = 0; n < rank; n++)
- dest[n * dstride] = count[n] + 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = count[n] + 1;
}')
MASKED_FOREACH_FUNCTION(
` atype_name minval;
@@ -100,16 +100,16 @@ MASKED_FOREACH_FUNCTION(
if (*mbase)
{
#if defined('atype_nan`)
- if (unlikely (dest[0] == 0))
+ if (unlikely (GFC_DESCRIPTOR1_ELEM (retarray, 0) == 0))
for (n = 0; n < rank; n++)
- dest[n * dstride] = count[n] + 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = count[n] + 1;
if (*base <= minval)
#endif
{
fast = 1;
minval = *base;
for (n = 0; n < rank; n++)
- dest[n * dstride] = count[n] + 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = count[n] + 1;
break;
}
}
@@ -128,7 +128,7 @@ MASKED_FOREACH_FUNCTION(
{
minval = *base;
for (n = 0; n < rank; n++)
- dest[n * dstride] = count[n] + 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = count[n] + 1;
}
base += sstride[0];
}
@@ -140,7 +140,7 @@ MASKED_FOREACH_FUNCTION(
{
minval = *base;
for (n = 0; n < rank; n++)
- dest[n * dstride] = count[n] + 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = count[n] + 1;
}')
SCALAR_FOREACH_FUNCTION(`0')
#endif
diff --git a/libgfortran/m4/minloc0s.m4 b/libgfortran/m4/minloc0s.m4
index 8b360509b806..983963d9d7bd 100644
--- a/libgfortran/m4/minloc0s.m4
+++ b/libgfortran/m4/minloc0s.m4
@@ -45,7 +45,7 @@ FOREACH_FUNCTION(
{
minval = base;
for (n = 0; n < rank; n++)
- dest[n * dstride] = count[n] + 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = count[n] + 1;
}')
MASKED_FOREACH_FUNCTION(
@@ -59,7 +59,7 @@ MASKED_FOREACH_FUNCTION(
{
minval = base;
for (n = 0; n < rank; n++)
- dest[n * dstride] = count[n] + 1;
+ GFC_DESCRIPTOR1_ELEM (retarray, n) = count[n] + 1;
}')
SCALAR_FOREACH_FUNCTION(`0')
diff --git a/libgfortran/m4/minloc2s.m4 b/libgfortran/m4/minloc2s.m4
index 9524fc4c62a7..d9674ae88ac1 100644
--- a/libgfortran/m4/minloc2s.m4
+++ b/libgfortran/m4/minloc2s.m4
@@ -129,7 +129,7 @@ m'name`'rtype_qual`_'atype_code` ('atype` * const restrict
array,
return 0;
ret = j + 1;
- src = array->base_addr + j * sstride;
+ src = GFC_DESCRIPTOR1_ELEM_ADDRESS (array, j);
maxval = src;
for (i=j+1; i<=extent; i++)
diff --git a/libgfortran/m4/pack.m4 b/libgfortran/m4/pack.m4
index 1e94fc8416b6..43589b87e859 100644
--- a/libgfortran/m4/pack.m4
+++ b/libgfortran/m4/pack.m4
@@ -245,7 +245,7 @@ pack_'rtype_code` ('rtype` *ret, const 'rtype` *array,
if (sstride0 == 0)
sstride0 = 1;
- sptr = vector->base_addr + sstride0 * nelem;
+ sptr = (const 'rtype_name` *) GFC_DESCRIPTOR1_ELEM_ADDRESS (vector,
nelem);
n -= nelem;
while (n--)
{
diff --git a/libgfortran/m4/reshape.m4 b/libgfortran/m4/reshape.m4
index ee1547e91282..3daa6f1230f3 100644
--- a/libgfortran/m4/reshape.m4
+++ b/libgfortran/m4/reshape.m4
@@ -91,7 +91,7 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret,
for (index_type n = 0; n < rdim; n++)
{
- shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE(shape,0)];
+ shape_data[n] = GFC_DESCRIPTOR1_ELEM (shape, n);
if (shape_data[n] <= 0)
{
shape_data[n] = 0;
@@ -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"
@@ -217,7 +217,7 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret,
{
index_type dim;
if (order)
- dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
+ dim = GFC_DESCRIPTOR1_ELEM (order, n) - 1;
else
dim = n;
diff --git a/libgfortran/m4/shape.m4 b/libgfortran/m4/shape.m4
index 82b13fd04fea..dc88035c53f0 100644
--- a/libgfortran/m4/shape.m4
+++ b/libgfortran/m4/shape.m4
@@ -37,7 +37,6 @@ void
shape_'rtype_kind` ('rtype` * const restrict ret,
const array_t * const restrict array)
{
- index_type stride;
index_type extent;
int rank = GFC_DESCRIPTOR_RANK (array);
@@ -49,15 +48,13 @@ shape_'rtype_kind` ('rtype` * const restrict ret,
ret->base_addr = xmallocarray (rank, sizeof ('rtype_name`));
}
- stride = GFC_DESCRIPTOR_STRIDE(ret,0);
-
if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1)
return;
for (index_type n = 0; n < rank; n++)
{
extent = GFC_DESCRIPTOR_EXTENT(array,n);
- ret->base_addr[n * stride] = extent > 0 ? extent : 0 ;
+ GFC_DESCRIPTOR1_ELEM (ret, n) = extent > 0 ? extent : 0 ;
}
}
