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