diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/iresolve.c | 41 | ||||
| -rw-r--r-- | libgfortran/ChangeLog | 10 | ||||
| -rw-r--r-- | libgfortran/Makefile.am | 4 | ||||
| -rw-r--r-- | libgfortran/Makefile.in | 16 | ||||
| -rw-r--r-- | libgfortran/generated/transpose_c4.c | 98 | ||||
| -rw-r--r-- | libgfortran/generated/transpose_c8.c | 98 | ||||
| -rw-r--r-- | libgfortran/generated/transpose_i4.c | 8 | ||||
| -rw-r--r-- | libgfortran/generated/transpose_i8.c | 8 | ||||
| -rw-r--r-- | libgfortran/intrinsics/cshift0.c | 106 | ||||
| -rw-r--r-- | libgfortran/m4/transpose.m4 | 8 |
11 files changed, 339 insertions, 64 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 19688624bfa..c692f3788bd 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2005-01-23 James A. Morrison <phython@gcc.gnu.org> + + PR fortran/19294 + * iresolve.c (gfc_resolve_transpose): Resolve to transpose_c4 or + transpose_c8 for complex types. + 2005-01-23 Kazu Hirata <kazu@cs.umass.edu> * data.c, dependency.c, f95-lang.c, io.c, trans-array.c, diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 60c443ecb4f..a4ab2251761 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -1340,31 +1340,32 @@ gfc_resolve_transpose (gfc_expr * f, gfc_expr * matrix) mpz_init_set (f->shape[1], matrix->shape[0]); } - switch (matrix->ts.type) - { - case BT_COMPLEX: - kind = matrix->ts.kind * 2; - break; - - case BT_REAL: - case BT_INTEGER: - case BT_LOGICAL: - kind = matrix->ts.kind; - break; - - default: - kind = 0; - break; - - } + kind = matrix->ts.kind; switch (kind) { case 4: case 8: - /* case 16: */ - f->value.function.name = - gfc_get_string (PREFIX("transpose_%d"), kind); + switch (matrix->ts.type) + { + case BT_COMPLEX: + f->value.function.name = + gfc_get_string (PREFIX("transpose_c%d"), kind); + break; + + case BT_INTEGER: + case BT_REAL: + case BT_LOGICAL: + /* Use the integer routines for real and logical cases. This + assumes they all have the same alignment requirements. */ + f->value.function.name = + gfc_get_string (PREFIX("transpose_i%d"), kind); + break; + + default: + f->value.function.name = PREFIX("transpose"); + break; + } break; default: diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 1296ab2a247..9f9bee8f7f9 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,13 @@ +2005-01-23 James A. Morrison <phython@gcc.gnu.org> + Paul Brook <paul@codesourcery.com> + + PR fortran/19294 + * Makefile.am: Add transpose_c4.c and transpose_c8.c. + * intrinsics/cshift0.c: Use separate optimized loops for complex types. + * m4/transpose.m4: Include type letter in function name. + * Makefile.in: Regenerate. + * generated/transpose_*.c: Regenerate. + 2005-01-22 Thomas Koenig <Thomas.Koenig@online.de> PR libfortran/19451 diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index d9594c829e2..27b31333ae1 100644 --- a/libgfortran/Makefile.am +++ b/libgfortran/Makefile.am @@ -202,7 +202,9 @@ generated/matmul_l8.c i_transpose_c= \ generated/transpose_i4.c \ -generated/transpose_i8.c +generated/transpose_i8.c \ +generated/transpose_c4.c \ +generated/transpose_c8.c i_shape_c= \ generated/shape_i4.c \ diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in index f4c1e268302..6449b3b5e44 100644 --- a/libgfortran/Makefile.in +++ b/libgfortran/Makefile.in @@ -1,4 +1,4 @@ -# Makefile.in generated by automake 1.9.3 from Makefile.am. +# Makefile.in generated by automake 1.9.4 from Makefile.am. # @configure_input@ # Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, @@ -98,7 +98,8 @@ am__objects_15 = dotprod_c4.lo dotprod_c8.lo am__objects_16 = matmul_i4.lo matmul_i8.lo matmul_r4.lo matmul_r8.lo \ matmul_c4.lo matmul_c8.lo am__objects_17 = matmul_l4.lo matmul_l8.lo -am__objects_18 = transpose_i4.lo transpose_i8.lo +am__objects_18 = transpose_i4.lo transpose_i8.lo transpose_c4.lo \ + transpose_c8.lo am__objects_19 = shape_i4.lo shape_i8.lo am__objects_20 = eoshift1_4.lo eoshift1_8.lo am__objects_21 = eoshift3_4.lo eoshift3_8.lo @@ -486,7 +487,9 @@ generated/matmul_l8.c i_transpose_c = \ generated/transpose_i4.c \ -generated/transpose_i8.c +generated/transpose_i8.c \ +generated/transpose_c4.c \ +generated/transpose_c8.c i_shape_c = \ generated/shape_i4.c \ @@ -685,7 +688,6 @@ I_M4_DEPS = m4/iparm.m4 I_M4_DEPS0 = $(I_M4_DEPS) m4/iforeach.m4 I_M4_DEPS1 = $(I_M4_DEPS) m4/ifunction.m4 EXTRA_DIST = $(m4_files) - all: $(BUILT_SOURCES) config.h $(MAKE) $(AM_MAKEFLAGS) all-am @@ -1046,6 +1048,12 @@ transpose_i4.lo: generated/transpose_i4.c transpose_i8.lo: generated/transpose_i8.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_i8.lo `test -f 'generated/transpose_i8.c' || echo '$(srcdir)/'`generated/transpose_i8.c +transpose_c4.lo: generated/transpose_c4.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c4.lo `test -f 'generated/transpose_c4.c' || echo '$(srcdir)/'`generated/transpose_c4.c + +transpose_c8.lo: generated/transpose_c8.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c8.lo `test -f 'generated/transpose_c8.c' || echo '$(srcdir)/'`generated/transpose_c8.c + shape_i4.lo: generated/shape_i4.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o shape_i4.lo `test -f 'generated/shape_i4.c' || echo '$(srcdir)/'`generated/shape_i4.c diff --git a/libgfortran/generated/transpose_c4.c b/libgfortran/generated/transpose_c4.c new file mode 100644 index 00000000000..c61d9072a81 --- /dev/null +++ b/libgfortran/generated/transpose_c4.c @@ -0,0 +1,98 @@ +/* Implementation of the TRANSPOSE intrinsic + Copyright 2003, 2005 Free Software Foundation, Inc. + Contributed by Tobias Schlüter + +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 <assert.h> +#include "libgfortran.h" + +extern void transpose_c4 (gfc_array_c4 * ret, gfc_array_c4 * source); +export_proto(transpose_c4); + +void +transpose_c4 (gfc_array_c4 * ret, gfc_array_c4 * source) +{ + /* r.* indicates the return array. */ + index_type rxstride, rystride; + GFC_COMPLEX_4 *rptr; + /* s.* indicates the source array. */ + index_type sxstride, systride; + const GFC_COMPLEX_4 *sptr; + + index_type xcount, ycount; + index_type x, y; + + assert (GFC_DESCRIPTOR_RANK (source) == 2); + + if (ret->data == NULL) + { + assert (GFC_DESCRIPTOR_RANK (ret) == 2); + assert (ret->dtype == source->dtype); + + ret->dim[0].lbound = 0; + ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound; + ret->dim[0].stride = 1; + + ret->dim[1].lbound = 0; + ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound; + ret->dim[1].stride = ret->dim[0].ubound+1; + + ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_4) * size0 (ret)); + ret->base = 0; + } + + if (ret->dim[0].stride == 0) + ret->dim[0].stride = 1; + if (source->dim[0].stride == 0) + source->dim[0].stride = 1; + + sxstride = source->dim[0].stride; + systride = source->dim[1].stride; + xcount = source->dim[0].ubound + 1 - source->dim[0].lbound; + ycount = source->dim[1].ubound + 1 - source->dim[1].lbound; + + rxstride = ret->dim[0].stride; + rystride = ret->dim[1].stride; + + rptr = ret->data; + sptr = source->data; + + for (y=0; y < ycount; y++) + { + for (x=0; x < xcount; x++) + { + *rptr = *sptr; + + sptr += sxstride; + rptr += rystride; + } + sptr += systride - (sxstride * xcount); + rptr += rxstride - (rystride * xcount); + } +} diff --git a/libgfortran/generated/transpose_c8.c b/libgfortran/generated/transpose_c8.c new file mode 100644 index 00000000000..fd74f26f5da --- /dev/null +++ b/libgfortran/generated/transpose_c8.c @@ -0,0 +1,98 @@ +/* Implementation of the TRANSPOSE intrinsic + Copyright 2003, 2005 Free Software Foundation, Inc. + Contributed by Tobias Schlüter + +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 <assert.h> +#include "libgfortran.h" + +extern void transpose_c8 (gfc_array_c8 * ret, gfc_array_c8 * source); +export_proto(transpose_c8); + +void +transpose_c8 (gfc_array_c8 * ret, gfc_array_c8 * source) +{ + /* r.* indicates the return array. */ + index_type rxstride, rystride; + GFC_COMPLEX_8 *rptr; + /* s.* indicates the source array. */ + index_type sxstride, systride; + const GFC_COMPLEX_8 *sptr; + + index_type xcount, ycount; + index_type x, y; + + assert (GFC_DESCRIPTOR_RANK (source) == 2); + + if (ret->data == NULL) + { + assert (GFC_DESCRIPTOR_RANK (ret) == 2); + assert (ret->dtype == source->dtype); + + ret->dim[0].lbound = 0; + ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound; + ret->dim[0].stride = 1; + + ret->dim[1].lbound = 0; + ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound; + ret->dim[1].stride = ret->dim[0].ubound+1; + + ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_8) * size0 (ret)); + ret->base = 0; + } + + if (ret->dim[0].stride == 0) + ret->dim[0].stride = 1; + if (source->dim[0].stride == 0) + source->dim[0].stride = 1; + + sxstride = source->dim[0].stride; + systride = source->dim[1].stride; + xcount = source->dim[0].ubound + 1 - source->dim[0].lbound; + ycount = source->dim[1].ubound + 1 - source->dim[1].lbound; + + rxstride = ret->dim[0].stride; + rystride = ret->dim[1].stride; + + rptr = ret->data; + sptr = source->data; + + for (y=0; y < ycount; y++) + { + for (x=0; x < xcount; x++) + { + *rptr = *sptr; + + sptr += sxstride; + rptr += rystride; + } + sptr += systride - (sxstride * xcount); + rptr += rxstride - (rystride * xcount); + } +} diff --git a/libgfortran/generated/transpose_i4.c b/libgfortran/generated/transpose_i4.c index afa0357c4e7..0945d065126 100644 --- a/libgfortran/generated/transpose_i4.c +++ b/libgfortran/generated/transpose_i4.c @@ -1,5 +1,5 @@ /* Implementation of the TRANSPOSE intrinsic - Copyright 2003 Free Software Foundation, Inc. + Copyright 2003, 2005 Free Software Foundation, Inc. Contributed by Tobias Schlüter This file is part of the GNU Fortran 95 runtime library (libgfortran). @@ -32,11 +32,11 @@ Boston, MA 02111-1307, USA. */ #include <assert.h> #include "libgfortran.h" -extern void transpose_4 (gfc_array_i4 * ret, gfc_array_i4 * source); -export_proto(transpose_4); +extern void transpose_i4 (gfc_array_i4 * ret, gfc_array_i4 * source); +export_proto(transpose_i4); void -transpose_4 (gfc_array_i4 * ret, gfc_array_i4 * source) +transpose_i4 (gfc_array_i4 * ret, gfc_array_i4 * source) { /* r.* indicates the return array. */ index_type rxstride, rystride; diff --git a/libgfortran/generated/transpose_i8.c b/libgfortran/generated/transpose_i8.c index 223ca57641f..f89dd6aac5a 100644 --- a/libgfortran/generated/transpose_i8.c +++ b/libgfortran/generated/transpose_i8.c @@ -1,5 +1,5 @@ /* Implementation of the TRANSPOSE intrinsic - Copyright 2003 Free Software Foundation, Inc. + Copyright 2003, 2005 Free Software Foundation, Inc. Contributed by Tobias Schlüter This file is part of the GNU Fortran 95 runtime library (libgfortran). @@ -32,11 +32,11 @@ Boston, MA 02111-1307, USA. */ #include <assert.h> #include "libgfortran.h" -extern void transpose_8 (gfc_array_i8 * ret, gfc_array_i8 * source); -export_proto(transpose_8); +extern void transpose_i8 (gfc_array_i8 * ret, gfc_array_i8 * source); +export_proto(transpose_i8); void -transpose_8 (gfc_array_i8 * ret, gfc_array_i8 * source) +transpose_i8 (gfc_array_i8 * ret, gfc_array_i8 * source) { /* r.* indicates the return array. */ index_type rxstride, rystride; diff --git a/libgfortran/intrinsics/cshift0.c b/libgfortran/intrinsics/cshift0.c index 4042ec4bd72..2dd6a022e8a 100644 --- a/libgfortran/intrinsics/cshift0.c +++ b/libgfortran/intrinsics/cshift0.c @@ -1,5 +1,5 @@ /* Generic implementation of the CSHIFT intrinsic - Copyright 2003 Free Software Foundation, Inc. + Copyright 2003, 2005 Free Software Foundation, Inc. Contributed by Feng Wang <wf_cs@yahoo.com> This file is part of the GNU Fortran 95 runtime library (libgfortran). @@ -72,6 +72,8 @@ DEF_COPY_LOOP(int, int) DEF_COPY_LOOP(long, long) DEF_COPY_LOOP(double, double) DEF_COPY_LOOP(ldouble, long double) +DEF_COPY_LOOP(cfloat, _Complex float) +DEF_COPY_LOOP(cdouble, _Complex double) static void @@ -96,12 +98,11 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array, index_type size; index_type len; index_type n; + int whichloop; if (which < 1 || which > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); - size = GFC_DESCRIPTOR_SIZE (ret); - which = which - 1; extent[0] = 1; @@ -109,6 +110,34 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array, size = GFC_DESCRIPTOR_SIZE (array); n = 0; + /* The values assigned here must match the cases in the inner loop. */ + whichloop = 0; + switch (GFC_DESCRIPTOR_TYPE (array)) + { + case GFC_DTYPE_LOGICAL: + case GFC_DTYPE_INTEGER: + case GFC_DTYPE_REAL: + if (size == sizeof (int)) + whichloop = 1; + else if (size == sizeof (long)) + whichloop = 2; + else if (size == sizeof (double)) + whichloop = 3; + else if (size == sizeof (long double)) + whichloop = 4; + break; + + case GFC_DTYPE_COMPLEX: + if (size == sizeof (_Complex float)) + whichloop = 5; + else if (size == sizeof (_Complex double)) + whichloop = 6; + break; + + default: + break; + } + /* Initialized for avoiding compiler warnings. */ roffset = size; soffset = size; @@ -187,31 +216,54 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array, /* Otherwise, we'll have to perform the copy one element at a time. We can speed this up a tad for common cases of fundamental types. */ - if (size == sizeof(int)) - copy_loop_int (rptr, sptr, roffset, soffset, len, shift); - else if (size == sizeof(long)) - copy_loop_long (rptr, sptr, roffset, soffset, len, shift); - else if (size == sizeof(double)) - copy_loop_double (rptr, sptr, roffset, soffset, len, shift); - else if (size == sizeof(long double)) - copy_loop_ldouble (rptr, sptr, roffset, soffset, len, shift); - else + switch (whichloop) { - char *dest = rptr; - const char *src = &sptr[shift * soffset]; - - for (n = 0; n < len - shift; n++) - { - memcpy (dest, src, size); - dest += roffset; - src += soffset; - } - for (src = sptr, n = 0; n < shift; n++) - { - memcpy (dest, src, size); - dest += roffset; - src += soffset; - } + case 0: + { + char *dest = rptr; + const char *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + memcpy (dest, src, size); + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + memcpy (dest, src, size); + dest += roffset; + src += soffset; + } + } + break; + + case 1: + copy_loop_int (rptr, sptr, roffset, soffset, len, shift); + break; + + case 2: + copy_loop_long (rptr, sptr, roffset, soffset, len, shift); + break; + + case 3: + copy_loop_double (rptr, sptr, roffset, soffset, len, shift); + break; + + case 4: + copy_loop_ldouble (rptr, sptr, roffset, soffset, len, shift); + break; + + case 5: + copy_loop_cfloat (rptr, sptr, roffset, soffset, len, shift); + break; + + case 6: + copy_loop_cdouble (rptr, sptr, roffset, soffset, len, shift); + break; + + default: + abort (); } } diff --git a/libgfortran/m4/transpose.m4 b/libgfortran/m4/transpose.m4 index 74d25bcfcb0..4ae6c091c62 100644 --- a/libgfortran/m4/transpose.m4 +++ b/libgfortran/m4/transpose.m4 @@ -1,5 +1,5 @@ `/* Implementation of the TRANSPOSE intrinsic - Copyright 2003 Free Software Foundation, Inc. + Copyright 2003, 2005 Free Software Foundation, Inc. Contributed by Tobias Schlüter This file is part of the GNU Fortran 95 runtime library (libgfortran). @@ -33,11 +33,11 @@ Boston, MA 02111-1307, USA. */ #include "libgfortran.h"' include(iparm.m4)dnl -extern void transpose_`'rtype_kind (rtype * ret, rtype * source); -export_proto(transpose_`'rtype_kind); +extern void transpose_`'rtype_code (rtype * ret, rtype * source); +export_proto(transpose_`'rtype_code); void -transpose_`'rtype_kind (rtype * ret, rtype * source) +transpose_`'rtype_code (rtype * ret, rtype * source) { /* r.* indicates the return array. */ index_type rxstride, rystride; |