git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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 2006-10-09 20:55:29 +00:00
parent a484326f89
commit cc6d3bde5a
23 changed files with 1035 additions and 268 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
gcc/fortran/ChangeLog
View File

@ -1,3 +1,28 @@
2006-10-09 Steven G. Kargl <kargl@gcc.gnu.org>
* gfortran.h: Define GFC_MPFR_TOO_OLD via mpfr version info.
* arith.c (arctangent, gfc_check_real_range): Use it.
* simplify.c (gfc_simplify_atan2, gfc_simplify_exponent,
gfc_simplify_log, gfc_simplify_nearest): Use it.
PR fortran/15441
PR fortran/29312
* iresolve.c (gfc_resolve_rrspacing): Give rrspacing library
routine hidden precision argument.
(gfc_resolve_spacing): Give spacing library routine hidden
precision, emin - 1, and tiny(x) arguments.
* simplify.c (gfc_simplify_nearest): Remove explicit subnormalization.
(gfc_simplify_rrspacing): Implement formula from Fortran 95 standard.
(gfc_simplify_spacing): Implement formula from Fortran 2003 standard.
* trans-intrinsic.c (gfc_intrinsic_map_t) Declare rrspacing and
spacing via LIBF_FUNCTION
(prepare_arg_info, call_builtin_clz, gfc_conv_intrinsic_spacing,
gfc_conv_intrinsic_rrspacing): Remove functions.
(gfc_conv_intrinsic_function): Remove calls to
gfc_conv_intrinsic_spacing and gfc_conv_intrinsic_rrspacing.
* f95-lang.c (gfc_init_builtin_functions): Remove __builtin_clz,
__builtin_clzl and __builtin_clzll
2006-10-09 Richard Henderson <rth@redhat.com> 2006-10-09 Richard Henderson <rth@redhat.com>
Revert emutls patch. Revert emutls patch.

4
gcc/fortran/arith.c
View File

@ -75,7 +75,7 @@ gfc_set_model (mpfr_t x)
mpfr_set_default_prec (mpfr_get_prec (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) /* Calculate atan2 (y, x)
atan2(y, x) = atan(y/x) if x > 0, 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) 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 /* MPFR operates on a number with a given precision and enormous
exponential range. To represent subnormal numbers, the exponent is exponential range. To represent subnormal numbers, the exponent is
allowed to become smaller than emin, but always retains the full allowed to become smaller than emin, but always retains the full

15
gcc/fortran/f95-lang.c
View File

@ -937,21 +937,6 @@ gfc_init_builtin_functions (void)
/* Other builtin functions we use. */ /* 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, void_list_node);
tmp = tree_cons (NULL_TREE, long_integer_type_node, tmp); tmp = tree_cons (NULL_TREE, long_integer_type_node, tmp);
ftype = build_function_type (long_integer_type_node, tmp); ftype = build_function_type (long_integer_type_node, tmp);

4
gcc/fortran/gfortran.h
View File

@ -1224,6 +1224,10 @@ gfc_intrinsic_sym;
#include <gmp.h> #include <gmp.h>
#include <mpfr.h> #include <mpfr.h>
#define GFC_RND_MODE GMP_RNDN #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 typedef struct gfc_expr
{ {

43
gcc/fortran/iresolve.c
View File

@ -1754,8 +1754,19 @@ gfc_resolve_reshape (gfc_expr * f, gfc_expr * source, gfc_expr * shape,
void void
gfc_resolve_rrspacing (gfc_expr * f, gfc_expr * x) gfc_resolve_rrspacing (gfc_expr * f, gfc_expr * x)
{ {
int k;
gfc_actual_arglist *prec;
f->ts = x->ts; f->ts = x->ts;
f->value.function.name = gfc_get_string ("__rrspacing_%d", x->ts.kind); 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 void
gfc_resolve_spacing (gfc_expr * f, gfc_expr * x) gfc_resolve_spacing (gfc_expr * f, gfc_expr * x)
{ {
int k;
gfc_actual_arglist *prec, *tiny, *emin_1;
f->ts = x->ts; f->ts = x->ts;
f->value.function.name = gfc_get_string ("__spacing_%d", x->ts.kind); 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;
} }

113
gcc/fortran/simplify.c
View File

@ -607,7 +607,7 @@ gfc_simplify_atan2 (gfc_expr * y, gfc_expr * x)
return &gfc_bad_expr; 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); arctangent2 (y->value.real, x->value.real, result->value.real);
#else #else
mpfr_atan2 (result->value.real, y->value.real, x->value.real, GFC_RND_MODE); 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; int i;
gfc_expr *result; 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; mpfr_t tmp;
#endif #endif
@ -1078,7 +1078,7 @@ gfc_simplify_exponent (gfc_expr * x)
return result; 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 /* PR fortran/28276 suffers from a buggy MPFR, and this block of code
does not function correctly. */ does not function correctly. */
mpfr_init (tmp); mpfr_init (tmp);
@ -1096,7 +1096,6 @@ gfc_simplify_exponent (gfc_expr * x)
mpfr_clear (tmp); mpfr_clear (tmp);
#else #else
/* Requires MPFR 2.2.0 or newer. */
i = (int) mpfr_get_exp (x->value.real); i = (int) mpfr_get_exp (x->value.real);
mpz_set_si (result->value.integer, i); mpz_set_si (result->value.integer, i);
#endif #endif
@ -2161,7 +2160,7 @@ gfc_simplify_log (gfc_expr * x)
mpfr_init (xr); mpfr_init (xr);
mpfr_init (xi); 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); arctangent2 (x->value.complex.i, x->value.complex.r, result->value.complex.i);
#else #else
mpfr_atan2 (result->value.complex.i, x->value.complex.i, x->value.complex.r, 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; gfc_expr *result;
mpfr_t tmp; mpfr_t tmp;
int sgn; int sgn;
#if MPFR_VERSION_MAJOR < 2 || (MPFR_VERSION_MAJOR == 2 && MPFR_VERSION_MINOR < 2) #if defined(GFC_MPFR_TOO_OLD)
int direction; int direction;
#else
mp_exp_t emin, emax;
#endif #endif
if (x->expr_type != EXPR_CONSTANT || s->expr_type != EXPR_CONSTANT) 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); gfc_set_model_kind (x->ts.kind);
result = gfc_copy_expr (x); 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); direction = mpfr_sgn (s->value.real);
sgn = mpfr_sgn (x->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); mpfr_neg (result->value.real, result->value.real, GFC_RND_MODE);
} }
#else #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); sgn = mpfr_sgn (s->value.real);
mpfr_init (tmp); mpfr_init (tmp);
mpfr_set_inf (tmp, sgn); mpfr_set_inf (tmp, sgn);
mpfr_nexttoward (result->value.real, tmp); 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); mpfr_clear(tmp);
#endif #endif
@ -3130,6 +3112,7 @@ bad_reshape:
} }
#if defined(GFC_MPFR_TOO_OLD)
gfc_expr * gfc_expr *
gfc_simplify_rrspacing (gfc_expr * x) gfc_simplify_rrspacing (gfc_expr * x)
{ {
@ -3150,7 +3133,7 @@ gfc_simplify_rrspacing (gfc_expr * x)
if (mpfr_sgn (x->value.real) == 0) 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; return result;
} }
@ -3179,7 +3162,40 @@ gfc_simplify_rrspacing (gfc_expr * x)
return range_check (result, "RRSPACING"); 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_expr *
gfc_simplify_scale (gfc_expr * x, gfc_expr * i) gfc_simplify_scale (gfc_expr * x, gfc_expr * i)
@ -3623,7 +3639,7 @@ gfc_simplify_sngl (gfc_expr * a)
return range_check (result, "SNGL"); return range_check (result, "SNGL");
} }
#if defined(GFC_MPFR_TOO_OLD)
gfc_expr * gfc_expr *
gfc_simplify_spacing (gfc_expr * x) gfc_simplify_spacing (gfc_expr * x)
{ {
@ -3643,16 +3659,16 @@ gfc_simplify_spacing (gfc_expr * x)
gfc_set_model_kind (x->ts.kind); 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); mpfr_set (result->value.real, gfc_real_kinds[i].tiny, GFC_RND_MODE);
return result; return result;
} }
mpfr_init (log2); mpfr_init (log2);
mpfr_init (absv);
mpfr_abs (absv, x->value.real, GFC_RND_MODE);
mpfr_log2 (log2, absv, GFC_RND_MODE); mpfr_log2 (log2, absv, GFC_RND_MODE);
mpfr_trunc (log2, log2); mpfr_trunc (log2, log2);
@ -3674,7 +3690,44 @@ gfc_simplify_spacing (gfc_expr * x)
return range_check (result, "SPACING"); 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_expr *
gfc_simplify_sqrt (gfc_expr * e) gfc_simplify_sqrt (gfc_expr * e)

207
gcc/fortran/trans-intrinsic.c
View File

@ -129,7 +129,9 @@ static GTY(()) gfc_intrinsic_map_t gfc_intrinsic_map[] =
/* Functions in libgfortran. */ /* Functions in libgfortran. */
LIBF_FUNCTION (FRACTION, "fraction", false), LIBF_FUNCTION (FRACTION, "fraction", false),
LIBF_FUNCTION (NEAREST, "nearest", false), LIBF_FUNCTION (NEAREST, "nearest", false),
LIBF_FUNCTION (RRSPACING, "rrspacing", false),
LIBF_FUNCTION (SET_EXPONENT, "set_exponent", false), LIBF_FUNCTION (SET_EXPONENT, "set_exponent", false),
LIBF_FUNCTION (SPACING, "spacing", false),
/* End the list. */ /* End the list. */
LIBF_FUNCTION (NONE, NULL, false) 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); 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. */ /* 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); gfc_conv_intrinsic_exponent (se, expr);
break; 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: case GFC_ISYM_SCAN:
gfc_conv_intrinsic_scan (se, expr); gfc_conv_intrinsic_scan (se, expr);
break; break;

20
libgfortran/ChangeLog
View File

@ -1,3 +1,23 @@
2006-10-06 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/15441
PR fortran/29312
* configure.ac: Add HAVE_LDEXPF, HAVE_LDEXP, and HAVE_LDEXPL
* m4/spacing.m4: New file. Use new HAVE_* defines.
* m4/rrspacing.m4: Ditto.
* Makefile.am: Handle new files.
* configure: Regenerated.
* Makefile.in: Ditto.
* config.h.in: Ditto.
* generated/spacing_r4.c: Generated.
* generated/spacing_r8.c: Ditto.
* generated/spacing_r10.c: Ditto.
* generated/spacing_r16.c: Ditto.
* generated/rrspacing_r4.c: Ditto.
* generated/rrspacing_r8.c: Ditto.
* generated/rrspacing_r10.c: Ditto.
* generated/rrspacing_r16.c: Ditto.
2006-10-08 Francois-Xavier Coudert <coudert@clipper.ens.fr> 2006-10-08 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* intrinsics/hyper.c: Remove file. * intrinsics/hyper.c: Remove file.

22
libgfortran/Makefile.am
View File

@ -359,6 +359,18 @@ generated/exponent_r8.c \
generated/exponent_r10.c \ generated/exponent_r10.c \
generated/exponent_r16.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 = \ i_fraction_c = \
generated/fraction_r4.c \ generated/fraction_r4.c \
generated/fraction_r8.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/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/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/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) \ 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_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_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_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_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 \ selected_int_kind.inc selected_real_kind.inc kinds.h \
kinds.inc c99_protos.inc fpu-target.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 $(i_exponent_c): m4/exponent.m4 m4/mtype.m4
$(M4) -Dfile=$@ -I$(srcdir)/m4 exponent.m4 > $(srcdir)/$@ $(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 $(i_fraction_c): m4/fraction.m4 m4/mtype.m4
$(M4) -Dfile=$@ -I$(srcdir)/m4 fraction.m4 > $(srcdir)/$@ $(M4) -Dfile=$@ -I$(srcdir)/m4 fraction.m4 > $(srcdir)/$@

75
libgfortran/Makefile.in
View File

@ -151,7 +151,11 @@ am__objects_27 = pow_i4_i4.lo pow_i8_i4.lo pow_i16_i4.lo pow_r4_i4.lo \
pow_i16_i16.lo pow_r4_i16.lo pow_r8_i16.lo pow_r10_i16.lo \ pow_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_r16_i16.lo pow_c4_i16.lo pow_c8_i16.lo pow_c10_i16.lo \
pow_c16_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_5) $(am__objects_6) $(am__objects_7) \
$(am__objects_8) $(am__objects_9) $(am__objects_10) \ $(am__objects_8) $(am__objects_9) $(am__objects_10) \
$(am__objects_11) $(am__objects_12) $(am__objects_13) \ $(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_17) $(am__objects_18) $(am__objects_19) \
$(am__objects_20) $(am__objects_21) $(am__objects_22) \ $(am__objects_20) $(am__objects_21) $(am__objects_22) \
$(am__objects_23) $(am__objects_24) $(am__objects_25) \ $(am__objects_23) $(am__objects_24) $(am__objects_25) \
$(am__objects_26) $(am__objects_27) $(am__objects_26) $(am__objects_27) $(am__objects_28) \
am__objects_29 = close.lo file_pos.lo format.lo inquire.lo \ $(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 \ list_read.lo lock.lo open.lo read.lo size_from_kind.lo \
transfer.lo unit.lo unix.lo write.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 \ 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 \ 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 \ 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 \ system_clock.lo time.lo transpose_generic.lo tty.lo umask.lo \
unlink.lo unpack_generic.lo in_pack_generic.lo \ unlink.lo unpack_generic.lo in_pack_generic.lo \
in_unpack_generic.lo in_unpack_generic.lo
am__objects_31 = am__objects_33 =
am__objects_32 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \ 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_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 \ _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 \ _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 \ _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 \ _aint_r4.lo _aint_r8.lo _aint_r10.lo _aint_r16.lo _anint_r4.lo \
_anint_r8.lo _anint_r10.lo _anint_r16.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 \ _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 \ _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 \ _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_i4.lo _mod_i8.lo _mod_i16.lo _mod_r4.lo _mod_r8.lo \
_mod_r10.lo _mod_r16.lo _mod_r10.lo _mod_r16.lo
am__objects_34 = misc_specifics.lo am__objects_36 = misc_specifics.lo
am__objects_35 = $(am__objects_32) $(am__objects_33) $(am__objects_34) \ am__objects_37 = $(am__objects_34) $(am__objects_35) $(am__objects_36) \
dprod_r8.lo f2c_specifics.lo dprod_r8.lo f2c_specifics.lo
am_libgfortran_la_OBJECTS = $(am__objects_1) $(am__objects_28) \ am_libgfortran_la_OBJECTS = $(am__objects_1) $(am__objects_30) \
$(am__objects_29) $(am__objects_30) $(am__objects_31) \ $(am__objects_31) $(am__objects_32) $(am__objects_33) \
$(am__objects_35) $(am__objects_37)
libgfortran_la_OBJECTS = $(am_libgfortran_la_OBJECTS) libgfortran_la_OBJECTS = $(am_libgfortran_la_OBJECTS)
libgfortranbegin_la_LIBADD = libgfortranbegin_la_LIBADD =
am_libgfortranbegin_la_OBJECTS = fmain.lo am_libgfortranbegin_la_OBJECTS = fmain.lo
@ -712,6 +717,18 @@ generated/exponent_r8.c \
generated/exponent_r10.c \ generated/exponent_r10.c \
generated/exponent_r16.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 = \ i_fraction_c = \
generated/fraction_r4.c \ generated/fraction_r4.c \
generated/fraction_r8.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/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/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/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) \ 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_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_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_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_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 \ selected_int_kind.inc selected_real_kind.inc kinds.h \
kinds.inc c99_protos.inc fpu-target.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 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 $(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 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 $(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@$(i_exponent_c): m4/exponent.m4 m4/mtype.m4
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 exponent.m4 > $(srcdir)/$@ @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@$(i_fraction_c): m4/fraction.m4 m4/mtype.m4
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 fraction.m4 > $(srcdir)/$@ @MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 fraction.m4 > $(srcdir)/$@

9
libgfortran/config.h.in
View File

@ -426,6 +426,15 @@
/* Define to 1 if you have the `kill' function. */ /* Define to 1 if you have the `kill' function. */
#undef HAVE_KILL #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. */ /* Define to 1 if you have the `link' function. */
#undef HAVE_LINK #undef HAVE_LINK

231
libgfortran/configure vendored
View File

@ -15348,6 +15348,237 @@ _ACEOF
fi 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 "$as_me:$LINENO: checking for logf in -lm" >&5
echo $ECHO_N "checking for logf in -lm... $ECHO_C" >&6 echo $ECHO_N "checking for logf in -lm... $ECHO_C" >&6
if test "${ac_cv_lib_m_logf+set}" = set; then if test "${ac_cv_lib_m_logf+set}" = set; then

3
libgfortran/configure.ac
View File

@ -247,6 +247,9 @@ AC_CHECK_LIB([m],[frexpl],[AC_DEFINE([HAVE_FREXPL],[1],[libm includes frexpl])])
AC_CHECK_LIB([m],[hypotf],[AC_DEFINE([HAVE_HYPOTF],[1],[libm includes hypotf])]) AC_CHECK_LIB([m],[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],[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],[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],[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],[log],[AC_DEFINE([HAVE_LOG],[1],[libm includes log])])
AC_CHECK_LIB([m],[logl],[AC_DEFINE([HAVE_LOGL],[1],[libm includes logl])]) AC_CHECK_LIB([m],[logl],[AC_DEFINE([HAVE_LOGL],[1],[libm includes logl])])

53
libgfortran/generated/rrspacing_r10.c Normal file
View File

@ -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

53
libgfortran/generated/rrspacing_r16.c Normal file
View File

@ -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

53
libgfortran/generated/rrspacing_r4.c Normal file
View File

@ -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

53
libgfortran/generated/rrspacing_r8.c Normal file
View File

@ -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

53
libgfortran/generated/spacing_r10.c Normal file
View File

@ -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

53
libgfortran/generated/spacing_r16.c Normal file
View File

@ -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

53
libgfortran/generated/spacing_r4.c Normal file
View File

@ -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

53
libgfortran/generated/spacing_r8.c Normal file
View File

@ -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

54
libgfortran/m4/rrspacing.m4 Normal file
View File

@ -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

54
libgfortran/m4/spacing.m4 Normal file
View File

@ -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