Add UMASKR and UMASKL intrinsics.

gcc/fortran/ChangeLog:

	* check.cc (gfc_check_mask): Handle BT_INSIGNED.
	* gfortran.h (enum gfc_isym_id): Add GFC_ISYM_UMASKL and
	GFC_ISYM_UMASKR.
	* gfortran.texi: List UMASKL and UMASKR, remove unsigned future
	unsigned arguments for MASKL and MASKR.
	* intrinsic.cc (add_functions): Add UMASKL and UMASKR.
	* intrinsic.h (gfc_simplify_umaskl): New function.
	(gfc_simplify_umaskr): New function.
	(gfc_resolve_umasklr): New function.
	* intrinsic.texi: Document UMASKL and UMASKR.
	* iresolve.cc (gfc_resolve_umasklr): New function.
	* simplify.cc (gfc_simplify_umaskr): New function.
	(gfc_simplify_umaskl): New function.

gcc/testsuite/ChangeLog:

	* gfortran.dg/unsigned_39.f90: New test.

9 files changed, 226 insertions, 9 deletions

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 304ca1b..2d4af8e 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -4466,7 +4466,12 @@ gfc_check_mask (gfc_expr *i, gfc_expr *kind)
 {
   int k;
 
-  if (!type_check (i, 0, BT_INTEGER))
+  if (flag_unsigned)
+    {
+      if (!type_check2 (i, 0, BT_INTEGER, BT_UNSIGNED))
+	return false;
+    }
+  else if (!type_check (i, 0, BT_INTEGER))
     return false;
 
   if (!nonnegative_check ("I", i))
@@ -4478,7 +4483,7 @@ gfc_check_mask (gfc_expr *i, gfc_expr *kind)
   if (kind)
     gfc_extract_int (kind, &k);
   else
-    k = gfc_default_integer_kind;
+    k = i->ts.type == BT_UNSIGNED ? gfc_default_unsigned_kind : gfc_default_integer_kind;
 
   if (!less_than_bitsizekind ("I", i, k))
     return false;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index dd599bc..309095d 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -699,6 +699,8 @@ enum gfc_isym_id
   GFC_ISYM_UBOUND,
   GFC_ISYM_UCOBOUND,
   GFC_ISYM_UMASK,
+  GFC_ISYM_UMASKL,
+  GFC_ISYM_UMASKR,
   GFC_ISYM_UNLINK,
   GFC_ISYM_UNPACK,
   GFC_ISYM_VERIFY,
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 3b26916..429d846 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -2825,16 +2825,11 @@ The following intrinsics take unsigned arguments:
 The following intinsics are enabled with @option{-funsigned}:
 @itemize @bullet
 @item @code{UINT}, @pxref{UINT}
+@item @code{UMASKL}, @pxref{UMASKL}
+@item @code{UMASKR}, @pxref{UMASKR}
 @item @code{SELECTED_UNSIGNED_KIND}, @pxref{SELECTED_UNSIGNED_KIND}
 @end itemize
 
-The following intrinsics will take unsigned arguments
-in the future:
-@itemize @bullet
-@item @code{MASKL}, @pxref{MASKL}
-@item @code{MASKR}, @pxref{MASKR}
-@end itemize
-
 The following intrinsics are not yet implemented in GNU Fortran,
 but will take unsigned arguments once they have been:
 @itemize @bullet
diff --git a/gcc/fortran/intrinsic.cc b/gcc/fortran/intrinsic.cc
index 83b65d3..3fb1c63 100644
--- a/gcc/fortran/intrinsic.cc
+++ b/gcc/fortran/intrinsic.cc
@@ -2568,6 +2568,22 @@ add_functions (void)
 
   make_generic ("maskr", GFC_ISYM_MASKR, GFC_STD_F2008);
 
+  add_sym_2 ("umaskl", GFC_ISYM_UMASKL, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_mask, gfc_simplify_umaskl, gfc_resolve_umasklr,
+	     i, BT_INTEGER, di, REQUIRED,
+	     kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("umaskl", GFC_ISYM_UMASKL, GFC_STD_F2008);
+
+  add_sym_2 ("umaskr", GFC_ISYM_UMASKR, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_mask, gfc_simplify_umaskr, gfc_resolve_umasklr,
+	     i, BT_INTEGER, di, REQUIRED,
+	     kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("umaskr", GFC_ISYM_UMASKR, 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);
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index ea29219..61d85ee 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -434,6 +434,8 @@ gfc_expr *gfc_simplify_transpose (gfc_expr *);
 gfc_expr *gfc_simplify_trim (gfc_expr *);
 gfc_expr *gfc_simplify_ubound (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_ucobound (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_umaskl (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_umaskr (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_unpack (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_xor (gfc_expr *, gfc_expr *);
@@ -566,6 +568,7 @@ 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_umasklr (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 *);
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index f47fa3b..9d0b752 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -323,6 +323,8 @@ Some basic guidelines for editing this document:
 * @code{UCOBOUND}:      UCOBOUND,  Upper codimension bounds of an array
 * @code{UINT}:          UINT,      Convert to an unsigned integer type
 * @code{UMASK}:         UMASK,     Set the file creation mask
+* @code{UMASKL}:        UMASKL,    Unsigned left justified mask
+* @code{UMASKR}:        UMASKR,    Unsigned right justified mask
 * @code{UNLINK}:        UNLINK,    Remove a file from the file system
 * @code{UNPACK}:        UNPACK,    Unpack an array of rank one into an array
 * @code{VERIFY}:        VERIFY,    Scan a string for the absence of a set of characters
@@ -14964,6 +14966,79 @@ Subroutine, function
 
 @end table
 
+@node UMASKL
+@section @code{UMASKL} --- Unsigned left justified mask
+@fnindex UMASKL
+@cindex mask, left justified
+
+@table @asis
+@item @emph{Description}:
+@code{UMASKL(I[, KIND])} has its leftmost @var{I} bits set to 1, and the
+remaining bits set to 0.
+
+@item @emph{Standard}:
+Extension (@pxref{Unsigned integers})
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = UMASKL(I[, KIND])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of type @code{UNSIGNED}.
+@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{UNSIGNED}. If @var{KIND} is present, it
+specifies the kind value of the return type; otherwise, it is of the
+default unsigned kind.
+
+@item @emph{See also}:
+@ref{MASKL}, @*
+@ref{MASKR}, @*
+@ref{UMASKR}
+@end table
+
+@node UMASKR
+@section @code{UMASKR} --- Unsigned right justified mask
+@fnindex UMASKR
+@cindex mask, right justified
+
+@table @asis
+@item @emph{Description}:
+@code{UMASKL(I[, KIND])} has its rightmost @var{I} bits set to 1, and the
+remaining bits set to 0.
+
+@item @emph{Standard}:
+Extension (@pxref{Unsigned integers})
+
+@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{UNSIGNED}.
+@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{UNSIGNED}. 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}, @*
+@ref{MASKR}, @*
+@ref{UMASKL}
+@end table
 
 
 @node UNLINK
diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index d8b216b..6adc630 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -2012,6 +2012,20 @@ gfc_resolve_mask (gfc_expr *f, gfc_expr *i ATTRIBUTE_UNUSED,
     f->value.function.name = gfc_get_string ("__maskr_i%d", f->ts.kind);
 }
 
+void
+gfc_resolve_umasklr (gfc_expr *f, gfc_expr *i ATTRIBUTE_UNUSED,
+		  gfc_expr *kind)
+{
+  f->ts.type = BT_UNSIGNED;
+  f->ts.kind = kind ? mpz_get_si (kind->value.integer)
+		    : gfc_default_unsigned_kind;
+
+  if (f->value.function.isym->id == GFC_ISYM_UMASKL)
+    f->value.function.name = gfc_get_string ("__maskl_m%d", f->ts.kind);
+  else
+    f->value.function.name = gfc_get_string ("__maskr_m%d", f->ts.kind);
+}
+
 
 void
 gfc_resolve_merge (gfc_expr *f, gfc_expr *tsource,
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index 1e2fa3e..573ec6b 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -5200,6 +5200,84 @@ gfc_simplify_maskl (gfc_expr *i, gfc_expr *kind_arg)
   return result;
 }
 
+/* Similar to gfc_simplify_maskr, but code paths are different enough to make
+   this into a separate function.  */
+
+gfc_expr *
+gfc_simplify_umaskr (gfc_expr *i, gfc_expr *kind_arg)
+{
+  gfc_expr *result;
+  int kind, arg, k;
+
+  if (i->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  kind = get_kind (BT_UNSIGNED, kind_arg, "UMASKR", gfc_default_unsigned_kind);
+  if (kind == -1)
+    return &gfc_bad_expr;
+  k = gfc_validate_kind (BT_UNSIGNED, kind, false);
+
+  bool fail = gfc_extract_int (i, &arg);
+  gcc_assert (!fail);
+
+  if (!gfc_check_mask (i, kind_arg))
+    return &gfc_bad_expr;
+
+  result = gfc_get_constant_expr (BT_UNSIGNED, 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);
+
+  gfc_convert_mpz_to_unsigned (result->value.integer,
+			       gfc_unsigned_kinds[k].bit_size,
+			       false);
+
+  return result;
+}
+
+/* Likewise, similar to gfc_simplify_maskl.  */
+
+gfc_expr *
+gfc_simplify_umaskl (gfc_expr *i, gfc_expr *kind_arg)
+{
+  gfc_expr *result;
+  int kind, arg, k;
+  mpz_t z;
+
+  if (i->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  kind = get_kind (BT_UNSIGNED, kind_arg, "UMASKL", gfc_default_integer_kind);
+  if (kind == -1)
+    return &gfc_bad_expr;
+  k = gfc_validate_kind (BT_UNSIGNED, kind, false);
+
+  bool fail = gfc_extract_int (i, &arg);
+  gcc_assert (!fail);
+
+  if (!gfc_check_mask (i, kind_arg))
+    return &gfc_bad_expr;
+
+  result = gfc_get_constant_expr (BT_UNSIGNED, kind, &i->where);
+
+  /* MASKL(n) = 2^bit_size - 2^(bit_size - n) */
+  mpz_init_set_ui (z, 1);
+  mpz_mul_2exp (z, z, gfc_unsigned_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);
+
+  gfc_convert_mpz_to_unsigned (result->value.integer,
+			       gfc_unsigned_kinds[k].bit_size,
+			       false);
+
+  return result;
+}
+
 
 gfc_expr *
 gfc_simplify_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask)
diff --git a/gcc/testsuite/gfortran.dg/unsigned_39.f90 b/gcc/testsuite/gfortran.dg/unsigned_39.f90
new file mode 100644
index 0000000..47c2174
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_39.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-options "-funsigned" }
+program memain
+  use iso_fortran_env, only : uint8, uint32
+  implicit none
+  call test1
+  call test2
+contains
+  subroutine test1
+    unsigned(uint32) :: u1, u2
+    unsigned(uint8), dimension(3,3) :: v1, v2
+    u1 = umaskr(3)
+    if (u1 /= 7u) error stop 1
+    u2 = umaskl(2)
+    if (u2 /= 3221225472u) error stop 2
+    v1 = umaskr(5,uint8)
+    if (any(v1 /= 31u)) error stop 3
+    v2 = umaskl(5,uint8)
+    if (any(v2 /= 248u_uint8)) error stop 4
+  end subroutine test1
+  subroutine test2
+    unsigned(uint32), parameter :: u1 = umaskr(3), u2=umaskl(2)
+    unsigned(uint8), dimension(3,3) :: v1 = umaskr(5,uint8), v2 = umaskl(5,uint8)
+    if (u1 /= 7u) error stop 11
+    if (u2 /= 3221225472u) error stop 12
+    if (any(v1 /= 31u)) error stop 13
+    if (any(v2 /= 248u_uint8)) error stop 14
+  end subroutine test2
+end program memain