Import gdtoa-20081205.
authorPeter Avalos <pavalos@theshell.com>
Mon, 19 Jan 2009 17:28:24 +0000 (12:28 -0500)
committerPeter Avalos <pavalos@theshell.com>
Sat, 24 Jan 2009 17:01:26 +0000 (12:01 -0500)
Note: This will not be connected to the build until after the 2.2
release.

49 files changed:
contrib/gdtoa/README [new file with mode: 0644]
contrib/gdtoa/arithchk.c [new file with mode: 0644]
contrib/gdtoa/dmisc.c [new file with mode: 0644]
contrib/gdtoa/dtoa.c [new file with mode: 0644]
contrib/gdtoa/g_Qfmt.c [new file with mode: 0644]
contrib/gdtoa/g__fmt.c [new file with mode: 0644]
contrib/gdtoa/g_ddfmt.c [new file with mode: 0644]
contrib/gdtoa/g_dfmt.c [new file with mode: 0644]
contrib/gdtoa/g_ffmt.c [new file with mode: 0644]
contrib/gdtoa/g_xLfmt.c [new file with mode: 0644]
contrib/gdtoa/g_xfmt.c [new file with mode: 0644]
contrib/gdtoa/gdtoa.c [new file with mode: 0644]
contrib/gdtoa/gdtoa.h [new file with mode: 0644]
contrib/gdtoa/gdtoa_fltrnds.h [new file with mode: 0644]
contrib/gdtoa/gdtoaimp.h [new file with mode: 0644]
contrib/gdtoa/gethex.c [new file with mode: 0644]
contrib/gdtoa/gmisc.c [new file with mode: 0644]
contrib/gdtoa/hd_init.c [new file with mode: 0644]
contrib/gdtoa/hexnan.c [new file with mode: 0644]
contrib/gdtoa/makefile [new file with mode: 0644]
contrib/gdtoa/misc.c [new file with mode: 0644]
contrib/gdtoa/qnan.c [new file with mode: 0644]
contrib/gdtoa/smisc.c [new file with mode: 0644]
contrib/gdtoa/strtoIQ.c [new file with mode: 0644]
contrib/gdtoa/strtoId.c [new file with mode: 0644]
contrib/gdtoa/strtoIdd.c [new file with mode: 0644]
contrib/gdtoa/strtoIf.c [new file with mode: 0644]
contrib/gdtoa/strtoIg.c [new file with mode: 0644]
contrib/gdtoa/strtoIx.c [new file with mode: 0644]
contrib/gdtoa/strtoIxL.c [new file with mode: 0644]
contrib/gdtoa/strtod.c [new file with mode: 0644]
contrib/gdtoa/strtodI.c [new file with mode: 0644]
contrib/gdtoa/strtodg.c [new file with mode: 0644]
contrib/gdtoa/strtodnrp.c [new file with mode: 0644]
contrib/gdtoa/strtof.c [new file with mode: 0644]
contrib/gdtoa/strtopQ.c [new file with mode: 0644]
contrib/gdtoa/strtopd.c [new file with mode: 0644]
contrib/gdtoa/strtopdd.c [new file with mode: 0644]
contrib/gdtoa/strtopf.c [new file with mode: 0644]
contrib/gdtoa/strtopx.c [new file with mode: 0644]
contrib/gdtoa/strtopxL.c [new file with mode: 0644]
contrib/gdtoa/strtorQ.c [new file with mode: 0644]
contrib/gdtoa/strtord.c [new file with mode: 0644]
contrib/gdtoa/strtordd.c [new file with mode: 0644]
contrib/gdtoa/strtorf.c [new file with mode: 0644]
contrib/gdtoa/strtorx.c [new file with mode: 0644]
contrib/gdtoa/strtorxL.c [new file with mode: 0644]
contrib/gdtoa/sum.c [new file with mode: 0644]
contrib/gdtoa/ulp.c [new file with mode: 0644]

diff --git a/contrib/gdtoa/README b/contrib/gdtoa/README
new file mode 100644 (file)
index 0000000..ce8be55
--- /dev/null
@@ -0,0 +1,357 @@
+This directory contains source for a library of binary -> decimal
+and decimal -> binary conversion routines, for single-, double-,
+and extended-precision IEEE binary floating-point arithmetic, and
+other IEEE-like binary floating-point, including "double double",
+as in
+
+       T. J. Dekker, "A Floating-Point Technique for Extending the
+       Available Precision", Numer. Math. 18 (1971), pp. 224-242
+
+and
+
+       "Inside Macintosh: PowerPC Numerics", Addison-Wesley, 1994
+
+The conversion routines use double-precision floating-point arithmetic
+and, where necessary, high precision integer arithmetic.  The routines
+are generalizations of the strtod and dtoa routines described in
+
+       David M. Gay, "Correctly Rounded Binary-Decimal and
+       Decimal-Binary Conversions", Numerical Analysis Manuscript
+       No. 90-10, Bell Labs, Murray Hill, 1990;
+       http://cm.bell-labs.com/cm/cs/what/ampl/REFS/rounding.ps.gz
+
+(based in part on papers by Clinger and Steele & White: see the
+references in the above paper).
+
+The present conversion routines should be able to use any of IEEE binary,
+VAX, or IBM-mainframe double-precision arithmetic internally, but I (dmg)
+have so far only had a chance to test them with IEEE double precision
+arithmetic.
+
+The core conversion routines are strtodg for decimal -> binary conversions
+and gdtoa for binary -> decimal conversions.  These routines operate
+on arrays of unsigned 32-bit integers of type ULong, a signed 32-bit
+exponent of type Long, and arithmetic characteristics described in
+struct FPI; FPI, Long, and ULong are defined in gdtoa.h.  File arith.h
+is supposed to provide #defines that cause gdtoa.h to define its
+types correctly.  File arithchk.c is source for a program that
+generates a suitable arith.h on all systems where I've been able to
+test it.
+
+The core conversion routines are meant to be called by helper routines
+that know details of the particular binary arithmetic of interest and
+convert.  The present directory provides helper routines for 5 variants
+of IEEE binary floating-point arithmetic, each indicated by one or
+two letters:
+
+       f       IEEE single precision
+       d       IEEE double precision
+       x       IEEE extended precision, as on Intel 80x87
+               and software emulations of Motorola 68xxx chips
+               that do not pad the way the 68xxx does, but
+               only store 80 bits
+       xL      IEEE extended precision, as on Motorola 68xxx chips
+       Q       quad precision, as on Sun Sparc chips
+       dd      double double, pairs of IEEE double numbers
+               whose sum is the desired value
+
+For decimal -> binary conversions, there are three families of
+helper routines: one for round-nearest (or the current rounding
+mode on IEEE-arithmetic systems that provide the C99 fegetround()
+function, if compiled with -DHonor_FLT_ROUNDS):
+
+       strtof
+       strtod
+       strtodd
+       strtopd
+       strtopf
+       strtopx
+       strtopxL
+       strtopQ
+
+one with rounding direction specified:
+
+       strtorf
+       strtord
+       strtordd
+       strtorx
+       strtorxL
+       strtorQ
+
+and one for computing an interval (at most one bit wide) that contains
+the decimal number:
+
+       strtoIf
+       strtoId
+       strtoIdd
+       strtoIx
+       strtoIxL
+       strtoIQ
+
+The latter call strtoIg, which makes one call on strtodg and adjusts
+the result to provide the desired interval.  On systems where native
+arithmetic can easily make one-ulp adjustments on values in the
+desired floating-point format, it might be more efficient to use the
+native arithmetic.  Routine strtodI is a variant of strtoId that
+illustrates one way to do this for IEEE binary double-precision
+arithmetic -- but whether this is more efficient remains to be seen.
+
+Functions strtod and strtof have "natural" return types, float and
+double -- strtod is specified by the C standard, and strtof appears
+in the stdlib.h of some systems, such as (at least some) Linux systems.
+The other functions write their results to their final argument(s):
+to the final two argument for the strtoI... (interval) functions,
+and to the final argument for the others (strtop... and strtor...).
+Where possible, these arguments have "natural" return types (double*
+or float*), to permit at least some type checking.  In reality, they
+are viewed as arrays of ULong (or, for the "x" functions, UShort)
+values. On systems where long double is the appropriate type, one can
+pass long double* final argument(s) to these routines.  The int value
+that these routines return is the return value from the call they make
+on strtodg; see the enum of possible return values in gdtoa.h.
+
+Source files g_ddfmt.c, misc.c, smisc.c, strtod.c, strtodg.c, and ulp.c
+should use true IEEE double arithmetic (not, e.g., double extended),
+at least for storing (and viewing the bits of) the variables declared
+"double" within them.
+
+One detail indicated in struct FPI is whether the target binary
+arithmetic departs from the IEEE standard by flushing denormalized
+numbers to 0.  On systems that do this, the helper routines for
+conversion to double-double format (when compiled with
+Sudden_Underflow #defined) penalize the bottom of the exponent
+range so that they return a nonzero result only when the least
+significant bit of the less significant member of the pair of
+double values returned can be expressed as a normalized double
+value.  An alternative would be to drop to 53-bit precision near
+the bottom of the exponent range.  To get correct rounding, this
+would (in general) require two calls on strtodg (one specifying
+126-bit arithmetic, then, if necessary, one specifying 53-bit
+arithmetic).
+
+By default, the core routine strtodg and strtod set errno to ERANGE
+if the result overflows to +Infinity or underflows to 0.  Compile
+these routines with NO_ERRNO #defined to inhibit errno assignments.
+
+Routine strtod is based on netlib's "dtoa.c from fp", and
+(f = strtod(s,se)) is more efficient for some conversions than, say,
+strtord(s,se,1,&f).  Parts of strtod require true IEEE double
+arithmetic with the default rounding mode (round-to-nearest) and, on
+systems with IEEE extended-precision registers, double-precision
+(53-bit) rounding precision.  If the machine uses (the equivalent of)
+Intel 80x87 arithmetic, the call
+       _control87(PC_53, MCW_PC);
+does this with many compilers.  Whether this or another call is
+appropriate depends on the compiler; for this to work, it may be
+necessary to #include "float.h" or another system-dependent header
+file.
+
+Source file strtodnrp.c gives a strtod that does not require 53-bit
+rounding precision on systems (such as Intel IA32 systems) that may
+suffer double rounding due to use of extended-precision registers.
+For some conversions this variant of strtod is less efficient than the
+one in strtod.c when the latter is run with 53-bit rounding precision.
+
+The values that the strto* routines return for NaNs are determined by
+gd_qnan.h, which the makefile generates by running the program whose
+source is qnan.c.  Note that the rules for distinguishing signaling
+from quiet NaNs are system-dependent.  For cross-compilation, you need
+to determine arith.h and gd_qnan.h suitably, e.g., using the
+arithmetic of the target machine.
+
+C99's hexadecimal floating-point constants are recognized by the
+strto* routines (but this feature has not yet been heavily tested).
+Compiling with NO_HEX_FP #defined disables this feature.
+
+When compiled with -DINFNAN_CHECK, the strto* routines recognize C99's
+NaN and Infinity syntax.  Moreover, unless No_Hex_NaN is #defined, the
+strto* routines also recognize C99's NaN(...) syntax: they accept
+(case insensitively) strings of the form NaN(x), where x is a string
+of hexadecimal digits and spaces; if there is only one string of
+hexadecimal digits, it is taken for the fraction bits of the resulting
+NaN; if there are two or more strings of hexadecimal digits, each
+string is assigned to the next available sequence of 32-bit words of
+fractions bits (starting with the most significant), right-aligned in
+each sequence.
+
+For binary -> decimal conversions, I've provided just one family
+of helper routines:
+
+       g_ffmt
+       g_dfmt
+       g_ddfmt
+       g_xfmt
+       g_xLfmt
+       g_Qfmt
+
+which do a "%g" style conversion either to a specified number of decimal
+places (if their ndig argument is positive), or to the shortest
+decimal string that rounds to the given binary floating-point value
+(if ndig <= 0).  They write into a buffer supplied as an argument
+and return either a pointer to the end of the string (a null character)
+in the buffer, if the buffer was long enough, or 0.  Other forms of
+conversion are easily done with the help of gdtoa(), such as %e or %f
+style and conversions with direction of rounding specified (so that, if
+desired, the decimal value is either >= or <= the binary value).
+On IEEE-arithmetic systems that provide the C99 fegetround() function,
+if compiled with -DHonor_FLT_ROUNDS, these routines honor the current
+rounding mode.
+
+For an example of more general conversions based on dtoa(), see
+netlib's "printf.c from ampl/solvers".
+
+For double-double -> decimal, g_ddfmt() assumes IEEE-like arithmetic
+of precision max(126, #bits(input)) bits, where #bits(input) is the
+number of mantissa bits needed to represent the sum of the two double
+values in the input.
+
+The makefile creates a library, gdtoa.a.  To use the helper
+routines, a program only needs to include gdtoa.h.  All the
+source files for gdtoa.a include a more extensive gdtoaimp.h;
+among other things, gdtoaimp.h has #defines that make "internal"
+names end in _D2A.  To make a "system" library, one could modify
+these #defines to make the names start with __.
+
+Various comments about possible #defines appear in gdtoaimp.h,
+but for most purposes, arith.h should set suitable #defines.
+
+Systems with preemptive scheduling of multiple threads require some
+manual intervention.  On such systems, it's necessary to compile
+dmisc.c, dtoa.c gdota.c, and misc.c with MULTIPLE_THREADS #defined,
+and to provide (or suitably #define) two locks, acquired by
+ACQUIRE_DTOA_LOCK(n) and freed by FREE_DTOA_LOCK(n) for n = 0 or 1.
+(The second lock, accessed in pow5mult, ensures lazy evaluation of
+only one copy of high powers of 5; omitting this lock would introduce
+a small probability of wasting memory, but would otherwise be harmless.)
+Routines that call dtoa or gdtoa directly must also invoke freedtoa(s)
+to free the value s returned by dtoa or gdtoa.  It's OK to do so whether
+or not MULTIPLE_THREADS is #defined, and the helper g_*fmt routines
+listed above all do this indirectly (in gfmt_D2A(), which they all call).
+
+By default, there is a private pool of memory of length 2000 bytes
+for intermediate quantities, and MALLOC (see gdtoaimp.h) is called only
+if the private pool does not suffice.   2000 is large enough that MALLOC
+is called only under very unusual circumstances (decimal -> binary
+conversion of very long strings) for conversions to and from double
+precision.  For systems with preemptively scheduled multiple threads
+or for conversions to extended or quad, it may be appropriate to
+#define PRIVATE_MEM nnnn, where nnnn is a suitable value > 2000.
+For extended and quad precisions, -DPRIVATE_MEM=20000 is probably
+plenty even for many digits at the ends of the exponent range.
+Use of the private pool avoids some overhead.
+
+Directory test provides some test routines.  See its README.
+I've also tested this stuff (except double double conversions)
+with Vern Paxson's testbase program: see
+
+       V. Paxson and W. Kahan, "A Program for Testing IEEE Binary-Decimal
+       Conversion", manuscript, May 1991,
+       ftp://ftp.ee.lbl.gov/testbase-report.ps.Z .
+
+(The same ftp directory has source for testbase.)
+
+Some system-dependent additions to CFLAGS in the makefile:
+
+       HU-UX: -Aa -Ae
+       OSF (DEC Unix): -ieee_with_no_inexact
+       SunOS 4.1x: -DKR_headers -DBad_float_h
+
+If you want to put this stuff into a shared library and your
+operating system requires export lists for shared libraries,
+the following would be an appropriate export list:
+
+       dtoa
+       freedtoa
+       g_Qfmt
+       g_ddfmt
+       g_dfmt
+       g_ffmt
+       g_xLfmt
+       g_xfmt
+       gdtoa
+       strtoIQ
+       strtoId
+       strtoIdd
+       strtoIf
+       strtoIx
+       strtoIxL
+       strtod
+       strtodI
+       strtodg
+       strtof
+       strtopQ
+       strtopd
+       strtopdd
+       strtopf
+       strtopx
+       strtopxL
+       strtorQ
+       strtord
+       strtordd
+       strtorf
+       strtorx
+       strtorxL
+
+When time permits, I (dmg) hope to write in more detail about the
+present conversion routines; for now, this README file must suffice.
+Meanwhile, if you wish to write helper functions for other kinds of
+IEEE-like arithmetic, some explanation of struct FPI and the bits
+array may be helpful.  Both gdtoa and strtodg operate on a bits array
+described by FPI *fpi.  The bits array is of type ULong, a 32-bit
+unsigned integer type.  Floating-point numbers have fpi->nbits bits,
+with the least significant 32 bits in bits[0], the next 32 bits in
+bits[1], etc.  These numbers are regarded as integers multiplied by
+2^e (i.e., 2 to the power of the exponent e), where e is the second
+argument (be) to gdtoa and is stored in *exp by strtodg.  The minimum
+and maximum exponent values fpi->emin and fpi->emax for normalized
+floating-point numbers reflect this arrangement.  For example, the
+P754 standard for binary IEEE arithmetic specifies doubles as having
+53 bits, with normalized values of the form 1.xxxxx... times 2^(b-1023),
+with 52 bits (the x's) and the biased exponent b represented explicitly;
+b is an unsigned integer in the range 1 <= b <= 2046 for normalized
+finite doubles, b = 0 for denormals, and b = 2047 for Infinities and NaNs.
+To turn an IEEE double into the representation used by strtodg and gdtoa,
+we multiply 1.xxxx... by 2^52 (to make it an integer) and reduce the
+exponent e = (b-1023) by 52:
+
+       fpi->emin = 1 - 1023 - 52
+       fpi->emax = 1046 - 1023 - 52
+
+In various wrappers for IEEE double, we actually write -53 + 1 rather
+than -52, to emphasize that there are 53 bits including one implicit bit.
+Field fpi->rounding indicates the desired rounding direction, with
+possible values
+       FPI_Round_zero = toward 0,
+       FPI_Round_near = unbiased rounding -- the IEEE default,
+       FPI_Round_up = toward +Infinity, and
+       FPI_Round_down = toward -Infinity
+given in gdtoa.h.
+
+Field fpi->sudden_underflow indicates whether strtodg should return
+denormals or flush them to zero.  Normal floating-point numbers have
+bit fpi->nbits in the bits array on.  Denormals have it off, with
+exponent = fpi->emin.  Strtodg provides distinct return values for normals
+and denormals; see gdtoa.h.
+
+Compiling g__fmt.c, strtod.c, and strtodg.c with -DUSE_LOCALE causes
+the decimal-point character to be taken from the current locale; otherwise
+it is '.'.
+
+Source files dtoa.c and strtod.c in this directory are derived from
+netlib's "dtoa.c from fp" and are meant to function equivalently.
+When compiled with Honor_FLT_ROUNDS #defined (on systems that provide
+FLT_ROUNDS and fegetround() as specified in the C99 standard), they
+honor the current rounding mode.  Because FLT_ROUNDS is buggy on some
+(Linux) systems -- not reflecting calls on fesetround(), as the C99
+standard says it should -- when Honor_FLT_ROUNDS is #defined, the
+current rounding mode is obtained from fegetround() rather than from
+FLT_ROUNDS, unless Trust_FLT_ROUNDS is also #defined.
+
+Compile with -DUSE_LOCALE to use the current locale; otherwise
+decimal points are assumed to be '.'.  With -DUSE_LOCALE, unless
+you also compile with -DNO_LOCALE_CACHE, the details about the
+current "decimal point" character string are cached and assumed not
+to change during the program's execution.
+
+Please send comments to        David M. Gay (dmg at acm dot org, with " at "
+changed at "@" and " dot " changed to ".").
diff --git a/contrib/gdtoa/arithchk.c b/contrib/gdtoa/arithchk.c
new file mode 100644 (file)
index 0000000..3211aed
--- /dev/null
@@ -0,0 +1,183 @@
+/****************************************************************
+Copyright (C) 1997, 1998 Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+****************************************************************/
+
+/* Try to deduce arith.h from arithmetic properties. */
+
+#include <stdio.h>
+
+ static int dalign;
+ typedef struct
+Akind {
+       char *name;
+       int   kind;
+       } Akind;
+
+ static Akind
+IEEE_8087      = { "IEEE_8087", 1 },
+IEEE_MC68k     = { "IEEE_MC68k", 2 },
+IBM            = { "IBM", 3 },
+VAX            = { "VAX", 4 },
+CRAY           = { "CRAY", 5};
+
+ static Akind *
+Lcheck()
+{
+       union {
+               double d;
+               long L[2];
+               } u;
+       struct {
+               double d;
+               long L;
+               } x[2];
+
+       if (sizeof(x) > 2*(sizeof(double) + sizeof(long)))
+               dalign = 1;
+       u.L[0] = u.L[1] = 0;
+       u.d = 1e13;
+       if (u.L[0] == 1117925532 && u.L[1] == -448790528)
+               return &IEEE_MC68k;
+       if (u.L[1] == 1117925532 && u.L[0] == -448790528)
+               return &IEEE_8087;
+       if (u.L[0] == -2065213935 && u.L[1] == 10752)
+               return &VAX;
+       if (u.L[0] == 1267827943 && u.L[1] == 704643072)
+               return &IBM;
+       return 0;
+       }
+
+ static Akind *
+icheck()
+{
+       union {
+               double d;
+               int L[2];
+               } u;
+       struct {
+               double d;
+               int L;
+               } x[2];
+
+       if (sizeof(x) > 2*(sizeof(double) + sizeof(int)))
+               dalign = 1;
+       u.L[0] = u.L[1] = 0;
+       u.d = 1e13;
+       if (u.L[0] == 1117925532 && u.L[1] == -448790528)
+               return &IEEE_MC68k;
+       if (u.L[1] == 1117925532 && u.L[0] == -448790528)
+               return &IEEE_8087;
+       if (u.L[0] == -2065213935 && u.L[1] == 10752)
+               return &VAX;
+       if (u.L[0] == 1267827943 && u.L[1] == 704643072)
+               return &IBM;
+       return 0;
+       }
+
+char *emptyfmt = "";   /* avoid possible warning message with printf("") */
+
+ static Akind *
+ccheck()
+{
+       union {
+               double d;
+               long L;
+               } u;
+       long Cray1;
+
+       /* Cray1 = 4617762693716115456 -- without overflow on non-Crays */
+       Cray1 = printf(emptyfmt) < 0 ? 0 : 4617762;
+       if (printf(emptyfmt, Cray1) >= 0)
+               Cray1 = 1000000*Cray1 + 693716;
+       if (printf(emptyfmt, Cray1) >= 0)
+               Cray1 = 1000000*Cray1 + 115456;
+       u.d = 1e13;
+       if (u.L == Cray1)
+               return &CRAY;
+       return 0;
+       }
+
+ static int
+fzcheck()
+{
+       double a, b;
+       int i;
+
+       a = 1.;
+       b = .1;
+       for(i = 155;; b *= b, i >>= 1) {
+               if (i & 1) {
+                       a *= b;
+                       if (i == 1)
+                               break;
+                       }
+               }
+       b = a * a;
+       return b == 0.;
+       }
+
+ int
+main()
+{
+       Akind *a = 0;
+       int Ldef = 0;
+       FILE *f;
+
+#ifdef WRITE_ARITH_H   /* for Symantec's buggy "make" */
+       f = fopen("arith.h", "w");
+       if (!f) {
+               printf("Cannot open arith.h\n");
+               return 1;
+               }
+#else
+       f = stdout;
+#endif
+
+       if (sizeof(double) == 2*sizeof(long))
+               a = Lcheck();
+       else if (sizeof(double) == 2*sizeof(int)) {
+               Ldef = 1;
+               a = icheck();
+               }
+       else if (sizeof(double) == sizeof(long))
+               a = ccheck();
+       if (a) {
+               fprintf(f, "#define %s\n#define Arith_Kind_ASL %d\n",
+                       a->name, a->kind);
+               if (Ldef)
+                       fprintf(f, "#define Long int\n#define Intcast (int)(long)\n");
+               if (dalign)
+                       fprintf(f, "#define Double_Align\n");
+               if (sizeof(char*) == 8)
+                       fprintf(f, "#define X64_bit_pointers\n");
+#ifndef NO_LONG_LONG
+               if (sizeof(long long) < 8)
+#endif
+                       fprintf(f, "#define NO_LONG_LONG\n");
+               if (a->kind <= 2 && fzcheck())
+                       fprintf(f, "#define Sudden_Underflow\n");
+               return 0;
+               }
+       fprintf(f, "/* Unknown arithmetic */\n");
+       return 1;
+       }
diff --git a/contrib/gdtoa/dmisc.c b/contrib/gdtoa/dmisc.c
new file mode 100644 (file)
index 0000000..ce170c7
--- /dev/null
@@ -0,0 +1,216 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+#ifndef MULTIPLE_THREADS
+ char *dtoa_result;
+#endif
+
+ char *
+#ifdef KR_headers
+rv_alloc(i) int i;
+#else
+rv_alloc(int i)
+#endif
+{
+       int j, k, *r;
+
+       j = sizeof(ULong);
+       for(k = 0;
+               sizeof(Bigint) - sizeof(ULong) - sizeof(int) + j <= i;
+               j <<= 1)
+                       k++;
+       r = (int*)Balloc(k);
+       *r = k;
+       return
+#ifndef MULTIPLE_THREADS
+       dtoa_result =
+#endif
+               (char *)(r+1);
+       }
+
+ char *
+#ifdef KR_headers
+nrv_alloc(s, rve, n) char *s, **rve; int n;
+#else
+nrv_alloc(char *s, char **rve, int n)
+#endif
+{
+       char *rv, *t;
+
+       t = rv = rv_alloc(n);
+       while((*t = *s++) !=0)
+               t++;
+       if (rve)
+               *rve = t;
+       return rv;
+       }
+
+/* freedtoa(s) must be used to free values s returned by dtoa
+ * when MULTIPLE_THREADS is #defined.  It should be used in all cases,
+ * but for consistency with earlier versions of dtoa, it is optional
+ * when MULTIPLE_THREADS is not defined.
+ */
+
+ void
+#ifdef KR_headers
+freedtoa(s) char *s;
+#else
+freedtoa(char *s)
+#endif
+{
+       Bigint *b = (Bigint *)((int *)s - 1);
+       b->maxwds = 1 << (b->k = *(int*)b);
+       Bfree(b);
+#ifndef MULTIPLE_THREADS
+       if (s == dtoa_result)
+               dtoa_result = 0;
+#endif
+       }
+
+ int
+quorem
+#ifdef KR_headers
+       (b, S) Bigint *b, *S;
+#else
+       (Bigint *b, Bigint *S)
+#endif
+{
+       int n;
+       ULong *bx, *bxe, q, *sx, *sxe;
+#ifdef ULLong
+       ULLong borrow, carry, y, ys;
+#else
+       ULong borrow, carry, y, ys;
+#ifdef Pack_32
+       ULong si, z, zs;
+#endif
+#endif
+
+       n = S->wds;
+#ifdef DEBUG
+       /*debug*/ if (b->wds > n)
+       /*debug*/       Bug("oversize b in quorem");
+#endif
+       if (b->wds < n)
+               return 0;
+       sx = S->x;
+       sxe = sx + --n;
+       bx = b->x;
+       bxe = bx + n;
+       q = *bxe / (*sxe + 1);  /* ensure q <= true quotient */
+#ifdef DEBUG
+       /*debug*/ if (q > 9)
+       /*debug*/       Bug("oversized quotient in quorem");
+#endif
+       if (q) {
+               borrow = 0;
+               carry = 0;
+               do {
+#ifdef ULLong
+                       ys = *sx++ * (ULLong)q + carry;
+                       carry = ys >> 32;
+                       y = *bx - (ys & 0xffffffffUL) - borrow;
+                       borrow = y >> 32 & 1UL;
+                       *bx++ = y & 0xffffffffUL;
+#else
+#ifdef Pack_32
+                       si = *sx++;
+                       ys = (si & 0xffff) * q + carry;
+                       zs = (si >> 16) * q + (ys >> 16);
+                       carry = zs >> 16;
+                       y = (*bx & 0xffff) - (ys & 0xffff) - borrow;
+                       borrow = (y & 0x10000) >> 16;
+                       z = (*bx >> 16) - (zs & 0xffff) - borrow;
+                       borrow = (z & 0x10000) >> 16;
+                       Storeinc(bx, z, y);
+#else
+                       ys = *sx++ * q + carry;
+                       carry = ys >> 16;
+                       y = *bx - (ys & 0xffff) - borrow;
+                       borrow = (y & 0x10000) >> 16;
+                       *bx++ = y & 0xffff;
+#endif
+#endif
+                       }
+                       while(sx <= sxe);
+               if (!*bxe) {
+                       bx = b->x;
+                       while(--bxe > bx && !*bxe)
+                               --n;
+                       b->wds = n;
+                       }
+               }
+       if (cmp(b, S) >= 0) {
+               q++;
+               borrow = 0;
+               carry = 0;
+               bx = b->x;
+               sx = S->x;
+               do {
+#ifdef ULLong
+                       ys = *sx++ + carry;
+                       carry = ys >> 32;
+                       y = *bx - (ys & 0xffffffffUL) - borrow;
+                       borrow = y >> 32 & 1UL;
+                       *bx++ = y & 0xffffffffUL;
+#else
+#ifdef Pack_32
+                       si = *sx++;
+                       ys = (si & 0xffff) + carry;
+                       zs = (si >> 16) + (ys >> 16);
+                       carry = zs >> 16;
+                       y = (*bx & 0xffff) - (ys & 0xffff) - borrow;
+                       borrow = (y & 0x10000) >> 16;
+                       z = (*bx >> 16) - (zs & 0xffff) - borrow;
+                       borrow = (z & 0x10000) >> 16;
+                       Storeinc(bx, z, y);
+#else
+                       ys = *sx++ + carry;
+                       carry = ys >> 16;
+                       y = *bx - (ys & 0xffff) - borrow;
+                       borrow = (y & 0x10000) >> 16;
+                       *bx++ = y & 0xffff;
+#endif
+#endif
+                       }
+                       while(sx <= sxe);
+               bx = b->x;
+               bxe = bx + n;
+               if (!*bxe) {
+                       while(--bxe > bx && !*bxe)
+                               --n;
+                       b->wds = n;
+                       }
+               }
+       return q;
+       }
diff --git a/contrib/gdtoa/dtoa.c b/contrib/gdtoa/dtoa.c
new file mode 100644 (file)
index 0000000..48fdf5e
--- /dev/null
@@ -0,0 +1,762 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998, 1999 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+/* dtoa for IEEE arithmetic (dmg): convert double to ASCII string.
+ *
+ * Inspired by "How to Print Floating-Point Numbers Accurately" by
+ * Guy L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90, pp. 112-126].
+ *
+ * Modifications:
+ *     1. Rather than iterating, we use a simple numeric overestimate
+ *        to determine k = floor(log10(d)).  We scale relevant
+ *        quantities using O(log2(k)) rather than O(k) multiplications.
+ *     2. For some modes > 2 (corresponding to ecvt and fcvt), we don't
+ *        try to generate digits strictly left to right.  Instead, we
+ *        compute with fewer bits and propagate the carry if necessary
+ *        when rounding the final digit up.  This is often faster.
+ *     3. Under the assumption that input will be rounded nearest,
+ *        mode 0 renders 1e23 as 1e23 rather than 9.999999999999999e22.
+ *        That is, we allow equality in stopping tests when the
+ *        round-nearest rule will give the same floating-point value
+ *        as would satisfaction of the stopping test with strict
+ *        inequality.
+ *     4. We remove common factors of powers of 2 from relevant
+ *        quantities.
+ *     5. When converting floating-point integers less than 1e16,
+ *        we use floating-point arithmetic rather than resorting
+ *        to multiple-precision integers.
+ *     6. When asked to produce fewer than 15 digits, we first try
+ *        to get by with floating-point arithmetic; we resort to
+ *        multiple-precision integer arithmetic only if we cannot
+ *        guarantee that the floating-point calculation has given
+ *        the correctly rounded result.  For k requested digits and
+ *        "uniformly" distributed input, the probability is
+ *        something like 10^(k-15) that we must resort to the Long
+ *        calculation.
+ */
+
+#ifdef Honor_FLT_ROUNDS
+#undef Check_FLT_ROUNDS
+#define Check_FLT_ROUNDS
+#else
+#define Rounding Flt_Rounds
+#endif
+
+ char *
+dtoa
+#ifdef KR_headers
+       (d, mode, ndigits, decpt, sign, rve)
+       double d; int mode, ndigits, *decpt, *sign; char **rve;
+#else
+       (double d, int mode, int ndigits, int *decpt, int *sign, char **rve)
+#endif
+{
+ /*    Arguments ndigits, decpt, sign are similar to those
+       of ecvt and fcvt; trailing zeros are suppressed from
+       the returned string.  If not null, *rve is set to point
+       to the end of the return value.  If d is +-Infinity or NaN,
+       then *decpt is set to 9999.
+
+       mode:
+               0 ==> shortest string that yields d when read in
+                       and rounded to nearest.
+               1 ==> like 0, but with Steele & White stopping rule;
+                       e.g. with IEEE P754 arithmetic , mode 0 gives
+                       1e23 whereas mode 1 gives 9.999999999999999e22.
+               2 ==> max(1,ndigits) significant digits.  This gives a
+                       return value similar to that of ecvt, except
+                       that trailing zeros are suppressed.
+               3 ==> through ndigits past the decimal point.  This
+                       gives a return value similar to that from fcvt,
+                       except that trailing zeros are suppressed, and
+                       ndigits can be negative.
+               4,5 ==> similar to 2 and 3, respectively, but (in
+                       round-nearest mode) with the tests of mode 0 to
+                       possibly return a shorter string that rounds to d.
+                       With IEEE arithmetic and compilation with
+                       -DHonor_FLT_ROUNDS, modes 4 and 5 behave the same
+                       as modes 2 and 3 when FLT_ROUNDS != 1.
+               6-9 ==> Debugging modes similar to mode - 4:  don't try
+                       fast floating-point estimate (if applicable).
+
+               Values of mode other than 0-9 are treated as mode 0.
+
+               Sufficient space is allocated to the return value
+               to hold the suppressed trailing zeros.
+       */
+
+       int bbits, b2, b5, be, dig, i, ieps, ilim, ilim0, ilim1,
+               j, j1, k, k0, k_check, leftright, m2, m5, s2, s5,
+               spec_case, try_quick;
+       Long L;
+#ifndef Sudden_Underflow
+       int denorm;
+       ULong x;
+#endif
+       Bigint *b, *b1, *delta, *mlo, *mhi, *S;
+       double d2, ds, eps;
+       char *s, *s0;
+#ifdef SET_INEXACT
+       int inexact, oldinexact;
+#endif
+#ifdef Honor_FLT_ROUNDS /*{*/
+       int Rounding;
+#ifdef Trust_FLT_ROUNDS /*{{ only define this if FLT_ROUNDS really works! */
+       Rounding = Flt_Rounds;
+#else /*}{*/
+       Rounding = 1;
+       switch(fegetround()) {
+         case FE_TOWARDZERO:   Rounding = 0; break;
+         case FE_UPWARD:       Rounding = 2; break;
+         case FE_DOWNWARD:     Rounding = 3;
+         }
+#endif /*}}*/
+#endif /*}*/
+
+#ifndef MULTIPLE_THREADS
+       if (dtoa_result) {
+               freedtoa(dtoa_result);
+               dtoa_result = 0;
+               }
+#endif
+
+       if (word0(d) & Sign_bit) {
+               /* set sign for everything, including 0's and NaNs */
+               *sign = 1;
+               word0(d) &= ~Sign_bit;  /* clear sign bit */
+               }
+       else
+               *sign = 0;
+
+#if defined(IEEE_Arith) + defined(VAX)
+#ifdef IEEE_Arith
+       if ((word0(d) & Exp_mask) == Exp_mask)
+#else
+       if (word0(d)  == 0x8000)
+#endif
+               {
+               /* Infinity or NaN */
+               *decpt = 9999;
+#ifdef IEEE_Arith
+               if (!word1(d) && !(word0(d) & 0xfffff))
+                       return nrv_alloc("Infinity", rve, 8);
+#endif
+               return nrv_alloc("NaN", rve, 3);
+               }
+#endif
+#ifdef IBM
+       dval(d) += 0; /* normalize */
+#endif
+       if (!dval(d)) {
+               *decpt = 1;
+               return nrv_alloc("0", rve, 1);
+               }
+
+#ifdef SET_INEXACT
+       try_quick = oldinexact = get_inexact();
+       inexact = 1;
+#endif
+#ifdef Honor_FLT_ROUNDS
+       if (Rounding >= 2) {
+               if (*sign)
+                       Rounding = Rounding == 2 ? 0 : 2;
+               else
+                       if (Rounding != 2)
+                               Rounding = 0;
+               }
+#endif
+
+       b = d2b(dval(d), &be, &bbits);
+#ifdef Sudden_Underflow
+       i = (int)(word0(d) >> Exp_shift1 & (Exp_mask>>Exp_shift1));
+#else
+       if (( i = (int)(word0(d) >> Exp_shift1 & (Exp_mask>>Exp_shift1)) )!=0) {
+#endif
+               dval(d2) = dval(d);
+               word0(d2) &= Frac_mask1;
+               word0(d2) |= Exp_11;
+#ifdef IBM
+               if (( j = 11 - hi0bits(word0(d2) & Frac_mask) )!=0)
+                       dval(d2) /= 1 << j;
+#endif
+
+               /* log(x)       ~=~ log(1.5) + (x-1.5)/1.5
+                * log10(x)      =  log(x) / log(10)
+                *              ~=~ log(1.5)/log(10) + (x-1.5)/(1.5*log(10))
+                * log10(d) = (i-Bias)*log(2)/log(10) + log10(d2)
+                *
+                * This suggests computing an approximation k to log10(d) by
+                *
+                * k = (i - Bias)*0.301029995663981
+                *      + ( (d2-1.5)*0.289529654602168 + 0.176091259055681 );
+                *
+                * We want k to be too large rather than too small.
+                * The error in the first-order Taylor series approximation
+                * is in our favor, so we just round up the constant enough
+                * to compensate for any error in the multiplication of
+                * (i - Bias) by 0.301029995663981; since |i - Bias| <= 1077,
+                * and 1077 * 0.30103 * 2^-52 ~=~ 7.2e-14,
+                * adding 1e-13 to the constant term more than suffices.
+                * Hence we adjust the constant term to 0.1760912590558.
+                * (We could get a more accurate k by invoking log10,
+                *  but this is probably not worthwhile.)
+                */
+
+               i -= Bias;
+#ifdef IBM
+               i <<= 2;
+               i += j;
+#endif
+#ifndef Sudden_Underflow
+               denorm = 0;
+               }
+       else {
+               /* d is denormalized */
+
+               i = bbits + be + (Bias + (P-1) - 1);
+               x = i > 32  ? word0(d) << 64 - i | word1(d) >> i - 32
+                           : word1(d) << 32 - i;
+               dval(d2) = x;
+               word0(d2) -= 31*Exp_msk1; /* adjust exponent */
+               i -= (Bias + (P-1) - 1) + 1;
+               denorm = 1;
+               }
+#endif
+       ds = (dval(d2)-1.5)*0.289529654602168 + 0.1760912590558 + i*0.301029995663981;
+       k = (int)ds;
+       if (ds < 0. && ds != k)
+               k--;    /* want k = floor(ds) */
+       k_check = 1;
+       if (k >= 0 && k <= Ten_pmax) {
+               if (dval(d) < tens[k])
+                       k--;
+               k_check = 0;
+               }
+       j = bbits - i - 1;
+       if (j >= 0) {
+               b2 = 0;
+               s2 = j;
+               }
+       else {
+               b2 = -j;
+               s2 = 0;
+               }
+       if (k >= 0) {
+               b5 = 0;
+               s5 = k;
+               s2 += k;
+               }
+       else {
+               b2 -= k;
+               b5 = -k;
+               s5 = 0;
+               }
+       if (mode < 0 || mode > 9)
+               mode = 0;
+
+#ifndef SET_INEXACT
+#ifdef Check_FLT_ROUNDS
+       try_quick = Rounding == 1;
+#else
+       try_quick = 1;
+#endif
+#endif /*SET_INEXACT*/
+
+       if (mode > 5) {
+               mode -= 4;
+               try_quick = 0;
+               }
+       leftright = 1;
+       switch(mode) {
+               case 0:
+               case 1:
+                       ilim = ilim1 = -1;
+                       i = 18;
+                       ndigits = 0;
+                       break;
+               case 2:
+                       leftright = 0;
+                       /* no break */
+               case 4:
+                       if (ndigits <= 0)
+                               ndigits = 1;
+                       ilim = ilim1 = i = ndigits;
+                       break;
+               case 3:
+                       leftright = 0;
+                       /* no break */
+               case 5:
+                       i = ndigits + k + 1;
+                       ilim = i;
+                       ilim1 = i - 1;
+                       if (i <= 0)
+                               i = 1;
+               }
+       s = s0 = rv_alloc(i);
+
+#ifdef Honor_FLT_ROUNDS
+       if (mode > 1 && Rounding != 1)
+               leftright = 0;
+#endif
+
+       if (ilim >= 0 && ilim <= Quick_max && try_quick) {
+
+               /* Try to get by with floating-point arithmetic. */
+
+               i = 0;
+               dval(d2) = dval(d);
+               k0 = k;
+               ilim0 = ilim;
+               ieps = 2; /* conservative */
+               if (k > 0) {
+                       ds = tens[k&0xf];
+                       j = k >> 4;
+                       if (j & Bletch) {
+                               /* prevent overflows */
+                               j &= Bletch - 1;
+                               dval(d) /= bigtens[n_bigtens-1];
+                               ieps++;
+                               }
+                       for(; j; j >>= 1, i++)
+                               if (j & 1) {
+                                       ieps++;
+                                       ds *= bigtens[i];
+                                       }
+                       dval(d) /= ds;
+                       }
+               else if (( j1 = -k )!=0) {
+                       dval(d) *= tens[j1 & 0xf];
+                       for(j = j1 >> 4; j; j >>= 1, i++)
+                               if (j & 1) {
+                                       ieps++;
+                                       dval(d) *= bigtens[i];
+                                       }
+                       }
+               if (k_check && dval(d) < 1. && ilim > 0) {
+                       if (ilim1 <= 0)
+                               goto fast_failed;
+                       ilim = ilim1;
+                       k--;
+                       dval(d) *= 10.;
+                       ieps++;
+                       }
+               dval(eps) = ieps*dval(d) + 7.;
+               word0(eps) -= (P-1)*Exp_msk1;
+               if (ilim == 0) {
+                       S = mhi = 0;
+                       dval(d) -= 5.;
+                       if (dval(d) > dval(eps))
+                               goto one_digit;
+                       if (dval(d) < -dval(eps))
+                               goto no_digits;
+                       goto fast_failed;
+                       }
+#ifndef No_leftright
+               if (leftright) {
+                       /* Use Steele & White method of only
+                        * generating digits needed.
+                        */
+                       dval(eps) = 0.5/tens[ilim-1] - dval(eps);
+                       for(i = 0;;) {
+                               L = dval(d);
+                               dval(d) -= L;
+                               *s++ = '0' + (int)L;
+                               if (dval(d) < dval(eps))
+                                       goto ret1;
+                               if (1. - dval(d) < dval(eps))
+                                       goto bump_up;
+                               if (++i >= ilim)
+                                       break;
+                               dval(eps) *= 10.;
+                               dval(d) *= 10.;
+                               }
+                       }
+               else {
+#endif
+                       /* Generate ilim digits, then fix them up. */
+                       dval(eps) *= tens[ilim-1];
+                       for(i = 1;; i++, dval(d) *= 10.) {
+                               L = (Long)(dval(d));
+                               if (!(dval(d) -= L))
+                                       ilim = i;
+                               *s++ = '0' + (int)L;
+                               if (i == ilim) {
+                                       if (dval(d) > 0.5 + dval(eps))
+                                               goto bump_up;
+                                       else if (dval(d) < 0.5 - dval(eps)) {
+                                               while(*--s == '0');
+                                               s++;
+                                               goto ret1;
+                                               }
+                                       break;
+                                       }
+                               }
+#ifndef No_leftright
+                       }
+#endif
+ fast_failed:
+               s = s0;
+               dval(d) = dval(d2);
+               k = k0;
+               ilim = ilim0;
+               }
+
+       /* Do we have a "small" integer? */
+
+       if (be >= 0 && k <= Int_max) {
+               /* Yes. */
+               ds = tens[k];
+               if (ndigits < 0 && ilim <= 0) {
+                       S = mhi = 0;
+                       if (ilim < 0 || dval(d) <= 5*ds)
+                               goto no_digits;
+                       goto one_digit;
+                       }
+               for(i = 1;; i++, dval(d) *= 10.) {
+                       L = (Long)(dval(d) / ds);
+                       dval(d) -= L*ds;
+#ifdef Check_FLT_ROUNDS
+                       /* If FLT_ROUNDS == 2, L will usually be high by 1 */
+                       if (dval(d) < 0) {
+                               L--;
+                               dval(d) += ds;
+                               }
+#endif
+                       *s++ = '0' + (int)L;
+                       if (!dval(d)) {
+#ifdef SET_INEXACT
+                               inexact = 0;
+#endif
+                               break;
+                               }
+                       if (i == ilim) {
+#ifdef Honor_FLT_ROUNDS
+                               if (mode > 1)
+                               switch(Rounding) {
+                                 case 0: goto ret1;
+                                 case 2: goto bump_up;
+                                 }
+#endif
+                               dval(d) += dval(d);
+                               if (dval(d) > ds || dval(d) == ds && L & 1) {
+ bump_up:
+                                       while(*--s == '9')
+                                               if (s == s0) {
+                                                       k++;
+                                                       *s = '0';
+                                                       break;
+                                                       }
+                                       ++*s++;
+                                       }
+                               break;
+                               }
+                       }
+               goto ret1;
+               }
+
+       m2 = b2;
+       m5 = b5;
+       mhi = mlo = 0;
+       if (leftright) {
+               i =
+#ifndef Sudden_Underflow
+                       denorm ? be + (Bias + (P-1) - 1 + 1) :
+#endif
+#ifdef IBM
+                       1 + 4*P - 3 - bbits + ((bbits + be - 1) & 3);
+#else
+                       1 + P - bbits;
+#endif
+               b2 += i;
+               s2 += i;
+               mhi = i2b(1);
+               }
+       if (m2 > 0 && s2 > 0) {
+               i = m2 < s2 ? m2 : s2;
+               b2 -= i;
+               m2 -= i;
+               s2 -= i;
+               }
+       if (b5 > 0) {
+               if (leftright) {
+                       if (m5 > 0) {
+                               mhi = pow5mult(mhi, m5);
+                               b1 = mult(mhi, b);
+                               Bfree(b);
+                               b = b1;
+                               }
+                       if (( j = b5 - m5 )!=0)
+                               b = pow5mult(b, j);
+                       }
+               else
+                       b = pow5mult(b, b5);
+               }
+       S = i2b(1);
+       if (s5 > 0)
+               S = pow5mult(S, s5);
+
+       /* Check for special case that d is a normalized power of 2. */
+
+       spec_case = 0;
+       if ((mode < 2 || leftright)
+#ifdef Honor_FLT_ROUNDS
+                       && Rounding == 1
+#endif
+                               ) {
+               if (!word1(d) && !(word0(d) & Bndry_mask)
+#ifndef Sudden_Underflow
+                && word0(d) & (Exp_mask & ~Exp_msk1)
+#endif
+                               ) {
+                       /* The special case */
+                       b2 += Log2P;
+                       s2 += Log2P;
+                       spec_case = 1;
+                       }
+               }
+
+       /* Arrange for convenient computation of quotients:
+        * shift left if necessary so divisor has 4 leading 0 bits.
+        *
+        * Perhaps we should just compute leading 28 bits of S once
+        * and for all and pass them and a shift to quorem, so it
+        * can do shifts and ors to compute the numerator for q.
+        */
+#ifdef Pack_32
+       if (( i = ((s5 ? 32 - hi0bits(S->x[S->wds-1]) : 1) + s2) & 0x1f )!=0)
+               i = 32 - i;
+#else
+       if (( i = ((s5 ? 32 - hi0bits(S->x[S->wds-1]) : 1) + s2) & 0xf )!=0)
+               i = 16 - i;
+#endif
+       if (i > 4) {
+               i -= 4;
+               b2 += i;
+               m2 += i;
+               s2 += i;
+               }
+       else if (i < 4) {
+               i += 28;
+               b2 += i;
+               m2 += i;
+               s2 += i;
+               }
+       if (b2 > 0)
+               b = lshift(b, b2);
+       if (s2 > 0)
+               S = lshift(S, s2);
+       if (k_check) {
+               if (cmp(b,S) < 0) {
+                       k--;
+                       b = multadd(b, 10, 0);  /* we botched the k estimate */
+                       if (leftright)
+                               mhi = multadd(mhi, 10, 0);
+                       ilim = ilim1;
+                       }
+               }
+       if (ilim <= 0 && (mode == 3 || mode == 5)) {
+               if (ilim < 0 || cmp(b,S = multadd(S,5,0)) <= 0) {
+                       /* no digits, fcvt style */
+ no_digits:
+                       k = -1 - ndigits;
+                       goto ret;
+                       }
+ one_digit:
+               *s++ = '1';
+               k++;
+               goto ret;
+               }
+       if (leftright) {
+               if (m2 > 0)
+                       mhi = lshift(mhi, m2);
+
+               /* Compute mlo -- check for special case
+                * that d is a normalized power of 2.
+                */
+
+               mlo = mhi;
+               if (spec_case) {
+                       mhi = Balloc(mhi->k);
+                       Bcopy(mhi, mlo);
+                       mhi = lshift(mhi, Log2P);
+                       }
+
+               for(i = 1;;i++) {
+                       dig = quorem(b,S) + '0';
+                       /* Do we yet have the shortest decimal string
+                        * that will round to d?
+                        */
+                       j = cmp(b, mlo);
+                       delta = diff(S, mhi);
+                       j1 = delta->sign ? 1 : cmp(b, delta);
+                       Bfree(delta);
+#ifndef ROUND_BIASED
+                       if (j1 == 0 && mode != 1 && !(word1(d) & 1)
+#ifdef Honor_FLT_ROUNDS
+                               && Rounding >= 1
+#endif
+                                                                  ) {
+                               if (dig == '9')
+                                       goto round_9_up;
+                               if (j > 0)
+                                       dig++;
+#ifdef SET_INEXACT
+                               else if (!b->x[0] && b->wds <= 1)
+                                       inexact = 0;
+#endif
+                               *s++ = dig;
+                               goto ret;
+                               }
+#endif
+                       if (j < 0 || j == 0 && mode != 1
+#ifndef ROUND_BIASED
+                                                       && !(word1(d) & 1)
+#endif
+                                       ) {
+                               if (!b->x[0] && b->wds <= 1) {
+#ifdef SET_INEXACT
+                                       inexact = 0;
+#endif
+                                       goto accept_dig;
+                                       }
+#ifdef Honor_FLT_ROUNDS
+                               if (mode > 1)
+                                switch(Rounding) {
+                                 case 0: goto accept_dig;
+                                 case 2: goto keep_dig;
+                                 }
+#endif /*Honor_FLT_ROUNDS*/
+                               if (j1 > 0) {
+                                       b = lshift(b, 1);
+                                       j1 = cmp(b, S);
+                                       if ((j1 > 0 || j1 == 0 && dig & 1)
+                                       && dig++ == '9')
+                                               goto round_9_up;
+                                       }
+ accept_dig:
+                               *s++ = dig;
+                               goto ret;
+                               }
+                       if (j1 > 0) {
+#ifdef Honor_FLT_ROUNDS
+                               if (!Rounding)
+                                       goto accept_dig;
+#endif
+                               if (dig == '9') { /* possible if i == 1 */
+ round_9_up:
+                                       *s++ = '9';
+                                       goto roundoff;
+                                       }
+                               *s++ = dig + 1;
+                               goto ret;
+                               }
+#ifdef Honor_FLT_ROUNDS
+ keep_dig:
+#endif
+                       *s++ = dig;
+                       if (i == ilim)
+                               break;
+                       b = multadd(b, 10, 0);
+                       if (mlo == mhi)
+                               mlo = mhi = multadd(mhi, 10, 0);
+                       else {
+                               mlo = multadd(mlo, 10, 0);
+                               mhi = multadd(mhi, 10, 0);
+                               }
+                       }
+               }
+       else
+               for(i = 1;; i++) {
+                       *s++ = dig = quorem(b,S) + '0';
+                       if (!b->x[0] && b->wds <= 1) {
+#ifdef SET_INEXACT
+                               inexact = 0;
+#endif
+                               goto ret;
+                               }
+                       if (i >= ilim)
+                               break;
+                       b = multadd(b, 10, 0);
+                       }
+
+       /* Round off last digit */
+
+#ifdef Honor_FLT_ROUNDS
+       switch(Rounding) {
+         case 0: goto trimzeros;
+         case 2: goto roundoff;
+         }
+#endif
+       b = lshift(b, 1);
+       j = cmp(b, S);
+       if (j > 0 || j == 0 && dig & 1) {
+ roundoff:
+               while(*--s == '9')
+                       if (s == s0) {
+                               k++;
+                               *s++ = '1';
+                               goto ret;
+                               }
+               ++*s++;
+               }
+       else {
+ trimzeros:
+               while(*--s == '0');
+               s++;
+               }
+ ret:
+       Bfree(S);
+       if (mhi) {
+               if (mlo && mlo != mhi)
+                       Bfree(mlo);
+               Bfree(mhi);
+               }
+ ret1:
+#ifdef SET_INEXACT
+       if (inexact) {
+               if (!oldinexact) {
+                       word0(d) = Exp_1 + (70 << Exp_shift);
+                       word1(d) = 0;
+                       dval(d) += 1.;
+                       }
+               }
+       else if (!oldinexact)
+               clear_inexact();
+#endif
+       Bfree(b);
+       *s = 0;
+       *decpt = k + 1;
+       if (rve)
+               *rve = s;
+       return s0;
+       }
diff --git a/contrib/gdtoa/g_Qfmt.c b/contrib/gdtoa/g_Qfmt.c
new file mode 100644 (file)
index 0000000..15d1bdd
--- /dev/null
@@ -0,0 +1,119 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998, 2000 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+#undef _0
+#undef _1
+
+/* one or the other of IEEE_MC68k or IEEE_8087 should be #defined */
+
+#ifdef IEEE_MC68k
+#define _0 0
+#define _1 1
+#define _2 2
+#define _3 3
+#endif
+#ifdef IEEE_8087
+#define _0 3
+#define _1 2
+#define _2 1
+#define _3 0
+#endif
+
+ char*
+#ifdef KR_headers
+g_Qfmt(buf, V, ndig, bufsize) char *buf; char *V; int ndig; size_t bufsize;
+#else
+g_Qfmt(char *buf, void *V, int ndig, size_t bufsize)
+#endif
+{
+       static FPI fpi0 = { 113, 1-16383-113+1, 32766 - 16383 - 113 + 1, 1, 0 };
+       char *b, *s, *se;
+       ULong bits[4], *L, sign;
+       int decpt, ex, i, mode;
+#ifdef Honor_FLT_ROUNDS
+#include "gdtoa_fltrnds.h"
+#else
+#define fpi &fpi0
+#endif
+
+       if (ndig < 0)
+               ndig = 0;
+       if (bufsize < ndig + 10)
+               return 0;
+
+       L = (ULong*)V;
+       sign = L[_0] & 0x80000000L;
+       bits[3] = L[_0] & 0xffff;
+       bits[2] = L[_1];
+       bits[1] = L[_2];
+       bits[0] = L[_3];
+       b = buf;
+       if ( (ex = (L[_0] & 0x7fff0000L) >> 16) !=0) {
+               if (ex == 0x7fff) {
+                       /* Infinity or NaN */
+                       if (bits[0] | bits[1] | bits[2] | bits[3])
+                               b = strcp(b, "NaN");
+                       else {
+                               b = buf;
+                               if (sign)
+                                       *b++ = '-';
+                               b = strcp(b, "Infinity");
+                               }
+                       return b;
+                       }
+               i = STRTOG_Normal;
+               bits[3] |= 0x10000;
+               }
+       else if (bits[0] | bits[1] | bits[2] | bits[3]) {
+               i = STRTOG_Denormal;
+               ex = 1;
+               }
+       else {
+#ifndef IGNORE_ZERO_SIGN
+               if (sign)
+                       *b++ = '-';
+#endif
+               *b++ = '0';
+               *b = 0;
+               return b;
+               }
+       ex -= 0x3fff + 112;
+       mode = 2;
+       if (ndig <= 0) {
+               if (bufsize < 48)
+                       return 0;
+               mode = 0;
+               }
+       s = gdtoa(fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+       return g__fmt(buf, s, se, decpt, sign, bufsize);
+       }
diff --git a/contrib/gdtoa/g__fmt.c b/contrib/gdtoa/g__fmt.c
new file mode 100644 (file)
index 0000000..fbccb7d
--- /dev/null
@@ -0,0 +1,147 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+#ifdef USE_LOCALE
+#include "locale.h"
+#endif
+
+ char *
+#ifdef KR_headers
+g__fmt(b, s, se, decpt, sign, blen) char *b; char *s; char *se; int decpt; ULong sign; size_t blen;
+#else
+g__fmt(char *b, char *s, char *se, int decpt, ULong sign, size_t blen)
+#endif
+{
+       int i, j, k;
+       char *be, *s0;
+       size_t len;
+#ifdef USE_LOCALE
+#ifdef NO_LOCALE_CACHE
+       char *decimalpoint = localeconv()->decimal_point;
+       size_t dlen = strlen(decimalpoint);
+#else
+       char *decimalpoint;
+       static char *decimalpoint_cache;
+       static size_t dlen;
+       if (!(s0 = decimalpoint_cache)) {
+               s0 = localeconv()->decimal_point;
+               dlen = strlen(s0);
+               if ((decimalpoint_cache = (char*)malloc(strlen(s0) + 1))) {
+                       strcpy(decimalpoint_cache, s0);
+                       s0 = decimalpoint_cache;
+                       }
+               }
+       decimalpoint = s0;
+#endif
+#else
+#define dlen 0
+#endif
+       s0 = s;
+       len = (se-s) + dlen + 6; /* 6 = sign + e+dd + trailing null */
+       if (blen < len)
+               goto ret0;
+       be = b + blen - 1;
+       if (sign)
+               *b++ = '-';
+       if (decpt <= -4 || decpt > se - s + 5) {
+               *b++ = *s++;
+               if (*s) {
+#ifdef USE_LOCALE
+                       while((*b = *decimalpoint++))
+                               ++b;
+#else
+                       *b++ = '.';
+#endif
+                       while((*b = *s++) !=0)
+                               b++;
+                       }
+               *b++ = 'e';
+               /* sprintf(b, "%+.2d", decpt - 1); */
+               if (--decpt < 0) {
+                       *b++ = '-';
+                       decpt = -decpt;
+                       }
+               else
+                       *b++ = '+';
+               for(j = 2, k = 10; 10*k <= decpt; j++, k *= 10){}
+               for(;;) {
+                       i = decpt / k;
+                       if (b >= be)
+                               goto ret0;
+                       *b++ = i + '0';
+                       if (--j <= 0)
+                               break;
+                       decpt -= i*k;
+                       decpt *= 10;
+                       }
+               *b = 0;
+               }
+       else if (decpt <= 0) {
+#ifdef USE_LOCALE
+               while((*b = *decimalpoint++))
+                       ++b;
+#else
+               *b++ = '.';
+#endif
+               if (be < b - decpt + (se - s))
+                       goto ret0;
+               for(; decpt < 0; decpt++)
+                       *b++ = '0';
+               while((*b = *s++) != 0)
+                       b++;
+               }
+       else {
+               while((*b = *s++) != 0) {
+                       b++;
+                       if (--decpt == 0 && *s) {
+#ifdef USE_LOCALE
+                               while(*b = *decimalpoint++)
+                                       ++b;
+#else
+                               *b++ = '.';
+#endif
+                               }
+                       }
+               if (b + decpt > be) {
+ ret0:
+                       b = 0;
+                       goto ret;
+                       }
+               for(; decpt > 0; decpt--)
+                       *b++ = '0';
+               *b = 0;
+               }
+ ret:
+       freedtoa(s0);
+       return b;
+       }
diff --git a/contrib/gdtoa/g_ddfmt.c b/contrib/gdtoa/g_ddfmt.c
new file mode 100644 (file)
index 0000000..b65d39d
--- /dev/null
@@ -0,0 +1,169 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg@acm.org). */
+
+#include "gdtoaimp.h"
+#include <string.h>
+
+ char *
+#ifdef KR_headers
+g_ddfmt(buf, dd, ndig, bufsize) char *buf; double *dd; int ndig; size_t bufsize;
+#else
+g_ddfmt(char *buf, double *dd, int ndig, size_t bufsize)
+#endif
+{
+       FPI fpi;
+       char *b, *s, *se;
+       ULong *L, bits0[4], *bits, *zx;
+       int bx, by, decpt, ex, ey, i, j, mode;
+       Bigint *x, *y, *z;
+       double ddx[2];
+#ifdef Honor_FLT_ROUNDS /*{{*/
+       int Rounding;
+#ifdef Trust_FLT_ROUNDS /*{{ only define this if FLT_ROUNDS really works! */
+       Rounding = Flt_Rounds;
+#else /*}{*/
+       Rounding = 1;
+       switch(fegetround()) {
+         case FE_TOWARDZERO:   Rounding = 0; break;
+         case FE_UPWARD:       Rounding = 2; break;
+         case FE_DOWNWARD:     Rounding = 3;
+         }
+#endif /*}}*/
+#else /*}{*/
+#define Rounding FPI_Round_near
+#endif /*}}*/
+
+       if (bufsize < 10 || bufsize < ndig + 8)
+               return 0;
+
+       L = (ULong*)dd;
+       if ((L[_0] & 0x7ff00000L) == 0x7ff00000L) {
+               /* Infinity or NaN */
+               if (L[_0] & 0xfffff || L[_1]) {
+ nanret:
+                       return strcp(buf, "NaN");
+                       }
+               if ((L[2+_0] & 0x7ff00000) == 0x7ff00000) {
+                       if (L[2+_0] & 0xfffff || L[2+_1])
+                               goto nanret;
+                       if ((L[_0] ^ L[2+_0]) & 0x80000000L)
+                               goto nanret;    /* Infinity - Infinity */
+                       }
+ infret:
+               b = buf;
+               if (L[_0] & 0x80000000L)
+                       *b++ = '-';
+               return strcp(b, "Infinity");
+               }
+       if ((L[2+_0] & 0x7ff00000) == 0x7ff00000) {
+               L += 2;
+               if (L[_0] & 0xfffff || L[_1])
+                       goto nanret;
+               goto infret;
+               }
+       if (dd[0] + dd[1] == 0.) {
+               b = buf;
+#ifndef IGNORE_ZERO_SIGN
+               if (L[_0] & L[2+_0] & 0x80000000L)
+                       *b++ = '-';
+#endif
+               *b++ = '0';
+               *b = 0;
+               return b;
+               }
+       if ((L[_0] & 0x7ff00000L) < (L[2+_0] & 0x7ff00000L)) {
+               ddx[1] = dd[0];
+               ddx[0] = dd[1];
+               dd = ddx;
+               L = (ULong*)dd;
+               }
+       z = d2b(dd[0], &ex, &bx);
+       if (dd[1] == 0.)
+               goto no_y;
+       x = z;
+       y = d2b(dd[1], &ey, &by);
+       if ( (i = ex - ey) !=0) {
+               if (i > 0) {
+                       x = lshift(x, i);
+                       ex = ey;
+                       }
+               else
+                       y = lshift(y, -i);
+               }
+       if ((L[_0] ^ L[2+_0]) & 0x80000000L) {
+               z = diff(x, y);
+               if (L[_0] & 0x80000000L)
+                       z->sign = 1 - z->sign;
+               }
+       else {
+               z = sum(x, y);
+               if (L[_0] & 0x80000000L)
+                       z->sign = 1;
+               }
+       Bfree(x);
+       Bfree(y);
+ no_y:
+       bits = zx = z->x;
+       for(i = 0; !*zx; zx++)
+               i += 32;
+       i += lo0bits(zx);
+       if (i) {
+               rshift(z, i);
+               ex += i;
+               }
+       fpi.nbits = z->wds * 32 - hi0bits(z->x[j = z->wds-1]);
+       if (fpi.nbits < 106) {
+               fpi.nbits = 106;
+               if (j < 3) {
+                       for(i = 0; i <= j; i++)
+                               bits0[i] = bits[i];
+                       while(i < 4)
+                               bits0[i++] = 0;
+                       bits = bits0;
+                       }
+               }
+       mode = 2;
+       if (ndig <= 0) {
+               if (bufsize < (int)(fpi.nbits * .301029995664) + 10) {
+                       Bfree(z);
+                       return 0;
+                       }
+               mode = 0;
+               }
+       fpi.emin = 1-1023-53+1;
+       fpi.emax = 2046-1023-106+1;
+       fpi.rounding = Rounding;
+       fpi.sudden_underflow = 0;
+       i = STRTOG_Normal;
+       s = gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+       b = g__fmt(buf, s, se, decpt, z->sign, bufsize);
+       Bfree(z);
+       return b;
+       }
diff --git a/contrib/gdtoa/g_dfmt.c b/contrib/gdtoa/g_dfmt.c
new file mode 100644 (file)
index 0000000..23d8b24
--- /dev/null
@@ -0,0 +1,93 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+ char*
+#ifdef KR_headers
+g_dfmt(buf, d, ndig, bufsize) char *buf; double *d; int ndig; size_t bufsize;
+#else
+g_dfmt(char *buf, double *d, int ndig, size_t bufsize)
+#endif
+{
+       static FPI fpi0 = { 53, 1-1023-53+1, 2046-1023-53+1, 1, 0 };
+       char *b, *s, *se;
+       ULong bits[2], *L, sign;
+       int decpt, ex, i, mode;
+#ifdef Honor_FLT_ROUNDS
+#include "gdtoa_fltrnds.h"
+#else
+#define fpi &fpi0
+#endif
+
+       if (ndig < 0)
+               ndig = 0;
+       if (bufsize < ndig + 10)
+               return 0;
+
+       L = (ULong*)d;
+       sign = L[_0] & 0x80000000L;
+       if ((L[_0] & 0x7ff00000) == 0x7ff00000) {
+               /* Infinity or NaN */
+               if (bufsize < 10)
+                       return 0;
+               if (L[_0] & 0xfffff || L[_1]) {
+                       return strcp(buf, "NaN");
+                       }
+               b = buf;
+               if (sign)
+                       *b++ = '-';
+               return strcp(b, "Infinity");
+               }
+       if (L[_1] == 0 && (L[_0] ^ sign) == 0 /*d == 0.*/) {
+               b = buf;
+#ifndef IGNORE_ZERO_SIGN
+               if (L[_0] & 0x80000000L)
+                       *b++ = '-';
+#endif
+               *b++ = '0';
+               *b = 0;
+               return b;
+               }
+       bits[0] = L[_1];
+       bits[1] = L[_0] & 0xfffff;
+       if ( (ex = (L[_0] >> 20) & 0x7ff) !=0)
+               bits[1] |= 0x100000;
+       else
+               ex = 1;
+       ex -= 0x3ff + 52;
+       mode = 2;
+       if (ndig <= 0)
+               mode = 0;
+       i = STRTOG_Normal;
+       s = gdtoa(fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+       return g__fmt(buf, s, se, decpt, sign, bufsize);
+       }
diff --git a/contrib/gdtoa/g_ffmt.c b/contrib/gdtoa/g_ffmt.c
new file mode 100644 (file)
index 0000000..1c27c60
--- /dev/null
@@ -0,0 +1,93 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+ char*
+#ifdef KR_headers
+g_ffmt(buf, f, ndig, bufsize) char *buf; float *f; int ndig; size_t bufsize;
+#else
+g_ffmt(char *buf, float *f, int ndig, size_t bufsize)
+#endif
+{
+       static FPI fpi0 = { 24, 1-127-24+1,  254-127-24+1, 1, 0 };
+       char *b, *s, *se;
+       ULong bits[1], *L, sign;
+       int decpt, ex, i, mode;
+#ifdef Honor_FLT_ROUNDS
+#include "gdtoa_fltrnds.h"
+#else
+#define fpi &fpi0
+#endif
+
+       if (ndig < 0)
+               ndig = 0;
+       if (bufsize < ndig + 10)
+               return 0;
+
+       L = (ULong*)f;
+       sign = L[0] & 0x80000000L;
+       if ((L[0] & 0x7f800000) == 0x7f800000) {
+               /* Infinity or NaN */
+               if (L[0] & 0x7fffff) {
+                       return strcp(buf, "NaN");
+                       }
+               b = buf;
+               if (sign)
+                       *b++ = '-';
+               return strcp(b, "Infinity");
+               }
+       if (*f == 0.) {
+               b = buf;
+#ifndef IGNORE_ZERO_SIGN
+               if (L[0] & 0x80000000L)
+                       *b++ = '-';
+#endif
+               *b++ = '0';
+               *b = 0;
+               return b;
+               }
+       bits[0] = L[0] & 0x7fffff;
+       if ( (ex = (L[0] >> 23) & 0xff) !=0)
+               bits[0] |= 0x800000;
+       else
+               ex = 1;
+       ex -= 0x7f + 23;
+       mode = 2;
+       if (ndig <= 0) {
+               if (bufsize < 16)
+                       return 0;
+               mode = 0;
+               }
+       i = STRTOG_Normal;
+       s = gdtoa(fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+       return g__fmt(buf, s, se, decpt, sign, bufsize);
+       }
diff --git a/contrib/gdtoa/g_xLfmt.c b/contrib/gdtoa/g_xLfmt.c
new file mode 100644 (file)
index 0000000..6fa1de2
--- /dev/null
@@ -0,0 +1,113 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+#undef _0
+#undef _1
+
+/* one or the other of IEEE_MC68k or IEEE_8087 should be #defined */
+
+#ifdef IEEE_MC68k
+#define _0 0
+#define _1 1
+#define _2 2
+#endif
+#ifdef IEEE_8087
+#define _0 2
+#define _1 1
+#define _2 0
+#endif
+
+ char*
+#ifdef KR_headers
+g_xLfmt(buf, V, ndig, bufsize) char *buf; char *V; int ndig; size_t bufsize;
+#else
+g_xLfmt(char *buf, void *V, int ndig, size_t bufsize)
+#endif
+{
+       static FPI fpi0 = { 64, 1-16383-64+1, 32766 - 16383 - 64 + 1, 1, 0 };
+       char *b, *s, *se;
+       ULong bits[2], *L, sign;
+       int decpt, ex, i, mode;
+#ifdef Honor_FLT_ROUNDS
+#include "gdtoa_fltrnds.h"
+#else
+#define fpi &fpi0
+#endif
+
+       if (ndig < 0)
+               ndig = 0;
+       if (bufsize < ndig + 10)
+               return 0;
+
+       L = (ULong*)V;
+       sign = L[_0] & 0x80000000L;
+       bits[1] = L[_1];
+       bits[0] = L[_2];
+       if ( (ex = (L[_0] >> 16) & 0x7fff) !=0) {
+               if (ex == 0x7fff) {
+                       /* Infinity or NaN */
+                       if (bits[0] | bits[1])
+                               b = strcp(buf, "NaN");
+                       else {
+                               b = buf;
+                               if (sign)
+                                       *b++ = '-';
+                               b = strcp(b, "Infinity");
+                               }
+                       return b;
+                       }
+               i = STRTOG_Normal;
+               }
+       else if (bits[0] | bits[1]) {
+               i = STRTOG_Denormal;
+               }
+       else {
+               b = buf;
+#ifndef IGNORE_ZERO_SIGN
+               if (sign)
+                       *b++ = '-';
+#endif
+               *b++ = '0';
+               *b = 0;
+               return b;
+               }
+       ex -= 0x3fff + 63;
+       mode = 2;
+       if (ndig <= 0) {
+               if (bufsize < 32)
+                       return 0;
+               mode = 0;
+               }
+       s = gdtoa(fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+       return g__fmt(buf, s, se, decpt, sign, bufsize);
+       }
diff --git a/contrib/gdtoa/g_xfmt.c b/contrib/gdtoa/g_xfmt.c
new file mode 100644 (file)
index 0000000..495c7b4
--- /dev/null
@@ -0,0 +1,119 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+#undef _0
+#undef _1
+
+/* one or the other of IEEE_MC68k or IEEE_8087 should be #defined */
+
+#ifdef IEEE_MC68k
+#define _0 0
+#define _1 1
+#define _2 2
+#define _3 3
+#define _4 4
+#endif
+#ifdef IEEE_8087
+#define _0 4
+#define _1 3
+#define _2 2
+#define _3 1
+#define _4 0
+#endif
+
+ char*
+#ifdef KR_headers
+g_xfmt(buf, V, ndig, bufsize) char *buf; char *V; int ndig; size_t bufsize;
+#else
+g_xfmt(char *buf, void *V, int ndig, size_t bufsize)
+#endif
+{
+       static FPI fpi0 = { 64, 1-16383-64+1, 32766 - 16383 - 64 + 1, 1, 0 };
+       char *b, *s, *se;
+       ULong bits[2], sign;
+       UShort *L;
+       int decpt, ex, i, mode;
+#ifdef Honor_FLT_ROUNDS
+#include "gdtoa_fltrnds.h"
+#else
+#define fpi &fpi0
+#endif
+
+       if (ndig < 0)
+               ndig = 0;
+       if (bufsize < ndig + 10)
+               return 0;
+
+       L = (UShort *)V;
+       sign = L[_0] & 0x8000;
+       bits[1] = (L[_1] << 16) | L[_2];
+       bits[0] = (L[_3] << 16) | L[_4];
+       if ( (ex = L[_0] & 0x7fff) !=0) {
+               if (ex == 0x7fff) {
+                       /* Infinity or NaN */
+                       if (bits[0] | bits[1])
+                               b = strcp(buf, "NaN");
+                       else {
+                               b = buf;
+                               if (sign)
+                                       *b++ = '-';
+                               b = strcp(b, "Infinity");
+                               }
+                       return b;
+                       }
+               i = STRTOG_Normal;
+               }
+       else if (bits[0] | bits[1]) {
+               i = STRTOG_Denormal;
+               ex = 1;
+               }
+       else {
+               b = buf;
+#ifndef IGNORE_ZERO_SIGN
+               if (sign)
+                       *b++ = '-';
+#endif
+               *b++ = '0';
+               *b = 0;
+               return b;
+               }
+       ex -= 0x3fff + 63;
+       mode = 2;
+       if (ndig <= 0) {
+               if (bufsize < 32)
+                       return 0;
+               mode = 0;
+               }
+       s = gdtoa(fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+       return g__fmt(buf, s, se, decpt, sign, bufsize);
+       }
diff --git a/contrib/gdtoa/gdtoa.c b/contrib/gdtoa/gdtoa.c
new file mode 100644 (file)
index 0000000..3b64250
--- /dev/null
@@ -0,0 +1,760 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998, 1999 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+ static Bigint *
+#ifdef KR_headers
+bitstob(bits, nbits, bbits) ULong *bits; int nbits; int *bbits;
+#else
+bitstob(ULong *bits, int nbits, int *bbits)
+#endif
+{
+       int i, k;
+       Bigint *b;
+       ULong *be, *x, *x0;
+
+       i = ULbits;
+       k = 0;
+       while(i < nbits) {
+               i <<= 1;
+               k++;
+               }
+#ifndef Pack_32
+       if (!k)
+               k = 1;
+#endif
+       b = Balloc(k);
+       be = bits + ((nbits - 1) >> kshift);
+       x = x0 = b->x;
+       do {
+               *x++ = *bits & ALL_ON;
+#ifdef Pack_16
+               *x++ = (*bits >> 16) & ALL_ON;
+#endif
+               } while(++bits <= be);
+       i = x - x0;
+       while(!x0[--i])
+               if (!i) {
+                       b->wds = 0;
+                       *bbits = 0;
+                       goto ret;
+                       }
+       b->wds = i + 1;
+       *bbits = i*ULbits + 32 - hi0bits(b->x[i]);
+ ret:
+       return b;
+       }
+
+/* dtoa for IEEE arithmetic (dmg): convert double to ASCII string.
+ *
+ * Inspired by "How to Print Floating-Point Numbers Accurately" by
+ * Guy L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90, pp. 112-126].
+ *
+ * Modifications:
+ *     1. Rather than iterating, we use a simple numeric overestimate
+ *        to determine k = floor(log10(d)).  We scale relevant
+ *        quantities using O(log2(k)) rather than O(k) multiplications.
+ *     2. For some modes > 2 (corresponding to ecvt and fcvt), we don't
+ *        try to generate digits strictly left to right.  Instead, we
+ *        compute with fewer bits and propagate the carry if necessary
+ *        when rounding the final digit up.  This is often faster.
+ *     3. Under the assumption that input will be rounded nearest,
+ *        mode 0 renders 1e23 as 1e23 rather than 9.999999999999999e22.
+ *        That is, we allow equality in stopping tests when the
+ *        round-nearest rule will give the same floating-point value
+ *        as would satisfaction of the stopping test with strict
+ *        inequality.
+ *     4. We remove common factors of powers of 2 from relevant
+ *        quantities.
+ *     5. When converting floating-point integers less than 1e16,
+ *        we use floating-point arithmetic rather than resorting
+ *        to multiple-precision integers.
+ *     6. When asked to produce fewer than 15 digits, we first try
+ *        to get by with floating-point arithmetic; we resort to
+ *        multiple-precision integer arithmetic only if we cannot
+ *        guarantee that the floating-point calculation has given
+ *        the correctly rounded result.  For k requested digits and
+ *        "uniformly" distributed input, the probability is
+ *        something like 10^(k-15) that we must resort to the Long
+ *        calculation.
+ */
+
+ char *
+gdtoa
+#ifdef KR_headers
+       (fpi, be, bits, kindp, mode, ndigits, decpt, rve)
+       FPI *fpi; int be; ULong *bits;
+       int *kindp, mode, ndigits, *decpt; char **rve;
+#else
+       (FPI *fpi, int be, ULong *bits, int *kindp, int mode, int ndigits, int *decpt, char **rve)
+#endif
+{
+ /*    Arguments ndigits and decpt are similar to the second and third
+       arguments of ecvt and fcvt; trailing zeros are suppressed from
+       the returned string.  If not null, *rve is set to point
+       to the end of the return value.  If d is +-Infinity or NaN,
+       then *decpt is set to 9999.
+
+       mode:
+               0 ==> shortest string that yields d when read in
+                       and rounded to nearest.
+               1 ==> like 0, but with Steele & White stopping rule;
+                       e.g. with IEEE P754 arithmetic , mode 0 gives
+                       1e23 whereas mode 1 gives 9.999999999999999e22.
+               2 ==> max(1,ndigits) significant digits.  This gives a
+                       return value similar to that of ecvt, except
+                       that trailing zeros are suppressed.
+               3 ==> through ndigits past the decimal point.  This
+                       gives a return value similar to that from fcvt,
+                       except that trailing zeros are suppressed, and
+                       ndigits can be negative.
+               4-9 should give the same return values as 2-3, i.e.,
+                       4 <= mode <= 9 ==> same return as mode
+                       2 + (mode & 1).  These modes are mainly for
+                       debugging; often they run slower but sometimes
+                       faster than modes 2-3.
+               4,5,8,9 ==> left-to-right digit generation.
+               6-9 ==> don't try fast floating-point estimate
+                       (if applicable).
+
+               Values of mode other than 0-9 are treated as mode 0.
+
+               Sufficient space is allocated to the return value
+               to hold the suppressed trailing zeros.
+       */
+
+       int bbits, b2, b5, be0, dig, i, ieps, ilim, ilim0, ilim1, inex;
+       int j, j1, k, k0, k_check, kind, leftright, m2, m5, nbits;
+       int rdir, s2, s5, spec_case, try_quick;
+       Long L;
+       Bigint *b, *b1, *delta, *mlo, *mhi, *mhi1, *S;
+       double d, d2, ds, eps;
+       char *s, *s0;
+
+#ifndef MULTIPLE_THREADS
+       if (dtoa_result) {
+               freedtoa(dtoa_result);
+               dtoa_result = 0;
+               }
+#endif
+       inex = 0;
+       kind = *kindp &= ~STRTOG_Inexact;
+       switch(kind & STRTOG_Retmask) {
+         case STRTOG_Zero:
+               goto ret_zero;
+         case STRTOG_Normal:
+         case STRTOG_Denormal:
+               break;
+         case STRTOG_Infinite:
+               *decpt = -32768;
+               return nrv_alloc("Infinity", rve, 8);
+         case STRTOG_NaN:
+               *decpt = -32768;
+               return nrv_alloc("NaN", rve, 3);
+         default:
+               return 0;
+         }
+       b = bitstob(bits, nbits = fpi->nbits, &bbits);
+       be0 = be;
+       if ( (i = trailz(b)) !=0) {
+               rshift(b, i);
+               be += i;
+               bbits -= i;
+               }
+       if (!b->wds) {
+               Bfree(b);
+ ret_zero:
+               *decpt = 1;
+               return nrv_alloc("0", rve, 1);
+               }
+
+       dval(d) = b2d(b, &i);
+       i = be + bbits - 1;
+       word0(d) &= Frac_mask1;
+       word0(d) |= Exp_11;
+#ifdef IBM
+       if ( (j = 11 - hi0bits(word0(d) & Frac_mask)) !=0)
+               dval(d) /= 1 << j;
+#endif
+
+       /* log(x)       ~=~ log(1.5) + (x-1.5)/1.5
+        * log10(x)      =  log(x) / log(10)
+        *              ~=~ log(1.5)/log(10) + (x-1.5)/(1.5*log(10))
+        * log10(d) = (i-Bias)*log(2)/log(10) + log10(d2)
+        *
+        * This suggests computing an approximation k to log10(d) by
+        *
+        * k = (i - Bias)*0.301029995663981
+        *      + ( (d2-1.5)*0.289529654602168 + 0.176091259055681 );
+        *
+        * We want k to be too large rather than too small.
+        * The error in the first-order Taylor series approximation
+        * is in our favor, so we just round up the constant enough
+        * to compensate for any error in the multiplication of
+        * (i - Bias) by 0.301029995663981; since |i - Bias| <= 1077,
+        * and 1077 * 0.30103 * 2^-52 ~=~ 7.2e-14,
+        * adding 1e-13 to the constant term more than suffices.
+        * Hence we adjust the constant term to 0.1760912590558.
+        * (We could get a more accurate k by invoking log10,
+        *  but this is probably not worthwhile.)
+        */
+#ifdef IBM
+       i <<= 2;
+       i += j;
+#endif
+       ds = (dval(d)-1.5)*0.289529654602168 + 0.1760912590558 + i*0.301029995663981;
+
+       /* correct assumption about exponent range */
+       if ((j = i) < 0)
+               j = -j;
+       if ((j -= 1077) > 0)
+               ds += j * 7e-17;
+
+       k = (int)ds;
+       if (ds < 0. && ds != k)
+               k--;    /* want k = floor(ds) */
+       k_check = 1;
+#ifdef IBM
+       j = be + bbits - 1;
+       if ( (j1 = j & 3) !=0)
+               dval(d) *= 1 << j1;
+       word0(d) += j << Exp_shift - 2 & Exp_mask;
+#else
+       word0(d) += (be + bbits - 1) << Exp_shift;
+#endif
+       if (k >= 0 && k <= Ten_pmax) {
+               if (dval(d) < tens[k])
+                       k--;
+               k_check = 0;
+               }
+       j = bbits - i - 1;
+       if (j >= 0) {
+               b2 = 0;
+               s2 = j;
+               }
+       else {
+               b2 = -j;
+               s2 = 0;
+               }
+       if (k >= 0) {
+               b5 = 0;
+               s5 = k;
+               s2 += k;
+               }
+       else {
+               b2 -= k;
+               b5 = -k;
+               s5 = 0;
+               }
+       if (mode < 0 || mode > 9)
+               mode = 0;
+       try_quick = 1;
+       if (mode > 5) {
+               mode -= 4;
+               try_quick = 0;
+               }
+       leftright = 1;
+       switch(mode) {
+               case 0:
+               case 1:
+                       ilim = ilim1 = -1;
+                       i = (int)(nbits * .30103) + 3;
+                       ndigits = 0;
+                       break;
+               case 2:
+                       leftright = 0;
+                       /* no break */
+               case 4:
+                       if (ndigits <= 0)
+                               ndigits = 1;
+                       ilim = ilim1 = i = ndigits;
+                       break;
+               case 3:
+                       leftright = 0;
+                       /* no break */
+               case 5:
+                       i = ndigits + k + 1;
+                       ilim = i;
+                       ilim1 = i - 1;
+                       if (i <= 0)
+                               i = 1;
+               }
+       s = s0 = rv_alloc(i);
+
+       if ( (rdir = fpi->rounding - 1) !=0) {
+               if (rdir < 0)
+                       rdir = 2;
+               if (kind & STRTOG_Neg)
+                       rdir = 3 - rdir;
+               }
+
+       /* Now rdir = 0 ==> round near, 1 ==> round up, 2 ==> round down. */
+
+       if (ilim >= 0 && ilim <= Quick_max && try_quick && !rdir
+#ifndef IMPRECISE_INEXACT
+               && k == 0
+#endif
+                                                               ) {
+
+               /* Try to get by with floating-point arithmetic. */
+
+               i = 0;
+               d2 = dval(d);
+#ifdef IBM
+               if ( (j = 11 - hi0bits(word0(d) & Frac_mask)) !=0)
+                       dval(d) /= 1 << j;
+#endif
+               k0 = k;
+               ilim0 = ilim;
+               ieps = 2; /* conservative */
+               if (k > 0) {
+                       ds = tens[k&0xf];
+                       j = k >> 4;
+                       if (j & Bletch) {
+                               /* prevent overflows */
+                               j &= Bletch - 1;
+                               dval(d) /= bigtens[n_bigtens-1];
+                               ieps++;
+                               }
+                       for(; j; j >>= 1, i++)
+                               if (j & 1) {
+                                       ieps++;
+                                       ds *= bigtens[i];
+                                       }
+                       }
+               else  {
+                       ds = 1.;
+                       if ( (j1 = -k) !=0) {
+                               dval(d) *= tens[j1 & 0xf];
+                               for(j = j1 >> 4; j; j >>= 1, i++)
+                                       if (j & 1) {
+                                               ieps++;
+                                               dval(d) *= bigtens[i];
+                                               }
+                               }
+                       }
+               if (k_check && dval(d) < 1. && ilim > 0) {
+                       if (ilim1 <= 0)
+                               goto fast_failed;
+                       ilim = ilim1;
+                       k--;
+                       dval(d) *= 10.;
+                       ieps++;
+                       }
+               dval(eps) = ieps*dval(d) + 7.;
+               word0(eps) -= (P-1)*Exp_msk1;
+               if (ilim == 0) {
+                       S = mhi = 0;
+                       dval(d) -= 5.;
+                       if (dval(d) > dval(eps))
+                               goto one_digit;
+                       if (dval(d) < -dval(eps))
+                               goto no_digits;
+                       goto fast_failed;
+                       }
+#ifndef No_leftright
+               if (leftright) {
+                       /* Use Steele & White method of only
+                        * generating digits needed.
+                        */
+                       dval(eps) = ds*0.5/tens[ilim-1] - dval(eps);
+                       for(i = 0;;) {
+                               L = (Long)(dval(d)/ds);
+                               dval(d) -= L*ds;
+                               *s++ = '0' + (int)L;
+                               if (dval(d) < dval(eps)) {
+                                       if (dval(d))
+                                               inex = STRTOG_Inexlo;
+                                       goto ret1;
+                                       }
+                               if (ds - dval(d) < dval(eps))
+                                       goto bump_up;
+                               if (++i >= ilim)
+                                       break;
+                               dval(eps) *= 10.;
+                               dval(d) *= 10.;
+                               }
+                       }
+               else {
+#endif
+                       /* Generate ilim digits, then fix them up. */
+                       dval(eps) *= tens[ilim-1];
+                       for(i = 1;; i++, dval(d) *= 10.) {
+                               if ( (L = (Long)(dval(d)/ds)) !=0)
+                                       dval(d) -= L*ds;
+                               *s++ = '0' + (int)L;
+                               if (i == ilim) {
+                                       ds *= 0.5;
+                                       if (dval(d) > ds + dval(eps))
+                                               goto bump_up;
+                                       else if (dval(d) < ds - dval(eps)) {
+                                               if (dval(d))
+                                                       inex = STRTOG_Inexlo;
+                                               goto clear_trailing0;
+                                               }
+                                       break;
+                                       }
+                               }
+#ifndef No_leftright
+                       }
+#endif
+ fast_failed:
+               s = s0;
+               dval(d) = d2;
+               k = k0;
+               ilim = ilim0;
+               }
+
+       /* Do we have a "small" integer? */
+
+       if (be >= 0 && k <= Int_max) {
+               /* Yes. */
+               ds = tens[k];
+               if (ndigits < 0 && ilim <= 0) {
+                       S = mhi = 0;
+                       if (ilim < 0 || dval(d) <= 5*ds)
+                               goto no_digits;
+                       goto one_digit;
+                       }
+               for(i = 1;; i++, dval(d) *= 10.) {
+                       L = dval(d) / ds;
+                       dval(d) -= L*ds;
+#ifdef Check_FLT_ROUNDS
+                       /* If FLT_ROUNDS == 2, L will usually be high by 1 */
+                       if (dval(d) < 0) {
+                               L--;
+                               dval(d) += ds;
+                               }
+#endif
+                       *s++ = '0' + (int)L;
+                       if (dval(d) == 0.)
+                               break;
+                       if (i == ilim) {
+                               if (rdir) {
+                                       if (rdir == 1)
+                                               goto bump_up;
+                                       inex = STRTOG_Inexlo;
+                                       goto ret1;
+                                       }
+                               dval(d) += dval(d);
+                               if (dval(d) > ds || dval(d) == ds && L & 1) {
+ bump_up:
+                                       inex = STRTOG_Inexhi;
+                                       while(*--s == '9')
+                                               if (s == s0) {
+                                                       k++;
+                                                       *s = '0';
+                                                       break;
+                                                       }
+                                       ++*s++;
+                                       }
+                               else {
+                                       inex = STRTOG_Inexlo;
+ clear_trailing0:
+                                       while(*--s == '0'){}
+                                       ++s;
+                                       }
+                               break;
+                               }
+                       }
+               goto ret1;
+               }
+
+       m2 = b2;
+       m5 = b5;
+       mhi = mlo = 0;
+       if (leftright) {
+               if (mode < 2) {
+                       i = nbits - bbits;
+                       if (be - i++ < fpi->emin)
+                               /* denormal */
+                               i = be - fpi->emin + 1;
+                       }
+               else {
+                       j = ilim - 1;
+                       if (m5 >= j)
+                               m5 -= j;
+                       else {
+                               s5 += j -= m5;
+                               b5 += j;
+                               m5 = 0;
+                               }
+                       if ((i = ilim) < 0) {
+                               m2 -= i;
+                               i = 0;
+                               }
+                       }
+               b2 += i;
+               s2 += i;
+               mhi = i2b(1);
+               }
+       if (m2 > 0 && s2 > 0) {
+               i = m2 < s2 ? m2 : s2;
+               b2 -= i;
+               m2 -= i;
+               s2 -= i;
+               }
+       if (b5 > 0) {
+               if (leftright) {
+                       if (m5 > 0) {
+                               mhi = pow5mult(mhi, m5);
+                               b1 = mult(mhi, b);
+                               Bfree(b);
+                               b = b1;
+                               }
+                       if ( (j = b5 - m5) !=0)
+                               b = pow5mult(b, j);
+                       }
+               else
+                       b = pow5mult(b, b5);
+               }
+       S = i2b(1);
+       if (s5 > 0)
+               S = pow5mult(S, s5);
+
+       /* Check for special case that d is a normalized power of 2. */
+
+       spec_case = 0;
+       if (mode < 2) {
+               if (bbits == 1 && be0 > fpi->emin + 1) {
+                       /* The special case */
+                       b2++;
+                       s2++;
+                       spec_case = 1;
+                       }
+               }
+
+       /* Arrange for convenient computation of quotients:
+        * shift left if necessary so divisor has 4 leading 0 bits.
+        *
+        * Perhaps we should just compute leading 28 bits of S once
+        * and for all and pass them and a shift to quorem, so it
+        * can do shifts and ors to compute the numerator for q.
+        */
+#ifdef Pack_32
+       if ( (i = ((s5 ? 32 - hi0bits(S->x[S->wds-1]) : 1) + s2) & 0x1f) !=0)
+               i = 32 - i;
+#else
+       if ( (i = ((s5 ? 32 - hi0bits(S->x[S->wds-1]) : 1) + s2) & 0xf) !=0)
+               i = 16 - i;
+#endif
+       if (i > 4) {
+               i -= 4;
+               b2 += i;
+               m2 += i;
+               s2 += i;
+               }
+       else if (i < 4) {
+               i += 28;
+               b2 += i;
+               m2 += i;
+               s2 += i;
+               }
+       if (b2 > 0)
+               b = lshift(b, b2);
+       if (s2 > 0)
+               S = lshift(S, s2);
+       if (k_check) {
+               if (cmp(b,S) < 0) {
+                       k--;
+                       b = multadd(b, 10, 0);  /* we botched the k estimate */
+                       if (leftright)
+                               mhi = multadd(mhi, 10, 0);
+                       ilim = ilim1;
+                       }
+               }
+       if (ilim <= 0 && mode > 2) {
+               if (ilim < 0 || cmp(b,S = multadd(S,5,0)) <= 0) {
+                       /* no digits, fcvt style */
+ no_digits:
+                       k = -1 - ndigits;
+                       inex = STRTOG_Inexlo;
+                       goto ret;
+                       }
+ one_digit:
+               inex = STRTOG_Inexhi;
+               *s++ = '1';
+               k++;
+               goto ret;
+               }
+       if (leftright) {
+               if (m2 > 0)
+                       mhi = lshift(mhi, m2);
+
+               /* Compute mlo -- check for special case
+                * that d is a normalized power of 2.
+                */
+
+               mlo = mhi;
+               if (spec_case) {
+                       mhi = Balloc(mhi->k);
+                       Bcopy(mhi, mlo);
+                       mhi = lshift(mhi, 1);
+                       }
+
+               for(i = 1;;i++) {
+                       dig = quorem(b,S) + '0';
+                       /* Do we yet have the shortest decimal string
+                        * that will round to d?
+                        */
+                       j = cmp(b, mlo);
+                       delta = diff(S, mhi);
+                       j1 = delta->sign ? 1 : cmp(b, delta);
+                       Bfree(delta);
+#ifndef ROUND_BIASED
+                       if (j1 == 0 && !mode && !(bits[0] & 1) && !rdir) {
+                               if (dig == '9')
+                                       goto round_9_up;
+                               if (j <= 0) {
+                                       if (b->wds > 1 || b->x[0])
+                                               inex = STRTOG_Inexlo;
+                                       }
+                               else {
+                                       dig++;
+                                       inex = STRTOG_Inexhi;
+                                       }
+                               *s++ = dig;
+                               goto ret;
+                               }
+#endif
+                       if (j < 0 || j == 0 && !mode
+#ifndef ROUND_BIASED
+                                                       && !(bits[0] & 1)
+#endif
+                                       ) {
+                               if (rdir && (b->wds > 1 || b->x[0])) {
+                                       if (rdir == 2) {
+                                               inex = STRTOG_Inexlo;
+                                               goto accept;
+                                               }
+                                       while (cmp(S,mhi) > 0) {
+                                               *s++ = dig;
+                                               mhi1 = multadd(mhi, 10, 0);
+                                               if (mlo == mhi)
+                                                       mlo = mhi1;
+                                               mhi = mhi1;
+                                               b = multadd(b, 10, 0);
+                                               dig = quorem(b,S) + '0';
+                                               }
+                                       if (dig++ == '9')
+                                               goto round_9_up;
+                                       inex = STRTOG_Inexhi;
+                                       goto accept;
+                                       }
+                               if (j1 > 0) {
+                                       b = lshift(b, 1);
+                                       j1 = cmp(b, S);
+                                       if ((j1 > 0 || j1 == 0 && dig & 1)
+                                       && dig++ == '9')
+                                               goto round_9_up;
+                                       inex = STRTOG_Inexhi;
+                                       }
+                               if (b->wds > 1 || b->x[0])
+                                       inex = STRTOG_Inexlo;
+ accept:
+                               *s++ = dig;
+                               goto ret;
+                               }
+                       if (j1 > 0 && rdir != 2) {
+                               if (dig == '9') { /* possible if i == 1 */
+ round_9_up:
+                                       *s++ = '9';
+                                       inex = STRTOG_Inexhi;
+                                       goto roundoff;
+                                       }
+                               inex = STRTOG_Inexhi;
+                               *s++ = dig + 1;
+                               goto ret;
+                               }
+                       *s++ = dig;
+                       if (i == ilim)
+                               break;
+                       b = multadd(b, 10, 0);
+                       if (mlo == mhi)
+                               mlo = mhi = multadd(mhi, 10, 0);
+                       else {
+                               mlo = multadd(mlo, 10, 0);
+                               mhi = multadd(mhi, 10, 0);
+                               }
+                       }
+               }
+       else
+               for(i = 1;; i++) {
+                       *s++ = dig = quorem(b,S) + '0';
+                       if (i >= ilim)
+                               break;
+                       b = multadd(b, 10, 0);
+                       }
+
+       /* Round off last digit */
+
+       if (rdir) {
+               if (rdir == 2 || b->wds <= 1 && !b->x[0])
+                       goto chopzeros;
+               goto roundoff;
+               }
+       b = lshift(b, 1);
+       j = cmp(b, S);
+       if (j > 0 || j == 0 && dig & 1) {
+ roundoff:
+               inex = STRTOG_Inexhi;
+               while(*--s == '9')
+                       if (s == s0) {
+                               k++;
+                               *s++ = '1';
+                               goto ret;
+                               }
+               ++*s++;
+               }
+       else {
+ chopzeros:
+               if (b->wds > 1 || b->x[0])
+                       inex = STRTOG_Inexlo;
+               while(*--s == '0'){}
+               ++s;
+               }
+ ret:
+       Bfree(S);
+       if (mhi) {
+               if (mlo && mlo != mhi)
+                       Bfree(mlo);
+               Bfree(mhi);
+               }
+ ret1:
+       Bfree(b);
+       *s = 0;
+       *decpt = k + 1;
+       if (rve)
+               *rve = s;
+       *kindp |= inex;
+       return s0;
+       }
diff --git a/contrib/gdtoa/gdtoa.h b/contrib/gdtoa/gdtoa.h
new file mode 100644 (file)
index 0000000..e59ebf6
--- /dev/null
@@ -0,0 +1,154 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#ifndef GDTOA_H_INCLUDED
+#define GDTOA_H_INCLUDED
+
+#include "arith.h"
+#include <stddef.h> /* for size_t */
+
+#ifndef Long
+#define Long long
+#endif
+#ifndef ULong
+typedef unsigned Long ULong;
+#endif
+#ifndef UShort
+typedef unsigned short UShort;
+#endif
+
+#ifndef ANSI
+#ifdef KR_headers
+#define ANSI(x) ()
+#define Void /*nothing*/
+#else
+#define ANSI(x) x
+#define Void void
+#endif
+#endif /* ANSI */
+
+#ifndef CONST
+#ifdef KR_headers
+#define CONST /* blank */
+#else
+#define CONST const
+#endif
+#endif /* CONST */
+
+ enum {        /* return values from strtodg */
+       STRTOG_Zero     = 0,
+       STRTOG_Normal   = 1,
+       STRTOG_Denormal = 2,
+       STRTOG_Infinite = 3,
+       STRTOG_NaN      = 4,
+       STRTOG_NaNbits  = 5,
+       STRTOG_NoNumber = 6,
+       STRTOG_Retmask  = 7,
+
+       /* The following may be or-ed into one of the above values. */
+
+       STRTOG_Neg      = 0x08, /* does not affect STRTOG_Inexlo or STRTOG_Inexhi */
+       STRTOG_Inexlo   = 0x10, /* returned result rounded toward zero */
+       STRTOG_Inexhi   = 0x20, /* returned result rounded away from zero */
+       STRTOG_Inexact  = 0x30,
+       STRTOG_Underflow= 0x40,
+       STRTOG_Overflow = 0x80
+       };
+
+ typedef struct
+FPI {
+       int nbits;
+       int emin;
+       int emax;
+       int rounding;
+       int sudden_underflow;
+       } FPI;
+
+enum { /* FPI.rounding values: same as FLT_ROUNDS */
+       FPI_Round_zero = 0,
+       FPI_Round_near = 1,
+       FPI_Round_up = 2,
+       FPI_Round_down = 3
+       };
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+extern char* dtoa  ANSI((double d, int mode, int ndigits, int *decpt,
+                       int *sign, char **rve));
+extern char* gdtoa ANSI((FPI *fpi, int be, ULong *bits, int *kindp,
+                       int mode, int ndigits, int *decpt, char **rve));
+extern void freedtoa ANSI((char*));
+extern float  strtof ANSI((CONST char *, char **));
+extern double strtod ANSI((CONST char *, char **));
+extern int strtodg ANSI((CONST char*, char**, FPI*, Long*, ULong*));
+
+extern char*   g_ddfmt  ANSI((char*, double*, int, size_t));
+extern char*   g_dfmt   ANSI((char*, double*, int, size_t));
+extern char*   g_ffmt   ANSI((char*, float*,  int, size_t));
+extern char*   g_Qfmt   ANSI((char*, void*,   int, size_t));
+extern char*   g_xfmt   ANSI((char*, void*,   int, size_t));
+extern char*   g_xLfmt  ANSI((char*, void*,   int, size_t));
+
+extern int     strtoId  ANSI((CONST char*, char**, double*, double*));
+extern int     strtoIdd ANSI((CONST char*, char**, double*, double*));
+extern int     strtoIf  ANSI((CONST char*, char**, float*, float*));
+extern int     strtoIQ  ANSI((CONST char*, char**, void*, void*));
+extern int     strtoIx  ANSI((CONST char*, char**, void*, void*));
+extern int     strtoIxL ANSI((CONST char*, char**, void*, void*));
+extern int     strtord  ANSI((CONST char*, char**, int, double*));
+extern int     strtordd ANSI((CONST char*, char**, int, double*));
+extern int     strtorf  ANSI((CONST char*, char**, int, float*));
+extern int     strtorQ  ANSI((CONST char*, char**, int, void*));
+extern int     strtorx  ANSI((CONST char*, char**, int, void*));
+extern int     strtorxL ANSI((CONST char*, char**, int, void*));
+#if 1
+extern int     strtodI  ANSI((CONST char*, char**, double*));
+extern int     strtopd  ANSI((CONST char*, char**, double*));
+extern int     strtopdd ANSI((CONST char*, char**, double*));
+extern int     strtopf  ANSI((CONST char*, char**, float*));
+extern int     strtopQ  ANSI((CONST char*, char**, void*));
+extern int     strtopx  ANSI((CONST char*, char**, void*));
+extern int     strtopxL ANSI((CONST char*, char**, void*));
+#else
+#define strtopd(s,se,x) strtord(s,se,1,x)
+#define strtopdd(s,se,x) strtordd(s,se,1,x)
+#define strtopf(s,se,x) strtorf(s,se,1,x)
+#define strtopQ(s,se,x) strtorQ(s,se,1,x)
+#define strtopx(s,se,x) strtorx(s,se,1,x)
+#define strtopxL(s,se,x) strtorxL(s,se,1,x)
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+#endif /* GDTOA_H_INCLUDED */
diff --git a/contrib/gdtoa/gdtoa_fltrnds.h b/contrib/gdtoa/gdtoa_fltrnds.h
new file mode 100644 (file)
index 0000000..33e5f9e
--- /dev/null
@@ -0,0 +1,18 @@
+       FPI *fpi, fpi1;
+       int Rounding;
+#ifdef Trust_FLT_ROUNDS /*{{ only define this if FLT_ROUNDS really works! */
+       Rounding = Flt_Rounds;
+#else /*}{*/
+       Rounding = 1;
+       switch(fegetround()) {
+         case FE_TOWARDZERO:   Rounding = 0; break;
+         case FE_UPWARD:       Rounding = 2; break;
+         case FE_DOWNWARD:     Rounding = 3;
+         }
+#endif /*}}*/
+       fpi = &fpi0;
+       if (Rounding != 1) {
+               fpi1 = fpi0;
+               fpi = &fpi1;
+               fpi1.rounding = Rounding;
+               }
diff --git a/contrib/gdtoa/gdtoaimp.h b/contrib/gdtoa/gdtoaimp.h
new file mode 100644 (file)
index 0000000..3b038ff
--- /dev/null
@@ -0,0 +1,627 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998-2000 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* This is a variation on dtoa.c that converts arbitary binary
+   floating-point formats to and from decimal notation.  It uses
+   double-precision arithmetic internally, so there are still
+   various #ifdefs that adapt the calculations to the native
+   double-precision arithmetic (any of IEEE, VAX D_floating,
+   or IBM mainframe arithmetic).
+
+   Please send bug reports to David M. Gay (dmg at acm dot org,
+   with " at " changed at "@" and " dot " changed to ".").
+ */
+
+/* On a machine with IEEE extended-precision registers, it is
+ * necessary to specify double-precision (53-bit) rounding precision
+ * before invoking strtod or dtoa.  If the machine uses (the equivalent
+ * of) Intel 80x87 arithmetic, the call
+ *     _control87(PC_53, MCW_PC);
+ * does this with many compilers.  Whether this or another call is
+ * appropriate depends on the compiler; for this to work, it may be
+ * necessary to #include "float.h" or another system-dependent header
+ * file.
+ */
+
+/* strtod for IEEE-, VAX-, and IBM-arithmetic machines.
+ *
+ * This strtod returns a nearest machine number to the input decimal
+ * string (or sets errno to ERANGE).  With IEEE arithmetic, ties are
+ * broken by the IEEE round-even rule.  Otherwise ties are broken by
+ * biased rounding (add half and chop).
+ *
+ * Inspired loosely by William D. Clinger's paper "How to Read Floating
+ * Point Numbers Accurately" [Proc. ACM SIGPLAN '90, pp. 112-126].
+ *
+ * Modifications:
+ *
+ *     1. We only require IEEE, IBM, or VAX double-precision
+ *             arithmetic (not IEEE double-extended).
+ *     2. We get by with floating-point arithmetic in a case that
+ *             Clinger missed -- when we're computing d * 10^n
+ *             for a small integer d and the integer n is not too
+ *             much larger than 22 (the maximum integer k for which
+ *             we can represent 10^k exactly), we may be able to
+ *             compute (d*10^k) * 10^(e-k) with just one roundoff.
+ *     3. Rather than a bit-at-a-time adjustment of the binary
+ *             result in the hard case, we use floating-point
+ *             arithmetic to determine the adjustment to within
+ *             one bit; only in really hard cases do we need to
+ *             compute a second residual.
+ *     4. Because of 3., we don't need a large table of powers of 10
+ *             for ten-to-e (just some small tables, e.g. of 10^k
+ *             for 0 <= k <= 22).
+ */
+
+/*
+ * #define IEEE_8087 for IEEE-arithmetic machines where the least
+ *     significant byte has the lowest address.
+ * #define IEEE_MC68k for IEEE-arithmetic machines where the most
+ *     significant byte has the lowest address.
+ * #define Long int on machines with 32-bit ints and 64-bit longs.
+ * #define Sudden_Underflow for IEEE-format machines without gradual
+ *     underflow (i.e., that flush to zero on underflow).
+ * #define IBM for IBM mainframe-style floating-point arithmetic.
+ * #define VAX for VAX-style floating-point arithmetic (D_floating).
+ * #define No_leftright to omit left-right logic in fast floating-point
+ *     computation of dtoa.
+ * #define Check_FLT_ROUNDS if FLT_ROUNDS can assume the values 2 or 3.
+ * #define RND_PRODQUOT to use rnd_prod and rnd_quot (assembly routines
+ *     that use extended-precision instructions to compute rounded
+ *     products and quotients) with IBM.
+ * #define ROUND_BIASED for IEEE-format with biased rounding.
+ * #define Inaccurate_Divide for IEEE-format with correctly rounded
+ *     products but inaccurate quotients, e.g., for Intel i860.
+ * #define NO_LONG_LONG on machines that do not have a "long long"
+ *     integer type (of >= 64 bits).  On such machines, you can
+ *     #define Just_16 to store 16 bits per 32-bit Long when doing
+ *     high-precision integer arithmetic.  Whether this speeds things
+ *     up or slows things down depends on the machine and the number
+ *     being converted.  If long long is available and the name is
+ *     something other than "long long", #define Llong to be the name,
+ *     and if "unsigned Llong" does not work as an unsigned version of
+ *     Llong, #define #ULLong to be the corresponding unsigned type.
+ * #define KR_headers for old-style C function headers.
+ * #define Bad_float_h if your system lacks a float.h or if it does not
+ *     define some or all of DBL_DIG, DBL_MAX_10_EXP, DBL_MAX_EXP,
+ *     FLT_RADIX, FLT_ROUNDS, and DBL_MAX.
+ * #define MALLOC your_malloc, where your_malloc(n) acts like malloc(n)
+ *     if memory is available and otherwise does something you deem
+ *     appropriate.  If MALLOC is undefined, malloc will be invoked
+ *     directly -- and assumed always to succeed.
+ * #define Omit_Private_Memory to omit logic (added Jan. 1998) for making
+ *     memory allocations from a private pool of memory when possible.
+ *     When used, the private pool is PRIVATE_MEM bytes long:  2304 bytes,
+ *     unless #defined to be a different length.  This default length
+ *     suffices to get rid of MALLOC calls except for unusual cases,
+ *     such as decimal-to-binary conversion of a very long string of
+ *     digits.  When converting IEEE double precision values, the
+ *     longest string gdtoa can return is about 751 bytes long.  For
+ *     conversions by strtod of strings of 800 digits and all gdtoa
+ *     conversions of IEEE doubles in single-threaded executions with
+ *     8-byte pointers, PRIVATE_MEM >= 7400 appears to suffice; with
+ *     4-byte pointers, PRIVATE_MEM >= 7112 appears adequate.
+ * #define NO_INFNAN_CHECK if you do not wish to have INFNAN_CHECK
+ *     #defined automatically on IEEE systems.  On such systems,
+ *     when INFNAN_CHECK is #defined, strtod checks
+ *     for Infinity and NaN (case insensitively).
+ *     When INFNAN_CHECK is #defined and No_Hex_NaN is not #defined,
+ *     strtodg also accepts (case insensitively) strings of the form
+ *     NaN(x), where x is a string of hexadecimal digits (optionally
+ *     preceded by 0x or 0X) and spaces; if there is only one string
+ *     of hexadecimal digits, it is taken for the fraction bits of the
+ *     resulting NaN; if there are two or more strings of hexadecimal
+ *     digits, each string is assigned to the next available sequence
+ *     of 32-bit words of fractions bits (starting with the most
+ *     significant), right-aligned in each sequence.
+ *     Unless GDTOA_NON_PEDANTIC_NANCHECK is #defined, input "NaN(...)"
+ *     is consumed even when ... has the wrong form (in which case the
+ *     "(...)" is consumed but ignored).
+ * #define MULTIPLE_THREADS if the system offers preemptively scheduled
+ *     multiple threads.  In this case, you must provide (or suitably
+ *     #define) two locks, acquired by ACQUIRE_DTOA_LOCK(n) and freed
+ *     by FREE_DTOA_LOCK(n) for n = 0 or 1.  (The second lock, accessed
+ *     in pow5mult, ensures lazy evaluation of only one copy of high
+ *     powers of 5; omitting this lock would introduce a small
+ *     probability of wasting memory, but would otherwise be harmless.)
+ *     You must also invoke freedtoa(s) to free the value s returned by
+ *     dtoa.  You may do so whether or not MULTIPLE_THREADS is #defined.
+ * #define IMPRECISE_INEXACT if you do not care about the setting of
+ *     the STRTOG_Inexact bits in the special case of doing IEEE double
+ *     precision conversions (which could also be done by the strtod in
+ *     dtoa.c).
+ * #define NO_HEX_FP to disable recognition of C9x's hexadecimal
+ *     floating-point constants.
+ * #define -DNO_ERRNO to suppress setting errno (in strtod.c and
+ *     strtodg.c).
+ * #define NO_STRING_H to use private versions of memcpy.
+ *     On some K&R systems, it may also be necessary to
+ *     #define DECLARE_SIZE_T in this case.
+ * #define YES_ALIAS to permit aliasing certain double values with
+ *     arrays of ULongs.  This leads to slightly better code with
+ *     some compilers and was always used prior to 19990916, but it
+ *     is not strictly legal and can cause trouble with aggressively
+ *     optimizing compilers (e.g., gcc 2.95.1 under -O2).
+ * #define USE_LOCALE to use the current locale's decimal_point value.
+ */
+
+#ifndef GDTOAIMP_H_INCLUDED
+#define GDTOAIMP_H_INCLUDED
+#include "gdtoa.h"
+#include "gd_qnan.h"
+#ifdef Honor_FLT_ROUNDS
+#include <fenv.h>
+#endif
+
+#ifdef DEBUG
+#include "stdio.h"
+#define Bug(x) {fprintf(stderr, "%s\n", x); exit(1);}
+#endif
+
+#include "stdlib.h"
+#include "string.h"
+
+#ifdef KR_headers
+#define Char char
+#else
+#define Char void
+#endif
+
+#ifdef MALLOC
+extern Char *MALLOC ANSI((size_t));
+#else
+#define MALLOC malloc
+#endif
+
+#undef IEEE_Arith
+#undef Avoid_Underflow
+#ifdef IEEE_MC68k
+#define IEEE_Arith
+#endif
+#ifdef IEEE_8087
+#define IEEE_Arith
+#endif
+
+#include "errno.h"
+#ifdef Bad_float_h
+
+#ifdef IEEE_Arith
+#define DBL_DIG 15
+#define DBL_MAX_10_EXP 308
+#define DBL_MAX_EXP 1024
+#define FLT_RADIX 2
+#define DBL_MAX 1.7976931348623157e+308
+#endif
+
+#ifdef IBM
+#define DBL_DIG 16
+#define DBL_MAX_10_EXP 75
+#define DBL_MAX_EXP 63
+#define FLT_RADIX 16
+#define DBL_MAX 7.2370055773322621e+75
+#endif
+
+#ifdef VAX
+#define DBL_DIG 16
+#define DBL_MAX_10_EXP 38
+#define DBL_MAX_EXP 127
+#define FLT_RADIX 2
+#define DBL_MAX 1.7014118346046923e+38
+#define n_bigtens 2
+#endif
+
+#ifndef LONG_MAX
+#define LONG_MAX 2147483647
+#endif
+
+#else /* ifndef Bad_float_h */
+#include "float.h"
+#endif /* Bad_float_h */
+
+#ifdef IEEE_Arith
+#define Scale_Bit 0x10
+#define n_bigtens 5
+#endif
+
+#ifdef IBM
+#define n_bigtens 3
+#endif
+
+#ifdef VAX
+#define n_bigtens 2
+#endif
+
+#ifndef __MATH_H__
+#include "math.h"
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#if defined(IEEE_8087) + defined(IEEE_MC68k) + defined(VAX) + defined(IBM) != 1
+Exactly one of IEEE_8087, IEEE_MC68k, VAX, or IBM should be defined.
+#endif
+
+typedef union { double d; ULong L[2]; } U;
+
+#ifdef YES_ALIAS
+#define dval(x) x
+#ifdef IEEE_8087
+#define word0(x) ((ULong *)&x)[1]
+#define word1(x) ((ULong *)&x)[0]
+#else
+#define word0(x) ((ULong *)&x)[0]
+#define word1(x) ((ULong *)&x)[1]
+#endif
+#else /* !YES_ALIAS */
+#ifdef IEEE_8087
+#define word0(x) ((U*)&x)->L[1]
+#define word1(x) ((U*)&x)->L[0]
+#else
+#define word0(x) ((U*)&x)->L[0]
+#define word1(x) ((U*)&x)->L[1]
+#endif
+#define dval(x) ((U*)&x)->d
+#endif /* YES_ALIAS */
+
+/* The following definition of Storeinc is appropriate for MIPS processors.
+ * An alternative that might be better on some machines is
+ * #define Storeinc(a,b,c) (*a++ = b << 16 | c & 0xffff)
+ */
+#if defined(IEEE_8087) + defined(VAX)
+#define Storeinc(a,b,c) (((unsigned short *)a)[1] = (unsigned short)b, \
+((unsigned short *)a)[0] = (unsigned short)c, a++)
+#else
+#define Storeinc(a,b,c) (((unsigned short *)a)[0] = (unsigned short)b, \
+((unsigned short *)a)[1] = (unsigned short)c, a++)
+#endif
+
+/* #define P DBL_MANT_DIG */
+/* Ten_pmax = floor(P*log(2)/log(5)) */
+/* Bletch = (highest power of 2 < DBL_MAX_10_EXP) / 16 */
+/* Quick_max = floor((P-1)*log(FLT_RADIX)/log(10) - 1) */
+/* Int_max = floor(P*log(FLT_RADIX)/log(10) - 1) */
+
+#ifdef IEEE_Arith
+#define Exp_shift  20
+#define Exp_shift1 20
+#define Exp_msk1    0x100000
+#define Exp_msk11   0x100000
+#define Exp_mask  0x7ff00000
+#define P 53
+#define Bias 1023
+#define Emin (-1022)
+#define Exp_1  0x3ff00000
+#define Exp_11 0x3ff00000
+#define Ebits 11
+#define Frac_mask  0xfffff
+#define Frac_mask1 0xfffff
+#define Ten_pmax 22
+#define Bletch 0x10
+#define Bndry_mask  0xfffff
+#define Bndry_mask1 0xfffff
+#define LSB 1
+#define Sign_bit 0x80000000
+#define Log2P 1
+#define Tiny0 0
+#define Tiny1 1
+#define Quick_max 14
+#define Int_max 14
+
+#ifndef Flt_Rounds
+#ifdef FLT_ROUNDS
+#define Flt_Rounds FLT_ROUNDS
+#else
+#define Flt_Rounds 1
+#endif
+#endif /*Flt_Rounds*/
+
+#else /* ifndef IEEE_Arith */
+#undef  Sudden_Underflow
+#define Sudden_Underflow
+#ifdef IBM
+#undef Flt_Rounds
+#define Flt_Rounds 0
+#define Exp_shift  24
+#define Exp_shift1 24
+#define Exp_msk1   0x1000000
+#define Exp_msk11  0x1000000
+#define Exp_mask  0x7f000000
+#define P 14
+#define Bias 65
+#define Exp_1  0x41000000
+#define Exp_11 0x41000000
+#define Ebits 8        /* exponent has 7 bits, but 8 is the right value in b2d */
+#define Frac_mask  0xffffff
+#define Frac_mask1 0xffffff
+#define Bletch 4
+#define Ten_pmax 22
+#define Bndry_mask  0xefffff
+#define Bndry_mask1 0xffffff
+#define LSB 1
+#define Sign_bit 0x80000000
+#define Log2P 4
+#define Tiny0 0x100000
+#define Tiny1 0
+#define Quick_max 14
+#define Int_max 15
+#else /* VAX */
+#undef Flt_Rounds
+#define Flt_Rounds 1
+#define Exp_shift  23
+#define Exp_shift1 7
+#define Exp_msk1    0x80
+#define Exp_msk11   0x800000
+#define Exp_mask  0x7f80
+#define P 56
+#define Bias 129
+#define Exp_1  0x40800000
+#define Exp_11 0x4080
+#define Ebits 8
+#define Frac_mask  0x7fffff
+#define Frac_mask1 0xffff007f
+#define Ten_pmax 24
+#define Bletch 2
+#define Bndry_mask  0xffff007f
+#define Bndry_mask1 0xffff007f
+#define LSB 0x10000
+#define Sign_bit 0x8000
+#define Log2P 1
+#define Tiny0 0x80
+#define Tiny1 0
+#define Quick_max 15
+#define Int_max 15
+#endif /* IBM, VAX */
+#endif /* IEEE_Arith */
+
+#ifndef IEEE_Arith
+#define ROUND_BIASED
+#endif
+
+#ifdef RND_PRODQUOT
+#define rounded_product(a,b) a = rnd_prod(a, b)
+#define rounded_quotient(a,b) a = rnd_quot(a, b)
+#ifdef KR_headers
+extern double rnd_prod(), rnd_quot();
+#else
+extern double rnd_prod(double, double), rnd_quot(double, double);
+#endif
+#else
+#define rounded_product(a,b) a *= b
+#define rounded_quotient(a,b) a /= b
+#endif
+
+#define Big0 (Frac_mask1 | Exp_msk1*(DBL_MAX_EXP+Bias-1))
+#define Big1 0xffffffff
+
+#undef  Pack_16
+#ifndef Pack_32
+#define Pack_32
+#endif
+
+#ifdef NO_LONG_LONG
+#undef ULLong
+#ifdef Just_16
+#undef Pack_32
+#define Pack_16
+/* When Pack_32 is not defined, we store 16 bits per 32-bit Long.
+ * This makes some inner loops simpler and sometimes saves work
+ * during multiplications, but it often seems to make things slightly
+ * slower.  Hence the default is now to store 32 bits per Long.
+ */
+#endif
+#else  /* long long available */
+#ifndef Llong
+#define Llong long long
+#endif
+#ifndef ULLong
+#define ULLong unsigned Llong
+#endif
+#endif /* NO_LONG_LONG */
+
+#ifdef Pack_32
+#define ULbits 32
+#define kshift 5
+#define kmask 31
+#define ALL_ON 0xffffffff
+#else
+#define ULbits 16
+#define kshift 4
+#define kmask 15
+#define ALL_ON 0xffff
+#endif
+
+#ifndef MULTIPLE_THREADS
+#define ACQUIRE_DTOA_LOCK(n)   /*nothing*/
+#define FREE_DTOA_LOCK(n)      /*nothing*/
+#endif
+
+#define Kmax 15
+
+ struct
+Bigint {
+       struct Bigint *next;
+       int k, maxwds, sign, wds;
+       ULong x[1];
+       };
+
+ typedef struct Bigint Bigint;
+
+#ifdef NO_STRING_H
+#ifdef DECLARE_SIZE_T
+typedef unsigned int size_t;
+#endif
+extern void memcpy_D2A ANSI((void*, const void*, size_t));
+#define Bcopy(x,y) memcpy_D2A(&x->sign,&y->sign,y->wds*sizeof(ULong) + 2*sizeof(int))
+#else /* !NO_STRING_H */
+#define Bcopy(x,y) memcpy(&x->sign,&y->sign,y->wds*sizeof(ULong) + 2*sizeof(int))
+#endif /* NO_STRING_H */
+
+#define Balloc Balloc_D2A
+#define Bfree Bfree_D2A
+#define ULtoQ ULtoQ_D2A
+#define ULtof ULtof_D2A
+#define ULtod ULtod_D2A
+#define ULtodd ULtodd_D2A
+#define ULtox ULtox_D2A
+#define ULtoxL ULtoxL_D2A
+#define any_on any_on_D2A
+#define b2d b2d_D2A
+#define bigtens bigtens_D2A
+#define cmp cmp_D2A
+#define copybits copybits_D2A
+#define d2b d2b_D2A
+#define decrement decrement_D2A
+#define diff diff_D2A
+#define dtoa_result dtoa_result_D2A
+#define g__fmt g__fmt_D2A
+#define gethex gethex_D2A
+#define hexdig hexdig_D2A
+#define hexnan hexnan_D2A
+#define hi0bits(x) hi0bits_D2A((ULong)(x))
+#define i2b i2b_D2A
+#define increment increment_D2A
+#define lo0bits lo0bits_D2A
+#define lshift lshift_D2A
+#define match match_D2A
+#define mult mult_D2A
+#define multadd multadd_D2A
+#define nrv_alloc nrv_alloc_D2A
+#define pow5mult pow5mult_D2A
+#define quorem quorem_D2A
+#define ratio ratio_D2A
+#define rshift rshift_D2A
+#define rv_alloc rv_alloc_D2A
+#define s2b s2b_D2A
+#define set_ones set_ones_D2A
+#define strcp strcp_D2A
+#define strtoIg strtoIg_D2A
+#define sum sum_D2A
+#define tens tens_D2A
+#define tinytens tinytens_D2A
+#define tinytens tinytens_D2A
+#define trailz trailz_D2A
+#define ulp ulp_D2A
+
+ extern char *dtoa_result;
+ extern CONST double bigtens[], tens[], tinytens[];
+ extern unsigned char hexdig[];
+
+ extern Bigint *Balloc ANSI((int));
+ extern void Bfree ANSI((Bigint*));
+ extern void ULtof ANSI((ULong*, ULong*, Long, int));
+ extern void ULtod ANSI((ULong*, ULong*, Long, int));
+ extern void ULtodd ANSI((ULong*, ULong*, Long, int));
+ extern void ULtoQ ANSI((ULong*, ULong*, Long, int));
+ extern void ULtox ANSI((UShort*, ULong*, Long, int));
+ extern void ULtoxL ANSI((ULong*, ULong*, Long, int));
+ extern ULong any_on ANSI((Bigint*, int));
+ extern double b2d ANSI((Bigint*, int*));
+ extern int cmp ANSI((Bigint*, Bigint*));
+ extern void copybits ANSI((ULong*, int, Bigint*));
+ extern Bigint *d2b ANSI((double, int*, int*));
+ extern void decrement ANSI((Bigint*));
+ extern Bigint *diff ANSI((Bigint*, Bigint*));
+ extern char *dtoa ANSI((double d, int mode, int ndigits,
+                       int *decpt, int *sign, char **rve));
+ extern char *g__fmt ANSI((char*, char*, char*, int, ULong, size_t));
+ extern int gethex ANSI((CONST char**, FPI*, Long*, Bigint**, int));
+ extern void hexdig_init_D2A(Void);
+ extern int hexnan ANSI((CONST char**, FPI*, ULong*));
+ extern int hi0bits_D2A ANSI((ULong));
+ extern Bigint *i2b ANSI((int));
+ extern Bigint *increment ANSI((Bigint*));
+ extern int lo0bits ANSI((ULong*));
+ extern Bigint *lshift ANSI((Bigint*, int));
+ extern int match ANSI((CONST char**, char*));
+ extern Bigint *mult ANSI((Bigint*, Bigint*));
+ extern Bigint *multadd ANSI((Bigint*, int, int));
+ extern char *nrv_alloc ANSI((char*, char **, int));
+ extern Bigint *pow5mult ANSI((Bigint*, int));
+ extern int quorem ANSI((Bigint*, Bigint*));
+ extern double ratio ANSI((Bigint*, Bigint*));
+ extern void rshift ANSI((Bigint*, int));
+ extern char *rv_alloc ANSI((int));
+ extern Bigint *s2b ANSI((CONST char*, int, int, ULong, int));
+ extern Bigint *set_ones ANSI((Bigint*, int));
+ extern char *strcp ANSI((char*, const char*));
+ extern int strtoIg ANSI((CONST char*, char**, FPI*, Long*, Bigint**, int*));
+ extern double strtod ANSI((const char *s00, char **se));
+ extern Bigint *sum ANSI((Bigint*, Bigint*));
+ extern int trailz ANSI((Bigint*));
+ extern double ulp ANSI((double));
+
+#ifdef __cplusplus
+}
+#endif
+/*
+ * NAN_WORD0 and NAN_WORD1 are only referenced in strtod.c.  Prior to
+ * 20050115, they used to be hard-wired here (to 0x7ff80000 and 0,
+ * respectively), but now are determined by compiling and running
+ * qnan.c to generate gd_qnan.h, which specifies d_QNAN0 and d_QNAN1.
+ * Formerly gdtoaimp.h recommended supplying suitable -DNAN_WORD0=...
+ * and -DNAN_WORD1=...  values if necessary.  This should still work.
+ * (On HP Series 700/800 machines, -DNAN_WORD0=0x7ff40000 works.)
+ */
+#ifdef IEEE_Arith
+#ifndef NO_INFNAN_CHECK
+#undef INFNAN_CHECK
+#define INFNAN_CHECK
+#endif
+#ifdef IEEE_MC68k
+#define _0 0
+#define _1 1
+#ifndef NAN_WORD0
+#define NAN_WORD0 d_QNAN0
+#endif
+#ifndef NAN_WORD1
+#define NAN_WORD1 d_QNAN1
+#endif
+#else
+#define _0 1
+#define _1 0
+#ifndef NAN_WORD0
+#define NAN_WORD0 d_QNAN1
+#endif
+#ifndef NAN_WORD1
+#define NAN_WORD1 d_QNAN0
+#endif
+#endif
+#else
+#undef INFNAN_CHECK
+#endif
+
+#undef SI
+#ifdef Sudden_Underflow
+#define SI 1
+#else
+#define SI 0
+#endif
+
+#endif /* GDTOAIMP_H_INCLUDED */
diff --git a/contrib/gdtoa/gethex.c b/contrib/gdtoa/gethex.c
new file mode 100644 (file)
index 0000000..c8ac8ba
--- /dev/null
@@ -0,0 +1,350 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+#ifdef USE_LOCALE
+#include "locale.h"
+#endif
+
+ int
+#ifdef KR_headers
+gethex(sp, fpi, exp, bp, sign)
+       CONST char **sp; FPI *fpi; Long *exp; Bigint **bp; int sign;
+#else
+gethex( CONST char **sp, FPI *fpi, Long *exp, Bigint **bp, int sign)
+#endif
+{
+       Bigint *b;
+       CONST unsigned char *decpt, *s0, *s, *s1;
+       int big, esign, havedig, irv, j, k, n, n0, nbits, up, zret;
+       ULong L, lostbits, *x;
+       Long e, e1;
+#ifdef USE_LOCALE
+       int i;
+#ifdef NO_LOCALE_CACHE
+       const unsigned char *decimalpoint = (unsigned char*)localeconv()->decimal_point;
+#else
+       const unsigned char *decimalpoint;
+       static unsigned char *decimalpoint_cache;
+       if (!(s0 = decimalpoint_cache)) {
+               s0 = (unsigned char*)localeconv()->decimal_point;
+               if ((decimalpoint_cache = (char*)malloc(strlen(s0) + 1))) {
+                       strcpy(decimalpoint_cache, s0);
+                       s0 = decimalpoint_cache;
+                       }
+               }
+       decimalpoint = s0;
+#endif
+#endif
+
+       if (!hexdig['0'])
+               hexdig_init_D2A();
+       *bp = 0;
+       havedig = 0;
+       s0 = *(CONST unsigned char **)sp + 2;
+       while(s0[havedig] == '0')
+               havedig++;
+       s0 += havedig;
+       s = s0;
+       decpt = 0;
+       zret = 0;
+       e = 0;
+       if (hexdig[*s])
+               havedig++;
+       else {
+               zret = 1;
+#ifdef USE_LOCALE
+               for(i = 0; decimalpoint[i]; ++i) {
+                       if (s[i] != decimalpoint[i])
+                               goto pcheck;
+                       }
+               decpt = s += i;
+#else
+               if (*s != '.')
+                       goto pcheck;
+               decpt = ++s;
+#endif
+               if (!hexdig[*s])
+                       goto pcheck;
+               while(*s == '0')
+                       s++;
+               if (hexdig[*s])
+                       zret = 0;
+               havedig = 1;
+               s0 = s;
+               }
+       while(hexdig[*s])
+               s++;
+#ifdef USE_LOCALE
+       if (*s == *decimalpoint && !decpt) {
+               for(i = 1; decimalpoint[i]; ++i) {
+                       if (s[i] != decimalpoint[i])
+                               goto pcheck;
+                       }
+               decpt = s += i;
+#else
+       if (*s == '.' && !decpt) {
+               decpt = ++s;
+#endif
+               while(hexdig[*s])
+                       s++;
+               }/*}*/
+       if (decpt)
+               e = -(((Long)(s-decpt)) << 2);
+ pcheck:
+       s1 = s;
+       big = esign = 0;
+       switch(*s) {
+         case 'p':
+         case 'P':
+               switch(*++s) {
+                 case '-':
+                       esign = 1;
+                       /* no break */
+                 case '+':
+                       s++;
+                 }
+               if ((n = hexdig[*s]) == 0 || n > 0x19) {
+                       s = s1;
+                       break;
+                       }
+               e1 = n - 0x10;
+               while((n = hexdig[*++s]) !=0 && n <= 0x19) {
+                       if (e1 & 0xf8000000)
+                               big = 1;
+                       e1 = 10*e1 + n - 0x10;
+                       }
+               if (esign)
+                       e1 = -e1;
+               e += e1;
+         }
+       *sp = (char*)s;
+       if (!havedig)
+               *sp = (char*)s0 - 1;
+       if (zret)
+               return STRTOG_Zero;
+       if (big) {
+               if (esign) {
+                       switch(fpi->rounding) {
+                         case FPI_Round_up:
+                               if (sign)
+                                       break;
+                               goto ret_tiny;
+                         case FPI_Round_down:
+                               if (!sign)
+                                       break;
+                               goto ret_tiny;
+                         }
+                       goto retz;
+ ret_tiny:
+                       b = Balloc(0);
+                       b->wds = 1;
+                       b->x[0] = 1;
+                       goto dret;
+                       }
+               switch(fpi->rounding) {
+                 case FPI_Round_near:
+                       goto ovfl1;
+                 case FPI_Round_up:
+                       if (!sign)
+                               goto ovfl1;
+                       goto ret_big;
+                 case FPI_Round_down:
+                       if (sign)
+                               goto ovfl1;
+                       goto ret_big;
+                 }
+ ret_big:
+               nbits = fpi->nbits;
+               n0 = n = nbits >> kshift;
+               if (nbits & kmask)
+                       ++n;
+               for(j = n, k = 0; j >>= 1; ++k);
+               *bp = b = Balloc(k);
+               b->wds = n;
+               for(j = 0; j < n0; ++j)
+                       b->x[j] = ALL_ON;
+               if (n > n0)
+                       b->x[j] = ULbits >> (ULbits - (nbits & kmask));
+               *exp = fpi->emin;
+               return STRTOG_Normal | STRTOG_Inexlo;
+               }
+       n = s1 - s0 - 1;
+       for(k = 0; n > (1 << kshift-2) - 1; n >>= 1)
+               k++;
+       b = Balloc(k);
+       x = b->x;
+       n = 0;
+       L = 0;
+#ifdef USE_LOCALE
+       for(i = 0; decimalpoint[i+1]; ++i);
+#endif
+       while(s1 > s0) {
+#ifdef USE_LOCALE
+               if (*--s1 == decimalpoint[i]) {
+                       s1 -= i;
+                       continue;
+                       }
+#else
+               if (*--s1 == '.')
+                       continue;
+#endif
+               if (n == ULbits) {
+                       *x++ = L;
+                       L = 0;
+                       n = 0;
+                       }
+               L |= (hexdig[*s1] & 0x0f) << n;
+               n += 4;
+               }
+       *x++ = L;
+       b->wds = n = x - b->x;
+       n = ULbits*n - hi0bits(L);
+       nbits = fpi->nbits;
+       lostbits = 0;
+       x = b->x;
+       if (n > nbits) {
+               n -= nbits;
+               if (any_on(b,n)) {
+                       lostbits = 1;
+                       k = n - 1;
+                       if (x[k>>kshift] & 1 << (k & kmask)) {
+                               lostbits = 2;
+                               if (k > 0 && any_on(b,k))
+                                       lostbits = 3;
+                               }
+                       }
+               rshift(b, n);
+               e += n;
+               }
+       else if (n < nbits) {
+               n = nbits - n;
+               b = lshift(b, n);
+               e -= n;
+               x = b->x;
+               }
+       if (e > fpi->emax) {
+ ovfl:
+               Bfree(b);
+ ovfl1:
+#ifndef NO_ERRNO
+               errno = ERANGE;
+#endif
+               return STRTOG_Infinite | STRTOG_Overflow | STRTOG_Inexhi;
+               }
+       irv = STRTOG_Normal;
+       if (e < fpi->emin) {
+               irv = STRTOG_Denormal;
+               n = fpi->emin - e;
+               if (n >= nbits) {
+                       switch (fpi->rounding) {
+                         case FPI_Round_near:
+                               if (n == nbits && (n < 2 || any_on(b,n-1)))
+                                       goto one_bit;
+                               break;
+                         case FPI_Round_up:
+                               if (!sign)
+                                       goto one_bit;
+                               break;
+                         case FPI_Round_down:
+                               if (sign) {
+ one_bit:
+                                       x[0] = b->wds = 1;
+ dret:
+                                       *bp = b;
+                                       *exp = fpi->emin;
+#ifndef NO_ERRNO
+                                       errno = ERANGE;
+#endif
+                                       return STRTOG_Denormal | STRTOG_Inexhi
+                                               | STRTOG_Underflow;
+                                       }
+                         }
+                       Bfree(b);
+ retz:
+#ifndef NO_ERRNO
+                       errno = ERANGE;
+#endif
+                       return STRTOG_Zero | STRTOG_Inexlo | STRTOG_Underflow;
+                       }
+               k = n - 1;
+               if (lostbits)
+                       lostbits = 1;
+               else if (k > 0)
+                       lostbits = any_on(b,k);
+               if (x[k>>kshift] & 1 << (k & kmask))
+                       lostbits |= 2;
+               nbits -= n;
+               rshift(b,n);
+               e = fpi->emin;
+               }
+       if (lostbits) {
+               up = 0;
+               switch(fpi->rounding) {
+                 case FPI_Round_zero:
+                       break;
+                 case FPI_Round_near:
+                       if (lostbits & 2
+                        && (lostbits & 1) | x[0] & 1)
+                               up = 1;
+                       break;
+                 case FPI_Round_up:
+                       up = 1 - sign;
+                       break;
+                 case FPI_Round_down:
+                       up = sign;
+                 }
+               if (up) {
+                       k = b->wds;
+                       b = increment(b);
+                       x = b->x;
+                       if (irv == STRTOG_Denormal) {
+                               if (nbits == fpi->nbits - 1
+                                && x[nbits >> kshift] & 1 << (nbits & kmask))
+                                       irv =  STRTOG_Normal;
+                               }
+                       else if (b->wds > k
+                        || (n = nbits & kmask) !=0
+                            && hi0bits(x[k-1]) < 32-n) {
+                               rshift(b,1);
+                               if (++e > fpi->emax)
+                                       goto ovfl;
+                               }
+                       irv |= STRTOG_Inexhi;
+                       }
+               else
+                       irv |= STRTOG_Inexlo;
+               }
+       *bp = b;
+       *exp = e;
+       return irv;
+       }
diff --git a/contrib/gdtoa/gmisc.c b/contrib/gdtoa/gmisc.c
new file mode 100644 (file)
index 0000000..8270ef9
--- /dev/null
@@ -0,0 +1,86 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+ void
+#ifdef KR_headers
+rshift(b, k) Bigint *b; int k;
+#else
+rshift(Bigint *b, int k)
+#endif
+{
+       ULong *x, *x1, *xe, y;
+       int n;
+
+       x = x1 = b->x;
+       n = k >> kshift;
+       if (n < b->wds) {
+               xe = x + b->wds;
+               x += n;
+               if (k &= kmask) {
+                       n = ULbits - k;
+                       y = *x++ >> k;
+                       while(x < xe) {
+                               *x1++ = (y | (*x << n)) & ALL_ON;
+                               y = *x++ >> k;
+                               }
+                       if ((*x1 = y) !=0)
+                               x1++;
+                       }
+               else
+                       while(x < xe)
+                               *x1++ = *x++;
+               }
+       if ((b->wds = x1 - b->x) == 0)
+               b->x[0] = 0;
+       }
+
+ int
+#ifdef KR_headers
+trailz(b) Bigint *b;
+#else
+trailz(Bigint *b)
+#endif
+{
+       ULong L, *x, *xe;
+       int n = 0;
+
+       x = b->x;
+       xe = x + b->wds;
+       for(n = 0; x < xe && !*x; x++)
+               n += ULbits;
+       if (x < xe) {
+               L = *x;
+               n += lo0bits(&L);
+               }
+       return n;
+       }
diff --git a/contrib/gdtoa/hd_init.c b/contrib/gdtoa/hd_init.c
new file mode 100644 (file)
index 0000000..fa6e18d
--- /dev/null
@@ -0,0 +1,55 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 2000 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+ unsigned char hexdig[256];
+
+ static void
+#ifdef KR_headers
+htinit(h, s, inc) unsigned char *h; unsigned char *s; int inc;
+#else
+htinit(unsigned char *h, unsigned char *s, int inc)
+#endif
+{
+       int i, j;
+       for(i = 0; (j = s[i]) !=0; i++)
+               h[j] = i + inc;
+       }
+
+ void
+hexdig_init_D2A(Void)
+{
+#define USC (unsigned char *)
+       htinit(hexdig, USC "0123456789", 0x10);
+       htinit(hexdig, USC "abcdef", 0x10 + 10);
+       htinit(hexdig, USC "ABCDEF", 0x10 + 10);
+       }
diff --git a/contrib/gdtoa/hexnan.c b/contrib/gdtoa/hexnan.c
new file mode 100644 (file)
index 0000000..e07e069
--- /dev/null
@@ -0,0 +1,150 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 2000 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+ static void
+#ifdef KR_headers
+L_shift(x, x1, i) ULong *x; ULong *x1; int i;
+#else
+L_shift(ULong *x, ULong *x1, int i)
+#endif
+{
+       int j;
+
+       i = 8 - i;
+       i <<= 2;
+       j = ULbits - i;
+       do {
+               *x |= x[1] << j;
+               x[1] >>= i;
+               } while(++x < x1);
+       }
+
+ int
+#ifdef KR_headers
+hexnan(sp, fpi, x0)
+       CONST char **sp; FPI *fpi; ULong *x0;
+#else
+hexnan( CONST char **sp, FPI *fpi, ULong *x0)
+#endif
+{
+       ULong c, h, *x, *x1, *xe;
+       CONST char *s;
+       int havedig, hd0, i, nbits;
+
+       if (!hexdig['0'])
+               hexdig_init_D2A();
+       nbits = fpi->nbits;
+       x = x0 + (nbits >> kshift);
+       if (nbits & kmask)
+               x++;
+       *--x = 0;
+       x1 = xe = x;
+       havedig = hd0 = i = 0;
+       s = *sp;
+       /* allow optional initial 0x or 0X */
+       while((c = *(CONST unsigned char*)(s+1)) && c <= ' ')
+               ++s;
+       if (s[1] == '0' && (s[2] == 'x' || s[2] == 'X')
+        && *(CONST unsigned char*)(s+3) > ' ')
+               s += 2;
+       while(c = *(CONST unsigned char*)++s) {
+               if (!(h = hexdig[c])) {
+                       if (c <= ' ') {
+                               if (hd0 < havedig) {
+                                       if (x < x1 && i < 8)
+                                               L_shift(x, x1, i);
+                                       if (x <= x0) {
+                                               i = 8;
+                                               continue;
+                                               }
+                                       hd0 = havedig;
+                                       *--x = 0;
+                                       x1 = x;
+                                       i = 0;
+                                       }
+                               while(*(CONST unsigned char*)(s+1) <= ' ')
+                                       ++s;
+                               if (s[1] == '0' && (s[2] == 'x' || s[2] == 'X')
+                                && *(CONST unsigned char*)(s+3) > ' ')
+                                       s += 2;
+                               continue;
+                               }
+                       if (/*(*/ c == ')' && havedig) {
+                               *sp = s + 1;
+                               break;
+                               }
+#ifndef GDTOA_NON_PEDANTIC_NANCHECK
+                       do {
+                               if (/*(*/ c == ')') {
+                                       *sp = s + 1;
+                                       break;
+                                       }
+                               } while(c = *++s);
+#endif
+                       return STRTOG_NaN;
+                       }
+               havedig++;
+               if (++i > 8) {
+                       if (x <= x0)
+                               continue;
+                       i = 1;
+                       *--x = 0;
+                       }
+               *x = (*x << 4) | h & 0xf;
+               }
+       if (!havedig)
+               return STRTOG_NaN;
+       if (x < x1 && i < 8)
+               L_shift(x, x1, i);
+       if (x > x0) {
+               x1 = x0;
+               do *x1++ = *x++;
+                       while(x <= xe);
+               do *x1++ = 0;
+                       while(x1 <= xe);
+               }
+       else {
+               /* truncate high-order word if necessary */
+               if ( (i = nbits & (ULbits-1)) !=0)
+                       *xe &= ((ULong)0xffffffff) >> (ULbits - i);
+               }
+       for(x1 = xe;; --x1) {
+               if (*x1 != 0)
+                       break;
+               if (x1 == x0) {
+                       *x1 = 1;
+                       break;
+                       }
+               }
+       return STRTOG_NaNbits;
+       }
diff --git a/contrib/gdtoa/makefile b/contrib/gdtoa/makefile
new file mode 100644 (file)
index 0000000..367eb9c
--- /dev/null
@@ -0,0 +1,74 @@
+# /****************************************************************
+# Copyright (C) 1998 by Lucent Technologies
+# All Rights Reserved
+#
+# Permission to use, copy, modify, and distribute this software and
+# its documentation for any purpose and without fee is hereby
+# granted, provided that the above copyright notice appear in all
+# copies and that both that the copyright notice and this
+# permission notice and warranty disclaimer appear in supporting
+# documentation, and that the name of Lucent or any of its entities
+# not be used in advertising or publicity pertaining to
+# distribution of the software without specific, written prior
+# permission.
+#
+# LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+# INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+# IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+# SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+# IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+# THIS SOFTWARE.
+#
+# ****************************************************************/
+
+.SUFFIXES: .c .o
+CC = cc
+CFLAGS = -g
+
+.c.o:
+       $(CC) -c $(CFLAGS) $*.c
+
+all: arith.h gd_qnan.h gdtoa.a
+
+arith.h: arithchk.c
+       $(CC) $(CFLAGS) arithchk.c || $(CC) -DNO_LONG_LONG $(CFLAGS) arithchk.c
+       ./a.out >arith.h
+       rm -f a.out arithchk.o
+
+gd_qnan.h: arith.h qnan.c
+       $(CC) $(CFLAGS) qnan.c
+       ./a.out >gd_qnan.h
+       rm -f a.out qnan.o
+
+gdtoa.a: dmisc.c dtoa.c g_Qfmt.c g__fmt.c g_ddfmt.c g_dfmt.c g_ffmt.c\
+        g_xLfmt.c g_xfmt.c gdtoa.c gethex.c gmisc.c hd_init.c hexnan.c\
+        misc.c smisc.c strtoIQ.c strtoId.c strtoIdd.c strtoIf.c strtoIg.c\
+        strtoIx.c strtoIxL.c strtod.c strtodI.c strtodg.c strtof.c strtopQ.c\
+        strtopd.c strtopdd.c strtopf.c strtopx.c strtopxL.c strtorQ.c\
+        strtord.c strtordd.c strtorf.c strtorx.c strtorxL.c sum.c ulp.c
+       $(CC) -c $(CFLAGS) $?
+       x=`echo $? | sed 's/\.c/.o/g'` && ar ruv gdtoa.a $$x && rm $$x
+       ranlib gdtoa.a || true
+
+# If your system lacks ranlib, you do not need it.
+
+xs0 = README arithchk.c dmisc.c dtoa.c g_Qfmt.c g__fmt.c g_ddfmt.c g_dfmt.c\
+        g_ffmt.c g_xLfmt.c g_xfmt.c gdtoa.c gdtoa.h gdtoa_fltrnds.h gdtoaimp.h\
+        gethex.c gmisc.c hd_init.c hexnan.c makefile misc.c qnan.c smisc.c\
+        strtoIQ.c strtoId.c strtoIdd.c strtoIf.c strtoIg.c strtoIx.c strtoIxL.c\
+        strtod.c strtodI.c strtodg.c strtodnrp.c strtof.c strtopQ.c strtopd.c\
+        strtopdd.c strtopf.c strtopx.c strtopxL.c strtorQ.c strtord.c strtordd.c\
+        strtorf.c strtorx.c strtorxL.c sum.c ulp.c
+
+# "make xsum.out" to check for transmission errors; source for xsum is
+# netlib's "xsum.c from f2c", e.g.,
+# ftp://netlib.bell-labs.com/netlib/f2c/xsum.c.gz
+
+xsum.out: xsum0.out $(xs0)
+       xsum $(xs0) >xsum1.out
+       cmp xsum0.out xsum1.out && mv xsum1.out xsum.out || diff xsum[01].out
+
+clean:
+       rm -f arith.h gd_qnan.h *.[ao] xsum.out xsum1.out
diff --git a/contrib/gdtoa/misc.c b/contrib/gdtoa/misc.c
new file mode 100644 (file)
index 0000000..b3ce7c9
--- /dev/null
@@ -0,0 +1,865 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998, 1999 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+ static Bigint *freelist[Kmax+1];
+#ifndef Omit_Private_Memory
+#ifndef PRIVATE_MEM
+#define PRIVATE_MEM 2304
+#endif
+#define PRIVATE_mem ((PRIVATE_MEM+sizeof(double)-1)/sizeof(double))
+static double private_mem[PRIVATE_mem], *pmem_next = private_mem;
+#endif
+
+ Bigint *
+Balloc
+#ifdef KR_headers
+       (k) int k;
+#else
+       (int k)
+#endif
+{
+       int x;
+       Bigint *rv;
+#ifndef Omit_Private_Memory
+       unsigned int len;
+#endif
+
+       ACQUIRE_DTOA_LOCK(0);
+       if ( (rv = freelist[k]) !=0) {
+               freelist[k] = rv->next;
+               }
+       else {
+               x = 1 << k;
+#ifdef Omit_Private_Memory
+               rv = (Bigint *)MALLOC(sizeof(Bigint) + (x-1)*sizeof(ULong));
+#else
+               len = (sizeof(Bigint) + (x-1)*sizeof(ULong) + sizeof(double) - 1)
+                       /sizeof(double);
+               if (pmem_next - private_mem + len <= PRIVATE_mem) {
+                       rv = (Bigint*)pmem_next;
+                       pmem_next += len;
+                       }
+               else
+                       rv = (Bigint*)MALLOC(len*sizeof(double));
+#endif
+               rv->k = k;
+               rv->maxwds = x;
+               }
+       FREE_DTOA_LOCK(0);
+       rv->sign = rv->wds = 0;
+       return rv;
+       }
+
+ void
+Bfree
+#ifdef KR_headers
+       (v) Bigint *v;
+#else
+       (Bigint *v)
+#endif
+{
+       if (v) {
+               ACQUIRE_DTOA_LOCK(0);
+               v->next = freelist[v->k];
+               freelist[v->k] = v;
+               FREE_DTOA_LOCK(0);
+               }
+       }
+
+ int
+lo0bits
+#ifdef KR_headers
+       (y) ULong *y;
+#else
+       (ULong *y)
+#endif
+{
+       register int k;
+       register ULong x = *y;
+
+       if (x & 7) {
+               if (x & 1)
+                       return 0;
+               if (x & 2) {
+                       *y = x >> 1;
+                       return 1;
+                       }
+               *y = x >> 2;
+               return 2;
+               }
+       k = 0;
+       if (!(x & 0xffff)) {
+               k = 16;
+               x >>= 16;
+               }
+       if (!(x & 0xff)) {
+               k += 8;
+               x >>= 8;
+               }
+       if (!(x & 0xf)) {
+               k += 4;
+               x >>= 4;
+               }
+       if (!(x & 0x3)) {
+               k += 2;
+               x >>= 2;
+               }
+       if (!(x & 1)) {
+               k++;
+               x >>= 1;
+               if (!x)
+                       return 32;
+               }
+       *y = x;
+       return k;
+       }
+
+ Bigint *
+multadd
+#ifdef KR_headers
+       (b, m, a) Bigint *b; int m, a;
+#else
+       (Bigint *b, int m, int a)       /* multiply by m and add a */
+#endif
+{
+       int i, wds;
+#ifdef ULLong
+       ULong *x;
+       ULLong carry, y;
+#else
+       ULong carry, *x, y;
+#ifdef Pack_32
+       ULong xi, z;
+#endif
+#endif
+       Bigint *b1;
+
+       wds = b->wds;
+       x = b->x;
+       i = 0;
+       carry = a;
+       do {
+#ifdef ULLong
+               y = *x * (ULLong)m + carry;
+               carry = y >> 32;
+               *x++ = y & 0xffffffffUL;
+#else
+#ifdef Pack_32
+               xi = *x;
+               y = (xi & 0xffff) * m + carry;
+               z = (xi >> 16) * m + (y >> 16);
+               carry = z >> 16;
+               *x++ = (z << 16) + (y & 0xffff);
+#else
+               y = *x * m + carry;
+               carry = y >> 16;
+               *x++ = y & 0xffff;
+#endif
+#endif
+               }
+               while(++i < wds);
+       if (carry) {
+               if (wds >= b->maxwds) {
+                       b1 = Balloc(b->k+1);
+                       Bcopy(b1, b);
+                       Bfree(b);
+                       b = b1;
+                       }
+               b->x[wds++] = carry;
+               b->wds = wds;
+               }
+       return b;
+       }
+
+ int
+hi0bits_D2A
+#ifdef KR_headers
+       (x) register ULong x;
+#else
+       (register ULong x)
+#endif
+{
+       register int k = 0;
+
+       if (!(x & 0xffff0000)) {
+               k = 16;
+               x <<= 16;
+               }
+       if (!(x & 0xff000000)) {
+               k += 8;
+               x <<= 8;
+               }
+       if (!(x & 0xf0000000)) {
+               k += 4;
+               x <<= 4;
+               }
+       if (!(x & 0xc0000000)) {
+               k += 2;
+               x <<= 2;
+               }
+       if (!(x & 0x80000000)) {
+               k++;
+               if (!(x & 0x40000000))
+                       return 32;
+               }
+       return k;
+       }
+
+ Bigint *
+i2b
+#ifdef KR_headers
+       (i) int i;
+#else
+       (int i)
+#endif
+{
+       Bigint *b;
+
+       b = Balloc(1);
+       b->x[0] = i;
+       b->wds = 1;
+       return b;
+       }
+
+ Bigint *
+mult
+#ifdef KR_headers
+       (a, b) Bigint *a, *b;
+#else
+       (Bigint *a, Bigint *b)
+#endif
+{
+       Bigint *c;
+       int k, wa, wb, wc;
+       ULong *x, *xa, *xae, *xb, *xbe, *xc, *xc0;
+       ULong y;
+#ifdef ULLong
+       ULLong carry, z;
+#else
+       ULong carry, z;
+#ifdef Pack_32
+       ULong z2;
+#endif
+#endif
+
+       if (a->wds < b->wds) {
+               c = a;
+               a = b;
+               b = c;
+               }
+       k = a->k;
+       wa = a->wds;
+       wb = b->wds;
+       wc = wa + wb;
+       if (wc > a->maxwds)
+               k++;
+       c = Balloc(k);
+       for(x = c->x, xa = x + wc; x < xa; x++)
+               *x = 0;
+       xa = a->x;
+       xae = xa + wa;
+       xb = b->x;
+       xbe = xb + wb;
+       xc0 = c->x;
+#ifdef ULLong
+       for(; xb < xbe; xc0++) {
+               if ( (y = *xb++) !=0) {
+                       x = xa;
+                       xc = xc0;
+                       carry = 0;
+                       do {
+                               z = *x++ * (ULLong)y + *xc + carry;
+                               carry = z >> 32;
+                               *xc++ = z & 0xffffffffUL;
+                               }
+                               while(x < xae);
+                       *xc = carry;
+                       }
+               }
+#else
+#ifdef Pack_32
+       for(; xb < xbe; xb++, xc0++) {
+               if ( (y = *xb & 0xffff) !=0) {
+                       x = xa;
+                       xc = xc0;
+                       carry = 0;
+                       do {
+                               z = (*x & 0xffff) * y + (*xc & 0xffff) + carry;
+                               carry = z >> 16;
+                               z2 = (*x++ >> 16) * y + (*xc >> 16) + carry;
+                               carry = z2 >> 16;
+                               Storeinc(xc, z2, z);
+                               }
+                               while(x < xae);
+                       *xc = carry;
+                       }
+               if ( (y = *xb >> 16) !=0) {
+                       x = xa;
+                       xc = xc0;
+                       carry = 0;
+                       z2 = *xc;
+                       do {
+                               z = (*x & 0xffff) * y + (*xc >> 16) + carry;
+                               carry = z >> 16;
+                               Storeinc(xc, z, z2);
+                               z2 = (*x++ >> 16) * y + (*xc & 0xffff) + carry;
+                               carry = z2 >> 16;
+                               }
+                               while(x < xae);
+                       *xc = z2;
+                       }
+               }
+#else
+       for(; xb < xbe; xc0++) {
+               if ( (y = *xb++) !=0) {
+                       x = xa;
+                       xc = xc0;
+                       carry = 0;
+                       do {
+                               z = *x++ * y + *xc + carry;
+                               carry = z >> 16;
+                               *xc++ = z & 0xffff;
+                               }
+                               while(x < xae);
+                       *xc = carry;
+                       }
+               }
+#endif
+#endif
+       for(xc0 = c->x, xc = xc0 + wc; wc > 0 && !*--xc; --wc) ;
+       c->wds = wc;
+       return c;
+       }
+
+ static Bigint *p5s;
+
+ Bigint *
+pow5mult
+#ifdef KR_headers
+       (b, k) Bigint *b; int k;
+#else
+       (Bigint *b, int k)
+#endif
+{
+       Bigint *b1, *p5, *p51;
+       int i;
+       static int p05[3] = { 5, 25, 125 };
+
+       if ( (i = k & 3) !=0)
+               b = multadd(b, p05[i-1], 0);
+
+       if (!(k >>= 2))
+               return b;
+       if ((p5 = p5s) == 0) {
+               /* first time */
+#ifdef MULTIPLE_THREADS
+               ACQUIRE_DTOA_LOCK(1);
+               if (!(p5 = p5s)) {
+                       p5 = p5s = i2b(625);
+                       p5->next = 0;
+                       }
+               FREE_DTOA_LOCK(1);
+#else
+               p5 = p5s = i2b(625);
+               p5->next = 0;
+#endif
+               }
+       for(;;) {
+               if (k & 1) {
+                       b1 = mult(b, p5);
+                       Bfree(b);
+                       b = b1;
+                       }
+               if (!(k >>= 1))
+                       break;
+               if ((p51 = p5->next) == 0) {
+#ifdef MULTIPLE_THREADS
+                       ACQUIRE_DTOA_LOCK(1);
+                       if (!(p51 = p5->next)) {
+                               p51 = p5->next = mult(p5,p5);
+                               p51->next = 0;
+                               }
+                       FREE_DTOA_LOCK(1);
+#else
+                       p51 = p5->next = mult(p5,p5);
+                       p51->next = 0;
+#endif
+                       }
+               p5 = p51;
+               }
+       return b;
+       }
+
+ Bigint *
+lshift
+#ifdef KR_headers
+       (b, k) Bigint *b; int k;
+#else
+       (Bigint *b, int k)
+#endif
+{
+       int i, k1, n, n1;
+       Bigint *b1;
+       ULong *x, *x1, *xe, z;
+
+       n = k >> kshift;
+       k1 = b->k;
+       n1 = n + b->wds + 1;
+       for(i = b->maxwds; n1 > i; i <<= 1)
+               k1++;
+       b1 = Balloc(k1);
+       x1 = b1->x;
+       for(i = 0; i < n; i++)
+               *x1++ = 0;
+       x = b->x;
+       xe = x + b->wds;
+       if (k &= kmask) {
+#ifdef Pack_32
+               k1 = 32 - k;
+               z = 0;
+               do {
+                       *x1++ = *x << k | z;
+                       z = *x++ >> k1;
+                       }
+                       while(x < xe);
+               if ((*x1 = z) !=0)
+                       ++n1;
+#else
+               k1 = 16 - k;
+               z = 0;
+               do {
+                       *x1++ = *x << k  & 0xffff | z;
+                       z = *x++ >> k1;
+                       }
+                       while(x < xe);
+               if (*x1 = z)
+                       ++n1;
+#endif
+               }
+       else do
+               *x1++ = *x++;
+               while(x < xe);
+       b1->wds = n1 - 1;
+       Bfree(b);
+       return b1;
+       }
+
+ int
+cmp
+#ifdef KR_headers
+       (a, b) Bigint *a, *b;
+#else
+       (Bigint *a, Bigint *b)
+#endif
+{
+       ULong *xa, *xa0, *xb, *xb0;
+       int i, j;
+
+       i = a->wds;
+       j = b->wds;
+#ifdef DEBUG
+       if (i > 1 && !a->x[i-1])
+               Bug("cmp called with a->x[a->wds-1] == 0");
+       if (j > 1 && !b->x[j-1])
+               Bug("cmp called with b->x[b->wds-1] == 0");
+#endif
+       if (i -= j)
+               return i;
+       xa0 = a->x;
+       xa = xa0 + j;
+       xb0 = b->x;
+       xb = xb0 + j;
+       for(;;) {
+               if (*--xa != *--xb)
+                       return *xa < *xb ? -1 : 1;
+               if (xa <= xa0)
+                       break;
+               }
+       return 0;
+       }
+
+ Bigint *
+diff
+#ifdef KR_headers
+       (a, b) Bigint *a, *b;
+#else
+       (Bigint *a, Bigint *b)
+#endif
+{
+       Bigint *c;
+       int i, wa, wb;
+       ULong *xa, *xae, *xb, *xbe, *xc;
+#ifdef ULLong
+       ULLong borrow, y;
+#else
+       ULong borrow, y;
+#ifdef Pack_32
+       ULong z;
+#endif
+#endif
+
+       i = cmp(a,b);
+       if (!i) {
+               c = Balloc(0);
+               c->wds = 1;
+               c->x[0] = 0;
+               return c;
+               }
+       if (i < 0) {
+               c = a;
+               a = b;
+               b = c;
+               i = 1;
+               }
+       else
+               i = 0;
+       c = Balloc(a->k);
+       c->sign = i;
+       wa = a->wds;
+       xa = a->x;
+       xae = xa + wa;
+       wb = b->wds;
+       xb = b->x;
+       xbe = xb + wb;
+       xc = c->x;
+       borrow = 0;
+#ifdef ULLong
+       do {
+               y = (ULLong)*xa++ - *xb++ - borrow;
+               borrow = y >> 32 & 1UL;
+               *xc++ = y & 0xffffffffUL;
+               }
+               while(xb < xbe);
+       while(xa < xae) {
+               y = *xa++ - borrow;
+               borrow = y >> 32 & 1UL;
+               *xc++ = y & 0xffffffffUL;
+               }
+#else
+#ifdef Pack_32
+       do {
+               y = (*xa & 0xffff) - (*xb & 0xffff) - borrow;
+               borrow = (y & 0x10000) >> 16;
+               z = (*xa++ >> 16) - (*xb++ >> 16) - borrow;
+               borrow = (z & 0x10000) >> 16;
+               Storeinc(xc, z, y);
+               }
+               while(xb < xbe);
+       while(xa < xae) {
+               y = (*xa & 0xffff) - borrow;
+               borrow = (y & 0x10000) >> 16;
+               z = (*xa++ >> 16) - borrow;
+               borrow = (z & 0x10000) >> 16;
+               Storeinc(xc, z, y);
+               }
+#else
+       do {
+               y = *xa++ - *xb++ - borrow;
+               borrow = (y & 0x10000) >> 16;
+               *xc++ = y & 0xffff;
+               }
+               while(xb < xbe);
+       while(xa < xae) {
+               y = *xa++ - borrow;
+               borrow = (y & 0x10000) >> 16;
+               *xc++ = y & 0xffff;
+               }
+#endif
+#endif
+       while(!*--xc)
+               wa--;
+       c->wds = wa;
+       return c;
+       }
+
+ double
+b2d
+#ifdef KR_headers
+       (a, e) Bigint *a; int *e;
+#else
+       (Bigint *a, int *e)
+#endif
+{
+       ULong *xa, *xa0, w, y, z;
+       int k;
+       double d;
+#ifdef VAX
+       ULong d0, d1;
+#else
+#define d0 word0(d)
+#define d1 word1(d)
+#endif
+
+       xa0 = a->x;
+       xa = xa0 + a->wds;
+       y = *--xa;
+#ifdef DEBUG
+       if (!y) Bug("zero y in b2d");
+#endif
+       k = hi0bits(y);
+       *e = 32 - k;
+#ifdef Pack_32
+       if (k < Ebits) {
+               d0 = Exp_1 | y >> Ebits - k;
+               w = xa > xa0 ? *--xa : 0;
+               d1 = y << (32-Ebits) + k | w >> Ebits - k;
+               goto ret_d;
+               }
+       z = xa > xa0 ? *--xa : 0;
+       if (k -= Ebits) {
+               d0 = Exp_1 | y << k | z >> 32 - k;
+               y = xa > xa0 ? *--xa : 0;
+               d1 = z << k | y >> 32 - k;
+               }
+       else {
+               d0 = Exp_1 | y;
+               d1 = z;
+               }
+#else
+       if (k < Ebits + 16) {
+               z = xa > xa0 ? *--xa : 0;
+               d0 = Exp_1 | y << k - Ebits | z >> Ebits + 16 - k;
+               w = xa > xa0 ? *--xa : 0;
+               y = xa > xa0 ? *--xa : 0;
+               d1 = z << k + 16 - Ebits | w << k - Ebits | y >> 16 + Ebits - k;
+               goto ret_d;
+               }
+       z = xa > xa0 ? *--xa : 0;
+       w = xa > xa0 ? *--xa : 0;
+       k -= Ebits + 16;
+       d0 = Exp_1 | y << k + 16 | z << k | w >> 16 - k;
+       y = xa > xa0 ? *--xa : 0;
+       d1 = w << k + 16 | y << k;
+#endif
+ ret_d:
+#ifdef VAX
+       word0(d) = d0 >> 16 | d0 << 16;
+       word1(d) = d1 >> 16 | d1 << 16;
+#endif
+       return dval(d);
+       }
+#undef d0
+#undef d1
+
+ Bigint *
+d2b
+#ifdef KR_headers
+       (d, e, bits) double d; int *e, *bits;
+#else
+       (double d, int *e, int *bits)
+#endif
+{
+       Bigint *b;
+#ifndef Sudden_Underflow
+       int i;
+#endif
+       int de, k;
+       ULong *x, y, z;
+#ifdef VAX
+       ULong d0, d1;
+       d0 = word0(d) >> 16 | word0(d) << 16;
+       d1 = word1(d) >> 16 | word1(d) << 16;
+#else
+#define d0 word0(d)
+#define d1 word1(d)
+#endif
+
+#ifdef Pack_32
+       b = Balloc(1);
+#else
+       b = Balloc(2);
+#endif
+       x = b->x;
+
+       z = d0 & Frac_mask;
+       d0 &= 0x7fffffff;       /* clear sign bit, which we ignore */
+#ifdef Sudden_Underflow
+       de = (int)(d0 >> Exp_shift);
+#ifndef IBM
+       z |= Exp_msk11;
+#endif
+#else
+       if ( (de = (int)(d0 >> Exp_shift)) !=0)
+               z |= Exp_msk1;
+#endif
+#ifdef Pack_32
+       if ( (y = d1) !=0) {
+               if ( (k = lo0bits(&y)) !=0) {
+                       x[0] = y | z << 32 - k;
+                       z >>= k;
+                       }
+               else
+                       x[0] = y;
+#ifndef Sudden_Underflow
+               i =
+#endif
+                    b->wds = (x[1] = z) !=0 ? 2 : 1;
+               }
+       else {
+#ifdef DEBUG
+               if (!z)
+                       Bug("Zero passed to d2b");
+#endif
+               k = lo0bits(&z);
+               x[0] = z;
+#ifndef Sudden_Underflow
+               i =
+#endif
+                   b->wds = 1;
+               k += 32;
+               }
+#else
+       if ( (y = d1) !=0) {
+               if ( (k = lo0bits(&y)) !=0)
+                       if (k >= 16) {
+                               x[0] = y | z << 32 - k & 0xffff;
+                               x[1] = z >> k - 16 & 0xffff;
+                               x[2] = z >> k;
+                               i = 2;
+                               }
+                       else {
+                               x[0] = y & 0xffff;
+                               x[1] = y >> 16 | z << 16 - k & 0xffff;
+                               x[2] = z >> k & 0xffff;
+                               x[3] = z >> k+16;
+                               i = 3;
+                               }
+               else {
+                       x[0] = y & 0xffff;
+                       x[1] = y >> 16;
+                       x[2] = z & 0xffff;
+                       x[3] = z >> 16;
+                       i = 3;
+                       }
+               }
+       else {
+#ifdef DEBUG
+               if (!z)
+                       Bug("Zero passed to d2b");
+#endif
+               k = lo0bits(&z);
+               if (k >= 16) {
+                       x[0] = z;
+                       i = 0;
+                       }
+               else {
+                       x[0] = z & 0xffff;
+                       x[1] = z >> 16;
+                       i = 1;
+                       }
+               k += 32;
+               }
+       while(!x[i])
+               --i;
+       b->wds = i + 1;
+#endif
+#ifndef Sudden_Underflow
+       if (de) {
+#endif
+#ifdef IBM
+               *e = (de - Bias - (P-1) << 2) + k;
+               *bits = 4*P + 8 - k - hi0bits(word0(d) & Frac_mask);
+#else
+               *e = de - Bias - (P-1) + k;
+               *bits = P - k;
+#endif
+#ifndef Sudden_Underflow
+               }
+       else {
+               *e = de - Bias - (P-1) + 1 + k;
+#ifdef Pack_32
+               *bits = 32*i - hi0bits(x[i-1]);
+#else
+               *bits = (i+2)*16 - hi0bits(x[i]);
+#endif
+               }
+#endif
+       return b;
+       }
+#undef d0
+#undef d1
+
+ CONST double
+#ifdef IEEE_Arith
+bigtens[] = { 1e16, 1e32, 1e64, 1e128, 1e256 };
+CONST double tinytens[] = { 1e-16, 1e-32, 1e-64, 1e-128, 1e-256
+               };
+#else
+#ifdef IBM
+bigtens[] = { 1e16, 1e32, 1e64 };
+CONST double tinytens[] = { 1e-16, 1e-32, 1e-64 };
+#else
+bigtens[] = { 1e16, 1e32 };
+CONST double tinytens[] = { 1e-16, 1e-32 };
+#endif
+#endif
+
+ CONST double
+tens[] = {
+               1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9,
+               1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19,
+               1e20, 1e21, 1e22
+#ifdef VAX
+               , 1e23, 1e24
+#endif
+               };
+
+ char *
+#ifdef KR_headers
+strcp_D2A(a, b) char *a; char *b;
+#else
+strcp_D2A(char *a, CONST char *b)
+#endif
+{
+       while(*a = *b++)
+               a++;
+       return a;
+       }
+
+#ifdef NO_STRING_H
+
+ Char *
+#ifdef KR_headers
+memcpy_D2A(a, b, len) Char *a; Char *b; size_t len;
+#else
+memcpy_D2A(void *a1, void *b1, size_t len)
+#endif
+{
+       register char *a = (char*)a1, *ae = a + len;
+       register char *b = (char*)b1, *a0 = a;
+       while(a < ae)
+               *a++ = *b++;
+       return a0;
+       }
+
+#endif /* NO_STRING_H */
diff --git a/contrib/gdtoa/qnan.c b/contrib/gdtoa/qnan.c
new file mode 100644 (file)
index 0000000..118e749
--- /dev/null
@@ -0,0 +1,110 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 2005 by David M. Gay
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that the copyright notice and this permission notice and warranty
+disclaimer appear in supporting documentation, and that the name of
+the author or any of his current or former employers not be used in
+advertising or publicity pertaining to distribution of the software
+without specific, written prior permission.
+
+THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.  IN
+NO EVENT SHALL THE AUTHOR OR ANY OF HIS CURRENT OR FORMER EMPLOYERS BE
+LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
+DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+/* Program to compute quiet NaNs of various precisions (float, */
+/* double, and perhaps long double) on the current system,     */
+/* provided the system uses binary IEEE (P754) arithmetic.     */
+/* Note that one system's quiet NaN may be a signaling NaN on  */
+/* another system.  The IEEE arithmetic standards (P754, P854) */
+/* do not specify how to distinguish signaling NaNs from quiet */
+/* ones, and this detail varies across systems.         The computed   */
+/* NaN values are encoded in #defines for values for an                */
+/* unsigned 32-bit integer type, called Ulong below, and       */
+/* (for long double) perhaps as unsigned short values.  Once   */
+/* upon a time, there were PC compilers for Intel CPUs that    */
+/* had sizeof(long double) = 10.  Are such compilers still     */
+/* distributed?                                                        */
+
+#include <stdio.h>
+#include "arith.h"
+
+#ifndef Long
+#define Long long
+#endif
+
+typedef unsigned Long Ulong;
+
+#undef HAVE_IEEE
+#ifdef IEEE_8087
+#define _0 1
+#define _1 0
+#define HAVE_IEEE
+#endif
+#ifdef IEEE_MC68k
+#define _0 0
+#define _1 1
+#define HAVE_IEEE
+#endif
+
+#define UL (unsigned long)
+
+ int
+main(void)
+{
+#ifdef HAVE_IEEE
+       typedef union {
+               float f;
+               double d;
+               Ulong L[4];
+#ifndef NO_LONG_LONG
+               unsigned short u[5];
+               long double D;
+#endif
+               } U;
+       U a, b, c;
+       int i;
+
+       a.L[0] = b.L[0] = 0x7f800000;
+       c.f = a.f - b.f;
+       printf("#define f_QNAN 0x%lx\n", UL c.L[0]);
+       a.L[_0] = b.L[_0] = 0x7ff00000;
+       a.L[_1] = b.L[_1] = 0;
+       c.d = a.d - b.d;        /* quiet NaN */
+       printf("#define d_QNAN0 0x%lx\n", UL c.L[0]);
+       printf("#define d_QNAN1 0x%lx\n", UL c.L[1]);
+#ifdef NO_LONG_LONG
+       for(i = 0; i < 4; i++)
+               printf("#define ld_QNAN%d 0xffffffff\n", i);
+       for(i = 0; i < 5; i++)
+               printf("#define ldus_QNAN%d 0xffff\n", i);
+#else
+       b.D = c.D = a.d;
+       if (printf("") < 0)
+               c.D = 37;       /* never executed; just defeat optimization */
+       a.L[2] = a.L[3] = 0;
+       a.D = b.D - c.D;
+       for(i = 0; i < 4; i++)
+               printf("#define ld_QNAN%d 0x%lx\n", i, UL a.L[i]);
+       for(i = 0; i < 5; i++)
+               printf("#define ldus_QNAN%d 0x%x\n", i, a.u[i]);
+#endif
+#endif /* HAVE_IEEE */
+       return 0;
+       }
diff --git a/contrib/gdtoa/smisc.c b/contrib/gdtoa/smisc.c
new file mode 100644 (file)
index 0000000..50431fc
--- /dev/null
@@ -0,0 +1,191 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998, 1999 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+ Bigint *
+s2b
+#ifdef KR_headers
+       (s, nd0, nd, y9, dplen) CONST char *s; int dplen, nd0, nd; ULong y9;
+#else
+       (CONST char *s, int nd0, int nd, ULong y9, int dplen)
+#endif
+{
+       Bigint *b;
+       int i, k;
+       Long x, y;
+
+       x = (nd + 8) / 9;
+       for(k = 0, y = 1; x > y; y <<= 1, k++) ;
+#ifdef Pack_32
+       b = Balloc(k);
+       b->x[0] = y9;
+       b->wds = 1;
+#else
+       b = Balloc(k+1);
+       b->x[0] = y9 & 0xffff;
+       b->wds = (b->x[1] = y9 >> 16) ? 2 : 1;
+#endif
+
+       i = 9;
+       if (9 < nd0) {
+               s += 9;
+               do b = multadd(b, 10, *s++ - '0');
+                       while(++i < nd0);
+               s += dplen;
+               }
+       else
+               s += dplen + 9;
+       for(; i < nd; i++)
+               b = multadd(b, 10, *s++ - '0');
+       return b;
+       }
+
+ double
+ratio
+#ifdef KR_headers
+       (a, b) Bigint *a, *b;
+#else
+       (Bigint *a, Bigint *b)
+#endif
+{
+       double da, db;
+       int k, ka, kb;
+
+       dval(da) = b2d(a, &ka);
+       dval(db) = b2d(b, &kb);
+       k = ka - kb + ULbits*(a->wds - b->wds);
+#ifdef IBM
+       if (k > 0) {
+               word0(da) += (k >> 2)*Exp_msk1;
+               if (k &= 3)
+                       dval(da) *= 1 << k;
+               }
+       else {
+               k = -k;
+               word0(db) += (k >> 2)*Exp_msk1;
+               if (k &= 3)
+                       dval(db) *= 1 << k;
+               }
+#else
+       if (k > 0)
+               word0(da) += k*Exp_msk1;
+       else {
+               k = -k;
+               word0(db) += k*Exp_msk1;
+               }
+#endif
+       return dval(da) / dval(db);
+       }
+
+#ifdef INFNAN_CHECK
+
+ int
+match
+#ifdef KR_headers
+       (sp, t) char **sp, *t;
+#else
+       (CONST char **sp, char *t)
+#endif
+{
+       int c, d;
+       CONST char *s = *sp;
+
+       while( (d = *t++) !=0) {
+               if ((c = *++s) >= 'A' && c <= 'Z')
+                       c += 'a' - 'A';
+               if (c != d)
+                       return 0;
+               }
+       *sp = s + 1;
+       return 1;
+       }
+#endif /* INFNAN_CHECK */
+
+ void
+#ifdef KR_headers
+copybits(c, n, b) ULong *c; int n; Bigint *b;
+#else
+copybits(ULong *c, int n, Bigint *b)
+#endif
+{
+       ULong *ce, *x, *xe;
+#ifdef Pack_16
+       int nw, nw1;
+#endif
+
+       ce = c + ((n-1) >> kshift) + 1;
+       x = b->x;
+#ifdef Pack_32
+       xe = x + b->wds;
+       while(x < xe)
+               *c++ = *x++;
+#else
+       nw = b->wds;
+       nw1 = nw & 1;
+       for(xe = x + (nw - nw1); x < xe; x += 2)
+               Storeinc(c, x[1], x[0]);
+       if (nw1)
+               *c++ = *x;
+#endif
+       while(c < ce)
+               *c++ = 0;
+       }
+
+ ULong
+#ifdef KR_headers
+any_on(b, k) Bigint *b; int k;
+#else
+any_on(Bigint *b, int k)
+#endif
+{
+       int n, nwds;
+       ULong *x, *x0, x1, x2;
+
+       x = b->x;
+       nwds = b->wds;
+       n = k >> kshift;
+       if (n > nwds)
+               n = nwds;
+       else if (n < nwds && (k &= kmask)) {
+               x1 = x2 = x[n];
+               x1 >>= k;
+               x1 <<= k;
+               if (x1 != x2)
+                       return 1;
+               }
+       x0 = x;
+       x += n;
+       while(x > x0)
+               if (*--x)
+                       return 1;
+       return 0;
+       }
diff --git a/contrib/gdtoa/strtoIQ.c b/contrib/gdtoa/strtoIQ.c
new file mode 100644 (file)
index 0000000..9ce5120
--- /dev/null
@@ -0,0 +1,63 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+ int
+#ifdef KR_headers
+strtoIQ(s, sp, a, b) CONST char *s; char **sp; void *a; void *b;
+#else
+strtoIQ(CONST char *s, char **sp, void *a, void *b)
+#endif
+{
+       static FPI fpi = { 113, 1-16383-113+1, 32766-16383-113+1, 1, SI };
+       Long exp[2];
+       Bigint *B[2];
+       int k, rv[2];
+       ULong *L = (ULong *)a, *M = (ULong *)b;
+
+       B[0] = Balloc(2);
+       B[0]->wds = 4;
+       k = strtoIg(s, sp, &fpi, exp, B, rv);
+       ULtoQ(L, B[0]->x, exp[0], rv[0]);
+       Bfree(B[0]);
+       if (B[1]) {
+               ULtoQ(M, B[1]->x, exp[1], rv[1]);
+               Bfree(B[1]);
+               }
+       else {
+               M[0] = L[0];
+               M[1] = L[1];
+               M[2] = L[2];
+               M[3] = L[3];
+               }
+       return k;
+       }
diff --git a/contrib/gdtoa/strtoId.c b/contrib/gdtoa/strtoId.c
new file mode 100644 (file)
index 0000000..1c97d38
--- /dev/null
@@ -0,0 +1,60 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+ int
+#ifdef KR_headers
+strtoId(s, sp, f0, f1) CONST char *s; char **sp; double *f0, *f1;
+#else
+strtoId(CONST char *s, char **sp, double *f0, double *f1)
+#endif
+{
+       static FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, SI };
+       Long exp[2];
+       Bigint *B[2];
+       int k, rv[2];
+
+       B[0] = Balloc(1);
+       B[0]->wds = 2;
+       k = strtoIg(s, sp, &fpi, exp, B, rv);
+       ULtod((ULong*)f0, B[0]->x, exp[0], rv[0]);
+       Bfree(B[0]);
+       if (B[1]) {
+               ULtod((ULong*)f1, B[1]->x, exp[1], rv[1]);
+               Bfree(B[1]);
+               }
+       else {
+               ((ULong*)f1)[0] = ((ULong*)f0)[0];
+               ((ULong*)f1)[1] = ((ULong*)f0)[1];
+               }
+       return k;
+       }
diff --git a/contrib/gdtoa/strtoIdd.c b/contrib/gdtoa/strtoIdd.c
new file mode 100644 (file)
index 0000000..40b7936
--- /dev/null
@@ -0,0 +1,66 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+ int
+#ifdef KR_headers
+strtoIdd(s, sp, f0, f1) CONST char *s; char **sp; double *f0, *f1;
+#else
+strtoIdd(CONST char *s, char **sp, double *f0, double *f1)
+#endif
+{
+#ifdef Sudden_Underflow
+       static FPI fpi = { 106, 1-1023, 2046-1023-106+1, 1, 1 };
+#else
+       static FPI fpi = { 106, 1-1023-53+1, 2046-1023-106+1, 1, 0 };
+#endif
+       Long exp[2];
+       Bigint *B[2];
+       int k, rv[2];
+
+       B[0] = Balloc(2);
+       B[0]->wds = 4;
+       k = strtoIg(s, sp, &fpi, exp, B, rv);
+       ULtodd((ULong*)f0, B[0]->x, exp[0], rv[0]);
+       Bfree(B[0]);
+       if (B[1]) {
+               ULtodd((ULong*)f1, B[1]->x, exp[1], rv[1]);
+               Bfree(B[1]);
+               }
+       else {
+               ((ULong*)f1)[0] = ((ULong*)f0)[0];
+               ((ULong*)f1)[1] = ((ULong*)f0)[1];
+               ((ULong*)f1)[2] = ((ULong*)f0)[2];
+               ((ULong*)f1)[3] = ((ULong*)f0)[3];
+               }
+       return k;
+       }
diff --git a/contrib/gdtoa/strtoIf.c b/contrib/gdtoa/strtoIf.c
new file mode 100644 (file)
index 0000000..65ecab2
--- /dev/null
@@ -0,0 +1,58 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+ int
+#ifdef KR_headers
+strtoIf(s, sp, f0, f1) CONST char *s; char **sp; float *f0, *f1;
+#else
+strtoIf(CONST char *s, char **sp, float *f0, float *f1)
+#endif
+{
+       static FPI fpi = { 24, 1-127-24+1,  254-127-24+1, 1, SI };
+       Long exp[2];
+       Bigint *B[2];
+       int k, rv[2];
+
+       B[0] = Balloc(0);
+       B[0]->wds = 1;
+       k = strtoIg(s, sp, &fpi, exp, B, rv);
+       ULtof((ULong*)f0, B[0]->x, exp[0], rv[0]);
+       Bfree(B[0]);
+       if (B[1]) {
+               ULtof((ULong*)f1, B[1]->x, exp[1], rv[1]);
+               Bfree(B[1]);
+               }
+       else
+               *(ULong*)f1 = *(ULong*)f0;
+       return k;
+       }
diff --git a/contrib/gdtoa/strtoIg.c b/contrib/gdtoa/strtoIg.c
new file mode 100644 (file)
index 0000000..90c88db
--- /dev/null
@@ -0,0 +1,137 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+ int
+#ifdef KR_headers
+strtoIg(s00, se, fpi, exp, B, rvp) CONST char *s00; char **se; FPI *fpi; Long *exp; Bigint **B; int *rvp;
+#else
+strtoIg(CONST char *s00, char **se, FPI *fpi, Long *exp, Bigint **B, int *rvp)
+#endif
+{
+       Bigint *b, *b1;
+       int i, nb, nw, nw1, rv, rv1, swap;
+       unsigned int nb1, nb11;
+       Long e1;
+
+       b = *B;
+       rv = strtodg(s00, se, fpi, exp, b->x);
+       if (!(rv & STRTOG_Inexact)) {
+               B[1] = 0;
+               return *rvp = rv;
+               }
+       e1 = exp[0];
+       rv1 = rv ^ STRTOG_Inexact;
+       b1 = Balloc(b->k);
+       Bcopy(b1, b);
+       nb = fpi->nbits;
+       nb1 = nb & 31;
+       nb11 = (nb1 - 1) & 31;
+       nw = b->wds;
+       nw1 = nw - 1;
+       if (rv & STRTOG_Inexlo) {
+               swap = 0;
+               b1 = increment(b1);
+               if ((rv & STRTOG_Retmask) == STRTOG_Zero) {
+                       if (fpi->sudden_underflow) {
+                               b1->x[0] = 0;
+                               b1->x[nw1] = 1L << nb11;
+                               rv1 += STRTOG_Normal - STRTOG_Zero;
+                               rv1 &= ~STRTOG_Underflow;
+                               goto swapcheck;
+                               }
+                       rv1 &= STRTOG_Inexlo | STRTOG_Underflow | STRTOG_Zero;
+                       rv1 |= STRTOG_Inexhi | STRTOG_Denormal;
+                       goto swapcheck;
+                       }
+               if (b1->wds > nw
+                || nb1 && b1->x[nw1] & 1L << nb1) {
+                       if (++e1 > fpi->emax)
+                               rv1 = STRTOG_Infinite | STRTOG_Inexhi;
+                       rshift(b1, 1);
+                       }
+               else if ((rv & STRTOG_Retmask) == STRTOG_Denormal) {
+                       if (b1->x[nw1] & 1L << nb11) {
+                               rv1 += STRTOG_Normal - STRTOG_Denormal;
+                               rv1 &= ~STRTOG_Underflow;
+                               }
+                       }
+               }
+       else {
+               swap = STRTOG_Neg;
+               if ((rv & STRTOG_Retmask) == STRTOG_Infinite) {
+                       b1 = set_ones(b1, nb);
+                       e1 = fpi->emax;
+                       rv1 = STRTOG_Normal | STRTOG_Inexlo;
+                       goto swapcheck;
+                       }
+               decrement(b1);
+               if ((rv & STRTOG_Retmask) == STRTOG_Denormal) {
+                       for(i = nw1; !b1->x[i]; --i)
+                               if (!i) {
+                                       rv1 = STRTOG_Zero | STRTOG_Inexlo;
+                                       break;
+                                       }
+                       goto swapcheck;
+                       }
+               if (!(b1->x[nw1] & 1L << nb11)) {
+                       if (e1 == fpi->emin) {
+                               if (fpi->sudden_underflow)
+                                       rv1 += STRTOG_Zero - STRTOG_Normal;
+                               else
+                                       rv1 += STRTOG_Denormal - STRTOG_Normal;
+                               rv1 |= STRTOG_Underflow;
+                               }
+                       else {
+                               b1 = lshift(b1, 1);
+                               b1->x[0] |= 1;
+                               --e1;
+                               }
+                       }
+               }
+ swapcheck:
+       if (swap ^ (rv & STRTOG_Neg)) {
+               rvp[0] = rv1;
+               rvp[1] = rv;
+               B[0] = b1;
+               B[1] = b;
+               exp[1] = exp[0];
+               exp[0] = e1;
+               }
+       else {
+               rvp[0] = rv;
+               rvp[1] = rv1;
+               B[1] = b1;
+               exp[1] = e1;
+               }
+       return rv;
+       }
diff --git a/contrib/gdtoa/strtoIx.c b/contrib/gdtoa/strtoIx.c
new file mode 100644 (file)
index 0000000..783a631
--- /dev/null
@@ -0,0 +1,64 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+ int
+#ifdef KR_headers
+strtoIx(s, sp, a, b) CONST char *s; char **sp; void *a; void *b;
+#else
+strtoIx(CONST char *s, char **sp, void *a, void *b)
+#endif
+{
+       static FPI fpi = { 64, 1-16383-64+1, 32766 - 16383 - 64 + 1, 1, SI };
+       Long exp[2];
+       Bigint *B[2];
+       int k, rv[2];
+       UShort *L = (UShort *)a, *M = (UShort *)b;
+
+       B[0] = Balloc(1);
+       B[0]->wds = 2;
+       k = strtoIg(s, sp, &fpi, exp, B, rv);
+       ULtox(L, B[0]->x, exp[0], rv[0]);
+       Bfree(B[0]);
+       if (B[1]) {
+               ULtox(M, B[1]->x, exp[1], rv[1]);
+               Bfree(B[1]);
+               }
+       else {
+               M[0] = L[0];
+               M[1] = L[1];
+               M[2] = L[2];
+               M[3] = L[3];
+               M[4] = L[4];
+               }
+       return k;
+       }
diff --git a/contrib/gdtoa/strtoIxL.c b/contrib/gdtoa/strtoIxL.c
new file mode 100644 (file)
index 0000000..869bfd1
--- /dev/null
@@ -0,0 +1,62 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+ int
+#ifdef KR_headers
+strtoIxL(s, sp, a, b) CONST char *s; char **sp; void *a; void *b;
+#else
+strtoIxL(CONST char *s, char **sp, void *a, void *b)
+#endif
+{
+       static FPI fpi = { 64, 1-16383-64+1, 32766 - 16383 - 64 + 1, 1, SI };
+       Long exp[2];
+       Bigint *B[2];
+       int k, rv[2];
+       ULong *L = (ULong *)a, *M = (ULong *)b;
+
+       B[0] = Balloc(1);
+       B[0]->wds = 2;
+       k = strtoIg(s, sp, &fpi, exp, B, rv);
+       ULtoxL(L, B[0]->x, exp[0], rv[0]);
+       Bfree(B[0]);
+       if (B[1]) {
+               ULtoxL(M, B[1]->x, exp[1], rv[1]);
+               Bfree(B[1]);
+               }
+       else {
+               M[0] = L[0];
+               M[1] = L[1];
+               M[2] = L[2];
+               }
+       return k;
+       }
diff --git a/contrib/gdtoa/strtod.c b/contrib/gdtoa/strtod.c
new file mode 100644 (file)
index 0000000..b8287eb
--- /dev/null
@@ -0,0 +1,1028 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998-2001 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+#ifndef NO_FENV_H
+#include <fenv.h>
+#endif
+
+#ifdef USE_LOCALE
+#include "locale.h"
+#endif
+
+#ifdef IEEE_Arith
+#ifndef NO_IEEE_Scale
+#define Avoid_Underflow
+#undef tinytens
+/* The factor of 2^106 in tinytens[4] helps us avoid setting the underflow */
+/* flag unnecessarily.  It leads to a song and dance at the end of strtod. */
+static CONST double tinytens[] = { 1e-16, 1e-32, 1e-64, 1e-128,
+               9007199254740992.*9007199254740992.e-256
+               };
+#endif
+#endif
+
+#ifdef Honor_FLT_ROUNDS
+#undef Check_FLT_ROUNDS
+#define Check_FLT_ROUNDS
+#else
+#define Rounding Flt_Rounds
+#endif
+
+ double
+strtod
+#ifdef KR_headers
+       (s00, se) CONST char *s00; char **se;
+#else
+       (CONST char *s00, char **se)
+#endif
+{
+#ifdef Avoid_Underflow
+       int scale;
+#endif
+       int bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, decpt, dsign,
+                e, e1, esign, i, j, k, nd, nd0, nf, nz, nz0, sign;
+       CONST char *s, *s0, *s1;
+       double aadj, aadj1, adj, rv, rv0;
+       Long L;
+       ULong y, z;
+       Bigint *bb, *bb1, *bd, *bd0, *bs, *delta;
+#ifdef SET_INEXACT
+       int inexact, oldinexact;
+#endif
+#ifdef USE_LOCALE /*{{*/
+#ifdef NO_LOCALE_CACHE
+       char *decimalpoint = localeconv()->decimal_point;
+       int dplen = strlen(decimalpoint);
+#else
+       char *decimalpoint;
+       static char *decimalpoint_cache;
+       static int dplen;
+       if (!(s0 = decimalpoint_cache)) {
+               s0 = localeconv()->decimal_point;
+               if ((decimalpoint_cache = (char*)malloc(strlen(s0) + 1))) {
+                       strcpy(decimalpoint_cache, s0);
+                       s0 = decimalpoint_cache;
+                       }
+               dplen = strlen(s0);
+               }
+       decimalpoint = (char*)s0;
+#endif /*NO_LOCALE_CACHE*/
+#else  /*USE_LOCALE}{*/
+#define dplen 1
+#endif /*USE_LOCALE}}*/
+
+#ifdef Honor_FLT_ROUNDS /*{*/
+       int Rounding;
+#ifdef Trust_FLT_ROUNDS /*{{ only define this if FLT_ROUNDS really works! */
+       Rounding = Flt_Rounds;
+#else /*}{*/
+       Rounding = 1;
+       switch(fegetround()) {
+         case FE_TOWARDZERO:   Rounding = 0; break;
+         case FE_UPWARD:       Rounding = 2; break;
+         case FE_DOWNWARD:     Rounding = 3;
+         }
+#endif /*}}*/
+#endif /*}*/
+
+       sign = nz0 = nz = decpt = 0;
+       dval(rv) = 0.;
+       for(s = s00;;s++) switch(*s) {
+               case '-':
+                       sign = 1;
+                       /* no break */
+               case '+':
+                       if (*++s)
+                               goto break2;
+                       /* no break */
+               case 0:
+                       goto ret0;
+               case '\t':
+               case '\n':
+               case '\v':
+               case '\f':
+               case '\r':
+               case ' ':
+                       continue;
+               default:
+                       goto break2;
+               }
+ break2:
+       if (*s == '0') {
+#ifndef NO_HEX_FP /*{*/
+               {
+               static FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, SI };
+               Long exp;
+               ULong bits[2];
+               switch(s[1]) {
+                 case 'x':
+                 case 'X':
+                       {
+#if defined(FE_DOWNWARD) && defined(FE_TONEAREST) && defined(FE_TOWARDZERO) && defined(FE_UPWARD) /*{{*/
+                       FPI fpi1 = fpi;
+#ifdef Honor_FLT_ROUNDS /*{{*/
+                       fpi1.rounding = Rounding;
+#else /*}{*/
+                       switch(fegetround()) {
+                         case FE_TOWARDZERO:   fpi1.rounding = 0; break;
+                         case FE_UPWARD:       fpi1.rounding = 2; break;
+                         case FE_DOWNWARD:     fpi1.rounding = 3;
+                         }
+#endif /*}}*/
+#else /*}{*/
+#define fpi1 fpi
+#endif /*}}*/
+                       switch((i = gethex(&s, &fpi1, &exp, &bb, sign)) & STRTOG_Retmask) {
+                         case STRTOG_NoNumber:
+                               s = s00;
+                               sign = 0;
+                         case STRTOG_Zero:
+                               break;
+                         default:
+                               if (bb) {
+                                       copybits(bits, fpi.nbits, bb);
+                                       Bfree(bb);
+                                       }
+                               ULtod(((U*)&rv)->L, bits, exp, i);
+                         }}
+                       goto ret;
+                 }
+               }
+#endif /*}*/
+               nz0 = 1;
+               while(*++s == '0') ;
+               if (!*s)
+                       goto ret;
+               }
+       s0 = s;
+       y = z = 0;
+       for(nd = nf = 0; (c = *s) >= '0' && c <= '9'; nd++, s++)
+               if (nd < 9)
+                       y = 10*y + c - '0';
+               else if (nd < 16)
+                       z = 10*z + c - '0';
+       nd0 = nd;
+#ifdef USE_LOCALE
+       if (c == *decimalpoint) {
+               for(i = 1; decimalpoint[i]; ++i)
+                       if (s[i] != decimalpoint[i])
+                               goto dig_done;
+               s += i;
+               c = *s;
+#else
+       if (c == '.') {
+               c = *++s;
+#endif
+               decpt = 1;
+               if (!nd) {
+                       for(; c == '0'; c = *++s)
+                               nz++;
+                       if (c > '0' && c <= '9') {
+                               s0 = s;
+                               nf += nz;
+                               nz = 0;
+                               goto have_dig;
+                               }
+                       goto dig_done;
+                       }
+               for(; c >= '0' && c <= '9'; c = *++s) {
+ have_dig:
+                       nz++;
+                       if (c -= '0') {
+                               nf += nz;
+                               for(i = 1; i < nz; i++)
+                                       if (nd++ < 9)
+                                               y *= 10;
+                                       else if (nd <= DBL_DIG + 1)
+                                               z *= 10;
+                               if (nd++ < 9)
+                                       y = 10*y + c;
+                               else if (nd <= DBL_DIG + 1)
+                                       z = 10*z + c;
+                               nz = 0;
+                               }
+                       }
+               }/*}*/
+ dig_done:
+       e = 0;
+       if (c == 'e' || c == 'E') {
+               if (!nd && !nz && !nz0) {
+                       goto ret0;
+                       }
+               s00 = s;
+               esign = 0;
+               switch(c = *++s) {
+                       case '-':
+                               esign = 1;
+                       case '+':
+                               c = *++s;
+                       }
+               if (c >= '0' && c <= '9') {
+                       while(c == '0')
+                               c = *++s;
+                       if (c > '0' && c <= '9') {
+                               L = c - '0';
+                               s1 = s;
+                               while((c = *++s) >= '0' && c <= '9')
+                                       L = 10*L + c - '0';
+                               if (s - s1 > 8 || L > 19999)
+                                       /* Avoid confusion from exponents
+                                        * so large that e might overflow.
+                                        */
+                                       e = 19999; /* safe for 16 bit ints */
+                               else
+                                       e = (int)L;
+                               if (esign)
+                                       e = -e;
+                               }
+                       else
+                               e = 0;
+                       }
+               else
+                       s = s00;
+               }
+       if (!nd) {
+               if (!nz && !nz0) {
+#ifdef INFNAN_CHECK
+                       /* Check for Nan and Infinity */
+                       ULong bits[2];
+                       static FPI fpinan =     /* only 52 explicit bits */
+                               { 52, 1-1023-53+1, 2046-1023-53+1, 1, SI };
+                       if (!decpt)
+                        switch(c) {
+                         case 'i':
+                         case 'I':
+                               if (match(&s,"nf")) {
+                                       --s;
+                                       if (!match(&s,"inity"))
+                                               ++s;
+                                       word0(rv) = 0x7ff00000;
+                                       word1(rv) = 0;
+                                       goto ret;
+                                       }
+                               break;
+                         case 'n':
+                         case 'N':
+                               if (match(&s, "an")) {
+#ifndef No_Hex_NaN
+                                       if (*s == '(' /*)*/
+                                        && hexnan(&s, &fpinan, bits)
+                                                       == STRTOG_NaNbits) {
+                                               word0(rv) = 0x7ff00000 | bits[1];
+                                               word1(rv) = bits[0];
+                                               }
+                                       else {
+#endif
+                                               word0(rv) = NAN_WORD0;
+                                               word1(rv) = NAN_WORD1;
+#ifndef No_Hex_NaN
+                                               }
+#endif
+                                       goto ret;
+                                       }
+                         }
+#endif /* INFNAN_CHECK */
+ ret0:
+                       s = s00;
+                       sign = 0;
+                       }
+               goto ret;
+               }
+       e1 = e -= nf;
+
+       /* Now we have nd0 digits, starting at s0, followed by a
+        * decimal point, followed by nd-nd0 digits.  The number we're
+        * after is the integer represented by those digits times
+        * 10**e */
+
+       if (!nd0)
+               nd0 = nd;
+       k = nd < DBL_DIG + 1 ? nd : DBL_DIG + 1;
+       dval(rv) = y;
+       if (k > 9) {
+#ifdef SET_INEXACT
+               if (k > DBL_DIG)
+                       oldinexact = get_inexact();
+#endif
+               dval(rv) = tens[k - 9] * dval(rv) + z;
+               }
+       bd0 = 0;
+       if (nd <= DBL_DIG
+#ifndef RND_PRODQUOT
+#ifndef Honor_FLT_ROUNDS
+               && Flt_Rounds == 1
+#endif
+#endif
+                       ) {
+               if (!e)
+                       goto ret;
+               if (e > 0) {
+                       if (e <= Ten_pmax) {
+#ifdef VAX
+                               goto vax_ovfl_check;
+#else
+#ifdef Honor_FLT_ROUNDS
+                               /* round correctly FLT_ROUNDS = 2 or 3 */
+                               if (sign) {
+                                       rv = -rv;
+                                       sign = 0;
+                                       }
+#endif
+                               /* rv = */ rounded_product(dval(rv), tens[e]);
+                               goto ret;
+#endif
+                               }
+                       i = DBL_DIG - nd;
+                       if (e <= Ten_pmax + i) {
+                               /* A fancier test would sometimes let us do
+                                * this for larger i values.
+                                */
+#ifdef Honor_FLT_ROUNDS
+                               /* round correctly FLT_ROUNDS = 2 or 3 */
+                               if (sign) {
+                                       rv = -rv;
+                                       sign = 0;
+                                       }
+#endif
+                               e -= i;
+                               dval(rv) *= tens[i];
+#ifdef VAX
+                               /* VAX exponent range is so narrow we must
+                                * worry about overflow here...
+                                */
+ vax_ovfl_check:
+                               word0(rv) -= P*Exp_msk1;
+                               /* rv = */ rounded_product(dval(rv), tens[e]);
+                               if ((word0(rv) & Exp_mask)
+                                > Exp_msk1*(DBL_MAX_EXP+Bias-1-P))
+                                       goto ovfl;
+                               word0(rv) += P*Exp_msk1;
+#else
+                               /* rv = */ rounded_product(dval(rv), tens[e]);
+#endif
+                               goto ret;
+                               }
+                       }
+#ifndef Inaccurate_Divide
+               else if (e >= -Ten_pmax) {
+#ifdef Honor_FLT_ROUNDS
+                       /* round correctly FLT_ROUNDS = 2 or 3 */
+                       if (sign) {
+                               rv = -rv;
+                               sign = 0;
+                               }
+#endif
+                       /* rv = */ rounded_quotient(dval(rv), tens[-e]);
+                       goto ret;
+                       }
+#endif
+               }
+       e1 += nd - k;
+
+#ifdef IEEE_Arith
+#ifdef SET_INEXACT
+       inexact = 1;
+       if (k <= DBL_DIG)
+               oldinexact = get_inexact();
+#endif
+#ifdef Avoid_Underflow
+       scale = 0;
+#endif
+#ifdef Honor_FLT_ROUNDS
+       if (Rounding >= 2) {
+               if (sign)
+                       Rounding = Rounding == 2 ? 0 : 2;
+               else
+                       if (Rounding != 2)
+                               Rounding = 0;
+               }
+#endif
+#endif /*IEEE_Arith*/
+
+       /* Get starting approximation = rv * 10**e1 */
+
+       if (e1 > 0) {
+               if ( (i = e1 & 15) !=0)
+                       dval(rv) *= tens[i];
+               if (e1 &= ~15) {
+                       if (e1 > DBL_MAX_10_EXP) {
+ ovfl:
+#ifndef NO_ERRNO
+                               errno = ERANGE;
+#endif
+                               /* Can't trust HUGE_VAL */
+#ifdef IEEE_Arith
+#ifdef Honor_FLT_ROUNDS
+                               switch(Rounding) {
+                                 case 0: /* toward 0 */
+                                 case 3: /* toward -infinity */
+                                       word0(rv) = Big0;
+                                       word1(rv) = Big1;
+                                       break;
+                                 default:
+                                       word0(rv) = Exp_mask;
+                                       word1(rv) = 0;
+                                 }
+#else /*Honor_FLT_ROUNDS*/
+                               word0(rv) = Exp_mask;
+                               word1(rv) = 0;
+#endif /*Honor_FLT_ROUNDS*/
+#ifdef SET_INEXACT
+                               /* set overflow bit */
+                               dval(rv0) = 1e300;
+                               dval(rv0) *= dval(rv0);
+#endif
+#else /*IEEE_Arith*/
+                               word0(rv) = Big0;
+                               word1(rv) = Big1;
+#endif /*IEEE_Arith*/
+                               if (bd0)
+                                       goto retfree;
+                               goto ret;
+                               }
+                       e1 >>= 4;
+                       for(j = 0; e1 > 1; j++, e1 >>= 1)
+                               if (e1 & 1)
+                                       dval(rv) *= bigtens[j];
+               /* The last multiplication could overflow. */
+                       word0(rv) -= P*Exp_msk1;
+                       dval(rv) *= bigtens[j];
+                       if ((z = word0(rv) & Exp_mask)
+                        > Exp_msk1*(DBL_MAX_EXP+Bias-P))
+                               goto ovfl;
+                       if (z > Exp_msk1*(DBL_MAX_EXP+Bias-1-P)) {
+                               /* set to largest number */
+                               /* (Can't trust DBL_MAX) */
+                               word0(rv) = Big0;
+                               word1(rv) = Big1;
+                               }
+                       else
+                               word0(rv) += P*Exp_msk1;
+                       }
+               }
+       else if (e1 < 0) {
+               e1 = -e1;
+               if ( (i = e1 & 15) !=0)
+                       dval(rv) /= tens[i];
+               if (e1 >>= 4) {
+                       if (e1 >= 1 << n_bigtens)
+                               goto undfl;
+#ifdef Avoid_Underflow
+                       if (e1 & Scale_Bit)
+                               scale = 2*P;
+                       for(j = 0; e1 > 0; j++, e1 >>= 1)
+                               if (e1 & 1)
+                                       dval(rv) *= tinytens[j];
+                       if (scale && (j = 2*P + 1 - ((word0(rv) & Exp_mask)
+                                               >> Exp_shift)) > 0) {
+                               /* scaled rv is denormal; zap j low bits */
+                               if (j >= 32) {
+                                       word1(rv) = 0;
+                                       if (j >= 53)
+                                        word0(rv) = (P+2)*Exp_msk1;
+                                       else
+                                        word0(rv) &= 0xffffffff << j-32;
+                                       }
+                               else
+                                       word1(rv) &= 0xffffffff << j;
+                               }
+#else
+                       for(j = 0; e1 > 1; j++, e1 >>= 1)
+                               if (e1 & 1)
+                                       dval(rv) *= tinytens[j];
+                       /* The last multiplication could underflow. */
+                       dval(rv0) = dval(rv);
+                       dval(rv) *= tinytens[j];
+                       if (!dval(rv)) {
+                               dval(rv) = 2.*dval(rv0);
+                               dval(rv) *= tinytens[j];
+#endif
+                               if (!dval(rv)) {
+ undfl:
+                                       dval(rv) = 0.;
+#ifndef NO_ERRNO
+                                       errno = ERANGE;
+#endif
+                                       if (bd0)
+                                               goto retfree;
+                                       goto ret;
+                                       }
+#ifndef Avoid_Underflow
+                               word0(rv) = Tiny0;
+                               word1(rv) = Tiny1;
+                               /* The refinement below will clean
+                                * this approximation up.
+                                */
+                               }
+#endif
+                       }
+               }
+
+       /* Now the hard part -- adjusting rv to the correct value.*/
+
+       /* Put digits into bd: true value = bd * 10^e */
+
+       bd0 = s2b(s0, nd0, nd, y, dplen);
+
+       for(;;) {
+               bd = Balloc(bd0->k);
+               Bcopy(bd, bd0);
+               bb = d2b(dval(rv), &bbe, &bbbits);      /* rv = bb * 2^bbe */
+               bs = i2b(1);
+
+               if (e >= 0) {
+                       bb2 = bb5 = 0;
+                       bd2 = bd5 = e;
+                       }
+               else {
+                       bb2 = bb5 = -e;
+                       bd2 = bd5 = 0;
+                       }
+               if (bbe >= 0)
+                       bb2 += bbe;
+               else
+                       bd2 -= bbe;
+               bs2 = bb2;
+#ifdef Honor_FLT_ROUNDS
+               if (Rounding != 1)
+                       bs2++;
+#endif
+#ifdef Avoid_Underflow
+               j = bbe - scale;
+               i = j + bbbits - 1;     /* logb(rv) */
+               if (i < Emin)   /* denormal */
+                       j += P - Emin;
+               else
+                       j = P + 1 - bbbits;
+#else /*Avoid_Underflow*/
+#ifdef Sudden_Underflow
+#ifdef IBM
+               j = 1 + 4*P - 3 - bbbits + ((bbe + bbbits - 1) & 3);
+#else
+               j = P + 1 - bbbits;
+#endif
+#else /*Sudden_Underflow*/
+               j = bbe;
+               i = j + bbbits - 1;     /* logb(rv) */
+               if (i < Emin)   /* denormal */
+                       j += P - Emin;
+               else
+                       j = P + 1 - bbbits;
+#endif /*Sudden_Underflow*/
+#endif /*Avoid_Underflow*/
+               bb2 += j;
+               bd2 += j;
+#ifdef Avoid_Underflow
+               bd2 += scale;
+#endif
+               i = bb2 < bd2 ? bb2 : bd2;
+               if (i > bs2)
+                       i = bs2;
+               if (i > 0) {
+                       bb2 -= i;
+                       bd2 -= i;
+                       bs2 -= i;
+                       }
+               if (bb5 > 0) {
+                       bs = pow5mult(bs, bb5);
+                       bb1 = mult(bs, bb);
+                       Bfree(bb);
+                       bb = bb1;
+                       }
+               if (bb2 > 0)
+                       bb = lshift(bb, bb2);
+               if (bd5 > 0)
+                       bd = pow5mult(bd, bd5);
+               if (bd2 > 0)
+                       bd = lshift(bd, bd2);
+               if (bs2 > 0)
+                       bs = lshift(bs, bs2);
+               delta = diff(bb, bd);
+               dsign = delta->sign;
+               delta->sign = 0;
+               i = cmp(delta, bs);
+#ifdef Honor_FLT_ROUNDS
+               if (Rounding != 1) {
+                       if (i < 0) {
+                               /* Error is less than an ulp */
+                               if (!delta->x[0] && delta->wds <= 1) {
+                                       /* exact */
+#ifdef SET_INEXACT
+                                       inexact = 0;
+#endif
+                                       break;
+                                       }
+                               if (Rounding) {
+                                       if (dsign) {
+                                               adj = 1.;
+                                               goto apply_adj;
+                                               }
+                                       }
+                               else if (!dsign) {
+                                       adj = -1.;
+                                       if (!word1(rv)
+                                        && !(word0(rv) & Frac_mask)) {
+                                               y = word0(rv) & Exp_mask;
+#ifdef Avoid_Underflow
+                                               if (!scale || y > 2*P*Exp_msk1)
+#else
+                                               if (y)
+#endif
+                                                 {
+                                                 delta = lshift(delta,Log2P);
+                                                 if (cmp(delta, bs) <= 0)
+                                                       adj = -0.5;
+                                                 }
+                                               }
+ apply_adj:
+#ifdef Avoid_Underflow
+                                       if (scale && (y = word0(rv) & Exp_mask)
+                                               <= 2*P*Exp_msk1)
+                                         word0(adj) += (2*P+1)*Exp_msk1 - y;
+#else
+#ifdef Sudden_Underflow
+                                       if ((word0(rv) & Exp_mask) <=
+                                                       P*Exp_msk1) {
+                                               word0(rv) += P*Exp_msk1;
+                                               dval(rv) += adj*ulp(dval(rv));
+                                               word0(rv) -= P*Exp_msk1;
+                                               }
+                                       else
+#endif /*Sudden_Underflow*/
+#endif /*Avoid_Underflow*/
+                                       dval(rv) += adj*ulp(dval(rv));
+                                       }
+                               break;
+                               }
+                       adj = ratio(delta, bs);
+                       if (adj < 1.)
+                               adj = 1.;
+                       if (adj <= 0x7ffffffe) {
+                               /* adj = Rounding ? ceil(adj) : floor(adj); */
+                               y = adj;
+                               if (y != adj) {
+                                       if (!((Rounding>>1) ^ dsign))
+                                               y++;
+                                       adj = y;
+                                       }
+                               }
+#ifdef Avoid_Underflow
+                       if (scale && (y = word0(rv) & Exp_mask) <= 2*P*Exp_msk1)
+                               word0(adj) += (2*P+1)*Exp_msk1 - y;
+#else
+#ifdef Sudden_Underflow
+                       if ((word0(rv) & Exp_mask) <= P*Exp_msk1) {
+                               word0(rv) += P*Exp_msk1;
+                               adj *= ulp(dval(rv));
+                               if (dsign)
+                                       dval(rv) += adj;
+                               else
+                                       dval(rv) -= adj;
+                               word0(rv) -= P*Exp_msk1;
+                               goto cont;
+                               }
+#endif /*Sudden_Underflow*/
+#endif /*Avoid_Underflow*/
+                       adj *= ulp(dval(rv));
+                       if (dsign) {
+                               if (word0(rv) == Big0 && word1(rv) == Big1)
+                                       goto ovfl;
+                               dval(rv) += adj;
+                               }
+                       else
+                               dval(rv) -= adj;
+                       goto cont;
+                       }
+#endif /*Honor_FLT_ROUNDS*/
+
+               if (i < 0) {
+                       /* Error is less than half an ulp -- check for
+                        * special case of mantissa a power of two.
+                        */
+                       if (dsign || word1(rv) || word0(rv) & Bndry_mask
+#ifdef IEEE_Arith
+#ifdef Avoid_Underflow
+                        || (word0(rv) & Exp_mask) <= (2*P+1)*Exp_msk1
+#else
+                        || (word0(rv) & Exp_mask) <= Exp_msk1
+#endif
+#endif
+                               ) {
+#ifdef SET_INEXACT
+                               if (!delta->x[0] && delta->wds <= 1)
+                                       inexact = 0;
+#endif
+                               break;
+                               }
+                       if (!delta->x[0] && delta->wds <= 1) {
+                               /* exact result */
+#ifdef SET_INEXACT
+                               inexact = 0;
+#endif
+                               break;
+                               }
+                       delta = lshift(delta,Log2P);
+                       if (cmp(delta, bs) > 0)
+                               goto drop_down;
+                       break;
+                       }
+               if (i == 0) {
+                       /* exactly half-way between */
+                       if (dsign) {
+                               if ((word0(rv) & Bndry_mask1) == Bndry_mask1
+                                &&  word1(rv) == (
+#ifdef Avoid_Underflow
+                       (scale && (y = word0(rv) & Exp_mask) <= 2*P*Exp_msk1)
+               ? (0xffffffff & (0xffffffff << (2*P+1-(y>>Exp_shift)))) :
+#endif
+                                                  0xffffffff)) {
+                                       /*boundary case -- increment exponent*/
+                                       word0(rv) = (word0(rv) & Exp_mask)
+                                               + Exp_msk1
+#ifdef IBM
+                                               | Exp_msk1 >> 4
+#endif
+                                               ;
+                                       word1(rv) = 0;
+#ifdef Avoid_Underflow
+                                       dsign = 0;
+#endif
+                                       break;
+                                       }
+                               }
+                       else if (!(word0(rv) & Bndry_mask) && !word1(rv)) {
+ drop_down:
+                               /* boundary case -- decrement exponent */
+#ifdef Sudden_Underflow /*{{*/
+                               L = word0(rv) & Exp_mask;
+#ifdef IBM
+                               if (L <  Exp_msk1)
+#else
+#ifdef Avoid_Underflow
+                               if (L <= (scale ? (2*P+1)*Exp_msk1 : Exp_msk1))
+#else
+                               if (L <= Exp_msk1)
+#endif /*Avoid_Underflow*/
+#endif /*IBM*/
+                                       goto undfl;
+                               L -= Exp_msk1;
+#else /*Sudden_Underflow}{*/
+#ifdef Avoid_Underflow
+                               if (scale) {
+                                       L = word0(rv) & Exp_mask;
+                                       if (L <= (2*P+1)*Exp_msk1) {
+                                               if (L > (P+2)*Exp_msk1)
+                                                       /* round even ==> */
+                                                       /* accept rv */
+                                                       break;
+                                               /* rv = smallest denormal */
+                                               goto undfl;
+                                               }
+                                       }
+#endif /*Avoid_Underflow*/
+                               L = (word0(rv) & Exp_mask) - Exp_msk1;
+#endif /*Sudden_Underflow}}*/
+                               word0(rv) = L | Bndry_mask1;
+                               word1(rv) = 0xffffffff;
+#ifdef IBM
+                               goto cont;
+#else
+                               break;
+#endif
+                               }
+#ifndef ROUND_BIASED
+                       if (!(word1(rv) & LSB))
+                               break;
+#endif
+                       if (dsign)
+                               dval(rv) += ulp(dval(rv));
+#ifndef ROUND_BIASED
+                       else {
+                               dval(rv) -= ulp(dval(rv));
+#ifndef Sudden_Underflow
+                               if (!dval(rv))
+                                       goto undfl;
+#endif
+                               }
+#ifdef Avoid_Underflow
+                       dsign = 1 - dsign;
+#endif
+#endif
+                       break;
+                       }
+               if ((aadj = ratio(delta, bs)) <= 2.) {
+                       if (dsign)
+                               aadj = aadj1 = 1.;
+                       else if (word1(rv) || word0(rv) & Bndry_mask) {
+#ifndef Sudden_Underflow
+                               if (word1(rv) == Tiny1 && !word0(rv))
+                                       goto undfl;
+#endif
+                               aadj = 1.;
+                               aadj1 = -1.;
+                               }
+                       else {
+                               /* special case -- power of FLT_RADIX to be */
+                               /* rounded down... */
+
+                               if (aadj < 2./FLT_RADIX)
+                                       aadj = 1./FLT_RADIX;
+                               else
+                                       aadj *= 0.5;
+                               aadj1 = -aadj;
+                               }
+                       }
+               else {
+                       aadj *= 0.5;
+                       aadj1 = dsign ? aadj : -aadj;
+#ifdef Check_FLT_ROUNDS
+                       switch(Rounding) {
+                               case 2: /* towards +infinity */
+                                       aadj1 -= 0.5;
+                                       break;
+                               case 0: /* towards 0 */
+                               case 3: /* towards -infinity */
+                                       aadj1 += 0.5;
+                               }
+#else
+                       if (Flt_Rounds == 0)
+                               aadj1 += 0.5;
+#endif /*Check_FLT_ROUNDS*/
+                       }
+               y = word0(rv) & Exp_mask;
+
+               /* Check for overflow */
+
+               if (y == Exp_msk1*(DBL_MAX_EXP+Bias-1)) {
+                       dval(rv0) = dval(rv);
+                       word0(rv) -= P*Exp_msk1;
+                       adj = aadj1 * ulp(dval(rv));
+                       dval(rv) += adj;
+                       if ((word0(rv) & Exp_mask) >=
+                                       Exp_msk1*(DBL_MAX_EXP+Bias-P)) {
+                               if (word0(rv0) == Big0 && word1(rv0) == Big1)
+                                       goto ovfl;
+                               word0(rv) = Big0;
+                               word1(rv) = Big1;
+                               goto cont;
+                               }
+                       else
+                               word0(rv) += P*Exp_msk1;
+                       }
+               else {
+#ifdef Avoid_Underflow
+                       if (scale && y <= 2*P*Exp_msk1) {
+                               if (aadj <= 0x7fffffff) {
+                                       if ((z = aadj) <= 0)
+                                               z = 1;
+                                       aadj = z;
+                                       aadj1 = dsign ? aadj : -aadj;
+                                       }
+                               word0(aadj1) += (2*P+1)*Exp_msk1 - y;
+                               }
+                       adj = aadj1 * ulp(dval(rv));
+                       dval(rv) += adj;
+#else
+#ifdef Sudden_Underflow
+                       if ((word0(rv) & Exp_mask) <= P*Exp_msk1) {
+                               dval(rv0) = dval(rv);
+                               word0(rv) += P*Exp_msk1;
+                               adj = aadj1 * ulp(dval(rv));
+                               dval(rv) += adj;
+#ifdef IBM
+                               if ((word0(rv) & Exp_mask) <  P*Exp_msk1)
+#else
+                               if ((word0(rv) & Exp_mask) <= P*Exp_msk1)
+#endif
+                                       {
+                                       if (word0(rv0) == Tiny0
+                                        && word1(rv0) == Tiny1)
+                                               goto undfl;
+                                       word0(rv) = Tiny0;
+                                       word1(rv) = Tiny1;
+                                       goto cont;
+                                       }
+                               else
+                                       word0(rv) -= P*Exp_msk1;
+                               }
+                       else {
+                               adj = aadj1 * ulp(dval(rv));
+                               dval(rv) += adj;
+                               }
+#else /*Sudden_Underflow*/
+                       /* Compute adj so that the IEEE rounding rules will
+                        * correctly round rv + adj in some half-way cases.
+                        * If rv * ulp(rv) is denormalized (i.e.,
+                        * y <= (P-1)*Exp_msk1), we must adjust aadj to avoid
+                        * trouble from bits lost to denormalization;
+                        * example: 1.2e-307 .
+                        */
+                       if (y <= (P-1)*Exp_msk1 && aadj > 1.) {
+                               aadj1 = (double)(int)(aadj + 0.5);
+                               if (!dsign)
+                                       aadj1 = -aadj1;
+                               }
+                       adj = aadj1 * ulp(dval(rv));
+                       dval(rv) += adj;
+#endif /*Sudden_Underflow*/
+#endif /*Avoid_Underflow*/
+                       }
+               z = word0(rv) & Exp_mask;
+#ifndef SET_INEXACT
+#ifdef Avoid_Underflow
+               if (!scale)
+#endif
+               if (y == z) {
+                       /* Can we stop now? */
+                       L = (Long)aadj;
+                       aadj -= L;
+                       /* The tolerances below are conservative. */
+                       if (dsign || word1(rv) || word0(rv) & Bndry_mask) {
+                               if (aadj < .4999999 || aadj > .5000001)
+                                       break;
+                               }
+                       else if (aadj < .4999999/FLT_RADIX)
+                               break;
+                       }
+#endif
+ cont:
+               Bfree(bb);
+               Bfree(bd);
+               Bfree(bs);
+               Bfree(delta);
+               }
+#ifdef SET_INEXACT
+       if (inexact) {
+               if (!oldinexact) {
+                       word0(rv0) = Exp_1 + (70 << Exp_shift);
+                       word1(rv0) = 0;
+                       dval(rv0) += 1.;
+                       }
+               }
+       else if (!oldinexact)
+               clear_inexact();
+#endif
+#ifdef Avoid_Underflow
+       if (scale) {
+               word0(rv0) = Exp_1 - 2*P*Exp_msk1;
+               word1(rv0) = 0;
+               dval(rv) *= dval(rv0);
+#ifndef NO_ERRNO
+               /* try to avoid the bug of testing an 8087 register value */
+#ifdef IEEE_Arith
+               if (!(word0(rv) & Exp_mask))
+#else
+               if (word0(rv) == 0 && word1(rv) == 0)
+#endif
+                       errno = ERANGE;
+#endif
+               }
+#endif /* Avoid_Underflow */
+#ifdef SET_INEXACT
+       if (inexact && !(word0(rv) & Exp_mask)) {
+               /* set underflow bit */
+               dval(rv0) = 1e-300;
+               dval(rv0) *= dval(rv0);
+               }
+#endif
+ retfree:
+       Bfree(bb);
+       Bfree(bd);
+       Bfree(bs);
+       Bfree(bd0);
+       Bfree(delta);
+ ret:
+       if (se)
+               *se = (char *)s;
+       return sign ? -dval(rv) : dval(rv);
+       }
+
diff --git a/contrib/gdtoa/strtodI.c b/contrib/gdtoa/strtodI.c
new file mode 100644 (file)
index 0000000..98f8891
--- /dev/null
@@ -0,0 +1,167 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998, 2000 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
+IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
+IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.
+
+****************************************************************/
+
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to ".").     */
+
+#include "gdtoaimp.h"
+
+ static double
+#ifdef KR_headers
+ulpdown(d) double *d;
+#else
+ulpdown(double *d)
+#endif
+{
+       double u;
+       ULong *L = (ULong*)d;
+
+       u = ulp(*d);
+       if (!(L[_1] | L[_0] & 0xfffff)
+        && (L[_0] & 0x7ff00000) > 0x00100000)
+               u *= 0.5;
+       return u;
+       }
+
+ int
+#ifdef KR_headers
+strtodI(s, sp, dd) CONST char *s; char **sp; double *dd;
+#else
+strtodI(CONST char *s, char **sp, double *dd)
+#endif
+{
+       static FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, SI };
+       ULong bits[2], sign;
+       Long exp;
+       int j, k;
+       typedef union {
+               double d[2];
+               ULong L[4];
+               } U;
+       U *u;
+
+       k = strtodg(s, sp, &fpi, &exp, bits);
+       u = (U*)dd;
+       sign = k & STRTOG_Neg ? 0x80000000L : 0;
+       switch(k & STRTOG_Retmask) {
+         case STRTOG_NoNumber:
+               u->d[0] = u->d[1] = 0.;
+               break;
+
+         case STRTOG_Zero:
+               u->d[0] = u->d[1] = 0.;
+#ifdef Sudden_Underflow
+               if (k & STRTOG_Inexact) {
+                       if (sign)
+                               u->L[_0] = 0x80100000L;
+                       else
+                               u->L[2+_0] = 0x100000L;
+                       }
+               break;
+#else
+               goto contain;
+#endif
+
+         case STRTOG_Denormal:
+               u->L[_1] = bits[0];
+               u->L[_0] = bits[1];
+               goto contain;
+
+         case STRTOG_Normal:
+               u->L[_1] = bits[0];
+               u->L[_0] = (bits[1] & ~0x100000) | ((exp + 0x3ff + 52) << 20);
+         contain:
+               j = k & STRTOG_Inexact;
+               if (sign) {
+                       u->L[_0] |= sign;
+                       j = STRTOG_Inexact - j;
+                       }
+               switch(j) {
+                 case STRTOG_Inexlo:
+#ifdef Sudden_Underflow
+                       if ((u->L[_0] & 0x7ff00000) < 0x3500000) {
+                               u->L[2+_0] = u->L[_0] + 0x3500000;
+                               u->L[2+_1] = u->L[_1];
+                               u->d[1] += ulp(u->d[1]);
+                               u->L[2+_0] -= 0x3500000;
+                               if (!(u->L[2+_0] & 0x7ff00000)) {
+                                       u->L[2+_0] = sign;
+                                       u->L[2+_1] = 0;
+                                       }
+                               }
+                       else
+#endif
+                       u->d[1] = u->d[0] + ulp(u->d[0]);
+                       break;
+                 case STRTOG_Inexhi:
+                       u->d[1] = u->d[0];
+#ifdef Sudden_Underflow
+                       if ((u->L[_0] & 0x7ff00000) < 0x3500000) {
+                               u->L[_0] += 0x3500000;
+                               u->d[0] -= ulpdown(u->d);
+                               u->L[_0] -= 0x3500000;
+                               if (!(u->L[_0] & 0x7ff00000)) {
+                                       u->L[_0] = sign;
+                                       u->L[_1] = 0;
+                                       }
+                               }
+                       else
+#endif
+                       u->d[0] -= ulpdown(u->d);
+                       break;
+                 default:
+                       u->d[1] = u->d[0];
+                 }
+               break;
+
+         case STRTOG_Infinite:
+               u->L[_0] = u->L[2+_0] = sign | 0x7ff00000;
+               u->L[_1] = u->L[2+_1] = 0;
+               if (k & STRTOG_Inexact) {
+                       if (sign) {
+                               u->L[2+_0] = 0xffefffffL;
+                               u->L[2+_1] = 0xffffffffL;
+                               }
+                       else {
+                               u->L[_0] = 0x7fefffffL;
+                               u->L[_1] = 0xffffffffL;
+                               }
+                       }
+               break;
+
+         case STRTOG_NaN:
+               u->L[0] = u->L[2] = d_QNAN0;
+               u->L[1] = u->L[3] = d_QNAN1;
+               break;
+
+         case STRTOG_NaNbits:
+               u->L[_0] = u->L[2+_0] = 0x7ff00000 | sign | bits[1];
+               u->L[_1] = u->L[2+_1] = bits[0];
+         }
+       return k;
+       }
diff --git a/contrib/gdtoa/strtodg.c b/contrib/gdtoa/strtodg.c
new file mode 100644 (file)
index 0000000..a69ce30
--- /dev/null
@@ -0,0 +1,1064 @@
+/****************************************************************
+
+The author of this software is David M. Gay.
+
+Copyright (C) 1998-2001 by Lucent Technologies
+All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and
+its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the name of Lucent or any of its entities
+not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior
+permission.
+
+LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+INCLUDIN