PR fortran/38282

	* intrinsic.c (add_functions): Add B{G,L}{E,T}, DSHIFT{L,R},
	MASK{L,R}, MERGE_BITS and SHIFT{A,L,R}.
	* gfortran.h: Define ISYM values for above intrinsics.
	* intrinsic.h (gfc_check_bge_bgt_ble_blt, gfc_check_dshift,
	gfc_check_mask, gfc_check_merge_bits, gfc_check_shift,
	gfc_simplify_bge, gfc_simplify_bgt, gfc_simplify_ble,
	gfc_simplify_blt, gfc_simplify_dshiftl, gfc_simplify_dshiftr,
	gfc_simplify_lshift, gfc_simplify_maskl, gfc_simplify_maskr,
	gfc_simplify_merge_bits, gfc_simplify_rshift,
	gfc_simplify_shifta, gfc_simplify_shiftl, gfc_simplify_shiftr,
	gfc_resolve_dshift, gfc_resolve_mask, gfc_resolve_merge_bits,
	gfc_resolve_shift): New prototypes.
	* iresolve.c (gfc_resolve_dshift, gfc_resolve_mask,
	gfc_resolve_merge_bits, gfc_resolve_shift): New functions.
	* check.c (gfc_check_bge_bgt_ble_blt, gfc_check_dshift,
	gfc_check_mask, gfc_check_merge_bits, gfc_check_shift): New
	functions.
	* trans-intrinsic.c (gfc_conv_intrinsic_dshift,
	gfc_conv_intrinsic_bitcomp, gfc_conv_intrinsic_shift,
	gfc_conv_intrinsic_merge_bits, gfc_conv_intrinsic_mask): New
	functions.
	(gfc_conv_intrinsic_function): Call above static functions.
	* intrinsic.texi: Document new intrinsics.
	* simplify.c (gfc_simplify_bge, gfc_simplify_bgt, gfc_simplify_ble,
        gfc_simplify_blt, gfc_simplify_dshiftl, gfc_simplify_dshiftr,
        gfc_simplify_lshift, gfc_simplify_maskl, gfc_simplify_maskr,
        gfc_simplify_merge_bits, gfc_simplify_rshift, 
        gfc_simplify_shifta, gfc_simplify_shiftl, gfc_simplify_shiftr):
	New functions.

	* gfortran.dg/bit_comparison_1.F90: New test.
	* gfortran.dg/leadz_trailz_3.f90: New test.
	* gfortran.dg/masklr_2.F90: New test.
	* gfortran.dg/shiftalr_1.F90: New test.
	* gfortran.dg/merge_bits_2.F90: New test.
	* gfortran.dg/dshift_2.F90: New test.
	* gfortran.dg/bit_comparison_2.F90: New test.
	* gfortran.dg/masklr_1.F90: New test.
	* gfortran.dg/merge_bits_1.F90: New test.
	* gfortran.dg/dshift_1.F90: New test.
	* gfortran.dg/shiftalr_2.F90: New test.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@164021 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 54 insertions, 0 deletions

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 9aab4995f7c..e7a92da905e 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -825,6 +825,20 @@ gfc_resolve_dprod (gfc_expr *f, gfc_expr *a ATTRIBUTE_UNUSED,
 
 
 void
+gfc_resolve_dshift (gfc_expr *f, gfc_expr *i, gfc_expr *j ATTRIBUTE_UNUSED,
+		    gfc_expr *shift ATTRIBUTE_UNUSED)
+{
+  f->ts = i->ts;
+  if (f->value.function.isym->id == GFC_ISYM_DSHIFTL)
+    f->value.function.name = gfc_get_string ("dshiftl_i%d", f->ts.kind);
+  else if (f->value.function.isym->id == GFC_ISYM_DSHIFTR)
+    f->value.function.name = gfc_get_string ("dshiftr_i%d", f->ts.kind);
+  else
+    gcc_unreachable ();
+}
+
+
+void
 gfc_resolve_eoshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
 		     gfc_expr *boundary, gfc_expr *dim)
 {
@@ -1689,6 +1703,21 @@ gfc_resolve_mclock8 (gfc_expr *f)
 
 
 void
+gfc_resolve_mask (gfc_expr *f, gfc_expr *i ATTRIBUTE_UNUSED,
+		  gfc_expr *kind)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = kind ? mpz_get_si (kind->value.integer)
+		    : gfc_default_integer_kind;
+
+  if (f->value.function.isym->id == GFC_ISYM_MASKL)
+    f->value.function.name = gfc_get_string ("__maskl_i%d", f->ts.kind);
+  else
+    f->value.function.name = gfc_get_string ("__maskr_i%d", f->ts.kind);
+}
+
+
+void
 gfc_resolve_merge (gfc_expr *f, gfc_expr *tsource,
 		   gfc_expr *fsource ATTRIBUTE_UNUSED,
 		   gfc_expr *mask ATTRIBUTE_UNUSED)
@@ -1710,6 +1739,16 @@ gfc_resolve_merge (gfc_expr *f, gfc_expr *tsource,
 
 
 void
+gfc_resolve_merge_bits (gfc_expr *f, gfc_expr *i,
+			gfc_expr *j ATTRIBUTE_UNUSED,
+			gfc_expr *mask ATTRIBUTE_UNUSED)
+{
+  f->ts = i->ts;
+  f->value.function.name = gfc_get_string ("__merge_bits_i%d", i->ts.kind);
+}
+
+
+void
 gfc_resolve_min (gfc_expr *f, gfc_actual_arglist *args)
 {
   gfc_resolve_minmax ("__min_%c%d", f, args);
@@ -2158,6 +2197,21 @@ gfc_resolve_shape (gfc_expr *f, gfc_expr *array)
 
 
 void
+gfc_resolve_shift (gfc_expr *f, gfc_expr *i, gfc_expr *shift ATTRIBUTE_UNUSED)
+{
+  f->ts = i->ts;
+  if (f->value.function.isym->id == GFC_ISYM_SHIFTA)
+    f->value.function.name = gfc_get_string ("shifta_i%d", f->ts.kind);
+  else if (f->value.function.isym->id == GFC_ISYM_SHIFTL)
+    f->value.function.name = gfc_get_string ("shiftl_i%d", f->ts.kind);
+  else if (f->value.function.isym->id == GFC_ISYM_SHIFTR)
+    f->value.function.name = gfc_get_string ("shiftr_i%d", f->ts.kind);
+  else
+    gcc_unreachable ();
+}
+
+
+void
 gfc_resolve_sign (gfc_expr *f, gfc_expr *a, gfc_expr *b ATTRIBUTE_UNUSED)
 {
   f->ts = a->ts;