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