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