libgfortran/generated/eoshift3_4.c

   1 /* Implementation of the EOSHIFT intrinsic
   2    Copyright 2002, 2005, 2007, 2009 Free Software Foundation, Inc.
   3    Contributed by Paul Brook <paul@nowt.org>
   4
   5 This file is part of the GNU Fortran 95 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_INTEGER_4)
  33
  34 static void
  35 eoshift3 (gfc_array_char * const restrict ret,
  36         const gfc_array_char * const restrict array,
  37         const gfc_array_i4 * const restrict h,
  38         const gfc_array_char * const restrict bound,
  39         const GFC_INTEGER_4 * const restrict pwhich,
  40         const char * filler, index_type filler_len)
  41 {
  42   /* r.* indicates the return array.  */
  43   index_type rstride[GFC_MAX_DIMENSIONS];
  44   index_type rstride0;
  45   index_type roffset;
  46   char *rptr;
  47   char * restrict dest;
  48   /* s.* indicates the source array.  */
  49   index_type sstride[GFC_MAX_DIMENSIONS];
  50   index_type sstride0;
  51   index_type soffset;
  52   const char *sptr;
  53   const char *src;
  54   /* h.* indicates the shift array.  */
  55   index_type hstride[GFC_MAX_DIMENSIONS];
  56   index_type hstride0;
  57   const GFC_INTEGER_4 *hptr;
  58   /* b.* indicates the bound array.  */
  59   index_type bstride[GFC_MAX_DIMENSIONS];
  60   index_type bstride0;
  61   const char *bptr;
  62
  63   index_type count[GFC_MAX_DIMENSIONS];
  64   index_type extent[GFC_MAX_DIMENSIONS];
  65   index_type dim;
  66   index_type len;
  67   index_type n;
  68   index_type size;
  69   int which;
  70   GFC_INTEGER_4 sh;
  71   GFC_INTEGER_4 delta;
  72
  73   /* The compiler cannot figure out that these are set, initialize
  74      them to avoid warnings.  */
  75   len = 0;
  76   soffset = 0;
  77   roffset = 0;
  78
  79   size = GFC_DESCRIPTOR_SIZE(array);
  80
  81   if (pwhich)
  82     which = *pwhich - 1;
  83   else
  84     which = 0;
  85
  86   if (ret->data == NULL)
  87     {
  88       int i;
  89
  90       ret->data = internal_malloc_size (size * size0 ((array_t *)array));
  91       ret->offset = 0;
  92       ret->dtype = array->dtype;
  93       for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
  94         {
  95           index_type ub, str;
  96
  97           ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
  98
  99           if (i == 0)
 100             str = 1;
 101           else
 102             str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
 103               * GFC_DESCRIPTOR_STRIDE(ret,i-1);
 104
 105           GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
 106
 107         }
 108     }
 109   else
 110     {
 111       if (size0 ((array_t *) ret) == 0)
 112         return;
 113     }
 114
 115
 116   extent[0] = 1;
 117   count[0] = 0;
 118   n = 0;
 119   for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
 120     {
 121       if (dim == which)
 122         {
 123           roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
 124           if (roffset == 0)
 125             roffset = size;
 126           soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
 127           if (soffset == 0)
 128             soffset = size;
 129           len = GFC_DESCRIPTOR_EXTENT(array,dim);
 130         }
 131       else
 132         {
 133           count[n] = 0;
 134           extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
 135           rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
 136           sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
 137
 138           hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n);
 139           if (bound)
 140             bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n);
 141           else
 142             bstride[n] = 0;
 143           n++;
 144         }
 145     }
 146   if (sstride[0] == 0)
 147     sstride[0] = size;
 148   if (rstride[0] == 0)
 149     rstride[0] = size;
 150   if (hstride[0] == 0)
 151     hstride[0] = 1;
 152   if (bound && bstride[0] == 0)
 153     bstride[0] = size;
 154
 155   dim = GFC_DESCRIPTOR_RANK (array);
 156   rstride0 = rstride[0];
 157   sstride0 = sstride[0];
 158   hstride0 = hstride[0];
 159   bstride0 = bstride[0];
 160   rptr = ret->data;
 161   sptr = array->data;
 162   hptr = h->data;
 163   if (bound)
 164     bptr = bound->data;
 165   else
 166     bptr = NULL;
 167
 168   while (rptr)
 169     {
 170       /* Do the shift for this dimension.  */
 171       sh = *hptr;
 172       if (( sh >= 0 ? sh : -sh ) > len)
 173         {
 174           delta = len;
 175           sh = len;
 176         }
 177       else
 178         delta = (sh >= 0) ? sh: -sh;
 179
 180       if (sh > 0)
 181         {
 182           src = &sptr[delta * soffset];
 183           dest = rptr;
 184         }
 185       else
 186         {
 187           src = sptr;
 188           dest = &rptr[delta * roffset];
 189         }
 190       for (n = 0; n < len - delta; n++)
 191         {
 192           memcpy (dest, src, size);
 193           dest += roffset;
 194           src += soffset;
 195         }
 196       if (sh < 0)
 197         dest = rptr;
 198       n = delta;
 199
 200       if (bptr)
 201         while (n--)
 202           {
 203             memcpy (dest, bptr, size);
 204             dest += roffset;
 205           }
 206       else
 207         while (n--)
 208           {
 209             index_type i;
 210
 211             if (filler_len == 1)
 212               memset (dest, filler[0], size);
 213             else
 214               for (i = 0; i < size; i += filler_len)
 215                 memcpy (&dest[i], filler, filler_len);
 216
 217             dest += roffset;
 218           }
 219
 220       /* Advance to the next section.  */
 221       rptr += rstride0;
 222       sptr += sstride0;
 223       hptr += hstride0;
 224       bptr += bstride0;
 225       count[0]++;
 226       n = 0;
 227       while (count[n] == extent[n])
 228         {
 229           /* When we get to the end of a dimension, reset it and increment
 230              the next dimension.  */
 231           count[n] = 0;
 232           /* We could precalculate these products, but this is a less
 233              frequently used path so probably not worth it.  */
 234           rptr -= rstride[n] * extent[n];
 235           sptr -= sstride[n] * extent[n];
 236           hptr -= hstride[n] * extent[n];
 237           bptr -= bstride[n] * extent[n];
 238           n++;
 239           if (n >= dim - 1)
 240             {
 241               /* Break out of the loop.  */
 242               rptr = NULL;
 243               break;
 244             }
 245           else
 246             {
 247               count[n]++;
 248               rptr += rstride[n];
 249               sptr += sstride[n];
 250               hptr += hstride[n];
 251               bptr += bstride[n];
 252             }
 253         }
 254     }
 255 }
 256
 257 extern void eoshift3_4 (gfc_array_char * const restrict,
 258         const gfc_array_char * const restrict,
 259         const gfc_array_i4 * const restrict,
 260         const gfc_array_char * const restrict,
 261         const GFC_INTEGER_4 *);
 262 export_proto(eoshift3_4);
 263
 264 void
 265 eoshift3_4 (gfc_array_char * const restrict ret,
 266         const gfc_array_char * const restrict array,
 267         const gfc_array_i4 * const restrict h,
 268         const gfc_array_char * const restrict bound,
 269         const GFC_INTEGER_4 * const restrict pwhich)
 270 {
 271   eoshift3 (ret, array, h, bound, pwhich, "\0", 1);
 272 }
 273
 274
 275 extern void eoshift3_4_char (gfc_array_char * const restrict,
 276         GFC_INTEGER_4,
 277         const gfc_array_char * const restrict,
 278         const gfc_array_i4 * const restrict,
 279         const gfc_array_char * const restrict,
 280         const GFC_INTEGER_4 * const restrict,
 281         GFC_INTEGER_4, GFC_INTEGER_4);
 282 export_proto(eoshift3_4_char);
 283
 284 void
 285 eoshift3_4_char (gfc_array_char * const restrict ret,
 286         GFC_INTEGER_4 ret_length __attribute__((unused)),
 287         const gfc_array_char * const restrict array,
 288         const gfc_array_i4 *  const restrict h,
 289         const gfc_array_char * const restrict bound,
 290         const GFC_INTEGER_4 * const restrict pwhich,
 291         GFC_INTEGER_4 array_length __attribute__((unused)),
 292         GFC_INTEGER_4 bound_length __attribute__((unused)))
 293 {
 294   eoshift3 (ret, array, h, bound, pwhich, " ", 1);
 295 }
 296
 297
 298 extern void eoshift3_4_char4 (gfc_array_char * const restrict,
 299         GFC_INTEGER_4,
 300         const gfc_array_char * const restrict,
 301         const gfc_array_i4 * const restrict,
 302         const gfc_array_char * const restrict,
 303         const GFC_INTEGER_4 * const restrict,
 304         GFC_INTEGER_4, GFC_INTEGER_4);
 305 export_proto(eoshift3_4_char4);
 306
 307 void
 308 eoshift3_4_char4 (gfc_array_char * const restrict ret,
 309         GFC_INTEGER_4 ret_length __attribute__((unused)),
 310         const gfc_array_char * const restrict array,
 311         const gfc_array_i4 *  const restrict h,
 312         const gfc_array_char * const restrict bound,
 313         const GFC_INTEGER_4 * const restrict pwhich,
 314         GFC_INTEGER_4 array_length __attribute__((unused)),
 315         GFC_INTEGER_4 bound_length __attribute__((unused)))
 316 {
 317   static const gfc_char4_t space = (unsigned char) ' ';
 318   eoshift3 (ret, array, h, bound, pwhich,
 319             (const char *) &space, sizeof (gfc_char4_t));
 320 }
 321
 322 #endif