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