tor-browser

The Tor Browser
git clone https://git.dasho.dev/tor-browser.git
Log | Files | Refs | README | LICENSE

prdtoa.c (80688B)


      1 /* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 2 -*- */
      2 /* This Source Code Form is subject to the terms of the Mozilla Public
      3 * License, v. 2.0. If a copy of the MPL was not distributed with this
      4 * file, You can obtain one at http://mozilla.org/MPL/2.0/. */
      5 
      6 /*
      7 * This file is based on the third-party code dtoa.c.  We minimize our
      8 * modifications to third-party code to make it easy to merge new versions.
      9 * The author of dtoa.c was not willing to add the parentheses suggested by
     10 * GCC, so we suppress these warnings.
     11 */
     12 #if (__GNUC__ > 4) || (__GNUC__ == 4 && __GNUC_MINOR__ >= 2)
     13 #  pragma GCC diagnostic ignored "-Wparentheses"
     14 #endif
     15 
     16 #include "primpl.h"
     17 #include "prbit.h"
     18 
     19 #define MULTIPLE_THREADS
     20 #define ACQUIRE_DTOA_LOCK(n) PR_Lock(dtoa_lock[n])
     21 #define FREE_DTOA_LOCK(n) PR_Unlock(dtoa_lock[n])
     22 
     23 static PRLock* dtoa_lock[2];
     24 
     25 void _PR_InitDtoa(void) {
     26  dtoa_lock[0] = PR_NewLock();
     27  dtoa_lock[1] = PR_NewLock();
     28 }
     29 
     30 void _PR_CleanupDtoa(void) {
     31  PR_DestroyLock(dtoa_lock[0]);
     32  dtoa_lock[0] = NULL;
     33  PR_DestroyLock(dtoa_lock[1]);
     34  dtoa_lock[1] = NULL;
     35 
     36  /* FIXME: deal with freelist and p5s. */
     37 }
     38 
     39 #if !defined(__ARM_EABI__) && (defined(__arm) || defined(__arm__) || \
     40                               defined(__arm26__) || defined(__arm32__))
     41 #  define IEEE_ARM
     42 #elif defined(IS_LITTLE_ENDIAN)
     43 #  define IEEE_8087
     44 #else
     45 #  define IEEE_MC68k
     46 #endif
     47 
     48 #define Long PRInt32
     49 #define ULong PRUint32
     50 #define NO_LONG_LONG
     51 
     52 #define No_Hex_NaN
     53 
     54 /****************************************************************
     55 *
     56 * The author of this software is David M. Gay.
     57 *
     58 * Copyright (c) 1991, 2000, 2001 by Lucent Technologies.
     59 *
     60 * Permission to use, copy, modify, and distribute this software for any
     61 * purpose without fee is hereby granted, provided that this entire notice
     62 * is included in all copies of any software which is or includes a copy
     63 * or modification of this software and in all copies of the supporting
     64 * documentation for such software.
     65 *
     66 * THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
     67 * WARRANTY.  IN PARTICULAR, NEITHER THE AUTHOR NOR LUCENT MAKES ANY
     68 * REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
     69 * OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
     70 *
     71 ***************************************************************/
     72 
     73 /* Please send bug reports to David M. Gay (dmg at acm dot org,
     74 * with " at " changed at "@" and " dot " changed to ".").  */
     75 
     76 /* On a machine with IEEE extended-precision registers, it is
     77 * necessary to specify double-precision (53-bit) rounding precision
     78 * before invoking strtod or dtoa.  If the machine uses (the equivalent
     79 * of) Intel 80x87 arithmetic, the call
     80 *  _control87(PC_53, MCW_PC);
     81 * does this with many compilers.  Whether this or another call is
     82 * appropriate depends on the compiler; for this to work, it may be
     83 * necessary to #include "float.h" or another system-dependent header
     84 * file.
     85 */
     86 
     87 /* strtod for IEEE-, VAX-, and IBM-arithmetic machines.
     88 *
     89 * This strtod returns a nearest machine number to the input decimal
     90 * string (or sets errno to ERANGE).  With IEEE arithmetic, ties are
     91 * broken by the IEEE round-even rule.  Otherwise ties are broken by
     92 * biased rounding (add half and chop).
     93 *
     94 * Inspired loosely by William D. Clinger's paper "How to Read Floating
     95 * Point Numbers Accurately" [Proc. ACM SIGPLAN '90, pp. 92-101].
     96 *
     97 * Modifications:
     98 *
     99 *  1. We only require IEEE, IBM, or VAX double-precision
    100 *      arithmetic (not IEEE double-extended).
    101 *  2. We get by with floating-point arithmetic in a case that
    102 *      Clinger missed -- when we're computing d * 10^n
    103 *      for a small integer d and the integer n is not too
    104 *      much larger than 22 (the maximum integer k for which
    105 *      we can represent 10^k exactly), we may be able to
    106 *      compute (d*10^k) * 10^(e-k) with just one roundoff.
    107 *  3. Rather than a bit-at-a-time adjustment of the binary
    108 *      result in the hard case, we use floating-point
    109 *      arithmetic to determine the adjustment to within
    110 *      one bit; only in really hard cases do we need to
    111 *      compute a second residual.
    112 *  4. Because of 3., we don't need a large table of powers of 10
    113 *      for ten-to-e (just some small tables, e.g. of 10^k
    114 *      for 0 <= k <= 22).
    115 */
    116 
    117 /*
    118 * #define IEEE_8087 for IEEE-arithmetic machines where the least
    119 *  significant byte has the lowest address.
    120 * #define IEEE_MC68k for IEEE-arithmetic machines where the most
    121 *  significant byte has the lowest address.
    122 * #define IEEE_ARM for IEEE-arithmetic machines where the two words
    123 *  in a double are stored in big endian order but the two shorts
    124 *  in a word are still stored in little endian order.
    125 * #define Long int on machines with 32-bit ints and 64-bit longs.
    126 * #define IBM for IBM mainframe-style floating-point arithmetic.
    127 * #define VAX for VAX-style floating-point arithmetic (D_floating).
    128 * #define No_leftright to omit left-right logic in fast floating-point
    129 *  computation of dtoa.
    130 * #define Honor_FLT_ROUNDS if FLT_ROUNDS can assume the values 2 or 3
    131 *  and strtod and dtoa should round accordingly.
    132 * #define Check_FLT_ROUNDS if FLT_ROUNDS can assume the values 2 or 3
    133 *  and Honor_FLT_ROUNDS is not #defined.
    134 * #define RND_PRODQUOT to use rnd_prod and rnd_quot (assembly routines
    135 *  that use extended-precision instructions to compute rounded
    136 *  products and quotients) with IBM.
    137 * #define ROUND_BIASED for IEEE-format with biased rounding.
    138 * #define Inaccurate_Divide for IEEE-format with correctly rounded
    139 *  products but inaccurate quotients, e.g., for Intel i860.
    140 * #define NO_LONG_LONG on machines that do not have a "long long"
    141 *  integer type (of >= 64 bits).  On such machines, you can
    142 *  #define Just_16 to store 16 bits per 32-bit Long when doing
    143 *  high-precision integer arithmetic.  Whether this speeds things
    144 *  up or slows things down depends on the machine and the number
    145 *  being converted.  If long long is available and the name is
    146 *  something other than "long long", #define Llong to be the name,
    147 *  and if "unsigned Llong" does not work as an unsigned version of
    148 *  Llong, #define #ULLong to be the corresponding unsigned type.
    149 * #define KR_headers for old-style C function headers.
    150 * #define Bad_float_h if your system lacks a float.h or if it does not
    151 *  define some or all of DBL_DIG, DBL_MAX_10_EXP, DBL_MAX_EXP,
    152 *  FLT_RADIX, FLT_ROUNDS, and DBL_MAX.
    153 * #define MALLOC your_malloc, where your_malloc(n) acts like malloc(n)
    154 *  if memory is available and otherwise does something you deem
    155 *  appropriate.  If MALLOC is undefined, malloc will be invoked
    156 *  directly -- and assumed always to succeed.  Similarly, if you
    157 *  want something other than the system's free() to be called to
    158 *  recycle memory acquired from MALLOC, #define FREE to be the
    159 *  name of the alternate routine.  (FREE or free is only called in
    160 *  pathological cases, e.g., in a dtoa call after a dtoa return in
    161 *  mode 3 with thousands of digits requested.)
    162 * #define Omit_Private_Memory to omit logic (added Jan. 1998) for making
    163 *  memory allocations from a private pool of memory when possible.
    164 *  When used, the private pool is PRIVATE_MEM bytes long:  2304 bytes,
    165 *  unless #defined to be a different length.  This default length
    166 *  suffices to get rid of MALLOC calls except for unusual cases,
    167 *  such as decimal-to-binary conversion of a very long string of
    168 *  digits.  The longest string dtoa can return is about 751 bytes
    169 *  long.  For conversions by strtod of strings of 800 digits and
    170 *  all dtoa conversions in single-threaded executions with 8-byte
    171 *  pointers, PRIVATE_MEM >= 7400 appears to suffice; with 4-byte
    172 *  pointers, PRIVATE_MEM >= 7112 appears adequate.
    173 * #define INFNAN_CHECK on IEEE systems to cause strtod to check for
    174 *  Infinity and NaN (case insensitively).  On some systems (e.g.,
    175 *  some HP systems), it may be necessary to #define NAN_WORD0
    176 *  appropriately -- to the most significant word of a quiet NaN.
    177 *  (On HP Series 700/800 machines, -DNAN_WORD0=0x7ff40000 works.)
    178 *  When INFNAN_CHECK is #defined and No_Hex_NaN is not #defined,
    179 *  strtod also accepts (case insensitively) strings of the form
    180 *  NaN(x), where x is a string of hexadecimal digits and spaces;
    181 *  if there is only one string of hexadecimal digits, it is taken
    182 *  for the 52 fraction bits of the resulting NaN; if there are two
    183 *  or more strings of hex digits, the first is for the high 20 bits,
    184 *  the second and subsequent for the low 32 bits, with intervening
    185 *  white space ignored; but if this results in none of the 52
    186 *  fraction bits being on (an IEEE Infinity symbol), then NAN_WORD0
    187 *  and NAN_WORD1 are used instead.
    188 * #define MULTIPLE_THREADS if the system offers preemptively scheduled
    189 *  multiple threads.  In this case, you must provide (or suitably
    190 *  #define) two locks, acquired by ACQUIRE_DTOA_LOCK(n) and freed
    191 *  by FREE_DTOA_LOCK(n) for n = 0 or 1.  (The second lock, accessed
    192 *  in pow5mult, ensures lazy evaluation of only one copy of high
    193 *  powers of 5; omitting this lock would introduce a small
    194 *  probability of wasting memory, but would otherwise be harmless.)
    195 *  You must also invoke freedtoa(s) to free the value s returned by
    196 *  dtoa.  You may do so whether or not MULTIPLE_THREADS is #defined.
    197 * #define NO_IEEE_Scale to disable new (Feb. 1997) logic in strtod that
    198 *  avoids underflows on inputs whose result does not underflow.
    199 *  If you #define NO_IEEE_Scale on a machine that uses IEEE-format
    200 *  floating-point numbers and flushes underflows to zero rather
    201 *  than implementing gradual underflow, then you must also #define
    202 *  Sudden_Underflow.
    203 * #define USE_LOCALE to use the current locale's decimal_point value.
    204 * #define SET_INEXACT if IEEE arithmetic is being used and extra
    205 *  computation should be done to set the inexact flag when the
    206 *  result is inexact and avoid setting inexact when the result
    207 *  is exact.  In this case, dtoa.c must be compiled in
    208 *  an environment, perhaps provided by #include "dtoa.c" in a
    209 *  suitable wrapper, that defines two functions,
    210 *      int get_inexact(void);
    211 *      void clear_inexact(void);
    212 *  such that get_inexact() returns a nonzero value if the
    213 *  inexact bit is already set, and clear_inexact() sets the
    214 *  inexact bit to 0.  When SET_INEXACT is #defined, strtod
    215 *  also does extra computations to set the underflow and overflow
    216 *  flags when appropriate (i.e., when the result is tiny and
    217 *  inexact or when it is a numeric value rounded to +-infinity).
    218 * #define NO_ERRNO if strtod should not assign errno = ERANGE when
    219 *  the result overflows to +-Infinity or underflows to 0.
    220 */
    221 
    222 #ifndef Long
    223 #  define Long long
    224 #endif
    225 #ifndef ULong
    226 typedef unsigned Long ULong;
    227 #endif
    228 
    229 #ifdef DEBUG
    230 #  include "stdio.h"
    231 #  define Bug(x)                  \
    232    {                             \
    233      fprintf(stderr, "%s\n", x); \
    234      exit(1);                    \
    235    }
    236 #endif
    237 
    238 #include "stdlib.h"
    239 #include "string.h"
    240 
    241 #ifdef USE_LOCALE
    242 #  include "locale.h"
    243 #endif
    244 
    245 #ifdef MALLOC
    246 #  ifdef KR_headers
    247 extern char* MALLOC();
    248 #  else
    249 extern void* MALLOC(size_t);
    250 #  endif
    251 #else
    252 #  define MALLOC malloc
    253 #endif
    254 
    255 #ifndef Omit_Private_Memory
    256 #  ifndef PRIVATE_MEM
    257 #    define PRIVATE_MEM 2304
    258 #  endif
    259 #  define PRIVATE_mem ((PRIVATE_MEM + sizeof(double) - 1) / sizeof(double))
    260 static double private_mem[PRIVATE_mem], *pmem_next = private_mem;
    261 #endif
    262 
    263 #undef IEEE_Arith
    264 #undef Avoid_Underflow
    265 #ifdef IEEE_MC68k
    266 #  define IEEE_Arith
    267 #endif
    268 #ifdef IEEE_8087
    269 #  define IEEE_Arith
    270 #endif
    271 #ifdef IEEE_ARM
    272 #  define IEEE_Arith
    273 #endif
    274 
    275 #include "errno.h"
    276 
    277 #ifdef Bad_float_h
    278 
    279 #  ifdef IEEE_Arith
    280 #    define DBL_DIG 15
    281 #    define DBL_MAX_10_EXP 308
    282 #    define DBL_MAX_EXP 1024
    283 #    define FLT_RADIX 2
    284 #  endif /*IEEE_Arith*/
    285 
    286 #  ifdef IBM
    287 #    define DBL_DIG 16
    288 #    define DBL_MAX_10_EXP 75
    289 #    define DBL_MAX_EXP 63
    290 #    define FLT_RADIX 16
    291 #    define DBL_MAX 7.2370055773322621e+75
    292 #  endif
    293 
    294 #  ifdef VAX
    295 #    define DBL_DIG 16
    296 #    define DBL_MAX_10_EXP 38
    297 #    define DBL_MAX_EXP 127
    298 #    define FLT_RADIX 2
    299 #    define DBL_MAX 1.7014118346046923e+38
    300 #  endif
    301 
    302 #  ifndef LONG_MAX
    303 #    define LONG_MAX 2147483647
    304 #  endif
    305 
    306 #else /* ifndef Bad_float_h */
    307 #  include "float.h"
    308 #endif /* Bad_float_h */
    309 
    310 #ifndef __MATH_H__
    311 #  include "math.h"
    312 #endif
    313 
    314 #ifdef __cplusplus
    315 extern "C" {
    316 #endif
    317 
    318 #ifndef CONST
    319 #  ifdef KR_headers
    320 #    define CONST /* blank */
    321 #  else
    322 #    define CONST const
    323 #  endif
    324 #endif
    325 
    326 #if defined(IEEE_8087) + defined(IEEE_MC68k) + defined(IEEE_ARM) + \
    327        defined(VAX) + defined(IBM) !=                             \
    328    1
    329 Exactly one of IEEE_8087, IEEE_MC68k, IEEE_ARM, VAX, or IBM should be defined.
    330 #endif
    331 
    332                                                         typedef union {
    333  double d;
    334  ULong L[2];
    335 } U;
    336 
    337 #define dval(x) (x).d
    338 #ifdef IEEE_8087
    339 #  define word0(x) (x).L[1]
    340 #  define word1(x) (x).L[0]
    341 #else
    342 #  define word0(x) (x).L[0]
    343 #  define word1(x) (x).L[1]
    344 #endif
    345 
    346 /* The following definition of Storeinc is appropriate for MIPS processors.
    347 * An alternative that might be better on some machines is
    348 * #define Storeinc(a,b,c) (*a++ = b << 16 | c & 0xffff)
    349 */
    350 #if defined(IEEE_8087) + defined(IEEE_ARM) + defined(VAX)
    351 #  define Storeinc(a, b, c)                       \
    352    (((unsigned short*)a)[1] = (unsigned short)b, \
    353     ((unsigned short*)a)[0] = (unsigned short)c, a++)
    354 #else
    355 #  define Storeinc(a, b, c)                       \
    356    (((unsigned short*)a)[0] = (unsigned short)b, \
    357     ((unsigned short*)a)[1] = (unsigned short)c, a++)
    358 #endif
    359 
    360 /* #define P DBL_MANT_DIG */
    361 /* Ten_pmax = floor(P*log(2)/log(5)) */
    362 /* Bletch = (highest power of 2 < DBL_MAX_10_EXP) / 16 */
    363 /* Quick_max = floor((P-1)*log(FLT_RADIX)/log(10) - 1) */
    364 /* Int_max = floor(P*log(FLT_RADIX)/log(10) - 1) */
    365 
    366 #ifdef IEEE_Arith
    367 #  define Exp_shift 20
    368 #  define Exp_shift1 20
    369 #  define Exp_msk1 0x100000
    370 #  define Exp_msk11 0x100000
    371 #  define Exp_mask 0x7ff00000
    372 #  define P 53
    373 #  define Bias 1023
    374 #  define Emin (-1022)
    375 #  define Exp_1 0x3ff00000
    376 #  define Exp_11 0x3ff00000
    377 #  define Ebits 11
    378 #  define Frac_mask 0xfffff
    379 #  define Frac_mask1 0xfffff
    380 #  define Ten_pmax 22
    381 #  define Bletch 0x10
    382 #  define Bndry_mask 0xfffff
    383 #  define Bndry_mask1 0xfffff
    384 #  define LSB 1
    385 #  define Sign_bit 0x80000000
    386 #  define Log2P 1
    387 #  define Tiny0 0
    388 #  define Tiny1 1
    389 #  define Quick_max 14
    390 #  define Int_max 14
    391 #  ifndef NO_IEEE_Scale
    392 #    define Avoid_Underflow
    393 #    ifdef Flush_Denorm /* debugging option */
    394 #      undef Sudden_Underflow
    395 #    endif
    396 #  endif
    397 
    398 #  ifndef Flt_Rounds
    399 #    ifdef FLT_ROUNDS
    400 #      define Flt_Rounds FLT_ROUNDS
    401 #    else
    402 #      define Flt_Rounds 1
    403 #    endif
    404 #  endif /*Flt_Rounds*/
    405 
    406 #  ifdef Honor_FLT_ROUNDS
    407 #    define Rounding rounding
    408 #    undef Check_FLT_ROUNDS
    409 #    define Check_FLT_ROUNDS
    410 #  else
    411 #    define Rounding Flt_Rounds
    412 #  endif
    413 
    414 #else /* ifndef IEEE_Arith */
    415 #  undef Check_FLT_ROUNDS
    416 #  undef Honor_FLT_ROUNDS
    417 #  undef SET_INEXACT
    418 #  undef Sudden_Underflow
    419 #  define Sudden_Underflow
    420 #  ifdef IBM
    421 #    undef Flt_Rounds
    422 #    define Flt_Rounds 0
    423 #    define Exp_shift 24
    424 #    define Exp_shift1 24
    425 #    define Exp_msk1 0x1000000
    426 #    define Exp_msk11 0x1000000
    427 #    define Exp_mask 0x7f000000
    428 #    define P 14
    429 #    define Bias 65
    430 #    define Exp_1 0x41000000
    431 #    define Exp_11 0x41000000
    432 #    define Ebits 8 /* exponent has 7 bits, but 8 is the right value in b2d */
    433 #    define Frac_mask 0xffffff
    434 #    define Frac_mask1 0xffffff
    435 #    define Bletch 4
    436 #    define Ten_pmax 22
    437 #    define Bndry_mask 0xefffff
    438 #    define Bndry_mask1 0xffffff
    439 #    define LSB 1
    440 #    define Sign_bit 0x80000000
    441 #    define Log2P 4
    442 #    define Tiny0 0x100000
    443 #    define Tiny1 0
    444 #    define Quick_max 14
    445 #    define Int_max 15
    446 #  else /* VAX */
    447 #    undef Flt_Rounds
    448 #    define Flt_Rounds 1
    449 #    define Exp_shift 23
    450 #    define Exp_shift1 7
    451 #    define Exp_msk1 0x80
    452 #    define Exp_msk11 0x800000
    453 #    define Exp_mask 0x7f80
    454 #    define P 56
    455 #    define Bias 129
    456 #    define Exp_1 0x40800000
    457 #    define Exp_11 0x4080
    458 #    define Ebits 8
    459 #    define Frac_mask 0x7fffff
    460 #    define Frac_mask1 0xffff007f
    461 #    define Ten_pmax 24
    462 #    define Bletch 2
    463 #    define Bndry_mask 0xffff007f
    464 #    define Bndry_mask1 0xffff007f
    465 #    define LSB 0x10000
    466 #    define Sign_bit 0x8000
    467 #    define Log2P 1
    468 #    define Tiny0 0x80
    469 #    define Tiny1 0
    470 #    define Quick_max 15
    471 #    define Int_max 15
    472 #  endif /* IBM, VAX */
    473 #endif   /* IEEE_Arith */
    474 
    475 #ifndef IEEE_Arith
    476 #  define ROUND_BIASED
    477 #endif
    478 
    479 #ifdef RND_PRODQUOT
    480 #  define rounded_product(a, b) a = rnd_prod(a, b)
    481 #  define rounded_quotient(a, b) a = rnd_quot(a, b)
    482 #  ifdef KR_headers
    483 extern double rnd_prod(), rnd_quot();
    484 #  else
    485 extern double rnd_prod(double, double), rnd_quot(double, double);
    486 #  endif
    487 #else
    488 #  define rounded_product(a, b) a *= b
    489 #  define rounded_quotient(a, b) a /= b
    490 #endif
    491 
    492 #define Big0 (Frac_mask1 | Exp_msk1 * (DBL_MAX_EXP + Bias - 1))
    493 #define Big1 0xffffffff
    494 
    495 #ifndef Pack_32
    496 #  define Pack_32
    497 #endif
    498 
    499 #ifdef KR_headers
    500 #  define FFFFFFFF ((((unsigned long)0xffff) << 16) | (unsigned long)0xffff)
    501 #else
    502 #  define FFFFFFFF 0xffffffffUL
    503 #endif
    504 
    505 #ifdef NO_LONG_LONG
    506 #  undef ULLong
    507 #  ifdef Just_16
    508 #    undef Pack_32
    509 /* When Pack_32 is not defined, we store 16 bits per 32-bit Long.
    510 * This makes some inner loops simpler and sometimes saves work
    511 * during multiplications, but it often seems to make things slightly
    512 * slower.  Hence the default is now to store 32 bits per Long.
    513 */
    514 #  endif
    515 #else /* long long available */
    516 #  ifndef Llong
    517 #    define Llong long long
    518 #  endif
    519 #  ifndef ULLong
    520 #    define ULLong unsigned Llong
    521 #  endif
    522 #endif /* NO_LONG_LONG */
    523 
    524 #ifndef MULTIPLE_THREADS
    525 #  define ACQUIRE_DTOA_LOCK(n) /*nothing*/
    526 #  define FREE_DTOA_LOCK(n)    /*nothing*/
    527 #endif
    528 
    529 #define Kmax 7
    530 
    531 struct Bigint {
    532  struct Bigint* next;
    533  int k, maxwds, sign, wds;
    534  ULong x[1];
    535 };
    536 
    537 typedef struct Bigint Bigint;
    538 
    539 static Bigint* freelist[Kmax + 1];
    540 
    541 static Bigint* Balloc
    542 #ifdef KR_headers
    543    (k) int k;
    544 #else
    545    (int k)
    546 #endif
    547 {
    548  int x;
    549  Bigint* rv;
    550 #ifndef Omit_Private_Memory
    551  unsigned int len;
    552 #endif
    553 
    554  ACQUIRE_DTOA_LOCK(0);
    555  /* The k > Kmax case does not need ACQUIRE_DTOA_LOCK(0), */
    556  /* but this case seems very unlikely. */
    557  if (k <= Kmax && (rv = freelist[k])) {
    558    freelist[k] = rv->next;
    559  } else {
    560    x = 1 << k;
    561 #ifdef Omit_Private_Memory
    562    rv = (Bigint*)MALLOC(sizeof(Bigint) + (x - 1) * sizeof(ULong));
    563 #else
    564    len = (sizeof(Bigint) + (x - 1) * sizeof(ULong) + sizeof(double) - 1) /
    565          sizeof(double);
    566    if (k <= Kmax && pmem_next - private_mem + len <= PRIVATE_mem) {
    567      rv = (Bigint*)pmem_next;
    568      pmem_next += len;
    569    } else {
    570      rv = (Bigint*)MALLOC(len * sizeof(double));
    571    }
    572 #endif
    573    rv->k = k;
    574    rv->maxwds = x;
    575  }
    576  FREE_DTOA_LOCK(0);
    577  rv->sign = rv->wds = 0;
    578  return rv;
    579 }
    580 
    581 static void Bfree
    582 #ifdef KR_headers
    583    (v) Bigint* v;
    584 #else
    585    (Bigint* v)
    586 #endif
    587 {
    588  if (v) {
    589    if (v->k > Kmax)
    590 #ifdef FREE
    591      FREE((void*)v);
    592 #else
    593      free((void*)v);
    594 #endif
    595    else {
    596      ACQUIRE_DTOA_LOCK(0);
    597      v->next = freelist[v->k];
    598      freelist[v->k] = v;
    599      FREE_DTOA_LOCK(0);
    600    }
    601  }
    602 }
    603 
    604 #define Bcopy(x, y)                        \
    605  memcpy((char*)&x->sign, (char*)&y->sign, \
    606         y->wds * sizeof(Long) + 2 * sizeof(int))
    607 
    608 static Bigint* multadd
    609 #ifdef KR_headers
    610    (b, m, a) Bigint* b;
    611 int m, a;
    612 #else
    613    (Bigint* b, int m, int a) /* multiply by m and add a */
    614 #endif
    615 {
    616  int i, wds;
    617 #ifdef ULLong
    618  ULong* x;
    619  ULLong carry, y;
    620 #else
    621  ULong carry, *x, y;
    622 #  ifdef Pack_32
    623  ULong xi, z;
    624 #  endif
    625 #endif
    626  Bigint* b1;
    627 
    628  wds = b->wds;
    629  x = b->x;
    630  i = 0;
    631  carry = a;
    632  do {
    633 #ifdef ULLong
    634    y = *x * (ULLong)m + carry;
    635    carry = y >> 32;
    636    *x++ = y & FFFFFFFF;
    637 #else
    638 #  ifdef Pack_32
    639    xi = *x;
    640    y = (xi & 0xffff) * m + carry;
    641    z = (xi >> 16) * m + (y >> 16);
    642    carry = z >> 16;
    643    *x++ = (z << 16) + (y & 0xffff);
    644 #  else
    645    y = *x * m + carry;
    646    carry = y >> 16;
    647    *x++ = y & 0xffff;
    648 #  endif
    649 #endif
    650  } while (++i < wds);
    651  if (carry) {
    652    if (wds >= b->maxwds) {
    653      b1 = Balloc(b->k + 1);
    654      Bcopy(b1, b);
    655      Bfree(b);
    656      b = b1;
    657    }
    658    b->x[wds++] = carry;
    659    b->wds = wds;
    660  }
    661  return b;
    662 }
    663 
    664 static Bigint* s2b
    665 #ifdef KR_headers
    666    (s, nd0, nd, y9) CONST char* s;
    667 int nd0, nd;
    668 ULong y9;
    669 #else
    670    (CONST char* s, int nd0, int nd, ULong y9)
    671 #endif
    672 {
    673  Bigint* b;
    674  int i, k;
    675  Long x, y;
    676 
    677  x = (nd + 8) / 9;
    678  for (k = 0, y = 1; x > y; y <<= 1, k++);
    679 #ifdef Pack_32
    680  b = Balloc(k);
    681  b->x[0] = y9;
    682  b->wds = 1;
    683 #else
    684  b = Balloc(k + 1);
    685  b->x[0] = y9 & 0xffff;
    686  b->wds = (b->x[1] = y9 >> 16) ? 2 : 1;
    687 #endif
    688 
    689  i = 9;
    690  if (9 < nd0) {
    691    s += 9;
    692    do {
    693      b = multadd(b, 10, *s++ - '0');
    694    } while (++i < nd0);
    695    s++;
    696  } else {
    697    s += 10;
    698  }
    699  for (; i < nd; i++) {
    700    b = multadd(b, 10, *s++ - '0');
    701  }
    702  return b;
    703 }
    704 
    705 static int hi0bits
    706 #ifdef KR_headers
    707    (x) register ULong x;
    708 #else
    709    (register ULong x)
    710 #endif
    711 {
    712 #ifdef PR_HAVE_BUILTIN_BITSCAN32
    713  return ((!x) ? 32 : pr_bitscan_clz32(x));
    714 #else
    715  register int k = 0;
    716 
    717  if (!(x & 0xffff0000)) {
    718    k = 16;
    719    x <<= 16;
    720  }
    721  if (!(x & 0xff000000)) {
    722    k += 8;
    723    x <<= 8;
    724  }
    725  if (!(x & 0xf0000000)) {
    726    k += 4;
    727    x <<= 4;
    728  }
    729  if (!(x & 0xc0000000)) {
    730    k += 2;
    731    x <<= 2;
    732  }
    733  if (!(x & 0x80000000)) {
    734    k++;
    735    if (!(x & 0x40000000)) {
    736      return 32;
    737    }
    738  }
    739  return k;
    740 #endif /* PR_HAVE_BUILTIN_BITSCAN32 */
    741 }
    742 
    743 static int lo0bits
    744 #ifdef KR_headers
    745    (y) ULong* y;
    746 #else
    747    (ULong* y)
    748 #endif
    749 {
    750 #ifdef PR_HAVE_BUILTIN_BITSCAN32
    751  int k;
    752  ULong x = *y;
    753 
    754  if (x > 1) {
    755    *y = (x >> (k = pr_bitscan_ctz32(x)));
    756  } else {
    757    k = ((x ^ 1) << 5);
    758  }
    759 #else
    760  register int k;
    761  register ULong x = *y;
    762 
    763  if (x & 7) {
    764    if (x & 1) {
    765      return 0;
    766    }
    767    if (x & 2) {
    768      *y = x >> 1;
    769      return 1;
    770    }
    771    *y = x >> 2;
    772    return 2;
    773  }
    774  k = 0;
    775  if (!(x & 0xffff)) {
    776    k = 16;
    777    x >>= 16;
    778  }
    779  if (!(x & 0xff)) {
    780    k += 8;
    781    x >>= 8;
    782  }
    783  if (!(x & 0xf)) {
    784    k += 4;
    785    x >>= 4;
    786  }
    787  if (!(x & 0x3)) {
    788    k += 2;
    789    x >>= 2;
    790  }
    791  if (!(x & 1)) {
    792    k++;
    793    x >>= 1;
    794    if (!x) {
    795      return 32;
    796    }
    797  }
    798  *y = x;
    799 #endif /* PR_HAVE_BUILTIN_BITSCAN32 */
    800  return k;
    801 }
    802 
    803 static Bigint* i2b
    804 #ifdef KR_headers
    805    (i) int i;
    806 #else
    807    (int i)
    808 #endif
    809 {
    810  Bigint* b;
    811 
    812  b = Balloc(1);
    813  b->x[0] = i;
    814  b->wds = 1;
    815  return b;
    816 }
    817 
    818 static Bigint *mult
    819 #ifdef KR_headers
    820    (a, b) Bigint *a,
    821    *b;
    822 #else
    823    (Bigint* a, Bigint* b)
    824 #endif
    825 {
    826  Bigint* c;
    827  int k, wa, wb, wc;
    828  ULong *x, *xa, *xae, *xb, *xbe, *xc, *xc0;
    829  ULong y;
    830 #ifdef ULLong
    831  ULLong carry, z;
    832 #else
    833  ULong carry, z;
    834 #  ifdef Pack_32
    835  ULong z2;
    836 #  endif
    837 #endif
    838 
    839  if (a->wds < b->wds) {
    840    c = a;
    841    a = b;
    842    b = c;
    843  }
    844  k = a->k;
    845  wa = a->wds;
    846  wb = b->wds;
    847  wc = wa + wb;
    848  if (wc > a->maxwds) {
    849    k++;
    850  }
    851  c = Balloc(k);
    852  for (x = c->x, xa = x + wc; x < xa; x++) {
    853    *x = 0;
    854  }
    855  xa = a->x;
    856  xae = xa + wa;
    857  xb = b->x;
    858  xbe = xb + wb;
    859  xc0 = c->x;
    860 #ifdef ULLong
    861  for (; xb < xbe; xc0++) {
    862    if (y = *xb++) {
    863      x = xa;
    864      xc = xc0;
    865      carry = 0;
    866      do {
    867        z = *x++ * (ULLong)y + *xc + carry;
    868        carry = z >> 32;
    869        *xc++ = z & FFFFFFFF;
    870      } while (x < xae);
    871      *xc = carry;
    872    }
    873  }
    874 #else
    875 #  ifdef Pack_32
    876  for (; xb < xbe; xb++, xc0++) {
    877    if (y = *xb & 0xffff) {
    878      x = xa;
    879      xc = xc0;
    880      carry = 0;
    881      do {
    882        z = (*x & 0xffff) * y + (*xc & 0xffff) + carry;
    883        carry = z >> 16;
    884        z2 = (*x++ >> 16) * y + (*xc >> 16) + carry;
    885        carry = z2 >> 16;
    886        Storeinc(xc, z2, z);
    887      } while (x < xae);
    888      *xc = carry;
    889    }
    890    if (y = *xb >> 16) {
    891      x = xa;
    892      xc = xc0;
    893      carry = 0;
    894      z2 = *xc;
    895      do {
    896        z = (*x & 0xffff) * y + (*xc >> 16) + carry;
    897        carry = z >> 16;
    898        Storeinc(xc, z, z2);
    899        z2 = (*x++ >> 16) * y + (*xc & 0xffff) + carry;
    900        carry = z2 >> 16;
    901      } while (x < xae);
    902      *xc = z2;
    903    }
    904  }
    905 #  else
    906  for (; xb < xbe; xc0++) {
    907    if (y = *xb++) {
    908      x = xa;
    909      xc = xc0;
    910      carry = 0;
    911      do {
    912        z = *x++ * y + *xc + carry;
    913        carry = z >> 16;
    914        *xc++ = z & 0xffff;
    915      } while (x < xae);
    916      *xc = carry;
    917    }
    918  }
    919 #  endif
    920 #endif
    921  for (xc0 = c->x, xc = xc0 + wc; wc > 0 && !*--xc; --wc);
    922  c->wds = wc;
    923  return c;
    924 }
    925 
    926 static Bigint* p5s;
    927 
    928 static Bigint* pow5mult
    929 #ifdef KR_headers
    930    (b, k) Bigint* b;
    931 int k;
    932 #else
    933    (Bigint* b, int k)
    934 #endif
    935 {
    936  Bigint *b1, *p5, *p51;
    937  int i;
    938  static int p05[3] = {5, 25, 125};
    939 
    940  if (i = k & 3) {
    941    b = multadd(b, p05[i - 1], 0);
    942  }
    943 
    944  if (!(k >>= 2)) {
    945    return b;
    946  }
    947  if (!(p5 = p5s)) {
    948    /* first time */
    949 #ifdef MULTIPLE_THREADS
    950    ACQUIRE_DTOA_LOCK(1);
    951    if (!(p5 = p5s)) {
    952      p5 = p5s = i2b(625);
    953      p5->next = 0;
    954    }
    955    FREE_DTOA_LOCK(1);
    956 #else
    957    p5 = p5s = i2b(625);
    958    p5->next = 0;
    959 #endif
    960  }
    961  for (;;) {
    962    if (k & 1) {
    963      b1 = mult(b, p5);
    964      Bfree(b);
    965      b = b1;
    966    }
    967    if (!(k >>= 1)) {
    968      break;
    969    }
    970    if (!(p51 = p5->next)) {
    971 #ifdef MULTIPLE_THREADS
    972      ACQUIRE_DTOA_LOCK(1);
    973      if (!(p51 = p5->next)) {
    974        p51 = p5->next = mult(p5, p5);
    975        p51->next = 0;
    976      }
    977      FREE_DTOA_LOCK(1);
    978 #else
    979      p51 = p5->next = mult(p5, p5);
    980      p51->next = 0;
    981 #endif
    982    }
    983    p5 = p51;
    984  }
    985  return b;
    986 }
    987 
    988 static Bigint* lshift
    989 #ifdef KR_headers
    990    (b, k) Bigint* b;
    991 int k;
    992 #else
    993    (Bigint* b, int k)
    994 #endif
    995 {
    996  int i, k1, n, n1;
    997  Bigint* b1;
    998  ULong *x, *x1, *xe, z;
    999 
   1000 #ifdef Pack_32
   1001  n = k >> 5;
   1002 #else
   1003  n = k >> 4;
   1004 #endif
   1005  k1 = b->k;
   1006  n1 = n + b->wds + 1;
   1007  for (i = b->maxwds; n1 > i; i <<= 1) {
   1008    k1++;
   1009  }
   1010  b1 = Balloc(k1);
   1011  x1 = b1->x;
   1012  for (i = 0; i < n; i++) {
   1013    *x1++ = 0;
   1014  }
   1015  x = b->x;
   1016  xe = x + b->wds;
   1017 #ifdef Pack_32
   1018  if (k &= 0x1f) {
   1019    k1 = 32 - k;
   1020    z = 0;
   1021    do {
   1022      *x1++ = *x << k | z;
   1023      z = *x++ >> k1;
   1024    } while (x < xe);
   1025    if (*x1 = z) {
   1026      ++n1;
   1027    }
   1028  }
   1029 #else
   1030  if (k &= 0xf) {
   1031    k1 = 16 - k;
   1032    z = 0;
   1033    do {
   1034      *x1++ = *x << k & 0xffff | z;
   1035      z = *x++ >> k1;
   1036    } while (x < xe);
   1037    if (*x1 = z) {
   1038      ++n1;
   1039    }
   1040  }
   1041 #endif
   1042  else
   1043    do {
   1044      *x1++ = *x++;
   1045    } while (x < xe);
   1046  b1->wds = n1 - 1;
   1047  Bfree(b);
   1048  return b1;
   1049 }
   1050 
   1051 static int cmp
   1052 #ifdef KR_headers
   1053    (a, b) Bigint *a,
   1054    *b;
   1055 #else
   1056    (Bigint* a, Bigint* b)
   1057 #endif
   1058 {
   1059  ULong *xa, *xa0, *xb, *xb0;
   1060  int i, j;
   1061 
   1062  i = a->wds;
   1063  j = b->wds;
   1064 #ifdef DEBUG
   1065  if (i > 1 && !a->x[i - 1]) {
   1066    Bug("cmp called with a->x[a->wds-1] == 0");
   1067  }
   1068  if (j > 1 && !b->x[j - 1]) {
   1069    Bug("cmp called with b->x[b->wds-1] == 0");
   1070  }
   1071 #endif
   1072  if (i -= j) {
   1073    return i;
   1074  }
   1075  xa0 = a->x;
   1076  xa = xa0 + j;
   1077  xb0 = b->x;
   1078  xb = xb0 + j;
   1079  for (;;) {
   1080    if (*--xa != *--xb) {
   1081      return *xa < *xb ? -1 : 1;
   1082    }
   1083    if (xa <= xa0) {
   1084      break;
   1085    }
   1086  }
   1087  return 0;
   1088 }
   1089 
   1090 static Bigint *diff
   1091 #ifdef KR_headers
   1092    (a, b) Bigint *a,
   1093    *b;
   1094 #else
   1095    (Bigint* a, Bigint* b)
   1096 #endif
   1097 {
   1098  Bigint* c;
   1099  int i, wa, wb;
   1100  ULong *xa, *xae, *xb, *xbe, *xc;
   1101 #ifdef ULLong
   1102  ULLong borrow, y;
   1103 #else
   1104  ULong borrow, y;
   1105 #  ifdef Pack_32
   1106  ULong z;
   1107 #  endif
   1108 #endif
   1109 
   1110  i = cmp(a, b);
   1111  if (!i) {
   1112    c = Balloc(0);
   1113    c->wds = 1;
   1114    c->x[0] = 0;
   1115    return c;
   1116  }
   1117  if (i < 0) {
   1118    c = a;
   1119    a = b;
   1120    b = c;
   1121    i = 1;
   1122  } else {
   1123    i = 0;
   1124  }
   1125  c = Balloc(a->k);
   1126  c->sign = i;
   1127  wa = a->wds;
   1128  xa = a->x;
   1129  xae = xa + wa;
   1130  wb = b->wds;
   1131  xb = b->x;
   1132  xbe = xb + wb;
   1133  xc = c->x;
   1134  borrow = 0;
   1135 #ifdef ULLong
   1136  do {
   1137    y = (ULLong)*xa++ - *xb++ - borrow;
   1138    borrow = y >> 32 & (ULong)1;
   1139    *xc++ = y & FFFFFFFF;
   1140  } while (xb < xbe);
   1141  while (xa < xae) {
   1142    y = *xa++ - borrow;
   1143    borrow = y >> 32 & (ULong)1;
   1144    *xc++ = y & FFFFFFFF;
   1145  }
   1146 #else
   1147 #  ifdef Pack_32
   1148  do {
   1149    y = (*xa & 0xffff) - (*xb & 0xffff) - borrow;
   1150    borrow = (y & 0x10000) >> 16;
   1151    z = (*xa++ >> 16) - (*xb++ >> 16) - borrow;
   1152    borrow = (z & 0x10000) >> 16;
   1153    Storeinc(xc, z, y);
   1154  } while (xb < xbe);
   1155  while (xa < xae) {
   1156    y = (*xa & 0xffff) - borrow;
   1157    borrow = (y & 0x10000) >> 16;
   1158    z = (*xa++ >> 16) - borrow;
   1159    borrow = (z & 0x10000) >> 16;
   1160    Storeinc(xc, z, y);
   1161  }
   1162 #  else
   1163  do {
   1164    y = *xa++ - *xb++ - borrow;
   1165    borrow = (y & 0x10000) >> 16;
   1166    *xc++ = y & 0xffff;
   1167  } while (xb < xbe);
   1168  while (xa < xae) {
   1169    y = *xa++ - borrow;
   1170    borrow = (y & 0x10000) >> 16;
   1171    *xc++ = y & 0xffff;
   1172  }
   1173 #  endif
   1174 #endif
   1175  while (!*--xc) {
   1176    wa--;
   1177  }
   1178  c->wds = wa;
   1179  return c;
   1180 }
   1181 
   1182 static double ulp
   1183 #ifdef KR_headers
   1184    (dx) double dx;
   1185 #else
   1186    (double dx)
   1187 #endif
   1188 {
   1189  register Long L;
   1190  U x, a;
   1191 
   1192  dval(x) = dx;
   1193  L = (word0(x) & Exp_mask) - (P - 1) * Exp_msk1;
   1194 #ifndef Avoid_Underflow
   1195 #  ifndef Sudden_Underflow
   1196  if (L > 0) {
   1197 #  endif
   1198 #endif
   1199 #ifdef IBM
   1200    L |= Exp_msk1 >> 4;
   1201 #endif
   1202    word0(a) = L;
   1203    word1(a) = 0;
   1204 #ifndef Avoid_Underflow
   1205 #  ifndef Sudden_Underflow
   1206  } else {
   1207    L = -L >> Exp_shift;
   1208    if (L < Exp_shift) {
   1209      word0(a) = 0x80000 >> L;
   1210      word1(a) = 0;
   1211    } else {
   1212      word0(a) = 0;
   1213      L -= Exp_shift;
   1214      word1(a) = L >= 31 ? 1 : 1 << 31 - L;
   1215    }
   1216  }
   1217 #  endif
   1218 #endif
   1219  return dval(a);
   1220 }
   1221 
   1222 static double b2d
   1223 #ifdef KR_headers
   1224    (a, e) Bigint* a;
   1225 int* e;
   1226 #else
   1227    (Bigint* a, int* e)
   1228 #endif
   1229 {
   1230  ULong *xa, *xa0, w, y, z;
   1231  int k;
   1232  U d;
   1233 #ifdef VAX
   1234  ULong d0, d1;
   1235 #else
   1236 #  define d0 word0(d)
   1237 #  define d1 word1(d)
   1238 #endif
   1239 
   1240  xa0 = a->x;
   1241  xa = xa0 + a->wds;
   1242  y = *--xa;
   1243 #ifdef DEBUG
   1244  if (!y) {
   1245    Bug("zero y in b2d");
   1246  }
   1247 #endif
   1248  k = hi0bits(y);
   1249  *e = 32 - k;
   1250 #ifdef Pack_32
   1251  if (k < Ebits) {
   1252    d0 = Exp_1 | y >> Ebits - k;
   1253    w = xa > xa0 ? *--xa : 0;
   1254    d1 = y << (32 - Ebits) + k | w >> Ebits - k;
   1255    goto ret_d;
   1256  }
   1257  z = xa > xa0 ? *--xa : 0;
   1258  if (k -= Ebits) {
   1259    d0 = Exp_1 | y << k | z >> 32 - k;
   1260    y = xa > xa0 ? *--xa : 0;
   1261    d1 = z << k | y >> 32 - k;
   1262  } else {
   1263    d0 = Exp_1 | y;
   1264    d1 = z;
   1265  }
   1266 #else
   1267  if (k < Ebits + 16) {
   1268    z = xa > xa0 ? *--xa : 0;
   1269    d0 = Exp_1 | y << k - Ebits | z >> Ebits + 16 - k;
   1270    w = xa > xa0 ? *--xa : 0;
   1271    y = xa > xa0 ? *--xa : 0;
   1272    d1 = z << k + 16 - Ebits | w << k - Ebits | y >> 16 + Ebits - k;
   1273    goto ret_d;
   1274  }
   1275  z = xa > xa0 ? *--xa : 0;
   1276  w = xa > xa0 ? *--xa : 0;
   1277  k -= Ebits + 16;
   1278  d0 = Exp_1 | y << k + 16 | z << k | w >> 16 - k;
   1279  y = xa > xa0 ? *--xa : 0;
   1280  d1 = w << k + 16 | y << k;
   1281 #endif
   1282 ret_d:
   1283 #ifdef VAX
   1284  word0(d) = d0 >> 16 | d0 << 16;
   1285  word1(d) = d1 >> 16 | d1 << 16;
   1286 #else
   1287 #  undef d0
   1288 #  undef d1
   1289 #endif
   1290  return dval(d);
   1291 }
   1292 
   1293 static Bigint* d2b
   1294 #ifdef KR_headers
   1295    (dd, e, bits) double dd;
   1296 int *e, *bits;
   1297 #else
   1298    (double dd, int* e, int* bits)
   1299 #endif
   1300 {
   1301  U d;
   1302  Bigint* b;
   1303  int de, k;
   1304  ULong *x, y, z;
   1305 #ifndef Sudden_Underflow
   1306  int i;
   1307 #endif
   1308 #ifdef VAX
   1309  ULong d0, d1;
   1310 #endif
   1311 
   1312  dval(d) = dd;
   1313 #ifdef VAX
   1314  d0 = word0(d) >> 16 | word0(d) << 16;
   1315  d1 = word1(d) >> 16 | word1(d) << 16;
   1316 #else
   1317 #  define d0 word0(d)
   1318 #  define d1 word1(d)
   1319 #endif
   1320 
   1321 #ifdef Pack_32
   1322  b = Balloc(1);
   1323 #else
   1324  b = Balloc(2);
   1325 #endif
   1326  x = b->x;
   1327 
   1328  z = d0 & Frac_mask;
   1329  d0 &= 0x7fffffff; /* clear sign bit, which we ignore */
   1330 #ifdef Sudden_Underflow
   1331  de = (int)(d0 >> Exp_shift);
   1332 #  ifndef IBM
   1333  z |= Exp_msk11;
   1334 #  endif
   1335 #else
   1336  if (de = (int)(d0 >> Exp_shift)) {
   1337    z |= Exp_msk1;
   1338  }
   1339 #endif
   1340 #ifdef Pack_32
   1341  if (y = d1) {
   1342    if (k = lo0bits(&y)) {
   1343      x[0] = y | z << 32 - k;
   1344      z >>= k;
   1345    } else {
   1346      x[0] = y;
   1347    }
   1348 #  ifndef Sudden_Underflow
   1349    i =
   1350 #  endif
   1351        b->wds = (x[1] = z) ? 2 : 1;
   1352  } else {
   1353    k = lo0bits(&z);
   1354    x[0] = z;
   1355 #  ifndef Sudden_Underflow
   1356    i =
   1357 #  endif
   1358        b->wds = 1;
   1359    k += 32;
   1360  }
   1361 #else
   1362  if (y = d1) {
   1363    if (k = lo0bits(&y))
   1364      if (k >= 16) {
   1365        x[0] = y | z << 32 - k & 0xffff;
   1366        x[1] = z >> k - 16 & 0xffff;
   1367        x[2] = z >> k;
   1368        i = 2;
   1369      } else {
   1370        x[0] = y & 0xffff;
   1371        x[1] = y >> 16 | z << 16 - k & 0xffff;
   1372        x[2] = z >> k & 0xffff;
   1373        x[3] = z >> k + 16;
   1374        i = 3;
   1375      }
   1376    else {
   1377      x[0] = y & 0xffff;
   1378      x[1] = y >> 16;
   1379      x[2] = z & 0xffff;
   1380      x[3] = z >> 16;
   1381      i = 3;
   1382    }
   1383  } else {
   1384 #  ifdef DEBUG
   1385    if (!z) {
   1386      Bug("Zero passed to d2b");
   1387    }
   1388 #  endif
   1389    k = lo0bits(&z);
   1390    if (k >= 16) {
   1391      x[0] = z;
   1392      i = 0;
   1393    } else {
   1394      x[0] = z & 0xffff;
   1395      x[1] = z >> 16;
   1396      i = 1;
   1397    }
   1398    k += 32;
   1399  }
   1400  while (!x[i]) {
   1401    --i;
   1402  }
   1403  b->wds = i + 1;
   1404 #endif
   1405 #ifndef Sudden_Underflow
   1406  if (de) {
   1407 #endif
   1408 #ifdef IBM
   1409    *e = (de - Bias - (P - 1) << 2) + k;
   1410    *bits = 4 * P + 8 - k - hi0bits(word0(d) & Frac_mask);
   1411 #else
   1412  *e = de - Bias - (P - 1) + k;
   1413  *bits = P - k;
   1414 #endif
   1415 #ifndef Sudden_Underflow
   1416  } else {
   1417    *e = de - Bias - (P - 1) + 1 + k;
   1418 #  ifdef Pack_32
   1419    *bits = 32 * i - hi0bits(x[i - 1]);
   1420 #  else
   1421    *bits = (i + 2) * 16 - hi0bits(x[i]);
   1422 #  endif
   1423  }
   1424 #endif
   1425  return b;
   1426 }
   1427 #undef d0
   1428 #undef d1
   1429 
   1430 static double ratio
   1431 #ifdef KR_headers
   1432    (a, b) Bigint *a,
   1433    *b;
   1434 #else
   1435    (Bigint* a, Bigint* b)
   1436 #endif
   1437 {
   1438  U da, db;
   1439  int k, ka, kb;
   1440 
   1441  dval(da) = b2d(a, &ka);
   1442  dval(db) = b2d(b, &kb);
   1443 #ifdef Pack_32
   1444  k = ka - kb + 32 * (a->wds - b->wds);
   1445 #else
   1446  k = ka - kb + 16 * (a->wds - b->wds);
   1447 #endif
   1448 #ifdef IBM
   1449  if (k > 0) {
   1450    word0(da) += (k >> 2) * Exp_msk1;
   1451    if (k &= 3) {
   1452      dval(da) *= 1 << k;
   1453    }
   1454  } else {
   1455    k = -k;
   1456    word0(db) += (k >> 2) * Exp_msk1;
   1457    if (k &= 3) {
   1458      dval(db) *= 1 << k;
   1459    }
   1460  }
   1461 #else
   1462  if (k > 0) {
   1463    word0(da) += k * Exp_msk1;
   1464  } else {
   1465    k = -k;
   1466    word0(db) += k * Exp_msk1;
   1467  }
   1468 #endif
   1469  return dval(da) / dval(db);
   1470 }
   1471 
   1472 static CONST double tens[] = {1e0,
   1473                              1e1,
   1474                              1e2,
   1475                              1e3,
   1476                              1e4,
   1477                              1e5,
   1478                              1e6,
   1479                              1e7,
   1480                              1e8,
   1481                              1e9,
   1482                              1e10,
   1483                              1e11,
   1484                              1e12,
   1485                              1e13,
   1486                              1e14,
   1487                              1e15,
   1488                              1e16,
   1489                              1e17,
   1490                              1e18,
   1491                              1e19,
   1492                              1e20,
   1493                              1e21,
   1494                              1e22
   1495 #ifdef VAX
   1496                              ,
   1497                              1e23,
   1498                              1e24
   1499 #endif
   1500 };
   1501 
   1502 static CONST double
   1503 #ifdef IEEE_Arith
   1504    bigtens[] = {1e16, 1e32, 1e64, 1e128, 1e256};
   1505 static CONST double tinytens[] = {1e-16, 1e-32, 1e-64, 1e-128,
   1506 #  ifdef Avoid_Underflow
   1507                                  9007199254740992. * 9007199254740992.e-256
   1508 /* = 2^106 * 1e-53 */
   1509 #  else
   1510                                  1e-256
   1511 #  endif
   1512 };
   1513 /* The factor of 2^53 in tinytens[4] helps us avoid setting the underflow */
   1514 /* flag unnecessarily.  It leads to a song and dance at the end of strtod. */
   1515 #  define Scale_Bit 0x10
   1516 #  define n_bigtens 5
   1517 #else
   1518 #  ifdef IBM
   1519    bigtens[] = {1e16, 1e32, 1e64};
   1520 static CONST double tinytens[] = {1e-16, 1e-32, 1e-64};
   1521 #    define n_bigtens 3
   1522 #  else
   1523    bigtens[] = {1e16, 1e32};
   1524 static CONST double tinytens[] = {1e-16, 1e-32};
   1525 #    define n_bigtens 2
   1526 #  endif
   1527 #endif
   1528 
   1529 #ifndef IEEE_Arith
   1530 #  undef INFNAN_CHECK
   1531 #endif
   1532 
   1533 #ifdef INFNAN_CHECK
   1534 
   1535 #  ifndef NAN_WORD0
   1536 #    define NAN_WORD0 0x7ff80000
   1537 #  endif
   1538 
   1539 #  ifndef NAN_WORD1
   1540 #    define NAN_WORD1 0
   1541 #  endif
   1542 
   1543 static int match
   1544 #  ifdef KR_headers
   1545    (sp, t) char **sp,
   1546    *t;
   1547 #  else
   1548    (CONST char** sp, char* t)
   1549 #  endif
   1550 {
   1551  int c, d;
   1552  CONST char* s = *sp;
   1553 
   1554  while (d = *t++) {
   1555    if ((c = *++s) >= 'A' && c <= 'Z') {
   1556      c += 'a' - 'A';
   1557    }
   1558    if (c != d) {
   1559      return 0;
   1560    }
   1561  }
   1562  *sp = s + 1;
   1563  return 1;
   1564 }
   1565 
   1566 #  ifndef No_Hex_NaN
   1567 static void hexnan
   1568 #    ifdef KR_headers
   1569    (rvp, sp) double* rvp;
   1570 CONST char** sp;
   1571 #    else
   1572    (double* rvp, CONST char** sp)
   1573 #    endif
   1574 {
   1575  ULong c, x[2];
   1576  CONST char* s;
   1577  int havedig, udx0, xshift;
   1578 
   1579  x[0] = x[1] = 0;
   1580  havedig = xshift = 0;
   1581  udx0 = 1;
   1582  s = *sp;
   1583  while (c = *(CONST unsigned char*)++s) {
   1584    if (c >= '0' && c <= '9') {
   1585      c -= '0';
   1586    } else if (c >= 'a' && c <= 'f') {
   1587      c += 10 - 'a';
   1588    } else if (c >= 'A' && c <= 'F') {
   1589      c += 10 - 'A';
   1590    } else if (c <= ' ') {
   1591      if (udx0 && havedig) {
   1592        udx0 = 0;
   1593        xshift = 1;
   1594      }
   1595      continue;
   1596    } else if (/*(*/ c == ')' && havedig) {
   1597      *sp = s + 1;
   1598      break;
   1599    } else {
   1600      return; /* invalid form: don't change *sp */
   1601    }
   1602    havedig = 1;
   1603    if (xshift) {
   1604      xshift = 0;
   1605      x[0] = x[1];
   1606      x[1] = 0;
   1607    }
   1608    if (udx0) {
   1609      x[0] = (x[0] << 4) | (x[1] >> 28);
   1610    }
   1611    x[1] = (x[1] << 4) | c;
   1612  }
   1613  if ((x[0] &= 0xfffff) || x[1]) {
   1614    word0(*rvp) = Exp_mask | x[0];
   1615    word1(*rvp) = x[1];
   1616  }
   1617 }
   1618 #  endif /*No_Hex_NaN*/
   1619 #endif   /* INFNAN_CHECK */
   1620 
   1621 PR_IMPLEMENT(double)
   1622 PR_strtod
   1623 #ifdef KR_headers
   1624    (s00, se) CONST char* s00;
   1625 char** se;
   1626 #else
   1627    (CONST char* s00, char** se)
   1628 #endif
   1629 {
   1630 #ifdef Avoid_Underflow
   1631  int scale;
   1632 #endif
   1633  int bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, dsign, e, e1, esign, i, j, k, nd,
   1634      nd0, nf, nz, nz0, sign;
   1635  CONST char *s, *s0, *s1;
   1636  double aadj, aadj1, adj;
   1637  U aadj2, rv, rv0;
   1638  Long L;
   1639  ULong y, z;
   1640  Bigint *bb, *bb1, *bd, *bd0, *bs, *delta;
   1641 #ifdef SET_INEXACT
   1642  int inexact, oldinexact;
   1643 #endif
   1644 #ifdef Honor_FLT_ROUNDS
   1645  int rounding;
   1646 #endif
   1647 #ifdef USE_LOCALE
   1648  CONST char* s2;
   1649 #endif
   1650 
   1651  if (!_pr_initialized) {
   1652    _PR_ImplicitInitialization();
   1653  }
   1654 
   1655  sign = nz0 = nz = 0;
   1656  dval(rv) = 0.;
   1657  for (s = s00;; s++) switch (*s) {
   1658      case '-':
   1659        sign = 1;
   1660      /* no break */
   1661      case '+':
   1662        if (*++s) {
   1663          goto break2;
   1664        }
   1665      /* no break */
   1666      case 0:
   1667        goto ret0;
   1668      case '\t':
   1669      case '\n':
   1670      case '\v':
   1671      case '\f':
   1672      case '\r':
   1673      case ' ':
   1674        continue;
   1675      default:
   1676        goto break2;
   1677    }
   1678 break2:
   1679  if (*s == '0') {
   1680    nz0 = 1;
   1681    while (*++s == '0');
   1682    if (!*s) {
   1683      goto ret;
   1684    }
   1685  }
   1686  s0 = s;
   1687  y = z = 0;
   1688  for (nd = nf = 0; (c = *s) >= '0' && c <= '9'; nd++, s++)
   1689    if (nd < 9) {
   1690      y = 10 * y + c - '0';
   1691    } else if (nd < 16) {
   1692      z = 10 * z + c - '0';
   1693    }
   1694  nd0 = nd;
   1695 #ifdef USE_LOCALE
   1696  s1 = localeconv()->decimal_point;
   1697  if (c == *s1) {
   1698    c = '.';
   1699    if (*++s1) {
   1700      s2 = s;
   1701      for (;;) {
   1702        if (*++s2 != *s1) {
   1703          c = 0;
   1704          break;
   1705        }
   1706        if (!*++s1) {
   1707          s = s2;
   1708          break;
   1709        }
   1710      }
   1711    }
   1712  }
   1713 #endif
   1714  if (c == '.') {
   1715    c = *++s;
   1716    if (!nd) {
   1717      for (; c == '0'; c = *++s) {
   1718        nz++;
   1719      }
   1720      if (c > '0' && c <= '9') {
   1721        s0 = s;
   1722        nf += nz;
   1723        nz = 0;
   1724        goto have_dig;
   1725      }
   1726      goto dig_done;
   1727    }
   1728    for (; c >= '0' && c <= '9'; c = *++s) {
   1729    have_dig:
   1730      nz++;
   1731      if (c -= '0') {
   1732        nf += nz;
   1733        for (i = 1; i < nz; i++)
   1734          if (nd++ < 9) {
   1735            y *= 10;
   1736          } else if (nd <= DBL_DIG + 1) {
   1737            z *= 10;
   1738          }
   1739        if (nd++ < 9) {
   1740          y = 10 * y + c;
   1741        } else if (nd <= DBL_DIG + 1) {
   1742          z = 10 * z + c;
   1743        }
   1744        nz = 0;
   1745      }
   1746    }
   1747  }
   1748 dig_done:
   1749  if (nd > 64 * 1024) {
   1750    goto ret0;
   1751  }
   1752  e = 0;
   1753  if (c == 'e' || c == 'E') {
   1754    if (!nd && !nz && !nz0) {
   1755      goto ret0;
   1756    }
   1757    s00 = s;
   1758    esign = 0;
   1759    switch (c = *++s) {
   1760      case '-':
   1761        esign = 1;
   1762      case '+':
   1763        c = *++s;
   1764    }
   1765    if (c >= '0' && c <= '9') {
   1766      while (c == '0') {
   1767        c = *++s;
   1768      }
   1769      if (c > '0' && c <= '9') {
   1770        L = c - '0';
   1771        s1 = s;
   1772        while ((c = *++s) >= '0' && c <= '9') {
   1773          L = 10 * L + c - '0';
   1774        }
   1775        if (s - s1 > 8 || L > 19999)
   1776        /* Avoid confusion from exponents
   1777         * so large that e might overflow.
   1778         */
   1779        {
   1780          e = 19999; /* safe for 16 bit ints */
   1781        } else {
   1782          e = (int)L;
   1783        }
   1784        if (esign) {
   1785          e = -e;
   1786        }
   1787      } else {
   1788        e = 0;
   1789      }
   1790    } else {
   1791      s = s00;
   1792    }
   1793  }
   1794  if (!nd) {
   1795    if (!nz && !nz0) {
   1796 #ifdef INFNAN_CHECK
   1797      /* Check for Nan and Infinity */
   1798      switch (c) {
   1799        case 'i':
   1800        case 'I':
   1801          if (match(&s, "nf")) {
   1802            --s;
   1803            if (!match(&s, "inity")) {
   1804              ++s;
   1805            }
   1806            word0(rv) = 0x7ff00000;
   1807            word1(rv) = 0;
   1808            goto ret;
   1809          }
   1810          break;
   1811        case 'n':
   1812        case 'N':
   1813          if (match(&s, "an")) {
   1814            word0(rv) = NAN_WORD0;
   1815            word1(rv) = NAN_WORD1;
   1816 #  ifndef No_Hex_NaN
   1817            if (*s == '(') { /*)*/
   1818              hexnan(&rv, &s);
   1819            }
   1820 #  endif
   1821            goto ret;
   1822          }
   1823      }
   1824 #endif /* INFNAN_CHECK */
   1825    ret0:
   1826      s = s00;
   1827      sign = 0;
   1828    }
   1829    goto ret;
   1830  }
   1831  e1 = e -= nf;
   1832 
   1833  /* Now we have nd0 digits, starting at s0, followed by a
   1834   * decimal point, followed by nd-nd0 digits.  The number we're
   1835   * after is the integer represented by those digits times
   1836   * 10**e */
   1837 
   1838  if (!nd0) {
   1839    nd0 = nd;
   1840  }
   1841  k = nd < DBL_DIG + 1 ? nd : DBL_DIG + 1;
   1842  dval(rv) = y;
   1843  if (k > 9) {
   1844 #ifdef SET_INEXACT
   1845    if (k > DBL_DIG) {
   1846      oldinexact = get_inexact();
   1847    }
   1848 #endif
   1849    dval(rv) = tens[k - 9] * dval(rv) + z;
   1850  }
   1851  bd0 = 0;
   1852  if (nd <= DBL_DIG
   1853 #ifndef RND_PRODQUOT
   1854 #  ifndef Honor_FLT_ROUNDS
   1855      && Flt_Rounds == 1
   1856 #  endif
   1857 #endif
   1858  ) {
   1859    if (!e) {
   1860      goto ret;
   1861    }
   1862    if (e > 0) {
   1863      if (e <= Ten_pmax) {
   1864 #ifdef VAX
   1865        goto vax_ovfl_check;
   1866 #else
   1867 #  ifdef Honor_FLT_ROUNDS
   1868        /* round correctly FLT_ROUNDS = 2 or 3 */
   1869        if (sign) {
   1870          rv = -rv;
   1871          sign = 0;
   1872        }
   1873 #  endif
   1874        /* rv = */ rounded_product(dval(rv), tens[e]);
   1875        goto ret;
   1876 #endif
   1877      }
   1878      i = DBL_DIG - nd;
   1879      if (e <= Ten_pmax + i) {
   1880        /* A fancier test would sometimes let us do
   1881         * this for larger i values.
   1882         */
   1883 #ifdef Honor_FLT_ROUNDS
   1884        /* round correctly FLT_ROUNDS = 2 or 3 */
   1885        if (sign) {
   1886          rv = -rv;
   1887          sign = 0;
   1888        }
   1889 #endif
   1890        e -= i;
   1891        dval(rv) *= tens[i];
   1892 #ifdef VAX
   1893        /* VAX exponent range is so narrow we must
   1894         * worry about overflow here...
   1895         */
   1896      vax_ovfl_check:
   1897        word0(rv) -= P * Exp_msk1;
   1898        /* rv = */ rounded_product(dval(rv), tens[e]);
   1899        if ((word0(rv) & Exp_mask) > Exp_msk1 * (DBL_MAX_EXP + Bias - 1 - P)) {
   1900          goto ovfl;
   1901        }
   1902        word0(rv) += P * Exp_msk1;
   1903 #else
   1904        /* rv = */ rounded_product(dval(rv), tens[e]);
   1905 #endif
   1906        goto ret;
   1907      }
   1908    }
   1909 #ifndef Inaccurate_Divide
   1910    else if (e >= -Ten_pmax) {
   1911 #  ifdef Honor_FLT_ROUNDS
   1912      /* round correctly FLT_ROUNDS = 2 or 3 */
   1913      if (sign) {
   1914        rv = -rv;
   1915        sign = 0;
   1916      }
   1917 #  endif
   1918      /* rv = */ rounded_quotient(dval(rv), tens[-e]);
   1919      goto ret;
   1920    }
   1921 #endif
   1922  }
   1923  e1 += nd - k;
   1924 
   1925 #ifdef IEEE_Arith
   1926 #  ifdef SET_INEXACT
   1927  inexact = 1;
   1928  if (k <= DBL_DIG) {
   1929    oldinexact = get_inexact();
   1930  }
   1931 #  endif
   1932 #  ifdef Avoid_Underflow
   1933  scale = 0;
   1934 #  endif
   1935 #  ifdef Honor_FLT_ROUNDS
   1936  if ((rounding = Flt_Rounds) >= 2) {
   1937    if (sign) {
   1938      rounding = rounding == 2 ? 0 : 2;
   1939    } else if (rounding != 2) {
   1940      rounding = 0;
   1941    }
   1942  }
   1943 #  endif
   1944 #endif /*IEEE_Arith*/
   1945 
   1946  /* Get starting approximation = rv * 10**e1 */
   1947 
   1948  if (e1 > 0) {
   1949    if (i = e1 & 15) {
   1950      dval(rv) *= tens[i];
   1951    }
   1952    if (e1 &= ~15) {
   1953      if (e1 > DBL_MAX_10_EXP) {
   1954      ovfl:
   1955 #ifndef NO_ERRNO
   1956        PR_SetError(PR_RANGE_ERROR, 0);
   1957 #endif
   1958        /* Can't trust HUGE_VAL */
   1959 #ifdef IEEE_Arith
   1960 #  ifdef Honor_FLT_ROUNDS
   1961        switch (rounding) {
   1962          case 0: /* toward 0 */
   1963          case 3: /* toward -infinity */
   1964            word0(rv) = Big0;
   1965            word1(rv) = Big1;
   1966            break;
   1967          default:
   1968            word0(rv) = Exp_mask;
   1969            word1(rv) = 0;
   1970        }
   1971 #  else  /*Honor_FLT_ROUNDS*/
   1972        word0(rv) = Exp_mask;
   1973        word1(rv) = 0;
   1974 #  endif /*Honor_FLT_ROUNDS*/
   1975 #  ifdef SET_INEXACT
   1976        /* set overflow bit */
   1977        dval(rv0) = 1e300;
   1978        dval(rv0) *= dval(rv0);
   1979 #  endif
   1980 #else  /*IEEE_Arith*/
   1981        word0(rv) = Big0;
   1982        word1(rv) = Big1;
   1983 #endif /*IEEE_Arith*/
   1984        if (bd0) {
   1985          goto retfree;
   1986        }
   1987        goto ret;
   1988      }
   1989      e1 >>= 4;
   1990      for (j = 0; e1 > 1; j++, e1 >>= 1)
   1991        if (e1 & 1) {
   1992          dval(rv) *= bigtens[j];
   1993        }
   1994      /* The last multiplication could overflow. */
   1995      word0(rv) -= P * Exp_msk1;
   1996      dval(rv) *= bigtens[j];
   1997      if ((z = word0(rv) & Exp_mask) > Exp_msk1 * (DBL_MAX_EXP + Bias - P)) {
   1998        goto ovfl;
   1999      }
   2000      if (z > Exp_msk1 * (DBL_MAX_EXP + Bias - 1 - P)) {
   2001        /* set to largest number */
   2002        /* (Can't trust DBL_MAX) */
   2003        word0(rv) = Big0;
   2004        word1(rv) = Big1;
   2005      } else {
   2006        word0(rv) += P * Exp_msk1;
   2007      }
   2008    }
   2009  } else if (e1 < 0) {
   2010    e1 = -e1;
   2011    if (i = e1 & 15) {
   2012      dval(rv) /= tens[i];
   2013    }
   2014    if (e1 >>= 4) {
   2015      if (e1 >= 1 << n_bigtens) {
   2016        goto undfl;
   2017      }
   2018 #ifdef Avoid_Underflow
   2019      if (e1 & Scale_Bit) {
   2020        scale = 2 * P;
   2021      }
   2022      for (j = 0; e1 > 0; j++, e1 >>= 1)
   2023        if (e1 & 1) {
   2024          dval(rv) *= tinytens[j];
   2025        }
   2026      if (scale &&
   2027          (j = 2 * P + 1 - ((word0(rv) & Exp_mask) >> Exp_shift)) > 0) {
   2028        /* scaled rv is denormal; zap j low bits */
   2029        if (j >= 32) {
   2030          word1(rv) = 0;
   2031          if (j >= 53) {
   2032            word0(rv) = (P + 2) * Exp_msk1;
   2033          } else {
   2034            word0(rv) &= 0xffffffff << j - 32;
   2035          }
   2036        } else {
   2037          word1(rv) &= 0xffffffff << j;
   2038        }
   2039      }
   2040 #else
   2041      for (j = 0; e1 > 1; j++, e1 >>= 1)
   2042        if (e1 & 1) {
   2043          dval(rv) *= tinytens[j];
   2044        }
   2045      /* The last multiplication could underflow. */
   2046      dval(rv0) = dval(rv);
   2047      dval(rv) *= tinytens[j];
   2048      if (!dval(rv)) {
   2049        dval(rv) = 2. * dval(rv0);
   2050        dval(rv) *= tinytens[j];
   2051 #endif
   2052      if (!dval(rv)) {
   2053      undfl:
   2054        dval(rv) = 0.;
   2055 #ifndef NO_ERRNO
   2056        PR_SetError(PR_RANGE_ERROR, 0);
   2057 #endif
   2058        if (bd0) {
   2059          goto retfree;
   2060        }
   2061        goto ret;
   2062      }
   2063 #ifndef Avoid_Underflow
   2064      word0(rv) = Tiny0;
   2065      word1(rv) = Tiny1;
   2066      /* The refinement below will clean
   2067       * this approximation up.
   2068       */
   2069    }
   2070 #endif
   2071  }
   2072 }
   2073 
   2074 /* Now the hard part -- adjusting rv to the correct value.*/
   2075 
   2076 /* Put digits into bd: true value = bd * 10^e */
   2077 
   2078 bd0 = s2b(s0, nd0, nd, y);
   2079 
   2080 for (;;) {
   2081  bd = Balloc(bd0->k);
   2082  Bcopy(bd, bd0);
   2083  bb = d2b(dval(rv), &bbe, &bbbits); /* rv = bb * 2^bbe */
   2084  bs = i2b(1);
   2085 
   2086  if (e >= 0) {
   2087    bb2 = bb5 = 0;
   2088    bd2 = bd5 = e;
   2089  } else {
   2090    bb2 = bb5 = -e;
   2091    bd2 = bd5 = 0;
   2092  }
   2093  if (bbe >= 0) {
   2094    bb2 += bbe;
   2095  } else {
   2096    bd2 -= bbe;
   2097  }
   2098  bs2 = bb2;
   2099 #ifdef Honor_FLT_ROUNDS
   2100  if (rounding != 1) {
   2101    bs2++;
   2102  }
   2103 #endif
   2104 #ifdef Avoid_Underflow
   2105  j = bbe - scale;
   2106  i = j + bbbits - 1; /* logb(rv) */
   2107  if (i < Emin) {     /* denormal */
   2108    j += P - Emin;
   2109  } else {
   2110    j = P + 1 - bbbits;
   2111  }
   2112 #else /*Avoid_Underflow*/
   2113 #  ifdef Sudden_Underflow
   2114 #    ifdef IBM
   2115      j = 1 + 4 * P - 3 - bbbits + ((bbe + bbbits - 1) & 3);
   2116 #    else
   2117      j = P + 1 - bbbits;
   2118 #    endif
   2119 #  else  /*Sudden_Underflow*/
   2120      j = bbe;
   2121      i = j + bbbits - 1; /* logb(rv) */
   2122      if (i < Emin) {     /* denormal */
   2123        j += P - Emin;
   2124      } else {
   2125        j = P + 1 - bbbits;
   2126      }
   2127 #  endif /*Sudden_Underflow*/
   2128 #endif   /*Avoid_Underflow*/
   2129  bb2 += j;
   2130  bd2 += j;
   2131 #ifdef Avoid_Underflow
   2132  bd2 += scale;
   2133 #endif
   2134  i = bb2 < bd2 ? bb2 : bd2;
   2135  if (i > bs2) {
   2136    i = bs2;
   2137  }
   2138  if (i > 0) {
   2139    bb2 -= i;
   2140    bd2 -= i;
   2141    bs2 -= i;
   2142  }
   2143  if (bb5 > 0) {
   2144    bs = pow5mult(bs, bb5);
   2145    bb1 = mult(bs, bb);
   2146    Bfree(bb);
   2147    bb = bb1;
   2148  }
   2149  if (bb2 > 0) {
   2150    bb = lshift(bb, bb2);
   2151  }
   2152  if (bd5 > 0) {
   2153    bd = pow5mult(bd, bd5);
   2154  }
   2155  if (bd2 > 0) {
   2156    bd = lshift(bd, bd2);
   2157  }
   2158  if (bs2 > 0) {
   2159    bs = lshift(bs, bs2);
   2160  }
   2161  delta = diff(bb, bd);
   2162  dsign = delta->sign;
   2163  delta->sign = 0;
   2164  i = cmp(delta, bs);
   2165 #ifdef Honor_FLT_ROUNDS
   2166  if (rounding != 1) {
   2167    if (i < 0) {
   2168      /* Error is less than an ulp */
   2169      if (!delta->x[0] && delta->wds <= 1) {
   2170        /* exact */
   2171 #  ifdef SET_INEXACT
   2172        inexact = 0;
   2173 #  endif
   2174        break;
   2175      }
   2176      if (rounding) {
   2177        if (dsign) {
   2178          adj = 1.;
   2179          goto apply_adj;
   2180        }
   2181      } else if (!dsign) {
   2182        adj = -1.;
   2183        if (!word1(rv) && !(word0(rv) & Frac_mask)) {
   2184          y = word0(rv) & Exp_mask;
   2185 #  ifdef Avoid_Underflow
   2186          if (!scale || y > 2 * P * Exp_msk1)
   2187 #  else
   2188          if (y)
   2189 #  endif
   2190          {
   2191            delta = lshift(delta, Log2P);
   2192            if (cmp(delta, bs) <= 0) {
   2193              adj = -0.5;
   2194            }
   2195          }
   2196        }
   2197      apply_adj:
   2198 #  ifdef Avoid_Underflow
   2199        if (scale && (y = word0(rv) & Exp_mask) <= 2 * P * Exp_msk1) {
   2200          word0(adj) += (2 * P + 1) * Exp_msk1 - y;
   2201        }
   2202 #  else
   2203 #    ifdef Sudden_Underflow
   2204        if ((word0(rv) & Exp_mask) <= P * Exp_msk1) {
   2205          word0(rv) += P * Exp_msk1;
   2206          dval(rv) += adj * ulp(dval(rv));
   2207          word0(rv) -= P * Exp_msk1;
   2208        } else
   2209 #    endif /*Sudden_Underflow*/
   2210 #  endif   /*Avoid_Underflow*/
   2211        dval(rv) += adj * ulp(dval(rv));
   2212      }
   2213      break;
   2214    }
   2215    adj = ratio(delta, bs);
   2216    if (adj < 1.) {
   2217      adj = 1.;
   2218    }
   2219    if (adj <= 0x7ffffffe) {
   2220      /* adj = rounding ? ceil(adj) : floor(adj); */
   2221      y = adj;
   2222      if (y != adj) {
   2223        if (!((rounding >> 1) ^ dsign)) {
   2224          y++;
   2225        }
   2226        adj = y;
   2227      }
   2228    }
   2229 #  ifdef Avoid_Underflow
   2230    if (scale && (y = word0(rv) & Exp_mask) <= 2 * P * Exp_msk1) {
   2231      word0(adj) += (2 * P + 1) * Exp_msk1 - y;
   2232    }
   2233 #  else
   2234 #    ifdef Sudden_Underflow
   2235    if ((word0(rv) & Exp_mask) <= P * Exp_msk1) {
   2236      word0(rv) += P * Exp_msk1;
   2237      adj *= ulp(dval(rv));
   2238      if (dsign) {
   2239        dval(rv) += adj;
   2240      } else {
   2241        dval(rv) -= adj;
   2242      }
   2243      word0(rv) -= P * Exp_msk1;
   2244      goto cont;
   2245    }
   2246 #    endif /*Sudden_Underflow*/
   2247 #  endif   /*Avoid_Underflow*/
   2248    adj *= ulp(dval(rv));
   2249    if (dsign) {
   2250      dval(rv) += adj;
   2251    } else {
   2252      dval(rv) -= adj;
   2253    }
   2254    goto cont;
   2255  }
   2256 #endif /*Honor_FLT_ROUNDS*/
   2257 
   2258  if (i < 0) {
   2259    /* Error is less than half an ulp -- check for
   2260     * special case of mantissa a power of two.
   2261     */
   2262    if (dsign || word1(rv) || word0(rv) & Bndry_mask
   2263 #ifdef IEEE_Arith
   2264 #  ifdef Avoid_Underflow
   2265        || (word0(rv) & Exp_mask) <= (2 * P + 1) * Exp_msk1
   2266 #  else
   2267        || (word0(rv) & Exp_mask) <= Exp_msk1
   2268 #  endif
   2269 #endif
   2270    ) {
   2271 #ifdef SET_INEXACT
   2272      if (!delta->x[0] && delta->wds <= 1) {
   2273        inexact = 0;
   2274      }
   2275 #endif
   2276      break;
   2277    }
   2278    if (!delta->x[0] && delta->wds <= 1) {
   2279      /* exact result */
   2280 #ifdef SET_INEXACT
   2281      inexact = 0;
   2282 #endif
   2283      break;
   2284    }
   2285    delta = lshift(delta, Log2P);
   2286    if (cmp(delta, bs) > 0) {
   2287      goto drop_down;
   2288    }
   2289    break;
   2290  }
   2291  if (i == 0) {
   2292    /* exactly half-way between */
   2293    if (dsign) {
   2294      if ((word0(rv) & Bndry_mask1) == Bndry_mask1 &&
   2295          word1(rv) ==
   2296              (
   2297 #ifdef Avoid_Underflow
   2298                  (scale && (y = word0(rv) & Exp_mask) <= 2 * P * Exp_msk1)
   2299                      ? (0xffffffff &
   2300                         (0xffffffff << (2 * P + 1 - (y >> Exp_shift))))
   2301                      :
   2302 #endif
   2303                      0xffffffff)) {
   2304        /*boundary case -- increment exponent*/
   2305        word0(rv) = (word0(rv) & Exp_mask) + Exp_msk1
   2306 #ifdef IBM
   2307                    | Exp_msk1 >> 4
   2308 #endif
   2309            ;
   2310        word1(rv) = 0;
   2311 #ifdef Avoid_Underflow
   2312        dsign = 0;
   2313 #endif
   2314        break;
   2315      }
   2316    } else if (!(word0(rv) & Bndry_mask) && !word1(rv)) {
   2317    drop_down:
   2318      /* boundary case -- decrement exponent */
   2319 #ifdef Sudden_Underflow /*{{*/
   2320      L = word0(rv) & Exp_mask;
   2321 #  ifdef IBM
   2322      if (L < Exp_msk1)
   2323 #  else
   2324 #    ifdef Avoid_Underflow
   2325      if (L <= (scale ? (2 * P + 1) * Exp_msk1 : Exp_msk1))
   2326 #    else
   2327      if (L <= Exp_msk1)
   2328 #    endif /*Avoid_Underflow*/
   2329 #  endif   /*IBM*/
   2330        goto undfl;
   2331      L -= Exp_msk1;
   2332 #else /*Sudden_Underflow}{*/
   2333 #  ifdef Avoid_Underflow
   2334          if (scale) {
   2335            L = word0(rv) & Exp_mask;
   2336            if (L <= (2 * P + 1) * Exp_msk1) {
   2337              if (L > (P + 2) * Exp_msk1)
   2338              /* round even ==> */
   2339              /* accept rv */
   2340              {
   2341                break;
   2342              }
   2343              /* rv = smallest denormal */
   2344              goto undfl;
   2345            }
   2346          }
   2347 #  endif /*Avoid_Underflow*/
   2348          L = (word0(rv) & Exp_mask) - Exp_msk1;
   2349 #endif   /*Sudden_Underflow}}*/
   2350      word0(rv) = L | Bndry_mask1;
   2351      word1(rv) = 0xffffffff;
   2352 #ifdef IBM
   2353      goto cont;
   2354 #else
   2355          break;
   2356 #endif
   2357    }
   2358 #ifndef ROUND_BIASED
   2359    if (!(word1(rv) & LSB)) {
   2360      break;
   2361    }
   2362 #endif
   2363    if (dsign) {
   2364      dval(rv) += ulp(dval(rv));
   2365    }
   2366 #ifndef ROUND_BIASED
   2367    else {
   2368      dval(rv) -= ulp(dval(rv));
   2369 #  ifndef Sudden_Underflow
   2370      if (!dval(rv)) {
   2371        goto undfl;
   2372      }
   2373 #  endif
   2374    }
   2375 #  ifdef Avoid_Underflow
   2376    dsign = 1 - dsign;
   2377 #  endif
   2378 #endif
   2379    break;
   2380  }
   2381  if ((aadj = ratio(delta, bs)) <= 2.) {
   2382    if (dsign) {
   2383      aadj = aadj1 = 1.;
   2384    } else if (word1(rv) || word0(rv) & Bndry_mask) {
   2385 #ifndef Sudden_Underflow
   2386      if (word1(rv) == Tiny1 && !word0(rv)) {
   2387        goto undfl;
   2388      }
   2389 #endif
   2390      aadj = 1.;
   2391      aadj1 = -1.;
   2392    } else {
   2393      /* special case -- power of FLT_RADIX to be */
   2394      /* rounded down... */
   2395 
   2396      if (aadj < 2. / FLT_RADIX) {
   2397        aadj = 1. / FLT_RADIX;
   2398      } else {
   2399        aadj *= 0.5;
   2400      }
   2401      aadj1 = -aadj;
   2402    }
   2403  } else {
   2404    aadj *= 0.5;
   2405    aadj1 = dsign ? aadj : -aadj;
   2406 #ifdef Check_FLT_ROUNDS
   2407    switch (Rounding) {
   2408      case 2: /* towards +infinity */
   2409        aadj1 -= 0.5;
   2410        break;
   2411      case 0: /* towards 0 */
   2412      case 3: /* towards -infinity */
   2413        aadj1 += 0.5;
   2414    }
   2415 #else
   2416        if (Flt_Rounds == 0) {
   2417          aadj1 += 0.5;
   2418        }
   2419 #endif /*Check_FLT_ROUNDS*/
   2420  }
   2421  y = word0(rv) & Exp_mask;
   2422 
   2423  /* Check for overflow */
   2424 
   2425  if (y == Exp_msk1 * (DBL_MAX_EXP + Bias - 1)) {
   2426    dval(rv0) = dval(rv);
   2427    word0(rv) -= P * Exp_msk1;
   2428    adj = aadj1 * ulp(dval(rv));
   2429    dval(rv) += adj;
   2430    if ((word0(rv) & Exp_mask) >= Exp_msk1 * (DBL_MAX_EXP + Bias - P)) {
   2431      if (word0(rv0) == Big0 && word1(rv0) == Big1) {
   2432        goto ovfl;
   2433      }
   2434      word0(rv) = Big0;
   2435      word1(rv) = Big1;
   2436      goto cont;
   2437    } else {
   2438      word0(rv) += P * Exp_msk1;
   2439    }
   2440  } else {
   2441 #ifdef Avoid_Underflow
   2442    if (scale && y <= 2 * P * Exp_msk1) {
   2443      if (aadj <= 0x7fffffff) {
   2444        if ((z = aadj) <= 0) {
   2445          z = 1;
   2446        }
   2447        aadj = z;
   2448        aadj1 = dsign ? aadj : -aadj;
   2449      }
   2450      dval(aadj2) = aadj1;
   2451      word0(aadj2) += (2 * P + 1) * Exp_msk1 - y;
   2452      aadj1 = dval(aadj2);
   2453    }
   2454    adj = aadj1 * ulp(dval(rv));
   2455    dval(rv) += adj;
   2456 #else
   2457 #  ifdef Sudden_Underflow
   2458        if ((word0(rv) & Exp_mask) <= P * Exp_msk1) {
   2459          dval(rv0) = dval(rv);
   2460          word0(rv) += P * Exp_msk1;
   2461          adj = aadj1 * ulp(dval(rv));
   2462          dval(rv) += adj;
   2463 #    ifdef IBM
   2464          if ((word0(rv) & Exp_mask) < P * Exp_msk1)
   2465 #    else
   2466          if ((word0(rv) & Exp_mask) <= P * Exp_msk1)
   2467 #    endif
   2468          {
   2469            if (word0(rv0) == Tiny0 && word1(rv0) == Tiny1) {
   2470              goto undfl;
   2471            }
   2472            word0(rv) = Tiny0;
   2473            word1(rv) = Tiny1;
   2474            goto cont;
   2475          } else {
   2476            word0(rv) -= P * Exp_msk1;
   2477          }
   2478        } else {
   2479          adj = aadj1 * ulp(dval(rv));
   2480          dval(rv) += adj;
   2481        }
   2482 #  else  /*Sudden_Underflow*/
   2483        /* Compute adj so that the IEEE rounding rules will
   2484         * correctly round rv + adj in some half-way cases.
   2485         * If rv * ulp(rv) is denormalized (i.e.,
   2486         * y <= (P-1)*Exp_msk1), we must adjust aadj to avoid
   2487         * trouble from bits lost to denormalization;
   2488         * example: 1.2e-307 .
   2489         */
   2490        if (y <= (P - 1) * Exp_msk1 && aadj > 1.) {
   2491          aadj1 = (double)(int)(aadj + 0.5);
   2492          if (!dsign) {
   2493            aadj1 = -aadj1;
   2494          }
   2495        }
   2496        adj = aadj1 * ulp(dval(rv));
   2497        dval(rv) += adj;
   2498 #  endif /*Sudden_Underflow*/
   2499 #endif   /*Avoid_Underflow*/
   2500  }
   2501  z = word0(rv) & Exp_mask;
   2502 #ifndef SET_INEXACT
   2503 #  ifdef Avoid_Underflow
   2504  if (!scale)
   2505 #  endif
   2506    if (y == z) {
   2507      /* Can we stop now? */
   2508      L = (Long)aadj;
   2509      aadj -= L;
   2510      /* The tolerances below are conservative. */
   2511      if (dsign || word1(rv) || word0(rv) & Bndry_mask) {
   2512        if (aadj < .4999999 || aadj > .5000001) {
   2513          break;
   2514        }
   2515      } else if (aadj < .4999999 / FLT_RADIX) {
   2516        break;
   2517      }
   2518    }
   2519 #endif
   2520 cont:
   2521  Bfree(bb);
   2522  Bfree(bd);
   2523  Bfree(bs);
   2524  Bfree(delta);
   2525 }
   2526 #ifdef SET_INEXACT
   2527 if (inexact) {
   2528  if (!oldinexact) {
   2529    word0(rv0) = Exp_1 + (70 << Exp_shift);
   2530    word1(rv0) = 0;
   2531    dval(rv0) += 1.;
   2532  }
   2533 } else if (!oldinexact) {
   2534  clear_inexact();
   2535 }
   2536 #endif
   2537 #ifdef Avoid_Underflow
   2538 if (scale) {
   2539  word0(rv0) = Exp_1 - 2 * P * Exp_msk1;
   2540  word1(rv0) = 0;
   2541  dval(rv) *= dval(rv0);
   2542 #  ifndef NO_ERRNO
   2543  /* try to avoid the bug of testing an 8087 register value */
   2544  if (word0(rv) == 0 && word1(rv) == 0) {
   2545    PR_SetError(PR_RANGE_ERROR, 0);
   2546  }
   2547 #  endif
   2548 }
   2549 #endif /* Avoid_Underflow */
   2550 #ifdef SET_INEXACT
   2551 if (inexact && !(word0(rv) & Exp_mask)) {
   2552  /* set underflow bit */
   2553  dval(rv0) = 1e-300;
   2554  dval(rv0) *= dval(rv0);
   2555 }
   2556 #endif
   2557 retfree: Bfree(bb);
   2558 Bfree(bd);
   2559 Bfree(bs);
   2560 Bfree(bd0);
   2561 Bfree(delta);
   2562 ret: if (se) { *se = (char*)s; }
   2563 return sign ? -dval(rv) : dval(rv);
   2564 }
   2565 
   2566 static int quorem
   2567 #ifdef KR_headers
   2568    (b, S)
   2569 Bigint *b, *S;
   2570 #else
   2571      (Bigint * b, Bigint * S)
   2572 #endif
   2573 {
   2574  int n;
   2575  ULong *bx, *bxe, q, *sx, *sxe;
   2576 #ifdef ULLong
   2577  ULLong borrow, carry, y, ys;
   2578 #else
   2579    ULong borrow, carry, y, ys;
   2580 #  ifdef Pack_32
   2581    ULong si, z, zs;
   2582 #  endif
   2583 #endif
   2584 
   2585  n = S->wds;
   2586 #ifdef DEBUG
   2587  /*debug*/ if (b->wds > n)
   2588  /*debug*/ {
   2589    Bug("oversize b in quorem");
   2590  }
   2591 #endif
   2592  if (b->wds < n) {
   2593    return 0;
   2594  }
   2595  sx = S->x;
   2596  sxe = sx + --n;
   2597  bx = b->x;
   2598  bxe = bx + n;
   2599  q = *bxe / (*sxe + 1); /* ensure q <= true quotient */
   2600 #ifdef DEBUG
   2601  /*debug*/ if (q > 9)
   2602  /*debug*/ {
   2603    Bug("oversized quotient in quorem");
   2604  }
   2605 #endif
   2606  if (q) {
   2607    borrow = 0;
   2608    carry = 0;
   2609    do {
   2610 #ifdef ULLong
   2611      ys = *sx++ * (ULLong)q + carry;
   2612      carry = ys >> 32;
   2613      y = *bx - (ys & FFFFFFFF) - borrow;
   2614      borrow = y >> 32 & (ULong)1;
   2615      *bx++ = y & FFFFFFFF;
   2616 #else
   2617 #  ifdef Pack_32
   2618        si = *sx++;
   2619        ys = (si & 0xffff) * q + carry;
   2620        zs = (si >> 16) * q + (ys >> 16);
   2621        carry = zs >> 16;
   2622        y = (*bx & 0xffff) - (ys & 0xffff) - borrow;
   2623        borrow = (y & 0x10000) >> 16;
   2624        z = (*bx >> 16) - (zs & 0xffff) - borrow;
   2625        borrow = (z & 0x10000) >> 16;
   2626        Storeinc(bx, z, y);
   2627 #  else
   2628        ys = *sx++ * q + carry;
   2629        carry = ys >> 16;
   2630        y = *bx - (ys & 0xffff) - borrow;
   2631        borrow = (y & 0x10000) >> 16;
   2632        *bx++ = y & 0xffff;
   2633 #  endif
   2634 #endif
   2635    } while (sx <= sxe);
   2636    if (!*bxe) {
   2637      bx = b->x;
   2638      while (--bxe > bx && !*bxe) {
   2639        --n;
   2640      }
   2641      b->wds = n;
   2642    }
   2643  }
   2644  if (cmp(b, S) >= 0) {
   2645    q++;
   2646    borrow = 0;
   2647    carry = 0;
   2648    bx = b->x;
   2649    sx = S->x;
   2650    do {
   2651 #ifdef ULLong
   2652      ys = *sx++ + carry;
   2653      carry = ys >> 32;
   2654      y = *bx - (ys & FFFFFFFF) - borrow;
   2655      borrow = y >> 32 & (ULong)1;
   2656      *bx++ = y & FFFFFFFF;
   2657 #else
   2658 #  ifdef Pack_32
   2659        si = *sx++;
   2660        ys = (si & 0xffff) + carry;
   2661        zs = (si >> 16) + (ys >> 16);
   2662        carry = zs >> 16;
   2663        y = (*bx & 0xffff) - (ys & 0xffff) - borrow;
   2664        borrow = (y & 0x10000) >> 16;
   2665        z = (*bx >> 16) - (zs & 0xffff) - borrow;
   2666        borrow = (z & 0x10000) >> 16;
   2667        Storeinc(bx, z, y);
   2668 #  else
   2669        ys = *sx++ + carry;
   2670        carry = ys >> 16;
   2671        y = *bx - (ys & 0xffff) - borrow;
   2672        borrow = (y & 0x10000) >> 16;
   2673        *bx++ = y & 0xffff;
   2674 #  endif
   2675 #endif
   2676    } while (sx <= sxe);
   2677    bx = b->x;
   2678    bxe = bx + n;
   2679    if (!*bxe) {
   2680      while (--bxe > bx && !*bxe) {
   2681        --n;
   2682      }
   2683      b->wds = n;
   2684    }
   2685  }
   2686  return q;
   2687 }
   2688 
   2689 #ifndef MULTIPLE_THREADS
   2690 static char* dtoa_result;
   2691 #endif
   2692 
   2693 static char*
   2694 #ifdef KR_headers
   2695 rv_alloc(i)
   2696 int i;
   2697 #else
   2698  rv_alloc(int i)
   2699 #endif
   2700 {
   2701  int j, k, *r;
   2702 
   2703  j = sizeof(ULong);
   2704  for (k = 0; sizeof(Bigint) - sizeof(ULong) - sizeof(int) + j <= i; j <<= 1) {
   2705    k++;
   2706  }
   2707  r = (int*)Balloc(k);
   2708  *r = k;
   2709  return
   2710 #ifndef MULTIPLE_THREADS
   2711      dtoa_result =
   2712 #endif
   2713          (char*)(r + 1);
   2714 }
   2715 
   2716 static char*
   2717 #ifdef KR_headers
   2718 nrv_alloc(s, rve, n)
   2719 char *s, **rve;
   2720 int n;
   2721 #else
   2722  nrv_alloc(char* s, char** rve, int n)
   2723 #endif
   2724 {
   2725  char *rv, *t;
   2726 
   2727  t = rv = rv_alloc(n);
   2728  while (*t = *s++) {
   2729    t++;
   2730  }
   2731  if (rve) {
   2732    *rve = t;
   2733  }
   2734  return rv;
   2735 }
   2736 
   2737 /* freedtoa(s) must be used to free values s returned by dtoa
   2738 * when MULTIPLE_THREADS is #defined.  It should be used in all cases,
   2739 * but for consistency with earlier versions of dtoa, it is optional
   2740 * when MULTIPLE_THREADS is not defined.
   2741 */
   2742 
   2743 static void
   2744 #ifdef KR_headers
   2745    freedtoa(s) char* s;
   2746 #else
   2747  freedtoa(char* s)
   2748 #endif
   2749 {
   2750  Bigint* b = (Bigint*)((int*)s - 1);
   2751  b->maxwds = 1 << (b->k = *(int*)b);
   2752  Bfree(b);
   2753 #ifndef MULTIPLE_THREADS
   2754  if (s == dtoa_result) {
   2755    dtoa_result = 0;
   2756  }
   2757 #endif
   2758 }
   2759 
   2760 /* dtoa for IEEE arithmetic (dmg): convert double to ASCII string.
   2761 *
   2762 * Inspired by "How to Print Floating-Point Numbers Accurately" by
   2763 * Guy L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90, pp. 112-126].
   2764 *
   2765 * Modifications:
   2766 *  1. Rather than iterating, we use a simple numeric overestimate
   2767 *     to determine k = floor(log10(d)).  We scale relevant
   2768 *     quantities using O(log2(k)) rather than O(k) multiplications.
   2769 *  2. For some modes > 2 (corresponding to ecvt and fcvt), we don't
   2770 *     try to generate digits strictly left to right.  Instead, we
   2771 *     compute with fewer bits and propagate the carry if necessary
   2772 *     when rounding the final digit up.  This is often faster.
   2773 *  3. Under the assumption that input will be rounded nearest,
   2774 *     mode 0 renders 1e23 as 1e23 rather than 9.999999999999999e22.
   2775 *     That is, we allow equality in stopping tests when the
   2776 *     round-nearest rule will give the same floating-point value
   2777 *     as would satisfaction of the stopping test with strict
   2778 *     inequality.
   2779 *  4. We remove common factors of powers of 2 from relevant
   2780 *     quantities.
   2781 *  5. When converting floating-point integers less than 1e16,
   2782 *     we use floating-point arithmetic rather than resorting
   2783 *     to multiple-precision integers.
   2784 *  6. When asked to produce fewer than 15 digits, we first try
   2785 *     to get by with floating-point arithmetic; we resort to
   2786 *     multiple-precision integer arithmetic only if we cannot
   2787 *     guarantee that the floating-point calculation has given
   2788 *     the correctly rounded result.  For k requested digits and
   2789 *     "uniformly" distributed input, the probability is
   2790 *     something like 10^(k-15) that we must resort to the Long
   2791 *     calculation.
   2792 */
   2793 
   2794 static char* dtoa
   2795 #ifdef KR_headers
   2796    (dd, mode, ndigits, decpt, sign, rve)
   2797 double dd;
   2798 int mode, ndigits, *decpt, *sign;
   2799 char** rve;
   2800 #else
   2801      (double dd, int mode, int ndigits, int* decpt, int* sign, char** rve)
   2802 #endif
   2803 {
   2804  /* Arguments ndigits, decpt, sign are similar to those
   2805  of ecvt and fcvt; trailing zeros are suppressed from
   2806  the returned string.  If not null, *rve is set to point
   2807  to the end of the return value.  If d is +-Infinity or NaN,
   2808  then *decpt is set to 9999.
   2809 
   2810  mode:
   2811     0 ==> shortest string that yields d when read in
   2812         and rounded to nearest.
   2813     1 ==> like 0, but with Steele & White stopping rule;
   2814         e.g. with IEEE P754 arithmetic , mode 0 gives
   2815         1e23 whereas mode 1 gives 9.999999999999999e22.
   2816     2 ==> max(1,ndigits) significant digits.  This gives a
   2817         return value similar to that of ecvt, except
   2818         that trailing zeros are suppressed.
   2819     3 ==> through ndigits past the decimal point.  This
   2820         gives a return value similar to that from fcvt,
   2821         except that trailing zeros are suppressed, and
   2822         ndigits can be negative.
   2823     4,5 ==> similar to 2 and 3, respectively, but (in
   2824         round-nearest mode) with the tests of mode 0 to
   2825         possibly return a shorter string that rounds to d.
   2826         With IEEE arithmetic and compilation with
   2827         -DHonor_FLT_ROUNDS, modes 4 and 5 behave the same
   2828         as modes 2 and 3 when FLT_ROUNDS != 1.
   2829     6-9 ==> Debugging modes similar to mode - 4:  don't try
   2830         fast floating-point estimate (if applicable).
   2831 
   2832     Values of mode other than 0-9 are treated as mode 0.
   2833 
   2834     Sufficient space is allocated to the return value
   2835     to hold the suppressed trailing zeros.
   2836  */
   2837 
   2838  int bbits, b2, b5, be, dig, i, ieps, ilim, ilim0, ilim1, j, j1, k, k0,
   2839      k_check, leftright, m2, m5, s2, s5, spec_case, try_quick;
   2840  Long L;
   2841 #ifndef Sudden_Underflow
   2842  int denorm;
   2843  ULong x;
   2844 #endif
   2845  Bigint *b, *b1, *delta, *mlo, *mhi, *S;
   2846  U d, d2, eps;
   2847  double ds;
   2848  char *s, *s0;
   2849 #ifdef Honor_FLT_ROUNDS
   2850  int rounding;
   2851 #endif
   2852 #ifdef SET_INEXACT
   2853  int inexact, oldinexact;
   2854 #endif
   2855 
   2856 #ifndef MULTIPLE_THREADS
   2857  if (dtoa_result) {
   2858    freedtoa(dtoa_result);
   2859    dtoa_result = 0;
   2860  }
   2861 #endif
   2862 
   2863  dval(d) = dd;
   2864  if (word0(d) & Sign_bit) {
   2865    /* set sign for everything, including 0's and NaNs */
   2866    *sign = 1;
   2867    word0(d) &= ~Sign_bit; /* clear sign bit */
   2868  } else {
   2869    *sign = 0;
   2870  }
   2871 
   2872 #if defined(IEEE_Arith) + defined(VAX)
   2873 #  ifdef IEEE_Arith
   2874  if ((word0(d) & Exp_mask) == Exp_mask)
   2875 #  else
   2876  if (word0(d) == 0x8000)
   2877 #  endif
   2878  {
   2879    /* Infinity or NaN */
   2880    *decpt = 9999;
   2881 #  ifdef IEEE_Arith
   2882    if (!word1(d) && !(word0(d) & 0xfffff)) {
   2883      return nrv_alloc("Infinity", rve, 8);
   2884    }
   2885 #  endif
   2886    return nrv_alloc("NaN", rve, 3);
   2887  }
   2888 #endif
   2889 #ifdef IBM
   2890  dval(d) += 0; /* normalize */
   2891 #endif
   2892  if (!dval(d)) {
   2893    *decpt = 1;
   2894    return nrv_alloc("0", rve, 1);
   2895  }
   2896 
   2897 #ifdef SET_INEXACT
   2898  try_quick = oldinexact = get_inexact();
   2899  inexact = 1;
   2900 #endif
   2901 #ifdef Honor_FLT_ROUNDS
   2902  if ((rounding = Flt_Rounds) >= 2) {
   2903    if (*sign) {
   2904      rounding = rounding == 2 ? 0 : 2;
   2905    } else if (rounding != 2) {
   2906      rounding = 0;
   2907    }
   2908  }
   2909 #endif
   2910 
   2911  b = d2b(dval(d), &be, &bbits);
   2912 #ifdef Sudden_Underflow
   2913  i = (int)(word0(d) >> Exp_shift1 & (Exp_mask >> Exp_shift1));
   2914 #else
   2915    if (i = (int)(word0(d) >> Exp_shift1 & (Exp_mask >> Exp_shift1))) {
   2916 #endif
   2917  dval(d2) = dval(d);
   2918  word0(d2) &= Frac_mask1;
   2919  word0(d2) |= Exp_11;
   2920 #ifdef IBM
   2921  if (j = 11 - hi0bits(word0(d2) & Frac_mask)) {
   2922    dval(d2) /= 1 << j;
   2923  }
   2924 #endif
   2925 
   2926  /* log(x)   ~=~ log(1.5) + (x-1.5)/1.5
   2927   * log10(x)  =  log(x) / log(10)
   2928   *      ~=~ log(1.5)/log(10) + (x-1.5)/(1.5*log(10))
   2929   * log10(d) = (i-Bias)*log(2)/log(10) + log10(d2)
   2930   *
   2931   * This suggests computing an approximation k to log10(d) by
   2932   *
   2933   * k = (i - Bias)*0.301029995663981
   2934   *  + ( (d2-1.5)*0.289529654602168 + 0.176091259055681 );
   2935   *
   2936   * We want k to be too large rather than too small.
   2937   * The error in the first-order Taylor series approximation
   2938   * is in our favor, so we just round up the constant enough
   2939   * to compensate for any error in the multiplication of
   2940   * (i - Bias) by 0.301029995663981; since |i - Bias| <= 1077,
   2941   * and 1077 * 0.30103 * 2^-52 ~=~ 7.2e-14,
   2942   * adding 1e-13 to the constant term more than suffices.
   2943   * Hence we adjust the constant term to 0.1760912590558.
   2944   * (We could get a more accurate k by invoking log10,
   2945   *  but this is probably not worthwhile.)
   2946   */
   2947 
   2948  i -= Bias;
   2949 #ifdef IBM
   2950  i <<= 2;
   2951  i += j;
   2952 #endif
   2953 #ifndef Sudden_Underflow
   2954  denorm = 0;
   2955 }
   2956 else {
   2957  /* d is denormalized */
   2958 
   2959  i = bbits + be + (Bias + (P - 1) - 1);
   2960  x = i > 32 ? word0(d) << 64 - i | word1(d) >> i - 32 : word1(d) << 32 - i;
   2961  dval(d2) = x;
   2962  word0(d2) -= 31 * Exp_msk1; /* adjust exponent */
   2963  i -= (Bias + (P - 1) - 1) + 1;
   2964  denorm = 1;
   2965 }
   2966 #endif
   2967 ds = (dval(d2) - 1.5) * 0.289529654602168 + 0.1760912590558 +
   2968     i * 0.301029995663981;
   2969 k = (int)ds;
   2970 if (ds < 0. && ds != k) {
   2971  k--; /* want k = floor(ds) */
   2972 }
   2973 k_check = 1;
   2974 if (k >= 0 && k <= Ten_pmax) {
   2975  if (dval(d) < tens[k]) {
   2976    k--;
   2977  }
   2978  k_check = 0;
   2979 }
   2980 j = bbits - i - 1;
   2981 if (j >= 0) {
   2982  b2 = 0;
   2983  s2 = j;
   2984 } else {
   2985  b2 = -j;
   2986  s2 = 0;
   2987 }
   2988 if (k >= 0) {
   2989  b5 = 0;
   2990  s5 = k;
   2991  s2 += k;
   2992 } else {
   2993  b2 -= k;
   2994  b5 = -k;
   2995  s5 = 0;
   2996 }
   2997 if (mode < 0 || mode > 9) {
   2998  mode = 0;
   2999 }
   3000 
   3001 #ifndef SET_INEXACT
   3002 #  ifdef Check_FLT_ROUNDS
   3003 try_quick = Rounding == 1;
   3004 #  else
   3005 try_quick = 1;
   3006 #  endif
   3007 #endif /*SET_INEXACT*/
   3008 
   3009 if (mode > 5) {
   3010  mode -= 4;
   3011  try_quick = 0;
   3012 }
   3013 leftright = 1;
   3014 switch (mode) {
   3015  case 0:
   3016  case 1:
   3017    ilim = ilim1 = -1;
   3018    i = 18;
   3019    ndigits = 0;
   3020    break;
   3021  case 2:
   3022    leftright = 0;
   3023  /* no break */
   3024  case 4:
   3025    if (ndigits <= 0) {
   3026      ndigits = 1;
   3027    }
   3028    ilim = ilim1 = i = ndigits;
   3029    break;
   3030  case 3:
   3031    leftright = 0;
   3032  /* no break */
   3033  case 5:
   3034    i = ndigits + k + 1;
   3035    ilim = i;
   3036    ilim1 = i - 1;
   3037    if (i <= 0) {
   3038      i = 1;
   3039    }
   3040 }
   3041 s = s0 = rv_alloc(i);
   3042 
   3043 #ifdef Honor_FLT_ROUNDS
   3044 if (mode > 1 && rounding != 1) {
   3045  leftright = 0;
   3046 }
   3047 #endif
   3048 
   3049 if (ilim >= 0 && ilim <= Quick_max && try_quick) {
   3050  /* Try to get by with floating-point arithmetic. */
   3051 
   3052  i = 0;
   3053  dval(d2) = dval(d);
   3054  k0 = k;
   3055  ilim0 = ilim;
   3056  ieps = 2; /* conservative */
   3057  if (k > 0) {
   3058    ds = tens[k & 0xf];
   3059    j = k >> 4;
   3060    if (j & Bletch) {
   3061      /* prevent overflows */
   3062      j &= Bletch - 1;
   3063      dval(d) /= bigtens[n_bigtens - 1];
   3064      ieps++;
   3065    }
   3066    for (; j; j >>= 1, i++)
   3067      if (j & 1) {
   3068        ieps++;
   3069        ds *= bigtens[i];
   3070      }
   3071    dval(d) /= ds;
   3072  } else if (j1 = -k) {
   3073    dval(d) *= tens[j1 & 0xf];
   3074    for (j = j1 >> 4; j; j >>= 1, i++)
   3075      if (j & 1) {
   3076        ieps++;
   3077        dval(d) *= bigtens[i];
   3078      }
   3079  }
   3080  if (k_check && dval(d) < 1. && ilim > 0) {
   3081    if (ilim1 <= 0) {
   3082      goto fast_failed;
   3083    }
   3084    ilim = ilim1;
   3085    k--;
   3086    dval(d) *= 10.;
   3087    ieps++;
   3088  }
   3089  dval(eps) = ieps * dval(d) + 7.;
   3090  word0(eps) -= (P - 1) * Exp_msk1;
   3091  if (ilim == 0) {
   3092    S = mhi = 0;
   3093    dval(d) -= 5.;
   3094    if (dval(d) > dval(eps)) {
   3095      goto one_digit;
   3096    }
   3097    if (dval(d) < -dval(eps)) {
   3098      goto no_digits;
   3099    }
   3100    goto fast_failed;
   3101  }
   3102 #ifndef No_leftright
   3103  if (leftright) {
   3104    /* Use Steele & White method of only
   3105     * generating digits needed.
   3106     */
   3107    dval(eps) = 0.5 / tens[ilim - 1] - dval(eps);
   3108    for (i = 0;;) {
   3109      L = dval(d);
   3110      dval(d) -= L;
   3111      *s++ = '0' + (int)L;
   3112      if (dval(d) < dval(eps)) {
   3113        goto ret1;
   3114      }
   3115      if (1. - dval(d) < dval(eps)) {
   3116        goto bump_up;
   3117      }
   3118      if (++i >= ilim) {
   3119        break;
   3120      }
   3121      dval(eps) *= 10.;
   3122      dval(d) *= 10.;
   3123    }
   3124  } else {
   3125 #endif
   3126    /* Generate ilim digits, then fix them up. */
   3127    dval(eps) *= tens[ilim - 1];
   3128    for (i = 1;; i++, dval(d) *= 10.) {
   3129      L = (Long)(dval(d));
   3130      if (!(dval(d) -= L)) {
   3131        ilim = i;
   3132      }
   3133      *s++ = '0' + (int)L;
   3134      if (i == ilim) {
   3135        if (dval(d) > 0.5 + dval(eps)) {
   3136          goto bump_up;
   3137        } else if (dval(d) < 0.5 - dval(eps)) {
   3138          while (*--s == '0');
   3139          s++;
   3140          goto ret1;
   3141        }
   3142        break;
   3143      }
   3144    }
   3145 #ifndef No_leftright
   3146  }
   3147 #endif
   3148 fast_failed:
   3149  s = s0;
   3150  dval(d) = dval(d2);
   3151  k = k0;
   3152  ilim = ilim0;
   3153 }
   3154 
   3155 /* Do we have a "small" integer? */
   3156 
   3157 if (be >= 0 && k <= Int_max) {
   3158  /* Yes. */
   3159  ds = tens[k];
   3160  if (ndigits < 0 && ilim <= 0) {
   3161    S = mhi = 0;
   3162    if (ilim < 0 || dval(d) <= 5 * ds) {
   3163      goto no_digits;
   3164    }
   3165    goto one_digit;
   3166  }
   3167  for (i = 1; i <= k + 1; i++, dval(d) *= 10.) {
   3168    L = (Long)(dval(d) / ds);
   3169    dval(d) -= L * ds;
   3170 #ifdef Check_FLT_ROUNDS
   3171    /* If FLT_ROUNDS == 2, L will usually be high by 1 */
   3172    if (dval(d) < 0) {
   3173      L--;
   3174      dval(d) += ds;
   3175    }
   3176 #endif
   3177    *s++ = '0' + (int)L;
   3178    if (!dval(d)) {
   3179 #ifdef SET_INEXACT
   3180      inexact = 0;
   3181 #endif
   3182      break;
   3183    }
   3184    if (i == ilim) {
   3185 #ifdef Honor_FLT_ROUNDS
   3186      if (mode > 1) switch (rounding) {
   3187          case 0:
   3188            goto ret1;
   3189          case 2:
   3190            goto bump_up;
   3191        }
   3192 #endif
   3193      dval(d) += dval(d);
   3194      if (dval(d) > ds || dval(d) == ds && L & 1) {
   3195      bump_up:
   3196        while (*--s == '9')
   3197          if (s == s0) {
   3198            k++;
   3199            *s = '0';
   3200            break;
   3201          }
   3202        ++*s++;
   3203      }
   3204      break;
   3205    }
   3206  }
   3207  goto ret1;
   3208 }
   3209 
   3210 m2 = b2;
   3211 m5 = b5;
   3212 mhi = mlo = 0;
   3213 if (leftright) {
   3214  i =
   3215 #ifndef Sudden_Underflow
   3216      denorm ? be + (Bias + (P - 1) - 1 + 1) :
   3217 #endif
   3218 #ifdef IBM
   3219             1 + 4 * P - 3 - bbits + ((bbits + be - 1) & 3);
   3220 #else
   3221            1 + P - bbits;
   3222 #endif
   3223  b2 += i;
   3224  s2 += i;
   3225  mhi = i2b(1);
   3226 }
   3227 if (m2 > 0 && s2 > 0) {
   3228  i = m2 < s2 ? m2 : s2;
   3229  b2 -= i;
   3230  m2 -= i;
   3231  s2 -= i;
   3232 }
   3233 if (b5 > 0) {
   3234  if (leftright) {
   3235    if (m5 > 0) {
   3236      mhi = pow5mult(mhi, m5);
   3237      b1 = mult(mhi, b);
   3238      Bfree(b);
   3239      b = b1;
   3240    }
   3241    if (j = b5 - m5) {
   3242      b = pow5mult(b, j);
   3243    }
   3244  } else {
   3245    b = pow5mult(b, b5);
   3246  }
   3247 }
   3248 S = i2b(1);
   3249 if (s5 > 0) {
   3250  S = pow5mult(S, s5);
   3251 }
   3252 
   3253 /* Check for special case that d is a normalized power of 2. */
   3254 
   3255 spec_case = 0;
   3256 if ((mode < 2 || leftright)
   3257 #ifdef Honor_FLT_ROUNDS
   3258    && rounding == 1
   3259 #endif
   3260 ) {
   3261  if (!word1(d) && !(word0(d) & Bndry_mask)
   3262 #ifndef Sudden_Underflow
   3263      && word0(d) & (Exp_mask & ~Exp_msk1)
   3264 #endif
   3265  ) {
   3266    /* The special case */
   3267    b2 += Log2P;
   3268    s2 += Log2P;
   3269    spec_case = 1;
   3270  }
   3271 }
   3272 
   3273 /* Arrange for convenient computation of quotients:
   3274 * shift left if necessary so divisor has 4 leading 0 bits.
   3275 *
   3276 * Perhaps we should just compute leading 28 bits of S once
   3277 * and for all and pass them and a shift to quorem, so it
   3278 * can do shifts and ors to compute the numerator for q.
   3279 */
   3280 #ifdef Pack_32
   3281 if (i = ((s5 ? 32 - hi0bits(S->x[S->wds - 1]) : 1) + s2) & 0x1f) {
   3282  i = 32 - i;
   3283 }
   3284 #else
   3285      if (i = ((s5 ? 32 - hi0bits(S->x[S->wds - 1]) : 1) + s2) & 0xf) {
   3286        i = 16 - i;
   3287      }
   3288 #endif
   3289 if (i > 4) {
   3290  i -= 4;
   3291  b2 += i;
   3292  m2 += i;
   3293  s2 += i;
   3294 } else if (i < 4) {
   3295  i += 28;
   3296  b2 += i;
   3297  m2 += i;
   3298  s2 += i;
   3299 }
   3300 if (b2 > 0) {
   3301  b = lshift(b, b2);
   3302 }
   3303 if (s2 > 0) {
   3304  S = lshift(S, s2);
   3305 }
   3306 if (k_check) {
   3307  if (cmp(b, S) < 0) {
   3308    k--;
   3309    b = multadd(b, 10, 0); /* we botched the k estimate */
   3310    if (leftright) {
   3311      mhi = multadd(mhi, 10, 0);
   3312    }
   3313    ilim = ilim1;
   3314  }
   3315 }
   3316 if (ilim <= 0 && (mode == 3 || mode == 5)) {
   3317  if (ilim < 0 || cmp(b, S = multadd(S, 5, 0)) <= 0) {
   3318    /* no digits, fcvt style */
   3319  no_digits:
   3320    k = -1 - ndigits;
   3321    goto ret;
   3322  }
   3323 one_digit:
   3324  *s++ = '1';
   3325  k++;
   3326  goto ret;
   3327 }
   3328 if (leftright) {
   3329  if (m2 > 0) {
   3330    mhi = lshift(mhi, m2);
   3331  }
   3332 
   3333  /* Compute mlo -- check for special case
   3334   * that d is a normalized power of 2.
   3335   */
   3336 
   3337  mlo = mhi;
   3338  if (spec_case) {
   3339    mhi = Balloc(mhi->k);
   3340    Bcopy(mhi, mlo);
   3341    mhi = lshift(mhi, Log2P);
   3342  }
   3343 
   3344  for (i = 1;; i++) {
   3345    dig = quorem(b, S) + '0';
   3346    /* Do we yet have the shortest decimal string
   3347     * that will round to d?
   3348     */
   3349    j = cmp(b, mlo);
   3350    delta = diff(S, mhi);
   3351    j1 = delta->sign ? 1 : cmp(b, delta);
   3352    Bfree(delta);
   3353 #ifndef ROUND_BIASED
   3354    if (j1 == 0 && mode != 1 && !(word1(d) & 1)
   3355 #  ifdef Honor_FLT_ROUNDS
   3356        && rounding >= 1
   3357 #  endif
   3358    ) {
   3359      if (dig == '9') {
   3360        goto round_9_up;
   3361      }
   3362      if (j > 0) {
   3363        dig++;
   3364      }
   3365 #  ifdef SET_INEXACT
   3366      else if (!b->x[0] && b->wds <= 1) {
   3367        inexact = 0;
   3368      }
   3369 #  endif
   3370      *s++ = dig;
   3371      goto ret;
   3372    }
   3373 #endif
   3374    if (j < 0 || j == 0 && mode != 1
   3375 #ifndef ROUND_BIASED
   3376                     && !(word1(d) & 1)
   3377 #endif
   3378    ) {
   3379      if (!b->x[0] && b->wds <= 1) {
   3380 #ifdef SET_INEXACT
   3381        inexact = 0;
   3382 #endif
   3383        goto accept_dig;
   3384      }
   3385 #ifdef Honor_FLT_ROUNDS
   3386      if (mode > 1) switch (rounding) {
   3387          case 0:
   3388            goto accept_dig;
   3389          case 2:
   3390            goto keep_dig;
   3391        }
   3392 #endif /*Honor_FLT_ROUNDS*/
   3393      if (j1 > 0) {
   3394        b = lshift(b, 1);
   3395        j1 = cmp(b, S);
   3396        if ((j1 > 0 || j1 == 0 && dig & 1) && dig++ == '9') {
   3397          goto round_9_up;
   3398        }
   3399      }
   3400    accept_dig:
   3401      *s++ = dig;
   3402      goto ret;
   3403    }
   3404    if (j1 > 0) {
   3405 #ifdef Honor_FLT_ROUNDS
   3406      if (!rounding) {
   3407        goto accept_dig;
   3408      }
   3409 #endif
   3410      if (dig == '9') { /* possible if i == 1 */
   3411      round_9_up:
   3412        *s++ = '9';
   3413        goto roundoff;
   3414      }
   3415      *s++ = dig + 1;
   3416      goto ret;
   3417    }
   3418 #ifdef Honor_FLT_ROUNDS
   3419  keep_dig:
   3420 #endif
   3421    *s++ = dig;
   3422    if (i == ilim) {
   3423      break;
   3424    }
   3425    b = multadd(b, 10, 0);
   3426    if (mlo == mhi) {
   3427      mlo = mhi = multadd(mhi, 10, 0);
   3428    } else {
   3429      mlo = multadd(mlo, 10, 0);
   3430      mhi = multadd(mhi, 10, 0);
   3431    }
   3432  }
   3433 } else
   3434  for (i = 1;; i++) {
   3435    *s++ = dig = quorem(b, S) + '0';
   3436    if (!b->x[0] && b->wds <= 1) {
   3437 #ifdef SET_INEXACT
   3438      inexact = 0;
   3439 #endif
   3440      goto ret;
   3441    }
   3442    if (i >= ilim) {
   3443      break;
   3444    }
   3445    b = multadd(b, 10, 0);
   3446  }
   3447 
   3448  /* Round off last digit */
   3449 
   3450 #ifdef Honor_FLT_ROUNDS
   3451 switch (rounding) {
   3452  case 0:
   3453    goto trimzeros;
   3454  case 2:
   3455    goto roundoff;
   3456 }
   3457 #endif
   3458 b = lshift(b, 1);
   3459 j = cmp(b, S);
   3460 if (j > 0 || j == 0 && dig & 1) {
   3461 roundoff:
   3462  while (*--s == '9')
   3463    if (s == s0) {
   3464      k++;
   3465      *s++ = '1';
   3466      goto ret;
   3467    }
   3468  ++*s++;
   3469 } else {
   3470 #ifdef Honor_FLT_ROUNDS
   3471 trimzeros:
   3472 #endif
   3473  while (*--s == '0');
   3474  s++;
   3475 }
   3476 ret: Bfree(S);
   3477 if (mhi) {
   3478  if (mlo && mlo != mhi) {
   3479    Bfree(mlo);
   3480  }
   3481  Bfree(mhi);
   3482 }
   3483 ret1:
   3484 #ifdef SET_INEXACT
   3485    if (inexact) {
   3486  if (!oldinexact) {
   3487    word0(d) = Exp_1 + (70 << Exp_shift);
   3488    word1(d) = 0;
   3489    dval(d) += 1.;
   3490  }
   3491 }
   3492 else if (!oldinexact) {
   3493  clear_inexact();
   3494 }
   3495 #endif
   3496 Bfree(b);
   3497 *s = 0;
   3498 *decpt = k + 1;
   3499 if (rve) {
   3500  *rve = s;
   3501 }
   3502 return s0;
   3503 }
   3504 #ifdef __cplusplus
   3505 }
   3506 #endif
   3507 
   3508 PR_IMPLEMENT(PRStatus)
   3509 PR_dtoa(PRFloat64 d, PRIntn mode, PRIntn ndigits, PRIntn* decpt, PRIntn* sign,
   3510        char** rve, char* buf, PRSize bufsize) {
   3511  char* result;
   3512  PRSize resultlen;
   3513  PRStatus rv = PR_FAILURE;
   3514 
   3515  if (!_pr_initialized) {
   3516    _PR_ImplicitInitialization();
   3517  }
   3518 
   3519  if (mode < 0 || mode > 3) {
   3520    PR_SetError(PR_INVALID_ARGUMENT_ERROR, 0);
   3521    return rv;
   3522  }
   3523  result = dtoa(d, mode, ndigits, decpt, sign, rve);
   3524  if (!result) {
   3525    PR_SetError(PR_OUT_OF_MEMORY_ERROR, 0);
   3526    return rv;
   3527  }
   3528  resultlen = strlen(result) + 1;
   3529  if (bufsize < resultlen) {
   3530    PR_SetError(PR_BUFFER_OVERFLOW_ERROR, 0);
   3531  } else {
   3532    memcpy(buf, result, resultlen);
   3533    if (rve) {
   3534      *rve = buf + (*rve - result);
   3535    }
   3536    rv = PR_SUCCESS;
   3537  }
   3538  freedtoa(result);
   3539  return rv;
   3540 }
   3541 
   3542 /*
   3543 ** conversion routines for floating point
   3544 ** prcsn - number of digits of precision to generate floating
   3545 ** point value.
   3546 ** This should be reparameterized so that you can send in a
   3547 **   prcn for the positive and negative ranges.  For now,
   3548 **   conform to the ECMA JavaScript spec which says numbers
   3549 **   less than 1e-6 are in scientific notation.
   3550 ** Also, the ECMA spec says that there should always be a
   3551 **   '+' or '-' after the 'e' in scientific notation
   3552 */
   3553 PR_IMPLEMENT(void)
   3554 PR_cnvtf(char* buf, int bufsz, int prcsn, double dfval) {
   3555  PRIntn decpt, sign, numdigits;
   3556  char *num, *nump;
   3557  char* bufp = buf;
   3558  char* endnum;
   3559  U fval;
   3560 
   3561  dval(fval) = dfval;
   3562  /* If anything fails, we store an empty string in 'buf' */
   3563  num = (char*)PR_MALLOC(bufsz);
   3564  if (num == NULL) {
   3565    buf[0] = '\0';
   3566    return;
   3567  }
   3568  /* XXX Why use mode 1? */
   3569  if (PR_dtoa(dval(fval), 1, prcsn, &decpt, &sign, &endnum, num, bufsz) ==
   3570      PR_FAILURE) {
   3571    buf[0] = '\0';
   3572    goto done;
   3573  }
   3574  numdigits = endnum - num;
   3575  nump = num;
   3576 
   3577  if (sign && !(word0(fval) == Sign_bit && word1(fval) == 0) &&
   3578      !((word0(fval) & Exp_mask) == Exp_mask &&
   3579        (word1(fval) || (word0(fval) & 0xfffff)))) {
   3580    *bufp++ = '-';
   3581  }
   3582 
   3583  if (decpt == 9999) {
   3584    while ((*bufp++ = *nump++) != 0) {
   3585    } /* nothing to execute */
   3586    goto done;
   3587  }
   3588 
   3589  if (decpt > (prcsn + 1) || decpt < -(prcsn - 1) || decpt < -5) {
   3590    *bufp++ = *nump++;
   3591    if (numdigits != 1) {
   3592      *bufp++ = '.';
   3593    }
   3594 
   3595    while (*nump != '\0') {
   3596      *bufp++ = *nump++;
   3597    }
   3598    *bufp++ = 'e';
   3599    PR_snprintf(bufp, bufsz - (bufp - buf), "%+d", decpt - 1);
   3600  } else if (decpt >= 0) {
   3601    if (decpt == 0) {
   3602      *bufp++ = '0';
   3603    } else {
   3604      while (decpt--) {
   3605        if (*nump != '\0') {
   3606          *bufp++ = *nump++;
   3607        } else {
   3608          *bufp++ = '0';
   3609        }
   3610      }
   3611    }
   3612    if (*nump != '\0') {
   3613      *bufp++ = '.';
   3614      while (*nump != '\0') {
   3615        *bufp++ = *nump++;
   3616      }
   3617    }
   3618    *bufp++ = '\0';
   3619  } else if (decpt < 0) {
   3620    *bufp++ = '0';
   3621    *bufp++ = '.';
   3622    while (decpt++) {
   3623      *bufp++ = '0';
   3624    }
   3625 
   3626    while (*nump != '\0') {
   3627      *bufp++ = *nump++;
   3628    }
   3629    *bufp++ = '\0';
   3630  }
   3631 done:
   3632  PR_DELETE(num);
   3633 }