1 /****************************************************************
2  *
3  * The author of this software is David M. Gay.
4  *
5  * Copyright (c) 1991 by AT&T.
6  *
7  * Permission to use, copy, modify, and distribute this software for any
8  * purpose without fee is hereby granted, provided that this entire notice
9  * is included in all copies of any software which is or includes a copy
10  * or modification of this software and in all copies of the supporting
11  * documentation for such software.
12  *
13  * THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
14  * WARRANTY.  IN PARTICULAR, NEITHER THE AUTHOR NOR AT&T MAKES ANY
15  * REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
16  * OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
17  *
18  ***************************************************************/
19 
20 /* Please send bug reports to
21 	David M. Gay
22 	AT&T Bell Laboratories, Room 2C-463
23 	600 Mountain Avenue
24 	Murray Hill, NJ 07974-2070
25 	U.S.A.
26 	dmg@research.att.com or research!dmg
27  */
28 
29 /* strtod for IEEE-, VAX-, and IBM-arithmetic machines.
30  *
31  * This strtod returns a nearest machine number to the input decimal
32  * string (or sets errno to ERANGE).  With IEEE arithmetic, ties are
33  * broken by the IEEE round-even rule.  Otherwise ties are broken by
34  * biased rounding (add half and chop).
35  *
36  * Inspired loosely by William D. Clinger's paper "How to Read Floating
37  * Point Numbers Accurately" [Proc. ACM SIGPLAN '90, pp. 92-101].
38  *
39  * Modifications:
40  *
41  *	1. We only require IEEE, IBM, or VAX double-precision
42  *		arithmetic (not IEEE double-extended).
43  *	2. We get by with floating-point arithmetic in a case that
44  *		Clinger missed -- when we're computing d * 10^n
45  *		for a small integer d and the integer n is not too
46  *		much larger than 22 (the maximum integer k for which
47  *		we can represent 10^k exactly), we may be able to
48  *		compute (d*10^k) * 10^(e-k) with just one roundoff.
49  *	3. Rather than a bit-at-a-time adjustment of the binary
50  *		result in the hard case, we use floating-point
51  *		arithmetic to determine the adjustment to within
52  *		one bit; only in really hard cases do we need to
53  *		compute a second residual.
54  *	4. Because of 3., we don't need a large table of powers of 10
55  *		for ten-to-e (just some small tables, e.g. of 10^k
56  *		for 0 <= k <= 22).
57  */
58 
59 /*
60  * #define IEEE_8087 for IEEE-arithmetic machines where the least
61  *	significant byte has the lowest address.
62  * #define IEEE_MC68k for IEEE-arithmetic machines where the most
63  *	significant byte has the lowest address.
64  * #define Sudden_Underflow for IEEE-format machines without gradual
65  *	underflow (i.e., that flush to zero on underflow).
66  * #define IBM for IBM mainframe-style floating-point arithmetic.
67  * #define VAX for VAX-style floating-point arithmetic.
68  * #define Unsigned_Shifts if >> does treats its left operand as unsigned.
69  * #define No_leftright to omit left-right logic in fast floating-point
70  *	computation of dtoa.
71  * #define Check_FLT_ROUNDS if FLT_ROUNDS can assume the values 2 or 3.
72  * #define RND_PRODQUOT to use rnd_prod and rnd_quot (assembly routines
73  *	that use extended-precision instructions to compute rounded
74  *	products and quotients) with IBM.
75  * #define ROUND_BIASED for IEEE-format with biased rounding.
76  * #define Inaccurate_Divide for IEEE-format with correctly rounded
77  *	products but inaccurate quotients, e.g., for Intel i860.
78  * #define Just_16 to store 16 bits per 32-bit long when doing high-precision
79  *	integer arithmetic.  Whether this speeds things up or slows things
80  *	down depends on the machine and the number being converted.
81  */
82 
83 /*#include <_ansi.h>*/
84 #include <assert.h>
85 #include <stdlib.h>
86 #include <string.h>
87 /* #include <reent.h> */
88 #include "mprec.h"
89 
90 /* reent.c knows this value */
91 /* #define _Kmax 15 */
92 
93 #define _reent _Jv_reent
94 #define _Bigint _Jv_Bigint
95 
96 #define _REENT_CHECK_MP(x)
97 #define _REENT_MP_FREELIST(x) ((x)->_freelist)
98 #define _REENT_MP_P5S(x) ((x)->_p5s)
99 
100 typedef unsigned long __ULong;
101 typedef long __Long;
102 
103 static void *
mprec_calloc(void * ignore,size_t x1,size_t x2)104 mprec_calloc (void *ignore, size_t x1, size_t x2)
105 {
106   char *result = (char *) malloc (x1 * x2);
107   memset (result, 0, x1 * x2);
108   return result;
109 }
110 
111 _Bigint *
112 _DEFUN (Balloc, (ptr, k), struct _reent *ptr _AND int k)
113 {
114   int x;
115   _Bigint *rv ;
116   int new_k = k + 1;
117 
118   _REENT_CHECK_MP(ptr);
119   if (_REENT_MP_FREELIST(ptr) == NULL)
120     {
121       /* Allocate a list of pointers to the mprec objects */
122       _REENT_MP_FREELIST(ptr) = (struct _Bigint **) mprec_calloc (ptr,
123 						      sizeof (struct _Bigint *),
124 							       new_k);
125       if (_REENT_MP_FREELIST(ptr) == NULL)
126 	{
127 	  return NULL;
128 	}
129       ptr->_max_k = new_k;
130     }
131   else if (new_k > ptr->_max_k)
132     {
133       struct _Bigint **new_list
134 	= (struct _Bigint **) realloc (ptr->_freelist,
135 				       new_k * sizeof (struct _Bigint *));
136       memset (&new_list[ptr->_max_k], 0,
137 	      (new_k - ptr->_max_k) * sizeof (struct _Bigint *));
138       ptr->_freelist = new_list;
139       ptr->_max_k = new_k;
140 
141     }
142 
143   assert (k <= ptr->_max_k);
144 
145   if ((rv = _REENT_MP_FREELIST(ptr)[k]) != 0)
146     {
147       _REENT_MP_FREELIST(ptr)[k] = rv->_next;
148     }
149   else
150     {
151       x = 1 << k;
152       /* Allocate an mprec Bigint and stick in in the freelist */
153       rv = (_Bigint *) mprec_calloc (ptr,
154 				  1,
155 				  sizeof (_Bigint) +
156 				  (x-1) * sizeof(rv->_x));
157       if (rv == NULL) return NULL;
158       rv->_k = k;
159       rv->_maxwds = x;
160     }
161   rv->_sign = rv->_wds = 0;
162   return rv;
163 }
164 
165 void
166 _DEFUN (Bfree, (ptr, v), struct _reent *ptr _AND _Bigint * v)
167 {
168   _REENT_CHECK_MP(ptr);
169   if (v)
170     {
171       v->_next = _REENT_MP_FREELIST(ptr)[v->_k];
172       _REENT_MP_FREELIST(ptr)[v->_k] = v;
173     }
174 }
175 
176 _Bigint *
177 _DEFUN (multadd, (ptr, b, m, a),
178 	struct _reent *ptr _AND
179 	_Bigint * b _AND
180 	int m _AND
181 	int a)
182 {
183   int i, wds;
184   __ULong *x, y;
185 #ifdef Pack_32
186   __ULong xi, z;
187 #endif
188   _Bigint *b1;
189 
190   wds = b->_wds;
191   x = b->_x;
192   i = 0;
193   do
194     {
195 #ifdef Pack_32
196       xi = *x;
197       y = (xi & 0xffff) * m + a;
198       z = (xi >> 16) * m + (y >> 16);
199       a = (int) (z >> 16);
200       *x++ = (z << 16) + (y & 0xffff);
201 #else
202       y = *x * m + a;
203       a = (int) (y >> 16);
204       *x++ = y & 0xffff;
205 #endif
206     }
207   while (++i < wds);
208   if (a)
209     {
210       if (wds >= b->_maxwds)
211 	{
212 	  b1 = Balloc (ptr, b->_k + 1);
213 	  Bcopy (b1, b);
214 	  Bfree (ptr, b);
215 	  b = b1;
216 	}
217       b->_x[wds++] = a;
218       b->_wds = wds;
219     }
220   return b;
221 }
222 
223 _Bigint *
224 _DEFUN (s2b, (ptr, s, nd0, nd, y9),
225 	struct _reent * ptr _AND
226 	_CONST char *s _AND
227 	int nd0 _AND
228 	int nd _AND
229 	__ULong y9)
230 {
231   _Bigint *b;
232   int i, k;
233   __Long x, y;
234 
235   x = (nd + 8) / 9;
236   for (k = 0, y = 1; x > y; y <<= 1, k++);
237 #ifdef Pack_32
238   b = Balloc (ptr, k);
239   b->_x[0] = y9;
240   b->_wds = 1;
241 #else
242   b = Balloc (ptr, k + 1);
243   b->_x[0] = y9 & 0xffff;
244   b->_wds = (b->_x[1] = y9 >> 16) ? 2 : 1;
245 #endif
246 
247   i = 9;
248   if (9 < nd0)
249     {
250       s += 9;
251       do
252 	b = multadd (ptr, b, 10, *s++ - '0');
253       while (++i < nd0);
254       s++;
255     }
256   else
257     s += 10;
258   for (; i < nd; i++)
259     b = multadd (ptr, b, 10, *s++ - '0');
260   return b;
261 }
262 
263 int
264 _DEFUN (hi0bits,
265 	(x), register __ULong x)
266 {
267   register int k = 0;
268 
269   if (!(x & 0xffff0000))
270     {
271       k = 16;
272       x <<= 16;
273     }
274   if (!(x & 0xff000000))
275     {
276       k += 8;
277       x <<= 8;
278     }
279   if (!(x & 0xf0000000))
280     {
281       k += 4;
282       x <<= 4;
283     }
284   if (!(x & 0xc0000000))
285     {
286       k += 2;
287       x <<= 2;
288     }
289   if (!(x & 0x80000000))
290     {
291       k++;
292       if (!(x & 0x40000000))
293 	return 32;
294     }
295   return k;
296 }
297 
298 int
299 _DEFUN (lo0bits, (y), __ULong *y)
300 {
301   register int k;
302   register __ULong x = *y;
303 
304   if (x & 7)
305     {
306       if (x & 1)
307 	return 0;
308       if (x & 2)
309 	{
310 	  *y = x >> 1;
311 	  return 1;
312 	}
313       *y = x >> 2;
314       return 2;
315     }
316   k = 0;
317   if (!(x & 0xffff))
318     {
319       k = 16;
320       x >>= 16;
321     }
322   if (!(x & 0xff))
323     {
324       k += 8;
325       x >>= 8;
326     }
327   if (!(x & 0xf))
328     {
329       k += 4;
330       x >>= 4;
331     }
332   if (!(x & 0x3))
333     {
334       k += 2;
335       x >>= 2;
336     }
337   if (!(x & 1))
338     {
339       k++;
340       x >>= 1;
341       if (!x & 1)
342 	return 32;
343     }
344   *y = x;
345   return k;
346 }
347 
348 _Bigint *
349 _DEFUN (i2b, (ptr, i), struct _reent * ptr _AND int i)
350 {
351   _Bigint *b;
352 
353   b = Balloc (ptr, 1);
354   b->_x[0] = i;
355   b->_wds = 1;
356   return b;
357 }
358 
359 _Bigint *
360 _DEFUN (mult, (ptr, a, b), struct _reent * ptr _AND _Bigint * a _AND _Bigint * b)
361 {
362   _Bigint *c;
363   int k, wa, wb, wc;
364   __ULong carry, y, z;
365   __ULong *x, *xa, *xae, *xb, *xbe, *xc, *xc0;
366 #ifdef Pack_32
367   __ULong z2;
368 #endif
369 
370   if (a->_wds < b->_wds)
371     {
372       c = a;
373       a = b;
374       b = c;
375     }
376   k = a->_k;
377   wa = a->_wds;
378   wb = b->_wds;
379   wc = wa + wb;
380   if (wc > a->_maxwds)
381     k++;
382   c = Balloc (ptr, k);
383   for (x = c->_x, xa = x + wc; x < xa; x++)
384     *x = 0;
385   xa = a->_x;
386   xae = xa + wa;
387   xb = b->_x;
388   xbe = xb + wb;
389   xc0 = c->_x;
390 #ifdef Pack_32
391   for (; xb < xbe; xb++, xc0++)
392     {
393       if ((y = *xb & 0xffff) != 0)
394 	{
395 	  x = xa;
396 	  xc = xc0;
397 	  carry = 0;
398 	  do
399 	    {
400 	      z = (*x & 0xffff) * y + (*xc & 0xffff) + carry;
401 	      carry = z >> 16;
402 	      z2 = (*x++ >> 16) * y + (*xc >> 16) + carry;
403 	      carry = z2 >> 16;
404 	      Storeinc (xc, z2, z);
405 	    }
406 	  while (x < xae);
407 	  *xc = carry;
408 	}
409       if ((y = *xb >> 16) != 0)
410 	{
411 	  x = xa;
412 	  xc = xc0;
413 	  carry = 0;
414 	  z2 = *xc;
415 	  do
416 	    {
417 	      z = (*x & 0xffff) * y + (*xc >> 16) + carry;
418 	      carry = z >> 16;
419 	      Storeinc (xc, z, z2);
420 	      z2 = (*x++ >> 16) * y + (*xc & 0xffff) + carry;
421 	      carry = z2 >> 16;
422 	    }
423 	  while (x < xae);
424 	  *xc = z2;
425 	}
426     }
427 #else
428   for (; xb < xbe; xc0++)
429     {
430       if (y = *xb++)
431 	{
432 	  x = xa;
433 	  xc = xc0;
434 	  carry = 0;
435 	  do
436 	    {
437 	      z = *x++ * y + *xc + carry;
438 	      carry = z >> 16;
439 	      *xc++ = z & 0xffff;
440 	    }
441 	  while (x < xae);
442 	  *xc = carry;
443 	}
444     }
445 #endif
446   for (xc0 = c->_x, xc = xc0 + wc; wc > 0 && !*--xc; --wc);
447   c->_wds = wc;
448   return c;
449 }
450 
451 _Bigint *
452 _DEFUN (pow5mult,
453 	(ptr, b, k), struct _reent * ptr _AND _Bigint * b _AND int k)
454 {
455   _Bigint *b1, *p5, *p51;
456   int i;
457   static _CONST int p05[3] = {5, 25, 125};
458 
459   if ((i = k & 3) != 0)
460     b = multadd (ptr, b, p05[i - 1], 0);
461 
462   if (!(k >>= 2))
463     return b;
464   _REENT_CHECK_MP(ptr);
465   if (!(p5 = _REENT_MP_P5S(ptr)))
466     {
467       /* first time */
468       p5 = _REENT_MP_P5S(ptr) = i2b (ptr, 625);
469       p5->_next = 0;
470     }
471   for (;;)
472     {
473       if (k & 1)
474 	{
475 	  b1 = mult (ptr, b, p5);
476 	  Bfree (ptr, b);
477 	  b = b1;
478 	}
479       if (!(k >>= 1))
480 	break;
481       if (!(p51 = p5->_next))
482 	{
483 	  p51 = p5->_next = mult (ptr, p5, p5);
484 	  p51->_next = 0;
485 	}
486       p5 = p51;
487     }
488   return b;
489 }
490 
491 _Bigint *
492 _DEFUN (lshift, (ptr, b, k), struct _reent * ptr _AND _Bigint * b _AND int k)
493 {
494   int i, k1, n, n1;
495   _Bigint *b1;
496   __ULong *x, *x1, *xe, z;
497 
498 #ifdef Pack_32
499   n = k >> 5;
500 #else
501   n = k >> 4;
502 #endif
503   k1 = b->_k;
504   n1 = n + b->_wds + 1;
505   for (i = b->_maxwds; n1 > i; i <<= 1)
506     k1++;
507   b1 = Balloc (ptr, k1);
508   x1 = b1->_x;
509   for (i = 0; i < n; i++)
510     *x1++ = 0;
511   x = b->_x;
512   xe = x + b->_wds;
513 #ifdef Pack_32
514   if (k &= 0x1f)
515     {
516       k1 = 32 - k;
517       z = 0;
518       do
519 	{
520 	  *x1++ = *x << k | z;
521 	  z = *x++ >> k1;
522 	}
523       while (x < xe);
524       if ((*x1 = z) != 0)
525 	++n1;
526     }
527 #else
528   if (k &= 0xf)
529     {
530       k1 = 16 - k;
531       z = 0;
532       do
533 	{
534 	  *x1++ = *x << k & 0xffff | z;
535 	  z = *x++ >> k1;
536 	}
537       while (x < xe);
538       if (*x1 = z)
539 	++n1;
540     }
541 #endif
542   else
543     do
544       *x1++ = *x++;
545     while (x < xe);
546   b1->_wds = n1 - 1;
547   Bfree (ptr, b);
548   return b1;
549 }
550 
551 int
552 _DEFUN (cmp, (a, b), _Bigint * a _AND _Bigint * b)
553 {
554   __ULong *xa, *xa0, *xb, *xb0;
555   int i, j;
556 
557   i = a->_wds;
558   j = b->_wds;
559 #ifdef DEBUG
560   if (i > 1 && !a->_x[i - 1])
561     Bug ("cmp called with a->_x[a->_wds-1] == 0");
562   if (j > 1 && !b->_x[j - 1])
563     Bug ("cmp called with b->_x[b->_wds-1] == 0");
564 #endif
565   if (i -= j)
566     return i;
567   xa0 = a->_x;
568   xa = xa0 + j;
569   xb0 = b->_x;
570   xb = xb0 + j;
571   for (;;)
572     {
573       if (*--xa != *--xb)
574 	return *xa < *xb ? -1 : 1;
575       if (xa <= xa0)
576 	break;
577     }
578   return 0;
579 }
580 
581 _Bigint *
582 _DEFUN (diff, (ptr, a, b), struct _reent * ptr _AND
583 	_Bigint * a _AND _Bigint * b)
584 {
585   _Bigint *c;
586   int i, wa, wb;
587   __Long borrow, y;		/* We need signed shifts here. */
588   __ULong *xa, *xae, *xb, *xbe, *xc;
589 #ifdef Pack_32
590   __Long z;
591 #endif
592 
593   i = cmp (a, b);
594   if (!i)
595     {
596       c = Balloc (ptr, 0);
597       c->_wds = 1;
598       c->_x[0] = 0;
599       return c;
600     }
601   if (i < 0)
602     {
603       c = a;
604       a = b;
605       b = c;
606       i = 1;
607     }
608   else
609     i = 0;
610   c = Balloc (ptr, a->_k);
611   c->_sign = i;
612   wa = a->_wds;
613   xa = a->_x;
614   xae = xa + wa;
615   wb = b->_wds;
616   xb = b->_x;
617   xbe = xb + wb;
618   xc = c->_x;
619   borrow = 0;
620 #ifdef Pack_32
621   do
622     {
623       y = (*xa & 0xffff) - (*xb & 0xffff) + borrow;
624       borrow = y >> 16;
625       Sign_Extend (borrow, y);
626       z = (*xa++ >> 16) - (*xb++ >> 16) + borrow;
627       borrow = z >> 16;
628       Sign_Extend (borrow, z);
629       Storeinc (xc, z, y);
630     }
631   while (xb < xbe);
632   while (xa < xae)
633     {
634       y = (*xa & 0xffff) + borrow;
635       borrow = y >> 16;
636       Sign_Extend (borrow, y);
637       z = (*xa++ >> 16) + borrow;
638       borrow = z >> 16;
639       Sign_Extend (borrow, z);
640       Storeinc (xc, z, y);
641     }
642 #else
643   do
644     {
645       y = *xa++ - *xb++ + borrow;
646       borrow = y >> 16;
647       Sign_Extend (borrow, y);
648       *xc++ = y & 0xffff;
649     }
650   while (xb < xbe);
651   while (xa < xae)
652     {
653       y = *xa++ + borrow;
654       borrow = y >> 16;
655       Sign_Extend (borrow, y);
656       *xc++ = y & 0xffff;
657     }
658 #endif
659   while (!*--xc)
660     wa--;
661   c->_wds = wa;
662   return c;
663 }
664 
665 double
666 _DEFUN (ulp, (_x), double _x)
667 {
668   union double_union x, a;
669   register int32_t L;
670 
671   x.d = _x;
672 
673   L = (word0 (x) & Exp_mask) - (P - 1) * Exp_msk1;
674 #ifndef Sudden_Underflow
675   if (L > 0)
676     {
677 #endif
678 #ifdef IBM
679       L |= Exp_msk1 >> 4;
680 #endif
681       word0 (a) = L;
682 #ifndef _DOUBLE_IS_32BITS
683       word1 (a) = 0;
684 #endif
685 
686 #ifndef Sudden_Underflow
687     }
688   else
689     {
690       L = -L >> Exp_shift;
691       if (L < Exp_shift)
692 	{
693 	  word0 (a) = 0x80000 >> L;
694 #ifndef _DOUBLE_IS_32BITS
695 	  word1 (a) = 0;
696 #endif
697 	}
698       else
699 	{
700 	  word0 (a) = 0;
701 	  L -= Exp_shift;
702 #ifndef _DOUBLE_IS_32BITS
703          word1 (a) = L >= 31 ? 1 : 1 << (31 - L);
704 #endif
705 	}
706     }
707 #endif
708   return a.d;
709 }
710 
711 double
712 _DEFUN (b2d, (a, e),
713 	_Bigint * a _AND int *e)
714 {
715   __ULong *xa, *xa0, w, y, z;
716   int k;
717   union double_union d;
718 #ifdef VAX
719   __ULong d0, d1;
720 #else
721 #define d0 word0(d)
722 #define d1 word1(d)
723 #endif
724 
725   xa0 = a->_x;
726   xa = xa0 + a->_wds;
727   y = *--xa;
728 #ifdef DEBUG
729   if (!y)
730     Bug ("zero y in b2d");
731 #endif
732   k = hi0bits (y);
733   *e = 32 - k;
734 #ifdef Pack_32
735   if (k < Ebits)
736     {
737       d0 = Exp_1 | y >> (Ebits - k);
738       w = xa > xa0 ? *--xa : 0;
739 #ifndef _DOUBLE_IS_32BITS
740       d1 = y << ((32 - Ebits) + k) | w >> (Ebits - k);
741 #endif
742       goto ret_d;
743     }
744   z = xa > xa0 ? *--xa : 0;
745   if (k -= Ebits)
746     {
747       d0 = Exp_1 | y << k | z >> (32 - k);
748       y = xa > xa0 ? *--xa : 0;
749 #ifndef _DOUBLE_IS_32BITS
750       d1 = z << k | y >> (32 - k);
751 #endif
752     }
753   else
754     {
755       d0 = Exp_1 | y;
756 #ifndef _DOUBLE_IS_32BITS
757       d1 = z;
758 #endif
759     }
760 #else
761   if (k < Ebits + 16)
762     {
763       z = xa > xa0 ? *--xa : 0;
764       d0 = Exp_1 | y << k - Ebits | z >> Ebits + 16 - k;
765       w = xa > xa0 ? *--xa : 0;
766       y = xa > xa0 ? *--xa : 0;
767       d1 = z << k + 16 - Ebits | w << k - Ebits | y >> 16 + Ebits - k;
768       goto ret_d;
769     }
770   z = xa > xa0 ? *--xa : 0;
771   w = xa > xa0 ? *--xa : 0;
772   k -= Ebits + 16;
773   d0 = Exp_1 | y << k + 16 | z << k | w >> 16 - k;
774   y = xa > xa0 ? *--xa : 0;
775   d1 = w << k + 16 | y << k;
776 #endif
777 ret_d:
778 #ifdef VAX
779   word0 (d) = d0 >> 16 | d0 << 16;
780   word1 (d) = d1 >> 16 | d1 << 16;
781 #else
782 #undef d0
783 #undef d1
784 #endif
785   return d.d;
786 }
787 
788 _Bigint *
789 _DEFUN (d2b,
790 	(ptr, _d, e, bits),
791 	struct _reent * ptr _AND
792 	double _d _AND
793 	int *e _AND
794 	int *bits)
795 
796 {
797   union double_union d;
798   _Bigint *b;
799   int de, i, k;
800   __ULong *x, y, z;
801 #ifdef VAX
802   __ULong d0, d1;
803 #endif
804   d.d = _d;
805 #ifdef VAX
806   d0 = word0 (d) >> 16 | word0 (d) << 16;
807   d1 = word1 (d) >> 16 | word1 (d) << 16;
808 #else
809 #define d0 word0(d)
810 #define d1 word1(d)
811   d.d = _d;
812 #endif
813 
814 #ifdef Pack_32
815   b = Balloc (ptr, 1);
816 #else
817   b = Balloc (ptr, 2);
818 #endif
819   x = b->_x;
820 
821   z = d0 & Frac_mask;
822   d0 &= 0x7fffffff;		/* clear sign bit, which we ignore */
823 #ifdef Sudden_Underflow
824   de = (int) (d0 >> Exp_shift);
825 #ifndef IBM
826   z |= Exp_msk11;
827 #endif
828 #else
829   if ((de = (int) (d0 >> Exp_shift)) != 0)
830     z |= Exp_msk1;
831 #endif
832 #ifdef Pack_32
833 #ifndef _DOUBLE_IS_32BITS
834   if (d1)
835     {
836       y = d1;
837       k = lo0bits (&y);
838       if (k)
839 	{
840          x[0] = y | z << (32 - k);
841 	  z >>= k;
842 	}
843       else
844 	x[0] = y;
845       i = b->_wds = (x[1] = z) ? 2 : 1;
846     }
847   else
848 #endif
849     {
850 #ifdef DEBUG
851       if (!z)
852 	Bug ("Zero passed to d2b");
853 #endif
854       k = lo0bits (&z);
855       x[0] = z;
856       i = b->_wds = 1;
857 #ifndef _DOUBLE_IS_32BITS
858       k += 32;
859 #endif
860     }
861 #else
862   if (d1)
863     {
864       y = d1;
865       k = lo0bits (&y);
866       if (k)
867 	if (k >= 16)
868 	  {
869 	    x[0] = y | z << 32 - k & 0xffff;
870 	    x[1] = z >> k - 16 & 0xffff;
871 	    x[2] = z >> k;
872 	    i = 2;
873 	  }
874 	else
875 	  {
876 	    x[0] = y & 0xffff;
877 	    x[1] = y >> 16 | z << 16 - k & 0xffff;
878 	    x[2] = z >> k & 0xffff;
879 	    x[3] = z >> k + 16;
880 	    i = 3;
881 	  }
882       else
883 	{
884 	  x[0] = y & 0xffff;
885 	  x[1] = y >> 16;
886 	  x[2] = z & 0xffff;
887 	  x[3] = z >> 16;
888 	  i = 3;
889 	}
890     }
891   else
892     {
893 #ifdef DEBUG
894       if (!z)
895 	Bug ("Zero passed to d2b");
896 #endif
897       k = lo0bits (&z);
898       if (k >= 16)
899 	{
900 	  x[0] = z;
901 	  i = 0;
902 	}
903       else
904 	{
905 	  x[0] = z & 0xffff;
906 	  x[1] = z >> 16;
907 	  i = 1;
908 	}
909       k += 32;
910     }
911   while (!x[i])
912     --i;
913   b->_wds = i + 1;
914 #endif
915 #ifndef Sudden_Underflow
916   if (de)
917     {
918 #endif
919 #ifdef IBM
920       *e = (de - Bias - (P - 1) << 2) + k;
921       *bits = 4 * P + 8 - k - hi0bits (word0 (d) & Frac_mask);
922 #else
923       *e = de - Bias - (P - 1) + k;
924       *bits = P - k;
925 #endif
926 #ifndef Sudden_Underflow
927     }
928   else
929     {
930       *e = de - Bias - (P - 1) + 1 + k;
931 #ifdef Pack_32
932       *bits = 32 * i - hi0bits (x[i - 1]);
933 #else
934       *bits = (i + 2) * 16 - hi0bits (x[i]);
935 #endif
936     }
937 #endif
938   return b;
939 }
940 #undef d0
941 #undef d1
942 
943 double
944 _DEFUN (ratio, (a, b), _Bigint * a _AND _Bigint * b)
945 
946 {
947   union double_union da, db;
948   int k, ka, kb;
949 
950   da.d = b2d (a, &ka);
951   db.d = b2d (b, &kb);
952 #ifdef Pack_32
953   k = ka - kb + 32 * (a->_wds - b->_wds);
954 #else
955   k = ka - kb + 16 * (a->_wds - b->_wds);
956 #endif
957 #ifdef IBM
958   if (k > 0)
959     {
960       word0 (da) += (k >> 2) * Exp_msk1;
961       if (k &= 3)
962 	da.d *= 1 << k;
963     }
964   else
965     {
966       k = -k;
967       word0 (db) += (k >> 2) * Exp_msk1;
968       if (k &= 3)
969 	db.d *= 1 << k;
970     }
971 #else
972   if (k > 0)
973     word0 (da) += k * Exp_msk1;
974   else
975     {
976       k = -k;
977       word0 (db) += k * Exp_msk1;
978     }
979 #endif
980   return da.d / db.d;
981 }
982 
983 
984 _CONST double
985   tens[] =
986 {
987   1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9,
988   1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19,
989   1e20, 1e21, 1e22, 1e23, 1e24
990 
991 };
992 
993 #if !defined(_DOUBLE_IS_32BITS) && !defined(__v800)
994 _CONST double bigtens[] =
995 {1e16, 1e32, 1e64, 1e128, 1e256};
996 
997 _CONST double tinytens[] =
998 {1e-16, 1e-32, 1e-64, 1e-128, 1e-256};
999 #else
1000 _CONST double bigtens[] =
1001 {1e16, 1e32};
1002 
1003 _CONST double tinytens[] =
1004 {1e-16, 1e-32};
1005 #endif
1006 
1007 
1008 double
1009 _DEFUN (_mprec_log10, (dig),
1010 	int dig)
1011 {
1012   double v = 1.0;
1013   if (dig < 24)
1014     return tens[dig];
1015   while (dig > 0)
1016     {
1017       v *= 10;
1018       dig--;
1019     }
1020   return v;
1021 }
1022