gdtoa/gdtoa-misc-fbsd.c

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