2008-10-30 Steven G. Kargl <kargls@comcast.net>

[pf3gnuchains/gcc-fork.git] / gcc / fortran / simplify.c

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 1690003..49a4aff 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -668,7 +668,6 @@ gfc_simplify_atan2 (gfc_expr *y, gfc_expr *x)
 gfc_expr *
 gfc_simplify_bessel_j0 (gfc_expr *x ATTRIBUTE_UNUSED)
 {
-#if MPFR_VERSION >= MPFR_VERSION_NUM(2,3,0)
   gfc_expr *result;
 
   if (x->expr_type != EXPR_CONSTANT)
@@ -678,16 +677,12 @@ gfc_simplify_bessel_j0 (gfc_expr *x ATTRIBUTE_UNUSED)
   mpfr_j0 (result->value.real, x->value.real, GFC_RND_MODE);
 
   return range_check (result, "BESSEL_J0");
-#else
-  return NULL;
-#endif
 }
 
 
 gfc_expr *
 gfc_simplify_bessel_j1 (gfc_expr *x ATTRIBUTE_UNUSED)
 {
-#if MPFR_VERSION >= MPFR_VERSION_NUM(2,3,0)
   gfc_expr *result;
 
   if (x->expr_type != EXPR_CONSTANT)
@@ -697,9 +692,6 @@ gfc_simplify_bessel_j1 (gfc_expr *x ATTRIBUTE_UNUSED)
   mpfr_j1 (result->value.real, x->value.real, GFC_RND_MODE);
 
   return range_check (result, "BESSEL_J1");
-#else
-  return NULL;
-#endif
 }
 
 
@@ -707,7 +699,6 @@ gfc_expr *
 gfc_simplify_bessel_jn (gfc_expr *order ATTRIBUTE_UNUSED,
                        gfc_expr *x ATTRIBUTE_UNUSED)
 {
-#if MPFR_VERSION >= MPFR_VERSION_NUM(2,3,0)
   gfc_expr *result;
   long n;
 
@@ -719,16 +710,12 @@ gfc_simplify_bessel_jn (gfc_expr *order ATTRIBUTE_UNUSED,
   mpfr_jn (result->value.real, n, x->value.real, GFC_RND_MODE);
 
   return range_check (result, "BESSEL_JN");
-#else
-  return NULL;
-#endif
 }
 
 
 gfc_expr *
 gfc_simplify_bessel_y0 (gfc_expr *x ATTRIBUTE_UNUSED)
 {
-#if MPFR_VERSION >= MPFR_VERSION_NUM(2,3,0)
   gfc_expr *result;
 
   if (x->expr_type != EXPR_CONSTANT)
@@ -738,16 +725,12 @@ gfc_simplify_bessel_y0 (gfc_expr *x ATTRIBUTE_UNUSED)
   mpfr_y0 (result->value.real, x->value.real, GFC_RND_MODE);
 
   return range_check (result, "BESSEL_Y0");
-#else
-  return NULL;
-#endif
 }
 
 
 gfc_expr *
 gfc_simplify_bessel_y1 (gfc_expr *x ATTRIBUTE_UNUSED)
 {
-#if MPFR_VERSION >= MPFR_VERSION_NUM(2,3,0)
   gfc_expr *result;
 
   if (x->expr_type != EXPR_CONSTANT)
@@ -757,9 +740,6 @@ gfc_simplify_bessel_y1 (gfc_expr *x ATTRIBUTE_UNUSED)
   mpfr_y1 (result->value.real, x->value.real, GFC_RND_MODE);
 
   return range_check (result, "BESSEL_Y1");
-#else
-  return NULL;
-#endif
 }
 
 
@@ -767,7 +747,6 @@ gfc_expr *
 gfc_simplify_bessel_yn (gfc_expr *order ATTRIBUTE_UNUSED,
                        gfc_expr *x ATTRIBUTE_UNUSED)
 {
-#if MPFR_VERSION >= MPFR_VERSION_NUM(2,3,0)
   gfc_expr *result;
   long n;
 
@@ -779,9 +758,6 @@ gfc_simplify_bessel_yn (gfc_expr *order ATTRIBUTE_UNUSED,
   mpfr_yn (result->value.real, n, x->value.real, GFC_RND_MODE);
 
   return range_check (result, "BESSEL_YN");
-#else
-  return NULL;
-#endif
 }
 
 
@@ -832,7 +808,7 @@ gfc_simplify_ceiling (gfc_expr *e, gfc_expr *k)
   ceil = gfc_copy_expr (e);
 
   mpfr_ceil (ceil->value.real, e->value.real);
-  gfc_mpfr_to_mpz (result->value.integer, ceil->value.real);
+  gfc_mpfr_to_mpz (result->value.integer, ceil->value.real, &e->where);
 
   gfc_free_expr (ceil);
 
@@ -884,7 +860,8 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
        {
        case BT_INTEGER:
          if (!y->is_boz)
-           mpfr_set_z (result->value.complex.i, y->value.integer, GFC_RND_MODE);
+           mpfr_set_z (result->value.complex.i, y->value.integer,
+                       GFC_RND_MODE);
          break;
 
        case BT_REAL:
@@ -1364,7 +1341,7 @@ gfc_simplify_floor (gfc_expr *e, gfc_expr *k)
   mpfr_init (floor);
   mpfr_floor (floor, e->value.real);
 
-  gfc_mpfr_to_mpz (result->value.integer, floor);
+  gfc_mpfr_to_mpz (result->value.integer, floor, &e->where);
 
   mpfr_clear (floor);
 
@@ -1948,7 +1925,7 @@ gfc_simplify_ifix (gfc_expr *e)
   rtrunc = gfc_copy_expr (e);
 
   mpfr_trunc (rtrunc->value.real, e->value.real);
-  gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real);
+  gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real, &e->where);
 
   gfc_free_expr (rtrunc);
   return range_check (result, "IFIX");
@@ -1969,7 +1946,7 @@ gfc_simplify_idint (gfc_expr *e)
   rtrunc = gfc_copy_expr (e);
 
   mpfr_trunc (rtrunc->value.real, e->value.real);
-  gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real);
+  gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real, &e->where);
 
   gfc_free_expr (rtrunc);
   return range_check (result, "IDINT");
@@ -2399,6 +2376,30 @@ gfc_simplify_lbound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
 
 
 gfc_expr *
+gfc_simplify_leadz (gfc_expr *e)
+{
+  gfc_expr *result;
+  unsigned long lz, bs;
+  int i;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
+  bs = gfc_integer_kinds[i].bit_size;
+  if (mpz_cmp_si (e->value.integer, 0) == 0)
+    lz = bs;
+  else
+    lz = bs - mpz_sizeinbase (e->value.integer, 2);
+
+  result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind, &e->where);
+  mpz_set_ui (result->value.integer, lz);
+
+  return result;
+}
+
+
+gfc_expr *
 gfc_simplify_len (gfc_expr *e, gfc_expr *kind)
 {
   gfc_expr *result;
@@ -2458,7 +2459,6 @@ gfc_simplify_len_trim (gfc_expr *e, gfc_expr *kind)
 gfc_expr *
 gfc_simplify_lgamma (gfc_expr *x ATTRIBUTE_UNUSED)
 {
-#if MPFR_VERSION >= MPFR_VERSION_NUM(2,3,0)
   gfc_expr *result;
   int sg;
 
@@ -2470,9 +2470,6 @@ gfc_simplify_lgamma (gfc_expr *x ATTRIBUTE_UNUSED)
   mpfr_lgamma (result->value.real, &sg, x->value.real, GFC_RND_MODE);
 
   return range_check (result, "LGAMMA");
-#else
-  return NULL;
-#endif
 }
 
 
@@ -2972,7 +2969,7 @@ simplify_nint (const char *name, gfc_expr *e, gfc_expr *k)
 
   mpfr_round (itrunc->value.real, e->value.real);
 
-  gfc_mpfr_to_mpz (result->value.integer, itrunc->value.real);
+  gfc_mpfr_to_mpz (result->value.integer, itrunc->value.real, &e->where);
 
   gfc_free_expr (itrunc);
 
@@ -3795,6 +3792,8 @@ gfc_simplify_selected_char_kind (gfc_expr *e)
   if (gfc_compare_with_Cstring (e, "ascii", false) == 0
       || gfc_compare_with_Cstring (e, "default", false) == 0)
     kind = 1;
+  else if (gfc_compare_with_Cstring (e, "iso_10646", false) == 0)
+    kind = 4;
   else
     kind = -1;
 
@@ -4335,6 +4334,27 @@ gfc_simplify_tiny (gfc_expr *e)
 
 
 gfc_expr *
+gfc_simplify_trailz (gfc_expr *e)
+{
+  gfc_expr *result;
+  unsigned long tz, bs;
+  int i;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
+  bs = gfc_integer_kinds[i].bit_size;
+  tz = mpz_scan1 (e->value.integer, 0);
+
+  result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind, &e->where);
+  mpz_set_ui (result->value.integer, MIN (tz, bs));
+
+  return result;
+}
+
+
+gfc_expr *
 gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
 {
   gfc_expr *result;