From 587579571db53d68bd90344c6a1746aef98bc145 Mon Sep 17 00:00:00 2001 From: "James A. Morrison" Date: Sun, 23 Jan 2005 17:01:00 +0000 Subject: re PR fortran/19294 (intrinsic_transpose.f90 runtime crash) 2005-01-23 James A. Morrison Paul Brook PR fortran/19294 * iresolve.c (gfc_resolve_transpose): Resolve to transpose_c4 or transpose_c8 for complex types. libgfortran/ * 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. Co-Authored-By: Paul Brook From-SVN: r94116 --- libgfortran/intrinsics/cshift0.c | 106 +++++++++++++++++++++++++++++---------- 1 file changed, 79 insertions(+), 27 deletions(-) (limited to 'libgfortran/intrinsics') diff --git a/libgfortran/intrinsics/cshift0.c b/libgfortran/intrinsics/cshift0.c index 4042ec4..2dd6a02 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 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 (); } } -- cgit v1.1