Drizzled Public API Documentation

dtoa.cc
00001 /* Copyright (C) 2007 MySQL AB
00002    This program is free software; you can redistribute it and/or modify
00003    it under the terms of the GNU General Public License as published by
00004    the Free Software Foundation; either version 2 of the License, or
00005    (at your option) any later version.
00006 
00007    This program is distributed in the hope that it will be useful,
00008    but WITHOUT ANY WARRANTY; without even the implied warranty of
00009    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00010    GNU General Public License for more details.
00011 
00012    You should have received a copy of the GNU General Public License
00013    along with this program; if not, write to the Free Software
00014    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA */
00015 
00016 /****************************************************************
00017 
00018   This file incorporates work covered by the following copyright and
00019   permission notice:
00020 
00021   The author of this software is David M. Gay.
00022 
00023   Copyright (C) 1991, 2000, 2001 by Lucent Technologies.
00024 
00025   Permission to use, copy, modify, and distribute this software for any
00026   purpose without fee is hereby granted, provided that this entire notice
00027   is included in all copies of any software which is or includes a copy
00028   or modification of this software and in all copies of the supporting
00029   documentation for such software.
00030 
00031   THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
00032   WARRANTY.  IN PARTICULAR, NEITHER THE AUTHOR NOR LUCENT MAKES ANY
00033   REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
00034   OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
00035 
00036  ***************************************************************/
00037 
00038 #include <config.h>
00039 
00040 #include <drizzled/internal/m_string.h>  /* for memcpy and NOT_FIXED_DEC */
00041 
00042 #include <float.h>
00043 
00044 #include <cstdlib>
00045 #include <cerrno>
00046 #include <algorithm>
00047 
00048 using namespace std;
00049 
00050 namespace drizzled
00051 {
00052 namespace internal
00053 {
00054 
00055 /* Magic value returned by dtoa() to indicate overflow */
00056 #define DTOA_OVERFLOW 9999
00057 
00058 static double my_strtod_int(const char *, char **, int *);
00059 static char *dtoa(double, int, int, int *, int *, char **);
00060 
00092 size_t my_fcvt(double x, int precision, char *to, bool *error)
00093 {
00094   int decpt, sign, len, i;
00095   char *res, *src, *end, *dst= to;
00096   assert(precision >= 0 && precision < NOT_FIXED_DEC && to != NULL);
00097 
00098   res= dtoa(x, 5, precision, &decpt, &sign, &end);
00099 
00100   if (decpt == DTOA_OVERFLOW)
00101   {
00102     free(res);
00103     *to++= '0';
00104     *to= '\0';
00105     if (error != NULL)
00106       *error= true;
00107     return 1;
00108   }
00109 
00110   src= res;
00111   len= end - src;
00112 
00113   if (sign)
00114     *dst++= '-';
00115 
00116   if (decpt <= 0)
00117   {
00118     *dst++= '0';
00119     *dst++= '.';
00120     for (i= decpt; i < 0; i++)
00121       *dst++= '0';
00122   }
00123 
00124   for (i= 1; i <= len; i++)
00125   {
00126     *dst++= *src++;
00127     if (i == decpt && i < len)
00128       *dst++= '.';
00129   }
00130   while (i++ <= decpt)
00131     *dst++= '0';
00132 
00133   if (precision > 0)
00134   {
00135     if (len <= decpt)
00136       *dst++= '.';
00137 
00138     for (i= precision - max(0, (len - decpt)); i > 0; i--)
00139       *dst++= '0';
00140   }
00141 
00142   *dst= '\0';
00143   if (error != NULL)
00144     *error= false;
00145 
00146   free(res);
00147 
00148   return dst - to;
00149 }
00150 
00214 size_t my_gcvt(double x, my_gcvt_arg_type type, int width, char *to,
00215                bool *error)
00216 {
00217   int decpt, sign, len, exp_len;
00218   char *res, *src, *end, *dst= to, *dend= dst + width;
00219   bool have_space, force_e_format;
00220   assert(width > 0 && to != NULL);
00221 
00222   /* We want to remove '-' from equations early */
00223   if (x < 0.)
00224     width--;
00225 
00226   res= dtoa(x, 4, type == MY_GCVT_ARG_DOUBLE ? min(width, DBL_DIG) : 
00227             min(width, FLT_DIG), &decpt, &sign, &end);
00228 
00229   if (decpt == DTOA_OVERFLOW)
00230   {
00231     free(res);
00232     *to++= '0';
00233     *to= '\0';
00234     if (error != NULL)
00235       *error= true;
00236     return 1;
00237   }
00238 
00239   if (error != NULL)
00240     *error= false;
00241 
00242   src= res;
00243   len= end - res;
00244 
00245   /*
00246     Number of digits in the exponent from the 'e' conversion.
00247      The sign of the exponent is taken into account separetely, we don't need
00248      to count it here.
00249    */
00250   exp_len= 1 + (decpt >= 101 || decpt <= -99) + (decpt >= 11 || decpt <= -9);
00251 
00252   /*
00253      Do we have enough space for all digits in the 'f' format?
00254      Let 'len' be the number of significant digits returned by dtoa,
00255      and F be the length of the resulting decimal representation.
00256      Consider the following cases:
00257      1. decpt <= 0, i.e. we have "0.NNN" => F = len - decpt + 2
00258      2. 0 < decpt < len, i.e. we have "NNN.NNN" => F = len + 1
00259      3. len <= decpt, i.e. we have "NNN00" => F = decpt
00260   */
00261   have_space= (decpt <= 0 ? len - decpt + 2 :
00262                decpt > 0 && decpt < len ? len + 1 :
00263                decpt) <= width;
00264   /*
00265     The following is true when no significant digits can be placed with the
00266     specified field width using the 'f' format, and the 'e' format
00267     will not be truncated.
00268   */
00269   force_e_format= (decpt <= 0 && width <= 2 - decpt && width >= 3 + exp_len);
00270   /*
00271     Assume that we don't have enough space to place all significant digits in
00272     the 'f' format. We have to choose between the 'e' format and the 'f' one
00273     to keep as many significant digits as possible.
00274     Let E and F be the lengths of decimal representaion in the 'e' and 'f'
00275     formats, respectively. We want to use the 'f' format if, and only if F <= E.
00276     Consider the following cases:
00277     1. decpt <= 0.
00278        F = len - decpt + 2 (see above)
00279        E = len + (len > 1) + 1 + 1 (decpt <= -99) + (decpt <= -9) + 1
00280        ("N.NNe-MMM")
00281        (F <= E) <=> (len == 1 && decpt >= -1) || (len > 1 && decpt >= -2)
00282        We also need to ensure that if the 'f' format is chosen,
00283        the field width allows us to place at least one significant digit
00284        (i.e. width > 2 - decpt). If not, we prefer the 'e' format.
00285     2. 0 < decpt < len
00286        F = len + 1 (see above)
00287        E = len + 1 + 1 + ... ("N.NNeMMM")
00288        F is always less than E.
00289     3. len <= decpt <= width
00290        In this case we have enough space to represent the number in the 'f'
00291        format, so we prefer it with some exceptions.
00292     4. width < decpt
00293        The number cannot be represented in the 'f' format at all, always use
00294        the 'e' 'one.
00295   */
00296   if ((have_space ||
00297       /*
00298         Not enough space, let's see if the 'f' format provides the most number
00299         of significant digits.
00300       */
00301        ((decpt <= width && (decpt >= -1 || (decpt == -2 &&
00302                                             (len > 1 || !force_e_format)))) &&
00303          !force_e_format)) &&
00304 
00305        /*
00306          Use the 'e' format in some cases even if we have enough space for the
00307          'f' one. See comment for MAX_DECPT_FOR_F_FORMAT.
00308        */
00309       (!have_space || (decpt >= -MAX_DECPT_FOR_F_FORMAT + 1 &&
00310                        (decpt <= MAX_DECPT_FOR_F_FORMAT || len > decpt))))
00311   {
00312     /* 'f' format */
00313     int i;
00314 
00315     width-= (decpt < len) + (decpt <= 0 ? 1 - decpt : 0);
00316 
00317     /* Do we have to truncate any digits? */
00318     if (width < len)
00319     {
00320       if (width < decpt)
00321       {
00322         if (error != NULL)
00323           *error= true;
00324         width= decpt;
00325       }
00326 
00327       /*
00328         We want to truncate (len - width) least significant digits after the
00329         decimal point. For this we are calling dtoa with mode=5, passing the
00330         number of significant digits = (len-decpt) - (len-width) = width-decpt
00331       */
00332       free(res);
00333       res= dtoa(x, 5, width - decpt, &decpt, &sign, &end);
00334       src= res;
00335       len= end - res;
00336     }
00337 
00338     if (len == 0)
00339     {
00340       /* Underflow. Just print '0' and exit */
00341       *dst++= '0';
00342       goto end;
00343     }
00344 
00345     /*
00346       At this point we are sure we have enough space to put all digits
00347       returned by dtoa
00348     */
00349     if (sign && dst < dend)
00350       *dst++= '-';
00351     if (decpt <= 0)
00352     {
00353       if (dst < dend)
00354         *dst++= '0';
00355       if (len > 0 && dst < dend)
00356         *dst++= '.';
00357       for (; decpt < 0 && dst < dend; decpt++)
00358         *dst++= '0';
00359     }
00360 
00361     for (i= 1; i <= len && dst < dend; i++)
00362     {
00363       *dst++= *src++;
00364       if (i == decpt && i < len && dst < dend)
00365         *dst++= '.';
00366     }
00367     while (i++ <= decpt && dst < dend)
00368       *dst++= '0';
00369   }
00370   else
00371   {
00372     /* 'e' format */
00373     int decpt_sign= 0;
00374 
00375     if (--decpt < 0)
00376     {
00377       decpt= -decpt;
00378       width--;
00379       decpt_sign= 1;
00380     }
00381     width-= 1 + exp_len; /* eNNN */
00382 
00383     if (len > 1)
00384       width--;
00385 
00386     if (width <= 0)
00387     {
00388       /* Overflow */
00389       if (error != NULL)
00390         *error= true;
00391       width= 0;
00392     }
00393 
00394     /* Do we have to truncate any digits? */
00395     if (width < len)
00396     {
00397       /* Yes, re-convert with a smaller width */
00398       free(res);
00399       res= dtoa(x, 4, width, &decpt, &sign, &end);
00400       src= res;
00401       len= end - res;
00402       if (--decpt < 0)
00403         decpt= -decpt;
00404     }
00405     /*
00406       At this point we are sure we have enough space to put all digits
00407       returned by dtoa
00408     */
00409     if (sign && dst < dend)
00410       *dst++= '-';
00411     if (dst < dend)
00412       *dst++= *src++;
00413     if (len > 1 && dst < dend)
00414     {
00415       *dst++= '.';
00416       while (src < end && dst < dend)
00417         *dst++= *src++;
00418     }
00419     if (dst < dend)
00420       *dst++= 'e';
00421     if (decpt_sign && dst < dend)
00422       *dst++= '-';
00423 
00424     if (decpt >= 100 && dst < dend)
00425     {
00426       *dst++= decpt / 100 + '0';
00427       decpt%= 100;
00428       if (dst < dend)
00429         *dst++= decpt / 10 + '0';
00430     }
00431     else if (decpt >= 10 && dst < dend)
00432       *dst++= decpt / 10 + '0';
00433     if (dst < dend)
00434       *dst++= decpt % 10 + '0';
00435 
00436   }
00437 
00438 end:
00439   free(res);
00440   *dst= '\0';
00441 
00442   return dst - to;
00443 }
00444 
00463 double my_strtod(const char *str, char **end, int *error)
00464 {
00465   double res;
00466   assert(str != NULL && end != NULL && *end != NULL && error != NULL);
00467 
00468   res= my_strtod_int(str, end, error);
00469   return (*error == 0) ? res : (res < 0 ? -DBL_MAX : DBL_MAX);
00470 }
00471 
00472 
00473 double my_atof(const char *nptr)
00474 {
00475   int error;
00476   const char *end= nptr+65535;                  /* Should be enough */
00477   return (my_strtod(nptr, (char**) &end, &error));
00478 }
00479 
00480 
00481 /****************************************************************
00482  *
00483  * The author of this software is David M. Gay.
00484  *
00485  * Copyright (C) 1991, 2000, 2001 by Lucent Technologies.
00486  *
00487  * Permission to use, copy, modify, and distribute this software for any
00488  * purpose without fee is hereby granted, provided that this entire notice
00489  * is included in all copies of any software which is or includes a copy
00490  * or modification of this software and in all copies of the supporting
00491  * documentation for such software.
00492  *
00493  * THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
00494  * WARRANTY.  IN PARTICULAR, NEITHER THE AUTHOR NOR LUCENT MAKES ANY
00495  * REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
00496  * OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
00497  *
00498  ***************************************************************/
00499 /* Please send bug reports to David M. Gay (dmg at acm dot org,
00500  * with " at " changed at "@" and " dot " changed to ".").      */
00501 
00502 /*
00503   Original copy of the software is located at http://www.netlib.org/fp/dtoa.c
00504   It was adjusted to serve MySQL server needs:
00505   * strtod() was modified to not expect a zero-terminated string.
00506     It now honors 'se' (end of string) argument as the input parameter,
00507     not just as the output one.
00508   * in dtoa(), in case of overflow/underflow/NaN result string now contains "0";
00509     decpt is set to DTOA_OVERFLOW to indicate overflow.
00510   * support for VAX, IBM mainframe and 16-bit hardware removed
00511   * we always assume that 64-bit integer type is available
00512   * support for Kernigan-Ritchie style headers (pre-ANSI compilers)
00513     removed
00514   * all gcc warnings ironed out
00515   * we always assume multithreaded environment, so we had to change
00516     memory allocation procedures to use stack in most cases;
00517     malloc is used as the last resort.
00518   * pow5mult rewritten to use pre-calculated pow5 list instead of
00519     the one generated on the fly.
00520 */
00521 
00522 
00523 /*
00524   On a machine with IEEE extended-precision registers, it is
00525   necessary to specify double-precision (53-bit) rounding precision
00526   before invoking strtod or dtoa.  If the machine uses (the equivalent
00527   of) Intel 80x87 arithmetic, the call
00528        _control87(PC_53, MCW_PC);
00529   does this with many compilers.  Whether this or another call is
00530   appropriate depends on the compiler; for this to work, it may be
00531   necessary to #include "float.h" or another system-dependent header
00532   file.
00533 */
00534 
00535 typedef int32_t Long;
00536 typedef uint32_t ULong;
00537 typedef int64_t LLong;
00538 typedef uint64_t ULLong;
00539 
00540 typedef union { double d; ULong L[2]; } U;
00541 
00542 #if defined(WORDS_BIGENDIAN) || (defined(__FLOAT_WORD_ORDER) &&        \
00543                                  (__FLOAT_WORD_ORDER == __BIG_ENDIAN))
00544 #define word0(x) ((U*)&x)->L[0]
00545 #define word1(x) ((U*)&x)->L[1]
00546 #else
00547 #define word0(x) ((U*)&x)->L[1]
00548 #define word1(x) ((U*)&x)->L[0]
00549 #endif
00550 
00551 #define dval(x) ((U*)&x)->d
00552 
00553 /* #define P DBL_MANT_DIG */
00554 /* Ten_pmax= floor(P*log(2)/log(5)) */
00555 /* Bletch= (highest power of 2 < DBL_MAX_10_EXP) / 16 */
00556 /* Quick_max= floor((P-1)*log(FLT_RADIX)/log(10) - 1) */
00557 /* Int_max= floor(P*log(FLT_RADIX)/log(10) - 1) */
00558 
00559 #define Exp_shift  20
00560 #define Exp_shift1 20
00561 #define Exp_msk1    0x100000
00562 #define Exp_mask  0x7ff00000
00563 #define P 53
00564 #define Bias 1023
00565 #define Emin (-1022)
00566 #define Exp_1  0x3ff00000
00567 #define Exp_11 0x3ff00000
00568 #define Ebits 11
00569 #define Frac_mask  0xfffff
00570 #define Frac_mask1 0xfffff
00571 #define Ten_pmax 22
00572 #define Bletch 0x10
00573 #define Bndry_mask  0xfffff
00574 #define Bndry_mask1 0xfffff
00575 #define LSB 1
00576 #define Sign_bit 0x80000000
00577 #define Log2P 1
00578 #define Tiny1 1
00579 #define Quick_max 14
00580 #define Int_max 14
00581 
00582 #ifndef Flt_Rounds
00583 #ifdef FLT_ROUNDS
00584 #define Flt_Rounds FLT_ROUNDS
00585 #else
00586 #define Flt_Rounds 1
00587 #endif
00588 #endif /*Flt_Rounds*/
00589 
00590 #define rounded_product(a,b) a*= b
00591 #define rounded_quotient(a,b) a/= b
00592 
00593 #define Big0 (Frac_mask1 | Exp_msk1*(DBL_MAX_EXP+Bias-1))
00594 #define Big1 0xffffffff
00595 #define FFFFFFFF 0xffffffffUL
00596 
00597 /* Arbitrary-length integer */
00598 
00599 typedef struct Bigint
00600 {
00601   union {
00602     ULong *x;              /* points right after this Bigint object */
00603   } p;
00604   int k;                   /* 2^k = maxwds */
00605   int maxwds;              /* maximum length in 32-bit words */
00606   int sign;                /* not zero if number is negative */
00607   int wds;                 /* current length in 32-bit words */
00608 } Bigint;
00609 
00610 static Bigint *Bcopy(Bigint* dst, Bigint* src)
00611 {
00612   dst->sign= src->sign;
00613   dst->wds= src->wds;
00614 
00615   assert(dst->maxwds >= src->wds);
00616 
00617   memcpy(dst->p.x, src->p.x, src->wds*sizeof(ULong));
00618 
00619   return dst;
00620 }
00621 
00622 static Bigint *Balloc(int k)
00623 {
00624   int x= 1 << k;
00625   Bigint* rv= (Bigint*) malloc(sizeof(Bigint));
00626 
00627   rv->p.x= (ULong*)malloc(x * sizeof(ULong));
00628 
00629   rv->k= k;
00630   rv->maxwds= x;
00631 
00632   rv->sign= rv->wds= 0;
00633 
00634   return rv;
00635 }
00636 
00637 
00638 /*
00639   If object was allocated on stack, try putting it to the free
00640   list. Otherwise call free().
00641 */
00642 
00643 static void Bfree(Bigint *v)
00644 {
00645   if(!v)
00646     return;
00647   free(v->p.x);
00648   free(v);
00649 }
00650 
00651 /* Bigint arithmetic functions */
00652 
00653 /* Multiply by m and add a */
00654 
00655 static Bigint *multadd(Bigint *b, int m, int a)
00656 {
00657   int i, wds;
00658   ULong *x;
00659   ULLong carry, y;
00660   Bigint *b1;
00661 
00662   wds= b->wds;
00663   x= b->p.x;
00664   i= 0;
00665   carry= a;
00666   do
00667   {
00668     y= *x * (ULLong)m + carry;
00669     carry= y >> 32;
00670     *x++= (ULong)(y & FFFFFFFF);
00671   }
00672   while (++i < wds);
00673   if (carry)
00674   {
00675     if (wds >= b->maxwds)
00676     {
00677       b1= Balloc(b->k+1);
00678       Bcopy(b1, b);
00679       Bfree(b);
00680       b= b1;
00681     }
00682     b->p.x[wds++]= (ULong) carry;
00683     b->wds= wds;
00684   }
00685   return b;
00686 }
00687 
00688 
00689 static Bigint *s2b(const char *s, int nd0, int nd, ULong y9)
00690 {
00691   Bigint *b;
00692   int i, k;
00693   Long x, y;
00694 
00695   x= (nd + 8) / 9;
00696   for (k= 0, y= 1; x > y; y <<= 1, k++) ;
00697   b= Balloc(k);
00698   b->p.x[0]= y9;
00699   b->wds= 1;
00700 
00701   i= 9;
00702   if (9 < nd0)
00703   {
00704     s+= 9;
00705     do
00706       b= multadd(b, 10, *s++ - '0');
00707     while (++i < nd0);
00708     s++;
00709   }
00710   else
00711     s+= 10;
00712   for(; i < nd; i++)
00713     b= multadd(b, 10, *s++ - '0');
00714   return b;
00715 }
00716 
00717 
00718 static int hi0bits(ULong x)
00719 {
00720   int k= 0;
00721 
00722   if (!(x & 0xffff0000))
00723   {
00724     k= 16;
00725     x<<= 16;
00726   }
00727   if (!(x & 0xff000000))
00728   {
00729     k+= 8;
00730     x<<= 8;
00731   }
00732   if (!(x & 0xf0000000))
00733   {
00734     k+= 4;
00735     x<<= 4;
00736   }
00737   if (!(x & 0xc0000000))
00738   {
00739     k+= 2;
00740     x<<= 2;
00741   }
00742   if (!(x & 0x80000000))
00743   {
00744     k++;
00745     if (!(x & 0x40000000))
00746       return 32;
00747   }
00748   return k;
00749 }
00750 
00751 
00752 static int lo0bits(ULong *y)
00753 {
00754   int k;
00755   ULong x= *y;
00756 
00757   if (x & 7)
00758   {
00759     if (x & 1)
00760       return 0;
00761     if (x & 2)
00762     {
00763       *y= x >> 1;
00764       return 1;
00765     }
00766     *y= x >> 2;
00767     return 2;
00768   }
00769   k= 0;
00770   if (!(x & 0xffff))
00771   {
00772     k= 16;
00773     x>>= 16;
00774   }
00775   if (!(x & 0xff))
00776   {
00777     k+= 8;
00778     x>>= 8;
00779   }
00780   if (!(x & 0xf))
00781   {
00782     k+= 4;
00783     x>>= 4;
00784   }
00785   if (!(x & 0x3))
00786   {
00787     k+= 2;
00788     x>>= 2;
00789   }
00790   if (!(x & 1))
00791   {
00792     k++;
00793     x>>= 1;
00794     if (!x)
00795       return 32;
00796   }
00797   *y= x;
00798   return k;
00799 }
00800 
00801 
00802 /* Convert integer to Bigint number */
00803 
00804 static Bigint *i2b(int i)
00805 {
00806   Bigint *b;
00807 
00808   b= Balloc(1);
00809   b->p.x[0]= i;
00810   b->wds= 1;
00811   return b;
00812 }
00813 
00814 
00815 /* Multiply two Bigint numbers */
00816 
00817 static Bigint *mult(Bigint *a, Bigint *b)
00818 {
00819   Bigint *c;
00820   int k, wa, wb, wc;
00821   ULong *x, *xa, *xae, *xb, *xbe, *xc, *xc0;
00822   ULong y;
00823   ULLong carry, z;
00824 
00825   if (a->wds < b->wds)
00826   {
00827     c= a;
00828     a= b;
00829     b= c;
00830   }
00831   k= a->k;
00832   wa= a->wds;
00833   wb= b->wds;
00834   wc= wa + wb;
00835   if (wc > a->maxwds)
00836     k++;
00837   c= Balloc(k);
00838   for (x= c->p.x, xa= x + wc; x < xa; x++)
00839     *x= 0;
00840   xa= a->p.x;
00841   xae= xa + wa;
00842   xb= b->p.x;
00843   xbe= xb + wb;
00844   xc0= c->p.x;
00845   for (; xb < xbe; xc0++)
00846   {
00847     if ((y= *xb++))
00848     {
00849       x= xa;
00850       xc= xc0;
00851       carry= 0;
00852       do
00853       {
00854         z= *x++ * (ULLong)y + *xc + carry;
00855         carry= z >> 32;
00856         *xc++= (ULong) (z & FFFFFFFF);
00857       }
00858       while (x < xae);
00859       *xc= (ULong) carry;
00860     }
00861   }
00862   for (xc0= c->p.x, xc= xc0 + wc; wc > 0 && !*--xc; --wc) ;
00863   c->wds= wc;
00864   return c;
00865 }
00866 
00867 
00868 /*
00869   Precalculated array of powers of 5: tested to be enough for
00870   vasting majority of dtoa_r cases.
00871 */
00872 
00873 static ULong powers5[]=
00874 {
00875   625UL,
00876 
00877   390625UL,
00878 
00879   2264035265UL, 35UL,
00880 
00881   2242703233UL, 762134875UL,  1262UL,
00882 
00883   3211403009UL, 1849224548UL, 3668416493UL, 3913284084UL, 1593091UL,
00884 
00885   781532673UL,  64985353UL,   253049085UL,  594863151UL,  3553621484UL,
00886   3288652808UL, 3167596762UL, 2788392729UL, 3911132675UL, 590UL,
00887 
00888   2553183233UL, 3201533787UL, 3638140786UL, 303378311UL, 1809731782UL,
00889   3477761648UL, 3583367183UL, 649228654UL, 2915460784UL, 487929380UL,
00890   1011012442UL, 1677677582UL, 3428152256UL, 1710878487UL, 1438394610UL,
00891   2161952759UL, 4100910556UL, 1608314830UL, 349175UL
00892 };
00893 
00894 
00895 static Bigint p5_a[]=
00896 {
00897   /*  { x } - k - maxwds - sign - wds */
00898   { { powers5 }, 1, 1, 0, 1 },
00899   { { powers5 + 1 }, 1, 1, 0, 1 },
00900   { { powers5 + 2 }, 1, 2, 0, 2 },
00901   { { powers5 + 4 }, 2, 3, 0, 3 },
00902   { { powers5 + 7 }, 3, 5, 0, 5 },
00903   { { powers5 + 12 }, 4, 10, 0, 10 },
00904   { { powers5 + 22 }, 5, 19, 0, 19 }
00905 };
00906 
00907 #define P5A_MAX (sizeof(p5_a)/sizeof(*p5_a) - 1)
00908 
00909 static Bigint *pow5mult(Bigint *b, int k)
00910 {
00911   Bigint *b1, *p5, *p51;
00912   int i;
00913   static int p05[3]= { 5, 25, 125 };
00914 
00915   if ((i= k & 3))
00916     b= multadd(b, p05[i-1], 0);
00917 
00918   if (!(k>>= 2))
00919     return b;
00920   p5= p5_a;
00921   for (;;)
00922   {
00923     if (k & 1)
00924     {
00925       b1= mult(b, p5);
00926       Bfree(b);
00927       b= b1;
00928     }
00929     if (!(k>>= 1))
00930       break;
00931     /* Calculate next power of 5 */
00932     if (p5 < p5_a + P5A_MAX)
00933       ++p5;
00934     else if (p5 == p5_a + P5A_MAX)
00935       p5= mult(p5, p5);
00936     else
00937     {
00938       p51= mult(p5, p5);
00939       Bfree(p5);
00940       p5= p51;
00941     }
00942   }
00943   return b;
00944 }
00945 
00946 
00947 static Bigint *lshift(Bigint *b, int k)
00948 {
00949   int i, k1, n, n1;
00950   Bigint *b1;
00951   ULong *x, *x1, *xe, z;
00952 
00953   n= k >> 5;
00954   k1= b->k;
00955   n1= n + b->wds + 1;
00956   for (i= b->maxwds; n1 > i; i<<= 1)
00957     k1++;
00958   b1= Balloc(k1);
00959   x1= b1->p.x;
00960   for (i= 0; i < n; i++)
00961     *x1++= 0;
00962   x= b->p.x;
00963   xe= x + b->wds;
00964   if (k&= 0x1f)
00965   {
00966     k1= 32 - k;
00967     z= 0;
00968     do
00969     {
00970       *x1++= *x << k | z;
00971       z= *x++ >> k1;
00972     }
00973     while (x < xe);
00974     if ((*x1= z))
00975       ++n1;
00976   }
00977   else
00978     do
00979       *x1++= *x++;
00980     while (x < xe);
00981   b1->wds= n1 - 1;
00982   Bfree(b);
00983   return b1;
00984 }
00985 
00986 
00987 static int cmp(Bigint *a, Bigint *b)
00988 {
00989   ULong *xa, *xa0, *xb, *xb0;
00990   int i, j;
00991 
00992   i= a->wds;
00993   j= b->wds;
00994   if (i-= j)
00995     return i;
00996   xa0= a->p.x;
00997   xa= xa0 + j;
00998   xb0= b->p.x;
00999   xb= xb0 + j;
01000   for (;;)
01001   {
01002     if (*--xa != *--xb)
01003       return *xa < *xb ? -1 : 1;
01004     if (xa <= xa0)
01005       break;
01006   }
01007   return 0;
01008 }
01009 
01010 
01011 static Bigint *diff(Bigint *a, Bigint *b)
01012 {
01013   Bigint *c;
01014   int i, wa, wb;
01015   ULong *xa, *xae, *xb, *xbe, *xc;
01016   ULLong borrow, y;
01017 
01018   i= cmp(a,b);
01019   if (!i)
01020   {
01021     c= Balloc(0);
01022     c->wds= 1;
01023     c->p.x[0]= 0;
01024     return c;
01025   }
01026   if (i < 0)
01027   {
01028     c= a;
01029     a= b;
01030     b= c;
01031     i= 1;
01032   }
01033   else
01034     i= 0;
01035   c= Balloc(a->k);
01036   c->sign= i;
01037   wa= a->wds;
01038   xa= a->p.x;
01039   xae= xa + wa;
01040   wb= b->wds;
01041   xb= b->p.x;
01042   xbe= xb + wb;
01043   xc= c->p.x;
01044   borrow= 0;
01045   do
01046   {
01047     y= (ULLong)*xa++ - *xb++ - borrow;
01048     borrow= y >> 32 & (ULong)1;
01049     *xc++= (ULong) (y & FFFFFFFF);
01050   }
01051   while (xb < xbe);
01052   while (xa < xae)
01053   {
01054     y= *xa++ - borrow;
01055     borrow= y >> 32 & (ULong)1;
01056     *xc++= (ULong) (y & FFFFFFFF);
01057   }
01058   while (!*--xc)
01059     wa--;
01060   c->wds= wa;
01061   return c;
01062 }
01063 
01064 
01065 static double ulp(double x)
01066 {
01067   Long L;
01068   double a;
01069 
01070   L= (word0(x) & Exp_mask) - (P - 1)*Exp_msk1;
01071   word0(a) = L;
01072   word1(a) = 0;
01073   return dval(a);
01074 }
01075 
01076 
01077 static double b2d(Bigint *a, int *e)
01078 {
01079   ULong *xa, *xa0, w, y, z;
01080   int k;
01081   double d;
01082 #define d0 word0(d)
01083 #define d1 word1(d)
01084 
01085   xa0= a->p.x;
01086   xa= xa0 + a->wds;
01087   y= *--xa;
01088   k= hi0bits(y);
01089   *e= 32 - k;
01090   if (k < Ebits)
01091   {
01092     d0= Exp_1 | y >> (Ebits - k);
01093     w= xa > xa0 ? *--xa : 0;
01094     d1= y << ((32-Ebits) + k) | w >> (Ebits - k);
01095     goto ret_d;
01096   }
01097   z= xa > xa0 ? *--xa : 0;
01098   if (k-= Ebits)
01099   {
01100     d0= Exp_1 | y << k | z >> (32 - k);
01101     y= xa > xa0 ? *--xa : 0;
01102     d1= z << k | y >> (32 - k);
01103   }
01104   else
01105   {
01106     d0= Exp_1 | y;
01107     d1= z;
01108   }
01109  ret_d:
01110 #undef d0
01111 #undef d1
01112   return dval(d);
01113 }
01114 
01115 
01116 static Bigint *d2b(double d, int *e, int *bits)
01117 {
01118   Bigint *b;
01119   int de, k;
01120   ULong *x, y, z;
01121   int i;
01122 #define d0 word0(d)
01123 #define d1 word1(d)
01124 
01125   b= Balloc(1);
01126   x= b->p.x;
01127 
01128   z= d0 & Frac_mask;
01129   d0 &= 0x7fffffff;       /* clear sign bit, which we ignore */
01130   if ((de= (int)(d0 >> Exp_shift)))
01131     z|= Exp_msk1;
01132   if ((y= d1))
01133   {
01134     if ((k= lo0bits(&y)))
01135     {
01136       x[0]= y | z << (32 - k);
01137       z>>= k;
01138     }
01139     else
01140       x[0]= y;
01141     i= b->wds= (x[1]= z) ? 2 : 1;
01142   }
01143   else
01144   {
01145     k= lo0bits(&z);
01146     x[0]= z;
01147     i= b->wds= 1;
01148     k+= 32;
01149   }
01150   if (de)
01151   {
01152     *e= de - Bias - (P-1) + k;
01153     *bits= P - k;
01154   }
01155   else
01156   {
01157     *e= de - Bias - (P-1) + 1 + k;
01158     *bits= 32*i - hi0bits(x[i-1]);
01159   }
01160   return b;
01161 #undef d0
01162 #undef d1
01163 }
01164 
01165 
01166 static double ratio(Bigint *a, Bigint *b)
01167 {
01168   double da, db;
01169   int k, ka, kb;
01170 
01171   dval(da)= b2d(a, &ka);
01172   dval(db)= b2d(b, &kb);
01173   k= ka - kb + 32*(a->wds - b->wds);
01174   if (k > 0)
01175     word0(da)+= k*Exp_msk1;
01176   else
01177   {
01178     k= -k;
01179     word0(db)+= k*Exp_msk1;
01180   }
01181   return dval(da) / dval(db);
01182 }
01183 
01184 static const double tens[] =
01185 {
01186   1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9,
01187   1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19,
01188   1e20, 1e21, 1e22
01189 };
01190 
01191 static const double bigtens[]= { 1e16, 1e32, 1e64, 1e128, 1e256 };
01192 static const double tinytens[]=
01193 { 1e-16, 1e-32, 1e-64, 1e-128,
01194   9007199254740992.*9007199254740992.e-256 /* = 2^106 * 1e-53 */
01195 };
01196 /*
01197   The factor of 2^53 in tinytens[4] helps us avoid setting the underflow
01198   flag unnecessarily.  It leads to a song and dance at the end of strtod.
01199 */
01200 #define Scale_Bit 0x10
01201 #define n_bigtens 5
01202 
01203 /*
01204   strtod for IEEE--arithmetic machines.
01205 
01206   This strtod returns a nearest machine number to the input decimal
01207   string (or sets errno to EOVERFLOW). Ties are broken by the IEEE round-even
01208   rule.
01209 
01210   Inspired loosely by William D. Clinger's paper "How to Read Floating
01211   Point Numbers Accurately" [Proc. ACM SIGPLAN '90, pp. 92-101].
01212 
01213   Modifications:
01214 
01215    1. We only require IEEE (not IEEE double-extended).
01216    2. We get by with floating-point arithmetic in a case that
01217      Clinger missed -- when we're computing d * 10^n
01218      for a small integer d and the integer n is not too
01219      much larger than 22 (the maximum integer k for which
01220      we can represent 10^k exactly), we may be able to
01221      compute (d*10^k) * 10^(e-k) with just one roundoff.
01222    3. Rather than a bit-at-a-time adjustment of the binary
01223      result in the hard case, we use floating-point
01224      arithmetic to determine the adjustment to within
01225      one bit; only in really hard cases do we need to
01226      compute a second residual.
01227    4. Because of 3., we don't need a large table of powers of 10
01228      for ten-to-e (just some small tables, e.g. of 10^k
01229      for 0 <= k <= 22).
01230 */
01231 
01232 static double my_strtod_int(const char *s00, char **se, int *error)
01233 {
01234   int scale;
01235   int bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, dsign,
01236      e, e1, esign, i, j, k, nd, nd0, nf, nz, nz0, sign;
01237   const char *s, *s0, *s1, *end = *se;
01238   double aadj, aadj1, adj, rv, rv0;
01239   Long L;
01240   ULong y, z;
01241   Bigint *bb= NULL, *bb1= NULL, *bd= NULL, *bd0= NULL, *bs= NULL, *delta= NULL;
01242 #ifdef SET_INEXACT
01243   int inexact, oldinexact;
01244 #endif
01245 
01246   c= 0;
01247   *error= 0;
01248 
01249   sign= nz0= nz= 0;
01250   dval(rv)= 0.;
01251   for (s= s00; s < end; s++)
01252     switch (*s) {
01253     case '-':
01254       sign= 1;
01255       /* no break */
01256     case '+':
01257       s++;
01258       goto break2;
01259     case '\t':
01260     case '\n':
01261     case '\v':
01262     case '\f':
01263     case '\r':
01264     case ' ':
01265       continue;
01266     default:
01267       goto break2;
01268     }
01269  break2:
01270   if (s >= end)
01271     goto ret0;
01272 
01273   if (*s == '0')
01274   {
01275     nz0= 1;
01276     while (++s < end && *s == '0') ;
01277     if (s >= end)
01278       goto ret;
01279   }
01280   s0= s;
01281   y= z= 0;
01282   for (nd= nf= 0; s < end && (c= *s) >= '0' && c <= '9'; nd++, s++)
01283     if (nd < 9)
01284       y= 10*y + c - '0';
01285     else if (nd < 16)
01286       z= 10*z + c - '0';
01287   nd0= nd;
01288   if (s < end - 1 && c == '.')
01289   {
01290     c= *++s;
01291     if (!nd)
01292     {
01293       for (; s < end && c == '0'; c= *++s)
01294         nz++;
01295       if (s < end && c > '0' && c <= '9')
01296       {
01297         s0= s;
01298         nf+= nz;
01299         nz= 0;
01300         goto have_dig;
01301       }
01302       goto dig_done;
01303     }
01304     for (; s < end && c >= '0' && c <= '9'; c = *++s)
01305     {
01306  have_dig:
01307       nz++;
01308       if (c-= '0')
01309       {
01310         nf+= nz;
01311         for (i= 1; i < nz; i++)
01312           if (nd++ < 9)
01313             y*= 10;
01314           else if (nd <= DBL_DIG + 1)
01315             z*= 10;
01316         if (nd++ < 9)
01317           y= 10*y + c;
01318         else if (nd <= DBL_DIG + 1)
01319           z= 10*z + c;
01320         nz= 0;
01321       }
01322     }
01323   }
01324  dig_done:
01325   e= 0;
01326   if (s < end && (c == 'e' || c == 'E'))
01327   {
01328     if (!nd && !nz && !nz0)
01329       goto ret0;
01330     s00= s;
01331     esign= 0;
01332     if (++s < end)
01333       switch (c= *s) {
01334       case '-':
01335         esign= 1;
01336       case '+':
01337         c= *++s;
01338       }
01339     if (s < end && c >= '0' && c <= '9')
01340     {
01341       while (s < end && c == '0')
01342         c= *++s;
01343       if (s < end && c > '0' && c <= '9') {
01344         L= c - '0';
01345         s1= s;
01346         while (++s < end && (c= *s) >= '0' && c <= '9')
01347           L= 10*L + c - '0';
01348         if (s - s1 > 8 || L > 19999)
01349           /* Avoid confusion from exponents
01350            * so large that e might overflow.
01351            */
01352           e= 19999; /* safe for 16 bit ints */
01353         else
01354           e= (int)L;
01355         if (esign)
01356           e= -e;
01357       }
01358       else
01359         e= 0;
01360     }
01361     else
01362       s= s00;
01363   }
01364   if (!nd)
01365   {
01366     if (!nz && !nz0)
01367     {
01368  ret0:
01369       s= s00;
01370       sign= 0;
01371     }
01372     goto ret;
01373   }
01374   e1= e -= nf;
01375 
01376   /*
01377     Now we have nd0 digits, starting at s0, followed by a
01378     decimal point, followed by nd-nd0 digits.  The number we're
01379     after is the integer represented by those digits times
01380     10**e
01381    */
01382 
01383   if (!nd0)
01384     nd0= nd;
01385   k= nd < DBL_DIG + 1 ? nd : DBL_DIG + 1;
01386   dval(rv)= y;
01387   if (k > 9)
01388   {
01389 #ifdef SET_INEXACT
01390     if (k > DBL_DIG)
01391       oldinexact = get_inexact();
01392 #endif
01393     dval(rv)= tens[k - 9] * dval(rv) + z;
01394   }
01395   bd0= 0;
01396   if (nd <= DBL_DIG
01397       )
01398   {
01399     if (!e)
01400       goto ret;
01401     if (e > 0)
01402     {
01403       if (e <= Ten_pmax)
01404       {
01405         /* rv = */ rounded_product(dval(rv), tens[e]);
01406         goto ret;
01407       }
01408       i= DBL_DIG - nd;
01409       if (e <= Ten_pmax + i)
01410       {
01411         /*
01412           A fancier test would sometimes let us do
01413           this for larger i values.
01414         */
01415         e-= i;
01416         dval(rv)*= tens[i];
01417         /* rv = */ rounded_product(dval(rv), tens[e]);
01418         goto ret;
01419       }
01420     }
01421 #ifndef Inaccurate_Divide
01422     else if (e >= -Ten_pmax)
01423     {
01424       /* rv = */ rounded_quotient(dval(rv), tens[-e]);
01425       goto ret;
01426     }
01427 #endif
01428   }
01429   e1+= nd - k;
01430 
01431 #ifdef SET_INEXACT
01432   inexact= 1;
01433   if (k <= DBL_DIG)
01434     oldinexact= get_inexact();
01435 #endif
01436   scale= 0;
01437 
01438   /* Get starting approximation = rv * 10**e1 */
01439 
01440   if (e1 > 0)
01441   {
01442     if ((i= e1 & 15))
01443       dval(rv)*= tens[i];
01444     if (e1&= ~15)
01445     {
01446       if (e1 > DBL_MAX_10_EXP)
01447       {
01448  ovfl:
01449         *error= EOVERFLOW;
01450         /* Can't trust HUGE_VAL */
01451         word0(rv)= Exp_mask;
01452         word1(rv)= 0;
01453 #ifdef SET_INEXACT
01454         /* set overflow bit */
01455         dval(rv0)= 1e300;
01456         dval(rv0)*= dval(rv0);
01457 #endif
01458         if (bd0)
01459           goto retfree;
01460         goto ret;
01461       }
01462       e1>>= 4;
01463       for(j= 0; e1 > 1; j++, e1>>= 1)
01464         if (e1 & 1)
01465           dval(rv)*= bigtens[j];
01466     /* The last multiplication could overflow. */
01467       word0(rv)-= P*Exp_msk1;
01468       dval(rv)*= bigtens[j];
01469       if ((z= word0(rv) & Exp_mask) > Exp_msk1 * (DBL_MAX_EXP + Bias - P))
01470         goto ovfl;
01471       if (z > Exp_msk1 * (DBL_MAX_EXP + Bias - 1 - P))
01472       {
01473         /* set to largest number (Can't trust DBL_MAX) */
01474         word0(rv)= Big0;
01475         word1(rv)= Big1;
01476       }
01477       else
01478         word0(rv)+= P*Exp_msk1;
01479     }
01480   }
01481   else if (e1 < 0)
01482   {
01483     e1= -e1;
01484     if ((i= e1 & 15))
01485       dval(rv)/= tens[i];
01486     if ((e1>>= 4))
01487     {
01488       if (e1 >= 1 << n_bigtens)
01489         goto undfl;
01490       if (e1 & Scale_Bit)
01491         scale= 2 * P;
01492       for(j= 0; e1 > 0; j++, e1>>= 1)
01493         if (e1 & 1)
01494           dval(rv)*= tinytens[j];
01495       if (scale && (j = 2 * P + 1 - ((word0(rv) & Exp_mask) >> Exp_shift)) > 0)
01496       {
01497         /* scaled rv is denormal; zap j low bits */
01498         if (j >= 32)
01499         {
01500           word1(rv)= 0;
01501           if (j >= 53)
01502             word0(rv)= (P + 2) * Exp_msk1;
01503           else
01504             word0(rv)&= 0xffffffff << (j - 32);
01505         }
01506         else
01507           word1(rv)&= 0xffffffff << j;
01508       }
01509       if (!dval(rv))
01510       {
01511  undfl:
01512           dval(rv)= 0.;
01513           if (bd0)
01514             goto retfree;
01515           goto ret;
01516       }
01517     }
01518   }
01519 
01520   /* Now the hard part -- adjusting rv to the correct value.*/
01521 
01522   /* Put digits into bd: true value = bd * 10^e */
01523 
01524   bd0= s2b(s0, nd0, nd, y);
01525 
01526   for(;;)
01527   {
01528     bd= Balloc(bd0->k);
01529     Bcopy(bd, bd0);
01530     bb= d2b(dval(rv), &bbe, &bbbits);  /* rv = bb * 2^bbe */
01531     bs= i2b(1);
01532 
01533     if (e >= 0)
01534     {
01535       bb2= bb5= 0;
01536       bd2= bd5= e;
01537     }
01538     else
01539     {
01540       bb2= bb5= -e;
01541       bd2= bd5= 0;
01542     }
01543     if (bbe >= 0)
01544       bb2+= bbe;
01545     else
01546       bd2-= bbe;
01547     bs2= bb2;
01548     j= bbe - scale;
01549     i= j + bbbits - 1;  /* logb(rv) */
01550     if (i < Emin)  /* denormal */
01551       j+= P - Emin;
01552     else
01553       j= P + 1 - bbbits;
01554     bb2+= j;
01555     bd2+= j;
01556     bd2+= scale;
01557     i= bb2 < bd2 ? bb2 : bd2;
01558     if (i > bs2)
01559       i= bs2;
01560     if (i > 0)
01561     {
01562       bb2-= i;
01563       bd2-= i;
01564       bs2-= i;
01565     }
01566     if (bb5 > 0)
01567     {
01568       bs= pow5mult(bs, bb5);
01569       bb1= mult(bs, bb);
01570       Bfree(bb);
01571       bb= bb1;
01572     }
01573     if (bb2 > 0)
01574       bb= lshift(bb, bb2);
01575     if (bd5 > 0)
01576       bd= pow5mult(bd, bd5);
01577     if (bd2 > 0)
01578       bd= lshift(bd, bd2);
01579     if (bs2 > 0)
01580       bs= lshift(bs, bs2);
01581     delta= diff(bb, bd);
01582     dsign= delta->sign;
01583     delta->sign= 0;
01584     i= cmp(delta, bs);
01585 
01586     if (i < 0)
01587     {
01588       /*
01589         Error is less than half an ulp -- check for special case of mantissa
01590         a power of two.
01591       */
01592       if (dsign || word1(rv) || word0(rv) & Bndry_mask ||
01593           (word0(rv) & Exp_mask) <= (2 * P + 1) * Exp_msk1)
01594       {
01595 #ifdef SET_INEXACT
01596         if (!delta->x[0] && delta->wds <= 1)
01597           inexact= 0;
01598 #endif
01599         break;
01600       }
01601       if (!delta->p.x[0] && delta->wds <= 1)
01602       {
01603         /* exact result */
01604 #ifdef SET_INEXACT
01605         inexact= 0;
01606 #endif
01607         break;
01608       }
01609       delta= lshift(delta, Log2P);
01610       if (cmp(delta, bs) > 0)
01611         goto drop_down;
01612       break;
01613     }
01614     if (i == 0)
01615     {
01616       /* exactly half-way between */
01617       if (dsign)
01618       {
01619         if ((word0(rv) & Bndry_mask1) == Bndry_mask1 &&
01620             word1(rv) ==
01621             ((scale && (y = word0(rv) & Exp_mask) <= 2 * P * Exp_msk1) ?
01622              (0xffffffff & (0xffffffff << (2*P+1-(y>>Exp_shift)))) :
01623              0xffffffff))
01624         {
01625           /*boundary case -- increment exponent*/
01626           word0(rv)= (word0(rv) & Exp_mask) + Exp_msk1;
01627           word1(rv) = 0;
01628           dsign = 0;
01629           break;
01630         }
01631       }
01632       else if (!(word0(rv) & Bndry_mask) && !word1(rv))
01633       {
01634  drop_down:
01635         /* boundary case -- decrement exponent */
01636         if (scale)
01637         {
01638           L= word0(rv) & Exp_mask;
01639           if (L <= (2 *P + 1) * Exp_msk1)
01640           {
01641             if (L > (P + 2) * Exp_msk1)
01642               /* round even ==> accept rv */
01643               break;
01644             /* rv = smallest denormal */
01645             goto undfl;
01646           }
01647         }
01648         L= (word0(rv) & Exp_mask) - Exp_msk1;
01649         word0(rv)= L | Bndry_mask1;
01650         word1(rv)= 0xffffffff;
01651         break;
01652       }
01653       if (!(word1(rv) & LSB))
01654         break;
01655       if (dsign)
01656         dval(rv)+= ulp(dval(rv));
01657       else
01658       {
01659         dval(rv)-= ulp(dval(rv));
01660         if (!dval(rv))
01661           goto undfl;
01662       }
01663       dsign= 1 - dsign;
01664       break;
01665     }
01666     if ((aadj= ratio(delta, bs)) <= 2.)
01667     {
01668       if (dsign)
01669         aadj= aadj1= 1.;
01670       else if (word1(rv) || word0(rv) & Bndry_mask)
01671       {
01672         if (word1(rv) == Tiny1 && !word0(rv))
01673           goto undfl;
01674         aadj= 1.;
01675         aadj1= -1.;
01676       }
01677       else
01678       {
01679         /* special case -- power of FLT_RADIX to be rounded down... */
01680         if (aadj < 2. / FLT_RADIX)
01681           aadj= 1. / FLT_RADIX;
01682         else
01683           aadj*= 0.5;
01684         aadj1= -aadj;
01685       }
01686     }
01687     else
01688     {
01689       aadj*= 0.5;
01690       aadj1= dsign ? aadj : -aadj;
01691       if (Flt_Rounds == 0)
01692         aadj1+= 0.5;
01693     }
01694     y= word0(rv) & Exp_mask;
01695 
01696     /* Check for overflow */
01697 
01698     if (y == Exp_msk1 * (DBL_MAX_EXP + Bias - 1))
01699     {
01700       dval(rv0)= dval(rv);
01701       word0(rv)-= P * Exp_msk1;
01702       adj= aadj1 * ulp(dval(rv));
01703       dval(rv)+= adj;
01704       if ((word0(rv) & Exp_mask) >= Exp_msk1 * (DBL_MAX_EXP + Bias - P))
01705       {
01706         if (word0(rv0) == Big0 && word1(rv0) == Big1)
01707           goto ovfl;
01708         word0(rv)= Big0;
01709         word1(rv)= Big1;
01710         goto cont;
01711       }
01712       else
01713         word0(rv)+= P * Exp_msk1;
01714     }
01715     else
01716     {
01717       if (scale && y <= 2 * P * Exp_msk1)
01718       {
01719         if (aadj <= 0x7fffffff)
01720         {
01721           if ((z= (ULong) aadj) <= 0)
01722             z= 1;
01723           aadj= z;
01724           aadj1= dsign ? aadj : -aadj;
01725         }
01726         word0(aadj1)+= (2 * P + 1) * Exp_msk1 - y;
01727       }
01728       adj = aadj1 * ulp(dval(rv));
01729       dval(rv) += adj;
01730     }
01731     z= word0(rv) & Exp_mask;
01732 #ifndef SET_INEXACT
01733     if (!scale)
01734       if (y == z)
01735       {
01736         /* Can we stop now? */
01737         L= (Long)aadj;
01738         aadj-= L;
01739         /* The tolerances below are conservative. */
01740         if (dsign || word1(rv) || word0(rv) & Bndry_mask)
01741         {
01742           if (aadj < .4999999 || aadj > .5000001)
01743             break;
01744         }
01745         else if (aadj < .4999999 / FLT_RADIX)
01746           break;
01747       }
01748 #endif
01749  cont:
01750     Bfree(bb);
01751     Bfree(bd);
01752     Bfree(bs);
01753     Bfree(delta);
01754   }
01755 #ifdef SET_INEXACT
01756   if (inexact)
01757   {
01758     if (!oldinexact)
01759     {
01760       word0(rv0)= Exp_1 + (70 << Exp_shift);
01761       word1(rv0)= 0;
01762       dval(rv0)+= 1.;
01763     }
01764   }
01765   else if (!oldinexact)
01766     clear_inexact();
01767 #endif
01768   if (scale)
01769   {
01770     word0(rv0)= Exp_1 - 2 * P * Exp_msk1;
01771     word1(rv0)= 0;
01772     dval(rv)*= dval(rv0);
01773   }
01774 #ifdef SET_INEXACT
01775   if (inexact && !(word0(rv) & Exp_mask))
01776   {
01777     /* set underflow bit */
01778     dval(rv0)= 1e-300;
01779     dval(rv0)*= dval(rv0);
01780   }
01781 #endif
01782  retfree:
01783   Bfree(bb);
01784   Bfree(bd);
01785   Bfree(bs);
01786   Bfree(bd0);
01787   Bfree(delta);
01788  ret:
01789   *se= (char *)s;
01790   return sign ? -dval(rv) : dval(rv);
01791 }
01792 
01793 
01794 static int quorem(Bigint *b, Bigint *S)
01795 {
01796   int n;
01797   ULong *bx, *bxe, q, *sx, *sxe;
01798   ULLong borrow, carry, y, ys;
01799 
01800   n= S->wds;
01801   if (b->wds < n)
01802     return 0;
01803   sx= S->p.x;
01804   sxe= sx + --n;
01805   bx= b->p.x;
01806   bxe= bx + n;
01807   q= *bxe / (*sxe + 1);  /* ensure q <= true quotient */
01808   if (q)
01809   {
01810     borrow= 0;
01811     carry= 0;
01812     do
01813     {
01814       ys= *sx++ * (ULLong)q + carry;
01815       carry= ys >> 32;
01816       y= *bx - (ys & FFFFFFFF) - borrow;
01817       borrow= y >> 32 & (ULong)1;
01818       *bx++= (ULong) (y & FFFFFFFF);
01819     }
01820     while (sx <= sxe);
01821     if (!*bxe)
01822     {
01823       bx= b->p.x;
01824       while (--bxe > bx && !*bxe)
01825         --n;
01826       b->wds= n;
01827     }
01828   }
01829   if (cmp(b, S) >= 0)
01830   {
01831     q++;
01832     borrow= 0;
01833     carry= 0;
01834     bx= b->p.x;
01835     sx= S->p.x;
01836     do
01837     {
01838       ys= *sx++ + carry;
01839       carry= ys >> 32;
01840       y= *bx - (ys & FFFFFFFF) - borrow;
01841       borrow= y >> 32 & (ULong)1;
01842       *bx++= (ULong) (y & FFFFFFFF);
01843     }
01844     while (sx <= sxe);
01845     bx= b->p.x;
01846     bxe= bx + n;
01847     if (!*bxe)
01848     {
01849       while (--bxe > bx && !*bxe)
01850         --n;
01851       b->wds= n;
01852     }
01853   }
01854   return q;
01855 }
01856 
01857 
01858 /*
01859    dtoa for IEEE arithmetic (dmg): convert double to ASCII string.
01860 
01861    Inspired by "How to Print Floating-Point Numbers Accurately" by
01862    Guy L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90, pp. 112-126].
01863 
01864    Modifications:
01865         1. Rather than iterating, we use a simple numeric overestimate
01866            to determine k= floor(log10(d)).  We scale relevant
01867            quantities using O(log2(k)) rather than O(k) multiplications.
01868         2. For some modes > 2 (corresponding to ecvt and fcvt), we don't
01869            try to generate digits strictly left to right.  Instead, we
01870            compute with fewer bits and propagate the carry if necessary
01871            when rounding the final digit up.  This is often faster.
01872         3. Under the assumption that input will be rounded nearest,
01873            mode 0 renders 1e23 as 1e23 rather than 9.999999999999999e22.
01874            That is, we allow equality in stopping tests when the
01875            round-nearest rule will give the same floating-point value
01876            as would satisfaction of the stopping test with strict
01877            inequality.
01878         4. We remove common factors of powers of 2 from relevant
01879            quantities.
01880         5. When converting floating-point integers less than 1e16,
01881            we use floating-point arithmetic rather than resorting
01882            to multiple-precision integers.
01883         6. When asked to produce fewer than 15 digits, we first try
01884            to get by with floating-point arithmetic; we resort to
01885            multiple-precision integer arithmetic only if we cannot
01886            guarantee that the floating-point calculation has given
01887            the correctly rounded result.  For k requested digits and
01888            "uniformly" distributed input, the probability is
01889            something like 10^(k-15) that we must resort to the Long
01890            calculation.
01891  */
01892 
01893 static char *dtoa(double d, int mode, int ndigits, int *decpt, int *sign,
01894                   char **rve)
01895 {
01896   /*
01897     Arguments ndigits, decpt, sign are similar to those
01898     of ecvt and fcvt; trailing zeros are suppressed from
01899     the returned string.  If not null, *rve is set to point
01900     to the end of the return value.  If d is +-Infinity or NaN,
01901     then *decpt is set to DTOA_OVERFLOW.
01902 
01903     mode:
01904           0 ==> shortest string that yields d when read in
01905                 and rounded to nearest.
01906 
01907           1 ==> like 0, but with Steele & White stopping rule;
01908                 e.g. with IEEE P754 arithmetic , mode 0 gives
01909                 1e23 whereas mode 1 gives 9.999999999999999e22.
01910           2 ==> cmax(1,ndigits) significant digits.  This gives a
01911                 return value similar to that of ecvt, except
01912                 that trailing zeros are suppressed.
01913           3 ==> through ndigits past the decimal point.  This
01914                 gives a return value similar to that from fcvt,
01915                 except that trailing zeros are suppressed, and
01916                 ndigits can be negative.
01917           4,5 ==> similar to 2 and 3, respectively, but (in
01918                 round-nearest mode) with the tests of mode 0 to
01919                 possibly return a shorter string that rounds to d.
01920           6-9 ==> Debugging modes similar to mode - 4:  don't try
01921                 fast floating-point estimate (if applicable).
01922 
01923       Values of mode other than 0-9 are treated as mode 0.
01924 
01925     Sufficient space is allocated to the return value
01926     to hold the suppressed trailing zeros.
01927   */
01928 
01929   int bbits, b2, b5, be, dig, i, ieps, ilim=0, ilim0, ilim1= 0,
01930     j, j1, k, k0, k_check, leftright, m2, m5, s2, s5,
01931     spec_case, try_quick;
01932   Long L;
01933   int denorm;
01934   ULong x;
01935   Bigint *b, *b1, *delta, *mlo = NULL, *mhi, *S;
01936   double d2, ds, eps;
01937   char *s, *s0;
01938 
01939   if (word0(d) & Sign_bit)
01940   {
01941     /* set sign for everything, including 0's and NaNs */
01942     *sign= 1;
01943     word0(d) &= ~Sign_bit;  /* clear sign bit */
01944   }
01945   else
01946     *sign= 0;
01947 
01948   /* If infinity, set decpt to DTOA_OVERFLOW, if 0 set it to 1 */
01949   if ((((word0(d) & Exp_mask) == Exp_mask) && ((*decpt= DTOA_OVERFLOW) != 0)) ||
01950       (!dval(d) && ((*decpt= 1) != 0)))
01951   {
01952     /* Infinity, NaN, 0 */
01953     char *res= (char*) malloc(2);
01954     res[0]= '0';
01955     res[1]= '\0';
01956     if (rve)
01957       *rve= res + 1;
01958     return res;
01959   }
01960 
01961 
01962   b= d2b(dval(d), &be, &bbits);
01963   if ((i= (int)(word0(d) >> Exp_shift1 & (Exp_mask>>Exp_shift1))))
01964   {
01965     dval(d2)= dval(d);
01966     word0(d2) &= Frac_mask1;
01967     word0(d2) |= Exp_11;
01968 
01969     /*
01970       log(x)       ~=~ log(1.5) + (x-1.5)/1.5
01971       log10(x)      =  log(x) / log(10)
01972                    ~=~ log(1.5)/log(10) + (x-1.5)/(1.5*log(10))
01973       log10(d)= (i-Bias)*log(2)/log(10) + log10(d2)
01974 
01975       This suggests computing an approximation k to log10(d) by
01976 
01977       k= (i - Bias)*0.301029995663981
01978            + ( (d2-1.5)*0.289529654602168 + 0.176091259055681 );
01979 
01980       We want k to be too large rather than too small.
01981       The error in the first-order Taylor series approximation
01982       is in our favor, so we just round up the constant enough
01983       to compensate for any error in the multiplication of
01984       (i - Bias) by 0.301029995663981; since |i - Bias| <= 1077,
01985       and 1077 * 0.30103 * 2^-52 ~=~ 7.2e-14,
01986       adding 1e-13 to the constant term more than suffices.
01987       Hence we adjust the constant term to 0.1760912590558.
01988       (We could get a more accurate k by invoking log10,
01989        but this is probably not worthwhile.)
01990     */
01991 
01992     i-= Bias;
01993     denorm= 0;
01994   }
01995   else
01996   {
01997     /* d is denormalized */
01998 
01999     i= bbits + be + (Bias + (P-1) - 1);
02000     x= i > 32  ? word0(d) << (64 - i) | word1(d) >> (i - 32)
02001       : word1(d) << (32 - i);
02002     dval(d2)= x;
02003     word0(d2)-= 31*Exp_msk1; /* adjust exponent */
02004     i-= (Bias + (P-1) - 1) + 1;
02005     denorm= 1;
02006   }
02007   ds= (dval(d2)-1.5)*0.289529654602168 + 0.1760912590558 + i*0.301029995663981;
02008   k= (int)ds;
02009   if (ds < 0. && ds != k)
02010     k--;    /* want k= floor(ds) */
02011   k_check= 1;
02012   if (k >= 0 && k <= Ten_pmax)
02013   {
02014     if (dval(d) < tens[k])
02015       k--;
02016     k_check= 0;
02017   }
02018   j= bbits - i - 1;
02019   if (j >= 0)
02020   {
02021     b2= 0;
02022     s2= j;
02023   }
02024   else
02025   {
02026     b2= -j;
02027     s2= 0;
02028   }
02029   if (k >= 0)
02030   {
02031     b5= 0;
02032     s5= k;
02033     s2+= k;
02034   }
02035   else
02036   {
02037     b2-= k;
02038     b5= -k;
02039     s5= 0;
02040   }
02041   if (mode < 0 || mode > 9)
02042     mode= 0;
02043 
02044   try_quick= 1;
02045 
02046   if (mode > 5)
02047   {
02048     mode-= 4;
02049     try_quick= 0;
02050   }
02051   leftright= 1;
02052   switch (mode) {
02053   case 0:
02054   case 1:
02055     ilim= ilim1= -1;
02056     i= 18;
02057     ndigits= 0;
02058     break;
02059   case 2:
02060     leftright= 0;
02061     /* no break */
02062   case 4:
02063     if (ndigits <= 0)
02064       ndigits= 1;
02065     ilim= ilim1= i= ndigits;
02066     break;
02067   case 3:
02068     leftright= 0;
02069     /* no break */
02070   case 5:
02071     i= ndigits + k + 1;
02072     ilim= i;
02073     ilim1= i - 1;
02074     if (i <= 0)
02075       i= 1;
02076   }
02077   s= s0= (char*)malloc(i+1); /* +1 for trailing '\0' appended
02078         at end of function */
02079 
02080   if (ilim >= 0 && ilim <= Quick_max && try_quick)
02081   {
02082     /* Try to get by with floating-point arithmetic. */
02083     i= 0;
02084     dval(d2)= dval(d);
02085     k0= k;
02086     ilim0= ilim;
02087     ieps= 2; /* conservative */
02088     if (k > 0)
02089     {
02090       ds= tens[k&0xf];
02091       j= k >> 4;
02092       if (j & Bletch)
02093       {
02094         /* prevent overflows */
02095         j&= Bletch - 1;
02096         dval(d)/= bigtens[n_bigtens-1];
02097         ieps++;
02098       }
02099       for (; j; j>>= 1, i++)
02100       {
02101         if (j & 1)
02102         {
02103           ieps++;
02104           ds*= bigtens[i];
02105         }
02106       }
02107       dval(d)/= ds;
02108     }
02109     else if ((j1= -k))
02110     {
02111       dval(d)*= tens[j1 & 0xf];
02112       for (j= j1 >> 4; j; j>>= 1, i++)
02113       {
02114         if (j & 1)
02115         {
02116           ieps++;
02117           dval(d)*= bigtens[i];
02118         }
02119       }
02120     }
02121     if (k_check && dval(d) < 1. && ilim > 0)
02122     {
02123       if (ilim1 <= 0)
02124         goto fast_failed;
02125       ilim= ilim1;
02126       k--;
02127       dval(d)*= 10.;
02128       ieps++;
02129     }
02130     dval(eps)= ieps*dval(d) + 7.;
02131     word0(eps)-= (P-1)*Exp_msk1;
02132     if (ilim == 0)
02133     {
02134       S= mhi= 0;
02135       dval(d)-= 5.;
02136       if (dval(d) > dval(eps))
02137         goto one_digit;
02138       if (dval(d) < -dval(eps))
02139         goto no_digits;
02140       goto fast_failed;
02141     }
02142     if (leftright)
02143     {
02144       /* Use Steele & White method of only generating digits needed. */
02145       dval(eps)= 0.5/tens[ilim-1] - dval(eps);
02146       for (i= 0;;)
02147       {
02148         L= (Long) dval(d);
02149         dval(d)-= L;
02150         *s++= '0' + (int)L;
02151         if (dval(d) < dval(eps))
02152           goto ret1;
02153         if (1. - dval(d) < dval(eps))
02154           goto bump_up;
02155         if (++i >= ilim)
02156           break;
02157         dval(eps)*= 10.;
02158         dval(d)*= 10.;
02159       }
02160     }
02161     else
02162     {
02163       /* Generate ilim digits, then fix them up. */
02164       dval(eps)*= tens[ilim-1];
02165       for (i= 1;; i++, dval(d)*= 10.)
02166       {
02167         L= (Long)(dval(d));
02168         if (!(dval(d)-= L))
02169           ilim= i;
02170         *s++= '0' + (int)L;
02171         if (i == ilim)
02172         {
02173           if (dval(d) > 0.5 + dval(eps))
02174             goto bump_up;
02175           else if (dval(d) < 0.5 - dval(eps))
02176           {
02177             while (*--s == '0') {}
02178             s++;
02179             goto ret1;
02180           }
02181           break;
02182         }
02183       }
02184     }
02185   fast_failed:
02186     s= s0;
02187     dval(d)= dval(d2);
02188     k= k0;
02189     ilim= ilim0;
02190   }
02191 
02192   /* Do we have a "small" integer? */
02193 
02194   if (be >= 0 && k <= Int_max)
02195   {
02196     /* Yes. */
02197     ds= tens[k];
02198     if (ndigits < 0 && ilim <= 0)
02199     {
02200       S= mhi= 0;
02201       if (ilim < 0 || dval(d) <= 5*ds)
02202         goto no_digits;
02203       goto one_digit;
02204     }
02205     for (i= 1;; i++, dval(d)*= 10.)
02206     {
02207       L= (Long)(dval(d) / ds);
02208       dval(d)-= L*ds;
02209       *s++= '0' + (int)L;
02210       if (!dval(d))
02211       {
02212         break;
02213       }
02214       if (i == ilim)
02215       {
02216         dval(d)+= dval(d);
02217         if (dval(d) > ds || (dval(d) == ds && L & 1))
02218         {
02219 bump_up:
02220           while (*--s == '9')
02221             if (s == s0)
02222             {
02223               k++;
02224               *s= '0';
02225               break;
02226             }
02227           ++*s++;
02228         }
02229         break;
02230       }
02231     }
02232     goto ret1;
02233   }
02234 
02235   m2= b2;
02236   m5= b5;
02237   mhi= mlo= 0;
02238   if (leftright)
02239   {
02240     i = denorm ? be + (Bias + (P-1) - 1 + 1) : 1 + P - bbits;
02241     b2+= i;
02242     s2+= i;
02243     mhi= i2b(1);
02244   }
02245   if (m2 > 0 && s2 > 0)
02246   {
02247     i= m2 < s2 ? m2 : s2;
02248     b2-= i;
02249     m2-= i;
02250     s2-= i;
02251   }
02252   if (b5 > 0)
02253   {
02254     if (leftright)
02255     {
02256       if (m5 > 0)
02257       {
02258         mhi= pow5mult(mhi, m5);
02259         b1= mult(mhi, b);
02260         Bfree(b);
02261         b= b1;
02262       }
02263       if ((j= b5 - m5))
02264         b= pow5mult(b, j);
02265     }
02266     else
02267       b= pow5mult(b, b5);
02268   }
02269   S= i2b(1);
02270   if (s5 > 0)
02271     S= pow5mult(S, s5);
02272 
02273   /* Check for special case that d is a normalized power of 2. */
02274 
02275   spec_case= 0;
02276   if ((mode < 2 || leftright)
02277      )
02278   {
02279     if (!word1(d) && !(word0(d) & Bndry_mask) &&
02280         word0(d) & (Exp_mask & ~Exp_msk1)
02281        )
02282     {
02283       /* The special case */
02284       b2+= Log2P;
02285       s2+= Log2P;
02286       spec_case= 1;
02287     }
02288   }
02289 
02290   /*
02291     Arrange for convenient computation of quotients:
02292     shift left if necessary so divisor has 4 leading 0 bits.
02293 
02294     Perhaps we should just compute leading 28 bits of S once
02295     a nd for all and pass them and a shift to quorem, so it
02296     can do shifts and ors to compute the numerator for q.
02297   */
02298   if ((i= ((s5 ? 32 - hi0bits(S->p.x[S->wds-1]) : 1) + s2) & 0x1f))
02299     i= 32 - i;
02300   if (i > 4)
02301   {
02302     i-= 4;
02303     b2+= i;
02304     m2+= i;
02305     s2+= i;
02306   }
02307   else if (i < 4)
02308   {
02309     i+= 28;
02310     b2+= i;
02311     m2+= i;
02312     s2+= i;
02313   }
02314   if (b2 > 0)
02315     b= lshift(b, b2);
02316   if (s2 > 0)
02317     S= lshift(S, s2);
02318   if (k_check)
02319   {
02320     if (cmp(b,S) < 0)
02321     {
02322       k--;
02323       /* we botched the k estimate */
02324       b= multadd(b, 10, 0);
02325       if (leftright)
02326         mhi= multadd(mhi, 10, 0);
02327       ilim= ilim1;
02328     }
02329   }
02330   if (ilim <= 0 && (mode == 3 || mode == 5))
02331   {
02332     if (ilim < 0 || cmp(b,S= multadd(S,5,0)) <= 0)
02333     {
02334       /* no digits, fcvt style */
02335 no_digits:
02336       k= -1 - ndigits;
02337       goto ret;
02338     }
02339 one_digit:
02340     *s++= '1';
02341     k++;
02342     goto ret;
02343   }
02344   if (leftright)
02345   {
02346     if (m2 > 0)
02347       mhi= lshift(mhi, m2);
02348 
02349     /*
02350       Compute mlo -- check for special case that d is a normalized power of 2.
02351     */
02352 
02353     mlo= mhi;
02354     if (spec_case)
02355     {
02356       mhi= Balloc(mhi->k);
02357       Bcopy(mhi, mlo);
02358       mhi= lshift(mhi, Log2P);
02359     }
02360 
02361     for (i= 1;;i++)
02362     {
02363       dig= quorem(b,S) + '0';
02364       /* Do we yet have the shortest decimal string that will round to d? */
02365       j= cmp(b, mlo);
02366       delta= diff(S, mhi);
02367       j1= delta->sign ? 1 : cmp(b, delta);
02368       Bfree(delta);
02369       if (j1 == 0 && mode != 1 && !(word1(d) & 1)
02370          )
02371       {
02372         if (dig == '9')
02373           goto round_9_up;
02374         if (j > 0)
02375           dig++;
02376         *s++= dig;
02377         goto ret;
02378       }
02379       if (j < 0 || (j == 0 && mode != 1 && !(word1(d) & 1)))
02380       {
02381         if (!b->p.x[0] && b->wds <= 1)
02382         {
02383           goto accept_dig;
02384         }
02385         if (j1 > 0)
02386         {
02387           b= lshift(b, 1);
02388           j1= cmp(b, S);
02389           if ((j1 > 0 || (j1 == 0 && dig & 1))
02390               && dig++ == '9')
02391             goto round_9_up;
02392         }
02393 accept_dig:
02394         *s++= dig;
02395         goto ret;
02396       }
02397       if (j1 > 0)
02398       {
02399         if (dig == '9')
02400         { /* possible if i == 1 */
02401 round_9_up:
02402           *s++= '9';
02403           goto roundoff;
02404         }
02405         *s++= dig + 1;
02406         goto ret;
02407       }
02408       *s++= dig;
02409       if (i == ilim)
02410         break;
02411       b= multadd(b, 10, 0);
02412       if (mlo == mhi)
02413         mlo= mhi= multadd(mhi, 10, 0);
02414       else
02415       {
02416         mlo= multadd(mlo, 10, 0);
02417         mhi= multadd(mhi, 10, 0);
02418       }
02419     }
02420   }
02421   else
02422     for (i= 1;; i++)
02423     {
02424       *s++= dig= quorem(b,S) + '0';
02425       if (!b->p.x[0] && b->wds <= 1)
02426       {
02427         goto ret;
02428       }
02429       if (i >= ilim)
02430         break;
02431       b= multadd(b, 10, 0);
02432     }
02433 
02434   /* Round off last digit */
02435 
02436   b= lshift(b, 1);
02437   j= cmp(b, S);
02438   if (j > 0 || (j == 0 && dig & 1))
02439   {
02440 roundoff:
02441     while (*--s == '9')
02442       if (s == s0)
02443       {
02444         k++;
02445         *s++= '1';
02446         goto ret;
02447       }
02448     ++*s++;
02449   }
02450   else
02451   {
02452     while (*--s == '0') {}
02453     s++;
02454   }
02455 ret:
02456   Bfree(S);
02457   if (mhi)
02458   {
02459     if (mlo && mlo != mhi)
02460       Bfree(mlo);
02461     Bfree(mhi);
02462   }
02463 ret1:
02464   Bfree(b);
02465   *s= 0;
02466   *decpt= k + 1;
02467   if (rve)
02468     *rve= s;
02469   return s0;
02470 }
02471 
02472 } /* namespace internal */
02473 } /* namespace drizzled */