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