https://gcc.gnu.org/g:6eb9f4266d044248faff2c005a4d6dd7b150b5d4
commit 6eb9f4266d044248faff2c005a4d6dd7b150b5d4 Author: Mikael Morin <[email protected]> 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 ; } }
