misc.c revision 1.1.1.1 1 /* $NetBSD: misc.c,v 1.1.1.1 2006/01/25 15:18:48 kleink Exp $ */
2
3 /****************************************************************
4
5 The author of this software is David M. Gay.
6
7 Copyright (C) 1998, 1999 by Lucent Technologies
8 All Rights Reserved
9
10 Permission to use, copy, modify, and distribute this software and
11 its documentation for any purpose and without fee is hereby
12 granted, provided that the above copyright notice appear in all
13 copies and that both that the copyright notice and this
14 permission notice and warranty disclaimer appear in supporting
15 documentation, and that the name of Lucent or any of its entities
16 not be used in advertising or publicity pertaining to
17 distribution of the software without specific, written prior
18 permission.
19
20 LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
21 INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
22 IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
23 SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
24 WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
25 IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
26 ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
27 THIS SOFTWARE.
28
29 ****************************************************************/
30
31 /* Please send bug reports to David M. Gay (dmg at acm dot org,
32 * with " at " changed at "@" and " dot " changed to "."). */
33
34 #include "gdtoaimp.h"
35
36 static Bigint *freelist[Kmax+1];
37 #ifndef Omit_Private_Memory
38 #ifndef PRIVATE_MEM
39 #define PRIVATE_MEM 2304
40 #endif
41 #define PRIVATE_mem ((PRIVATE_MEM+sizeof(double)-1)/sizeof(double))
42 static double private_mem[PRIVATE_mem], *pmem_next = private_mem;
43 #endif
44
45 Bigint *
46 Balloc
47 #ifdef KR_headers
48 (k) int k;
49 #else
50 (int k)
51 #endif
52 {
53 int x;
54 Bigint *rv;
55 #ifndef Omit_Private_Memory
56 unsigned int len;
57 #endif
58
59 ACQUIRE_DTOA_LOCK(0);
60 if ( (rv = freelist[k]) !=0) {
61 freelist[k] = rv->next;
62 }
63 else {
64 x = 1 << k;
65 #ifdef Omit_Private_Memory
66 rv = (Bigint *)MALLOC(sizeof(Bigint) + (x-1)*sizeof(ULong));
67 #else
68 len = (sizeof(Bigint) + (x-1)*sizeof(ULong) + sizeof(double) - 1)
69 /sizeof(double);
70 if (pmem_next - private_mem + len <= PRIVATE_mem) {
71 rv = (Bigint*)pmem_next;
72 pmem_next += len;
73 }
74 else
75 rv = (Bigint*)MALLOC(len*sizeof(double));
76 #endif
77 rv->k = k;
78 rv->maxwds = x;
79 }
80 FREE_DTOA_LOCK(0);
81 rv->sign = rv->wds = 0;
82 return rv;
83 }
84
85 void
86 Bfree
87 #ifdef KR_headers
88 (v) Bigint *v;
89 #else
90 (Bigint *v)
91 #endif
92 {
93 if (v) {
94 ACQUIRE_DTOA_LOCK(0);
95 v->next = freelist[v->k];
96 freelist[v->k] = v;
97 FREE_DTOA_LOCK(0);
98 }
99 }
100
101 int
102 lo0bits
103 #ifdef KR_headers
104 (y) ULong *y;
105 #else
106 (ULong *y)
107 #endif
108 {
109 register int k;
110 register ULong x = *y;
111
112 if (x & 7) {
113 if (x & 1)
114 return 0;
115 if (x & 2) {
116 *y = x >> 1;
117 return 1;
118 }
119 *y = x >> 2;
120 return 2;
121 }
122 k = 0;
123 if (!(x & 0xffff)) {
124 k = 16;
125 x >>= 16;
126 }
127 if (!(x & 0xff)) {
128 k += 8;
129 x >>= 8;
130 }
131 if (!(x & 0xf)) {
132 k += 4;
133 x >>= 4;
134 }
135 if (!(x & 0x3)) {
136 k += 2;
137 x >>= 2;
138 }
139 if (!(x & 1)) {
140 k++;
141 x >>= 1;
142 if (!x)
143 return 32;
144 }
145 *y = x;
146 return k;
147 }
148
149 Bigint *
150 multadd
151 #ifdef KR_headers
152 (b, m, a) Bigint *b; int m, a;
153 #else
154 (Bigint *b, int m, int a) /* multiply by m and add a */
155 #endif
156 {
157 int i, wds;
158 #ifdef ULLong
159 ULong *x;
160 ULLong carry, y;
161 #else
162 ULong carry, *x, y;
163 #ifdef Pack_32
164 ULong xi, z;
165 #endif
166 #endif
167 Bigint *b1;
168
169 wds = b->wds;
170 x = b->x;
171 i = 0;
172 carry = a;
173 do {
174 #ifdef ULLong
175 y = *x * (ULLong)m + carry;
176 carry = y >> 32;
177 *x++ = y & 0xffffffffUL;
178 #else
179 #ifdef Pack_32
180 xi = *x;
181 y = (xi & 0xffff) * m + carry;
182 z = (xi >> 16) * m + (y >> 16);
183 carry = z >> 16;
184 *x++ = (z << 16) + (y & 0xffff);
185 #else
186 y = *x * m + carry;
187 carry = y >> 16;
188 *x++ = y & 0xffff;
189 #endif
190 #endif
191 }
192 while(++i < wds);
193 if (carry) {
194 if (wds >= b->maxwds) {
195 b1 = Balloc(b->k+1);
196 Bcopy(b1, b);
197 Bfree(b);
198 b = b1;
199 }
200 b->x[wds++] = carry;
201 b->wds = wds;
202 }
203 return b;
204 }
205
206 int
207 hi0bits_D2A
208 #ifdef KR_headers
209 (x) register ULong x;
210 #else
211 (register ULong x)
212 #endif
213 {
214 register int k = 0;
215
216 if (!(x & 0xffff0000)) {
217 k = 16;
218 x <<= 16;
219 }
220 if (!(x & 0xff000000)) {
221 k += 8;
222 x <<= 8;
223 }
224 if (!(x & 0xf0000000)) {
225 k += 4;
226 x <<= 4;
227 }
228 if (!(x & 0xc0000000)) {
229 k += 2;
230 x <<= 2;
231 }
232 if (!(x & 0x80000000)) {
233 k++;
234 if (!(x & 0x40000000))
235 return 32;
236 }
237 return k;
238 }
239
240 Bigint *
241 i2b
242 #ifdef KR_headers
243 (i) int i;
244 #else
245 (int i)
246 #endif
247 {
248 Bigint *b;
249
250 b = Balloc(1);
251 b->x[0] = i;
252 b->wds = 1;
253 return b;
254 }
255
256 Bigint *
257 mult
258 #ifdef KR_headers
259 (a, b) Bigint *a, *b;
260 #else
261 (Bigint *a, Bigint *b)
262 #endif
263 {
264 Bigint *c;
265 int k, wa, wb, wc;
266 ULong *x, *xa, *xae, *xb, *xbe, *xc, *xc0;
267 ULong y;
268 #ifdef ULLong
269 ULLong carry, z;
270 #else
271 ULong carry, z;
272 #ifdef Pack_32
273 ULong z2;
274 #endif
275 #endif
276
277 if (a->wds < b->wds) {
278 c = a;
279 a = b;
280 b = c;
281 }
282 k = a->k;
283 wa = a->wds;
284 wb = b->wds;
285 wc = wa + wb;
286 if (wc > a->maxwds)
287 k++;
288 c = Balloc(k);
289 for(x = c->x, xa = x + wc; x < xa; x++)
290 *x = 0;
291 xa = a->x;
292 xae = xa + wa;
293 xb = b->x;
294 xbe = xb + wb;
295 xc0 = c->x;
296 #ifdef ULLong
297 for(; xb < xbe; xc0++) {
298 if ( (y = *xb++) !=0) {
299 x = xa;
300 xc = xc0;
301 carry = 0;
302 do {
303 z = *x++ * (ULLong)y + *xc + carry;
304 carry = z >> 32;
305 *xc++ = z & 0xffffffffUL;
306 }
307 while(x < xae);
308 *xc = carry;
309 }
310 }
311 #else
312 #ifdef Pack_32
313 for(; xb < xbe; xb++, xc0++) {
314 if ( (y = *xb & 0xffff) !=0) {
315 x = xa;
316 xc = xc0;
317 carry = 0;
318 do {
319 z = (*x & 0xffff) * y + (*xc & 0xffff) + carry;
320 carry = z >> 16;
321 z2 = (*x++ >> 16) * y + (*xc >> 16) + carry;
322 carry = z2 >> 16;
323 Storeinc(xc, z2, z);
324 }
325 while(x < xae);
326 *xc = carry;
327 }
328 if ( (y = *xb >> 16) !=0) {
329 x = xa;
330 xc = xc0;
331 carry = 0;
332 z2 = *xc;
333 do {
334 z = (*x & 0xffff) * y + (*xc >> 16) + carry;
335 carry = z >> 16;
336 Storeinc(xc, z, z2);
337 z2 = (*x++ >> 16) * y + (*xc & 0xffff) + carry;
338 carry = z2 >> 16;
339 }
340 while(x < xae);
341 *xc = z2;
342 }
343 }
344 #else
345 for(; xb < xbe; xc0++) {
346 if ( (y = *xb++) !=0) {
347 x = xa;
348 xc = xc0;
349 carry = 0;
350 do {
351 z = *x++ * y + *xc + carry;
352 carry = z >> 16;
353 *xc++ = z & 0xffff;
354 }
355 while(x < xae);
356 *xc = carry;
357 }
358 }
359 #endif
360 #endif
361 for(xc0 = c->x, xc = xc0 + wc; wc > 0 && !*--xc; --wc) ;
362 c->wds = wc;
363 return c;
364 }
365
366 static Bigint *p5s;
367
368 Bigint *
369 pow5mult
370 #ifdef KR_headers
371 (b, k) Bigint *b; int k;
372 #else
373 (Bigint *b, int k)
374 #endif
375 {
376 Bigint *b1, *p5, *p51;
377 int i;
378 static int p05[3] = { 5, 25, 125 };
379
380 if ( (i = k & 3) !=0)
381 b = multadd(b, p05[i-1], 0);
382
383 if (!(k >>= 2))
384 return b;
385 if ((p5 = p5s) == 0) {
386 /* first time */
387 #ifdef MULTIPLE_THREADS
388 ACQUIRE_DTOA_LOCK(1);
389 if (!(p5 = p5s)) {
390 p5 = p5s = i2b(625);
391 p5->next = 0;
392 }
393 FREE_DTOA_LOCK(1);
394 #else
395 p5 = p5s = i2b(625);
396 p5->next = 0;
397 #endif
398 }
399 for(;;) {
400 if (k & 1) {
401 b1 = mult(b, p5);
402 Bfree(b);
403 b = b1;
404 }
405 if (!(k >>= 1))
406 break;
407 if ((p51 = p5->next) == 0) {
408 #ifdef MULTIPLE_THREADS
409 ACQUIRE_DTOA_LOCK(1);
410 if (!(p51 = p5->next)) {
411 p51 = p5->next = mult(p5,p5);
412 p51->next = 0;
413 }
414 FREE_DTOA_LOCK(1);
415 #else
416 p51 = p5->next = mult(p5,p5);
417 p51->next = 0;
418 #endif
419 }
420 p5 = p51;
421 }
422 return b;
423 }
424
425 Bigint *
426 lshift
427 #ifdef KR_headers
428 (b, k) Bigint *b; int k;
429 #else
430 (Bigint *b, int k)
431 #endif
432 {
433 int i, k1, n, n1;
434 Bigint *b1;
435 ULong *x, *x1, *xe, z;
436
437 n = k >> kshift;
438 k1 = b->k;
439 n1 = n + b->wds + 1;
440 for(i = b->maxwds; n1 > i; i <<= 1)
441 k1++;
442 b1 = Balloc(k1);
443 x1 = b1->x;
444 for(i = 0; i < n; i++)
445 *x1++ = 0;
446 x = b->x;
447 xe = x + b->wds;
448 if (k &= kmask) {
449 #ifdef Pack_32
450 k1 = 32 - k;
451 z = 0;
452 do {
453 *x1++ = *x << k | z;
454 z = *x++ >> k1;
455 }
456 while(x < xe);
457 if ((*x1 = z) !=0)
458 ++n1;
459 #else
460 k1 = 16 - k;
461 z = 0;
462 do {
463 *x1++ = *x << k & 0xffff | z;
464 z = *x++ >> k1;
465 }
466 while(x < xe);
467 if (*x1 = z)
468 ++n1;
469 #endif
470 }
471 else do
472 *x1++ = *x++;
473 while(x < xe);
474 b1->wds = n1 - 1;
475 Bfree(b);
476 return b1;
477 }
478
479 int
480 cmp
481 #ifdef KR_headers
482 (a, b) Bigint *a, *b;
483 #else
484 (Bigint *a, Bigint *b)
485 #endif
486 {
487 ULong *xa, *xa0, *xb, *xb0;
488 int i, j;
489
490 i = a->wds;
491 j = b->wds;
492 #ifdef DEBUG
493 if (i > 1 && !a->x[i-1])
494 Bug("cmp called with a->x[a->wds-1] == 0");
495 if (j > 1 && !b->x[j-1])
496 Bug("cmp called with b->x[b->wds-1] == 0");
497 #endif
498 if (i -= j)
499 return i;
500 xa0 = a->x;
501 xa = xa0 + j;
502 xb0 = b->x;
503 xb = xb0 + j;
504 for(;;) {
505 if (*--xa != *--xb)
506 return *xa < *xb ? -1 : 1;
507 if (xa <= xa0)
508 break;
509 }
510 return 0;
511 }
512
513 Bigint *
514 diff
515 #ifdef KR_headers
516 (a, b) Bigint *a, *b;
517 #else
518 (Bigint *a, Bigint *b)
519 #endif
520 {
521 Bigint *c;
522 int i, wa, wb;
523 ULong *xa, *xae, *xb, *xbe, *xc;
524 #ifdef ULLong
525 ULLong borrow, y;
526 #else
527 ULong borrow, y;
528 #ifdef Pack_32
529 ULong z;
530 #endif
531 #endif
532
533 i = cmp(a,b);
534 if (!i) {
535 c = Balloc(0);
536 c->wds = 1;
537 c->x[0] = 0;
538 return c;
539 }
540 if (i < 0) {
541 c = a;
542 a = b;
543 b = c;
544 i = 1;
545 }
546 else
547 i = 0;
548 c = Balloc(a->k);
549 c->sign = i;
550 wa = a->wds;
551 xa = a->x;
552 xae = xa + wa;
553 wb = b->wds;
554 xb = b->x;
555 xbe = xb + wb;
556 xc = c->x;
557 borrow = 0;
558 #ifdef ULLong
559 do {
560 y = (ULLong)*xa++ - *xb++ - borrow;
561 borrow = y >> 32 & 1UL;
562 *xc++ = y & 0xffffffffUL;
563 }
564 while(xb < xbe);
565 while(xa < xae) {
566 y = *xa++ - borrow;
567 borrow = y >> 32 & 1UL;
568 *xc++ = y & 0xffffffffUL;
569 }
570 #else
571 #ifdef Pack_32
572 do {
573 y = (*xa & 0xffff) - (*xb & 0xffff) - borrow;
574 borrow = (y & 0x10000) >> 16;
575 z = (*xa++ >> 16) - (*xb++ >> 16) - borrow;
576 borrow = (z & 0x10000) >> 16;
577 Storeinc(xc, z, y);
578 }
579 while(xb < xbe);
580 while(xa < xae) {
581 y = (*xa & 0xffff) - borrow;
582 borrow = (y & 0x10000) >> 16;
583 z = (*xa++ >> 16) - borrow;
584 borrow = (z & 0x10000) >> 16;
585 Storeinc(xc, z, y);
586 }
587 #else
588 do {
589 y = *xa++ - *xb++ - borrow;
590 borrow = (y & 0x10000) >> 16;
591 *xc++ = y & 0xffff;
592 }
593 while(xb < xbe);
594 while(xa < xae) {
595 y = *xa++ - borrow;
596 borrow = (y & 0x10000) >> 16;
597 *xc++ = y & 0xffff;
598 }
599 #endif
600 #endif
601 while(!*--xc)
602 wa--;
603 c->wds = wa;
604 return c;
605 }
606
607 double
608 b2d
609 #ifdef KR_headers
610 (a, e) Bigint *a; int *e;
611 #else
612 (Bigint *a, int *e)
613 #endif
614 {
615 ULong *xa, *xa0, w, y, z;
616 int k;
617 double d;
618 #ifdef VAX
619 ULong d0, d1;
620 #else
621 #define d0 word0(d)
622 #define d1 word1(d)
623 #endif
624
625 xa0 = a->x;
626 xa = xa0 + a->wds;
627 y = *--xa;
628 #ifdef DEBUG
629 if (!y) Bug("zero y in b2d");
630 #endif
631 k = hi0bits(y);
632 *e = 32 - k;
633 #ifdef Pack_32
634 if (k < Ebits) {
635 d0 = Exp_1 | y >> Ebits - k;
636 w = xa > xa0 ? *--xa : 0;
637 d1 = y << (32-Ebits) + k | w >> Ebits - k;
638 goto ret_d;
639 }
640 z = xa > xa0 ? *--xa : 0;
641 if (k -= Ebits) {
642 d0 = Exp_1 | y << k | z >> 32 - k;
643 y = xa > xa0 ? *--xa : 0;
644 d1 = z << k | y >> 32 - k;
645 }
646 else {
647 d0 = Exp_1 | y;
648 d1 = z;
649 }
650 #else
651 if (k < Ebits + 16) {
652 z = xa > xa0 ? *--xa : 0;
653 d0 = Exp_1 | y << k - Ebits | z >> Ebits + 16 - k;
654 w = xa > xa0 ? *--xa : 0;
655 y = xa > xa0 ? *--xa : 0;
656 d1 = z << k + 16 - Ebits | w << k - Ebits | y >> 16 + Ebits - k;
657 goto ret_d;
658 }
659 z = xa > xa0 ? *--xa : 0;
660 w = xa > xa0 ? *--xa : 0;
661 k -= Ebits + 16;
662 d0 = Exp_1 | y << k + 16 | z << k | w >> 16 - k;
663 y = xa > xa0 ? *--xa : 0;
664 d1 = w << k + 16 | y << k;
665 #endif
666 ret_d:
667 #ifdef VAX
668 word0(d) = d0 >> 16 | d0 << 16;
669 word1(d) = d1 >> 16 | d1 << 16;
670 #endif
671 return dval(d);
672 }
673 #undef d0
674 #undef d1
675
676 Bigint *
677 d2b
678 #ifdef KR_headers
679 (d, e, bits) double d; int *e, *bits;
680 #else
681 (double d, int *e, int *bits)
682 #endif
683 {
684 Bigint *b;
685 #ifndef Sudden_Underflow
686 int i;
687 #endif
688 int de, k;
689 ULong *x, y, z;
690 #ifdef VAX
691 ULong d0, d1;
692 d0 = word0(d) >> 16 | word0(d) << 16;
693 d1 = word1(d) >> 16 | word1(d) << 16;
694 #else
695 #define d0 word0(d)
696 #define d1 word1(d)
697 #endif
698
699 #ifdef Pack_32
700 b = Balloc(1);
701 #else
702 b = Balloc(2);
703 #endif
704 x = b->x;
705
706 z = d0 & Frac_mask;
707 d0 &= 0x7fffffff; /* clear sign bit, which we ignore */
708 #ifdef Sudden_Underflow
709 de = (int)(d0 >> Exp_shift);
710 #ifndef IBM
711 z |= Exp_msk11;
712 #endif
713 #else
714 if ( (de = (int)(d0 >> Exp_shift)) !=0)
715 z |= Exp_msk1;
716 #endif
717 #ifdef Pack_32
718 if ( (y = d1) !=0) {
719 if ( (k = lo0bits(&y)) !=0) {
720 x[0] = y | z << 32 - k;
721 z >>= k;
722 }
723 else
724 x[0] = y;
725 #ifndef Sudden_Underflow
726 i =
727 #endif
728 b->wds = (x[1] = z) !=0 ? 2 : 1;
729 }
730 else {
731 #ifdef DEBUG
732 if (!z)
733 Bug("Zero passed to d2b");
734 #endif
735 k = lo0bits(&z);
736 x[0] = z;
737 #ifndef Sudden_Underflow
738 i =
739 #endif
740 b->wds = 1;
741 k += 32;
742 }
743 #else
744 if ( (y = d1) !=0) {
745 if ( (k = lo0bits(&y)) !=0)
746 if (k >= 16) {
747 x[0] = y | z << 32 - k & 0xffff;
748 x[1] = z >> k - 16 & 0xffff;
749 x[2] = z >> k;
750 i = 2;
751 }
752 else {
753 x[0] = y & 0xffff;
754 x[1] = y >> 16 | z << 16 - k & 0xffff;
755 x[2] = z >> k & 0xffff;
756 x[3] = z >> k+16;
757 i = 3;
758 }
759 else {
760 x[0] = y & 0xffff;
761 x[1] = y >> 16;
762 x[2] = z & 0xffff;
763 x[3] = z >> 16;
764 i = 3;
765 }
766 }
767 else {
768 #ifdef DEBUG
769 if (!z)
770 Bug("Zero passed to d2b");
771 #endif
772 k = lo0bits(&z);
773 if (k >= 16) {
774 x[0] = z;
775 i = 0;
776 }
777 else {
778 x[0] = z & 0xffff;
779 x[1] = z >> 16;
780 i = 1;
781 }
782 k += 32;
783 }
784 while(!x[i])
785 --i;
786 b->wds = i + 1;
787 #endif
788 #ifndef Sudden_Underflow
789 if (de) {
790 #endif
791 #ifdef IBM
792 *e = (de - Bias - (P-1) << 2) + k;
793 *bits = 4*P + 8 - k - hi0bits(word0(d) & Frac_mask);
794 #else
795 *e = de - Bias - (P-1) + k;
796 *bits = P - k;
797 #endif
798 #ifndef Sudden_Underflow
799 }
800 else {
801 *e = de - Bias - (P-1) + 1 + k;
802 #ifdef Pack_32
803 *bits = 32*i - hi0bits(x[i-1]);
804 #else
805 *bits = (i+2)*16 - hi0bits(x[i]);
806 #endif
807 }
808 #endif
809 return b;
810 }
811 #undef d0
812 #undef d1
813
814 CONST double
815 #ifdef IEEE_Arith
816 bigtens[] = { 1e16, 1e32, 1e64, 1e128, 1e256 };
817 CONST double tinytens[] = { 1e-16, 1e-32, 1e-64, 1e-128, 1e-256
818 };
819 #else
820 #ifdef IBM
821 bigtens[] = { 1e16, 1e32, 1e64 };
822 CONST double tinytens[] = { 1e-16, 1e-32, 1e-64 };
823 #else
824 bigtens[] = { 1e16, 1e32 };
825 CONST double tinytens[] = { 1e-16, 1e-32 };
826 #endif
827 #endif
828
829 CONST double
830 tens[] = {
831 1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9,
832 1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19,
833 1e20, 1e21, 1e22
834 #ifdef VAX
835 , 1e23, 1e24
836 #endif
837 };
838
839 char *
840 #ifdef KR_headers
841 strcp_D2A(a, b) char *a; char *b;
842 #else
843 strcp_D2A(char *a, CONST char *b)
844 #endif
845 {
846 while(*a = *b++)
847 a++;
848 return a;
849 }
850
851 #ifdef NO_STRING_H
852
853 Char *
854 #ifdef KR_headers
855 memcpy_D2A(a, b, len) Char *a; Char *b; size_t len;
856 #else
857 memcpy_D2A(void *a1, void *b1, size_t len)
858 #endif
859 {
860 register char *a = (char*)a1, *ae = a + len;
861 register char *b = (char*)b1, *a0 = a;
862 while(a < ae)
863 *a++ = *b++;
864 return a0;
865 }
866
867 #endif /* NO_STRING_H */
868