Coverage Report

Created: 2025-08-29 06:12

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