[PATCH] fortran/15441,29312 -- Fix subnormal numbers, spacing, rrspacing.
Steve Kargl
sgk@troutmask.apl.washington.edu
Fri Oct 6 20:08:00 GMT 2006
On Thu, Oct 05, 2006 at 07:28:34PM -0700, Steve Kargl wrote:
> The attached patch has been bootstrapped and regression tested
> on amd64-*-freebsd. There are no regressions with this patch.
>
> The patch fixes 2 PR's that are related, and it also introduces
> a new preprocsor token GFC_MPFR_TOO_OLD to aid in testing gfortran
> with older and newer versions of mpfr.
>
> The primary problems are that spacing() and rrspacing() did not
> handle the special case 0. and did not handle subnormal numbers
> well. To fix rrspacing, I have removed the inlining of this
> intrinsic procedure in favor of library routine. Before anyone
> complains "fast and wrong" is probably not as good as "slower
> and correct".
>
> Dominique posted a program in PR 29312 that gfortran now compiles
> and executes correctly.
>
> There is one caveat. The rrspacing library routines use ldexp[f,l].
> If anyone reports a problem with these C99 functions I'll introduce
> pow().
>
Here's a new patch that removes the inlining of spacing in favor of
a library routine. It also adds HAVE_LDEXP[F,L] checks to configure.
Regression tested on amd64-*-freebsd.
2006-10-06 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 rrspacing 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.
--
Steve
-------------- next part --------------
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 117461)
+++ gcc/fortran/gfortran.h (working copy)
@@ -1221,6 +1221,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: gcc/fortran/f95-lang.c
===================================================================
--- gcc/fortran/f95-lang.c (revision 117461)
+++ gcc/fortran/f95-lang.c (working copy)
@@ -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: gcc/fortran/iresolve.c
===================================================================
--- gcc/fortran/iresolve.c (revision 117461)
+++ gcc/fortran/iresolve.c (working copy)
@@ -1730,8 +1730,19 @@ gfc_resolve_reshape (gfc_expr * f, gfc_e
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_getmem(sizeof(gfc_actual_arglist));
+ prec->name = "p";
+ prec->expr = gfc_int_expr (gfc_real_kinds[k].digits);
+ f->value.function.actual->next = prec;
}
@@ -1861,8 +1872,38 @@ gfc_resolve_sinh (gfc_expr * f, gfc_expr
void
gfc_resolve_spacing (gfc_expr * f, gfc_expr * x)
{
+ int k;
+ gfc_actual_arglist *prec, *wee, *emin;
+
f->ts = x->ts;
f->value.function.name = gfc_get_string ("__spacing_%d", x->ts.kind);
+
+ /* Create a hidden argument to the library routine for spacing. This
+ hidden argument is the precision of x. */
+ k = gfc_validate_kind (BT_REAL, x->ts.kind, false);
+
+ wee = gfc_getmem(sizeof (gfc_actual_arglist));
+ wee->name = "wee";
+ wee->expr = gfc_get_expr ();
+ wee->expr->expr_type = EXPR_CONSTANT;
+ wee->expr->where = gfc_current_locus;
+ wee->expr->ts.type = x->ts.type;
+ wee->expr->ts.kind = x->ts.kind;
+ mpfr_init (wee->expr->value.real);
+ mpfr_set (wee->expr->value.real, gfc_real_kinds[k].tiny, GFC_RND_MODE);
+
+ emin = gfc_getmem(sizeof (gfc_actual_arglist));
+ emin->name = "emin";
+ emin->expr = gfc_int_expr (gfc_real_kinds[k].min_exponent - 1);
+ emin->next = wee;
+
+ prec = gfc_getmem(sizeof (gfc_actual_arglist));
+ prec->name = "prec";
+ prec->expr = gfc_int_expr (gfc_real_kinds[k].digits);
+ prec->next = emin;
+
+ f->value.function.actual->next = prec;
+
}
Index: gcc/fortran/arith.c
===================================================================
--- gcc/fortran/arith.c (revision 117461)
+++ gcc/fortran/arith.c (working copy)
@@ -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: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c (revision 117461)
+++ gcc/fortran/trans-intrinsic.c (working copy)
@@ -129,7 +129,9 @@ static GTY(()) gfc_intrinsic_map_t gfc_i
/* 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,
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. */
@@ -3418,14 +3223,6 @@ gfc_conv_intrinsic_function (gfc_se * se
case GFC_ISYM_EXPONENT:
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:
Index: gcc/fortran/simplify.c
===================================================================
--- gcc/fortran/simplify.c (revision 117461)
+++ gcc/fortran/simplify.c (working copy)
@@ -607,7 +607,7 @@ gfc_simplify_atan2 (gfc_expr * y, gfc_ex
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_
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_
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_
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
@@ -3111,6 +3093,7 @@ bad_reshape:
}
+#if defined(GFC_MPFR_TOO_OLD)
gfc_expr *
gfc_simplify_rrspacing (gfc_expr * x)
{
@@ -3131,7 +3114,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;
}
@@ -3160,7 +3143,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)
@@ -3604,7 +3620,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)
{
@@ -3624,16 +3640,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);
@@ -3655,7 +3671,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: libgfortran/m4/spacing.m4
===================================================================
--- libgfortran/m4/spacing.m4 (revision 0)
+++ libgfortran/m4/spacing.m4 (revision 0)
@@ -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
Index: libgfortran/m4/rrspacing.m4
===================================================================
--- libgfortran/m4/rrspacing.m4 (revision 0)
+++ libgfortran/m4/rrspacing.m4 (revision 0)
@@ -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
Index: libgfortran/configure
===================================================================
--- libgfortran/configure (revision 117466)
+++ libgfortran/configure (working copy)
@@ -6898,8 +6898,9 @@ fi
break
done
if test "$acx_cv_header_stdint" = stddef.h; then
- acx_cv_header_stdint_kind="(lacks uintptr_t)"
+ acx_cv_header_stdint_kind="(lacks uintmax_t)"
for i in stdint.h $inttype_headers; do
+ unset ac_cv_type_uintptr_t
unset ac_cv_type_uint32_t
unset ac_cv_type_uint64_t
echo $ECHO_N "looking for an incomplete stdint.h in $i, $ECHO_C" >&6
@@ -7025,11 +7026,65 @@ rm -f conftest.err conftest.$ac_objext c
fi
echo "$as_me:$LINENO: result: $ac_cv_type_uint64_t" >&5
echo "${ECHO_T}$ac_cv_type_uint64_t" >&6
-if test $ac_cv_type_uint64_t = yes; then
- :
+
+ echo "$as_me:$LINENO: checking for uintptr_t" >&5
+echo $ECHO_N "checking for uintptr_t... $ECHO_C" >&6
+if test "${ac_cv_type_uintptr_t+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
else
- acx_cv_header_stdint_kind="(lacks uintptr_t and uint64_t)"
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <sys/types.h>
+#include <$i>
+
+int
+main ()
+{
+if ((uintptr_t *) 0)
+ return 0;
+if (sizeof (uintptr_t))
+ return 0;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 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_objext'
+ { (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_type_uintptr_t=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_type_uintptr_t=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
fi
+echo "$as_me:$LINENO: result: $ac_cv_type_uintptr_t" >&5
+echo "${ECHO_T}$ac_cv_type_uintptr_t" >&6
break
done
@@ -7162,11 +7217,6 @@ rm -f conftest.err conftest.$ac_objext c
fi
echo "$as_me:$LINENO: result: $ac_cv_type_u_int64_t" >&5
echo "${ECHO_T}$ac_cv_type_u_int64_t" >&6
-if test $ac_cv_type_u_int64_t = yes; then
- :
-else
- acx_cv_header_stdint_kind="(u_intXX_t style, lacks u_int64_t)"
-fi
break
done
@@ -10037,6 +10087,7 @@ fi
done
+
for ac_func in wait setmode
do
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
@@ -15226,6 +15277,237 @@ if test $ac_cv_lib_m_hypotl = yes; then
cat >>confdefs.h <<\_ACEOF
#define HAVE_HYPOTL 1
+_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
Index: libgfortran/Makefile.in
===================================================================
--- libgfortran/Makefile.in (revision 117467)
+++ libgfortran/Makefile.in (working copy)
@@ -138,11 +138,15 @@ am__objects_23 = exponent_r4.lo exponent
exponent_r16.lo
am__objects_24 = fraction_r4.lo fraction_r8.lo fraction_r10.lo \
fraction_r16.lo
-am__objects_25 = nearest_r4.lo nearest_r8.lo nearest_r10.lo \
+am__objects_25 = rrspacing_r4.lo rrspacing_r8.lo rrspacing_r10.lo \
+ rrspacing_r16.lo
+am__objects_26 = spacing_r4.lo spacing_r8.lo spacing_r10.lo \
+ spacing_r16.lo
+am__objects_27 = nearest_r4.lo nearest_r8.lo nearest_r10.lo \
nearest_r16.lo
-am__objects_26 = set_exponent_r4.lo set_exponent_r8.lo \
+am__objects_28 = set_exponent_r4.lo set_exponent_r8.lo \
set_exponent_r10.lo set_exponent_r16.lo
-am__objects_27 = pow_i4_i4.lo pow_i8_i4.lo pow_i16_i4.lo pow_r4_i4.lo \
+am__objects_29 = pow_i4_i4.lo pow_i8_i4.lo pow_i16_i4.lo pow_r4_i4.lo \
pow_r8_i4.lo pow_r10_i4.lo pow_r16_i4.lo pow_c4_i4.lo \
pow_c8_i4.lo pow_c10_i4.lo pow_c16_i4.lo pow_i4_i8.lo \
pow_i8_i8.lo pow_i16_i8.lo pow_r4_i8.lo pow_r8_i8.lo \
@@ -151,7 +155,7 @@ am__objects_27 = pow_i4_i4.lo pow_i8_i4.
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_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__
$(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
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 _exp_r4.lo _exp_r8.lo _exp_r10.lo \
_exp_r16.lo _exp_c4.lo _exp_c8.lo _exp_c10.lo _exp_c16.lo \
@@ -197,17 +202,17 @@ am__objects_32 = _abs_c4.lo _abs_c8.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 = $(am__objects_32) $(am__objects_33) dprod_r8.lo \
+am__objects_36 = $(am__objects_34) $(am__objects_35) 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_34)
+am_libgfortran_la_OBJECTS = $(am__objects_1) $(am__objects_30) \
+ $(am__objects_31) $(am__objects_32) $(am__objects_33) \
+ $(am__objects_36)
libgfortran_la_OBJECTS = $(am_libgfortran_la_OBJECTS)
libgfortranbegin_la_LIBADD =
am_libgfortranbegin_la_OBJECTS = fmain.lo
@@ -707,6 +712,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 \
@@ -767,15 +784,16 @@ m4_files = m4/iparm.m4 m4/ifunction.m4 m
m4/ctrig.m4 m4/cexp.m4 m4/chyp.m4 m4/mtype.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/fraction.m4 m4/rrspacing.m4 m4/spacing.m4 m4/nearest.m4 \
+ m4/set_exponent.m4 m4/pow.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) \
$(i_product_c) $(i_sum_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_exponent_c) $(i_fraction_c) $(i_rrspacing_c) $(i_spacing_c) $(i_nearest_c) \
+ $(i_set_exponent_c) $(i_pow_c) \
selected_int_kind.inc selected_real_kind.inc kinds.h \
kinds.inc c99_protos.inc fpu-target.h
@@ -2067,6 +2085,30 @@ fraction_r10.lo: generated/fraction_r10.
fraction_r16.lo: generated/fraction_r16.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fraction_r16.lo `test -f 'generated/fraction_r16.c' || echo '$(srcdir)/'`generated/fraction_r16.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
+
nearest_r4.lo: generated/nearest_r4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o nearest_r4.lo `test -f 'generated/nearest_r4.c' || echo '$(srcdir)/'`generated/nearest_r4.c
@@ -2826,6 +2868,12 @@ fpu-target.h: $(srcdir)/$(FPU_HOST_HEADE
@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: libgfortran/config.h.in
===================================================================
--- libgfortran/config.h.in (revision 117466)
+++ libgfortran/config.h.in (working copy)
@@ -423,6 +423,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
Index: libgfortran/configure.ac
===================================================================
--- libgfortran/configure.ac (revision 117466)
+++ libgfortran/configure.ac (working copy)
@@ -244,6 +244,9 @@ AC_CHECK_LIB([m],[frexpl],[AC_DEFINE([HA
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])])
Index: libgfortran/Makefile.am
===================================================================
--- libgfortran/Makefile.am (revision 117467)
+++ libgfortran/Makefile.am (working copy)
@@ -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 \
@@ -419,15 +431,16 @@ m4_files= m4/iparm.m4 m4/ifunction.m4 m4
m4/ctrig.m4 m4/cexp.m4 m4/chyp.m4 m4/mtype.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/fraction.m4 m4/rrspacing.m4 m4/spacing.m4 m4/nearest.m4 \
+ m4/set_exponent.m4 m4/pow.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) \
$(i_product_c) $(i_sum_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_exponent_c) $(i_fraction_c) $(i_rrspacing_c) $(i_spacing_c) $(i_nearest_c) \
+ $(i_set_exponent_c) $(i_pow_c) \
selected_int_kind.inc selected_real_kind.inc kinds.h \
kinds.inc c99_protos.inc fpu-target.h
@@ -667,6 +680,12 @@ $(in_unpack_c): m4/in_unpack.m4 $(I_M4_D
$(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)/$@
More information about the Gcc-patches
mailing list