[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Ajout macros GFC_DESCRIPTOR1_ELEM, PTR_ADD_OFFSET, etc
Mikael Morin
mikael@gcc.gnu.org
Fri Sep 12 18:01:55 GMT 2025
https://gcc.gnu.org/g:6eb9f4266d044248faff2c005a4d6dd7b150b5d4
commit 6eb9f4266d044248faff2c005a4d6dd7b150b5d4
Author: Mikael Morin <mikael@gcc.gnu.org>
Date: Thu Sep 11 12:28:19 2025 +0200
Ajout macros GFC_DESCRIPTOR1_ELEM, PTR_ADD_OFFSET, 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
Diff:
---
libgfortran/intrinsics/reduce.c | 44 +++---
libgfortran/intrinsics/reshape_generic.c | 37 +++--
libgfortran/intrinsics/spread_generic.c | 2 +-
libgfortran/intrinsics/stat.c | 132 ++++++++---------
libgfortran/libgfortran.h | 19 ++-
libgfortran/m4/bessel.m4 | 34 ++---
libgfortran/m4/cshift0.m4 | 2 +-
libgfortran/m4/cshift1.m4 | 2 +-
libgfortran/m4/cshift1a.m4 | 2 +-
libgfortran/m4/ifindloc0.m4 | 32 ++---
libgfortran/m4/ifindloc1.m4 | 4 +-
libgfortran/m4/ifindloc2.m4 | 4 +-
libgfortran/m4/iforeach-s.m4 | 22 +--
libgfortran/m4/iforeach.m4 | 22 +--
libgfortran/m4/matmul_internal.m4 | 235 +++++++++++++++++--------------
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 | 4 +-
libgfortran/m4/shape.m4 | 5 +-
24 files changed, 314 insertions(+), 334 deletions(-)
diff --git a/libgfortran/intrinsics/reduce.c b/libgfortran/intrinsics/reduce.c
index aa391fb1373d..2895bd3dd587 100644
--- a/libgfortran/intrinsics/reduce.c
+++ b/libgfortran/intrinsics/reduce.c
@@ -51,8 +51,9 @@ reduce (parray *ret,
void *res;
index_type ext0, ext1, ext2;
index_type str0, str1, str2;
+ index_type mstr0, mstr1, mstr2;
index_type idx0, idx1, idx2;
- index_type dimen, dimen_m1, ldx, ext, str;
+ index_type dimen, dimen_m1, ext, str;
bool started;
bool masked = false;
bool dim_present = dim != NULL;
@@ -95,7 +96,8 @@ reduce (parray *ret,
painless by the use of pointer arithmetic throughout (except for MASK,
whose type is known. */
ext0 = ext1 = ext2 = 1;
- str0 = str1 = str2 = 1;
+ str0 = str1 = str2 = GFC_DESCRIPTOR_SIZE (array);
+ mstr0 = mstr1 = mstr2 = sizeof (GFC_LOGICAL_4);
scalar_result = (!dim_present && array_rank > 1) || array_rank == 1;
@@ -104,7 +106,6 @@ reduce (parray *ret,
{
/* Obtain the shape of the reshaped ARRAY. */
ext = GFC_DESCRIPTOR_EXTENT (array,i);
- str = GFC_DESCRIPTOR_STRIDE (array,i);
if (masked && (ext != GFC_DESCRIPTOR_EXTENT (mask, i)))
{
@@ -136,11 +137,15 @@ reduce (parray *ret,
if (!scalar_result)
{
- str1 = GFC_DESCRIPTOR_STRIDE (array, dimen_m1);
+ str1 = GFC_DESCRIPTOR_STRIDE_BYTES (array, dimen_m1);
+ if (mask_present)
+ mstr1 = GFC_DESCRIPTOR_STRIDE_BYTES (mask, dimen_m1);
if (dimen < array_rank)
- str2 = GFC_DESCRIPTOR_STRIDE (array, dimen);
- else
- str2 = 1;
+ {
+ str2 = GFC_DESCRIPTOR_STRIDE_BYTES (array, dimen);
+ if (mask_present)
+ mstr2 = GFC_DESCRIPTOR_STRIDE_BYTES (mask, dimen);
+ }
}
/* Allocate the result data, the result buffer and zero. */
@@ -154,14 +159,14 @@ reduce (parray *ret,
{
for (idx2 = 0; idx2 < ext2; idx2++)
{
- ldx = idx0 * str0 + idx2 * str2;
if (mask_present)
- maskR = mask->base_addr[ldx];
+ maskR = ARRAY_ELEM_AT_OFFSET (mask->base_addr,
+ idx0 * mstr0 + idx2 * mstr2);
started = (mask_present && maskR) || !mask_present;
- buffer_ptr = array->base_addr
- + (size_t)((idx0 * str0 + idx2 * str2) * elem_len);
+ buffer_ptr = PTR_ADD_OFFSET (array->base_addr,
+ idx0 * str0 + idx2 * str2);
/* Start the iteration over the second dimension of ARRAY. */
for (idx1 = 1; idx1 < ext1; idx1++)
@@ -169,13 +174,16 @@ reduce (parray *ret,
/* If masked, cycle until after first element that is not masked
out. Then set 'started' and cycle so that this becomes the
first element in the reduction. */
- ldx = idx0 * str0 + idx1 * str1 + idx2 * str2;
if (mask_present)
- maskR = mask->base_addr[ldx];
-
- array_ptr = array->base_addr
- + (size_t)((idx0 * str0 + idx1 * str1
- + idx2 * str2) * elem_len);
+ maskR = ARRAY_ELEM_AT_OFFSET (mask->base_addr,
+ idx0 * mstr0
+ + idx1 * mstr1
+ + idx2 * mstr2);
+
+ array_ptr = PTR_ADD_OFFSET (array->base_addr,
+ idx0 * str0
+ + idx1 * str1
+ + idx2 * str2);
if (!started)
{
if (mask_present && maskR)
@@ -199,7 +207,7 @@ reduce (parray *ret,
result. If this result element is empty emit an error or, if
available, set to identity. Note that str1 is paired with idx2
here because the result skips a dimension. */
- res = ret->base_addr + (size_t)((idx0 * str0 + idx2 * str1) * elem_len);
+ res = PTR_ADD_OFFSET (ret->base_addr, idx0 * str0 + idx2 * str1);
if (started)
{
operation (buffer_ptr, NULL, res);
diff --git a/libgfortran/intrinsics/reshape_generic.c b/libgfortran/intrinsics/reshape_generic.c
index 1aa47bb9d8ee..046537a25fc3 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;
@@ -115,12 +115,12 @@ reshape_internal (parray *ret, parray *source, shape_type *shape,
if (pad)
{
pdim = GFC_DESCRIPTOR_RANK (pad);
- psize = 1;
+ psize = GFC_DESCRIPTOR_SIZE (pad);
pempty = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
- pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n);
+ pstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(pad,n);
pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n);
if (pextent[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"
@@ -202,16 +202,16 @@ reshape_internal (parray *ret, parray *source, shape_type *shape,
}
}
- rsize = 1;
+ rsize = GFC_DESCRIPTOR_SIZE (ret);
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;
rcount[n] = 0;
- rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim);
if (rextent[n] != shape_data[dim])
@@ -230,12 +230,12 @@ reshape_internal (parray *ret, parray *source, shape_type *shape,
avoids a warning. */
GFC_ASSERT(sdim>0);
- ssize = 1;
+ ssize = GFC_DESCRIPTOR_SIZE (source);
sempty = 0;
for (n = 0; n < sdim; n++)
{
scount[n] = 0;
- sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(source,n);
sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (sextent[n] <= 0)
{
@@ -251,17 +251,14 @@ reshape_internal (parray *ret, parray *source, shape_type *shape,
if (rsize != 0 && ssize != 0 && psize != 0)
{
- rsize *= size;
- ssize *= size;
- psize *= size;
reshape_packed (ret->base_addr, rsize, source->base_addr, ssize,
pad ? pad->base_addr : NULL, psize);
return;
}
rptr = ret->base_addr;
src = sptr = source->base_addr;
- rstride0 = rstride[0] * size;
- sstride0 = sstride[0] * size;
+ rstride0 = rstride[0];
+ sstride0 = sstride[0];
if (sempty && pempty)
abort ();
@@ -277,7 +274,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape,
scount[dim] = pcount[dim];
sextent[dim] = pextent[dim];
sstride[dim] = pstride[dim];
- sstride0 = pstride[0] * size;
+ sstride0 = pstride[0];
}
}
@@ -300,7 +297,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape,
rcount[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
- rptr -= rstride[n] * rextent[n] * size;
+ rptr -= rstride[n] * rextent[n];
n++;
if (n == rdim)
{
@@ -311,7 +308,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape,
else
{
rcount[n]++;
- rptr += rstride[n] * size;
+ rptr += rstride[n];
}
}
@@ -324,7 +321,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape,
scount[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
- src -= sstride[n] * sextent[n] * size;
+ src -= sstride[n] * sextent[n];
n++;
if (n == sdim)
{
@@ -338,7 +335,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape,
scount[dim] = pcount[dim];
sextent[dim] = pextent[dim];
sstride[dim] = pstride[dim];
- sstride0 = sstride[0] * size;
+ sstride0 = sstride[0];
}
}
/* We now start again from the beginning of the pad array. */
@@ -348,7 +345,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape,
else
{
scount[n]++;
- src += sstride[n] * size;
+ src += sstride[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 d7100fd5b7c4..70b7b40fb29d 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -586,10 +586,27 @@ typedef GFC_FULL_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_full_a
(__alignof__(GFC_COMPLEX_8) - 1))
-#define PTR_INCREMENT_BYTES(ptr,bytes) ptr = (typeof (ptr)) (((char*) ptr) + (bytes))
+#define PTR_ADD_OFFSET(ptr,bytes) ((typeof (ptr)) (((char*) ptr) + (bytes)))
+#define ARRAY_ELEM_AT_OFFSET(array_ptr,offset) (*PTR_ADD_OFFSET ((array_ptr), (offset)))
+#define GFC_DESCRIPTOR_DIM_OFFSET(descr, dim, idx) \
+ ((idx) * GFC_DESCRIPTOR_STRIDE_BYTES ((descr), (dim)))
+#define GFC_DESCRIPTOR1_ELEM_ADDRESS(descr, idx) \
+ PTR_ADD_OFFSET ((descr)->base_addr, GFC_DESCRIPTOR_DIM_OFFSET((descr), 0, (idx)))
+#define GFC_DESCRIPTOR1_ELEM(descr, idx) \
+ (*GFC_DESCRIPTOR1_ELEM_ADDRESS((descr), (idx)))
+#define GFC_DESCRIPTOR2_ELEM_ADDRESS(descr, idx1, idx2) \
+ PTR_ADD_OFFSET ((descr)->base_addr, \
+ GFC_DESCRIPTOR_DIM_OFFSET((descr), 0, (idx1)) \
+ + GFC_DESCRIPTOR_DIM_OFFSET((descr), 1, (idx2)))
+#define GFC_DESCRIPTOR2_ELEM(descr, idx1, idx2) \
+ (*GFC_DESCRIPTOR2_ELEM_ADDRESS((descr), (idx1), (idx2)))
+
+#define PTR_INCREMENT_BYTES(ptr,bytes) ptr = PTR_ADD_OFFSET (ptr, bytes)
#define PTR_DECREMENT_BYTES(ptr,bytes) ptr = (typeof (ptr)) (((char*) ptr) - (bytes))
+
+
/* 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/cshift0.m4 b/libgfortran/m4/cshift0.m4
index 650703cf1253..39cdeb966303 100644
--- a/libgfortran/m4/cshift0.m4
+++ b/libgfortran/m4/cshift0.m4
@@ -191,7 +191,7 @@ cshift0_'rtype_code` ('rtype` *ret, const 'rtype` *array, ptrdiff_t shift,
/* Otherwise, we will have to perform the copy one element at
a time. */
'rtype_name` *dest = rptr;
- const 'rtype_name` *src = (const 'rtype_name` *) (((char*)sptr) + shift * soffset);
+ const 'rtype_name` *src = PTR_ADD_OFFSET (sptr, shift * soffset);
for (n = 0; n < len - shift; n++)
{
diff --git a/libgfortran/m4/cshift1.m4 b/libgfortran/m4/cshift1.m4
index bbb521c3a240..e35c5aa0f563 100644
--- a/libgfortran/m4/cshift1.m4
+++ b/libgfortran/m4/cshift1.m4
@@ -264,7 +264,7 @@ cshift1 (gfc_array_char * const restrict ret,
sh += len;
}
- src = &sptr[sh * soffset];
+ src = PTR_ADD_OFFSET (sptr, sh * soffset);
dest = rptr;
if (soffset == size && roffset == size)
{
diff --git a/libgfortran/m4/cshift1a.m4 b/libgfortran/m4/cshift1a.m4
index 1b5f983a2404..2ad6571c7395 100644
--- a/libgfortran/m4/cshift1a.m4
+++ b/libgfortran/m4/cshift1a.m4
@@ -134,7 +134,7 @@ cshift1'rtype_qual`_'atype_code` ('atype` * const restrict ret,
if (sh < 0)
sh += len;
}
- src = (const 'atype_name` *) (((char*)sptr) + sh * soffset);
+ src = PTR_ADD_OFFSET (sptr, sh * soffset);
dest = rptr;
if (soffset == sizeof ('atype_name`) && roffset == sizeof ('atype_name`))
{
diff --git a/libgfortran/m4/ifindloc0.m4 b/libgfortran/m4/ifindloc0.m4
index a6e50299ccd0..1fb5f169fdc0 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/ifindloc1.m4 b/libgfortran/m4/ifindloc1.m4
index 8e2eb95df7f4..7d4ba327ca08 100644
--- a/libgfortran/m4/ifindloc1.m4
+++ b/libgfortran/m4/ifindloc1.m4
@@ -131,7 +131,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
result = 0;
if (back)
{
- src = (const 'atype_name` * restrict) (((char*) base) + (len - 1) * delta);
+ src = PTR_ADD_OFFSET (base, (len - 1) * delta);
for (n = len; n > 0; n--)
{
if ('comparison`)
@@ -307,7 +307,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
result = 0;
if (back)
{
- src = (const 'atype_name` * restrict) (((char*)base) + (len - 1) * delta);
+ src = PTR_ADD_OFFSET (base, (len - 1) * delta);
msrc = mbase + (len - 1) * mdelta;
for (n = len; n > 0; n--)
{
diff --git a/libgfortran/m4/ifindloc2.m4 b/libgfortran/m4/ifindloc2.m4
index 14062a1a67f0..d01e770287f3 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_BYTES(array,0);
if (back)
{
- src = (const 'atype_name` * restrict) (((char*)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 = (const 'atype_name` * restrict) (((char*)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 4858ab2c7d82..ae6cf656e269 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_BYTES(array,n);
@@ -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_BYTES(array,n);
@@ -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 ca5664e537cb..2a88bd3affad 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_BYTES(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_BYTES(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 f13487ccd192..c013a6b60078 100644
--- a/libgfortran/m4/matmul_internal.m4
+++ b/libgfortran/m4/matmul_internal.m4
@@ -9,7 +9,8 @@
index_type rxstride, rystride, axstride, aystride, bxstride, bystride;
index_type x, y, n, count, xcount, ycount;
- index_type aystride_bytes, bystride_bytes, rystride_bytes;
+ index_type axstride_bytes, aystride_bytes, bxstride_bytes, bystride_bytes,
+ rxstride_bytes, rystride_bytes;
assert (GFC_DESCRIPTOR_RANK (a) == 2
|| GFC_DESCRIPTOR_RANK (b) == 2);
@@ -99,12 +100,13 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
either as a row or a column matrix. We want both cases to
work. */
rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0);
- rystride_bytes = GFC_DESCRIPTOR_STRIDE_BYTES(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);
}
@@ -113,6 +115,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
/* Treat it as a a row matrix A[1,count]. */
axstride = GFC_DESCRIPTOR_STRIDE(a,0);
aystride = 1;
+ axstride_bytes = GFC_DESCRIPTOR_STRIDE_BYTES(a,0);
aystride_bytes = sizeof ('rtype_name`);
xcount = 1;
@@ -122,6 +125,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
{
axstride = GFC_DESCRIPTOR_STRIDE(a,0);
aystride = GFC_DESCRIPTOR_STRIDE(a,1);
+ axstride_bytes = GFC_DESCRIPTOR_STRIDE_BYTES(a,0);
aystride_bytes = GFC_DESCRIPTOR_STRIDE_BYTES(a,1);
count = GFC_DESCRIPTOR_EXTENT(a,1);
@@ -140,17 +144,20 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
{
/* Treat it as a column matrix B[count,1] */
bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
+ bxstride_bytes = GFC_DESCRIPTOR_STRIDE_BYTES(b,0);
/* bystride should never be used for 1-dimensional b.
The value is only used for calculation of the
memory by the buffer. */
bystride = 256;
+ bystride_bytes = 99999999;
ycount = 1;
}
else
{
bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
bystride = GFC_DESCRIPTOR_STRIDE(b,1);
+ bxstride_bytes = GFC_DESCRIPTOR_STRIDE_BYTES(b,0);
bystride_bytes = GFC_DESCRIPTOR_STRIDE_BYTES(b,1);
ycount = GFC_DESCRIPTOR_EXTENT(b,1);
}
@@ -210,12 +217,11 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
from netlib.org, translated to C, and modified for matmul.m4. */
- const 'rtype_name` *a, *b;
'rtype_name` *c;
const index_type m = xcount, n = ycount, k = count;
/* System generated locals */
- index_type a_dim1, b_dim1, c_dim1,
+ index_type a_dim1, b_dim1,
i1, i2, i3, i4, i5, i6;
/* Local variables */
@@ -225,19 +231,25 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
index_type isec, jsec, lsec, uisec, ujsec, ulsec;
'rtype_name` *t1;
- a = abase;
- b = bbase;
c = retarray->base_addr;
/* Parameter adjustments */
- c_dim1 = rystride;
a_dim1 = aystride;
b_dim1 = bystride;
- /* Empty c first. */
+#define A_ARRAY_ELEM(i,j) \
+ (ARRAY_ELEM_AT_OFFSET (abase, (i) * sizeof ('rtype_name`) + (j) * aystride_bytes))
+
+#define B_ARRAY_ELEM(i,j) \
+ (ARRAY_ELEM_AT_OFFSET (bbase, (i) * sizeof ('rtype_name`) + (j) * bystride_bytes))
+
+#define C_ARRAY_ELEM(i,j) \
+ (ARRAY_ELEM_AT_OFFSET (c, (i) * sizeof ('rtype_name`) + (j) * rystride_bytes))
+
+ /* Empty result 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)
@@ -289,20 +301,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)
@@ -311,7 +323,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);
}
}
@@ -322,100 +334,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;
}
}
}
@@ -427,38 +439,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;
}
}
}
@@ -467,6 +479,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)
{
@@ -479,11 +494,11 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
for (y = 0; y < ycount; y++)
{
- bbase_y = &bbase[y*bystride];
- dest_y = &dest[y*rystride];
+ bbase_y = PTR_ADD_OFFSET (bbase, y * bystride_bytes);
+ dest_y = PTR_ADD_OFFSET (dest, y * rystride_bytes);
for (x = 0; x < xcount; x++)
{
- abase_x = &abase[x*axstride];
+ abase_x = PTR_ADD_OFFSET (abase, x * axstride_bytes);
s = ('rtype_name`) 0;
for (n = 0; n < count; n++)
s += abase_x[n] * bbase_y[n];
@@ -498,11 +513,11 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
for (y = 0; y < ycount; y++)
{
- bbase_y = &bbase[y*bystride];
+ bbase_y = PTR_ADD_OFFSET (bbase, y * bystride_bytes);
s = ('rtype_name`) 0;
for (n = 0; n < count; n++)
- s += abase[n*axstride] * bbase_y[n];
- dest[y*rystride] = s;
+ s += GFC_DESCRIPTOR1_ELEM (a, n) * bbase_y[n];
+ ARRAY_ELEM_AT_OFFSET (dest, y * rystride_bytes) = s;
}
}
}
@@ -513,26 +528,27 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
for (y = 0; y < ycount; y++)
{
- bbase_y = &bbase[y*bystride];
+ bbase_y = PTR_ADD_OFFSET (bbase, y * bystride_bytes);
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)
+ * ARRAY_ELEM_AT_OFFSET (bbase_y, n * bxstride_bytes);
+ 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
{
@@ -543,15 +559,16 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
for (y = 0; y < ycount; y++)
{
- bbase_y = &bbase[y*bystride];
- dest_y = &dest[y*rystride];
+ bbase_y = PTR_ADD_OFFSET (bbase, y * bystride_bytes);
+ dest_y = PTR_ADD_OFFSET (dest, y * rystride_bytes);
for (x = 0; x < xcount; x++)
{
- abase_x = &abase[x*axstride];
+ abase_x = PTR_ADD_OFFSET (abase, x * axstride_bytes);
s = ('rtype_name`) 0;
for (n = 0; n < count; n++)
- s += abase_x[n*aystride] * bbase_y[n*bxstride];
- dest_y[x*rxstride] = s;
+ s += ARRAY_ELEM_AT_OFFSET (abase_x, n * aystride_bytes)
+ * ARRAY_ELEM_AT_OFFSET (bbase_y, n * bxstride_bytes);
+ ARRAY_ELEM_AT_OFFSET (dest_y, x * rxstride_bytes) = s;
}
}
}
diff --git a/libgfortran/m4/maxloc0.m4 b/libgfortran/m4/maxloc0.m4
index 041965e2ef21..ce5cc0b88cef 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;
}
PTR_INCREMENT_BYTES (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;
}
PTR_INCREMENT_BYTES (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;
}
PTR_INCREMENT_BYTES (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 20f8f989f046..6def7dc86fa7 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 = ('atype_name`*) (((char*)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 6dd99a519c90..23b668ac9937 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;
}
PTR_INCREMENT_BYTES (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;
}
PTR_INCREMENT_BYTES (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;
}
PTR_INCREMENT_BYTES (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 2d1a14814648..65a200664c62 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 accbbfcd4b98..abbcd2e92700 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 = sizeof ('rtype_name`);
- sptr = (const 'rtype_name` *) (((char*)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 9519fc4d2e80..acf3df3fcba2 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;
@@ -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 ;
}
}
More information about the Gcc-cvs
mailing list