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