libgfortran/generated/maxval_i4.c

   1 /* Implementation of the MAXVAL 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 "libgfortran.h"
  27
  28
  29 void
  30 __maxval_i4 (gfc_array_i4 * retarray, gfc_array_i4 *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_4 *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   if (len <= 0)
  55     return;
  56   delta = array->dim[dim].stride;
  57
  58   for (n = 0; n < dim; n++)
  59     {
  60       sstride[n] = array->dim[n].stride;
  61       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
  62     }
  63   for (n = dim; n < rank; n++)
  64     {
  65       sstride[n] = array->dim[n + 1].stride;
  66       extent[n] =
  67         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
  68     }
  69
  70   for (n = 0; n < rank; n++)
  71     {
  72       count[n] = 0;
  73       dstride[n] = retarray->dim[n].stride;
  74       if (extent[n] <= 0)
  75         return;
  76     }
  77
  78   base = array->data;
  79   dest = retarray->data;
  80
  81   while (base)
  82     {
  83       GFC_INTEGER_4 *src;
  84       GFC_INTEGER_4 result;
  85       src = base;
  86       {
  87
  88   result = -GFC_INTEGER_4_HUGE;
  89        for (n = 0; n < len; n++, src += delta)
  90           {
  91
  92   if (*src > result)
  93     result = *src;
  94           }
  95         *dest = result;
  96       }
  97       /* Advance to the next element.  */
  98       count[0]++;
  99       base += sstride[0];
 100       dest += dstride[0];
 101       n = 0;
 102       while (count[n] == extent[n])
 103         {
 104           /* When we get to the end of a dimension, reset it and increment
 105              the next dimension.  */
 106           count[n] = 0;
 107           /* We could precalculate these products, but this is a less
 108              frequently used path so proabably not worth it.  */
 109           base -= sstride[n] * extent[n];
 110           dest -= dstride[n] * extent[n];
 111           n++;
 112           if (n == rank)
 113             {
 114               /* Break out of the look.  */
 115               base = NULL;
 116               break;
 117             }
 118           else
 119             {
 120               count[n]++;
 121               base += sstride[n];
 122               dest += dstride[n];
 123             }
 124         }
 125     }
 126 }
 127
 128 void
 129 __mmaxval_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, index_type *pdim, gfc_array_l4 * mask)
 130 {
 131   index_type count[GFC_MAX_DIMENSIONS - 1];
 132   index_type extent[GFC_MAX_DIMENSIONS - 1];
 133   index_type sstride[GFC_MAX_DIMENSIONS - 1];
 134   index_type dstride[GFC_MAX_DIMENSIONS - 1];
 135   index_type mstride[GFC_MAX_DIMENSIONS - 1];
 136   GFC_INTEGER_4 *dest;
 137   GFC_INTEGER_4 *base;
 138   GFC_LOGICAL_4 *mbase;
 139   int rank;
 140   int dim;
 141   index_type n;
 142   index_type len;
 143   index_type delta;
 144   index_type mdelta;
 145
 146   dim = (*pdim) - 1;
 147   rank = GFC_DESCRIPTOR_RANK (array) - 1;
 148   assert (rank == GFC_DESCRIPTOR_RANK (retarray));
 149   if (array->dim[0].stride == 0)
 150     array->dim[0].stride = 1;
 151   if (retarray->dim[0].stride == 0)
 152     retarray->dim[0].stride = 1;
 153
 154   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
 155   if (len <= 0)
 156     return;
 157   delta = array->dim[dim].stride;
 158   mdelta = mask->dim[dim].stride;
 159
 160   for (n = 0; n < dim; n++)
 161     {
 162       sstride[n] = array->dim[n].stride;
 163       mstride[n] = mask->dim[n].stride;
 164       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
 165     }
 166   for (n = dim; n < rank; n++)
 167     {
 168       sstride[n] = array->dim[n + 1].stride;
 169       mstride[n] = mask->dim[n + 1].stride;
 170       extent[n] =
 171         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
 172     }
 173
 174   for (n = 0; n < rank; n++)
 175     {
 176       count[n] = 0;
 177       dstride[n] = retarray->dim[n].stride;
 178       if (extent[n] <= 0)
 179         return;
 180     }
 181
 182   dest = retarray->data;
 183   base = array->data;
 184   mbase = mask->data;
 185
 186   if (GFC_DESCRIPTOR_SIZE (mask) != 4)
 187     {
 188       /* This allows the same loop to be used for all logical types.  */
 189       assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
 190       for (n = 0; n < rank; n++)
 191         mstride[n] <<= 1;
 192       mdelta <<= 1;
 193       mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
 194     }
 195
 196   while (base)
 197     {
 198       GFC_INTEGER_4 *src;
 199       GFC_LOGICAL_4 *msrc;
 200       GFC_INTEGER_4 result;
 201       src = base;
 202       msrc = mbase;
 203       {
 204
 205   result = -GFC_INTEGER_4_HUGE;
 206         for (n = 0; n < len; n++, src += delta, msrc += mdelta)
 207           {
 208
 209   if (*msrc && *src > result)
 210     result = *src;
 211           }
 212         *dest = result;
 213       }
 214       /* Advance to the next element.  */
 215       count[0]++;
 216       base += sstride[0];
 217       mbase += mstride[0];
 218       dest += dstride[0];
 219       n = 0;
 220       while (count[n] == extent[n])
 221         {
 222           /* When we get to the end of a dimension, reset it and increment
 223              the next dimension.  */
 224           count[n] = 0;
 225           /* We could precalculate these products, but this is a less
 226              frequently used path so proabably not worth it.  */
 227           base -= sstride[n] * extent[n];
 228           mbase -= mstride[n] * extent[n];
 229           dest -= dstride[n] * extent[n];
 230           n++;
 231           if (n == rank)
 232             {
 233               /* Break out of the look.  */
 234               base = NULL;
 235               break;
 236             }
 237           else
 238             {
 239               count[n]++;
 240               base += sstride[n];
 241               mbase += mstride[n];
 242               dest += dstride[n];
 243             }
 244         }
 245     }
 246 }
 247