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 #define _DEFAULT_SOURCE
30 #include <_ansi.h>
31 #include <stdlib.h>
32 #include <string.h>
33 #include "mprec.h"
34 
35 static int
quorem(_Bigint * b,_Bigint * S)36 quorem (_Bigint * b, _Bigint * S)
37 {
38   int n;
39   __Long borrow, y;
40   __ULong carry, q, ys;
41   __ULong *bx, *bxe, *sx, *sxe;
42 #ifdef Pack_32
43   __Long z;
44   __ULong si, zs;
45 #endif
46 
47   if (!b || !S)
48     return 0;
49 
50   n = S->_wds;
51 #ifdef DEBUG
52   /*debug*/ if (b->_wds > n)
53     /*debug*/ Bug ("oversize b in quorem");
54 #endif
55   if (b->_wds < n)
56     return 0;
57   sx = S->_x;
58   sxe = sx + --n;
59   bx = b->_x;
60   bxe = bx + n;
61   q = *bxe / (*sxe + 1);	/* ensure q <= true quotient */
62 #ifdef DEBUG
63   /*debug*/ if (q > 9)
64     /*debug*/ Bug ("oversized quotient in quorem");
65 #endif
66   if (q)
67     {
68       borrow = 0;
69       carry = 0;
70       do
71 	{
72 #ifdef Pack_32
73 	  si = *sx++;
74 	  ys = (si & 0xffff) * q + carry;
75 	  zs = (si >> 16) * q + (ys >> 16);
76 	  carry = zs >> 16;
77 	  y = (*bx & 0xffff) - (ys & 0xffff) + borrow;
78 	  borrow = y >> 16;
79 	  Sign_Extend (borrow, y);
80 	  z = (*bx >> 16) - (zs & 0xffff) + borrow;
81 	  borrow = z >> 16;
82 	  Sign_Extend (borrow, z);
83 	  Storeinc (bx, z, y);
84 #else
85 	  ys = *sx++ * q + carry;
86 	  carry = ys >> 16;
87 	  y = *bx - (ys & 0xffff) + borrow;
88 	  borrow = y >> 16;
89 	  Sign_Extend (borrow, y);
90 	  *bx++ = y & 0xffff;
91 #endif
92 	}
93       while (sx <= sxe);
94       if (!*bxe)
95 	{
96 	  bx = b->_x;
97 	  while (--bxe > bx && !*bxe)
98 	    --n;
99 	  b->_wds = n;
100 	}
101     }
102   if (cmp (b, S) >= 0)
103     {
104       q++;
105       borrow = 0;
106       carry = 0;
107       bx = b->_x;
108       sx = S->_x;
109       do
110 	{
111 #ifdef Pack_32
112 	  si = *sx++;
113 	  ys = (si & 0xffff) + carry;
114 	  zs = (si >> 16) + (ys >> 16);
115 	  carry = zs >> 16;
116 	  y = (*bx & 0xffff) - (ys & 0xffff) + borrow;
117 	  borrow = y >> 16;
118 	  Sign_Extend (borrow, y);
119 	  z = (*bx >> 16) - (zs & 0xffff) + borrow;
120 	  borrow = z >> 16;
121 	  Sign_Extend (borrow, z);
122 	  Storeinc (bx, z, y);
123 #else
124 	  ys = *sx++ + carry;
125 	  carry = ys >> 16;
126 	  y = *bx - (ys & 0xffff) + borrow;
127 	  borrow = y >> 16;
128 	  Sign_Extend (borrow, y);
129 	  *bx++ = y & 0xffff;
130 #endif
131 	}
132       while (sx <= sxe);
133       bx = b->_x;
134       bxe = bx + n;
135       if (!*bxe)
136 	{
137 	  while (--bxe > bx && !*bxe)
138 	    --n;
139 	  b->_wds = n;
140 	}
141     }
142   return q;
143 }
144 
145 /* dtoa for IEEE arithmetic (dmg): convert double to ASCII string.
146  *
147  * Inspired by "How to Print Floating-Point Numbers Accurately" by
148  * Guy L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90, pp. 92-101].
149  *
150  * Modifications:
151  *	1. Rather than iterating, we use a simple numeric overestimate
152  *	   to determine k = floor(log10(d)).  We scale relevant
153  *	   quantities using O(log2(k)) rather than O(k) multiplications.
154  *	2. For some modes > 2 (corresponding to ecvt and fcvt), we don't
155  *	   try to generate digits strictly left to right.  Instead, we
156  *	   compute with fewer bits and propagate the carry if necessary
157  *	   when rounding the final digit up.  This is often faster.
158  *	3. Under the assumption that input will be rounded nearest,
159  *	   mode 0 renders 1e23 as 1e23 rather than 9.999999999999999e22.
160  *	   That is, we allow equality in stopping tests when the
161  *	   round-nearest rule will give the same floating-point value
162  *	   as would satisfaction of the stopping test with strict
163  *	   inequality.
164  *	4. We remove common factors of powers of 2 from relevant
165  *	   quantities.
166  *	5. When converting floating-point integers less than 1e16,
167  *	   we use floating-point arithmetic rather than resorting
168  *	   to multiple-precision integers.
169  *	6. When asked to produce fewer than 15 digits, we first try
170  *	   to get by with floating-point arithmetic; we resort to
171  *	   multiple-precision integer arithmetic only if we cannot
172  *	   guarantee that the floating-point calculation has given
173  *	   the correctly rounded result.  For k requested digits and
174  *	   "uniformly" distributed input, the probability is
175  *	   something like 10^(k-15) that we must resort to the long
176  *	   calculation.
177  */
178 
179 
180 char *
__dtoa(double _d,int mode,int ndigits,int * decpt,int * sign,char ** rve)181 __dtoa (
182 	double _d,
183 	int mode,
184 	int ndigits,
185 	int *decpt,
186 	int *sign,
187 	char **rve)
188 {
189   /*	Arguments ndigits, decpt, sign are similar to those
190 	of ecvt and fcvt; trailing zeros are suppressed from
191 	the returned string.  If not null, *rve is set to point
192 	to the end of the return value.  If d is +-Infinity or NaN,
193 	then *decpt is set to 9999.
194 
195 	mode:
196 		0 ==> shortest string that yields d when read in
197 			and rounded to nearest.
198 		1 ==> like 0, but with Steele & White stopping rule;
199 			e.g. with IEEE P754 arithmetic , mode 0 gives
200 			1e23 whereas mode 1 gives 9.999999999999999e22.
201 		2 ==> max(1,ndigits) significant digits.  This gives a
202 			return value similar to that of ecvt, except
203 			that trailing zeros are suppressed.
204 		3 ==> through ndigits past the decimal point.  This
205 			gives a return value similar to that from fcvt,
206 			except that trailing zeros are suppressed, and
207 			ndigits can be negative.
208 		4-9 should give the same return values as 2-3, i.e.,
209 			4 <= mode <= 9 ==> same return as mode
210 			2 + (mode & 1).  These modes are mainly for
211 			debugging; often they run slower but sometimes
212 			faster than modes 2-3.
213 		4,5,8,9 ==> left-to-right digit generation.
214 		6-9 ==> don't try fast floating-point estimate
215 			(if applicable).
216 
217 		Values of mode other than 0-9 are treated as mode 0.
218 
219 		Sufficient space is allocated to the return value
220 		to hold the suppressed trailing zeros.
221 	*/
222 
223   int bbits, b2, b5, be, dig, i, ieps, ilim, ilim0, ilim1, j, j1, k, k0,
224     k_check, leftright, m2, m5, s2, s5, spec_case, try_quick;
225   union double_union d, d2, eps;
226   __Long L;
227 #ifndef Sudden_Underflow
228   int denorm;
229   __ULong x;
230 #endif
231   _Bigint *b, *b1, *delta, *mlo = NULL, *mhi, *S;
232   double ds;
233   char *s, *s0;
234 
235   d.d = _d;
236 
237   if (word0 (d) & Sign_bit)
238     {
239       /* set sign for everything, including 0's and NaNs */
240       *sign = 1;
241       word0 (d) &= ~Sign_bit;	/* clear sign bit */
242     }
243   else
244     *sign = 0;
245 
246 #if defined(IEEE_Arith) + defined(VAX)
247 #ifdef IEEE_Arith
248   if ((word0 (d) & Exp_mask) == Exp_mask)
249 #else
250   if (word0 (d) == 0x8000)
251 #endif
252     {
253       /* Infinity or NaN */
254       *decpt = 9999;
255       s =
256 #ifdef IEEE_Arith
257 	!word1 (d) && !(word0 (d) & 0xfffff) ? "Infinity" :
258 #endif
259 	"NaN";
260       if (rve)
261 	*rve =
262 #ifdef IEEE_Arith
263 	  s[3] ? s + 8 :
264 #endif
265 	  s + 3;
266       return s;
267     }
268 #endif
269 #ifdef IBM
270   d.d += 0;			/* normalize */
271 #endif
272   if (!d.d)
273     {
274       *decpt = 1;
275       s = "0";
276       if (rve)
277 	*rve = s + 1;
278       return s;
279     }
280 
281   b = d2b (d.d, &be, &bbits);
282   if (!b)
283     return NULL;
284 #ifdef Sudden_Underflow
285   i = (int) (word0 (d) >> Exp_shift1 & (Exp_mask >> Exp_shift1));
286 #else
287   if ((i = (int) (word0 (d) >> Exp_shift1 & (Exp_mask >> Exp_shift1))) != 0)
288     {
289 #endif
290       d2.d = d.d;
291       word0 (d2) &= Frac_mask1;
292       word0 (d2) |= Exp_11;
293 #ifdef IBM
294       if (j = 11 - hi0bits (word0 (d2) & Frac_mask))
295 	d2.d /= 1 << j;
296 #endif
297 
298       /* log(x)	~=~ log(1.5) + (x-1.5)/1.5
299 		 * log10(x)	 =  log(x) / log(10)
300 		 *		~=~ log(1.5)/log(10) + (x-1.5)/(1.5*log(10))
301 		 * log10(d) = (i-Bias)*log(2)/log(10) + log10(d2)
302 		 *
303 		 * This suggests computing an approximation k to log10(d) by
304 		 *
305 		 * k = (i - Bias)*0.301029995663981
306 		 *	+ ( (d2-1.5)*0.289529654602168 + 0.176091259055681 );
307 		 *
308 		 * We want k to be too large rather than too small.
309 		 * The error in the first-order Taylor series approximation
310 		 * is in our favor, so we just round up the constant enough
311 		 * to compensate for any error in the multiplication of
312 		 * (i - Bias) by 0.301029995663981; since |i - Bias| <= 1077,
313 		 * and 1077 * 0.30103 * 2^-52 ~=~ 7.2e-14,
314 		 * adding 1e-13 to the constant term more than suffices.
315 		 * Hence we adjust the constant term to 0.1760912590558.
316 		 * (We could get a more accurate k by invoking log10,
317 		 *  but this is probably not worthwhile.)
318 		 */
319 
320       i -= Bias;
321 #ifdef IBM
322       i <<= 2;
323       i += j;
324 #endif
325 #ifndef Sudden_Underflow
326       denorm = 0;
327     }
328   else
329     {
330       /* d is denormalized */
331 
332       i = bbits + be + (Bias + (P - 1) - 1);
333 #if defined (_DOUBLE_IS_32BITS)
334       x = word0 (d) << (32 - i);
335 #else
336       x = (i > 32) ? (word0 (d) << (64 - i)) | (word1 (d) >> (i - 32))
337        : (word1 (d) << (32 - i));
338 #endif
339       d2.d = x;
340       word0 (d2) -= 31 * Exp_msk1;	/* adjust exponent */
341       i -= (Bias + (P - 1) - 1) + 1;
342       denorm = 1;
343     }
344 #endif
345 #if defined (_DOUBLE_IS_32BITS)
346   ds = (d2.d - 1.5) * 0.289529651 + 0.176091269 + i * 0.30103001;
347 #else
348   ds = (d2.d - 1.5) * 0.289529654602168 + 0.1760912590558 + i * 0.301029995663981;
349 #endif
350   k = (int) ds;
351   if (ds < 0. && ds != k)
352     k--;			/* want k = floor(ds) */
353   k_check = 1;
354   if (k >= 0 && k <= Ten_pmax)
355     {
356       if (d.d < tens[k])
357 	k--;
358       k_check = 0;
359     }
360   j = bbits - i - 1;
361   if (j >= 0)
362     {
363       b2 = 0;
364       s2 = j;
365     }
366   else
367     {
368       b2 = -j;
369       s2 = 0;
370     }
371   if (k >= 0)
372     {
373       b5 = 0;
374       s5 = k;
375       s2 += k;
376     }
377   else
378     {
379       b2 -= k;
380       b5 = -k;
381       s5 = 0;
382     }
383   if (mode < 0 || mode > 9)
384     mode = 0;
385   try_quick = 1;
386   if (mode > 5)
387     {
388       mode -= 4;
389       try_quick = 0;
390     }
391   leftright = 1;
392   ilim = ilim1 = -1;
393   switch (mode)
394     {
395     case 0:
396     case 1:
397       i = 18;
398       ndigits = 0;
399       break;
400     case 2:
401       leftright = 0;
402       __PICOLIBC_FALLTHROUGH;
403     case 4:
404       if (ndigits <= 0)
405 	ndigits = 1;
406       ilim = ilim1 = i = ndigits;
407       break;
408     case 3:
409       leftright = 0;
410       __PICOLIBC_FALLTHROUGH;
411     case 5:
412       i = ndigits + k + 1;
413       ilim = i;
414       ilim1 = i - 1;
415       if (i <= 0)
416 	i = 1;
417     }
418   s = s0 = __alloc_dtoa_result(i);
419   if (!s) {
420     Bfree(b);
421     return NULL;
422   }
423 
424   if (ilim >= 0 && ilim <= Quick_max && try_quick)
425     {
426       /* Try to get by with floating-point arithmetic. */
427 
428       i = 0;
429       d2.d = d.d;
430       k0 = k;
431       ilim0 = ilim;
432       ieps = 2;			/* conservative */
433       if (k > 0)
434 	{
435 	  ds = tens[k & 0xf];
436 	  j = k >> 4;
437 	  if (j & Bletch)
438 	    {
439 	      /* prevent overflows */
440 	      j &= Bletch - 1;
441 	      d.d /= bigtens[n_bigtens - 1];
442 	      ieps++;
443 	    }
444 	  for (; j; j >>= 1, i++)
445 	    if (j & 1)
446 	      {
447 		ieps++;
448 		ds *= bigtens[i];
449 	      }
450 	  d.d /= ds;
451 	}
452       else if ((j1 = -k) != 0)
453 	{
454 	  d.d *= tens[j1 & 0xf];
455 	  for (j = j1 >> 4; j; j >>= 1, i++)
456 	    if (j & 1)
457 	      {
458 		ieps++;
459 		d.d *= bigtens[i];
460 	      }
461 	}
462       if (k_check && d.d < 1. && ilim > 0)
463 	{
464 	  if (ilim1 <= 0)
465 	    goto fast_failed;
466 	  ilim = ilim1;
467 	  k--;
468 	  d.d *= 10.;
469 	  ieps++;
470 	}
471       eps.d = ieps * d.d + 7.;
472       word0 (eps) -= (P - 1) * Exp_msk1;
473       if (ilim == 0)
474 	{
475 	  S = mhi = 0;
476 	  d.d -= 5.;
477 	  if (d.d > eps.d)
478 	    goto one_digit;
479 	  if (d.d < -eps.d)
480 	    goto no_digits;
481 	  goto fast_failed;
482 	}
483 #ifndef No_leftright
484       if (leftright)
485 	{
486 	  /* Use Steele & White method of only
487 	   * generating digits needed.
488 	   */
489 	  eps.d = 0.5 / tens[ilim - 1] - eps.d;
490 	  for (i = 0;;)
491 	    {
492 	      L = d.d;
493 	      d.d -= L;
494 	      *s++ = '0' + (int) L;
495 	      if (d.d < eps.d)
496 		goto ret1;
497 	      if (1. - d.d < eps.d)
498 		goto bump_up;
499 	      if (++i >= ilim)
500 		break;
501 	      eps.d *= 10.;
502 	      d.d *= 10.;
503 	    }
504 	}
505       else
506 	{
507 #endif
508 	  /* Generate ilim digits, then fix them up. */
509 	  eps.d *= tens[ilim - 1];
510 	  for (i = 1;; i++, d.d *= 10.)
511 	    {
512 	      L = d.d;
513 	      d.d -= L;
514 	      *s++ = '0' + (int) L;
515 	      if (i == ilim)
516 		{
517 		  if (d.d > 0.5 + eps.d)
518 		    goto bump_up;
519 		  else if (d.d < 0.5 - eps.d)
520 		    {
521 		      while (*--s == '0');
522 		      s++;
523 		      goto ret1;
524 		    }
525 		  break;
526 		}
527 	    }
528 #ifndef No_leftright
529 	}
530 #endif
531     fast_failed:
532       s = s0;
533       d.d = d2.d;
534       k = k0;
535       ilim = ilim0;
536     }
537 
538   /* Do we have a "small" integer? */
539 
540   if (be >= 0 && k <= Int_max)
541     {
542       /* Yes. */
543       ds = tens[k];
544       if (ndigits < 0 && ilim <= 0)
545 	{
546 	  S = mhi = 0;
547 	  if (ilim < 0 || d.d <= 5 * ds)
548 	    goto no_digits;
549 	  goto one_digit;
550 	}
551       for (i = 1;; i++)
552 	{
553 	  L = d.d / ds;
554 	  d.d -= L * ds;
555 #ifdef Check_FLT_ROUNDS
556 	  /* If FLT_ROUNDS == 2, L will usually be high by 1 */
557 	  if (d.d < 0)
558 	    {
559 	      L--;
560 	      d.d += ds;
561 	    }
562 #endif
563 	  *s++ = '0' + (int) L;
564 	  if (i == ilim)
565 	    {
566 	      d.d += d.d;
567              if ((d.d > ds) || ((d.d == ds) && (L & 1)))
568 		{
569 		bump_up:
570 		  while (*--s == '9')
571 		    if (s == s0)
572 		      {
573 			k++;
574 			*s = '0';
575 			break;
576 		      }
577 		  ++*s++;
578 		}
579 	      break;
580 	    }
581 	  if (!(d.d *= 10.))
582 	    break;
583 	}
584       goto ret1;
585     }
586 
587   m2 = b2;
588   m5 = b5;
589   mhi = mlo = 0;
590   if (leftright)
591     {
592       if (mode < 2)
593 	{
594 	  i =
595 #ifndef Sudden_Underflow
596 	    denorm ? be + (Bias + (P - 1) - 1 + 1) :
597 #endif
598 #ifdef IBM
599 	    1 + 4 * P - 3 - bbits + ((bbits + be - 1) & 3);
600 #else
601 	    1 + P - bbits;
602 #endif
603 	}
604       else
605 	{
606 	  j = ilim - 1;
607 	  if (m5 >= j)
608 	    m5 -= j;
609 	  else
610 	    {
611 	      s5 += j -= m5;
612 	      b5 += j;
613 	      m5 = 0;
614 	    }
615 	  if ((i = ilim) < 0)
616 	    {
617 	      m2 -= i;
618 	      i = 0;
619 	    }
620 	}
621       b2 += i;
622       s2 += i;
623       mhi = i2b (1);
624     }
625   if (m2 > 0 && s2 > 0)
626     {
627       i = m2 < s2 ? m2 : s2;
628       b2 -= i;
629       m2 -= i;
630       s2 -= i;
631     }
632   if (b5 > 0)
633     {
634       if (leftright)
635 	{
636 	  if (m5 > 0)
637 	    {
638 	      mhi = pow5mult (mhi, m5);
639 	      b1 = mult (mhi, b);
640 	      Bfree (b);
641 	      b = b1;
642 	    }
643          if ((j = b5 - m5) != 0)
644 	    b = pow5mult (b, j);
645 	}
646       else
647 	b = pow5mult (b, b5);
648     }
649   S = i2b (1);
650   if (s5 > 0)
651     S = pow5mult (S, s5);
652   if (!S)
653     goto ret;
654 
655   /* Check for special case that d is a normalized power of 2. */
656 
657   spec_case = 0;
658   if (mode < 2)
659     {
660       if (!word1 (d) && !(word0 (d) & Bndry_mask)
661 #ifndef Sudden_Underflow
662 	  && word0 (d) & Exp_mask
663 #endif
664 	)
665 	{
666 	  /* The special case */
667 	  b2 += Log2P;
668 	  s2 += Log2P;
669 	  spec_case = 1;
670 	}
671     }
672 
673   /* Arrange for convenient computation of quotients:
674    * shift left if necessary so divisor has 4 leading 0 bits.
675    *
676    * Perhaps we should just compute leading 28 bits of S once
677    * and for all and pass them and a shift to quorem, so it
678    * can do shifts and ors to compute the numerator for q.
679    */
680 
681 #ifdef Pack_32
682   if ((i = ((s5 ? 32 - hi0bits (S->_x[S->_wds - 1]) : 1) + s2) & 0x1f) != 0)
683     i = 32 - i;
684 #else
685   if ((i = ((s5 ? 32 - hi0bits (S->_x[S->_wds - 1]) : 1) + s2) & 0xf) != 0)
686     i = 16 - i;
687 #endif
688   if (i > 4)
689     {
690       i -= 4;
691       b2 += i;
692       m2 += i;
693       s2 += i;
694     }
695   else if (i < 4)
696     {
697       i += 28;
698       b2 += i;
699       m2 += i;
700       s2 += i;
701     }
702   if (b2 > 0)
703     b = lshift (b, b2);
704   if (s2 > 0)
705     S = lshift (S, s2);
706   if (k_check)
707     {
708       if (cmp (b, S) < 0)
709 	{
710 	  k--;
711 	  b = multadd (b, 10, 0);	/* we botched the k estimate */
712 	  if (leftright)
713 	    mhi = multadd (mhi, 10, 0);
714 	  ilim = ilim1;
715 	}
716     }
717   if (ilim <= 0 && mode > 2)
718     {
719       if (ilim < 0 || cmp (b, S = multadd (S, 5, 0)) <= 0)
720 	{
721 	  /* no digits, fcvt style */
722 	no_digits:
723 	  k = -1 - ndigits;
724 	  goto ret;
725 	}
726     one_digit:
727       *s++ = '1';
728       k++;
729       goto ret;
730     }
731   if (leftright)
732     {
733       if (m2 > 0)
734 	mhi = lshift (mhi, m2);
735 
736       /* Compute mlo -- check for special case
737        * that d is a normalized power of 2.
738        */
739 
740       mlo = mhi;
741       if (spec_case)
742 	{
743 	  mhi = Balloc (mhi->_k);
744 	  if (!mhi) {
745 	    Bfree(mlo);
746 	    return NULL;
747 	  }
748 	  Bcopy (mhi, mlo);
749 	  mhi = lshift (mhi, Log2P);
750 	}
751 
752       for (i = 1;; i++)
753 	{
754 	  dig = quorem (b, S) + '0';
755 	  /* Do we yet have the shortest decimal string
756 	   * that will round to d?
757 	   */
758 	  j = cmp (b, mlo);
759 	  delta = diff (S, mhi);
760 	  j1 = delta->_sign ? 1 : cmp (b, delta);
761 	  Bfree (delta);
762 #ifndef ROUND_BIASED
763 	  if (j1 == 0 && !mode && !(word1 (d) & 1))
764 	    {
765 	      if (dig == '9')
766 		goto round_9_up;
767 	      if (j > 0)
768 		dig++;
769 	      *s++ = dig;
770 	      goto ret;
771 	    }
772 #endif
773          if ((j < 0) || ((j == 0) && !mode
774 #ifndef ROUND_BIASED
775 	      && !(word1 (d) & 1)
776 #endif
777            ))
778 	    {
779 	      if (j1 > 0)
780 		{
781 		  b = lshift (b, 1);
782 		  j1 = cmp (b, S);
783                  if (((j1 > 0) || ((j1 == 0) && (dig & 1)))
784 		      && dig++ == '9')
785 		    goto round_9_up;
786 		}
787 	      *s++ = dig;
788 	      goto ret;
789 	    }
790 	  if (j1 > 0)
791 	    {
792 	      if (dig == '9')
793 		{		/* possible if i == 1 */
794 		round_9_up:
795 		  *s++ = '9';
796 		  goto roundoff;
797 		}
798 	      *s++ = dig + 1;
799 	      goto ret;
800 	    }
801 	  *s++ = dig;
802 	  if (i == ilim)
803 	    break;
804 	  b = multadd (b, 10, 0);
805 	  if (mlo == mhi)
806 	    mlo = mhi = multadd (mhi, 10, 0);
807 	  else
808 	    {
809 	      mlo = multadd (mlo, 10, 0);
810 	      mhi = multadd (mhi, 10, 0);
811 	    }
812 	}
813     }
814   else
815     for (i = 1;; i++)
816       {
817 	*s++ = dig = quorem (b, S) + '0';
818 	if (i >= ilim)
819 	  break;
820 	b = multadd (b, 10, 0);
821       }
822 
823   /* Round off last digit */
824 
825   b = lshift (b, 1);
826   j = cmp (b, S);
827   if ((j > 0) || ((j == 0) && (dig & 1)))
828     {
829     roundoff:
830       while (*--s == '9')
831 	if (s == s0)
832 	  {
833 	    k++;
834 	    *s++ = '1';
835 	    goto ret;
836 	  }
837       ++*s++;
838     }
839   else
840     {
841       while (*--s == '0');
842       s++;
843     }
844 ret:
845   Bfree (S);
846   if (mhi)
847     {
848       if (mlo && mlo != mhi)
849 	Bfree (mlo);
850       Bfree (mhi);
851     }
852 ret1:
853   Bfree (b);
854   *s = 0;
855   *decpt = k + 1;
856   if (rve)
857     *rve = s;
858   return s0;
859 }
860