Home | History | Annotate | Line # | Download | only in gdtoa
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