Home | History | Annotate | Line # | Download | only in m4
      1      1.1  mrg `/* Implementation of the MINLOC intrinsic
      2  1.1.1.3  mrg    Copyright (C) 2002-2022 Free Software Foundation, Inc.
      3      1.1  mrg    Contributed by Paul Brook <paul (a] nowt.org>
      4      1.1  mrg 
      5      1.1  mrg This file is part of the GNU Fortran 95 runtime library (libgfortran).
      6      1.1  mrg 
      7      1.1  mrg Libgfortran is free software; you can redistribute it and/or
      8      1.1  mrg modify it under the terms of the GNU General Public
      9      1.1  mrg License as published by the Free Software Foundation; either
     10      1.1  mrg version 3 of the License, or (at your option) any later version.
     11      1.1  mrg 
     12      1.1  mrg Libgfortran is distributed in the hope that it will be useful,
     13      1.1  mrg but WITHOUT ANY WARRANTY; without even the implied warranty of
     14      1.1  mrg MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     15      1.1  mrg GNU General Public License for more details.
     16      1.1  mrg 
     17      1.1  mrg Under Section 7 of GPL version 3, you are granted additional
     18      1.1  mrg permissions described in the GCC Runtime Library Exception, version
     19      1.1  mrg 3.1, as published by the Free Software Foundation.
     20      1.1  mrg 
     21      1.1  mrg You should have received a copy of the GNU General Public License and
     22      1.1  mrg a copy of the GCC Runtime Library Exception along with this program;
     23      1.1  mrg see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
     24      1.1  mrg <http://www.gnu.org/licenses/>.  */
     25      1.1  mrg 
     26      1.1  mrg #include "libgfortran.h"
     27      1.1  mrg #include <assert.h>'
     28      1.1  mrg 
     29      1.1  mrg include(iparm.m4)dnl
     30      1.1  mrg include(iforeach.m4)dnl
     31      1.1  mrg 
     32      1.1  mrg `#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
     33      1.1  mrg 
     34      1.1  mrg FOREACH_FUNCTION(
     35      1.1  mrg `    atype_name minval;
     36      1.1  mrg #if defined('atype_nan`)
     37      1.1  mrg     int fast = 0;
     38      1.1  mrg #endif
     39      1.1  mrg 
     40      1.1  mrg #if defined('atype_inf`)
     41      1.1  mrg     minval = atype_inf;
     42      1.1  mrg #else
     43      1.1  mrg     minval = atype_max;
     44      1.1  mrg #endif',
     45      1.1  mrg `#if defined('atype_nan`)
     46      1.1  mrg       if (unlikely (!fast))
     47      1.1  mrg 	{
     48      1.1  mrg 	  do
     49      1.1  mrg 	    {
     50      1.1  mrg 	      if (*base <= minval)
     51      1.1  mrg 		{
     52      1.1  mrg 		  fast = 1;
     53      1.1  mrg 		  minval = *base;
     54      1.1  mrg 		  for (n = 0; n < rank; n++)
     55      1.1  mrg 		    dest[n * dstride] = count[n] + 1;
     56      1.1  mrg 		  break;
     57      1.1  mrg 		}
     58      1.1  mrg 	      base += sstride[0];
     59      1.1  mrg 	    }
     60      1.1  mrg 	  while (++count[0] != extent[0]);
     61      1.1  mrg 	  if (likely (fast))
     62      1.1  mrg 	    continue;
     63      1.1  mrg 	}
     64      1.1  mrg       else
     65      1.1  mrg #endif
     66      1.1  mrg       if (back)
     67      1.1  mrg 	do
     68      1.1  mrg 	  {
     69      1.1  mrg 	    if (unlikely (*base <= minval))
     70      1.1  mrg 	      {
     71      1.1  mrg 		minval = *base;
     72      1.1  mrg 		for (n = 0; n < rank; n++)
     73      1.1  mrg 		  dest[n * dstride] = count[n] + 1;
     74      1.1  mrg 	      }
     75      1.1  mrg 	    base += sstride[0];
     76      1.1  mrg 	  }
     77      1.1  mrg 	while (++count[0] != extent[0]);
     78      1.1  mrg       else
     79      1.1  mrg 	do
     80      1.1  mrg 	  {
     81      1.1  mrg 	    if (unlikely (*base < minval))
     82      1.1  mrg 	      {
     83      1.1  mrg 		minval = *base;
     84      1.1  mrg 		for (n = 0; n < rank; n++)
     85      1.1  mrg 		  dest[n * dstride] = count[n] + 1;
     86      1.1  mrg 	      }')
     87      1.1  mrg MASKED_FOREACH_FUNCTION(
     88      1.1  mrg `  atype_name minval;
     89      1.1  mrg    int fast = 0;
     90      1.1  mrg 
     91      1.1  mrg #if defined('atype_inf`)
     92      1.1  mrg     minval = atype_inf;
     93      1.1  mrg #else
     94      1.1  mrg     minval = atype_max;
     95      1.1  mrg #endif',
     96      1.1  mrg `      if (unlikely (!fast))
     97      1.1  mrg 	{
     98      1.1  mrg 	  do
     99      1.1  mrg 	    {
    100      1.1  mrg 	      if (*mbase)
    101      1.1  mrg 		{
    102      1.1  mrg #if defined('atype_nan`)
    103      1.1  mrg 		  if (unlikely (dest[0] == 0))
    104      1.1  mrg 		    for (n = 0; n < rank; n++)
    105      1.1  mrg 		      dest[n * dstride] = count[n] + 1;
    106      1.1  mrg 		  if (*base <= minval)
    107      1.1  mrg #endif
    108      1.1  mrg 		    {
    109      1.1  mrg 		      fast = 1;
    110      1.1  mrg 		      minval = *base;
    111      1.1  mrg 		      for (n = 0; n < rank; n++)
    112      1.1  mrg 			dest[n * dstride] = count[n] + 1;
    113      1.1  mrg 		      break;
    114      1.1  mrg 		    }
    115      1.1  mrg 		}
    116      1.1  mrg 	      base += sstride[0];
    117      1.1  mrg 	      mbase += mstride[0];
    118      1.1  mrg 	    }
    119      1.1  mrg 	  while (++count[0] != extent[0]);
    120      1.1  mrg 	  if (likely (fast))
    121      1.1  mrg 	    continue;
    122      1.1  mrg 	}
    123      1.1  mrg         else
    124      1.1  mrg         if (back)
    125      1.1  mrg 	  do
    126      1.1  mrg 	    {
    127      1.1  mrg 	      if (unlikely (*mbase && (*base <= minval)))
    128      1.1  mrg 	        {
    129      1.1  mrg 	      	  minval = *base;
    130      1.1  mrg 	      	  for (n = 0; n < rank; n++)
    131      1.1  mrg 		    dest[n * dstride] = count[n] + 1;
    132      1.1  mrg 	    	}
    133      1.1  mrg 		base += sstride[0];
    134      1.1  mrg 	    }
    135      1.1  mrg 	    while (++count[0] != extent[0]);
    136      1.1  mrg 	else
    137      1.1  mrg 	  do
    138      1.1  mrg 	    {
    139      1.1  mrg 	      if (unlikely (*mbase && (*base < minval)))
    140      1.1  mrg 		{
    141      1.1  mrg 		  minval = *base;
    142      1.1  mrg 		  for (n = 0; n < rank; n++)
    143      1.1  mrg 		    dest[n * dstride] = count[n] + 1;
    144      1.1  mrg 		}')
    145      1.1  mrg SCALAR_FOREACH_FUNCTION(`0')
    146      1.1  mrg #endif
    147