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