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