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