Home | History | Annotate | Line # | Download | only in gdtoa
misc.c revision 1.8
      1  1.8  christos /* $NetBSD: misc.c,v 1.8 2011/11/18 02:38:17 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.4  christos 			if (p5 == NULL)
    419  1.4  christos 				return NULL;
    420  1.1    kleink 			p5->next = 0;
    421  1.1    kleink 			}
    422  1.1    kleink 		FREE_DTOA_LOCK(1);
    423  1.1    kleink #else
    424  1.1    kleink 		p5 = p5s = i2b(625);
    425  1.4  christos 		if (p5 == NULL)
    426  1.4  christos 			return NULL;
    427  1.1    kleink 		p5->next = 0;
    428  1.1    kleink #endif
    429  1.1    kleink 		}
    430  1.1    kleink 	for(;;) {
    431  1.1    kleink 		if (k & 1) {
    432  1.1    kleink 			b1 = mult(b, p5);
    433  1.4  christos 			if (b1 == NULL)
    434  1.4  christos 				return NULL;
    435  1.8  christos 			Bfree(b);
    436  1.1    kleink 			b = b1;
    437  1.1    kleink 			}
    438  1.2    kleink 		if (!(k = (unsigned int)k >> 1))
    439  1.1    kleink 			break;
    440  1.1    kleink 		if ((p51 = p5->next) == 0) {
    441  1.1    kleink #ifdef MULTIPLE_THREADS
    442  1.1    kleink 			ACQUIRE_DTOA_LOCK(1);
    443  1.1    kleink 			if (!(p51 = p5->next)) {
    444  1.1    kleink 				p51 = p5->next = mult(p5,p5);
    445  1.4  christos 				if (p51 == NULL)
    446  1.4  christos 					return NULL;
    447  1.1    kleink 				p51->next = 0;
    448  1.1    kleink 				}
    449  1.1    kleink 			FREE_DTOA_LOCK(1);
    450  1.1    kleink #else
    451  1.1    kleink 			p51 = p5->next = mult(p5,p5);
    452  1.4  christos 			if (p51 == NULL)
    453  1.4  christos 				return NULL;
    454  1.1    kleink 			p51->next = 0;
    455  1.1    kleink #endif
    456  1.1    kleink 			}
    457  1.1    kleink 		p5 = p51;
    458  1.1    kleink 		}
    459  1.1    kleink 	return b;
    460  1.1    kleink 	}
    461  1.1    kleink 
    462  1.1    kleink  Bigint *
    463  1.1    kleink lshift
    464  1.1    kleink #ifdef KR_headers
    465  1.1    kleink 	(b, k) Bigint *b; int k;
    466  1.1    kleink #else
    467  1.1    kleink 	(Bigint *b, int k)
    468  1.1    kleink #endif
    469  1.1    kleink {
    470  1.1    kleink 	int i, k1, n, n1;
    471  1.1    kleink 	Bigint *b1;
    472  1.1    kleink 	ULong *x, *x1, *xe, z;
    473  1.1    kleink 
    474  1.2    kleink 	n = (unsigned int)k >> kshift;
    475  1.1    kleink 	k1 = b->k;
    476  1.1    kleink 	n1 = n + b->wds + 1;
    477  1.1    kleink 	for(i = b->maxwds; n1 > i; i <<= 1)
    478  1.1    kleink 		k1++;
    479  1.1    kleink 	b1 = Balloc(k1);
    480  1.4  christos 	if (b1 == NULL)
    481  1.4  christos 		return NULL;
    482  1.1    kleink 	x1 = b1->x;
    483  1.1    kleink 	for(i = 0; i < n; i++)
    484  1.1    kleink 		*x1++ = 0;
    485  1.1    kleink 	x = b->x;
    486  1.1    kleink 	xe = x + b->wds;
    487  1.1    kleink 	if (k &= kmask) {
    488  1.1    kleink #ifdef Pack_32
    489  1.1    kleink 		k1 = 32 - k;
    490  1.1    kleink 		z = 0;
    491  1.1    kleink 		do {
    492  1.1    kleink 			*x1++ = *x << k | z;
    493  1.1    kleink 			z = *x++ >> k1;
    494  1.1    kleink 			}
    495  1.1    kleink 			while(x < xe);
    496  1.1    kleink 		if ((*x1 = z) !=0)
    497  1.1    kleink 			++n1;
    498  1.1    kleink #else
    499  1.1    kleink 		k1 = 16 - k;
    500  1.1    kleink 		z = 0;
    501  1.1    kleink 		do {
    502  1.1    kleink 			*x1++ = *x << k  & 0xffff | z;
    503  1.1    kleink 			z = *x++ >> k1;
    504  1.1    kleink 			}
    505  1.1    kleink 			while(x < xe);
    506  1.1    kleink 		if (*x1 = z)
    507  1.1    kleink 			++n1;
    508  1.1    kleink #endif
    509  1.1    kleink 		}
    510  1.1    kleink 	else do
    511  1.1    kleink 		*x1++ = *x++;
    512  1.1    kleink 		while(x < xe);
    513  1.1    kleink 	b1->wds = n1 - 1;
    514  1.1    kleink 	Bfree(b);
    515  1.1    kleink 	return b1;
    516  1.1    kleink 	}
    517  1.1    kleink 
    518  1.1    kleink  int
    519  1.1    kleink cmp
    520  1.1    kleink #ifdef KR_headers
    521  1.1    kleink 	(a, b) Bigint *a, *b;
    522  1.1    kleink #else
    523  1.1    kleink 	(Bigint *a, Bigint *b)
    524  1.1    kleink #endif
    525  1.1    kleink {
    526  1.1    kleink 	ULong *xa, *xa0, *xb, *xb0;
    527  1.1    kleink 	int i, j;
    528  1.1    kleink 
    529  1.1    kleink 	i = a->wds;
    530  1.1    kleink 	j = b->wds;
    531  1.1    kleink #ifdef DEBUG
    532  1.1    kleink 	if (i > 1 && !a->x[i-1])
    533  1.1    kleink 		Bug("cmp called with a->x[a->wds-1] == 0");
    534  1.1    kleink 	if (j > 1 && !b->x[j-1])
    535  1.1    kleink 		Bug("cmp called with b->x[b->wds-1] == 0");
    536  1.1    kleink #endif
    537  1.1    kleink 	if (i -= j)
    538  1.1    kleink 		return i;
    539  1.1    kleink 	xa0 = a->x;
    540  1.1    kleink 	xa = xa0 + j;
    541  1.1    kleink 	xb0 = b->x;
    542  1.1    kleink 	xb = xb0 + j;
    543  1.1    kleink 	for(;;) {
    544  1.1    kleink 		if (*--xa != *--xb)
    545  1.1    kleink 			return *xa < *xb ? -1 : 1;
    546  1.1    kleink 		if (xa <= xa0)
    547  1.1    kleink 			break;
    548  1.1    kleink 		}
    549  1.1    kleink 	return 0;
    550  1.1    kleink 	}
    551  1.1    kleink 
    552  1.1    kleink  Bigint *
    553  1.1    kleink diff
    554  1.1    kleink #ifdef KR_headers
    555  1.1    kleink 	(a, b) Bigint *a, *b;
    556  1.1    kleink #else
    557  1.1    kleink 	(Bigint *a, Bigint *b)
    558  1.1    kleink #endif
    559  1.1    kleink {
    560  1.1    kleink 	Bigint *c;
    561  1.1    kleink 	int i, wa, wb;
    562  1.1    kleink 	ULong *xa, *xae, *xb, *xbe, *xc;
    563  1.1    kleink #ifdef ULLong
    564  1.1    kleink 	ULLong borrow, y;
    565  1.1    kleink #else
    566  1.1    kleink 	ULong borrow, y;
    567  1.1    kleink #ifdef Pack_32
    568  1.1    kleink 	ULong z;
    569  1.1    kleink #endif
    570  1.1    kleink #endif
    571  1.1    kleink 
    572  1.1    kleink 	i = cmp(a,b);
    573  1.1    kleink 	if (!i) {
    574  1.1    kleink 		c = Balloc(0);
    575  1.4  christos 		if (c == NULL)
    576  1.4  christos 			return NULL;
    577  1.1    kleink 		c->wds = 1;
    578  1.1    kleink 		c->x[0] = 0;
    579  1.1    kleink 		return c;
    580  1.1    kleink 		}
    581  1.1    kleink 	if (i < 0) {
    582  1.1    kleink 		c = a;
    583  1.1    kleink 		a = b;
    584  1.1    kleink 		b = c;
    585  1.1    kleink 		i = 1;
    586  1.1    kleink 		}
    587  1.1    kleink 	else
    588  1.1    kleink 		i = 0;
    589  1.1    kleink 	c = Balloc(a->k);
    590  1.4  christos 	if (c == NULL)
    591  1.4  christos 		return NULL;
    592  1.1    kleink 	c->sign = i;
    593  1.1    kleink 	wa = a->wds;
    594  1.1    kleink 	xa = a->x;
    595  1.1    kleink 	xae = xa + wa;
    596  1.1    kleink 	wb = b->wds;
    597  1.1    kleink 	xb = b->x;
    598  1.1    kleink 	xbe = xb + wb;
    599  1.1    kleink 	xc = c->x;
    600  1.1    kleink 	borrow = 0;
    601  1.1    kleink #ifdef ULLong
    602  1.1    kleink 	do {
    603  1.1    kleink 		y = (ULLong)*xa++ - *xb++ - borrow;
    604  1.1    kleink 		borrow = y >> 32 & 1UL;
    605  1.2    kleink 		/* LINTED conversion */
    606  1.1    kleink 		*xc++ = y & 0xffffffffUL;
    607  1.1    kleink 		}
    608  1.1    kleink 		while(xb < xbe);
    609  1.1    kleink 	while(xa < xae) {
    610  1.1    kleink 		y = *xa++ - borrow;
    611  1.1    kleink 		borrow = y >> 32 & 1UL;
    612  1.2    kleink 		/* LINTED conversion */
    613  1.1    kleink 		*xc++ = y & 0xffffffffUL;
    614  1.1    kleink 		}
    615  1.1    kleink #else
    616  1.1    kleink #ifdef Pack_32
    617  1.1    kleink 	do {
    618  1.1    kleink 		y = (*xa & 0xffff) - (*xb & 0xffff) - borrow;
    619  1.1    kleink 		borrow = (y & 0x10000) >> 16;
    620  1.1    kleink 		z = (*xa++ >> 16) - (*xb++ >> 16) - borrow;
    621  1.1    kleink 		borrow = (z & 0x10000) >> 16;
    622  1.1    kleink 		Storeinc(xc, z, y);
    623  1.1    kleink 		}
    624  1.1    kleink 		while(xb < xbe);
    625  1.1    kleink 	while(xa < xae) {
    626  1.1    kleink 		y = (*xa & 0xffff) - borrow;
    627  1.1    kleink 		borrow = (y & 0x10000) >> 16;
    628  1.1    kleink 		z = (*xa++ >> 16) - borrow;
    629  1.1    kleink 		borrow = (z & 0x10000) >> 16;
    630  1.1    kleink 		Storeinc(xc, z, y);
    631  1.1    kleink 		}
    632  1.1    kleink #else
    633  1.1    kleink 	do {
    634  1.1    kleink 		y = *xa++ - *xb++ - borrow;
    635  1.1    kleink 		borrow = (y & 0x10000) >> 16;
    636  1.1    kleink 		*xc++ = y & 0xffff;
    637  1.1    kleink 		}
    638  1.1    kleink 		while(xb < xbe);
    639  1.1    kleink 	while(xa < xae) {
    640  1.1    kleink 		y = *xa++ - borrow;
    641  1.1    kleink 		borrow = (y & 0x10000) >> 16;
    642  1.1    kleink 		*xc++ = y & 0xffff;
    643  1.1    kleink 		}
    644  1.1    kleink #endif
    645  1.1    kleink #endif
    646  1.1    kleink 	while(!*--xc)
    647  1.1    kleink 		wa--;
    648  1.1    kleink 	c->wds = wa;
    649  1.1    kleink 	return c;
    650  1.1    kleink 	}
    651  1.1    kleink 
    652  1.1    kleink  double
    653  1.1    kleink b2d
    654  1.1    kleink #ifdef KR_headers
    655  1.1    kleink 	(a, e) Bigint *a; int *e;
    656  1.1    kleink #else
    657  1.1    kleink 	(Bigint *a, int *e)
    658  1.1    kleink #endif
    659  1.1    kleink {
    660  1.1    kleink 	ULong *xa, *xa0, w, y, z;
    661  1.1    kleink 	int k;
    662  1.6  christos 	U d;
    663  1.1    kleink #ifdef VAX
    664  1.1    kleink 	ULong d0, d1;
    665  1.1    kleink #else
    666  1.6  christos #define d0 word0(&d)
    667  1.6  christos #define d1 word1(&d)
    668  1.1    kleink #endif
    669  1.1    kleink 
    670  1.1    kleink 	xa0 = a->x;
    671  1.1    kleink 	xa = xa0 + a->wds;
    672  1.1    kleink 	y = *--xa;
    673  1.1    kleink #ifdef DEBUG
    674  1.1    kleink 	if (!y) Bug("zero y in b2d");
    675  1.1    kleink #endif
    676  1.1    kleink 	k = hi0bits(y);
    677  1.1    kleink 	*e = 32 - k;
    678  1.1    kleink #ifdef Pack_32
    679  1.1    kleink 	if (k < Ebits) {
    680  1.2    kleink 		d0 = Exp_1 | y >> (Ebits - k);
    681  1.1    kleink 		w = xa > xa0 ? *--xa : 0;
    682  1.2    kleink 		d1 = y << ((32-Ebits) + k) | w >> (Ebits - k);
    683  1.1    kleink 		goto ret_d;
    684  1.1    kleink 		}
    685  1.1    kleink 	z = xa > xa0 ? *--xa : 0;
    686  1.1    kleink 	if (k -= Ebits) {
    687  1.2    kleink 		d0 = Exp_1 | y << k | z >> (32 - k);
    688  1.1    kleink 		y = xa > xa0 ? *--xa : 0;
    689  1.2    kleink 		d1 = z << k | y >> (32 - k);
    690  1.1    kleink 		}
    691  1.1    kleink 	else {
    692  1.1    kleink 		d0 = Exp_1 | y;
    693  1.1    kleink 		d1 = z;
    694  1.1    kleink 		}
    695  1.1    kleink #else
    696  1.1    kleink 	if (k < Ebits + 16) {
    697  1.1    kleink 		z = xa > xa0 ? *--xa : 0;
    698  1.1    kleink 		d0 = Exp_1 | y << k - Ebits | z >> Ebits + 16 - k;
    699  1.1    kleink 		w = xa > xa0 ? *--xa : 0;
    700  1.1    kleink 		y = xa > xa0 ? *--xa : 0;
    701  1.1    kleink 		d1 = z << k + 16 - Ebits | w << k - Ebits | y >> 16 + Ebits - k;
    702  1.1    kleink 		goto ret_d;
    703  1.1    kleink 		}
    704  1.1    kleink 	z = xa > xa0 ? *--xa : 0;
    705  1.1    kleink 	w = xa > xa0 ? *--xa : 0;
    706  1.1    kleink 	k -= Ebits + 16;
    707  1.1    kleink 	d0 = Exp_1 | y << k + 16 | z << k | w >> 16 - k;
    708  1.1    kleink 	y = xa > xa0 ? *--xa : 0;
    709  1.1    kleink 	d1 = w << k + 16 | y << k;
    710  1.1    kleink #endif
    711  1.1    kleink  ret_d:
    712  1.1    kleink #ifdef VAX
    713  1.6  christos 	word0(&d) = d0 >> 16 | d0 << 16;
    714  1.6  christos 	word1(&d) = d1 >> 16 | d1 << 16;
    715  1.1    kleink #endif
    716  1.6  christos 	return dval(&d);
    717  1.1    kleink 	}
    718  1.1    kleink #undef d0
    719  1.1    kleink #undef d1
    720  1.1    kleink 
    721  1.1    kleink  Bigint *
    722  1.1    kleink d2b
    723  1.1    kleink #ifdef KR_headers
    724  1.6  christos 	(dd, e, bits) double dd; int *e, *bits;
    725  1.1    kleink #else
    726  1.6  christos 	(double dd, int *e, int *bits)
    727  1.1    kleink #endif
    728  1.1    kleink {
    729  1.1    kleink 	Bigint *b;
    730  1.6  christos 	U d;
    731  1.1    kleink #ifndef Sudden_Underflow
    732  1.1    kleink 	int i;
    733  1.1    kleink #endif
    734  1.1    kleink 	int de, k;
    735  1.1    kleink 	ULong *x, y, z;
    736  1.1    kleink #ifdef VAX
    737  1.1    kleink 	ULong d0, d1;
    738  1.1    kleink #else
    739  1.6  christos #define d0 word0(&d)
    740  1.6  christos #define d1 word1(&d)
    741  1.6  christos #endif
    742  1.6  christos 	d.d = dd;
    743  1.6  christos #ifdef VAX
    744  1.6  christos 	d0 = word0(&d) >> 16 | word0(&d) << 16;
    745  1.6  christos 	d1 = word1(&d) >> 16 | word1(&d) << 16;
    746  1.1    kleink #endif
    747  1.1    kleink 
    748  1.1    kleink #ifdef Pack_32
    749  1.1    kleink 	b = Balloc(1);
    750  1.1    kleink #else
    751  1.1    kleink 	b = Balloc(2);
    752  1.1    kleink #endif
    753  1.4  christos 	if (b == NULL)
    754  1.4  christos 		return NULL;
    755  1.1    kleink 	x = b->x;
    756  1.1    kleink 
    757  1.1    kleink 	z = d0 & Frac_mask;
    758  1.1    kleink 	d0 &= 0x7fffffff;	/* clear sign bit, which we ignore */
    759  1.1    kleink #ifdef Sudden_Underflow
    760  1.1    kleink 	de = (int)(d0 >> Exp_shift);
    761  1.1    kleink #ifndef IBM
    762  1.1    kleink 	z |= Exp_msk11;
    763  1.1    kleink #endif
    764  1.1    kleink #else
    765  1.1    kleink 	if ( (de = (int)(d0 >> Exp_shift)) !=0)
    766  1.1    kleink 		z |= Exp_msk1;
    767  1.1    kleink #endif
    768  1.1    kleink #ifdef Pack_32
    769  1.1    kleink 	if ( (y = d1) !=0) {
    770  1.1    kleink 		if ( (k = lo0bits(&y)) !=0) {
    771  1.2    kleink 			x[0] = y | z << (32 - k);
    772  1.1    kleink 			z >>= k;
    773  1.1    kleink 			}
    774  1.1    kleink 		else
    775  1.1    kleink 			x[0] = y;
    776  1.1    kleink #ifndef Sudden_Underflow
    777  1.1    kleink 		i =
    778  1.1    kleink #endif
    779  1.1    kleink 		     b->wds = (x[1] = z) !=0 ? 2 : 1;
    780  1.1    kleink 		}
    781  1.1    kleink 	else {
    782  1.1    kleink 		k = lo0bits(&z);
    783  1.1    kleink 		x[0] = z;
    784  1.1    kleink #ifndef Sudden_Underflow
    785  1.1    kleink 		i =
    786  1.1    kleink #endif
    787  1.1    kleink 		    b->wds = 1;
    788  1.1    kleink 		k += 32;
    789  1.1    kleink 		}
    790  1.1    kleink #else
    791  1.1    kleink 	if ( (y = d1) !=0) {
    792  1.1    kleink 		if ( (k = lo0bits(&y)) !=0)
    793  1.1    kleink 			if (k >= 16) {
    794  1.1    kleink 				x[0] = y | z << 32 - k & 0xffff;
    795  1.1    kleink 				x[1] = z >> k - 16 & 0xffff;
    796  1.1    kleink 				x[2] = z >> k;
    797  1.1    kleink 				i = 2;
    798  1.1    kleink 				}
    799  1.1    kleink 			else {
    800  1.1    kleink 				x[0] = y & 0xffff;
    801  1.1    kleink 				x[1] = y >> 16 | z << 16 - k & 0xffff;
    802  1.1    kleink 				x[2] = z >> k & 0xffff;
    803  1.1    kleink 				x[3] = z >> k+16;
    804  1.1    kleink 				i = 3;
    805  1.1    kleink 				}
    806  1.1    kleink 		else {
    807  1.1    kleink 			x[0] = y & 0xffff;
    808  1.1    kleink 			x[1] = y >> 16;
    809  1.1    kleink 			x[2] = z & 0xffff;
    810  1.1    kleink 			x[3] = z >> 16;
    811  1.1    kleink 			i = 3;
    812  1.1    kleink 			}
    813  1.1    kleink 		}
    814  1.1    kleink 	else {
    815  1.1    kleink #ifdef DEBUG
    816  1.1    kleink 		if (!z)
    817  1.1    kleink 			Bug("Zero passed to d2b");
    818  1.1    kleink #endif
    819  1.1    kleink 		k = lo0bits(&z);
    820  1.1    kleink 		if (k >= 16) {
    821  1.1    kleink 			x[0] = z;
    822  1.1    kleink 			i = 0;
    823  1.1    kleink 			}
    824  1.1    kleink 		else {
    825  1.1    kleink 			x[0] = z & 0xffff;
    826  1.1    kleink 			x[1] = z >> 16;
    827  1.1    kleink 			i = 1;
    828  1.1    kleink 			}
    829  1.1    kleink 		k += 32;
    830  1.1    kleink 		}
    831  1.1    kleink 	while(!x[i])
    832  1.1    kleink 		--i;
    833  1.1    kleink 	b->wds = i + 1;
    834  1.1    kleink #endif
    835  1.1    kleink #ifndef Sudden_Underflow
    836  1.1    kleink 	if (de) {
    837  1.1    kleink #endif
    838  1.1    kleink #ifdef IBM
    839  1.1    kleink 		*e = (de - Bias - (P-1) << 2) + k;
    840  1.6  christos 		*bits = 4*P + 8 - k - hi0bits(word0(&d) & Frac_mask);
    841  1.1    kleink #else
    842  1.1    kleink 		*e = de - Bias - (P-1) + k;
    843  1.1    kleink 		*bits = P - k;
    844  1.1    kleink #endif
    845  1.1    kleink #ifndef Sudden_Underflow
    846  1.1    kleink 		}
    847  1.1    kleink 	else {
    848  1.1    kleink 		*e = de - Bias - (P-1) + 1 + k;
    849  1.1    kleink #ifdef Pack_32
    850  1.1    kleink 		*bits = 32*i - hi0bits(x[i-1]);
    851  1.1    kleink #else
    852  1.1    kleink 		*bits = (i+2)*16 - hi0bits(x[i]);
    853  1.1    kleink #endif
    854  1.1    kleink 		}
    855  1.1    kleink #endif
    856  1.1    kleink 	return b;
    857  1.1    kleink 	}
    858  1.1    kleink #undef d0
    859  1.1    kleink #undef d1
    860  1.1    kleink 
    861  1.1    kleink  CONST double
    862  1.1    kleink #ifdef IEEE_Arith
    863  1.1    kleink bigtens[] = { 1e16, 1e32, 1e64, 1e128, 1e256 };
    864  1.1    kleink CONST double tinytens[] = { 1e-16, 1e-32, 1e-64, 1e-128, 1e-256
    865  1.1    kleink 		};
    866  1.1    kleink #else
    867  1.1    kleink #ifdef IBM
    868  1.1    kleink bigtens[] = { 1e16, 1e32, 1e64 };
    869  1.1    kleink CONST double tinytens[] = { 1e-16, 1e-32, 1e-64 };
    870  1.1    kleink #else
    871  1.1    kleink bigtens[] = { 1e16, 1e32 };
    872  1.1    kleink CONST double tinytens[] = { 1e-16, 1e-32 };
    873  1.1    kleink #endif
    874  1.1    kleink #endif
    875  1.1    kleink 
    876  1.1    kleink  CONST double
    877  1.1    kleink tens[] = {
    878  1.1    kleink 		1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9,
    879  1.1    kleink 		1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19,
    880  1.1    kleink 		1e20, 1e21, 1e22
    881  1.1    kleink #ifdef VAX
    882  1.1    kleink 		, 1e23, 1e24
    883  1.1    kleink #endif
    884  1.1    kleink 		};
    885  1.1    kleink 
    886  1.1    kleink  char *
    887  1.1    kleink #ifdef KR_headers
    888  1.1    kleink strcp_D2A(a, b) char *a; char *b;
    889  1.1    kleink #else
    890  1.1    kleink strcp_D2A(char *a, CONST char *b)
    891  1.1    kleink #endif
    892  1.1    kleink {
    893  1.2    kleink 	while((*a = *b++))
    894  1.1    kleink 		a++;
    895  1.1    kleink 	return a;
    896  1.1    kleink 	}
    897  1.1    kleink 
    898  1.1    kleink #ifdef NO_STRING_H
    899  1.1    kleink 
    900  1.1    kleink  Char *
    901  1.1    kleink #ifdef KR_headers
    902  1.1    kleink memcpy_D2A(a, b, len) Char *a; Char *b; size_t len;
    903  1.1    kleink #else
    904  1.1    kleink memcpy_D2A(void *a1, void *b1, size_t len)
    905  1.1    kleink #endif
    906  1.1    kleink {
    907  1.2    kleink 	char *a = (char*)a1, *ae = a + len;
    908  1.2    kleink 	char *b = (char*)b1, *a0 = a;
    909  1.1    kleink 	while(a < ae)
    910  1.1    kleink 		*a++ = *b++;
    911  1.1    kleink 	return a0;
    912  1.1    kleink 	}
    913  1.1    kleink 
    914  1.1    kleink #endif /* NO_STRING_H */
    915