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