[gfortran] I/O of large integer and real kinds, round 2

[Steve Kargl]

On Thu, Jun 09, 2005 at 12:50:04AM +0200, FX Coudert wrote:
> >Built, tested and regtested on:
> >   - i686-linux, which has real(10)
> >   - i386-freebsd
> >   - sparc-solaris, which has real(16)
> >   - x86_64-linux, which has real(10) and integer(16)
> >   - alpha-linux, which has integer(16)
> >
> >OK for mainline? (and should it be backported to 4.0, too?)
> 
> Tobias told me I sent a barely readable patch with no context around my 
> changes. Sorry for the inconvenience (and then, how many times a week do 
> I say "sorry" on this list? it's high time to upgrade my brain).
> 

FX, I think that this patch is ok with the exception of
your implementation of log10l().  I don't understand how
your regression tests where able to pass when there is
no provision for small numbers.  In particular, tiny(1._10)
is something like 3e-4391.  The current implementation of
of log10l() will call log10() with 3e-4391.  On FreeBSD,
this isn't a Good Thing.

I've attached an alternative implementation of log10l()
that permits amd64-*-freebsd to pass the regression tests.
Note, to accommondate the corner case of huge(1._10) I
had to reduce the integers proposed by rth by 1.  I likewise
increased the integers for tiny(1._10) by 1.

-- 
steve
-------------- next part --------------
Index: c99_functions.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/intrinsics/c99_functions.c,v
retrieving revision 1.12
diff -c -p -r1.12 c99_functions.c
*** c99_functions.c	15 Jun 2005 08:40:35 -0000	1.12
--- c99_functions.c	21 Jun 2005 23:06:34 -0000
*************** roundf(float x)
*** 371,373 ****
--- 371,411 ----
      }
  }
  #endif
+ 
+ #ifndef HAVE_LOG10L
+ /* log10 function for long double variables. The version provided here
+    reduces the argument until it fits into a double, then use log10.  */
+ long double
+ log10l(long double x)
+ {
+ #if LDBL_MAX_EXP > DBL_MAX_EXP
+   if (x > DBL_MAX)
+     {
+       double val;
+       int p2_result = 0;
+       if (x > 0x1p16383L) { p2_result += 16383; x /= 0x1p16383L; }
+       if (x > 0x1p8191L) { p2_result += 8191; x /= 0x1p8191L; }
+       if (x > 0x1p4095L) { p2_result += 4095; x /= 0x1p4095L; }
+       if (x > 0x1p2047L) { p2_result += 2047; x /= 0x1p2047L; }
+       if (x > 0x1p1023L) { p2_result += 1023; x /= 0x1p1023L; }
+       val = log10 ((double) x);
+       return (val + p2_result * .30102999566398119521373889472449302L);
+     }
+ #endif
+ #if LDBL_MIN_EXP < DBL_MIN_EXP
+   if (x < DBL_MIN)
+     {
+       double val;
+       int p2_result = 0;
+       if (x < 0x1p-16380L) { p2_result += 16380; x /= 0x1p-16380L; }
+       if (x < 0x1p-8189L) { p2_result += 8189; x /= 0x1p-8189L; }
+       if (x < 0x1p-4093L) { p2_result += 4093; x /= 0x1p-4093L; }
+       if (x < 0x1p-2045L) { p2_result += 2045; x /= 0x1p-2045L; }
+       if (x < 0x1p-1021L) { p2_result += 1021; x /= 0x1p-1021L; }
+       val = abs(log10 ((double) x));
+       return (val + p2_result * .30102999566398119521373889472449302L);
+     }
+ #endif
+     return log10 (x);
+ }
+ #endif