decimal 0.1.0 → 0.1.1

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