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