libgfortran/generated/cshift0_r4.c

   1 /* Helper function for cshift functions.
   2    Copyright (C) 2008-2016 Free Software Foundation, Inc.
   3    Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>
   4
   5 This file is part of the GNU Fortran runtime library (libgfortran).
   6
   7 Libgfortran is free software; you can redistribute it and/or
   8 modify it under the terms of the GNU General Public
   9 License as published by the Free Software Foundation; either
  10 version 3 of the License, or (at your option) any later version.
  11
  12 Libgfortran is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 Under Section 7 of GPL version 3, you are granted additional
  18 permissions described in the GCC Runtime Library Exception, version
  19 3.1, as published by the Free Software Foundation.
  20
  21 You should have received a copy of the GNU General Public License and
  22 a copy of the GCC Runtime Library Exception along with this program;
  23 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  24 <http://www.gnu.org/licenses/>.  */
  25
  26 #include "libgfortran.h"
  27 #include <stdlib.h>
  28 #include <assert.h>
  29 #include <string.h>
  30
  31
  32 #if defined (HAVE_GFC_REAL_4)
  33
  34 void
  35 cshift0_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, ptrdiff_t shift,
  36                      int which)
  37 {
  38   /* r.* indicates the return array.  */
  39   index_type rstride[GFC_MAX_DIMENSIONS];
  40   index_type rstride0;
  41   index_type roffset;
  42   GFC_REAL_4 *rptr;
  43
  44   /* s.* indicates the source array.  */
  45   index_type sstride[GFC_MAX_DIMENSIONS];
  46   index_type sstride0;
  47   index_type soffset;
  48   const GFC_REAL_4 *sptr;
  49
  50   index_type count[GFC_MAX_DIMENSIONS];
  51   index_type extent[GFC_MAX_DIMENSIONS];
  52   index_type dim;
  53   index_type len;
  54   index_type n;
  55
  56   which = which - 1;
  57   sstride[0] = 0;
  58   rstride[0] = 0;
  59
  60   extent[0] = 1;
  61   count[0] = 0;
  62   n = 0;
  63   /* Initialized for avoiding compiler warnings.  */
  64   roffset = 1;
  65   soffset = 1;
  66   len = 0;
  67
  68   for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
  69     {
  70       if (dim == which)
  71         {
  72           roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
  73           if (roffset == 0)
  74             roffset = 1;
  75           soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
  76           if (soffset == 0)
  77             soffset = 1;
  78           len = GFC_DESCRIPTOR_EXTENT(array,dim);
  79         }
  80       else
  81         {
  82           count[n] = 0;
  83           extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
  84           rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
  85           sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
  86           n++;
  87         }
  88     }
  89   if (sstride[0] == 0)
  90     sstride[0] = 1;
  91   if (rstride[0] == 0)
  92     rstride[0] = 1;
  93
  94   dim = GFC_DESCRIPTOR_RANK (array);
  95   rstride0 = rstride[0];
  96   sstride0 = sstride[0];
  97   rptr = ret->base_addr;
  98   sptr = array->base_addr;
  99
 100   /* Avoid the costly modulo for trivially in-bound shifts.  */
 101   if (shift < 0 || shift >= len)
 102     {
 103       shift = len == 0 ? 0 : shift % (ptrdiff_t)len;
 104       if (shift < 0)
 105         shift += len;
 106     }
 107
 108   while (rptr)
 109     {
 110       /* Do the shift for this dimension.  */
 111
 112       /* If elements are contiguous, perform the operation
 113          in two block moves.  */
 114       if (soffset == 1 && roffset == 1)
 115         {
 116           size_t len1 = shift * sizeof (GFC_REAL_4);
 117           size_t len2 = (len - shift) * sizeof (GFC_REAL_4);
 118           memcpy (rptr, sptr + shift, len2);
 119           memcpy (rptr + (len - shift), sptr, len1);
 120         }
 121       else
 122         {
 123           /* Otherwise, we will have to perform the copy one element at
 124              a time.  */
 125           GFC_REAL_4 *dest = rptr;
 126           const GFC_REAL_4 *src = &sptr[shift * soffset];
 127
 128           for (n = 0; n < len - shift; n++)
 129             {
 130               *dest = *src;
 131               dest += roffset;
 132               src += soffset;
 133             }
 134           for (src = sptr, n = 0; n < shift; n++)
 135             {
 136               *dest = *src;
 137               dest += roffset;
 138               src += soffset;
 139             }
 140         }
 141
 142       /* Advance to the next section.  */
 143       rptr += rstride0;
 144       sptr += sstride0;
 145       count[0]++;
 146       n = 0;
 147       while (count[n] == extent[n])
 148         {
 149           /* When we get to the end of a dimension, reset it and increment
 150              the next dimension.  */
 151           count[n] = 0;
 152           /* We could precalculate these products, but this is a less
 153              frequently used path so probably not worth it.  */
 154           rptr -= rstride[n] * extent[n];
 155           sptr -= sstride[n] * extent[n];
 156           n++;
 157           if (n >= dim - 1)
 158             {
 159               /* Break out of the loop.  */
 160               rptr = NULL;
 161               break;
 162             }
 163           else
 164             {
 165               count[n]++;
 166               rptr += rstride[n];
 167               sptr += sstride[n];
 168             }
 169         }
 170     }
 171
 172   return;
 173 }
 174
 175 #endif