re PR fortran/33197 (Fortran 2008: math functions)

gcc/fortran/
2010-08-27  Tobias Burnus  <burnus@net-b.de>

        PR fortran/33197
        * gcc/fortran/intrinsic.c (add_functions): Add norm2 and parity.
        * gcc/fortran/intrinsic.h (gfc_check_norm2, gfc_check_parity):
        gfc_simplify_norm2, gfc_simplify_parity, gfc_resolve_norm2,
        gfc_resolve_parity): New prototypes.
        * gcc/fortran/gfortran.h (gfc_isym_id): New enum items
        GFC_ISYM_NORM2 and GFC_ISYM_PARITY.
        * gcc/fortran/iresolve.c (gfc_resolve_norm2,
        gfc_resolve_parity): New functions.
        * gcc/fortran/check.c (gfc_check_norm2, gfc_check_parity):
        New functions.
        * gcc/fortran/trans-intrinsic.c (gfc_conv_intrinsic_arith,
        gfc_conv_intrinsic_function): Handle NORM2 and PARITY.
        * gcc/fortran/intrinsic.texi (NORM2, PARITY): Add.
        * gcc/fortran/simplify.c (simplify_transformation_to_array):
        Add post-processing opterator.
        (gfc_simplify_all, gfc_simplify_any, gfc_simplify_count,
        gfc_simplify_product, gfc_simplify_sum): Update call.
        (add_squared, do_sqrt, gfc_simplify_norm2, do_xor,
        gfc_simplify_parity): New functions.

gcc/testsuite/
2010-08-27  Tobias Burnus  <burnus@net-b.de>

        PR fortran/33197
        * gcc/testsuite/gfortran.dg/norm2_1.f90: New.
        * gcc/testsuite/gfortran.dg/norm2_2.f90: New.
        * gcc/testsuite/gfortran.dg/norm2_3.f90: New.
        * gcc/testsuite/gfortran.dg/norm2_4.f90: New.
        * gcc/testsuite/gfortran.dg/parity_1.f90: New.
        * gcc/testsuite/gfortran.dg/parity_2.f90: New.
        * gcc/testsuite/gfortran.dg/parity_3.f90: New.

libgfortran/
2010-08-27  Tobias Burnus  <burnus@net-b.de>

        PR fortran/33197
        * libgfortran/m4/ifunction.m4 (FINISH_ARRAY_FUNCTION,
        ARRAY_FUNCTION): Allow expression after loop.
        * libgfortran/m4/norm2.m4: New for _gfortran_norm2_r{4,8,10,16}.
        * libgfortran/m4/parity.m4: New for
        * _gfortran_parity_l{1,2,4,8,16}.
        * libgfortran/gfortran.map: Add new functions.
        * libgfortran/Makefile.am: Ditto.
        * libgfortran/m4/minloc1.m4: Add empty argument for
        * ARRAY_FUNCTION.
        * libgfortran/m4/maxloc1.m4: Ditto.
        * libgfortran/m4/all.m4: Ditto.
        * libgfortran/m4/minval.m4: Ditto.
        * libgfortran/m4/maxval.m4: Ditto.
        * libgfortran/m4/count.m4: Ditto.
        * libgfortran/m4/product.m4: Ditto.
        * libgfortran/m4/any.m4: Ditto.
        * Makefile.in: Regenerated.
        * generated/minval_r8.c: Regenerated.
        * generated/maxloc1_4_r8.c: Regenerated.
        * generated/minloc1_16_r16.c: Regenerated.
        * generated/norm2_r4.c: Regenerated.
        * generated/sum_i8.c: Regenerated.
        * generated/parity_l2.c: Regenerated.
        * generated/any_l16.c: Regenerated.
        * generated/maxval_i2.c: Regenerated.
        * generated/any_l2.c: Regenerated.
        * generated/product_r4.c: Regenerated.
        * generated/maxloc1_8_i4.c: Regenerated.
        * generated/parity_l16.c: Regenerated.
        * generated/all_l1.c: Regenerated.
        * generated/product_i2.c: Regenerated.
        * generated/minloc1_8_r16.c: Regenerated.
        * generated/maxloc1_8_r16.c: Regenerated.
        * generated/sum_r16.c: Regenerated.
        * generated/sum_i1.c: Regenerated.
        * generated/minloc1_4_r8.c: Regenerated.
        * generated/maxloc1_16_r16.c: Regenerated.
        * generated/minloc1_16_i4.c: Regenerated.
        * generated/maxloc1_16_i4.c: Regenerated.
        * generated/maxval_r16.c: Regenerated.
        * generated/product_c10.c: Regenerated.
        * generated/minloc1_8_i4.c: Regenerated.
        * generated/all_l2.c: Regenerated.
        * generated/product_c4.c: Regenerated.
        * generated/sum_r4.c: Regenerated.
        * generated/all_l16.c: Regenerated.
        * generated/minloc1_16_r10.c: Regenerated.
        * generated/sum_i2.c: Regenerated.
        * generated/maxloc1_8_r8.c: Regenerated.
        * generated/minval_i16.c: Regenerated.
        * generated/parity_l4.c: Regenerated.
        * generated/maxval_i4.c: Regenerated.
        * generated/any_l4.c: Regenerated.
        * generated/minval_i8.c: Regenerated.
        * generated/maxloc1_4_i8.c: Regenerated.
        * generated/minloc1_4_i16.c: Regenerated.
        * generated/maxloc1_4_i16.c: Regenerated.
        * generated/minloc1_8_r10.c: Regenerated.
        * generated/product_i4.c: Regenerated.
        * generated/maxloc1_8_r10.c: Regenerated.
        * generated/sum_c16.c: Regenerated.
        * generated/minloc1_16_r8.c: Regenerated.
        * generated/maxloc1_16_r8.c: Regenerated.
        * generated/count_4_l.c: Regenerated.
        * generated/sum_r10.c: Regenerated.
        * generated/count_8_l.c: Regenerated.
        * generated/sum_c4.c: Regenerated.
        * generated/maxloc1_16_r10.c: Regenerated.
        * generated/minloc1_8_r8.c: Regenerated.
        * generated/maxval_r10.c: Regenerated.
        * generated/minval_i1.c: Regenerated.
        * generated/maxloc1_4_i1.c: Regenerated.
        * generated/minloc1_4_i8.c: Regenerated.
        * generated/product_i16.c: Regenerated.
        * generated/all_l4.c: Regenerated.
        * generated/norm2_r16.c: Regenerated.
        * generated/minval_r4.c: Regenerated.
        * generated/maxloc1_4_r4.c: Regenerated.
        * generated/sum_i4.c: Regenerated.
        * generated/maxval_r8.c: Regenerated.
        * generated/norm2_r8.c: Regenerated.
        * generated/minloc1_4_i1.c: Regenerated.
        * generated/minval_r16.c: Regenerated.
        * generated/minval_i2.c: Regenerated.
        * generated/maxloc1_4_i2.c: Regenerated.
        * generated/product_r8.c: Regenerated.
        * generated/maxloc1_8_i8.c: Regenerated.
        * generated/sum_c10.c: Regenerated.
        * generated/minloc1_4_r16.c: Regenerated.
        * generated/maxloc1_4_r16.c: Regenerated.
        * generated/count_1_l.c: Regenerated.
        * generated/minloc1_4_r4.c: Regenerated.
        * generated/minloc1_16_i8.c: Regenerated.
        * generated/maxloc1_16_i8.c: Regenerated.
        * generated/minloc1_4_i2.c: Regenerated.
        * generated/maxloc1_8_i1.c: Regenerated.
        * generated/minloc1_8_i8.c: Regenerated.
        * generated/product_r16.c: Regenerated.
        * generated/product_c8.c: Regenerated.
        * generated/sum_r8.c: Regenerated.
        * generated/norm2_r10.c: Regenerated.
        * generated/minloc1_16_i16.c: Regenerated.
        * generated/maxloc1_8_r4.c: Regenerated.
        * generated/minloc1_16_i1.c: Regenerated.
        * generated/maxloc1_16_i1.c: Regenerated.
        * generated/minval_r10.c: Regenerated.
        * generated/count_16_l.c: Regenerated.
        * generated/parity_l8.c: Regenerated.
        * generated/minloc1_8_i1.c: Regenerated.
        * generated/minval_i4.c: Regenerated.
        * generated/maxloc1_4_i4.c: Regenerated.
        * generated/maxloc1_8_i2.c: Regenerated.
        * generated/maxval_i8.c: Regenerated.
        * generated/any_l8.c: Regenerated.
        * generated/minloc1_4_r10.c: Regenerated.
        * generated/minloc1_8_i16.c: Regenerated.
        * generated/maxloc1_4_r10.c: Regenerated.
        * generated/maxloc1_8_i16.c: Regenerated.
        * generated/minloc1_16_r4.c: Regenerated.
        * generated/maxloc1_16_r4.c: Regenerated.
        * generated/product_i8.c: Regenerated.
        * generated/sum_i16.c: Regenerated.
        * generated/count_2_l.c: Regenerated.
        * generated/maxloc1_16_i16.c: Regenerated.
        * generated/minloc1_8_r4.c: Regenerated.
        * generated/sum_c8.c: Regenerated.
        * generated/minloc1_16_i2.c: Regenerated.
        * generated/maxloc1_16_i2.c: Regenerated.
        * generated/parity_l1.c: Regenerated.
        * generated/maxval_i16.c: Regenerated.
        * generated/maxval_i1.c: Regenerated.
        * generated/minloc1_4_i4.c: Regenerated.
        * generated/any_l1.c: Regenerated.
        * generated/minloc1_8_i2.c: Regenerated.
        * generated/product_c16.c: Regenerated.
        * generated/product_r10.c: Regenerated.
        * generated/product_i1.c: Regenerated.
        * generated/all_l8.c: Regenerated.
        * generated/maxval_r4.c: Regenerated.

From-SVN: r163595

1 files changed, 191 insertions, 0 deletions

diff --git a/libgfortran/generated/parity_l2.c b/libgfortran/generated/parity_l2.c
new file mode 100644
index 00000000000..13e77bd52e0
--- /dev/null
+++ b/libgfortran/generated/parity_l2.c
@@ -0,0 +1,191 @@
+/* Implementation of the NORM2 intrinsic
+   Copyright 2010 Free Software Foundation, Inc.
+   Contributed by Tobias Burnus  <burnus@net-b.de>
+
+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 <math.h>
+#include <assert.h>
+
+
+#if defined (HAVE_GFC_LOGICAL_2) && defined (HAVE_GFC_LOGICAL_2)
+
+
+extern void parity_l2 (gfc_array_l2 * const restrict, 
+	gfc_array_l2 * const restrict, const index_type * const restrict);
+export_proto(parity_l2);
+
+void
+parity_l2 (gfc_array_l2 * const restrict retarray, 
+	gfc_array_l2 * const restrict array, 
+	const index_type * const restrict pdim)
+{
+  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 GFC_LOGICAL_2 * restrict base;
+  GFC_LOGICAL_2 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+  int continue_loop;
+
+  /* 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 (GFC_LOGICAL_2) * 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"
+		       " PARITY 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", "PARITY");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+	len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  continue_loop = 1;
+  while (continue_loop)
+    {
+      const GFC_LOGICAL_2 * restrict src;
+      GFC_LOGICAL_2 result;
+      src = base;
+      {
+
+  result = 0;
+	if (len <= 0)
+	  *dest = 0;
+	else
+	  {
+	    for (n = 0; n < len; n++, src += delta)
+	      {
+
+  result = result != *src;
+	      }
+	    
+	    *dest = result;
+	  }
+      }
+      /* 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];
+	    }
+	}
+    }
+}
+
+#endif