re PR fortran/38282 (Bit intrinsics: ILEN and IBCHNG)

2010-09-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/38282
        * intrinsic.c (add_functions): Support IALL, IANY, IPARITY.
        (check_specific): Special case for those intrinsics.
        * gfortran.h (gfc_isym_id): Add new intrinsics
        * intrinsic.h (gfc_check_transf_bit_intrins,
        gfc_simplify_iall, gfc_simplify_iany, gfc_simplify_iparity,
        gfc_resolve_iall, gfc_resolve_iany, gfc_resolve_iparity):
        New prototypes.
        * iresolve.c (gfc_resolve_iall, gfc_resolve_iany,
        gfc_resolve_iparity, resolve_transformational): New functions.
        (gfc_resolve_product, gfc_resolve_sum,
        gfc_resolve_parity): Use resolve_transformational.
        * check.c (gfc_check_transf_bit_intrins): New function.
        * simplify.c (gfc_simplify_iall, gfc_simplify_iany,
        gfc_simplify_iparity, do_bit_any, do_bit_ior,
        do_bit_xor, simplify_transformation): New functions.
        (gfc_simplify_all, gfc_simplify_any, gfc_simplify_parity,
        gfc_simplify_sum, gfc_simplify_product): Use simplify_transformation.
        * trans-intrinsic.c (gfc_conv_intrinsic_arith,
        gfc_conv_intrinsic_function, gfc_is_intrinsic_libcall):
        Handle IALL, IANY and IPARITY intrinsics.       
        * intrinsic.texi (IMAGE_INDEX): Move up to fix alphabetic
        order.
        (IALL, IANY, IPARITY): Document new intrinsics.

2010-09-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/38282
        * gfortran.dg/iall_iany_iparity_1.f90: New.
        * gfortran.dg/iall_iany_iparity_2.f90: New.

2010-09-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/38282
        * gfortran.map: Add new iany, iall and iparity intrinsics.
        * Makefile.am: Ditto.
        * m4/iany.m4: New.
        * m4/iall.m4: New.
        * m4/iparity.m4: New.
        * Makefile.in: Regenerate.
        * generated/iall_i1.c: Generate.
        * generated/iall_i2.c: Generate.
        * generated/iall_i4.c: Generate.
        * generated/iall_i8.c: Generate.
        * generated/iall_i16.c: Generate.
        * generated/iany_i1.c: Generate.
        * generated/iany_i2.c: Generate.
        * generated/iany_i4.c: Generate.
        * generated/iany_i8.c: Generate.
        * generated/iany_i16.c: Generate.
        * generated/iparity_i1.c: Generate.
        * generated/iparity_i2.c: Generate.
        * generated/iparity_i4.c: Generate.
        * generated/iparity_i8.c: Generate.
        * generated/iparity_i16.c: Generate.

From-SVN: r163898

1 files changed, 87 insertions, 74 deletions

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 8649597..248df6c 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -620,6 +620,30 @@ simplify_transformation_to_array (gfc_expr *result, gfc_expr *array, gfc_expr *d
 }
 
 
+static gfc_expr *
+simplify_transformation (gfc_expr *array, gfc_expr *dim, gfc_expr *mask,
+			 int init_val, transformational_op op)
+{
+  gfc_expr *result;
+
+  if (!is_constant_array_expr (array)
+      || !gfc_is_constant_expr (dim))
+    return NULL;
+
+  if (mask
+      && !is_constant_array_expr (mask)
+      && mask->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = transformational_result (array, dim, array->ts.type,
+				    array->ts.kind, &array->where);
+  init_result_expr (result, init_val, NULL);
+
+  return !dim || array->rank == 1 ?
+    simplify_transformation_to_scalar (result, array, mask, op) :
+    simplify_transformation_to_array (result, array, dim, mask, op, NULL);
+}
+
 
 /********************** Simplification functions *****************************/
 
@@ -888,19 +912,7 @@ gfc_simplify_aint (gfc_expr *e, gfc_expr *k)
 gfc_expr *
 gfc_simplify_all (gfc_expr *mask, gfc_expr *dim)
 {
-  gfc_expr *result;
-
-  if (!is_constant_array_expr (mask)
-      || !gfc_is_constant_expr (dim))
-    return NULL;
-
-  result = transformational_result (mask, dim, mask->ts.type,
-				    mask->ts.kind, &mask->where);
-  init_result_expr (result, true, NULL);
-
-  return !dim || mask->rank == 1 ?
-    simplify_transformation_to_scalar (result, mask, NULL, gfc_and) :
-    simplify_transformation_to_array (result, mask, dim, NULL, gfc_and, NULL);
+  return simplify_transformation (mask, dim, NULL, true, gfc_and);
 }
 
 
@@ -974,19 +986,7 @@ gfc_simplify_and (gfc_expr *x, gfc_expr *y)
 gfc_expr *
 gfc_simplify_any (gfc_expr *mask, gfc_expr *dim)
 {
-  gfc_expr *result;
-
-  if (!is_constant_array_expr (mask)
-      || !gfc_is_constant_expr (dim))
-    return NULL;
-
-  result = transformational_result (mask, dim, mask->ts.type,
-				    mask->ts.kind, &mask->where);
-  init_result_expr (result, false, NULL);
-
-  return !dim || mask->rank == 1 ?
-    simplify_transformation_to_scalar (result, mask, NULL, gfc_or) :
-    simplify_transformation_to_array (result, mask, dim, NULL, gfc_or, NULL);
+  return simplify_transformation (mask, dim, NULL, false, gfc_or);
 }
 
 
@@ -2231,6 +2231,44 @@ gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind)
 }
 
 
+static gfc_expr *
+do_bit_and (gfc_expr *result, gfc_expr *e)
+{
+  gcc_assert (e->ts.type == BT_INTEGER && e->expr_type == EXPR_CONSTANT);
+  gcc_assert (result->ts.type == BT_INTEGER
+	      && result->expr_type == EXPR_CONSTANT);
+
+  mpz_and (result->value.integer, result->value.integer, e->value.integer);
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_iall (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
+{
+  return simplify_transformation (array, dim, mask, -1, do_bit_and);
+}
+
+
+static gfc_expr *
+do_bit_ior (gfc_expr *result, gfc_expr *e)
+{
+  gcc_assert (e->ts.type == BT_INTEGER && e->expr_type == EXPR_CONSTANT);
+  gcc_assert (result->ts.type == BT_INTEGER
+	      && result->expr_type == EXPR_CONSTANT);
+
+  mpz_ior (result->value.integer, result->value.integer, e->value.integer);
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_iany (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
+{
+  return simplify_transformation (array, dim, mask, 0, do_bit_ior);
+}
+
+
 gfc_expr *
 gfc_simplify_iand (gfc_expr *x, gfc_expr *y)
 {
@@ -2683,6 +2721,26 @@ gfc_simplify_ior (gfc_expr *x, gfc_expr *y)
 }
 
 
+static gfc_expr *
+do_bit_xor (gfc_expr *result, gfc_expr *e)
+{
+  gcc_assert (e->ts.type == BT_INTEGER && e->expr_type == EXPR_CONSTANT);
+  gcc_assert (result->ts.type == BT_INTEGER
+	      && result->expr_type == EXPR_CONSTANT);
+
+  mpz_xor (result->value.integer, result->value.integer, e->value.integer);
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_iparity (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
+{
+  return simplify_transformation (array, dim, mask, 0, do_bit_xor);
+}
+
+
+
 gfc_expr *
 gfc_simplify_is_iostat_end (gfc_expr *x)
 {
@@ -4277,18 +4335,7 @@ do_xor (gfc_expr *result, gfc_expr *e)
 gfc_expr *
 gfc_simplify_parity (gfc_expr *e, gfc_expr *dim)
 {
-  gfc_expr *result;
-
-  if (!is_constant_array_expr (e)
-      || (dim != NULL && !gfc_is_constant_expr (dim)))
-    return NULL;
-
-  result = transformational_result (e, dim, e->ts.type, e->ts.kind, &e->where);
-  init_result_expr (result, 0, NULL);
-
-  return (!dim || e->rank == 1)
-    ? simplify_transformation_to_scalar (result, e, NULL, do_xor)
-    : simplify_transformation_to_array (result, e, dim, NULL, do_xor, NULL);
+  return simplify_transformation (e, dim, NULL, 0, do_xor);
 }
 
 
@@ -4345,24 +4392,7 @@ gfc_simplify_precision (gfc_expr *e)
 gfc_expr *
 gfc_simplify_product (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
 {
-  gfc_expr *result;
-
-  if (!is_constant_array_expr (array)
-      || !gfc_is_constant_expr (dim))
-    return NULL;
-
-  if (mask
-      && !is_constant_array_expr (mask)
-      && mask->expr_type != EXPR_CONSTANT)
-    return NULL;
-
-  result = transformational_result (array, dim, array->ts.type,
-				    array->ts.kind, &array->where);
-  init_result_expr (result, 1, NULL);
-
-  return !dim || array->rank == 1 ?
-    simplify_transformation_to_scalar (result, array, mask, gfc_multiply) :
-    simplify_transformation_to_array (result, array, dim, mask, gfc_multiply, NULL);
+  return simplify_transformation (array, dim, mask, 1, gfc_multiply);
 }
 
 
@@ -5508,24 +5538,7 @@ gfc_simplify_sqrt (gfc_expr *e)
 gfc_expr *
 gfc_simplify_sum (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
 {
-  gfc_expr *result;
-
-  if (!is_constant_array_expr (array)
-      || !gfc_is_constant_expr (dim))
-    return NULL;
-
-  if (mask
-      && !is_constant_array_expr (mask)
-      && mask->expr_type != EXPR_CONSTANT)
-    return NULL;
-
-  result = transformational_result (array, dim, array->ts.type,
-				    array->ts.kind, &array->where);
-  init_result_expr (result, 0, NULL);
-
-  return !dim || array->rank == 1 ?
-    simplify_transformation_to_scalar (result, array, mask, gfc_add) :
-    simplify_transformation_to_array (result, array, dim, mask, gfc_add, NULL);
+  return simplify_transformation (array, dim, mask, 0, gfc_add);
 }