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