summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog25
-rw-r--r--gcc/fortran/arith.c4
-rw-r--r--gcc/fortran/f95-lang.c15
-rw-r--r--gcc/fortran/gfortran.h4
-rw-r--r--gcc/fortran/iresolve.c43
-rw-r--r--gcc/fortran/simplify.c113
-rw-r--r--gcc/fortran/trans-intrinsic.c207
-rw-r--r--libgfortran/ChangeLog20
-rw-r--r--libgfortran/Makefile.am22
-rw-r--r--libgfortran/Makefile.in75
-rw-r--r--libgfortran/config.h.in9
-rwxr-xr-xlibgfortran/configure231
-rw-r--r--libgfortran/configure.ac3
-rw-r--r--libgfortran/generated/rrspacing_r10.c53
-rw-r--r--libgfortran/generated/rrspacing_r16.c53
-rw-r--r--libgfortran/generated/rrspacing_r4.c53
-rw-r--r--libgfortran/generated/rrspacing_r8.c53
-rw-r--r--libgfortran/generated/spacing_r10.c53
-rw-r--r--libgfortran/generated/spacing_r16.c53
-rw-r--r--libgfortran/generated/spacing_r4.c53
-rw-r--r--libgfortran/generated/spacing_r8.c53
-rw-r--r--libgfortran/m4/rrspacing.m454
-rw-r--r--libgfortran/m4/spacing.m454
23 files changed, 1035 insertions, 268 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 85c9533ffcf..16672af41d3 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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.
diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index 3541adc49a6..d4c527fb356 100644
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -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
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 6dc00da63a3..fb626f70446 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -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);
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 5ba7ad4fc84..7b624b07711 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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
{
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 1e57881125c..c702294fc82 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -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;
+
}
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 9d35bae749e..1b04e6e4a91 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -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)
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index facc15a739a..811555d37ca 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -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;
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 49990ab2115..9adf768d96d 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -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.
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index b4bd73de5cc..258366943f4 100644
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -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)/$@
diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index 8520131213d..313e5cff14b 100644
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -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)/$@
diff --git a/libgfortran/config.h.in b/libgfortran/config.h.in
index 0be4cf94fef..a198d42c7bb 100644
--- a/libgfortran/config.h.in
+++ b/libgfortran/config.h.in
@@ -426,6 +426,15 @@
/* 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
diff --git a/libgfortran/configure b/libgfortran/configure
index 8265f5b3683..6b767eb1fd3 100755
--- a/libgfortran/configure
+++ b/libgfortran/configure
@@ -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
diff --git a/libgfortran/configure.ac b/libgfortran/configure.ac
index abdf37a65b1..f8f1d3e93c5 100644
--- a/libgfortran/configure.ac
+++ b/libgfortran/configure.ac
@@ -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
index 00000000000..315fb1ba26c
--- /dev/null
+++ b/libgfortran/generated/rrspacing_r10.c
@@ -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
index 00000000000..d18a9c3fea4
--- /dev/null
+++ b/libgfortran/generated/rrspacing_r16.c
@@ -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
index 00000000000..0c7d1828e6d
--- /dev/null
+++ b/libgfortran/generated/rrspacing_r4.c
@@ -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
index 00000000000..3969f66941c
--- /dev/null
+++ b/libgfortran/generated/rrspacing_r8.c
@@ -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
index 00000000000..fd11ab65964
--- /dev/null
+++ b/libgfortran/generated/spacing_r10.c
@@ -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
index 00000000000..333221a4b2e
--- /dev/null
+++ b/libgfortran/generated/spacing_r16.c
@@ -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
index 00000000000..41cc72e9b2d
--- /dev/null
+++ b/libgfortran/generated/spacing_r4.c
@@ -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
index 00000000000..0f925217e42
--- /dev/null
+++ b/libgfortran/generated/spacing_r8.c
@@ -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
index 00000000000..6b3ccd55ec1
--- /dev/null
+++ b/libgfortran/m4/rrspacing.m4
@@ -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
index 00000000000..4aa4e19250f
--- /dev/null
+++ b/libgfortran/m4/spacing.m4
@@ -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
View Lorry Controller Status