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

	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.

From-SVN: r164021

9 files changed, 1396 insertions, 52 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4faf639..c0551e15 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,36 @@
+2010-09-08  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	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.
+
 2010-09-08  Jakub Jelinek  <jakub@redhat.com>
 
 	* frontend-passes.c (optimize_code_node): Walk block chain by default.
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 308895d..51ea877 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -299,11 +299,11 @@ nonnegative_check (const char *arg, gfc_expr *expr)
 
 
 /* If expr2 is constant, then check that the value is less than
-   bit_size(expr1).  */
+   (less than or equal to, if 'or_equal' is true) bit_size(expr1).  */
 
 static gfc_try
 less_than_bitsize1 (const char *arg1, gfc_expr *expr1, const char *arg2,
-	       gfc_expr *expr2)
+		    gfc_expr *expr2, bool or_equal)
 {
   int i2, i3;
 
@@ -311,11 +311,24 @@ less_than_bitsize1 (const char *arg1, gfc_expr *expr1, const char *arg2,
     {
       gfc_extract_int (expr2, &i2);
       i3 = gfc_validate_kind (BT_INTEGER, expr1->ts.kind, false);
-      if (i2 >= gfc_integer_kinds[i3].bit_size)
+      if (or_equal)
 	{
-	  gfc_error ("'%s' at %L must be less than BIT_SIZE('%s')",
-		     arg2, &expr2->where, arg1);
-	  return FAILURE;
+	  if (i2 > gfc_integer_kinds[i3].bit_size)
+	    {
+	      gfc_error ("'%s' at %L must be less than "
+			 "or equal to BIT_SIZE('%s')",
+			 arg2, &expr2->where, arg1);
+	      return FAILURE;
+	    }
+	}
+      else
+	{
+	  if (i2 >= gfc_integer_kinds[i3].bit_size)
+	    {
+	      gfc_error ("'%s' at %L must be less than BIT_SIZE('%s')",
+			 arg2, &expr2->where, arg1);
+	      return FAILURE;
+	    }
 	}
     }
 
@@ -323,6 +336,31 @@ less_than_bitsize1 (const char *arg1, gfc_expr *expr1, const char *arg2,
 }
 
 
+/* If expr is constant, then check that the value is less than or equal
+   to the bit_size of the kind k.  */
+
+static gfc_try
+less_than_bitsizekind (const char *arg, gfc_expr *expr, int k)
+{
+  int i, val;
+
+  if (expr->expr_type != EXPR_CONSTANT)
+    return SUCCESS;
+ 
+  i = gfc_validate_kind (BT_INTEGER, k, false);
+  gfc_extract_int (expr, &val);
+
+  if (val > gfc_integer_kinds[i].bit_size)
+    {
+      gfc_error ("'%s' at %L must be less than or equal to the BIT_SIZE of "
+		 "INTEGER(KIND=%d)", arg, &expr->where, k);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
 /* If expr2 and expr3 are constants, then check that the value is less than
    or equal to bit_size(expr1).  */
 
@@ -929,6 +967,19 @@ gfc_check_bessel_n2 (gfc_expr *n1, gfc_expr *n2, gfc_expr *x)
 
 
 gfc_try
+gfc_check_bge_bgt_ble_blt (gfc_expr *i, gfc_expr *j)
+{
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (j, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
 gfc_check_bitfcn (gfc_expr *i, gfc_expr *pos)
 {
   if (type_check (i, 0, BT_INTEGER) == FAILURE)
@@ -940,7 +991,7 @@ gfc_check_bitfcn (gfc_expr *i, gfc_expr *pos)
   if (nonnegative_check ("pos", pos) == FAILURE)
     return FAILURE;
 
-  if (less_than_bitsize1 ("i", i, "pos", pos) == FAILURE)
+  if (less_than_bitsize1 ("i", i, "pos", pos, false) == FAILURE)
     return FAILURE;
 
   return SUCCESS;
@@ -1317,6 +1368,31 @@ gfc_check_dprod (gfc_expr *x, gfc_expr *y)
 
 
 gfc_try
+gfc_check_dshift (gfc_expr *i, gfc_expr *j, gfc_expr *shift)
+{
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (j, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (same_type_check (i, 0, j, 1) == FAILURE)
+    return FAILURE;
+
+  if (type_check (shift, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (nonnegative_check ("SHIFT", shift) == FAILURE)
+    return FAILURE;
+
+  if (less_than_bitsize1 ("I", i, "SHIFT", shift, true) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
 gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
 		   gfc_expr *dim)
 {
@@ -2356,6 +2432,32 @@ gfc_check_product_sum (gfc_actual_arglist *ap)
 /* For IANY, IALL and IPARITY.  */
 
 gfc_try
+gfc_check_mask (gfc_expr *i, gfc_expr *kind)
+{
+  int k;
+
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (nonnegative_check ("I", i) == FAILURE)
+    return FAILURE;
+
+  if (kind_check (kind, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (kind)
+    gfc_extract_int (kind, &k);
+  else
+    k = gfc_default_integer_kind;
+
+  if (less_than_bitsizekind ("I", i, k) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
 gfc_check_transf_bit_intrins (gfc_actual_arglist *ap)
 {
   if (ap->expr->ts.type != BT_INTEGER)
@@ -2390,6 +2492,28 @@ gfc_check_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask)
 
 
 gfc_try
+gfc_check_merge_bits (gfc_expr *i, gfc_expr *j, gfc_expr *mask)
+{
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (j, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (mask, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (same_type_check (i, 0, j, 1) == FAILURE)
+    return FAILURE;
+
+  if (same_type_check (i, 0, mask, 2) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
 gfc_check_move_alloc (gfc_expr *from, gfc_expr *to)
 {
   if (variable_check (from, 0) == FAILURE)
@@ -3118,6 +3242,25 @@ gfc_check_shape (gfc_expr *source)
 
 
 gfc_try
+gfc_check_shift (gfc_expr *i, gfc_expr *shift)
+{
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (shift, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (nonnegative_check ("SHIFT", shift) == FAILURE)
+    return FAILURE;
+
+  if (less_than_bitsize1 ("I", i, "SHIFT", shift, true) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
 gfc_check_sign (gfc_expr *a, gfc_expr *b)
 {
   if (int_or_real_check (a, 0) == FAILURE)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 06ef0c5..ef4612f 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -331,7 +331,11 @@ enum gfc_isym_id
   GFC_ISYM_ATAN,
   GFC_ISYM_ATAN2,
   GFC_ISYM_ATANH,
+  GFC_ISYM_BGE,
+  GFC_ISYM_BGT,
   GFC_ISYM_BIT_SIZE,
+  GFC_ISYM_BLE,
+  GFC_ISYM_BLT,
   GFC_ISYM_BTEST,
   GFC_ISYM_CEILING,
   GFC_ISYM_CHAR,
@@ -355,6 +359,8 @@ enum gfc_isym_id
   GFC_ISYM_DIM,
   GFC_ISYM_DOT_PRODUCT,
   GFC_ISYM_DPROD,
+  GFC_ISYM_DSHIFTL,
+  GFC_ISYM_DSHIFTR,
   GFC_ISYM_DTIME,
   GFC_ISYM_EOSHIFT,
   GFC_ISYM_EPSILON,
@@ -449,6 +455,8 @@ enum gfc_isym_id
   GFC_ISYM_LSTAT,
   GFC_ISYM_LTIME,
   GFC_ISYM_MALLOC,
+  GFC_ISYM_MASKL,
+  GFC_ISYM_MASKR,
   GFC_ISYM_MATMUL,
   GFC_ISYM_MAX,
   GFC_ISYM_MAXEXPONENT,
@@ -457,6 +465,7 @@ enum gfc_isym_id
   GFC_ISYM_MCLOCK,
   GFC_ISYM_MCLOCK8,
   GFC_ISYM_MERGE,
+  GFC_ISYM_MERGE_BITS,
   GFC_ISYM_MIN,
   GFC_ISYM_MINEXPONENT,
   GFC_ISYM_MINLOC,
@@ -500,6 +509,9 @@ enum gfc_isym_id
   GFC_ISYM_SECOND,
   GFC_ISYM_SET_EXPONENT,
   GFC_ISYM_SHAPE,
+  GFC_ISYM_SHIFTA,
+  GFC_ISYM_SHIFTL,
+  GFC_ISYM_SHIFTR,
   GFC_ISYM_SIGN,
   GFC_ISYM_SIGNAL,
   GFC_ISYM_SI_KIND,
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index f36484a..1a1d828 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -1392,12 +1392,40 @@ add_functions (void)
 
   make_generic ("bessel_yn", GFC_ISYM_YN, GFC_STD_F2008);
 
+  add_sym_2 ("bge", GFC_ISYM_BGE, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_LOGICAL, dl, GFC_STD_F2008,
+	     gfc_check_bge_bgt_ble_blt, gfc_simplify_bge, NULL,
+	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("bge", GFC_ISYM_BGE, GFC_STD_F2008);
+
+  add_sym_2 ("bgt", GFC_ISYM_BGT, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_LOGICAL, dl, GFC_STD_F2008,
+	     gfc_check_bge_bgt_ble_blt, gfc_simplify_bgt, NULL,
+	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("bgt", GFC_ISYM_BGT, GFC_STD_F2008);
+
   add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
 	     gfc_check_i, gfc_simplify_bit_size, NULL,
 	     i, BT_INTEGER, di, REQUIRED);
 
   make_generic ("bit_size", GFC_ISYM_BIT_SIZE, GFC_STD_F95);
 
+  add_sym_2 ("ble", GFC_ISYM_BLE, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_LOGICAL, dl, GFC_STD_F2008,
+	     gfc_check_bge_bgt_ble_blt, gfc_simplify_ble, NULL,
+	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("ble", GFC_ISYM_BLE, GFC_STD_F2008);
+
+  add_sym_2 ("blt", GFC_ISYM_BLT, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_LOGICAL, dl, GFC_STD_F2008,
+	     gfc_check_bge_bgt_ble_blt, gfc_simplify_blt, NULL,
+	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("blt", GFC_ISYM_BLT, GFC_STD_F2008);
+
   add_sym_2 ("btest", GFC_ISYM_BTEST, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
 	     gfc_check_bitfcn, gfc_simplify_btest, gfc_resolve_btest,
 	     i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
@@ -1561,10 +1589,28 @@ add_functions (void)
 
   make_generic ("dreal", GFC_ISYM_REAL, GFC_STD_GNU);
 
+  add_sym_3 ("dshiftl", GFC_ISYM_DSHIFTL, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_dshift, gfc_simplify_dshiftl, gfc_resolve_dshift,
+	     i, BT_INTEGER, di, REQUIRED,
+	     j, BT_INTEGER, di, REQUIRED,
+	     sh, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("dshiftl", GFC_ISYM_DSHIFTL, GFC_STD_F2008);
+
+  add_sym_3 ("dshiftr", GFC_ISYM_DSHIFTR, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_dshift, gfc_simplify_dshiftr, gfc_resolve_dshift,
+	     i, BT_INTEGER, di, REQUIRED,
+	     j, BT_INTEGER, di, REQUIRED,
+	     sh, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("dshiftr", GFC_ISYM_DSHIFTR, GFC_STD_F2008);
+
   add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
 	     gfc_check_eoshift, NULL, gfc_resolve_eoshift,
-	     ar, BT_REAL, dr, 0, sh, BT_INTEGER, ii, REQUIRED,
-	     bd, BT_REAL, dr, 1, dm, BT_INTEGER, ii, OPTIONAL);
+	     ar, BT_REAL, dr, REQUIRED, sh, BT_INTEGER, ii, REQUIRED,
+	     bd, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL);
 
   make_generic ("eoshift", GFC_ISYM_EOSHIFT, GFC_STD_F95);
 
@@ -1940,14 +1986,16 @@ add_functions (void)
 
   make_generic ("isnan", GFC_ISYM_ISNAN, GFC_STD_GNU);
 
-  add_sym_2 ("rshift", GFC_ISYM_RSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
-	     gfc_check_ishft, NULL, gfc_resolve_rshift,
+  add_sym_2 ("rshift", GFC_ISYM_RSHIFT, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_GNU,
+	     gfc_check_ishft, gfc_simplify_rshift, gfc_resolve_rshift,
 	     i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
 
   make_generic ("rshift", GFC_ISYM_RSHIFT, GFC_STD_GNU);
 
-  add_sym_2 ("lshift", GFC_ISYM_LSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
-	     gfc_check_ishft, NULL, gfc_resolve_lshift,
+  add_sym_2 ("lshift", GFC_ISYM_LSHIFT, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_GNU,
+	     gfc_check_ishft, gfc_simplify_lshift, gfc_resolve_lshift,
 	     i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
 
   make_generic ("lshift", GFC_ISYM_LSHIFT, GFC_STD_GNU);
@@ -2120,6 +2168,22 @@ add_functions (void)
 
   make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
 
+  add_sym_2 ("maskl", GFC_ISYM_MASKL, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_mask, gfc_simplify_maskl, gfc_resolve_mask,
+	     i, BT_INTEGER, di, REQUIRED,
+	     kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("maskl", GFC_ISYM_MASKL, GFC_STD_F2008);
+
+  add_sym_2 ("maskr", GFC_ISYM_MASKR, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_mask, gfc_simplify_maskr, gfc_resolve_mask,
+	     i, BT_INTEGER, di, REQUIRED,
+	     kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("maskr", GFC_ISYM_MASKR, GFC_STD_F2008);
+
   add_sym_2 ("matmul", GFC_ISYM_MATMUL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
 	     gfc_check_matmul, gfc_simplify_matmul, gfc_resolve_matmul,
 	     ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
@@ -2192,6 +2256,16 @@ add_functions (void)
 
   make_generic ("merge", GFC_ISYM_MERGE, GFC_STD_F95);
 
+  add_sym_3 ("merge_bits", GFC_ISYM_MERGE_BITS, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_merge_bits, gfc_simplify_merge_bits,
+	     gfc_resolve_merge_bits,
+	     i, BT_INTEGER, di, REQUIRED,
+	     j, BT_INTEGER, di, REQUIRED,
+	     msk, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("merge_bits", GFC_ISYM_MERGE_BITS, GFC_STD_F2008);
+
   /* Note: amin0 is equivalent to real(min), min1 is equivalent to
      int(min).  */
 
@@ -2491,6 +2565,30 @@ add_functions (void)
 
   make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
 
+  add_sym_2 ("shifta", GFC_ISYM_SHIFTA, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_shift, gfc_simplify_shifta, gfc_resolve_shift,
+	     i, BT_INTEGER, di, REQUIRED,
+	     sh, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("shifta", GFC_ISYM_SHIFTA, GFC_STD_F2008);
+
+  add_sym_2 ("shiftl", GFC_ISYM_SHIFTL, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_shift, gfc_simplify_shiftl, gfc_resolve_shift,
+	     i, BT_INTEGER, di, REQUIRED,
+	     sh, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("shiftl", GFC_ISYM_SHIFTL, GFC_STD_F2008);
+
+  add_sym_2 ("shiftr", GFC_ISYM_SHIFTR, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_shift, gfc_simplify_shiftr, gfc_resolve_shift,
+	     i, BT_INTEGER, di, REQUIRED,
+	     sh, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("shiftr", GFC_ISYM_SHIFTR, GFC_STD_F2008);
+
   add_sym_2 ("sign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
 	     gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
 	     a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 178dbf7..9818f7a 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -41,6 +41,7 @@ gfc_try gfc_check_atan_2 (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_atan2 (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_besn (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_bessel_n2 (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_bge_bgt_ble_blt (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_bitfcn (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_char (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_chdir (gfc_expr *);
@@ -56,6 +57,7 @@ gfc_try gfc_check_dble (gfc_expr *);
 gfc_try gfc_check_digits (gfc_expr *);
 gfc_try gfc_check_dot_product (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_dprod (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_dshift (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_try gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_try gfc_check_dtime_etime (gfc_expr *);
 gfc_try gfc_check_fgetputc (gfc_expr *, gfc_expr *);
@@ -102,8 +104,10 @@ gfc_try gfc_check_min_max_integer (gfc_actual_arglist *);
 gfc_try gfc_check_min_max_real (gfc_actual_arglist *);
 gfc_try gfc_check_min_max_double (gfc_actual_arglist *);
 gfc_try gfc_check_malloc (gfc_expr *);
+gfc_try gfc_check_mask (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_matmul (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_merge (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_merge_bits (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_try gfc_check_minloc_maxloc (gfc_actual_arglist *);
 gfc_try gfc_check_minval_maxval (gfc_actual_arglist *);
 gfc_try gfc_check_nearest (gfc_expr *, gfc_expr *);
@@ -132,6 +136,7 @@ gfc_try gfc_check_selected_int_kind (gfc_expr *);
 gfc_try gfc_check_selected_real_kind (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_try gfc_check_set_exponent (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_shape (gfc_expr *);
+gfc_try gfc_check_shift (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_size (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_try gfc_check_sign (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_signal (gfc_expr *, gfc_expr *);
@@ -232,7 +237,11 @@ gfc_expr *gfc_simplify_bessel_y0 (gfc_expr *);
 gfc_expr *gfc_simplify_bessel_y1 (gfc_expr *);
 gfc_expr *gfc_simplify_bessel_yn (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_bessel_yn2 (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_bge (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_bgt (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_bit_size (gfc_expr *);
+gfc_expr *gfc_simplify_ble (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_blt (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_btest (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_ceiling (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_char (gfc_expr *, gfc_expr *);
@@ -248,6 +257,8 @@ gfc_expr *gfc_simplify_digits (gfc_expr *);
 gfc_expr *gfc_simplify_dim (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_dprod (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_dot_product (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_dshiftl (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_dshiftr (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_epsilon (gfc_expr *);
 gfc_expr *gfc_simplify_erf (gfc_expr *);
 gfc_expr *gfc_simplify_erfc (gfc_expr *);
@@ -298,8 +309,12 @@ gfc_expr *gfc_simplify_llt (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_log (gfc_expr *);
 gfc_expr *gfc_simplify_log10 (gfc_expr *);
 gfc_expr *gfc_simplify_logical (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_lshift (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_matmul (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_maskl (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_maskr (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_merge (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_merge_bits (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_min (gfc_expr *);
 gfc_expr *gfc_simplify_minval (gfc_expr *, gfc_expr*, gfc_expr*);
 gfc_expr *gfc_simplify_max (gfc_expr *);
@@ -333,6 +348,7 @@ gfc_expr *gfc_simplify_repeat (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_reshape (gfc_expr *, gfc_expr *, gfc_expr *,
 				gfc_expr *);
 gfc_expr *gfc_simplify_rrspacing (gfc_expr *);
+gfc_expr *gfc_simplify_rshift (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_scale (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_selected_char_kind (gfc_expr *);
@@ -341,6 +357,9 @@ gfc_expr *gfc_simplify_selected_real_kind (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_set_exponent (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_sign (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_shape (gfc_expr *);
+gfc_expr *gfc_simplify_shifta (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_shiftl (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_shiftr (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_sin (gfc_expr *);
 gfc_expr *gfc_simplify_sinh (gfc_expr *);
 gfc_expr *gfc_simplify_size (gfc_expr *, gfc_expr *, gfc_expr *);
@@ -409,6 +428,7 @@ void gfc_resolve_dble (gfc_expr *, gfc_expr *);
 void gfc_resolve_dim (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_dot_product (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_dprod (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_dshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_dtime_sub (gfc_code *);
 void gfc_resolve_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
 			  gfc_expr *);
@@ -478,7 +498,9 @@ void gfc_resolve_maxloc (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_maxval (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_mclock (gfc_expr *);
 void gfc_resolve_mclock8 (gfc_expr *);
+void gfc_resolve_mask (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_merge (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_merge_bits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_min (gfc_expr *, gfc_actual_arglist *);
 void gfc_resolve_minloc (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_minval (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
@@ -506,6 +528,7 @@ void gfc_resolve_second_sub (gfc_code *);
 void gfc_resolve_secnds (gfc_expr *, gfc_expr *);
 void gfc_resolve_set_exponent (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_shape (gfc_expr *, gfc_expr *);
+void gfc_resolve_shift (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_sign (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_signal (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_sin (gfc_expr *, gfc_expr *);
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 4d10193..65b3c05 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -67,7 +67,11 @@ Some basic guidelines for editing this document:
 * @code{BESSEL_Y0}:     BESSEL_Y0, Bessel function of the second kind of order 0
 * @code{BESSEL_Y1}:     BESSEL_Y1, Bessel function of the second kind of order 1
 * @code{BESSEL_YN}:     BESSEL_YN, Bessel function of the second kind
+* @code{BGE}:           BGE,       Bitwise greater than or equal to
+* @code{BGT}:           BGT,       Bitwise greater than
 * @code{BIT_SIZE}:      BIT_SIZE,  Bit size inquiry function
+* @code{BLE}:           BLE,       Bitwise less than or equal to
+* @code{BLT}:           BLT,       Bitwise less than
 * @code{BTEST}:         BTEST,     Bit test function
 * @code{C_ASSOCIATED}:  C_ASSOCIATED, Status of a C pointer
 * @code{C_F_POINTER}:   C_F_POINTER, Convert C into Fortran pointer
@@ -97,6 +101,8 @@ Some basic guidelines for editing this document:
 * @code{DOT_PRODUCT}:   DOT_PRODUCT, Dot product function
 * @code{DPROD}:         DPROD,     Double product function
 * @code{DREAL}:         DREAL,     Double real part function
+* @code{DSHIFTL}:       DSHIFTL,   Combined left shift
+* @code{DSHIFTR}:       DSHIFTR,   Combined right shift
 * @code{DTIME}:         DTIME,     Execution time subroutine (or function)
 * @code{EOSHIFT}:       EOSHIFT,   End-off shift elements of an array
 * @code{EPSILON}:       EPSILON,   Epsilon function
@@ -188,6 +194,8 @@ Some basic guidelines for editing this document:
 * @code{LSTAT}:         LSTAT,     Get file status
 * @code{LTIME}:         LTIME,     Convert time to local time info
 * @code{MALLOC}:        MALLOC,    Dynamic memory allocation function
+* @code{MASKL}:         MASKL,     Left justified mask
+* @code{MASKR}:         MASKR,     Right justified mask
 * @code{MATMUL}:        MATMUL,    matrix multiplication
 * @code{MAX}:           MAX,       Maximum value of an argument list
 * @code{MAXEXPONENT}:   MAXEXPONENT, Maximum exponent of a real kind
@@ -196,6 +204,7 @@ Some basic guidelines for editing this document:
 * @code{MCLOCK}:        MCLOCK,    Time function
 * @code{MCLOCK8}:       MCLOCK8,   Time function (64-bit)
 * @code{MERGE}:         MERGE,     Merge arrays
+* @code{MERGE_BITS}:    MERGE_BITS, Merge of bits under mask
 * @code{MIN}:           MIN,       Minimum value of an argument list
 * @code{MINEXPONENT}:   MINEXPONENT, Minimum exponent of a real kind
 * @code{MINLOC}:        MINLOC,    Location of the minimum value within an array
@@ -242,6 +251,9 @@ Some basic guidelines for editing this document:
 * @code{SELECTED_REAL_KIND}: SELECTED_REAL_KIND,  Choose real kind
 * @code{SET_EXPONENT}:  SET_EXPONENT, Set the exponent of the model
 * @code{SHAPE}:         SHAPE,     Determine the shape of an array
+* @code{SHIFTA}:        SHIFTA,    Right shift with fill
+* @code{SHIFTL}:        SHIFTL,    Left shift
+* @code{SHIFTR}:        SHIFTR,    Right shift
 * @code{SIGN}:          SIGN,      Sign copying function
 * @code{SIGNAL}:        SIGNAL,    Signal handling subroutine (or function)
 * @code{SIN}:           SIN,       Sine function
@@ -1851,6 +1863,75 @@ end program test_besyn
 
 
 
+@node BGE
+@section @code{BGE} --- Bitwise greater than or equal to
+@fnindex BGE
+@cindex bitwise comparison
+
+@table @asis
+@item @emph{Description}:
+Determines whether an integral is a bitwise greater than or equal to
+another.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = BGE(I, J)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of @code{INTEGER} type.
+@item @var{J} @tab Shall be of @code{INTEGER} type, and of the same kind
+as @var{I}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{LOGICAL} and of the default kind.
+
+@item @emph{See also}:
+@ref{BGT}, @ref{BLE}, @ref{BLT}
+@end table
+
+
+
+@node BGT
+@section @code{BGT} --- Bitwise greater than
+@fnindex BGT
+@cindex bitwise comparison
+
+@table @asis
+@item @emph{Description}:
+Determines whether an integral is a bitwise greater than another.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = BGT(I, J)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of @code{INTEGER} type.
+@item @var{J} @tab Shall be of @code{INTEGER} type, and of the same kind
+as @var{I}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{LOGICAL} and of the default kind.
+
+@item @emph{See also}:
+@ref{BGE}, @ref{BLE}, @ref{BLT}
+@end table
+
+
+
 @node BIT_SIZE
 @section @code{BIT_SIZE} --- Bit size inquiry function
 @fnindex BIT_SIZE
@@ -1893,6 +1974,75 @@ end program test_bit_size
 
 
 
+@node BLE
+@section @code{BLE} --- Bitwise less than or equal to
+@fnindex BLE
+@cindex bitwise comparison
+
+@table @asis
+@item @emph{Description}:
+Determines whether an integral is a bitwise less than or equal to
+another.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = BLE(I, J)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of @code{INTEGER} type.
+@item @var{J} @tab Shall be of @code{INTEGER} type, and of the same kind
+as @var{I}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{LOGICAL} and of the default kind.
+
+@item @emph{See also}:
+@ref{BGT}, @ref{BGE}, @ref{BLT}
+@end table
+
+
+
+@node BLT
+@section @code{BLT} --- Bitwise less than
+@fnindex BLT
+@cindex bitwise comparison
+
+@table @asis
+@item @emph{Description}:
+Determines whether an integral is a bitwise less than another.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = BLT(I, J)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of @code{INTEGER} type.
+@item @var{J} @tab Shall be of @code{INTEGER} type, and of the same kind
+as @var{I}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{LOGICAL} and of the default kind.
+
+@item @emph{See also}:
+@ref{BGE}, @ref{BGT}, @ref{BLE}
+@end table
+
+
+
 @node BTEST
 @section @code{BTEST} --- Bit test function
 @fnindex BTEST
@@ -3424,6 +3574,86 @@ end program test_dreal
 
 
 
+@node DSHIFTL
+@section @code{DSHIFTL} --- Combined left shift
+@fnindex DSHIFTL
+@cindex left shift, combined
+@cindex shift, left
+
+@table @asis
+@item @emph{Description}:
+@code{DSHIFTL(I, J, SHIFT)} combines bits of @var{I} and @var{J}. The
+rightmost @var{SHIFT} bits of the result are the leftmost @var{SHIFT}
+bits of @var{J}, and the remaining bits are the rightmost bits of
+@var{I}.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = DSHIFTL(I, J, SHIFT)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of type @code{INTEGER}.
+@item @var{J} @tab Shall be of type @code{INTEGER}, and of the same kind
+as @var{I}.
+@item @var{SHIFT} @tab Shall be of type @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value has same type and kind as @var{I}.
+
+@item @emph{See also}:
+@ref{DSHIFTR}
+
+@end table
+
+
+
+@node DSHIFTR
+@section @code{DSHIFTR} --- Combined right shift
+@fnindex DSHIFTR
+@cindex right shift, combined
+@cindex shift, right
+
+@table @asis
+@item @emph{Description}:
+@code{DSHIFTR(I, J, SHIFT)} combines bits of @var{I} and @var{J}. The
+leftmost @var{SHIFT} bits of the result are the rightmost @var{SHIFT}
+bits of @var{I}, and the remaining bits are the leftmost bits of
+@var{J}.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = DSHIFTR(I, J, SHIFT)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of type @code{INTEGER}.
+@item @var{J} @tab Shall be of type @code{INTEGER}, and of the same kind
+as @var{I}.
+@item @var{SHIFT} @tab Shall be of type @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value has same type and kind as @var{I}.
+
+@item @emph{See also}:
+@ref{DSHIFTL}
+
+@end table
+
+
+
 @node DTIME
 @section @code{DTIME} --- Execution time subroutine (or function)
 @fnindex DTIME
@@ -7644,7 +7874,8 @@ Bits shifted out from the left end are lost; zeros are shifted in from
 the opposite end.
 
 This function has been superseded by the @code{ISHFT} intrinsic, which
-is standard in Fortran 95 and later.
+is standard in Fortran 95 and later, and the @code{SHIFTL} intrinsic,
+which is standard in Fortran 2008 and later.
 
 @item @emph{Standard}:
 GNU extension
@@ -7666,7 +7897,8 @@ The return value is of type @code{INTEGER} and of the same kind as
 @var{I}.
 
 @item @emph{See also}:
-@ref{ISHFT}, @ref{ISHFTC}, @ref{RSHIFT}
+@ref{ISHFT}, @ref{ISHFTC}, @ref{RSHIFT}, @ref{SHIFTA}, @ref{SHIFTL},
+@ref{SHIFTR}
 
 @end table
 
@@ -7829,6 +8061,80 @@ end program test_malloc
 
 
 
+@node MASKL
+@section @code{MASKL} --- Left justified mask
+@fnindex MASKL
+@cindex mask, left justified
+
+@table @asis
+@item @emph{Description}:
+@code{MASKL(I[, KIND])} has its leftmost @var{I} bits set to 1, and the
+remaining bits set to 0.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = MASKL(I[, KIND])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of type @code{INTEGER}.
+@item @var{KIND} @tab Shall be a scalar constant expression of type
+@code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER}. If @var{KIND} is present, it
+specifies the kind value of the return type; otherwise, it is of the
+default integer kind.
+
+@item @emph{See also}:
+@ref{MASKR}
+@end table
+
+
+
+@node MASKR
+@section @code{MASKR} --- Right justified mask
+@fnindex MASKR
+@cindex mask, right justified
+
+@table @asis
+@item @emph{Description}:
+@code{MASKL(I[, KIND])} has its rightmost @var{I} bits set to 1, and the
+remaining bits set to 0.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = MASKR(I[, KIND])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of type @code{INTEGER}.
+@item @var{KIND} @tab Shall be a scalar constant expression of type
+@code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER}. If @var{KIND} is present, it
+specifies the kind value of the return type; otherwise, it is of the
+default integer kind.
+
+@item @emph{See also}:
+@ref{MASKL}
+@end table
+
+
+
 @node MATMUL
 @section @code{MATMUL} --- matrix multiplication
 @fnindex MATMUL
@@ -8190,6 +8496,43 @@ The result is of the same type and type parameters as @var{TSOURCE}.
 
 
 
+@node MERGE_BITS
+@section @code{MERGE_BITS} --- Merge of bits under mask
+@fnindex MERGE_BITS
+@cindex bits, merge
+
+@table @asis
+@item @emph{Description}:
+@code{MERGE_BITS(I, J, MASK)} merges the bits of @var{I} and @var{J}
+as determined by the mask.  The i-th bit of the result is equal to the 
+i-th bit of @var{I} if the i-th bit of @var{MASK} is 1; it is equal to
+the i-th bit of @var{J} otherwise.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = MERGE_BITS(I, J, MASK)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I}    @tab Shall be of type @code{INTEGER}.
+@item @var{J}    @tab Shall be of type @code{INTEGER} and of the same
+kind as @var{I}.
+@item @var{MASK} @tab Shall be of type @code{INTEGER} and of the same
+kind as @var{I}.
+@end multitable
+
+@item @emph{Return value}:
+The result is of the same type and kind as @var{I}.
+
+@end table
+
+
+
 @node MIN
 @section @code{MIN} --- Minimum value of an argument list
 @fnindex MIN
@@ -9895,8 +10238,8 @@ Bits shifted out from the right end are lost. The fill is arithmetic: the
 bits shifted in from the left end are equal to the leftmost bit, which in
 two's complement representation is the sign bit.
 
-This function has been superseded by the @code{ISHFT} intrinsic, which
-is standard in Fortran 95 and later.
+This function has been superseded by the @code{SHIFTA} intrinsic, which
+is standard in Fortran 2008 and later.
 
 @item @emph{Standard}:
 GNU extension
@@ -9918,7 +10261,8 @@ The return value is of type @code{INTEGER} and of the same kind as
 @var{I}.
 
 @item @emph{See also}:
-@ref{ISHFT}, @ref{ISHFTC}, @ref{LSHIFT}
+@ref{ISHFT}, @ref{ISHFTC}, @ref{LSHIFT}, @ref{SHIFTA}, @ref{SHIFTR},
+@ref{SHIFTL}
 
 @end table
 
@@ -10415,6 +10759,124 @@ END PROGRAM
 
 
 
+@node SHIFTA
+@section @code{SHIFTA} --- Right shift with fill
+@fnindex SHIFTA
+@cindex bits, shift right
+@cindex shift, right with fill
+
+@table @asis
+@item @emph{Description}:
+@code{SHIFTA} returns a value corresponding to @var{I} with all of the
+bits shifted right by @var{SHIFT} places.  If the absolute value of
+@var{SHIFT} is greater than @code{BIT_SIZE(I)}, the value is undefined.
+Bits shifted out from the right end are lost. The fill is arithmetic: the
+bits shifted in from the left end are equal to the leftmost bit, which in
+two's complement representation is the sign bit.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = SHIFTA(I, SHIFT)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be @code{INTEGER}.
+@item @var{SHIFT} @tab The type shall be @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of the same kind as
+@var{I}.
+
+@item @emph{See also}:
+@ref{SHIFTL}, @ref{SHIFTR}
+@end table
+
+
+
+@node SHIFTL
+@section @code{SHIFTL} --- Left shift
+@fnindex SHIFTL
+@cindex bits, shift left
+@cindex shift, left
+
+@table @asis
+@item @emph{Description}:
+@code{SHIFTL} returns a value corresponding to @var{I} with all of the
+bits shifted left by @var{SHIFT} places.  If the absolute value of
+@var{SHIFT} is greater than @code{BIT_SIZE(I)}, the value is undefined.
+Bits shifted out from the left end are lost, and bits shifted in from
+the right end are set to 0.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = SHIFTL(I, SHIFT)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be @code{INTEGER}.
+@item @var{SHIFT} @tab The type shall be @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of the same kind as
+@var{I}.
+
+@item @emph{See also}:
+@ref{SHIFTA}, @ref{SHIFTR}
+@end table
+
+
+
+@node SHIFTR
+@section @code{SHIFTR} --- Right shift
+@fnindex SHIFTR
+@cindex bits, shift right
+@cindex shift, right
+
+@table @asis
+@item @emph{Description}:
+@code{SHIFTR} returns a value corresponding to @var{I} with all of the
+bits shifted right by @var{SHIFT} places.  If the absolute value of
+@var{SHIFT} is greater than @code{BIT_SIZE(I)}, the value is undefined.
+Bits shifted out from the right end are lost, and bits shifted in from
+the left end are set to 0.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = SHIFTR(I, SHIFT)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be @code{INTEGER}.
+@item @var{SHIFT} @tab The type shall be @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of the same kind as
+@var{I}.
+
+@item @emph{See also}:
+@ref{SHIFTA}, @ref{SHIFTL}
+@end table
+
+
+
 @node SIGN
 @section @code{SIGN} --- Sign copying function
 @fnindex SIGN
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 9aab499..e7a92da 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;
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 248df6c..a7b678f 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -1464,6 +1464,74 @@ gfc_simplify_btest (gfc_expr *e, gfc_expr *bit)
 }
 
 
+static int
+compare_bitwise (gfc_expr *i, gfc_expr *j)
+{
+  mpz_t x, y;
+  int k, res;
+
+  gcc_assert (i->ts.type == BT_INTEGER);
+  gcc_assert (j->ts.type == BT_INTEGER);
+
+  mpz_init_set (x, i->value.integer);
+  k = gfc_validate_kind (i->ts.type, i->ts.kind, false);
+  convert_mpz_to_unsigned (x, gfc_integer_kinds[k].bit_size);
+
+  mpz_init_set (y, j->value.integer);
+  k = gfc_validate_kind (j->ts.type, j->ts.kind, false);
+  convert_mpz_to_unsigned (y, gfc_integer_kinds[k].bit_size);
+
+  res = mpz_cmp (x, y);
+  mpz_clear (x);
+  mpz_clear (y);
+  return res;
+}
+
+
+gfc_expr *
+gfc_simplify_bge (gfc_expr *i, gfc_expr *j)
+{
+  if (i->expr_type != EXPR_CONSTANT || j->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  return gfc_get_logical_expr (gfc_default_logical_kind, &i->where,
+			       compare_bitwise (i, j) >= 0);
+}
+
+
+gfc_expr *
+gfc_simplify_bgt (gfc_expr *i, gfc_expr *j)
+{
+  if (i->expr_type != EXPR_CONSTANT || j->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  return gfc_get_logical_expr (gfc_default_logical_kind, &i->where,
+			       compare_bitwise (i, j) > 0);
+}
+
+
+gfc_expr *
+gfc_simplify_ble (gfc_expr *i, gfc_expr *j)
+{
+  if (i->expr_type != EXPR_CONSTANT || j->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  return gfc_get_logical_expr (gfc_default_logical_kind, &i->where,
+			       compare_bitwise (i, j) <= 0);
+}
+
+
+gfc_expr *
+gfc_simplify_blt (gfc_expr *i, gfc_expr *j)
+{
+  if (i->expr_type != EXPR_CONSTANT || j->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  return gfc_get_logical_expr (gfc_default_logical_kind, &i->where,
+			       compare_bitwise (i, j) < 0);
+}
+
+
 gfc_expr *
 gfc_simplify_ceiling (gfc_expr *e, gfc_expr *k)
 {
@@ -1814,6 +1882,64 @@ gfc_simplify_dprod (gfc_expr *x, gfc_expr *y)
 }
 
 
+static gfc_expr *
+simplify_dshift (gfc_expr *arg1, gfc_expr *arg2, gfc_expr *shiftarg,
+		      bool right)
+{
+  gfc_expr *result;
+  int i, k, size, shift;
+
+  if (arg1->expr_type != EXPR_CONSTANT || arg2->expr_type != EXPR_CONSTANT
+      || shiftarg->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  k = gfc_validate_kind (BT_INTEGER, arg1->ts.kind, false);
+  size = gfc_integer_kinds[k].bit_size;
+
+  if (gfc_extract_int (shiftarg, &shift) != NULL)
+    {
+      gfc_error ("Invalid SHIFT argument of DSHIFTL at %L", &shiftarg->where);
+      return &gfc_bad_expr;
+    }
+
+  gcc_assert (shift >= 0 && shift <= size);
+
+  /* DSHIFTR(I,J,SHIFT) = DSHIFTL(I,J,SIZE-SHIFT).  */
+  if (right)
+    shift = size - shift;
+
+  result = gfc_get_constant_expr (BT_INTEGER, arg1->ts.kind, &arg1->where);
+  mpz_set_ui (result->value.integer, 0);
+
+  for (i = 0; i < shift; i++)
+    if (mpz_tstbit (arg2->value.integer, size - shift + i))
+      mpz_setbit (result->value.integer, i);
+
+  for (i = 0; i < size - shift; i++)
+    if (mpz_tstbit (arg1->value.integer, i))
+      mpz_setbit (result->value.integer, shift + i);
+
+  /* Convert to a signed value.  */
+  convert_mpz_to_signed (result->value.integer, size);
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_dshiftr (gfc_expr *arg1, gfc_expr *arg2, gfc_expr *shiftarg)
+{
+  return simplify_dshift (arg1, arg2, shiftarg, true);
+}
+
+
+gfc_expr *
+gfc_simplify_dshiftl (gfc_expr *arg1, gfc_expr *arg2, gfc_expr *shiftarg)
+{
+  return simplify_dshift (arg1, arg2, shiftarg, false);
+}
+
+
 gfc_expr *
 gfc_simplify_erf (gfc_expr *x)
 {
@@ -2776,56 +2902,75 @@ gfc_simplify_isnan (gfc_expr *x)
 }
 
 
-gfc_expr *
-gfc_simplify_ishft (gfc_expr *e, gfc_expr *s)
+/* Performs a shift on its first argument.  Depending on the last
+   argument, the shift can be arithmetic, i.e. with filling from the
+   left like in the SHIFTA intrinsic.  */
+static gfc_expr *
+simplify_shift (gfc_expr *e, gfc_expr *s, const char *name,
+		bool arithmetic, int direction)
 {
   gfc_expr *result;
-  int shift, ashift, isize, k, *bits, i;
+  int ashift, *bits, i, k, bitsize, shift;
 
   if (e->expr_type != EXPR_CONSTANT || s->expr_type != EXPR_CONSTANT)
     return NULL;
-
   if (gfc_extract_int (s, &shift) != NULL)
     {
-      gfc_error ("Invalid second argument of ISHFT at %L", &s->where);
+      gfc_error ("Invalid second argument of %s at %L", name, &s->where);
       return &gfc_bad_expr;
     }
 
   k = gfc_validate_kind (BT_INTEGER, e->ts.kind, false);
+  bitsize = gfc_integer_kinds[k].bit_size;
 
-  isize = gfc_integer_kinds[k].bit_size;
+  result = gfc_get_constant_expr (e->ts.type, e->ts.kind, &e->where);
 
-  if (shift >= 0)
-    ashift = shift;
-  else
-    ashift = -shift;
+  if (shift == 0)
+    {
+      mpz_set (result->value.integer, e->value.integer);
+      return result;
+    }
 
-  if (ashift > isize)
+  if (direction > 0 && shift < 0)
     {
-      gfc_error ("Magnitude of second argument of ISHFT exceeds bit size "
-		 "at %L", &s->where);
+      /* Left shift, as in SHIFTL.  */
+      gfc_error ("Second argument of %s is negative at %L", name, &e->where);
       return &gfc_bad_expr;
     }
+  else if (direction < 0)
+    {
+      /* Right shift, as in SHIFTR or SHIFTA.  */
+      if (shift < 0)
+	{
+	  gfc_error ("Second argument of %s is negative at %L",
+		     name, &e->where);
+	  return &gfc_bad_expr;
+	}
 
-  result = gfc_get_constant_expr (e->ts.type, e->ts.kind, &e->where);
+      shift = -shift;
+    }
 
-  if (shift == 0)
+  ashift = (shift >= 0 ? shift : -shift);
+
+  if (ashift > bitsize)
     {
-      mpz_set (result->value.integer, e->value.integer);
-      return range_check (result, "ISHFT");
+      gfc_error ("Magnitude of second argument of %s exceeds bit size "
+		 "at %L", name, &e->where);
+      return &gfc_bad_expr;
     }
-  
-  bits = XCNEWVEC (int, isize);
 
-  for (i = 0; i < isize; i++)
+  bits = XCNEWVEC (int, bitsize);
+
+  for (i = 0; i < bitsize; i++)
     bits[i] = mpz_tstbit (e->value.integer, i);
 
   if (shift > 0)
     {
+      /* Left shift.  */
       for (i = 0; i < shift; i++)
 	mpz_clrbit (result->value.integer, i);
 
-      for (i = 0; i < isize - shift; i++)
+      for (i = 0; i < bitsize - shift; i++)
 	{
 	  if (bits[i] == 0)
 	    mpz_clrbit (result->value.integer, i + shift);
@@ -2835,10 +2980,15 @@ gfc_simplify_ishft (gfc_expr *e, gfc_expr *s)
     }
   else
     {
-      for (i = isize - 1; i >= isize - ashift; i--)
-	mpz_clrbit (result->value.integer, i);
+      /* Right shift.  */
+      if (arithmetic && bits[bitsize - 1])
+	for (i = bitsize - 1; i >= bitsize - ashift; i--)
+	  mpz_setbit (result->value.integer, i);
+      else
+	for (i = bitsize - 1; i >= bitsize - ashift; i--)
+	  mpz_clrbit (result->value.integer, i);
 
-      for (i = isize - 1; i >= ashift; i--)
+      for (i = bitsize - 1; i >= ashift; i--)
 	{
 	  if (bits[i] == 0)
 	    mpz_clrbit (result->value.integer, i - ashift);
@@ -2847,14 +2997,56 @@ gfc_simplify_ishft (gfc_expr *e, gfc_expr *s)
 	}
     }
 
-  convert_mpz_to_signed (result->value.integer, isize);
-
+  convert_mpz_to_signed (result->value.integer, bitsize);
   gfc_free (bits);
+
   return result;
 }
 
 
 gfc_expr *
+gfc_simplify_ishft (gfc_expr *e, gfc_expr *s)
+{
+  return simplify_shift (e, s, "ISHFT", false, 0);
+}
+
+
+gfc_expr *
+gfc_simplify_lshift (gfc_expr *e, gfc_expr *s)
+{
+  return simplify_shift (e, s, "LSHIFT", false, 1);
+}
+
+
+gfc_expr *
+gfc_simplify_rshift (gfc_expr *e, gfc_expr *s)
+{
+  return simplify_shift (e, s, "RSHIFT", true, -1);
+}
+
+
+gfc_expr *
+gfc_simplify_shifta (gfc_expr *e, gfc_expr *s)
+{
+  return simplify_shift (e, s, "SHIFTA", true, -1);
+}
+
+
+gfc_expr *
+gfc_simplify_shiftl (gfc_expr *e, gfc_expr *s)
+{
+  return simplify_shift (e, s, "SHIFTL", false, 1);
+}
+
+
+gfc_expr *
+gfc_simplify_shiftr (gfc_expr *e, gfc_expr *s)
+{
+  return simplify_shift (e, s, "SHIFTR", false, -1);
+}
+
+
+gfc_expr *
 gfc_simplify_ishftc (gfc_expr *e, gfc_expr *s, gfc_expr *sz)
 {
   gfc_expr *result;
@@ -3657,6 +3849,73 @@ gfc_simplify_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b)
 
 
 gfc_expr *
+gfc_simplify_maskr (gfc_expr *i, gfc_expr *kind_arg)
+{
+  gfc_expr *result;
+  int kind, arg, k;
+  const char *s;
+
+  if (i->expr_type != EXPR_CONSTANT)
+    return NULL;
+ 
+  kind = get_kind (BT_INTEGER, kind_arg, "MASKR", gfc_default_integer_kind);
+  if (kind == -1)
+    return &gfc_bad_expr;
+  k = gfc_validate_kind (BT_INTEGER, kind, false);
+
+  s = gfc_extract_int (i, &arg);
+  gcc_assert (!s);
+
+  result = gfc_get_constant_expr (BT_INTEGER, kind, &i->where);
+
+  /* MASKR(n) = 2^n - 1 */
+  mpz_set_ui (result->value.integer, 1);
+  mpz_mul_2exp (result->value.integer, result->value.integer, arg);
+  mpz_sub_ui (result->value.integer, result->value.integer, 1);
+
+  convert_mpz_to_signed (result->value.integer, gfc_integer_kinds[k].bit_size);
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_maskl (gfc_expr *i, gfc_expr *kind_arg)
+{
+  gfc_expr *result;
+  int kind, arg, k;
+  const char *s;
+  mpz_t z;
+
+  if (i->expr_type != EXPR_CONSTANT)
+    return NULL;
+ 
+  kind = get_kind (BT_INTEGER, kind_arg, "MASKL", gfc_default_integer_kind);
+  if (kind == -1)
+    return &gfc_bad_expr;
+  k = gfc_validate_kind (BT_INTEGER, kind, false);
+
+  s = gfc_extract_int (i, &arg);
+  gcc_assert (!s);
+
+  result = gfc_get_constant_expr (BT_INTEGER, kind, &i->where);
+
+  /* MASKL(n) = 2^bit_size - 2^(bit_size - n) */
+  mpz_init_set_ui (z, 1);
+  mpz_mul_2exp (z, z, gfc_integer_kinds[k].bit_size);
+  mpz_set_ui (result->value.integer, 1);
+  mpz_mul_2exp (result->value.integer, result->value.integer,
+		gfc_integer_kinds[k].bit_size - arg);
+  mpz_sub (result->value.integer, z, result->value.integer);
+  mpz_clear (z);
+
+  convert_mpz_to_signed (result->value.integer, gfc_integer_kinds[k].bit_size);
+
+  return result;
+}
+
+
+gfc_expr *
 gfc_simplify_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask)
 {
   if (tsource->expr_type != EXPR_CONSTANT
@@ -3668,7 +3927,38 @@ gfc_simplify_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask)
 }
 
 
-/* Selects bewteen current value and extremum for simplify_min_max
+gfc_expr *
+gfc_simplify_merge_bits (gfc_expr *i, gfc_expr *j, gfc_expr *mask_expr)
+{
+  mpz_t arg1, arg2, mask;
+  gfc_expr *result;
+
+  if (i->expr_type != EXPR_CONSTANT || j->expr_type != EXPR_CONSTANT
+      || mask_expr->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_INTEGER, i->ts.kind, &i->where);
+
+  /* Convert all argument to unsigned.  */
+  mpz_init_set (arg1, i->value.integer);
+  mpz_init_set (arg2, j->value.integer);
+  mpz_init_set (mask, mask_expr->value.integer);
+
+  /* MERGE_BITS(I,J,MASK) = IOR (IAND (I, MASK), IAND (J, NOT (MASK))).  */
+  mpz_and (arg1, arg1, mask);
+  mpz_com (mask, mask);
+  mpz_and (arg2, arg2, mask);
+  mpz_ior (result->value.integer, arg1, arg2);
+
+  mpz_clear (arg1);
+  mpz_clear (arg2);
+  mpz_clear (mask);
+
+  return result;
+}
+
+
+/* Selects between current value and extremum for simplify_min_max
    and simplify_minval_maxval.  */
 static void
 min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign)
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 53cbc99e2..29116d6 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1288,6 +1288,62 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo)
     }
 }
 
+/* DSHIFTL(I,J,S) = (I << S) | (J >> (BITSIZE(J) - S))
+   DSHIFTR(I,J,S) = (I << (BITSIZE(I) - S)) | (J >> S)
+   where the right shifts are logical (i.e. 0's are shifted in).
+   Because SHIFT_EXPR's want shifts strictly smaller than the integral
+   type width, we have to special-case both S == 0 and S == BITSIZE(J):
+     DSHIFTL(I,J,0) = I
+     DSHIFTL(I,J,BITSIZE) = J
+     DSHIFTR(I,J,0) = J
+     DSHIFTR(I,J,BITSIZE) = I.  */
+
+static void
+gfc_conv_intrinsic_dshift (gfc_se * se, gfc_expr * expr, bool dshiftl)
+{
+  tree type, utype, stype, arg1, arg2, shift, res, left, right;
+  tree args[3], cond, tmp;
+  int bitsize;
+
+  gfc_conv_intrinsic_function_args (se, expr, args, 3);
+
+  gcc_assert (TREE_TYPE (args[0]) == TREE_TYPE (args[1]));
+  type = TREE_TYPE (args[0]);
+  bitsize = TYPE_PRECISION (type);
+  utype = unsigned_type_for (type);
+  stype = TREE_TYPE (args[2]);
+
+  arg1 = gfc_evaluate_now (args[0], &se->pre);
+  arg2 = gfc_evaluate_now (args[1], &se->pre);
+  shift = gfc_evaluate_now (args[2], &se->pre);
+
+  /* The generic case.  */
+  tmp = fold_build2_loc (input_location, MINUS_EXPR, stype,
+			 build_int_cst (stype, bitsize), shift);
+  left = fold_build2_loc (input_location, LSHIFT_EXPR, type,
+			  arg1, dshiftl ? shift : tmp);
+
+  right = fold_build2_loc (input_location, RSHIFT_EXPR, utype,
+			   fold_convert (utype, arg2), dshiftl ? tmp : shift);
+  right = fold_convert (type, right);
+
+  res = fold_build2_loc (input_location, BIT_IOR_EXPR, type, left, right);
+
+  /* Special cases.  */
+  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, shift,
+			  build_int_cst (stype, 0));
+  res = fold_build3_loc (input_location, COND_EXPR, type, cond,
+			 dshiftl ? arg1 : arg2, res);
+
+  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, shift,
+			  build_int_cst (stype, bitsize));
+  res = fold_build3_loc (input_location, COND_EXPR, type, cond,
+			 dshiftl ? arg2 : arg1, res);
+
+  se->expr = res;
+}
+
+
 /* Positive difference DIM (x, y) = ((x - y) < 0) ? 0 : x - y.  */
 
 static void
@@ -3209,6 +3265,33 @@ gfc_conv_intrinsic_btest (gfc_se * se, gfc_expr * expr)
   se->expr = convert (type, tmp);
 }
 
+
+/* Generate code for BGE, BGT, BLE and BLT intrinsics.  */
+static void
+gfc_conv_intrinsic_bitcomp (gfc_se * se, gfc_expr * expr, enum tree_code op)
+{
+  tree args[2];
+
+  gfc_conv_intrinsic_function_args (se, expr, args, 2);
+
+  /* Convert both arguments to the unsigned type of the same size.  */
+  args[0] = fold_convert (unsigned_type_for (TREE_TYPE (args[0])), args[0]);
+  args[1] = fold_convert (unsigned_type_for (TREE_TYPE (args[1])), args[1]);
+
+  /* If they have unequal type size, convert to the larger one.  */
+  if (TYPE_PRECISION (TREE_TYPE (args[0]))
+      > TYPE_PRECISION (TREE_TYPE (args[1])))
+    args[1] = fold_convert (TREE_TYPE (args[0]), args[1]);
+  else if (TYPE_PRECISION (TREE_TYPE (args[1]))
+	   > TYPE_PRECISION (TREE_TYPE (args[0])))
+    args[0] = fold_convert (TREE_TYPE (args[1]), args[0]);
+
+  /* Now, we compare them.  */
+  se->expr = fold_build2_loc (input_location, op, boolean_type_node,
+			      args[0], args[1]);
+}
+
+
 /* Generate code to perform the specified operation.  */
 static void
 gfc_conv_intrinsic_bitop (gfc_se * se, gfc_expr * expr, enum tree_code op)
@@ -3277,18 +3360,39 @@ gfc_conv_intrinsic_ibits (gfc_se * se, gfc_expr * expr)
   se->expr = fold_build2_loc (input_location, BIT_AND_EXPR, type, tmp, mask);
 }
 
-/* RSHIFT (I, SHIFT) = I >> SHIFT
-   LSHIFT (I, SHIFT) = I << SHIFT  */
 static void
-gfc_conv_intrinsic_rlshift (gfc_se * se, gfc_expr * expr, int right_shift)
+gfc_conv_intrinsic_shift (gfc_se * se, gfc_expr * expr, bool right_shift,
+			  bool arithmetic)
 {
-  tree args[2];
+  tree args[2], type, num_bits, cond;
 
   gfc_conv_intrinsic_function_args (se, expr, args, 2);
 
+  args[0] = gfc_evaluate_now (args[0], &se->pre);
+  args[1] = gfc_evaluate_now (args[1], &se->pre);
+  type = TREE_TYPE (args[0]);
+
+  if (!arithmetic)
+    args[0] = fold_convert (unsigned_type_for (type), args[0]);
+  else
+    gcc_assert (right_shift);
+
   se->expr = fold_build2_loc (input_location,
 			      right_shift ? RSHIFT_EXPR : LSHIFT_EXPR,
 			      TREE_TYPE (args[0]), args[0], args[1]);
+
+  if (!arithmetic)
+    se->expr = fold_convert (type, se->expr);
+
+  /* The Fortran standard allows shift widths <= BIT_SIZE(I), whereas
+     gcc requires a shift width < BIT_SIZE(I), so we have to catch this
+     special case.  */
+  num_bits = build_int_cst (TREE_TYPE (args[1]), TYPE_PRECISION (type));
+  cond = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
+			  args[1], num_bits);
+
+  se->expr = fold_build3_loc (input_location, COND_EXPR, type, cond,
+			      build_int_cst (type, 0), se->expr);
 }
 
 /* ISHFT (I, SHIFT) = (abs (shift) >= BIT_SIZE (i))
@@ -3510,7 +3614,6 @@ gfc_conv_intrinsic_leadz (gfc_se * se, gfc_expr * expr)
 	      return clzll ((unsigned long long) (x >> ULLSIZE));
 	    else
 	      return ULL_SIZE + clzll ((unsigned long long) x);
-
 	 where ULL_MAX is the largest value that a ULL_MAX can hold
 	 (0xFFFFFFFFFFFFFFFF for a 64-bit long long type), and ULLSIZE
 	 is the bit-size of the long long type (64 in this example).  */
@@ -4032,6 +4135,84 @@ gfc_conv_intrinsic_merge (gfc_se * se, gfc_expr * expr)
 }
 
 
+/* MERGE_BITS (I, J, MASK) = (I & MASK) | (I & (~MASK)).  */
+
+static void
+gfc_conv_intrinsic_merge_bits (gfc_se * se, gfc_expr * expr)
+{
+  tree args[3], mask, type;
+
+  gfc_conv_intrinsic_function_args (se, expr, args, 3);
+  mask = gfc_evaluate_now (args[2], &se->pre);
+
+  type = TREE_TYPE (args[0]);
+  gcc_assert (TREE_TYPE (args[1]) == type);
+  gcc_assert (TREE_TYPE (mask) == type);
+
+  args[0] = fold_build2_loc (input_location, BIT_AND_EXPR, type, args[0], mask);
+  args[1] = fold_build2_loc (input_location, BIT_AND_EXPR, type, args[1],
+			     fold_build1_loc (input_location, BIT_NOT_EXPR,
+					      type, mask));
+  se->expr = fold_build2_loc (input_location, BIT_IOR_EXPR, type,
+			      args[0], args[1]);
+}
+
+
+/* MASKL(n)  =  n == 0 ? 0 : (~0) << (BIT_SIZE - n)
+   MASKR(n)  =  n == BIT_SIZE ? ~0 : ~((~0) << n)  */
+
+static void
+gfc_conv_intrinsic_mask (gfc_se * se, gfc_expr * expr, int left)
+{
+  tree arg, allones, type, utype, res, cond, bitsize;
+  int i;
+ 
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+  arg = gfc_evaluate_now (arg, &se->pre);
+
+  type = gfc_get_int_type (expr->ts.kind);
+  utype = unsigned_type_for (type);
+
+  i = gfc_validate_kind (BT_INTEGER, expr->ts.kind, false);
+  bitsize = build_int_cst (TREE_TYPE (arg), gfc_integer_kinds[i].bit_size);
+
+  allones = fold_build1_loc (input_location, BIT_NOT_EXPR, utype,
+			     build_int_cst (utype, 0));
+
+  if (left)
+    {
+      /* Left-justified mask.  */
+      res = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (arg),
+			     bitsize, arg);
+      res = fold_build2_loc (input_location, LSHIFT_EXPR, utype, allones,
+			     fold_convert (utype, res));
+
+      /* Special case arg == 0, because SHIFT_EXPR wants a shift strictly
+	 smaller than type width.  */
+      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, arg,
+			      build_int_cst (TREE_TYPE (arg), 0));
+      res = fold_build3_loc (input_location, COND_EXPR, utype, cond,
+			     build_int_cst (utype, 0), res);
+    }
+  else
+    {
+      /* Right-justified mask.  */
+      res = fold_build2_loc (input_location, LSHIFT_EXPR, utype, allones,
+			     fold_convert (utype, arg));
+      res = fold_build1_loc (input_location, BIT_NOT_EXPR, utype, res);
+
+      /* Special case agr == bit_size, because SHIFT_EXPR wants a shift
+	 strictly smaller than type width.  */
+      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+			      arg, bitsize);
+      res = fold_build3_loc (input_location, COND_EXPR, utype,
+			     cond, allones, res);
+    }
+
+  se->expr = fold_convert (type, res);
+}
+
+
 /* FRACTION (s) is translated into frexp (s, &dummy_int).  */
 static void
 gfc_conv_intrinsic_fraction (gfc_se * se, gfc_expr * expr)
@@ -5548,6 +5729,22 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_btest (se, expr);
       break;
 
+    case GFC_ISYM_BGE:
+      gfc_conv_intrinsic_bitcomp (se, expr, GE_EXPR);
+      break;
+
+    case GFC_ISYM_BGT:
+      gfc_conv_intrinsic_bitcomp (se, expr, GT_EXPR);
+      break;
+
+    case GFC_ISYM_BLE:
+      gfc_conv_intrinsic_bitcomp (se, expr, LE_EXPR);
+      break;
+
+    case GFC_ISYM_BLT:
+      gfc_conv_intrinsic_bitcomp (se, expr, LT_EXPR);
+      break;
+
     case GFC_ISYM_ACHAR:
     case GFC_ISYM_CHAR:
       gfc_conv_intrinsic_char (se, expr);
@@ -5625,6 +5822,14 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_dprod (se, expr);
       break;
 
+    case GFC_ISYM_DSHIFTL:
+      gfc_conv_intrinsic_dshift (se, expr, true);
+      break;
+
+    case GFC_ISYM_DSHIFTR:
+      gfc_conv_intrinsic_dshift (se, expr, false);
+      break;
+
     case GFC_ISYM_FDATE:
       gfc_conv_intrinsic_fdate (se, expr);
       break;
@@ -5704,11 +5909,23 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       break;
 
     case GFC_ISYM_LSHIFT:
-      gfc_conv_intrinsic_rlshift (se, expr, 0);
+      gfc_conv_intrinsic_shift (se, expr, false, false);
       break;
 
     case GFC_ISYM_RSHIFT:
-      gfc_conv_intrinsic_rlshift (se, expr, 1);
+      gfc_conv_intrinsic_shift (se, expr, true, true);
+      break;
+
+    case GFC_ISYM_SHIFTA:
+      gfc_conv_intrinsic_shift (se, expr, true, true);
+      break;
+
+    case GFC_ISYM_SHIFTL:
+      gfc_conv_intrinsic_shift (se, expr, false, false);
+      break;
+
+    case GFC_ISYM_SHIFTR:
+      gfc_conv_intrinsic_shift (se, expr, true, false);
       break;
 
     case GFC_ISYM_ISHFT:
@@ -5773,6 +5990,14 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_strcmp (se, expr, LT_EXPR);
       break;
 
+    case GFC_ISYM_MASKL:
+      gfc_conv_intrinsic_mask (se, expr, 1);
+      break;
+
+    case GFC_ISYM_MASKR:
+      gfc_conv_intrinsic_mask (se, expr, 0);
+      break;
+
     case GFC_ISYM_MAX:
       if (expr->ts.type == BT_CHARACTER)
 	gfc_conv_intrinsic_minmax_char (se, expr, 1);
@@ -5792,6 +6017,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_merge (se, expr);
       break;
 
+    case GFC_ISYM_MERGE_BITS:
+      gfc_conv_intrinsic_merge_bits (se, expr);
+      break;
+
     case GFC_ISYM_MIN:
       if (expr->ts.type == BT_CHARACTER)
 	gfc_conv_intrinsic_minmax_char (se, expr, -1);