Add compile-time version of selected_unsigned_kind.

7 files changed, 58 insertions, 2 deletions

diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index a7b8af7..849fa78 100644
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -160,6 +160,7 @@ void
 gfc_arith_init_1 (void)
 {
   gfc_integer_info *int_info;
+  gfc_unsigned_info *uint_info;
   gfc_real_info *real_info;
   mpfr_t a, b;
   int i;
@@ -202,6 +203,28 @@ gfc_arith_init_1 (void)
       int_info->range = (int) mpfr_get_si (a, GFC_RND_MODE);
     }
 
+  /* Similar, for UNSIGNED.  */
+  if (flag_unsigned)
+    {
+      for (uint_info = gfc_unsigned_kinds; uint_info->kind != 0; uint_info++)
+	{
+	  /* Huge.  */
+	  mpz_init (uint_info->huge);
+	  mpz_set_ui (uint_info->huge, uint_info->radix);
+	  mpz_pow_ui (uint_info->huge, uint_info->huge, uint_info->digits);
+
+	  /* UNSIGNED is radix 2.  */
+	  gcc_assert (uint_info->radix == 2);
+
+	  /* Range.  */
+	  mpfr_set_z (a, uint_info->huge, GFC_RND_MODE);
+	  mpfr_log10 (a, a, GFC_RND_MODE);
+	  mpfr_trunc (a,a);
+	  uint_info->range = (int) mpfr_get_si (a, GFC_RND_MODE);
+	}
+
+    }
+
   mpfr_clear (a);
 
   for (real_info = gfc_real_kinds; real_info->kind != 0; real_info++)
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index e90a99d..25ae21a 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -5012,7 +5012,6 @@ gfc_check_selected_int_kind (gfc_expr *r)
   return true;
 }
 
-
 bool
 gfc_check_selected_real_kind (gfc_expr *p, gfc_expr *r, gfc_expr *radix)
 {
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 545a64d..b47a84a 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -700,7 +700,6 @@ gfc_extract_int (gfc_expr *expr, int *result, int report_error)
   return false;
 }
 
-
 /* Same as gfc_extract_int, but use a HWI.  */
 
 bool
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index f922bf3..d7bbcf6 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -677,6 +677,7 @@ enum gfc_isym_id
   GFC_ISYM_STOPPED_IMAGES,
   GFC_ISYM_STORAGE_SIZE,
   GFC_ISYM_STRIDE,
+  GFC_ISYM_SU_KIND,
   GFC_ISYM_SUM,
   GFC_ISYM_SYMLINK,
   GFC_ISYM_SYMLNK,
diff --git a/gcc/fortran/intrinsic.cc b/gcc/fortran/intrinsic.cc
index 40f4c4f..9074fe3 100644
--- a/gcc/fortran/intrinsic.cc
+++ b/gcc/fortran/intrinsic.cc
@@ -2952,6 +2952,16 @@ add_functions (void)
 
   make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
 
+  if (flag_unsigned)
+    {
+
+      add_sym_1 ("selected_unsigned_kind", GFC_ISYM_SU_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO,
+		 BT_INTEGER, di, GFC_STD_GNU, gfc_check_selected_int_kind,
+		 gfc_simplify_selected_unsigned_kind, NULL, r, BT_INTEGER, di, REQUIRED);
+
+      make_generic ("selected_unsigned_kind", GFC_ISYM_SU_KIND, GFC_STD_GNU);
+    }
+
   add_sym_1 ("selected_logical_kind", GFC_ISYM_SL_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
 	     GFC_STD_F2023, /* it has the same requirements */ gfc_check_selected_int_kind,
 	     gfc_simplify_selected_logical_kind, NULL, r, BT_INTEGER, di, REQUIRED);
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 2c287ca..bfd0ac4 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -399,6 +399,7 @@ 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 *);
 gfc_expr *gfc_simplify_selected_int_kind (gfc_expr *);
+gfc_expr *gfc_simplify_selected_unsigned_kind (gfc_expr *);
 gfc_expr *gfc_simplify_selected_logical_kind (gfc_expr *);
 gfc_expr *gfc_simplify_selected_real_kind (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_set_exponent (gfc_expr *, gfc_expr *);
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index 18c9088..b96f5ee 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -7404,6 +7404,29 @@ gfc_simplify_selected_int_kind (gfc_expr *e)
   return gfc_get_int_expr (gfc_default_integer_kind, &e->where, kind);
 }
 
+/* Same as above, but with unsigneds.  */
+
+gfc_expr *
+gfc_simplify_selected_unsigned_kind (gfc_expr *e)
+{
+  int i, kind, range;
+
+  if (e->expr_type != EXPR_CONSTANT || gfc_extract_int (e, &range))
+    return NULL;
+
+  kind = INT_MAX;
+
+  for (i = 0; gfc_unsigned_kinds[i].kind != 0; i++)
+    if (gfc_unsigned_kinds[i].range >= range
+	&& gfc_unsigned_kinds[i].kind < kind)
+      kind = gfc_unsigned_kinds[i].kind;
+
+  if (kind == INT_MAX)
+    kind = -1;
+
+  return gfc_get_int_expr (gfc_default_integer_kind, &e->where, kind);
+}
+
 
 gfc_expr *
 gfc_simplify_selected_logical_kind (gfc_expr *e)