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