libgfortran/generated/minloc1_4_i8.c

   1 /* Implementation of the MINLOC intrinsic
   2    Copyright 2002 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 (libgfor).
   6
   7 Libgfortran is free software; you can redistribute it and/or
   8 modify it under the terms of the GNU Lesser General Public
   9 License as published by the Free Software Foundation; either
  10 version 2.1 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 Lesser General Public License for more details.
  16
  17 You should have received a copy of the GNU Lesser General Public
  18 License along with libgfor; see the file COPYING.LIB.  If not,
  19 write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 Boston, MA 02111-1307, USA.  */
  21
  22 #include "config.h"
  23 #include <stdlib.h>
  24 #include <assert.h>
  25 #include <float.h>
  26 #include <limits.h>
  27 #include "libgfortran.h"
  28
  29 void
  30 __minloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array, index_type *pdim)
  31 {
  32   index_type count[GFC_MAX_DIMENSIONS - 1];
  33   index_type extent[GFC_MAX_DIMENSIONS - 1];
  34   index_type sstride[GFC_MAX_DIMENSIONS - 1];
  35   index_type dstride[GFC_MAX_DIMENSIONS - 1];
  36   GFC_INTEGER_8 *base;
  37   GFC_INTEGER_4 *dest;
  38   index_type rank;
  39   index_type n;
  40   index_type len;
  41   index_type delta;
  42   index_type dim;
  43
  44   /* Make dim zero based to avoid confusion.  */
  45   dim = (*pdim) - 1;
  46   rank = GFC_DESCRIPTOR_RANK (array) - 1;
  47   assert (rank == GFC_DESCRIPTOR_RANK (retarray));
  48   if (array->dim[0].stride == 0)
  49     array->dim[0].stride = 1;
  50   if (retarray->dim[0].stride == 0)
  51     retarray->dim[0].stride = 1;
  52
  53   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
  54   delta = array->dim[dim].stride;
  55
  56   for (n = 0; n < dim; n++)
  57     {
  58       sstride[n] = array->dim[n].stride;
  59       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
  60     }
  61   for (n = dim; n < rank; n++)
  62     {
  63       sstride[n] = array->dim[n + 1].stride;
  64       extent[n] =
  65         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
  66     }
  67
  68   for (n = 0; n < rank; n++)
  69     {
  70       count[n] = 0;
  71       dstride[n] = retarray->dim[n].stride;
  72       if (extent[n] <= 0)
  73         len = 0;
  74     }
  75
  76   base = array->data;
  77   dest = retarray->data;
  78
  79   while (base)
  80     {
  81       GFC_INTEGER_8 *src;
  82       GFC_INTEGER_4 result;
  83       src = base;
  84       {
  85
  86   GFC_INTEGER_8 minval;
  87   minval = GFC_INTEGER_8_HUGE;
  88   result = 1;
  89         if (len <= 0)
  90           *dest = 0;
  91         else
  92           {
  93             for (n = 0; n < len; n++, src += delta)
  94               {
  95
  96   if (*src < minval)
  97     {
  98       minval = *src;
  99       result = (GFC_INTEGER_4)n + 1;
 100     }
 101           }
 102             *dest = result;
 103           }
 104       }
 105       /* Advance to the next element.  */
 106       count[0]++;
 107       base += sstride[0];
 108       dest += dstride[0];
 109       n = 0;
 110       while (count[n] == extent[n])
 111         {
 112           /* When we get to the end of a dimension, reset it and increment
 113              the next dimension.  */
 114           count[n] = 0;
 115           /* We could precalculate these products, but this is a less
 116              frequently used path so proabably not worth it.  */
 117           base -= sstride[n] * extent[n];
 118           dest -= dstride[n] * extent[n];
 119           n++;
 120           if (n == rank)
 121             {
 122               /* Break out of the look.  */
 123               base = NULL;
 124               break;
 125             }
 126           else
 127             {
 128               count[n]++;
 129               base += sstride[n];
 130               dest += dstride[n];
 131             }
 132         }
 133     }
 134 }
 135
 136 void
 137 __mminloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 * array, index_type *pdim, gfc_array_l4 * mask)
 138 {
 139   index_type count[GFC_MAX_DIMENSIONS - 1];
 140   index_type extent[GFC_MAX_DIMENSIONS - 1];
 141   index_type sstride[GFC_MAX_DIMENSIONS - 1];
 142   index_type dstride[GFC_MAX_DIMENSIONS - 1];
 143   index_type mstride[GFC_MAX_DIMENSIONS - 1];
 144   GFC_INTEGER_4 *dest;
 145   GFC_INTEGER_8 *base;
 146   GFC_LOGICAL_4 *mbase;
 147   int rank;
 148   int dim;
 149   index_type n;
 150   index_type len;
 151   index_type delta;
 152   index_type mdelta;
 153
 154   dim = (*pdim) - 1;
 155   rank = GFC_DESCRIPTOR_RANK (array) - 1;
 156   assert (rank == GFC_DESCRIPTOR_RANK (retarray));
 157   if (array->dim[0].stride == 0)
 158     array->dim[0].stride = 1;
 159   if (retarray->dim[0].stride == 0)
 160     retarray->dim[0].stride = 1;
 161
 162   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
 163   if (len <= 0)
 164     return;
 165   delta = array->dim[dim].stride;
 166   mdelta = mask->dim[dim].stride;
 167
 168   for (n = 0; n < dim; n++)
 169     {
 170       sstride[n] = array->dim[n].stride;
 171       mstride[n] = mask->dim[n].stride;
 172       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
 173     }
 174   for (n = dim; n < rank; n++)
 175     {
 176       sstride[n] = array->dim[n + 1].stride;
 177       mstride[n] = mask->dim[n + 1].stride;
 178       extent[n] =
 179         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
 180     }
 181
 182   for (n = 0; n < rank; n++)
 183     {
 184       count[n] = 0;
 185       dstride[n] = retarray->dim[n].stride;
 186       if (extent[n] <= 0)
 187         return;
 188     }
 189
 190   dest = retarray->data;
 191   base = array->data;
 192   mbase = mask->data;
 193
 194   if (GFC_DESCRIPTOR_SIZE (mask) != 4)
 195     {
 196       /* This allows the same loop to be used for all logical types.  */
 197       assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
 198       for (n = 0; n < rank; n++)
 199         mstride[n] <<= 1;
 200       mdelta <<= 1;
 201       mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
 202     }
 203
 204   while (base)
 205     {
 206       GFC_INTEGER_8 *src;
 207       GFC_LOGICAL_4 *msrc;
 208       GFC_INTEGER_4 result;
 209       src = base;
 210       msrc = mbase;
 211       {
 212
 213   GFC_INTEGER_8 minval;
 214   minval = GFC_INTEGER_8_HUGE;
 215   result = 1;
 216         if (len <= 0)
 217           *dest = 0;
 218         else
 219           {
 220             for (n = 0; n < len; n++, src += delta, msrc += mdelta)
 221               {
 222
 223   if (*msrc && *src < minval)
 224     {
 225       minval = *src;
 226       result = (GFC_INTEGER_4)n + 1;
 227     }
 228               }
 229             *dest = result;
 230           }
 231       }
 232       /* Advance to the next element.  */
 233       count[0]++;
 234       base += sstride[0];
 235       mbase += mstride[0];
 236       dest += dstride[0];
 237       n = 0;
 238       while (count[n] == extent[n])
 239         {
 240           /* When we get to the end of a dimension, reset it and increment
 241              the next dimension.  */
 242           count[n] = 0;
 243           /* We could precalculate these products, but this is a less
 244              frequently used path so proabably not worth it.  */
 245           base -= sstride[n] * extent[n];
 246           mbase -= mstride[n] * extent[n];
 247           dest -= dstride[n] * extent[n];
 248           n++;
 249           if (n == rank)
 250             {
 251               /* Break out of the look.  */
 252               base = NULL;
 253               break;
 254             }
 255           else
 256             {
 257               count[n]++;
 258               base += sstride[n];
 259               mbase += mstride[n];
 260               dest += dstride[n];
 261             }
 262         }
 263     }
 264 }
 265