diff options
Diffstat (limited to 'libgfortran')
| -rw-r--r-- | libgfortran/Makefile.am | 8 | ||||
| -rw-r--r-- | libgfortran/Makefile.in | 26 | ||||
| -rw-r--r-- | libgfortran/generated/in_pack_c4.c | 123 | ||||
| -rw-r--r-- | libgfortran/generated/in_pack_c8.c | 123 | ||||
| -rw-r--r-- | libgfortran/generated/in_pack_i4.c | 2 | ||||
| -rw-r--r-- | libgfortran/generated/in_pack_i8.c | 2 | ||||
| -rw-r--r-- | libgfortran/generated/in_unpack_c4.c | 111 | ||||
| -rw-r--r-- | libgfortran/generated/in_unpack_c8.c | 111 | ||||
| -rw-r--r-- | libgfortran/generated/in_unpack_i4.c | 2 | ||||
| -rw-r--r-- | libgfortran/generated/in_unpack_i8.c | 2 | ||||
| -rw-r--r-- | libgfortran/libgfortran.h | 14 | ||||
| -rw-r--r-- | libgfortran/m4/in_pack.m4 | 7 | ||||
| -rw-r--r-- | libgfortran/m4/in_unpack.m4 | 7 | ||||
| -rw-r--r-- | libgfortran/runtime/in_pack_generic.c | 35 | ||||
| -rw-r--r-- | libgfortran/runtime/in_unpack_generic.c | 39 |
15 files changed, 581 insertions, 31 deletions
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index 0e1893b5cce..43fc9883001 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 0240dd127fb..4fc4357cf25 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 00000000000..ed3b8ec6ef6 --- /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 00000000000..e313540f7bf --- /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 72a1519b299..75ea83bda9d 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 51c6986a288..69cc861d404 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 00000000000..e24939e5e52 --- /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 00000000000..66865075c02 --- /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 92561a21d7e..4759568d73a 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 1f3e6a23dd3..28c3a90f6af 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 c525fad7a2e..e5485d1ba8b 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 b2eac40581f..819cb3e2c33 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 ea9ccc89f76..47ae51d9ac0 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 99fdb92436f..23810cf8320 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 42f3b5d67a2..1e8ac6b7a47 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) |
