https://gcc.gnu.org/g:b7e2c9737eaefc05c5ee9919b9ec690b908c52a2
commit b7e2c9737eaefc05c5ee9919b9ec690b908c52a2 Author: Mikael Morin <mik...@gcc.gnu.org> Date: Sun Sep 14 21:38:56 2025 +0200 Extraction ARRAY_ELEM_AT_OFFSET, PTR_ADD_OFFSET Modification definition macros Diff: --- libgfortran/intrinsics/reduce.c | 44 ++++++++++++++++----------- libgfortran/intrinsics/reshape_generic.c | 31 +++++++++---------- libgfortran/libgfortran.h | 25 ++++++++-------- libgfortran/m4/cshift0.m4 | 2 +- libgfortran/m4/cshift1.m4 | 2 +- libgfortran/m4/cshift1a.m4 | 2 +- libgfortran/m4/ifindloc1.m4 | 4 +-- libgfortran/m4/matmul_internal.m4 | 51 ++++++++++++++++++-------------- 8 files changed, 85 insertions(+), 76 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 4d15ce100fb8..046537a25fc3 100644 --- a/libgfortran/intrinsics/reshape_generic.c +++ b/libgfortran/intrinsics/reshape_generic.c @@ -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) { @@ -202,7 +202,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, } } - rsize = 1; + rsize = GFC_DESCRIPTOR_SIZE (ret); for (n = 0; n < rdim; n++) { if (order) @@ -211,7 +211,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, 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/libgfortran.h b/libgfortran/libgfortran.h index 0e523bb6d60c..5cdd564ab0e6 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -587,27 +587,26 @@ typedef GFC_FULL_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_full_a #define PTR_ADD_OFFSET(ptr,bytes) ((typeof (ptr)) (((char*) ptr) + (bytes))) -#define GFC_DESCRIPTOR_DIM_INDEX_OFFSET(descr, dim, idx) \ - ((idx) * GFC_DESCRIPTOR_STRIDE ((descr), (dim))) -#define GFC_DESCRIPTOR1_INDEX(descr, idx) \ - (GFC_DESCRIPTOR_DIM_INDEX_OFFSET((descr), 0, (idx))) -#define GFC_DESCRIPTOR1_ELEM(descr, idx) \ - (descr)->base_addr[GFC_DESCRIPTOR1_INDEX((descr), (idx))] +#define 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) \ - (&GFC_DESCRIPTOR1_ELEM((descr), (idx))) -#define GFC_DESCRIPTOR2_INDEX(descr, idx1, idx2) \ - (GFC_DESCRIPTOR_DIM_INDEX_OFFSET((descr), 0, (idx1)) \ - + GFC_DESCRIPTOR_DIM_INDEX_OFFSET((descr), 1, (idx2))) -#define GFC_DESCRIPTOR2_ELEM(descr, idx1, idx2) \ - (descr)->base_addr[GFC_DESCRIPTOR2_INDEX((descr),(idx1),(idx2))] + 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) \ - (&GFC_DESCRIPTOR2_ELEM((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 = (typeof (ptr)) (((char*) ptr) + (bytes)) #define PTR_DECREMENT_BYTES(ptr,bytes) ptr = (typeof (ptr)) (((char*) ptr) - (bytes)) + /* Generic vtab structure. */ typedef struct { 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/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/matmul_internal.m4 b/libgfortran/m4/matmul_internal.m4 index d41a27110151..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,25 +231,22 @@ 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; #define A_ARRAY_ELEM(i,j) \ - a[(i) + (j) * a_dim1] + (ARRAY_ELEM_AT_OFFSET (abase, (i) * sizeof ('rtype_name`) + (j) * aystride_bytes)) #define B_ARRAY_ELEM(i,j) \ - b[(i) + (j) * b_dim1] + (ARRAY_ELEM_AT_OFFSET (bbase, (i) * sizeof ('rtype_name`) + (j) * bystride_bytes)) #define C_ARRAY_ELEM(i,j) \ - c[(i) + (j) * c_dim1] + (ARRAY_ELEM_AT_OFFSET (c, (i) * sizeof ('rtype_name`) + (j) * rystride_bytes)) - /* Empty c first. */ + /* Empty result first. */ for (j=0; j<n; j++) for (i=0; i<m; i++) C_ARRAY_ELEM (i, j) = ('rtype_name`)0; @@ -491,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]; @@ -510,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 += GFC_DESCRIPTOR1_ELEM (a, n) * bbase_y[n]; - dest[y*rystride] = s; + ARRAY_ELEM_AT_OFFSET (dest, y * rystride_bytes) = s; } } } @@ -525,10 +528,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 += GFC_DESCRIPTOR1_ELEM (a, n) * bbase_y[n*bxstride]; + s += GFC_DESCRIPTOR1_ELEM (a, n) + * ARRAY_ELEM_AT_OFFSET (bbase_y, n * bxstride_bytes); GFC_DESCRIPTOR1_ELEM (retarray, y) = s; } } @@ -555,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; } } }