Coverage Report

Created: 2024-06-18 07:03

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