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