This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch, fortran-dev] More array access macros
- 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: Thu, 07 May 2009 19:53:48 +0200
- Subject: [patch, fortran-dev] More array access macros
Hello world,
here's the next installment of the array macro patch. With this,
everything in io/* and intrinsics/* is converted to the new macros, with
the exception of intrinsics/iso_c_binding.c, which has a style all of
its own and so needs some more thought :-)
Thanks to Jerry for un-breaking the fortran-dev branch!
Regression-tested on x86_64-unknown-linux-gnu.
OK for the branch?
Thomas
2009-05-07 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/37577
* intrinsics/pack_generic.c (pack_internal): Use array access
macros for accessing array descriptors.
(pack_s_internal): Likewise.
* intrinsics/transpose_generic.c (transpose_internal): Remove
size argument, calculate from array descriptor. Use array
access macros for accessing array descriptors.
(transpose): Remove size argument from call.
(transpoe_char): Likewise.
(transpose_char4): Likewise.
* intrinsics/move_alloc.c (move_alloc): Use array access macros
for accessing array descriptors.
* intrinsics/spread_generic.c (spread_internal): Remove size
argument, calculate from array descriptor. Use array access
macros for accessing array descriptors.
(spread_internal_scalar): Likewise.
(spread): Remove size argument from call to spread_internal.
(spread_char): Mark argument source_length as unused.
Remove size argument from call to spread_internal.
(spread_char4): Likewise.
(spread_char_scalar): Likewise.
(spread_char4_scalar): Likewise.
* intrinsics/unpack_generic.c (unpack_internal): Use array access
macros for accessing array descriptors.
* intrinsics/eoshift2.c (eoshift2): Remove size argument, calculate
from array descriptor instead. Use array access macros for
accessing array descriptors.
(eoshift2_##N): Remove size argument from call to eoshift2.
(eoshift2_##N_##char): Likewise.
(eoshift2_##N_##char4): Likewise.
* intrinsics/reshape_generic.c (reshape_internal): Use array
access macross for accessing array descriptors.
Index: intrinsics/pack_generic.c
===================================================================
--- intrinsics/pack_generic.c (revision 147240)
+++ intrinsics/pack_generic.c (working copy)
@@ -121,11 +121,11 @@
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
zero_sized = 1;
- sstride[n] = array->dim[n].stride * size;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (sstride[0] == 0)
sstride[0] = size;
@@ -141,7 +141,7 @@
{
/* The return array will have as many
elements as there are in VECTOR. */
- total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ total = GFC_DESCRIPTOR_EXTENT(vector,0);
}
else
{
@@ -204,9 +204,7 @@
if (ret->data == NULL)
{
/* Setup the array descriptor. */
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = total - 1;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1);
ret->offset = 0;
if (total == 0)
@@ -223,7 +221,7 @@
/* We come here because of range checking. */
index_type ret_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
if (total != ret_extent)
runtime_error ("Incorrect extent in return value of PACK intrinsic;"
" is %ld, should be %ld", (long int) total,
@@ -231,7 +229,7 @@
}
}
- rstride0 = ret->dim[0].stride * size;
+ rstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(ret,0);
if (rstride0 == 0)
rstride0 = size;
sstride0 = sstride[0];
@@ -280,11 +278,11 @@
/* Add any remaining elements from VECTOR. */
if (vector)
{
- n = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ n = GFC_DESCRIPTOR_EXTENT(vector,0);
nelem = ((rptr - ret->data) / rstride0);
if (n > nelem)
{
- sstride0 = vector->dim[0].stride * size;
+ sstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(vector,0);
if (sstride0 == 0)
sstride0 = size;
@@ -511,11 +509,11 @@
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
- sstride[n] = array->dim[n].stride * size;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
ssize *= extent[n];
}
if (sstride[0] == 0)
@@ -536,7 +534,7 @@
{
/* The return array will have as many elements as there are
in vector. */
- total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ total = GFC_DESCRIPTOR_EXTENT(vector,0);
if (total <= 0)
{
total = 0;
@@ -559,9 +557,8 @@
}
/* Setup the array descriptor. */
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = total - 1;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0],0,total-1,1);
+
ret->offset = 0;
if (total == 0)
@@ -573,7 +570,7 @@
ret->data = internal_malloc_size (size * total);
}
- rstride0 = ret->dim[0].stride * size;
+ rstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(ret,0);
if (rstride0 == 0)
rstride0 = size;
rptr = ret->data;
@@ -623,11 +620,11 @@
/* Add any remaining elements from VECTOR. */
if (vector)
{
- n = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ n = GFC_DESCRIPTOR_EXTENT(vector,0);
nelem = ((rptr - ret->data) / rstride0);
if (n > nelem)
{
- sstride0 = vector->dim[0].stride * size;
+ sstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(vector,0);
if (sstride0 == 0)
sstride0 = size;
Index: intrinsics/transpose_generic.c
===================================================================
--- intrinsics/transpose_generic.c (revision 147240)
+++ intrinsics/transpose_generic.c (working copy)
@@ -32,8 +32,7 @@
export_proto(transpose);
static void
-transpose_internal (gfc_array_char *ret, gfc_array_char *source,
- index_type size)
+transpose_internal (gfc_array_char *ret, gfc_array_char *source)
{
/* r.* indicates the return array. */
index_type rxstride, rystride;
@@ -44,21 +43,22 @@
index_type xcount, ycount;
index_type x, y;
+ index_type size;
assert (GFC_DESCRIPTOR_RANK (source) == 2
&& GFC_DESCRIPTOR_RANK (ret) == 2);
+ size = GFC_DESCRIPTOR_SIZE(ret);
+
if (ret->data == NULL)
{
assert (ret->dtype == source->dtype);
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1,
+ 1);
- ret->dim[1].lbound = 0;
- ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
- ret->dim[1].stride = ret->dim[0].ubound+1;
+ GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1,
+ GFC_DESCRIPTOR_EXTENT(source, 1));
ret->data = internal_malloc_size (size * size0 ((array_t*)ret));
ret->offset = 0;
@@ -67,8 +67,8 @@
{
index_type ret_extent, src_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
- src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,1);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
@@ -76,8 +76,8 @@
" should be %ld", (long int) src_extent,
(long int) ret_extent);
- ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
- src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,0);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
@@ -87,13 +87,13 @@
}
- sxstride = source->dim[0].stride * size;
- systride = source->dim[1].stride * size;
- xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
- ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ sxstride = GFC_DESCRIPTOR_STRIDE_BYTES(source,0);
+ systride = GFC_DESCRIPTOR_STRIDE_BYTES(source,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(source,0);
+ ycount = GFC_DESCRIPTOR_EXTENT(source,1);
- rxstride = ret->dim[0].stride * size;
- rystride = ret->dim[1].stride * size;
+ rxstride = GFC_DESCRIPTOR_STRIDE_BYTES(ret,0);
+ rystride = GFC_DESCRIPTOR_STRIDE_BYTES(ret,1);
rptr = ret->data;
sptr = source->data;
@@ -119,7 +119,7 @@
void
transpose (gfc_array_char *ret, gfc_array_char *source)
{
- transpose_internal (ret, source, GFC_DESCRIPTOR_SIZE (source));
+ transpose_internal (ret, source);
}
@@ -130,9 +130,10 @@
void
transpose_char (gfc_array_char *ret,
GFC_INTEGER_4 ret_length __attribute__((unused)),
- gfc_array_char *source, GFC_INTEGER_4 source_length)
+ gfc_array_char *source,
+ GFC_INTEGER_4 source_length __attribute__((unused)))
{
- transpose_internal (ret, source, source_length);
+ transpose_internal (ret, source);
}
@@ -143,7 +144,8 @@
void
transpose_char4 (gfc_array_char *ret,
GFC_INTEGER_4 ret_length __attribute__((unused)),
- gfc_array_char *source, GFC_INTEGER_4 source_length)
+ gfc_array_char *source,
+ GFC_INTEGER_4 source_length __attribute__((unused)))
{
- transpose_internal (ret, source, source_length * sizeof (gfc_char4_t));
+ transpose_internal (ret, source);
}
Index: intrinsics/move_alloc.c
===================================================================
--- intrinsics/move_alloc.c (revision 147240)
+++ intrinsics/move_alloc.c (working copy)
@@ -42,11 +42,11 @@
for (i = 0; i < GFC_DESCRIPTOR_RANK (from); i++)
{
- to->dim[i].lbound = from->dim[i].lbound;
- to->dim[i].ubound = from->dim[i].ubound;
- to->dim[i].stride = from->dim[i].stride;
- from->dim[i].stride = 0;
- from->dim[i].ubound = from->dim[i].lbound;
+ GFC_DIMENSION_SET(to->dim[i],GFC_DESCRIPTOR_LBOUND(from,i),
+ GFC_DESCRIPTOR_UBOUND(from,i),
+ GFC_DESCRIPTOR_STRIDE(from,i));
+ GFC_DIMENSION_SET(from->dim[i],GFC_DESCRIPTOR_LBOUND(from,i),
+ GFC_DESCRIPTOR_LBOUND(from,i), 0);
}
to->offset = from->offset;
Index: intrinsics/spread_generic.c
===================================================================
--- intrinsics/spread_generic.c (revision 147240)
+++ intrinsics/spread_generic.c (working copy)
@@ -30,8 +30,7 @@
static void
spread_internal (gfc_array_char *ret, const gfc_array_char *source,
- const index_type *along, const index_type *pncopies,
- index_type size)
+ const index_type *along, const index_type *pncopies)
{
/* r.* indicates the return array. */
index_type rstride[GFC_MAX_DIMENSIONS];
@@ -52,7 +51,10 @@
index_type n;
index_type dim;
index_type ncopies;
+ index_type size;
+ size = GFC_DESCRIPTOR_SIZE(source);
+
srank = GFC_DESCRIPTOR_RANK(source);
rrank = srank + 1;
@@ -68,31 +70,34 @@
{
/* The front end has signalled that we need to populate the
return array descriptor. */
+
+ size_t ub, stride;
+
ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank;
dim = 0;
rs = 1;
for (n = 0; n < rrank; n++)
{
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
+ stride = rs;
if (n == *along - 1)
{
- ret->dim[n].ubound = ncopies - 1;
+ ub = ncopies - 1;
rdelta = rs * size;
rs *= ncopies;
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
- sstride[dim] = source->dim[dim].stride * size;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(source,dim);
rstride[dim] = rs * size;
- ret->dim[n].ubound = extent[dim]-1;
+ ub = extent[dim]-1;
rs *= extent[dim];
dim++;
}
+
+ GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride);
}
ret->offset = 0;
if (rs > 0)
@@ -119,10 +124,10 @@
{
index_type ret_extent;
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (n == *along - 1)
{
- rdelta = ret->dim[n].stride * size;
+ rdelta = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n);
if (ret_extent != ncopies)
runtime_error("Incorrect extent in return value of SPREAD"
@@ -133,8 +138,7 @@
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (ret_extent != extent[dim])
runtime_error("Incorrect extent in return value of SPREAD"
" intrinsic in dimension %ld: is %ld,"
@@ -144,8 +148,8 @@
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride * size;
- rstride[dim] = ret->dim[n].stride * size;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n);
dim++;
}
}
@@ -156,17 +160,16 @@
{
if (n == *along - 1)
{
- rdelta = ret->dim[n].stride * size;
+ rdelta = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n);
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride * size;
- rstride[dim] = ret->dim[n].stride * size;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n);
dim++;
}
}
@@ -228,13 +231,15 @@
static void
spread_internal_scalar (gfc_array_char *ret, const char *source,
- const index_type *along, const index_type *pncopies,
- index_type size)
+ const index_type *along, const index_type *pncopies)
{
int n;
int ncopies = *pncopies;
char * dest;
+ size_t size;
+ size = GFC_DESCRIPTOR_SIZE(ret);
+
if (GFC_DESCRIPTOR_RANK (ret) != 1)
runtime_error ("incorrect destination rank in spread()");
@@ -245,20 +250,18 @@
{
ret->data = internal_malloc_size (ncopies * size);
ret->offset = 0;
- ret->dim[0].stride = 1;
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = ncopies - 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1);
}
else
{
- if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound)
- / ret->dim[0].stride)
+ if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1)
+ / GFC_DESCRIPTOR_STRIDE(ret,0))
runtime_error ("dim too large in spread()");
}
for (n = 0; n < ncopies; n++)
{
- dest = (char*)(ret->data + n*size*ret->dim[0].stride);
+ dest = (char*)(ret->data + n * GFC_DESCRIPTOR_STRIDE_BYTES(ret,0));
memcpy (dest , source, size);
}
}
@@ -400,7 +403,7 @@
#endif
}
- spread_internal (ret, source, along, pncopies, GFC_DESCRIPTOR_SIZE (source));
+ spread_internal (ret, source, along, pncopies);
}
@@ -413,9 +416,10 @@
spread_char (gfc_array_char *ret,
GFC_INTEGER_4 ret_length __attribute__((unused)),
const gfc_array_char *source, const index_type *along,
- const index_type *pncopies, GFC_INTEGER_4 source_length)
+ const index_type *pncopies,
+ GFC_INTEGER_4 source_length __attribute__((unused)))
{
- spread_internal (ret, source, along, pncopies, source_length);
+ spread_internal (ret, source, along, pncopies);
}
@@ -428,10 +432,10 @@
spread_char4 (gfc_array_char *ret,
GFC_INTEGER_4 ret_length __attribute__((unused)),
const gfc_array_char *source, const index_type *along,
- const index_type *pncopies, GFC_INTEGER_4 source_length)
+ const index_type *pncopies,
+ GFC_INTEGER_4 source_length __attribute__((unused)))
{
- spread_internal (ret, source, along, pncopies,
- source_length * sizeof (gfc_char4_t));
+ spread_internal (ret, source, along, pncopies);
}
@@ -577,7 +581,7 @@
#endif
}
- spread_internal_scalar (ret, source, along, pncopies, GFC_DESCRIPTOR_SIZE (ret));
+ spread_internal_scalar (ret, source, along, pncopies);
}
@@ -590,11 +594,12 @@
spread_char_scalar (gfc_array_char *ret,
GFC_INTEGER_4 ret_length __attribute__((unused)),
const char *source, const index_type *along,
- const index_type *pncopies, GFC_INTEGER_4 source_length)
+ const index_type *pncopies,
+ GFC_INTEGER_4 source_length __attribute__((unused)))
{
if (!ret->dtype)
runtime_error ("return array missing descriptor in spread()");
- spread_internal_scalar (ret, source, along, pncopies, source_length);
+ spread_internal_scalar (ret, source, along, pncopies);
}
@@ -607,11 +612,12 @@
spread_char4_scalar (gfc_array_char *ret,
GFC_INTEGER_4 ret_length __attribute__((unused)),
const char *source, const index_type *along,
- const index_type *pncopies, GFC_INTEGER_4 source_length)
+ const index_type *pncopies,
+ GFC_INTEGER_4 source_length __attribute__((unused)))
{
if (!ret->dtype)
runtime_error ("return array missing descriptor in spread()");
- spread_internal_scalar (ret, source, along, pncopies,
- source_length * sizeof (gfc_char4_t));
+ spread_internal_scalar (ret, source, along, pncopies);
+
}
Index: intrinsics/unpack_generic.c
===================================================================
--- intrinsics/unpack_generic.c (revision 147240)
+++ intrinsics/unpack_generic.c (working copy)
@@ -89,14 +89,13 @@
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride * size;
- fstride[n] = field->dim[n].stride * fsize;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret, n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(field, n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n);
rs *= extent[n];
}
ret->offset = 0;
@@ -108,11 +107,11 @@
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride * size;
- fstride[n] = field->dim[n].stride * fsize;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret, n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(field, n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n);
}
if (rstride[0] == 0)
rstride[0] = size;
@@ -126,7 +125,7 @@
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride * size;
+ vstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(vector,0);
if (vstride0 == 0)
vstride0 = size;
rstride0 = rstride[0];
Index: intrinsics/eoshift2.c
===================================================================
--- intrinsics/eoshift2.c (revision 147240)
+++ intrinsics/eoshift2.c (working copy)
@@ -34,7 +34,7 @@
static void
eoshift2 (gfc_array_char *ret, const gfc_array_char *array,
int shift, const gfc_array_char *bound, int which,
- index_type size, const char *filler, index_type filler_len)
+ const char *filler, index_type filler_len)
{
/* r.* indicates the return array. */
index_type rstride[GFC_MAX_DIMENSIONS];
@@ -59,6 +59,7 @@
index_type len;
index_type n;
index_type arraysize;
+ index_type size;
/* The compiler cannot figure out that these are set, initialize
them to avoid warnings. */
@@ -66,6 +67,8 @@
soffset = 0;
roffset = 0;
+ size = GFC_DESCRIPTOR_SIZE (array);
+
arraysize = size0 ((array_t *) array);
if (ret->data == NULL)
@@ -77,13 +80,18 @@
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,22 +115,22 @@
{
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);
if (bound)
- bstride[n] = bound->dim[n].stride * size;
+ bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n);
else
bstride[n] = 0;
n++;
@@ -256,7 +264,7 @@
const GFC_INTEGER_##N *pdim) \
{ \
eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \
- GFC_DESCRIPTOR_SIZE (array), "\0", 1); \
+ "\0", 1); \
} \
\
extern void eoshift2_##N##_char (gfc_array_char *, GFC_INTEGER_4, \
@@ -274,11 +282,11 @@
const GFC_INTEGER_##N *pshift, \
const gfc_array_char *pbound, \
const GFC_INTEGER_##N *pdim, \
- GFC_INTEGER_4 array_length, \
+ GFC_INTEGER_4 array_length __attribute__((unused)), \
GFC_INTEGER_4 bound_length __attribute__((unused))) \
{ \
eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \
- array_length, " ", 1); \
+ " ", 1); \
} \
\
extern void eoshift2_##N##_char4 (gfc_array_char *, GFC_INTEGER_4, \
@@ -296,12 +304,12 @@
const GFC_INTEGER_##N *pshift, \
const gfc_array_char *pbound, \
const GFC_INTEGER_##N *pdim, \
- GFC_INTEGER_4 array_length, \
+ GFC_INTEGER_4 array_length __attribute__((unused)), \
GFC_INTEGER_4 bound_length __attribute__((unused))) \
{ \
static const gfc_char4_t space = (unsigned char) ' '; \
eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \
- array_length * sizeof (gfc_char4_t), (const char *) &space, \
+ (const char *) &space, \
sizeof (gfc_char4_t)); \
}
Index: intrinsics/reshape_generic.c
===================================================================
--- intrinsics/reshape_generic.c (revision 147240)
+++ intrinsics/reshape_generic.c (working copy)
@@ -67,7 +67,7 @@
int sempty, pempty, shape_empty;
index_type shape_data[GFC_MAX_DIMENSIONS];
- rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+ rdim = GFC_DESCRIPTOR_EXTENT(shape,0);
if (rdim != GFC_DESCRIPTOR_RANK(ret))
runtime_error("rank of return array incorrect in RESHAPE intrinsic");
@@ -75,7 +75,7 @@
for (n = 0; n < rdim; n++)
{
- shape_data[n] = shape->data[n * shape->dim[0].stride];
+ shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)];
if (shape_data[n] <= 0)
{
shape_data[n] = 0;
@@ -85,14 +85,14 @@
if (ret->data == NULL)
{
- rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+ rdim = GFC_DESCRIPTOR_EXTENT(shape,0);
rs = 1;
for (n = 0; n < rdim; n++)
{
- ret->dim[n].lbound = 0;
rex = shape_data[n];
- ret->dim[n].ubound = rex - 1;
- ret->dim[n].stride = rs;
+
+ GFC_DIMENSION_SET(ret->dim[n],0,rex - 1,rs);
+
rs *= rex;
}
ret->offset = 0;
@@ -111,8 +111,8 @@
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
- pstride[n] = pad->dim[n].stride;
- pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
+ pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n);
+ pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n);
if (pextent[n] <= 0)
{
pempty = 1;
@@ -142,7 +142,7 @@
for (n = 0; n < rdim; n++)
{
rs *= shape_data[n];
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (ret_extent != shape_data[n])
runtime_error("Incorrect extent in return value of RESHAPE"
" intrinsic in dimension %ld: is %ld,"
@@ -155,7 +155,7 @@
for (n = 0; n < sdim; n++)
{
index_type se;
- se = source->dim[n].ubound + 1 - source->dim[0].lbound;
+ se = GFC_DESCRIPTOR_EXTENT(source,n);
source_extent *= se > 0 ? se : 0;
}
@@ -174,7 +174,7 @@
for (n = 0; n < rdim; n++)
{
- v = order->data[n * order->dim[0].stride] - 1;
+ v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
if (v < 0 || v >= rdim)
runtime_error("Value %ld out of range in ORDER argument"
@@ -193,13 +193,13 @@
for (n = 0; n < rdim; n++)
{
if (order)
- dim = order->data[n * order->dim[0].stride] - 1;
+ dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
else
dim = n;
rcount[n] = 0;
- rstride[n] = ret->dim[dim].stride;
- rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim);
if (rextent[n] != shape_data[dim])
runtime_error ("shape and target do not conform");
@@ -218,8 +218,8 @@
for (n = 0; n < sdim; n++)
{
scount[n] = 0;
- sstride[n] = source->dim[n].stride;
- sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (sextent[n] <= 0)
{
sempty = 1;