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

1 files changed, 43 insertions, 0 deletions

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 1e57881..c702294 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -1754,8 +1754,19 @@ gfc_resolve_reshape (gfc_expr * f, gfc_expr * source, gfc_expr * shape,
 void
 gfc_resolve_rrspacing (gfc_expr * f, gfc_expr * x)
 {
+  int k;
+  gfc_actual_arglist *prec;
+
   f->ts = x->ts;
   f->value.function.name = gfc_get_string ("__rrspacing_%d", x->ts.kind);
+
+  /* Create a hidden argument to the library routines for rrspacing.  This
+     hidden argument is the precision of x.  */
+  k = gfc_validate_kind (BT_REAL, x->ts.kind, false);
+  prec = gfc_get_actual_arglist ();
+  prec->name = "p";
+  prec->expr = gfc_int_expr (gfc_real_kinds[k].digits);
+  f->value.function.actual->next = prec;
 }
 
 
@@ -1885,8 +1896,40 @@ gfc_resolve_sinh (gfc_expr * f, gfc_expr * x)
 void
 gfc_resolve_spacing (gfc_expr * f, gfc_expr * x)
 {
+  int k; 
+  gfc_actual_arglist *prec, *tiny, *emin_1;
+ 
   f->ts = x->ts;
   f->value.function.name = gfc_get_string ("__spacing_%d", x->ts.kind);
+
+  /* Create hidden arguments to the library routine for spacing.  These
+     hidden arguments are tiny(x), min_exponent - 1,  and the precision
+     of x.  */
+
+  k = gfc_validate_kind (BT_REAL, x->ts.kind, false);
+
+  tiny = gfc_get_actual_arglist ();
+  tiny->name = "tiny";
+  tiny->expr = gfc_get_expr ();
+  tiny->expr->expr_type = EXPR_CONSTANT;
+  tiny->expr->where = gfc_current_locus;
+  tiny->expr->ts.type = x->ts.type;
+  tiny->expr->ts.kind = x->ts.kind;
+  mpfr_init (tiny->expr->value.real);
+  mpfr_set (tiny->expr->value.real, gfc_real_kinds[k].tiny, GFC_RND_MODE);
+
+  emin_1 = gfc_get_actual_arglist ();
+  emin_1->name = "emin";
+  emin_1->expr = gfc_int_expr (gfc_real_kinds[k].min_exponent - 1);
+  emin_1->next = tiny;
+
+  prec = gfc_get_actual_arglist ();
+  prec->name = "prec";
+  prec->expr = gfc_int_expr (gfc_real_kinds[k].digits);
+  prec->next = emin_1;
+
+  f->value.function.actual->next = prec;
+
 }