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