FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/40643 (maxloc/minloc: Wrong result for NaN at position 1)

Browse source 
PR fortran/40643
	PR fortran/31067
	* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc,
	gfc_conv_intrinsic_minmaxval): Handle Infinities and NaNs properly,
	optimize.
	* trans-array.c (gfc_trans_scalarized_loop_end): No longer static.
	* trans-array.h (gfc_trans_scalarized_loop_end): New prototype.

	* libgfortran.h (GFC_REAL_4_INFINITY, GFC_REAL_8_INFINITY,
	GFC_REAL_10_INFINITY, GFC_REAL_16_INFINITY, GFC_REAL_4_QUIET_NAN,
	GFC_REAL_8_QUIET_NAN, GFC_REAL_10_QUIET_NAN, GFC_REAL_16_QUIET_NAN):
	Define.
	* m4/iparm.m4 (atype_inf, atype_nan): Define.
	* m4/ifunction.m4: Formatting.
	* m4/iforeach.m4: Likewise.
	(START_FOREACH_FUNCTION): Initialize dest to all 1s, not all 0s.
	(START_FOREACH_BLOCK, FINISH_FOREACH_FUNCTION,
	FINISH_MASKED_FOREACH_FUNCTION): Run foreach block inside a loop
	until count[0] == extent[0].
	* m4/minval.m4: Formatting.  Handle NaNs and infinities.  Optimize.
	* m4/maxval.m4: Likewise.
	* m4/minloc0.m4: Likewise.
	* m4/maxloc0.m4: Likewise.
	* m4/minloc1.m4: Likewise.
	* m4/maxloc1.m4: Likewise.
	* generated/maxloc0_16_i16.c: Regenerated.
	* generated/maxloc0_16_i1.c: Likewise.
	* generated/maxloc0_16_i2.c: Likewise.
	* generated/maxloc0_16_i4.c: Likewise.
	* generated/maxloc0_16_i8.c: Likewise.
	* generated/maxloc0_16_r10.c: Likewise.
	* generated/maxloc0_16_r16.c: Likewise.
	* generated/maxloc0_16_r4.c: Likewise.
	* generated/maxloc0_16_r8.c: Likewise.
	* generated/maxloc0_4_i16.c: Likewise.
	* generated/maxloc0_4_i1.c: Likewise.
	* generated/maxloc0_4_i2.c: Likewise.
	* generated/maxloc0_4_i4.c: Likewise.
	* generated/maxloc0_4_i8.c: Likewise.
	* generated/maxloc0_4_r10.c: Likewise.
	* generated/maxloc0_4_r16.c: Likewise.
	* generated/maxloc0_4_r4.c: Likewise.
	* generated/maxloc0_4_r8.c: Likewise.
	* generated/maxloc0_8_i16.c: Likewise.
	* generated/maxloc0_8_i1.c: Likewise.
	* generated/maxloc0_8_i2.c: Likewise.
	* generated/maxloc0_8_i4.c: Likewise.
	* generated/maxloc0_8_i8.c: Likewise.
	* generated/maxloc0_8_r10.c: Likewise.
	* generated/maxloc0_8_r16.c: Likewise.
	* generated/maxloc0_8_r4.c: Likewise.
	* generated/maxloc0_8_r8.c: Likewise.
	* generated/maxloc1_16_i16.c: Likewise.
	* generated/maxloc1_16_i1.c: Likewise.
	* generated/maxloc1_16_i2.c: Likewise.
	* generated/maxloc1_16_i4.c: Likewise.
	* generated/maxloc1_16_i8.c: Likewise.
	* generated/maxloc1_16_r10.c: Likewise.
	* generated/maxloc1_16_r16.c: Likewise.
	* generated/maxloc1_16_r4.c: Likewise.
	* generated/maxloc1_16_r8.c: Likewise.
	* generated/maxloc1_4_i16.c: Likewise.
	* generated/maxloc1_4_i1.c: Likewise.
	* generated/maxloc1_4_i2.c: Likewise.
	* generated/maxloc1_4_i4.c: Likewise.
	* generated/maxloc1_4_i8.c: Likewise.
	* generated/maxloc1_4_r10.c: Likewise.
	* generated/maxloc1_4_r16.c: Likewise.
	* generated/maxloc1_4_r4.c: Likewise.
	* generated/maxloc1_4_r8.c: Likewise.
	* generated/maxloc1_8_i16.c: Likewise.
	* generated/maxloc1_8_i1.c: Likewise.
	* generated/maxloc1_8_i2.c: Likewise.
	* generated/maxloc1_8_i4.c: Likewise.
	* generated/maxloc1_8_i8.c: Likewise.
	* generated/maxloc1_8_r10.c: Likewise.
	* generated/maxloc1_8_r16.c: Likewise.
	* generated/maxloc1_8_r4.c: Likewise.
	* generated/maxloc1_8_r8.c: Likewise.
	* generated/maxval_i16.c: Likewise.
	* generated/maxval_i1.c: Likewise.
	* generated/maxval_i2.c: Likewise.
	* generated/maxval_i4.c: Likewise.
	* generated/maxval_i8.c: Likewise.
	* generated/maxval_r10.c: Likewise.
	* generated/maxval_r16.c: Likewise.
	* generated/maxval_r4.c: Likewise.
	* generated/maxval_r8.c: Likewise.
	* generated/minloc0_16_i16.c: Likewise.
	* generated/minloc0_16_i1.c: Likewise.
	* generated/minloc0_16_i2.c: Likewise.
	* generated/minloc0_16_i4.c: Likewise.
	* generated/minloc0_16_i8.c: Likewise.
	* generated/minloc0_16_r10.c: Likewise.
	* generated/minloc0_16_r16.c: Likewise.
	* generated/minloc0_16_r4.c: Likewise.
	* generated/minloc0_16_r8.c: Likewise.
	* generated/minloc0_4_i16.c: Likewise.
	* generated/minloc0_4_i1.c: Likewise.
	* generated/minloc0_4_i2.c: Likewise.
	* generated/minloc0_4_i4.c: Likewise.
	* generated/minloc0_4_i8.c: Likewise.
	* generated/minloc0_4_r10.c: Likewise.
	* generated/minloc0_4_r16.c: Likewise.
	* generated/minloc0_4_r4.c: Likewise.
	* generated/minloc0_4_r8.c: Likewise.
	* generated/minloc0_8_i16.c: Likewise.
	* generated/minloc0_8_i1.c: Likewise.
	* generated/minloc0_8_i2.c: Likewise.
	* generated/minloc0_8_i4.c: Likewise.
	* generated/minloc0_8_i8.c: Likewise.
	* generated/minloc0_8_r10.c: Likewise.
	* generated/minloc0_8_r16.c: Likewise.
	* generated/minloc0_8_r4.c: Likewise.
	* generated/minloc0_8_r8.c: Likewise.
	* generated/minloc1_16_i16.c: Likewise.
	* generated/minloc1_16_i1.c: Likewise.
	* generated/minloc1_16_i2.c: Likewise.
	* generated/minloc1_16_i4.c: Likewise.
	* generated/minloc1_16_i8.c: Likewise.
	* generated/minloc1_16_r10.c: Likewise.
	* generated/minloc1_16_r16.c: Likewise.
	* generated/minloc1_16_r4.c: Likewise.
	* generated/minloc1_16_r8.c: Likewise.
	* generated/minloc1_4_i16.c: Likewise.
	* generated/minloc1_4_i1.c: Likewise.
	* generated/minloc1_4_i2.c: Likewise.
	* generated/minloc1_4_i4.c: Likewise.
	* generated/minloc1_4_i8.c: Likewise.
	* generated/minloc1_4_r10.c: Likewise.
	* generated/minloc1_4_r16.c: Likewise.
	* generated/minloc1_4_r4.c: Likewise.
	* generated/minloc1_4_r8.c: Likewise.
	* generated/minloc1_8_i16.c: Likewise.
	* generated/minloc1_8_i1.c: Likewise.
	* generated/minloc1_8_i2.c: Likewise.
	* generated/minloc1_8_i4.c: Likewise.
	* generated/minloc1_8_i8.c: Likewise.
	* generated/minloc1_8_r10.c: Likewise.
	* generated/minloc1_8_r16.c: Likewise.
	* generated/minloc1_8_r4.c: Likewise.
	* generated/minloc1_8_r8.c: Likewise.
	* generated/minval_i16.c: Likewise.
	* generated/minval_i1.c: Likewise.
	* generated/minval_i2.c: Likewise.
	* generated/minval_i4.c: Likewise.
	* generated/minval_i8.c: Likewise.
	* generated/minval_r10.c: Likewise.
	* generated/minval_r16.c: Likewise.
	* generated/minval_r4.c: Likewise.
	* generated/minval_r8.c: Likewise.
	* generated/product_c10.c: Likewise.
	* generated/product_c16.c: Likewise.
	* generated/product_c4.c: Likewise.
	* generated/product_c8.c: Likewise.
	* generated/product_i16.c: Likewise.
	* generated/product_i1.c: Likewise.
	* generated/product_i2.c: Likewise.
	* generated/product_i4.c: Likewise.
	* generated/product_i8.c: Likewise.
	* generated/product_r10.c: Likewise.
	* generated/product_r16.c: Likewise.
	* generated/product_r4.c: Likewise.
	* generated/product_r8.c: Likewise.
	* generated/sum_c10.c: Likewise.
	* generated/sum_c16.c: Likewise.
	* generated/sum_c4.c: Likewise.
	* generated/sum_c8.c: Likewise.
	* generated/sum_i16.c: Likewise.
	* generated/sum_i1.c: Likewise.
	* generated/sum_i2.c: Likewise.
	* generated/sum_i4.c: Likewise.
	* generated/sum_i8.c: Likewise.
	* generated/sum_r10.c: Likewise.
	* generated/sum_r16.c: Likewise.
	* generated/sum_r4.c: Likewise.
	* generated/sum_r8.c: Likewise.

	* gfortran.dg/maxlocval_2.f90: New test.
	* gfortran.dg/maxlocval_3.f90: New test.
	* gfortran.dg/maxlocval_4.f90: New test.
	* gfortran.dg/minlocval_1.f90: New test.
	* gfortran.dg/minlocval_2.f90: New test.
	* gfortran.dg/minlocval_3.f90: New test.
	* gfortran.dg/minlocval_4.f90: New test.

From-SVN: r150041
This commit is contained in:
Jakub Jelinek 2009-07-24 09:57:13 +02:00 • committed by Jakub Jelinek
parent 3a802a9e6d
commit 80927a562e
175 changed files with 22428 additions and 13527 deletions
Download patch file Download diff file Expand all files Collapse all files

123
libgfortran/m4/iforeach.m4
View file

@ -35,8 +35,8 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"u_name");
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"u_name");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -59,43 +59,45 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
dest[n * dstride] = 1;
{
')dnl
define(START_FOREACH_BLOCK,
` while (base)
{
{
/* Implementation start. */
do
{
/* Implementation start. */
')dnl
define(FINISH_FOREACH_FUNCTION,
` /* Implementation end. */
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
` /* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
}
while (++count[0] != extent[0]);
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
n++;
if (n == rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
}
}
do
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
n++;
if (n == rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
}
}
while (count[n] == extent[n]);
}
}
}')dnl
@ -184,36 +186,37 @@ void
')dnl
define(START_MASKED_FOREACH_BLOCK, `START_FOREACH_BLOCK')dnl
define(FINISH_MASKED_FOREACH_FUNCTION,
` /* Implementation end. */
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
mbase += mstride[0];
` /* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
mbase += mstride[0];
}
while (++count[0] != extent[0]);
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
n++;
if (n == rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
}
}
do
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
n++;
if (n == rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
}
}
while (count[n] == extent[n]);
}
}
}')dnl

164
libgfortran/m4/ifunction.m4
View file

@ -72,15 +72,15 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
@ -116,7 +116,7 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
len = 0;
}
base = array->data;
@ -131,7 +131,7 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
{
')dnl
define(START_ARRAY_BLOCK,
` if (len <= 0)
` if (len <= 0)
*dest = '$1`;
else
{
@ -139,7 +139,7 @@ define(START_ARRAY_BLOCK,
{
')dnl
define(FINISH_ARRAY_FUNCTION,
` }
` }
*dest = result;
}
}
@ -149,28 +149,28 @@ define(FINISH_ARRAY_FUNCTION,
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n == rank)
{
/* Break out of the look. */
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n == rank)
{
/* Break out of the look. */
continue_loop = 0;
break;
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
}')dnl
define(START_MASKED_ARRAY_FUNCTION,
@ -250,15 +250,15 @@ void
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
{
if (n == 0)
str = 1;
else
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
}
alloc_size = sizeof (rtype_name) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
@ -295,7 +295,7 @@ void
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
return;
}
dest = retarray->data;
@ -311,7 +311,7 @@ void
{
')dnl
define(START_MASKED_ARRAY_BLOCK,
` if (len <= 0)
` if (len <= 0)
*dest = '$1`;
else
{
@ -319,7 +319,7 @@ define(START_MASKED_ARRAY_BLOCK,
{
')dnl
define(FINISH_MASKED_ARRAY_FUNCTION,
` }
` }
*dest = result;
}
}
@ -330,30 +330,30 @@ define(FINISH_MASKED_ARRAY_FUNCTION,
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n == rank)
{
/* Break out of the look. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
dest += dstride[n];
}
}
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n == rank)
{
/* Break out of the look. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
dest += dstride[n];
}
}
}
}')dnl
define(SCALAR_ARRAY_FUNCTION,
@ -401,10 +401,10 @@ void
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
GFC_DESCRIPTOR_EXTENT(array,n + 1);
GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
extent[n] = 0;
}
if (retarray->data == NULL)
@ -412,15 +412,15 @@ void
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
@ -476,21 +476,21 @@ void
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
dest -= dstride[n] * extent[n];
n++;
if (n == rank)
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
dest -= dstride[n] * extent[n];
n++;
if (n == rank)
return;
else
{
count[n]++;
dest += dstride[n];
}
else
{
count[n]++;
dest += dstride[n];
}
}
}
}')dnl

2
libgfortran/m4/iparm.m4
View file

@ -29,6 +29,8 @@ define(rtype_qual,`_'rtype_kind)dnl
')dnl
define(atype_max, atype_name`_HUGE')dnl
define(atype_min,ifelse(regexp(file, `_\(.\)[0-9]*\.c$', `\1'),`i',`(-'atype_max`-1)',`-'atype_max))dnl
define(atype_inf, atype_name`_INFINITY')dnl
define(atype_nan, atype_name`_QUIET_NAN')dnl
define(name, regexp(regexp(file, `[^/]*$', `\&'), `^\([^_]*\)_', `\1'))dnl
define(`upcase', `translit(`$*', `a-z', `A-Z')')dnl
define(`u_name',`regexp(upcase(name),`\([A-Z]*\)',`\1')')dnl

99
libgfortran/m4/maxloc0.m4
View file

@ -34,28 +34,93 @@ include(iforeach.m4)dnl
`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
FOREACH_FUNCTION(
` atype_name maxval;
` atype_name maxval;
#if defined('atype_nan`)
int fast = 0;
#endif
maxval = atype_min;'
,
` if (*base > maxval || !dest[0])
{
maxval = *base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}')
#if defined('atype_inf`)
maxval = -atype_inf;
#else
maxval = atype_min;
#endif',
`#if defined('atype_nan`)
}
while (0);
if (unlikely (!fast))
{
do
{
if (*base >= maxval)
{
fast = 1;
maxval = *base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
break;
}
base += sstride[0];
}
while (++count[0] != extent[0]);
if (likely (fast))
continue;
}
else do
{
#endif
if (*base > maxval)
{
maxval = *base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}')
MASKED_FOREACH_FUNCTION(
` atype_name maxval;
int fast = 0;
maxval = atype_min;'
,
` if (*mbase && (*base > maxval || !dest[0]))
{
maxval = *base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}')
#if defined('atype_inf`)
maxval = -atype_inf;
#else
maxval = atype_min;
#endif',
` }
while (0);
if (unlikely (!fast))
{
do
{
if (*mbase)
{
#if defined('atype_nan`)
if (unlikely (dest[0] == 0))
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
if (*base >= maxval)
#endif
{
fast = 1;
maxval = *base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
break;
}
}
base += sstride[0];
mbase += mstride[0];
}
while (++count[0] != extent[0]);
if (likely (fast))
continue;
}
else do
{
if (*mbase && *base > maxval)
{
maxval = *base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}')
SCALAR_FOREACH_FUNCTION(`0')
#endif

75
libgfortran/m4/maxloc1.m4
View file

@ -34,24 +34,67 @@ include(ifunction.m4)dnl
`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
ARRAY_FUNCTION(0,
` atype_name maxval;
maxval = atype_min;
result = 0;',
` if (*src > maxval || !result)
{
maxval = *src;
result = (rtype_name)n + 1;
}')
` atype_name maxval;
#if defined ('atype_inf`)
maxval = -atype_inf;
#else
maxval = atype_min;
#endif
result = 1;',
`#if defined ('atype_nan`)
if (*src >= maxval)
{
maxval = *src;
result = (rtype_name)n + 1;
break;
}
}
for (; n < len; n++, src += delta)
{
#endif
if (*src > maxval)
{
maxval = *src;
result = (rtype_name)n + 1;
}')
MASKED_ARRAY_FUNCTION(0,
` atype_name maxval;
maxval = atype_min;
result = 0;',
` if (*msrc && (*src > maxval || !result))
{
maxval = *src;
result = (rtype_name)n + 1;
}')
` atype_name maxval;
#if defined ('atype_inf`)
maxval = -atype_inf;
#else
maxval = atype_min;
#endif
#if defined ('atype_nan`)
rtype_name result2 = 0;
#endif
result = 0;',
` if (*msrc)
{
#if defined ('atype_nan`)
if (!result2)
result2 = (rtype_name)n + 1;
if (*src >= maxval)
#endif
{
maxval = *src;
result = (rtype_name)n + 1;
break;
}
}
}
#if defined ('atype_nan`)
if (unlikely (n >= len))
result = result2;
else
#endif
for (; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc && *src > maxval)
{
maxval = *src;
result = (rtype_name)n + 1;
}')
SCALAR_ARRAY_FUNCTION(0)

53
libgfortran/m4/maxval.m4
View file

@ -33,14 +33,55 @@ include(ifunction.m4)dnl
`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
ARRAY_FUNCTION(atype_min,
` result = atype_min;',
` if (*src > result)
result = *src;')
`#if defined ('atype_inf`)
result = -atype_inf;
#else
result = atype_min;
#endif',
`#if defined ('atype_nan`)
if (*src >= result)
break;
}
if (unlikely (n >= len))
result = atype_nan;
else for (; n < len; n++, src += delta)
{
#endif
if (*src > result)
result = *src;')
MASKED_ARRAY_FUNCTION(atype_min,
` result = atype_min;',
` if (*msrc && *src > result)
result = *src;')
`#if defined ('atype_inf`)
result = -atype_inf;
#else
result = atype_min;
#endif
#if defined ('atype_nan`)
int non_empty_p = 0;
#endif',
`#if defined ('atype_inf`) || defined ('atype_nan`)
if (*msrc)
{
#if defined ('atype_nan`)
non_empty_p = 1;
if (*src >= result)
#endif
break;
}
}
if (unlikely (n >= len))
{
#if defined ('atype_nan`)
result = non_empty_p ? atype_nan : atype_min;
#else
result = atype_min;
#endif
}
else for (; n < len; n++, src += delta, msrc += mdelta)
{
#endif
if (*msrc && *src > result)
result = *src;')
SCALAR_ARRAY_FUNCTION(atype_min)

99
libgfortran/m4/minloc0.m4
View file

@ -34,28 +34,93 @@ include(iforeach.m4)dnl
`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
FOREACH_FUNCTION(
` atype_name minval;
` atype_name minval;
#if defined('atype_nan`)
int fast = 0;
#endif
minval = atype_max;'
,
` if (*base < minval || !dest[0])
{
minval = *base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}')
#if defined('atype_inf`)
minval = atype_inf;
#else
minval = atype_max;
#endif',
`#if defined('atype_nan`)
}
while (0);
if (unlikely (!fast))
{
do
{
if (*base <= minval)
{
fast = 1;
minval = *base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
break;
}
base += sstride[0];
}
while (++count[0] != extent[0]);
if (likely (fast))
continue;
}
else do
{
#endif
if (*base < minval)
{
minval = *base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}')
MASKED_FOREACH_FUNCTION(
` atype_name minval;
int fast = 0;
minval = atype_max;'
,
` if (*mbase && (*base < minval || !dest[0]))
{
minval = *base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}')
#if defined('atype_inf`)
minval = atype_inf;
#else
minval = atype_max;
#endif',
` }
while (0);
if (unlikely (!fast))
{
do
{
if (*mbase)
{
#if defined('atype_nan`)
if (unlikely (dest[0] == 0))
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
if (*base <= minval)
#endif
{
fast = 1;
minval = *base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
break;
}
}
base += sstride[0];
mbase += mstride[0];
}
while (++count[0] != extent[0]);
if (likely (fast))
continue;
}
else do
{
if (*mbase && *base < minval)
{
minval = *base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}')
SCALAR_FOREACH_FUNCTION(`0')
#endif

75
libgfortran/m4/minloc1.m4
View file

@ -34,24 +34,67 @@ include(ifunction.m4)dnl
`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
ARRAY_FUNCTION(0,
` atype_name minval;
minval = atype_max;
result = 0;',
` if (*src < minval || !result)
{
minval = *src;
result = (rtype_name)n + 1;
}')
` atype_name minval;
#if defined ('atype_inf`)
minval = atype_inf;
#else
minval = atype_max;
#endif
result = 1;',
`#if defined ('atype_nan`)
if (*src <= minval)
{
minval = *src;
result = (rtype_name)n + 1;
break;
}
}
for (; n < len; n++, src += delta)
{
#endif
if (*src < minval)
{
minval = *src;
result = (rtype_name)n + 1;
}')
MASKED_ARRAY_FUNCTION(0,
` atype_name minval;
minval = atype_max;
result = 0;',
` if (*msrc && (*src < minval || !result))
{
minval = *src;
result = (rtype_name)n + 1;
}')
` atype_name minval;
#if defined ('atype_inf`)
minval = atype_inf;
#else
minval = atype_max;
#endif
#if defined ('atype_nan`)
rtype_name result2 = 0;
#endif
result = 0;',
` if (*msrc)
{
#if defined ('atype_nan`)
if (!result2)
result2 = (rtype_name)n + 1;
if (*src <= minval)
#endif
{
minval = *src;
result = (rtype_name)n + 1;
break;
}
}
}
#if defined ('atype_nan`)
if (unlikely (n >= len))
result = result2;
else
#endif
for (; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc && *src < minval)
{
minval = *src;
result = (rtype_name)n + 1;
}')
SCALAR_ARRAY_FUNCTION(0)

53
libgfortran/m4/minval.m4
View file

@ -33,14 +33,55 @@ include(ifunction.m4)dnl
`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
ARRAY_FUNCTION(atype_max,
` result = atype_max;',
` if (*src < result)
result = *src;')
`#if defined ('atype_inf`)
result = atype_inf;
#else
result = atype_max;
#endif',
`#if defined ('atype_nan`)
if (*src <= result)
break;
}
if (unlikely (n >= len))
result = atype_nan;
else for (; n < len; n++, src += delta)
{
#endif
if (*src < result)
result = *src;')
MASKED_ARRAY_FUNCTION(atype_max,
` result = atype_max;',
` if (*msrc && *src < result)
result = *src;')
`#if defined ('atype_inf`)
result = atype_inf;
#else
result = atype_max;
#endif
#if defined ('atype_nan`)
int non_empty_p = 0;
#endif',
`#if defined ('atype_inf`) || defined ('atype_nan`)
if (*msrc)
{
#if defined ('atype_nan`)
non_empty_p = 1;
if (*src <= result)
#endif
break;
}
}
if (unlikely (n >= len))
{
#if defined ('atype_nan`)
result = non_empty_p ? atype_nan : atype_max;
#else
result = atype_max;
#endif
}
else for (; n < len; n++, src += delta, msrc += mdelta)
{
#endif
if (*msrc && *src < result)
result = *src;')
SCALAR_ARRAY_FUNCTION(atype_max)