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