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