libgfortran/generated/eoshift3_8.c

   1 /* Implementation of the EOSHIFT intrinsic
   2    Copyright 2002, 2005, 2007 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 2 of the License, or (at your option) any later version.
  11
  12 In addition to the permissions in the GNU General Public License, the
  13 Free Software Foundation gives you unlimited permission to link the
  14 compiled version of this file into combinations with other programs,
  15 and to distribute those combinations without any restriction coming
  16 from the use of this file.  (The General Public License restrictions
  17 do apply in other respects; for example, they cover modification of
  18 the file, and distribution when not linked into a combine
  19 executable.)
  20
  21 Libgfortran is distributed in the hope that it will be useful,
  22 but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 GNU General Public License for more details.
  25
  26 You should have received a copy of the GNU General Public
  27 License along with libgfortran; see the file COPYING.  If not,
  28 write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  29 Boston, MA 02110-1301, USA.  */
  30
  31 #include "libgfortran.h"
  32 #include <stdlib.h>
  33 #include <assert.h>
  34 #include <string.h>
  35
  36
  37 #if defined (HAVE_GFC_INTEGER_8)
  38
  39 static void
  40 eoshift3 (gfc_array_char * const restrict ret,
  41         const gfc_array_char * const restrict array,
  42         const gfc_array_i8 * const restrict h,
  43         const gfc_array_char * const restrict bound,
  44         const GFC_INTEGER_8 * const restrict pwhich,
  45         index_type size, const char * filler, index_type filler_len)
  46 {
  47   /* r.* indicates the return array.  */
  48   index_type rstride[GFC_MAX_DIMENSIONS];
  49   index_type rstride0;
  50   index_type roffset;
  51   char *rptr;
  52   char * restrict dest;
  53   /* s.* indicates the source array.  */
  54   index_type sstride[GFC_MAX_DIMENSIONS];
  55   index_type sstride0;
  56   index_type soffset;
  57   const char *sptr;
  58   const char *src;
  59   /* h.* indicates the shift array.  */
  60   index_type hstride[GFC_MAX_DIMENSIONS];
  61   index_type hstride0;
  62   const GFC_INTEGER_8 *hptr;
  63   /* b.* indicates the bound array.  */
  64   index_type bstride[GFC_MAX_DIMENSIONS];
  65   index_type bstride0;
  66   const char *bptr;
  67
  68   index_type count[GFC_MAX_DIMENSIONS];
  69   index_type extent[GFC_MAX_DIMENSIONS];
  70   index_type dim;
  71   index_type len;
  72   index_type n;
  73   int which;
  74   GFC_INTEGER_8 sh;
  75   GFC_INTEGER_8 delta;
  76
  77   /* The compiler cannot figure out that these are set, initialize
  78      them to avoid warnings.  */
  79   len = 0;
  80   soffset = 0;
  81   roffset = 0;
  82
  83   if (pwhich)
  84     which = *pwhich - 1;
  85   else
  86     which = 0;
  87
  88   if (ret->data == NULL)
  89     {
  90       int i;
  91
  92       ret->data = internal_malloc_size (size * size0 ((array_t *)array));
  93       ret->offset = 0;
  94       ret->dtype = array->dtype;
  95       for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
  96         {
  97           ret->dim[i].lbound = 0;
  98           ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
  99
 100           if (i == 0)
 101             ret->dim[i].stride = 1;
 102           else
 103             ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
 104         }
 105     }
 106   else
 107     {
 108       if (size0 ((array_t *) ret) == 0)
 109         return;
 110     }
 111
 112
 113   extent[0] = 1;
 114   count[0] = 0;
 115   n = 0;
 116   for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
 117     {
 118       if (dim == which)
 119         {
 120           roffset = ret->dim[dim].stride * size;
 121           if (roffset == 0)
 122             roffset = size;
 123           soffset = array->dim[dim].stride * size;
 124           if (soffset == 0)
 125             soffset = size;
 126           len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
 127         }
 128       else
 129         {
 130           count[n] = 0;
 131           extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
 132           rstride[n] = ret->dim[dim].stride * size;
 133           sstride[n] = array->dim[dim].stride * size;
 134
 135           hstride[n] = h->dim[n].stride;
 136           if (bound)
 137             bstride[n] = bound->dim[n].stride * size;
 138           else
 139             bstride[n] = 0;
 140           n++;
 141         }
 142     }
 143   if (sstride[0] == 0)
 144     sstride[0] = size;
 145   if (rstride[0] == 0)
 146     rstride[0] = size;
 147   if (hstride[0] == 0)
 148     hstride[0] = 1;
 149   if (bound && bstride[0] == 0)
 150     bstride[0] = size;
 151
 152   dim = GFC_DESCRIPTOR_RANK (array);
 153   rstride0 = rstride[0];
 154   sstride0 = sstride[0];
 155   hstride0 = hstride[0];
 156   bstride0 = bstride[0];
 157   rptr = ret->data;
 158   sptr = array->data;
 159   hptr = h->data;
 160   if (bound)
 161     bptr = bound->data;
 162   else
 163     bptr = NULL;
 164
 165   while (rptr)
 166     {
 167       /* Do the shift for this dimension.  */
 168       sh = *hptr;
 169       if (( sh >= 0 ? sh : -sh ) > len)
 170         {
 171           delta = len;
 172           sh = len;
 173         }
 174       else
 175         delta = (sh >= 0) ? sh: -sh;
 176
 177       if (sh > 0)
 178         {
 179           src = &sptr[delta * soffset];
 180           dest = rptr;
 181         }
 182       else
 183         {
 184           src = sptr;
 185           dest = &rptr[delta * roffset];
 186         }
 187       for (n = 0; n < len - delta; n++)
 188         {
 189           memcpy (dest, src, size);
 190           dest += roffset;
 191           src += soffset;
 192         }
 193       if (sh < 0)
 194         dest = rptr;
 195       n = delta;
 196
 197       if (bptr)
 198         while (n--)
 199           {
 200             memcpy (dest, bptr, size);
 201             dest += roffset;
 202           }
 203       else
 204         while (n--)
 205           {
 206             index_type i;
 207
 208             if (filler_len == 1)
 209               memset (dest, filler[0], size);
 210             else
 211               for (i = 0; i < size; i += filler_len)
 212                 memcpy (&dest[i], filler, filler_len);
 213
 214             dest += roffset;
 215           }
 216
 217       /* Advance to the next section.  */
 218       rptr += rstride0;
 219       sptr += sstride0;
 220       hptr += hstride0;
 221       bptr += bstride0;
 222       count[0]++;
 223       n = 0;
 224       while (count[n] == extent[n])
 225         {
 226           /* When we get to the end of a dimension, reset it and increment
 227              the next dimension.  */
 228           count[n] = 0;
 229           /* We could precalculate these products, but this is a less
 230              frequently used path so probably not worth it.  */
 231           rptr -= rstride[n] * extent[n];
 232           sptr -= sstride[n] * extent[n];
 233           hptr -= hstride[n] * extent[n];
 234           bptr -= bstride[n] * extent[n];
 235           n++;
 236           if (n >= dim - 1)
 237             {
 238               /* Break out of the loop.  */
 239               rptr = NULL;
 240               break;
 241             }
 242           else
 243             {
 244               count[n]++;
 245               rptr += rstride[n];
 246               sptr += sstride[n];
 247               hptr += hstride[n];
 248               bptr += bstride[n];
 249             }
 250         }
 251     }
 252 }
 253
 254 extern void eoshift3_8 (gfc_array_char * const restrict,
 255         const gfc_array_char * const restrict,
 256         const gfc_array_i8 * const restrict,
 257         const gfc_array_char * const restrict,
 258         const GFC_INTEGER_8 *);
 259 export_proto(eoshift3_8);
 260
 261 void
 262 eoshift3_8 (gfc_array_char * const restrict ret,
 263         const gfc_array_char * const restrict array,
 264         const gfc_array_i8 * const restrict h,
 265         const gfc_array_char * const restrict bound,
 266         const GFC_INTEGER_8 * const restrict pwhich)
 267 {
 268   eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array),
 269             "\0", 1);
 270 }
 271
 272
 273 extern void eoshift3_8_char (gfc_array_char * const restrict,
 274         GFC_INTEGER_4,
 275         const gfc_array_char * const restrict,
 276         const gfc_array_i8 * const restrict,
 277         const gfc_array_char * const restrict,
 278         const GFC_INTEGER_8 * const restrict,
 279         GFC_INTEGER_4, GFC_INTEGER_4);
 280 export_proto(eoshift3_8_char);
 281
 282 void
 283 eoshift3_8_char (gfc_array_char * const restrict ret,
 284         GFC_INTEGER_4 ret_length __attribute__((unused)),
 285         const gfc_array_char * const restrict array,
 286         const gfc_array_i8 *  const restrict h,
 287         const gfc_array_char * const restrict bound,
 288         const GFC_INTEGER_8 * const restrict pwhich,
 289         GFC_INTEGER_4 array_length,
 290         GFC_INTEGER_4 bound_length __attribute__((unused)))
 291 {
 292   eoshift3 (ret, array, h, bound, pwhich, array_length, " ", 1);
 293 }
 294
 295
 296 extern void eoshift3_8_char4 (gfc_array_char * const restrict,
 297         GFC_INTEGER_4,
 298         const gfc_array_char * const restrict,
 299         const gfc_array_i8 * const restrict,
 300         const gfc_array_char * const restrict,
 301         const GFC_INTEGER_8 * const restrict,
 302         GFC_INTEGER_4, GFC_INTEGER_4);
 303 export_proto(eoshift3_8_char4);
 304
 305 void
 306 eoshift3_8_char4 (gfc_array_char * const restrict ret,
 307         GFC_INTEGER_4 ret_length __attribute__((unused)),
 308         const gfc_array_char * const restrict array,
 309         const gfc_array_i8 *  const restrict h,
 310         const gfc_array_char * const restrict bound,
 311         const GFC_INTEGER_8 * const restrict pwhich,
 312         GFC_INTEGER_4 array_length,
 313         GFC_INTEGER_4 bound_length __attribute__((unused)))
 314 {
 315   static const gfc_char4_t space = (unsigned char) ' ';
 316   eoshift3 (ret, array, h, bound, pwhich, array_length * sizeof (gfc_char4_t),
 317             (const char *) &space, sizeof (gfc_char4_t));
 318 }
 319
 320 #endif