OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [newlib/] [newlib/] [libc/] [stdlib/] [dtoa.c] - Blame information for rev 1774

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.