Ruby  2.1.3p242(2014-09-19revision47630)
util.c
Go to the documentation of this file.
1 /**********************************************************************
2 
3  util.c -
4 
5  $Author: nobu $
6  created at: Fri Mar 10 17:22:34 JST 1995
7 
8  Copyright (C) 1993-2008 Yukihiro Matsumoto
9 
10 **********************************************************************/
11 
12 #include "ruby/ruby.h"
13 #include "internal.h"
14 
15 #include <ctype.h>
16 #include <stdio.h>
17 #include <errno.h>
18 #include <math.h>
19 #include <float.h>
20 
21 #ifdef _WIN32
22 #include "missing/file.h"
23 #endif
24 
25 #include "ruby/util.h"
26 
27 unsigned long
28 ruby_scan_oct(const char *start, size_t len, size_t *retlen)
29 {
30  register const char *s = start;
31  register unsigned long retval = 0;
32 
33  while (len-- && *s >= '0' && *s <= '7') {
34  retval <<= 3;
35  retval |= *s++ - '0';
36  }
37  *retlen = (int)(s - start); /* less than len */
38  return retval;
39 }
40 
41 unsigned long
42 ruby_scan_hex(const char *start, size_t len, size_t *retlen)
43 {
44  static const char hexdigit[] = "0123456789abcdef0123456789ABCDEF";
45  register const char *s = start;
46  register unsigned long retval = 0;
47  const char *tmp;
48 
49  while (len-- && *s && (tmp = strchr(hexdigit, *s))) {
50  retval <<= 4;
51  retval |= (tmp - hexdigit) & 15;
52  s++;
53  }
54  *retlen = (int)(s - start); /* less than len */
55  return retval;
56 }
57 
58 const signed char ruby_digit36_to_number_table[] = {
59  /* 0 1 2 3 4 5 6 7 8 9 a b c d e f */
60  /*0*/ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
61  /*1*/ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
62  /*2*/ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
63  /*3*/ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,-1,-1,-1,-1,-1,-1,
64  /*4*/ -1,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,
65  /*5*/ 25,26,27,28,29,30,31,32,33,34,35,-1,-1,-1,-1,-1,
66  /*6*/ -1,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,
67  /*7*/ 25,26,27,28,29,30,31,32,33,34,35,-1,-1,-1,-1,-1,
68  /*8*/ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
69  /*9*/ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
70  /*a*/ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
71  /*b*/ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
72  /*c*/ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
73  /*d*/ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
74  /*e*/ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
75  /*f*/ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
76 };
77 
78 static unsigned long
79 scan_digits(const char *str, int base, size_t *retlen, int *overflow)
80 {
81 
82  const char *start = str;
83  unsigned long ret = 0, x;
84  unsigned long mul_overflow = (~(unsigned long)0) / base;
85  int c;
86  *overflow = 0;
87 
88  while ((c = (unsigned char)*str++) != '\0') {
89  int d = ruby_digit36_to_number_table[c];
90  if (d == -1 || base <= d) {
91  *retlen = (str-1) - start;
92  return ret;
93  }
94  if (mul_overflow < ret)
95  *overflow = 1;
96  ret *= base;
97  x = ret;
98  ret += d;
99  if (ret < x)
100  *overflow = 1;
101  }
102  *retlen = (str-1) - start;
103  return ret;
104 }
105 
106 unsigned long
107 ruby_strtoul(const char *str, char **endptr, int base)
108 {
109  int c, b, overflow;
110  int sign = 0;
111  size_t len;
112  unsigned long ret;
113  const char *subject_found = str;
114 
115  if (base == 1 || 36 < base) {
116  errno = EINVAL;
117  return 0;
118  }
119 
120  while ((c = *str) && ISSPACE(c))
121  str++;
122 
123  if (c == '+') {
124  sign = 1;
125  str++;
126  }
127  else if (c == '-') {
128  sign = -1;
129  str++;
130  }
131 
132  if (str[0] == '0') {
133  subject_found = str+1;
134  if (base == 0 || base == 16) {
135  if (str[1] == 'x' || str[1] == 'X') {
136  b = 16;
137  str += 2;
138  }
139  else {
140  b = base == 0 ? 8 : 16;
141  str++;
142  }
143  }
144  else {
145  b = base;
146  str++;
147  }
148  }
149  else {
150  b = base == 0 ? 10 : base;
151  }
152 
153  ret = scan_digits(str, b, &len, &overflow);
154 
155  if (0 < len)
156  subject_found = str+len;
157 
158  if (endptr)
159  *endptr = (char*)subject_found;
160 
161  if (overflow) {
162  errno = ERANGE;
163  return ULONG_MAX;
164  }
165 
166  if (sign < 0) {
167  ret = (unsigned long)(-(long)ret);
168  return ret;
169  }
170  else {
171  return ret;
172  }
173 }
174 
175 #include <sys/types.h>
176 #include <sys/stat.h>
177 #ifdef HAVE_UNISTD_H
178 #include <unistd.h>
179 #endif
180 #if defined(HAVE_FCNTL_H)
181 #include <fcntl.h>
182 #endif
183 
184 #ifndef S_ISDIR
185 # define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR)
186 #endif
187 
188 
189 /* mm.c */
190 
191 #define mmtype long
192 #define mmcount (16 / SIZEOF_LONG)
193 #define A ((mmtype*)a)
194 #define B ((mmtype*)b)
195 #define C ((mmtype*)c)
196 #define D ((mmtype*)d)
197 
198 #define mmstep (sizeof(mmtype) * mmcount)
199 #define mmprepare(base, size) do {\
200  if (((VALUE)(base) % sizeof(mmtype)) == 0 && ((size) % sizeof(mmtype)) == 0) \
201  if ((size) >= mmstep) mmkind = 1;\
202  else mmkind = 0;\
203  else mmkind = -1;\
204  high = ((size) / mmstep) * mmstep;\
205  low = ((size) % mmstep);\
206 } while (0)\
207 
208 #define mmarg mmkind, size, high, low
209 #define mmargdecl int mmkind, size_t size, size_t high, size_t low
210 
211 static void mmswap_(register char *a, register char *b, mmargdecl)
212 {
213  if (a == b) return;
214  if (mmkind >= 0) {
215  register mmtype s;
216 #if mmcount > 1
217  if (mmkind > 0) {
218  register char *t = a + high;
219  do {
220  s = A[0]; A[0] = B[0]; B[0] = s;
221  s = A[1]; A[1] = B[1]; B[1] = s;
222 #if mmcount > 2
223  s = A[2]; A[2] = B[2]; B[2] = s;
224 #if mmcount > 3
225  s = A[3]; A[3] = B[3]; B[3] = s;
226 #endif
227 #endif
228  a += mmstep; b += mmstep;
229  } while (a < t);
230  }
231 #endif
232  if (low != 0) { s = A[0]; A[0] = B[0]; B[0] = s;
233 #if mmcount > 2
234  if (low >= 2 * sizeof(mmtype)) { s = A[1]; A[1] = B[1]; B[1] = s;
235 #if mmcount > 3
236  if (low >= 3 * sizeof(mmtype)) {s = A[2]; A[2] = B[2]; B[2] = s;}
237 #endif
238  }
239 #endif
240  }
241  }
242  else {
243  register char *t = a + size, s;
244  do {s = *a; *a++ = *b; *b++ = s;} while (a < t);
245  }
246 }
247 #define mmswap(a,b) mmswap_((a),(b),mmarg)
248 
249 /* a, b, c = b, c, a */
250 static void mmrot3_(register char *a, register char *b, register char *c, mmargdecl)
251 {
252  if (mmkind >= 0) {
253  register mmtype s;
254 #if mmcount > 1
255  if (mmkind > 0) {
256  register char *t = a + high;
257  do {
258  s = A[0]; A[0] = B[0]; B[0] = C[0]; C[0] = s;
259  s = A[1]; A[1] = B[1]; B[1] = C[1]; C[1] = s;
260 #if mmcount > 2
261  s = A[2]; A[2] = B[2]; B[2] = C[2]; C[2] = s;
262 #if mmcount > 3
263  s = A[3]; A[3] = B[3]; B[3] = C[3]; C[3] = s;
264 #endif
265 #endif
266  a += mmstep; b += mmstep; c += mmstep;
267  } while (a < t);
268  }
269 #endif
270  if (low != 0) { s = A[0]; A[0] = B[0]; B[0] = C[0]; C[0] = s;
271 #if mmcount > 2
272  if (low >= 2 * sizeof(mmtype)) { s = A[1]; A[1] = B[1]; B[1] = C[1]; C[1] = s;
273 #if mmcount > 3
274  if (low == 3 * sizeof(mmtype)) {s = A[2]; A[2] = B[2]; B[2] = C[2]; C[2] = s;}
275 #endif
276  }
277 #endif
278  }
279  }
280  else {
281  register char *t = a + size, s;
282  do {s = *a; *a++ = *b; *b++ = *c; *c++ = s;} while (a < t);
283  }
284 }
285 #define mmrot3(a,b,c) mmrot3_((a),(b),(c),mmarg)
286 
287 /* qs6.c */
288 /*****************************************************/
289 /* */
290 /* qs6 (Quick sort function) */
291 /* */
292 /* by Tomoyuki Kawamura 1995.4.21 */
293 /* kawamura@tokuyama.ac.jp */
294 /*****************************************************/
295 
296 typedef struct { char *LL, *RR; } stack_node; /* Stack structure for L,l,R,r */
297 #define PUSH(ll,rr) do { top->LL = (ll); top->RR = (rr); ++top; } while (0) /* Push L,l,R,r */
298 #define POP(ll,rr) do { --top; (ll) = top->LL; (rr) = top->RR; } while (0) /* Pop L,l,R,r */
299 
300 #define med3(a,b,c) ((*cmp)((a),(b),d)<0 ? \
301  ((*cmp)((b),(c),d)<0 ? (b) : ((*cmp)((a),(c),d)<0 ? (c) : (a))) : \
302  ((*cmp)((b),(c),d)>0 ? (b) : ((*cmp)((a),(c),d)<0 ? (a) : (c))))
303 
304 typedef int (cmpfunc_t)(const void*, const void*, void*);
305 void
306 ruby_qsort(void* base, const size_t nel, const size_t size, cmpfunc_t *cmp, void *d)
307 {
308  register char *l, *r, *m; /* l,r:left,right group m:median point */
309  register int t, eq_l, eq_r; /* eq_l: all items in left group are equal to S */
310  char *L = base; /* left end of current region */
311  char *R = (char*)base + size*(nel-1); /* right end of current region */
312  size_t chklim = 63; /* threshold of ordering element check */
313  enum {size_bits = sizeof(size) * CHAR_BIT};
314  stack_node stack[size_bits]; /* enough for size_t size */
315  stack_node *top = stack;
316  int mmkind;
317  size_t high, low, n;
318 
319  if (nel <= 1) return; /* need not to sort */
320  mmprepare(base, size);
321  goto start;
322 
323  nxt:
324  if (stack == top) return; /* return if stack is empty */
325  POP(L,R);
326 
327  for (;;) {
328  start:
329  if (L + size == R) { /* 2 elements */
330  if ((*cmp)(L,R,d) > 0) mmswap(L,R); goto nxt;
331  }
332 
333  l = L; r = R;
334  n = (r - l + size) / size; /* number of elements */
335  m = l + size * (n >> 1); /* calculate median value */
336 
337  if (n >= 60) {
338  register char *m1;
339  register char *m3;
340  if (n >= 200) {
341  n = size*(n>>3); /* number of bytes in splitting 8 */
342  {
343  register char *p1 = l + n;
344  register char *p2 = p1 + n;
345  register char *p3 = p2 + n;
346  m1 = med3(p1, p2, p3);
347  p1 = m + n;
348  p2 = p1 + n;
349  p3 = p2 + n;
350  m3 = med3(p1, p2, p3);
351  }
352  }
353  else {
354  n = size*(n>>2); /* number of bytes in splitting 4 */
355  m1 = l + n;
356  m3 = m + n;
357  }
358  m = med3(m1, m, m3);
359  }
360 
361  if ((t = (*cmp)(l,m,d)) < 0) { /*3-5-?*/
362  if ((t = (*cmp)(m,r,d)) < 0) { /*3-5-7*/
363  if (chklim && nel >= chklim) { /* check if already ascending order */
364  char *p;
365  chklim = 0;
366  for (p=l; p<r; p+=size) if ((*cmp)(p,p+size,d) > 0) goto fail;
367  goto nxt;
368  }
369  fail: goto loopA; /*3-5-7*/
370  }
371  if (t > 0) {
372  if ((*cmp)(l,r,d) <= 0) {mmswap(m,r); goto loopA;} /*3-5-4*/
373  mmrot3(r,m,l); goto loopA; /*3-5-2*/
374  }
375  goto loopB; /*3-5-5*/
376  }
377 
378  if (t > 0) { /*7-5-?*/
379  if ((t = (*cmp)(m,r,d)) > 0) { /*7-5-3*/
380  if (chklim && nel >= chklim) { /* check if already ascending order */
381  char *p;
382  chklim = 0;
383  for (p=l; p<r; p+=size) if ((*cmp)(p,p+size,d) < 0) goto fail2;
384  while (l<r) {mmswap(l,r); l+=size; r-=size;} /* reverse region */
385  goto nxt;
386  }
387  fail2: mmswap(l,r); goto loopA; /*7-5-3*/
388  }
389  if (t < 0) {
390  if ((*cmp)(l,r,d) <= 0) {mmswap(l,m); goto loopB;} /*7-5-8*/
391  mmrot3(l,m,r); goto loopA; /*7-5-6*/
392  }
393  mmswap(l,r); goto loopA; /*7-5-5*/
394  }
395 
396  if ((t = (*cmp)(m,r,d)) < 0) {goto loopA;} /*5-5-7*/
397  if (t > 0) {mmswap(l,r); goto loopB;} /*5-5-3*/
398 
399  /* determining splitting type in case 5-5-5 */ /*5-5-5*/
400  for (;;) {
401  if ((l += size) == r) goto nxt; /*5-5-5*/
402  if (l == m) continue;
403  if ((t = (*cmp)(l,m,d)) > 0) {mmswap(l,r); l = L; goto loopA;}/*575-5*/
404  if (t < 0) {mmswap(L,l); l = L; goto loopB;} /*535-5*/
405  }
406 
407  loopA: eq_l = 1; eq_r = 1; /* splitting type A */ /* left <= median < right */
408  for (;;) {
409  for (;;) {
410  if ((l += size) == r)
411  {l -= size; if (l != m) mmswap(m,l); l -= size; goto fin;}
412  if (l == m) continue;
413  if ((t = (*cmp)(l,m,d)) > 0) {eq_r = 0; break;}
414  if (t < 0) eq_l = 0;
415  }
416  for (;;) {
417  if (l == (r -= size))
418  {l -= size; if (l != m) mmswap(m,l); l -= size; goto fin;}
419  if (r == m) {m = l; break;}
420  if ((t = (*cmp)(r,m,d)) < 0) {eq_l = 0; break;}
421  if (t == 0) break;
422  }
423  mmswap(l,r); /* swap left and right */
424  }
425 
426  loopB: eq_l = 1; eq_r = 1; /* splitting type B */ /* left < median <= right */
427  for (;;) {
428  for (;;) {
429  if (l == (r -= size))
430  {r += size; if (r != m) mmswap(r,m); r += size; goto fin;}
431  if (r == m) continue;
432  if ((t = (*cmp)(r,m,d)) < 0) {eq_l = 0; break;}
433  if (t > 0) eq_r = 0;
434  }
435  for (;;) {
436  if ((l += size) == r)
437  {r += size; if (r != m) mmswap(r,m); r += size; goto fin;}
438  if (l == m) {m = r; break;}
439  if ((t = (*cmp)(l,m,d)) > 0) {eq_r = 0; break;}
440  if (t == 0) break;
441  }
442  mmswap(l,r); /* swap left and right */
443  }
444 
445  fin:
446  if (eq_l == 0) /* need to sort left side */
447  if (eq_r == 0) /* need to sort right side */
448  if (l-L < R-r) {PUSH(r,R); R = l;} /* sort left side first */
449  else {PUSH(L,l); L = r;} /* sort right side first */
450  else R = l; /* need to sort left side only */
451  else if (eq_r == 0) L = r; /* need to sort right side only */
452  else goto nxt; /* need not to sort both sides */
453  }
454 }
455 
456 char *
457 ruby_strdup(const char *str)
458 {
459  char *tmp;
460  size_t len = strlen(str) + 1;
461 
462  tmp = xmalloc(len);
463  memcpy(tmp, str, len);
464 
465  return tmp;
466 }
467 
468 #ifdef __native_client__
469 char *
470 ruby_getcwd(void)
471 {
472  char *buf = xmalloc(2);
473  strcpy(buf, ".");
474  return buf;
475 }
476 #else
477 char *
478 ruby_getcwd(void)
479 {
480 #ifdef HAVE_GETCWD
481  int size = 200;
482  char *buf = xmalloc(size);
483 
484  while (!getcwd(buf, size)) {
485  if (errno != ERANGE) {
486  xfree(buf);
487  rb_sys_fail("getcwd");
488  }
489  size *= 2;
490  buf = xrealloc(buf, size);
491  }
492 #else
493 # ifndef PATH_MAX
494 # define PATH_MAX 8192
495 # endif
496  char *buf = xmalloc(PATH_MAX+1);
497 
498  if (!getwd(buf)) {
499  xfree(buf);
500  rb_sys_fail("getwd");
501  }
502 #endif
503  return buf;
504 }
505 #endif
506 
507 /****************************************************************
508  *
509  * The author of this software is David M. Gay.
510  *
511  * Copyright (c) 1991, 2000, 2001 by Lucent Technologies.
512  *
513  * Permission to use, copy, modify, and distribute this software for any
514  * purpose without fee is hereby granted, provided that this entire notice
515  * is included in all copies of any software which is or includes a copy
516  * or modification of this software and in all copies of the supporting
517  * documentation for such software.
518  *
519  * THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
520  * WARRANTY. IN PARTICULAR, NEITHER THE AUTHOR NOR LUCENT MAKES ANY
521  * REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
522  * OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
523  *
524  ***************************************************************/
525 
526 /* Please send bug reports to David M. Gay (dmg at acm dot org,
527  * with " at " changed at "@" and " dot " changed to "."). */
528 
529 /* On a machine with IEEE extended-precision registers, it is
530  * necessary to specify double-precision (53-bit) rounding precision
531  * before invoking strtod or dtoa. If the machine uses (the equivalent
532  * of) Intel 80x87 arithmetic, the call
533  * _control87(PC_53, MCW_PC);
534  * does this with many compilers. Whether this or another call is
535  * appropriate depends on the compiler; for this to work, it may be
536  * necessary to #include "float.h" or another system-dependent header
537  * file.
538  */
539 
540 /* strtod for IEEE-, VAX-, and IBM-arithmetic machines.
541  *
542  * This strtod returns a nearest machine number to the input decimal
543  * string (or sets errno to ERANGE). With IEEE arithmetic, ties are
544  * broken by the IEEE round-even rule. Otherwise ties are broken by
545  * biased rounding (add half and chop).
546  *
547  * Inspired loosely by William D. Clinger's paper "How to Read Floating
548  * Point Numbers Accurately" [Proc. ACM SIGPLAN '90, pp. 92-101].
549  *
550  * Modifications:
551  *
552  * 1. We only require IEEE, IBM, or VAX double-precision
553  * arithmetic (not IEEE double-extended).
554  * 2. We get by with floating-point arithmetic in a case that
555  * Clinger missed -- when we're computing d * 10^n
556  * for a small integer d and the integer n is not too
557  * much larger than 22 (the maximum integer k for which
558  * we can represent 10^k exactly), we may be able to
559  * compute (d*10^k) * 10^(e-k) with just one roundoff.
560  * 3. Rather than a bit-at-a-time adjustment of the binary
561  * result in the hard case, we use floating-point
562  * arithmetic to determine the adjustment to within
563  * one bit; only in really hard cases do we need to
564  * compute a second residual.
565  * 4. Because of 3., we don't need a large table of powers of 10
566  * for ten-to-e (just some small tables, e.g. of 10^k
567  * for 0 <= k <= 22).
568  */
569 
570 /*
571  * #define IEEE_LITTLE_ENDIAN for IEEE-arithmetic machines where the least
572  * significant byte has the lowest address.
573  * #define IEEE_BIG_ENDIAN for IEEE-arithmetic machines where the most
574  * significant byte has the lowest address.
575  * #define Long int on machines with 32-bit ints and 64-bit longs.
576  * #define IBM for IBM mainframe-style floating-point arithmetic.
577  * #define VAX for VAX-style floating-point arithmetic (D_floating).
578  * #define No_leftright to omit left-right logic in fast floating-point
579  * computation of dtoa.
580  * #define Honor_FLT_ROUNDS if FLT_ROUNDS can assume the values 2 or 3
581  * and strtod and dtoa should round accordingly.
582  * #define Check_FLT_ROUNDS if FLT_ROUNDS can assume the values 2 or 3
583  * and Honor_FLT_ROUNDS is not #defined.
584  * #define RND_PRODQUOT to use rnd_prod and rnd_quot (assembly routines
585  * that use extended-precision instructions to compute rounded
586  * products and quotients) with IBM.
587  * #define ROUND_BIASED for IEEE-format with biased rounding.
588  * #define Inaccurate_Divide for IEEE-format with correctly rounded
589  * products but inaccurate quotients, e.g., for Intel i860.
590  * #define NO_LONG_LONG on machines that do not have a "long long"
591  * integer type (of >= 64 bits). On such machines, you can
592  * #define Just_16 to store 16 bits per 32-bit Long when doing
593  * high-precision integer arithmetic. Whether this speeds things
594  * up or slows things down depends on the machine and the number
595  * being converted. If long long is available and the name is
596  * something other than "long long", #define Llong to be the name,
597  * and if "unsigned Llong" does not work as an unsigned version of
598  * Llong, #define #ULLong to be the corresponding unsigned type.
599  * #define KR_headers for old-style C function headers.
600  * #define Bad_float_h if your system lacks a float.h or if it does not
601  * define some or all of DBL_DIG, DBL_MAX_10_EXP, DBL_MAX_EXP,
602  * FLT_RADIX, FLT_ROUNDS, and DBL_MAX.
603  * #define MALLOC your_malloc, where your_malloc(n) acts like malloc(n)
604  * if memory is available and otherwise does something you deem
605  * appropriate. If MALLOC is undefined, malloc will be invoked
606  * directly -- and assumed always to succeed.
607  * #define Omit_Private_Memory to omit logic (added Jan. 1998) for making
608  * memory allocations from a private pool of memory when possible.
609  * When used, the private pool is PRIVATE_MEM bytes long: 2304 bytes,
610  * unless #defined to be a different length. This default length
611  * suffices to get rid of MALLOC calls except for unusual cases,
612  * such as decimal-to-binary conversion of a very long string of
613  * digits. The longest string dtoa can return is about 751 bytes
614  * long. For conversions by strtod of strings of 800 digits and
615  * all dtoa conversions in single-threaded executions with 8-byte
616  * pointers, PRIVATE_MEM >= 7400 appears to suffice; with 4-byte
617  * pointers, PRIVATE_MEM >= 7112 appears adequate.
618  * #define INFNAN_CHECK on IEEE systems to cause strtod to check for
619  * Infinity and NaN (case insensitively). On some systems (e.g.,
620  * some HP systems), it may be necessary to #define NAN_WORD0
621  * appropriately -- to the most significant word of a quiet NaN.
622  * (On HP Series 700/800 machines, -DNAN_WORD0=0x7ff40000 works.)
623  * When INFNAN_CHECK is #defined and No_Hex_NaN is not #defined,
624  * strtod also accepts (case insensitively) strings of the form
625  * NaN(x), where x is a string of hexadecimal digits and spaces;
626  * if there is only one string of hexadecimal digits, it is taken
627  * for the 52 fraction bits of the resulting NaN; if there are two
628  * or more strings of hex digits, the first is for the high 20 bits,
629  * the second and subsequent for the low 32 bits, with intervening
630  * white space ignored; but if this results in none of the 52
631  * fraction bits being on (an IEEE Infinity symbol), then NAN_WORD0
632  * and NAN_WORD1 are used instead.
633  * #define MULTIPLE_THREADS if the system offers preemptively scheduled
634  * multiple threads. In this case, you must provide (or suitably
635  * #define) two locks, acquired by ACQUIRE_DTOA_LOCK(n) and freed
636  * by FREE_DTOA_LOCK(n) for n = 0 or 1. (The second lock, accessed
637  * in pow5mult, ensures lazy evaluation of only one copy of high
638  * powers of 5; omitting this lock would introduce a small
639  * probability of wasting memory, but would otherwise be harmless.)
640  * You must also invoke freedtoa(s) to free the value s returned by
641  * dtoa. You may do so whether or not MULTIPLE_THREADS is #defined.
642  * #define NO_IEEE_Scale to disable new (Feb. 1997) logic in strtod that
643  * avoids underflows on inputs whose result does not underflow.
644  * If you #define NO_IEEE_Scale on a machine that uses IEEE-format
645  * floating-point numbers and flushes underflows to zero rather
646  * than implementing gradual underflow, then you must also #define
647  * Sudden_Underflow.
648  * #define YES_ALIAS to permit aliasing certain double values with
649  * arrays of ULongs. This leads to slightly better code with
650  * some compilers and was always used prior to 19990916, but it
651  * is not strictly legal and can cause trouble with aggressively
652  * optimizing compilers (e.g., gcc 2.95.1 under -O2).
653  * #define USE_LOCALE to use the current locale's decimal_point value.
654  * #define SET_INEXACT if IEEE arithmetic is being used and extra
655  * computation should be done to set the inexact flag when the
656  * result is inexact and avoid setting inexact when the result
657  * is exact. In this case, dtoa.c must be compiled in
658  * an environment, perhaps provided by #include "dtoa.c" in a
659  * suitable wrapper, that defines two functions,
660  * int get_inexact(void);
661  * void clear_inexact(void);
662  * such that get_inexact() returns a nonzero value if the
663  * inexact bit is already set, and clear_inexact() sets the
664  * inexact bit to 0. When SET_INEXACT is #defined, strtod
665  * also does extra computations to set the underflow and overflow
666  * flags when appropriate (i.e., when the result is tiny and
667  * inexact or when it is a numeric value rounded to +-infinity).
668  * #define NO_ERRNO if strtod should not assign errno = ERANGE when
669  * the result overflows to +-Infinity or underflows to 0.
670  */
671 
672 #ifdef WORDS_BIGENDIAN
673 #define IEEE_BIG_ENDIAN
674 #else
675 #define IEEE_LITTLE_ENDIAN
676 #endif
677 
678 #ifdef __vax__
679 #define VAX
680 #undef IEEE_BIG_ENDIAN
681 #undef IEEE_LITTLE_ENDIAN
682 #endif
683 
684 #if defined(__arm__) && !defined(__VFP_FP__)
685 #define IEEE_BIG_ENDIAN
686 #undef IEEE_LITTLE_ENDIAN
687 #endif
688 
689 #undef Long
690 #undef ULong
691 
692 #if SIZEOF_INT == 4
693 #define Long int
694 #define ULong unsigned int
695 #elif SIZEOF_LONG == 4
696 #define Long long int
697 #define ULong unsigned long int
698 #endif
699 
700 #if HAVE_LONG_LONG
701 #define Llong LONG_LONG
702 #endif
703 
704 #ifdef DEBUG
705 #include "stdio.h"
706 #define Bug(x) {fprintf(stderr, "%s\n", (x)); exit(EXIT_FAILURE);}
707 #endif
708 
709 #include "stdlib.h"
710 #include "string.h"
711 
712 #ifdef USE_LOCALE
713 #include "locale.h"
714 #endif
715 
716 #ifdef MALLOC
717 extern void *MALLOC(size_t);
718 #else
719 #define MALLOC malloc
720 #endif
721 #ifdef FREE
722 extern void FREE(void*);
723 #else
724 #define FREE free
725 #endif
726 
727 #ifndef Omit_Private_Memory
728 #ifndef PRIVATE_MEM
729 #define PRIVATE_MEM 2304
730 #endif
731 #define PRIVATE_mem ((PRIVATE_MEM+sizeof(double)-1)/sizeof(double))
732 static double private_mem[PRIVATE_mem], *pmem_next = private_mem;
733 #endif
734 
735 #undef IEEE_Arith
736 #undef Avoid_Underflow
737 #ifdef IEEE_BIG_ENDIAN
738 #define IEEE_Arith
739 #endif
740 #ifdef IEEE_LITTLE_ENDIAN
741 #define IEEE_Arith
742 #endif
743 
744 #ifdef Bad_float_h
745 
746 #ifdef IEEE_Arith
747 #define DBL_DIG 15
748 #define DBL_MAX_10_EXP 308
749 #define DBL_MAX_EXP 1024
750 #define FLT_RADIX 2
751 #endif /*IEEE_Arith*/
752 
753 #ifdef IBM
754 #define DBL_DIG 16
755 #define DBL_MAX_10_EXP 75
756 #define DBL_MAX_EXP 63
757 #define FLT_RADIX 16
758 #define DBL_MAX 7.2370055773322621e+75
759 #endif
760 
761 #ifdef VAX
762 #define DBL_DIG 16
763 #define DBL_MAX_10_EXP 38
764 #define DBL_MAX_EXP 127
765 #define FLT_RADIX 2
766 #define DBL_MAX 1.7014118346046923e+38
767 #endif
768 
769 #ifndef LONG_MAX
770 #define LONG_MAX 2147483647
771 #endif
772 
773 #else /* ifndef Bad_float_h */
774 #include "float.h"
775 #endif /* Bad_float_h */
776 
777 #ifndef __MATH_H__
778 #include "math.h"
779 #endif
780 
781 #ifdef __cplusplus
782 extern "C" {
783 #if 0
784 } /* satisfy cc-mode */
785 #endif
786 #endif
787 
788 #if defined(IEEE_LITTLE_ENDIAN) + defined(IEEE_BIG_ENDIAN) + defined(VAX) + defined(IBM) != 1
789 Exactly one of IEEE_LITTLE_ENDIAN, IEEE_BIG_ENDIAN, VAX, or IBM should be defined.
790 #endif
791 
792 typedef union { double d; ULong L[2]; } U;
793 
794 #ifdef YES_ALIAS
795 typedef double double_u;
796 # define dval(x) (x)
797 # ifdef IEEE_LITTLE_ENDIAN
798 # define word0(x) (((ULong *)&(x))[1])
799 # define word1(x) (((ULong *)&(x))[0])
800 # else
801 # define word0(x) (((ULong *)&(x))[0])
802 # define word1(x) (((ULong *)&(x))[1])
803 # endif
804 #else
805 typedef U double_u;
806 # ifdef IEEE_LITTLE_ENDIAN
807 # define word0(x) ((x).L[1])
808 # define word1(x) ((x).L[0])
809 # else
810 # define word0(x) ((x).L[0])
811 # define word1(x) ((x).L[1])
812 # endif
813 # define dval(x) ((x).d)
814 #endif
815 
816 /* The following definition of Storeinc is appropriate for MIPS processors.
817  * An alternative that might be better on some machines is
818  * #define Storeinc(a,b,c) (*a++ = b << 16 | c & 0xffff)
819  */
820 #if defined(IEEE_LITTLE_ENDIAN) + defined(VAX) + defined(__arm__)
821 #define Storeinc(a,b,c) (((unsigned short *)(a))[1] = (unsigned short)(b), \
822 ((unsigned short *)(a))[0] = (unsigned short)(c), (a)++)
823 #else
824 #define Storeinc(a,b,c) (((unsigned short *)(a))[0] = (unsigned short)(b), \
825 ((unsigned short *)(a))[1] = (unsigned short)(c), (a)++)
826 #endif
827 
828 /* #define P DBL_MANT_DIG */
829 /* Ten_pmax = floor(P*log(2)/log(5)) */
830 /* Bletch = (highest power of 2 < DBL_MAX_10_EXP) / 16 */
831 /* Quick_max = floor((P-1)*log(FLT_RADIX)/log(10) - 1) */
832 /* Int_max = floor(P*log(FLT_RADIX)/log(10) - 1) */
833 
834 #ifdef IEEE_Arith
835 #define Exp_shift 20
836 #define Exp_shift1 20
837 #define Exp_msk1 0x100000
838 #define Exp_msk11 0x100000
839 #define Exp_mask 0x7ff00000
840 #define P 53
841 #define Bias 1023
842 #define Emin (-1022)
843 #define Exp_1 0x3ff00000
844 #define Exp_11 0x3ff00000
845 #define Ebits 11
846 #define Frac_mask 0xfffff
847 #define Frac_mask1 0xfffff
848 #define Ten_pmax 22
849 #define Bletch 0x10
850 #define Bndry_mask 0xfffff
851 #define Bndry_mask1 0xfffff
852 #define LSB 1
853 #define Sign_bit 0x80000000
854 #define Log2P 1
855 #define Tiny0 0
856 #define Tiny1 1
857 #define Quick_max 14
858 #define Int_max 14
859 #ifndef NO_IEEE_Scale
860 #define Avoid_Underflow
861 #ifdef Flush_Denorm /* debugging option */
862 #undef Sudden_Underflow
863 #endif
864 #endif
865 
866 #ifndef Flt_Rounds
867 #ifdef FLT_ROUNDS
868 #define Flt_Rounds FLT_ROUNDS
869 #else
870 #define Flt_Rounds 1
871 #endif
872 #endif /*Flt_Rounds*/
873 
874 #ifdef Honor_FLT_ROUNDS
875 #define Rounding rounding
876 #undef Check_FLT_ROUNDS
877 #define Check_FLT_ROUNDS
878 #else
879 #define Rounding Flt_Rounds
880 #endif
881 
882 #else /* ifndef IEEE_Arith */
883 #undef Check_FLT_ROUNDS
884 #undef Honor_FLT_ROUNDS
885 #undef SET_INEXACT
886 #undef Sudden_Underflow
887 #define Sudden_Underflow
888 #ifdef IBM
889 #undef Flt_Rounds
890 #define Flt_Rounds 0
891 #define Exp_shift 24
892 #define Exp_shift1 24
893 #define Exp_msk1 0x1000000
894 #define Exp_msk11 0x1000000
895 #define Exp_mask 0x7f000000
896 #define P 14
897 #define Bias 65
898 #define Exp_1 0x41000000
899 #define Exp_11 0x41000000
900 #define Ebits 8 /* exponent has 7 bits, but 8 is the right value in b2d */
901 #define Frac_mask 0xffffff
902 #define Frac_mask1 0xffffff
903 #define Bletch 4
904 #define Ten_pmax 22
905 #define Bndry_mask 0xefffff
906 #define Bndry_mask1 0xffffff
907 #define LSB 1
908 #define Sign_bit 0x80000000
909 #define Log2P 4
910 #define Tiny0 0x100000
911 #define Tiny1 0
912 #define Quick_max 14
913 #define Int_max 15
914 #else /* VAX */
915 #undef Flt_Rounds
916 #define Flt_Rounds 1
917 #define Exp_shift 23
918 #define Exp_shift1 7
919 #define Exp_msk1 0x80
920 #define Exp_msk11 0x800000
921 #define Exp_mask 0x7f80
922 #define P 56
923 #define Bias 129
924 #define Exp_1 0x40800000
925 #define Exp_11 0x4080
926 #define Ebits 8
927 #define Frac_mask 0x7fffff
928 #define Frac_mask1 0xffff007f
929 #define Ten_pmax 24
930 #define Bletch 2
931 #define Bndry_mask 0xffff007f
932 #define Bndry_mask1 0xffff007f
933 #define LSB 0x10000
934 #define Sign_bit 0x8000
935 #define Log2P 1
936 #define Tiny0 0x80
937 #define Tiny1 0
938 #define Quick_max 15
939 #define Int_max 15
940 #endif /* IBM, VAX */
941 #endif /* IEEE_Arith */
942 
943 #ifndef IEEE_Arith
944 #define ROUND_BIASED
945 #endif
946 
947 #ifdef RND_PRODQUOT
948 #define rounded_product(a,b) ((a) = rnd_prod((a), (b)))
949 #define rounded_quotient(a,b) ((a) = rnd_quot((a), (b)))
950 extern double rnd_prod(double, double), rnd_quot(double, double);
951 #else
952 #define rounded_product(a,b) ((a) *= (b))
953 #define rounded_quotient(a,b) ((a) /= (b))
954 #endif
955 
956 #define Big0 (Frac_mask1 | Exp_msk1*(DBL_MAX_EXP+Bias-1))
957 #define Big1 0xffffffff
958 
959 #ifndef Pack_32
960 #define Pack_32
961 #endif
962 
963 #define FFFFFFFF 0xffffffffUL
964 
965 #ifdef NO_LONG_LONG
966 #undef ULLong
967 #ifdef Just_16
968 #undef Pack_32
969 /* When Pack_32 is not defined, we store 16 bits per 32-bit Long.
970  * This makes some inner loops simpler and sometimes saves work
971  * during multiplications, but it often seems to make things slightly
972  * slower. Hence the default is now to store 32 bits per Long.
973  */
974 #endif
975 #else /* long long available */
976 #ifndef Llong
977 #define Llong long long
978 #endif
979 #ifndef ULLong
980 #define ULLong unsigned Llong
981 #endif
982 #endif /* NO_LONG_LONG */
983 
984 #define MULTIPLE_THREADS 1
985 
986 #ifndef MULTIPLE_THREADS
987 #define ACQUIRE_DTOA_LOCK(n) /*nothing*/
988 #define FREE_DTOA_LOCK(n) /*nothing*/
989 #else
990 #define ACQUIRE_DTOA_LOCK(n) /*unused right now*/
991 #define FREE_DTOA_LOCK(n) /*unused right now*/
992 #endif
993 
994 #define Kmax 15
995 
996 struct Bigint {
997  struct Bigint *next;
998  int k, maxwds, sign, wds;
999  ULong x[1];
1000 };
1001 
1002 typedef struct Bigint Bigint;
1003 
1004 static Bigint *freelist[Kmax+1];
1005 
1006 static Bigint *
1007 Balloc(int k)
1008 {
1009  int x;
1010  Bigint *rv;
1011 #ifndef Omit_Private_Memory
1012  size_t len;
1013 #endif
1014 
1015  ACQUIRE_DTOA_LOCK(0);
1016  if (k <= Kmax && (rv = freelist[k]) != 0) {
1017  freelist[k] = rv->next;
1018  }
1019  else {
1020  x = 1 << k;
1021 #ifdef Omit_Private_Memory
1022  rv = (Bigint *)MALLOC(sizeof(Bigint) + (x-1)*sizeof(ULong));
1023 #else
1024  len = (sizeof(Bigint) + (x-1)*sizeof(ULong) + sizeof(double) - 1)
1025  /sizeof(double);
1026  if (k <= Kmax && pmem_next - private_mem + len <= PRIVATE_mem) {
1027  rv = (Bigint*)pmem_next;
1028  pmem_next += len;
1029  }
1030  else
1031  rv = (Bigint*)MALLOC(len*sizeof(double));
1032 #endif
1033  rv->k = k;
1034  rv->maxwds = x;
1035  }
1036  FREE_DTOA_LOCK(0);
1037  rv->sign = rv->wds = 0;
1038  return rv;
1039 }
1040 
1041 static void
1042 Bfree(Bigint *v)
1043 {
1044  if (v) {
1045  if (v->k > Kmax) {
1046  FREE(v);
1047  return;
1048  }
1049  ACQUIRE_DTOA_LOCK(0);
1050  v->next = freelist[v->k];
1051  freelist[v->k] = v;
1052  FREE_DTOA_LOCK(0);
1053  }
1054 }
1055 
1056 #define Bcopy(x,y) memcpy((char *)&(x)->sign, (char *)&(y)->sign, \
1057 (y)->wds*sizeof(Long) + 2*sizeof(int))
1058 
1059 static Bigint *
1060 multadd(Bigint *b, int m, int a) /* multiply by m and add a */
1061 {
1062  int i, wds;
1063  ULong *x;
1064 #ifdef ULLong
1065  ULLong carry, y;
1066 #else
1067  ULong carry, y;
1068 #ifdef Pack_32
1069  ULong xi, z;
1070 #endif
1071 #endif
1072  Bigint *b1;
1073 
1074  wds = b->wds;
1075  x = b->x;
1076  i = 0;
1077  carry = a;
1078  do {
1079 #ifdef ULLong
1080  y = *x * (ULLong)m + carry;
1081  carry = y >> 32;
1082  *x++ = (ULong)(y & FFFFFFFF);
1083 #else
1084 #ifdef Pack_32
1085  xi = *x;
1086  y = (xi & 0xffff) * m + carry;
1087  z = (xi >> 16) * m + (y >> 16);
1088  carry = z >> 16;
1089  *x++ = (z << 16) + (y & 0xffff);
1090 #else
1091  y = *x * m + carry;
1092  carry = y >> 16;
1093  *x++ = y & 0xffff;
1094 #endif
1095 #endif
1096  } while (++i < wds);
1097  if (carry) {
1098  if (wds >= b->maxwds) {
1099  b1 = Balloc(b->k+1);
1100  Bcopy(b1, b);
1101  Bfree(b);
1102  b = b1;
1103  }
1104  b->x[wds++] = (ULong)carry;
1105  b->wds = wds;
1106  }
1107  return b;
1108 }
1109 
1110 static Bigint *
1111 s2b(const char *s, int nd0, int nd, ULong y9)
1112 {
1113  Bigint *b;
1114  int i, k;
1115  Long x, y;
1116 
1117  x = (nd + 8) / 9;
1118  for (k = 0, y = 1; x > y; y <<= 1, k++) ;
1119 #ifdef Pack_32
1120  b = Balloc(k);
1121  b->x[0] = y9;
1122  b->wds = 1;
1123 #else
1124  b = Balloc(k+1);
1125  b->x[0] = y9 & 0xffff;
1126  b->wds = (b->x[1] = y9 >> 16) ? 2 : 1;
1127 #endif
1128 
1129  i = 9;
1130  if (9 < nd0) {
1131  s += 9;
1132  do {
1133  b = multadd(b, 10, *s++ - '0');
1134  } while (++i < nd0);
1135  s++;
1136  }
1137  else
1138  s += 10;
1139  for (; i < nd; i++)
1140  b = multadd(b, 10, *s++ - '0');
1141  return b;
1142 }
1143 
1144 static int
1145 hi0bits(register ULong x)
1146 {
1147  register int k = 0;
1148 
1149  if (!(x & 0xffff0000)) {
1150  k = 16;
1151  x <<= 16;
1152  }
1153  if (!(x & 0xff000000)) {
1154  k += 8;
1155  x <<= 8;
1156  }
1157  if (!(x & 0xf0000000)) {
1158  k += 4;
1159  x <<= 4;
1160  }
1161  if (!(x & 0xc0000000)) {
1162  k += 2;
1163  x <<= 2;
1164  }
1165  if (!(x & 0x80000000)) {
1166  k++;
1167  if (!(x & 0x40000000))
1168  return 32;
1169  }
1170  return k;
1171 }
1172 
1173 static int
1174 lo0bits(ULong *y)
1175 {
1176  register int k;
1177  register ULong x = *y;
1178 
1179  if (x & 7) {
1180  if (x & 1)
1181  return 0;
1182  if (x & 2) {
1183  *y = x >> 1;
1184  return 1;
1185  }
1186  *y = x >> 2;
1187  return 2;
1188  }
1189  k = 0;
1190  if (!(x & 0xffff)) {
1191  k = 16;
1192  x >>= 16;
1193  }
1194  if (!(x & 0xff)) {
1195  k += 8;
1196  x >>= 8;
1197  }
1198  if (!(x & 0xf)) {
1199  k += 4;
1200  x >>= 4;
1201  }
1202  if (!(x & 0x3)) {
1203  k += 2;
1204  x >>= 2;
1205  }
1206  if (!(x & 1)) {
1207  k++;
1208  x >>= 1;
1209  if (!x)
1210  return 32;
1211  }
1212  *y = x;
1213  return k;
1214 }
1215 
1216 static Bigint *
1217 i2b(int i)
1218 {
1219  Bigint *b;
1220 
1221  b = Balloc(1);
1222  b->x[0] = i;
1223  b->wds = 1;
1224  return b;
1225 }
1226 
1227 static Bigint *
1228 mult(Bigint *a, Bigint *b)
1229 {
1230  Bigint *c;
1231  int k, wa, wb, wc;
1232  ULong *x, *xa, *xae, *xb, *xbe, *xc, *xc0;
1233  ULong y;
1234 #ifdef ULLong
1235  ULLong carry, z;
1236 #else
1237  ULong carry, z;
1238 #ifdef Pack_32
1239  ULong z2;
1240 #endif
1241 #endif
1242 
1243  if (a->wds < b->wds) {
1244  c = a;
1245  a = b;
1246  b = c;
1247  }
1248  k = a->k;
1249  wa = a->wds;
1250  wb = b->wds;
1251  wc = wa + wb;
1252  if (wc > a->maxwds)
1253  k++;
1254  c = Balloc(k);
1255  for (x = c->x, xa = x + wc; x < xa; x++)
1256  *x = 0;
1257  xa = a->x;
1258  xae = xa + wa;
1259  xb = b->x;
1260  xbe = xb + wb;
1261  xc0 = c->x;
1262 #ifdef ULLong
1263  for (; xb < xbe; xc0++) {
1264  if ((y = *xb++) != 0) {
1265  x = xa;
1266  xc = xc0;
1267  carry = 0;
1268  do {
1269  z = *x++ * (ULLong)y + *xc + carry;
1270  carry = z >> 32;
1271  *xc++ = (ULong)(z & FFFFFFFF);
1272  } while (x < xae);
1273  *xc = (ULong)carry;
1274  }
1275  }
1276 #else
1277 #ifdef Pack_32
1278  for (; xb < xbe; xb++, xc0++) {
1279  if (y = *xb & 0xffff) {
1280  x = xa;
1281  xc = xc0;
1282  carry = 0;
1283  do {
1284  z = (*x & 0xffff) * y + (*xc & 0xffff) + carry;
1285  carry = z >> 16;
1286  z2 = (*x++ >> 16) * y + (*xc >> 16) + carry;
1287  carry = z2 >> 16;
1288  Storeinc(xc, z2, z);
1289  } while (x < xae);
1290  *xc = (ULong)carry;
1291  }
1292  if (y = *xb >> 16) {
1293  x = xa;
1294  xc = xc0;
1295  carry = 0;
1296  z2 = *xc;
1297  do {
1298  z = (*x & 0xffff) * y + (*xc >> 16) + carry;
1299  carry = z >> 16;
1300  Storeinc(xc, z, z2);
1301  z2 = (*x++ >> 16) * y + (*xc & 0xffff) + carry;
1302  carry = z2 >> 16;
1303  } while (x < xae);
1304  *xc = z2;
1305  }
1306  }
1307 #else
1308  for (; xb < xbe; xc0++) {
1309  if (y = *xb++) {
1310  x = xa;
1311  xc = xc0;
1312  carry = 0;
1313  do {
1314  z = *x++ * y + *xc + carry;
1315  carry = z >> 16;
1316  *xc++ = z & 0xffff;
1317  } while (x < xae);
1318  *xc = (ULong)carry;
1319  }
1320  }
1321 #endif
1322 #endif
1323  for (xc0 = c->x, xc = xc0 + wc; wc > 0 && !*--xc; --wc) ;
1324  c->wds = wc;
1325  return c;
1326 }
1327 
1328 static Bigint *p5s;
1329 
1330 static Bigint *
1331 pow5mult(Bigint *b, int k)
1332 {
1333  Bigint *b1, *p5, *p51;
1334  int i;
1335  static int p05[3] = { 5, 25, 125 };
1336 
1337  if ((i = k & 3) != 0)
1338  b = multadd(b, p05[i-1], 0);
1339 
1340  if (!(k >>= 2))
1341  return b;
1342  if (!(p5 = p5s)) {
1343  /* first time */
1344 #ifdef MULTIPLE_THREADS
1345  ACQUIRE_DTOA_LOCK(1);
1346  if (!(p5 = p5s)) {
1347  p5 = p5s = i2b(625);
1348  p5->next = 0;
1349  }
1350  FREE_DTOA_LOCK(1);
1351 #else
1352  p5 = p5s = i2b(625);
1353  p5->next = 0;
1354 #endif
1355  }
1356  for (;;) {
1357  if (k & 1) {
1358  b1 = mult(b, p5);
1359  Bfree(b);
1360  b = b1;
1361  }
1362  if (!(k >>= 1))
1363  break;
1364  if (!(p51 = p5->next)) {
1365 #ifdef MULTIPLE_THREADS
1366  ACQUIRE_DTOA_LOCK(1);
1367  if (!(p51 = p5->next)) {
1368  p51 = p5->next = mult(p5,p5);
1369  p51->next = 0;
1370  }
1371  FREE_DTOA_LOCK(1);
1372 #else
1373  p51 = p5->next = mult(p5,p5);
1374  p51->next = 0;
1375 #endif
1376  }
1377  p5 = p51;
1378  }
1379  return b;
1380 }
1381 
1382 static Bigint *
1383 lshift(Bigint *b, int k)
1384 {
1385  int i, k1, n, n1;
1386  Bigint *b1;
1387  ULong *x, *x1, *xe, z;
1388 
1389 #ifdef Pack_32
1390  n = k >> 5;
1391 #else
1392  n = k >> 4;
1393 #endif
1394  k1 = b->k;
1395  n1 = n + b->wds + 1;
1396  for (i = b->maxwds; n1 > i; i <<= 1)
1397  k1++;
1398  b1 = Balloc(k1);
1399  x1 = b1->x;
1400  for (i = 0; i < n; i++)
1401  *x1++ = 0;
1402  x = b->x;
1403  xe = x + b->wds;
1404 #ifdef Pack_32
1405  if (k &= 0x1f) {
1406  k1 = 32 - k;
1407  z = 0;
1408  do {
1409  *x1++ = *x << k | z;
1410  z = *x++ >> k1;
1411  } while (x < xe);
1412  if ((*x1 = z) != 0)
1413  ++n1;
1414  }
1415 #else
1416  if (k &= 0xf) {
1417  k1 = 16 - k;
1418  z = 0;
1419  do {
1420  *x1++ = *x << k & 0xffff | z;
1421  z = *x++ >> k1;
1422  } while (x < xe);
1423  if (*x1 = z)
1424  ++n1;
1425  }
1426 #endif
1427  else
1428  do {
1429  *x1++ = *x++;
1430  } while (x < xe);
1431  b1->wds = n1 - 1;
1432  Bfree(b);
1433  return b1;
1434 }
1435 
1436 static int
1437 cmp(Bigint *a, Bigint *b)
1438 {
1439  ULong *xa, *xa0, *xb, *xb0;
1440  int i, j;
1441 
1442  i = a->wds;
1443  j = b->wds;
1444 #ifdef DEBUG
1445  if (i > 1 && !a->x[i-1])
1446  Bug("cmp called with a->x[a->wds-1] == 0");
1447  if (j > 1 && !b->x[j-1])
1448  Bug("cmp called with b->x[b->wds-1] == 0");
1449 #endif
1450  if (i -= j)
1451  return i;
1452  xa0 = a->x;
1453  xa = xa0 + j;
1454  xb0 = b->x;
1455  xb = xb0 + j;
1456  for (;;) {
1457  if (*--xa != *--xb)
1458  return *xa < *xb ? -1 : 1;
1459  if (xa <= xa0)
1460  break;
1461  }
1462  return 0;
1463 }
1464 
1465 static Bigint *
1466 diff(Bigint *a, Bigint *b)
1467 {
1468  Bigint *c;
1469  int i, wa, wb;
1470  ULong *xa, *xae, *xb, *xbe, *xc;
1471 #ifdef ULLong
1472  ULLong borrow, y;
1473 #else
1474  ULong borrow, y;
1475 #ifdef Pack_32
1476  ULong z;
1477 #endif
1478 #endif
1479 
1480  i = cmp(a,b);
1481  if (!i) {
1482  c = Balloc(0);
1483  c->wds = 1;
1484  c->x[0] = 0;
1485  return c;
1486  }
1487  if (i < 0) {
1488  c = a;
1489  a = b;
1490  b = c;
1491  i = 1;
1492  }
1493  else
1494  i = 0;
1495  c = Balloc(a->k);
1496  c->sign = i;
1497  wa = a->wds;
1498  xa = a->x;
1499  xae = xa + wa;
1500  wb = b->wds;
1501  xb = b->x;
1502  xbe = xb + wb;
1503  xc = c->x;
1504  borrow = 0;
1505 #ifdef ULLong
1506  do {
1507  y = (ULLong)*xa++ - *xb++ - borrow;
1508  borrow = y >> 32 & (ULong)1;
1509  *xc++ = (ULong)(y & FFFFFFFF);
1510  } while (xb < xbe);
1511  while (xa < xae) {
1512  y = *xa++ - borrow;
1513  borrow = y >> 32 & (ULong)1;
1514  *xc++ = (ULong)(y & FFFFFFFF);
1515  }
1516 #else
1517 #ifdef Pack_32
1518  do {
1519  y = (*xa & 0xffff) - (*xb & 0xffff) - borrow;
1520  borrow = (y & 0x10000) >> 16;
1521  z = (*xa++ >> 16) - (*xb++ >> 16) - borrow;
1522  borrow = (z & 0x10000) >> 16;
1523  Storeinc(xc, z, y);
1524  } while (xb < xbe);
1525  while (xa < xae) {
1526  y = (*xa & 0xffff) - borrow;
1527  borrow = (y & 0x10000) >> 16;
1528  z = (*xa++ >> 16) - borrow;
1529  borrow = (z & 0x10000) >> 16;
1530  Storeinc(xc, z, y);
1531  }
1532 #else
1533  do {
1534  y = *xa++ - *xb++ - borrow;
1535  borrow = (y & 0x10000) >> 16;
1536  *xc++ = y & 0xffff;
1537  } while (xb < xbe);
1538  while (xa < xae) {
1539  y = *xa++ - borrow;
1540  borrow = (y & 0x10000) >> 16;
1541  *xc++ = y & 0xffff;
1542  }
1543 #endif
1544 #endif
1545  while (!*--xc)
1546  wa--;
1547  c->wds = wa;
1548  return c;
1549 }
1550 
1551 static double
1552 ulp(double x_)
1553 {
1554  register Long L;
1555  double_u x, a;
1556  dval(x) = x_;
1557 
1558  L = (word0(x) & Exp_mask) - (P-1)*Exp_msk1;
1559 #ifndef Avoid_Underflow
1560 #ifndef Sudden_Underflow
1561  if (L > 0) {
1562 #endif
1563 #endif
1564 #ifdef IBM
1565  L |= Exp_msk1 >> 4;
1566 #endif
1567  word0(a) = L;
1568  word1(a) = 0;
1569 #ifndef Avoid_Underflow
1570 #ifndef Sudden_Underflow
1571  }
1572  else {
1573  L = -L >> Exp_shift;
1574  if (L < Exp_shift) {
1575  word0(a) = 0x80000 >> L;
1576  word1(a) = 0;
1577  }
1578  else {
1579  word0(a) = 0;
1580  L -= Exp_shift;
1581  word1(a) = L >= 31 ? 1 : 1 << 31 - L;
1582  }
1583  }
1584 #endif
1585 #endif
1586  return dval(a);
1587 }
1588 
1589 static double
1590 b2d(Bigint *a, int *e)
1591 {
1592  ULong *xa, *xa0, w, y, z;
1593  int k;
1594  double_u d;
1595 #ifdef VAX
1596  ULong d0, d1;
1597 #else
1598 #define d0 word0(d)
1599 #define d1 word1(d)
1600 #endif
1601 
1602  xa0 = a->x;
1603  xa = xa0 + a->wds;
1604  y = *--xa;
1605 #ifdef DEBUG
1606  if (!y) Bug("zero y in b2d");
1607 #endif
1608  k = hi0bits(y);
1609  *e = 32 - k;
1610 #ifdef Pack_32
1611  if (k < Ebits) {
1612  d0 = Exp_1 | y >> (Ebits - k);
1613  w = xa > xa0 ? *--xa : 0;
1614  d1 = y << ((32-Ebits) + k) | w >> (Ebits - k);
1615  goto ret_d;
1616  }
1617  z = xa > xa0 ? *--xa : 0;
1618  if (k -= Ebits) {
1619  d0 = Exp_1 | y << k | z >> (32 - k);
1620  y = xa > xa0 ? *--xa : 0;
1621  d1 = z << k | y >> (32 - k);
1622  }
1623  else {
1624  d0 = Exp_1 | y;
1625  d1 = z;
1626  }
1627 #else
1628  if (k < Ebits + 16) {
1629  z = xa > xa0 ? *--xa : 0;
1630  d0 = Exp_1 | y << k - Ebits | z >> Ebits + 16 - k;
1631  w = xa > xa0 ? *--xa : 0;
1632  y = xa > xa0 ? *--xa : 0;
1633  d1 = z << k + 16 - Ebits | w << k - Ebits | y >> 16 + Ebits - k;
1634  goto ret_d;
1635  }
1636  z = xa > xa0 ? *--xa : 0;
1637  w = xa > xa0 ? *--xa : 0;
1638  k -= Ebits + 16;
1639  d0 = Exp_1 | y << k + 16 | z << k | w >> 16 - k;
1640  y = xa > xa0 ? *--xa : 0;
1641  d1 = w << k + 16 | y << k;
1642 #endif
1643 ret_d:
1644 #ifdef VAX
1645  word0(d) = d0 >> 16 | d0 << 16;
1646  word1(d) = d1 >> 16 | d1 << 16;
1647 #else
1648 #undef d0
1649 #undef d1
1650 #endif
1651  return dval(d);
1652 }
1653 
1654 static Bigint *
1655 d2b(double d_, int *e, int *bits)
1656 {
1657  double_u d;
1658  Bigint *b;
1659  int de, k;
1660  ULong *x, y, z;
1661 #ifndef Sudden_Underflow
1662  int i;
1663 #endif
1664 #ifdef VAX
1665  ULong d0, d1;
1666 #endif
1667  dval(d) = d_;
1668 #ifdef VAX
1669  d0 = word0(d) >> 16 | word0(d) << 16;
1670  d1 = word1(d) >> 16 | word1(d) << 16;
1671 #else
1672 #define d0 word0(d)
1673 #define d1 word1(d)
1674 #endif
1675 
1676 #ifdef Pack_32
1677  b = Balloc(1);
1678 #else
1679  b = Balloc(2);
1680 #endif
1681  x = b->x;
1682 
1683  z = d0 & Frac_mask;
1684  d0 &= 0x7fffffff; /* clear sign bit, which we ignore */
1685 #ifdef Sudden_Underflow
1686  de = (int)(d0 >> Exp_shift);
1687 #ifndef IBM
1688  z |= Exp_msk11;
1689 #endif
1690 #else
1691  if ((de = (int)(d0 >> Exp_shift)) != 0)
1692  z |= Exp_msk1;
1693 #endif
1694 #ifdef Pack_32
1695  if ((y = d1) != 0) {
1696  if ((k = lo0bits(&y)) != 0) {
1697  x[0] = y | z << (32 - k);
1698  z >>= k;
1699  }
1700  else
1701  x[0] = y;
1702 #ifndef Sudden_Underflow
1703  i =
1704 #endif
1705  b->wds = (x[1] = z) ? 2 : 1;
1706  }
1707  else {
1708 #ifdef DEBUG
1709  if (!z)
1710  Bug("Zero passed to d2b");
1711 #endif
1712  k = lo0bits(&z);
1713  x[0] = z;
1714 #ifndef Sudden_Underflow
1715  i =
1716 #endif
1717  b->wds = 1;
1718  k += 32;
1719  }
1720 #else
1721  if (y = d1) {
1722  if (k = lo0bits(&y))
1723  if (k >= 16) {
1724  x[0] = y | z << 32 - k & 0xffff;
1725  x[1] = z >> k - 16 & 0xffff;
1726  x[2] = z >> k;
1727  i = 2;
1728  }
1729  else {
1730  x[0] = y & 0xffff;
1731  x[1] = y >> 16 | z << 16 - k & 0xffff;
1732  x[2] = z >> k & 0xffff;
1733  x[3] = z >> k+16;
1734  i = 3;
1735  }
1736  else {
1737  x[0] = y & 0xffff;
1738  x[1] = y >> 16;
1739  x[2] = z & 0xffff;
1740  x[3] = z >> 16;
1741  i = 3;
1742  }
1743  }
1744  else {
1745 #ifdef DEBUG
1746  if (!z)
1747  Bug("Zero passed to d2b");
1748 #endif
1749  k = lo0bits(&z);
1750  if (k >= 16) {
1751  x[0] = z;
1752  i = 0;
1753  }
1754  else {
1755  x[0] = z & 0xffff;
1756  x[1] = z >> 16;
1757  i = 1;
1758  }
1759  k += 32;
1760  }
1761  while (!x[i])
1762  --i;
1763  b->wds = i + 1;
1764 #endif
1765 #ifndef Sudden_Underflow
1766  if (de) {
1767 #endif
1768 #ifdef IBM
1769  *e = (de - Bias - (P-1) << 2) + k;
1770  *bits = 4*P + 8 - k - hi0bits(word0(d) & Frac_mask);
1771 #else
1772  *e = de - Bias - (P-1) + k;
1773  *bits = P - k;
1774 #endif
1775 #ifndef Sudden_Underflow
1776  }
1777  else {
1778  *e = de - Bias - (P-1) + 1 + k;
1779 #ifdef Pack_32
1780  *bits = 32*i - hi0bits(x[i-1]);
1781 #else
1782  *bits = (i+2)*16 - hi0bits(x[i]);
1783 #endif
1784  }
1785 #endif
1786  return b;
1787 }
1788 #undef d0
1789 #undef d1
1790 
1791 static double
1792 ratio(Bigint *a, Bigint *b)
1793 {
1794  double_u da, db;
1795  int k, ka, kb;
1796 
1797  dval(da) = b2d(a, &ka);
1798  dval(db) = b2d(b, &kb);
1799 #ifdef Pack_32
1800  k = ka - kb + 32*(a->wds - b->wds);
1801 #else
1802  k = ka - kb + 16*(a->wds - b->wds);
1803 #endif
1804 #ifdef IBM
1805  if (k > 0) {
1806  word0(da) += (k >> 2)*Exp_msk1;
1807  if (k &= 3)
1808  dval(da) *= 1 << k;
1809  }
1810  else {
1811  k = -k;
1812  word0(db) += (k >> 2)*Exp_msk1;
1813  if (k &= 3)
1814  dval(db) *= 1 << k;
1815  }
1816 #else
1817  if (k > 0)
1818  word0(da) += k*Exp_msk1;
1819  else {
1820  k = -k;
1821  word0(db) += k*Exp_msk1;
1822  }
1823 #endif
1824  return dval(da) / dval(db);
1825 }
1826 
1827 static const double
1828 tens[] = {
1829  1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9,
1830  1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19,
1831  1e20, 1e21, 1e22
1832 #ifdef VAX
1833  , 1e23, 1e24
1834 #endif
1835 };
1836 
1837 static const double
1838 #ifdef IEEE_Arith
1839 bigtens[] = { 1e16, 1e32, 1e64, 1e128, 1e256 };
1840 static const double tinytens[] = { 1e-16, 1e-32, 1e-64, 1e-128,
1841 #ifdef Avoid_Underflow
1842  9007199254740992.*9007199254740992.e-256
1843  /* = 2^106 * 1e-53 */
1844 #else
1845  1e-256
1846 #endif
1847 };
1848 /* The factor of 2^53 in tinytens[4] helps us avoid setting the underflow */
1849 /* flag unnecessarily. It leads to a song and dance at the end of strtod. */
1850 #define Scale_Bit 0x10
1851 #define n_bigtens 5
1852 #else
1853 #ifdef IBM
1854 bigtens[] = { 1e16, 1e32, 1e64 };
1855 static const double tinytens[] = { 1e-16, 1e-32, 1e-64 };
1856 #define n_bigtens 3
1857 #else
1858 bigtens[] = { 1e16, 1e32 };
1859 static const double tinytens[] = { 1e-16, 1e-32 };
1860 #define n_bigtens 2
1861 #endif
1862 #endif
1863 
1864 #ifndef IEEE_Arith
1865 #undef INFNAN_CHECK
1866 #endif
1867 
1868 #ifdef INFNAN_CHECK
1869 
1870 #ifndef NAN_WORD0
1871 #define NAN_WORD0 0x7ff80000
1872 #endif
1873 
1874 #ifndef NAN_WORD1
1875 #define NAN_WORD1 0
1876 #endif
1877 
1878 static int
1879 match(const char **sp, char *t)
1880 {
1881  int c, d;
1882  const char *s = *sp;
1883 
1884  while (d = *t++) {
1885  if ((c = *++s) >= 'A' && c <= 'Z')
1886  c += 'a' - 'A';
1887  if (c != d)
1888  return 0;
1889  }
1890  *sp = s + 1;
1891  return 1;
1892 }
1893 
1894 #ifndef No_Hex_NaN
1895 static void
1896 hexnan(double *rvp, const char **sp)
1897 {
1898  ULong c, x[2];
1899  const char *s;
1900  int havedig, udx0, xshift;
1901 
1902  x[0] = x[1] = 0;
1903  havedig = xshift = 0;
1904  udx0 = 1;
1905  s = *sp;
1906  while (c = *(const unsigned char*)++s) {
1907  if (c >= '0' && c <= '9')
1908  c -= '0';
1909  else if (c >= 'a' && c <= 'f')
1910  c += 10 - 'a';
1911  else if (c >= 'A' && c <= 'F')
1912  c += 10 - 'A';
1913  else if (c <= ' ') {
1914  if (udx0 && havedig) {
1915  udx0 = 0;
1916  xshift = 1;
1917  }
1918  continue;
1919  }
1920  else if (/*(*/ c == ')' && havedig) {
1921  *sp = s + 1;
1922  break;
1923  }
1924  else
1925  return; /* invalid form: don't change *sp */
1926  havedig = 1;
1927  if (xshift) {
1928  xshift = 0;
1929  x[0] = x[1];
1930  x[1] = 0;
1931  }
1932  if (udx0)
1933  x[0] = (x[0] << 4) | (x[1] >> 28);
1934  x[1] = (x[1] << 4) | c;
1935  }
1936  if ((x[0] &= 0xfffff) || x[1]) {
1937  word0(*rvp) = Exp_mask | x[0];
1938  word1(*rvp) = x[1];
1939  }
1940 }
1941 #endif /*No_Hex_NaN*/
1942 #endif /* INFNAN_CHECK */
1943 
1944 double
1945 ruby_strtod(const char *s00, char **se)
1946 {
1947 #ifdef Avoid_Underflow
1948  int scale;
1949 #endif
1950  int bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, dsign,
1951  e, e1, esign, i, j, k, nd, nd0, nf, nz, nz0, sign;
1952  const char *s, *s0, *s1;
1953  double aadj, adj;
1954  double_u aadj1, rv, rv0;
1955  Long L;
1956  ULong y, z;
1957  Bigint *bb, *bb1, *bd, *bd0, *bs, *delta;
1958 #ifdef SET_INEXACT
1959  int inexact, oldinexact;
1960 #endif
1961 #ifdef Honor_FLT_ROUNDS
1962  int rounding;
1963 #endif
1964 #ifdef USE_LOCALE
1965  const char *s2;
1966 #endif
1967 
1968  errno = 0;
1969  sign = nz0 = nz = 0;
1970  dval(rv) = 0.;
1971  for (s = s00;;s++)
1972  switch (*s) {
1973  case '-':
1974  sign = 1;
1975  /* no break */
1976  case '+':
1977  if (*++s)
1978  goto break2;
1979  /* no break */
1980  case 0:
1981  goto ret0;
1982  case '\t':
1983  case '\n':
1984  case '\v':
1985  case '\f':
1986  case '\r':
1987  case ' ':
1988  continue;
1989  default:
1990  goto break2;
1991  }
1992 break2:
1993  if (*s == '0') {
1994  if (s[1] == 'x' || s[1] == 'X') {
1995  static const char hexdigit[] = "0123456789abcdef0123456789ABCDEF";
1996  s0 = ++s;
1997  adj = 0;
1998  aadj = 1.0;
1999  nd0 = -4;
2000 
2001  if (!*++s || !(s1 = strchr(hexdigit, *s))) goto ret0;
2002  if (*s == '0') {
2003  while (*++s == '0');
2004  s1 = strchr(hexdigit, *s);
2005  }
2006  if (s1 != NULL) {
2007  do {
2008  adj += aadj * ((s1 - hexdigit) & 15);
2009  nd0 += 4;
2010  aadj /= 16;
2011  } while (*++s && (s1 = strchr(hexdigit, *s)));
2012  }
2013 
2014  if (*s == '.') {
2015  dsign = 1;
2016  if (!*++s || !(s1 = strchr(hexdigit, *s))) goto ret0;
2017  if (nd0 < 0) {
2018  while (*s == '0') {
2019  s++;
2020  nd0 -= 4;
2021  }
2022  }
2023  for (; *s && (s1 = strchr(hexdigit, *s)); ++s) {
2024  adj += aadj * ((s1 - hexdigit) & 15);
2025  if ((aadj /= 16) == 0.0) {
2026  while (strchr(hexdigit, *++s));
2027  break;
2028  }
2029  }
2030  }
2031  else {
2032  dsign = 0;
2033  }
2034 
2035  if (*s == 'P' || *s == 'p') {
2036  dsign = 0x2C - *++s; /* +: 2B, -: 2D */
2037  if (abs(dsign) == 1) s++;
2038  else dsign = 1;
2039 
2040  nd = 0;
2041  c = *s;
2042  if (c < '0' || '9' < c) goto ret0;
2043  do {
2044  nd *= 10;
2045  nd += c;
2046  nd -= '0';
2047  c = *++s;
2048  /* Float("0x0."+("0"*267)+"1fp2095") */
2049  if (nd + dsign * nd0 > 2095) {
2050  while ('0' <= c && c <= '9') c = *++s;
2051  break;
2052  }
2053  } while ('0' <= c && c <= '9');
2054  nd0 += nd * dsign;
2055  }
2056  else {
2057  if (dsign) goto ret0;
2058  }
2059  dval(rv) = ldexp(adj, nd0);
2060  goto ret;
2061  }
2062  nz0 = 1;
2063  while (*++s == '0') ;
2064  if (!*s)
2065  goto ret;
2066  }
2067  s0 = s;
2068  y = z = 0;
2069  for (nd = nf = 0; (c = *s) >= '0' && c <= '9'; nd++, s++)
2070  if (nd < 9)
2071  y = 10*y + c - '0';
2072  else if (nd < 16)
2073  z = 10*z + c - '0';
2074  nd0 = nd;
2075 #ifdef USE_LOCALE
2076  s1 = localeconv()->decimal_point;
2077  if (c == *s1) {
2078  c = '.';
2079  if (*++s1) {
2080  s2 = s;
2081  for (;;) {
2082  if (*++s2 != *s1) {
2083  c = 0;
2084  break;
2085  }
2086  if (!*++s1) {
2087  s = s2;
2088  break;
2089  }
2090  }
2091  }
2092  }
2093 #endif
2094  if (c == '.') {
2095  if (!ISDIGIT(s[1]))
2096  goto dig_done;
2097  c = *++s;
2098  if (!nd) {
2099  for (; c == '0'; c = *++s)
2100  nz++;
2101  if (c > '0' && c <= '9') {
2102  s0 = s;
2103  nf += nz;
2104  nz = 0;
2105  goto have_dig;
2106  }
2107  goto dig_done;
2108  }
2109  for (; c >= '0' && c <= '9'; c = *++s) {
2110 have_dig:
2111  nz++;
2112  if (nf > DBL_DIG * 4) continue;
2113  if (c -= '0') {
2114  nf += nz;
2115  for (i = 1; i < nz; i++)
2116  if (nd++ < 9)
2117  y *= 10;
2118  else if (nd <= DBL_DIG + 1)
2119  z *= 10;
2120  if (nd++ < 9)
2121  y = 10*y + c;
2122  else if (nd <= DBL_DIG + 1)
2123  z = 10*z + c;
2124  nz = 0;
2125  }
2126  }
2127  }
2128 dig_done:
2129  e = 0;
2130  if (c == 'e' || c == 'E') {
2131  if (!nd && !nz && !nz0) {
2132  goto ret0;
2133  }
2134  s00 = s;
2135  esign = 0;
2136  switch (c = *++s) {
2137  case '-':
2138  esign = 1;
2139  case '+':
2140  c = *++s;
2141  }
2142  if (c >= '0' && c <= '9') {
2143  while (c == '0')
2144  c = *++s;
2145  if (c > '0' && c <= '9') {
2146  L = c - '0';
2147  s1 = s;
2148  while ((c = *++s) >= '0' && c <= '9')
2149  L = 10*L + c - '0';
2150  if (s - s1 > 8 || L > 19999)
2151  /* Avoid confusion from exponents
2152  * so large that e might overflow.
2153  */
2154  e = 19999; /* safe for 16 bit ints */
2155  else
2156  e = (int)L;
2157  if (esign)
2158  e = -e;
2159  }
2160  else
2161  e = 0;
2162  }
2163  else
2164  s = s00;
2165  }
2166  if (!nd) {
2167  if (!nz && !nz0) {
2168 #ifdef INFNAN_CHECK
2169  /* Check for Nan and Infinity */
2170  switch (c) {
2171  case 'i':
2172  case 'I':
2173  if (match(&s,"nf")) {
2174  --s;
2175  if (!match(&s,"inity"))
2176  ++s;
2177  word0(rv) = 0x7ff00000;
2178  word1(rv) = 0;
2179  goto ret;
2180  }
2181  break;
2182  case 'n':
2183  case 'N':
2184  if (match(&s, "an")) {
2185  word0(rv) = NAN_WORD0;
2186  word1(rv) = NAN_WORD1;
2187 #ifndef No_Hex_NaN
2188  if (*s == '(') /*)*/
2189  hexnan(&rv, &s);
2190 #endif
2191  goto ret;
2192  }
2193  }
2194 #endif /* INFNAN_CHECK */
2195 ret0:
2196  s = s00;
2197  sign = 0;
2198  }
2199  goto ret;
2200  }
2201  e1 = e -= nf;
2202 
2203  /* Now we have nd0 digits, starting at s0, followed by a
2204  * decimal point, followed by nd-nd0 digits. The number we're
2205  * after is the integer represented by those digits times
2206  * 10**e */
2207 
2208  if (!nd0)
2209  nd0 = nd;
2210  k = nd < DBL_DIG + 1 ? nd : DBL_DIG + 1;
2211  dval(rv) = y;
2212  if (k > 9) {
2213 #ifdef SET_INEXACT
2214  if (k > DBL_DIG)
2215  oldinexact = get_inexact();
2216 #endif
2217  dval(rv) = tens[k - 9] * dval(rv) + z;
2218  }
2219  bd0 = bb = bd = bs = delta = 0;
2220  if (nd <= DBL_DIG
2221 #ifndef RND_PRODQUOT
2222 #ifndef Honor_FLT_ROUNDS
2223  && Flt_Rounds == 1
2224 #endif
2225 #endif
2226  ) {
2227  if (!e)
2228  goto ret;
2229  if (e > 0) {
2230  if (e <= Ten_pmax) {
2231 #ifdef VAX
2232  goto vax_ovfl_check;
2233 #else
2234 #ifdef Honor_FLT_ROUNDS
2235  /* round correctly FLT_ROUNDS = 2 or 3 */
2236  if (sign) {
2237  dval(rv) = -dval(rv);
2238  sign = 0;
2239  }
2240 #endif
2241  /* rv = */ rounded_product(dval(rv), tens[e]);
2242  goto ret;
2243 #endif
2244  }
2245  i = DBL_DIG - nd;
2246  if (e <= Ten_pmax + i) {
2247  /* A fancier test would sometimes let us do
2248  * this for larger i values.
2249  */
2250 #ifdef Honor_FLT_ROUNDS
2251  /* round correctly FLT_ROUNDS = 2 or 3 */
2252  if (sign) {
2253  dval(rv) = -dval(rv);
2254  sign = 0;
2255  }
2256 #endif
2257  e -= i;
2258  dval(rv) *= tens[i];
2259 #ifdef VAX
2260  /* VAX exponent range is so narrow we must
2261  * worry about overflow here...
2262  */
2263 vax_ovfl_check:
2264  word0(rv) -= P*Exp_msk1;
2265  /* rv = */ rounded_product(dval(rv), tens[e]);
2266  if ((word0(rv) & Exp_mask)
2267  > Exp_msk1*(DBL_MAX_EXP+Bias-1-P))
2268  goto ovfl;
2269  word0(rv) += P*Exp_msk1;
2270 #else
2271  /* rv = */ rounded_product(dval(rv), tens[e]);
2272 #endif
2273  goto ret;
2274  }
2275  }
2276 #ifndef Inaccurate_Divide
2277  else if (e >= -Ten_pmax) {
2278 #ifdef Honor_FLT_ROUNDS
2279  /* round correctly FLT_ROUNDS = 2 or 3 */
2280  if (sign) {
2281  dval(rv) = -dval(rv);
2282  sign = 0;
2283  }
2284 #endif
2285  /* rv = */ rounded_quotient(dval(rv), tens[-e]);
2286  goto ret;
2287  }
2288 #endif
2289  }
2290  e1 += nd - k;
2291 
2292 #ifdef IEEE_Arith
2293 #ifdef SET_INEXACT
2294  inexact = 1;
2295  if (k <= DBL_DIG)
2296  oldinexact = get_inexact();
2297 #endif
2298 #ifdef Avoid_Underflow
2299  scale = 0;
2300 #endif
2301 #ifdef Honor_FLT_ROUNDS
2302  if ((rounding = Flt_Rounds) >= 2) {
2303  if (sign)
2304  rounding = rounding == 2 ? 0 : 2;
2305  else
2306  if (rounding != 2)
2307  rounding = 0;
2308  }
2309 #endif
2310 #endif /*IEEE_Arith*/
2311 
2312  /* Get starting approximation = rv * 10**e1 */
2313 
2314  if (e1 > 0) {
2315  if ((i = e1 & 15) != 0)
2316  dval(rv) *= tens[i];
2317  if (e1 &= ~15) {
2318  if (e1 > DBL_MAX_10_EXP) {
2319 ovfl:
2320 #ifndef NO_ERRNO
2321  errno = ERANGE;
2322 #endif
2323  /* Can't trust HUGE_VAL */
2324 #ifdef IEEE_Arith
2325 #ifdef Honor_FLT_ROUNDS
2326  switch (rounding) {
2327  case 0: /* toward 0 */
2328  case 3: /* toward -infinity */
2329  word0(rv) = Big0;
2330  word1(rv) = Big1;
2331  break;
2332  default:
2333  word0(rv) = Exp_mask;
2334  word1(rv) = 0;
2335  }
2336 #else /*Honor_FLT_ROUNDS*/
2337  word0(rv) = Exp_mask;
2338  word1(rv) = 0;
2339 #endif /*Honor_FLT_ROUNDS*/
2340 #ifdef SET_INEXACT
2341  /* set overflow bit */
2342  dval(rv0) = 1e300;
2343  dval(rv0) *= dval(rv0);
2344 #endif
2345 #else /*IEEE_Arith*/
2346  word0(rv) = Big0;
2347  word1(rv) = Big1;
2348 #endif /*IEEE_Arith*/
2349  if (bd0)
2350  goto retfree;
2351  goto ret;
2352  }
2353  e1 >>= 4;
2354  for (j = 0; e1 > 1; j++, e1 >>= 1)
2355  if (e1 & 1)
2356  dval(rv) *= bigtens[j];
2357  /* The last multiplication could overflow. */
2358  word0(rv) -= P*Exp_msk1;
2359  dval(rv) *= bigtens[j];
2360  if ((z = word0(rv) & Exp_mask)
2361  > Exp_msk1*(DBL_MAX_EXP+Bias-P))
2362  goto ovfl;
2363  if (z > Exp_msk1*(DBL_MAX_EXP+Bias-1-P)) {
2364  /* set to largest number */
2365  /* (Can't trust DBL_MAX) */
2366  word0(rv) = Big0;
2367  word1(rv) = Big1;
2368  }
2369  else
2370  word0(rv) += P*Exp_msk1;
2371  }
2372  }
2373  else if (e1 < 0) {
2374  e1 = -e1;
2375  if ((i = e1 & 15) != 0)
2376  dval(rv) /= tens[i];
2377  if (e1 >>= 4) {
2378  if (e1 >= 1 << n_bigtens)
2379  goto undfl;
2380 #ifdef Avoid_Underflow
2381  if (e1 & Scale_Bit)
2382  scale = 2*P;
2383  for (j = 0; e1 > 0; j++, e1 >>= 1)
2384  if (e1 & 1)
2385  dval(rv) *= tinytens[j];
2386  if (scale && (j = 2*P + 1 - ((word0(rv) & Exp_mask)
2387  >> Exp_shift)) > 0) {
2388  /* scaled rv is denormal; zap j low bits */
2389  if (j >= 32) {
2390  word1(rv) = 0;
2391  if (j >= 53)
2392  word0(rv) = (P+2)*Exp_msk1;
2393  else
2394  word0(rv) &= 0xffffffff << (j-32);
2395  }
2396  else
2397  word1(rv) &= 0xffffffff << j;
2398  }
2399 #else
2400  for (j = 0; e1 > 1; j++, e1 >>= 1)
2401  if (e1 & 1)
2402  dval(rv) *= tinytens[j];
2403  /* The last multiplication could underflow. */
2404  dval(rv0) = dval(rv);
2405  dval(rv) *= tinytens[j];
2406  if (!dval(rv)) {
2407  dval(rv) = 2.*dval(rv0);
2408  dval(rv) *= tinytens[j];
2409 #endif
2410  if (!dval(rv)) {
2411 undfl:
2412  dval(rv) = 0.;
2413 #ifndef NO_ERRNO
2414  errno = ERANGE;
2415 #endif
2416  if (bd0)
2417  goto retfree;
2418  goto ret;
2419  }
2420 #ifndef Avoid_Underflow
2421  word0(rv) = Tiny0;
2422  word1(rv) = Tiny1;
2423  /* The refinement below will clean
2424  * this approximation up.
2425  */
2426  }
2427 #endif
2428  }
2429  }
2430 
2431  /* Now the hard part -- adjusting rv to the correct value.*/
2432 
2433  /* Put digits into bd: true value = bd * 10^e */
2434 
2435  bd0 = s2b(s0, nd0, nd, y);
2436 
2437  for (;;) {
2438  bd = Balloc(bd0->k);
2439  Bcopy(bd, bd0);
2440  bb = d2b(dval(rv), &bbe, &bbbits); /* rv = bb * 2^bbe */
2441  bs = i2b(1);
2442 
2443  if (e >= 0) {
2444  bb2 = bb5 = 0;
2445  bd2 = bd5 = e;
2446  }
2447  else {
2448  bb2 = bb5 = -e;
2449  bd2 = bd5 = 0;
2450  }
2451  if (bbe >= 0)
2452  bb2 += bbe;
2453  else
2454  bd2 -= bbe;
2455  bs2 = bb2;
2456 #ifdef Honor_FLT_ROUNDS
2457  if (rounding != 1)
2458  bs2++;
2459 #endif
2460 #ifdef Avoid_Underflow
2461  j = bbe - scale;
2462  i = j + bbbits - 1; /* logb(rv) */
2463  if (i < Emin) /* denormal */
2464  j += P - Emin;
2465  else
2466  j = P + 1 - bbbits;
2467 #else /*Avoid_Underflow*/
2468 #ifdef Sudden_Underflow
2469 #ifdef IBM
2470  j = 1 + 4*P - 3 - bbbits + ((bbe + bbbits - 1) & 3);
2471 #else
2472  j = P + 1 - bbbits;
2473 #endif
2474 #else /*Sudden_Underflow*/
2475  j = bbe;
2476  i = j + bbbits - 1; /* logb(rv) */
2477  if (i < Emin) /* denormal */
2478  j += P - Emin;
2479  else
2480  j = P + 1 - bbbits;
2481 #endif /*Sudden_Underflow*/
2482 #endif /*Avoid_Underflow*/
2483  bb2 += j;
2484  bd2 += j;
2485 #ifdef Avoid_Underflow
2486  bd2 += scale;
2487 #endif
2488  i = bb2 < bd2 ? bb2 : bd2;
2489  if (i > bs2)
2490  i = bs2;
2491  if (i > 0) {
2492  bb2 -= i;
2493  bd2 -= i;
2494  bs2 -= i;
2495  }
2496  if (bb5 > 0) {
2497  bs = pow5mult(bs, bb5);
2498  bb1 = mult(bs, bb);
2499  Bfree(bb);
2500  bb = bb1;
2501  }
2502  if (bb2 > 0)
2503  bb = lshift(bb, bb2);
2504  if (bd5 > 0)
2505  bd = pow5mult(bd, bd5);
2506  if (bd2 > 0)
2507  bd = lshift(bd, bd2);
2508  if (bs2 > 0)
2509  bs = lshift(bs, bs2);
2510  delta = diff(bb, bd);
2511  dsign = delta->sign;
2512  delta->sign = 0;
2513  i = cmp(delta, bs);
2514 #ifdef Honor_FLT_ROUNDS
2515  if (rounding != 1) {
2516  if (i < 0) {
2517  /* Error is less than an ulp */
2518  if (!delta->x[0] && delta->wds <= 1) {
2519  /* exact */
2520 #ifdef SET_INEXACT
2521  inexact = 0;
2522 #endif
2523  break;
2524  }
2525  if (rounding) {
2526  if (dsign) {
2527  adj = 1.;
2528  goto apply_adj;
2529  }
2530  }
2531  else if (!dsign) {
2532  adj = -1.;
2533  if (!word1(rv)
2534  && !(word0(rv) & Frac_mask)) {
2535  y = word0(rv) & Exp_mask;
2536 #ifdef Avoid_Underflow
2537  if (!scale || y > 2*P*Exp_msk1)
2538 #else
2539  if (y)
2540 #endif
2541  {
2542  delta = lshift(delta,Log2P);
2543  if (cmp(delta, bs) <= 0)
2544  adj = -0.5;
2545  }
2546  }
2547 apply_adj:
2548 #ifdef Avoid_Underflow
2549  if (scale && (y = word0(rv) & Exp_mask)
2550  <= 2*P*Exp_msk1)
2551  word0(adj) += (2*P+1)*Exp_msk1 - y;
2552 #else
2553 #ifdef Sudden_Underflow
2554  if ((word0(rv) & Exp_mask) <=
2555  P*Exp_msk1) {
2556  word0(rv) += P*Exp_msk1;
2557  dval(rv) += adj*ulp(dval(rv));
2558  word0(rv) -= P*Exp_msk1;
2559  }
2560  else
2561 #endif /*Sudden_Underflow*/
2562 #endif /*Avoid_Underflow*/
2563  dval(rv) += adj*ulp(dval(rv));
2564  }
2565  break;
2566  }
2567  adj = ratio(delta, bs);
2568  if (adj < 1.)
2569  adj = 1.;
2570  if (adj <= 0x7ffffffe) {
2571  /* adj = rounding ? ceil(adj) : floor(adj); */
2572  y = adj;
2573  if (y != adj) {
2574  if (!((rounding>>1) ^ dsign))
2575  y++;
2576  adj = y;
2577  }
2578  }
2579 #ifdef Avoid_Underflow
2580  if (scale && (y = word0(rv) & Exp_mask) <= 2*P*Exp_msk1)
2581  word0(adj) += (2*P+1)*Exp_msk1 - y;
2582 #else
2583 #ifdef Sudden_Underflow
2584  if ((word0(rv) & Exp_mask) <= P*Exp_msk1) {
2585  word0(rv) += P*Exp_msk1;
2586  adj *= ulp(dval(rv));
2587  if (dsign)
2588  dval(rv) += adj;
2589  else
2590  dval(rv) -= adj;
2591  word0(rv) -= P*Exp_msk1;
2592  goto cont;
2593  }
2594 #endif /*Sudden_Underflow*/
2595 #endif /*Avoid_Underflow*/
2596  adj *= ulp(dval(rv));
2597  if (dsign)
2598  dval(rv) += adj;
2599  else
2600  dval(rv) -= adj;
2601  goto cont;
2602  }
2603 #endif /*Honor_FLT_ROUNDS*/
2604 
2605  if (i < 0) {
2606  /* Error is less than half an ulp -- check for
2607  * special case of mantissa a power of two.
2608  */
2609  if (dsign || word1(rv) || word0(rv) & Bndry_mask
2610 #ifdef IEEE_Arith
2611 #ifdef Avoid_Underflow
2612  || (word0(rv) & Exp_mask) <= (2*P+1)*Exp_msk1
2613 #else
2614  || (word0(rv) & Exp_mask) <= Exp_msk1
2615 #endif
2616 #endif
2617  ) {
2618 #ifdef SET_INEXACT
2619  if (!delta->x[0] && delta->wds <= 1)
2620  inexact = 0;
2621 #endif
2622  break;
2623  }
2624  if (!delta->x[0] && delta->wds <= 1) {
2625  /* exact result */
2626 #ifdef SET_INEXACT
2627  inexact = 0;
2628 #endif
2629  break;
2630  }
2631  delta = lshift(delta,Log2P);
2632  if (cmp(delta, bs) > 0)
2633  goto drop_down;
2634  break;
2635  }
2636  if (i == 0) {
2637  /* exactly half-way between */
2638  if (dsign) {
2639  if ((word0(rv) & Bndry_mask1) == Bndry_mask1
2640  && word1(rv) == (
2641 #ifdef Avoid_Underflow
2642  (scale && (y = word0(rv) & Exp_mask) <= 2*P*Exp_msk1)
2643  ? (0xffffffff & (0xffffffff << (2*P+1-(y>>Exp_shift)))) :
2644 #endif
2645  0xffffffff)) {
2646  /*boundary case -- increment exponent*/
2647  word0(rv) = (word0(rv) & Exp_mask)
2648  + Exp_msk1
2649 #ifdef IBM
2650  | Exp_msk1 >> 4
2651 #endif
2652  ;
2653  word1(rv) = 0;
2654 #ifdef Avoid_Underflow
2655  dsign = 0;
2656 #endif
2657  break;
2658  }
2659  }
2660  else if (!(word0(rv) & Bndry_mask) && !word1(rv)) {
2661 drop_down:
2662  /* boundary case -- decrement exponent */
2663 #ifdef Sudden_Underflow /*{{*/
2664  L = word0(rv) & Exp_mask;
2665 #ifdef IBM
2666  if (L < Exp_msk1)
2667 #else
2668 #ifdef Avoid_Underflow
2669  if (L <= (scale ? (2*P+1)*Exp_msk1 : Exp_msk1))
2670 #else
2671  if (L <= Exp_msk1)
2672 #endif /*Avoid_Underflow*/
2673 #endif /*IBM*/
2674  goto undfl;
2675  L -= Exp_msk1;
2676 #else /*Sudden_Underflow}{*/
2677 #ifdef Avoid_Underflow
2678  if (scale) {
2679  L = word0(rv) & Exp_mask;
2680  if (L <= (2*P+1)*Exp_msk1) {
2681  if (L > (P+2)*Exp_msk1)
2682  /* round even ==> */
2683  /* accept rv */
2684  break;
2685  /* rv = smallest denormal */
2686  goto undfl;
2687  }
2688  }
2689 #endif /*Avoid_Underflow*/
2690  L = (word0(rv) & Exp_mask) - Exp_msk1;
2691 #endif /*Sudden_Underflow}}*/
2692  word0(rv) = L | Bndry_mask1;
2693  word1(rv) = 0xffffffff;
2694 #ifdef IBM
2695  goto cont;
2696 #else
2697  break;
2698 #endif
2699  }
2700 #ifndef ROUND_BIASED
2701  if (!(word1(rv) & LSB))
2702  break;
2703 #endif
2704  if (dsign)
2705  dval(rv) += ulp(dval(rv));
2706 #ifndef ROUND_BIASED
2707  else {
2708  dval(rv) -= ulp(dval(rv));
2709 #ifndef Sudden_Underflow
2710  if (!dval(rv))
2711  goto undfl;
2712 #endif
2713  }
2714 #ifdef Avoid_Underflow
2715  dsign = 1 - dsign;
2716 #endif
2717 #endif
2718  break;
2719  }
2720  if ((aadj = ratio(delta, bs)) <= 2.) {
2721  if (dsign)
2722  aadj = dval(aadj1) = 1.;
2723  else if (word1(rv) || word0(rv) & Bndry_mask) {
2724 #ifndef Sudden_Underflow
2725  if (word1(rv) == Tiny1 && !word0(rv))
2726  goto undfl;
2727 #endif
2728  aadj = 1.;
2729  dval(aadj1) = -1.;
2730  }
2731  else {
2732  /* special case -- power of FLT_RADIX to be */
2733  /* rounded down... */
2734 
2735  if (aadj < 2./FLT_RADIX)
2736  aadj = 1./FLT_RADIX;
2737  else
2738  aadj *= 0.5;
2739  dval(aadj1) = -aadj;
2740  }
2741  }
2742  else {
2743  aadj *= 0.5;
2744  dval(aadj1) = dsign ? aadj : -aadj;
2745 #ifdef Check_FLT_ROUNDS
2746  switch (Rounding) {
2747  case 2: /* towards +infinity */
2748  dval(aadj1) -= 0.5;
2749  break;
2750  case 0: /* towards 0 */
2751  case 3: /* towards -infinity */
2752  dval(aadj1) += 0.5;
2753  }
2754 #else
2755  if (Flt_Rounds == 0)
2756  dval(aadj1) += 0.5;
2757 #endif /*Check_FLT_ROUNDS*/
2758  }
2759  y = word0(rv) & Exp_mask;
2760 
2761  /* Check for overflow */
2762 
2763  if (y == Exp_msk1*(DBL_MAX_EXP+Bias-1)) {
2764  dval(rv0) = dval(rv);
2765  word0(rv) -= P*Exp_msk1;
2766  adj = dval(aadj1) * ulp(dval(rv));
2767  dval(rv) += adj;
2768  if ((word0(rv) & Exp_mask) >=
2769  Exp_msk1*(DBL_MAX_EXP+Bias-P)) {
2770  if (word0(rv0) == Big0 && word1(rv0) == Big1)
2771  goto ovfl;
2772  word0(rv) = Big0;
2773  word1(rv) = Big1;
2774  goto cont;
2775  }
2776  else
2777  word0(rv) += P*Exp_msk1;
2778  }
2779  else {
2780 #ifdef Avoid_Underflow
2781  if (scale && y <= 2*P*Exp_msk1) {
2782  if (aadj <= 0x7fffffff) {
2783  if ((z = (int)aadj) <= 0)
2784  z = 1;
2785  aadj = z;
2786  dval(aadj1) = dsign ? aadj : -aadj;
2787  }
2788  word0(aadj1) += (2*P+1)*Exp_msk1 - y;
2789  }
2790  adj = dval(aadj1) * ulp(dval(rv));
2791  dval(rv) += adj;
2792 #else
2793 #ifdef Sudden_Underflow
2794  if ((word0(rv) & Exp_mask) <= P*Exp_msk1) {
2795  dval(rv0) = dval(rv);
2796  word0(rv) += P*Exp_msk1;
2797  adj = dval(aadj1) * ulp(dval(rv));
2798  dval(rv) += adj;
2799 #ifdef IBM
2800  if ((word0(rv) & Exp_mask) < P*Exp_msk1)
2801 #else
2802  if ((word0(rv) & Exp_mask) <= P*Exp_msk1)
2803 #endif
2804  {
2805  if (word0(rv0) == Tiny0 && word1(rv0) == Tiny1)
2806  goto undfl;
2807  word0(rv) = Tiny0;
2808  word1(rv) = Tiny1;
2809  goto cont;
2810  }
2811  else
2812  word0(rv) -= P*Exp_msk1;
2813  }
2814  else {
2815  adj = dval(aadj1) * ulp(dval(rv));
2816  dval(rv) += adj;
2817  }
2818 #else /*Sudden_Underflow*/
2819  /* Compute adj so that the IEEE rounding rules will
2820  * correctly round rv + adj in some half-way cases.
2821  * If rv * ulp(rv) is denormalized (i.e.,
2822  * y <= (P-1)*Exp_msk1), we must adjust aadj to avoid
2823  * trouble from bits lost to denormalization;
2824  * example: 1.2e-307 .
2825  */
2826  if (y <= (P-1)*Exp_msk1 && aadj > 1.) {
2827  dval(aadj1) = (double)(int)(aadj + 0.5);
2828  if (!dsign)
2829  dval(aadj1) = -dval(aadj1);
2830  }
2831  adj = dval(aadj1) * ulp(dval(rv));
2832  dval(rv) += adj;
2833 #endif /*Sudden_Underflow*/
2834 #endif /*Avoid_Underflow*/
2835  }
2836  z = word0(rv) & Exp_mask;
2837 #ifndef SET_INEXACT
2838 #ifdef Avoid_Underflow
2839  if (!scale)
2840 #endif
2841  if (y == z) {
2842  /* Can we stop now? */
2843  L = (Long)aadj;
2844  aadj -= L;
2845  /* The tolerances below are conservative. */
2846  if (dsign || word1(rv) || word0(rv) & Bndry_mask) {
2847  if (aadj < .4999999 || aadj > .5000001)
2848  break;
2849  }
2850  else if (aadj < .4999999/FLT_RADIX)
2851  break;
2852  }
2853 #endif
2854 cont:
2855  Bfree(bb);
2856  Bfree(bd);
2857  Bfree(bs);
2858  Bfree(delta);
2859  }
2860 #ifdef SET_INEXACT
2861  if (inexact) {
2862  if (!oldinexact) {
2863  word0(rv0) = Exp_1 + (70 << Exp_shift);
2864  word1(rv0) = 0;
2865  dval(rv0) += 1.;
2866  }
2867  }
2868  else if (!oldinexact)
2869  clear_inexact();
2870 #endif
2871 #ifdef Avoid_Underflow
2872  if (scale) {
2873  word0(rv0) = Exp_1 - 2*P*Exp_msk1;
2874  word1(rv0) = 0;
2875  dval(rv) *= dval(rv0);
2876 #ifndef NO_ERRNO
2877  /* try to avoid the bug of testing an 8087 register value */
2878  if (word0(rv) == 0 && word1(rv) == 0)
2879  errno = ERANGE;
2880 #endif
2881  }
2882 #endif /* Avoid_Underflow */
2883 #ifdef SET_INEXACT
2884  if (inexact && !(word0(rv) & Exp_mask)) {
2885  /* set underflow bit */
2886  dval(rv0) = 1e-300;
2887  dval(rv0) *= dval(rv0);
2888  }
2889 #endif
2890 retfree:
2891  Bfree(bb);
2892  Bfree(bd);
2893  Bfree(bs);
2894  Bfree(bd0);
2895  Bfree(delta);
2896 ret:
2897  if (se)
2898  *se = (char *)s;
2899  return sign ? -dval(rv) : dval(rv);
2900 }
2901 
2902 static int
2903 quorem(Bigint *b, Bigint *S)
2904 {
2905  int n;
2906  ULong *bx, *bxe, q, *sx, *sxe;
2907 #ifdef ULLong
2908  ULLong borrow, carry, y, ys;
2909 #else
2910  ULong borrow, carry, y, ys;
2911 #ifdef Pack_32
2912  ULong si, z, zs;
2913 #endif
2914 #endif
2915 
2916  n = S->wds;
2917 #ifdef DEBUG
2918  /*debug*/ if (b->wds > n)
2919  /*debug*/ Bug("oversize b in quorem");
2920 #endif
2921  if (b->wds < n)
2922  return 0;
2923  sx = S->x;
2924  sxe = sx + --n;
2925  bx = b->x;
2926  bxe = bx + n;
2927  q = *bxe / (*sxe + 1); /* ensure q <= true quotient */
2928 #ifdef DEBUG
2929  /*debug*/ if (q > 9)
2930  /*debug*/ Bug("oversized quotient in quorem");
2931 #endif
2932  if (q) {
2933  borrow = 0;
2934  carry = 0;
2935  do {
2936 #ifdef ULLong
2937  ys = *sx++ * (ULLong)q + carry;
2938  carry = ys >> 32;
2939  y = *bx - (ys & FFFFFFFF) - borrow;
2940  borrow = y >> 32 & (ULong)1;
2941  *bx++ = (ULong)(y & FFFFFFFF);
2942 #else
2943 #ifdef Pack_32
2944  si = *sx++;
2945  ys = (si & 0xffff) * q + carry;
2946  zs = (si >> 16) * q + (ys >> 16);
2947  carry = zs >> 16;
2948  y = (*bx & 0xffff) - (ys & 0xffff) - borrow;
2949  borrow = (y & 0x10000) >> 16;
2950  z = (*bx >> 16) - (zs & 0xffff) - borrow;
2951  borrow = (z & 0x10000) >> 16;
2952  Storeinc(bx, z, y);
2953 #else
2954  ys = *sx++ * q + carry;
2955  carry = ys >> 16;
2956  y = *bx - (ys & 0xffff) - borrow;
2957  borrow = (y & 0x10000) >> 16;
2958  *bx++ = y & 0xffff;
2959 #endif
2960 #endif
2961  } while (sx <= sxe);
2962  if (!*bxe) {
2963  bx = b->x;
2964  while (--bxe > bx && !*bxe)
2965  --n;
2966  b->wds = n;
2967  }
2968  }
2969  if (cmp(b, S) >= 0) {
2970  q++;
2971  borrow = 0;
2972  carry = 0;
2973  bx = b->x;
2974  sx = S->x;
2975  do {
2976 #ifdef ULLong
2977  ys = *sx++ + carry;
2978  carry = ys >> 32;
2979  y = *bx - (ys & FFFFFFFF) - borrow;
2980  borrow = y >> 32 & (ULong)1;
2981  *bx++ = (ULong)(y & FFFFFFFF);
2982 #else
2983 #ifdef Pack_32
2984  si = *sx++;
2985  ys = (si & 0xffff) + carry;
2986  zs = (si >> 16) + (ys >> 16);
2987  carry = zs >> 16;
2988  y = (*bx & 0xffff) - (ys & 0xffff) - borrow;
2989  borrow = (y & 0x10000) >> 16;
2990  z = (*bx >> 16) - (zs & 0xffff) - borrow;
2991  borrow = (z & 0x10000) >> 16;
2992  Storeinc(bx, z, y);
2993 #else
2994  ys = *sx++ + carry;
2995  carry = ys >> 16;
2996  y = *bx - (ys & 0xffff) - borrow;
2997  borrow = (y & 0x10000) >> 16;
2998  *bx++ = y & 0xffff;
2999 #endif
3000 #endif
3001  } while (sx <= sxe);
3002  bx = b->x;
3003  bxe = bx + n;
3004  if (!*bxe) {
3005  while (--bxe > bx && !*bxe)
3006  --n;
3007  b->wds = n;
3008  }
3009  }
3010  return q;
3011 }
3012 
3013 #ifndef MULTIPLE_THREADS
3014 static char *dtoa_result;
3015 #endif
3016 
3017 #ifndef MULTIPLE_THREADS
3018 static char *
3019 rv_alloc(int i)
3020 {
3021  return dtoa_result = xmalloc(i);
3022 }
3023 #else
3024 #define rv_alloc(i) xmalloc(i)
3025 #endif
3026 
3027 static char *
3028 nrv_alloc(const char *s, char **rve, size_t n)
3029 {
3030  char *rv, *t;
3031 
3032  t = rv = rv_alloc(n);
3033  while ((*t = *s++) != 0) t++;
3034  if (rve)
3035  *rve = t;
3036  return rv;
3037 }
3038 
3039 #define rv_strdup(s, rve) nrv_alloc((s), (rve), strlen(s)+1)
3040 
3041 #ifndef MULTIPLE_THREADS
3042 /* freedtoa(s) must be used to free values s returned by dtoa
3043  * when MULTIPLE_THREADS is #defined. It should be used in all cases,
3044  * but for consistency with earlier versions of dtoa, it is optional
3045  * when MULTIPLE_THREADS is not defined.
3046  */
3047 
3048 static void
3049 freedtoa(char *s)
3050 {
3051  xfree(s);
3052 }
3053 #endif
3054 
3055 static const char INFSTR[] = "Infinity";
3056 static const char NANSTR[] = "NaN";
3057 static const char ZEROSTR[] = "0";
3058 
3059 /* dtoa for IEEE arithmetic (dmg): convert double to ASCII string.
3060  *
3061  * Inspired by "How to Print Floating-Point Numbers Accurately" by
3062  * Guy L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90, pp. 112-126].
3063  *
3064  * Modifications:
3065  * 1. Rather than iterating, we use a simple numeric overestimate
3066  * to determine k = floor(log10(d)). We scale relevant
3067  * quantities using O(log2(k)) rather than O(k) multiplications.
3068  * 2. For some modes > 2 (corresponding to ecvt and fcvt), we don't
3069  * try to generate digits strictly left to right. Instead, we
3070  * compute with fewer bits and propagate the carry if necessary
3071  * when rounding the final digit up. This is often faster.
3072  * 3. Under the assumption that input will be rounded nearest,
3073  * mode 0 renders 1e23 as 1e23 rather than 9.999999999999999e22.
3074  * That is, we allow equality in stopping tests when the
3075  * round-nearest rule will give the same floating-point value
3076  * as would satisfaction of the stopping test with strict
3077  * inequality.
3078  * 4. We remove common factors of powers of 2 from relevant
3079  * quantities.
3080  * 5. When converting floating-point integers less than 1e16,
3081  * we use floating-point arithmetic rather than resorting
3082  * to multiple-precision integers.
3083  * 6. When asked to produce fewer than 15 digits, we first try
3084  * to get by with floating-point arithmetic; we resort to
3085  * multiple-precision integer arithmetic only if we cannot
3086  * guarantee that the floating-point calculation has given
3087  * the correctly rounded result. For k requested digits and
3088  * "uniformly" distributed input, the probability is
3089  * something like 10^(k-15) that we must resort to the Long
3090  * calculation.
3091  */
3092 
3093 char *
3094 ruby_dtoa(double d_, int mode, int ndigits, int *decpt, int *sign, char **rve)
3095 {
3096  /* Arguments ndigits, decpt, sign are similar to those
3097  of ecvt and fcvt; trailing zeros are suppressed from
3098  the returned string. If not null, *rve is set to point
3099  to the end of the return value. If d is +-Infinity or NaN,
3100  then *decpt is set to 9999.
3101 
3102  mode:
3103  0 ==> shortest string that yields d when read in
3104  and rounded to nearest.
3105  1 ==> like 0, but with Steele & White stopping rule;
3106  e.g. with IEEE P754 arithmetic , mode 0 gives
3107  1e23 whereas mode 1 gives 9.999999999999999e22.
3108  2 ==> max(1,ndigits) significant digits. This gives a
3109  return value similar to that of ecvt, except
3110  that trailing zeros are suppressed.
3111  3 ==> through ndigits past the decimal point. This
3112  gives a return value similar to that from fcvt,
3113  except that trailing zeros are suppressed, and
3114  ndigits can be negative.
3115  4,5 ==> similar to 2 and 3, respectively, but (in
3116  round-nearest mode) with the tests of mode 0 to
3117  possibly return a shorter string that rounds to d.
3118  With IEEE arithmetic and compilation with
3119  -DHonor_FLT_ROUNDS, modes 4 and 5 behave the same
3120  as modes 2 and 3 when FLT_ROUNDS != 1.
3121  6-9 ==> Debugging modes similar to mode - 4: don't try
3122  fast floating-point estimate (if applicable).
3123 
3124  Values of mode other than 0-9 are treated as mode 0.
3125 
3126  Sufficient space is allocated to the return value
3127  to hold the suppressed trailing zeros.
3128  */
3129 
3130  int bbits, b2, b5, be, dig, i, ieps, ilim, ilim0, ilim1,
3131  j, j1, k, k0, k_check, leftright, m2, m5, s2, s5,
3132  spec_case, try_quick;
3133  Long L;
3134 #ifndef Sudden_Underflow
3135  int denorm;
3136  ULong x;
3137 #endif
3138  Bigint *b, *b1, *delta, *mlo = 0, *mhi = 0, *S;
3139  double ds;
3140  double_u d, d2, eps;
3141  char *s, *s0;
3142 #ifdef Honor_FLT_ROUNDS
3143  int rounding;
3144 #endif
3145 #ifdef SET_INEXACT
3146  int inexact, oldinexact;
3147 #endif
3148 
3149  dval(d) = d_;
3150 
3151 #ifndef MULTIPLE_THREADS
3152  if (dtoa_result) {
3153  freedtoa(dtoa_result);
3154  dtoa_result = 0;
3155  }
3156 #endif
3157 
3158  if (word0(d) & Sign_bit) {
3159  /* set sign for everything, including 0's and NaNs */
3160  *sign = 1;
3161  word0(d) &= ~Sign_bit; /* clear sign bit */
3162  }
3163  else
3164  *sign = 0;
3165 
3166 #if defined(IEEE_Arith) + defined(VAX)
3167 #ifdef IEEE_Arith
3168  if ((word0(d) & Exp_mask) == Exp_mask)
3169 #else
3170  if (word0(d) == 0x8000)
3171 #endif
3172  {
3173  /* Infinity or NaN */
3174  *decpt = 9999;
3175 #ifdef IEEE_Arith
3176  if (!word1(d) && !(word0(d) & 0xfffff))
3177  return rv_strdup(INFSTR, rve);
3178 #endif
3179  return rv_strdup(NANSTR, rve);
3180  }
3181 #endif
3182 #ifdef IBM
3183  dval(d) += 0; /* normalize */
3184 #endif
3185  if (!dval(d)) {
3186  *decpt = 1;
3187  return rv_strdup(ZEROSTR, rve);
3188  }
3189 
3190 #ifdef SET_INEXACT
3191  try_quick = oldinexact = get_inexact();
3192  inexact = 1;
3193 #endif
3194 #ifdef Honor_FLT_ROUNDS
3195  if ((rounding = Flt_Rounds) >= 2) {
3196  if (*sign)
3197  rounding = rounding == 2 ? 0 : 2;
3198  else
3199  if (rounding != 2)
3200  rounding = 0;
3201  }
3202 #endif
3203 
3204  b = d2b(dval(d), &be, &bbits);
3205 #ifdef Sudden_Underflow
3206  i = (int)(word0(d) >> Exp_shift1 & (Exp_mask>>Exp_shift1));
3207 #else
3208  if ((i = (int)(word0(d) >> Exp_shift1 & (Exp_mask>>Exp_shift1))) != 0) {
3209 #endif
3210  dval(d2) = dval(d);
3211  word0(d2) &= Frac_mask1;
3212  word0(d2) |= Exp_11;
3213 #ifdef IBM
3214  if (j = 11 - hi0bits(word0(d2) & Frac_mask))
3215  dval(d2) /= 1 << j;
3216 #endif
3217 
3218  /* log(x) ~=~ log(1.5) + (x-1.5)/1.5
3219  * log10(x) = log(x) / log(10)
3220  * ~=~ log(1.5)/log(10) + (x-1.5)/(1.5*log(10))
3221  * log10(d) = (i-Bias)*log(2)/log(10) + log10(d2)
3222  *
3223  * This suggests computing an approximation k to log10(d) by
3224  *
3225  * k = (i - Bias)*0.301029995663981
3226  * + ( (d2-1.5)*0.289529654602168 + 0.176091259055681 );
3227  *
3228  * We want k to be too large rather than too small.
3229  * The error in the first-order Taylor series approximation
3230  * is in our favor, so we just round up the constant enough
3231  * to compensate for any error in the multiplication of
3232  * (i - Bias) by 0.301029995663981; since |i - Bias| <= 1077,
3233  * and 1077 * 0.30103 * 2^-52 ~=~ 7.2e-14,
3234  * adding 1e-13 to the constant term more than suffices.
3235  * Hence we adjust the constant term to 0.1760912590558.
3236  * (We could get a more accurate k by invoking log10,
3237  * but this is probably not worthwhile.)
3238  */
3239 
3240  i -= Bias;
3241 #ifdef IBM
3242  i <<= 2;
3243  i += j;
3244 #endif
3245 #ifndef Sudden_Underflow
3246  denorm = 0;
3247  }
3248  else {
3249  /* d is denormalized */
3250 
3251  i = bbits + be + (Bias + (P-1) - 1);
3252  x = i > 32 ? word0(d) << (64 - i) | word1(d) >> (i - 32)
3253  : word1(d) << (32 - i);
3254  dval(d2) = x;
3255  word0(d2) -= 31*Exp_msk1; /* adjust exponent */
3256  i -= (Bias + (P-1) - 1) + 1;
3257  denorm = 1;
3258  }
3259 #endif
3260  ds = (dval(d2)-1.5)*0.289529654602168 + 0.1760912590558 + i*0.301029995663981;
3261  k = (int)ds;
3262  if (ds < 0. && ds != k)
3263  k--; /* want k = floor(ds) */
3264  k_check = 1;
3265  if (k >= 0 && k <= Ten_pmax) {
3266  if (dval(d) < tens[k])
3267  k--;
3268  k_check = 0;
3269  }
3270  j = bbits - i - 1;
3271  if (j >= 0) {
3272  b2 = 0;
3273  s2 = j;
3274  }
3275  else {
3276  b2 = -j;
3277  s2 = 0;
3278  }
3279  if (k >= 0) {
3280  b5 = 0;
3281  s5 = k;
3282  s2 += k;
3283  }
3284  else {
3285  b2 -= k;
3286  b5 = -k;
3287  s5 = 0;
3288  }
3289  if (mode < 0 || mode > 9)
3290  mode = 0;
3291 
3292 #ifndef SET_INEXACT
3293 #ifdef Check_FLT_ROUNDS
3294  try_quick = Rounding == 1;
3295 #else
3296  try_quick = 1;
3297 #endif
3298 #endif /*SET_INEXACT*/
3299 
3300  if (mode > 5) {
3301  mode -= 4;
3302  try_quick = 0;
3303  }
3304  leftright = 1;
3305  ilim = ilim1 = -1;
3306  switch (mode) {
3307  case 0:
3308  case 1:
3309  i = 18;
3310  ndigits = 0;
3311  break;
3312  case 2:
3313  leftright = 0;
3314  /* no break */
3315  case 4:
3316  if (ndigits <= 0)
3317  ndigits = 1;
3318  ilim = ilim1 = i = ndigits;
3319  break;
3320  case 3:
3321  leftright = 0;
3322  /* no break */
3323  case 5:
3324  i = ndigits + k + 1;
3325  ilim = i;
3326  ilim1 = i - 1;
3327  if (i <= 0)
3328  i = 1;
3329  }
3330  s = s0 = rv_alloc(i+1);
3331 
3332 #ifdef Honor_FLT_ROUNDS
3333  if (mode > 1 && rounding != 1)
3334  leftright = 0;
3335 #endif
3336 
3337  if (ilim >= 0 && ilim <= Quick_max && try_quick) {
3338 
3339  /* Try to get by with floating-point arithmetic. */
3340 
3341  i = 0;
3342  dval(d2) = dval(d);
3343  k0 = k;
3344  ilim0 = ilim;
3345  ieps = 2; /* conservative */
3346  if (k > 0) {
3347  ds = tens[k&0xf];
3348  j = k >> 4;
3349  if (j & Bletch) {
3350  /* prevent overflows */
3351  j &= Bletch - 1;
3352  dval(d) /= bigtens[n_bigtens-1];
3353  ieps++;
3354  }
3355  for (; j; j >>= 1, i++)
3356  if (j & 1) {
3357  ieps++;
3358  ds *= bigtens[i];
3359  }
3360  dval(d) /= ds;
3361  }
3362  else if ((j1 = -k) != 0) {
3363  dval(d) *= tens[j1 & 0xf];
3364  for (j = j1 >> 4; j; j >>= 1, i++)
3365  if (j & 1) {
3366  ieps++;
3367  dval(d) *= bigtens[i];
3368  }
3369  }
3370  if (k_check && dval(d) < 1. && ilim > 0) {
3371  if (ilim1 <= 0)
3372  goto fast_failed;
3373  ilim = ilim1;
3374  k--;
3375  dval(d) *= 10.;
3376  ieps++;
3377  }
3378  dval(eps) = ieps*dval(d) + 7.;
3379  word0(eps) -= (P-1)*Exp_msk1;
3380  if (ilim == 0) {
3381  S = mhi = 0;
3382  dval(d) -= 5.;
3383  if (dval(d) > dval(eps))
3384  goto one_digit;
3385  if (dval(d) < -dval(eps))
3386  goto no_digits;
3387  goto fast_failed;
3388  }
3389 #ifndef No_leftright
3390  if (leftright) {
3391  /* Use Steele & White method of only
3392  * generating digits needed.
3393  */
3394  dval(eps) = 0.5/tens[ilim-1] - dval(eps);
3395  for (i = 0;;) {
3396  L = (int)dval(d);
3397  dval(d) -= L;
3398  *s++ = '0' + (int)L;
3399  if (dval(d) < dval(eps))
3400  goto ret1;
3401  if (1. - dval(d) < dval(eps))
3402  goto bump_up;
3403  if (++i >= ilim)
3404  break;
3405  dval(eps) *= 10.;
3406  dval(d) *= 10.;
3407  }
3408  }
3409  else {
3410 #endif
3411  /* Generate ilim digits, then fix them up. */
3412  dval(eps) *= tens[ilim-1];
3413  for (i = 1;; i++, dval(d) *= 10.) {
3414  L = (Long)(dval(d));
3415  if (!(dval(d) -= L))
3416  ilim = i;
3417  *s++ = '0' + (int)L;
3418  if (i == ilim) {
3419  if (dval(d) > 0.5 + dval(eps))
3420  goto bump_up;
3421  else if (dval(d) < 0.5 - dval(eps)) {
3422  while (*--s == '0') ;
3423  s++;
3424  goto ret1;
3425  }
3426  break;
3427  }
3428  }
3429 #ifndef No_leftright
3430  }
3431 #endif
3432 fast_failed:
3433  s = s0;
3434  dval(d) = dval(d2);
3435  k = k0;
3436  ilim = ilim0;
3437  }
3438 
3439  /* Do we have a "small" integer? */
3440 
3441  if (be >= 0 && k <= Int_max) {
3442  /* Yes. */
3443  ds = tens[k];
3444  if (ndigits < 0 && ilim <= 0) {
3445  S = mhi = 0;
3446  if (ilim < 0 || dval(d) <= 5*ds)
3447  goto no_digits;
3448  goto one_digit;
3449  }
3450  for (i = 1;; i++, dval(d) *= 10.) {
3451  L = (Long)(dval(d) / ds);
3452  dval(d) -= L*ds;
3453 #ifdef Check_FLT_ROUNDS
3454  /* If FLT_ROUNDS == 2, L will usually be high by 1 */
3455  if (dval(d) < 0) {
3456  L--;
3457  dval(d) += ds;
3458  }
3459 #endif
3460  *s++ = '0' + (int)L;
3461  if (!dval(d)) {
3462 #ifdef SET_INEXACT
3463  inexact = 0;
3464 #endif
3465  break;
3466  }
3467  if (i == ilim) {
3468 #ifdef Honor_FLT_ROUNDS
3469  if (mode > 1)
3470  switch (rounding) {
3471  case 0: goto ret1;
3472  case 2: goto bump_up;
3473  }
3474 #endif
3475  dval(d) += dval(d);
3476  if (dval(d) > ds || (dval(d) == ds && (L & 1))) {
3477 bump_up:
3478  while (*--s == '9')
3479  if (s == s0) {
3480  k++;
3481  *s = '0';
3482  break;
3483  }
3484  ++*s++;
3485  }
3486  break;
3487  }
3488  }
3489  goto ret1;
3490  }
3491 
3492  m2 = b2;
3493  m5 = b5;
3494  if (leftright) {
3495  i =
3496 #ifndef Sudden_Underflow
3497  denorm ? be + (Bias + (P-1) - 1 + 1) :
3498 #endif
3499 #ifdef IBM
3500  1 + 4*P - 3 - bbits + ((bbits + be - 1) & 3);
3501 #else
3502  1 + P - bbits;
3503 #endif
3504  b2 += i;
3505  s2 += i;
3506  mhi = i2b(1);
3507  }
3508  if (m2 > 0 && s2 > 0) {
3509  i = m2 < s2 ? m2 : s2;
3510  b2 -= i;
3511  m2 -= i;
3512  s2 -= i;
3513  }
3514  if (b5 > 0) {
3515  if (leftright) {
3516  if (m5 > 0) {
3517  mhi = pow5mult(mhi, m5);
3518  b1 = mult(mhi, b);
3519  Bfree(b);
3520  b = b1;
3521  }
3522  if ((j = b5 - m5) != 0)
3523  b = pow5mult(b, j);
3524  }
3525  else
3526  b = pow5mult(b, b5);
3527  }
3528  S = i2b(1);
3529  if (s5 > 0)
3530  S = pow5mult(S, s5);
3531 
3532  /* Check for special case that d is a normalized power of 2. */
3533 
3534  spec_case = 0;
3535  if ((mode < 2 || leftright)
3536 #ifdef Honor_FLT_ROUNDS
3537  && rounding == 1
3538 #endif
3539  ) {
3540  if (!word1(d) && !(word0(d) & Bndry_mask)
3541 #ifndef Sudden_Underflow
3542  && word0(d) & (Exp_mask & ~Exp_msk1)
3543 #endif
3544  ) {
3545  /* The special case */
3546  b2 += Log2P;
3547  s2 += Log2P;
3548  spec_case = 1;
3549  }
3550  }
3551 
3552  /* Arrange for convenient computation of quotients:
3553  * shift left if necessary so divisor has 4 leading 0 bits.
3554  *
3555  * Perhaps we should just compute leading 28 bits of S once
3556  * and for all and pass them and a shift to quorem, so it
3557  * can do shifts and ors to compute the numerator for q.
3558  */
3559 #ifdef Pack_32
3560  if ((i = ((s5 ? 32 - hi0bits(S->x[S->wds-1]) : 1) + s2) & 0x1f) != 0)
3561  i = 32 - i;
3562 #else
3563  if ((i = ((s5 ? 32 - hi0bits(S->x[S->wds-1]) : 1) + s2) & 0xf) != 0)
3564  i = 16 - i;
3565 #endif
3566  if (i > 4) {
3567  i -= 4;
3568  b2 += i;
3569  m2 += i;
3570  s2 += i;
3571  }
3572  else if (i < 4) {
3573  i += 28;
3574  b2 += i;
3575  m2 += i;
3576  s2 += i;
3577  }
3578  if (b2 > 0)
3579  b = lshift(b, b2);
3580  if (s2 > 0)
3581  S = lshift(S, s2);
3582  if (k_check) {
3583  if (cmp(b,S) < 0) {
3584  k--;
3585  b = multadd(b, 10, 0); /* we botched the k estimate */
3586  if (leftright)
3587  mhi = multadd(mhi, 10, 0);
3588  ilim = ilim1;
3589  }
3590  }
3591  if (ilim <= 0 && (mode == 3 || mode == 5)) {
3592  if (ilim < 0 || cmp(b,S = multadd(S,5,0)) <= 0) {
3593  /* no digits, fcvt style */
3594 no_digits:
3595  k = -1 - ndigits;
3596  goto ret;
3597  }
3598 one_digit:
3599  *s++ = '1';
3600  k++;
3601  goto ret;
3602  }
3603  if (leftright) {
3604  if (m2 > 0)
3605  mhi = lshift(mhi, m2);
3606 
3607  /* Compute mlo -- check for special case
3608  * that d is a normalized power of 2.
3609  */
3610 
3611  mlo = mhi;
3612  if (spec_case) {
3613  mhi = Balloc(mhi->k);
3614  Bcopy(mhi, mlo);
3615  mhi = lshift(mhi, Log2P);
3616  }
3617 
3618  for (i = 1;;i++) {
3619  dig = quorem(b,S) + '0';
3620  /* Do we yet have the shortest decimal string
3621  * that will round to d?
3622  */
3623  j = cmp(b, mlo);
3624  delta = diff(S, mhi);
3625  j1 = delta->sign ? 1 : cmp(b, delta);
3626  Bfree(delta);
3627 #ifndef ROUND_BIASED
3628  if (j1 == 0 && mode != 1 && !(word1(d) & 1)
3629 #ifdef Honor_FLT_ROUNDS
3630  && rounding >= 1
3631 #endif
3632  ) {
3633  if (dig == '9')
3634  goto round_9_up;
3635  if (j > 0)
3636  dig++;
3637 #ifdef SET_INEXACT
3638  else if (!b->x[0] && b->wds <= 1)
3639  inexact = 0;
3640 #endif
3641  *s++ = dig;
3642  goto ret;
3643  }
3644 #endif
3645  if (j < 0 || (j == 0 && mode != 1
3646 #ifndef ROUND_BIASED
3647  && !(word1(d) & 1)
3648 #endif
3649  )) {
3650  if (!b->x[0] && b->wds <= 1) {
3651 #ifdef SET_INEXACT
3652  inexact = 0;
3653 #endif
3654  goto accept_dig;
3655  }
3656 #ifdef Honor_FLT_ROUNDS
3657  if (mode > 1)
3658  switch (rounding) {
3659  case 0: goto accept_dig;
3660  case 2: goto keep_dig;
3661  }
3662 #endif /*Honor_FLT_ROUNDS*/
3663  if (j1 > 0) {
3664  b = lshift(b, 1);
3665  j1 = cmp(b, S);
3666  if ((j1 > 0 || (j1 == 0 && (dig & 1))) && dig++ == '9')
3667  goto round_9_up;
3668  }
3669 accept_dig:
3670  *s++ = dig;
3671  goto ret;
3672  }
3673  if (j1 > 0) {
3674 #ifdef Honor_FLT_ROUNDS
3675  if (!rounding)
3676  goto accept_dig;
3677 #endif
3678  if (dig == '9') { /* possible if i == 1 */
3679 round_9_up:
3680  *s++ = '9';
3681  goto roundoff;
3682  }
3683  *s++ = dig + 1;
3684  goto ret;
3685  }
3686 #ifdef Honor_FLT_ROUNDS
3687 keep_dig:
3688 #endif
3689  *s++ = dig;
3690  if (i == ilim)
3691  break;
3692  b = multadd(b, 10, 0);
3693  if (mlo == mhi)
3694  mlo = mhi = multadd(mhi, 10, 0);
3695  else {
3696  mlo = multadd(mlo, 10, 0);
3697  mhi = multadd(mhi, 10, 0);
3698  }
3699  }
3700  }
3701  else
3702  for (i = 1;; i++) {
3703  *s++ = dig = quorem(b,S) + '0';
3704  if (!b->x[0] && b->wds <= 1) {
3705 #ifdef SET_INEXACT
3706  inexact = 0;
3707 #endif
3708  goto ret;
3709  }
3710  if (i >= ilim)
3711  break;
3712  b = multadd(b, 10, 0);
3713  }
3714 
3715  /* Round off last digit */
3716 
3717 #ifdef Honor_FLT_ROUNDS
3718  switch (rounding) {
3719  case 0: goto trimzeros;
3720  case 2: goto roundoff;
3721  }
3722 #endif
3723  b = lshift(b, 1);
3724  j = cmp(b, S);
3725  if (j > 0 || (j == 0 && (dig & 1))) {
3726  roundoff:
3727  while (*--s == '9')
3728  if (s == s0) {
3729  k++;
3730  *s++ = '1';
3731  goto ret;
3732  }
3733  ++*s++;
3734  }
3735  else {
3736  while (*--s == '0') ;
3737  s++;
3738  }
3739 ret:
3740  Bfree(S);
3741  if (mhi) {
3742  if (mlo && mlo != mhi)
3743  Bfree(mlo);
3744  Bfree(mhi);
3745  }
3746 ret1:
3747 #ifdef SET_INEXACT
3748  if (inexact) {
3749  if (!oldinexact) {
3750  word0(d) = Exp_1 + (70 << Exp_shift);
3751  word1(d) = 0;
3752  dval(d) += 1.;
3753  }
3754  }
3755  else if (!oldinexact)
3756  clear_inexact();
3757 #endif
3758  Bfree(b);
3759  *s = 0;
3760  *decpt = k + 1;
3761  if (rve)
3762  *rve = s;
3763  return s0;
3764 }
3765 
3766 void
3767 ruby_each_words(const char *str, void (*func)(const char*, int, void*), void *arg)
3768 {
3769  const char *end;
3770  int len;
3771 
3772  if (!str) return;
3773  for (; *str; str = end) {
3774  while (ISSPACE(*str) || *str == ',') str++;
3775  if (!*str) break;
3776  end = str;
3777  while (*end && !ISSPACE(*end) && *end != ',') end++;
3778  len = (int)(end - str); /* assume no string exceeds INT_MAX */
3779  (*func)(str, len, arg);
3780  }
3781 }
3782 
3783 /*-
3784  * Copyright (c) 2004-2008 David Schultz <das@FreeBSD.ORG>
3785  * All rights reserved.
3786  *
3787  * Redistribution and use in source and binary forms, with or without
3788  * modification, are permitted provided that the following conditions
3789  * are met:
3790  * 1. Redistributions of source code must retain the above copyright
3791  * notice, this list of conditions and the following disclaimer.
3792  * 2. Redistributions in binary form must reproduce the above copyright
3793  * notice, this list of conditions and the following disclaimer in the
3794  * documentation and/or other materials provided with the distribution.
3795  *
3796  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
3797  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
3798  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
3799  * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
3800  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
3801  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
3802  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
3803  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
3804  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
3805  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
3806  * SUCH DAMAGE.
3807  */
3808 
3809 #define DBL_MANH_SIZE 20
3810 #define DBL_MANL_SIZE 32
3811 #define DBL_ADJ (DBL_MAX_EXP - 2)
3812 #define SIGFIGS ((DBL_MANT_DIG + 3) / 4 + 1)
3813 #define dexp_get(u) ((int)(word0(u) >> Exp_shift) & ~Exp_msk1)
3814 #define dexp_set(u,v) (word0(u) = (((int)(word0(u)) & ~Exp_mask) | ((v) << Exp_shift)))
3815 #define dmanh_get(u) ((uint32_t)(word0(u) & Frac_mask))
3816 #define dmanl_get(u) ((uint32_t)word1(u))
3817 
3818 
3819 /*
3820  * This procedure converts a double-precision number in IEEE format
3821  * into a string of hexadecimal digits and an exponent of 2. Its
3822  * behavior is bug-for-bug compatible with dtoa() in mode 2, with the
3823  * following exceptions:
3824  *
3825  * - An ndigits < 0 causes it to use as many digits as necessary to
3826  * represent the number exactly.
3827  * - The additional xdigs argument should point to either the string
3828  * "0123456789ABCDEF" or the string "0123456789abcdef", depending on
3829  * which case is desired.
3830  * - This routine does not repeat dtoa's mistake of setting decpt
3831  * to 9999 in the case of an infinity or NaN. INT_MAX is used
3832  * for this purpose instead.
3833  *
3834  * Note that the C99 standard does not specify what the leading digit
3835  * should be for non-zero numbers. For instance, 0x1.3p3 is the same
3836  * as 0x2.6p2 is the same as 0x4.cp3. This implementation always makes
3837  * the leading digit a 1. This ensures that the exponent printed is the
3838  * actual base-2 exponent, i.e., ilogb(d).
3839  *
3840  * Inputs: d, xdigs, ndigits
3841  * Outputs: decpt, sign, rve
3842  */
3843 char *
3844 ruby_hdtoa(double d, const char *xdigs, int ndigits, int *decpt, int *sign,
3845  char **rve)
3846 {
3847  U u;
3848  char *s, *s0;
3849  int bufsize;
3850  uint32_t manh, manl;
3851 
3852  u.d = d;
3853  if (word0(u) & Sign_bit) {
3854  /* set sign for everything, including 0's and NaNs */
3855  *sign = 1;
3856  word0(u) &= ~Sign_bit; /* clear sign bit */
3857  }
3858  else
3859  *sign = 0;
3860 
3861  if (isinf(d)) { /* FP_INFINITE */
3862  *decpt = INT_MAX;
3863  return rv_strdup(INFSTR, rve);
3864  }
3865  else if (isnan(d)) { /* FP_NAN */
3866  *decpt = INT_MAX;
3867  return rv_strdup(NANSTR, rve);
3868  }
3869  else if (d == 0.0) { /* FP_ZERO */
3870  *decpt = 1;
3871  return rv_strdup(ZEROSTR, rve);
3872  }
3873  else if (dexp_get(u)) { /* FP_NORMAL */
3874  *decpt = dexp_get(u) - DBL_ADJ;
3875  }
3876  else { /* FP_SUBNORMAL */
3877  u.d *= 5.363123171977039e+154 /* 0x1p514 */;
3878  *decpt = dexp_get(u) - (514 + DBL_ADJ);
3879  }
3880 
3881  if (ndigits == 0) /* dtoa() compatibility */
3882  ndigits = 1;
3883 
3884  /*
3885  * If ndigits < 0, we are expected to auto-size, so we allocate
3886  * enough space for all the digits.
3887  */
3888  bufsize = (ndigits > 0) ? ndigits : SIGFIGS;
3889  s0 = rv_alloc(bufsize+1);
3890 
3891  /* Round to the desired number of digits. */
3892  if (SIGFIGS > ndigits && ndigits > 0) {
3893  float redux = 1.0f;
3894  int offset = 4 * ndigits + DBL_MAX_EXP - 4 - DBL_MANT_DIG;
3895  dexp_set(u, offset);
3896  u.d += redux;
3897  u.d -= redux;
3898  *decpt += dexp_get(u) - offset;
3899  }
3900 
3901  manh = dmanh_get(u);
3902  manl = dmanl_get(u);
3903  *s0 = '1';
3904  for (s = s0 + 1; s < s0 + bufsize; s++) {
3905  *s = xdigs[(manh >> (DBL_MANH_SIZE - 4)) & 0xf];
3906  manh = (manh << 4) | (manl >> (DBL_MANL_SIZE - 4));
3907  manl <<= 4;
3908  }
3909 
3910  /* If ndigits < 0, we are expected to auto-size the precision. */
3911  if (ndigits < 0) {
3912  for (ndigits = SIGFIGS; s0[ndigits - 1] == '0'; ndigits--)
3913  ;
3914  }
3915 
3916  s = s0 + ndigits;
3917  *s = '\0';
3918  if (rve != NULL)
3919  *rve = s;
3920  return (s0);
3921 }
3922 
3923 #ifdef __cplusplus
3924 #if 0
3925 { /* satisfy cc-mode */
3926 #endif
3927 }
3928 #endif
d0
#define d0
Sign_bit
#define Sign_bit
Definition: util.c:853
mmstep
#define mmstep
Definition: util.c:198
dexp_set
#define dexp_set(u, v)
Definition: util.c:3814
ISDIGIT
#define ISDIGIT(c)
Definition: ruby.h:1775
lo0bits
static int lo0bits(ULong *y)
Definition: util.c:1174
FLT_RADIX
#define FLT_RADIX
Definition: numeric.c:43
Big1
#define Big1
Definition: util.c:957
R
#define R(b, x)
Definition: sha2.c:203
strlen
size_t strlen(const char *)
ACQUIRE_DTOA_LOCK
#define ACQUIRE_DTOA_LOCK(n)
Definition: util.c:990
rv_alloc
#define rv_alloc(i)
Definition: util.c:3024
d1
#define d1
P
#define P
Definition: util.c:840
Balloc
static Bigint * Balloc(int k)
Definition: util.c:1007
rv_strdup
#define rv_strdup(s, rve)
Definition: util.c:3039
DBL_DIG
#define DBL_DIG
Definition: numeric.c:67
dmanh_get
#define dmanh_get(u)
Definition: util.c:3815
PATH_MAX
#define PATH_MAX
pow5mult
static Bigint * pow5mult(Bigint *b, int k)
Definition: util.c:1331
stack_node
Definition: util.c:296
med3
#define med3(a, b, c)
Definition: util.c:300
Exp_1
#define Exp_1
Definition: util.c:843
ruby_scan_hex
unsigned long ruby_scan_hex(const char *start, size_t len, size_t *retlen)
Definition: util.c:42
ZEROSTR
static const char ZEROSTR[]
Definition: util.c:3057
dmanl_get
#define dmanl_get(u)
Definition: util.c:3816
Kmax
#define Kmax
Definition: util.c:994
stack_node::RR
char * RR
Definition: util.c:296
Quick_max
#define Quick_max
Definition: util.c:857
DBL_MANL_SIZE
#define DBL_MANL_SIZE
Definition: util.c:3810
Tiny0
#define Tiny0
Definition: util.c:855
Bigint::sign
int sign
Definition: util.c:998
Bletch
#define Bletch
Definition: util.c:849
mmrot3_
static void mmrot3_(register char *a, register char *b, register char *c, mmargdecl)
Definition: util.c:250
C
#define C
Definition: util.c:195
ulp
static double ulp(double x_)
Definition: util.c:1552
Storeinc
#define Storeinc(a, b, c)
Definition: util.c:821
Bigint
struct Bigint Bigint
Definition: util.c:1002
Int_max
#define Int_max
Definition: util.c:858
Ebits
#define Ebits
Definition: util.c:845
PRIVATE_mem
#define PRIVATE_mem
Definition: util.c:731
S
#define S(s)
A
#define A
Definition: util.c:193
hi0bits
static int hi0bits(register ULong x)
Definition: util.c:1145
lshift
static Bigint * lshift(Bigint *b, int k)
Definition: util.c:1383
Bigint
Definition: util.c:996
NANSTR
static const char NANSTR[]
Definition: util.c:3056
private_mem
static double private_mem[PRIVATE_mem]
Definition: util.c:732
DBL_MAX_10_EXP
#define DBL_MAX_10_EXP
Definition: numeric.c:64
cmpfunc_t
int( cmpfunc_t)(const void *, const void *, void *)
Definition: util.c:304
LSB
#define LSB
Definition: util.c:852
Bigint::x
ULong x[1]
Definition: util.c:999
Emin
#define Emin
Definition: util.c:842
nrv_alloc
static char * nrv_alloc(const char *s, char **rve, size_t n)
Definition: util.c:3028
fail
#define fail()
Definition: date_strptime.c:118
dexp_get
#define dexp_get(u)
Definition: util.c:3813
scan_digits
static unsigned long scan_digits(const char *str, int base, size_t *retlen, int *overflow)
Definition: util.c:79
mmargdecl
#define mmargdecl
Definition: util.c:209
B
#define B
Definition: util.c:194
Exp_mask
#define Exp_mask
Definition: util.c:839
Rounding
#define Rounding
Definition: util.c:879
quorem
static int quorem(Bigint *b, Bigint *S)
Definition: util.c:2903
DBL_MANH_SIZE
#define DBL_MANH_SIZE
Definition: util.c:3809
one
static double one(void)
Definition: isinf.c:52
n_bigtens
#define n_bigtens
Definition: util.c:1851
SIGFIGS
#define SIGFIGS
Definition: util.c:3812
POP
#define POP(ll, rr)
Definition: util.c:298
Bndry_mask1
#define Bndry_mask1
Definition: util.c:851
isinf
RUBY_EXTERN int isinf(double)
Definition: isinf.c:56
Bigint::maxwds
int maxwds
Definition: util.c:998
U::d
double d
Definition: util.c:792
s2b
static Bigint * s2b(const char *s, int nd0, int nd, ULong y9)
Definition: util.c:1111
pmem_next
static double * pmem_next
Definition: util.c:732
U
Definition: util.c:792
ruby_strtod
double ruby_strtod(const char *s00, char **se)
Definition: util.c:1945
Scale_Bit
#define Scale_Bit
Definition: util.c:1850
IEEE_Arith
#define IEEE_Arith
Definition: util.c:741
func
SSL_METHOD *(* func)(void)
Definition: ossl_ssl.c:113
errno
int errno
tens
static const double tens[]
Definition: util.c:1828
rounded_product
#define rounded_product(a, b)
Definition: util.c:952
Bigint::wds
int wds
Definition: util.c:998
INFSTR
static const char INFSTR[]
Definition: util.c:3055
ruby_qsort
void ruby_qsort(void *base, const size_t nel, const size_t size, cmpfunc_t *cmp, void *d)
Definition: util.c:306
Avoid_Underflow
#define Avoid_Underflow
Definition: util.c:860
buf
unsigned char buf[MIME_BUF_SIZE]
Definition: nkf.c:4308
no_digits
#define no_digits()
bigtens
static const double bigtens[]
Definition: util.c:1839
cmp
static int cmp(Bigint *a, Bigint *b)
Definition: util.c:1437
ruby_digit36_to_number_table
const signed char ruby_digit36_to_number_table[]
Definition: util.c:58
Log2P
#define Log2P
Definition: util.c:854
rounded_quotient
#define rounded_quotient(a, b)
Definition: util.c:953
multadd
static Bigint * multadd(Bigint *b, int m, int a)
Definition: util.c:1060
strchr
char * strchr(char *, char)
b2d
static double b2d(Bigint *a, int *e)
Definition: util.c:1590
Ten_pmax
#define Ten_pmax
Definition: util.c:848
mmswap
#define mmswap(a, b)
Definition: util.c:247
isnan
#define isnan(x)
Definition: win32.h:376
rb_sys_fail
void rb_sys_fail(const char *mesg)
Definition: error.c:1973
MALLOC
#define MALLOC
Definition: util.c:719
DBL_MANT_DIG
#define DBL_MANT_DIG
Definition: acosh.c:19
Tiny1
#define Tiny1
Definition: util.c:856
ULLong
#define ULLong
Definition: util.c:980
word1
#define word1(x)
Definition: util.c:808
CHAR_BIT
#define CHAR_BIT
Definition: ruby.h:198
DBL_MAX_EXP
#define DBL_MAX_EXP
Definition: numeric.c:58
ruby_scan_oct
unsigned long ruby_scan_oct(const char *start, size_t len, size_t *retlen)
Definition: util.c:28
p5s
static Bigint * p5s
Definition: util.c:1328
uint32_t
unsigned int uint32_t
Definition: sha2.h:101
mmtype
#define mmtype
Definition: util.c:191
Bndry_mask
#define Bndry_mask
Definition: util.c:850
top
unsigned int top
Definition: nkf.c:4309
IEEE_LITTLE_ENDIAN
#define IEEE_LITTLE_ENDIAN
Definition: util.c:675
Exp_shift1
#define Exp_shift1
Definition: util.c:836
size
int size
Definition: encoding.c:49
DBL_ADJ
#define DBL_ADJ
Definition: util.c:3811
d2b
static Bigint * d2b(double d_, int *e, int *bits)
Definition: util.c:1655
xmalloc
#define xmalloc
Definition: defines.h:108
PUSH
#define PUSH(ll, rr)
Definition: util.c:297
ruby_hdtoa
char * ruby_hdtoa(double d, const char *xdigs, int ndigits, int *decpt, int *sign, char **rve)
Definition: util.c:3844
Exp_msk11
#define Exp_msk11
Definition: util.c:838
double_u
U double_u
Definition: util.c:805
Frac_mask1
#define Frac_mask1
Definition: util.c:847
FREE_DTOA_LOCK
#define FREE_DTOA_LOCK(n)
Definition: util.c:991
mmprepare
#define mmprepare(base, size)
Definition: util.c:199
mmswap_
static void mmswap_(register char *a, register char *b, mmargdecl)
Definition: util.c:211
mmrot3
#define mmrot3(a, b, c)
Definition: util.c:285
diff
static Bigint * diff(Bigint *a, Bigint *b)
Definition: util.c:1466
Big0
#define Big0
Definition: util.c:956
Bigint::next
struct Bigint * next
Definition: util.c:997
Exp_msk1
#define Exp_msk1
Definition: util.c:837
ratio
static double ratio(Bigint *a, Bigint *b)
Definition: util.c:1792
Bigint::k
int k
Definition: util.c:998
xrealloc
#define xrealloc
Definition: defines.h:111
Bfree
static void Bfree(Bigint *v)
Definition: util.c:1042
FFFFFFFF
#define FFFFFFFF
Definition: util.c:963
ruby_strtoul
unsigned long ruby_strtoul(const char *str, char **endptr, int base)
Definition: util.c:107
Flt_Rounds
#define Flt_Rounds
Definition: util.c:870
ruby_getcwd
char * ruby_getcwd(void)
Definition: util.c:478
ruby_each_words
void ruby_each_words(const char *str, void(*func)(const char *, int, void *), void *arg)
Definition: util.c:3767
xfree
void void xfree(void *)
tinytens
static const double tinytens[]
Definition: util.c:1840
Bcopy
#define Bcopy(x, y)
Definition: util.c:1056
word0
#define word0(x)
Definition: util.c:807
NULL
#define NULL
Definition: _sdbm.c:103
freelist
static Bigint * freelist[Kmax+1]
Definition: util.c:1004
match
static int match(VALUE str, VALUE pat, VALUE hash, int(*cb)(VALUE, VALUE))
Definition: date_parse.c:273
Exp_11
#define Exp_11
Definition: util.c:844
dval
#define dval(x)
Definition: util.c:813
ruby_strdup
char * ruby_strdup(const char *str)
Definition: util.c:457
i2b
static Bigint * i2b(int i)
Definition: util.c:1217
mult
static Bigint * mult(Bigint *a, Bigint *b)
Definition: util.c:1228
Bias
#define Bias
Definition: util.c:841
ISSPACE
#define ISSPACE(c)
Definition: ruby.h:1770
Frac_mask
#define Frac_mask
Definition: util.c:846
Exp_shift
#define Exp_shift
Definition: util.c:835
ruby_dtoa
char * ruby_dtoa(double d_, int mode, int ndigits, int *decpt, int *sign, char **rve)
Definition: util.c:3094
FREE
#define FREE
Definition: util.c:724
Generated on Mon Sep 22 2014 08:59:50 for Ruby by   doxygen 1.8.8