libgfortran/generated/maxloc1_4_i8.c

   1 /* Implementation of the MAXLOC 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
  30 extern void __maxloc1_4_i8 (gfc_array_i4 *, gfc_array_i8 *, index_type *);
  31 export_proto_np(__maxloc1_4_i8);
  32
  33 void
  34 __maxloc1_4_i8 (gfc_array_i4 *retarray, gfc_array_i8 *array, index_type *pdim)
  35 {
  36   index_type count[GFC_MAX_DIMENSIONS - 1];
  37   index_type extent[GFC_MAX_DIMENSIONS - 1];
  38   index_type sstride[GFC_MAX_DIMENSIONS - 1];
  39   index_type dstride[GFC_MAX_DIMENSIONS - 1];
  40   GFC_INTEGER_8 *base;
  41   GFC_INTEGER_4 *dest;
  42   index_type rank;
  43   index_type n;
  44   index_type len;
  45   index_type delta;
  46   index_type dim;
  47
  48   /* Make dim zero based to avoid confusion.  */
  49   dim = (*pdim) - 1;
  50   rank = GFC_DESCRIPTOR_RANK (array) - 1;
  51   assert (rank == GFC_DESCRIPTOR_RANK (retarray));
  52   if (array->dim[0].stride == 0)
  53     array->dim[0].stride = 1;
  54   if (retarray->dim[0].stride == 0)
  55     retarray->dim[0].stride = 1;
  56
  57   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
  58   delta = array->dim[dim].stride;
  59
  60   for (n = 0; n < dim; n++)
  61     {
  62       sstride[n] = array->dim[n].stride;
  63       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
  64     }
  65   for (n = dim; n < rank; n++)
  66     {
  67       sstride[n] = array->dim[n + 1].stride;
  68       extent[n] =
  69         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
  70     }
  71
  72   if (retarray->data == NULL)
  73     {
  74       for (n = 0; n < rank; n++)
  75         {
  76           retarray->dim[n].lbound = 0;
  77           retarray->dim[n].ubound = extent[n]-1;
  78           if (n == 0)
  79             retarray->dim[n].stride = 1;
  80           else
  81             retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
  82         }
  83
  84       retarray->data
  85          = internal_malloc_size (sizeof (GFC_INTEGER_4)
  86                                  * retarray->dim[rank-1].stride
  87                                  * extent[rank-1]);
  88       retarray->base = 0;
  89     }
  90
  91   for (n = 0; n < rank; n++)
  92     {
  93       count[n] = 0;
  94       dstride[n] = retarray->dim[n].stride;
  95       if (extent[n] <= 0)
  96         len = 0;
  97     }
  98
  99   base = array->data;
 100   dest = retarray->data;
 101
 102   while (base)
 103     {
 104       GFC_INTEGER_8 *src;
 105       GFC_INTEGER_4 result;
 106       src = base;
 107       {
 108
 109   GFC_INTEGER_8 maxval;
 110   maxval = -GFC_INTEGER_8_HUGE;
 111   result = 1;
 112         if (len <= 0)
 113           *dest = 0;
 114         else
 115           {
 116             for (n = 0; n < len; n++, src += delta)
 117               {
 118
 119   if (*src > maxval)
 120     {
 121       maxval = *src;
 122       result = (GFC_INTEGER_4)n + 1;
 123     }
 124           }
 125             *dest = result;
 126           }
 127       }
 128       /* Advance to the next element.  */
 129       count[0]++;
 130       base += sstride[0];
 131       dest += dstride[0];
 132       n = 0;
 133       while (count[n] == extent[n])
 134         {
 135           /* When we get to the end of a dimension, reset it and increment
 136              the next dimension.  */
 137           count[n] = 0;
 138           /* We could precalculate these products, but this is a less
 139              frequently used path so proabably not worth it.  */
 140           base -= sstride[n] * extent[n];
 141           dest -= dstride[n] * extent[n];
 142           n++;
 143           if (n == rank)
 144             {
 145               /* Break out of the look.  */
 146               base = NULL;
 147               break;
 148             }
 149           else
 150             {
 151               count[n]++;
 152               base += sstride[n];
 153               dest += dstride[n];
 154             }
 155         }
 156     }
 157 }
 158
 159
 160 extern void __mmaxloc1_4_i8 (gfc_array_i4 *, gfc_array_i8 *, index_type *,
 161                                                 gfc_array_l4 *);
 162 export_proto_np(__mmaxloc1_4_i8);
 163
 164 void
 165 __mmaxloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 * array, index_type *pdim, gfc_array_l4 * mask)
 166 {
 167   index_type count[GFC_MAX_DIMENSIONS - 1];
 168   index_type extent[GFC_MAX_DIMENSIONS - 1];
 169   index_type sstride[GFC_MAX_DIMENSIONS - 1];
 170   index_type dstride[GFC_MAX_DIMENSIONS - 1];
 171   index_type mstride[GFC_MAX_DIMENSIONS - 1];
 172   GFC_INTEGER_4 *dest;
 173   GFC_INTEGER_8 *base;
 174   GFC_LOGICAL_4 *mbase;
 175   int rank;
 176   int dim;
 177   index_type n;
 178   index_type len;
 179   index_type delta;
 180   index_type mdelta;
 181
 182   dim = (*pdim) - 1;
 183   rank = GFC_DESCRIPTOR_RANK (array) - 1;
 184   assert (rank == GFC_DESCRIPTOR_RANK (retarray));
 185   if (array->dim[0].stride == 0)
 186     array->dim[0].stride = 1;
 187   if (retarray->dim[0].stride == 0)
 188     retarray->dim[0].stride = 1;
 189
 190   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
 191   if (len <= 0)
 192     return;
 193   delta = array->dim[dim].stride;
 194   mdelta = mask->dim[dim].stride;
 195
 196   for (n = 0; n < dim; n++)
 197     {
 198       sstride[n] = array->dim[n].stride;
 199       mstride[n] = mask->dim[n].stride;
 200       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
 201     }
 202   for (n = dim; n < rank; n++)
 203     {
 204       sstride[n] = array->dim[n + 1].stride;
 205       mstride[n] = mask->dim[n + 1].stride;
 206       extent[n] =
 207         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
 208     }
 209
 210   for (n = 0; n < rank; n++)
 211     {
 212       count[n] = 0;
 213       dstride[n] = retarray->dim[n].stride;
 214       if (extent[n] <= 0)
 215         return;
 216     }
 217
 218   dest = retarray->data;
 219   base = array->data;
 220   mbase = mask->data;
 221
 222   if (GFC_DESCRIPTOR_SIZE (mask) != 4)
 223     {
 224       /* This allows the same loop to be used for all logical types.  */
 225       assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
 226       for (n = 0; n < rank; n++)
 227         mstride[n] <<= 1;
 228       mdelta <<= 1;
 229       mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
 230     }
 231
 232   while (base)
 233     {
 234       GFC_INTEGER_8 *src;
 235       GFC_LOGICAL_4 *msrc;
 236       GFC_INTEGER_4 result;
 237       src = base;
 238       msrc = mbase;
 239       {
 240
 241   GFC_INTEGER_8 maxval;
 242   maxval = -GFC_INTEGER_8_HUGE;
 243   result = 1;
 244         if (len <= 0)
 245           *dest = 0;
 246         else
 247           {
 248             for (n = 0; n < len; n++, src += delta, msrc += mdelta)
 249               {
 250
 251   if (*msrc && *src > maxval)
 252     {
 253       maxval = *src;
 254       result = (GFC_INTEGER_4)n + 1;
 255     }
 256               }
 257             *dest = result;
 258           }
 259       }
 260       /* Advance to the next element.  */
 261       count[0]++;
 262       base += sstride[0];
 263       mbase += mstride[0];
 264       dest += dstride[0];
 265       n = 0;
 266       while (count[n] == extent[n])
 267         {
 268           /* When we get to the end of a dimension, reset it and increment
 269              the next dimension.  */
 270           count[n] = 0;
 271           /* We could precalculate these products, but this is a less
 272              frequently used path so proabably not worth it.  */
 273           base -= sstride[n] * extent[n];
 274           mbase -= mstride[n] * extent[n];
 275           dest -= dstride[n] * extent[n];
 276           n++;
 277           if (n == rank)
 278             {
 279               /* Break out of the look.  */
 280               base = NULL;
 281               break;
 282             }
 283           else
 284             {
 285               count[n]++;
 286               base += sstride[n];
 287               mbase += mstride[n];
 288               dest += dstride[n];
 289             }
 290         }
 291     }
 292 }
 293