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