]> git.ipfire.org Git - thirdparty/gcc.git/blobdiff - libgfortran/generated/cshift0_c8.c
Update copyright years.
[thirdparty/gcc.git] / libgfortran / generated / cshift0_c8.c
index 9b9c3b2acced65e4b01e88b4bf2845720f0726bd..c75d882c5c263fe7378530f907aecf2e98ca447f 100644 (file)
@@ -1,8 +1,8 @@
 /* Helper function for cshift functions.
-   Copyright 2008, 2009 Free Software Foundation, Inc.
+   Copyright (C) 2008-2020 Free Software Foundation, Inc.
    Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>
 
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
 
 Libgfortran is free software; you can redistribute it and/or
 modify it under the terms of the GNU General Public
@@ -24,15 +24,13 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 <http://www.gnu.org/licenses/>.  */
 
 #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,
+cshift0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, ptrdiff_t shift,
                     int which)
 {
   /* r.* indicates the return array.  */
@@ -53,6 +51,9 @@ cshift0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, ssize_t shift,
   index_type len;
   index_type n;
 
+  bool do_blocked;
+  index_type r_ex, a_ex;
+
   which = which - 1;
   sstride[0] = 0;
   rstride[0] = 0;
@@ -65,41 +66,111 @@ cshift0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, ssize_t shift,
   soffset = 1;
   len = 0;
 
-  for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+  r_ex = 1;
+  a_ex = 1;
+
+  if (which > 0)
     {
-      if (dim == which)
-        {
-          roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
-          if (roffset == 0)
-            roffset = 1;
-          soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
-          if (soffset == 0)
-            soffset = 1;
-          len = GFC_DESCRIPTOR_EXTENT(array,dim);
-        }
-      else
-        {
-          count[n] = 0;
-          extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
-          rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
-          sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
-          n++;
-        }
+      /* Test if both ret and array are contiguous.  */
+      do_blocked = true;
+      dim = GFC_DESCRIPTOR_RANK (array);
+      for (n = 0; n < dim; n ++)
+       {
+         index_type rs, as;
+         rs = GFC_DESCRIPTOR_STRIDE (ret, n);
+         if (rs != r_ex)
+           {
+             do_blocked = false;
+             break;
+           }
+         as = GFC_DESCRIPTOR_STRIDE (array, n);
+         if (as != a_ex)
+           {
+             do_blocked = false;
+             break;
+           }
+         r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n);
+         a_ex *= GFC_DESCRIPTOR_EXTENT (array, n);
+       }
+    }
+  else
+    do_blocked = false;
+
+  n = 0;
+
+  if (do_blocked)
+    {
+      /* For contiguous arrays, use the relationship that
+
+         dimension(n1,n2,n3) :: a, b
+        b = cshift(a,sh,3)
+
+         can be dealt with as if
+
+        dimension(n1*n2*n3) :: an, bn
+        bn = cshift(a,sh*n1*n2,1)
+
+        we can used a more blocked algorithm for dim>1.  */
+      sstride[0] = 1;
+      rstride[0] = 1;
+      roffset = 1;
+      soffset = 1;
+      len = GFC_DESCRIPTOR_STRIDE(array, which)
+       * GFC_DESCRIPTOR_EXTENT(array, which);      
+      shift *= GFC_DESCRIPTOR_STRIDE(array, which);
+      for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+       {
+         count[n] = 0;
+         extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+         rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+         sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+         n++;
+       }
+      dim = GFC_DESCRIPTOR_RANK (array) - which;
+    }
+  else
+    {
+      for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+       {
+         if (dim == which)
+           {
+             roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
+             if (roffset == 0)
+               roffset = 1;
+             soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
+             if (soffset == 0)
+               soffset = 1;
+             len = GFC_DESCRIPTOR_EXTENT(array,dim);
+           }
+         else
+           {
+             count[n] = 0;
+             extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+             rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+             sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+             n++;
+           }
+       }
+      if (sstride[0] == 0)
+       sstride[0] = 1;
+      if (rstride[0] == 0)
+       rstride[0] = 1;
+
+      dim = GFC_DESCRIPTOR_RANK (array);
     }
-  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;
+  rptr = ret->base_addr;
+  sptr = array->base_addr;
 
-  shift = len == 0 ? 0 : shift % (ssize_t)len;
-  if (shift < 0)
-    shift += len;
+  /* Avoid the costly modulo for trivially in-bound shifts.  */
+  if (shift < 0 || shift >= len)
+    {
+      shift = len == 0 ? 0 : shift % (ptrdiff_t)len;
+      if (shift < 0)
+       shift += len;
+    }
 
   while (rptr)
     {