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