summaryrefslogtreecommitdiff
path: root/libgfortran/generated
diff options
context:
space:
mode:
authortkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>2008-08-14 18:31:32 +0000
committertkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>2008-08-14 18:31:32 +0000
commit95f15c5be0c530535b82bfe418cf4c42c3a3158c (patch)
tree85eb8b641f01c373a1ab8b4253e57f255f52349f /libgfortran/generated
parentd010953eebc456ca7654214131f6e4b9da8b1487 (diff)
downloadgcc-95f15c5be0c530535b82bfe418cf4c42c3a3158c.tar.gz
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
Diffstat (limited to 'libgfortran/generated')
-rw-r--r--libgfortran/generated/cshift0_c10.c176
-rw-r--r--libgfortran/generated/cshift0_c16.c176
-rw-r--r--libgfortran/generated/cshift0_c4.c176
-rw-r--r--libgfortran/generated/cshift0_c8.c176
-rw-r--r--libgfortran/generated/cshift0_i1.c176
-rw-r--r--libgfortran/generated/cshift0_i16.c176
-rw-r--r--libgfortran/generated/cshift0_i2.c176
-rw-r--r--libgfortran/generated/cshift0_i4.c176
-rw-r--r--libgfortran/generated/cshift0_i8.c176
-rw-r--r--libgfortran/generated/cshift0_r10.c176
-rw-r--r--libgfortran/generated/cshift0_r16.c176
-rw-r--r--libgfortran/generated/cshift0_r4.c176
-rw-r--r--libgfortran/generated/cshift0_r8.c176
13 files changed, 2288 insertions, 0 deletions
diff --git a/libgfortran/generated/cshift0_c10.c b/libgfortran/generated/cshift0_c10.c
new file mode 100644
index 00000000000..9f0997044d2
--- /dev/null
+++ b/libgfortran/generated/cshift0_c10.c
@@ -0,0 +1,176 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_COMPLEX_10)
+
+void
+cshift0_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, ssize_t shift,
+ int which)
+{
+ /* r.* indicates the return array. */
+ index_type rstride[GFC_MAX_DIMENSIONS];
+ index_type rstride0;
+ index_type roffset;
+ GFC_COMPLEX_10 *rptr;
+
+ /* s.* indicates the source array. */
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type sstride0;
+ index_type soffset;
+ const GFC_COMPLEX_10 *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 (GFC_COMPLEX_10);
+ size_t len2 = (len - shift) * sizeof (GFC_COMPLEX_10);
+ 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. */
+ GFC_COMPLEX_10 *dest = rptr;
+ const GFC_COMPLEX_10 *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
diff --git a/libgfortran/generated/cshift0_c16.c b/libgfortran/generated/cshift0_c16.c
new file mode 100644
index 00000000000..deabe262937
--- /dev/null
+++ b/libgfortran/generated/cshift0_c16.c
@@ -0,0 +1,176 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_COMPLEX_16)
+
+void
+cshift0_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, ssize_t shift,
+ int which)
+{
+ /* r.* indicates the return array. */
+ index_type rstride[GFC_MAX_DIMENSIONS];
+ index_type rstride0;
+ index_type roffset;
+ GFC_COMPLEX_16 *rptr;
+
+ /* s.* indicates the source array. */
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type sstride0;
+ index_type soffset;
+ const GFC_COMPLEX_16 *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 (GFC_COMPLEX_16);
+ size_t len2 = (len - shift) * sizeof (GFC_COMPLEX_16);
+ 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. */
+ GFC_COMPLEX_16 *dest = rptr;
+ const GFC_COMPLEX_16 *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
diff --git a/libgfortran/generated/cshift0_c4.c b/libgfortran/generated/cshift0_c4.c
new file mode 100644
index 00000000000..462169f9a26
--- /dev/null
+++ b/libgfortran/generated/cshift0_c4.c
@@ -0,0 +1,176 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_COMPLEX_4)
+
+void
+cshift0_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, ssize_t shift,
+ int which)
+{
+ /* r.* indicates the return array. */
+ index_type rstride[GFC_MAX_DIMENSIONS];
+ index_type rstride0;
+ index_type roffset;
+ GFC_COMPLEX_4 *rptr;
+
+ /* s.* indicates the source array. */
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type sstride0;
+ index_type soffset;
+ const GFC_COMPLEX_4 *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 (GFC_COMPLEX_4);
+ size_t len2 = (len - shift) * sizeof (GFC_COMPLEX_4);
+ 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. */
+ GFC_COMPLEX_4 *dest = rptr;
+ const GFC_COMPLEX_4 *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
diff --git a/libgfortran/generated/cshift0_c8.c b/libgfortran/generated/cshift0_c8.c
new file mode 100644
index 00000000000..0653e1d3f0d
--- /dev/null
+++ b/libgfortran/generated/cshift0_c8.c
@@ -0,0 +1,176 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_COMPLEX_8)
+
+void
+cshift0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, ssize_t shift,
+ int which)
+{
+ /* r.* indicates the return array. */
+ index_type rstride[GFC_MAX_DIMENSIONS];
+ index_type rstride0;
+ index_type roffset;
+ GFC_COMPLEX_8 *rptr;
+
+ /* s.* indicates the source array. */
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type sstride0;
+ index_type soffset;
+ const GFC_COMPLEX_8 *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 (GFC_COMPLEX_8);
+ size_t len2 = (len - shift) * sizeof (GFC_COMPLEX_8);
+ 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. */
+ GFC_COMPLEX_8 *dest = rptr;
+ const GFC_COMPLEX_8 *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
diff --git a/libgfortran/generated/cshift0_i1.c b/libgfortran/generated/cshift0_i1.c
new file mode 100644
index 00000000000..c21d75ebe5e
--- /dev/null
+++ b/libgfortran/generated/cshift0_i1.c
@@ -0,0 +1,176 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_INTEGER_1)
+
+void
+cshift0_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, ssize_t shift,
+ int which)
+{
+ /* r.* indicates the return array. */
+ index_type rstride[GFC_MAX_DIMENSIONS];
+ index_type rstride0;
+ index_type roffset;
+ GFC_INTEGER_1 *rptr;
+
+ /* s.* indicates the source array. */
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type sstride0;
+ index_type soffset;
+ const GFC_INTEGER_1 *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 (GFC_INTEGER_1);
+ size_t len2 = (len - shift) * sizeof (GFC_INTEGER_1);
+ 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. */
+ GFC_INTEGER_1 *dest = rptr;
+ const GFC_INTEGER_1 *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
diff --git a/libgfortran/generated/cshift0_i16.c b/libgfortran/generated/cshift0_i16.c
new file mode 100644
index 00000000000..e2c88f461af
--- /dev/null
+++ b/libgfortran/generated/cshift0_i16.c
@@ -0,0 +1,176 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+void
+cshift0_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, ssize_t shift,
+ int which)
+{
+ /* r.* indicates the return array. */
+ index_type rstride[GFC_MAX_DIMENSIONS];
+ index_type rstride0;
+ index_type roffset;
+ GFC_INTEGER_16 *rptr;
+
+ /* s.* indicates the source array. */
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type sstride0;
+ index_type soffset;
+ const GFC_INTEGER_16 *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 (GFC_INTEGER_16);
+ size_t len2 = (len - shift) * sizeof (GFC_INTEGER_16);
+ 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. */
+ GFC_INTEGER_16 *dest = rptr;
+ const GFC_INTEGER_16 *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
diff --git a/libgfortran/generated/cshift0_i2.c b/libgfortran/generated/cshift0_i2.c
new file mode 100644
index 00000000000..ec2ea1d8b6b
--- /dev/null
+++ b/libgfortran/generated/cshift0_i2.c
@@ -0,0 +1,176 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_INTEGER_2)
+
+void
+cshift0_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, ssize_t shift,
+ int which)
+{
+ /* r.* indicates the return array. */
+ index_type rstride[GFC_MAX_DIMENSIONS];
+ index_type rstride0;
+ index_type roffset;
+ GFC_INTEGER_2 *rptr;
+
+ /* s.* indicates the source array. */
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type sstride0;
+ index_type soffset;
+ const GFC_INTEGER_2 *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 (GFC_INTEGER_2);
+ size_t len2 = (len - shift) * sizeof (GFC_INTEGER_2);
+ 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. */
+ GFC_INTEGER_2 *dest = rptr;
+ const GFC_INTEGER_2 *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
diff --git a/libgfortran/generated/cshift0_i4.c b/libgfortran/generated/cshift0_i4.c
new file mode 100644
index 00000000000..c2dc7b83764
--- /dev/null
+++ b/libgfortran/generated/cshift0_i4.c
@@ -0,0 +1,176 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_INTEGER_4)
+
+void
+cshift0_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, ssize_t shift,
+ int which)
+{
+ /* r.* indicates the return array. */
+ index_type rstride[GFC_MAX_DIMENSIONS];
+ index_type rstride0;
+ index_type roffset;
+ GFC_INTEGER_4 *rptr;
+
+ /* s.* indicates the source array. */
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type sstride0;
+ index_type soffset;
+ const GFC_INTEGER_4 *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 (GFC_INTEGER_4);
+ size_t len2 = (len - shift) * sizeof (GFC_INTEGER_4);
+ 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. */
+ GFC_INTEGER_4 *dest = rptr;
+ const GFC_INTEGER_4 *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
diff --git a/libgfortran/generated/cshift0_i8.c b/libgfortran/generated/cshift0_i8.c
new file mode 100644
index 00000000000..b4e38659172
--- /dev/null
+++ b/libgfortran/generated/cshift0_i8.c
@@ -0,0 +1,176 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_INTEGER_8)
+
+void
+cshift0_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, ssize_t shift,
+ int which)
+{
+ /* r.* indicates the return array. */
+ index_type rstride[GFC_MAX_DIMENSIONS];
+ index_type rstride0;
+ index_type roffset;
+ GFC_INTEGER_8 *rptr;
+
+ /* s.* indicates the source array. */
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type sstride0;
+ index_type soffset;
+ const GFC_INTEGER_8 *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 (GFC_INTEGER_8);
+ size_t len2 = (len - shift) * sizeof (GFC_INTEGER_8);
+ 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. */
+ GFC_INTEGER_8 *dest = rptr;
+ const GFC_INTEGER_8 *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
diff --git a/libgfortran/generated/cshift0_r10.c b/libgfortran/generated/cshift0_r10.c
new file mode 100644
index 00000000000..1eb9169e93a
--- /dev/null
+++ b/libgfortran/generated/cshift0_r10.c
@@ -0,0 +1,176 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_REAL_10)
+
+void
+cshift0_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, ssize_t shift,
+ int which)
+{
+ /* r.* indicates the return array. */
+ index_type rstride[GFC_MAX_DIMENSIONS];
+ index_type rstride0;
+ index_type roffset;
+ GFC_REAL_10 *rptr;
+
+ /* s.* indicates the source array. */
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type sstride0;
+ index_type soffset;
+ const GFC_REAL_10 *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 (GFC_REAL_10);
+ size_t len2 = (len - shift) * sizeof (GFC_REAL_10);
+ 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. */
+ GFC_REAL_10 *dest = rptr;
+ const GFC_REAL_10 *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
diff --git a/libgfortran/generated/cshift0_r16.c b/libgfortran/generated/cshift0_r16.c
new file mode 100644
index 00000000000..c4e229bdaa7
--- /dev/null
+++ b/libgfortran/generated/cshift0_r16.c
@@ -0,0 +1,176 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_REAL_16)
+
+void
+cshift0_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, ssize_t shift,
+ int which)
+{
+ /* r.* indicates the return array. */
+ index_type rstride[GFC_MAX_DIMENSIONS];
+ index_type rstride0;
+ index_type roffset;
+ GFC_REAL_16 *rptr;
+
+ /* s.* indicates the source array. */
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type sstride0;
+ index_type soffset;
+ const GFC_REAL_16 *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 (GFC_REAL_16);
+ size_t len2 = (len - shift) * sizeof (GFC_REAL_16);
+ 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. */
+ GFC_REAL_16 *dest = rptr;
+ const GFC_REAL_16 *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
diff --git a/libgfortran/generated/cshift0_r4.c b/libgfortran/generated/cshift0_r4.c
new file mode 100644
index 00000000000..112ff97e5d3
--- /dev/null
+++ b/libgfortran/generated/cshift0_r4.c
@@ -0,0 +1,176 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_REAL_4)
+
+void
+cshift0_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, ssize_t shift,
+ int which)
+{
+ /* r.* indicates the return array. */
+ index_type rstride[GFC_MAX_DIMENSIONS];
+ index_type rstride0;
+ index_type roffset;
+ GFC_REAL_4 *rptr;
+
+ /* s.* indicates the source array. */
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type sstride0;
+ index_type soffset;
+ const GFC_REAL_4 *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 (GFC_REAL_4);
+ size_t len2 = (len - shift) * sizeof (GFC_REAL_4);
+ 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. */
+ GFC_REAL_4 *dest = rptr;
+ const GFC_REAL_4 *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
diff --git a/libgfortran/generated/cshift0_r8.c b/libgfortran/generated/cshift0_r8.c
new file mode 100644
index 00000000000..a167fd3306a
--- /dev/null
+++ b/libgfortran/generated/cshift0_r8.c
@@ -0,0 +1,176 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_REAL_8)
+
+void
+cshift0_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, ssize_t shift,
+ int which)
+{
+ /* r.* indicates the return array. */
+ index_type rstride[GFC_MAX_DIMENSIONS];
+ index_type rstride0;
+ index_type roffset;
+ GFC_REAL_8 *rptr;
+
+ /* s.* indicates the source array. */
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type sstride0;
+ index_type soffset;
+ const GFC_REAL_8 *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 (GFC_REAL_8);
+ size_t len2 = (len - shift) * sizeof (GFC_REAL_8);
+ 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. */
+ GFC_REAL_8 *dest = rptr;
+ const GFC_REAL_8 *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