+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,
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:
+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
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 \
-# 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,
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
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 \
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
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
--- /dev/null
+/* 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);
+ }
+}
--- /dev/null
+/* 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);
+ }
+}
/* 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).
#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;
/* 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).
#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;
/* 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).
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
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;
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;
/* 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 ();
}
}
`/* 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).
#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;
projects / platform / upstream / linaro-gcc.git / commitdiff