decimal 0.1.2 → 0.1.3

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
Files changed (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
+ }