diff options
Diffstat (limited to 'libgfortran')
| -rw-r--r-- | libgfortran/ChangeLog | 17 | ||||
| -rw-r--r-- | libgfortran/intrinsics/spread_generic.c | 98 |
2 files changed, 92 insertions, 23 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 5553575a8b3..9fc0b63b51a 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,20 @@ +2005-04-15 Thomas Koenig <Thomas.Koenig@online.de> + + PR libfortran/18495 + * intrinsics/spread_generic.c (spread): Remove const from + return array descriptor. + New variables: rrank (rank of return array), rs (for + calculating the size of the return array), srank (rank + of the source array). + Generate runtime error if the dim= argument is larger than + the rank of the return array. + Generate runtime error if the needed rank of the return + array is larger than 7. + If ret->data is null, populate the return array descriptor + and initialize the variables for the actual operation. + Otherwise, set ret->dim[0].stride to one if it is zero. + Change second, independent use of variable dim to srank. + 2005-04-12 Mike Stump <mrs@apple.com> * configure: Regenerate. diff --git a/libgfortran/intrinsics/spread_generic.c b/libgfortran/intrinsics/spread_generic.c index e40739e4614..7dcabf63bcb 100644 --- a/libgfortran/intrinsics/spread_generic.c +++ b/libgfortran/intrinsics/spread_generic.c @@ -34,23 +34,26 @@ Boston, MA 02111-1307, USA. */ #include <string.h> #include "libgfortran.h" -extern void spread (const gfc_array_char *, const gfc_array_char *, +extern void spread (gfc_array_char *, const gfc_array_char *, const index_type *, const index_type *); export_proto(spread); void -spread (const gfc_array_char *ret, const gfc_array_char *source, +spread (gfc_array_char *ret, const gfc_array_char *source, const index_type *along, const index_type *pncopies) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS - 1]; index_type rstride0; index_type rdelta; + index_type rrank; + index_type rs; char *rptr; char *dest; /* s.* indicates the source array. */ index_type sstride[GFC_MAX_DIMENSIONS - 1]; index_type sstride0; + index_type srank; const char *sptr; index_type count[GFC_MAX_DIMENSIONS - 1]; @@ -60,34 +63,83 @@ spread (const gfc_array_char *ret, const gfc_array_char *source, index_type size; index_type ncopies; + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (*along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = *pncopies; + size = GFC_DESCRIPTOR_SIZE (source); - dim = 0; - for (n = 0; n < GFC_DESCRIPTOR_RANK (ret); n++) + if (ret->data == NULL) { - if (n == *along - 1) - { - rdelta = ret->dim[n].stride * size; - } - else - { - count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - source->dim[dim].lbound; - sstride[dim] = source->dim[dim].stride * size; - rstride[dim] = ret->dim[n].stride * size; - dim++; - } + /* The front end has signalled that we need to populate the + return array descriptor. */ + 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; + if (n == *along - 1) + { + ret->dim[n].ubound = 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; + rstride[dim] = rs * size; + + ret->dim[n].ubound = extent[dim]-1; + rs *= extent[dim]; + dim++; + } + } + ret->base = 0; + ret->data = internal_malloc_size (rs * size); } - dim = GFC_DESCRIPTOR_RANK (source); - if (sstride[0] == 0) - sstride[0] = size; - if (rstride[0] == 0) - rstride[0] = size; + else + { + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + if (ret->dim[0].stride == 0) + ret->dim[0].stride = 1; + + for (n = 0; n < rrank; n++) + { + if (n == *along - 1) + { + rdelta = ret->dim[n].stride * size; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + sstride[dim] = source->dim[dim].stride * size; + rstride[dim] = ret->dim[n].stride * size; + dim++; + } + } + if (sstride[0] == 0) + sstride[0] = size; + } sstride0 = sstride[0]; rstride0 = rstride[0]; rptr = ret->data; sptr = source->data; - ncopies = *pncopies; while (sptr) { @@ -113,7 +165,7 @@ spread (const gfc_array_char *ret, const gfc_array_char *source, sptr -= sstride[n] * extent[n]; rptr -= rstride[n] * extent[n]; n++; - if (n >= dim) + if (n >= srank) { /* Break out of the loop. */ sptr = NULL; |
