~drizzle-trunk/drizzle/development

« back to all changes in this revision

Viewing changes to mystrings/dtoa.c

Moved sql_common.h and my_time.h to libdrizzle.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
/* Copyright (C) 2007 MySQL AB
2
 
   This program is free software; you can redistribute it and/or modify
3
 
   it under the terms of the GNU General Public License as published by
4
 
   the Free Software Foundation; either version 2 of the License, or
5
 
   (at your option) any later version.
6
 
 
7
 
   This program is distributed in the hope that it will be useful,
8
 
   but WITHOUT ANY WARRANTY; without even the implied warranty of
9
 
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
10
 
   GNU General Public License for more details.
11
 
 
12
 
   You should have received a copy of the GNU General Public License
13
 
   along with this program; if not, write to the Free Software
14
 
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA */
15
 
 
16
 
/****************************************************************
17
 
 
18
 
  This file incorporates work covered by the following copyright and
19
 
  permission notice:
20
 
 
21
 
  The author of this software is David M. Gay.
22
 
 
23
 
  Copyright (c) 1991, 2000, 2001 by Lucent Technologies.
24
 
 
25
 
  Permission to use, copy, modify, and distribute this software for any
26
 
  purpose without fee is hereby granted, provided that this entire notice
27
 
  is included in all copies of any software which is or includes a copy
28
 
  or modification of this software and in all copies of the supporting
29
 
  documentation for such software.
30
 
 
31
 
  THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
32
 
  WARRANTY.  IN PARTICULAR, NEITHER THE AUTHOR NOR LUCENT MAKES ANY
33
 
  REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
34
 
  OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
35
 
 
36
 
 ***************************************************************/
37
 
 
38
 
#include <m_string.h>  /* for memcpy and NOT_FIXED_DEC */
39
 
 
40
 
/**
41
 
   Appears to suffice to not call malloc() in most cases.
42
 
   @todo
43
 
     see if it is possible to get rid of malloc().
44
 
     this constant is sufficient to avoid malloc() on all inputs I have tried.
45
 
*/
46
 
#define DTOA_BUFF_SIZE (420 * sizeof(void *))
47
 
 
48
 
/* Magic value returned by dtoa() to indicate overflow */
49
 
#define DTOA_OVERFLOW 9999
50
 
 
51
 
static double my_strtod_int(const char *, char **, int *, char *, size_t);
52
 
static char *dtoa(double, int, int, int *, int *, char **, char *, size_t);
53
 
static void dtoa_free(char *, char *, size_t);
54
 
 
55
 
/**
56
 
   @brief
57
 
   Converts a given floating point number to a zero-terminated string
58
 
   representation using the 'f' format.
59
 
 
60
 
   @details
61
 
   This function is a wrapper around dtoa() to do the same as
62
 
   sprintf(to, "%-.*f", precision, x), though the conversion is usually more
63
 
   precise. The only difference is in handling [-,+]infinity and nan values,
64
 
   in which case we print '0\0' to the output string and indicate an overflow.
65
 
 
66
 
   @param x           the input floating point number.
67
 
   @param precision   the number of digits after the decimal point.
68
 
                      All properties of sprintf() apply:
69
 
                      - if the number of significant digits after the decimal
70
 
                        point is less than precision, the resulting string is
71
 
                        right-padded with zeros
72
 
                      - if the precision is 0, no decimal point appears
73
 
                      - if a decimal point appears, at least one digit appears
74
 
                        before it
75
 
   @param to          pointer to the output buffer. The longest string which
76
 
                      my_fcvt() can return is FLOATING_POINT_BUFFER bytes
77
 
                      (including the terminating '\0').
78
 
   @param error       if not NULL, points to a location where the status of
79
 
                      conversion is stored upon return.
80
 
                      false  successful conversion
81
 
                      true   the input number is [-,+]infinity or nan.
82
 
                             The output string in this case is always '0'.
83
 
   @return            number of written characters (excluding terminating '\0')
84
 
*/
85
 
 
86
 
size_t my_fcvt(double x, int precision, char *to, bool *error)
87
 
{
88
 
  int decpt, sign, len, i;
89
 
  char *res, *src, *end, *dst= to;
90
 
  char buf[DTOA_BUFF_SIZE];
91
 
  assert(precision >= 0 && precision < NOT_FIXED_DEC && to != NULL);
92
 
  
93
 
  res= dtoa(x, 5, precision, &decpt, &sign, &end, buf, sizeof(buf));
94
 
 
95
 
  if (decpt == DTOA_OVERFLOW)
96
 
  {
97
 
    dtoa_free(res, buf, sizeof(buf));
98
 
    *to++= '0';
99
 
    *to= '\0';
100
 
    if (error != NULL)
101
 
      *error= true;
102
 
    return 1;
103
 
  }
104
 
 
105
 
  src= res;
106
 
  len= end - src;
107
 
 
108
 
  if (sign)
109
 
    *dst++= '-';
110
 
 
111
 
  if (decpt <= 0)
112
 
  {
113
 
    *dst++= '0';
114
 
    *dst++= '.';
115
 
    for (i= decpt; i < 0; i++)
116
 
      *dst++= '0';
117
 
  }
118
 
 
119
 
  for (i= 1; i <= len; i++)
120
 
  {
121
 
    *dst++= *src++;
122
 
    if (i == decpt && i < len)
123
 
      *dst++= '.';
124
 
  }
125
 
  while (i++ <= decpt)
126
 
    *dst++= '0';
127
 
 
128
 
  if (precision > 0)
129
 
  {
130
 
    if (len <= decpt)
131
 
      *dst++= '.';
132
 
    
133
 
    for (i= precision - cmax(0, (len - decpt)); i > 0; i--)
134
 
      *dst++= '0';
135
 
  }
136
 
  
137
 
  *dst= '\0';
138
 
  if (error != NULL)
139
 
    *error= false;
140
 
 
141
 
  dtoa_free(res, buf, sizeof(buf));
142
 
 
143
 
  return dst - to;
144
 
}
145
 
 
146
 
/**
147
 
   @brief
148
 
   Converts a given floating point number to a zero-terminated string
149
 
   representation with a given field width using the 'e' format
150
 
   (aka scientific notation) or the 'f' one.
151
 
 
152
 
   @details
153
 
   The format is chosen automatically to provide the most number of significant
154
 
   digits (and thus, precision) with a given field width. In many cases, the
155
 
   result is similar to that of sprintf(to, "%g", x) with a few notable
156
 
   differences:
157
 
   - the conversion is usually more precise than C library functions.
158
 
   - there is no 'precision' argument. instead, we specify the number of
159
 
     characters available for conversion (i.e. a field width).
160
 
   - the result never exceeds the specified field width. If the field is too
161
 
     short to contain even a rounded decimal representation, my_gcvt()
162
 
     indicates overflow and truncates the output string to the specified width.
163
 
   - float-type arguments are handled differently than double ones. For a
164
 
     float input number (i.e. when the 'type' argument is MY_GCVT_ARG_FLOAT)
165
 
     we deliberately limit the precision of conversion by FLT_DIG digits to
166
 
     avoid garbage past the significant digits.
167
 
   - unlike sprintf(), in cases where the 'e' format is preferred,  we don't
168
 
     zero-pad the exponent to save space for significant digits. The '+' sign
169
 
     for a positive exponent does not appear for the same reason.
170
 
 
171
 
   @param x           the input floating point number.
172
 
   @param type        is either MY_GCVT_ARG_FLOAT or MY_GCVT_ARG_DOUBLE.
173
 
                      Specifies the type of the input number (see notes above).
174
 
   @param width       field width in characters. The minimal field width to
175
 
                      hold any number representation (albeit rounded) is 7
176
 
                      characters ("-Ne-NNN").
177
 
   @param to          pointer to the output buffer. The result is always
178
 
                      zero-terminated, and the longest returned string is thus
179
 
                      'width + 1' bytes.
180
 
   @param error       if not NULL, points to a location where the status of
181
 
                      conversion is stored upon return.
182
 
                      false  successful conversion
183
 
                      true   the input number is [-,+]infinity or nan.
184
 
                             The output string in this case is always '0'.
185
 
   @return            number of written characters (excluding terminating '\0')
186
 
 
187
 
   @todo
188
 
   Check if it is possible and  makes sense to do our own rounding on top of
189
 
   dtoa() instead of calling dtoa() twice in (rare) cases when the resulting
190
 
   string representation does not fit in the specified field width and we want
191
 
   to re-round the input number with fewer significant digits. Examples:
192
 
 
193
 
     my_gcvt(-9e-3, ..., 4, ...);
194
 
     my_gcvt(-9e-3, ..., 2, ...);
195
 
     my_gcvt(1.87e-3, ..., 4, ...);
196
 
     my_gcvt(55, ..., 1, ...);
197
 
 
198
 
   We do our best to minimize such cases by:
199
 
   
200
 
   - passing to dtoa() the field width as the number of significant digits
201
 
   
202
 
   - removing the sign of the number early (and decreasing the width before
203
 
     passing it to dtoa())
204
 
   
205
 
   - choosing the proper format to preserve the most number of significant
206
 
     digits.
207
 
*/
208
 
 
209
 
size_t my_gcvt(double x, my_gcvt_arg_type type, int width, char *to,
210
 
               bool *error)
211
 
{
212
 
  int decpt, sign, len, exp_len;
213
 
  char *res, *src, *end, *dst= to, *dend= dst + width;
214
 
  char buf[DTOA_BUFF_SIZE];
215
 
  bool have_space, force_e_format;
216
 
  assert(width > 0 && to != NULL);
217
 
  
218
 
  /* We want to remove '-' from equations early */
219
 
  if (x < 0.)
220
 
    width--;
221
 
 
222
 
  res= dtoa(x, 4, type == MY_GCVT_ARG_DOUBLE ? width : cmin(width, FLT_DIG),
223
 
            &decpt, &sign, &end, buf, sizeof(buf));
224
 
  if (decpt == DTOA_OVERFLOW)
225
 
  {
226
 
    dtoa_free(res, buf, sizeof(buf));
227
 
    *to++= '0';
228
 
    *to= '\0';
229
 
    if (error != NULL)
230
 
      *error= true;
231
 
    return 1;
232
 
  }
233
 
 
234
 
  if (error != NULL)
235
 
    *error= false;
236
 
 
237
 
  src= res;
238
 
  len= end - res;
239
 
 
240
 
  /*
241
 
    Number of digits in the exponent from the 'e' conversion.
242
 
     The sign of the exponent is taken into account separetely, we don't need
243
 
     to count it here.
244
 
   */
245
 
  exp_len= 1 + (decpt >= 101 || decpt <= -99) + (decpt >= 11 || decpt <= -9);
246
 
  
247
 
  /*
248
 
     Do we have enough space for all digits in the 'f' format?
249
 
     Let 'len' be the number of significant digits returned by dtoa,
250
 
     and F be the length of the resulting decimal representation.
251
 
     Consider the following cases:
252
 
     1. decpt <= 0, i.e. we have "0.NNN" => F = len - decpt + 2
253
 
     2. 0 < decpt < len, i.e. we have "NNN.NNN" => F = len + 1
254
 
     3. len <= decpt, i.e. we have "NNN00" => F = decpt
255
 
  */
256
 
  have_space= (decpt <= 0 ? len - decpt + 2 :
257
 
               decpt > 0 && decpt < len ? len + 1 :
258
 
               decpt) <= width;
259
 
  /*
260
 
    The following is true when no significant digits can be placed with the
261
 
    specified field width using the 'f' format, and the 'e' format
262
 
    will not be truncated.
263
 
  */
264
 
  force_e_format= (decpt <= 0 && width <= 2 - decpt && width >= 3 + exp_len);
265
 
  /*
266
 
    Assume that we don't have enough space to place all significant digits in
267
 
    the 'f' format. We have to choose between the 'e' format and the 'f' one
268
 
    to keep as many significant digits as possible.
269
 
    Let E and F be the lengths of decimal representaion in the 'e' and 'f'
270
 
    formats, respectively. We want to use the 'f' format if, and only if F <= E.
271
 
    Consider the following cases:
272
 
    1. decpt <= 0.
273
 
       F = len - decpt + 2 (see above)
274
 
       E = len + (len > 1) + 1 + 1 (decpt <= -99) + (decpt <= -9) + 1
275
 
       ("N.NNe-MMM")
276
 
       (F <= E) <=> (len == 1 && decpt >= -1) || (len > 1 && decpt >= -2)
277
 
       We also need to ensure that if the 'f' format is chosen,
278
 
       the field width allows us to place at least one significant digit
279
 
       (i.e. width > 2 - decpt). If not, we prefer the 'e' format.
280
 
    2. 0 < decpt < len
281
 
       F = len + 1 (see above)
282
 
       E = len + 1 + 1 + ... ("N.NNeMMM")
283
 
       F is always less than E.
284
 
    3. len <= decpt <= width
285
 
       In this case we have enough space to represent the number in the 'f'
286
 
       format, so we prefer it with some exceptions.
287
 
    4. width < decpt
288
 
       The number cannot be represented in the 'f' format at all, always use
289
 
       the 'e' 'one.
290
 
  */
291
 
  if ((have_space ||
292
 
      /*
293
 
        Not enough space, let's see if the 'f' format provides the most number
294
 
        of significant digits.
295
 
      */
296
 
       ((decpt <= width && (decpt >= -1 || (decpt == -2 &&
297
 
                                            (len > 1 || !force_e_format)))) &&
298
 
         !force_e_format)) &&
299
 
      
300
 
       /*
301
 
         Use the 'e' format in some cases even if we have enough space for the
302
 
         'f' one. See comment for MAX_DECPT_FOR_F_FORMAT.
303
 
       */
304
 
      (!have_space || (decpt >= -MAX_DECPT_FOR_F_FORMAT + 1 &&
305
 
                       (decpt <= MAX_DECPT_FOR_F_FORMAT || len > decpt))))
306
 
  {
307
 
    /* 'f' format */
308
 
    int i;
309
 
 
310
 
    width-= (decpt < len) + (decpt <= 0 ? 1 - decpt : 0);
311
 
 
312
 
    /* Do we have to truncate any digits? */
313
 
    if (width < len)
314
 
    {
315
 
      if (width < decpt)
316
 
      {
317
 
        if (error != NULL)
318
 
          *error= true;
319
 
        width= decpt;
320
 
      }
321
 
      
322
 
      /*
323
 
        We want to truncate (len - width) least significant digits after the
324
 
        decimal point. For this we are calling dtoa with mode=5, passing the
325
 
        number of significant digits = (len-decpt) - (len-width) = width-decpt
326
 
      */
327
 
      dtoa_free(res, buf, sizeof(buf));
328
 
      res= dtoa(x, 5, width - decpt, &decpt, &sign, &end, buf, sizeof(buf));
329
 
      src= res;
330
 
      len= end - res;
331
 
    }
332
 
 
333
 
    if (len == 0)
334
 
    {
335
 
      /* Underflow. Just print '0' and exit */
336
 
      *dst++= '0';
337
 
      goto end;
338
 
    }
339
 
    
340
 
    /*
341
 
      At this point we are sure we have enough space to put all digits
342
 
      returned by dtoa
343
 
    */
344
 
    if (sign && dst < dend)
345
 
      *dst++= '-';
346
 
    if (decpt <= 0)
347
 
    {
348
 
      if (dst < dend)
349
 
        *dst++= '0';
350
 
      if (len > 0 && dst < dend)
351
 
        *dst++= '.';
352
 
      for (; decpt < 0 && dst < dend; decpt++)
353
 
        *dst++= '0';
354
 
    }
355
 
 
356
 
    for (i= 1; i <= len && dst < dend; i++)
357
 
    {
358
 
      *dst++= *src++;
359
 
      if (i == decpt && i < len && dst < dend)
360
 
        *dst++= '.';
361
 
    }
362
 
    while (i++ <= decpt && dst < dend)
363
 
      *dst++= '0';
364
 
  }
365
 
  else
366
 
  {
367
 
    /* 'e' format */
368
 
    int decpt_sign= 0;
369
 
 
370
 
    if (--decpt < 0)
371
 
    {
372
 
      decpt= -decpt;
373
 
      width--;
374
 
      decpt_sign= 1;
375
 
    }
376
 
    width-= 1 + exp_len; /* eNNN */
377
 
 
378
 
    if (len > 1)
379
 
      width--;
380
 
 
381
 
    if (width <= 0)
382
 
    {
383
 
      /* Overflow */
384
 
      if (error != NULL)
385
 
        *error= true;
386
 
      width= 0;
387
 
    }
388
 
      
389
 
    /* Do we have to truncate any digits? */
390
 
    if (width < len)
391
 
    {
392
 
      /* Yes, re-convert with a smaller width */
393
 
      dtoa_free(res, buf, sizeof(buf));
394
 
      res= dtoa(x, 4, width, &decpt, &sign, &end, buf, sizeof(buf));
395
 
      src= res;
396
 
      len= end - res;
397
 
      if (--decpt < 0)
398
 
        decpt= -decpt;
399
 
    }
400
 
    /*
401
 
      At this point we are sure we have enough space to put all digits
402
 
      returned by dtoa
403
 
    */
404
 
    if (sign && dst < dend)
405
 
      *dst++= '-';
406
 
    if (dst < dend)
407
 
      *dst++= *src++;
408
 
    if (len > 1 && dst < dend)
409
 
    {
410
 
      *dst++= '.';
411
 
      while (src < end && dst < dend)
412
 
        *dst++= *src++;
413
 
    }
414
 
    if (dst < dend)
415
 
      *dst++= 'e';
416
 
    if (decpt_sign && dst < dend)
417
 
      *dst++= '-';
418
 
 
419
 
    if (decpt >= 100 && dst < dend)
420
 
    {
421
 
      *dst++= decpt / 100 + '0';
422
 
      decpt%= 100;
423
 
      if (dst < dend)
424
 
        *dst++= decpt / 10 + '0';
425
 
    }
426
 
    else if (decpt >= 10 && dst < dend)
427
 
      *dst++= decpt / 10 + '0';
428
 
    if (dst < dend)
429
 
      *dst++= decpt % 10 + '0';
430
 
 
431
 
  }
432
 
 
433
 
end:
434
 
  dtoa_free(res, buf, sizeof(buf));
435
 
  *dst= '\0';
436
 
 
437
 
  return dst - to;
438
 
}
439
 
 
440
 
/**
441
 
   @brief
442
 
   Converts string to double (string does not have to be zero-terminated)
443
 
 
444
 
   @details
445
 
   This is a wrapper around dtoa's version of strtod().
446
 
 
447
 
   @param str     input string
448
 
   @param end     address of a pointer to the first character after the input
449
 
                  string. Upon return the pointer is set to point to the first
450
 
                  rejected character.
451
 
   @param error   Upon return is set to EOVERFLOW in case of underflow or
452
 
                  overflow.
453
 
   
454
 
   @return        The resulting double value. In case of underflow, 0.0 is
455
 
                  returned. In case overflow, signed DBL_MAX is returned.
456
 
*/
457
 
 
458
 
double my_strtod(const char *str, char **end, int *error)
459
 
{
460
 
  char buf[DTOA_BUFF_SIZE];
461
 
  double res;
462
 
  assert(str != NULL && end != NULL && *end != NULL && error != NULL);
463
 
 
464
 
  res= my_strtod_int(str, end, error, buf, sizeof(buf));
465
 
  return (*error == 0) ? res : (res < 0 ? -DBL_MAX : DBL_MAX);
466
 
}
467
 
 
468
 
 
469
 
double my_atof(const char *nptr)
470
 
{
471
 
  int error;
472
 
  const char *end= nptr+65535;                  /* Should be enough */
473
 
  return (my_strtod(nptr, (char**) &end, &error));
474
 
}
475
 
 
476
 
 
477
 
/****************************************************************
478
 
 *
479
 
 * The author of this software is David M. Gay.
480
 
 *
481
 
 * Copyright (c) 1991, 2000, 2001 by Lucent Technologies.
482
 
 *
483
 
 * Permission to use, copy, modify, and distribute this software for any
484
 
 * purpose without fee is hereby granted, provided that this entire notice
485
 
 * is included in all copies of any software which is or includes a copy
486
 
 * or modification of this software and in all copies of the supporting
487
 
 * documentation for such software.
488
 
 *
489
 
 * THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
490
 
 * WARRANTY.  IN PARTICULAR, NEITHER THE AUTHOR NOR LUCENT MAKES ANY
491
 
 * REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
492
 
 * OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
493
 
 *
494
 
 ***************************************************************/
495
 
/* Please send bug reports to David M. Gay (dmg at acm dot org,
496
 
 * with " at " changed at "@" and " dot " changed to ".").      */
497
 
 
498
 
/*
499
 
  Original copy of the software is located at http://www.netlib.org/fp/dtoa.c
500
 
  It was adjusted to serve MySQL server needs:
501
 
  * strtod() was modified to not expect a zero-terminated string.
502
 
    It now honors 'se' (end of string) argument as the input parameter,
503
 
    not just as the output one.
504
 
  * in dtoa(), in case of overflow/underflow/NaN result string now contains "0";
505
 
    decpt is set to DTOA_OVERFLOW to indicate overflow.
506
 
  * support for VAX, IBM mainframe and 16-bit hardware removed
507
 
  * we always assume that 64-bit integer type is available
508
 
  * support for Kernigan-Ritchie style headers (pre-ANSI compilers)
509
 
    removed
510
 
  * all gcc warnings ironed out
511
 
  * we always assume multithreaded environment, so we had to change
512
 
    memory allocation procedures to use stack in most cases;
513
 
    malloc is used as the last resort.
514
 
  * pow5mult rewritten to use pre-calculated pow5 list instead of
515
 
    the one generated on the fly.
516
 
*/
517
 
 
518
 
 
519
 
/*
520
 
  On a machine with IEEE extended-precision registers, it is
521
 
  necessary to specify double-precision (53-bit) rounding precision
522
 
  before invoking strtod or dtoa.  If the machine uses (the equivalent
523
 
  of) Intel 80x87 arithmetic, the call
524
 
       _control87(PC_53, MCW_PC);
525
 
  does this with many compilers.  Whether this or another call is
526
 
  appropriate depends on the compiler; for this to work, it may be
527
 
  necessary to #include "float.h" or another system-dependent header
528
 
  file.
529
 
*/
530
 
 
531
 
typedef int32_t Long;
532
 
typedef uint32_t ULong;
533
 
typedef int64_t LLong;
534
 
typedef uint64_t ULLong;
535
 
 
536
 
typedef union { double d; ULong L[2]; } U;
537
 
 
538
 
#if defined(WORDS_BIGENDIAN) || (defined(__FLOAT_WORD_ORDER) &&        \
539
 
                                 (__FLOAT_WORD_ORDER == __BIG_ENDIAN))
540
 
#define word0(x) ((U*)&x)->L[0]
541
 
#define word1(x) ((U*)&x)->L[1]
542
 
#else
543
 
#define word0(x) ((U*)&x)->L[1]
544
 
#define word1(x) ((U*)&x)->L[0]
545
 
#endif
546
 
 
547
 
#define dval(x) ((U*)&x)->d
548
 
 
549
 
/* #define P DBL_MANT_DIG */
550
 
/* Ten_pmax= floor(P*log(2)/log(5)) */
551
 
/* Bletch= (highest power of 2 < DBL_MAX_10_EXP) / 16 */
552
 
/* Quick_max= floor((P-1)*log(FLT_RADIX)/log(10) - 1) */
553
 
/* Int_max= floor(P*log(FLT_RADIX)/log(10) - 1) */
554
 
 
555
 
#define Exp_shift  20
556
 
#define Exp_shift1 20
557
 
#define Exp_msk1    0x100000
558
 
#define Exp_mask  0x7ff00000
559
 
#define P 53
560
 
#define Bias 1023
561
 
#define Emin (-1022)
562
 
#define Exp_1  0x3ff00000
563
 
#define Exp_11 0x3ff00000
564
 
#define Ebits 11
565
 
#define Frac_mask  0xfffff
566
 
#define Frac_mask1 0xfffff
567
 
#define Ten_pmax 22
568
 
#define Bletch 0x10
569
 
#define Bndry_mask  0xfffff
570
 
#define Bndry_mask1 0xfffff
571
 
#define LSB 1
572
 
#define Sign_bit 0x80000000
573
 
#define Log2P 1
574
 
#define Tiny1 1
575
 
#define Quick_max 14
576
 
#define Int_max 14
577
 
 
578
 
#ifndef Flt_Rounds
579
 
#ifdef FLT_ROUNDS
580
 
#define Flt_Rounds FLT_ROUNDS
581
 
#else
582
 
#define Flt_Rounds 1
583
 
#endif
584
 
#endif /*Flt_Rounds*/
585
 
 
586
 
#define rounded_product(a,b) a*= b
587
 
#define rounded_quotient(a,b) a/= b
588
 
 
589
 
#define Big0 (Frac_mask1 | Exp_msk1*(DBL_MAX_EXP+Bias-1))
590
 
#define Big1 0xffffffff
591
 
#define FFFFFFFF 0xffffffffUL
592
 
 
593
 
/* This is tested to be enough for dtoa */
594
 
 
595
 
#define Kmax 15
596
 
 
597
 
#define Bcopy(x,y) memcpy(&x->sign, &y->sign, \
598
 
                          2*sizeof(int) + y->wds*sizeof(ULong))
599
 
 
600
 
/* Arbitrary-length integer */
601
 
 
602
 
typedef struct Bigint
603
 
{
604
 
  union {
605
 
    ULong *x;              /* points right after this Bigint object */
606
 
    struct Bigint *next;   /* to maintain free lists */
607
 
  } p;
608
 
  int k;                   /* 2^k = maxwds */
609
 
  int maxwds;              /* maximum length in 32-bit words */
610
 
  int sign;                /* not zero if number is negative */
611
 
  int wds;                 /* current length in 32-bit words */
612
 
} Bigint;
613
 
 
614
 
 
615
 
/* A simple stack-memory based allocator for Bigints */
616
 
 
617
 
typedef struct Stack_alloc
618
 
{
619
 
  char *begin;
620
 
  char *free;
621
 
  char *end;
622
 
  /*
623
 
    Having list of free blocks lets us reduce maximum required amount
624
 
    of memory from ~4000 bytes to < 1680 (tested on x86).
625
 
  */
626
 
  Bigint *freelist[Kmax+1];
627
 
} Stack_alloc;
628
 
 
629
 
 
630
 
/*
631
 
  Try to allocate object on stack, and resort to malloc if all
632
 
  stack memory is used.
633
 
*/
634
 
 
635
 
static Bigint *Balloc(int k, Stack_alloc *alloc)
636
 
{
637
 
  Bigint *rv;
638
 
  if (k <= Kmax &&  alloc->freelist[k])
639
 
  {
640
 
    rv= alloc->freelist[k];
641
 
    alloc->freelist[k]= rv->p.next;
642
 
  }
643
 
  else
644
 
  {
645
 
    int x, len;
646
 
 
647
 
    x= 1 << k;
648
 
    len= sizeof(Bigint) + x * sizeof(ULong);
649
 
 
650
 
    if (alloc->free + len <= alloc->end)
651
 
    {
652
 
      rv= (Bigint*) alloc->free;
653
 
      alloc->free+= len;
654
 
    }
655
 
    else
656
 
      rv= (Bigint*) malloc(len);
657
 
 
658
 
    rv->k= k;
659
 
    rv->maxwds= x;
660
 
  }
661
 
  rv->sign= rv->wds= 0;
662
 
  rv->p.x= (ULong*) (rv + 1);
663
 
  return rv;
664
 
}
665
 
 
666
 
 
667
 
/*
668
 
  If object was allocated on stack, try putting it to the free
669
 
  list. Otherwise call free().
670
 
*/
671
 
 
672
 
static void Bfree(Bigint *v, Stack_alloc *alloc)
673
 
{
674
 
  char *gptr= (char*) v;                       /* generic pointer */
675
 
  if (gptr < alloc->begin || gptr >= alloc->end)
676
 
    free(gptr);
677
 
  else if (v->k <= Kmax)
678
 
  {
679
 
    /*
680
 
      Maintain free lists only for stack objects: this way we don't
681
 
      have to bother with freeing lists in the end of dtoa;
682
 
      heap should not be used normally anyway.
683
 
    */
684
 
    v->p.next= alloc->freelist[v->k];
685
 
    alloc->freelist[v->k]= v;
686
 
  }
687
 
}
688
 
 
689
 
 
690
 
/*
691
 
  This is to place return value of dtoa in: tries to use stack
692
 
  as well, but passes by free lists management and just aligns len by
693
 
  sizeof(ULong).
694
 
*/
695
 
 
696
 
static char *dtoa_alloc(int i, Stack_alloc *alloc)
697
 
{
698
 
  char *rv;
699
 
  int aligned_size= (i + sizeof(ULong) - 1) / sizeof(ULong) * sizeof(ULong);
700
 
  if (alloc->free + aligned_size <= alloc->end)
701
 
  {
702
 
    rv= alloc->free;
703
 
    alloc->free+= aligned_size;
704
 
  }
705
 
  else
706
 
    rv= malloc(i);
707
 
  return rv;
708
 
}
709
 
 
710
 
 
711
 
/*
712
 
  dtoa_free() must be used to free values s returned by dtoa()
713
 
  This is the counterpart of dtoa_alloc()
714
 
*/
715
 
 
716
 
static void dtoa_free(char *gptr, char *buf, size_t buf_size)
717
 
{
718
 
  if (gptr < buf || gptr >= buf + buf_size)
719
 
    free(gptr);
720
 
}
721
 
 
722
 
 
723
 
/* Bigint arithmetic functions */
724
 
 
725
 
/* Multiply by m and add a */
726
 
 
727
 
static Bigint *multadd(Bigint *b, int m, int a, Stack_alloc *alloc)
728
 
{
729
 
  int i, wds;
730
 
  ULong *x;
731
 
  ULLong carry, y;
732
 
  Bigint *b1;
733
 
 
734
 
  wds= b->wds;
735
 
  x= b->p.x;
736
 
  i= 0;
737
 
  carry= a;
738
 
  do
739
 
  {
740
 
    y= *x * (ULLong)m + carry;
741
 
    carry= y >> 32;
742
 
    *x++= (ULong)(y & FFFFFFFF);
743
 
  }
744
 
  while (++i < wds);
745
 
  if (carry)
746
 
  {
747
 
    if (wds >= b->maxwds)
748
 
    {
749
 
      b1= Balloc(b->k+1, alloc);
750
 
      Bcopy(b1, b);
751
 
      Bfree(b, alloc);
752
 
      b= b1;
753
 
    }
754
 
    b->p.x[wds++]= (ULong) carry;
755
 
    b->wds= wds;
756
 
  }
757
 
  return b;
758
 
}
759
 
 
760
 
 
761
 
static Bigint *s2b(const char *s, int nd0, int nd, ULong y9, Stack_alloc *alloc)
762
 
{
763
 
  Bigint *b;
764
 
  int i, k;
765
 
  Long x, y;
766
 
 
767
 
  x= (nd + 8) / 9;
768
 
  for (k= 0, y= 1; x > y; y <<= 1, k++) ;
769
 
  b= Balloc(k, alloc);
770
 
  b->p.x[0]= y9;
771
 
  b->wds= 1;
772
 
  
773
 
  i= 9;
774
 
  if (9 < nd0)
775
 
  {
776
 
    s+= 9;
777
 
    do
778
 
      b= multadd(b, 10, *s++ - '0', alloc);
779
 
    while (++i < nd0);
780
 
    s++;
781
 
  }
782
 
  else
783
 
    s+= 10;
784
 
  for(; i < nd; i++)
785
 
    b= multadd(b, 10, *s++ - '0', alloc);
786
 
  return b;
787
 
}
788
 
 
789
 
 
790
 
static int hi0bits(register ULong x)
791
 
{
792
 
  register int k= 0;
793
 
 
794
 
  if (!(x & 0xffff0000))
795
 
  {
796
 
    k= 16;
797
 
    x<<= 16;
798
 
  }
799
 
  if (!(x & 0xff000000))
800
 
  {
801
 
    k+= 8;
802
 
    x<<= 8;
803
 
  }
804
 
  if (!(x & 0xf0000000))
805
 
  {
806
 
    k+= 4;
807
 
    x<<= 4;
808
 
  }
809
 
  if (!(x & 0xc0000000))
810
 
  {
811
 
    k+= 2;
812
 
    x<<= 2;
813
 
  }
814
 
  if (!(x & 0x80000000))
815
 
  {
816
 
    k++;
817
 
    if (!(x & 0x40000000))
818
 
      return 32;
819
 
  }
820
 
  return k;
821
 
}
822
 
 
823
 
 
824
 
static int lo0bits(ULong *y)
825
 
{
826
 
  register int k;
827
 
  register ULong x= *y;
828
 
 
829
 
  if (x & 7)
830
 
  {
831
 
    if (x & 1)
832
 
      return 0;
833
 
    if (x & 2)
834
 
    {
835
 
      *y= x >> 1;
836
 
      return 1;
837
 
    }
838
 
    *y= x >> 2;
839
 
    return 2;
840
 
  }
841
 
  k= 0;
842
 
  if (!(x & 0xffff))
843
 
  {
844
 
    k= 16;
845
 
    x>>= 16;
846
 
  }
847
 
  if (!(x & 0xff))
848
 
  {
849
 
    k+= 8;
850
 
    x>>= 8;
851
 
  }
852
 
  if (!(x & 0xf))
853
 
  {
854
 
    k+= 4;
855
 
    x>>= 4;
856
 
  }
857
 
  if (!(x & 0x3))
858
 
  {
859
 
    k+= 2;
860
 
    x>>= 2;
861
 
  }
862
 
  if (!(x & 1))
863
 
  {
864
 
    k++;
865
 
    x>>= 1;
866
 
    if (!x)
867
 
      return 32;
868
 
  }
869
 
  *y= x;
870
 
  return k;
871
 
}
872
 
 
873
 
 
874
 
/* Convert integer to Bigint number */
875
 
 
876
 
static Bigint *i2b(int i, Stack_alloc *alloc)
877
 
{
878
 
  Bigint *b;
879
 
 
880
 
  b= Balloc(1, alloc);
881
 
  b->p.x[0]= i;
882
 
  b->wds= 1;
883
 
  return b;
884
 
}
885
 
 
886
 
 
887
 
/* Multiply two Bigint numbers */
888
 
 
889
 
static Bigint *mult(Bigint *a, Bigint *b, Stack_alloc *alloc)
890
 
{
891
 
  Bigint *c;
892
 
  int k, wa, wb, wc;
893
 
  ULong *x, *xa, *xae, *xb, *xbe, *xc, *xc0;
894
 
  ULong y;
895
 
  ULLong carry, z;
896
 
 
897
 
  if (a->wds < b->wds)
898
 
  {
899
 
    c= a;
900
 
    a= b;
901
 
    b= c;
902
 
  }
903
 
  k= a->k;
904
 
  wa= a->wds;
905
 
  wb= b->wds;
906
 
  wc= wa + wb;
907
 
  if (wc > a->maxwds)
908
 
    k++;
909
 
  c= Balloc(k, alloc);
910
 
  for (x= c->p.x, xa= x + wc; x < xa; x++)
911
 
    *x= 0;
912
 
  xa= a->p.x;
913
 
  xae= xa + wa;
914
 
  xb= b->p.x;
915
 
  xbe= xb + wb;
916
 
  xc0= c->p.x;
917
 
  for (; xb < xbe; xc0++)
918
 
  {
919
 
    if ((y= *xb++))
920
 
    {
921
 
      x= xa;
922
 
      xc= xc0;
923
 
      carry= 0;
924
 
      do
925
 
      {
926
 
        z= *x++ * (ULLong)y + *xc + carry;
927
 
        carry= z >> 32;
928
 
        *xc++= (ULong) (z & FFFFFFFF);
929
 
      }
930
 
      while (x < xae);
931
 
      *xc= (ULong) carry;
932
 
    }
933
 
  }
934
 
  for (xc0= c->p.x, xc= xc0 + wc; wc > 0 && !*--xc; --wc) ;
935
 
  c->wds= wc;
936
 
  return c;
937
 
}
938
 
 
939
 
 
940
 
/*
941
 
  Precalculated array of powers of 5: tested to be enough for
942
 
  vasting majority of dtoa_r cases.
943
 
*/
944
 
 
945
 
static ULong powers5[]=
946
 
{
947
 
  625UL,
948
 
 
949
 
  390625UL,
950
 
 
951
 
  2264035265UL, 35UL,
952
 
 
953
 
  2242703233UL, 762134875UL,  1262UL,
954
 
 
955
 
  3211403009UL, 1849224548UL, 3668416493UL, 3913284084UL, 1593091UL,
956
 
 
957
 
  781532673UL,  64985353UL,   253049085UL,  594863151UL,  3553621484UL,
958
 
  3288652808UL, 3167596762UL, 2788392729UL, 3911132675UL, 590UL,
959
 
 
960
 
  2553183233UL, 3201533787UL, 3638140786UL, 303378311UL, 1809731782UL,
961
 
  3477761648UL, 3583367183UL, 649228654UL, 2915460784UL, 487929380UL,
962
 
  1011012442UL, 1677677582UL, 3428152256UL, 1710878487UL, 1438394610UL,
963
 
  2161952759UL, 4100910556UL, 1608314830UL, 349175UL
964
 
};
965
 
 
966
 
 
967
 
static Bigint p5_a[]=
968
 
{
969
 
  /*  { x } - k - maxwds - sign - wds */
970
 
  { { powers5 }, 1, 1, 0, 1 },
971
 
  { { powers5 + 1 }, 1, 1, 0, 1 },
972
 
  { { powers5 + 2 }, 1, 2, 0, 2 },
973
 
  { { powers5 + 4 }, 2, 3, 0, 3 },
974
 
  { { powers5 + 7 }, 3, 5, 0, 5 },
975
 
  { { powers5 + 12 }, 4, 10, 0, 10 },
976
 
  { { powers5 + 22 }, 5, 19, 0, 19 }
977
 
};
978
 
 
979
 
#define P5A_MAX (sizeof(p5_a)/sizeof(*p5_a) - 1)
980
 
 
981
 
static Bigint *pow5mult(Bigint *b, int k, Stack_alloc *alloc)
982
 
{
983
 
  Bigint *b1, *p5, *p51;
984
 
  int i;
985
 
  static int p05[3]= { 5, 25, 125 };
986
 
 
987
 
  if ((i= k & 3))
988
 
    b= multadd(b, p05[i-1], 0, alloc);
989
 
 
990
 
  if (!(k>>= 2))
991
 
    return b;
992
 
  p5= p5_a;
993
 
  for (;;)
994
 
  {
995
 
    if (k & 1)
996
 
    {
997
 
      b1= mult(b, p5, alloc);
998
 
      Bfree(b, alloc);
999
 
      b= b1;
1000
 
    }
1001
 
    if (!(k>>= 1))
1002
 
      break;
1003
 
    /* Calculate next power of 5 */
1004
 
    if (p5 < p5_a + P5A_MAX)
1005
 
      ++p5;
1006
 
    else if (p5 == p5_a + P5A_MAX)
1007
 
      p5= mult(p5, p5, alloc);
1008
 
    else
1009
 
    {
1010
 
      p51= mult(p5, p5, alloc);
1011
 
      Bfree(p5, alloc);
1012
 
      p5= p51;
1013
 
    }
1014
 
  }
1015
 
  return b;
1016
 
}
1017
 
 
1018
 
 
1019
 
static Bigint *lshift(Bigint *b, int k, Stack_alloc *alloc)
1020
 
{
1021
 
  int i, k1, n, n1;
1022
 
  Bigint *b1;
1023
 
  ULong *x, *x1, *xe, z;
1024
 
 
1025
 
  n= k >> 5;
1026
 
  k1= b->k;
1027
 
  n1= n + b->wds + 1;
1028
 
  for (i= b->maxwds; n1 > i; i<<= 1)
1029
 
    k1++;
1030
 
  b1= Balloc(k1, alloc);
1031
 
  x1= b1->p.x;
1032
 
  for (i= 0; i < n; i++)
1033
 
    *x1++= 0;
1034
 
  x= b->p.x;
1035
 
  xe= x + b->wds;
1036
 
  if (k&= 0x1f)
1037
 
  {
1038
 
    k1= 32 - k;
1039
 
    z= 0;
1040
 
    do
1041
 
    {
1042
 
      *x1++= *x << k | z;
1043
 
      z= *x++ >> k1;
1044
 
    }
1045
 
    while (x < xe);
1046
 
    if ((*x1= z))
1047
 
      ++n1;
1048
 
  }
1049
 
  else
1050
 
    do
1051
 
      *x1++= *x++;
1052
 
    while (x < xe);
1053
 
  b1->wds= n1 - 1;
1054
 
  Bfree(b, alloc);
1055
 
  return b1;
1056
 
}
1057
 
 
1058
 
 
1059
 
static int cmp(Bigint *a, Bigint *b)
1060
 
{
1061
 
  ULong *xa, *xa0, *xb, *xb0;
1062
 
  int i, j;
1063
 
 
1064
 
  i= a->wds;
1065
 
  j= b->wds;
1066
 
  if (i-= j)
1067
 
    return i;
1068
 
  xa0= a->p.x;
1069
 
  xa= xa0 + j;
1070
 
  xb0= b->p.x;
1071
 
  xb= xb0 + j;
1072
 
  for (;;)
1073
 
  {
1074
 
    if (*--xa != *--xb)
1075
 
      return *xa < *xb ? -1 : 1;
1076
 
    if (xa <= xa0)
1077
 
      break;
1078
 
  }
1079
 
  return 0;
1080
 
}
1081
 
 
1082
 
 
1083
 
static Bigint *diff(Bigint *a, Bigint *b, Stack_alloc *alloc)
1084
 
{
1085
 
  Bigint *c;
1086
 
  int i, wa, wb;
1087
 
  ULong *xa, *xae, *xb, *xbe, *xc;
1088
 
  ULLong borrow, y;
1089
 
 
1090
 
  i= cmp(a,b);
1091
 
  if (!i)
1092
 
  {
1093
 
    c= Balloc(0, alloc);
1094
 
    c->wds= 1;
1095
 
    c->p.x[0]= 0;
1096
 
    return c;
1097
 
  }
1098
 
  if (i < 0)
1099
 
  {
1100
 
    c= a;
1101
 
    a= b;
1102
 
    b= c;
1103
 
    i= 1;
1104
 
  }
1105
 
  else
1106
 
    i= 0;
1107
 
  c= Balloc(a->k, alloc);
1108
 
  c->sign= i;
1109
 
  wa= a->wds;
1110
 
  xa= a->p.x;
1111
 
  xae= xa + wa;
1112
 
  wb= b->wds;
1113
 
  xb= b->p.x;
1114
 
  xbe= xb + wb;
1115
 
  xc= c->p.x;
1116
 
  borrow= 0;
1117
 
  do
1118
 
  {
1119
 
    y= (ULLong)*xa++ - *xb++ - borrow;
1120
 
    borrow= y >> 32 & (ULong)1;
1121
 
    *xc++= (ULong) (y & FFFFFFFF);
1122
 
  }
1123
 
  while (xb < xbe);
1124
 
  while (xa < xae)
1125
 
  {
1126
 
    y= *xa++ - borrow;
1127
 
    borrow= y >> 32 & (ULong)1;
1128
 
    *xc++= (ULong) (y & FFFFFFFF);
1129
 
  }
1130
 
  while (!*--xc)
1131
 
    wa--;
1132
 
  c->wds= wa;
1133
 
  return c;
1134
 
}
1135
 
 
1136
 
 
1137
 
static double ulp(double x)
1138
 
{
1139
 
  register Long L;
1140
 
  double a;
1141
 
 
1142
 
  L= (word0(x) & Exp_mask) - (P - 1)*Exp_msk1;
1143
 
  word0(a) = L;
1144
 
  word1(a) = 0;
1145
 
  return dval(a);
1146
 
}
1147
 
 
1148
 
 
1149
 
static double b2d(Bigint *a, int *e)
1150
 
{
1151
 
  ULong *xa, *xa0, w, y, z;
1152
 
  int k;
1153
 
  double d;
1154
 
#define d0 word0(d)
1155
 
#define d1 word1(d)
1156
 
 
1157
 
  xa0= a->p.x;
1158
 
  xa= xa0 + a->wds;
1159
 
  y= *--xa;
1160
 
  k= hi0bits(y);
1161
 
  *e= 32 - k;
1162
 
  if (k < Ebits)
1163
 
  {
1164
 
    d0= Exp_1 | y >> (Ebits - k);
1165
 
    w= xa > xa0 ? *--xa : 0;
1166
 
    d1= y << ((32-Ebits) + k) | w >> (Ebits - k);
1167
 
    goto ret_d;
1168
 
  }
1169
 
  z= xa > xa0 ? *--xa : 0;
1170
 
  if (k-= Ebits)
1171
 
  {
1172
 
    d0= Exp_1 | y << k | z >> (32 - k);
1173
 
    y= xa > xa0 ? *--xa : 0;
1174
 
    d1= z << k | y >> (32 - k);
1175
 
  }
1176
 
  else
1177
 
  {
1178
 
    d0= Exp_1 | y;
1179
 
    d1= z;
1180
 
  }
1181
 
 ret_d:
1182
 
#undef d0
1183
 
#undef d1
1184
 
  return dval(d);
1185
 
}
1186
 
 
1187
 
 
1188
 
static Bigint *d2b(double d, int *e, int *bits, Stack_alloc *alloc)
1189
 
{
1190
 
  Bigint *b;
1191
 
  int de, k;
1192
 
  ULong *x, y, z;
1193
 
  int i;
1194
 
#define d0 word0(d)
1195
 
#define d1 word1(d)
1196
 
 
1197
 
  b= Balloc(1, alloc);
1198
 
  x= b->p.x;
1199
 
 
1200
 
  z= d0 & Frac_mask;
1201
 
  d0 &= 0x7fffffff;       /* clear sign bit, which we ignore */
1202
 
  if ((de= (int)(d0 >> Exp_shift)))
1203
 
    z|= Exp_msk1;
1204
 
  if ((y= d1))
1205
 
  {
1206
 
    if ((k= lo0bits(&y)))
1207
 
    {
1208
 
      x[0]= y | z << (32 - k);
1209
 
      z>>= k;
1210
 
    }
1211
 
    else
1212
 
      x[0]= y;
1213
 
    i= b->wds= (x[1]= z) ? 2 : 1;
1214
 
  }
1215
 
  else
1216
 
  {
1217
 
    k= lo0bits(&z);
1218
 
    x[0]= z;
1219
 
    i= b->wds= 1;
1220
 
    k+= 32;
1221
 
  }
1222
 
  if (de)
1223
 
  {
1224
 
    *e= de - Bias - (P-1) + k;
1225
 
    *bits= P - k;
1226
 
  }
1227
 
  else
1228
 
  {
1229
 
    *e= de - Bias - (P-1) + 1 + k;
1230
 
    *bits= 32*i - hi0bits(x[i-1]);
1231
 
  }
1232
 
  return b;
1233
 
#undef d0
1234
 
#undef d1
1235
 
}
1236
 
 
1237
 
 
1238
 
static double ratio(Bigint *a, Bigint *b)
1239
 
{
1240
 
  double da, db;
1241
 
  int k, ka, kb;
1242
 
 
1243
 
  dval(da)= b2d(a, &ka);
1244
 
  dval(db)= b2d(b, &kb);
1245
 
  k= ka - kb + 32*(a->wds - b->wds);
1246
 
  if (k > 0)
1247
 
    word0(da)+= k*Exp_msk1;
1248
 
  else
1249
 
  {
1250
 
    k= -k;
1251
 
    word0(db)+= k*Exp_msk1;
1252
 
  }
1253
 
  return dval(da) / dval(db);
1254
 
}
1255
 
 
1256
 
static const double tens[] =
1257
 
{
1258
 
  1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9,
1259
 
  1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19,
1260
 
  1e20, 1e21, 1e22
1261
 
};
1262
 
 
1263
 
static const double bigtens[]= { 1e16, 1e32, 1e64, 1e128, 1e256 };
1264
 
static const double tinytens[]=
1265
 
{ 1e-16, 1e-32, 1e-64, 1e-128,
1266
 
  9007199254740992.*9007199254740992.e-256 /* = 2^106 * 1e-53 */
1267
 
};
1268
 
/*
1269
 
  The factor of 2^53 in tinytens[4] helps us avoid setting the underflow 
1270
 
  flag unnecessarily.  It leads to a song and dance at the end of strtod.
1271
 
*/
1272
 
#define Scale_Bit 0x10
1273
 
#define n_bigtens 5
1274
 
 
1275
 
/*
1276
 
  strtod for IEEE--arithmetic machines.
1277
 
 
1278
 
  This strtod returns a nearest machine number to the input decimal
1279
 
  string (or sets errno to EOVERFLOW). Ties are broken by the IEEE round-even
1280
 
  rule.
1281
 
 
1282
 
  Inspired loosely by William D. Clinger's paper "How to Read Floating
1283
 
  Point Numbers Accurately" [Proc. ACM SIGPLAN '90, pp. 92-101].
1284
 
 
1285
 
  Modifications:
1286
 
 
1287
 
   1. We only require IEEE (not IEEE double-extended).
1288
 
   2. We get by with floating-point arithmetic in a case that
1289
 
     Clinger missed -- when we're computing d * 10^n
1290
 
     for a small integer d and the integer n is not too
1291
 
     much larger than 22 (the maximum integer k for which
1292
 
     we can represent 10^k exactly), we may be able to
1293
 
     compute (d*10^k) * 10^(e-k) with just one roundoff.
1294
 
   3. Rather than a bit-at-a-time adjustment of the binary
1295
 
     result in the hard case, we use floating-point
1296
 
     arithmetic to determine the adjustment to within
1297
 
     one bit; only in really hard cases do we need to
1298
 
     compute a second residual.
1299
 
   4. Because of 3., we don't need a large table of powers of 10
1300
 
     for ten-to-e (just some small tables, e.g. of 10^k
1301
 
     for 0 <= k <= 22).
1302
 
*/
1303
 
 
1304
 
static double my_strtod_int(const char *s00, char **se, int *error, char *buf, size_t buf_size)
1305
 
{
1306
 
  int scale;
1307
 
  int bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, dsign,
1308
 
     e, e1, esign, i, j, k, nd, nd0, nf, nz, nz0, sign;
1309
 
  const char *s, *s0, *s1, *end = *se;
1310
 
  double aadj, aadj1, adj, rv, rv0;
1311
 
  Long L;
1312
 
  ULong y, z;
1313
 
  Bigint *bb= NULL, *bb1= NULL, *bd= NULL, *bd0= NULL, *bs= NULL, *delta= NULL;
1314
 
#ifdef SET_INEXACT
1315
 
  int inexact, oldinexact;
1316
 
#endif
1317
 
  Stack_alloc alloc;
1318
 
 
1319
 
  c= 0;
1320
 
  *error= 0;
1321
 
 
1322
 
  alloc.begin= alloc.free= buf;
1323
 
  alloc.end= buf + buf_size;
1324
 
  memset(alloc.freelist, 0, sizeof(alloc.freelist));
1325
 
 
1326
 
  sign= nz0= nz= 0;
1327
 
  dval(rv)= 0.;
1328
 
  for (s= s00; s < end; s++)
1329
 
    switch (*s) {
1330
 
    case '-':
1331
 
      sign= 1;
1332
 
      /* no break */
1333
 
    case '+':
1334
 
      s++;
1335
 
      goto break2;
1336
 
    case '\t':
1337
 
    case '\n':
1338
 
    case '\v':
1339
 
    case '\f':
1340
 
    case '\r':
1341
 
    case ' ':
1342
 
      continue;
1343
 
    default:
1344
 
      goto break2;
1345
 
    }
1346
 
 break2:
1347
 
  if (s >= end)
1348
 
    goto ret0;
1349
 
  
1350
 
  if (*s == '0')
1351
 
  {
1352
 
    nz0= 1;
1353
 
    while (++s < end && *s == '0') ;
1354
 
    if (s >= end)
1355
 
      goto ret;
1356
 
  }
1357
 
  s0= s;
1358
 
  y= z= 0;
1359
 
  for (nd= nf= 0; s < end && (c= *s) >= '0' && c <= '9'; nd++, s++)
1360
 
    if (nd < 9)
1361
 
      y= 10*y + c - '0';
1362
 
    else if (nd < 16)
1363
 
      z= 10*z + c - '0';
1364
 
  nd0= nd;
1365
 
  if (s < end - 1 && c == '.')
1366
 
  {
1367
 
    c= *++s;
1368
 
    if (!nd)
1369
 
    {
1370
 
      for (; s < end && c == '0'; c= *++s)
1371
 
        nz++;
1372
 
      if (s < end && c > '0' && c <= '9')
1373
 
      {
1374
 
        s0= s;
1375
 
        nf+= nz;
1376
 
        nz= 0;
1377
 
        goto have_dig;
1378
 
      }
1379
 
      goto dig_done;
1380
 
    }
1381
 
    for (; s < end && c >= '0' && c <= '9'; c = *++s)
1382
 
    {
1383
 
 have_dig:
1384
 
      nz++;
1385
 
      if (c-= '0')
1386
 
      {
1387
 
        nf+= nz;
1388
 
        for (i= 1; i < nz; i++)
1389
 
          if (nd++ < 9)
1390
 
            y*= 10;
1391
 
          else if (nd <= DBL_DIG + 1)
1392
 
            z*= 10;
1393
 
        if (nd++ < 9)
1394
 
          y= 10*y + c;
1395
 
        else if (nd <= DBL_DIG + 1)
1396
 
          z= 10*z + c;
1397
 
        nz= 0;
1398
 
      }
1399
 
    }
1400
 
  }
1401
 
 dig_done:
1402
 
  e= 0;
1403
 
  if (s < end && (c == 'e' || c == 'E'))
1404
 
  {
1405
 
    if (!nd && !nz && !nz0)
1406
 
      goto ret0;
1407
 
    s00= s;
1408
 
    esign= 0;
1409
 
    if (++s < end)
1410
 
      switch (c= *s) {
1411
 
      case '-':
1412
 
        esign= 1;
1413
 
      case '+':
1414
 
        c= *++s;
1415
 
      }
1416
 
    if (s < end && c >= '0' && c <= '9')
1417
 
    {
1418
 
      while (s < end && c == '0')
1419
 
        c= *++s;
1420
 
      if (s < end && c > '0' && c <= '9') {
1421
 
        L= c - '0';
1422
 
        s1= s;
1423
 
        while (++s < end && (c= *s) >= '0' && c <= '9')
1424
 
          L= 10*L + c - '0';
1425
 
        if (s - s1 > 8 || L > 19999)
1426
 
          /* Avoid confusion from exponents
1427
 
           * so large that e might overflow.
1428
 
           */
1429
 
          e= 19999; /* safe for 16 bit ints */
1430
 
        else
1431
 
          e= (int)L;
1432
 
        if (esign)
1433
 
          e= -e;
1434
 
      }
1435
 
      else
1436
 
        e= 0;
1437
 
    }
1438
 
    else
1439
 
      s= s00;
1440
 
  }
1441
 
  if (!nd)
1442
 
  {
1443
 
    if (!nz && !nz0)
1444
 
    {
1445
 
 ret0:
1446
 
      s= s00;
1447
 
      sign= 0;
1448
 
    }
1449
 
    goto ret;
1450
 
  }
1451
 
  e1= e -= nf;
1452
 
 
1453
 
  /*
1454
 
    Now we have nd0 digits, starting at s0, followed by a
1455
 
    decimal point, followed by nd-nd0 digits.  The number we're
1456
 
    after is the integer represented by those digits times
1457
 
    10**e
1458
 
   */
1459
 
 
1460
 
  if (!nd0)
1461
 
    nd0= nd;
1462
 
  k= nd < DBL_DIG + 1 ? nd : DBL_DIG + 1;
1463
 
  dval(rv)= y;
1464
 
  if (k > 9)
1465
 
  {
1466
 
#ifdef SET_INEXACT
1467
 
    if (k > DBL_DIG)
1468
 
      oldinexact = get_inexact();
1469
 
#endif
1470
 
    dval(rv)= tens[k - 9] * dval(rv) + z;
1471
 
  }
1472
 
  bd0= 0;
1473
 
  if (nd <= DBL_DIG
1474
 
      )
1475
 
  {
1476
 
    if (!e)
1477
 
      goto ret;
1478
 
    if (e > 0)
1479
 
    {
1480
 
      if (e <= Ten_pmax)
1481
 
      {
1482
 
        /* rv = */ rounded_product(dval(rv), tens[e]);
1483
 
        goto ret;
1484
 
      }
1485
 
      i= DBL_DIG - nd;
1486
 
      if (e <= Ten_pmax + i)
1487
 
      {
1488
 
        /*
1489
 
          A fancier test would sometimes let us do
1490
 
          this for larger i values.
1491
 
        */
1492
 
        e-= i;
1493
 
        dval(rv)*= tens[i];
1494
 
        /* rv = */ rounded_product(dval(rv), tens[e]);
1495
 
        goto ret;
1496
 
      }
1497
 
    }
1498
 
#ifndef Inaccurate_Divide
1499
 
    else if (e >= -Ten_pmax)
1500
 
    {
1501
 
      /* rv = */ rounded_quotient(dval(rv), tens[-e]);
1502
 
      goto ret;
1503
 
    }
1504
 
#endif
1505
 
  }
1506
 
  e1+= nd - k;
1507
 
 
1508
 
#ifdef SET_INEXACT
1509
 
  inexact= 1;
1510
 
  if (k <= DBL_DIG)
1511
 
    oldinexact= get_inexact();
1512
 
#endif
1513
 
  scale= 0;
1514
 
 
1515
 
  /* Get starting approximation = rv * 10**e1 */
1516
 
 
1517
 
  if (e1 > 0)
1518
 
  {
1519
 
    if ((i= e1 & 15))
1520
 
      dval(rv)*= tens[i];
1521
 
    if (e1&= ~15)
1522
 
    {
1523
 
      if (e1 > DBL_MAX_10_EXP)
1524
 
      {
1525
 
 ovfl:
1526
 
        *error= EOVERFLOW;
1527
 
        /* Can't trust HUGE_VAL */
1528
 
        word0(rv)= Exp_mask;
1529
 
        word1(rv)= 0;
1530
 
#ifdef SET_INEXACT
1531
 
        /* set overflow bit */
1532
 
        dval(rv0)= 1e300;
1533
 
        dval(rv0)*= dval(rv0);
1534
 
#endif
1535
 
        if (bd0)
1536
 
          goto retfree;
1537
 
        goto ret;
1538
 
      }
1539
 
      e1>>= 4;
1540
 
      for(j= 0; e1 > 1; j++, e1>>= 1)
1541
 
        if (e1 & 1)
1542
 
          dval(rv)*= bigtens[j];
1543
 
    /* The last multiplication could overflow. */
1544
 
      word0(rv)-= P*Exp_msk1;
1545
 
      dval(rv)*= bigtens[j];
1546
 
      if ((z= word0(rv) & Exp_mask) > Exp_msk1 * (DBL_MAX_EXP + Bias - P))
1547
 
        goto ovfl;
1548
 
      if (z > Exp_msk1 * (DBL_MAX_EXP + Bias - 1 - P))
1549
 
      {
1550
 
        /* set to largest number (Can't trust DBL_MAX) */
1551
 
        word0(rv)= Big0;
1552
 
        word1(rv)= Big1;
1553
 
      }
1554
 
      else
1555
 
        word0(rv)+= P*Exp_msk1;
1556
 
    }
1557
 
  }
1558
 
  else if (e1 < 0)
1559
 
  {
1560
 
    e1= -e1;
1561
 
    if ((i= e1 & 15))
1562
 
      dval(rv)/= tens[i];
1563
 
    if ((e1>>= 4))
1564
 
    {
1565
 
      if (e1 >= 1 << n_bigtens)
1566
 
        goto undfl;
1567
 
      if (e1 & Scale_Bit)
1568
 
        scale= 2 * P;
1569
 
      for(j= 0; e1 > 0; j++, e1>>= 1)
1570
 
        if (e1 & 1)
1571
 
          dval(rv)*= tinytens[j];
1572
 
      if (scale && (j = 2 * P + 1 - ((word0(rv) & Exp_mask) >> Exp_shift)) > 0)
1573
 
      {
1574
 
        /* scaled rv is denormal; zap j low bits */
1575
 
        if (j >= 32)
1576
 
        {
1577
 
          word1(rv)= 0;
1578
 
          if (j >= 53)
1579
 
            word0(rv)= (P + 2) * Exp_msk1;
1580
 
          else
1581
 
            word0(rv)&= 0xffffffff << (j - 32);
1582
 
        }
1583
 
        else
1584
 
          word1(rv)&= 0xffffffff << j;
1585
 
      }
1586
 
      if (!dval(rv))
1587
 
      {
1588
 
 undfl:
1589
 
          dval(rv)= 0.;
1590
 
          if (bd0)
1591
 
            goto retfree;
1592
 
          goto ret;
1593
 
      }
1594
 
    }
1595
 
  }
1596
 
 
1597
 
  /* Now the hard part -- adjusting rv to the correct value.*/
1598
 
 
1599
 
  /* Put digits into bd: true value = bd * 10^e */
1600
 
 
1601
 
  bd0= s2b(s0, nd0, nd, y, &alloc);
1602
 
 
1603
 
  for(;;)
1604
 
  {
1605
 
    bd= Balloc(bd0->k, &alloc);
1606
 
    Bcopy(bd, bd0);
1607
 
    bb= d2b(dval(rv), &bbe, &bbbits, &alloc);  /* rv = bb * 2^bbe */
1608
 
    bs= i2b(1, &alloc);
1609
 
 
1610
 
    if (e >= 0)
1611
 
    {
1612
 
      bb2= bb5= 0;
1613
 
      bd2= bd5= e;
1614
 
    }
1615
 
    else
1616
 
    {
1617
 
      bb2= bb5= -e;
1618
 
      bd2= bd5= 0;
1619
 
    }
1620
 
    if (bbe >= 0)
1621
 
      bb2+= bbe;
1622
 
    else
1623
 
      bd2-= bbe;
1624
 
    bs2= bb2;
1625
 
    j= bbe - scale;
1626
 
    i= j + bbbits - 1;  /* logb(rv) */
1627
 
    if (i < Emin)  /* denormal */
1628
 
      j+= P - Emin;
1629
 
    else
1630
 
      j= P + 1 - bbbits;
1631
 
    bb2+= j;
1632
 
    bd2+= j;
1633
 
    bd2+= scale;
1634
 
    i= bb2 < bd2 ? bb2 : bd2;
1635
 
    if (i > bs2)
1636
 
      i= bs2;
1637
 
    if (i > 0)
1638
 
    {
1639
 
      bb2-= i;
1640
 
      bd2-= i;
1641
 
      bs2-= i;
1642
 
    }
1643
 
    if (bb5 > 0)
1644
 
    {
1645
 
      bs= pow5mult(bs, bb5, &alloc);
1646
 
      bb1= mult(bs, bb, &alloc);
1647
 
      Bfree(bb, &alloc);
1648
 
      bb= bb1;
1649
 
    }
1650
 
    if (bb2 > 0)
1651
 
      bb= lshift(bb, bb2, &alloc);
1652
 
    if (bd5 > 0)
1653
 
      bd= pow5mult(bd, bd5, &alloc);
1654
 
    if (bd2 > 0)
1655
 
      bd= lshift(bd, bd2, &alloc);
1656
 
    if (bs2 > 0)
1657
 
      bs= lshift(bs, bs2, &alloc);
1658
 
    delta= diff(bb, bd, &alloc);
1659
 
    dsign= delta->sign;
1660
 
    delta->sign= 0;
1661
 
    i= cmp(delta, bs);
1662
 
 
1663
 
    if (i < 0)
1664
 
    {
1665
 
      /*
1666
 
        Error is less than half an ulp -- check for special case of mantissa
1667
 
        a power of two.
1668
 
      */
1669
 
      if (dsign || word1(rv) || word0(rv) & Bndry_mask ||
1670
 
          (word0(rv) & Exp_mask) <= (2 * P + 1) * Exp_msk1)
1671
 
      {
1672
 
#ifdef SET_INEXACT
1673
 
        if (!delta->x[0] && delta->wds <= 1)
1674
 
          inexact= 0;
1675
 
#endif
1676
 
        break;
1677
 
      }
1678
 
      if (!delta->p.x[0] && delta->wds <= 1)
1679
 
      {
1680
 
        /* exact result */
1681
 
#ifdef SET_INEXACT
1682
 
        inexact= 0;
1683
 
#endif
1684
 
        break;
1685
 
      }
1686
 
      delta= lshift(delta, Log2P, &alloc);
1687
 
      if (cmp(delta, bs) > 0)
1688
 
        goto drop_down;
1689
 
      break;
1690
 
    }
1691
 
    if (i == 0)
1692
 
    {
1693
 
      /* exactly half-way between */
1694
 
      if (dsign)
1695
 
      {
1696
 
        if ((word0(rv) & Bndry_mask1) == Bndry_mask1 &&
1697
 
            word1(rv) ==
1698
 
            ((scale && (y = word0(rv) & Exp_mask) <= 2 * P * Exp_msk1) ?
1699
 
             (0xffffffff & (0xffffffff << (2*P+1-(y>>Exp_shift)))) :
1700
 
             0xffffffff))
1701
 
        {
1702
 
          /*boundary case -- increment exponent*/
1703
 
          word0(rv)= (word0(rv) & Exp_mask) + Exp_msk1;
1704
 
          word1(rv) = 0;
1705
 
          dsign = 0;
1706
 
          break;
1707
 
        }
1708
 
      }
1709
 
      else if (!(word0(rv) & Bndry_mask) && !word1(rv))
1710
 
      {
1711
 
 drop_down:
1712
 
        /* boundary case -- decrement exponent */
1713
 
        if (scale)
1714
 
        {
1715
 
          L= word0(rv) & Exp_mask;
1716
 
          if (L <= (2 *P + 1) * Exp_msk1)
1717
 
          {
1718
 
            if (L > (P + 2) * Exp_msk1)
1719
 
              /* round even ==> accept rv */
1720
 
              break;
1721
 
            /* rv = smallest denormal */
1722
 
            goto undfl;
1723
 
          }
1724
 
        }
1725
 
        L= (word0(rv) & Exp_mask) - Exp_msk1;
1726
 
        word0(rv)= L | Bndry_mask1;
1727
 
        word1(rv)= 0xffffffff;
1728
 
        break;
1729
 
      }
1730
 
      if (!(word1(rv) & LSB))
1731
 
        break;
1732
 
      if (dsign)
1733
 
        dval(rv)+= ulp(dval(rv));
1734
 
      else
1735
 
      {
1736
 
        dval(rv)-= ulp(dval(rv));
1737
 
        if (!dval(rv))
1738
 
          goto undfl;
1739
 
      }
1740
 
      dsign= 1 - dsign;
1741
 
      break;
1742
 
    }
1743
 
    if ((aadj= ratio(delta, bs)) <= 2.)
1744
 
    {
1745
 
      if (dsign)
1746
 
        aadj= aadj1= 1.;
1747
 
      else if (word1(rv) || word0(rv) & Bndry_mask)
1748
 
      {
1749
 
        if (word1(rv) == Tiny1 && !word0(rv))
1750
 
          goto undfl;
1751
 
        aadj= 1.;
1752
 
        aadj1= -1.;
1753
 
      }
1754
 
      else
1755
 
      {
1756
 
        /* special case -- power of FLT_RADIX to be rounded down... */
1757
 
        if (aadj < 2. / FLT_RADIX)
1758
 
          aadj= 1. / FLT_RADIX;
1759
 
        else
1760
 
          aadj*= 0.5;
1761
 
        aadj1= -aadj;
1762
 
      }
1763
 
    }
1764
 
    else
1765
 
    {
1766
 
      aadj*= 0.5;
1767
 
      aadj1= dsign ? aadj : -aadj;
1768
 
      if (Flt_Rounds == 0)
1769
 
        aadj1+= 0.5;
1770
 
    }
1771
 
    y= word0(rv) & Exp_mask;
1772
 
 
1773
 
    /* Check for overflow */
1774
 
 
1775
 
    if (y == Exp_msk1 * (DBL_MAX_EXP + Bias - 1))
1776
 
    {
1777
 
      dval(rv0)= dval(rv);
1778
 
      word0(rv)-= P * Exp_msk1;
1779
 
      adj= aadj1 * ulp(dval(rv));
1780
 
      dval(rv)+= adj;
1781
 
      if ((word0(rv) & Exp_mask) >= Exp_msk1 * (DBL_MAX_EXP + Bias - P))
1782
 
      {
1783
 
        if (word0(rv0) == Big0 && word1(rv0) == Big1)
1784
 
          goto ovfl;
1785
 
        word0(rv)= Big0;
1786
 
        word1(rv)= Big1;
1787
 
        goto cont;
1788
 
      }
1789
 
      else
1790
 
        word0(rv)+= P * Exp_msk1;
1791
 
    }
1792
 
    else
1793
 
    {
1794
 
      if (scale && y <= 2 * P * Exp_msk1)
1795
 
      {
1796
 
        if (aadj <= 0x7fffffff)
1797
 
        {
1798
 
          if ((z= (ULong) aadj) <= 0)
1799
 
            z= 1;
1800
 
          aadj= z;
1801
 
          aadj1= dsign ? aadj : -aadj;
1802
 
        }
1803
 
        word0(aadj1)+= (2 * P + 1) * Exp_msk1 - y;
1804
 
      }
1805
 
      adj = aadj1 * ulp(dval(rv));
1806
 
      dval(rv) += adj;
1807
 
    }
1808
 
    z= word0(rv) & Exp_mask;
1809
 
#ifndef SET_INEXACT
1810
 
    if (!scale)
1811
 
      if (y == z)
1812
 
      {
1813
 
        /* Can we stop now? */
1814
 
        L= (Long)aadj;
1815
 
        aadj-= L;
1816
 
        /* The tolerances below are conservative. */
1817
 
        if (dsign || word1(rv) || word0(rv) & Bndry_mask)
1818
 
        {
1819
 
          if (aadj < .4999999 || aadj > .5000001)
1820
 
            break;
1821
 
        }
1822
 
        else if (aadj < .4999999 / FLT_RADIX)
1823
 
          break;
1824
 
      }
1825
 
#endif
1826
 
 cont:
1827
 
    Bfree(bb, &alloc);
1828
 
    Bfree(bd, &alloc);
1829
 
    Bfree(bs, &alloc);
1830
 
    Bfree(delta, &alloc);
1831
 
  }
1832
 
#ifdef SET_INEXACT
1833
 
  if (inexact)
1834
 
  {
1835
 
    if (!oldinexact)
1836
 
    {
1837
 
      word0(rv0)= Exp_1 + (70 << Exp_shift);
1838
 
      word1(rv0)= 0;
1839
 
      dval(rv0)+= 1.;
1840
 
    }
1841
 
  }
1842
 
  else if (!oldinexact)
1843
 
    clear_inexact();
1844
 
#endif
1845
 
  if (scale)
1846
 
  {
1847
 
    word0(rv0)= Exp_1 - 2 * P * Exp_msk1;
1848
 
    word1(rv0)= 0;
1849
 
    dval(rv)*= dval(rv0);
1850
 
  }
1851
 
#ifdef SET_INEXACT
1852
 
  if (inexact && !(word0(rv) & Exp_mask))
1853
 
  {
1854
 
    /* set underflow bit */
1855
 
    dval(rv0)= 1e-300;
1856
 
    dval(rv0)*= dval(rv0);
1857
 
  }
1858
 
#endif
1859
 
 retfree:
1860
 
  Bfree(bb, &alloc);
1861
 
  Bfree(bd, &alloc);
1862
 
  Bfree(bs, &alloc);
1863
 
  Bfree(bd0, &alloc);
1864
 
  Bfree(delta, &alloc);
1865
 
 ret:
1866
 
  *se= (char *)s;
1867
 
  return sign ? -dval(rv) : dval(rv);
1868
 
}
1869
 
 
1870
 
 
1871
 
static int quorem(Bigint *b, Bigint *S)
1872
 
{
1873
 
  int n;
1874
 
  ULong *bx, *bxe, q, *sx, *sxe;
1875
 
  ULLong borrow, carry, y, ys;
1876
 
 
1877
 
  n= S->wds;
1878
 
  if (b->wds < n)
1879
 
    return 0;
1880
 
  sx= S->p.x;
1881
 
  sxe= sx + --n;
1882
 
  bx= b->p.x;
1883
 
  bxe= bx + n;
1884
 
  q= *bxe / (*sxe + 1);  /* ensure q <= true quotient */
1885
 
  if (q)
1886
 
  {
1887
 
    borrow= 0;
1888
 
    carry= 0;
1889
 
    do
1890
 
    {
1891
 
      ys= *sx++ * (ULLong)q + carry;
1892
 
      carry= ys >> 32;
1893
 
      y= *bx - (ys & FFFFFFFF) - borrow;
1894
 
      borrow= y >> 32 & (ULong)1;
1895
 
      *bx++= (ULong) (y & FFFFFFFF);
1896
 
    }
1897
 
    while (sx <= sxe);
1898
 
    if (!*bxe)
1899
 
    {
1900
 
      bx= b->p.x;
1901
 
      while (--bxe > bx && !*bxe)
1902
 
        --n;
1903
 
      b->wds= n;
1904
 
    }
1905
 
  }
1906
 
  if (cmp(b, S) >= 0)
1907
 
  {
1908
 
    q++;
1909
 
    borrow= 0;
1910
 
    carry= 0;
1911
 
    bx= b->p.x;
1912
 
    sx= S->p.x;
1913
 
    do
1914
 
    {
1915
 
      ys= *sx++ + carry;
1916
 
      carry= ys >> 32;
1917
 
      y= *bx - (ys & FFFFFFFF) - borrow;
1918
 
      borrow= y >> 32 & (ULong)1;
1919
 
      *bx++= (ULong) (y & FFFFFFFF);
1920
 
    }
1921
 
    while (sx <= sxe);
1922
 
    bx= b->p.x;
1923
 
    bxe= bx + n;
1924
 
    if (!*bxe)
1925
 
    {
1926
 
      while (--bxe > bx && !*bxe)
1927
 
        --n;
1928
 
      b->wds= n;
1929
 
    }
1930
 
  }
1931
 
  return q;
1932
 
}
1933
 
 
1934
 
 
1935
 
/*
1936
 
   dtoa for IEEE arithmetic (dmg): convert double to ASCII string.
1937
 
 
1938
 
   Inspired by "How to Print Floating-Point Numbers Accurately" by
1939
 
   Guy L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90, pp. 112-126].
1940
 
 
1941
 
   Modifications:
1942
 
        1. Rather than iterating, we use a simple numeric overestimate
1943
 
           to determine k= floor(log10(d)).  We scale relevant
1944
 
           quantities using O(log2(k)) rather than O(k) multiplications.
1945
 
        2. For some modes > 2 (corresponding to ecvt and fcvt), we don't
1946
 
           try to generate digits strictly left to right.  Instead, we
1947
 
           compute with fewer bits and propagate the carry if necessary
1948
 
           when rounding the final digit up.  This is often faster.
1949
 
        3. Under the assumption that input will be rounded nearest,
1950
 
           mode 0 renders 1e23 as 1e23 rather than 9.999999999999999e22.
1951
 
           That is, we allow equality in stopping tests when the
1952
 
           round-nearest rule will give the same floating-point value
1953
 
           as would satisfaction of the stopping test with strict
1954
 
           inequality.
1955
 
        4. We remove common factors of powers of 2 from relevant
1956
 
           quantities.
1957
 
        5. When converting floating-point integers less than 1e16,
1958
 
           we use floating-point arithmetic rather than resorting
1959
 
           to multiple-precision integers.
1960
 
        6. When asked to produce fewer than 15 digits, we first try
1961
 
           to get by with floating-point arithmetic; we resort to
1962
 
           multiple-precision integer arithmetic only if we cannot
1963
 
           guarantee that the floating-point calculation has given
1964
 
           the correctly rounded result.  For k requested digits and
1965
 
           "uniformly" distributed input, the probability is
1966
 
           something like 10^(k-15) that we must resort to the Long
1967
 
           calculation.
1968
 
 */
1969
 
 
1970
 
static char *dtoa(double d, int mode, int ndigits, int *decpt, int *sign,
1971
 
                  char **rve, char *buf, size_t buf_size)
1972
 
{
1973
 
  /*
1974
 
    Arguments ndigits, decpt, sign are similar to those
1975
 
    of ecvt and fcvt; trailing zeros are suppressed from
1976
 
    the returned string.  If not null, *rve is set to point
1977
 
    to the end of the return value.  If d is +-Infinity or NaN,
1978
 
    then *decpt is set to DTOA_OVERFLOW.
1979
 
 
1980
 
    mode:
1981
 
          0 ==> shortest string that yields d when read in
1982
 
                and rounded to nearest.
1983
 
          1 ==> like 0, but with Steele & White stopping rule;
1984
 
                e.g. with IEEE P754 arithmetic , mode 0 gives
1985
 
                1e23 whereas mode 1 gives 9.999999999999999e22.
1986
 
          2 ==> cmax(1,ndigits) significant digits.  This gives a
1987
 
                return value similar to that of ecvt, except
1988
 
                that trailing zeros are suppressed.
1989
 
          3 ==> through ndigits past the decimal point.  This
1990
 
                gives a return value similar to that from fcvt,
1991
 
                except that trailing zeros are suppressed, and
1992
 
                ndigits can be negative.
1993
 
          4,5 ==> similar to 2 and 3, respectively, but (in
1994
 
                round-nearest mode) with the tests of mode 0 to
1995
 
                possibly return a shorter string that rounds to d.
1996
 
          6-9 ==> Debugging modes similar to mode - 4:  don't try
1997
 
                fast floating-point estimate (if applicable).
1998
 
 
1999
 
      Values of mode other than 0-9 are treated as mode 0.
2000
 
 
2001
 
    Sufficient space is allocated to the return value
2002
 
    to hold the suppressed trailing zeros.
2003
 
  */
2004
 
 
2005
 
  int bbits, b2, b5, be, dig, i, ieps, ilim=0, ilim0, ilim1= 0,
2006
 
    j, j1, k, k0, k_check, leftright, m2, m5, s2, s5,
2007
 
    spec_case, try_quick;
2008
 
  Long L;
2009
 
  int denorm;
2010
 
  ULong x;
2011
 
  Bigint *b, *b1, *delta, *mlo = NULL, *mhi, *S;
2012
 
  double d2, ds, eps;
2013
 
  char *s, *s0;
2014
 
  Stack_alloc alloc;
2015
 
  
2016
 
  alloc.begin= alloc.free= buf;
2017
 
  alloc.end= buf + buf_size;
2018
 
  memset(alloc.freelist, 0, sizeof(alloc.freelist));
2019
 
 
2020
 
  if (word0(d) & Sign_bit)
2021
 
  {
2022
 
    /* set sign for everything, including 0's and NaNs */
2023
 
    *sign= 1;
2024
 
    word0(d) &= ~Sign_bit;  /* clear sign bit */
2025
 
  }
2026
 
  else
2027
 
    *sign= 0;
2028
 
 
2029
 
  /* If infinity, set decpt to DTOA_OVERFLOW, if 0 set it to 1 */
2030
 
  if (((word0(d) & Exp_mask) == Exp_mask && (*decpt= DTOA_OVERFLOW)) ||
2031
 
      (!dval(d) && (*decpt= 1)))
2032
 
  {
2033
 
    /* Infinity, NaN, 0 */
2034
 
    char *res= (char*) dtoa_alloc(2, &alloc);
2035
 
    res[0]= '0';
2036
 
    res[1]= '\0';
2037
 
    if (rve)
2038
 
      *rve= res + 1;
2039
 
    return res;
2040
 
  }
2041
 
  
2042
 
 
2043
 
  b= d2b(dval(d), &be, &bbits, &alloc);
2044
 
  if ((i= (int)(word0(d) >> Exp_shift1 & (Exp_mask>>Exp_shift1))))
2045
 
  {
2046
 
    dval(d2)= dval(d);
2047
 
    word0(d2) &= Frac_mask1;
2048
 
    word0(d2) |= Exp_11;
2049
 
 
2050
 
    /*
2051
 
      log(x)       ~=~ log(1.5) + (x-1.5)/1.5
2052
 
      log10(x)      =  log(x) / log(10)
2053
 
                   ~=~ log(1.5)/log(10) + (x-1.5)/(1.5*log(10))
2054
 
      log10(d)= (i-Bias)*log(2)/log(10) + log10(d2)
2055
 
     
2056
 
      This suggests computing an approximation k to log10(d) by
2057
 
     
2058
 
      k= (i - Bias)*0.301029995663981
2059
 
           + ( (d2-1.5)*0.289529654602168 + 0.176091259055681 );
2060
 
     
2061
 
      We want k to be too large rather than too small.
2062
 
      The error in the first-order Taylor series approximation
2063
 
      is in our favor, so we just round up the constant enough
2064
 
      to compensate for any error in the multiplication of
2065
 
      (i - Bias) by 0.301029995663981; since |i - Bias| <= 1077,
2066
 
      and 1077 * 0.30103 * 2^-52 ~=~ 7.2e-14,
2067
 
      adding 1e-13 to the constant term more than suffices.
2068
 
      Hence we adjust the constant term to 0.1760912590558.
2069
 
      (We could get a more accurate k by invoking log10,
2070
 
       but this is probably not worthwhile.)
2071
 
    */
2072
 
 
2073
 
    i-= Bias;
2074
 
    denorm= 0;
2075
 
  }
2076
 
  else
2077
 
  {
2078
 
    /* d is denormalized */
2079
 
 
2080
 
    i= bbits + be + (Bias + (P-1) - 1);
2081
 
    x= i > 32  ? word0(d) << (64 - i) | word1(d) >> (i - 32)
2082
 
      : word1(d) << (32 - i);
2083
 
    dval(d2)= x;
2084
 
    word0(d2)-= 31*Exp_msk1; /* adjust exponent */
2085
 
    i-= (Bias + (P-1) - 1) + 1;
2086
 
    denorm= 1;
2087
 
  }
2088
 
  ds= (dval(d2)-1.5)*0.289529654602168 + 0.1760912590558 + i*0.301029995663981;
2089
 
  k= (int)ds;
2090
 
  if (ds < 0. && ds != k)
2091
 
    k--;    /* want k= floor(ds) */
2092
 
  k_check= 1;
2093
 
  if (k >= 0 && k <= Ten_pmax)
2094
 
  {
2095
 
    if (dval(d) < tens[k])
2096
 
      k--;
2097
 
    k_check= 0;
2098
 
  }
2099
 
  j= bbits - i - 1;
2100
 
  if (j >= 0)
2101
 
  {
2102
 
    b2= 0;
2103
 
    s2= j;
2104
 
  }
2105
 
  else
2106
 
  {
2107
 
    b2= -j;
2108
 
    s2= 0;
2109
 
  }
2110
 
  if (k >= 0)
2111
 
  {
2112
 
    b5= 0;
2113
 
    s5= k;
2114
 
    s2+= k;
2115
 
  }
2116
 
  else
2117
 
  {
2118
 
    b2-= k;
2119
 
    b5= -k;
2120
 
    s5= 0;
2121
 
  }
2122
 
  if (mode < 0 || mode > 9)
2123
 
    mode= 0;
2124
 
 
2125
 
  try_quick= 1;
2126
 
 
2127
 
  if (mode > 5)
2128
 
  {
2129
 
    mode-= 4;
2130
 
    try_quick= 0;
2131
 
  }
2132
 
  leftright= 1;
2133
 
  switch (mode) {
2134
 
  case 0:
2135
 
  case 1:
2136
 
    ilim= ilim1= -1;
2137
 
    i= 18;
2138
 
    ndigits= 0;
2139
 
    break;
2140
 
  case 2:
2141
 
    leftright= 0;
2142
 
    /* no break */
2143
 
  case 4:
2144
 
    if (ndigits <= 0)
2145
 
      ndigits= 1;
2146
 
    ilim= ilim1= i= ndigits;
2147
 
    break;
2148
 
  case 3:
2149
 
    leftright= 0;
2150
 
    /* no break */
2151
 
  case 5:
2152
 
    i= ndigits + k + 1;
2153
 
    ilim= i;
2154
 
    ilim1= i - 1;
2155
 
    if (i <= 0)
2156
 
      i= 1;
2157
 
  }
2158
 
  s= s0= dtoa_alloc(i, &alloc);
2159
 
 
2160
 
  if (ilim >= 0 && ilim <= Quick_max && try_quick)
2161
 
  {
2162
 
    /* Try to get by with floating-point arithmetic. */
2163
 
    i= 0;
2164
 
    dval(d2)= dval(d);
2165
 
    k0= k;
2166
 
    ilim0= ilim;
2167
 
    ieps= 2; /* conservative */
2168
 
    if (k > 0)
2169
 
    {
2170
 
      ds= tens[k&0xf];
2171
 
      j= k >> 4;
2172
 
      if (j & Bletch)
2173
 
      {
2174
 
        /* prevent overflows */
2175
 
        j&= Bletch - 1;
2176
 
        dval(d)/= bigtens[n_bigtens-1];
2177
 
        ieps++;
2178
 
      }
2179
 
      for (; j; j>>= 1, i++)
2180
 
      {
2181
 
        if (j & 1)
2182
 
        {
2183
 
          ieps++;
2184
 
          ds*= bigtens[i];
2185
 
        }
2186
 
      }
2187
 
      dval(d)/= ds;
2188
 
    }
2189
 
    else if ((j1= -k))
2190
 
    {
2191
 
      dval(d)*= tens[j1 & 0xf];
2192
 
      for (j= j1 >> 4; j; j>>= 1, i++)
2193
 
      {
2194
 
        if (j & 1)
2195
 
        {
2196
 
          ieps++;
2197
 
          dval(d)*= bigtens[i];
2198
 
        }
2199
 
      }
2200
 
    }
2201
 
    if (k_check && dval(d) < 1. && ilim > 0)
2202
 
    {
2203
 
      if (ilim1 <= 0)
2204
 
        goto fast_failed;
2205
 
      ilim= ilim1;
2206
 
      k--;
2207
 
      dval(d)*= 10.;
2208
 
      ieps++;
2209
 
    }
2210
 
    dval(eps)= ieps*dval(d) + 7.;
2211
 
    word0(eps)-= (P-1)*Exp_msk1;
2212
 
    if (ilim == 0)
2213
 
    {
2214
 
      S= mhi= 0;
2215
 
      dval(d)-= 5.;
2216
 
      if (dval(d) > dval(eps))
2217
 
        goto one_digit;
2218
 
      if (dval(d) < -dval(eps))
2219
 
        goto no_digits;
2220
 
      goto fast_failed;
2221
 
    }
2222
 
    if (leftright)
2223
 
    {
2224
 
      /* Use Steele & White method of only generating digits needed. */
2225
 
      dval(eps)= 0.5/tens[ilim-1] - dval(eps);
2226
 
      for (i= 0;;)
2227
 
      {
2228
 
        L= (Long) dval(d);
2229
 
        dval(d)-= L;
2230
 
        *s++= '0' + (int)L;
2231
 
        if (dval(d) < dval(eps))
2232
 
          goto ret1;
2233
 
        if (1. - dval(d) < dval(eps))
2234
 
          goto bump_up;
2235
 
        if (++i >= ilim)
2236
 
          break;
2237
 
        dval(eps)*= 10.;
2238
 
        dval(d)*= 10.;
2239
 
      }
2240
 
    }
2241
 
    else
2242
 
    {
2243
 
      /* Generate ilim digits, then fix them up. */
2244
 
      dval(eps)*= tens[ilim-1];
2245
 
      for (i= 1;; i++, dval(d)*= 10.)
2246
 
      {
2247
 
        L= (Long)(dval(d));
2248
 
        if (!(dval(d)-= L))
2249
 
          ilim= i;
2250
 
        *s++= '0' + (int)L;
2251
 
        if (i == ilim)
2252
 
        {
2253
 
          if (dval(d) > 0.5 + dval(eps))
2254
 
            goto bump_up;
2255
 
          else if (dval(d) < 0.5 - dval(eps))
2256
 
          {
2257
 
            while (*--s == '0');
2258
 
            s++;
2259
 
            goto ret1;
2260
 
          }
2261
 
          break;
2262
 
        }
2263
 
      }
2264
 
    }
2265
 
  fast_failed:
2266
 
    s= s0;
2267
 
    dval(d)= dval(d2);
2268
 
    k= k0;
2269
 
    ilim= ilim0;
2270
 
  }
2271
 
 
2272
 
  /* Do we have a "small" integer? */
2273
 
 
2274
 
  if (be >= 0 && k <= Int_max)
2275
 
  {
2276
 
    /* Yes. */
2277
 
    ds= tens[k];
2278
 
    if (ndigits < 0 && ilim <= 0)
2279
 
    {
2280
 
      S= mhi= 0;
2281
 
      if (ilim < 0 || dval(d) <= 5*ds)
2282
 
        goto no_digits;
2283
 
      goto one_digit;
2284
 
    }
2285
 
    for (i= 1;; i++, dval(d)*= 10.)
2286
 
    {
2287
 
      L= (Long)(dval(d) / ds);
2288
 
      dval(d)-= L*ds;
2289
 
      *s++= '0' + (int)L;
2290
 
      if (!dval(d))
2291
 
      {
2292
 
        break;
2293
 
      }
2294
 
      if (i == ilim)
2295
 
      {
2296
 
        dval(d)+= dval(d);
2297
 
        if (dval(d) > ds || (dval(d) == ds && L & 1))
2298
 
        {
2299
 
bump_up:
2300
 
          while (*--s == '9')
2301
 
            if (s == s0)
2302
 
            {
2303
 
              k++;
2304
 
              *s= '0';
2305
 
              break;
2306
 
            }
2307
 
          ++*s++;
2308
 
        }
2309
 
        break;
2310
 
      }
2311
 
    }
2312
 
    goto ret1;
2313
 
  }
2314
 
 
2315
 
  m2= b2;
2316
 
  m5= b5;
2317
 
  mhi= mlo= 0;
2318
 
  if (leftright)
2319
 
  {
2320
 
    i = denorm ? be + (Bias + (P-1) - 1 + 1) : 1 + P - bbits;
2321
 
    b2+= i;
2322
 
    s2+= i;
2323
 
    mhi= i2b(1, &alloc);
2324
 
  }
2325
 
  if (m2 > 0 && s2 > 0)
2326
 
  {
2327
 
    i= m2 < s2 ? m2 : s2;
2328
 
    b2-= i;
2329
 
    m2-= i;
2330
 
    s2-= i;
2331
 
  }
2332
 
  if (b5 > 0)
2333
 
  {
2334
 
    if (leftright)
2335
 
    {
2336
 
      if (m5 > 0)
2337
 
      {
2338
 
        mhi= pow5mult(mhi, m5, &alloc);
2339
 
        b1= mult(mhi, b, &alloc);
2340
 
        Bfree(b, &alloc);
2341
 
        b= b1;
2342
 
      }
2343
 
      if ((j= b5 - m5))
2344
 
        b= pow5mult(b, j, &alloc);
2345
 
    }
2346
 
    else
2347
 
      b= pow5mult(b, b5, &alloc);
2348
 
  }
2349
 
  S= i2b(1, &alloc);
2350
 
  if (s5 > 0)
2351
 
    S= pow5mult(S, s5, &alloc);
2352
 
 
2353
 
  /* Check for special case that d is a normalized power of 2. */
2354
 
 
2355
 
  spec_case= 0;
2356
 
  if ((mode < 2 || leftright)
2357
 
     )
2358
 
  {
2359
 
    if (!word1(d) && !(word0(d) & Bndry_mask) &&
2360
 
        word0(d) & (Exp_mask & ~Exp_msk1)
2361
 
       )
2362
 
    {
2363
 
      /* The special case */
2364
 
      b2+= Log2P;
2365
 
      s2+= Log2P;
2366
 
      spec_case= 1;
2367
 
    }
2368
 
  }
2369
 
 
2370
 
  /*
2371
 
    Arrange for convenient computation of quotients:
2372
 
    shift left if necessary so divisor has 4 leading 0 bits.
2373
 
    
2374
 
    Perhaps we should just compute leading 28 bits of S once
2375
 
    a nd for all and pass them and a shift to quorem, so it
2376
 
    can do shifts and ors to compute the numerator for q.
2377
 
  */
2378
 
  if ((i= ((s5 ? 32 - hi0bits(S->p.x[S->wds-1]) : 1) + s2) & 0x1f))
2379
 
    i= 32 - i;
2380
 
  if (i > 4)
2381
 
  {
2382
 
    i-= 4;
2383
 
    b2+= i;
2384
 
    m2+= i;
2385
 
    s2+= i;
2386
 
  }
2387
 
  else if (i < 4)
2388
 
  {
2389
 
    i+= 28;
2390
 
    b2+= i;
2391
 
    m2+= i;
2392
 
    s2+= i;
2393
 
  }
2394
 
  if (b2 > 0)
2395
 
    b= lshift(b, b2, &alloc);
2396
 
  if (s2 > 0)
2397
 
    S= lshift(S, s2, &alloc);
2398
 
  if (k_check)
2399
 
  {
2400
 
    if (cmp(b,S) < 0)
2401
 
    {
2402
 
      k--;
2403
 
      /* we botched the k estimate */
2404
 
      b= multadd(b, 10, 0, &alloc);
2405
 
      if (leftright)
2406
 
        mhi= multadd(mhi, 10, 0, &alloc);
2407
 
      ilim= ilim1;
2408
 
    }
2409
 
  }
2410
 
  if (ilim <= 0 && (mode == 3 || mode == 5))
2411
 
  {
2412
 
    if (ilim < 0 || cmp(b,S= multadd(S,5,0, &alloc)) <= 0)
2413
 
    {
2414
 
      /* no digits, fcvt style */
2415
 
no_digits:
2416
 
      k= -1 - ndigits;
2417
 
      goto ret;
2418
 
    }
2419
 
one_digit:
2420
 
    *s++= '1';
2421
 
    k++;
2422
 
    goto ret;
2423
 
  }
2424
 
  if (leftright)
2425
 
  {
2426
 
    if (m2 > 0)
2427
 
      mhi= lshift(mhi, m2, &alloc);
2428
 
 
2429
 
    /*
2430
 
      Compute mlo -- check for special case that d is a normalized power of 2.
2431
 
    */
2432
 
 
2433
 
    mlo= mhi;
2434
 
    if (spec_case)
2435
 
    {
2436
 
      mhi= Balloc(mhi->k, &alloc);
2437
 
      Bcopy(mhi, mlo);
2438
 
      mhi= lshift(mhi, Log2P, &alloc);
2439
 
    }
2440
 
 
2441
 
    for (i= 1;;i++)
2442
 
    {
2443
 
      dig= quorem(b,S) + '0';
2444
 
      /* Do we yet have the shortest decimal string that will round to d? */
2445
 
      j= cmp(b, mlo);
2446
 
      delta= diff(S, mhi, &alloc);
2447
 
      j1= delta->sign ? 1 : cmp(b, delta);
2448
 
      Bfree(delta, &alloc);
2449
 
      if (j1 == 0 && mode != 1 && !(word1(d) & 1)
2450
 
         )
2451
 
      {
2452
 
        if (dig == '9')
2453
 
          goto round_9_up;
2454
 
        if (j > 0)
2455
 
          dig++;
2456
 
        *s++= dig;
2457
 
        goto ret;
2458
 
      }
2459
 
      if (j < 0 || (j == 0 && mode != 1 && !(word1(d) & 1)))
2460
 
      {
2461
 
        if (!b->p.x[0] && b->wds <= 1)
2462
 
        {
2463
 
          goto accept_dig;
2464
 
        }
2465
 
        if (j1 > 0)
2466
 
        {
2467
 
          b= lshift(b, 1, &alloc);
2468
 
          j1= cmp(b, S);
2469
 
          if ((j1 > 0 || (j1 == 0 && dig & 1))
2470
 
              && dig++ == '9')
2471
 
            goto round_9_up;
2472
 
        }
2473
 
accept_dig:
2474
 
        *s++= dig;
2475
 
        goto ret;
2476
 
      }
2477
 
      if (j1 > 0)
2478
 
      {
2479
 
        if (dig == '9')
2480
 
        { /* possible if i == 1 */
2481
 
round_9_up:
2482
 
          *s++= '9';
2483
 
          goto roundoff;
2484
 
        }
2485
 
        *s++= dig + 1;
2486
 
        goto ret;
2487
 
      }
2488
 
      *s++= dig;
2489
 
      if (i == ilim)
2490
 
        break;
2491
 
      b= multadd(b, 10, 0, &alloc);
2492
 
      if (mlo == mhi)
2493
 
        mlo= mhi= multadd(mhi, 10, 0, &alloc);
2494
 
      else
2495
 
      {
2496
 
        mlo= multadd(mlo, 10, 0, &alloc);
2497
 
        mhi= multadd(mhi, 10, 0, &alloc);
2498
 
      }
2499
 
    }
2500
 
  }
2501
 
  else
2502
 
    for (i= 1;; i++)
2503
 
    {
2504
 
      *s++= dig= quorem(b,S) + '0';
2505
 
      if (!b->p.x[0] && b->wds <= 1)
2506
 
      {
2507
 
        goto ret;
2508
 
      }
2509
 
      if (i >= ilim)
2510
 
        break;
2511
 
      b= multadd(b, 10, 0, &alloc);
2512
 
    }
2513
 
 
2514
 
  /* Round off last digit */
2515
 
 
2516
 
  b= lshift(b, 1, &alloc);
2517
 
  j= cmp(b, S);
2518
 
  if (j > 0 || (j == 0 && dig & 1))
2519
 
  {
2520
 
roundoff:
2521
 
    while (*--s == '9')
2522
 
      if (s == s0)
2523
 
      {
2524
 
        k++;
2525
 
        *s++= '1';
2526
 
        goto ret;
2527
 
      }
2528
 
    ++*s++;
2529
 
  }
2530
 
  else
2531
 
  {
2532
 
    while (*--s == '0');
2533
 
    s++;
2534
 
  }
2535
 
ret:
2536
 
  Bfree(S, &alloc);
2537
 
  if (mhi)
2538
 
  {
2539
 
    if (mlo && mlo != mhi)
2540
 
      Bfree(mlo, &alloc);
2541
 
    Bfree(mhi, &alloc);
2542
 
  }
2543
 
ret1:
2544
 
  Bfree(b, &alloc);
2545
 
  *s= 0;
2546
 
  *decpt= k + 1;
2547
 
  if (rve)
2548
 
    *rve= s;
2549
 
  return s0;
2550
 
}