From 95f15c5be0c530535b82bfe418cf4c42c3a3158c Mon Sep 17 00:00:00 2001
From: tkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Thu, 14 Aug 2008 18:31:32 +0000
Subject: 2008-08-14 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/36886
* Makefile.am: Added $(i_cshift0_c).
Added $(i_cshift0_c) to gfor_built_specific_src.
Add rule to build from cshift0.m4.
* Makefile.in: Regenerated.
* libgfortran.h: Addedd prototypes for cshift0_i1,
cshift0_i2, cshift0_i4, cshift0_i8, cshift0_i16,
cshift0_r4, cshift0_r8, cshift0_r10, cshift0_r16,
cshift0_c4, cshift0_c8, cshift0_c10, cshift0_c16.
Define Macros GFC_UNALIGNED_C4 and GFC_UNALIGNED_C8.
* intrinsics/cshift0.c: Remove helper functions for
the innter shift loop.
(cshift0): Call specific functions depending on type
of array argument. Only call specific functions for
correct alignment for other types.
* m4/cshift0.m4: New file.
* generated/cshift0_i1.c: New file.
* generated/cshift0_i2.c: New file.
* generated/cshift0_i4.c: New file.
* generated/cshift0_i8:.c New file.
* generated/cshift0_i16.c: New file.
* generated/cshift0_r4.c: New file.
* generated/cshift0_r8.c: New file.
* generated/cshift0_r10.c: New file.
* generated/cshift0_r16.c: New file.
* generated/cshift0_c4.c: New file.
* generated/cshift0_c8.c: New file.
* generated/cshift0_c10.c: New file.
* generated/cshift0_c16.c: New file.
2008-08-14 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/36886
* gfortran.dg/cshift_char_3.f90: New test case.
* gfortran.dg/cshift_nan_1.f90: New test case.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@139111 138bc75d-0d04-0410-961f-82ee72b054a4
---
libgfortran/m4/cshift0.m4 | 177 ++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 177 insertions(+)
create mode 100644 libgfortran/m4/cshift0.m4
(limited to 'libgfortran/m4')
diff --git a/libgfortran/m4/cshift0.m4 b/libgfortran/m4/cshift0.m4
new file mode 100644
index 00000000000..b633169ae51
--- /dev/null
+++ b/libgfortran/m4/cshift0.m4
@@ -0,0 +1,177 @@
+`/* Helper function for cshift functions.
+ Copyright 2008 Free Software Foundation, Inc.
+ Contributed by Thomas Koenig <tkoenig@gcc.gnu.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., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <string.h>'
+
+include(iparm.m4)dnl
+
+`#if defined (HAVE_'rtype_name`)
+
+void
+cshift0_'rtype_code` ('rtype` *ret, const 'rtype` *array, ssize_t shift,
+ int which)
+{
+ /* r.* indicates the return array. */
+ index_type rstride[GFC_MAX_DIMENSIONS];
+ index_type rstride0;
+ index_type roffset;
+ 'rtype_name` *rptr;
+
+ /* s.* indicates the source array. */
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type sstride0;
+ index_type soffset;
+ const 'rtype_name` *sptr;
+
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dim;
+ index_type len;
+ index_type n;
+
+ which = which - 1;
+ sstride[0] = 0;
+ rstride[0] = 0;
+
+ extent[0] = 1;
+ count[0] = 0;
+ n = 0;
+ /* Initialized for avoiding compiler warnings. */
+ roffset = 1;
+ soffset = 1;
+ len = 0;
+
+ for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ if (dim == which)
+ {
+ roffset = ret->dim[dim].stride;
+ if (roffset == 0)
+ roffset = 1;
+ soffset = array->dim[dim].stride;
+ if (soffset == 0)
+ soffset = 1;
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ }
+ else
+ {
+ count[n] = 0;
+ extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ rstride[n] = ret->dim[dim].stride;
+ sstride[n] = array->dim[dim].stride;
+ n++;
+ }
+ }
+ if (sstride[0] == 0)
+ sstride[0] = 1;
+ if (rstride[0] == 0)
+ rstride[0] = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (array);
+ rstride0 = rstride[0];
+ sstride0 = sstride[0];
+ rptr = ret->data;
+ sptr = array->data;
+
+ shift = len == 0 ? 0 : shift % (ssize_t)len;
+ if (shift < 0)
+ shift += len;
+
+ while (rptr)
+ {
+ /* Do the shift for this dimension. */
+
+ /* If elements are contiguous, perform the operation
+ in two block moves. */
+ if (soffset == 1 && roffset == 1)
+ {
+ size_t len1 = shift * sizeof ('rtype_name`);
+ size_t len2 = (len - shift) * sizeof ('rtype_name`);
+ memcpy (rptr, sptr + shift, len2);
+ memcpy (rptr + (len - shift), sptr, len1);
+ }
+ else
+ {
+ /* Otherwise, we will have to perform the copy one element at
+ a time. */
+ 'rtype_name` *dest = rptr;
+ const 'rtype_name` *src = &sptr[shift * soffset];
+
+ for (n = 0; n < len - shift; n++)
+ {
+ *dest = *src;
+ dest += roffset;
+ src += soffset;
+ }
+ for (src = sptr, n = 0; n < shift; n++)
+ {
+ *dest = *src;
+ dest += roffset;
+ src += soffset;
+ }
+ }
+
+ /* Advance to the next section. */
+ rptr += rstride0;
+ sptr += sstride0;
+ count[0]++;
+ 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 probably not worth it. */
+ rptr -= rstride[n] * extent[n];
+ sptr -= sstride[n] * extent[n];
+ n++;
+ if (n >= dim - 1)
+ {
+ /* Break out of the loop. */
+ rptr = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ rptr += rstride[n];
+ sptr += sstride[n];
+ }
+ }
+ }
+
+ return;
+}
+
+#endif'
--
cgit v1.2.1