Home | History | Annotate | Line # | Download | only in m4 
      1 `/* Implementation of the MINLOC intrinsic
      2    Copyright (C) 2002-2022 Free Software Foundation, Inc.
      3    Contributed by Paul Brook <paul (a] 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 minval;
     36 #if defined('atype_nan`)
     37     int fast = 0;
     38 #endif
     39 
     40 #if defined('atype_inf`)
     41     minval = atype_inf;
     42 #else
     43     minval = atype_max;
     44 #endif',
     45 `#if defined('atype_nan`)
     46       if (unlikely (!fast))
     47 	{
     48 	  do
     49 	    {
     50 	      if (*base <= minval)
     51 		{
     52 		  fast = 1;
     53 		  minval = *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 <= minval))
     70 	      {
     71 		minval = *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 < minval))
     82 	      {
     83 		minval = *base;
     84 		for (n = 0; n < rank; n++)
     85 		  dest[n * dstride] = count[n] + 1;
     86 	      }')
     87 MASKED_FOREACH_FUNCTION(
     88 `  atype_name minval;
     89    int fast = 0;
     90 
     91 #if defined('atype_inf`)
     92     minval = atype_inf;
     93 #else
     94     minval = atype_max;
     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 <= minval)
    107 #endif
    108 		    {
    109 		      fast = 1;
    110 		      minval = *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 (unlikely (*mbase && (*base <= minval)))
    128 	        {
    129 	      	  minval = *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 (unlikely (*mbase && (*base < minval)))
    140 		{
    141 		  minval = *base;
    142 		  for (n = 0; n < rank; n++)
    143 		    dest[n * dstride] = count[n] + 1;
    144 		}')
    145 SCALAR_FOREACH_FUNCTION(`0')
    146 #endif
    147