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