This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch, partial, fortran-dev] Macroize array descriptor accesses in the library
- From: Thomas Koenig <tkoenig at netcologne dot de>
- To: fortran at gcc dot gnu dot org
- Cc: gcc-patches at gcc dot gnu dot org
- Date: Sat, 11 Apr 2009 18:49:31 +0200
- Subject: [patch, partial, fortran-dev] Macroize array descriptor accesses in the library
Hello world,
this is a partial take on macroizing the array descriptor accesses in
the library. Regression-tested on i686-pc-linux-gnu.
If possible, I would like to have a review and to commit to the
fortran-dev branch now, because
- I would like some more input on the approach
- Introducing this in parts will make it easier to spot any regressions
- I might not have the time to implement all (array descriptor access
is done in *lots* of places in the library), and I would like a
template in place so somebody else can do parts
OK for the branch? I promise I'll add a ChangeLog.dev entry, too :-)
Thomas
Index: runtime/in_pack_generic.c
===================================================================
--- runtime/in_pack_generic.c (revision 145559)
+++ runtime/in_pack_generic.c (working copy)
@@ -152,8 +152,8 @@ internal_pack (gfc_array_char * source)
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = source->dim[n].stride;
- extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (extent[n] <= 0)
{
/* Do nothing. */
Index: runtime/in_unpack_generic.c
===================================================================
--- runtime/in_unpack_generic.c (revision 145559)
+++ runtime/in_unpack_generic.c (working copy)
@@ -175,8 +175,8 @@ internal_unpack (gfc_array_char * d, con
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = d->dim[n].stride;
- extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
if (extent[n] <= 0)
return;
Index: intrinsics/dtime.c
===================================================================
--- intrinsics/dtime.c (revision 145559)
+++ intrinsics/dtime.c (working copy)
@@ -47,7 +47,7 @@ dtime_sub (gfc_array_r4 *t, GFC_REAL_4 *
GFC_REAL_4 *tp;
long user_sec, user_usec, system_sec, system_usec;
- if (((t->dim[0].ubound + 1 - t->dim[0].lbound)) < 2)
+ if (GFC_DESCRIPTOR_EXTENT(t,0) < 2)
runtime_error ("Insufficient number of elements in TARRAY.");
__gthread_mutex_lock (&dtime_update_lock);
@@ -67,7 +67,7 @@ dtime_sub (gfc_array_r4 *t, GFC_REAL_4 *
tp = t->data;
*tp = tu;
- tp += t->dim[0].stride;
+ tp += GFC_DESCRIPTOR_STRIDE(t,0);
*tp = ts;
*result = tt;
__gthread_mutex_unlock (&dtime_update_lock);
Index: intrinsics/cshift0.c
===================================================================
--- intrinsics/cshift0.c (revision 145559)
+++ intrinsics/cshift0.c (working copy)
@@ -35,7 +35,7 @@ Boston, MA 02110-1301, USA. */
static void
cshift0 (gfc_array_char * ret, const gfc_array_char * array,
- ssize_t shift, int which, index_type size)
+ ssize_t shift, int which)
{
/* r.* indicates the return array. */
index_type rstride[GFC_MAX_DIMENSIONS];
@@ -57,11 +57,13 @@ cshift0 (gfc_array_char * ret, const gfc
index_type arraysize;
index_type type_size;
+ index_type size;
if (which < 1 || which > GFC_DESCRIPTOR_RANK (array))
runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'");
arraysize = size0 ((array_t *) array);
+ size = GFC_DESCRIPTOR_SIZE(array);
if (ret->data == NULL)
{
@@ -71,14 +73,17 @@ cshift0 (gfc_array_char * ret, const gfc
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
- ret->dim[i].lbound = 0;
- ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+ index_type ub, str;
+
+ ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
if (i == 0)
- ret->dim[i].stride = 1;
+ str = 1;
else
- ret->dim[i].stride = (ret->dim[i-1].ubound + 1)
- * ret->dim[i-1].stride;
+ str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
+ * GFC_DESCRIPTOR_STRIDE(ret,i-1);
+
+ GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
}
if (arraysize > 0)
@@ -283,20 +288,20 @@ cshift0 (gfc_array_char * ret, const gfc
{
if (dim == which)
{
- roffset = ret->dim[dim].stride * size;
+ roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
if (roffset == 0)
roffset = size;
- soffset = array->dim[dim].stride * size;
+ soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
if (soffset == 0)
soffset = size;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride * size;
- sstride[n] = array->dim[dim].stride * size;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
n++;
}
}
@@ -389,8 +394,7 @@ cshift0 (gfc_array_char * ret, const gfc
cshift0_##N (gfc_array_char *ret, const gfc_array_char *array, \
const GFC_INTEGER_##N *pshift, const GFC_INTEGER_##N *pdim) \
{ \
- cshift0 (ret, array, *pshift, pdim ? *pdim : 1, \
- GFC_DESCRIPTOR_SIZE (array)); \
+ cshift0 (ret, array, *pshift, pdim ? *pdim : 1); \
} \
\
extern void cshift0_##N##_char (gfc_array_char *, GFC_INTEGER_4, \
@@ -405,9 +409,9 @@ cshift0 (gfc_array_char * ret, const gfc
const gfc_array_char *array, \
const GFC_INTEGER_##N *pshift, \
const GFC_INTEGER_##N *pdim, \
- GFC_INTEGER_4 array_length) \
+ GFC_INTEGER_4 array_length __attribute__((unused))) \
{ \
- cshift0 (ret, array, *pshift, pdim ? *pdim : 1, array_length); \
+ cshift0 (ret, array, *pshift, pdim ? *pdim : 1); \
} \
\
extern void cshift0_##N##_char4 (gfc_array_char *, GFC_INTEGER_4, \
@@ -422,10 +426,9 @@ cshift0 (gfc_array_char * ret, const gfc
const gfc_array_char *array, \
const GFC_INTEGER_##N *pshift, \
const GFC_INTEGER_##N *pdim, \
- GFC_INTEGER_4 array_length) \
+ GFC_INTEGER_4 array_length __attribute__((unused))) \
{ \
- cshift0 (ret, array, *pshift, pdim ? *pdim : 1, \
- array_length * sizeof (gfc_char4_t)); \
+ cshift0 (ret, array, *pshift, pdim ? *pdim : 1); \
}
DEFINE_CSHIFT (1);
Index: intrinsics/etime.c
===================================================================
--- intrinsics/etime.c (revision 145559)
+++ intrinsics/etime.c (working copy)
@@ -40,7 +40,7 @@ etime_sub (gfc_array_r4 *t, GFC_REAL_4 *
GFC_REAL_4 tu, ts, tt, *tp;
long user_sec, user_usec, system_sec, system_usec;
- if (((t->dim[0].ubound + 1 - t->dim[0].lbound)) < 2)
+ if (GFC_DESCRIPTOR_EXTENT(t,0) < 2)
runtime_error ("Insufficient number of elements in TARRAY.");
if (__time_1 (&user_sec, &user_usec, &system_sec, &system_usec) == 0)
@@ -59,7 +59,7 @@ etime_sub (gfc_array_r4 *t, GFC_REAL_4 *
tp = t->data;
*tp = tu;
- tp += t->dim[0].stride;
+ tp += GFC_DESCRIPTOR_STRIDE(t,0);
*tp = ts;
*result = tt;
}
Index: intrinsics/stat.c
===================================================================
--- intrinsics/stat.c (revision 145559)
+++ intrinsics/stat.c (working copy)
@@ -71,7 +71,7 @@ stat_i4_sub_0 (char *name, gfc_array_i4
runtime_error ("Array rank of SARRAY is not 1.");
/* If the array is too small, abort. */
- if (sarray->dim[0].ubound + 1 - sarray->dim[0].lbound < 13)
+ if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13)
runtime_error ("Array size of SARRAY is too small.");
/* Trim trailing spaces from name. */
@@ -93,55 +93,57 @@ stat_i4_sub_0 (char *name, gfc_array_i4
if (val == 0)
{
+ index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0);
+
/* Device ID */
- sarray->data[0 * sarray->dim[0].stride] = sb.st_dev;
+ sarray->data[0 * stride] = sb.st_dev;
/* Inode number */
- sarray->data[1 * sarray->dim[0].stride] = sb.st_ino;
+ sarray->data[1 * stride] = sb.st_ino;
/* File mode */
- sarray->data[2 * sarray->dim[0].stride] = sb.st_mode;
+ sarray->data[2 * stride] = sb.st_mode;
/* Number of (hard) links */
- sarray->data[3 * sarray->dim[0].stride] = sb.st_nlink;
+ sarray->data[3 * stride] = sb.st_nlink;
/* Owner's uid */
- sarray->data[4 * sarray->dim[0].stride] = sb.st_uid;
+ sarray->data[4 * stride] = sb.st_uid;
/* Owner's gid */
- sarray->data[5 * sarray->dim[0].stride] = sb.st_gid;
+ sarray->data[5 * stride] = sb.st_gid;
/* ID of device containing directory entry for file (0 if not available) */
#if HAVE_STRUCT_STAT_ST_RDEV
- sarray->data[6 * sarray->dim[0].stride] = sb.st_rdev;
+ sarray->data[6 * stride] = sb.st_rdev;
#else
- sarray->data[6 * sarray->dim[0].stride] = 0;
+ sarray->data[6 * stride] = 0;
#endif
/* File size (bytes) */
- sarray->data[7 * sarray->dim[0].stride] = sb.st_size;
+ sarray->data[7 * stride] = sb.st_size;
/* Last access time */
- sarray->data[8 * sarray->dim[0].stride] = sb.st_atime;
+ sarray->data[8 * stride] = sb.st_atime;
/* Last modification time */
- sarray->data[9 * sarray->dim[0].stride] = sb.st_mtime;
+ sarray->data[9 * stride] = sb.st_mtime;
/* Last file status change time */
- sarray->data[10 * sarray->dim[0].stride] = sb.st_ctime;
+ sarray->data[10 * stride] = sb.st_ctime;
/* Preferred I/O block size (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLKSIZE
- sarray->data[11 * sarray->dim[0].stride] = sb.st_blksize;
+ sarray->data[11 * stride] = sb.st_blksize;
#else
- sarray->data[11 * sarray->dim[0].stride] = -1;
+ sarray->data[11 * stride] = -1;
#endif
/* Number of blocks allocated (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLOCKS
- sarray->data[12 * sarray->dim[0].stride] = sb.st_blocks;
+ sarray->data[12 * stride] = sb.st_blocks;
#else
- sarray->data[12 * sarray->dim[0].stride] = -1;
+ sarray->data[12 * stride] = -1;
#endif
}
@@ -190,7 +192,7 @@ stat_i8_sub_0 (char *name, gfc_array_i8
runtime_error ("Array rank of SARRAY is not 1.");
/* If the array is too small, abort. */
- if (sarray->dim[0].ubound + 1 - sarray->dim[0].lbound < 13)
+ if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13)
runtime_error ("Array size of SARRAY is too small.");
/* Trim trailing spaces from name. */
@@ -212,55 +214,57 @@ stat_i8_sub_0 (char *name, gfc_array_i8
if (val == 0)
{
+ index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0);
+
/* Device ID */
sarray->data[0] = sb.st_dev;
/* Inode number */
- sarray->data[sarray->dim[0].stride] = sb.st_ino;
+ sarray->data[stride] = sb.st_ino;
/* File mode */
- sarray->data[2 * sarray->dim[0].stride] = sb.st_mode;
+ sarray->data[2 * stride] = sb.st_mode;
/* Number of (hard) links */
- sarray->data[3 * sarray->dim[0].stride] = sb.st_nlink;
+ sarray->data[3 * stride] = sb.st_nlink;
/* Owner's uid */
- sarray->data[4 * sarray->dim[0].stride] = sb.st_uid;
+ sarray->data[4 * stride] = sb.st_uid;
/* Owner's gid */
- sarray->data[5 * sarray->dim[0].stride] = sb.st_gid;
+ sarray->data[5 * stride] = sb.st_gid;
/* ID of device containing directory entry for file (0 if not available) */
#if HAVE_STRUCT_STAT_ST_RDEV
- sarray->data[6 * sarray->dim[0].stride] = sb.st_rdev;
+ sarray->data[6 * stride] = sb.st_rdev;
#else
- sarray->data[6 * sarray->dim[0].stride] = 0;
+ sarray->data[6 * stride] = 0;
#endif
/* File size (bytes) */
- sarray->data[7 * sarray->dim[0].stride] = sb.st_size;
+ sarray->data[7 * stride] = sb.st_size;
/* Last access time */
- sarray->data[8 * sarray->dim[0].stride] = sb.st_atime;
+ sarray->data[8 * stride] = sb.st_atime;
/* Last modification time */
- sarray->data[9 * sarray->dim[0].stride] = sb.st_mtime;
+ sarray->data[9 * stride] = sb.st_mtime;
/* Last file status change time */
- sarray->data[10 * sarray->dim[0].stride] = sb.st_ctime;
+ sarray->data[10 * stride] = sb.st_ctime;
/* Preferred I/O block size (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLKSIZE
- sarray->data[11 * sarray->dim[0].stride] = sb.st_blksize;
+ sarray->data[11 * stride] = sb.st_blksize;
#else
- sarray->data[11 * sarray->dim[0].stride] = -1;
+ sarray->data[11 * stride] = -1;
#endif
/* Number of blocks allocated (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLOCKS
- sarray->data[12 * sarray->dim[0].stride] = sb.st_blocks;
+ sarray->data[12 * stride] = sb.st_blocks;
#else
- sarray->data[12 * sarray->dim[0].stride] = -1;
+ sarray->data[12 * stride] = -1;
#endif
}
@@ -381,7 +385,7 @@ fstat_i4_sub (GFC_INTEGER_4 *unit, gfc_a
runtime_error ("Array rank of SARRAY is not 1.");
/* If the array is too small, abort. */
- if (sarray->dim[0].ubound + 1 - sarray->dim[0].lbound < 13)
+ if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13)
runtime_error ("Array size of SARRAY is too small.");
/* Convert Fortran unit number to C file descriptor. */
@@ -391,55 +395,57 @@ fstat_i4_sub (GFC_INTEGER_4 *unit, gfc_a
if (val == 0)
{
+ index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0);
+
/* Device ID */
- sarray->data[0 * sarray->dim[0].stride] = sb.st_dev;
+ sarray->data[0 * stride] = sb.st_dev;
/* Inode number */
- sarray->data[1 * sarray->dim[0].stride] = sb.st_ino;
+ sarray->data[1 * stride] = sb.st_ino;
/* File mode */
- sarray->data[2 * sarray->dim[0].stride] = sb.st_mode;
+ sarray->data[2 * stride] = sb.st_mode;
/* Number of (hard) links */
- sarray->data[3 * sarray->dim[0].stride] = sb.st_nlink;
+ sarray->data[3 * stride] = sb.st_nlink;
/* Owner's uid */
- sarray->data[4 * sarray->dim[0].stride] = sb.st_uid;
+ sarray->data[4 * stride] = sb.st_uid;
/* Owner's gid */
- sarray->data[5 * sarray->dim[0].stride] = sb.st_gid;
+ sarray->data[5 * stride] = sb.st_gid;
/* ID of device containing directory entry for file (0 if not available) */
#if HAVE_STRUCT_STAT_ST_RDEV
- sarray->data[6 * sarray->dim[0].stride] = sb.st_rdev;
+ sarray->data[6 * stride] = sb.st_rdev;
#else
- sarray->data[6 * sarray->dim[0].stride] = 0;
+ sarray->data[6 * stride] = 0;
#endif
/* File size (bytes) */
- sarray->data[7 * sarray->dim[0].stride] = sb.st_size;
+ sarray->data[7 * stride] = sb.st_size;
/* Last access time */
- sarray->data[8 * sarray->dim[0].stride] = sb.st_atime;
+ sarray->data[8 * stride] = sb.st_atime;
/* Last modification time */
- sarray->data[9 * sarray->dim[0].stride] = sb.st_mtime;
+ sarray->data[9 * stride] = sb.st_mtime;
/* Last file status change time */
- sarray->data[10 * sarray->dim[0].stride] = sb.st_ctime;
+ sarray->data[10 * stride] = sb.st_ctime;
/* Preferred I/O block size (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLKSIZE
- sarray->data[11 * sarray->dim[0].stride] = sb.st_blksize;
+ sarray->data[11 * stride] = sb.st_blksize;
#else
- sarray->data[11 * sarray->dim[0].stride] = -1;
+ sarray->data[11 * stride] = -1;
#endif
/* Number of blocks allocated (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLOCKS
- sarray->data[12 * sarray->dim[0].stride] = sb.st_blocks;
+ sarray->data[12 * stride] = sb.st_blocks;
#else
- sarray->data[12 * sarray->dim[0].stride] = -1;
+ sarray->data[12 * stride] = -1;
#endif
}
@@ -462,7 +468,7 @@ fstat_i8_sub (GFC_INTEGER_8 *unit, gfc_a
runtime_error ("Array rank of SARRAY is not 1.");
/* If the array is too small, abort. */
- if (sarray->dim[0].ubound + 1 - sarray->dim[0].lbound < 13)
+ if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13)
runtime_error ("Array size of SARRAY is too small.");
/* Convert Fortran unit number to C file descriptor. */
@@ -472,55 +478,57 @@ fstat_i8_sub (GFC_INTEGER_8 *unit, gfc_a
if (val == 0)
{
+ index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0);
+
/* Device ID */
sarray->data[0] = sb.st_dev;
/* Inode number */
- sarray->data[sarray->dim[0].stride] = sb.st_ino;
+ sarray->data[stride] = sb.st_ino;
/* File mode */
- sarray->data[2 * sarray->dim[0].stride] = sb.st_mode;
+ sarray->data[2 * stride] = sb.st_mode;
/* Number of (hard) links */
- sarray->data[3 * sarray->dim[0].stride] = sb.st_nlink;
+ sarray->data[3 * stride] = sb.st_nlink;
/* Owner's uid */
- sarray->data[4 * sarray->dim[0].stride] = sb.st_uid;
+ sarray->data[4 * stride] = sb.st_uid;
/* Owner's gid */
- sarray->data[5 * sarray->dim[0].stride] = sb.st_gid;
+ sarray->data[5 * stride] = sb.st_gid;
/* ID of device containing directory entry for file (0 if not available) */
#if HAVE_STRUCT_STAT_ST_RDEV
- sarray->data[6 * sarray->dim[0].stride] = sb.st_rdev;
+ sarray->data[6 * stride] = sb.st_rdev;
#else
- sarray->data[6 * sarray->dim[0].stride] = 0;
+ sarray->data[6 * stride] = 0;
#endif
/* File size (bytes) */
- sarray->data[7 * sarray->dim[0].stride] = sb.st_size;
+ sarray->data[7 * stride] = sb.st_size;
/* Last access time */
- sarray->data[8 * sarray->dim[0].stride] = sb.st_atime;
+ sarray->data[8 * stride] = sb.st_atime;
/* Last modification time */
- sarray->data[9 * sarray->dim[0].stride] = sb.st_mtime;
+ sarray->data[9 * stride] = sb.st_mtime;
/* Last file status change time */
- sarray->data[10 * sarray->dim[0].stride] = sb.st_ctime;
+ sarray->data[10 * stride] = sb.st_ctime;
/* Preferred I/O block size (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLKSIZE
- sarray->data[11 * sarray->dim[0].stride] = sb.st_blksize;
+ sarray->data[11 * stride] = sb.st_blksize;
#else
- sarray->data[11 * sarray->dim[0].stride] = -1;
+ sarray->data[11 * stride] = -1;
#endif
/* Number of blocks allocated (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLOCKS
- sarray->data[12 * sarray->dim[0].stride] = sb.st_blocks;
+ sarray->data[12 * stride] = sb.st_blocks;
#else
- sarray->data[12 * sarray->dim[0].stride] = -1;
+ sarray->data[12 * stride] = -1;
#endif
}
Index: intrinsics/date_and_time.c
===================================================================
--- intrinsics/date_and_time.c (revision 145559)
+++ intrinsics/date_and_time.c (working copy)
@@ -245,8 +245,8 @@ date_and_time (char *__date, char *__tim
size_t len, delta, elt_size;
elt_size = GFC_DESCRIPTOR_SIZE (__values);
- len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
- delta = __values->dim[0].stride;
+ len = GFC_DESCRIPTOR_EXTENT(__values,0);
+ delta = GFC_DESCRIPTOR_STRIDE(__values,0);
if (delta == 0)
delta = 1;
@@ -331,9 +331,7 @@ secnds (GFC_REAL_4 *x)
& GFC_DTYPE_TYPE_MASK) +
(4 << GFC_DTYPE_SIZE_SHIFT);
- avalues->dim[0].ubound = 7;
- avalues->dim[0].lbound = 0;
- avalues->dim[0].stride = 1;
+ GFC_DIMENSION_SET(avalues->dim[0], 0, 7, 1);
date_and_time (NULL, NULL, NULL, avalues, 0, 0, 0);
@@ -391,9 +389,9 @@ itime_i4 (gfc_array_i4 *__values)
itime0(x);
/* Copy the value into the array. */
- len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(__values,0);
assert (len >= 3);
- delta = __values->dim[0].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(__values,0);
if (delta == 0)
delta = 1;
@@ -417,9 +415,9 @@ itime_i8 (gfc_array_i8 *__values)
itime0(x);
/* Copy the value into the array. */
- len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(__values,0);
assert (len >= 3);
- delta = __values->dim[0].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(__values,0);
if (delta == 0)
delta = 1;
@@ -473,9 +471,9 @@ idate_i4 (gfc_array_i4 *__values)
idate0(x);
/* Copy the value into the array. */
- len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(__values,0);
assert (len >= 3);
- delta = __values->dim[0].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(__values,0);
if (delta == 0)
delta = 1;
@@ -499,9 +497,9 @@ idate_i8 (gfc_array_i8 *__values)
idate0(x);
/* Copy the value into the array. */
- len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(__values,0);
assert (len >= 3);
- delta = __values->dim[0].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(__values,0);
if (delta == 0)
delta = 1;
@@ -563,9 +561,9 @@ gmtime_i4 (GFC_INTEGER_4 * t, gfc_array_
gmtime_0(&tt, x);
/* Copy the values into the array. */
- len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(tarray,0);
assert (len >= 9);
- delta = tarray->dim[0].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(tarray,0);
if (delta == 0)
delta = 1;
@@ -590,9 +588,9 @@ gmtime_i8 (GFC_INTEGER_8 * t, gfc_array_
gmtime_0(&tt, x);
/* Copy the values into the array. */
- len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(tarray,0);
assert (len >= 9);
- delta = tarray->dim[0].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(tarray,0);
if (delta == 0)
delta = 1;
@@ -655,9 +653,9 @@ ltime_i4 (GFC_INTEGER_4 * t, gfc_array_i
ltime_0(&tt, x);
/* Copy the values into the array. */
- len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(tarray,0);
assert (len >= 9);
- delta = tarray->dim[0].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(tarray,0);
if (delta == 0)
delta = 1;
@@ -682,9 +680,9 @@ ltime_i8 (GFC_INTEGER_8 * t, gfc_array_i
ltime_0(&tt, x);
/* Copy the values into the array. */
- len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(tarray,0);
assert (len >= 9);
- delta = tarray->dim[0].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(tarray,0);
if (delta == 0)
delta = 1;
Index: intrinsics/associated.c
===================================================================
--- intrinsics/associated.c (revision 145559)
+++ intrinsics/associated.c (working copy)
@@ -48,14 +48,14 @@ associated (const gfc_array_void *pointe
rank = GFC_DESCRIPTOR_RANK (pointer);
for (n = 0; n < rank; n++)
{
- long diff;
- diff = pointer->dim[n].ubound - pointer->dim[n].lbound;
+ long extent;
+ extent = GFC_DESCRIPTOR_EXTENT(pointer,n);
- if (diff != (target->dim[n].ubound - target->dim[n].lbound))
+ if (extent != GFC_DESCRIPTOR_EXTENT(target,n))
return 0;
- if (pointer->dim[n].stride != target->dim[n].stride && diff != 0)
+ if (GFC_DESCRIPTOR_STRIDE(pointer,n) != GFC_DESCRIPTOR_STRIDE(target,n) && extent != 1)
return 0;
- if (pointer->dim[n].ubound < pointer->dim[n].lbound)
+ if (extent <= 0)
return 0;
}
Index: intrinsics/eoshift0.c
===================================================================
--- intrinsics/eoshift0.c (revision 145559)
+++ intrinsics/eoshift0.c (working copy)
@@ -75,13 +75,18 @@ eoshift0 (gfc_array_char * ret, const gf
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
- ret->dim[i].lbound = 0;
- ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+ index_type ub, str;
+
+ ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
if (i == 0)
- ret->dim[i].stride = 1;
+ str = 1;
else
- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+ str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
+ * GFC_DESCRIPTOR_STRIDE(ret,i-1);
+
+ GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
+
}
}
else
@@ -107,14 +112,14 @@ eoshift0 (gfc_array_char * ret, const gf
soffset = array->dim[dim].stride * size;
if (soffset == 0)
soffset = size;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride * size;
- sstride[n] = array->dim[dim].stride * size;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
n++;
}
}
Index: intrinsics/size.c
===================================================================
--- intrinsics/size.c (revision 145559)
+++ intrinsics/size.c (working copy)
@@ -40,7 +40,7 @@ size0 (const array_t * array)
size = 1;
for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++)
{
- len = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,n);
if (len < 0)
len = 0;
size *= len;
@@ -59,7 +59,7 @@ size1 (const array_t * array, index_type
dim--;
- size = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ size = GFC_DESCRIPTOR_EXTENT(array,dim);
if (size < 0)
size = 0;
return size;
Index: intrinsics/random.c
===================================================================
--- intrinsics/random.c (revision 145559)
+++ intrinsics/random.c (working copy)
@@ -379,8 +379,8 @@ arandom_r4 (gfc_array_r4 *x)
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = x->dim[n].stride;
- extent[n] = x->dim[n].ubound + 1 - x->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(x,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(x,n);
if (extent[n] <= 0)
return;
}
@@ -446,8 +446,8 @@ arandom_r8 (gfc_array_r8 *x)
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = x->dim[n].stride;
- extent[n] = x->dim[n].ubound + 1 - x->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(x,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(x,n);
if (extent[n] <= 0)
return;
}
@@ -516,8 +516,8 @@ arandom_r10 (gfc_array_r10 *x)
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = x->dim[n].stride;
- extent[n] = x->dim[n].ubound + 1 - x->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(x,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(x,n);
if (extent[n] <= 0)
return;
}
@@ -588,8 +588,8 @@ arandom_r16 (gfc_array_r16 *x)
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = x->dim[n].stride;
- extent[n] = x->dim[n].ubound + 1 - x->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(x,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(x,n);
if (extent[n] <= 0)
return;
}
@@ -695,13 +695,13 @@ random_seed_i4 (GFC_INTEGER_4 *size, gfc
runtime_error ("Array rank of PUT is not 1.");
/* If the array is too small, abort. */
- if (((put->dim[0].ubound + 1 - put->dim[0].lbound)) < kiss_size)
+ if (GFC_DESCRIPTOR_EXTENT(put,0) < kiss_size)
runtime_error ("Array size of PUT is too small.");
/* We copy the seed given by the user. */
for (i = 0; i < kiss_size; i++)
memcpy (seed + i * sizeof(GFC_UINTEGER_4),
- &(put->data[(kiss_size - 1 - i) * put->dim[0].stride]),
+ &(put->data[(kiss_size - 1 - i) * GFC_DESCRIPTOR_STRIDE(put,0)]),
sizeof(GFC_UINTEGER_4));
/* We put it after scrambling the bytes, to paper around users who
@@ -717,7 +717,7 @@ random_seed_i4 (GFC_INTEGER_4 *size, gfc
runtime_error ("Array rank of GET is not 1.");
/* If the array is too small, abort. */
- if (((get->dim[0].ubound + 1 - get->dim[0].lbound)) < kiss_size)
+ if (GFC_DESCRIPTOR_EXTENT(get,0) < kiss_size)
runtime_error ("Array size of GET is too small.");
/* Unscramble the seed. */
@@ -725,7 +725,7 @@ random_seed_i4 (GFC_INTEGER_4 *size, gfc
/* Then copy it back to the user variable. */
for (i = 0; i < kiss_size; i++)
- memcpy (&(get->data[(kiss_size - 1 - i) * get->dim[0].stride]),
+ memcpy (&(get->data[(kiss_size - 1 - i) * GFC_DESCRIPTOR_STRIDE(get,0)]),
seed + i * sizeof(GFC_UINTEGER_4),
sizeof(GFC_UINTEGER_4));
}
@@ -762,12 +762,12 @@ random_seed_i8 (GFC_INTEGER_8 *size, gfc
runtime_error ("Array rank of PUT is not 1.");
/* If the array is too small, abort. */
- if (((put->dim[0].ubound + 1 - put->dim[0].lbound)) < kiss_size / 2)
+ if (GFC_DESCRIPTOR_EXTENT(put,0) < kiss_size / 2)
runtime_error ("Array size of PUT is too small.");
/* This code now should do correct strides. */
for (i = 0; i < kiss_size / 2; i++)
- memcpy (&kiss_seed[2*i], &(put->data[i * put->dim[0].stride]),
+ memcpy (&kiss_seed[2*i], &(put->data[i * GFC_DESCRIPTOR_STRIDE(put,0)]),
sizeof (GFC_UINTEGER_8));
}
@@ -779,12 +779,12 @@ random_seed_i8 (GFC_INTEGER_8 *size, gfc
runtime_error ("Array rank of GET is not 1.");
/* If the array is too small, abort. */
- if (((get->dim[0].ubound + 1 - get->dim[0].lbound)) < kiss_size / 2)
+ if (GFC_DESCRIPTOR_EXTENT(get,0) < kiss_size / 2)
runtime_error ("Array size of GET is too small.");
/* This code now should do correct strides. */
for (i = 0; i < kiss_size / 2; i++)
- memcpy (&(get->data[i * get->dim[0].stride]), &kiss_seed[2*i],
+ memcpy (&(get->data[i * GFC_DESCRIPTOR_STRIDE(get,0)]), &kiss_seed[2*i],
sizeof (GFC_UINTEGER_8));
}
Index: libgfortran.h
===================================================================
--- libgfortran.h (revision 145559)
+++ libgfortran.h (working copy)
@@ -305,6 +305,7 @@ typedef struct descriptor_dimension
index_type lbound;
index_type ubound;
}
+
descriptor_dimension;
#define GFC_ARRAY_DESCRIPTOR(r, type) \
@@ -357,6 +358,30 @@ typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DI
#define GFC_DESCRIPTOR_DATA(desc) ((desc)->data)
#define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype)
+#define GFC_DIMENSION_LBOUND(dim) ((dim).lbound)
+#define GFC_DIMENSION_UBOUND(dim) ((dim).ubound)
+#define GFC_DIMENSION_STRIDE(dim) ((dim).stride)
+#define GFC_DIMENSION_EXTENT(dim) ((dim).ubound + 1 - (dim).lbound)
+#define GFC_DIMENSION_SET(dim,lb,ub,str) \
+ do \
+ { \
+ (dim).lbound = lb; \
+ (dim).ubound = ub; \
+ (dim).stride = str; \
+ } while (0)
+
+
+#define GFC_DESCRIPTOR_LBOUND(desc,i) ((desc)->dim[i].lbound)
+#define GFC_DESCRIPTOR_UBOUND(desc,i) ((desc)->dim[i].ubound)
+#define GFC_DESCRIPTOR_EXTENT(desc,i) ((desc)->dim[i].ubound + 1 \
+ - (desc)->dim[i].lbound)
+#define GFC_DESCRIPTOR_EXTENT_BYTES(desc,i) \
+ (GFC_DESCRIPTOR_EXTENT(desc,i) * GFC_DESCRIPTOR_SIZE(desc))
+
+#define GFC_DESCRIPTOR_STRIDE(desc,i) ((desc)->dim[i].stride)
+#define GFC_DESCRIPTOR_STRIDE_BYTES(desc,i) \
+ (GFC_DESCRIPTOR_STRIDE(desc,i) * GFC_DESCRIPTOR_SIZE(desc))
+
/* Macros to get both the size and the type with a single masking operation */
#define GFC_DTYPE_SIZE_MASK \
Index: io/list_read.c
===================================================================
--- io/list_read.c (revision 145559)
+++ io/list_read.c (working copy)
@@ -2083,10 +2083,10 @@ nml_parse_qualifier (st_parameter_dt *dt
}
/* Check the values of the triplet indices. */
- if ((ls[dim].start > (ssize_t)ad[dim].ubound)
- || (ls[dim].start < (ssize_t)ad[dim].lbound)
- || (ls[dim].end > (ssize_t)ad[dim].ubound)
- || (ls[dim].end < (ssize_t)ad[dim].lbound))
+ if ((ls[dim].start > (ssize_t) GFC_DIMENSION_UBOUND(ad[dim]))
+ || (ls[dim].start < (ssize_t) GFC_DIMENSION_LBOUND(ad[dim]))
+ || (ls[dim].end > (ssize_t) GFC_DIMENSION_UBOUND(ad[dim]))
+ || (ls[dim].end < (ssize_t) GFC_DIMENSION_LBOUND(ad[dim])))
{
if (is_char)
sprintf (parse_err_msg, "Substring out of range");
@@ -2150,8 +2150,8 @@ nml_touch_nodes (namelist_info * nl)
for (dim=0; dim < nl->var_rank; dim++)
{
nl->ls[dim].step = 1;
- nl->ls[dim].end = nl->dim[dim].ubound;
- nl->ls[dim].start = nl->dim[dim].lbound;
+ nl->ls[dim].end = GFC_DESCRIPTOR_UBOUND(nl,dim);
+ nl->ls[dim].start = GFC_DESCRIPTOR_LBOUND(nl,dim);
nl->ls[dim].idx = nl->ls[dim].start;
}
}
@@ -2346,8 +2346,9 @@ nml_read_obj (st_parameter_dt *dtp, name
pdata = (void*)(nl->mem_pos + offset);
for (dim = 0; dim < nl->var_rank; dim++)
- pdata = (void*)(pdata + (nl->ls[dim].idx - nl->dim[dim].lbound) *
- nl->dim[dim].stride * nl->size);
+ pdata = (void*)(pdata + (nl->ls[dim].idx
+ - GFC_DESCRIPTOR_LBOUND(nl,dim))
+ * GFC_DESCRIPTOR_STRIDE(nl,dim) * nl->size);
/* Reset the error flag and try to read next value, if
dtp->u.p.repeat_count=0 */
@@ -2664,8 +2665,8 @@ get_name:
for (dim=0; dim < nl->var_rank; dim++)
{
nl->ls[dim].step = 1;
- nl->ls[dim].end = nl->dim[dim].ubound;
- nl->ls[dim].start = nl->dim[dim].lbound;
+ nl->ls[dim].end = GFC_DESCRIPTOR_UBOUND(nl,dim);
+ nl->ls[dim].start = GFC_DESCRIPTOR_LBOUND(nl,dim);
nl->ls[dim].idx = nl->ls[dim].start;
}
Index: io/transfer.c
===================================================================
--- io/transfer.c (revision 145559)
+++ io/transfer.c (working copy)
@@ -1794,7 +1794,7 @@ transfer_array (st_parameter_dt *dtp, gf
stride[n] = iotype == BT_CHARACTER ?
desc->dim[n].stride * GFC_SIZE_OF_CHAR_KIND(kind) :
desc->dim[n].stride;
- extent[n] = desc->dim[n].ubound + 1 - desc->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(desc,n);
/* If the extent of even one dimension is zero, then the entire
array section contains zero elements, so we return after writing
@@ -2504,23 +2504,24 @@ init_loop_spec (gfc_array_char *desc, ar
for (i=0; i<rank; i++)
{
- ls[i].idx = desc->dim[i].lbound;
- ls[i].start = desc->dim[i].lbound;
- ls[i].end = desc->dim[i].ubound;
- ls[i].step = desc->dim[i].stride;
- empty = empty || (desc->dim[i].ubound < desc->dim[i].lbound);
+ ls[i].idx = GFC_DESCRIPTOR_LBOUND(desc,i);
+ ls[i].start = GFC_DESCRIPTOR_LBOUND(desc,i);
+ ls[i].end = GFC_DESCRIPTOR_UBOUND(desc,i);
+ ls[i].step = GFC_DESCRIPTOR_STRIDE(desc,i);
+ empty = empty || (GFC_DESCRIPTOR_UBOUND(desc,i)
+ < GFC_DESCRIPTOR_LBOUND(desc,i));
- if (desc->dim[i].stride > 0)
+ if (GFC_DESCRIPTOR_STRIDE(desc,i) > 0)
{
- index += (desc->dim[i].ubound - desc->dim[i].lbound)
- * desc->dim[i].stride;
+ index += (GFC_DESCRIPTOR_EXTENT(desc,i) - 1)
+ * GFC_DESCRIPTOR_STRIDE(desc,i);
}
else
{
- index -= (desc->dim[i].ubound - desc->dim[i].lbound)
- * desc->dim[i].stride;
- *start_record -= (desc->dim[i].ubound - desc->dim[i].lbound)
- * desc->dim[i].stride;
+ index -= (GFC_DESCRIPTOR_EXTENT(desc,i) - 1)
+ * GFC_DESCRIPTOR_STRIDE(desc,i);
+ *start_record -= (GFC_DESCRIPTOR_EXTENT(desc,i) - 1)
+ * GFC_DESCRIPTOR_STRIDE(desc,i);
}
}
@@ -3423,9 +3424,7 @@ st_set_nml_var_dim (st_parameter_dt *dtp
for (nml = dtp->u.p.ionml; nml->next; nml = nml->next);
- nml->dim[n].stride = stride;
- nml->dim[n].lbound = lbound;
- nml->dim[n].ubound = ubound;
+ GFC_DIMENSION_SET(nml->dim[n],lbound,ubound,stride);
}
/* Reverse memcpy - used for byte swapping. */
Index: io/write.c
===================================================================
--- io/write.c (revision 145559)
+++ io/write.c (working copy)
@@ -1277,8 +1277,8 @@ nml_write_obj (st_parameter_dt *dtp, nam
nelem = 1;
for (dim_i=0; dim_i < obj->var_rank; dim_i++)
{
- obj->ls[dim_i].idx = obj->dim[dim_i].lbound;
- nelem = nelem * (obj->dim[dim_i].ubound + 1 - obj->dim[dim_i].lbound);
+ obj->ls[dim_i].idx = GFC_DESCRIPTOR_LBOUND(obj, dim_i);
+ nelem = nelem * GFC_DESCRIPTOR_EXTENT (obj, dim_i);
}
/* Main loop to output the data held in the object. */
@@ -1445,9 +1445,9 @@ obj_loop:
{
obj->ls[dim_i].idx += nml_carry ;
nml_carry = 0;
- if (obj->ls[dim_i].idx > (ssize_t)obj->dim[dim_i].ubound)
+ if (obj->ls[dim_i].idx > (ssize_t) GFC_DESCRIPTOR_UBOUND(obj,dim_i))
{
- obj->ls[dim_i].idx = obj->dim[dim_i].lbound;
+ obj->ls[dim_i].idx = GFC_DESCRIPTOR_LBOUND(obj,dim_i);
nml_carry = 1;
}
}