libgfortran/generated/eoshift3_4.c

   1 /* Implementation of the EOSHIFT intrinsic
   2    Copyright 2002, 2005 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 "config.h"
  32 #include <stdlib.h>
  33 #include <assert.h>
  34 #include <string.h>
  35 #include "libgfortran.h"
  36
  37 #if defined (HAVE_GFC_INTEGER_4)
  38
  39 static void
  40 eoshift3 (gfc_array_char * const restrict ret,
  41         const gfc_array_char * const restrict array,
  42         const gfc_array_i4 * const restrict h,
  43         const gfc_array_char * const restrict bound,
  44         const GFC_INTEGER_4 * const restrict pwhich,
  45         index_type size, char filler)
  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 *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_4 *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_4 sh;
  75   GFC_INTEGER_4 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
 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             memset (dest, filler, size);
 202             dest += roffset;
 203           }
 204
 205       /* Advance to the next section.  */
 206       rptr += rstride0;
 207       sptr += sstride0;
 208       hptr += hstride0;
 209       bptr += bstride0;
 210       count[0]++;
 211       n = 0;
 212       while (count[n] == extent[n])
 213         {
 214           /* When we get to the end of a dimension, reset it and increment
 215              the next dimension.  */
 216           count[n] = 0;
 217           /* We could precalculate these products, but this is a less
 218              frequently used path so proabably not worth it.  */
 219           rptr -= rstride[n] * extent[n];
 220           sptr -= sstride[n] * extent[n];
 221           hptr -= hstride[n] * extent[n];
 222           bptr -= bstride[n] * extent[n];
 223           n++;
 224           if (n >= dim - 1)
 225             {
 226               /* Break out of the loop.  */
 227               rptr = NULL;
 228               break;
 229             }
 230           else
 231             {
 232               count[n]++;
 233               rptr += rstride[n];
 234               sptr += sstride[n];
 235               hptr += hstride[n];
 236               bptr += bstride[n];
 237             }
 238         }
 239     }
 240 }
 241
 242 extern void eoshift3_4 (gfc_array_char * const restrict,
 243         const gfc_array_char * const restrict,
 244         const gfc_array_i4 * const restrict,
 245         const gfc_array_char * const restrict,
 246         const GFC_INTEGER_4 *);
 247 export_proto(eoshift3_4);
 248
 249 void
 250 eoshift3_4 (gfc_array_char * const restrict ret,
 251         const gfc_array_char * const restrict array,
 252         const gfc_array_i4 * const restrict h,
 253         const gfc_array_char * const restrict bound,
 254         const GFC_INTEGER_4 * const restrict pwhich)
 255 {
 256   eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0);
 257 }
 258
 259 extern void eoshift3_4_char (gfc_array_char * const restrict,
 260         GFC_INTEGER_4,
 261         const gfc_array_char * const restrict,
 262         const gfc_array_i4 * const restrict,
 263         const gfc_array_char * const restrict,
 264         const GFC_INTEGER_4 * const restrict,
 265         GFC_INTEGER_4, GFC_INTEGER_4);
 266 export_proto(eoshift3_4_char);
 267
 268 void
 269 eoshift3_4_char (gfc_array_char * const restrict ret,
 270         GFC_INTEGER_4 ret_length __attribute__((unused)),
 271         const gfc_array_char * const restrict array,
 272         const gfc_array_i4 *  const restrict h,
 273         const gfc_array_char * const restrict bound,
 274         const GFC_INTEGER_4 * const restrict pwhich,
 275         GFC_INTEGER_4 array_length,
 276         GFC_INTEGER_4 bound_length __attribute__((unused)))
 277 {
 278   eoshift3 (ret, array, h, bound, pwhich, array_length, ' ');
 279 }
 280
 281 #endif