~drizzle-trunk/drizzle/development

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