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