decimal 0.1.2 → 0.1.3

Sign up to get free protection for your applications and to get access to all the features.
Files changed (8) hide show
  1. checksums.yaml +4 -4
  2. data/README.rdoc +1 -1
  3. data/decimal.gemspec +4 -3
  4. data/depend +1 -1
  5. data/extconf.rb +3 -1
  6. data/inum22.h +1 -1
  7. data/inum23.h +2429 -0
  8. metadata +19 -4
checksums.yaml CHANGED
@@ -1,7 +1,7 @@
1
1
  ---
2
2
  SHA1:
3
- metadata.gz: 185bf749e80766d69e2d39797f59b92ffb861bf2
4
- data.tar.gz: 164920bd3e42a04416ecfd8de3f4dd4da8fa4b46
3
+ metadata.gz: 9056ebdb0f87458d6578905b64cda69569e8721b
4
+ data.tar.gz: 528544416b661660af5a28bb5ffe813ec11357a7
5
5
  SHA512:
6
- metadata.gz: 05482d0f108ca11411f3bf08743253403081ce561c89c1282e54bc8284422853495e58df25072d6ed1317e5e47ad8f142e6ef1244f14645f6cc0db98c9af44ce
7
- data.tar.gz: e2d9b40705dab6daa19e8604b0feae2d1410882a857d2b7db0f21852f5de0acd93b14c2eb59c2f7388e215d4d34282833bcd660f4578b03ec091caf6da119dea
6
+ metadata.gz: cfc74f5c08b9c9f3426ccd804a9918030a908eee361511f3627affbf18a6064d9831e2a2501a6ed62ddc78bd4f761951ce9949e659a3421d978ee527bd4196eb
7
+ data.tar.gz: 2f25fafdb1239544c704293a4a1b7dc1bb31a0f6f45765681c5e9830b84d8838dbdfbac28f982dc20a8a0f377160baeff9d3980059560b074b48ac9eea43546d
@@ -11,7 +11,7 @@ precise, stable and easy-to-use solution.
11
11
 
12
12
  == Requirements
13
13
 
14
- Ruby 1.9.3 / 2.0.0 / 2.1.x / 2.2.x
14
+ Ruby 1.9.3 / 2.0.0 / 2.1.x / 2.2.x / 2.3.x
15
15
 
16
16
  == Install
17
17
 
@@ -1,8 +1,8 @@
1
1
  Gem::Specification.new do |s|
2
2
  s.name = "decimal"
3
- s.version = "0.1.2"
3
+ s.version = "0.1.3"
4
4
  s.summary = "(yet another) multi-precision decimal arithmetic library"
5
- s.description = <<-EOS.split("\n").map{|l|l.lstrip}.join(" ")
5
+ s.description = <<-EOS.split("\n").map(&:lstrip).join(" ")
6
6
  Decimal is (yet another) multi-precision decimal arithmetic library. It
7
7
  provides simple, compact, fast, precise, stable and easy-to-use solution.
8
8
  EOS
@@ -17,11 +17,12 @@ Gem::Specification.new do |s|
17
17
  s.extensions = "extconf.rb"
18
18
  s.files = %w(.document COPYING BSDL INSTALL README.1st README.rdoc TODO decimal.c
19
19
  decimal.gemspec depend extconf.rb inum193.h inum200.h inum21.h inum22.h
20
- ruby18compat.h lib/decimal.rb lib/decimal/math.rb
20
+ inum23.h ruby18compat.h lib/decimal.rb lib/decimal/math.rb
21
21
  test_decimal.rb)
22
22
  s.has_rdoc = true
23
23
  s.rdoc_options = %w(-t Decimal -m README.rdoc)
24
24
  s.extra_rdoc_files = %w(README.rdoc decimal.c)
25
+ s.add_development_dependency 'test-unit', '~> 0'
25
26
 
26
27
  s.post_install_message = "\n\t\t" << IO.read("README.1st") << "\n"
27
28
  end
data/depend CHANGED
@@ -1,3 +1,3 @@
1
- decimal.o: decimal.c inum193.h inum200.h inum21.h inum22.h \
1
+ decimal.o: decimal.c inum193.h inum200.h inum21.h inum22.h inum23.h \
2
2
  $(hdrdir)/ruby.h $(topdir)/config.h $(hdrdir)/defines.h $(hdrdir)/missing.h \
3
3
  $(hdrdir)/intern.h $(hdrdir)/util.h
data/extconf.rb CHANGED
@@ -8,8 +8,10 @@ version = if have_func('rb_gc_mark_threads')
8
8
  '200'
9
9
  elsif have_func('rb_fork')
10
10
  '21'
11
- else
11
+ elsif have_func('rb_quad_pack')
12
12
  '22'
13
+ else
14
+ '23'
13
15
  end
14
16
  $CFLAGS << " -DINUM_SOURCE_FILE=" + %(\\"inum#{version}.h\\")
15
17
 
data/inum22.h CHANGED
@@ -1,5 +1,5 @@
1
1
  /*
2
- * Ruby's Integer part from trunk, rXXXXX.
2
+ * Ruby's Integer part from trunk, r47910.
3
3
  *
4
4
  * These are hand copies (with few modifications) taken from original
5
5
  * Ruby's code in "numeric.c" and "bignum.c," so the copyrights are
@@ -0,0 +1,2429 @@
1
+ /*
2
+ * Ruby's Integer part from trunk, r52118.
3
+ *
4
+ * These are hand copies (with few modifications) taken from original
5
+ * Ruby's code in "numeric.c" and "bignum.c," so the copyrights are
6
+ * held by matz and other contributors:
7
+ *
8
+ * Copyright (C) 1993-2015 Yukihiro Matsumoto
9
+ *
10
+ */
11
+
12
+ /*
13
+ * copied from internal.h
14
+ */
15
+
16
+ #define MUL_OVERFLOW_SIGNED_INTEGER_P(a, b, min, max) ( \
17
+ (a) == 0 ? 0 : \
18
+ (a) == -1 ? (b) < -(max) : \
19
+ (a) > 0 ? \
20
+ ((b) > 0 ? (max) / (a) < (b) : (min) / (a) > (b)) : \
21
+ ((b) > 0 ? (min) / (a) < (b) : (max) / (a) > (b)))
22
+ #define MUL_OVERFLOW_FIXNUM_P(a, b) MUL_OVERFLOW_SIGNED_INTEGER_P(a, b, FIXNUM_MIN, FIXNUM_MAX)
23
+
24
+ #ifndef BDIGIT
25
+ # if SIZEOF_INT*2 <= SIZEOF_LONG_LONG
26
+ # define BDIGIT unsigned int
27
+ # define SIZEOF_BDIGIT SIZEOF_INT
28
+ # define BDIGIT_DBL unsigned LONG_LONG
29
+ # define BDIGIT_DBL_SIGNED LONG_LONG
30
+ # define PRI_BDIGIT_PREFIX ""
31
+ # define PRI_BDIGIT_DBL_PREFIX PRI_LL_PREFIX
32
+ # elif SIZEOF_INT*2 <= SIZEOF_LONG
33
+ # define BDIGIT unsigned int
34
+ # define SIZEOF_BDIGIT SIZEOF_INT
35
+ # define BDIGIT_DBL unsigned long
36
+ # define BDIGIT_DBL_SIGNED long
37
+ # define PRI_BDIGIT_PREFIX ""
38
+ # define PRI_BDIGIT_DBL_PREFIX "l"
39
+ # elif SIZEOF_SHORT*2 <= SIZEOF_LONG
40
+ # define BDIGIT unsigned short
41
+ # define SIZEOF_BDIGIT SIZEOF_SHORT
42
+ # define BDIGIT_DBL unsigned long
43
+ # define BDIGIT_DBL_SIGNED long
44
+ # define PRI_BDIGIT_PREFIX "h"
45
+ # define PRI_BDIGIT_DBL_PREFIX "l"
46
+ # else
47
+ # define BDIGIT unsigned short
48
+ # define SIZEOF_BDIGIT (SIZEOF_LONG/2)
49
+ # define SIZEOF_ACTUAL_BDIGIT SIZEOF_LONG
50
+ # define BDIGIT_DBL unsigned long
51
+ # define BDIGIT_DBL_SIGNED long
52
+ # define PRI_BDIGIT_PREFIX "h"
53
+ # define PRI_BDIGIT_DBL_PREFIX "l"
54
+ # endif
55
+ #endif
56
+ #ifndef SIZEOF_ACTUAL_BDIGIT
57
+ # define SIZEOF_ACTUAL_BDIGIT SIZEOF_BDIGIT
58
+ #endif
59
+
60
+ #define BIGNUM_EMBED_LEN_NUMBITS 3
61
+ #ifndef BIGNUM_EMBED_LEN_MAX
62
+ # if (SIZEOF_VALUE*3/SIZEOF_ACTUAL_BDIGIT) < (1 << BIGNUM_EMBED_LEN_NUMBITS)-1
63
+ # define BIGNUM_EMBED_LEN_MAX (SIZEOF_VALUE*3/SIZEOF_ACTUAL_BDIGIT)
64
+ # else
65
+ # define BIGNUM_EMBED_LEN_MAX ((1 << BIGNUM_EMBED_LEN_NUMBITS)-1)
66
+ # endif
67
+ #endif
68
+
69
+ struct RBignum {
70
+ struct RBasic basic;
71
+ union {
72
+ struct {
73
+ size_t len;
74
+ BDIGIT *digits;
75
+ } heap;
76
+ BDIGIT ary[BIGNUM_EMBED_LEN_MAX];
77
+ } as;
78
+ };
79
+ #define BIGNUM_SIGN_BIT FL_USER1
80
+ /* sign: positive:1, negative:0 */
81
+ #define BIGNUM_SIGN(b) ((RBASIC(b)->flags & BIGNUM_SIGN_BIT) != 0)
82
+ #define BIGNUM_SET_SIGN(b,sign) \
83
+ ((sign) ? (RBASIC(b)->flags |= BIGNUM_SIGN_BIT) \
84
+ : (RBASIC(b)->flags &= ~BIGNUM_SIGN_BIT))
85
+ #define BIGNUM_POSITIVE_P(b) BIGNUM_SIGN(b)
86
+ #define BIGNUM_NEGATIVE_P(b) (!BIGNUM_SIGN(b))
87
+
88
+ #define BIGNUM_EMBED_FLAG FL_USER2
89
+ #define BIGNUM_EMBED_LEN_MASK (FL_USER5|FL_USER4|FL_USER3)
90
+ #define BIGNUM_EMBED_LEN_SHIFT (FL_USHIFT+BIGNUM_EMBED_LEN_NUMBITS)
91
+ #define BIGNUM_LEN(b) \
92
+ ((RBASIC(b)->flags & BIGNUM_EMBED_FLAG) ? \
93
+ (long)((RBASIC(b)->flags >> BIGNUM_EMBED_LEN_SHIFT) & \
94
+ (BIGNUM_EMBED_LEN_MASK >> BIGNUM_EMBED_LEN_SHIFT)) : \
95
+ RBIGNUM(b)->as.heap.len)
96
+ /* LSB:BIGNUM_DIGITS(b)[0], MSB:BIGNUM_DIGITS(b)[BIGNUM_LEN(b)-1] */
97
+ #define BIGNUM_DIGITS(b) \
98
+ ((RBASIC(b)->flags & BIGNUM_EMBED_FLAG) ? \
99
+ RBIGNUM(b)->as.ary : \
100
+ RBIGNUM(b)->as.heap.digits)
101
+
102
+ #define RBIGNUM(obj) (R_CAST(RBignum)(obj))
103
+
104
+ /*
105
+ * copied from util.c
106
+ */
107
+
108
+ #include <errno.h>
109
+
110
+ #ifdef WORDS_BIGENDIAN
111
+ #define IEEE_BIG_ENDIAN
112
+ #else
113
+ #define IEEE_LITTLE_ENDIAN
114
+ #endif
115
+
116
+ #ifdef __vax__
117
+ #define VAX
118
+ #undef IEEE_BIG_ENDIAN
119
+ #undef IEEE_LITTLE_ENDIAN
120
+ #endif
121
+
122
+ #if defined(__arm__) && !defined(__VFP_FP__)
123
+ #define IEEE_BIG_ENDIAN
124
+ #undef IEEE_LITTLE_ENDIAN
125
+ #endif
126
+
127
+ #undef Long
128
+ #undef ULong
129
+
130
+ #if SIZEOF_INT == 4
131
+ #define Long int
132
+ #define ULong unsigned int
133
+ #elif SIZEOF_LONG == 4
134
+ #define Long long int
135
+ #define ULong unsigned long int
136
+ #endif
137
+
138
+ #if HAVE_LONG_LONG
139
+ #define Llong LONG_LONG
140
+ #endif
141
+
142
+ #ifdef DEBUG
143
+ #include "stdio.h"
144
+ #define Bug(x) {fprintf(stderr, "%s\n", (x)); exit(EXIT_FAILURE);}
145
+ #endif
146
+
147
+ #include "stdlib.h"
148
+ #include "string.h"
149
+
150
+ #ifdef USE_LOCALE
151
+ #include "locale.h"
152
+ #endif
153
+
154
+ #ifdef MALLOC
155
+ extern void *MALLOC(size_t);
156
+ #else
157
+ #define MALLOC malloc
158
+ #endif
159
+ #ifdef FREE
160
+ extern void FREE(void*);
161
+ #else
162
+ #define FREE free
163
+ #endif
164
+
165
+ #ifndef Omit_Private_Memory
166
+ #ifndef PRIVATE_MEM
167
+ #define PRIVATE_MEM 2304
168
+ #endif
169
+ #define PRIVATE_mem ((PRIVATE_MEM+sizeof(double)-1)/sizeof(double))
170
+ static double private_mem[PRIVATE_mem], *pmem_next = private_mem;
171
+ #endif
172
+
173
+ #undef IEEE_Arith
174
+ #undef Avoid_Underflow
175
+ #ifdef IEEE_BIG_ENDIAN
176
+ #define IEEE_Arith
177
+ #endif
178
+ #ifdef IEEE_LITTLE_ENDIAN
179
+ #define IEEE_Arith
180
+ #endif
181
+
182
+ #ifdef Bad_float_h
183
+
184
+ #ifdef IEEE_Arith
185
+ #define DBL_DIG 15
186
+ #define DBL_MAX_10_EXP 308
187
+ #define DBL_MAX_EXP 1024
188
+ #define FLT_RADIX 2
189
+ #endif /*IEEE_Arith*/
190
+
191
+ #ifdef IBM
192
+ #define DBL_DIG 16
193
+ #define DBL_MAX_10_EXP 75
194
+ #define DBL_MAX_EXP 63
195
+ #define FLT_RADIX 16
196
+ #define DBL_MAX 7.2370055773322621e+75
197
+ #endif
198
+
199
+ #ifdef VAX
200
+ #define DBL_DIG 16
201
+ #define DBL_MAX_10_EXP 38
202
+ #define DBL_MAX_EXP 127
203
+ #define FLT_RADIX 2
204
+ #define DBL_MAX 1.7014118346046923e+38
205
+ #endif
206
+
207
+ #ifndef LONG_MAX
208
+ #define LONG_MAX 2147483647
209
+ #endif
210
+
211
+ #else /* ifndef Bad_float_h */
212
+ #include "float.h"
213
+ #endif /* Bad_float_h */
214
+
215
+ #ifndef __MATH_H__
216
+ #include "math.h"
217
+ #endif
218
+
219
+ #ifdef __cplusplus
220
+ extern "C" {
221
+ #if 0
222
+ } /* satisfy cc-mode */
223
+ #endif
224
+ #endif
225
+
226
+ #if defined(IEEE_LITTLE_ENDIAN) + defined(IEEE_BIG_ENDIAN) + defined(VAX) + defined(IBM) != 1
227
+ Exactly one of IEEE_LITTLE_ENDIAN, IEEE_BIG_ENDIAN, VAX, or IBM should be defined.
228
+ #endif
229
+
230
+ typedef union { double d; ULong L[2]; } U;
231
+
232
+ #ifdef YES_ALIAS
233
+ typedef double double_u;
234
+ # define dval(x) (x)
235
+ # ifdef IEEE_LITTLE_ENDIAN
236
+ # define word0(x) (((ULong *)&(x))[1])
237
+ # define word1(x) (((ULong *)&(x))[0])
238
+ # else
239
+ # define word0(x) (((ULong *)&(x))[0])
240
+ # define word1(x) (((ULong *)&(x))[1])
241
+ # endif
242
+ #else
243
+ typedef U double_u;
244
+ # ifdef IEEE_LITTLE_ENDIAN
245
+ # define word0(x) ((x).L[1])
246
+ # define word1(x) ((x).L[0])
247
+ # else
248
+ # define word0(x) ((x).L[0])
249
+ # define word1(x) ((x).L[1])
250
+ # endif
251
+ # define dval(x) ((x).d)
252
+ #endif
253
+
254
+ /* The following definition of Storeinc is appropriate for MIPS processors.
255
+ * An alternative that might be better on some machines is
256
+ * #define Storeinc(a,b,c) (*a++ = b << 16 | c & 0xffff)
257
+ */
258
+ #if defined(IEEE_LITTLE_ENDIAN) + defined(VAX) + defined(__arm__)
259
+ #define Storeinc(a,b,c) (((unsigned short *)(a))[1] = (unsigned short)(b), \
260
+ ((unsigned short *)(a))[0] = (unsigned short)(c), (a)++)
261
+ #else
262
+ #define Storeinc(a,b,c) (((unsigned short *)(a))[0] = (unsigned short)(b), \
263
+ ((unsigned short *)(a))[1] = (unsigned short)(c), (a)++)
264
+ #endif
265
+
266
+ /* #define P DBL_MANT_DIG */
267
+ /* Ten_pmax = floor(P*log(2)/log(5)) */
268
+ /* Bletch = (highest power of 2 < DBL_MAX_10_EXP) / 16 */
269
+ /* Quick_max = floor((P-1)*log(FLT_RADIX)/log(10) - 1) */
270
+ /* Int_max = floor(P*log(FLT_RADIX)/log(10) - 1) */
271
+
272
+ #ifdef IEEE_Arith
273
+ #define Exp_shift 20
274
+ #define Exp_shift1 20
275
+ #define Exp_msk1 0x100000
276
+ #define Exp_msk11 0x100000
277
+ #define Exp_mask 0x7ff00000
278
+ #define P 53
279
+ #define Bias 1023
280
+ #define Emin (-1022)
281
+ #define Exp_1 0x3ff00000
282
+ #define Exp_11 0x3ff00000
283
+ #define Ebits 11
284
+ #define Frac_mask 0xfffff
285
+ #define Frac_mask1 0xfffff
286
+ #define Ten_pmax 22
287
+ #define Bletch 0x10
288
+ #define Bndry_mask 0xfffff
289
+ #define Bndry_mask1 0xfffff
290
+ #define LSB 1
291
+ #define Sign_bit 0x80000000
292
+ #define Log2P 1
293
+ #define Tiny0 0
294
+ #define Tiny1 1
295
+ #define Quick_max 14
296
+ #define Int_max 14
297
+ #ifndef NO_IEEE_Scale
298
+ #define Avoid_Underflow
299
+ #ifdef Flush_Denorm /* debugging option */
300
+ #undef Sudden_Underflow
301
+ #endif
302
+ #endif
303
+
304
+ #ifndef Flt_Rounds
305
+ #ifdef FLT_ROUNDS
306
+ #define Flt_Rounds FLT_ROUNDS
307
+ #else
308
+ #define Flt_Rounds 1
309
+ #endif
310
+ #endif /*Flt_Rounds*/
311
+
312
+ #ifdef Honor_FLT_ROUNDS
313
+ #define Rounding rounding
314
+ #undef Check_FLT_ROUNDS
315
+ #define Check_FLT_ROUNDS
316
+ #else
317
+ #define Rounding Flt_Rounds
318
+ #endif
319
+
320
+ #else /* ifndef IEEE_Arith */
321
+ #undef Check_FLT_ROUNDS
322
+ #undef Honor_FLT_ROUNDS
323
+ #undef SET_INEXACT
324
+ #undef Sudden_Underflow
325
+ #define Sudden_Underflow
326
+ #ifdef IBM
327
+ #undef Flt_Rounds
328
+ #define Flt_Rounds 0
329
+ #define Exp_shift 24
330
+ #define Exp_shift1 24
331
+ #define Exp_msk1 0x1000000
332
+ #define Exp_msk11 0x1000000
333
+ #define Exp_mask 0x7f000000
334
+ #define P 14
335
+ #define Bias 65
336
+ #define Exp_1 0x41000000
337
+ #define Exp_11 0x41000000
338
+ #define Ebits 8 /* exponent has 7 bits, but 8 is the right value in b2d */
339
+ #define Frac_mask 0xffffff
340
+ #define Frac_mask1 0xffffff
341
+ #define Bletch 4
342
+ #define Ten_pmax 22
343
+ #define Bndry_mask 0xefffff
344
+ #define Bndry_mask1 0xffffff
345
+ #define LSB 1
346
+ #define Sign_bit 0x80000000
347
+ #define Log2P 4
348
+ #define Tiny0 0x100000
349
+ #define Tiny1 0
350
+ #define Quick_max 14
351
+ #define Int_max 15
352
+ #else /* VAX */
353
+ #undef Flt_Rounds
354
+ #define Flt_Rounds 1
355
+ #define Exp_shift 23
356
+ #define Exp_shift1 7
357
+ #define Exp_msk1 0x80
358
+ #define Exp_msk11 0x800000
359
+ #define Exp_mask 0x7f80
360
+ #define P 56
361
+ #define Bias 129
362
+ #define Exp_1 0x40800000
363
+ #define Exp_11 0x4080
364
+ #define Ebits 8
365
+ #define Frac_mask 0x7fffff
366
+ #define Frac_mask1 0xffff007f
367
+ #define Ten_pmax 24
368
+ #define Bletch 2
369
+ #define Bndry_mask 0xffff007f
370
+ #define Bndry_mask1 0xffff007f
371
+ #define LSB 0x10000
372
+ #define Sign_bit 0x8000
373
+ #define Log2P 1
374
+ #define Tiny0 0x80
375
+ #define Tiny1 0
376
+ #define Quick_max 15
377
+ #define Int_max 15
378
+ #endif /* IBM, VAX */
379
+ #endif /* IEEE_Arith */
380
+
381
+ #ifndef IEEE_Arith
382
+ #define ROUND_BIASED
383
+ #endif
384
+
385
+ #ifdef RND_PRODQUOT
386
+ #define rounded_product(a,b) ((a) = rnd_prod((a), (b)))
387
+ #define rounded_quotient(a,b) ((a) = rnd_quot((a), (b)))
388
+ extern double rnd_prod(double, double), rnd_quot(double, double);
389
+ #else
390
+ #define rounded_product(a,b) ((a) *= (b))
391
+ #define rounded_quotient(a,b) ((a) /= (b))
392
+ #endif
393
+
394
+ #define Big0 (Frac_mask1 | Exp_msk1*(DBL_MAX_EXP+Bias-1))
395
+ #define Big1 0xffffffff
396
+
397
+ #ifndef Pack_32
398
+ #define Pack_32
399
+ #endif
400
+
401
+ #define FFFFFFFF 0xffffffffUL
402
+
403
+ #ifdef NO_LONG_LONG
404
+ #undef ULLong
405
+ #ifdef Just_16
406
+ #undef Pack_32
407
+ /* When Pack_32 is not defined, we store 16 bits per 32-bit Long.
408
+ * This makes some inner loops simpler and sometimes saves work
409
+ * during multiplications, but it often seems to make things slightly
410
+ * slower. Hence the default is now to store 32 bits per Long.
411
+ */
412
+ #endif
413
+ #else /* long long available */
414
+ #ifndef Llong
415
+ #define Llong long long
416
+ #endif
417
+ #ifndef ULLong
418
+ #define ULLong unsigned Llong
419
+ #endif
420
+ #endif /* NO_LONG_LONG */
421
+
422
+ #define MULTIPLE_THREADS 1
423
+
424
+ #ifndef MULTIPLE_THREADS
425
+ #define ACQUIRE_DTOA_LOCK(n) /*nothing*/
426
+ #define FREE_DTOA_LOCK(n) /*nothing*/
427
+ #else
428
+ #define ACQUIRE_DTOA_LOCK(n) /*unused right now*/
429
+ #define FREE_DTOA_LOCK(n) /*unused right now*/
430
+ #endif
431
+
432
+ #define Kmax 15
433
+
434
+ struct Bigint {
435
+ struct Bigint *next;
436
+ int k, maxwds, sign, wds;
437
+ ULong x[1];
438
+ };
439
+
440
+ typedef struct Bigint Bigint;
441
+
442
+ static Bigint *freelist[Kmax+1];
443
+
444
+ static Bigint *
445
+ Balloc(int k)
446
+ {
447
+ int x;
448
+ Bigint *rv;
449
+ #ifndef Omit_Private_Memory
450
+ size_t len;
451
+ #endif
452
+
453
+ ACQUIRE_DTOA_LOCK(0);
454
+ if (k <= Kmax && (rv = freelist[k]) != 0) {
455
+ freelist[k] = rv->next;
456
+ }
457
+ else {
458
+ x = 1 << k;
459
+ #ifdef Omit_Private_Memory
460
+ rv = (Bigint *)MALLOC(sizeof(Bigint) + (x-1)*sizeof(ULong));
461
+ #else
462
+ len = (sizeof(Bigint) + (x-1)*sizeof(ULong) + sizeof(double) - 1)
463
+ /sizeof(double);
464
+ if (k <= Kmax && pmem_next - private_mem + len <= PRIVATE_mem) {
465
+ rv = (Bigint*)pmem_next;
466
+ pmem_next += len;
467
+ }
468
+ else
469
+ rv = (Bigint*)MALLOC(len*sizeof(double));
470
+ #endif
471
+ rv->k = k;
472
+ rv->maxwds = x;
473
+ }
474
+ FREE_DTOA_LOCK(0);
475
+ rv->sign = rv->wds = 0;
476
+ return rv;
477
+ }
478
+
479
+ static void
480
+ Bfree(Bigint *v)
481
+ {
482
+ if (v) {
483
+ if (v->k > Kmax) {
484
+ FREE(v);
485
+ return;
486
+ }
487
+ ACQUIRE_DTOA_LOCK(0);
488
+ v->next = freelist[v->k];
489
+ freelist[v->k] = v;
490
+ FREE_DTOA_LOCK(0);
491
+ }
492
+ }
493
+
494
+ #define Bcopy(x,y) memcpy((char *)&(x)->sign, (char *)&(y)->sign, \
495
+ (y)->wds*sizeof(Long) + 2*sizeof(int))
496
+
497
+ static Bigint *
498
+ multadd(Bigint *b, int m, int a) /* multiply by m and add a */
499
+ {
500
+ int i, wds;
501
+ ULong *x;
502
+ #ifdef ULLong
503
+ ULLong carry, y;
504
+ #else
505
+ ULong carry, y;
506
+ #ifdef Pack_32
507
+ ULong xi, z;
508
+ #endif
509
+ #endif
510
+ Bigint *b1;
511
+
512
+ wds = b->wds;
513
+ x = b->x;
514
+ i = 0;
515
+ carry = a;
516
+ do {
517
+ #ifdef ULLong
518
+ y = *x * (ULLong)m + carry;
519
+ carry = y >> 32;
520
+ *x++ = (ULong)(y & FFFFFFFF);
521
+ #else
522
+ #ifdef Pack_32
523
+ xi = *x;
524
+ y = (xi & 0xffff) * m + carry;
525
+ z = (xi >> 16) * m + (y >> 16);
526
+ carry = z >> 16;
527
+ *x++ = (z << 16) + (y & 0xffff);
528
+ #else
529
+ y = *x * m + carry;
530
+ carry = y >> 16;
531
+ *x++ = y & 0xffff;
532
+ #endif
533
+ #endif
534
+ } while (++i < wds);
535
+ if (carry) {
536
+ if (wds >= b->maxwds) {
537
+ b1 = Balloc(b->k+1);
538
+ Bcopy(b1, b);
539
+ Bfree(b);
540
+ b = b1;
541
+ }
542
+ b->x[wds++] = (ULong)carry;
543
+ b->wds = wds;
544
+ }
545
+ return b;
546
+ }
547
+
548
+ /* removed: s2b() */
549
+
550
+ static int
551
+ hi0bits(register ULong x)
552
+ {
553
+ register int k = 0;
554
+
555
+ if (!(x & 0xffff0000)) {
556
+ k = 16;
557
+ x <<= 16;
558
+ }
559
+ if (!(x & 0xff000000)) {
560
+ k += 8;
561
+ x <<= 8;
562
+ }
563
+ if (!(x & 0xf0000000)) {
564
+ k += 4;
565
+ x <<= 4;
566
+ }
567
+ if (!(x & 0xc0000000)) {
568
+ k += 2;
569
+ x <<= 2;
570
+ }
571
+ if (!(x & 0x80000000)) {
572
+ k++;
573
+ if (!(x & 0x40000000))
574
+ return 32;
575
+ }
576
+ return k;
577
+ }
578
+
579
+ static int
580
+ lo0bits(ULong *y)
581
+ {
582
+ register int k;
583
+ register ULong x = *y;
584
+
585
+ if (x & 7) {
586
+ if (x & 1)
587
+ return 0;
588
+ if (x & 2) {
589
+ *y = x >> 1;
590
+ return 1;
591
+ }
592
+ *y = x >> 2;
593
+ return 2;
594
+ }
595
+ k = 0;
596
+ if (!(x & 0xffff)) {
597
+ k = 16;
598
+ x >>= 16;
599
+ }
600
+ if (!(x & 0xff)) {
601
+ k += 8;
602
+ x >>= 8;
603
+ }
604
+ if (!(x & 0xf)) {
605
+ k += 4;
606
+ x >>= 4;
607
+ }
608
+ if (!(x & 0x3)) {
609
+ k += 2;
610
+ x >>= 2;
611
+ }
612
+ if (!(x & 1)) {
613
+ k++;
614
+ x >>= 1;
615
+ if (!x)
616
+ return 32;
617
+ }
618
+ *y = x;
619
+ return k;
620
+ }
621
+
622
+ static Bigint *
623
+ i2b(int i)
624
+ {
625
+ Bigint *b;
626
+
627
+ b = Balloc(1);
628
+ b->x[0] = i;
629
+ b->wds = 1;
630
+ return b;
631
+ }
632
+
633
+ static Bigint *
634
+ mult(Bigint *a, Bigint *b)
635
+ {
636
+ Bigint *c;
637
+ int k, wa, wb, wc;
638
+ ULong *x, *xa, *xae, *xb, *xbe, *xc, *xc0;
639
+ ULong y;
640
+ #ifdef ULLong
641
+ ULLong carry, z;
642
+ #else
643
+ ULong carry, z;
644
+ #ifdef Pack_32
645
+ ULong z2;
646
+ #endif
647
+ #endif
648
+
649
+ if (a->wds < b->wds) {
650
+ c = a;
651
+ a = b;
652
+ b = c;
653
+ }
654
+ k = a->k;
655
+ wa = a->wds;
656
+ wb = b->wds;
657
+ wc = wa + wb;
658
+ if (wc > a->maxwds)
659
+ k++;
660
+ c = Balloc(k);
661
+ for (x = c->x, xa = x + wc; x < xa; x++)
662
+ *x = 0;
663
+ xa = a->x;
664
+ xae = xa + wa;
665
+ xb = b->x;
666
+ xbe = xb + wb;
667
+ xc0 = c->x;
668
+ #ifdef ULLong
669
+ for (; xb < xbe; xc0++) {
670
+ if ((y = *xb++) != 0) {
671
+ x = xa;
672
+ xc = xc0;
673
+ carry = 0;
674
+ do {
675
+ z = *x++ * (ULLong)y + *xc + carry;
676
+ carry = z >> 32;
677
+ *xc++ = (ULong)(z & FFFFFFFF);
678
+ } while (x < xae);
679
+ *xc = (ULong)carry;
680
+ }
681
+ }
682
+ #else
683
+ #ifdef Pack_32
684
+ for (; xb < xbe; xb++, xc0++) {
685
+ if (y = *xb & 0xffff) {
686
+ x = xa;
687
+ xc = xc0;
688
+ carry = 0;
689
+ do {
690
+ z = (*x & 0xffff) * y + (*xc & 0xffff) + carry;
691
+ carry = z >> 16;
692
+ z2 = (*x++ >> 16) * y + (*xc >> 16) + carry;
693
+ carry = z2 >> 16;
694
+ Storeinc(xc, z2, z);
695
+ } while (x < xae);
696
+ *xc = (ULong)carry;
697
+ }
698
+ if (y = *xb >> 16) {
699
+ x = xa;
700
+ xc = xc0;
701
+ carry = 0;
702
+ z2 = *xc;
703
+ do {
704
+ z = (*x & 0xffff) * y + (*xc >> 16) + carry;
705
+ carry = z >> 16;
706
+ Storeinc(xc, z, z2);
707
+ z2 = (*x++ >> 16) * y + (*xc & 0xffff) + carry;
708
+ carry = z2 >> 16;
709
+ } while (x < xae);
710
+ *xc = z2;
711
+ }
712
+ }
713
+ #else
714
+ for (; xb < xbe; xc0++) {
715
+ if (y = *xb++) {
716
+ x = xa;
717
+ xc = xc0;
718
+ carry = 0;
719
+ do {
720
+ z = *x++ * y + *xc + carry;
721
+ carry = z >> 16;
722
+ *xc++ = z & 0xffff;
723
+ } while (x < xae);
724
+ *xc = (ULong)carry;
725
+ }
726
+ }
727
+ #endif
728
+ #endif
729
+ for (xc0 = c->x, xc = xc0 + wc; wc > 0 && !*--xc; --wc) ;
730
+ c->wds = wc;
731
+ return c;
732
+ }
733
+
734
+ static Bigint *p5s;
735
+
736
+ static Bigint *
737
+ pow5mult(Bigint *b, int k)
738
+ {
739
+ Bigint *b1, *p5, *p51;
740
+ int i;
741
+ static int p05[3] = { 5, 25, 125 };
742
+
743
+ if ((i = k & 3) != 0)
744
+ b = multadd(b, p05[i-1], 0);
745
+
746
+ if (!(k >>= 2))
747
+ return b;
748
+ if (!(p5 = p5s)) {
749
+ /* first time */
750
+ #ifdef MULTIPLE_THREADS
751
+ ACQUIRE_DTOA_LOCK(1);
752
+ if (!(p5 = p5s)) {
753
+ p5 = p5s = i2b(625);
754
+ p5->next = 0;
755
+ }
756
+ FREE_DTOA_LOCK(1);
757
+ #else
758
+ p5 = p5s = i2b(625);
759
+ p5->next = 0;
760
+ #endif
761
+ }
762
+ for (;;) {
763
+ if (k & 1) {
764
+ b1 = mult(b, p5);
765
+ Bfree(b);
766
+ b = b1;
767
+ }
768
+ if (!(k >>= 1))
769
+ break;
770
+ if (!(p51 = p5->next)) {
771
+ #ifdef MULTIPLE_THREADS
772
+ ACQUIRE_DTOA_LOCK(1);
773
+ if (!(p51 = p5->next)) {
774
+ p51 = p5->next = mult(p5,p5);
775
+ p51->next = 0;
776
+ }
777
+ FREE_DTOA_LOCK(1);
778
+ #else
779
+ p51 = p5->next = mult(p5,p5);
780
+ p51->next = 0;
781
+ #endif
782
+ }
783
+ p5 = p51;
784
+ }
785
+ return b;
786
+ }
787
+
788
+ static Bigint *
789
+ lshift(Bigint *b, int k)
790
+ {
791
+ int i, k1, n, n1;
792
+ Bigint *b1;
793
+ ULong *x, *x1, *xe, z;
794
+
795
+ #ifdef Pack_32
796
+ n = k >> 5;
797
+ #else
798
+ n = k >> 4;
799
+ #endif
800
+ k1 = b->k;
801
+ n1 = n + b->wds + 1;
802
+ for (i = b->maxwds; n1 > i; i <<= 1)
803
+ k1++;
804
+ b1 = Balloc(k1);
805
+ x1 = b1->x;
806
+ for (i = 0; i < n; i++)
807
+ *x1++ = 0;
808
+ x = b->x;
809
+ xe = x + b->wds;
810
+ #ifdef Pack_32
811
+ if (k &= 0x1f) {
812
+ k1 = 32 - k;
813
+ z = 0;
814
+ do {
815
+ *x1++ = *x << k | z;
816
+ z = *x++ >> k1;
817
+ } while (x < xe);
818
+ if ((*x1 = z) != 0)
819
+ ++n1;
820
+ }
821
+ #else
822
+ if (k &= 0xf) {
823
+ k1 = 16 - k;
824
+ z = 0;
825
+ do {
826
+ *x1++ = *x << k & 0xffff | z;
827
+ z = *x++ >> k1;
828
+ } while (x < xe);
829
+ if (*x1 = z)
830
+ ++n1;
831
+ }
832
+ #endif
833
+ else
834
+ do {
835
+ *x1++ = *x++;
836
+ } while (x < xe);
837
+ b1->wds = n1 - 1;
838
+ Bfree(b);
839
+ return b1;
840
+ }
841
+
842
+ /* renamed from cmp() */
843
+ static int
844
+ bicmp(Bigint *a, Bigint *b)
845
+ {
846
+ ULong *xa, *xa0, *xb, *xb0;
847
+ int i, j;
848
+
849
+ i = a->wds;
850
+ j = b->wds;
851
+ #ifdef DEBUG
852
+ if (i > 1 && !a->x[i-1])
853
+ Bug("bicmp called with a->x[a->wds-1] == 0");
854
+ if (j > 1 && !b->x[j-1])
855
+ Bug("bicmp called with b->x[b->wds-1] == 0");
856
+ #endif
857
+ if (i -= j)
858
+ return i;
859
+ xa0 = a->x;
860
+ xa = xa0 + j;
861
+ xb0 = b->x;
862
+ xb = xb0 + j;
863
+ for (;;) {
864
+ if (*--xa != *--xb)
865
+ return *xa < *xb ? -1 : 1;
866
+ if (xa <= xa0)
867
+ break;
868
+ }
869
+ return 0;
870
+ }
871
+
872
+ static Bigint *
873
+ diff(Bigint *a, Bigint *b)
874
+ {
875
+ Bigint *c;
876
+ int i, wa, wb;
877
+ ULong *xa, *xae, *xb, *xbe, *xc;
878
+ #ifdef ULLong
879
+ ULLong borrow, y;
880
+ #else
881
+ ULong borrow, y;
882
+ #ifdef Pack_32
883
+ ULong z;
884
+ #endif
885
+ #endif
886
+
887
+ i = bicmp(a,b);
888
+ if (!i) {
889
+ c = Balloc(0);
890
+ c->wds = 1;
891
+ c->x[0] = 0;
892
+ return c;
893
+ }
894
+ if (i < 0) {
895
+ c = a;
896
+ a = b;
897
+ b = c;
898
+ i = 1;
899
+ }
900
+ else
901
+ i = 0;
902
+ c = Balloc(a->k);
903
+ c->sign = i;
904
+ wa = a->wds;
905
+ xa = a->x;
906
+ xae = xa + wa;
907
+ wb = b->wds;
908
+ xb = b->x;
909
+ xbe = xb + wb;
910
+ xc = c->x;
911
+ borrow = 0;
912
+ #ifdef ULLong
913
+ do {
914
+ y = (ULLong)*xa++ - *xb++ - borrow;
915
+ borrow = y >> 32 & (ULong)1;
916
+ *xc++ = (ULong)(y & FFFFFFFF);
917
+ } while (xb < xbe);
918
+ while (xa < xae) {
919
+ y = *xa++ - borrow;
920
+ borrow = y >> 32 & (ULong)1;
921
+ *xc++ = (ULong)(y & FFFFFFFF);
922
+ }
923
+ #else
924
+ #ifdef Pack_32
925
+ do {
926
+ y = (*xa & 0xffff) - (*xb & 0xffff) - borrow;
927
+ borrow = (y & 0x10000) >> 16;
928
+ z = (*xa++ >> 16) - (*xb++ >> 16) - borrow;
929
+ borrow = (z & 0x10000) >> 16;
930
+ Storeinc(xc, z, y);
931
+ } while (xb < xbe);
932
+ while (xa < xae) {
933
+ y = (*xa & 0xffff) - borrow;
934
+ borrow = (y & 0x10000) >> 16;
935
+ z = (*xa++ >> 16) - borrow;
936
+ borrow = (z & 0x10000) >> 16;
937
+ Storeinc(xc, z, y);
938
+ }
939
+ #else
940
+ do {
941
+ y = *xa++ - *xb++ - borrow;
942
+ borrow = (y & 0x10000) >> 16;
943
+ *xc++ = y & 0xffff;
944
+ } while (xb < xbe);
945
+ while (xa < xae) {
946
+ y = *xa++ - borrow;
947
+ borrow = (y & 0x10000) >> 16;
948
+ *xc++ = y & 0xffff;
949
+ }
950
+ #endif
951
+ #endif
952
+ while (!*--xc)
953
+ wa--;
954
+ c->wds = wa;
955
+ return c;
956
+ }
957
+
958
+ /* removed: ulp(), b2d() */
959
+
960
+ static Bigint *
961
+ d2b(double d_, int *e, int *bits)
962
+ {
963
+ double_u d;
964
+ Bigint *b;
965
+ int de, k;
966
+ ULong *x, y, z;
967
+ #ifndef Sudden_Underflow
968
+ int i;
969
+ #endif
970
+ #ifdef VAX
971
+ ULong d0, d1;
972
+ #endif
973
+ dval(d) = d_;
974
+ #ifdef VAX
975
+ d0 = word0(d) >> 16 | word0(d) << 16;
976
+ d1 = word1(d) >> 16 | word1(d) << 16;
977
+ #else
978
+ #define d0 word0(d)
979
+ #define d1 word1(d)
980
+ #endif
981
+
982
+ #ifdef Pack_32
983
+ b = Balloc(1);
984
+ #else
985
+ b = Balloc(2);
986
+ #endif
987
+ x = b->x;
988
+
989
+ z = d0 & Frac_mask;
990
+ d0 &= 0x7fffffff; /* clear sign bit, which we ignore */
991
+ #ifdef Sudden_Underflow
992
+ de = (int)(d0 >> Exp_shift);
993
+ #ifndef IBM
994
+ z |= Exp_msk11;
995
+ #endif
996
+ #else
997
+ if ((de = (int)(d0 >> Exp_shift)) != 0)
998
+ z |= Exp_msk1;
999
+ #endif
1000
+ #ifdef Pack_32
1001
+ if ((y = d1) != 0) {
1002
+ if ((k = lo0bits(&y)) != 0) {
1003
+ x[0] = y | z << (32 - k);
1004
+ z >>= k;
1005
+ }
1006
+ else
1007
+ x[0] = y;
1008
+ #ifndef Sudden_Underflow
1009
+ i =
1010
+ #endif
1011
+ b->wds = (x[1] = z) ? 2 : 1;
1012
+ }
1013
+ else {
1014
+ #ifdef DEBUG
1015
+ if (!z)
1016
+ Bug("Zero passed to d2b");
1017
+ #endif
1018
+ k = lo0bits(&z);
1019
+ x[0] = z;
1020
+ #ifndef Sudden_Underflow
1021
+ i =
1022
+ #endif
1023
+ b->wds = 1;
1024
+ k += 32;
1025
+ }
1026
+ #else
1027
+ if (y = d1) {
1028
+ if (k = lo0bits(&y))
1029
+ if (k >= 16) {
1030
+ x[0] = y | z << 32 - k & 0xffff;
1031
+ x[1] = z >> k - 16 & 0xffff;
1032
+ x[2] = z >> k;
1033
+ i = 2;
1034
+ }
1035
+ else {
1036
+ x[0] = y & 0xffff;
1037
+ x[1] = y >> 16 | z << 16 - k & 0xffff;
1038
+ x[2] = z >> k & 0xffff;
1039
+ x[3] = z >> k+16;
1040
+ i = 3;
1041
+ }
1042
+ else {
1043
+ x[0] = y & 0xffff;
1044
+ x[1] = y >> 16;
1045
+ x[2] = z & 0xffff;
1046
+ x[3] = z >> 16;
1047
+ i = 3;
1048
+ }
1049
+ }
1050
+ else {
1051
+ #ifdef DEBUG
1052
+ if (!z)
1053
+ Bug("Zero passed to d2b");
1054
+ #endif
1055
+ k = lo0bits(&z);
1056
+ if (k >= 16) {
1057
+ x[0] = z;
1058
+ i = 0;
1059
+ }
1060
+ else {
1061
+ x[0] = z & 0xffff;
1062
+ x[1] = z >> 16;
1063
+ i = 1;
1064
+ }
1065
+ k += 32;
1066
+ }
1067
+ while (!x[i])
1068
+ --i;
1069
+ b->wds = i + 1;
1070
+ #endif
1071
+ #ifndef Sudden_Underflow
1072
+ if (de) {
1073
+ #endif
1074
+ #ifdef IBM
1075
+ *e = (de - Bias - (P-1) << 2) + k;
1076
+ *bits = 4*P + 8 - k - hi0bits(word0(d) & Frac_mask);
1077
+ #else
1078
+ *e = de - Bias - (P-1) + k;
1079
+ *bits = P - k;
1080
+ #endif
1081
+ #ifndef Sudden_Underflow
1082
+ }
1083
+ else {
1084
+ *e = de - Bias - (P-1) + 1 + k;
1085
+ #ifdef Pack_32
1086
+ *bits = 32*i - hi0bits(x[i-1]);
1087
+ #else
1088
+ *bits = (i+2)*16 - hi0bits(x[i]);
1089
+ #endif
1090
+ }
1091
+ #endif
1092
+ return b;
1093
+ }
1094
+ #undef d0
1095
+ #undef d1
1096
+
1097
+ /* removed: ratio() */
1098
+
1099
+ static const double
1100
+ tens[] = {
1101
+ 1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9,
1102
+ 1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19,
1103
+ 1e20, 1e21, 1e22
1104
+ #ifdef VAX
1105
+ , 1e23, 1e24
1106
+ #endif
1107
+ };
1108
+
1109
+ static const double
1110
+ #ifdef IEEE_Arith
1111
+ bigtens[] = { 1e16, 1e32, 1e64, 1e128, 1e256 };
1112
+ static const double tinytens[] = { 1e-16, 1e-32, 1e-64, 1e-128,
1113
+ #ifdef Avoid_Underflow
1114
+ 9007199254740992.*9007199254740992.e-256
1115
+ /* = 2^106 * 1e-53 */
1116
+ #else
1117
+ 1e-256
1118
+ #endif
1119
+ };
1120
+ /* The factor of 2^53 in tinytens[4] helps us avoid setting the underflow */
1121
+ /* flag unnecessarily. It leads to a song and dance at the end of strtod. */
1122
+ #define Scale_Bit 0x10
1123
+ #define n_bigtens 5
1124
+ #else
1125
+ #ifdef IBM
1126
+ bigtens[] = { 1e16, 1e32, 1e64 };
1127
+ static const double tinytens[] = { 1e-16, 1e-32, 1e-64 };
1128
+ #define n_bigtens 3
1129
+ #else
1130
+ bigtens[] = { 1e16, 1e32 };
1131
+ static const double tinytens[] = { 1e-16, 1e-32 };
1132
+ #define n_bigtens 2
1133
+ #endif
1134
+ #endif
1135
+
1136
+ #ifndef IEEE_Arith
1137
+ #undef INFNAN_CHECK
1138
+ #endif
1139
+
1140
+ #ifdef INFNAN_CHECK
1141
+
1142
+ #ifndef NAN_WORD0
1143
+ #define NAN_WORD0 0x7ff80000
1144
+ #endif
1145
+
1146
+ #ifndef NAN_WORD1
1147
+ #define NAN_WORD1 0
1148
+ #endif
1149
+
1150
+ static int
1151
+ match(const char **sp, char *t)
1152
+ {
1153
+ int c, d;
1154
+ const char *s = *sp;
1155
+
1156
+ while (d = *t++) {
1157
+ if ((c = *++s) >= 'A' && c <= 'Z')
1158
+ c += 'a' - 'A';
1159
+ if (c != d)
1160
+ return 0;
1161
+ }
1162
+ *sp = s + 1;
1163
+ return 1;
1164
+ }
1165
+
1166
+ #ifndef No_Hex_NaN
1167
+ static void
1168
+ hexnan(double *rvp, const char **sp)
1169
+ {
1170
+ ULong c, x[2];
1171
+ const char *s;
1172
+ int havedig, udx0, xshift;
1173
+
1174
+ x[0] = x[1] = 0;
1175
+ havedig = xshift = 0;
1176
+ udx0 = 1;
1177
+ s = *sp;
1178
+ while (c = *(const unsigned char*)++s) {
1179
+ if (c >= '0' && c <= '9')
1180
+ c -= '0';
1181
+ else if (c >= 'a' && c <= 'f')
1182
+ c += 10 - 'a';
1183
+ else if (c >= 'A' && c <= 'F')
1184
+ c += 10 - 'A';
1185
+ else if (c <= ' ') {
1186
+ if (udx0 && havedig) {
1187
+ udx0 = 0;
1188
+ xshift = 1;
1189
+ }
1190
+ continue;
1191
+ }
1192
+ else if (/*(*/ c == ')' && havedig) {
1193
+ *sp = s + 1;
1194
+ break;
1195
+ }
1196
+ else
1197
+ return; /* invalid form: don't change *sp */
1198
+ havedig = 1;
1199
+ if (xshift) {
1200
+ xshift = 0;
1201
+ x[0] = x[1];
1202
+ x[1] = 0;
1203
+ }
1204
+ if (udx0)
1205
+ x[0] = (x[0] << 4) | (x[1] >> 28);
1206
+ x[1] = (x[1] << 4) | c;
1207
+ }
1208
+ if ((x[0] &= 0xfffff) || x[1]) {
1209
+ word0(*rvp) = Exp_mask | x[0];
1210
+ word1(*rvp) = x[1];
1211
+ }
1212
+ }
1213
+ #endif /*No_Hex_NaN*/
1214
+ #endif /* INFNAN_CHECK */
1215
+
1216
+ /* removed: ruby_strtod() */
1217
+
1218
+ static int
1219
+ quorem(Bigint *b, Bigint *S)
1220
+ {
1221
+ int n;
1222
+ ULong *bx, *bxe, q, *sx, *sxe;
1223
+ #ifdef ULLong
1224
+ ULLong borrow, carry, y, ys;
1225
+ #else
1226
+ ULong borrow, carry, y, ys;
1227
+ #ifdef Pack_32
1228
+ ULong si, z, zs;
1229
+ #endif
1230
+ #endif
1231
+
1232
+ n = S->wds;
1233
+ #ifdef DEBUG
1234
+ /*debug*/ if (b->wds > n)
1235
+ /*debug*/ Bug("oversize b in quorem");
1236
+ #endif
1237
+ if (b->wds < n)
1238
+ return 0;
1239
+ sx = S->x;
1240
+ sxe = sx + --n;
1241
+ bx = b->x;
1242
+ bxe = bx + n;
1243
+ q = *bxe / (*sxe + 1); /* ensure q <= true quotient */
1244
+ #ifdef DEBUG
1245
+ /*debug*/ if (q > 9)
1246
+ /*debug*/ Bug("oversized quotient in quorem");
1247
+ #endif
1248
+ if (q) {
1249
+ borrow = 0;
1250
+ carry = 0;
1251
+ do {
1252
+ #ifdef ULLong
1253
+ ys = *sx++ * (ULLong)q + carry;
1254
+ carry = ys >> 32;
1255
+ y = *bx - (ys & FFFFFFFF) - borrow;
1256
+ borrow = y >> 32 & (ULong)1;
1257
+ *bx++ = (ULong)(y & FFFFFFFF);
1258
+ #else
1259
+ #ifdef Pack_32
1260
+ si = *sx++;
1261
+ ys = (si & 0xffff) * q + carry;
1262
+ zs = (si >> 16) * q + (ys >> 16);
1263
+ carry = zs >> 16;
1264
+ y = (*bx & 0xffff) - (ys & 0xffff) - borrow;
1265
+ borrow = (y & 0x10000) >> 16;
1266
+ z = (*bx >> 16) - (zs & 0xffff) - borrow;
1267
+ borrow = (z & 0x10000) >> 16;
1268
+ Storeinc(bx, z, y);
1269
+ #else
1270
+ ys = *sx++ * q + carry;
1271
+ carry = ys >> 16;
1272
+ y = *bx - (ys & 0xffff) - borrow;
1273
+ borrow = (y & 0x10000) >> 16;
1274
+ *bx++ = y & 0xffff;
1275
+ #endif
1276
+ #endif
1277
+ } while (sx <= sxe);
1278
+ if (!*bxe) {
1279
+ bx = b->x;
1280
+ while (--bxe > bx && !*bxe)
1281
+ --n;
1282
+ b->wds = n;
1283
+ }
1284
+ }
1285
+ if (bicmp(b, S) >= 0) {
1286
+ q++;
1287
+ borrow = 0;
1288
+ carry = 0;
1289
+ bx = b->x;
1290
+ sx = S->x;
1291
+ do {
1292
+ #ifdef ULLong
1293
+ ys = *sx++ + carry;
1294
+ carry = ys >> 32;
1295
+ y = *bx - (ys & FFFFFFFF) - borrow;
1296
+ borrow = y >> 32 & (ULong)1;
1297
+ *bx++ = (ULong)(y & FFFFFFFF);
1298
+ #else
1299
+ #ifdef Pack_32
1300
+ si = *sx++;
1301
+ ys = (si & 0xffff) + carry;
1302
+ zs = (si >> 16) + (ys >> 16);
1303
+ carry = zs >> 16;
1304
+ y = (*bx & 0xffff) - (ys & 0xffff) - borrow;
1305
+ borrow = (y & 0x10000) >> 16;
1306
+ z = (*bx >> 16) - (zs & 0xffff) - borrow;
1307
+ borrow = (z & 0x10000) >> 16;
1308
+ Storeinc(bx, z, y);
1309
+ #else
1310
+ ys = *sx++ + carry;
1311
+ carry = ys >> 16;
1312
+ y = *bx - (ys & 0xffff) - borrow;
1313
+ borrow = (y & 0x10000) >> 16;
1314
+ *bx++ = y & 0xffff;
1315
+ #endif
1316
+ #endif
1317
+ } while (sx <= sxe);
1318
+ bx = b->x;
1319
+ bxe = bx + n;
1320
+ if (!*bxe) {
1321
+ while (--bxe > bx && !*bxe)
1322
+ --n;
1323
+ b->wds = n;
1324
+ }
1325
+ }
1326
+ return q;
1327
+ }
1328
+
1329
+ #ifndef MULTIPLE_THREADS
1330
+ static char *dtoa_result;
1331
+ #endif
1332
+
1333
+ #ifndef MULTIPLE_THREADS
1334
+ static char *
1335
+ rv_alloc(int i)
1336
+ {
1337
+ return dtoa_result = xmalloc(i);
1338
+ }
1339
+ #else
1340
+ #define rv_alloc(i) xmalloc(i)
1341
+ #endif
1342
+
1343
+ static char *
1344
+ nrv_alloc(const char *s, char **rve, size_t n)
1345
+ {
1346
+ char *rv, *t;
1347
+
1348
+ t = rv = rv_alloc(n);
1349
+ while ((*t = *s++) != 0) t++;
1350
+ if (rve)
1351
+ *rve = t;
1352
+ return rv;
1353
+ }
1354
+
1355
+ #define rv_strdup(s, rve) nrv_alloc((s), (rve), strlen(s)+1)
1356
+
1357
+ #ifndef MULTIPLE_THREADS
1358
+ /* freedtoa(s) must be used to free values s returned by dtoa
1359
+ * when MULTIPLE_THREADS is #defined. It should be used in all cases,
1360
+ * but for consistency with earlier versions of dtoa, it is optional
1361
+ * when MULTIPLE_THREADS is not defined.
1362
+ */
1363
+
1364
+ static void
1365
+ freedtoa(char *s)
1366
+ {
1367
+ xfree(s);
1368
+ }
1369
+ #endif
1370
+
1371
+ static const char INFSTR[] = "Infinity";
1372
+ static const char NANSTR[] = "NaN";
1373
+ static const char ZEROSTR[] = "0";
1374
+
1375
+ /* dtoa for IEEE arithmetic (dmg): convert double to ASCII string.
1376
+ *
1377
+ * Inspired by "How to Print Floating-Point Numbers Accurately" by
1378
+ * Guy L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90, pp. 112-126].
1379
+ *
1380
+ * Modifications:
1381
+ * 1. Rather than iterating, we use a simple numeric overestimate
1382
+ * to determine k = floor(log10(d)). We scale relevant
1383
+ * quantities using O(log2(k)) rather than O(k) multiplications.
1384
+ * 2. For some modes > 2 (corresponding to ecvt and fcvt), we don't
1385
+ * try to generate digits strictly left to right. Instead, we
1386
+ * compute with fewer bits and propagate the carry if necessary
1387
+ * when rounding the final digit up. This is often faster.
1388
+ * 3. Under the assumption that input will be rounded nearest,
1389
+ * mode 0 renders 1e23 as 1e23 rather than 9.999999999999999e22.
1390
+ * That is, we allow equality in stopping tests when the
1391
+ * round-nearest rule will give the same floating-point value
1392
+ * as would satisfaction of the stopping test with strict
1393
+ * inequality.
1394
+ * 4. We remove common factors of powers of 2 from relevant
1395
+ * quantities.
1396
+ * 5. When converting floating-point integers less than 1e16,
1397
+ * we use floating-point arithmetic rather than resorting
1398
+ * to multiple-precision integers.
1399
+ * 6. When asked to produce fewer than 15 digits, we first try
1400
+ * to get by with floating-point arithmetic; we resort to
1401
+ * multiple-precision integer arithmetic only if we cannot
1402
+ * guarantee that the floating-point calculation has given
1403
+ * the correctly rounded result. For k requested digits and
1404
+ * "uniformly" distributed input, the probability is
1405
+ * something like 10^(k-15) that we must resort to the Long
1406
+ * calculation.
1407
+ */
1408
+
1409
+ char *
1410
+ ruby_dtoa(double d_, int mode, int ndigits, int *decpt, int *sign, char **rve)
1411
+ {
1412
+ /* Arguments ndigits, decpt, sign are similar to those
1413
+ of ecvt and fcvt; trailing zeros are suppressed from
1414
+ the returned string. If not null, *rve is set to point
1415
+ to the end of the return value. If d is +-Infinity or NaN,
1416
+ then *decpt is set to 9999.
1417
+
1418
+ mode:
1419
+ 0 ==> shortest string that yields d when read in
1420
+ and rounded to nearest.
1421
+ 1 ==> like 0, but with Steele & White stopping rule;
1422
+ e.g. with IEEE P754 arithmetic , mode 0 gives
1423
+ 1e23 whereas mode 1 gives 9.999999999999999e22.
1424
+ 2 ==> max(1,ndigits) significant digits. This gives a
1425
+ return value similar to that of ecvt, except
1426
+ that trailing zeros are suppressed.
1427
+ 3 ==> through ndigits past the decimal point. This
1428
+ gives a return value similar to that from fcvt,
1429
+ except that trailing zeros are suppressed, and
1430
+ ndigits can be negative.
1431
+ 4,5 ==> similar to 2 and 3, respectively, but (in
1432
+ round-nearest mode) with the tests of mode 0 to
1433
+ possibly return a shorter string that rounds to d.
1434
+ With IEEE arithmetic and compilation with
1435
+ -DHonor_FLT_ROUNDS, modes 4 and 5 behave the same
1436
+ as modes 2 and 3 when FLT_ROUNDS != 1.
1437
+ 6-9 ==> Debugging modes similar to mode - 4: don't try
1438
+ fast floating-point estimate (if applicable).
1439
+
1440
+ Values of mode other than 0-9 are treated as mode 0.
1441
+
1442
+ Sufficient space is allocated to the return value
1443
+ to hold the suppressed trailing zeros.
1444
+ */
1445
+
1446
+ int bbits, b2, b5, be, dig, i, ieps, ilim, ilim0, ilim1,
1447
+ j, j1, k, k0, k_check, leftright, m2, m5, s2, s5,
1448
+ spec_case, try_quick;
1449
+ Long L;
1450
+ #ifndef Sudden_Underflow
1451
+ int denorm;
1452
+ ULong x;
1453
+ #endif
1454
+ Bigint *b, *b1, *delta, *mlo = 0, *mhi = 0, *S;
1455
+ double ds;
1456
+ double_u d, d2, eps;
1457
+ char *s, *s0;
1458
+ #ifdef Honor_FLT_ROUNDS
1459
+ int rounding;
1460
+ #endif
1461
+ #ifdef SET_INEXACT
1462
+ int inexact, oldinexact;
1463
+ #endif
1464
+
1465
+ dval(d) = d_;
1466
+
1467
+ #ifndef MULTIPLE_THREADS
1468
+ if (dtoa_result) {
1469
+ freedtoa(dtoa_result);
1470
+ dtoa_result = 0;
1471
+ }
1472
+ #endif
1473
+
1474
+ if (word0(d) & Sign_bit) {
1475
+ /* set sign for everything, including 0's and NaNs */
1476
+ *sign = 1;
1477
+ word0(d) &= ~Sign_bit; /* clear sign bit */
1478
+ }
1479
+ else
1480
+ *sign = 0;
1481
+
1482
+ #if defined(IEEE_Arith) + defined(VAX)
1483
+ #ifdef IEEE_Arith
1484
+ if ((word0(d) & Exp_mask) == Exp_mask)
1485
+ #else
1486
+ if (word0(d) == 0x8000)
1487
+ #endif
1488
+ {
1489
+ /* Infinity or NaN */
1490
+ *decpt = 9999;
1491
+ #ifdef IEEE_Arith
1492
+ if (!word1(d) && !(word0(d) & 0xfffff))
1493
+ return rv_strdup(INFSTR, rve);
1494
+ #endif
1495
+ return rv_strdup(NANSTR, rve);
1496
+ }
1497
+ #endif
1498
+ #ifdef IBM
1499
+ dval(d) += 0; /* normalize */
1500
+ #endif
1501
+ if (!dval(d)) {
1502
+ *decpt = 1;
1503
+ return rv_strdup(ZEROSTR, rve);
1504
+ }
1505
+
1506
+ #ifdef SET_INEXACT
1507
+ try_quick = oldinexact = get_inexact();
1508
+ inexact = 1;
1509
+ #endif
1510
+ #ifdef Honor_FLT_ROUNDS
1511
+ if ((rounding = Flt_Rounds) >= 2) {
1512
+ if (*sign)
1513
+ rounding = rounding == 2 ? 0 : 2;
1514
+ else
1515
+ if (rounding != 2)
1516
+ rounding = 0;
1517
+ }
1518
+ #endif
1519
+
1520
+ b = d2b(dval(d), &be, &bbits);
1521
+ #ifdef Sudden_Underflow
1522
+ i = (int)(word0(d) >> Exp_shift1 & (Exp_mask>>Exp_shift1));
1523
+ #else
1524
+ if ((i = (int)(word0(d) >> Exp_shift1 & (Exp_mask>>Exp_shift1))) != 0) {
1525
+ #endif
1526
+ dval(d2) = dval(d);
1527
+ word0(d2) &= Frac_mask1;
1528
+ word0(d2) |= Exp_11;
1529
+ #ifdef IBM
1530
+ if (j = 11 - hi0bits(word0(d2) & Frac_mask))
1531
+ dval(d2) /= 1 << j;
1532
+ #endif
1533
+
1534
+ /* log(x) ~=~ log(1.5) + (x-1.5)/1.5
1535
+ * log10(x) = log(x) / log(10)
1536
+ * ~=~ log(1.5)/log(10) + (x-1.5)/(1.5*log(10))
1537
+ * log10(d) = (i-Bias)*log(2)/log(10) + log10(d2)
1538
+ *
1539
+ * This suggests computing an approximation k to log10(d) by
1540
+ *
1541
+ * k = (i - Bias)*0.301029995663981
1542
+ * + ( (d2-1.5)*0.289529654602168 + 0.176091259055681 );
1543
+ *
1544
+ * We want k to be too large rather than too small.
1545
+ * The error in the first-order Taylor series approximation
1546
+ * is in our favor, so we just round up the constant enough
1547
+ * to compensate for any error in the multiplication of
1548
+ * (i - Bias) by 0.301029995663981; since |i - Bias| <= 1077,
1549
+ * and 1077 * 0.30103 * 2^-52 ~=~ 7.2e-14,
1550
+ * adding 1e-13 to the constant term more than suffices.
1551
+ * Hence we adjust the constant term to 0.1760912590558.
1552
+ * (We could get a more accurate k by invoking log10,
1553
+ * but this is probably not worthwhile.)
1554
+ */
1555
+
1556
+ i -= Bias;
1557
+ #ifdef IBM
1558
+ i <<= 2;
1559
+ i += j;
1560
+ #endif
1561
+ #ifndef Sudden_Underflow
1562
+ denorm = 0;
1563
+ }
1564
+ else {
1565
+ /* d is denormalized */
1566
+
1567
+ i = bbits + be + (Bias + (P-1) - 1);
1568
+ x = i > 32 ? word0(d) << (64 - i) | word1(d) >> (i - 32)
1569
+ : word1(d) << (32 - i);
1570
+ dval(d2) = x;
1571
+ word0(d2) -= 31*Exp_msk1; /* adjust exponent */
1572
+ i -= (Bias + (P-1) - 1) + 1;
1573
+ denorm = 1;
1574
+ }
1575
+ #endif
1576
+ ds = (dval(d2)-1.5)*0.289529654602168 + 0.1760912590558 + i*0.301029995663981;
1577
+ k = (int)ds;
1578
+ if (ds < 0. && ds != k)
1579
+ k--; /* want k = floor(ds) */
1580
+ k_check = 1;
1581
+ if (k >= 0 && k <= Ten_pmax) {
1582
+ if (dval(d) < tens[k])
1583
+ k--;
1584
+ k_check = 0;
1585
+ }
1586
+ j = bbits - i - 1;
1587
+ if (j >= 0) {
1588
+ b2 = 0;
1589
+ s2 = j;
1590
+ }
1591
+ else {
1592
+ b2 = -j;
1593
+ s2 = 0;
1594
+ }
1595
+ if (k >= 0) {
1596
+ b5 = 0;
1597
+ s5 = k;
1598
+ s2 += k;
1599
+ }
1600
+ else {
1601
+ b2 -= k;
1602
+ b5 = -k;
1603
+ s5 = 0;
1604
+ }
1605
+ if (mode < 0 || mode > 9)
1606
+ mode = 0;
1607
+
1608
+ #ifndef SET_INEXACT
1609
+ #ifdef Check_FLT_ROUNDS
1610
+ try_quick = Rounding == 1;
1611
+ #else
1612
+ try_quick = 1;
1613
+ #endif
1614
+ #endif /*SET_INEXACT*/
1615
+
1616
+ if (mode > 5) {
1617
+ mode -= 4;
1618
+ try_quick = 0;
1619
+ }
1620
+ leftright = 1;
1621
+ ilim = ilim1 = -1;
1622
+ switch (mode) {
1623
+ case 0:
1624
+ case 1:
1625
+ i = 18;
1626
+ ndigits = 0;
1627
+ break;
1628
+ case 2:
1629
+ leftright = 0;
1630
+ /* no break */
1631
+ case 4:
1632
+ if (ndigits <= 0)
1633
+ ndigits = 1;
1634
+ ilim = ilim1 = i = ndigits;
1635
+ break;
1636
+ case 3:
1637
+ leftright = 0;
1638
+ /* no break */
1639
+ case 5:
1640
+ i = ndigits + k + 1;
1641
+ ilim = i;
1642
+ ilim1 = i - 1;
1643
+ if (i <= 0)
1644
+ i = 1;
1645
+ }
1646
+ s = s0 = rv_alloc(i+1);
1647
+
1648
+ #ifdef Honor_FLT_ROUNDS
1649
+ if (mode > 1 && rounding != 1)
1650
+ leftright = 0;
1651
+ #endif
1652
+
1653
+ if (ilim >= 0 && ilim <= Quick_max && try_quick) {
1654
+
1655
+ /* Try to get by with floating-point arithmetic. */
1656
+
1657
+ i = 0;
1658
+ dval(d2) = dval(d);
1659
+ k0 = k;
1660
+ ilim0 = ilim;
1661
+ ieps = 2; /* conservative */
1662
+ if (k > 0) {
1663
+ ds = tens[k&0xf];
1664
+ j = k >> 4;
1665
+ if (j & Bletch) {
1666
+ /* prevent overflows */
1667
+ j &= Bletch - 1;
1668
+ dval(d) /= bigtens[n_bigtens-1];
1669
+ ieps++;
1670
+ }
1671
+ for (; j; j >>= 1, i++)
1672
+ if (j & 1) {
1673
+ ieps++;
1674
+ ds *= bigtens[i];
1675
+ }
1676
+ dval(d) /= ds;
1677
+ }
1678
+ else if ((j1 = -k) != 0) {
1679
+ dval(d) *= tens[j1 & 0xf];
1680
+ for (j = j1 >> 4; j; j >>= 1, i++)
1681
+ if (j & 1) {
1682
+ ieps++;
1683
+ dval(d) *= bigtens[i];
1684
+ }
1685
+ }
1686
+ if (k_check && dval(d) < 1. && ilim > 0) {
1687
+ if (ilim1 <= 0)
1688
+ goto fast_failed;
1689
+ ilim = ilim1;
1690
+ k--;
1691
+ dval(d) *= 10.;
1692
+ ieps++;
1693
+ }
1694
+ dval(eps) = ieps*dval(d) + 7.;
1695
+ word0(eps) -= (P-1)*Exp_msk1;
1696
+ if (ilim == 0) {
1697
+ S = mhi = 0;
1698
+ dval(d) -= 5.;
1699
+ if (dval(d) > dval(eps))
1700
+ goto one_digit;
1701
+ if (dval(d) < -dval(eps))
1702
+ goto no_digits;
1703
+ goto fast_failed;
1704
+ }
1705
+ #ifndef No_leftright
1706
+ if (leftright) {
1707
+ /* Use Steele & White method of only
1708
+ * generating digits needed.
1709
+ */
1710
+ dval(eps) = 0.5/tens[ilim-1] - dval(eps);
1711
+ for (i = 0;;) {
1712
+ L = (int)dval(d);
1713
+ dval(d) -= L;
1714
+ *s++ = '0' + (int)L;
1715
+ if (dval(d) < dval(eps))
1716
+ goto ret1;
1717
+ if (1. - dval(d) < dval(eps))
1718
+ goto bump_up;
1719
+ if (++i >= ilim)
1720
+ break;
1721
+ dval(eps) *= 10.;
1722
+ dval(d) *= 10.;
1723
+ }
1724
+ }
1725
+ else {
1726
+ #endif
1727
+ /* Generate ilim digits, then fix them up. */
1728
+ dval(eps) *= tens[ilim-1];
1729
+ for (i = 1;; i++, dval(d) *= 10.) {
1730
+ L = (Long)(dval(d));
1731
+ if (!(dval(d) -= L))
1732
+ ilim = i;
1733
+ *s++ = '0' + (int)L;
1734
+ if (i == ilim) {
1735
+ if (dval(d) > 0.5 + dval(eps))
1736
+ goto bump_up;
1737
+ else if (dval(d) < 0.5 - dval(eps)) {
1738
+ while (*--s == '0') ;
1739
+ s++;
1740
+ goto ret1;
1741
+ }
1742
+ break;
1743
+ }
1744
+ }
1745
+ #ifndef No_leftright
1746
+ }
1747
+ #endif
1748
+ fast_failed:
1749
+ s = s0;
1750
+ dval(d) = dval(d2);
1751
+ k = k0;
1752
+ ilim = ilim0;
1753
+ }
1754
+
1755
+ /* Do we have a "small" integer? */
1756
+
1757
+ if (be >= 0 && k <= Int_max) {
1758
+ /* Yes. */
1759
+ ds = tens[k];
1760
+ if (ndigits < 0 && ilim <= 0) {
1761
+ S = mhi = 0;
1762
+ if (ilim < 0 || dval(d) <= 5*ds)
1763
+ goto no_digits;
1764
+ goto one_digit;
1765
+ }
1766
+ for (i = 1;; i++, dval(d) *= 10.) {
1767
+ L = (Long)(dval(d) / ds);
1768
+ dval(d) -= L*ds;
1769
+ #ifdef Check_FLT_ROUNDS
1770
+ /* If FLT_ROUNDS == 2, L will usually be high by 1 */
1771
+ if (dval(d) < 0) {
1772
+ L--;
1773
+ dval(d) += ds;
1774
+ }
1775
+ #endif
1776
+ *s++ = '0' + (int)L;
1777
+ if (!dval(d)) {
1778
+ #ifdef SET_INEXACT
1779
+ inexact = 0;
1780
+ #endif
1781
+ break;
1782
+ }
1783
+ if (i == ilim) {
1784
+ #ifdef Honor_FLT_ROUNDS
1785
+ if (mode > 1)
1786
+ switch (rounding) {
1787
+ case 0: goto ret1;
1788
+ case 2: goto bump_up;
1789
+ }
1790
+ #endif
1791
+ dval(d) += dval(d);
1792
+ if (dval(d) > ds || (dval(d) == ds && (L & 1))) {
1793
+ bump_up:
1794
+ while (*--s == '9')
1795
+ if (s == s0) {
1796
+ k++;
1797
+ *s = '0';
1798
+ break;
1799
+ }
1800
+ ++*s++;
1801
+ }
1802
+ break;
1803
+ }
1804
+ }
1805
+ goto ret1;
1806
+ }
1807
+
1808
+ m2 = b2;
1809
+ m5 = b5;
1810
+ if (leftright) {
1811
+ i =
1812
+ #ifndef Sudden_Underflow
1813
+ denorm ? be + (Bias + (P-1) - 1 + 1) :
1814
+ #endif
1815
+ #ifdef IBM
1816
+ 1 + 4*P - 3 - bbits + ((bbits + be - 1) & 3);
1817
+ #else
1818
+ 1 + P - bbits;
1819
+ #endif
1820
+ b2 += i;
1821
+ s2 += i;
1822
+ mhi = i2b(1);
1823
+ }
1824
+ if (m2 > 0 && s2 > 0) {
1825
+ i = m2 < s2 ? m2 : s2;
1826
+ b2 -= i;
1827
+ m2 -= i;
1828
+ s2 -= i;
1829
+ }
1830
+ if (b5 > 0) {
1831
+ if (leftright) {
1832
+ if (m5 > 0) {
1833
+ mhi = pow5mult(mhi, m5);
1834
+ b1 = mult(mhi, b);
1835
+ Bfree(b);
1836
+ b = b1;
1837
+ }
1838
+ if ((j = b5 - m5) != 0)
1839
+ b = pow5mult(b, j);
1840
+ }
1841
+ else
1842
+ b = pow5mult(b, b5);
1843
+ }
1844
+ S = i2b(1);
1845
+ if (s5 > 0)
1846
+ S = pow5mult(S, s5);
1847
+
1848
+ /* Check for special case that d is a normalized power of 2. */
1849
+
1850
+ spec_case = 0;
1851
+ if ((mode < 2 || leftright)
1852
+ #ifdef Honor_FLT_ROUNDS
1853
+ && rounding == 1
1854
+ #endif
1855
+ ) {
1856
+ if (!word1(d) && !(word0(d) & Bndry_mask)
1857
+ #ifndef Sudden_Underflow
1858
+ && word0(d) & (Exp_mask & ~Exp_msk1)
1859
+ #endif
1860
+ ) {
1861
+ /* The special case */
1862
+ b2 += Log2P;
1863
+ s2 += Log2P;
1864
+ spec_case = 1;
1865
+ }
1866
+ }
1867
+
1868
+ /* Arrange for convenient computation of quotients:
1869
+ * shift left if necessary so divisor has 4 leading 0 bits.
1870
+ *
1871
+ * Perhaps we should just compute leading 28 bits of S once
1872
+ * and for all and pass them and a shift to quorem, so it
1873
+ * can do shifts and ors to compute the numerator for q.
1874
+ */
1875
+ #ifdef Pack_32
1876
+ if ((i = ((s5 ? 32 - hi0bits(S->x[S->wds-1]) : 1) + s2) & 0x1f) != 0)
1877
+ i = 32 - i;
1878
+ #else
1879
+ if ((i = ((s5 ? 32 - hi0bits(S->x[S->wds-1]) : 1) + s2) & 0xf) != 0)
1880
+ i = 16 - i;
1881
+ #endif
1882
+ if (i > 4) {
1883
+ i -= 4;
1884
+ b2 += i;
1885
+ m2 += i;
1886
+ s2 += i;
1887
+ }
1888
+ else if (i < 4) {
1889
+ i += 28;
1890
+ b2 += i;
1891
+ m2 += i;
1892
+ s2 += i;
1893
+ }
1894
+ if (b2 > 0)
1895
+ b = lshift(b, b2);
1896
+ if (s2 > 0)
1897
+ S = lshift(S, s2);
1898
+ if (k_check) {
1899
+ if (bicmp(b,S) < 0) {
1900
+ k--;
1901
+ b = multadd(b, 10, 0); /* we botched the k estimate */
1902
+ if (leftright)
1903
+ mhi = multadd(mhi, 10, 0);
1904
+ ilim = ilim1;
1905
+ }
1906
+ }
1907
+ if (ilim <= 0 && (mode == 3 || mode == 5)) {
1908
+ if (ilim < 0 || bicmp(b,S = multadd(S,5,0)) <= 0) {
1909
+ /* no digits, fcvt style */
1910
+ no_digits:
1911
+ k = -1 - ndigits;
1912
+ goto ret;
1913
+ }
1914
+ one_digit:
1915
+ *s++ = '1';
1916
+ k++;
1917
+ goto ret;
1918
+ }
1919
+ if (leftright) {
1920
+ if (m2 > 0)
1921
+ mhi = lshift(mhi, m2);
1922
+
1923
+ /* Compute mlo -- check for special case
1924
+ * that d is a normalized power of 2.
1925
+ */
1926
+
1927
+ mlo = mhi;
1928
+ if (spec_case) {
1929
+ mhi = Balloc(mhi->k);
1930
+ Bcopy(mhi, mlo);
1931
+ mhi = lshift(mhi, Log2P);
1932
+ }
1933
+
1934
+ for (i = 1;;i++) {
1935
+ dig = quorem(b,S) + '0';
1936
+ /* Do we yet have the shortest decimal string
1937
+ * that will round to d?
1938
+ */
1939
+ j = bicmp(b, mlo);
1940
+ delta = diff(S, mhi);
1941
+ j1 = delta->sign ? 1 : bicmp(b, delta);
1942
+ Bfree(delta);
1943
+ #ifndef ROUND_BIASED
1944
+ if (j1 == 0 && mode != 1 && !(word1(d) & 1)
1945
+ #ifdef Honor_FLT_ROUNDS
1946
+ && rounding >= 1
1947
+ #endif
1948
+ ) {
1949
+ if (dig == '9')
1950
+ goto round_9_up;
1951
+ if (j > 0)
1952
+ dig++;
1953
+ #ifdef SET_INEXACT
1954
+ else if (!b->x[0] && b->wds <= 1)
1955
+ inexact = 0;
1956
+ #endif
1957
+ *s++ = dig;
1958
+ goto ret;
1959
+ }
1960
+ #endif
1961
+ if (j < 0 || (j == 0 && mode != 1
1962
+ #ifndef ROUND_BIASED
1963
+ && !(word1(d) & 1)
1964
+ #endif
1965
+ )) {
1966
+ if (!b->x[0] && b->wds <= 1) {
1967
+ #ifdef SET_INEXACT
1968
+ inexact = 0;
1969
+ #endif
1970
+ goto accept_dig;
1971
+ }
1972
+ #ifdef Honor_FLT_ROUNDS
1973
+ if (mode > 1)
1974
+ switch (rounding) {
1975
+ case 0: goto accept_dig;
1976
+ case 2: goto keep_dig;
1977
+ }
1978
+ #endif /*Honor_FLT_ROUNDS*/
1979
+ if (j1 > 0) {
1980
+ b = lshift(b, 1);
1981
+ j1 = bicmp(b, S);
1982
+ if ((j1 > 0 || (j1 == 0 && (dig & 1))) && dig++ == '9')
1983
+ goto round_9_up;
1984
+ }
1985
+ accept_dig:
1986
+ *s++ = dig;
1987
+ goto ret;
1988
+ }
1989
+ if (j1 > 0) {
1990
+ #ifdef Honor_FLT_ROUNDS
1991
+ if (!rounding)
1992
+ goto accept_dig;
1993
+ #endif
1994
+ if (dig == '9') { /* possible if i == 1 */
1995
+ round_9_up:
1996
+ *s++ = '9';
1997
+ goto roundoff;
1998
+ }
1999
+ *s++ = dig + 1;
2000
+ goto ret;
2001
+ }
2002
+ #ifdef Honor_FLT_ROUNDS
2003
+ keep_dig:
2004
+ #endif
2005
+ *s++ = dig;
2006
+ if (i == ilim)
2007
+ break;
2008
+ b = multadd(b, 10, 0);
2009
+ if (mlo == mhi)
2010
+ mlo = mhi = multadd(mhi, 10, 0);
2011
+ else {
2012
+ mlo = multadd(mlo, 10, 0);
2013
+ mhi = multadd(mhi, 10, 0);
2014
+ }
2015
+ }
2016
+ }
2017
+ else
2018
+ for (i = 1;; i++) {
2019
+ *s++ = dig = quorem(b,S) + '0';
2020
+ if (!b->x[0] && b->wds <= 1) {
2021
+ #ifdef SET_INEXACT
2022
+ inexact = 0;
2023
+ #endif
2024
+ goto ret;
2025
+ }
2026
+ if (i >= ilim)
2027
+ break;
2028
+ b = multadd(b, 10, 0);
2029
+ }
2030
+
2031
+ /* Round off last digit */
2032
+
2033
+ #ifdef Honor_FLT_ROUNDS
2034
+ switch (rounding) {
2035
+ case 0: goto trimzeros;
2036
+ case 2: goto roundoff;
2037
+ }
2038
+ #endif
2039
+ b = lshift(b, 1);
2040
+ j = bicmp(b, S);
2041
+ if (j > 0 || (j == 0 && (dig & 1))) {
2042
+ roundoff:
2043
+ while (*--s == '9')
2044
+ if (s == s0) {
2045
+ k++;
2046
+ *s++ = '1';
2047
+ goto ret;
2048
+ }
2049
+ ++*s++;
2050
+ }
2051
+ else {
2052
+ while (*--s == '0') ;
2053
+ s++;
2054
+ }
2055
+ ret:
2056
+ Bfree(S);
2057
+ if (mhi) {
2058
+ if (mlo && mlo != mhi)
2059
+ Bfree(mlo);
2060
+ Bfree(mhi);
2061
+ }
2062
+ ret1:
2063
+ #ifdef SET_INEXACT
2064
+ if (inexact) {
2065
+ if (!oldinexact) {
2066
+ word0(d) = Exp_1 + (70 << Exp_shift);
2067
+ word1(d) = 0;
2068
+ dval(d) += 1.;
2069
+ }
2070
+ }
2071
+ else if (!oldinexact)
2072
+ clear_inexact();
2073
+ #endif
2074
+ Bfree(b);
2075
+ *s = 0;
2076
+ *decpt = k + 1;
2077
+ if (rve)
2078
+ *rve = s;
2079
+ return s0;
2080
+ }
2081
+
2082
+ /*
2083
+ * copied from bignum.c
2084
+ */
2085
+
2086
+
2087
+ #define BDIGITS(x) (BIGNUM_DIGITS(x))
2088
+
2089
+ static VALUE
2090
+ rb_big_uminus(VALUE x)
2091
+ {
2092
+ VALUE z = rb_big_clone(x);
2093
+
2094
+ BIGNUM_SET_SIGN(z, !RBIGNUM_SIGN(x));
2095
+
2096
+ return rb_big_norm(z); /* modified to use exported one */
2097
+ }
2098
+
2099
+ static VALUE
2100
+ rb_big_hash(VALUE x)
2101
+ {
2102
+ st_index_t hash;
2103
+
2104
+ hash = rb_memhash(BDIGITS(x), sizeof(BDIGIT)*BIGNUM_LEN(x)) ^ BIGNUM_SIGN(x);
2105
+ return INT2FIX(hash);
2106
+ }
2107
+
2108
+ static VALUE
2109
+ rb_big_odd_p(VALUE num)
2110
+ {
2111
+ if (BIGNUM_LEN(num) != 0 && BDIGITS(num)[0] & 1) {
2112
+ return Qtrue;
2113
+ }
2114
+ return Qfalse;
2115
+ }
2116
+
2117
+ /*
2118
+ * copied from numeric.c
2119
+ */
2120
+
2121
+ static VALUE
2122
+ flo_to_s(VALUE flt)
2123
+ {
2124
+ char *ruby_dtoa(double d_, int mode, int ndigits, int *decpt, int *sign, char **rve);
2125
+ enum {decimal_mant = DBL_MANT_DIG-DBL_DIG};
2126
+ enum {float_dig = DBL_DIG+1};
2127
+ char buf[float_dig + (decimal_mant + CHAR_BIT - 1) / CHAR_BIT + 10];
2128
+ double value = RFLOAT_VALUE(flt);
2129
+ VALUE s;
2130
+ char *p, *e;
2131
+ int sign, decpt, digs;
2132
+
2133
+ if (isinf(value))
2134
+ return rb_usascii_str_new2(value < 0 ? "-Infinity" : "Infinity");
2135
+ else if (isnan(value))
2136
+ return rb_usascii_str_new2("NaN");
2137
+
2138
+ p = ruby_dtoa(value, 0, 0, &decpt, &sign, &e);
2139
+ s = sign ? rb_usascii_str_new_cstr("-") : rb_usascii_str_new(0, 0);
2140
+ if ((digs = (int)(e - p)) >= (int)sizeof(buf)) digs = (int)sizeof(buf) - 1;
2141
+ memcpy(buf, p, digs);
2142
+ xfree(p);
2143
+ if (decpt > 0) {
2144
+ if (decpt < digs) {
2145
+ memmove(buf + decpt + 1, buf + decpt, digs - decpt);
2146
+ buf[decpt] = '.';
2147
+ rb_str_cat(s, buf, digs + 1);
2148
+ }
2149
+ else if (decpt <= DBL_DIG) {
2150
+ long len;
2151
+ char *ptr;
2152
+ rb_str_cat(s, buf, digs);
2153
+ rb_str_resize(s, (len = RSTRING_LEN(s)) + decpt - digs + 2);
2154
+ ptr = RSTRING_PTR(s) + len;
2155
+ if (decpt > digs) {
2156
+ memset(ptr, '0', decpt - digs);
2157
+ ptr += decpt - digs;
2158
+ }
2159
+ memcpy(ptr, ".0", 2);
2160
+ }
2161
+ else {
2162
+ goto exp;
2163
+ }
2164
+ }
2165
+ else if (decpt > -4) {
2166
+ long len;
2167
+ char *ptr;
2168
+ rb_str_cat(s, "0.", 2);
2169
+ rb_str_resize(s, (len = RSTRING_LEN(s)) - decpt + digs);
2170
+ ptr = RSTRING_PTR(s);
2171
+ memset(ptr += len, '0', -decpt);
2172
+ memcpy(ptr -= decpt, buf, digs);
2173
+ }
2174
+ else {
2175
+ exp:
2176
+ if (digs > 1) {
2177
+ memmove(buf + 2, buf + 1, digs - 1);
2178
+ }
2179
+ else {
2180
+ buf[2] = '0';
2181
+ digs++;
2182
+ }
2183
+ buf[1] = '.';
2184
+ rb_str_cat(s, buf, digs + 1);
2185
+ rb_str_catf(s, "e%+03d", decpt - 1);
2186
+ }
2187
+ return s;
2188
+ }
2189
+
2190
+ static VALUE
2191
+ fix_plus(VALUE x, VALUE y)
2192
+ {
2193
+ if (FIXNUM_P(y)) {
2194
+ long a, b, c;
2195
+ VALUE r;
2196
+
2197
+ a = FIX2LONG(x);
2198
+ b = FIX2LONG(y);
2199
+ c = a + b;
2200
+ r = LONG2NUM(c);
2201
+
2202
+ return r;
2203
+ }
2204
+ return rb_big_plus(y, x); /* modified */
2205
+ }
2206
+
2207
+ static VALUE
2208
+ fix_minus(VALUE x, VALUE y)
2209
+ {
2210
+ if (FIXNUM_P(y)) {
2211
+ long a, b, c;
2212
+ VALUE r;
2213
+
2214
+ a = FIX2LONG(x);
2215
+ b = FIX2LONG(y);
2216
+ c = a - b;
2217
+ r = LONG2NUM(c);
2218
+
2219
+ return r;
2220
+ }
2221
+ /* modified */
2222
+ x = rb_int2big(FIX2LONG(x));
2223
+ return rb_big_minus(x, y);
2224
+ }
2225
+
2226
+ #define SQRT_LONG_MAX ((SIGNED_VALUE)1<<((SIZEOF_LONG*CHAR_BIT-1)/2))
2227
+ /*tests if N*N would overflow*/
2228
+ #define FIT_SQRT_LONG(n) (((n)<SQRT_LONG_MAX)&&((n)>=-SQRT_LONG_MAX))
2229
+
2230
+ static VALUE
2231
+ fix_mul(VALUE x, VALUE y)
2232
+ {
2233
+ if (FIXNUM_P(y)) {
2234
+ #ifdef __HP_cc
2235
+ /* avoids an optimization bug of HP aC++/ANSI C B3910B A.06.05 [Jul 25 2005] */
2236
+ volatile
2237
+ #endif
2238
+ long a, b;
2239
+ #if SIZEOF_LONG * 2 <= SIZEOF_LONG_LONG
2240
+ LONG_LONG d;
2241
+ #else
2242
+ VALUE r;
2243
+ #endif
2244
+
2245
+ a = FIX2LONG(x);
2246
+ b = FIX2LONG(y);
2247
+
2248
+ #if SIZEOF_LONG * 2 <= SIZEOF_LONG_LONG
2249
+ d = (LONG_LONG)a * b;
2250
+ if (FIXABLE(d)) return LONG2FIX(d);
2251
+ return rb_ll2inum(d);
2252
+ #else
2253
+ if (a == 0) return x;
2254
+ if (MUL_OVERFLOW_FIXNUM_P(a, b))
2255
+ r = rb_big_mul(rb_int2big(a), rb_int2big(b));
2256
+ else
2257
+ r = LONG2FIX(a * b);
2258
+ return r;
2259
+ #endif
2260
+ }
2261
+ /* modified */
2262
+ return rb_big_mul(y, x);
2263
+ }
2264
+
2265
+ static void
2266
+ fixdivmod(long x, long y, long *divp, long *modp)
2267
+ {
2268
+ long div, mod;
2269
+
2270
+ if (y == 0) rb_bug("fixdivmod(): not reached"); /* modified */
2271
+ if (y < 0) {
2272
+ if (x < 0)
2273
+ div = -x / -y;
2274
+ else
2275
+ div = - (x / -y);
2276
+ }
2277
+ else {
2278
+ if (x < 0)
2279
+ div = - (-x / y);
2280
+ else
2281
+ div = x / y;
2282
+ }
2283
+ mod = x - div*y;
2284
+ if ((mod < 0 && y > 0) || (mod > 0 && y < 0)) {
2285
+ mod += y;
2286
+ div -= 1;
2287
+ }
2288
+ if (divp) *divp = div;
2289
+ if (modp) *modp = mod;
2290
+ }
2291
+
2292
+ /* extracted from fix_divide() */
2293
+ static VALUE
2294
+ fix_div(VALUE x, VALUE y)
2295
+ {
2296
+ if (FIXNUM_P(y)) {
2297
+ long div;
2298
+
2299
+ fixdivmod(FIX2LONG(x), FIX2LONG(y), &div, 0);
2300
+ return LONG2NUM(div);
2301
+ }
2302
+ /* modified */
2303
+ x = rb_int2big(FIX2LONG(x));
2304
+ return rb_big_div(x, y);
2305
+ }
2306
+
2307
+ static VALUE
2308
+ fix_divmod(VALUE x, VALUE y)
2309
+ {
2310
+ if (FIXNUM_P(y)) {
2311
+ long div, mod;
2312
+
2313
+ fixdivmod(FIX2LONG(x), FIX2LONG(y), &div, &mod);
2314
+
2315
+ return rb_assoc_new(LONG2NUM(div), LONG2NUM(mod));
2316
+ }
2317
+ /* modified */
2318
+ x = rb_int2big(FIX2LONG(x));
2319
+ return rb_big_divmod(x, y);
2320
+ }
2321
+
2322
+ static VALUE
2323
+ int_pow(long x, unsigned long y)
2324
+ {
2325
+ int neg = x < 0;
2326
+ long z = 1;
2327
+
2328
+ if (neg) x = -x;
2329
+ if (y & 1)
2330
+ z = x;
2331
+ else
2332
+ neg = 0;
2333
+ y &= ~1;
2334
+ do {
2335
+ while (y % 2 == 0) {
2336
+ if (!FIT_SQRT_LONG(x)) {
2337
+ VALUE v;
2338
+ bignum:
2339
+ v = rb_big_pow(rb_int2big(x), LONG2NUM(y));
2340
+ if (z != 1) v = rb_big_mul(rb_int2big(neg ? -z : z), v);
2341
+ return v;
2342
+ }
2343
+ x = x * x;
2344
+ y >>= 1;
2345
+ }
2346
+ {
2347
+ if (MUL_OVERFLOW_FIXNUM_P(x, z)) {
2348
+ goto bignum;
2349
+ }
2350
+ z = x * z;
2351
+ }
2352
+ } while (--y);
2353
+ if (neg) z = -z;
2354
+ return LONG2NUM(z);
2355
+ }
2356
+
2357
+ static VALUE fix_odd_p(VALUE num);
2358
+
2359
+ static VALUE
2360
+ fix_pow(VALUE x, VALUE y)
2361
+ {
2362
+ long a = FIX2LONG(x);
2363
+
2364
+ if (FIXNUM_P(y)) {
2365
+ long b = FIX2LONG(y);
2366
+
2367
+ if (a == 1) return INT2FIX(1);
2368
+ if (a == -1) {
2369
+ if (b % 2 == 0)
2370
+ return INT2FIX(1);
2371
+ else
2372
+ return INT2FIX(-1);
2373
+ }
2374
+ if (b < 0)
2375
+ rb_bug("fix_pow(): infinity returned"); // modified
2376
+
2377
+ if (b == 0) return INT2FIX(1);
2378
+ if (b == 1) return x;
2379
+ if (a == 0) {
2380
+ if (b > 0) return INT2FIX(0);
2381
+ return DBL2NUM(INFINITY);
2382
+ }
2383
+ return int_pow(a, b);
2384
+ }
2385
+ /* modified */
2386
+ if (a == 1) return INT2FIX(1);
2387
+ if (a == -1) {
2388
+ #define int_even_p(x) (FIXNUM_P(x) ? !fix_odd_p(x) : !rb_big_odd_p(x))
2389
+ if (int_even_p(y)) return INT2FIX(1);
2390
+ else return INT2FIX(-1);
2391
+ }
2392
+ #define negative_int_p(x) (FIXNUM_P(x) ? (FIX2LONG(x) < 0) : !RBIGNUM_SIGN(x))
2393
+ if (negative_int_p(y))
2394
+ return rb_funcall(rb_rational_raw1(x), rb_intern("**"), 1, y);
2395
+ if (a == 0) return INT2FIX(0);
2396
+ x = rb_int2big(FIX2LONG(x));
2397
+ return rb_big_pow(x, y);
2398
+ #undef int_even_p
2399
+ #undef negative_int_p
2400
+ }
2401
+
2402
+ static VALUE
2403
+ fix_equal(VALUE x, VALUE y)
2404
+ {
2405
+ if (x == y) return Qtrue;
2406
+ if (FIXNUM_P(y)) return Qfalse;
2407
+ return rb_big_eq(y, x); /* modified */
2408
+ }
2409
+
2410
+ static VALUE
2411
+ fix_cmp(VALUE x, VALUE y)
2412
+ {
2413
+ if (x == y) return INT2FIX(0);
2414
+ if (FIXNUM_P(y)) {
2415
+ if (FIX2LONG(x) > FIX2LONG(y)) return INT2FIX(1);
2416
+ return INT2FIX(-1);
2417
+ }
2418
+ /* modified */
2419
+ return rb_big_cmp(rb_int2big(FIX2LONG(x)), y);
2420
+ }
2421
+
2422
+ static VALUE
2423
+ fix_odd_p(VALUE num)
2424
+ {
2425
+ if (num & 2) {
2426
+ return Qtrue;
2427
+ }
2428
+ return Qfalse;
2429
+ }