re PR fortran/15441 (RRSPACING broken for denormals)
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 spacing library routine hidden precision, emin - 1, and tiny(x) arguments. * simplify.c (gfc_simplify_nearest): Remove explicit subnormalization. (gfc_simplify_rrspacing): Implement formula from Fortran 95 standard. (gfc_simplify_spacing): Implement formula from Fortran 2003 standard. * trans-intrinsic.c (gfc_intrinsic_map_t) Declare rrspacing and spacing via LIBF_FUNCTION (prepare_arg_info, call_builtin_clz, gfc_conv_intrinsic_spacing, gfc_conv_intrinsic_rrspacing): Remove functions. (gfc_conv_intrinsic_function): Remove calls to gfc_conv_intrinsic_spacing and gfc_conv_intrinsic_rrspacing. * f95-lang.c (gfc_init_builtin_functions): Remove __builtin_clz, __builtin_clzl and __builtin_clzll 2006-10-06 Steven G. Kargl <kargl@gcc.gnu.org> PR fortran/15441 PR fortran/29312 * configure.ac: Add HAVE_LDEXPF, HAVE_LDEXP, and HAVE_LDEXPL * m4/spacing.m4: New file. Use new HAVE_* defines. * m4/rrspacing.m4: Ditto. * Makefile.am: Handle new files. * configure: Regenerated. * Makefile.in: Ditto. * config.h.in: Ditto. * generated/spacing_r4.c: Generated. * generated/spacing_r8.c: Ditto. * generated/spacing_r10.c: Ditto. * generated/spacing_r16.c: Ditto. * generated/rrspacing_r4.c: Ditto. * generated/rrspacing_r8.c: Ditto. * generated/rrspacing_r10.c: Ditto. * generated/rrspacing_r16.c: Ditto. From-SVN: r117584
This commit is contained in:
Steven G. Kargl
parent
a484326f89
commit
cc6d3bde5a
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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)/$@
|
||||
|
||||
|
|
|
|||
|
|
@ -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)/$@
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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])])
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
Loading…
Reference in New Issue