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