dtoa.c revision 1.6 1 1.6 christos /* $NetBSD: dtoa.c,v 1.6 2011/03/20 23:15:35 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.2 kleink for(j = jj1 >> 4; j; 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.1 kleink 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.1 kleink }
544 1.1 kleink else
545 1.1 kleink b = pow5mult(b, b5);
546 1.5 christos if (b == NULL)
547 1.5 christos return NULL;
548 1.1 kleink }
549 1.1 kleink S = i2b(1);
550 1.5 christos if (S == NULL)
551 1.5 christos return NULL;
552 1.5 christos if (s5 > 0) {
553 1.1 kleink S = pow5mult(S, s5);
554 1.5 christos if (S == NULL)
555 1.5 christos return NULL;
556 1.5 christos }
557 1.1 kleink
558 1.1 kleink /* Check for special case that d is a normalized power of 2. */
559 1.1 kleink
560 1.1 kleink spec_case = 0;
561 1.1 kleink if ((mode < 2 || leftright)
562 1.1 kleink #ifdef Honor_FLT_ROUNDS
563 1.6 christos && Rounding == 1
564 1.1 kleink #endif
565 1.1 kleink ) {
566 1.6 christos if (!word1(&d) && !(word0(&d) & Bndry_mask)
567 1.1 kleink #ifndef Sudden_Underflow
568 1.6 christos && word0(&d) & (Exp_mask & ~Exp_msk1)
569 1.1 kleink #endif
570 1.1 kleink ) {
571 1.1 kleink /* The special case */
572 1.1 kleink b2 += Log2P;
573 1.1 kleink s2 += Log2P;
574 1.1 kleink spec_case = 1;
575 1.1 kleink }
576 1.1 kleink }
577 1.1 kleink
578 1.1 kleink /* Arrange for convenient computation of quotients:
579 1.1 kleink * shift left if necessary so divisor has 4 leading 0 bits.
580 1.1 kleink *
581 1.1 kleink * Perhaps we should just compute leading 28 bits of S once
582 1.1 kleink * and for all and pass them and a shift to quorem, so it
583 1.1 kleink * can do shifts and ors to compute the numerator for q.
584 1.1 kleink */
585 1.1 kleink #ifdef Pack_32
586 1.1 kleink if (( i = ((s5 ? 32 - hi0bits(S->x[S->wds-1]) : 1) + s2) & 0x1f )!=0)
587 1.1 kleink i = 32 - i;
588 1.1 kleink #else
589 1.1 kleink if (( i = ((s5 ? 32 - hi0bits(S->x[S->wds-1]) : 1) + s2) & 0xf )!=0)
590 1.1 kleink i = 16 - i;
591 1.1 kleink #endif
592 1.1 kleink if (i > 4) {
593 1.1 kleink i -= 4;
594 1.1 kleink b2 += i;
595 1.1 kleink m2 += i;
596 1.1 kleink s2 += i;
597 1.1 kleink }
598 1.1 kleink else if (i < 4) {
599 1.1 kleink i += 28;
600 1.1 kleink b2 += i;
601 1.1 kleink m2 += i;
602 1.1 kleink s2 += i;
603 1.1 kleink }
604 1.5 christos if (b2 > 0) {
605 1.1 kleink b = lshift(b, b2);
606 1.5 christos if (b == NULL)
607 1.5 christos return NULL;
608 1.5 christos }
609 1.5 christos if (s2 > 0) {
610 1.1 kleink S = lshift(S, s2);
611 1.5 christos if (S == NULL)
612 1.5 christos return NULL;
613 1.5 christos }
614 1.1 kleink if (k_check) {
615 1.1 kleink if (cmp(b,S) < 0) {
616 1.1 kleink k--;
617 1.1 kleink b = multadd(b, 10, 0); /* we botched the k estimate */
618 1.5 christos if (b == NULL)
619 1.5 christos return NULL;
620 1.5 christos if (leftright) {
621 1.1 kleink mhi = multadd(mhi, 10, 0);
622 1.5 christos if (mhi == NULL)
623 1.5 christos return NULL;
624 1.5 christos }
625 1.1 kleink ilim = ilim1;
626 1.1 kleink }
627 1.1 kleink }
628 1.1 kleink if (ilim <= 0 && (mode == 3 || mode == 5)) {
629 1.1 kleink if (ilim < 0 || cmp(b,S = multadd(S,5,0)) <= 0) {
630 1.1 kleink /* no digits, fcvt style */
631 1.1 kleink no_digits:
632 1.1 kleink k = -1 - ndigits;
633 1.1 kleink goto ret;
634 1.1 kleink }
635 1.1 kleink one_digit:
636 1.1 kleink *s++ = '1';
637 1.1 kleink k++;
638 1.1 kleink goto ret;
639 1.1 kleink }
640 1.1 kleink if (leftright) {
641 1.5 christos if (m2 > 0) {
642 1.1 kleink mhi = lshift(mhi, m2);
643 1.5 christos if (mhi == NULL)
644 1.5 christos return NULL;
645 1.5 christos }
646 1.1 kleink
647 1.1 kleink /* Compute mlo -- check for special case
648 1.1 kleink * that d is a normalized power of 2.
649 1.1 kleink */
650 1.1 kleink
651 1.1 kleink mlo = mhi;
652 1.1 kleink if (spec_case) {
653 1.1 kleink mhi = Balloc(mhi->k);
654 1.5 christos if (mhi == NULL)
655 1.5 christos return NULL;
656 1.1 kleink Bcopy(mhi, mlo);
657 1.1 kleink mhi = lshift(mhi, Log2P);
658 1.5 christos if (mhi == NULL)
659 1.5 christos return NULL;
660 1.1 kleink }
661 1.1 kleink
662 1.1 kleink for(i = 1;;i++) {
663 1.1 kleink dig = quorem(b,S) + '0';
664 1.1 kleink /* Do we yet have the shortest decimal string
665 1.1 kleink * that will round to d?
666 1.1 kleink */
667 1.1 kleink j = cmp(b, mlo);
668 1.1 kleink delta = diff(S, mhi);
669 1.5 christos if (delta == NULL)
670 1.5 christos return NULL;
671 1.2 kleink jj1 = delta->sign ? 1 : cmp(b, delta);
672 1.1 kleink Bfree(delta);
673 1.1 kleink #ifndef ROUND_BIASED
674 1.6 christos if (jj1 == 0 && mode != 1 && !(word1(&d) & 1)
675 1.1 kleink #ifdef Honor_FLT_ROUNDS
676 1.6 christos && Rounding >= 1
677 1.1 kleink #endif
678 1.1 kleink ) {
679 1.1 kleink if (dig == '9')
680 1.1 kleink goto round_9_up;
681 1.1 kleink if (j > 0)
682 1.1 kleink dig++;
683 1.1 kleink #ifdef SET_INEXACT
684 1.1 kleink else if (!b->x[0] && b->wds <= 1)
685 1.1 kleink inexact = 0;
686 1.1 kleink #endif
687 1.1 kleink *s++ = dig;
688 1.1 kleink goto ret;
689 1.1 kleink }
690 1.1 kleink #endif
691 1.2 kleink if (j < 0 || (j == 0 && mode != 1
692 1.1 kleink #ifndef ROUND_BIASED
693 1.6 christos && !(word1(&d) & 1)
694 1.1 kleink #endif
695 1.2 kleink )) {
696 1.1 kleink if (!b->x[0] && b->wds <= 1) {
697 1.1 kleink #ifdef SET_INEXACT
698 1.1 kleink inexact = 0;
699 1.1 kleink #endif
700 1.1 kleink goto accept_dig;
701 1.1 kleink }
702 1.1 kleink #ifdef Honor_FLT_ROUNDS
703 1.1 kleink if (mode > 1)
704 1.6 christos switch(Rounding) {
705 1.1 kleink case 0: goto accept_dig;
706 1.1 kleink case 2: goto keep_dig;
707 1.1 kleink }
708 1.1 kleink #endif /*Honor_FLT_ROUNDS*/
709 1.2 kleink if (jj1 > 0) {
710 1.1 kleink b = lshift(b, 1);
711 1.5 christos if (b == NULL)
712 1.5 christos return NULL;
713 1.2 kleink jj1 = cmp(b, S);
714 1.6 christos #ifdef ROUND_BIASED
715 1.6 christos if (jjj1 >= 0 /*)*/
716 1.6 christos #else
717 1.2 kleink if ((jj1 > 0 || (jj1 == 0 && dig & 1))
718 1.6 christos #endif
719 1.1 kleink && dig++ == '9')
720 1.1 kleink goto round_9_up;
721 1.1 kleink }
722 1.1 kleink accept_dig:
723 1.1 kleink *s++ = dig;
724 1.1 kleink goto ret;
725 1.1 kleink }
726 1.2 kleink if (jj1 > 0) {
727 1.1 kleink #ifdef Honor_FLT_ROUNDS
728 1.6 christos if (!Rounding)
729 1.1 kleink goto accept_dig;
730 1.1 kleink #endif
731 1.1 kleink if (dig == '9') { /* possible if i == 1 */
732 1.1 kleink round_9_up:
733 1.1 kleink *s++ = '9';
734 1.1 kleink goto roundoff;
735 1.1 kleink }
736 1.1 kleink *s++ = dig + 1;
737 1.1 kleink goto ret;
738 1.1 kleink }
739 1.1 kleink #ifdef Honor_FLT_ROUNDS
740 1.1 kleink keep_dig:
741 1.1 kleink #endif
742 1.1 kleink *s++ = dig;
743 1.1 kleink if (i == ilim)
744 1.1 kleink break;
745 1.1 kleink b = multadd(b, 10, 0);
746 1.5 christos if (b == NULL)
747 1.5 christos return NULL;
748 1.5 christos if (mlo == mhi) {
749 1.1 kleink mlo = mhi = multadd(mhi, 10, 0);
750 1.5 christos if (mlo == NULL)
751 1.5 christos return NULL;
752 1.5 christos }
753 1.1 kleink else {
754 1.1 kleink mlo = multadd(mlo, 10, 0);
755 1.5 christos if (mlo == NULL)
756 1.5 christos return NULL;
757 1.1 kleink mhi = multadd(mhi, 10, 0);
758 1.5 christos if (mhi == NULL)
759 1.5 christos return NULL;
760 1.1 kleink }
761 1.1 kleink }
762 1.1 kleink }
763 1.1 kleink else
764 1.1 kleink for(i = 1;; i++) {
765 1.1 kleink *s++ = dig = quorem(b,S) + '0';
766 1.1 kleink if (!b->x[0] && b->wds <= 1) {
767 1.1 kleink #ifdef SET_INEXACT
768 1.1 kleink inexact = 0;
769 1.1 kleink #endif
770 1.1 kleink goto ret;
771 1.1 kleink }
772 1.1 kleink if (i >= ilim)
773 1.1 kleink break;
774 1.1 kleink b = multadd(b, 10, 0);
775 1.5 christos if (b == NULL)
776 1.5 christos return NULL;
777 1.1 kleink }
778 1.1 kleink
779 1.1 kleink /* Round off last digit */
780 1.1 kleink
781 1.1 kleink #ifdef Honor_FLT_ROUNDS
782 1.6 christos switch(Rounding) {
783 1.1 kleink case 0: goto trimzeros;
784 1.1 kleink case 2: goto roundoff;
785 1.1 kleink }
786 1.1 kleink #endif
787 1.1 kleink b = lshift(b, 1);
788 1.1 kleink j = cmp(b, S);
789 1.6 christos #ifdef ROUND_BIASED
790 1.6 christos if (j >= 0)
791 1.6 christos #else
792 1.6 christos if (j > 0 || (j == 0 && dig & 1))
793 1.6 christos #endif
794 1.6 christos {
795 1.1 kleink roundoff:
796 1.1 kleink while(*--s == '9')
797 1.1 kleink if (s == s0) {
798 1.1 kleink k++;
799 1.1 kleink *s++ = '1';
800 1.1 kleink goto ret;
801 1.1 kleink }
802 1.1 kleink ++*s++;
803 1.1 kleink }
804 1.1 kleink else {
805 1.2 kleink #ifdef Honor_FLT_ROUNDS
806 1.1 kleink trimzeros:
807 1.2 kleink #endif
808 1.1 kleink while(*--s == '0');
809 1.1 kleink s++;
810 1.1 kleink }
811 1.1 kleink ret:
812 1.1 kleink Bfree(S);
813 1.1 kleink if (mhi) {
814 1.1 kleink if (mlo && mlo != mhi)
815 1.1 kleink Bfree(mlo);
816 1.1 kleink Bfree(mhi);
817 1.1 kleink }
818 1.1 kleink ret1:
819 1.1 kleink #ifdef SET_INEXACT
820 1.1 kleink if (inexact) {
821 1.1 kleink if (!oldinexact) {
822 1.6 christos word0(&d) = Exp_1 + (70 << Exp_shift);
823 1.6 christos word1(&d) = 0;
824 1.6 christos dval(&d) += 1.;
825 1.1 kleink }
826 1.1 kleink }
827 1.1 kleink else if (!oldinexact)
828 1.1 kleink clear_inexact();
829 1.1 kleink #endif
830 1.1 kleink Bfree(b);
831 1.3 kleink if (s == s0) { /* don't return empty string */
832 1.3 kleink *s++ = '0';
833 1.3 kleink k = 0;
834 1.3 kleink }
835 1.1 kleink *s = 0;
836 1.1 kleink *decpt = k + 1;
837 1.1 kleink if (rve)
838 1.1 kleink *rve = s;
839 1.1 kleink return s0;
840 1.1 kleink }
841