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