libgfortran/m4/maxloc0.m4

   1 `/* Implementation of the MAXLOC intrinsic
   2    Copyright (C) 2002-2023 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 3 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 General Public License for more details.
  16
  17 Under Section 7 of GPL version 3, you are granted additional
  18 permissions described in the GCC Runtime Library Exception, version
  19 3.1, as published by the Free Software Foundation.
  20
  21 You should have received a copy of the GNU General Public License and
  22 a copy of the GCC Runtime Library Exception along with this program;
  23 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  24 <http://www.gnu.org/licenses/>.  */
  25
  26 #include "libgfortran.h"
  27 #include <assert.h>'
  28
  29 include(iparm.m4)dnl
  30 include(iforeach.m4)dnl
  31
  32 `#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
  33
  34 FOREACH_FUNCTION(
  35 `    atype_name maxval;
  36 #if defined('atype_nan`)
  37     int fast = 0;
  38 #endif
  39
  40 #if defined('atype_inf`)
  41     maxval = -atype_inf;
  42 #else
  43     maxval = atype_min;
  44 #endif',
  45 `#if defined('atype_nan`)
  46       if (unlikely (!fast))
  47         {
  48           do
  49             {
  50               if (*base >= maxval)
  51                 {
  52                   fast = 1;
  53                   maxval = *base;
  54                   for (n = 0; n < rank; n++)
  55                     dest[n * dstride] = count[n] + 1;
  56                   break;
  57                 }
  58               base += sstride[0];
  59             }
  60           while (++count[0] != extent[0]);
  61           if (likely (fast))
  62             continue;
  63         }
  64       else
  65 #endif
  66         if (back)
  67           do
  68             {
  69               if (unlikely (*base >= maxval))
  70                {
  71                  maxval = *base;
  72                  for (n = 0; n < rank; n++)
  73                    dest[n * dstride] = count[n] + 1;
  74                }
  75              base += sstride[0];
  76            }
  77          while (++count[0] != extent[0]);
  78        else
  79          do
  80            {
  81              if (unlikely (*base > maxval))
  82                {
  83                  maxval = *base;
  84                  for (n = 0; n < rank; n++)
  85                    dest[n * dstride] = count[n] + 1;
  86                }')
  87 MASKED_FOREACH_FUNCTION(
  88 `  atype_name maxval;
  89    int fast = 0;
  90
  91 #if defined('atype_inf`)
  92     maxval = -atype_inf;
  93 #else
  94     maxval = atype_min;
  95 #endif',
  96 `      if (unlikely (!fast))
  97         {
  98           do
  99             {
 100               if (*mbase)
 101                 {
 102 #if defined('atype_nan`)
 103                   if (unlikely (dest[0] == 0))
 104                     for (n = 0; n < rank; n++)
 105                       dest[n * dstride] = count[n] + 1;
 106                   if (*base >= maxval)
 107 #endif
 108                     {
 109                       fast = 1;
 110                       maxval = *base;
 111                       for (n = 0; n < rank; n++)
 112                         dest[n * dstride] = count[n] + 1;
 113                       break;
 114                     }
 115                 }
 116               base += sstride[0];
 117               mbase += mstride[0];
 118             }
 119           while (++count[0] != extent[0]);
 120           if (likely (fast))
 121             continue;
 122         }
 123       else
 124         if (back)
 125           do
 126             {
 127               if (*mbase && *base >= maxval)
 128                 {
 129                   maxval = *base;
 130                   for (n = 0; n < rank; n++)
 131                     dest[n * dstride] = count[n] + 1;
 132                 }
 133               base += sstride[0];
 134             }
 135           while (++count[0] != extent[0]);
 136         else
 137           do
 138             {
 139               if (*mbase && unlikely (*base > maxval))
 140                 {
 141                   maxval = *base;
 142                   for (n = 0; n < rank; n++)
 143                     dest[n * dstride] = count[n] + 1;
 144                 }')
 145
 146 SCALAR_FOREACH_FUNCTION(`0')
 147 #endif