OSDN Git Service

2006-10-06 Steven G. Kargl <kargl@gcc.gnu.org>
authorkargl <kargl@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 9 Oct 2006 20:55:29 +0000 (20:55 +0000)
committerkargl <kargl@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 9 Oct 2006 20:55:29 +0000 (20:55 +0000)
* gfortran.h: Define GFC_MPFR_TOO_OLD via mpfr version info.
* arith.c (arctangent, gfc_check_real_range): Use it.
* simplify.c (gfc_simplify_atan2, gfc_simplify_exponent,
gfc_simplify_log, gfc_simplify_nearest): Use it.

PR fortran/15441
PR fortran/29312
* iresolve.c (gfc_resolve_rrspacing): Give rrspacing library
routine hidden precision argument.
(gfc_resolve_spacing): Give spacing library routine hidden
precision, emin - 1, and tiny(x) arguments.
* simplify.c (gfc_simplify_nearest): Remove explicit subnormalization.
(gfc_simplify_rrspacing): Implement formula from Fortran 95 standard.
(gfc_simplify_spacing): Implement formula from Fortran 2003 standard.
* trans-intrinsic.c (gfc_intrinsic_map_t) Declare rrspacing and
spacing via LIBF_FUNCTION
(prepare_arg_info, call_builtin_clz, gfc_conv_intrinsic_spacing,
gfc_conv_intrinsic_rrspacing): Remove functions.
(gfc_conv_intrinsic_function): Remove calls to
gfc_conv_intrinsic_spacing and gfc_conv_intrinsic_rrspacing.
* f95-lang.c (gfc_init_builtin_functions): Remove __builtin_clz,
__builtin_clzl and __builtin_clzll

2006-10-06  Steven G. Kargl  <kargl@gcc.gnu.org>

PR fortran/15441
PR fortran/29312
* configure.ac: Add HAVE_LDEXPF, HAVE_LDEXP, and HAVE_LDEXPL
* m4/spacing.m4: New file.  Use new HAVE_* defines.
* m4/rrspacing.m4: Ditto.
* Makefile.am: Handle new files.
* configure: Regenerated.
* Makefile.in: Ditto.
* config.h.in: Ditto.
* generated/spacing_r4.c: Generated.
* generated/spacing_r8.c: Ditto.
* generated/spacing_r10.c: Ditto.
* generated/spacing_r16.c: Ditto.
* generated/rrspacing_r4.c: Ditto.
* generated/rrspacing_r8.c: Ditto.
* generated/rrspacing_r10.c: Ditto.
* generated/rrspacing_r16.c: Ditto.

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

23 files changed:
gcc/fortran/ChangeLog
gcc/fortran/arith.c
gcc/fortran/f95-lang.c
gcc/fortran/gfortran.h
gcc/fortran/iresolve.c
gcc/fortran/simplify.c
gcc/fortran/trans-intrinsic.c
libgfortran/ChangeLog
libgfortran/Makefile.am
libgfortran/Makefile.in
libgfortran/config.h.in
libgfortran/configure
libgfortran/configure.ac
libgfortran/generated/rrspacing_r10.c [new file with mode: 0644]
libgfortran/generated/rrspacing_r16.c [new file with mode: 0644]
libgfortran/generated/rrspacing_r4.c [new file with mode: 0644]
libgfortran/generated/rrspacing_r8.c [new file with mode: 0644]
libgfortran/generated/spacing_r10.c [new file with mode: 0644]
libgfortran/generated/spacing_r16.c [new file with mode: 0644]
libgfortran/generated/spacing_r4.c [new file with mode: 0644]
libgfortran/generated/spacing_r8.c [new file with mode: 0644]
libgfortran/m4/rrspacing.m4 [new file with mode: 0644]
libgfortran/m4/spacing.m4 [new file with mode: 0644]

index 85c9533..16672af 100644 (file)
@@ -1,3 +1,28 @@
+2006-10-09  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       * gfortran.h: Define GFC_MPFR_TOO_OLD via mpfr version info.
+       * arith.c (arctangent, gfc_check_real_range): Use it.   
+       * simplify.c (gfc_simplify_atan2, gfc_simplify_exponent,
+       gfc_simplify_log, gfc_simplify_nearest): Use it.
+
+       PR fortran/15441
+       PR fortran/29312
+       * iresolve.c (gfc_resolve_rrspacing): Give rrspacing library
+       routine hidden precision argument.
+       (gfc_resolve_spacing): Give spacing library routine hidden
+       precision, emin - 1, and tiny(x) arguments.
+       * simplify.c (gfc_simplify_nearest): Remove explicit subnormalization.
+       (gfc_simplify_rrspacing): Implement formula from Fortran 95 standard.
+       (gfc_simplify_spacing): Implement formula from Fortran 2003 standard.
+       * trans-intrinsic.c (gfc_intrinsic_map_t) Declare rrspacing and
+       spacing via LIBF_FUNCTION
+       (prepare_arg_info, call_builtin_clz, gfc_conv_intrinsic_spacing,
+       gfc_conv_intrinsic_rrspacing): Remove functions.
+       (gfc_conv_intrinsic_function): Remove calls to
+       gfc_conv_intrinsic_spacing and gfc_conv_intrinsic_rrspacing.
+       * f95-lang.c (gfc_init_builtin_functions): Remove __builtin_clz,
+       __builtin_clzl and __builtin_clzll
+
 2006-10-09  Richard Henderson  <rth@redhat.com>
 
        Revert emutls patch.
index 3541adc..d4c527f 100644 (file)
@@ -75,7 +75,7 @@ gfc_set_model (mpfr_t x)
   mpfr_set_default_prec (mpfr_get_prec (x));
 }
 
-#if MPFR_VERSION_MAJOR < 2 || (MPFR_VERSION_MAJOR == 2 && MPFR_VERSION_MINOR < 2)
+#if defined(GFC_MPFR_TOO_OLD)
 /* Calculate atan2 (y, x)
 
 atan2(y, x) = atan(y/x)                                if x > 0,
@@ -412,7 +412,7 @@ gfc_check_real_range (mpfr_t p, int kind)
     }
   else if (mpfr_cmp (q, gfc_real_kinds[i].tiny) < 0)
     {
-#if MPFR_VERSION_MAJOR < 2 || (MPFR_VERSION_MAJOR == 2 && MPFR_VERSION_MINOR < 2)
+#if defined(GFC_MPFR_TOO_OLD)
       /* MPFR operates on a number with a given precision and enormous
        exponential range.  To represent subnormal numbers, the exponent is
        allowed to become smaller than emin, but always retains the full
index 6dc00da..fb626f7 100644 (file)
@@ -937,21 +937,6 @@ gfc_init_builtin_functions (void)
 
   /* Other builtin functions we use.  */
 
-  tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node);
-  ftype = build_function_type (integer_type_node, tmp);
-  gfc_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ,
-                     "__builtin_clz", true);
-
-  tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node);
-  ftype = build_function_type (integer_type_node, tmp);
-  gfc_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL,
-                     "__builtin_clzl", true);
-
-  tmp = tree_cons (NULL_TREE, long_long_integer_type_node, void_list_node);
-  ftype = build_function_type (integer_type_node, tmp);
-  gfc_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL,
-                     "__builtin_clzll", true);
-
   tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node);
   tmp = tree_cons (NULL_TREE, long_integer_type_node, tmp);
   ftype = build_function_type (long_integer_type_node, tmp);
index 5ba7ad4..7b624b0 100644 (file)
@@ -1224,6 +1224,10 @@ gfc_intrinsic_sym;
 #include <gmp.h>
 #include <mpfr.h>
 #define GFC_RND_MODE GMP_RNDN
+#undef GFC_MPFR_TOO_OLD
+#if MPFR_VERSION_MAJOR < 2 || (MPFR_VERSION_MAJOR == 2 && MPFR_VERSION_MINOR < 2)
+#define GFC_MPFR_TOO_OLD 1
+#endif
 
 typedef struct gfc_expr
 {
index 1e57881..c702294 100644 (file)
@@ -1754,8 +1754,19 @@ gfc_resolve_reshape (gfc_expr * f, gfc_expr * source, gfc_expr * shape,
 void
 gfc_resolve_rrspacing (gfc_expr * f, gfc_expr * x)
 {
+  int k;
+  gfc_actual_arglist *prec;
+
   f->ts = x->ts;
   f->value.function.name = gfc_get_string ("__rrspacing_%d", x->ts.kind);
+
+  /* Create a hidden argument to the library routines for rrspacing.  This
+     hidden argument is the precision of x.  */
+  k = gfc_validate_kind (BT_REAL, x->ts.kind, false);
+  prec = gfc_get_actual_arglist ();
+  prec->name = "p";
+  prec->expr = gfc_int_expr (gfc_real_kinds[k].digits);
+  f->value.function.actual->next = prec;
 }
 
 
@@ -1885,8 +1896,40 @@ gfc_resolve_sinh (gfc_expr * f, gfc_expr * x)
 void
 gfc_resolve_spacing (gfc_expr * f, gfc_expr * x)
 {
+  int k; 
+  gfc_actual_arglist *prec, *tiny, *emin_1;
   f->ts = x->ts;
   f->value.function.name = gfc_get_string ("__spacing_%d", x->ts.kind);
+
+  /* Create hidden arguments to the library routine for spacing.  These
+     hidden arguments are tiny(x), min_exponent - 1,  and the precision
+     of x.  */
+
+  k = gfc_validate_kind (BT_REAL, x->ts.kind, false);
+
+  tiny = gfc_get_actual_arglist ();
+  tiny->name = "tiny";
+  tiny->expr = gfc_get_expr ();
+  tiny->expr->expr_type = EXPR_CONSTANT;
+  tiny->expr->where = gfc_current_locus;
+  tiny->expr->ts.type = x->ts.type;
+  tiny->expr->ts.kind = x->ts.kind;
+  mpfr_init (tiny->expr->value.real);
+  mpfr_set (tiny->expr->value.real, gfc_real_kinds[k].tiny, GFC_RND_MODE);
+
+  emin_1 = gfc_get_actual_arglist ();
+  emin_1->name = "emin";
+  emin_1->expr = gfc_int_expr (gfc_real_kinds[k].min_exponent - 1);
+  emin_1->next = tiny;
+
+  prec = gfc_get_actual_arglist ();
+  prec->name = "prec";
+  prec->expr = gfc_int_expr (gfc_real_kinds[k].digits);
+  prec->next = emin_1;
+
+  f->value.function.actual->next = prec;
+
 }
 
 
index 9d35bae..1b04e6e 100644 (file)
@@ -607,7 +607,7 @@ gfc_simplify_atan2 (gfc_expr * y, gfc_expr * x)
       return &gfc_bad_expr;
     }
 
-#if MPFR_VERSION_MAJOR < 2 || (MPFR_VERSION_MAJOR == 2 && MPFR_VERSION_MINOR < 2)
+#if defined(GFC_MPFR_TOO_OLD)
   arctangent2 (y->value.real, x->value.real, result->value.real);
 #else
   mpfr_atan2 (result->value.real, y->value.real, x->value.real, GFC_RND_MODE);
@@ -1060,7 +1060,7 @@ gfc_simplify_exponent (gfc_expr * x)
   int i;
   gfc_expr *result;
 
-#if MPFR_VERSION_MAJOR < 2 || (MPFR_VERSION_MAJOR == 2 && MPFR_VERSION_MINOR < 2)
+#if defined(GFC_MPFR_TOO_OLD)
   mpfr_t tmp;
 #endif
 
@@ -1078,7 +1078,7 @@ gfc_simplify_exponent (gfc_expr * x)
       return result;
     }
 
-#if MPFR_VERSION_MAJOR < 2 || (MPFR_VERSION_MAJOR == 2 && MPFR_VERSION_MINOR < 2)
+#if defined(GFC_MPFR_TOO_OLD)
   /* PR fortran/28276 suffers from a buggy MPFR, and this block of code
      does not function correctly.  */
   mpfr_init (tmp);
@@ -1096,7 +1096,6 @@ gfc_simplify_exponent (gfc_expr * x)
 
   mpfr_clear (tmp);
 #else
-  /* Requires MPFR 2.2.0 or newer.  */
   i = (int) mpfr_get_exp (x->value.real);
   mpz_set_si (result->value.integer, i);
 #endif
@@ -2161,7 +2160,7 @@ gfc_simplify_log (gfc_expr * x)
       mpfr_init (xr);
       mpfr_init (xi);
 
-#if MPFR_VERSION_MAJOR < 2 || (MPFR_VERSION_MAJOR == 2 && MPFR_VERSION_MINOR < 2)
+#if defined(GFC_MPFR_TOO_OLD)
       arctangent2 (x->value.complex.i, x->value.complex.r, result->value.complex.i);
 #else
       mpfr_atan2 (result->value.complex.i, x->value.complex.i, x->value.complex.r,
@@ -2495,10 +2494,8 @@ gfc_simplify_nearest (gfc_expr * x, gfc_expr * s)
   gfc_expr *result;
   mpfr_t tmp;
   int sgn;
-#if MPFR_VERSION_MAJOR < 2 || (MPFR_VERSION_MAJOR == 2 && MPFR_VERSION_MINOR < 2)
+#if defined(GFC_MPFR_TOO_OLD)
   int direction;
-#else
-  mp_exp_t emin, emax;
 #endif
 
   if (x->expr_type != EXPR_CONSTANT || s->expr_type != EXPR_CONSTANT)
@@ -2513,7 +2510,7 @@ gfc_simplify_nearest (gfc_expr * x, gfc_expr * s)
   gfc_set_model_kind (x->ts.kind);
   result = gfc_copy_expr (x);
 
-#if MPFR_VERSION_MAJOR < 2 || (MPFR_VERSION_MAJOR == 2 && MPFR_VERSION_MINOR < 2)
+#if defined(GFC_MPFR_TOO_OLD)
 
   direction = mpfr_sgn (s->value.real);
   sgn = mpfr_sgn (x->value.real);
@@ -2561,25 +2558,10 @@ gfc_simplify_nearest (gfc_expr * x, gfc_expr * s)
        mpfr_neg (result->value.real, result->value.real, GFC_RND_MODE);
     }
 #else
-
-  /* Save current values of emin and emax.  */
-  emin = mpfr_get_emin ();
-  emax = mpfr_get_emax ();
-
-  /* Set emin and emax for the current model number.  */
-  sgn = gfc_validate_kind (BT_REAL, x->ts.kind, 0);
-  mpfr_set_emin ((mp_exp_t) gfc_real_kinds[sgn].min_exponent - 1);
-  mpfr_set_emax ((mp_exp_t) gfc_real_kinds[sgn].max_exponent - 1);
-
   sgn = mpfr_sgn (s->value.real); 
   mpfr_init (tmp);
   mpfr_set_inf (tmp, sgn);
   mpfr_nexttoward (result->value.real, tmp);
-  mpfr_subnormalize (result->value.real, 0, GFC_RND_MODE);
-  mpfr_set_emin (emin);
-  mpfr_set_emax (emax);
   mpfr_clear(tmp);
 #endif
 
@@ -3130,6 +3112,7 @@ bad_reshape:
 }
 
 
+#if defined(GFC_MPFR_TOO_OLD)
 gfc_expr *
 gfc_simplify_rrspacing (gfc_expr * x)
 {
@@ -3150,7 +3133,7 @@ gfc_simplify_rrspacing (gfc_expr * x)
 
   if (mpfr_sgn (x->value.real) == 0)
     {
-      mpfr_ui_div (result->value.real, 1, gfc_real_kinds[i].tiny, GFC_RND_MODE);
+      mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
       return result;
     }
 
@@ -3179,7 +3162,40 @@ gfc_simplify_rrspacing (gfc_expr * x)
 
   return range_check (result, "RRSPACING");
 }
+#else
+gfc_expr *
+gfc_simplify_rrspacing (gfc_expr * x)
+{
+  gfc_expr *result;
+  int i;
+  long int e, p;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
 
+  i = gfc_validate_kind (x->ts.type, x->ts.kind, false);
+
+  result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where);
+
+  mpfr_abs (result->value.real, x->value.real, GFC_RND_MODE);
+
+  /* Special case x = 0 and 0.  */
+  if (mpfr_sgn (result->value.real) == 0)
+    {
+      mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
+      return result;
+    }
+
+  /* | x * 2**(-e) | * 2**p.  */
+  e = - (long int) mpfr_get_exp (x->value.real);
+  mpfr_mul_2si (result->value.real, result->value.real, e, GFC_RND_MODE);
+
+  p = (long int) gfc_real_kinds[i].digits;
+  mpfr_mul_2si (result->value.real, result->value.real, p, GFC_RND_MODE);
+
+  return range_check (result, "RRSPACING");
+}
+#endif
 
 gfc_expr *
 gfc_simplify_scale (gfc_expr * x, gfc_expr * i)
@@ -3623,7 +3639,7 @@ gfc_simplify_sngl (gfc_expr * a)
   return range_check (result, "SNGL");
 }
 
-
+#if defined(GFC_MPFR_TOO_OLD)
 gfc_expr *
 gfc_simplify_spacing (gfc_expr * x)
 {
@@ -3643,16 +3659,16 @@ gfc_simplify_spacing (gfc_expr * x)
 
   gfc_set_model_kind (x->ts.kind);
 
-  if (mpfr_sgn (x->value.real) == 0)
+  /* Special case x = 0 and -0.  */
+  mpfr_init (absv);
+  mpfr_abs (absv, x->value.real, GFC_RND_MODE);
+  if (mpfr_sgn (absv) == 0)
     {
       mpfr_set (result->value.real, gfc_real_kinds[i].tiny, GFC_RND_MODE);
       return result;
     }
 
   mpfr_init (log2);
-  mpfr_init (absv);
-
-  mpfr_abs (absv, x->value.real, GFC_RND_MODE);
   mpfr_log2 (log2, absv, GFC_RND_MODE);
   mpfr_trunc (log2, log2);
 
@@ -3674,7 +3690,44 @@ gfc_simplify_spacing (gfc_expr * x)
 
   return range_check (result, "SPACING");
 }
+#else
+gfc_expr *
+gfc_simplify_spacing (gfc_expr * x)
+{
+  gfc_expr *result;
+  int i;
+  long int en, ep;
 
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  i = gfc_validate_kind (x->ts.type, x->ts.kind, false);
+
+  result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where);
+
+  /* Special case x = 0 and -0.  */
+  mpfr_abs (result->value.real, x->value.real, GFC_RND_MODE);
+  if (mpfr_sgn (result->value.real) == 0)
+    {
+      mpfr_set (result->value.real, gfc_real_kinds[i].tiny, GFC_RND_MODE);
+      return result;
+    }
+
+  /* In the Fortran 95 standard, the result is b**(e - p) where b, e, and p
+     are the radix, exponent of x, and precision.  This excludes the 
+     possibility of subnormal numbers.  Fortran 2003 states the result is
+     b**max(e - p, emin - 1).  */
+
+  ep = (long int) mpfr_get_exp (x->value.real) - gfc_real_kinds[i].digits;
+  en = (long int) gfc_real_kinds[i].min_exponent - 1;
+  en = en > ep ? en : ep;
+
+  mpfr_set_ui (result->value.real, 1, GFC_RND_MODE);
+  mpfr_mul_2si (result->value.real, result->value.real, en, GFC_RND_MODE);
+
+  return range_check (result, "SPACING");
+}
+#endif
 
 gfc_expr *
 gfc_simplify_sqrt (gfc_expr * e)
index facc15a..811555d 100644 (file)
@@ -129,7 +129,9 @@ static GTY(()) gfc_intrinsic_map_t gfc_intrinsic_map[] =
   /* Functions in libgfortran.  */
   LIBF_FUNCTION (FRACTION, "fraction", false),
   LIBF_FUNCTION (NEAREST, "nearest", false),
+  LIBF_FUNCTION (RRSPACING, "rrspacing", false),
   LIBF_FUNCTION (SET_EXPONENT, "set_exponent", false),
+  LIBF_FUNCTION (SPACING, "spacing", false),
 
   /* End the list.  */
   LIBF_FUNCTION (NONE, NULL, false)
@@ -3003,203 +3005,6 @@ gfc_conv_intrinsic_verify (gfc_se * se, gfc_expr * expr)
   se->expr = convert (type, se->expr);
 }
 
-/* Prepare components and related information of a real number which is
-   the first argument of a elemental functions to manipulate reals.  */
-
-static void
-prepare_arg_info (gfc_se * se, gfc_expr * expr,
-                 real_compnt_info * rcs, int all)
-{
-   tree arg;
-   tree masktype;
-   tree tmp;
-   tree wbits;
-   tree one;
-   tree exponent, fraction;
-   int n;
-   gfc_expr *a1;
-
-   if (TARGET_FLOAT_FORMAT != IEEE_FLOAT_FORMAT)
-     gfc_todo_error ("Non-IEEE floating format");
-
-   gcc_assert (expr->expr_type == EXPR_FUNCTION);
-
-   arg = gfc_conv_intrinsic_function_args (se, expr);
-   arg = TREE_VALUE (arg);
-   rcs->type = TREE_TYPE (arg);
-
-   /* Force arg'type to integer by unaffected convert  */
-   a1 = expr->value.function.actual->expr;
-   masktype = gfc_get_int_type (a1->ts.kind);
-   rcs->mtype = masktype;
-   tmp = build1 (VIEW_CONVERT_EXPR, masktype, arg);
-   arg = gfc_create_var (masktype, "arg");
-   gfc_add_modify_expr(&se->pre, arg, tmp);
-   rcs->arg = arg;
-
-   /* Calculate the numbers of bits of exponent, fraction and word  */
-   n = gfc_validate_kind (a1->ts.type, a1->ts.kind, false);
-   tmp = build_int_cst (NULL_TREE, gfc_real_kinds[n].digits - 1);
-   rcs->fdigits = convert (masktype, tmp);
-   wbits = build_int_cst (NULL_TREE, TYPE_PRECISION (rcs->type) - 1);
-   wbits = convert (masktype, wbits);
-   rcs->edigits = fold_build2 (MINUS_EXPR, masktype, wbits, tmp);
-
-   /* Form masks for exponent/fraction/sign  */
-   one = gfc_build_const (masktype, integer_one_node);
-   rcs->smask = fold_build2 (LSHIFT_EXPR, masktype, one, wbits);
-   rcs->f1 = fold_build2 (LSHIFT_EXPR, masktype, one, rcs->fdigits);
-   rcs->emask = fold_build2 (MINUS_EXPR, masktype, rcs->smask, rcs->f1);
-   rcs->fmask = fold_build2 (MINUS_EXPR, masktype, rcs->f1, one);
-   /* Form bias.  */
-   tmp = fold_build2 (MINUS_EXPR, masktype, rcs->edigits, one);
-   tmp = fold_build2 (LSHIFT_EXPR, masktype, one, tmp);
-   rcs->bias = fold_build2 (MINUS_EXPR, masktype, tmp ,one);
-
-   if (all)
-     {
-       /* exponent, and fraction  */
-       tmp = build2 (BIT_AND_EXPR, masktype, arg, rcs->emask);
-       tmp = build2 (RSHIFT_EXPR, masktype, tmp, rcs->fdigits);
-       exponent = gfc_create_var (masktype, "exponent");
-       gfc_add_modify_expr(&se->pre, exponent, tmp);
-       rcs->expn = exponent;
-
-       tmp = build2 (BIT_AND_EXPR, masktype, arg, rcs->fmask);
-       fraction = gfc_create_var (masktype, "fraction");
-       gfc_add_modify_expr(&se->pre, fraction, tmp);
-       rcs->frac = fraction;
-     }
-}
-
-/* Build a call to __builtin_clz.  */
-
-static tree
-call_builtin_clz (tree result_type, tree op0)
-{
-  tree fn, parms, call;
-  enum machine_mode op0_mode = TYPE_MODE (TREE_TYPE (op0));
-
-  if (op0_mode == TYPE_MODE (integer_type_node))
-    fn = built_in_decls[BUILT_IN_CLZ];
-  else if (op0_mode == TYPE_MODE (long_integer_type_node))
-    fn = built_in_decls[BUILT_IN_CLZL];
-  else if (op0_mode == TYPE_MODE (long_long_integer_type_node))
-    fn = built_in_decls[BUILT_IN_CLZLL];
-  else
-    gcc_unreachable ();
-
-  parms = tree_cons (NULL, op0, NULL);
-  call = build_function_call_expr (fn, parms);
-
-  return convert (result_type, call);
-}
-
-
-/* Generate code for SPACING (X) intrinsic function.
-   SPACING (X) = POW (2, e-p)
-
-   We generate:
-
-    t = expn - fdigits // e - p.
-    res = t << fdigits // Form the exponent. Fraction is zero.
-    if (t < 0) // The result is out of range. Denormalized case.
-      res = tiny(X)
- */
-
-static void
-gfc_conv_intrinsic_spacing (gfc_se * se, gfc_expr * expr)
-{
-   tree arg;
-   tree masktype;
-   tree tmp, t1, cond;
-   tree tiny, zero;
-   tree fdigits;
-   real_compnt_info rcs;
-
-   prepare_arg_info (se, expr, &rcs, 0);
-   arg = rcs.arg;
-   masktype = rcs.mtype;
-   fdigits = rcs.fdigits;
-   tiny = rcs.f1;
-   zero = gfc_build_const (masktype, integer_zero_node);
-   tmp = build2 (BIT_AND_EXPR, masktype, rcs.emask, arg);
-   tmp = build2 (RSHIFT_EXPR, masktype, tmp, fdigits);
-   tmp = build2 (MINUS_EXPR, masktype, tmp, fdigits);
-   cond = build2 (LE_EXPR, boolean_type_node, tmp, zero);
-   t1 = build2 (LSHIFT_EXPR, masktype, tmp, fdigits);
-   tmp = build3 (COND_EXPR, masktype, cond, tiny, t1);
-   tmp = build1 (VIEW_CONVERT_EXPR, rcs.type, tmp);
-
-   se->expr = tmp;
-}
-
-/* Generate code for RRSPACING (X) intrinsic function.
-   RRSPACING (X) = |X * POW (2, -e)| * POW (2, p) = |FRACTION (X)| * POW (2, p)
-
-   So the result's exponent is p. And if X is normalized, X's fraction part
-   is the result's fraction. If X is denormalized, to get the X's fraction we
-   shift X's fraction part to left until the first '1' is removed.
-
-   We generate:
-
-    if (expn == 0 && frac == 0)
-       res = 0;
-    else
-    {
-       // edigits is the number of exponent bits. Add the sign bit.
-       sedigits = edigits + 1;
-
-       if (expn == 0) // Denormalized case.
-       {
-         t1 = leadzero (frac);
-         frac = frac << (t1 + 1); //Remove the first '1'.
-         frac = frac >> (sedigits); //Form the fraction.
-       }
-
-       //fdigits is the number of fraction bits. Form the exponent.
-       t = bias + fdigits;
-
-       res = (t << fdigits) | frac;
-    }
-*/
-
-static void
-gfc_conv_intrinsic_rrspacing (gfc_se * se, gfc_expr * expr)
-{
-   tree masktype;
-   tree tmp, t1, t2, cond, cond2;
-   tree one, zero;
-   tree fdigits, fraction;
-   real_compnt_info rcs;
-
-   prepare_arg_info (se, expr, &rcs, 1);
-   masktype = rcs.mtype;
-   fdigits = rcs.fdigits;
-   fraction = rcs.frac;
-   one = gfc_build_const (masktype, integer_one_node);
-   zero = gfc_build_const (masktype, integer_zero_node);
-   t2 = fold_build2 (PLUS_EXPR, masktype, rcs.edigits, one);
-
-   t1 = call_builtin_clz (masktype, fraction);
-   tmp = build2 (PLUS_EXPR, masktype, t1, one);
-   tmp = build2 (LSHIFT_EXPR, masktype, fraction, tmp);
-   tmp = build2 (RSHIFT_EXPR, masktype, tmp, t2);
-   cond = build2 (EQ_EXPR, boolean_type_node, rcs.expn, zero);
-   fraction = build3 (COND_EXPR, masktype, cond, tmp, fraction);
-
-   tmp = fold_build2 (PLUS_EXPR, masktype, rcs.bias, fdigits);
-   tmp = fold_build2 (LSHIFT_EXPR, masktype, tmp, fdigits);
-   tmp = build2 (BIT_IOR_EXPR, masktype, tmp, fraction);
-
-   cond2 = build2 (EQ_EXPR, boolean_type_node, rcs.frac, zero);
-   cond = build2 (TRUTH_ANDIF_EXPR, boolean_type_node, cond, cond2);
-   tmp = build3 (COND_EXPR, masktype, cond,
-                build_int_cst (masktype, 0), tmp);
-
-   tmp = build1 (VIEW_CONVERT_EXPR, rcs.type, tmp);
-   se->expr = tmp;
-}
 
 /* Generate code for SELECTED_INT_KIND (R) intrinsic function.  */
 
@@ -3420,14 +3225,6 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_exponent (se, expr);
       break;
 
-    case GFC_ISYM_SPACING:
-      gfc_conv_intrinsic_spacing (se, expr);
-      break;
-
-    case GFC_ISYM_RRSPACING:
-      gfc_conv_intrinsic_rrspacing (se, expr);
-      break;
-
     case GFC_ISYM_SCAN:
       gfc_conv_intrinsic_scan (se, expr);
       break;
index 49990ab..9adf768 100644 (file)
@@ -1,3 +1,23 @@
+2006-10-06  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/15441
+       PR fortran/29312
+       * configure.ac: Add HAVE_LDEXPF, HAVE_LDEXP, and HAVE_LDEXPL
+       * m4/spacing.m4: New file.  Use new HAVE_* defines.
+       * m4/rrspacing.m4: Ditto.
+       * Makefile.am: Handle new files.
+       * configure: Regenerated.
+       * Makefile.in: Ditto.
+       * config.h.in: Ditto.
+       * generated/spacing_r4.c: Generated.
+       * generated/spacing_r8.c: Ditto.
+       * generated/spacing_r10.c: Ditto.
+       * generated/spacing_r16.c: Ditto.
+       * generated/rrspacing_r4.c: Ditto.
+       * generated/rrspacing_r8.c: Ditto.
+       * generated/rrspacing_r10.c: Ditto.
+       * generated/rrspacing_r16.c: Ditto.
+
 2006-10-08  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
        * intrinsics/hyper.c: Remove file.
index b4bd73d..2583669 100644 (file)
@@ -359,6 +359,18 @@ generated/exponent_r8.c \
 generated/exponent_r10.c \
 generated/exponent_r16.c
 
+i_spacing_c = \
+generated/spacing_r4.c \
+generated/spacing_r8.c \
+generated/spacing_r10.c \
+generated/spacing_r16.c
+
+i_rrspacing_c = \
+generated/rrspacing_r4.c \
+generated/rrspacing_r8.c \
+generated/rrspacing_r10.c \
+generated/rrspacing_r16.c
+
 i_fraction_c = \
 generated/fraction_r4.c \
 generated/fraction_r8.c \
@@ -420,7 +432,7 @@ m4_files= m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
     m4/specific.m4 m4/specific2.m4 m4/head.m4 m4/shape.m4 m4/reshape.m4 \
     m4/transpose.m4 m4/eoshift1.m4 m4/eoshift3.m4 m4/exponent.m4 \
     m4/fraction.m4 m4/nearest.m4 m4/set_exponent.m4 m4/pow.m4 \
-    m4/misc_specifics.m4
+    m4/misc_specifics.m4 m4/rrspacing.m4 m4/spacing.m4
 
 gfor_built_src= $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
     $(i_maxloc1_c) $(i_maxval_c) $(i_minloc0_c) $(i_minloc1_c) $(i_minval_c) \
@@ -428,7 +440,7 @@ gfor_built_src= $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
     $(i_matmul_c) $(i_matmull_c) $(i_transpose_c) $(i_shape_c) $(i_eoshift1_c) \
     $(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \
     $(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \
-    $(i_pow_c) \
+    $(i_pow_c) $(i_rrspacing_c) $(i_spacing_c) \
     selected_int_kind.inc selected_real_kind.inc kinds.h \
     kinds.inc c99_protos.inc fpu-target.h
 
@@ -688,6 +700,12 @@ $(in_unpack_c): m4/in_unpack.m4 $(I_M4_DEPS)
 $(i_exponent_c): m4/exponent.m4 m4/mtype.m4
        $(M4) -Dfile=$@ -I$(srcdir)/m4 exponent.m4 > $(srcdir)/$@
 
+$(i_rrspacing_c): m4/rrspacing.m4 m4/mtype.m4
+       $(M4) -Dfile=$@ -I$(srcdir)/m4 rrspacing.m4 > $(srcdir)/$@
+
+$(i_spacing_c): m4/spacing.m4 m4/mtype.m4
+       $(M4) -Dfile=$@ -I$(srcdir)/m4 spacing.m4 > $(srcdir)/$@
+
 $(i_fraction_c): m4/fraction.m4 m4/mtype.m4
        $(M4) -Dfile=$@ -I$(srcdir)/m4 fraction.m4 > $(srcdir)/$@
 
index 8520131..313e5cf 100644 (file)
@@ -151,7 +151,11 @@ am__objects_27 = pow_i4_i4.lo pow_i8_i4.lo pow_i16_i4.lo pow_r4_i4.lo \
        pow_i16_i16.lo pow_r4_i16.lo pow_r8_i16.lo pow_r10_i16.lo \
        pow_r16_i16.lo pow_c4_i16.lo pow_c8_i16.lo pow_c10_i16.lo \
        pow_c16_i16.lo
-am__objects_28 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \
+am__objects_28 = rrspacing_r4.lo rrspacing_r8.lo rrspacing_r10.lo \
+       rrspacing_r16.lo
+am__objects_29 = spacing_r4.lo spacing_r8.lo spacing_r10.lo \
+       spacing_r16.lo
+am__objects_30 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \
        $(am__objects_5) $(am__objects_6) $(am__objects_7) \
        $(am__objects_8) $(am__objects_9) $(am__objects_10) \
        $(am__objects_11) $(am__objects_12) $(am__objects_13) \
@@ -159,11 +163,12 @@ am__objects_28 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \
        $(am__objects_17) $(am__objects_18) $(am__objects_19) \
        $(am__objects_20) $(am__objects_21) $(am__objects_22) \
        $(am__objects_23) $(am__objects_24) $(am__objects_25) \
-       $(am__objects_26) $(am__objects_27)
-am__objects_29 = close.lo file_pos.lo format.lo inquire.lo \
+       $(am__objects_26) $(am__objects_27) $(am__objects_28) \
+       $(am__objects_29)
+am__objects_31 = close.lo file_pos.lo format.lo inquire.lo \
        list_read.lo lock.lo open.lo read.lo size_from_kind.lo \
        transfer.lo unit.lo unix.lo write.lo
-am__objects_30 = associated.lo abort.lo access.lo args.lo bessel.lo \
+am__objects_32 = associated.lo abort.lo access.lo args.lo bessel.lo \
        c99_functions.lo chdir.lo chmod.lo clock.lo cpu_time.lo \
        cshift0.lo ctime.lo date_and_time.lo env.lo erf.lo eoshift0.lo \
        eoshift2.lo etime.lo exit.lo fget.lo flush.lo fnum.lo ftell.lo \
@@ -176,8 +181,8 @@ am__objects_30 = associated.lo abort.lo access.lo args.lo bessel.lo \
        system_clock.lo time.lo transpose_generic.lo tty.lo umask.lo \
        unlink.lo unpack_generic.lo in_pack_generic.lo \
        in_unpack_generic.lo
-am__objects_31 =
-am__objects_32 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
+am__objects_33 =
+am__objects_34 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
        _abs_i4.lo _abs_i8.lo _abs_i16.lo _abs_r4.lo _abs_r8.lo \
        _abs_r10.lo _abs_r16.lo _aimag_c4.lo _aimag_c8.lo \
        _aimag_c10.lo _aimag_c16.lo _exp_r4.lo _exp_r8.lo _exp_r10.lo \
@@ -201,18 +206,18 @@ am__objects_32 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
        _conjg_c4.lo _conjg_c8.lo _conjg_c10.lo _conjg_c16.lo \
        _aint_r4.lo _aint_r8.lo _aint_r10.lo _aint_r16.lo _anint_r4.lo \
        _anint_r8.lo _anint_r10.lo _anint_r16.lo
-am__objects_33 = _sign_i4.lo _sign_i8.lo _sign_i16.lo _sign_r4.lo \
+am__objects_35 = _sign_i4.lo _sign_i8.lo _sign_i16.lo _sign_r4.lo \
        _sign_r8.lo _sign_r10.lo _sign_r16.lo _dim_i4.lo _dim_i8.lo \
        _dim_i16.lo _dim_r4.lo _dim_r8.lo _dim_r10.lo _dim_r16.lo \
        _atan2_r4.lo _atan2_r8.lo _atan2_r10.lo _atan2_r16.lo \
        _mod_i4.lo _mod_i8.lo _mod_i16.lo _mod_r4.lo _mod_r8.lo \
        _mod_r10.lo _mod_r16.lo
-am__objects_34 = misc_specifics.lo
-am__objects_35 = $(am__objects_32) $(am__objects_33) $(am__objects_34) \
+am__objects_36 = misc_specifics.lo
+am__objects_37 = $(am__objects_34) $(am__objects_35) $(am__objects_36) \
        dprod_r8.lo f2c_specifics.lo
-am_libgfortran_la_OBJECTS = $(am__objects_1) $(am__objects_28) \
-       $(am__objects_29) $(am__objects_30) $(am__objects_31) \
-       $(am__objects_35)
+am_libgfortran_la_OBJECTS = $(am__objects_1) $(am__objects_30) \
+       $(am__objects_31) $(am__objects_32) $(am__objects_33) \
+       $(am__objects_37)
 libgfortran_la_OBJECTS = $(am_libgfortran_la_OBJECTS)
 libgfortranbegin_la_LIBADD =
 am_libgfortranbegin_la_OBJECTS = fmain.lo
@@ -712,6 +717,18 @@ generated/exponent_r8.c \
 generated/exponent_r10.c \
 generated/exponent_r16.c
 
+i_spacing_c = \
+generated/spacing_r4.c \
+generated/spacing_r8.c \
+generated/spacing_r10.c \
+generated/spacing_r16.c
+
+i_rrspacing_c = \
+generated/rrspacing_r4.c \
+generated/rrspacing_r8.c \
+generated/rrspacing_r10.c \
+generated/rrspacing_r16.c
+
 i_fraction_c = \
 generated/fraction_r4.c \
 generated/fraction_r8.c \
@@ -773,7 +790,7 @@ m4_files = m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
     m4/specific.m4 m4/specific2.m4 m4/head.m4 m4/shape.m4 m4/reshape.m4 \
     m4/transpose.m4 m4/eoshift1.m4 m4/eoshift3.m4 m4/exponent.m4 \
     m4/fraction.m4 m4/nearest.m4 m4/set_exponent.m4 m4/pow.m4 \
-    m4/misc_specifics.m4
+    m4/misc_specifics.m4 m4/rrspacing.m4 m4/spacing.m4
 
 gfor_built_src = $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
     $(i_maxloc1_c) $(i_maxval_c) $(i_minloc0_c) $(i_minloc1_c) $(i_minval_c) \
@@ -781,7 +798,7 @@ gfor_built_src = $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
     $(i_matmul_c) $(i_matmull_c) $(i_transpose_c) $(i_shape_c) $(i_eoshift1_c) \
     $(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \
     $(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \
-    $(i_pow_c) \
+    $(i_pow_c) $(i_rrspacing_c) $(i_spacing_c) \
     selected_int_kind.inc selected_real_kind.inc kinds.h \
     kinds.inc c99_protos.inc fpu-target.h
 
@@ -2265,6 +2282,30 @@ pow_c10_i16.lo: generated/pow_c10_i16.c
 pow_c16_i16.lo: generated/pow_c16_i16.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c16_i16.lo `test -f 'generated/pow_c16_i16.c' || echo '$(srcdir)/'`generated/pow_c16_i16.c
 
+rrspacing_r4.lo: generated/rrspacing_r4.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o rrspacing_r4.lo `test -f 'generated/rrspacing_r4.c' || echo '$(srcdir)/'`generated/rrspacing_r4.c
+
+rrspacing_r8.lo: generated/rrspacing_r8.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o rrspacing_r8.lo `test -f 'generated/rrspacing_r8.c' || echo '$(srcdir)/'`generated/rrspacing_r8.c
+
+rrspacing_r10.lo: generated/rrspacing_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o rrspacing_r10.lo `test -f 'generated/rrspacing_r10.c' || echo '$(srcdir)/'`generated/rrspacing_r10.c
+
+rrspacing_r16.lo: generated/rrspacing_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o rrspacing_r16.lo `test -f 'generated/rrspacing_r16.c' || echo '$(srcdir)/'`generated/rrspacing_r16.c
+
+spacing_r4.lo: generated/spacing_r4.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spacing_r4.lo `test -f 'generated/spacing_r4.c' || echo '$(srcdir)/'`generated/spacing_r4.c
+
+spacing_r8.lo: generated/spacing_r8.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spacing_r8.lo `test -f 'generated/spacing_r8.c' || echo '$(srcdir)/'`generated/spacing_r8.c
+
+spacing_r10.lo: generated/spacing_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spacing_r10.lo `test -f 'generated/spacing_r10.c' || echo '$(srcdir)/'`generated/spacing_r10.c
+
+spacing_r16.lo: generated/spacing_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spacing_r16.lo `test -f 'generated/spacing_r16.c' || echo '$(srcdir)/'`generated/spacing_r16.c
+
 close.lo: io/close.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o close.lo `test -f 'io/close.c' || echo '$(srcdir)/'`io/close.c
 
@@ -2902,6 +2943,12 @@ fpu-target.h: $(srcdir)/$(FPU_HOST_HEADER)
 @MAINTAINER_MODE_TRUE@$(i_exponent_c): m4/exponent.m4 m4/mtype.m4
 @MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 exponent.m4 > $(srcdir)/$@
 
+@MAINTAINER_MODE_TRUE@$(i_rrspacing_c): m4/rrspacing.m4 m4/mtype.m4
+@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 rrspacing.m4 > $(srcdir)/$@
+
+@MAINTAINER_MODE_TRUE@$(i_spacing_c): m4/spacing.m4 m4/mtype.m4
+@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 spacing.m4 > $(srcdir)/$@
+
 @MAINTAINER_MODE_TRUE@$(i_fraction_c): m4/fraction.m4 m4/mtype.m4
 @MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 fraction.m4 > $(srcdir)/$@
 
index 0be4cf9..a198d42 100644 (file)
 /* Define to 1 if you have the `kill' function. */
 #undef HAVE_KILL
 
+/* libm includes ldexp */
+#undef HAVE_LDEXP
+
+/* libm includes ldexpf */
+#undef HAVE_LDEXPF
+
+/* libm includes ldexpl */
+#undef HAVE_LDEXPL
+
 /* Define to 1 if you have the `link' function. */
 #undef HAVE_LINK
 
index 8265f5b..6b767eb 100755 (executable)
@@ -15348,6 +15348,237 @@ _ACEOF
 
 fi
 
+echo "$as_me:$LINENO: checking for ldexpf in -lm" >&5
+echo $ECHO_N "checking for ldexpf in -lm... $ECHO_C" >&6
+if test "${ac_cv_lib_m_ldexpf+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lm  $LIBS"
+if test x$gcc_no_link = xyes; then
+  { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5
+echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;}
+   { (exit 1); exit 1; }; }
+fi
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+
+/* Override any gcc2 internal prototype to avoid an error.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+/* We use char because int might match the return type of a gcc2
+   builtin and then its argument prototype would still apply.  */
+char ldexpf ();
+int
+main ()
+{
+ldexpf ();
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+  (eval $ac_link) 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } &&
+        { ac_try='test -z "$ac_c_werror_flag"
+                        || test ! -s conftest.err'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; } &&
+        { ac_try='test -s conftest$ac_exeext'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; }; then
+  ac_cv_lib_m_ldexpf=yes
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_lib_m_ldexpf=no
+fi
+rm -f conftest.err conftest.$ac_objext \
+      conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+echo "$as_me:$LINENO: result: $ac_cv_lib_m_ldexpf" >&5
+echo "${ECHO_T}$ac_cv_lib_m_ldexpf" >&6
+if test $ac_cv_lib_m_ldexpf = yes; then
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_LDEXPF 1
+_ACEOF
+
+fi
+
+echo "$as_me:$LINENO: checking for ldexp in -lm" >&5
+echo $ECHO_N "checking for ldexp in -lm... $ECHO_C" >&6
+if test "${ac_cv_lib_m_ldexp+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lm  $LIBS"
+if test x$gcc_no_link = xyes; then
+  { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5
+echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;}
+   { (exit 1); exit 1; }; }
+fi
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+
+/* Override any gcc2 internal prototype to avoid an error.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+/* We use char because int might match the return type of a gcc2
+   builtin and then its argument prototype would still apply.  */
+char ldexp ();
+int
+main ()
+{
+ldexp ();
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+  (eval $ac_link) 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } &&
+        { ac_try='test -z "$ac_c_werror_flag"
+                        || test ! -s conftest.err'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; } &&
+        { ac_try='test -s conftest$ac_exeext'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; }; then
+  ac_cv_lib_m_ldexp=yes
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_lib_m_ldexp=no
+fi
+rm -f conftest.err conftest.$ac_objext \
+      conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+echo "$as_me:$LINENO: result: $ac_cv_lib_m_ldexp" >&5
+echo "${ECHO_T}$ac_cv_lib_m_ldexp" >&6
+if test $ac_cv_lib_m_ldexp = yes; then
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_LDEXP 1
+_ACEOF
+
+fi
+
+echo "$as_me:$LINENO: checking for ldexpl in -lm" >&5
+echo $ECHO_N "checking for ldexpl in -lm... $ECHO_C" >&6
+if test "${ac_cv_lib_m_ldexpl+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lm  $LIBS"
+if test x$gcc_no_link = xyes; then
+  { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5
+echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;}
+   { (exit 1); exit 1; }; }
+fi
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+
+/* Override any gcc2 internal prototype to avoid an error.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+/* We use char because int might match the return type of a gcc2
+   builtin and then its argument prototype would still apply.  */
+char ldexpl ();
+int
+main ()
+{
+ldexpl ();
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+  (eval $ac_link) 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } &&
+        { ac_try='test -z "$ac_c_werror_flag"
+                        || test ! -s conftest.err'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; } &&
+        { ac_try='test -s conftest$ac_exeext'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; }; then
+  ac_cv_lib_m_ldexpl=yes
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_lib_m_ldexpl=no
+fi
+rm -f conftest.err conftest.$ac_objext \
+      conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+echo "$as_me:$LINENO: result: $ac_cv_lib_m_ldexpl" >&5
+echo "${ECHO_T}$ac_cv_lib_m_ldexpl" >&6
+if test $ac_cv_lib_m_ldexpl = yes; then
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_LDEXPL 1
+_ACEOF
+
+fi
+
 echo "$as_me:$LINENO: checking for logf in -lm" >&5
 echo $ECHO_N "checking for logf in -lm... $ECHO_C" >&6
 if test "${ac_cv_lib_m_logf+set}" = set; then
index abdf37a..f8f1d3e 100644 (file)
@@ -247,6 +247,9 @@ AC_CHECK_LIB([m],[frexpl],[AC_DEFINE([HAVE_FREXPL],[1],[libm includes frexpl])])
 AC_CHECK_LIB([m],[hypotf],[AC_DEFINE([HAVE_HYPOTF],[1],[libm includes hypotf])])
 AC_CHECK_LIB([m],[hypot],[AC_DEFINE([HAVE_HYPOT],[1],[libm includes hypot])])
 AC_CHECK_LIB([m],[hypotl],[AC_DEFINE([HAVE_HYPOTL],[1],[libm includes hypotl])])
+AC_CHECK_LIB([m],[ldexpf],[AC_DEFINE([HAVE_LDEXPF],[1],[libm includes ldexpf])])
+AC_CHECK_LIB([m],[ldexp],[AC_DEFINE([HAVE_LDEXP],[1],[libm includes ldexp])])
+AC_CHECK_LIB([m],[ldexpl],[AC_DEFINE([HAVE_LDEXPL],[1],[libm includes ldexpl])])
 AC_CHECK_LIB([m],[logf],[AC_DEFINE([HAVE_LOGF],[1],[libm includes logf])])
 AC_CHECK_LIB([m],[log],[AC_DEFINE([HAVE_LOG],[1],[libm includes log])])
 AC_CHECK_LIB([m],[logl],[AC_DEFINE([HAVE_LOGL],[1],[libm includes logl])])
diff --git a/libgfortran/generated/rrspacing_r10.c b/libgfortran/generated/rrspacing_r10.c
new file mode 100644 (file)
index 0000000..315fb1b
--- /dev/null
@@ -0,0 +1,53 @@
+/* Implementation of the RRSPACING intrinsic
+   Copyright 2006 Free Software Foundation, Inc.
+   Contributed by Steven G. Kargl <kargl@gcc.gnu.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_FABSL) && defined (HAVE_FREXPL) && defined (HAVE_LDEXPL)
+
+extern GFC_REAL_10 rrspacing_r10 (GFC_REAL_10 s, int p);
+export_proto(rrspacing_r10);
+
+GFC_REAL_10
+rrspacing_r10 (GFC_REAL_10 s, int p)
+{
+  int e;
+  GFC_REAL_10 x;
+  x = fabsl (s);
+  if (x == 0.)
+    return 0.;
+  frexpl (s, &e);
+  return ldexpl (x, p - e);
+}
+
+#endif
diff --git a/libgfortran/generated/rrspacing_r16.c b/libgfortran/generated/rrspacing_r16.c
new file mode 100644 (file)
index 0000000..d18a9c3
--- /dev/null
@@ -0,0 +1,53 @@
+/* Implementation of the RRSPACING intrinsic
+   Copyright 2006 Free Software Foundation, Inc.
+   Contributed by Steven G. Kargl <kargl@gcc.gnu.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_FABSL) && defined (HAVE_FREXPL) && defined (HAVE_LDEXPL)
+
+extern GFC_REAL_16 rrspacing_r16 (GFC_REAL_16 s, int p);
+export_proto(rrspacing_r16);
+
+GFC_REAL_16
+rrspacing_r16 (GFC_REAL_16 s, int p)
+{
+  int e;
+  GFC_REAL_16 x;
+  x = fabsl (s);
+  if (x == 0.)
+    return 0.;
+  frexpl (s, &e);
+  return ldexpl (x, p - e);
+}
+
+#endif
diff --git a/libgfortran/generated/rrspacing_r4.c b/libgfortran/generated/rrspacing_r4.c
new file mode 100644 (file)
index 0000000..0c7d182
--- /dev/null
@@ -0,0 +1,53 @@
+/* Implementation of the RRSPACING intrinsic
+   Copyright 2006 Free Software Foundation, Inc.
+   Contributed by Steven G. Kargl <kargl@gcc.gnu.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_FABSF) && defined (HAVE_FREXPF) && defined (HAVE_LDEXPF)
+
+extern GFC_REAL_4 rrspacing_r4 (GFC_REAL_4 s, int p);
+export_proto(rrspacing_r4);
+
+GFC_REAL_4
+rrspacing_r4 (GFC_REAL_4 s, int p)
+{
+  int e;
+  GFC_REAL_4 x;
+  x = fabsf (s);
+  if (x == 0.)
+    return 0.;
+  frexpf (s, &e);
+  return ldexpf (x, p - e);
+}
+
+#endif
diff --git a/libgfortran/generated/rrspacing_r8.c b/libgfortran/generated/rrspacing_r8.c
new file mode 100644 (file)
index 0000000..3969f66
--- /dev/null
@@ -0,0 +1,53 @@
+/* Implementation of the RRSPACING intrinsic
+   Copyright 2006 Free Software Foundation, Inc.
+   Contributed by Steven G. Kargl <kargl@gcc.gnu.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_FABS) && defined (HAVE_FREXP) && defined (HAVE_LDEXP)
+
+extern GFC_REAL_8 rrspacing_r8 (GFC_REAL_8 s, int p);
+export_proto(rrspacing_r8);
+
+GFC_REAL_8
+rrspacing_r8 (GFC_REAL_8 s, int p)
+{
+  int e;
+  GFC_REAL_8 x;
+  x = fabs (s);
+  if (x == 0.)
+    return 0.;
+  frexp (s, &e);
+  return ldexp (x, p - e);
+}
+
+#endif
diff --git a/libgfortran/generated/spacing_r10.c b/libgfortran/generated/spacing_r10.c
new file mode 100644 (file)
index 0000000..fd11ab6
--- /dev/null
@@ -0,0 +1,53 @@
+/* Implementation of the SPACING intrinsic
+   Copyright 2006 Free Software Foundation, Inc.
+   Contributed by Steven G. Kargl <kargl@gcc.gnu.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_FREXPL) && defined (HAVE_LDEXPL)
+
+extern GFC_REAL_10 spacing_r10 (GFC_REAL_10 s, int p, int emin, GFC_REAL_10 tiny);
+export_proto(spacing_r10);
+
+GFC_REAL_10
+spacing_r10 (GFC_REAL_10 s, int p, int emin, GFC_REAL_10 tiny)
+{
+  int e;
+  if (s == 0.)
+    return tiny;
+  frexpl (s, &e);
+  e = e - p;
+  e = e > emin ? e : emin;
+  return ldexpl (1., e);
+}
+
+#endif
diff --git a/libgfortran/generated/spacing_r16.c b/libgfortran/generated/spacing_r16.c
new file mode 100644 (file)
index 0000000..333221a
--- /dev/null
@@ -0,0 +1,53 @@
+/* Implementation of the SPACING intrinsic
+   Copyright 2006 Free Software Foundation, Inc.
+   Contributed by Steven G. Kargl <kargl@gcc.gnu.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_FREXPL) && defined (HAVE_LDEXPL)
+
+extern GFC_REAL_16 spacing_r16 (GFC_REAL_16 s, int p, int emin, GFC_REAL_16 tiny);
+export_proto(spacing_r16);
+
+GFC_REAL_16
+spacing_r16 (GFC_REAL_16 s, int p, int emin, GFC_REAL_16 tiny)
+{
+  int e;
+  if (s == 0.)
+    return tiny;
+  frexpl (s, &e);
+  e = e - p;
+  e = e > emin ? e : emin;
+  return ldexpl (1., e);
+}
+
+#endif
diff --git a/libgfortran/generated/spacing_r4.c b/libgfortran/generated/spacing_r4.c
new file mode 100644 (file)
index 0000000..41cc72e
--- /dev/null
@@ -0,0 +1,53 @@
+/* Implementation of the SPACING intrinsic
+   Copyright 2006 Free Software Foundation, Inc.
+   Contributed by Steven G. Kargl <kargl@gcc.gnu.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_FREXPF) && defined (HAVE_LDEXPF)
+
+extern GFC_REAL_4 spacing_r4 (GFC_REAL_4 s, int p, int emin, GFC_REAL_4 tiny);
+export_proto(spacing_r4);
+
+GFC_REAL_4
+spacing_r4 (GFC_REAL_4 s, int p, int emin, GFC_REAL_4 tiny)
+{
+  int e;
+  if (s == 0.)
+    return tiny;
+  frexpf (s, &e);
+  e = e - p;
+  e = e > emin ? e : emin;
+  return ldexpf (1., e);
+}
+
+#endif
diff --git a/libgfortran/generated/spacing_r8.c b/libgfortran/generated/spacing_r8.c
new file mode 100644 (file)
index 0000000..0f92521
--- /dev/null
@@ -0,0 +1,53 @@
+/* Implementation of the SPACING intrinsic
+   Copyright 2006 Free Software Foundation, Inc.
+   Contributed by Steven G. Kargl <kargl@gcc.gnu.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_FREXP) && defined (HAVE_LDEXP)
+
+extern GFC_REAL_8 spacing_r8 (GFC_REAL_8 s, int p, int emin, GFC_REAL_8 tiny);
+export_proto(spacing_r8);
+
+GFC_REAL_8
+spacing_r8 (GFC_REAL_8 s, int p, int emin, GFC_REAL_8 tiny)
+{
+  int e;
+  if (s == 0.)
+    return tiny;
+  frexp (s, &e);
+  e = e - p;
+  e = e > emin ? e : emin;
+  return ldexp (1., e);
+}
+
+#endif
diff --git a/libgfortran/m4/rrspacing.m4 b/libgfortran/m4/rrspacing.m4
new file mode 100644 (file)
index 0000000..6b3ccd5
--- /dev/null
@@ -0,0 +1,54 @@
+`/* Implementation of the RRSPACING intrinsic
+   Copyright 2006 Free Software Foundation, Inc.
+   Contributed by Steven G. Kargl <kargl@gcc.gnu.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"'
+
+include(`mtype.m4')dnl
+
+`#if defined (HAVE_'real_type`) && defined (HAVE_FABS'Q`) && defined (HAVE_FREXP'Q`) && defined (HAVE_LDEXP'Q`)'
+
+extern real_type rrspacing_r`'kind (real_type s, int p);
+export_proto(rrspacing_r`'kind);
+
+real_type
+rrspacing_r`'kind (real_type s, int p)
+{
+  int e;
+  real_type x;
+  x = fabs`'q (s);
+  if (x == 0.)
+    return 0.;
+  frexp`'q (s, &e);
+  return ldexp`'q (x, p - e);
+}
+
+#endif
diff --git a/libgfortran/m4/spacing.m4 b/libgfortran/m4/spacing.m4
new file mode 100644 (file)
index 0000000..4aa4e19
--- /dev/null
@@ -0,0 +1,54 @@
+`/* Implementation of the SPACING intrinsic
+   Copyright 2006 Free Software Foundation, Inc.
+   Contributed by Steven G. Kargl <kargl@gcc.gnu.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"'
+
+include(`mtype.m4')dnl
+
+`#if defined (HAVE_'real_type`) && defined (HAVE_FREXP'Q`) && defined (HAVE_LDEXP'Q`)'
+
+extern real_type spacing_r`'kind (real_type s, int p, int emin, real_type tiny);
+export_proto(spacing_r`'kind);
+
+real_type
+spacing_r`'kind (real_type s, int p, int emin, real_type tiny)
+{
+  int e;
+  if (s == 0.)
+    return tiny;
+  frexp`'q (s, &e);
+  e = e - p;
+  e = e > emin ? e : emin;
+  return ldexp`'q (1., e);
+}
+
+#endif