misc.c revision 1.9 1 1.9 christos /* $NetBSD: misc.c,v 1.9 2011/11/18 04:17:23 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.9 christos if (p5 == NULL) {
419 1.9 christos FREE_DTOA_LOCK(1);
420 1.4 christos return NULL;
421 1.9 christos }
422 1.1 kleink p5->next = 0;
423 1.1 kleink }
424 1.1 kleink FREE_DTOA_LOCK(1);
425 1.1 kleink #else
426 1.1 kleink p5 = p5s = i2b(625);
427 1.4 christos if (p5 == NULL)
428 1.4 christos return NULL;
429 1.1 kleink p5->next = 0;
430 1.1 kleink #endif
431 1.1 kleink }
432 1.1 kleink for(;;) {
433 1.1 kleink if (k & 1) {
434 1.1 kleink b1 = mult(b, p5);
435 1.4 christos if (b1 == NULL)
436 1.4 christos return NULL;
437 1.8 christos Bfree(b);
438 1.1 kleink b = b1;
439 1.1 kleink }
440 1.2 kleink if (!(k = (unsigned int)k >> 1))
441 1.1 kleink break;
442 1.1 kleink if ((p51 = p5->next) == 0) {
443 1.1 kleink #ifdef MULTIPLE_THREADS
444 1.1 kleink ACQUIRE_DTOA_LOCK(1);
445 1.1 kleink if (!(p51 = p5->next)) {
446 1.1 kleink p51 = p5->next = mult(p5,p5);
447 1.4 christos if (p51 == NULL)
448 1.4 christos return NULL;
449 1.1 kleink p51->next = 0;
450 1.1 kleink }
451 1.1 kleink FREE_DTOA_LOCK(1);
452 1.1 kleink #else
453 1.1 kleink p51 = p5->next = mult(p5,p5);
454 1.4 christos if (p51 == NULL)
455 1.4 christos return NULL;
456 1.1 kleink p51->next = 0;
457 1.1 kleink #endif
458 1.1 kleink }
459 1.1 kleink p5 = p51;
460 1.1 kleink }
461 1.1 kleink return b;
462 1.1 kleink }
463 1.1 kleink
464 1.1 kleink Bigint *
465 1.1 kleink lshift
466 1.1 kleink #ifdef KR_headers
467 1.1 kleink (b, k) Bigint *b; int k;
468 1.1 kleink #else
469 1.1 kleink (Bigint *b, int k)
470 1.1 kleink #endif
471 1.1 kleink {
472 1.1 kleink int i, k1, n, n1;
473 1.1 kleink Bigint *b1;
474 1.1 kleink ULong *x, *x1, *xe, z;
475 1.1 kleink
476 1.2 kleink n = (unsigned int)k >> kshift;
477 1.1 kleink k1 = b->k;
478 1.1 kleink n1 = n + b->wds + 1;
479 1.1 kleink for(i = b->maxwds; n1 > i; i <<= 1)
480 1.1 kleink k1++;
481 1.1 kleink b1 = Balloc(k1);
482 1.4 christos if (b1 == NULL)
483 1.4 christos return NULL;
484 1.1 kleink x1 = b1->x;
485 1.1 kleink for(i = 0; i < n; i++)
486 1.1 kleink *x1++ = 0;
487 1.1 kleink x = b->x;
488 1.1 kleink xe = x + b->wds;
489 1.1 kleink if (k &= kmask) {
490 1.1 kleink #ifdef Pack_32
491 1.1 kleink k1 = 32 - k;
492 1.1 kleink z = 0;
493 1.1 kleink do {
494 1.1 kleink *x1++ = *x << k | z;
495 1.1 kleink z = *x++ >> k1;
496 1.1 kleink }
497 1.1 kleink while(x < xe);
498 1.1 kleink if ((*x1 = z) !=0)
499 1.1 kleink ++n1;
500 1.1 kleink #else
501 1.1 kleink k1 = 16 - k;
502 1.1 kleink z = 0;
503 1.1 kleink do {
504 1.1 kleink *x1++ = *x << k & 0xffff | z;
505 1.1 kleink z = *x++ >> k1;
506 1.1 kleink }
507 1.1 kleink while(x < xe);
508 1.1 kleink if (*x1 = z)
509 1.1 kleink ++n1;
510 1.1 kleink #endif
511 1.1 kleink }
512 1.1 kleink else do
513 1.1 kleink *x1++ = *x++;
514 1.1 kleink while(x < xe);
515 1.1 kleink b1->wds = n1 - 1;
516 1.1 kleink Bfree(b);
517 1.1 kleink return b1;
518 1.1 kleink }
519 1.1 kleink
520 1.1 kleink int
521 1.1 kleink cmp
522 1.1 kleink #ifdef KR_headers
523 1.1 kleink (a, b) Bigint *a, *b;
524 1.1 kleink #else
525 1.1 kleink (Bigint *a, Bigint *b)
526 1.1 kleink #endif
527 1.1 kleink {
528 1.1 kleink ULong *xa, *xa0, *xb, *xb0;
529 1.1 kleink int i, j;
530 1.1 kleink
531 1.1 kleink i = a->wds;
532 1.1 kleink j = b->wds;
533 1.1 kleink #ifdef DEBUG
534 1.1 kleink if (i > 1 && !a->x[i-1])
535 1.1 kleink Bug("cmp called with a->x[a->wds-1] == 0");
536 1.1 kleink if (j > 1 && !b->x[j-1])
537 1.1 kleink Bug("cmp called with b->x[b->wds-1] == 0");
538 1.1 kleink #endif
539 1.1 kleink if (i -= j)
540 1.1 kleink return i;
541 1.1 kleink xa0 = a->x;
542 1.1 kleink xa = xa0 + j;
543 1.1 kleink xb0 = b->x;
544 1.1 kleink xb = xb0 + j;
545 1.1 kleink for(;;) {
546 1.1 kleink if (*--xa != *--xb)
547 1.1 kleink return *xa < *xb ? -1 : 1;
548 1.1 kleink if (xa <= xa0)
549 1.1 kleink break;
550 1.1 kleink }
551 1.1 kleink return 0;
552 1.1 kleink }
553 1.1 kleink
554 1.1 kleink Bigint *
555 1.1 kleink diff
556 1.1 kleink #ifdef KR_headers
557 1.1 kleink (a, b) Bigint *a, *b;
558 1.1 kleink #else
559 1.1 kleink (Bigint *a, Bigint *b)
560 1.1 kleink #endif
561 1.1 kleink {
562 1.1 kleink Bigint *c;
563 1.1 kleink int i, wa, wb;
564 1.1 kleink ULong *xa, *xae, *xb, *xbe, *xc;
565 1.1 kleink #ifdef ULLong
566 1.1 kleink ULLong borrow, y;
567 1.1 kleink #else
568 1.1 kleink ULong borrow, y;
569 1.1 kleink #ifdef Pack_32
570 1.1 kleink ULong z;
571 1.1 kleink #endif
572 1.1 kleink #endif
573 1.1 kleink
574 1.1 kleink i = cmp(a,b);
575 1.1 kleink if (!i) {
576 1.1 kleink c = Balloc(0);
577 1.4 christos if (c == NULL)
578 1.4 christos return NULL;
579 1.1 kleink c->wds = 1;
580 1.1 kleink c->x[0] = 0;
581 1.1 kleink return c;
582 1.1 kleink }
583 1.1 kleink if (i < 0) {
584 1.1 kleink c = a;
585 1.1 kleink a = b;
586 1.1 kleink b = c;
587 1.1 kleink i = 1;
588 1.1 kleink }
589 1.1 kleink else
590 1.1 kleink i = 0;
591 1.1 kleink c = Balloc(a->k);
592 1.4 christos if (c == NULL)
593 1.4 christos return NULL;
594 1.1 kleink c->sign = i;
595 1.1 kleink wa = a->wds;
596 1.1 kleink xa = a->x;
597 1.1 kleink xae = xa + wa;
598 1.1 kleink wb = b->wds;
599 1.1 kleink xb = b->x;
600 1.1 kleink xbe = xb + wb;
601 1.1 kleink xc = c->x;
602 1.1 kleink borrow = 0;
603 1.1 kleink #ifdef ULLong
604 1.1 kleink do {
605 1.1 kleink y = (ULLong)*xa++ - *xb++ - borrow;
606 1.1 kleink borrow = y >> 32 & 1UL;
607 1.2 kleink /* LINTED conversion */
608 1.1 kleink *xc++ = y & 0xffffffffUL;
609 1.1 kleink }
610 1.1 kleink while(xb < xbe);
611 1.1 kleink while(xa < xae) {
612 1.1 kleink y = *xa++ - borrow;
613 1.1 kleink borrow = y >> 32 & 1UL;
614 1.2 kleink /* LINTED conversion */
615 1.1 kleink *xc++ = y & 0xffffffffUL;
616 1.1 kleink }
617 1.1 kleink #else
618 1.1 kleink #ifdef Pack_32
619 1.1 kleink do {
620 1.1 kleink y = (*xa & 0xffff) - (*xb & 0xffff) - borrow;
621 1.1 kleink borrow = (y & 0x10000) >> 16;
622 1.1 kleink z = (*xa++ >> 16) - (*xb++ >> 16) - borrow;
623 1.1 kleink borrow = (z & 0x10000) >> 16;
624 1.1 kleink Storeinc(xc, z, y);
625 1.1 kleink }
626 1.1 kleink while(xb < xbe);
627 1.1 kleink while(xa < xae) {
628 1.1 kleink y = (*xa & 0xffff) - borrow;
629 1.1 kleink borrow = (y & 0x10000) >> 16;
630 1.1 kleink z = (*xa++ >> 16) - borrow;
631 1.1 kleink borrow = (z & 0x10000) >> 16;
632 1.1 kleink Storeinc(xc, z, y);
633 1.1 kleink }
634 1.1 kleink #else
635 1.1 kleink do {
636 1.1 kleink y = *xa++ - *xb++ - borrow;
637 1.1 kleink borrow = (y & 0x10000) >> 16;
638 1.1 kleink *xc++ = y & 0xffff;
639 1.1 kleink }
640 1.1 kleink while(xb < xbe);
641 1.1 kleink while(xa < xae) {
642 1.1 kleink y = *xa++ - borrow;
643 1.1 kleink borrow = (y & 0x10000) >> 16;
644 1.1 kleink *xc++ = y & 0xffff;
645 1.1 kleink }
646 1.1 kleink #endif
647 1.1 kleink #endif
648 1.1 kleink while(!*--xc)
649 1.1 kleink wa--;
650 1.1 kleink c->wds = wa;
651 1.1 kleink return c;
652 1.1 kleink }
653 1.1 kleink
654 1.1 kleink double
655 1.1 kleink b2d
656 1.1 kleink #ifdef KR_headers
657 1.1 kleink (a, e) Bigint *a; int *e;
658 1.1 kleink #else
659 1.1 kleink (Bigint *a, int *e)
660 1.1 kleink #endif
661 1.1 kleink {
662 1.1 kleink ULong *xa, *xa0, w, y, z;
663 1.1 kleink int k;
664 1.6 christos U d;
665 1.1 kleink #ifdef VAX
666 1.1 kleink ULong d0, d1;
667 1.1 kleink #else
668 1.6 christos #define d0 word0(&d)
669 1.6 christos #define d1 word1(&d)
670 1.1 kleink #endif
671 1.1 kleink
672 1.1 kleink xa0 = a->x;
673 1.1 kleink xa = xa0 + a->wds;
674 1.1 kleink y = *--xa;
675 1.1 kleink #ifdef DEBUG
676 1.1 kleink if (!y) Bug("zero y in b2d");
677 1.1 kleink #endif
678 1.1 kleink k = hi0bits(y);
679 1.1 kleink *e = 32 - k;
680 1.1 kleink #ifdef Pack_32
681 1.1 kleink if (k < Ebits) {
682 1.2 kleink d0 = Exp_1 | y >> (Ebits - k);
683 1.1 kleink w = xa > xa0 ? *--xa : 0;
684 1.2 kleink d1 = y << ((32-Ebits) + k) | w >> (Ebits - k);
685 1.1 kleink goto ret_d;
686 1.1 kleink }
687 1.1 kleink z = xa > xa0 ? *--xa : 0;
688 1.1 kleink if (k -= Ebits) {
689 1.2 kleink d0 = Exp_1 | y << k | z >> (32 - k);
690 1.1 kleink y = xa > xa0 ? *--xa : 0;
691 1.2 kleink d1 = z << k | y >> (32 - k);
692 1.1 kleink }
693 1.1 kleink else {
694 1.1 kleink d0 = Exp_1 | y;
695 1.1 kleink d1 = z;
696 1.1 kleink }
697 1.1 kleink #else
698 1.1 kleink if (k < Ebits + 16) {
699 1.1 kleink z = xa > xa0 ? *--xa : 0;
700 1.1 kleink d0 = Exp_1 | y << k - Ebits | z >> Ebits + 16 - k;
701 1.1 kleink w = xa > xa0 ? *--xa : 0;
702 1.1 kleink y = xa > xa0 ? *--xa : 0;
703 1.1 kleink d1 = z << k + 16 - Ebits | w << k - Ebits | y >> 16 + Ebits - k;
704 1.1 kleink goto ret_d;
705 1.1 kleink }
706 1.1 kleink z = xa > xa0 ? *--xa : 0;
707 1.1 kleink w = xa > xa0 ? *--xa : 0;
708 1.1 kleink k -= Ebits + 16;
709 1.1 kleink d0 = Exp_1 | y << k + 16 | z << k | w >> 16 - k;
710 1.1 kleink y = xa > xa0 ? *--xa : 0;
711 1.1 kleink d1 = w << k + 16 | y << k;
712 1.1 kleink #endif
713 1.1 kleink ret_d:
714 1.1 kleink #ifdef VAX
715 1.6 christos word0(&d) = d0 >> 16 | d0 << 16;
716 1.6 christos word1(&d) = d1 >> 16 | d1 << 16;
717 1.1 kleink #endif
718 1.6 christos return dval(&d);
719 1.1 kleink }
720 1.1 kleink #undef d0
721 1.1 kleink #undef d1
722 1.1 kleink
723 1.1 kleink Bigint *
724 1.1 kleink d2b
725 1.1 kleink #ifdef KR_headers
726 1.6 christos (dd, e, bits) double dd; int *e, *bits;
727 1.1 kleink #else
728 1.6 christos (double dd, int *e, int *bits)
729 1.1 kleink #endif
730 1.1 kleink {
731 1.1 kleink Bigint *b;
732 1.6 christos U d;
733 1.1 kleink #ifndef Sudden_Underflow
734 1.1 kleink int i;
735 1.1 kleink #endif
736 1.1 kleink int de, k;
737 1.1 kleink ULong *x, y, z;
738 1.1 kleink #ifdef VAX
739 1.1 kleink ULong d0, d1;
740 1.1 kleink #else
741 1.6 christos #define d0 word0(&d)
742 1.6 christos #define d1 word1(&d)
743 1.6 christos #endif
744 1.6 christos d.d = dd;
745 1.6 christos #ifdef VAX
746 1.6 christos d0 = word0(&d) >> 16 | word0(&d) << 16;
747 1.6 christos d1 = word1(&d) >> 16 | word1(&d) << 16;
748 1.1 kleink #endif
749 1.1 kleink
750 1.1 kleink #ifdef Pack_32
751 1.1 kleink b = Balloc(1);
752 1.1 kleink #else
753 1.1 kleink b = Balloc(2);
754 1.1 kleink #endif
755 1.4 christos if (b == NULL)
756 1.4 christos return NULL;
757 1.1 kleink x = b->x;
758 1.1 kleink
759 1.1 kleink z = d0 & Frac_mask;
760 1.1 kleink d0 &= 0x7fffffff; /* clear sign bit, which we ignore */
761 1.1 kleink #ifdef Sudden_Underflow
762 1.1 kleink de = (int)(d0 >> Exp_shift);
763 1.1 kleink #ifndef IBM
764 1.1 kleink z |= Exp_msk11;
765 1.1 kleink #endif
766 1.1 kleink #else
767 1.1 kleink if ( (de = (int)(d0 >> Exp_shift)) !=0)
768 1.1 kleink z |= Exp_msk1;
769 1.1 kleink #endif
770 1.1 kleink #ifdef Pack_32
771 1.1 kleink if ( (y = d1) !=0) {
772 1.1 kleink if ( (k = lo0bits(&y)) !=0) {
773 1.2 kleink x[0] = y | z << (32 - k);
774 1.1 kleink z >>= k;
775 1.1 kleink }
776 1.1 kleink else
777 1.1 kleink x[0] = y;
778 1.1 kleink #ifndef Sudden_Underflow
779 1.1 kleink i =
780 1.1 kleink #endif
781 1.1 kleink b->wds = (x[1] = z) !=0 ? 2 : 1;
782 1.1 kleink }
783 1.1 kleink else {
784 1.1 kleink k = lo0bits(&z);
785 1.1 kleink x[0] = z;
786 1.1 kleink #ifndef Sudden_Underflow
787 1.1 kleink i =
788 1.1 kleink #endif
789 1.1 kleink b->wds = 1;
790 1.1 kleink k += 32;
791 1.1 kleink }
792 1.1 kleink #else
793 1.1 kleink if ( (y = d1) !=0) {
794 1.1 kleink if ( (k = lo0bits(&y)) !=0)
795 1.1 kleink if (k >= 16) {
796 1.1 kleink x[0] = y | z << 32 - k & 0xffff;
797 1.1 kleink x[1] = z >> k - 16 & 0xffff;
798 1.1 kleink x[2] = z >> k;
799 1.1 kleink i = 2;
800 1.1 kleink }
801 1.1 kleink else {
802 1.1 kleink x[0] = y & 0xffff;
803 1.1 kleink x[1] = y >> 16 | z << 16 - k & 0xffff;
804 1.1 kleink x[2] = z >> k & 0xffff;
805 1.1 kleink x[3] = z >> k+16;
806 1.1 kleink i = 3;
807 1.1 kleink }
808 1.1 kleink else {
809 1.1 kleink x[0] = y & 0xffff;
810 1.1 kleink x[1] = y >> 16;
811 1.1 kleink x[2] = z & 0xffff;
812 1.1 kleink x[3] = z >> 16;
813 1.1 kleink i = 3;
814 1.1 kleink }
815 1.1 kleink }
816 1.1 kleink else {
817 1.1 kleink #ifdef DEBUG
818 1.1 kleink if (!z)
819 1.1 kleink Bug("Zero passed to d2b");
820 1.1 kleink #endif
821 1.1 kleink k = lo0bits(&z);
822 1.1 kleink if (k >= 16) {
823 1.1 kleink x[0] = z;
824 1.1 kleink i = 0;
825 1.1 kleink }
826 1.1 kleink else {
827 1.1 kleink x[0] = z & 0xffff;
828 1.1 kleink x[1] = z >> 16;
829 1.1 kleink i = 1;
830 1.1 kleink }
831 1.1 kleink k += 32;
832 1.1 kleink }
833 1.1 kleink while(!x[i])
834 1.1 kleink --i;
835 1.1 kleink b->wds = i + 1;
836 1.1 kleink #endif
837 1.1 kleink #ifndef Sudden_Underflow
838 1.1 kleink if (de) {
839 1.1 kleink #endif
840 1.1 kleink #ifdef IBM
841 1.1 kleink *e = (de - Bias - (P-1) << 2) + k;
842 1.6 christos *bits = 4*P + 8 - k - hi0bits(word0(&d) & Frac_mask);
843 1.1 kleink #else
844 1.1 kleink *e = de - Bias - (P-1) + k;
845 1.1 kleink *bits = P - k;
846 1.1 kleink #endif
847 1.1 kleink #ifndef Sudden_Underflow
848 1.1 kleink }
849 1.1 kleink else {
850 1.1 kleink *e = de - Bias - (P-1) + 1 + k;
851 1.1 kleink #ifdef Pack_32
852 1.1 kleink *bits = 32*i - hi0bits(x[i-1]);
853 1.1 kleink #else
854 1.1 kleink *bits = (i+2)*16 - hi0bits(x[i]);
855 1.1 kleink #endif
856 1.1 kleink }
857 1.1 kleink #endif
858 1.1 kleink return b;
859 1.1 kleink }
860 1.1 kleink #undef d0
861 1.1 kleink #undef d1
862 1.1 kleink
863 1.1 kleink CONST double
864 1.1 kleink #ifdef IEEE_Arith
865 1.1 kleink bigtens[] = { 1e16, 1e32, 1e64, 1e128, 1e256 };
866 1.1 kleink CONST double tinytens[] = { 1e-16, 1e-32, 1e-64, 1e-128, 1e-256
867 1.1 kleink };
868 1.1 kleink #else
869 1.1 kleink #ifdef IBM
870 1.1 kleink bigtens[] = { 1e16, 1e32, 1e64 };
871 1.1 kleink CONST double tinytens[] = { 1e-16, 1e-32, 1e-64 };
872 1.1 kleink #else
873 1.1 kleink bigtens[] = { 1e16, 1e32 };
874 1.1 kleink CONST double tinytens[] = { 1e-16, 1e-32 };
875 1.1 kleink #endif
876 1.1 kleink #endif
877 1.1 kleink
878 1.1 kleink CONST double
879 1.1 kleink tens[] = {
880 1.1 kleink 1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9,
881 1.1 kleink 1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19,
882 1.1 kleink 1e20, 1e21, 1e22
883 1.1 kleink #ifdef VAX
884 1.1 kleink , 1e23, 1e24
885 1.1 kleink #endif
886 1.1 kleink };
887 1.1 kleink
888 1.1 kleink char *
889 1.1 kleink #ifdef KR_headers
890 1.1 kleink strcp_D2A(a, b) char *a; char *b;
891 1.1 kleink #else
892 1.1 kleink strcp_D2A(char *a, CONST char *b)
893 1.1 kleink #endif
894 1.1 kleink {
895 1.2 kleink while((*a = *b++))
896 1.1 kleink a++;
897 1.1 kleink return a;
898 1.1 kleink }
899 1.1 kleink
900 1.1 kleink #ifdef NO_STRING_H
901 1.1 kleink
902 1.1 kleink Char *
903 1.1 kleink #ifdef KR_headers
904 1.1 kleink memcpy_D2A(a, b, len) Char *a; Char *b; size_t len;
905 1.1 kleink #else
906 1.1 kleink memcpy_D2A(void *a1, void *b1, size_t len)
907 1.1 kleink #endif
908 1.1 kleink {
909 1.2 kleink char *a = (char*)a1, *ae = a + len;
910 1.2 kleink char *b = (char*)b1, *a0 = a;
911 1.1 kleink while(a < ae)
912 1.1 kleink *a++ = *b++;
913 1.1 kleink return a0;
914 1.1 kleink }
915 1.1 kleink
916 1.1 kleink #endif /* NO_STRING_H */
917