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