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