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