decimal 0.1.0 → 0.1.1

Sign up to get free protection for your applications and to get access to all the features.
@@ -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
+ }