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