aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/testsuite/ChangeLog4
-rw-r--r--gcc/testsuite/gfortran.fortran-torture/execute/in-pack.f9092
-rw-r--r--libgfortran/Makefile.am8
-rw-r--r--libgfortran/Makefile.in26
-rw-r--r--libgfortran/generated/in_pack_c4.c123
-rw-r--r--libgfortran/generated/in_pack_c8.c123
-rw-r--r--libgfortran/generated/in_pack_i4.c2
-rw-r--r--libgfortran/generated/in_pack_i8.c2
-rw-r--r--libgfortran/generated/in_unpack_c4.c111
-rw-r--r--libgfortran/generated/in_unpack_c8.c111
-rw-r--r--libgfortran/generated/in_unpack_i4.c2
-rw-r--r--libgfortran/generated/in_unpack_i8.c2
-rw-r--r--libgfortran/libgfortran.h14
-rw-r--r--libgfortran/m4/in_pack.m47
-rw-r--r--libgfortran/m4/in_unpack.m47
-rw-r--r--libgfortran/runtime/in_pack_generic.c35
-rw-r--r--libgfortran/runtime/in_unpack_generic.c39
17 files changed, 677 insertions, 31 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5c33deb..1dced9a 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2005-05-11 Thomas Koenig <Thomas.Koenig@online.de>
+
+ * gfortran.fortran-torture/execute/in-pack.f90: New test.
+
2005-06-10 Dorit Nuzman <dorit@il.ibm.com>
* gfortran.dg/vect/vect-4.f90: Update comments. Only one unaligned
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/in-pack.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/in-pack.f90
new file mode 100644
index 0000000..b9ea268
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/in-pack.f90
@@ -0,0 +1,92 @@
+! Check in_pack and in_unpack for integer and comlex types, with
+! alignment issues thrown in for good measure.
+
+program main
+ implicit none
+
+ complex(kind=4) :: a4(5),b4(5),aa4(5),bb4(5)
+ real(kind=4) :: r4(100)
+ equivalence(a4(1),r4(1)),(b4(1),r4(12))
+
+ complex(kind=8) :: a8(5),b8(5),aa8(5),bb8(5)
+ real(kind=8) :: r8(100)
+ equivalence(a8(1),r8(1)),(b8(1),r8(12))
+
+ integer(kind=4) :: i4(5),ii4(5)
+ integer(kind=8) :: i8(5),ii8(5)
+
+ integer :: i
+
+ a4 = (/(cmplx(i,-i,kind=4),i=1,5)/)
+ b4 = (/(2*cmplx(i,-i,kind=4),i=1,5)/)
+ call csub4(a4(5:1:-1),b4(5:1:-1),5)
+ aa4 = (/(cmplx(5-i+1,i-5-1,kind=4),i=1,5)/)
+ if (any(aa4 /= a4)) call abort
+ bb4 = (/(2*cmplx(5-i+1,i-5-1,kind=4),i=1,5)/)
+ if (any(bb4 /= b4)) call abort
+
+ a8 = (/(cmplx(i,-i,kind=8),i=1,5)/)
+ b8 = (/(2*cmplx(i,-i,kind=8),i=1,5)/)
+ call csub8(a8(5:1:-1),b8(5:1:-1),5)
+ aa8 = (/(cmplx(5-i+1,i-5-1,kind=8),i=1,5)/)
+ if (any(aa8 /= a8)) call abort
+ bb8 = (/(2*cmplx(5-i+1,i-5-1,kind=8),i=1,5)/)
+ if (any(bb8 /= b8)) call abort
+
+ i4 = (/(i, i=1,5)/)
+ call isub4(i4(5:1:-1),5)
+ ii4 = (/(5-i+1,i=1,5)/)
+ if (any(ii4 /= i4)) call abort
+
+ i8 = (/(i,i=1,5)/)
+ call isub8(i8(5:1:-1),5)
+ ii8 = (/(5-i+1,i=1,5)/)
+ if (any(ii8 /= i8)) call abort
+
+end program main
+
+subroutine csub4(a,b,n)
+ implicit none
+ complex(kind=4), dimension(n) :: a,b
+ complex(kind=4), dimension(n) :: aa, bb
+ integer :: n, i
+ aa = (/(cmplx(n-i+1,i-n-1,kind=4),i=1,n)/)
+ if (any(aa /= a)) call abort
+ bb = (/(2*cmplx(n-i+1,i-n-1,kind=4),i=1,5)/)
+ if (any(bb /= b)) call abort
+ a = (/(cmplx(i,-i,kind=4),i=1,5)/)
+ b = (/(2*cmplx(i,-i,kind=4),i=1,5)/)
+end subroutine csub4
+
+subroutine csub8(a,b,n)
+ implicit none
+ complex(kind=8), dimension(n) :: a,b
+ complex(kind=8), dimension(n) :: aa, bb
+ integer :: n, i
+ aa = (/(cmplx(n-i+1,i-n-1,kind=8),i=1,n)/)
+ if (any(aa /= a)) call abort
+ bb = (/(2*cmplx(n-i+1,i-n-1,kind=8),i=1,5)/)
+ if (any(bb /= b)) call abort
+ a = (/(cmplx(i,-i,kind=8),i=1,5)/)
+ b = (/(2*cmplx(i,-i,kind=8),i=1,5)/)
+end subroutine csub8
+
+subroutine isub4(a,n)
+ implicit none
+ integer(kind=4), dimension(n) :: a
+ integer(kind=4), dimension(n) :: aa
+ integer :: n, i
+ aa = (/(n-i+1,i=1,n)/)
+ if (any(aa /= a)) call abort
+ a = (/(i,i=1,5)/)
+end subroutine isub4
+
+subroutine isub8(a,n)
+ implicit none
+ integer(kind=8), dimension(n) :: a
+ integer(kind=8), dimension(n) :: aa
+ integer :: n, i
+ aa = (/(n-i+1,i=1,n)/)
+ if (any(aa /= a)) call abort
+ a = (/(i,i=1,5)/)
+end subroutine isub8
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index 0e1893b..43fc988 100644
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -243,11 +243,15 @@ generated/cshift1_8.c
in_pack_c = \
generated/in_pack_i4.c \
-generated/in_pack_i8.c
+generated/in_pack_i8.c \
+generated/in_pack_c4.c \
+generated/in_pack_c8.c
in_unpack_c = \
generated/in_unpack_i4.c \
-generated/in_unpack_i8.c
+generated/in_unpack_i8.c \
+generated/in_unpack_c4.c \
+generated/in_unpack_c8.c
i_exponent_c = \
generated/exponent_r4.c \
diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index 0240dd1..4fc4357 100644
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -104,8 +104,10 @@ am__objects_21 = eoshift3_4.lo eoshift3_8.lo
am__objects_22 = cshift1_4.lo cshift1_8.lo
am__objects_23 = reshape_i4.lo reshape_i8.lo reshape_c4.lo \
reshape_c8.lo
-am__objects_24 = in_pack_i4.lo in_pack_i8.lo
-am__objects_25 = in_unpack_i4.lo in_unpack_i8.lo
+am__objects_24 = in_pack_i4.lo in_pack_i8.lo in_pack_c4.lo \
+ in_pack_c8.lo
+am__objects_25 = in_unpack_i4.lo in_unpack_i8.lo in_unpack_c4.lo \
+ in_unpack_c8.lo
am__objects_26 = exponent_r4.lo exponent_r8.lo
am__objects_27 = fraction_r4.lo fraction_r8.lo
am__objects_28 = nearest_r4.lo nearest_r8.lo
@@ -533,11 +535,15 @@ generated/cshift1_8.c
in_pack_c = \
generated/in_pack_i4.c \
-generated/in_pack_i8.c
+generated/in_pack_i8.c \
+generated/in_pack_c4.c \
+generated/in_pack_c8.c
in_unpack_c = \
generated/in_unpack_i4.c \
-generated/in_unpack_i8.c
+generated/in_unpack_i8.c \
+generated/in_unpack_c4.c \
+generated/in_unpack_c8.c
i_exponent_c = \
generated/exponent_r4.c \
@@ -1129,12 +1135,24 @@ in_pack_i4.lo: generated/in_pack_i4.c
in_pack_i8.lo: generated/in_pack_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i8.lo `test -f 'generated/in_pack_i8.c' || echo '$(srcdir)/'`generated/in_pack_i8.c
+in_pack_c4.lo: generated/in_pack_c4.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c4.lo `test -f 'generated/in_pack_c4.c' || echo '$(srcdir)/'`generated/in_pack_c4.c
+
+in_pack_c8.lo: generated/in_pack_c8.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c8.lo `test -f 'generated/in_pack_c8.c' || echo '$(srcdir)/'`generated/in_pack_c8.c
+
in_unpack_i4.lo: generated/in_unpack_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i4.lo `test -f 'generated/in_unpack_i4.c' || echo '$(srcdir)/'`generated/in_unpack_i4.c
in_unpack_i8.lo: generated/in_unpack_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i8.lo `test -f 'generated/in_unpack_i8.c' || echo '$(srcdir)/'`generated/in_unpack_i8.c
+in_unpack_c4.lo: generated/in_unpack_c4.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c4.lo `test -f 'generated/in_unpack_c4.c' || echo '$(srcdir)/'`generated/in_unpack_c4.c
+
+in_unpack_c8.lo: generated/in_unpack_c8.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c8.lo `test -f 'generated/in_unpack_c8.c' || echo '$(srcdir)/'`generated/in_unpack_c8.c
+
exponent_r4.lo: generated/exponent_r4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exponent_r4.lo `test -f 'generated/exponent_r4.c' || echo '$(srcdir)/'`generated/exponent_r4.c
diff --git a/libgfortran/generated/in_pack_c4.c b/libgfortran/generated/in_pack_c4.c
new file mode 100644
index 0000000..ed3b8ec
--- /dev/null
+++ b/libgfortran/generated/in_pack_c4.c
@@ -0,0 +1,123 @@
+/* Helper function for repacking arrays.
+ Copyright 2003 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran 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 General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. 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"
+
+/* Allocates a block of memory with internal_malloc if the array needs
+ repacking. */
+
+GFC_COMPLEX_4 *
+internal_pack_c4 (gfc_array_c4 * source)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type stride[GFC_MAX_DIMENSIONS];
+ index_type stride0;
+ index_type dim;
+ index_type ssize;
+ const GFC_COMPLEX_4 *src;
+ GFC_COMPLEX_4 *dest;
+ GFC_COMPLEX_4 *destptr;
+ int n;
+ int packed;
+
+ if (source->dim[0].stride == 0)
+ {
+ source->dim[0].stride = 1;
+ return source->data;
+ }
+
+ dim = GFC_DESCRIPTOR_RANK (source);
+ ssize = 1;
+ packed = 1;
+ for (n = 0; n < dim; n++)
+ {
+ count[n] = 0;
+ stride[n] = source->dim[n].stride;
+ extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ if (extent[n] <= 0)
+ {
+ /* Do nothing. */
+ packed = 1;
+ break;
+ }
+
+ if (ssize != stride[n])
+ packed = 0;
+
+ ssize *= extent[n];
+ }
+
+ if (packed)
+ return source->data;
+
+ /* Allocate storage for the destination. */
+ destptr = (GFC_COMPLEX_4 *)internal_malloc_size (ssize * sizeof (GFC_COMPLEX_4));
+ dest = destptr;
+ src = source->data;
+ stride0 = stride[0];
+
+
+ while (src)
+ {
+ /* Copy the data. */
+ *(dest++) = *src;
+ /* Advance to the next element. */
+ src += stride0;
+ count[0]++;
+ /* Advance to the next source element. */
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ src -= stride[n] * extent[n];
+ n++;
+ if (n == dim)
+ {
+ src = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ src += stride[n];
+ }
+ }
+ }
+ return destptr;
+}
+
diff --git a/libgfortran/generated/in_pack_c8.c b/libgfortran/generated/in_pack_c8.c
new file mode 100644
index 0000000..e313540
--- /dev/null
+++ b/libgfortran/generated/in_pack_c8.c
@@ -0,0 +1,123 @@
+/* Helper function for repacking arrays.
+ Copyright 2003 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran 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 General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. 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"
+
+/* Allocates a block of memory with internal_malloc if the array needs
+ repacking. */
+
+GFC_COMPLEX_8 *
+internal_pack_c8 (gfc_array_c8 * source)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type stride[GFC_MAX_DIMENSIONS];
+ index_type stride0;
+ index_type dim;
+ index_type ssize;
+ const GFC_COMPLEX_8 *src;
+ GFC_COMPLEX_8 *dest;
+ GFC_COMPLEX_8 *destptr;
+ int n;
+ int packed;
+
+ if (source->dim[0].stride == 0)
+ {
+ source->dim[0].stride = 1;
+ return source->data;
+ }
+
+ dim = GFC_DESCRIPTOR_RANK (source);
+ ssize = 1;
+ packed = 1;
+ for (n = 0; n < dim; n++)
+ {
+ count[n] = 0;
+ stride[n] = source->dim[n].stride;
+ extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ if (extent[n] <= 0)
+ {
+ /* Do nothing. */
+ packed = 1;
+ break;
+ }
+
+ if (ssize != stride[n])
+ packed = 0;
+
+ ssize *= extent[n];
+ }
+
+ if (packed)
+ return source->data;
+
+ /* Allocate storage for the destination. */
+ destptr = (GFC_COMPLEX_8 *)internal_malloc_size (ssize * sizeof (GFC_COMPLEX_8));
+ dest = destptr;
+ src = source->data;
+ stride0 = stride[0];
+
+
+ while (src)
+ {
+ /* Copy the data. */
+ *(dest++) = *src;
+ /* Advance to the next element. */
+ src += stride0;
+ count[0]++;
+ /* Advance to the next source element. */
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ src -= stride[n] * extent[n];
+ n++;
+ if (n == dim)
+ {
+ src = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ src += stride[n];
+ }
+ }
+ }
+ return destptr;
+}
+
diff --git a/libgfortran/generated/in_pack_i4.c b/libgfortran/generated/in_pack_i4.c
index 72a1519..75ea83b 100644
--- a/libgfortran/generated/in_pack_i4.c
+++ b/libgfortran/generated/in_pack_i4.c
@@ -82,7 +82,7 @@ internal_pack_4 (gfc_array_i4 * source)
return source->data;
/* Allocate storage for the destination. */
- destptr = (GFC_INTEGER_4 *)internal_malloc_size (ssize * 4);
+ destptr = (GFC_INTEGER_4 *)internal_malloc_size (ssize * sizeof (GFC_INTEGER_4));
dest = destptr;
src = source->data;
stride0 = stride[0];
diff --git a/libgfortran/generated/in_pack_i8.c b/libgfortran/generated/in_pack_i8.c
index 51c6986..69cc861 100644
--- a/libgfortran/generated/in_pack_i8.c
+++ b/libgfortran/generated/in_pack_i8.c
@@ -82,7 +82,7 @@ internal_pack_8 (gfc_array_i8 * source)
return source->data;
/* Allocate storage for the destination. */
- destptr = (GFC_INTEGER_8 *)internal_malloc_size (ssize * 8);
+ destptr = (GFC_INTEGER_8 *)internal_malloc_size (ssize * sizeof (GFC_INTEGER_8));
dest = destptr;
src = source->data;
stride0 = stride[0];
diff --git a/libgfortran/generated/in_unpack_c4.c b/libgfortran/generated/in_unpack_c4.c
new file mode 100644
index 0000000..e24939e
--- /dev/null
+++ b/libgfortran/generated/in_unpack_c4.c
@@ -0,0 +1,111 @@
+/* Helper function for repacking arrays.
+ Copyright 2003 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran 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 General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. 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 <string.h>
+#include "libgfortran.h"
+
+void
+internal_unpack_c4 (gfc_array_c4 * d, const GFC_COMPLEX_4 * src)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type stride[GFC_MAX_DIMENSIONS];
+ index_type stride0;
+ index_type dim;
+ index_type dsize;
+ GFC_COMPLEX_4 *dest;
+ int n;
+
+ dest = d->data;
+ if (src == dest || !src)
+ return;
+
+ if (d->dim[0].stride == 0)
+ d->dim[0].stride = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (d);
+ dsize = 1;
+ for (n = 0; n < dim; n++)
+ {
+ count[n] = 0;
+ stride[n] = d->dim[n].stride;
+ extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+ if (extent[n] <= 0)
+ abort ();
+
+ if (dsize == stride[n])
+ dsize *= extent[n];
+ else
+ dsize = 0;
+ }
+
+ if (dsize != 0)
+ {
+ memcpy (dest, src, dsize * sizeof (GFC_COMPLEX_4));
+ return;
+ }
+
+ stride0 = stride[0];
+
+ while (dest)
+ {
+ /* Copy the data. */
+ *dest = *(src++);
+ /* Advance to the next element. */
+ dest += stride0;
+ count[0]++;
+ /* Advance to the next source element. */
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ dest -= stride[n] * extent[n];
+ n++;
+ if (n == dim)
+ {
+ dest = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ dest += stride[n];
+ }
+ }
+ }
+}
+
diff --git a/libgfortran/generated/in_unpack_c8.c b/libgfortran/generated/in_unpack_c8.c
new file mode 100644
index 0000000..6686507
--- /dev/null
+++ b/libgfortran/generated/in_unpack_c8.c
@@ -0,0 +1,111 @@
+/* Helper function for repacking arrays.
+ Copyright 2003 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran 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 General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. 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 <string.h>
+#include "libgfortran.h"
+
+void
+internal_unpack_c8 (gfc_array_c8 * d, const GFC_COMPLEX_8 * src)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type stride[GFC_MAX_DIMENSIONS];
+ index_type stride0;
+ index_type dim;
+ index_type dsize;
+ GFC_COMPLEX_8 *dest;
+ int n;
+
+ dest = d->data;
+ if (src == dest || !src)
+ return;
+
+ if (d->dim[0].stride == 0)
+ d->dim[0].stride = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (d);
+ dsize = 1;
+ for (n = 0; n < dim; n++)
+ {
+ count[n] = 0;
+ stride[n] = d->dim[n].stride;
+ extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+ if (extent[n] <= 0)
+ abort ();
+
+ if (dsize == stride[n])
+ dsize *= extent[n];
+ else
+ dsize = 0;
+ }
+
+ if (dsize != 0)
+ {
+ memcpy (dest, src, dsize * sizeof (GFC_COMPLEX_8));
+ return;
+ }
+
+ stride0 = stride[0];
+
+ while (dest)
+ {
+ /* Copy the data. */
+ *dest = *(src++);
+ /* Advance to the next element. */
+ dest += stride0;
+ count[0]++;
+ /* Advance to the next source element. */
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ dest -= stride[n] * extent[n];
+ n++;
+ if (n == dim)
+ {
+ dest = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ dest += stride[n];
+ }
+ }
+ }
+}
+
diff --git a/libgfortran/generated/in_unpack_i4.c b/libgfortran/generated/in_unpack_i4.c
index 92561a2..4759568 100644
--- a/libgfortran/generated/in_unpack_i4.c
+++ b/libgfortran/generated/in_unpack_i4.c
@@ -71,7 +71,7 @@ internal_unpack_4 (gfc_array_i4 * d, const GFC_INTEGER_4 * src)
if (dsize != 0)
{
- memcpy (dest, src, dsize * 4);
+ memcpy (dest, src, dsize * sizeof (GFC_INTEGER_4));
return;
}
diff --git a/libgfortran/generated/in_unpack_i8.c b/libgfortran/generated/in_unpack_i8.c
index 1f3e6a2..28c3a90 100644
--- a/libgfortran/generated/in_unpack_i8.c
+++ b/libgfortran/generated/in_unpack_i8.c
@@ -71,7 +71,7 @@ internal_unpack_8 (gfc_array_i8 * d, const GFC_INTEGER_8 * src)
if (dsize != 0)
{
- memcpy (dest, src, dsize * 8);
+ memcpy (dest, src, dsize * sizeof (GFC_INTEGER_8));
return;
}
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index c525fad..e5485d1 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -482,7 +482,7 @@ internal_proto(reshape_packed);
/* Repacking functions. */
-/* ??? These four aren't currently used by the compiler, though we
+/* ??? These eight aren't currently used by the compiler, though we
certainly could do so. */
GFC_INTEGER_4 *internal_pack_4 (gfc_array_i4 *);
internal_proto(internal_pack_4);
@@ -490,12 +490,24 @@ internal_proto(internal_pack_4);
GFC_INTEGER_8 *internal_pack_8 (gfc_array_i8 *);
internal_proto(internal_pack_8);
+GFC_COMPLEX_4 *internal_pack_c4 (gfc_array_c4 *);
+internal_proto(internal_pack_c4);
+
+GFC_COMPLEX_8 *internal_pack_c8 (gfc_array_c8 *);
+internal_proto(internal_pack_c8);
+
extern void internal_unpack_4 (gfc_array_i4 *, const GFC_INTEGER_4 *);
internal_proto(internal_unpack_4);
extern void internal_unpack_8 (gfc_array_i8 *, const GFC_INTEGER_8 *);
internal_proto(internal_unpack_8);
+extern void internal_unpack_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *);
+internal_proto(internal_unpack_c4);
+
+extern void internal_unpack_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *);
+internal_proto(internal_unpack_c8);
+
/* string_intrinsics.c */
extern GFC_INTEGER_4 compare_string (GFC_INTEGER_4, const char *,
diff --git a/libgfortran/m4/in_pack.m4 b/libgfortran/m4/in_pack.m4
index b2eac40..819cb3e 100644
--- a/libgfortran/m4/in_pack.m4
+++ b/libgfortran/m4/in_pack.m4
@@ -37,9 +37,10 @@ include(iparm.m4)dnl
/* Allocates a block of memory with internal_malloc if the array needs
repacking. */
-dnl Only the kind (ie size) is used to name the function.
+dnl The kind (ie size) is used to name the function for logicals, integers
+dnl and reals. For complex, it's c4 or c8.
rtype_name *
-`internal_pack_'rtype_kind (rtype * source)
+`internal_pack_'rtype_ccode (rtype * source)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
@@ -84,7 +85,7 @@ rtype_name *
return source->data;
/* Allocate storage for the destination. */
- destptr = (rtype_name *)internal_malloc_size (ssize * rtype_kind);
+ destptr = (rtype_name *)internal_malloc_size (ssize * sizeof (rtype_name));
dest = destptr;
src = source->data;
stride0 = stride[0];
diff --git a/libgfortran/m4/in_unpack.m4 b/libgfortran/m4/in_unpack.m4
index ea9ccc8..47ae51d 100644
--- a/libgfortran/m4/in_unpack.m4
+++ b/libgfortran/m4/in_unpack.m4
@@ -35,9 +35,10 @@ Boston, MA 02111-1307, USA. */
#include "libgfortran.h"'
include(iparm.m4)dnl
-dnl Only the kind (ie size) is used to name the function.
+dnl Only the kind (ie size) is used to name the function for integers,
+dnl reals and logicals. For complex, it's c4 and c8.
void
-`internal_unpack_'rtype_kind (rtype * d, const rtype_name * src)
+`internal_unpack_'rtype_ccode (rtype * d, const rtype_name * src)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
@@ -73,7 +74,7 @@ void
if (dsize != 0)
{
- memcpy (dest, src, dsize * rtype_kind);
+ memcpy (dest, src, dsize * sizeof (rtype_name));
return;
}
diff --git a/libgfortran/runtime/in_pack_generic.c b/libgfortran/runtime/in_pack_generic.c
index 99fdb92..23810cf 100644
--- a/libgfortran/runtime/in_pack_generic.c
+++ b/libgfortran/runtime/in_pack_generic.c
@@ -52,6 +52,7 @@ internal_pack (gfc_array_char * source)
int n;
int packed;
index_type size;
+ int type;
if (source->dim[0].stride == 0)
{
@@ -59,14 +60,36 @@ internal_pack (gfc_array_char * source)
return source->data;
}
+ type = GFC_DESCRIPTOR_TYPE (source);
size = GFC_DESCRIPTOR_SIZE (source);
- switch (size)
+ switch (type)
{
- case 4:
- return internal_pack_4 ((gfc_array_i4 *)source);
-
- case 8:
- return internal_pack_8 ((gfc_array_i8 *)source);
+ case GFC_DTYPE_INTEGER:
+ case GFC_DTYPE_LOGICAL:
+ case GFC_DTYPE_REAL:
+ switch (size)
+ {
+ case 4:
+ return internal_pack_4 ((gfc_array_i4 *)source);
+
+ case 8:
+ return internal_pack_8 ((gfc_array_i8 *)source);
+ }
+ break;
+
+ case GFC_DTYPE_COMPLEX:
+ switch (size)
+ {
+ case 8:
+ return internal_pack_c4 ((gfc_array_c4 *)source);
+
+ case 16:
+ return internal_pack_c8 ((gfc_array_c8 *)source);
+ }
+ break;
+
+ default:
+ break;
}
dim = GFC_DESCRIPTOR_RANK (source);
diff --git a/libgfortran/runtime/in_unpack_generic.c b/libgfortran/runtime/in_unpack_generic.c
index 42f3b5d..1e8ac6b 100644
--- a/libgfortran/runtime/in_unpack_generic.c
+++ b/libgfortran/runtime/in_unpack_generic.c
@@ -50,22 +50,45 @@ internal_unpack (gfc_array_char * d, const void * s)
const char *src;
int n;
int size;
+ int type;
dest = d->data;
/* This check may be redundant, but do it anyway. */
if (s == dest || !s)
return;
+ type = GFC_DESCRIPTOR_TYPE (d);
size = GFC_DESCRIPTOR_SIZE (d);
- switch (size)
+ switch (type)
{
- case 4:
- internal_unpack_4 ((gfc_array_i4 *)d, (const GFC_INTEGER_4 *)s);
- return;
-
- case 8:
- internal_unpack_8 ((gfc_array_i8 *)d, (const GFC_INTEGER_8 *)s);
- return;
+ case GFC_DTYPE_INTEGER:
+ case GFC_DTYPE_LOGICAL:
+ case GFC_DTYPE_REAL:
+ switch (size)
+ {
+ case 4:
+ internal_unpack_4 ((gfc_array_i4 *)d, (const GFC_INTEGER_4 *)s);
+ return;
+
+ case 8:
+ internal_unpack_8 ((gfc_array_i8 *)d, (const GFC_INTEGER_8 *)s);
+ return;
+ }
+ break;
+
+ case GFC_DTYPE_COMPLEX:
+ switch (size)
+ {
+ case 8:
+ internal_unpack_c4 ((gfc_array_c4 *)d, (const GFC_COMPLEX_4 *)s);
+ return;
+
+ case 16:
+ internal_unpack_c8 ((gfc_array_c8 *)d, (const GFC_COMPLEX_8 *)s);
+ return;
+ }
+ default:
+ break;
}
if (d->dim[0].stride == 0)
generated by cgit v1.1 at 2024-11-02 19:57:04 +0000