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