reshape broken for 64bit
Richard Henderson
rth@redhat.com
Mon Dec 6 05:55:00 GMT 2004
This is the cause of most of the regressions on 64bit.
The big problem is that the SHAPE and ORDER arrays are being passed
in a different kind than expected. Most of our test cases use
a = reshape (val, (/3, 3/))
which means that SHAPE has default integer kind, whereas the reshape
library routines are written to use index_kind. Oops.
I'm of a couple of minds on this. Solutions:
(1) Replicate the library routines for multiple SHAPE kinds.
(2) Convert the SHAPE and ORDER arguments to index_kind temporaries.
Arguments:
Con 1, Pro 2:
Library smaller because of less duplication.
Pro 1, Con 2:
I suspect that most everyone will be using the default integer
kind here, so if a version using default kind is available, we
wouldn't have to add conversion code to the application.
Of course, how often do folks use non-constant SHAPE here? If
we *usually* have constants, then the conversions wouldn't
happen often and so it shouldn't be seen to matter much.
Pro 2:
The Standard doesn't say anything about constraints on
the kind of the SHAPE and ORDER arrays, it just says they have
to be integers. So having the ability to convert from kind=1
or kind=2 would seem to be necessary for corner-case correctness.
Further, the standard doesn't say anything about SHAPE and
ORDER having to be the *same* kind, which would tend to lead
to combinatorial explosion.
That said, I couldn't figure out how to implement option 2 at all.
If that's the way we intend to go, then I'll need help.
I do have an implementation of 1, which follows. I may try and see
if I can merge reshape.m4 with reshape_gen.m4. Seems like we ought
to be able to make all that work out nicely with a few macros...
r~
Index: gcc/fortran/iresolve.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/iresolve.c,v
retrieving revision 1.23
diff -c -p -d -r1.23 iresolve.c
*** gcc/fortran/iresolve.c 2 Dec 2004 04:10:24 -0000 1.23
--- gcc/fortran/iresolve.c 6 Dec 2004 02:43:11 -0000
*************** gfc_resolve_reshape (gfc_expr * f, gfc_e
*** 1117,1123 ****
gfc_expr * pad ATTRIBUTE_UNUSED,
gfc_expr * order ATTRIBUTE_UNUSED)
{
- static char reshape0[] = "__reshape";
mpz_t rank;
int kind;
int i;
--- 1117,1122 ----
*************** gfc_resolve_reshape (gfc_expr * f, gfc_e
*** 1149,1163 ****
case 4:
case 8:
/* case 16: */
! f->value.function.name =
! gfc_get_string ("__reshape_%d", source->ts.kind);
break;
default:
! f->value.function.name = reshape0;
break;
}
/* TODO: Make this work with a constant ORDER parameter. */
if (shape->expr_type == EXPR_ARRAY
&& gfc_is_constant_expr (shape)
--- 1148,1165 ----
case 4:
case 8:
/* case 16: */
! f->value.function.name
! = gfc_get_string ("__reshape_%d_%d", source->ts.kind, shape->ts.kind);
break;
default:
! f->value.function.name
! = gfc_get_string ("__reshape_gen_%d", shape->ts.kind);
break;
}
+ /* ??? We can't support ORDER and SHAPE being different kinds. */
+
/* TODO: Make this work with a constant ORDER parameter. */
if (shape->expr_type == EXPR_ARRAY
&& gfc_is_constant_expr (shape)
Index: libgfortran/Makefile.am
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/Makefile.am,v
retrieving revision 1.25
diff -c -p -d -r1.25 Makefile.am
*** libgfortran/Makefile.am 2 Dec 2004 04:10:25 -0000 1.25
--- libgfortran/Makefile.am 6 Dec 2004 02:43:11 -0000
*************** intrinsics/string_intrinsics.c \
*** 66,72 ****
intrinsics/system.c \
intrinsics/rand.c \
intrinsics/random.c \
- intrinsics/reshape_generic.c \
intrinsics/reshape_packed.c \
intrinsics/selected_int_kind.f90 \
intrinsics/selected_real_kind.f90 \
--- 66,71 ----
*************** generated/shape_i4.c \
*** 209,216 ****
generated/shape_i8.c
i_reshape_c= \
! generated/reshape_i4.c \
! generated/reshape_i8.c
i_eoshift1_c= \
generated/eoshift1_4.c \
--- 208,221 ----
generated/shape_i8.c
i_reshape_c= \
! generated/reshape_i4_i4.c \
! generated/reshape_i4_i8.c \
! generated/reshape_i8_i4.c \
! generated/reshape_i8_i8.c
!
! i_reshape_gen_c= \
! generated/reshape_gen_i4.c \
! generated/reshape_gen_i8.c
i_eoshift1_c= \
generated/eoshift1_4.c \
*************** m4_files= m4/iparm.m4 m4/ifunction.m4 m4
*** 269,275 ****
m4/ctrig.m4 m4/cexp.m4 m4/chyp.m4 m4/mtype.m4 \
m4/specific.m4 m4/specific2.m4 m4/head.m4 m4/shape.m4 m4/reshape.m4 \
m4/transpose.m4 m4/eoshift1.m4 m4/eoshift3.m4 m4/exponent.m4 \
! m4/fraction.m4 m4/nearest.m4 m4/set_exponent.m4 m4/pow.m4
gfor_built_src= $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
$(i_maxloc1_c) $(i_maxval_c) $(i_minloc0_c) $(i_minloc1_c) $(i_minval_c) \
--- 274,281 ----
m4/ctrig.m4 m4/cexp.m4 m4/chyp.m4 m4/mtype.m4 \
m4/specific.m4 m4/specific2.m4 m4/head.m4 m4/shape.m4 m4/reshape.m4 \
m4/transpose.m4 m4/eoshift1.m4 m4/eoshift3.m4 m4/exponent.m4 \
! m4/fraction.m4 m4/nearest.m4 m4/set_exponent.m4 m4/pow.m4 \
! m4/reshape_gen.m4
gfor_built_src= $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
$(i_maxloc1_c) $(i_maxval_c) $(i_minloc0_c) $(i_minloc1_c) $(i_minval_c) \
*************** gfor_built_src= $(i_all_c) $(i_any_c) $(
*** 277,283 ****
$(i_matmul_c) $(i_matmull_c) $(i_transpose_c) $(i_shape_c) $(i_eoshift1_c) \
$(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \
$(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \
! $(i_pow_c) \
selected_int_kind.inc selected_real_kind.inc
# We only use these if libm doesn't contain complex math functions.
--- 283,289 ----
$(i_matmul_c) $(i_matmull_c) $(i_transpose_c) $(i_shape_c) $(i_eoshift1_c) \
$(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \
$(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \
! $(i_pow_c) $(i_reshape_gen_c) \
selected_int_kind.inc selected_real_kind.inc
# We only use these if libm doesn't contain complex math functions.
*************** $(i_shape_c): m4/shape.m4 $(I_M4_DEPS)
*** 464,469 ****
--- 470,478 ----
$(i_reshape_c): m4/reshape.m4 $(I_M4_DEPS)
m4 -Dfile=$@ -I$(srcdir)/m4 reshape.m4 > $@
+ $(i_reshape_gen_c): m4/reshape_gen.m4 $(I_M4_DEPS)
+ m4 -Dfile=$@ -I$(srcdir)/m4 reshape_gen.m4 > $@
+
$(i_eoshift1_c): m4/eoshift1.m4 $(I_M4_DEPS)
m4 -Dfile=$@ -I$(srcdir)/m4 eoshift1.m4 > $@
Index: libgfortran/generated/reshape_gen_i4.c
===================================================================
RCS file: libgfortran/generated/reshape_gen_i4.c
diff -N libgfortran/generated/reshape_gen_i4.c
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- libgfortran/generated/reshape_gen_i4.c 6 Dec 2004 02:43:12 -0000
***************
*** 0 ****
--- 1,230 ----
+ /* Generic implementation of the RESHAPE intrinsic
+ Copyright 2002, 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+ This generated/reshape_gen_i4.c is part of the GNU Fortran 95 runtime library (libgfor).
+
+ Libgfor is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ Ligbfor is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with libgfor; see the generated/reshape_gen_i4.c COPYING.LIB. If not,
+ write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+ #include "config.h"
+ #include <stdlib.h>
+ #include <string.h>
+ #include <assert.h>
+ #include "libgfortran.h"
+
+ typedef GFC_ARRAY_DESCRIPTOR(1, GFC_INTEGER_4) shape_type;
+ typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) parray;
+
+ /* The shape parameter is ignored. We can currently deduce the shape from the
+ return array. */
+
+ void
+ __reshape_gen_4 (parray * ret, parray * source, shape_type * shape,
+ parray * pad, shape_type * order)
+ {
+ /* r.* indicates the return array. */
+ index_type rcount[GFC_MAX_DIMENSIONS - 1];
+ index_type rextent[GFC_MAX_DIMENSIONS - 1];
+ index_type rstride[GFC_MAX_DIMENSIONS - 1];
+ index_type rstride0;
+ index_type rdim;
+ index_type rsize;
+ char *rptr;
+ /* s.* indicates the source array. */
+ index_type scount[GFC_MAX_DIMENSIONS - 1];
+ index_type sextent[GFC_MAX_DIMENSIONS - 1];
+ index_type sstride[GFC_MAX_DIMENSIONS - 1];
+ index_type sstride0;
+ index_type sdim;
+ index_type ssize;
+ const char *sptr;
+ /* p.* indicates the pad array. */
+ index_type pcount[GFC_MAX_DIMENSIONS - 1];
+ index_type pextent[GFC_MAX_DIMENSIONS - 1];
+ index_type pstride[GFC_MAX_DIMENSIONS - 1];
+ index_type pdim;
+ index_type psize;
+ const char *pptr;
+
+ const char *src;
+ int n;
+ int dim;
+ int size;
+
+ size = GFC_DESCRIPTOR_SIZE (ret);
+ if (ret->dim[0].stride == 0)
+ ret->dim[0].stride = 1;
+ if (source->dim[0].stride == 0)
+ source->dim[0].stride = 1;
+ if (shape->dim[0].stride == 0)
+ shape->dim[0].stride = 1;
+ if (pad && pad->dim[0].stride == 0)
+ pad->dim[0].stride = 1;
+ if (order && order->dim[0].stride == 0)
+ order->dim[0].stride = 1;
+
+ rdim = GFC_DESCRIPTOR_RANK (ret);
+ rsize = 1;
+ for (n = 0; n < rdim; n++)
+ {
+ if (order)
+ dim = order->data[n * order->dim[0].stride] - 1;
+ else
+ dim = n;
+
+ rcount[n] = 0;
+ rstride[n] = ret->dim[dim].stride;
+ rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+
+ if (rextent[n] != shape->data[dim * shape->dim[0].stride])
+ runtime_error ("shape and target do not conform");
+
+ if (rsize == rstride[n])
+ rsize *= rextent[n];
+ else
+ rsize = 0;
+ if (rextent[dim] <= 0)
+ return;
+ }
+
+ sdim = GFC_DESCRIPTOR_RANK (source);
+ ssize = 1;
+ 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;
+ if (sextent[n] <= 0)
+ abort ();
+
+ if (rsize == sstride[n])
+ ssize *= sextent[n];
+ else
+ ssize = 0;
+ }
+
+ if (pad)
+ {
+ if (pad->dim[0].stride == 0)
+ pad->dim[0].stride = 1;
+ pdim = GFC_DESCRIPTOR_RANK (pad);
+ psize = 1;
+ 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;
+ if (pextent[n] <= 0)
+ abort ();
+ if (psize == pstride[n])
+ psize *= pextent[n];
+ else
+ rsize = 0;
+ }
+ pptr = pad->data;
+ }
+ else
+ {
+ pdim = 0;
+ psize = 1;
+ pptr = NULL;
+ }
+
+ if (rsize != 0 && ssize != 0 && psize != 0)
+ {
+ rsize *= size;
+ ssize *= size;
+ psize *= size;
+ reshape_packed (ret->data, rsize, source->data, ssize,
+ pad ? pad->data : NULL, psize);
+ return;
+ }
+ rptr = ret->data;
+ src = sptr = source->data;
+ rstride0 = rstride[0] * size;
+ sstride0 = sstride[0] * size;
+
+ while (rptr)
+ {
+ /* Select between the source and pad arrays. */
+ memcpy(rptr, src, size);
+ /* Advance to the next element. */
+ rptr += rstride0;
+ src += sstride0;
+ rcount[0]++;
+ scount[0]++;
+ /* Advance to the next destination element. */
+ n = 0;
+ while (rcount[n] == rextent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ rcount[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ rptr -= rstride[n] * rextent[n] * size;
+ n++;
+ if (n == rdim)
+ {
+ /* Break out of the loop. */
+ rptr = NULL;
+ break;
+ }
+ else
+ {
+ rcount[n]++;
+ rptr += rstride[n] * size;
+ }
+ }
+ /* Advance to the next source element. */
+ n = 0;
+ while (scount[n] == sextent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ scount[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ src -= sstride[n] * sextent[n] * size;
+ n++;
+ if (n == sdim)
+ {
+ if (sptr && pad)
+ {
+ /* Switch to the pad array. */
+ sptr = NULL;
+ sdim = pdim;
+ for (dim = 0; dim < pdim; dim++)
+ {
+ scount[dim] = pcount[dim];
+ sextent[dim] = pextent[dim];
+ sstride[dim] = pstride[dim];
+ sstride0 = sstride[0] * size;
+ }
+ }
+ /* We now start again from the beginning of the pad array. */
+ src = pptr;
+ break;
+ }
+ else
+ {
+ scount[n]++;
+ sptr += sstride[n] * size;
+ }
+ }
+ }
+ }
+
Index: libgfortran/generated/reshape_gen_i8.c
===================================================================
RCS file: libgfortran/generated/reshape_gen_i8.c
diff -N libgfortran/generated/reshape_gen_i8.c
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- libgfortran/generated/reshape_gen_i8.c 6 Dec 2004 02:43:12 -0000
***************
*** 0 ****
--- 1,230 ----
+ /* Generic implementation of the RESHAPE intrinsic
+ Copyright 2002, 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+ This generated/reshape_gen_i8.c is part of the GNU Fortran 95 runtime library (libgfor).
+
+ Libgfor is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ Ligbfor is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with libgfor; see the generated/reshape_gen_i8.c COPYING.LIB. If not,
+ write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+ #include "config.h"
+ #include <stdlib.h>
+ #include <string.h>
+ #include <assert.h>
+ #include "libgfortran.h"
+
+ typedef GFC_ARRAY_DESCRIPTOR(1, GFC_INTEGER_8) shape_type;
+ typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) parray;
+
+ /* The shape parameter is ignored. We can currently deduce the shape from the
+ return array. */
+
+ void
+ __reshape_gen_8 (parray * ret, parray * source, shape_type * shape,
+ parray * pad, shape_type * order)
+ {
+ /* r.* indicates the return array. */
+ index_type rcount[GFC_MAX_DIMENSIONS - 1];
+ index_type rextent[GFC_MAX_DIMENSIONS - 1];
+ index_type rstride[GFC_MAX_DIMENSIONS - 1];
+ index_type rstride0;
+ index_type rdim;
+ index_type rsize;
+ char *rptr;
+ /* s.* indicates the source array. */
+ index_type scount[GFC_MAX_DIMENSIONS - 1];
+ index_type sextent[GFC_MAX_DIMENSIONS - 1];
+ index_type sstride[GFC_MAX_DIMENSIONS - 1];
+ index_type sstride0;
+ index_type sdim;
+ index_type ssize;
+ const char *sptr;
+ /* p.* indicates the pad array. */
+ index_type pcount[GFC_MAX_DIMENSIONS - 1];
+ index_type pextent[GFC_MAX_DIMENSIONS - 1];
+ index_type pstride[GFC_MAX_DIMENSIONS - 1];
+ index_type pdim;
+ index_type psize;
+ const char *pptr;
+
+ const char *src;
+ int n;
+ int dim;
+ int size;
+
+ size = GFC_DESCRIPTOR_SIZE (ret);
+ if (ret->dim[0].stride == 0)
+ ret->dim[0].stride = 1;
+ if (source->dim[0].stride == 0)
+ source->dim[0].stride = 1;
+ if (shape->dim[0].stride == 0)
+ shape->dim[0].stride = 1;
+ if (pad && pad->dim[0].stride == 0)
+ pad->dim[0].stride = 1;
+ if (order && order->dim[0].stride == 0)
+ order->dim[0].stride = 1;
+
+ rdim = GFC_DESCRIPTOR_RANK (ret);
+ rsize = 1;
+ for (n = 0; n < rdim; n++)
+ {
+ if (order)
+ dim = order->data[n * order->dim[0].stride] - 1;
+ else
+ dim = n;
+
+ rcount[n] = 0;
+ rstride[n] = ret->dim[dim].stride;
+ rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+
+ if (rextent[n] != shape->data[dim * shape->dim[0].stride])
+ runtime_error ("shape and target do not conform");
+
+ if (rsize == rstride[n])
+ rsize *= rextent[n];
+ else
+ rsize = 0;
+ if (rextent[dim] <= 0)
+ return;
+ }
+
+ sdim = GFC_DESCRIPTOR_RANK (source);
+ ssize = 1;
+ 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;
+ if (sextent[n] <= 0)
+ abort ();
+
+ if (rsize == sstride[n])
+ ssize *= sextent[n];
+ else
+ ssize = 0;
+ }
+
+ if (pad)
+ {
+ if (pad->dim[0].stride == 0)
+ pad->dim[0].stride = 1;
+ pdim = GFC_DESCRIPTOR_RANK (pad);
+ psize = 1;
+ 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;
+ if (pextent[n] <= 0)
+ abort ();
+ if (psize == pstride[n])
+ psize *= pextent[n];
+ else
+ rsize = 0;
+ }
+ pptr = pad->data;
+ }
+ else
+ {
+ pdim = 0;
+ psize = 1;
+ pptr = NULL;
+ }
+
+ if (rsize != 0 && ssize != 0 && psize != 0)
+ {
+ rsize *= size;
+ ssize *= size;
+ psize *= size;
+ reshape_packed (ret->data, rsize, source->data, ssize,
+ pad ? pad->data : NULL, psize);
+ return;
+ }
+ rptr = ret->data;
+ src = sptr = source->data;
+ rstride0 = rstride[0] * size;
+ sstride0 = sstride[0] * size;
+
+ while (rptr)
+ {
+ /* Select between the source and pad arrays. */
+ memcpy(rptr, src, size);
+ /* Advance to the next element. */
+ rptr += rstride0;
+ src += sstride0;
+ rcount[0]++;
+ scount[0]++;
+ /* Advance to the next destination element. */
+ n = 0;
+ while (rcount[n] == rextent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ rcount[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ rptr -= rstride[n] * rextent[n] * size;
+ n++;
+ if (n == rdim)
+ {
+ /* Break out of the loop. */
+ rptr = NULL;
+ break;
+ }
+ else
+ {
+ rcount[n]++;
+ rptr += rstride[n] * size;
+ }
+ }
+ /* Advance to the next source element. */
+ n = 0;
+ while (scount[n] == sextent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ scount[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ src -= sstride[n] * sextent[n] * size;
+ n++;
+ if (n == sdim)
+ {
+ if (sptr && pad)
+ {
+ /* Switch to the pad array. */
+ sptr = NULL;
+ sdim = pdim;
+ for (dim = 0; dim < pdim; dim++)
+ {
+ scount[dim] = pcount[dim];
+ sextent[dim] = pextent[dim];
+ sstride[dim] = pstride[dim];
+ sstride0 = sstride[0] * size;
+ }
+ }
+ /* We now start again from the beginning of the pad array. */
+ src = pptr;
+ break;
+ }
+ else
+ {
+ scount[n]++;
+ sptr += sstride[n] * size;
+ }
+ }
+ }
+ }
+
Index: libgfortran/generated/reshape_i4.c
===================================================================
RCS file: libgfortran/generated/reshape_i4.c
diff -N libgfortran/generated/reshape_i4.c
*** libgfortran/generated/reshape_i4.c 13 May 2004 06:41:01 -0000 1.2
--- /dev/null 1 Jan 1970 00:00:00 -0000
***************
*** 1,225 ****
- /* Implementation of the RESHAPE
- Copyright 2002 Free Software Foundation, Inc.
- Contributed by Paul Brook <paul@nowt.org>
-
- This file is part of the GNU Fortran 95 runtime library (libgfor).
-
- Libgfor is free software; you can redistribute it and/or
- modify it under the terms of the GNU Lesser General Public
- License as published by the Free Software Foundation; either
- version 2.1 of the License, or (at your option) any later version.
-
- Ligbfor is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU Lesser General Public License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with libgfor; see the file COPYING.LIB. If not,
- write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
- Boston, MA 02111-1307, USA. */
-
- #include "config.h"
- #include <stdlib.h>
- #include <assert.h>
- #include "libgfortran.h"
-
- typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
-
- /* The shape parameter is ignored. We can currently deduce the shape from the
- return array. */
- void
- __reshape_4 (gfc_array_i4 * ret, gfc_array_i4 * source, shape_type * shape,
- gfc_array_i4 * pad, shape_type * order)
- {
- /* r.* indicates the return array. */
- index_type rcount[GFC_MAX_DIMENSIONS - 1];
- index_type rextent[GFC_MAX_DIMENSIONS - 1];
- index_type rstride[GFC_MAX_DIMENSIONS - 1];
- index_type rstride0;
- index_type rdim;
- index_type rsize;
- GFC_INTEGER_4 *rptr;
- /* s.* indicates the source array. */
- index_type scount[GFC_MAX_DIMENSIONS - 1];
- index_type sextent[GFC_MAX_DIMENSIONS - 1];
- index_type sstride[GFC_MAX_DIMENSIONS - 1];
- index_type sstride0;
- index_type sdim;
- index_type ssize;
- const GFC_INTEGER_4 *sptr;
- /* p.* indicates the pad array. */
- index_type pcount[GFC_MAX_DIMENSIONS - 1];
- index_type pextent[GFC_MAX_DIMENSIONS - 1];
- index_type pstride[GFC_MAX_DIMENSIONS - 1];
- index_type pdim;
- index_type psize;
- const GFC_INTEGER_4 *pptr;
-
- const GFC_INTEGER_4 *src;
- int n;
- int dim;
-
- if (ret->dim[0].stride == 0)
- ret->dim[0].stride = 1;
- if (source->dim[0].stride == 0)
- source->dim[0].stride = 1;
- if (shape->dim[0].stride == 0)
- shape->dim[0].stride = 1;
- if (pad && pad->dim[0].stride == 0)
- pad->dim[0].stride = 1;
- if (order && order->dim[0].stride == 0)
- order->dim[0].stride = 1;
-
- rdim = GFC_DESCRIPTOR_RANK (ret);
- rsize = 1;
- for (n = 0; n < rdim; n++)
- {
- if (order)
- dim = order->data[n * order->dim[0].stride] - 1;
- else
- dim = n;
-
- rcount[n] = 0;
- rstride[n] = ret->dim[dim].stride;
- rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
-
- if (rextent[n] != shape->data[dim * shape->dim[0].stride])
- runtime_error ("shape and target do not conform");
-
- if (rsize == rstride[n])
- rsize *= rextent[n];
- else
- rsize = 0;
- if (rextent[dim] <= 0)
- return;
- }
-
- sdim = GFC_DESCRIPTOR_RANK (source);
- ssize = 1;
- 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;
- if (sextent[n] <= 0)
- abort ();
-
- if (ssize == sstride[n])
- ssize *= sextent[n];
- else
- ssize = 0;
- }
-
- if (pad)
- {
- if (pad->dim[0].stride == 0)
- pad->dim[0].stride = 1;
- pdim = GFC_DESCRIPTOR_RANK (pad);
- psize = 1;
- 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;
- if (pextent[n] <= 0)
- abort ();
- if (psize == pstride[n])
- psize *= pextent[n];
- else
- psize = 0;
- }
- pptr = pad->data;
- }
- else
- {
- pdim = 0;
- psize = 1;
- pptr = NULL;
- }
-
- if (rsize != 0 && ssize != 0 && psize != 0)
- {
- rsize *= 4;
- ssize *= 4;
- psize *= 4;
- reshape_packed ((char *)ret->data, rsize, (char *)source->data,
- ssize, pad ? (char *)pad->data : NULL, psize);
- return;
- }
- rptr = ret->data;
- src = sptr = source->data;
- rstride0 = rstride[0];
- sstride0 = sstride[0];
-
- while (rptr)
- {
- /* Select between the source and pad arrays. */
- *rptr = *src;
- /* Advance to the next element. */
- rptr += rstride0;
- src += sstride0;
- rcount[0]++;
- scount[0]++;
- /* Advance to the next destination element. */
- n = 0;
- while (rcount[n] == rextent[n])
- {
- /* When we get to the end of a dimension, reset it and increment
- the next dimension. */
- rcount[n] = 0;
- /* We could precalculate these products, but this is a less
- frequently used path so proabably not worth it. */
- rptr -= rstride[n] * rextent[n];
- n++;
- if (n == rdim)
- {
- /* Break out of the loop. */
- rptr = NULL;
- break;
- }
- else
- {
- rcount[n]++;
- rptr += rstride[n];
- }
- }
- /* Advance to the next source element. */
- n = 0;
- while (scount[n] == sextent[n])
- {
- /* When we get to the end of a dimension, reset it and increment
- the next dimension. */
- scount[n] = 0;
- /* We could precalculate these products, but this is a less
- frequently used path so proabably not worth it. */
- src -= sstride[n] * sextent[n];
- n++;
- if (n == sdim)
- {
- if (sptr && pad)
- {
- /* Switch to the pad array. */
- sptr = NULL;
- sdim = pdim;
- for (dim = 0; dim < pdim; dim++)
- {
- scount[dim] = pcount[dim];
- sextent[dim] = pextent[dim];
- sstride[dim] = pstride[dim];
- sstride0 = sstride[0];
- }
- }
- /* We now start again from the beginning of the pad array. */
- src = pptr;
- break;
- }
- else
- {
- scount[n]++;
- src += sstride[n];
- }
- }
- }
- }
-
--- 0 ----
Index: libgfortran/generated/reshape_i4_i4.c
===================================================================
RCS file: libgfortran/generated/reshape_i4_i4.c
diff -N libgfortran/generated/reshape_i4_i4.c
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- libgfortran/generated/reshape_i4_i4.c 6 Dec 2004 02:43:12 -0000
***************
*** 0 ****
--- 1,226 ----
+ /* Implementation of the RESHAPE
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+ This file is part of the GNU Fortran 95 runtime library (libgfor).
+
+ Libgfor is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ Ligbfor is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with libgfor; see the file COPYING.LIB. If not,
+ write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+ #include "config.h"
+ #include <stdlib.h>
+ #include <assert.h>
+ #include "libgfortran.h"
+
+ typedef GFC_ARRAY_DESCRIPTOR(1, GFC_INTEGER_4) shape_type;
+
+ /* The shape parameter is ignored. We can currently deduce the shape from the
+ return array. */
+ void
+ __reshape_4_4 (gfc_array_i4 * ret, gfc_array_i4 * source,
+ shape_type * shape, gfc_array_i4 * pad,
+ shape_type * order)
+ {
+ /* r.* indicates the return array. */
+ index_type rcount[GFC_MAX_DIMENSIONS - 1];
+ index_type rextent[GFC_MAX_DIMENSIONS - 1];
+ index_type rstride[GFC_MAX_DIMENSIONS - 1];
+ index_type rstride0;
+ index_type rdim;
+ index_type rsize;
+ GFC_INTEGER_4 *rptr;
+ /* s.* indicates the source array. */
+ index_type scount[GFC_MAX_DIMENSIONS - 1];
+ index_type sextent[GFC_MAX_DIMENSIONS - 1];
+ index_type sstride[GFC_MAX_DIMENSIONS - 1];
+ index_type sstride0;
+ index_type sdim;
+ index_type ssize;
+ const GFC_INTEGER_4 *sptr;
+ /* p.* indicates the pad array. */
+ index_type pcount[GFC_MAX_DIMENSIONS - 1];
+ index_type pextent[GFC_MAX_DIMENSIONS - 1];
+ index_type pstride[GFC_MAX_DIMENSIONS - 1];
+ index_type pdim;
+ index_type psize;
+ const GFC_INTEGER_4 *pptr;
+
+ const GFC_INTEGER_4 *src;
+ int n;
+ int dim;
+
+ if (ret->dim[0].stride == 0)
+ ret->dim[0].stride = 1;
+ if (source->dim[0].stride == 0)
+ source->dim[0].stride = 1;
+ if (shape->dim[0].stride == 0)
+ shape->dim[0].stride = 1;
+ if (pad && pad->dim[0].stride == 0)
+ pad->dim[0].stride = 1;
+ if (order && order->dim[0].stride == 0)
+ order->dim[0].stride = 1;
+
+ rdim = GFC_DESCRIPTOR_RANK (ret);
+ rsize = 1;
+ for (n = 0; n < rdim; n++)
+ {
+ if (order)
+ dim = order->data[n * order->dim[0].stride] - 1;
+ else
+ dim = n;
+
+ rcount[n] = 0;
+ rstride[n] = ret->dim[dim].stride;
+ rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+
+ if (rextent[n] != shape->data[dim * shape->dim[0].stride])
+ runtime_error ("shape and target do not conform");
+
+ if (rsize == rstride[n])
+ rsize *= rextent[n];
+ else
+ rsize = 0;
+ if (rextent[dim] <= 0)
+ return;
+ }
+
+ sdim = GFC_DESCRIPTOR_RANK (source);
+ ssize = 1;
+ 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;
+ if (sextent[n] <= 0)
+ abort ();
+
+ if (ssize == sstride[n])
+ ssize *= sextent[n];
+ else
+ ssize = 0;
+ }
+
+ if (pad)
+ {
+ if (pad->dim[0].stride == 0)
+ pad->dim[0].stride = 1;
+ pdim = GFC_DESCRIPTOR_RANK (pad);
+ psize = 1;
+ 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;
+ if (pextent[n] <= 0)
+ abort ();
+ if (psize == pstride[n])
+ psize *= pextent[n];
+ else
+ psize = 0;
+ }
+ pptr = pad->data;
+ }
+ else
+ {
+ pdim = 0;
+ psize = 1;
+ pptr = NULL;
+ }
+
+ if (rsize != 0 && ssize != 0 && psize != 0)
+ {
+ rsize *= 4;
+ ssize *= 4;
+ psize *= 4;
+ reshape_packed ((char *)ret->data, rsize, (char *)source->data,
+ ssize, pad ? (char *)pad->data : NULL, psize);
+ return;
+ }
+ rptr = ret->data;
+ src = sptr = source->data;
+ rstride0 = rstride[0];
+ sstride0 = sstride[0];
+
+ while (rptr)
+ {
+ /* Select between the source and pad arrays. */
+ *rptr = *src;
+ /* Advance to the next element. */
+ rptr += rstride0;
+ src += sstride0;
+ rcount[0]++;
+ scount[0]++;
+ /* Advance to the next destination element. */
+ n = 0;
+ while (rcount[n] == rextent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ rcount[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ rptr -= rstride[n] * rextent[n];
+ n++;
+ if (n == rdim)
+ {
+ /* Break out of the loop. */
+ rptr = NULL;
+ break;
+ }
+ else
+ {
+ rcount[n]++;
+ rptr += rstride[n];
+ }
+ }
+ /* Advance to the next source element. */
+ n = 0;
+ while (scount[n] == sextent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ scount[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ src -= sstride[n] * sextent[n];
+ n++;
+ if (n == sdim)
+ {
+ if (sptr && pad)
+ {
+ /* Switch to the pad array. */
+ sptr = NULL;
+ sdim = pdim;
+ for (dim = 0; dim < pdim; dim++)
+ {
+ scount[dim] = pcount[dim];
+ sextent[dim] = pextent[dim];
+ sstride[dim] = pstride[dim];
+ sstride0 = sstride[0];
+ }
+ }
+ /* We now start again from the beginning of the pad array. */
+ src = pptr;
+ break;
+ }
+ else
+ {
+ scount[n]++;
+ src += sstride[n];
+ }
+ }
+ }
+ }
+
Index: libgfortran/generated/reshape_i4_i8.c
===================================================================
RCS file: libgfortran/generated/reshape_i4_i8.c
diff -N libgfortran/generated/reshape_i4_i8.c
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- libgfortran/generated/reshape_i4_i8.c 6 Dec 2004 02:43:12 -0000
***************
*** 0 ****
--- 1,226 ----
+ /* Implementation of the RESHAPE
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+ This file is part of the GNU Fortran 95 runtime library (libgfor).
+
+ Libgfor is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ Ligbfor is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with libgfor; see the file COPYING.LIB. If not,
+ write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+ #include "config.h"
+ #include <stdlib.h>
+ #include <assert.h>
+ #include "libgfortran.h"
+
+ typedef GFC_ARRAY_DESCRIPTOR(1, GFC_INTEGER_8) shape_type;
+
+ /* The shape parameter is ignored. We can currently deduce the shape from the
+ return array. */
+ void
+ __reshape_4_8 (gfc_array_i4 * ret, gfc_array_i4 * source,
+ shape_type * shape, gfc_array_i4 * pad,
+ shape_type * order)
+ {
+ /* r.* indicates the return array. */
+ index_type rcount[GFC_MAX_DIMENSIONS - 1];
+ index_type rextent[GFC_MAX_DIMENSIONS - 1];
+ index_type rstride[GFC_MAX_DIMENSIONS - 1];
+ index_type rstride0;
+ index_type rdim;
+ index_type rsize;
+ GFC_INTEGER_4 *rptr;
+ /* s.* indicates the source array. */
+ index_type scount[GFC_MAX_DIMENSIONS - 1];
+ index_type sextent[GFC_MAX_DIMENSIONS - 1];
+ index_type sstride[GFC_MAX_DIMENSIONS - 1];
+ index_type sstride0;
+ index_type sdim;
+ index_type ssize;
+ const GFC_INTEGER_4 *sptr;
+ /* p.* indicates the pad array. */
+ index_type pcount[GFC_MAX_DIMENSIONS - 1];
+ index_type pextent[GFC_MAX_DIMENSIONS - 1];
+ index_type pstride[GFC_MAX_DIMENSIONS - 1];
+ index_type pdim;
+ index_type psize;
+ const GFC_INTEGER_4 *pptr;
+
+ const GFC_INTEGER_4 *src;
+ int n;
+ int dim;
+
+ if (ret->dim[0].stride == 0)
+ ret->dim[0].stride = 1;
+ if (source->dim[0].stride == 0)
+ source->dim[0].stride = 1;
+ if (shape->dim[0].stride == 0)
+ shape->dim[0].stride = 1;
+ if (pad && pad->dim[0].stride == 0)
+ pad->dim[0].stride = 1;
+ if (order && order->dim[0].stride == 0)
+ order->dim[0].stride = 1;
+
+ rdim = GFC_DESCRIPTOR_RANK (ret);
+ rsize = 1;
+ for (n = 0; n < rdim; n++)
+ {
+ if (order)
+ dim = order->data[n * order->dim[0].stride] - 1;
+ else
+ dim = n;
+
+ rcount[n] = 0;
+ rstride[n] = ret->dim[dim].stride;
+ rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+
+ if (rextent[n] != shape->data[dim * shape->dim[0].stride])
+ runtime_error ("shape and target do not conform");
+
+ if (rsize == rstride[n])
+ rsize *= rextent[n];
+ else
+ rsize = 0;
+ if (rextent[dim] <= 0)
+ return;
+ }
+
+ sdim = GFC_DESCRIPTOR_RANK (source);
+ ssize = 1;
+ 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;
+ if (sextent[n] <= 0)
+ abort ();
+
+ if (ssize == sstride[n])
+ ssize *= sextent[n];
+ else
+ ssize = 0;
+ }
+
+ if (pad)
+ {
+ if (pad->dim[0].stride == 0)
+ pad->dim[0].stride = 1;
+ pdim = GFC_DESCRIPTOR_RANK (pad);
+ psize = 1;
+ 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;
+ if (pextent[n] <= 0)
+ abort ();
+ if (psize == pstride[n])
+ psize *= pextent[n];
+ else
+ psize = 0;
+ }
+ pptr = pad->data;
+ }
+ else
+ {
+ pdim = 0;
+ psize = 1;
+ pptr = NULL;
+ }
+
+ if (rsize != 0 && ssize != 0 && psize != 0)
+ {
+ rsize *= 4;
+ ssize *= 4;
+ psize *= 4;
+ reshape_packed ((char *)ret->data, rsize, (char *)source->data,
+ ssize, pad ? (char *)pad->data : NULL, psize);
+ return;
+ }
+ rptr = ret->data;
+ src = sptr = source->data;
+ rstride0 = rstride[0];
+ sstride0 = sstride[0];
+
+ while (rptr)
+ {
+ /* Select between the source and pad arrays. */
+ *rptr = *src;
+ /* Advance to the next element. */
+ rptr += rstride0;
+ src += sstride0;
+ rcount[0]++;
+ scount[0]++;
+ /* Advance to the next destination element. */
+ n = 0;
+ while (rcount[n] == rextent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ rcount[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ rptr -= rstride[n] * rextent[n];
+ n++;
+ if (n == rdim)
+ {
+ /* Break out of the loop. */
+ rptr = NULL;
+ break;
+ }
+ else
+ {
+ rcount[n]++;
+ rptr += rstride[n];
+ }
+ }
+ /* Advance to the next source element. */
+ n = 0;
+ while (scount[n] == sextent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ scount[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ src -= sstride[n] * sextent[n];
+ n++;
+ if (n == sdim)
+ {
+ if (sptr && pad)
+ {
+ /* Switch to the pad array. */
+ sptr = NULL;
+ sdim = pdim;
+ for (dim = 0; dim < pdim; dim++)
+ {
+ scount[dim] = pcount[dim];
+ sextent[dim] = pextent[dim];
+ sstride[dim] = pstride[dim];
+ sstride0 = sstride[0];
+ }
+ }
+ /* We now start again from the beginning of the pad array. */
+ src = pptr;
+ break;
+ }
+ else
+ {
+ scount[n]++;
+ src += sstride[n];
+ }
+ }
+ }
+ }
+
Index: libgfortran/generated/reshape_i8.c
===================================================================
RCS file: libgfortran/generated/reshape_i8.c
diff -N libgfortran/generated/reshape_i8.c
*** libgfortran/generated/reshape_i8.c 13 May 2004 06:41:01 -0000 1.2
--- /dev/null 1 Jan 1970 00:00:00 -0000
***************
*** 1,225 ****
- /* Implementation of the RESHAPE
- Copyright 2002 Free Software Foundation, Inc.
- Contributed by Paul Brook <paul@nowt.org>
-
- This file is part of the GNU Fortran 95 runtime library (libgfor).
-
- Libgfor is free software; you can redistribute it and/or
- modify it under the terms of the GNU Lesser General Public
- License as published by the Free Software Foundation; either
- version 2.1 of the License, or (at your option) any later version.
-
- Ligbfor is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU Lesser General Public License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with libgfor; see the file COPYING.LIB. If not,
- write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
- Boston, MA 02111-1307, USA. */
-
- #include "config.h"
- #include <stdlib.h>
- #include <assert.h>
- #include "libgfortran.h"
-
- typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
-
- /* The shape parameter is ignored. We can currently deduce the shape from the
- return array. */
- void
- __reshape_8 (gfc_array_i8 * ret, gfc_array_i8 * source, shape_type * shape,
- gfc_array_i8 * pad, shape_type * order)
- {
- /* r.* indicates the return array. */
- index_type rcount[GFC_MAX_DIMENSIONS - 1];
- index_type rextent[GFC_MAX_DIMENSIONS - 1];
- index_type rstride[GFC_MAX_DIMENSIONS - 1];
- index_type rstride0;
- index_type rdim;
- index_type rsize;
- GFC_INTEGER_8 *rptr;
- /* s.* indicates the source array. */
- index_type scount[GFC_MAX_DIMENSIONS - 1];
- index_type sextent[GFC_MAX_DIMENSIONS - 1];
- index_type sstride[GFC_MAX_DIMENSIONS - 1];
- index_type sstride0;
- index_type sdim;
- index_type ssize;
- const GFC_INTEGER_8 *sptr;
- /* p.* indicates the pad array. */
- index_type pcount[GFC_MAX_DIMENSIONS - 1];
- index_type pextent[GFC_MAX_DIMENSIONS - 1];
- index_type pstride[GFC_MAX_DIMENSIONS - 1];
- index_type pdim;
- index_type psize;
- const GFC_INTEGER_8 *pptr;
-
- const GFC_INTEGER_8 *src;
- int n;
- int dim;
-
- if (ret->dim[0].stride == 0)
- ret->dim[0].stride = 1;
- if (source->dim[0].stride == 0)
- source->dim[0].stride = 1;
- if (shape->dim[0].stride == 0)
- shape->dim[0].stride = 1;
- if (pad && pad->dim[0].stride == 0)
- pad->dim[0].stride = 1;
- if (order && order->dim[0].stride == 0)
- order->dim[0].stride = 1;
-
- rdim = GFC_DESCRIPTOR_RANK (ret);
- rsize = 1;
- for (n = 0; n < rdim; n++)
- {
- if (order)
- dim = order->data[n * order->dim[0].stride] - 1;
- else
- dim = n;
-
- rcount[n] = 0;
- rstride[n] = ret->dim[dim].stride;
- rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
-
- if (rextent[n] != shape->data[dim * shape->dim[0].stride])
- runtime_error ("shape and target do not conform");
-
- if (rsize == rstride[n])
- rsize *= rextent[n];
- else
- rsize = 0;
- if (rextent[dim] <= 0)
- return;
- }
-
- sdim = GFC_DESCRIPTOR_RANK (source);
- ssize = 1;
- 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;
- if (sextent[n] <= 0)
- abort ();
-
- if (ssize == sstride[n])
- ssize *= sextent[n];
- else
- ssize = 0;
- }
-
- if (pad)
- {
- if (pad->dim[0].stride == 0)
- pad->dim[0].stride = 1;
- pdim = GFC_DESCRIPTOR_RANK (pad);
- psize = 1;
- 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;
- if (pextent[n] <= 0)
- abort ();
- if (psize == pstride[n])
- psize *= pextent[n];
- else
- psize = 0;
- }
- pptr = pad->data;
- }
- else
- {
- pdim = 0;
- psize = 1;
- pptr = NULL;
- }
-
- if (rsize != 0 && ssize != 0 && psize != 0)
- {
- rsize *= 8;
- ssize *= 8;
- psize *= 8;
- reshape_packed ((char *)ret->data, rsize, (char *)source->data,
- ssize, pad ? (char *)pad->data : NULL, psize);
- return;
- }
- rptr = ret->data;
- src = sptr = source->data;
- rstride0 = rstride[0];
- sstride0 = sstride[0];
-
- while (rptr)
- {
- /* Select between the source and pad arrays. */
- *rptr = *src;
- /* Advance to the next element. */
- rptr += rstride0;
- src += sstride0;
- rcount[0]++;
- scount[0]++;
- /* Advance to the next destination element. */
- n = 0;
- while (rcount[n] == rextent[n])
- {
- /* When we get to the end of a dimension, reset it and increment
- the next dimension. */
- rcount[n] = 0;
- /* We could precalculate these products, but this is a less
- frequently used path so proabably not worth it. */
- rptr -= rstride[n] * rextent[n];
- n++;
- if (n == rdim)
- {
- /* Break out of the loop. */
- rptr = NULL;
- break;
- }
- else
- {
- rcount[n]++;
- rptr += rstride[n];
- }
- }
- /* Advance to the next source element. */
- n = 0;
- while (scount[n] == sextent[n])
- {
- /* When we get to the end of a dimension, reset it and increment
- the next dimension. */
- scount[n] = 0;
- /* We could precalculate these products, but this is a less
- frequently used path so proabably not worth it. */
- src -= sstride[n] * sextent[n];
- n++;
- if (n == sdim)
- {
- if (sptr && pad)
- {
- /* Switch to the pad array. */
- sptr = NULL;
- sdim = pdim;
- for (dim = 0; dim < pdim; dim++)
- {
- scount[dim] = pcount[dim];
- sextent[dim] = pextent[dim];
- sstride[dim] = pstride[dim];
- sstride0 = sstride[0];
- }
- }
- /* We now start again from the beginning of the pad array. */
- src = pptr;
- break;
- }
- else
- {
- scount[n]++;
- src += sstride[n];
- }
- }
- }
- }
-
--- 0 ----
Index: libgfortran/generated/reshape_i8_i4.c
===================================================================
RCS file: libgfortran/generated/reshape_i8_i4.c
diff -N libgfortran/generated/reshape_i8_i4.c
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- libgfortran/generated/reshape_i8_i4.c 6 Dec 2004 02:43:12 -0000
***************
*** 0 ****
--- 1,226 ----
+ /* Implementation of the RESHAPE
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+ This file is part of the GNU Fortran 95 runtime library (libgfor).
+
+ Libgfor is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ Ligbfor is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with libgfor; see the file COPYING.LIB. If not,
+ write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+ #include "config.h"
+ #include <stdlib.h>
+ #include <assert.h>
+ #include "libgfortran.h"
+
+ typedef GFC_ARRAY_DESCRIPTOR(1, GFC_INTEGER_4) shape_type;
+
+ /* The shape parameter is ignored. We can currently deduce the shape from the
+ return array. */
+ void
+ __reshape_8_4 (gfc_array_i8 * ret, gfc_array_i8 * source,
+ shape_type * shape, gfc_array_i8 * pad,
+ shape_type * order)
+ {
+ /* r.* indicates the return array. */
+ index_type rcount[GFC_MAX_DIMENSIONS - 1];
+ index_type rextent[GFC_MAX_DIMENSIONS - 1];
+ index_type rstride[GFC_MAX_DIMENSIONS - 1];
+ index_type rstride0;
+ index_type rdim;
+ index_type rsize;
+ GFC_INTEGER_8 *rptr;
+ /* s.* indicates the source array. */
+ index_type scount[GFC_MAX_DIMENSIONS - 1];
+ index_type sextent[GFC_MAX_DIMENSIONS - 1];
+ index_type sstride[GFC_MAX_DIMENSIONS - 1];
+ index_type sstride0;
+ index_type sdim;
+ index_type ssize;
+ const GFC_INTEGER_8 *sptr;
+ /* p.* indicates the pad array. */
+ index_type pcount[GFC_MAX_DIMENSIONS - 1];
+ index_type pextent[GFC_MAX_DIMENSIONS - 1];
+ index_type pstride[GFC_MAX_DIMENSIONS - 1];
+ index_type pdim;
+ index_type psize;
+ const GFC_INTEGER_8 *pptr;
+
+ const GFC_INTEGER_8 *src;
+ int n;
+ int dim;
+
+ if (ret->dim[0].stride == 0)
+ ret->dim[0].stride = 1;
+ if (source->dim[0].stride == 0)
+ source->dim[0].stride = 1;
+ if (shape->dim[0].stride == 0)
+ shape->dim[0].stride = 1;
+ if (pad && pad->dim[0].stride == 0)
+ pad->dim[0].stride = 1;
+ if (order && order->dim[0].stride == 0)
+ order->dim[0].stride = 1;
+
+ rdim = GFC_DESCRIPTOR_RANK (ret);
+ rsize = 1;
+ for (n = 0; n < rdim; n++)
+ {
+ if (order)
+ dim = order->data[n * order->dim[0].stride] - 1;
+ else
+ dim = n;
+
+ rcount[n] = 0;
+ rstride[n] = ret->dim[dim].stride;
+ rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+
+ if (rextent[n] != shape->data[dim * shape->dim[0].stride])
+ runtime_error ("shape and target do not conform");
+
+ if (rsize == rstride[n])
+ rsize *= rextent[n];
+ else
+ rsize = 0;
+ if (rextent[dim] <= 0)
+ return;
+ }
+
+ sdim = GFC_DESCRIPTOR_RANK (source);
+ ssize = 1;
+ 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;
+ if (sextent[n] <= 0)
+ abort ();
+
+ if (ssize == sstride[n])
+ ssize *= sextent[n];
+ else
+ ssize = 0;
+ }
+
+ if (pad)
+ {
+ if (pad->dim[0].stride == 0)
+ pad->dim[0].stride = 1;
+ pdim = GFC_DESCRIPTOR_RANK (pad);
+ psize = 1;
+ 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;
+ if (pextent[n] <= 0)
+ abort ();
+ if (psize == pstride[n])
+ psize *= pextent[n];
+ else
+ psize = 0;
+ }
+ pptr = pad->data;
+ }
+ else
+ {
+ pdim = 0;
+ psize = 1;
+ pptr = NULL;
+ }
+
+ if (rsize != 0 && ssize != 0 && psize != 0)
+ {
+ rsize *= 8;
+ ssize *= 8;
+ psize *= 8;
+ reshape_packed ((char *)ret->data, rsize, (char *)source->data,
+ ssize, pad ? (char *)pad->data : NULL, psize);
+ return;
+ }
+ rptr = ret->data;
+ src = sptr = source->data;
+ rstride0 = rstride[0];
+ sstride0 = sstride[0];
+
+ while (rptr)
+ {
+ /* Select between the source and pad arrays. */
+ *rptr = *src;
+ /* Advance to the next element. */
+ rptr += rstride0;
+ src += sstride0;
+ rcount[0]++;
+ scount[0]++;
+ /* Advance to the next destination element. */
+ n = 0;
+ while (rcount[n] == rextent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ rcount[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ rptr -= rstride[n] * rextent[n];
+ n++;
+ if (n == rdim)
+ {
+ /* Break out of the loop. */
+ rptr = NULL;
+ break;
+ }
+ else
+ {
+ rcount[n]++;
+ rptr += rstride[n];
+ }
+ }
+ /* Advance to the next source element. */
+ n = 0;
+ while (scount[n] == sextent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ scount[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ src -= sstride[n] * sextent[n];
+ n++;
+ if (n == sdim)
+ {
+ if (sptr && pad)
+ {
+ /* Switch to the pad array. */
+ sptr = NULL;
+ sdim = pdim;
+ for (dim = 0; dim < pdim; dim++)
+ {
+ scount[dim] = pcount[dim];
+ sextent[dim] = pextent[dim];
+ sstride[dim] = pstride[dim];
+ sstride0 = sstride[0];
+ }
+ }
+ /* We now start again from the beginning of the pad array. */
+ src = pptr;
+ break;
+ }
+ else
+ {
+ scount[n]++;
+ src += sstride[n];
+ }
+ }
+ }
+ }
+
Index: libgfortran/generated/reshape_i8_i8.c
===================================================================
RCS file: libgfortran/generated/reshape_i8_i8.c
diff -N libgfortran/generated/reshape_i8_i8.c
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- libgfortran/generated/reshape_i8_i8.c 6 Dec 2004 02:43:12 -0000
***************
*** 0 ****
--- 1,226 ----
+ /* Implementation of the RESHAPE
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+ This file is part of the GNU Fortran 95 runtime library (libgfor).
+
+ Libgfor is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ Ligbfor is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with libgfor; see the file COPYING.LIB. If not,
+ write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+ #include "config.h"
+ #include <stdlib.h>
+ #include <assert.h>
+ #include "libgfortran.h"
+
+ typedef GFC_ARRAY_DESCRIPTOR(1, GFC_INTEGER_8) shape_type;
+
+ /* The shape parameter is ignored. We can currently deduce the shape from the
+ return array. */
+ void
+ __reshape_8_8 (gfc_array_i8 * ret, gfc_array_i8 * source,
+ shape_type * shape, gfc_array_i8 * pad,
+ shape_type * order)
+ {
+ /* r.* indicates the return array. */
+ index_type rcount[GFC_MAX_DIMENSIONS - 1];
+ index_type rextent[GFC_MAX_DIMENSIONS - 1];
+ index_type rstride[GFC_MAX_DIMENSIONS - 1];
+ index_type rstride0;
+ index_type rdim;
+ index_type rsize;
+ GFC_INTEGER_8 *rptr;
+ /* s.* indicates the source array. */
+ index_type scount[GFC_MAX_DIMENSIONS - 1];
+ index_type sextent[GFC_MAX_DIMENSIONS - 1];
+ index_type sstride[GFC_MAX_DIMENSIONS - 1];
+ index_type sstride0;
+ index_type sdim;
+ index_type ssize;
+ const GFC_INTEGER_8 *sptr;
+ /* p.* indicates the pad array. */
+ index_type pcount[GFC_MAX_DIMENSIONS - 1];
+ index_type pextent[GFC_MAX_DIMENSIONS - 1];
+ index_type pstride[GFC_MAX_DIMENSIONS - 1];
+ index_type pdim;
+ index_type psize;
+ const GFC_INTEGER_8 *pptr;
+
+ const GFC_INTEGER_8 *src;
+ int n;
+ int dim;
+
+ if (ret->dim[0].stride == 0)
+ ret->dim[0].stride = 1;
+ if (source->dim[0].stride == 0)
+ source->dim[0].stride = 1;
+ if (shape->dim[0].stride == 0)
+ shape->dim[0].stride = 1;
+ if (pad && pad->dim[0].stride == 0)
+ pad->dim[0].stride = 1;
+ if (order && order->dim[0].stride == 0)
+ order->dim[0].stride = 1;
+
+ rdim = GFC_DESCRIPTOR_RANK (ret);
+ rsize = 1;
+ for (n = 0; n < rdim; n++)
+ {
+ if (order)
+ dim = order->data[n * order->dim[0].stride] - 1;
+ else
+ dim = n;
+
+ rcount[n] = 0;
+ rstride[n] = ret->dim[dim].stride;
+ rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+
+ if (rextent[n] != shape->data[dim * shape->dim[0].stride])
+ runtime_error ("shape and target do not conform");
+
+ if (rsize == rstride[n])
+ rsize *= rextent[n];
+ else
+ rsize = 0;
+ if (rextent[dim] <= 0)
+ return;
+ }
+
+ sdim = GFC_DESCRIPTOR_RANK (source);
+ ssize = 1;
+ 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;
+ if (sextent[n] <= 0)
+ abort ();
+
+ if (ssize == sstride[n])
+ ssize *= sextent[n];
+ else
+ ssize = 0;
+ }
+
+ if (pad)
+ {
+ if (pad->dim[0].stride == 0)
+ pad->dim[0].stride = 1;
+ pdim = GFC_DESCRIPTOR_RANK (pad);
+ psize = 1;
+ 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;
+ if (pextent[n] <= 0)
+ abort ();
+ if (psize == pstride[n])
+ psize *= pextent[n];
+ else
+ psize = 0;
+ }
+ pptr = pad->data;
+ }
+ else
+ {
+ pdim = 0;
+ psize = 1;
+ pptr = NULL;
+ }
+
+ if (rsize != 0 && ssize != 0 && psize != 0)
+ {
+ rsize *= 8;
+ ssize *= 8;
+ psize *= 8;
+ reshape_packed ((char *)ret->data, rsize, (char *)source->data,
+ ssize, pad ? (char *)pad->data : NULL, psize);
+ return;
+ }
+ rptr = ret->data;
+ src = sptr = source->data;
+ rstride0 = rstride[0];
+ sstride0 = sstride[0];
+
+ while (rptr)
+ {
+ /* Select between the source and pad arrays. */
+ *rptr = *src;
+ /* Advance to the next element. */
+ rptr += rstride0;
+ src += sstride0;
+ rcount[0]++;
+ scount[0]++;
+ /* Advance to the next destination element. */
+ n = 0;
+ while (rcount[n] == rextent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ rcount[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ rptr -= rstride[n] * rextent[n];
+ n++;
+ if (n == rdim)
+ {
+ /* Break out of the loop. */
+ rptr = NULL;
+ break;
+ }
+ else
+ {
+ rcount[n]++;
+ rptr += rstride[n];
+ }
+ }
+ /* Advance to the next source element. */
+ n = 0;
+ while (scount[n] == sextent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ scount[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ src -= sstride[n] * sextent[n];
+ n++;
+ if (n == sdim)
+ {
+ if (sptr && pad)
+ {
+ /* Switch to the pad array. */
+ sptr = NULL;
+ sdim = pdim;
+ for (dim = 0; dim < pdim; dim++)
+ {
+ scount[dim] = pcount[dim];
+ sextent[dim] = pextent[dim];
+ sstride[dim] = pstride[dim];
+ sstride0 = sstride[0];
+ }
+ }
+ /* We now start again from the beginning of the pad array. */
+ src = pptr;
+ break;
+ }
+ else
+ {
+ scount[n]++;
+ src += sstride[n];
+ }
+ }
+ }
+ }
+
Index: libgfortran/intrinsics/reshape_generic.c
===================================================================
RCS file: libgfortran/intrinsics/reshape_generic.c
diff -N libgfortran/intrinsics/reshape_generic.c
*** libgfortran/intrinsics/reshape_generic.c 13 May 2004 06:41:02 -0000 1.2
--- /dev/null 1 Jan 1970 00:00:00 -0000
***************
*** 1,231 ****
- /* Generic implementation of the RESHAPE intrinsic
- Copyright 2002 Free Software Foundation, Inc.
- Contributed by Paul Brook <paul@nowt.org>
-
- This file is part of the GNU Fortran 95 runtime library (libgfor).
-
- Libgfor is free software; you can redistribute it and/or
- modify it under the terms of the GNU Lesser General Public
- License as published by the Free Software Foundation; either
- version 2.1 of the License, or (at your option) any later version.
-
- Ligbfor is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU Lesser General Public License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with libgfor; see the file COPYING.LIB. If not,
- write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
- Boston, MA 02111-1307, USA. */
-
- #include "config.h"
- #include <stdlib.h>
- #include <string.h>
- #include <assert.h>
- #include "libgfortran.h"
-
- typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
- typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) parray;
-
-
- /* The shape parameter is ignored. We can currently deduce the shape from the
- return array. */
-
- void
- __reshape (parray * ret, parray * source, shape_type * shape,
- parray * pad, shape_type * order)
- {
- /* r.* indicates the return array. */
- index_type rcount[GFC_MAX_DIMENSIONS - 1];
- index_type rextent[GFC_MAX_DIMENSIONS - 1];
- index_type rstride[GFC_MAX_DIMENSIONS - 1];
- index_type rstride0;
- index_type rdim;
- index_type rsize;
- char *rptr;
- /* s.* indicates the source array. */
- index_type scount[GFC_MAX_DIMENSIONS - 1];
- index_type sextent[GFC_MAX_DIMENSIONS - 1];
- index_type sstride[GFC_MAX_DIMENSIONS - 1];
- index_type sstride0;
- index_type sdim;
- index_type ssize;
- const char *sptr;
- /* p.* indicates the pad array. */
- index_type pcount[GFC_MAX_DIMENSIONS - 1];
- index_type pextent[GFC_MAX_DIMENSIONS - 1];
- index_type pstride[GFC_MAX_DIMENSIONS - 1];
- index_type pdim;
- index_type psize;
- const char *pptr;
-
- const char *src;
- int n;
- int dim;
- int size;
-
- size = GFC_DESCRIPTOR_SIZE (ret);
- if (ret->dim[0].stride == 0)
- ret->dim[0].stride = 1;
- if (source->dim[0].stride == 0)
- source->dim[0].stride = 1;
- if (shape->dim[0].stride == 0)
- shape->dim[0].stride = 1;
- if (pad && pad->dim[0].stride == 0)
- pad->dim[0].stride = 1;
- if (order && order->dim[0].stride == 0)
- order->dim[0].stride = 1;
-
- rdim = GFC_DESCRIPTOR_RANK (ret);
- rsize = 1;
- for (n = 0; n < rdim; n++)
- {
- if (order)
- dim = order->data[n * order->dim[0].stride] - 1;
- else
- dim = n;
-
- rcount[n] = 0;
- rstride[n] = ret->dim[dim].stride;
- rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
-
- if (rextent[n] != shape->data[dim * shape->dim[0].stride])
- runtime_error ("shape and target do not conform");
-
- if (rsize == rstride[n])
- rsize *= rextent[n];
- else
- rsize = 0;
- if (rextent[dim] <= 0)
- return;
- }
-
- sdim = GFC_DESCRIPTOR_RANK (source);
- ssize = 1;
- 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;
- if (sextent[n] <= 0)
- abort ();
-
- if (rsize == sstride[n])
- ssize *= sextent[n];
- else
- ssize = 0;
- }
-
- if (pad)
- {
- if (pad->dim[0].stride == 0)
- pad->dim[0].stride = 1;
- pdim = GFC_DESCRIPTOR_RANK (pad);
- psize = 1;
- 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;
- if (pextent[n] <= 0)
- abort ();
- if (psize == pstride[n])
- psize *= pextent[n];
- else
- rsize = 0;
- }
- pptr = pad->data;
- }
- else
- {
- pdim = 0;
- psize = 1;
- pptr = NULL;
- }
-
- if (rsize != 0 && ssize != 0 && psize != 0)
- {
- rsize *= size;
- ssize *= size;
- psize *= size;
- reshape_packed (ret->data, rsize, source->data, ssize,
- pad ? pad->data : NULL, psize);
- return;
- }
- rptr = ret->data;
- src = sptr = source->data;
- rstride0 = rstride[0] * size;
- sstride0 = sstride[0] * size;
-
- while (rptr)
- {
- /* Select between the source and pad arrays. */
- memcpy(rptr, src, size);
- /* Advance to the next element. */
- rptr += rstride0;
- src += sstride0;
- rcount[0]++;
- scount[0]++;
- /* Advance to the next destination element. */
- n = 0;
- while (rcount[n] == rextent[n])
- {
- /* When we get to the end of a dimension, reset it and increment
- the next dimension. */
- rcount[n] = 0;
- /* We could precalculate these products, but this is a less
- frequently used path so proabably not worth it. */
- rptr -= rstride[n] * rextent[n] * size;
- n++;
- if (n == rdim)
- {
- /* Break out of the loop. */
- rptr = NULL;
- break;
- }
- else
- {
- rcount[n]++;
- rptr += rstride[n] * size;
- }
- }
- /* Advance to the next source element. */
- n = 0;
- while (scount[n] == sextent[n])
- {
- /* When we get to the end of a dimension, reset it and increment
- the next dimension. */
- scount[n] = 0;
- /* We could precalculate these products, but this is a less
- frequently used path so proabably not worth it. */
- src -= sstride[n] * sextent[n] * size;
- n++;
- if (n == sdim)
- {
- if (sptr && pad)
- {
- /* Switch to the pad array. */
- sptr = NULL;
- sdim = pdim;
- for (dim = 0; dim < pdim; dim++)
- {
- scount[dim] = pcount[dim];
- sextent[dim] = pextent[dim];
- sstride[dim] = pstride[dim];
- sstride0 = sstride[0] * size;
- }
- }
- /* We now start again from the beginning of the pad array. */
- src = pptr;
- break;
- }
- else
- {
- scount[n]++;
- sptr += sstride[n] * size;
- }
- }
- }
- }
-
--- 0 ----
Index: libgfortran/m4/reshape.m4
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/m4/reshape.m4,v
retrieving revision 1.3
diff -c -p -d -r1.3 reshape.m4
*** libgfortran/m4/reshape.m4 18 May 2004 19:03:26 -0000 1.3
--- libgfortran/m4/reshape.m4 6 Dec 2004 02:43:12 -0000
*************** Boston, MA 02111-1307, USA. */
*** 25,38 ****
#include "libgfortran.h"'
include(iparm.m4)dnl
! typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
/* The shape parameter is ignored. We can currently deduce the shape from the
return array. */
dnl Only the kind (ie size) is used to name the function.
void
! `__reshape_'rtype_kind (rtype * ret, rtype * source, shape_type * shape,
! rtype * pad, shape_type * order)
{
/* r.* indicates the return array. */
index_type rcount[GFC_MAX_DIMENSIONS - 1];
--- 25,39 ----
#include "libgfortran.h"'
include(iparm.m4)dnl
! typedef GFC_ARRAY_DESCRIPTOR(1, atype_name) shape_type;
/* The shape parameter is ignored. We can currently deduce the shape from the
return array. */
dnl Only the kind (ie size) is used to name the function.
void
! `__reshape_'rtype_kind`_'atype_kind (rtype * ret, rtype * source,
! shape_type * shape, rtype * pad,
! shape_type * order)
{
/* r.* indicates the return array. */
index_type rcount[GFC_MAX_DIMENSIONS - 1];
Index: libgfortran/m4/reshape_gen.m4
===================================================================
RCS file: libgfortran/m4/reshape_gen.m4
diff -N libgfortran/m4/reshape_gen.m4
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- libgfortran/m4/reshape_gen.m4 6 Dec 2004 02:43:12 -0000
***************
*** 0 ****
--- 1,231 ----
+ /* Generic implementation of the RESHAPE intrinsic
+ Copyright 2002, 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+ This file is part of the GNU Fortran 95 runtime library (libgfor).
+
+ Libgfor is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ Ligbfor is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with libgfor; see the file COPYING.LIB. If not,
+ write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+ #include "config.h"
+ #include <stdlib.h>
+ #include <string.h>
+ #include <assert.h>
+ #include "libgfortran.h"
+ include(iparm.m4)dnl
+
+ typedef GFC_ARRAY_DESCRIPTOR(1, rtype_name) shape_type;
+ typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) parray;
+
+ /* The shape parameter is ignored. We can currently deduce the shape from the
+ return array. */
+
+ void
+ `__reshape_gen_'rtype_kind (parray * ret, parray * source, shape_type * shape,
+ parray * pad, shape_type * order)
+ {
+ /* r.* indicates the return array. */
+ index_type rcount[GFC_MAX_DIMENSIONS - 1];
+ index_type rextent[GFC_MAX_DIMENSIONS - 1];
+ index_type rstride[GFC_MAX_DIMENSIONS - 1];
+ index_type rstride0;
+ index_type rdim;
+ index_type rsize;
+ char *rptr;
+ /* s.* indicates the source array. */
+ index_type scount[GFC_MAX_DIMENSIONS - 1];
+ index_type sextent[GFC_MAX_DIMENSIONS - 1];
+ index_type sstride[GFC_MAX_DIMENSIONS - 1];
+ index_type sstride0;
+ index_type sdim;
+ index_type ssize;
+ const char *sptr;
+ /* p.* indicates the pad array. */
+ index_type pcount[GFC_MAX_DIMENSIONS - 1];
+ index_type pextent[GFC_MAX_DIMENSIONS - 1];
+ index_type pstride[GFC_MAX_DIMENSIONS - 1];
+ index_type pdim;
+ index_type psize;
+ const char *pptr;
+
+ const char *src;
+ int n;
+ int dim;
+ int size;
+
+ size = GFC_DESCRIPTOR_SIZE (ret);
+ if (ret->dim[0].stride == 0)
+ ret->dim[0].stride = 1;
+ if (source->dim[0].stride == 0)
+ source->dim[0].stride = 1;
+ if (shape->dim[0].stride == 0)
+ shape->dim[0].stride = 1;
+ if (pad && pad->dim[0].stride == 0)
+ pad->dim[0].stride = 1;
+ if (order && order->dim[0].stride == 0)
+ order->dim[0].stride = 1;
+
+ rdim = GFC_DESCRIPTOR_RANK (ret);
+ rsize = 1;
+ for (n = 0; n < rdim; n++)
+ {
+ if (order)
+ dim = order->data[n * order->dim[0].stride] - 1;
+ else
+ dim = n;
+
+ rcount[n] = 0;
+ rstride[n] = ret->dim[dim].stride;
+ rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+
+ if (rextent[n] != shape->data[dim * shape->dim[0].stride])
+ runtime_error ("shape and target do not conform");
+
+ if (rsize == rstride[n])
+ rsize *= rextent[n];
+ else
+ rsize = 0;
+ if (rextent[dim] <= 0)
+ return;
+ }
+
+ sdim = GFC_DESCRIPTOR_RANK (source);
+ ssize = 1;
+ 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;
+ if (sextent[n] <= 0)
+ abort ();
+
+ if (rsize == sstride[n])
+ ssize *= sextent[n];
+ else
+ ssize = 0;
+ }
+
+ if (pad)
+ {
+ if (pad->dim[0].stride == 0)
+ pad->dim[0].stride = 1;
+ pdim = GFC_DESCRIPTOR_RANK (pad);
+ psize = 1;
+ 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;
+ if (pextent[n] <= 0)
+ abort ();
+ if (psize == pstride[n])
+ psize *= pextent[n];
+ else
+ rsize = 0;
+ }
+ pptr = pad->data;
+ }
+ else
+ {
+ pdim = 0;
+ psize = 1;
+ pptr = NULL;
+ }
+
+ if (rsize != 0 && ssize != 0 && psize != 0)
+ {
+ rsize *= size;
+ ssize *= size;
+ psize *= size;
+ reshape_packed (ret->data, rsize, source->data, ssize,
+ pad ? pad->data : NULL, psize);
+ return;
+ }
+ rptr = ret->data;
+ src = sptr = source->data;
+ rstride0 = rstride[0] * size;
+ sstride0 = sstride[0] * size;
+
+ while (rptr)
+ {
+ /* Select between the source and pad arrays. */
+ memcpy(rptr, src, size);
+ /* Advance to the next element. */
+ rptr += rstride0;
+ src += sstride0;
+ rcount[0]++;
+ scount[0]++;
+ /* Advance to the next destination element. */
+ n = 0;
+ while (rcount[n] == rextent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ rcount[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ rptr -= rstride[n] * rextent[n] * size;
+ n++;
+ if (n == rdim)
+ {
+ /* Break out of the loop. */
+ rptr = NULL;
+ break;
+ }
+ else
+ {
+ rcount[n]++;
+ rptr += rstride[n] * size;
+ }
+ }
+ /* Advance to the next source element. */
+ n = 0;
+ while (scount[n] == sextent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ scount[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ src -= sstride[n] * sextent[n] * size;
+ n++;
+ if (n == sdim)
+ {
+ if (sptr && pad)
+ {
+ /* Switch to the pad array. */
+ sptr = NULL;
+ sdim = pdim;
+ for (dim = 0; dim < pdim; dim++)
+ {
+ scount[dim] = pcount[dim];
+ sextent[dim] = pextent[dim];
+ sstride[dim] = pstride[dim];
+ sstride0 = sstride[0] * size;
+ }
+ }
+ /* We now start again from the beginning of the pad array. */
+ src = pptr;
+ break;
+ }
+ else
+ {
+ scount[n]++;
+ sptr += sstride[n] * size;
+ }
+ }
+ }
+ }
+
More information about the Fortran
mailing list