bigdecimal 3.0.2 → 3.1.6

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