diff mbox

[Fortran,RFC] Implement library side of {MIN,MAX}{LOC,VAL} with character arguments

Message ID 4E779C44.1050109@netcologne.de
State New
Headers show

Commit Message

Thomas Koenig Sept. 19, 2011, 7:47 p.m. UTC 
Hello world,

this patch implements the library side of PR 36313, minloc and friends
on character arguments.

I haven't started tackling the inline versions yet.  I suspect that
these are easy for somebody who knows the scalarizer (not me :-) but
I'll start looking into how to do it.  Unless, of course, somebody
else wants to do it *HINT*

Any comments?  I was not planning on committing yet, because for the
more simple cases we actually hit an ICE with this patch instead of
a clean error message.

Regards

	Thomas

2011-09-19  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/36313
         * m4/foreach.m4 (slen_proto): New macro, for adding ',int ' in
         prototypes.  Use it throughout the file.
         (slen_def): New macro, for adding ', int slen' in function
         argument lists.  Use it throughout the file.
         (slen_use): New macro for optionally putting slen into an argument
         list.  Use it throughout the file.
         * m4/iparm.m4: Use 's' as letter for character functions.
         * m4/ifunction.m4 (slen_proto): New macro, for adding ',int ' in
         prototypes.  Use it throughout the file.
         (slen_def): New macro, for adding ', int slen' in function
         argument lists.  Use it throughout the file.
         (slen_use): New macro for optionally putting slen into an argument
         list.  Use it throughout the file.
         * gfortran.map: Add _gfortran_maxloc0_1_s1,
         _gfortran_maxloc0_2_s1, _gfortran_maxloc0_4_s1,
         _gfortran_maxloc0_8_s1, _gfortran_maxloc0_16_s1,
         _gfortran_maxloc0_1_s4, _gfortran_maxloc0_2_s4,
         _gfortran_maxloc0_4_s4, _gfortran_maxloc0_8_s4,
         _gfortran_maxloc0_16_s4, _gfortran_minloc0_1_s1,
         _gfortran_minloc0_2_s1, _gfortran_minloc0_4_s1,
         _gfortran_minloc0_8_s1, _gfortran_minloc0_16_s1,
         _gfortran_minloc0_1_s4, _gfortran_minloc0_2_s4,
         _gfortran_minloc0_4_s4, _gfortran_minloc0_8_s4,
         _gfortran_minloc0_16_s4, _gfortran_maxloc1_1_s1,
         _gfortran_maxloc1_2_s1, _gfortran_maxloc1_4_s1,
         _gfortran_maxloc1_8_s1, _gfortran_maxloc1_16_s1,
         _gfortran_maxloc1_1_s4, _gfortran_maxloc1_2_s4,
         _gfortran_maxloc1_4_s4, _gfortran_maxloc1_8_s4,
         _gfortran_maxloc1_16_s4, _gfortran_minloc1_1_s1,
         _gfortran_minloc1_2_s1, _gfortran_minloc1_4_s1,
         _gfortran_minloc1_8_s1, _gfortran_minloc1_16_s1,
         _gfortran_minloc1_1_s4, _gfortran_minloc1_2_s4,
         _gfortran_minloc1_4_s4, _gfortran_minloc1_8_s4,
         _gfortran_minloc1_16_s4, _gfortran_maxval_s1,
         _gfortran_maxval_s4, _gfortran_minval_s1,
         _gfortran_minval_s4.
         * libgfortran.h (gfc_array_s1):  Add type definition.
         (gfc_array_s4):  Add type definition.
         * Makefile.am (i_maxloc0s_c):  Add; also add dependencies.
         (i_maxloc1s_c):  Likewise.
         (i_maxvals_c):  Likewise.
         (i_minloc0s_c):  Likewise.
         (i_minloc1s_c):  Likewise.
         (i_minvals_c):  Likewise.
         * mk-kinds-h.sh:  Also emit HAVE_GFC_UINTEGER_* macros.
         * m4/ifunction-s.m4:  New file.
         * m4/maxloc0s.m4:  New file.
         * m4/maxloc1s.m4:  New file.
         * m4/maxvals.m4:  New file.
         * m4/minloc0s.m4:  New file.
         * m4/minloc1s.m4:  New file.
         * m4/minvals.m4:  New file.

2011-09-19  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/36313
         * frontend-passes.c (optimize_minmaxloc):  Don't optimize
         minloc/maxloc if the first argument is of type character.
         * check.c (int_or_real_or_char_check_2003):  New function.
         (gfc_check_minloc_maxloc):  Use it, instead of
         int_or_real_check.
         (gfc_check_minval_maxval):  Likewise.
dnl Support macro file for intrinsic functions.
dnl Contains the generic sections of the array functions.
dnl This file is part of the GNU Fortran Runtime Library (libgfortran)
dnl Distributed under the GNU GPL with exception.  See COPYING for details.
dnl
dnl Pass the implementation for a single section as the parameter to
dnl {MASK_}ARRAY_FUNCTION.
dnl The variables base, delta, and len describe the input section.
dnl For masked section the mask is described by mbase and mdelta.
dnl These should not be modified. The result should be stored in *dest.
dnl The names count, extent, sstride, dstride, base, dest, rank, dim
dnl retarray, array, pdim and mstride should not be used.
dnl The variable n is declared as index_type and may be used.
dnl Other variable declarations may be placed at the start of the code,
dnl The types of the array parameter and the return value are
dnl atype_name and rtype_name respectively.
dnl Execution should be allowed to continue to the end of the block.
dnl You should not return or break from the inner loop of the implementation.
dnl Care should also be taken to avoid using the names defined in iparm.m4
define(START_ARRAY_FUNCTION,
`
extern void name`'rtype_qual`_'atype_code (rtype * const restrict, int,
	atype * const restrict, const index_type * const restrict, int);
export_proto(name`'rtype_qual`_'atype_code);

void
name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
	int rlen,
	atype * const restrict array, 
	const index_type * const restrict pdim, int slen)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type dstride[GFC_MAX_DIMENSIONS];
  const atype_name * restrict base;
  rtype_name * restrict dest;
  index_type rank;
  index_type n;
  index_type len;
  index_type delta;
  index_type dim;
  int continue_loop;

  assert(rlen == slen);
  /* Make dim zero based to avoid confusion.  */
  dim = (*pdim) - 1;
  rank = GFC_DESCRIPTOR_RANK (array) - 1;

  len = GFC_DESCRIPTOR_EXTENT(array,dim);
  if (len < 0)
    len = 0;
  delta = GFC_DESCRIPTOR_STRIDE(array,dim);

  for (n = 0; n < dim; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);

      if (extent[n] < 0)
	extent[n] = 0;
    }
  for (n = dim; n < rank; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);

      if (extent[n] < 0)
	extent[n] = 0;
    }

  if (retarray->data == NULL)
    {
      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];

	  GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);

	}

      retarray->offset = 0;
      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;

      alloc_size = sizeof (rtype_name) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
    		   * extent[rank-1] * slen;

      retarray->data = internal_malloc_size (alloc_size);
      if (alloc_size == 0)
	{
	  /* Make sure we have a zero-sized array.  */
	  GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
	  return;

	}
    }
  else
    {
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
	runtime_error ("rank of return array incorrect in"
		       " u_name intrinsic: is %ld, should be %ld",
		       (long int) (GFC_DESCRIPTOR_RANK (retarray)),
		       (long int) rank);

      if (unlikely (compile_options.bounds_check))
	bounds_ifunction_return ((array_t *) retarray, extent,
				 "return value", "u_name");
    }

  for (n = 0; n < rank; n++)
    {
      count[n] = 0;
      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
      if (extent[n] <= 0)
	return;
    }

  base = array->data;
  dest = retarray->data;

  continue_loop = 1;
  while (continue_loop)
    {
      const atype_name * restrict src;
      const rtype_name *result;
      src = base;
      {
')dnl
define(START_ARRAY_BLOCK,
`	if (len <= 0)
	  memset (dest, '$1`, slen * sizeof('atype_name`));
	else
	  {
	    for (n = 0; n < len; n++, src += delta)
	      {
')dnl
define(FINISH_ARRAY_FUNCTION,
`	      }
	    '$1`
	    memcpy (dest, result, slen * sizeof ('atype_name`));
	  }
      }
      /* Advance to the next element.  */
      count[0]++;
      base += sstride[0];
      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.  */
	      continue_loop = 0;
	      break;
	    }
	  else
	    {
	      count[n]++;
	      base += sstride[n];
	      dest += dstride[n];
	    }
	}
    }
}')dnl
define(START_MASKED_ARRAY_FUNCTION,
`
extern void `m'name`'rtype_qual`_'atype_code (rtype * const restrict, int,
	atype * const restrict, const index_type * const restrict,
	gfc_array_l1 * const restrict, int);
export_proto(`m'name`'rtype_qual`_'atype_code);

void
`m'name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
	int rlen,
	atype * const restrict array, 
	const index_type * const restrict pdim, 
	gfc_array_l1 * const restrict mask, int slen)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type dstride[GFC_MAX_DIMENSIONS];
  index_type mstride[GFC_MAX_DIMENSIONS];
  rtype_name * restrict dest;
  const atype_name * restrict base;
  const GFC_LOGICAL_1 * restrict mbase;
  int rank;
  int dim;
  index_type n;
  index_type len;
  index_type delta;
  index_type mdelta;
  int mask_kind;

  assert(rlen == slen);
  dim = (*pdim) - 1;
  rank = GFC_DESCRIPTOR_RANK (array) - 1;

  len = GFC_DESCRIPTOR_EXTENT(array,dim);
  if (len <= 0)
    return;

  mbase = mask->data;

  mask_kind = GFC_DESCRIPTOR_SIZE (mask);

  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
      || mask_kind == 16
#endif
      )
    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
  else
    runtime_error ("Funny sized logical array");

  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
  mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);

  for (n = 0; n < dim; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);

      if (extent[n] < 0)
	extent[n] = 0;

    }
  for (n = dim; n < rank; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);

      if (extent[n] < 0)
	extent[n] = 0;
    }

  if (retarray->data == NULL)
    {
      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];

	  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] * slen;

      retarray->offset = 0;
      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;

      retarray->data = internal_malloc_size (alloc_size);
      if (alloc_size == 0)
	{
	  /* Make sure we have a zero-sized array.  */
	  GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
	  return;
	}
    }
  else
    {
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
	runtime_error ("rank of return array incorrect in u_name intrinsic");

      if (unlikely (compile_options.bounds_check))
	{
	  bounds_ifunction_return ((array_t *) retarray, extent,
				   "return value", "u_name");
	  bounds_equal_extents ((array_t *) mask, (array_t *) array,
	  			"MASK argument", "u_name");
	}
    }

  for (n = 0; n < rank; n++)
    {
      count[n] = 0;
      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
      if (extent[n] <= 0)
	return;
    }

  dest = retarray->data;
  base = array->data;

  while (base)
    {
      const atype_name * restrict src;
      const GFC_LOGICAL_1 * restrict msrc;
      const rtype_name *result;
      src = base;
      msrc = mbase;
      {
')dnl
define(START_MASKED_ARRAY_BLOCK,
`	if (len <= 0)
	  memset (dest, '$1`, slen * sizeof('atype_name`));
	else
	  {
	    for (n = 0; n < len; n++, src += delta, msrc += mdelta)
	      {
')dnl
define(FINISH_MASKED_ARRAY_FUNCTION,
`	      }
	    memcpy (dest, result, slen * sizeof('atype_name`));
	  }
      }
      /* Advance to the next element.  */
      count[0]++;
      base += sstride[0];
      mbase += mstride[0];
      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];
	    }
	}
    }
}')dnl
define(SCALAR_ARRAY_FUNCTION,
`
extern void `s'name`'rtype_qual`_'atype_code (rtype * const restrict, int,
	atype * const restrict, const index_type * const restrict,
	GFC_LOGICAL_4 *, int);
export_proto(`s'name`'rtype_qual`_'atype_code);

void
`s'name`'rtype_qual`_'atype_code (rtype * const restrict retarray, int rlen,
	atype * const restrict array, 
	const index_type * const restrict pdim, 
	GFC_LOGICAL_4 * mask, int slen)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type dstride[GFC_MAX_DIMENSIONS];
  rtype_name * restrict dest;
  index_type rank;
  index_type n;
  index_type dim;


  assert(rlen == slen);
  if (*mask)
    {
      name`'rtype_qual`_'atype_code (retarray, rlen, array, pdim, slen);
      return;
    }
  /* Make dim zero based to avoid confusion.  */
  dim = (*pdim) - 1;
  rank = GFC_DESCRIPTOR_RANK (array) - 1;

  for (n = 0; n < dim; n++)
    {
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);

      if (extent[n] <= 0)
	extent[n] = 0;
    }

  for (n = dim; n < rank; n++)
    {
      extent[n] =
	GFC_DESCRIPTOR_EXTENT(array,n + 1);

      if (extent[n] <= 0)
	extent[n] = 0;
    }

  if (retarray->data == NULL)
    {
      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];

	  GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);

	}

      retarray->offset = 0;
      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;

      alloc_size = sizeof (rtype_name) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
    		   * extent[rank-1];

      if (alloc_size == 0)
	{
	  /* Make sure we have a zero-sized array.  */
	  GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
	  return;
	}
      else
	retarray->data = internal_malloc_size (alloc_size);
    }
  else
    {
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
	runtime_error ("rank of return array incorrect in"
		       " u_name intrinsic: is %ld, should be %ld",
		       (long int) (GFC_DESCRIPTOR_RANK (retarray)),
		       (long int) rank);

      if (unlikely (compile_options.bounds_check))
	{
	  for (n=0; n < rank; n++)
	    {
	      index_type ret_extent;

	      ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
	      if (extent[n] != ret_extent)
		runtime_error ("Incorrect extent in return value of"
			       " u_name intrinsic in dimension %ld:"
			       " is %ld, should be %ld", (long int) n + 1,
			       (long int) ret_extent, (long int) extent[n]);
	    }
	}
    }

  for (n = 0; n < rank; n++)
    {
      count[n] = 0;
      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
    }

  dest = retarray->data;

  while(1)
    {
      memset (dest, `$1', slen * sizeof('atype_name`));
      count[0]++;
      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)
	    return;
	  else
	    {
	      count[n]++;
	      dest += dstride[n];
	    }
      	}
    }
}')dnl
define(ARRAY_FUNCTION,
`START_ARRAY_FUNCTION
$2
START_ARRAY_BLOCK($1)
$3
FINISH_ARRAY_FUNCTION($4)')dnl
define(MASKED_ARRAY_FUNCTION,
`START_MASKED_ARRAY_FUNCTION
$2
START_MASKED_ARRAY_BLOCK($1)
$3
FINISH_MASKED_ARRAY_FUNCTION')dnl
`/* Implementation of the MAXLOC intrinsic
   Copyright 2011 Free Software Foundation, Inc.
   Contributed by Thomas Koenig.

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.

You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
<http://www.gnu.org/licenses/>.  */

#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <limits.h>'

include(iparm.m4)dnl
include(iforeach.m4)dnl
define(`compare_function',`ifelse(atype_kind,1,memcmp,memcmp_char4)')dnl

`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'

FOREACH_FUNCTION(
`  const atype_name *maxval;
   maxval = base;'
,
`  if ('compare_function` (base, maxval, slen) > 0 || !dest[0])
    {
      maxval = base;
      for (n = 0; n < rank; n++)
        dest[n * dstride] = count[n] + 1;
    }')

MASKED_FOREACH_FUNCTION(
`  const atype_name *maxval;

  maxval = base;'
,
`  if (*mbase && ('compare_function` (base, maxval, slen) > 0 || !dest[0]))
    {
      maxval = base;
      for (n = 0; n < rank; n++)
        dest[n * dstride] = count[n] + 1;
    }')

SCALAR_FOREACH_FUNCTION(`0')
#endif
`/* Implementation of the MINLOC intrinsic
   Copyright 2011 Free Software Foundation, Inc.
   Contributed by Thomas Koenig.

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.

You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
<http://www.gnu.org/licenses/>.  */

#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <limits.h>'

include(iparm.m4)dnl
include(ifunction.m4)dnl
define(`compare_function',`ifelse(atype_kind,1,memcmp,memcmp_char4)')dnl

`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'

ARRAY_FUNCTION(0,
`	const atype_name *minval;
	minval = base;
	result = 1;',
`		if ('compare_function` (base, minval, slen) < 0)
		  {
		    minval = src;
		    result = (rtype_name)n + 1;
		  }', `')

MASKED_ARRAY_FUNCTION(0,
`	const atype_name *minval;
	minval = base;
	result = 0;',
`		if (*msrc)
		  {
		      {
			minval = src;
			result = (rtype_name)n + 1;
			break;
		      }
		  }
	      }
	    for (; n < len; n++, src += delta, msrc += mdelta)
	      {
		if (*msrc && 'compare_function` (src, minval, slen) < 0)
		  {
		    minval = src;
		    result = (rtype_name)n + 1;
		  }')

SCALAR_ARRAY_FUNCTION(0)

#endif
`/* Implementation of the MINLOC intrinsic
   Copyright 2011 Free Software Foundation, Inc.
   Contributed by Thomas Koenig.

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.

You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
<http://www.gnu.org/licenses/>.  */

#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <limits.h>'

include(iparm.m4)dnl
include(iforeach.m4)dnl
define(`compare_function',`ifelse(atype_kind,1,memcmp,memcmp_char4)')dnl

`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'

FOREACH_FUNCTION(
`  const atype_name *minval;
   minval = base;'
,
`  if ('compare_function` (base, minval, slen) < 0 || !dest[0])
    {
      minval = base;
      for (n = 0; n < rank; n++)
        dest[n * dstride] = count[n] + 1;
    }')

MASKED_FOREACH_FUNCTION(
`  const atype_name *minval;

  minval = base;'
,
`  if (*mbase && ('compare_function` (base, minval, slen) < 0 || !dest[0]))
    {
      minval = base;
      for (n = 0; n < rank; n++)
        dest[n * dstride] = count[n] + 1;
    }')

SCALAR_FOREACH_FUNCTION(`0')
#endif
`/* Implementation of the MINLOC intrinsic
   Copyright 2011 Free Software Foundation, Inc.
   Contributed by Thomas Koenig.

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.

You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
<http://www.gnu.org/licenses/>.  */

#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <limits.h>'

include(iparm.m4)dnl
include(ifunction.m4)dnl
define(`compare_function',`ifelse(atype_kind,1,memcmp,memcmp_char4)')dnl

`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'

ARRAY_FUNCTION(0,
`	const atype_name *maxval;
	maxval = base;
	result = 1;',
`		if ('compare_function` (base, maxval, slen) > 0)
		  {
		    maxval = src;
		    result = (rtype_name)n + 1;
		  }', `')

MASKED_ARRAY_FUNCTION(0,
`	const atype_name *maxval;
	maxval = base;
	result = 0;',
`		if (*msrc)
		  {
		      {
			maxval = src;
			result = (rtype_name)n + 1;
			break;
		      }
		  }
	      }
	    for (; n < len; n++, src += delta, msrc += mdelta)
	      {
		if (*msrc && 'compare_function` (src, maxval, slen) > 0)
		  {
		    maxval = src;
		    result = (rtype_name)n + 1;
		  }')

SCALAR_ARRAY_FUNCTION(0)

#endif
`/* Implementation of the MAXVAL intrinsic
   Copyright 2011 Free Software Foundation, Inc.
   Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>

This file is part of the GNU Fortran runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.

You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
<http://www.gnu.org/licenses/>.  */

#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#include <string.h>'

include(iparm.m4)dnl
include(ifunction-s.m4)dnl
define(`compare_function',`ifelse(atype_kind,1,memcmp,memcmp_char4)')dnl

`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'

ARRAY_FUNCTION(255,
`  result = base;',
`  if (compare_function (src, result, slen) < 0)
    result = src;')

MASKED_ARRAY_FUNCTION(255,
`  result = base;',
`  if (*msrc && compare_function (src, result, slen) < 0)
    result = src;')

SCALAR_ARRAY_FUNCTION(255)

#endif
`/* Implementation of the MAXVAL intrinsic
   Copyright 2011 Free Software Foundation, Inc.
   Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>

This file is part of the GNU Fortran runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.

You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
<http://www.gnu.org/licenses/>.  */

#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#include <string.h>'

include(iparm.m4)dnl
include(ifunction-s.m4)dnl
define(`compare_function',`ifelse(atype_kind,1,memcmp,memcmp_char4)')dnl

`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'

ARRAY_FUNCTION(0,
`  result = base;',
`  if (compare_function (src, result, slen) > 0)
    result = src;')

MASKED_ARRAY_FUNCTION(0,
`  result = base;',
`  if (*msrc && compare_function (src, result, slen) > 0)
    result = src;')

SCALAR_ARRAY_FUNCTION(0)

#endif

Comments

Mikael Morin Sept. 22, 2011, 8:29 p.m. UTC | #1 
Hello, 

sorry for the slow (yet faster than anyone else ;) review.

I'm a bit surprised that there is no resolve.c or iresolve.c change.
intrinsic.c may cerainly need some modification too.
Same goes for trans-intrinsic.c, but perhaps resolution time support is 
sufficient in the library call case.
Those are possible causes for your ICEs.

About the library code, I don't understand why you are changing ifunction.m4 
and at the same time adding a new ifunction-s.m4 providing (it seems) the same 
set of macros. I would think that either is necessary, not both. And sharing 
is better if possible.
I have the same concern about the {min,max}{loc{0,1},val}-s which should be 
shared with their non-character counterparts if possible, though in that case 
they are not that big, so it's perhaps not worth bothering too much.

Now onto the inline versions. Ahem! For those you can start looking at the 
existing minmax{loc,val} code, and if you are not running away as fast as you 
can within a couple of seconds, you can probably manage to do something there 
(adding code step by step and looking at the dump every time will certainly 
help). The different cases to be handled (with the different algorithms) are 
described in the comments before the functions, and some more comments are 
added to not get lost along a code, which remains, despite that, painfully big 
for something conceptually simple such as{min,max}{loc,val}.
Good luck.
I can certainly help on very specific points, but writing the whole code and 
testing will be too time consuming.

Mikael
diff mbox

Patch

Index: libgfortran/m4/iforeach.m4
===================================================================
--- libgfortran/m4/iforeach.m4	(Revision 178930)
+++ libgfortran/m4/iforeach.m4	(Arbeitskopie)
@@ -2,15 +2,18 @@  dnl Support macro file for intrinsic functions.
 dnl Contains the generic sections of the array functions.
 dnl This file is part of the GNU Fortran 95 Runtime Library (libgfortran)
 dnl Distributed under the GNU GPL with exception.  See COPYING for details.
+define(`slen_proto',`ifelse(atype_letter,s,`, int')')dnl
+define(`slen_def',`ifelse(atype_letter,s,`, int slen')')dnl
+define(`slen_use',`ifelse(atype_letter,s,`, slen')')dnl
 define(START_FOREACH_FUNCTION,
 `
 extern void name`'rtype_qual`_'atype_code (rtype * const restrict retarray, 
-	atype * const restrict array);
+	atype * const restrict array`'slen_proto`');
 export_proto(name`'rtype_qual`_'atype_code);
 
 void
 name`'rtype_qual`_'atype_code (rtype * const restrict retarray, 
-	atype * const restrict array)
+	atype * const restrict array`'slen_def`')
 {
   index_type count[GFC_MAX_DIMENSIONS];
   index_type extent[GFC_MAX_DIMENSIONS];
@@ -104,13 +107,13 @@  define(FINISH_FOREACH_FUNCTION,
 define(START_MASKED_FOREACH_FUNCTION,
 `
 extern void `m'name`'rtype_qual`_'atype_code (rtype * const restrict, 
-	atype * const restrict, gfc_array_l1 * const restrict);
+	atype * const restrict, gfc_array_l1 * const restrict`'slen_proto`');
 export_proto(`m'name`'rtype_qual`_'atype_code);
 
 void
 `m'name`'rtype_qual`_'atype_code (rtype * const restrict retarray, 
 	atype * const restrict array,
-	gfc_array_l1 * const restrict mask)
+	gfc_array_l1 * const restrict mask`'slen_def`')
 {
   index_type count[GFC_MAX_DIMENSIONS];
   index_type extent[GFC_MAX_DIMENSIONS];
@@ -235,13 +238,13 @@  FINISH_MASKED_FOREACH_FUNCTION')dnl
 define(SCALAR_FOREACH_FUNCTION,
 `
 extern void `s'name`'rtype_qual`_'atype_code (rtype * const restrict, 
-	atype * const restrict, GFC_LOGICAL_4 *);
+	atype * const restrict, GFC_LOGICAL_4 *`'slen_proto`');
 export_proto(`s'name`'rtype_qual`_'atype_code);
 
 void
 `s'name`'rtype_qual`_'atype_code (rtype * const restrict retarray, 
 	atype * const restrict array,
-	GFC_LOGICAL_4 * mask)
+	GFC_LOGICAL_4 * mask`'slen_def`')
 {
   index_type rank;
   index_type dstride;
@@ -250,7 +253,7 @@  void
 
   if (*mask)
     {
-      name`'rtype_qual`_'atype_code (retarray, array);
+      name`'rtype_qual`_'atype_code (retarray, array`'slen_use`');
       return;
     }
 
Index: libgfortran/m4/iparm.m4
===================================================================
--- libgfortran/m4/iparm.m4	(Revision 178930)
+++ libgfortran/m4/iparm.m4	(Arbeitskopie)
@@ -4,7 +4,7 @@  dnl This file is part of the GNU Fortran 95 Runtim
 dnl Distributed under the GNU GPL with exception.  See COPYING for details.
 dnl M4 macro file to get type names from filenames
 define(get_typename2, `GFC_$1_$2')dnl
-define(get_typename, `get_typename2(ifelse($1,i,INTEGER,ifelse($1,r,REAL,ifelse($1,l,LOGICAL,ifelse($1,c,COMPLEX,unknown)))),`$2')')dnl
+define(get_typename, `get_typename2(ifelse($1,i,INTEGER,ifelse($1,r,REAL,ifelse($1,l,LOGICAL,ifelse($1,s,UINTEGER,ifelse($1,c,COMPLEX,unknown))))),`$2')')dnl
 define(get_arraytype, `gfc_array_$1$2')dnl
 define(define_type, `dnl
 ifelse(regexp($2,`^[0-9]'),-1,`dnl
Index: libgfortran/m4/ifunction.m4
===================================================================
--- libgfortran/m4/ifunction.m4	(Revision 178930)
+++ libgfortran/m4/ifunction.m4	(Arbeitskopie)
@@ -17,16 +17,19 @@  dnl atype_name and rtype_name respectively.
 dnl Execution should be allowed to continue to the end of the block.
 dnl You should not return or break from the inner loop of the implementation.
 dnl Care should also be taken to avoid using the names defined in iparm.m4
+define(`slen_proto',`ifelse(atype_letter,s,`, int')')dnl
+define(`slen_def',`ifelse(atype_letter,s,`, int slen')')dnl
+define(`slen_use',`ifelse(atype_letter,s,`, slen')')dnl
 define(START_ARRAY_FUNCTION,
 `
 extern void name`'rtype_qual`_'atype_code (rtype * const restrict, 
-	atype * const restrict, const index_type * const restrict);
+	atype * const restrict, const index_type * const restrict`'slen_proto`');
 export_proto(name`'rtype_qual`_'atype_code);
 
 void
 name`'rtype_qual`_'atype_code (rtype * const restrict retarray, 
 	atype * const restrict array, 
-	const index_type * const restrict pdim)
+	const index_type * const restrict pdim`'slen_def`')
 {
   index_type count[GFC_MAX_DIMENSIONS];
   index_type extent[GFC_MAX_DIMENSIONS];
@@ -177,14 +180,14 @@  define(START_MASKED_ARRAY_FUNCTION,
 `
 extern void `m'name`'rtype_qual`_'atype_code (rtype * const restrict, 
 	atype * const restrict, const index_type * const restrict,
-	gfc_array_l1 * const restrict);
+	gfc_array_l1 * const restrict`'slen_proto`');
 export_proto(`m'name`'rtype_qual`_'atype_code);
 
 void
 `m'name`'rtype_qual`_'atype_code (rtype * const restrict retarray, 
 	atype * const restrict array, 
 	const index_type * const restrict pdim, 
-	gfc_array_l1 * const restrict mask)
+	gfc_array_l1 * const restrict mask`'slen_def`')
 {
   index_type count[GFC_MAX_DIMENSIONS];
   index_type extent[GFC_MAX_DIMENSIONS];
@@ -360,14 +363,14 @@  define(SCALAR_ARRAY_FUNCTION,
 `
 extern void `s'name`'rtype_qual`_'atype_code (rtype * const restrict, 
 	atype * const restrict, const index_type * const restrict,
-	GFC_LOGICAL_4 *);
+	GFC_LOGICAL_4 *`'slen_def`');
 export_proto(`s'name`'rtype_qual`_'atype_code);
 
 void
 `s'name`'rtype_qual`_'atype_code (rtype * const restrict retarray, 
 	atype * const restrict array, 
 	const index_type * const restrict pdim, 
-	GFC_LOGICAL_4 * mask)
+	GFC_LOGICAL_4 * mask`'slen_def`')
 {
   index_type count[GFC_MAX_DIMENSIONS];
   index_type extent[GFC_MAX_DIMENSIONS];
@@ -380,7 +383,7 @@  void
 
   if (*mask)
     {
-      name`'rtype_qual`_'atype_code (retarray, array, pdim);
+      name`'rtype_qual`_'atype_code (retarray, array, pdim`'slen_use`');
       return;
     }
   /* Make dim zero based to avoid confusion.  */
Index: libgfortran/gfortran.map
===================================================================
--- libgfortran/gfortran.map	(Revision 178930)
+++ libgfortran/gfortran.map	(Arbeitskopie)
@@ -1187,6 +1187,50 @@  GFORTRAN_1.4 {
     _gfortran_cshift0_16_char4;
     _gfortran_eoshift0_16_char4;
     _gfortran_eoshift2_16_char4;
+    _gfortran_maxloc0_1_s1;
+    _gfortran_maxloc0_2_s1;
+    _gfortran_maxloc0_4_s1;
+    _gfortran_maxloc0_8_s1;
+    _gfortran_maxloc0_16_s1;
+    _gfortran_maxloc0_1_s4;
+    _gfortran_maxloc0_2_s4;
+    _gfortran_maxloc0_4_s4;
+    _gfortran_maxloc0_8_s4;
+    _gfortran_maxloc0_16_s4;
+    _gfortran_minloc0_1_s1;
+    _gfortran_minloc0_2_s1;
+    _gfortran_minloc0_4_s1;
+    _gfortran_minloc0_8_s1;
+    _gfortran_minloc0_16_s1;
+    _gfortran_minloc0_1_s4;
+    _gfortran_minloc0_2_s4;
+    _gfortran_minloc0_4_s4;
+    _gfortran_minloc0_8_s4;
+    _gfortran_minloc0_16_s4;
+    _gfortran_maxloc1_1_s1;
+    _gfortran_maxloc1_2_s1;
+    _gfortran_maxloc1_4_s1;
+    _gfortran_maxloc1_8_s1;
+    _gfortran_maxloc1_16_s1;
+    _gfortran_maxloc1_1_s4;
+    _gfortran_maxloc1_2_s4;
+    _gfortran_maxloc1_4_s4;
+    _gfortran_maxloc1_8_s4;
+    _gfortran_maxloc1_16_s4;
+    _gfortran_minloc1_1_s1;
+    _gfortran_minloc1_2_s1;
+    _gfortran_minloc1_4_s1;
+    _gfortran_minloc1_8_s1;
+    _gfortran_minloc1_16_s1;
+    _gfortran_minloc1_1_s4;
+    _gfortran_minloc1_2_s4;
+    _gfortran_minloc1_4_s4;
+    _gfortran_minloc1_8_s4;
+    _gfortran_minloc1_16_s4;
+    _gfortran_maxval_s1;
+    _gfortran_maxval_s4;
+    _gfortran_minval_s1;
+    _gfortran_minval_s4;
 } GFORTRAN_1.3; 
 
 F2C_1.0 {
Index: libgfortran/libgfortran.h
===================================================================
--- libgfortran/libgfortran.h	(Revision 178930)
+++ libgfortran/libgfortran.h	(Arbeitskopie)
@@ -339,6 +339,8 @@  struct {\
 /* Commonly used array descriptor types.  */
 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) gfc_array_void;
 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, char) gfc_array_char;
+typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_UINTEGER_1) gfc_array_s1;
+typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_UINTEGER_4) gfc_array_s4;
 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_1) gfc_array_i1;
 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_2) gfc_array_i2;
 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_array_i4;
Index: libgfortran/Makefile.am
===================================================================
--- libgfortran/Makefile.am	(Revision 178930)
+++ libgfortran/Makefile.am	(Arbeitskopie)
@@ -248,6 +248,18 @@  $(srcdir)/generated/maxloc0_4_r16.c \
 $(srcdir)/generated/maxloc0_8_r16.c \
 $(srcdir)/generated/maxloc0_16_r16.c
 
+i_maxloc0s_c = \
+$(srcdir)/generated/maxloc0_1_s1.c \
+$(srcdir)/generated/maxloc0_1_s4.c \
+$(srcdir)/generated/maxloc0_2_s1.c \
+$(srcdir)/generated/maxloc0_2_s4.c \
+$(srcdir)/generated/maxloc0_4_s1.c \
+$(srcdir)/generated/maxloc0_4_s4.c \
+$(srcdir)/generated/maxloc0_8_s1.c \
+$(srcdir)/generated/maxloc0_8_s4.c \
+$(srcdir)/generated/maxloc0_16_s1.c \
+$(srcdir)/generated/maxloc0_16_s4.c
+
 i_maxloc1_c= \
 $(srcdir)/generated/maxloc1_4_i1.c \
 $(srcdir)/generated/maxloc1_8_i1.c \
@@ -277,6 +289,18 @@  $(srcdir)/generated/maxloc1_4_r16.c \
 $(srcdir)/generated/maxloc1_8_r16.c \
 $(srcdir)/generated/maxloc1_16_r16.c
 
+i_maxloc1s_c = \
+$(srcdir)/generated/maxloc1_1_s1.c \
+$(srcdir)/generated/maxloc1_1_s4.c \
+$(srcdir)/generated/maxloc1_2_s1.c \
+$(srcdir)/generated/maxloc1_2_s4.c \
+$(srcdir)/generated/maxloc1_4_s1.c \
+$(srcdir)/generated/maxloc1_4_s4.c \
+$(srcdir)/generated/maxloc1_8_s1.c \
+$(srcdir)/generated/maxloc1_8_s4.c \
+$(srcdir)/generated/maxloc1_16_s1.c \
+$(srcdir)/generated/maxloc1_16_s4.c
+
 i_maxval_c= \
 $(srcdir)/generated/maxval_i1.c \
 $(srcdir)/generated/maxval_i2.c \
@@ -288,6 +312,10 @@  $(srcdir)/generated/maxval_r8.c \
 $(srcdir)/generated/maxval_r10.c \
 $(srcdir)/generated/maxval_r16.c
 
+i_maxvals_c= \
+$(srcdir)/generated/maxval_s1.c \
+$(srcdir)/generated/maxval_s4.c
+
 i_minloc0_c= \
 $(srcdir)/generated/minloc0_4_i1.c \
 $(srcdir)/generated/minloc0_8_i1.c \
@@ -317,6 +345,18 @@  $(srcdir)/generated/minloc0_4_r16.c \
 $(srcdir)/generated/minloc0_8_r16.c \
 $(srcdir)/generated/minloc0_16_r16.c
 
+i_minloc0s_c = \
+$(srcdir)/generated/minloc0_1_s1.c \
+$(srcdir)/generated/minloc0_1_s4.c \
+$(srcdir)/generated/minloc0_2_s1.c \
+$(srcdir)/generated/minloc0_2_s4.c \
+$(srcdir)/generated/minloc0_4_s1.c \
+$(srcdir)/generated/minloc0_4_s4.c \
+$(srcdir)/generated/minloc0_8_s1.c \
+$(srcdir)/generated/minloc0_8_s4.c \
+$(srcdir)/generated/minloc0_16_s1.c \
+$(srcdir)/generated/minloc0_16_s4.c
+
 i_minloc1_c= \
 $(srcdir)/generated/minloc1_4_i1.c \
 $(srcdir)/generated/minloc1_8_i1.c \
@@ -346,6 +386,18 @@  $(srcdir)/generated/minloc1_4_r16.c \
 $(srcdir)/generated/minloc1_8_r16.c \
 $(srcdir)/generated/minloc1_16_r16.c
 
+i_minloc1s_c = \
+$(srcdir)/generated/minloc1_1_s1.c \
+$(srcdir)/generated/minloc1_1_s4.c \
+$(srcdir)/generated/minloc1_2_s1.c \
+$(srcdir)/generated/minloc1_2_s4.c \
+$(srcdir)/generated/minloc1_4_s1.c \
+$(srcdir)/generated/minloc1_4_s4.c \
+$(srcdir)/generated/minloc1_8_s1.c \
+$(srcdir)/generated/minloc1_8_s4.c \
+$(srcdir)/generated/minloc1_16_s1.c \
+$(srcdir)/generated/minloc1_16_s4.c
+
 i_minval_c= \
 $(srcdir)/generated/minval_i1.c \
 $(srcdir)/generated/minval_i2.c \
@@ -357,6 +409,10 @@  $(srcdir)/generated/minval_r8.c \
 $(srcdir)/generated/minval_r10.c \
 $(srcdir)/generated/minval_r16.c
 
+i_minvals_c= \
+$(srcdir)/generated/minval_s1.c \
+$(srcdir)/generated/minval_s4.c
+
 i_norm2_c= \
 $(srcdir)/generated/norm2_r4.c \
 $(srcdir)/generated/norm2_r8.c \
@@ -646,7 +702,8 @@  gfor_built_src= $(i_all_c) $(i_any_c) $(i_count_c)
     $(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \
     $(i_pow_c) $(i_rrspacing_c) $(i_spacing_c) $(i_pack_c) $(i_unpack_c) \
     $(i_spread_c) selected_int_kind.inc selected_real_kind.inc kinds.h \
-    $(i_cshift0_c) kinds.inc c99_protos.inc fpu-target.h
+    $(i_cshift0_c) kinds.inc c99_protos.inc fpu-target.h $(i_maxloc0s_c) \
+    $(i_minloc0s_c) $(i_maxloc1s_c) $(i_minloc1s_c) $(i_maxvals_c) $(i_minvals_c)
 
 # Machine generated specifics
 gfor_built_specific_src= \
@@ -848,6 +905,7 @@  I_M4_DEPS=m4/iparm.m4
 I_M4_DEPS0=$(I_M4_DEPS) m4/iforeach.m4
 I_M4_DEPS1=$(I_M4_DEPS) m4/ifunction.m4
 I_M4_DEPS2=$(I_M4_DEPS) m4/ifunction_logical.m4
+I_M4_DEPS3=$(I_M4_DEPS) m4/ifunction-s.m4
 
 kinds.h: $(srcdir)/mk-kinds-h.sh
 	$(SHELL) $(srcdir)/mk-kinds-h.sh '$(FCCOMPILE)' > $@ || rm $@
@@ -895,21 +953,39 @@  $(i_iparity_c): m4/iparity.m4 $(I_M4_DEPS)
 $(i_maxloc0_c): m4/maxloc0.m4 $(I_M4_DEPS0)
 	$(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc0.m4 > $@
 
+$(i_maxloc0s_c) : m4/maxloc0s.m4 $(I_M4_DEPS0)
+	$(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc0s.m4 > $@
+
 $(i_maxloc1_c): m4/maxloc1.m4 $(I_M4_DEPS1)
 	$(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc1.m4 > $@
 
+$(i_maxloc1s_c): m4/maxloc1s.m4 $(I_M4_DEPS1)
+	$(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc1s.m4 > $@
+
 $(i_maxval_c): m4/maxval.m4 $(I_M4_DEPS1)
 	$(M4) -Dfile=$@ -I$(srcdir)/m4 maxval.m4 > $@
 
+$(i_maxvals_c): m4/maxvals.m4 $(I_M4_DEPS3)
+	$(M4) -Dfile=$@ -I$(srcdir)/m4 maxvals.m4 > $@
+
 $(i_minloc0_c): m4/minloc0.m4 $(I_M4_DEPS0)
 	$(M4) -Dfile=$@ -I$(srcdir)/m4 minloc0.m4 > $@
 
+$(i_minloc0s_c) : m4/minloc0s.m4 $(I_M4_DEPS0)
+	$(M4) -Dfile=$@ -I$(srcdir)/m4 minloc0s.m4 > $@
+
 $(i_minloc1_c): m4/minloc1.m4 $(I_M4_DEPS1)
 	$(M4) -Dfile=$@ -I$(srcdir)/m4 minloc1.m4 > $@
 
+$(i_minloc1s_c): m4/minloc1s.m4 $(I_M4_DEPS1)
+	$(M4) -Dfile=$@ -I$(srcdir)/m4 minloc1s.m4 > $@
+
 $(i_minval_c): m4/minval.m4 $(I_M4_DEPS1)
 	$(M4) -Dfile=$@ -I$(srcdir)/m4 minval.m4 > $@
 
+$(i_minvals_c): m4/minvals.m4 $(I_M4_DEPS3)
+	$(M4) -Dfile=$@ -I$(srcdir)/m4 minvals.m4 > $@
+
 $(i_product_c): m4/product.m4 $(I_M4_DEPS1)
 	$(M4) -Dfile=$@ -I$(srcdir)/m4 product.m4 > $@
 
Index: libgfortran/mk-kinds-h.sh
===================================================================
--- libgfortran/mk-kinds-h.sh	(Revision 178930)
+++ libgfortran/mk-kinds-h.sh	(Arbeitskopie)
@@ -34,6 +34,7 @@  for k in $possible_integer_kinds; do
     echo "typedef GFC_INTEGER_${k} GFC_LOGICAL_${k};"
     echo "#define HAVE_GFC_LOGICAL_${k}"
     echo "#define HAVE_GFC_INTEGER_${k}"
+    echo "#define HAVE_GFC_UINTEGER_${k}"
     echo ""
   fi
   rm -f tmp$$.*