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