@port-labs/jq-node-bindings 0.0.1

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