iv-phonic 0.1.1 → 0.1.2

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