]>
Commit | Line | Data |
---|---|---|
d78fab6b | 1 | /** @file\r |
2 | \r | |
a0d36729 | 3 | Copyright (c) 2012 - 2014, Intel Corporation. All rights reserved.<BR>\r |
d78fab6b | 4 | This program and the accompanying materials are licensed and made available under\r |
5 | the terms and conditions of the BSD License that accompanies this distribution.\r | |
6 | The full text of the license may be found at\r | |
7 | http://opensource.org/licenses/bsd-license.\r | |
8 | \r | |
9 | THE PROGRAM IS DISTRIBUTED UNDER THE BSD LICENSE ON AN "AS IS" BASIS,\r | |
10 | WITHOUT WARRANTIES OR REPRESENTATIONS OF ANY KIND, EITHER EXPRESS OR IMPLIED.\r | |
11 | \r | |
12 | *****************************************************************\r | |
13 | \r | |
14 | The author of this software is David M. Gay.\r | |
15 | \r | |
16 | Copyright (C) 1998-2001 by Lucent Technologies\r | |
17 | All Rights Reserved\r | |
18 | \r | |
19 | Permission to use, copy, modify, and distribute this software and\r | |
20 | its documentation for any purpose and without fee is hereby\r | |
21 | granted, provided that the above copyright notice appear in all\r | |
22 | copies and that both that the copyright notice and this\r | |
23 | permission notice and warranty disclaimer appear in supporting\r | |
24 | documentation, and that the name of Lucent or any of its entities\r | |
25 | not be used in advertising or publicity pertaining to\r | |
26 | distribution of the software without specific, written prior\r | |
27 | permission.\r | |
28 | \r | |
29 | LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,\r | |
30 | INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.\r | |
31 | IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY\r | |
32 | SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES\r | |
33 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER\r | |
34 | IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,\r | |
35 | ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF\r | |
36 | THIS SOFTWARE.\r | |
37 | \r | |
d78fab6b | 38 | Please send bug reports to David M. Gay (dmg at acm dot org,\r |
39 | with " at " changed at "@" and " dot " changed to ".").\r | |
40 | \r | |
41 | *****************************************************************\r | |
42 | \r | |
43 | NetBSD: strtodg.c,v 1.5.14.1 2008/04/08 21:10:55 jdc Exp\r | |
44 | **/\r | |
2aa62f2b | 45 | #include <LibConfig.h>\r |
46 | \r | |
47 | #include "gdtoaimp.h"\r | |
48 | \r | |
49 | #ifdef USE_LOCALE\r | |
50 | #include "locale.h"\r | |
51 | #endif\r | |
52 | \r | |
53 | #if defined(_MSC_VER)\r | |
54 | // Disable warnings about assignment within conditional expressions.\r | |
55 | #pragma warning ( disable : 4706 )\r | |
56 | #endif\r | |
57 | \r | |
58 | static CONST int\r | |
59 | fivesbits[] = { 0, 3, 5, 7, 10, 12, 14, 17, 19, 21,\r | |
60 | 24, 26, 28, 31, 33, 35, 38, 40, 42, 45,\r | |
61 | 47, 49, 52\r | |
62 | #ifdef VAX\r | |
63 | , 54, 56\r | |
64 | #endif\r | |
65 | };\r | |
66 | \r | |
67 | Bigint *\r | |
2aa62f2b | 68 | increment(Bigint *b)\r |
2aa62f2b | 69 | {\r |
70 | ULong *x, *xe;\r | |
71 | Bigint *b1;\r | |
72 | #ifdef Pack_16\r | |
73 | ULong carry = 1, y;\r | |
74 | #endif\r | |
75 | \r | |
76 | x = b->x;\r | |
77 | xe = x + b->wds;\r | |
78 | #ifdef Pack_32\r | |
79 | do {\r | |
80 | if (*x < (ULong)0xffffffffL) {\r | |
81 | ++*x;\r | |
82 | return b;\r | |
83 | }\r | |
84 | *x++ = 0;\r | |
85 | } while(x < xe);\r | |
86 | #else\r | |
87 | do {\r | |
88 | y = *x + carry;\r | |
89 | carry = y >> 16;\r | |
90 | *x++ = y & 0xffff;\r | |
91 | if (!carry)\r | |
92 | return b;\r | |
93 | } while(x < xe);\r | |
94 | if (carry)\r | |
95 | #endif\r | |
96 | {\r | |
97 | if (b->wds >= b->maxwds) {\r | |
98 | b1 = Balloc(b->k+1);\r | |
99 | if (b1 == NULL)\r | |
100 | return NULL;\r | |
101 | Bcopy(b1,b);\r | |
102 | Bfree(b);\r | |
103 | b = b1;\r | |
104 | }\r | |
105 | b->x[b->wds++] = 1;\r | |
106 | }\r | |
107 | return b;\r | |
108 | }\r | |
109 | \r | |
110 | int\r | |
2aa62f2b | 111 | decrement(Bigint *b)\r |
2aa62f2b | 112 | {\r |
113 | ULong *x, *xe;\r | |
114 | #ifdef Pack_16\r | |
115 | ULong borrow = 1, y;\r | |
116 | #endif\r | |
117 | \r | |
118 | x = b->x;\r | |
119 | xe = x + b->wds;\r | |
120 | #ifdef Pack_32\r | |
121 | do {\r | |
122 | if (*x) {\r | |
123 | --*x;\r | |
124 | break;\r | |
125 | }\r | |
126 | *x++ = 0xffffffffUL;\r | |
127 | }\r | |
128 | while(x < xe);\r | |
129 | #else\r | |
130 | do {\r | |
131 | y = *x - borrow;\r | |
132 | borrow = (y & 0x10000) >> 16;\r | |
133 | *x++ = y & 0xffff;\r | |
134 | } while(borrow && x < xe);\r | |
135 | #endif\r | |
136 | return STRTOG_Inexlo;\r | |
137 | }\r | |
138 | \r | |
139 | static int\r | |
2aa62f2b | 140 | all_on(CONST Bigint *b, int n)\r |
2aa62f2b | 141 | {\r |
142 | CONST ULong *x, *xe;\r | |
143 | \r | |
144 | x = b->x;\r | |
145 | xe = x + ((unsigned int)n >> kshift);\r | |
146 | while(x < xe)\r | |
147 | if ((*x++ & ALL_ON) != ALL_ON)\r | |
148 | return 0;\r | |
149 | if (n &= kmask)\r | |
150 | return ((*x | (ALL_ON << n)) & ALL_ON) == ALL_ON;\r | |
151 | return 1;\r | |
152 | }\r | |
153 | \r | |
154 | Bigint *\r | |
2aa62f2b | 155 | set_ones(Bigint *b, int n)\r |
2aa62f2b | 156 | {\r |
157 | int k;\r | |
158 | ULong *x, *xe;\r | |
159 | \r | |
160 | k = (unsigned int)(n + ((1 << kshift) - 1)) >> kshift;\r | |
161 | if (b->k < k) {\r | |
162 | Bfree(b);\r | |
163 | b = Balloc(k);\r | |
164 | if (b == NULL)\r | |
165 | return NULL;\r | |
166 | }\r | |
167 | k = (unsigned int)n >> kshift;\r | |
168 | if (n &= kmask)\r | |
169 | k++;\r | |
170 | b->wds = k;\r | |
171 | x = b->x;\r | |
172 | xe = x + k;\r | |
173 | while(x < xe)\r | |
174 | *x++ = ALL_ON;\r | |
175 | if (n)\r | |
176 | x[-1] >>= ULbits - n;\r | |
177 | return b;\r | |
178 | }\r | |
179 | \r | |
180 | static int\r | |
a0d36729 DM |
181 | rvOK (\r |
182 | double d, CONST FPI *fpi, Long *expt, ULong *bits, int exact, int rd, int *irv\r | |
183 | )\r | |
2aa62f2b | 184 | {\r |
185 | Bigint *b;\r | |
186 | ULong carry, inex, lostbits;\r | |
187 | int bdif, e, j, k, k1, nb, rv;\r | |
188 | \r | |
189 | carry = rv = 0;\r | |
190 | b = d2b(d, &e, &bdif);\r | |
191 | bdif -= nb = fpi->nbits;\r | |
192 | e += bdif;\r | |
193 | if (bdif <= 0) {\r | |
194 | if (exact)\r | |
195 | goto trunc;\r | |
196 | goto ret;\r | |
197 | }\r | |
198 | if (P == nb) {\r | |
199 | if (\r | |
200 | #ifndef IMPRECISE_INEXACT\r | |
201 | exact &&\r | |
202 | #endif\r | |
203 | fpi->rounding ==\r | |
204 | #ifdef RND_PRODQUOT\r | |
205 | FPI_Round_near\r | |
206 | #else\r | |
207 | Flt_Rounds\r | |
208 | #endif\r | |
209 | ) goto trunc;\r | |
210 | goto ret;\r | |
211 | }\r | |
212 | switch(rd) {\r | |
213 | case 1:\r | |
214 | goto trunc;\r | |
215 | case 2:\r | |
216 | break;\r | |
217 | default: /* round near */\r | |
218 | k = bdif - 1;\r | |
219 | if (!k) {\r | |
220 | if (!exact)\r | |
221 | goto ret;\r | |
222 | if (b->x[0] & 2)\r | |
223 | break;\r | |
224 | goto trunc;\r | |
225 | }\r | |
226 | if (b->x[(unsigned int)k>>kshift] & ((ULong)1 << (k & kmask)))\r | |
227 | break;\r | |
228 | goto trunc;\r | |
229 | }\r | |
230 | /* "break" cases: round up 1 bit, then truncate; bdif > 0 */\r | |
231 | carry = 1;\r | |
232 | trunc:\r | |
233 | inex = lostbits = 0;\r | |
234 | if (bdif > 0) {\r | |
235 | if ( (lostbits = any_on(b, bdif)) !=0)\r | |
236 | inex = STRTOG_Inexlo;\r | |
237 | rshift(b, bdif);\r | |
238 | if (carry) {\r | |
239 | inex = STRTOG_Inexhi;\r | |
240 | b = increment(b);\r | |
241 | if ( (j = nb & kmask) !=0)\r | |
242 | j = ULbits - j;\r | |
243 | if (hi0bits(b->x[b->wds - 1]) != j) {\r | |
244 | if (!lostbits)\r | |
245 | lostbits = b->x[0] & 1;\r | |
246 | rshift(b, 1);\r | |
247 | e++;\r | |
248 | }\r | |
249 | }\r | |
250 | }\r | |
251 | else if (bdif < 0)\r | |
252 | b = lshift(b, -bdif);\r | |
253 | if (e < fpi->emin) {\r | |
254 | k = fpi->emin - e;\r | |
255 | e = fpi->emin;\r | |
256 | if (k > nb || fpi->sudden_underflow) {\r | |
257 | inex = b->wds = 0;\r | |
258 | *irv = STRTOG_Underflow | STRTOG_Inexlo;\r | |
259 | }\r | |
260 | else {\r | |
261 | k1 = k - 1;\r | |
262 | if (k1 > 0 && !lostbits)\r | |
263 | lostbits = any_on(b, k1);\r | |
264 | if (!lostbits && !exact)\r | |
265 | goto ret;\r | |
266 | lostbits |=\r | |
267 | carry = b->x[(unsigned int)k1>>kshift] &\r | |
268 | (ULong)(1 << ((unsigned int)k1 & kmask));\r | |
269 | rshift(b, k);\r | |
270 | *irv = STRTOG_Denormal;\r | |
271 | if (carry) {\r | |
272 | b = increment(b);\r | |
273 | inex = STRTOG_Inexhi | STRTOG_Underflow;\r | |
274 | }\r | |
275 | else if (lostbits)\r | |
276 | inex = STRTOG_Inexlo | STRTOG_Underflow;\r | |
277 | }\r | |
278 | }\r | |
279 | else if (e > fpi->emax) {\r | |
280 | e = fpi->emax + 1;\r | |
281 | *irv = STRTOG_Infinite | STRTOG_Overflow | STRTOG_Inexhi;\r | |
282 | #ifndef NO_ERRNO\r | |
283 | errno = ERANGE;\r | |
284 | #endif\r | |
285 | inex = b->wds = 0;\r | |
286 | }\r | |
287 | *expt = e;\r | |
288 | copybits(bits, nb, b);\r | |
289 | *irv |= inex;\r | |
290 | rv = 1;\r | |
291 | ret:\r | |
292 | Bfree(b);\r | |
293 | return rv;\r | |
294 | }\r | |
295 | \r | |
2aa62f2b | 296 | static int\r |
2aa62f2b | 297 | mantbits(double d)\r |
2aa62f2b | 298 | {\r |
299 | ULong L;\r | |
2aa62f2b | 300 | if ( (L = word1(d)) !=0)\r |
2aa62f2b | 301 | return P - lo0bits(&L);\r |
2aa62f2b | 302 | L = word0(d) | Exp_msk1;\r |
2aa62f2b | 303 | return P - 32 - lo0bits(&L);\r |
304 | }\r | |
2aa62f2b | 305 | \r |
306 | int\r | |
a0d36729 DM |
307 | strtodg (\r |
308 | CONST char *s00, char **se, CONST FPI *fpi, Long *expt, ULong *bits\r | |
309 | )\r | |
2aa62f2b | 310 | {\r |
a0d36729 | 311 | int abe = 0, abits = 0, asub;\r |
2aa62f2b | 312 | int bb0, bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, decpt, denorm;\r |
313 | int dsign, e, e1, e2, emin, esign, finished, i, inex, irv;\r | |
314 | int j, k, nbits, nd, nd0, nf, nz, nz0, rd, rvbits, rve, rve1, sign;\r | |
315 | int sudden_underflow = 0; /* pacify gcc */\r | |
316 | CONST char *s, *s0, *s1;\r | |
317 | double adj, adj0, rv, tol;\r | |
318 | Long L;\r | |
319 | ULong y, z;\r | |
320 | Bigint *ab, *bb, *bb1, *bd, *bd0, *bs, *delta, *rvb, *rvb0;\r | |
321 | \r | |
322 | e2 = 0; /* XXX gcc */\r | |
323 | \r | |
324 | irv = STRTOG_Zero;\r | |
325 | denorm = sign = nz0 = nz = 0;\r | |
326 | dval(rv) = 0.;\r | |
327 | rvb = 0;\r | |
328 | nbits = fpi->nbits;\r | |
329 | for(s = s00;;s++) switch(*s) {\r | |
330 | case '-':\r | |
331 | sign = 1;\r | |
332 | /* FALLTHROUGH */\r | |
333 | case '+':\r | |
334 | if (*++s)\r | |
335 | goto break2;\r | |
336 | /* FALLTHROUGH */\r | |
337 | case 0:\r | |
338 | sign = 0;\r | |
339 | irv = STRTOG_NoNumber;\r | |
340 | s = s00;\r | |
341 | goto ret;\r | |
342 | case '\t':\r | |
343 | case '\n':\r | |
344 | case '\v':\r | |
345 | case '\f':\r | |
346 | case '\r':\r | |
347 | case ' ':\r | |
348 | continue;\r | |
349 | default:\r | |
350 | goto break2;\r | |
351 | }\r | |
352 | break2:\r | |
353 | if (*s == '0') {\r | |
354 | #ifndef NO_HEX_FP\r | |
355 | switch(s[1]) {\r | |
356 | case 'x':\r | |
357 | case 'X':\r | |
358 | irv = gethex(&s, fpi, expt, &rvb, sign);\r | |
359 | if (irv == STRTOG_NoNumber) {\r | |
360 | s = s00;\r | |
361 | sign = 0;\r | |
362 | }\r | |
363 | goto ret;\r | |
364 | }\r | |
365 | #endif\r | |
366 | nz0 = 1;\r | |
367 | while(*++s == '0') ;\r | |
368 | if (!*s)\r | |
369 | goto ret;\r | |
370 | }\r | |
371 | sudden_underflow = fpi->sudden_underflow;\r | |
372 | s0 = s;\r | |
373 | y = z = 0;\r | |
374 | for(decpt = nd = nf = 0; (c = *s) >= '0' && c <= '9'; nd++, s++)\r | |
375 | if (nd < 9)\r | |
376 | y = 10*y + c - '0';\r | |
377 | else if (nd < 16)\r | |
378 | z = 10*z + c - '0';\r | |
379 | nd0 = nd;\r | |
380 | #ifdef USE_LOCALE\r | |
381 | if (c == *localeconv()->decimal_point)\r | |
382 | #else\r | |
383 | if (c == '.')\r | |
384 | #endif\r | |
385 | {\r | |
386 | decpt = 1;\r | |
387 | c = *++s;\r | |
388 | if (!nd) {\r | |
389 | for(; c == '0'; c = *++s)\r | |
390 | nz++;\r | |
391 | if (c > '0' && c <= '9') {\r | |
392 | s0 = s;\r | |
393 | nf += nz;\r | |
394 | nz = 0;\r | |
395 | goto have_dig;\r | |
396 | }\r | |
397 | goto dig_done;\r | |
398 | }\r | |
399 | for(; c >= '0' && c <= '9'; c = *++s) {\r | |
400 | have_dig:\r | |
401 | nz++;\r | |
402 | if (c -= '0') {\r | |
403 | nf += nz;\r | |
404 | for(i = 1; i < nz; i++)\r | |
405 | if (nd++ < 9)\r | |
406 | y *= 10;\r | |
407 | else if (nd <= DBL_DIG + 1)\r | |
408 | z *= 10;\r | |
409 | if (nd++ < 9)\r | |
410 | y = 10*y + c;\r | |
411 | else if (nd <= DBL_DIG + 1)\r | |
412 | z = 10*z + c;\r | |
413 | nz = 0;\r | |
414 | }\r | |
415 | }\r | |
416 | }\r | |
417 | dig_done:\r | |
418 | e = 0;\r | |
419 | if (c == 'e' || c == 'E') {\r | |
420 | if (!nd && !nz && !nz0) {\r | |
421 | irv = STRTOG_NoNumber;\r | |
422 | s = s00;\r | |
423 | goto ret;\r | |
424 | }\r | |
425 | s00 = s;\r | |
426 | esign = 0;\r | |
427 | switch(c = *++s) {\r | |
428 | case '-':\r | |
429 | esign = 1;\r | |
430 | /* FALLTHROUGH */\r | |
431 | case '+':\r | |
432 | c = *++s;\r | |
433 | }\r | |
434 | if (c >= '0' && c <= '9') {\r | |
435 | while(c == '0')\r | |
436 | c = *++s;\r | |
437 | if (c > '0' && c <= '9') {\r | |
438 | L = c - '0';\r | |
439 | s1 = s;\r | |
440 | while((c = *++s) >= '0' && c <= '9')\r | |
441 | L = 10*L + c - '0';\r | |
442 | if (s - s1 > 8 || L > 19999)\r | |
443 | /* Avoid confusion from exponents\r | |
444 | * so large that e might overflow.\r | |
445 | */\r | |
446 | e = 19999; /* safe for 16 bit ints */\r | |
447 | else\r | |
448 | e = (int)L;\r | |
449 | if (esign)\r | |
450 | e = -e;\r | |
451 | }\r | |
452 | else\r | |
453 | e = 0;\r | |
454 | }\r | |
455 | else\r | |
456 | s = s00;\r | |
457 | }\r | |
458 | if (!nd) {\r | |
459 | if (!nz && !nz0) {\r | |
460 | #ifdef INFNAN_CHECK\r | |
461 | /* Check for Nan and Infinity */\r | |
462 | if (!decpt)\r | |
463 | switch(c) {\r | |
464 | case 'i':\r | |
465 | case 'I':\r | |
466 | if (match(&s,"nf")) {\r | |
467 | --s;\r | |
468 | if (!match(&s,"inity"))\r | |
469 | ++s;\r | |
470 | irv = STRTOG_Infinite;\r | |
471 | goto infnanexp;\r | |
472 | }\r | |
473 | break;\r | |
474 | case 'n':\r | |
475 | case 'N':\r | |
476 | if (match(&s, "an")) {\r | |
477 | irv = STRTOG_NaN;\r | |
478 | *expt = fpi->emax + 1;\r | |
479 | #ifndef No_Hex_NaN\r | |
480 | if (*s == '(') /*)*/\r | |
481 | irv = hexnan(&s, fpi, bits);\r | |
482 | #endif\r | |
483 | goto infnanexp;\r | |
484 | }\r | |
485 | }\r | |
486 | #endif /* INFNAN_CHECK */\r | |
487 | irv = STRTOG_NoNumber;\r | |
488 | s = s00;\r | |
489 | }\r | |
490 | goto ret;\r | |
491 | }\r | |
492 | \r | |
493 | irv = STRTOG_Normal;\r | |
494 | e1 = e -= nf;\r | |
495 | rd = 0;\r | |
496 | switch(fpi->rounding & 3) {\r | |
497 | case FPI_Round_up:\r | |
498 | rd = 2 - sign;\r | |
499 | break;\r | |
500 | case FPI_Round_zero:\r | |
501 | rd = 1;\r | |
502 | break;\r | |
503 | case FPI_Round_down:\r | |
504 | rd = 1 + sign;\r | |
505 | }\r | |
506 | \r | |
507 | /* Now we have nd0 digits, starting at s0, followed by a\r | |
508 | * decimal point, followed by nd-nd0 digits. The number we're\r | |
509 | * after is the integer represented by those digits times\r | |
510 | * 10**e */\r | |
511 | \r | |
512 | if (!nd0)\r | |
513 | nd0 = nd;\r | |
514 | k = nd < DBL_DIG + 1 ? nd : DBL_DIG + 1;\r | |
515 | dval(rv) = (double)y;\r | |
516 | if (k > 9)\r | |
517 | dval(rv) = tens[k - 9] * dval(rv) + z;\r | |
518 | bd0 = 0;\r | |
519 | if (nbits <= P && nd <= DBL_DIG) {\r | |
520 | if (!e) {\r | |
521 | if (rvOK(dval(rv), fpi, expt, bits, 1, rd, &irv))\r | |
522 | goto ret;\r | |
523 | }\r | |
524 | else if (e > 0) {\r | |
525 | if (e <= Ten_pmax) {\r | |
2aa62f2b | 526 | i = fivesbits[e] + mantbits(dval(rv)) <= P;\r |
527 | /* rv = */ rounded_product(dval(rv), tens[e]);\r | |
528 | if (rvOK(dval(rv), fpi, expt, bits, i, rd, &irv))\r | |
529 | goto ret;\r | |
530 | e1 -= e;\r | |
531 | goto rv_notOK;\r | |
2aa62f2b | 532 | }\r |
533 | i = DBL_DIG - nd;\r | |
534 | if (e <= Ten_pmax + i) {\r | |
535 | /* A fancier test would sometimes let us do\r | |
536 | * this for larger i values.\r | |
537 | */\r | |
538 | e2 = e - i;\r | |
539 | e1 -= i;\r | |
540 | dval(rv) *= tens[i];\r | |
2aa62f2b | 541 | /* rv = */ rounded_product(dval(rv), tens[e2]);\r |
2aa62f2b | 542 | if (rvOK(dval(rv), fpi, expt, bits, 0, rd, &irv))\r |
543 | goto ret;\r | |
544 | e1 -= e2;\r | |
545 | }\r | |
546 | }\r | |
547 | #ifndef Inaccurate_Divide\r | |
548 | else if (e >= -Ten_pmax) {\r | |
549 | /* rv = */ rounded_quotient(dval(rv), tens[-e]);\r | |
550 | if (rvOK(dval(rv), fpi, expt, bits, 0, rd, &irv))\r | |
551 | goto ret;\r | |
552 | e1 -= e;\r | |
553 | }\r | |
554 | #endif\r | |
555 | }\r | |
556 | rv_notOK:\r | |
557 | e1 += nd - k;\r | |
558 | \r | |
559 | /* Get starting approximation = rv * 10**e1 */\r | |
560 | \r | |
561 | e2 = 0;\r | |
562 | if (e1 > 0) {\r | |
563 | if ( (i = e1 & 15) !=0)\r | |
564 | dval(rv) *= tens[i];\r | |
565 | if (e1 &= ~15) {\r | |
566 | e1 = (unsigned int)e1 >> 4;\r | |
567 | while(e1 >= (1 << (n_bigtens-1))) {\r | |
d78fab6b | 568 | e2 += (unsigned int)((word0(rv) & Exp_mask)\r |
2aa62f2b | 569 | >> Exp_shift1) - Bias;\r |
570 | word0(rv) &= ~Exp_mask;\r | |
571 | word0(rv) |= Bias << Exp_shift1;\r | |
572 | dval(rv) *= bigtens[n_bigtens-1];\r | |
573 | e1 -= 1 << (n_bigtens-1);\r | |
574 | }\r | |
d78fab6b | 575 | e2 += (unsigned int)((word0(rv) & Exp_mask) >> Exp_shift1) - Bias;\r |
2aa62f2b | 576 | word0(rv) &= ~Exp_mask;\r |
577 | word0(rv) |= Bias << Exp_shift1;\r | |
578 | for(j = 0; e1 > 0; j++, e1 = (unsigned int)e1 >> 1)\r | |
579 | if (e1 & 1)\r | |
580 | dval(rv) *= bigtens[j];\r | |
581 | }\r | |
582 | }\r | |
583 | else if (e1 < 0) {\r | |
584 | e1 = -e1;\r | |
585 | if ( (i = e1 & 15) !=0)\r | |
586 | dval(rv) /= tens[i];\r | |
587 | if (e1 &= ~15) {\r | |
588 | e1 = (unsigned int)e1 >> 4;\r | |
589 | while(e1 >= (1 << (n_bigtens-1))) {\r | |
d78fab6b | 590 | e2 += (unsigned int)((word0(rv) & Exp_mask)\r |
2aa62f2b | 591 | >> Exp_shift1) - Bias;\r |
592 | word0(rv) &= ~Exp_mask;\r | |
593 | word0(rv) |= Bias << Exp_shift1;\r | |
594 | dval(rv) *= tinytens[n_bigtens-1];\r | |
595 | e1 -= 1 << (n_bigtens-1);\r | |
596 | }\r | |
d78fab6b | 597 | e2 += (unsigned int)((word0(rv) & Exp_mask) >> Exp_shift1) - Bias;\r |
2aa62f2b | 598 | word0(rv) &= ~Exp_mask;\r |
599 | word0(rv) |= Bias << Exp_shift1;\r | |
600 | for(j = 0; e1 > 0; j++, e1 = (unsigned int)e1 >> 1)\r | |
601 | if (e1 & 1)\r | |
602 | dval(rv) *= tinytens[j];\r | |
603 | }\r | |
604 | }\r | |
2aa62f2b | 605 | rvb = d2b(dval(rv), &rve, &rvbits); /* rv = rvb * 2^rve */\r |
606 | if (rvb == NULL)\r | |
607 | return STRTOG_NoMemory;\r | |
608 | rve += e2;\r | |
609 | if ((j = rvbits - nbits) > 0) {\r | |
610 | rshift(rvb, j);\r | |
611 | rvbits = nbits;\r | |
612 | rve += j;\r | |
613 | }\r | |
614 | bb0 = 0; /* trailing zero bits in rvb */\r | |
615 | e2 = rve + rvbits - nbits;\r | |
616 | if (e2 > fpi->emax + 1)\r | |
617 | goto huge;\r | |
618 | rve1 = rve + rvbits - nbits;\r | |
619 | if (e2 < (emin = fpi->emin)) {\r | |
620 | denorm = 1;\r | |
621 | j = rve - emin;\r | |
622 | if (j > 0) {\r | |
623 | rvb = lshift(rvb, j);\r | |
624 | rvbits += j;\r | |
625 | }\r | |
626 | else if (j < 0) {\r | |
627 | rvbits += j;\r | |
628 | if (rvbits <= 0) {\r | |
629 | if (rvbits < -1) {\r | |
630 | ufl:\r | |
631 | rvb->wds = 0;\r | |
632 | rvb->x[0] = 0;\r | |
633 | *expt = emin;\r | |
634 | irv = STRTOG_Underflow | STRTOG_Inexlo;\r | |
635 | goto ret;\r | |
636 | }\r | |
637 | rvb->x[0] = rvb->wds = rvbits = 1;\r | |
638 | }\r | |
639 | else\r | |
640 | rshift(rvb, -j);\r | |
641 | }\r | |
642 | rve = rve1 = emin;\r | |
643 | if (sudden_underflow && e2 + 1 < emin)\r | |
644 | goto ufl;\r | |
645 | }\r | |
646 | \r | |
647 | /* Now the hard part -- adjusting rv to the correct value.*/\r | |
648 | \r | |
649 | /* Put digits into bd: true value = bd * 10^e */\r | |
650 | \r | |
651 | bd0 = s2b(s0, nd0, nd, y);\r | |
652 | \r | |
653 | for(;;) {\r | |
654 | bd = Balloc(bd0->k);\r | |
655 | if (bd == NULL)\r | |
656 | return STRTOG_NoMemory;\r | |
657 | Bcopy(bd, bd0);\r | |
658 | bb = Balloc(rvb->k);\r | |
659 | if (bb == NULL)\r | |
660 | return STRTOG_NoMemory;\r | |
661 | Bcopy(bb, rvb);\r | |
662 | bbbits = rvbits - bb0;\r | |
663 | bbe = rve + bb0;\r | |
664 | bs = i2b(1);\r | |
665 | if (bs == NULL)\r | |
666 | return STRTOG_NoMemory;\r | |
667 | \r | |
668 | if (e >= 0) {\r | |
669 | bb2 = bb5 = 0;\r | |
670 | bd2 = bd5 = e;\r | |
671 | }\r | |
672 | else {\r | |
673 | bb2 = bb5 = -e;\r | |
674 | bd2 = bd5 = 0;\r | |
675 | }\r | |
676 | if (bbe >= 0)\r | |
677 | bb2 += bbe;\r | |
678 | else\r | |
679 | bd2 -= bbe;\r | |
680 | bs2 = bb2;\r | |
681 | j = nbits + 1 - bbbits;\r | |
682 | i = bbe + bbbits - nbits;\r | |
683 | if (i < emin) /* denormal */\r | |
684 | j += i - emin;\r | |
685 | bb2 += j;\r | |
686 | bd2 += j;\r | |
687 | i = bb2 < bd2 ? bb2 : bd2;\r | |
688 | if (i > bs2)\r | |
689 | i = bs2;\r | |
690 | if (i > 0) {\r | |
691 | bb2 -= i;\r | |
692 | bd2 -= i;\r | |
693 | bs2 -= i;\r | |
694 | }\r | |
695 | if (bb5 > 0) {\r | |
696 | bs = pow5mult(bs, bb5);\r | |
697 | if (bs == NULL)\r | |
698 | return STRTOG_NoMemory;\r | |
699 | bb1 = mult(bs, bb);\r | |
700 | if (bb1 == NULL)\r | |
701 | return STRTOG_NoMemory;\r | |
702 | Bfree(bb);\r | |
703 | bb = bb1;\r | |
704 | }\r | |
705 | bb2 -= bb0;\r | |
706 | if (bb2 > 0) {\r | |
707 | bb = lshift(bb, bb2);\r | |
708 | if (bb == NULL)\r | |
709 | return STRTOG_NoMemory;\r | |
710 | }\r | |
711 | else if (bb2 < 0)\r | |
712 | rshift(bb, -bb2);\r | |
713 | if (bd5 > 0) {\r | |
714 | bd = pow5mult(bd, bd5);\r | |
715 | if (bd == NULL)\r | |
716 | return STRTOG_NoMemory;\r | |
717 | }\r | |
718 | if (bd2 > 0) {\r | |
719 | bd = lshift(bd, bd2);\r | |
720 | if (bd == NULL)\r | |
721 | return STRTOG_NoMemory;\r | |
722 | }\r | |
723 | if (bs2 > 0) {\r | |
724 | bs = lshift(bs, bs2);\r | |
725 | if (bs == NULL)\r | |
726 | return STRTOG_NoMemory;\r | |
727 | }\r | |
728 | asub = 1;\r | |
729 | inex = STRTOG_Inexhi;\r | |
730 | delta = diff(bb, bd);\r | |
731 | if (delta == NULL)\r | |
732 | return STRTOG_NoMemory;\r | |
733 | if (delta->wds <= 1 && !delta->x[0])\r | |
734 | break;\r | |
735 | dsign = delta->sign;\r | |
736 | delta->sign = finished = 0;\r | |
737 | L = 0;\r | |
738 | i = cmp(delta, bs);\r | |
739 | if (rd && i <= 0) {\r | |
740 | irv = STRTOG_Normal;\r | |
741 | if ( (finished = dsign ^ (rd&1)) !=0) {\r | |
742 | if (dsign != 0) {\r | |
743 | irv |= STRTOG_Inexhi;\r | |
744 | goto adj1;\r | |
745 | }\r | |
746 | irv |= STRTOG_Inexlo;\r | |
747 | if (rve1 == emin)\r | |
748 | goto adj1;\r | |
749 | for(i = 0, j = nbits; j >= ULbits;\r | |
750 | i++, j -= ULbits) {\r | |
751 | if (rvb->x[i] & ALL_ON)\r | |
752 | goto adj1;\r | |
753 | }\r | |
754 | if (j > 1 && lo0bits(rvb->x + i) < j - 1)\r | |
755 | goto adj1;\r | |
756 | rve = rve1 - 1;\r | |
757 | rvb = set_ones(rvb, rvbits = nbits);\r | |
758 | if (rvb == NULL)\r | |
759 | return STRTOG_NoMemory;\r | |
760 | break;\r | |
761 | }\r | |
762 | irv |= dsign ? STRTOG_Inexlo : STRTOG_Inexhi;\r | |
763 | break;\r | |
764 | }\r | |
765 | if (i < 0) {\r | |
766 | /* Error is less than half an ulp -- check for\r | |
767 | * special case of mantissa a power of two.\r | |
768 | */\r | |
769 | irv = dsign\r | |
770 | ? STRTOG_Normal | STRTOG_Inexlo\r | |
771 | : STRTOG_Normal | STRTOG_Inexhi;\r | |
772 | if (dsign || bbbits > 1 || denorm || rve1 == emin)\r | |
773 | break;\r | |
774 | delta = lshift(delta,1);\r | |
775 | if (delta == NULL)\r | |
776 | return STRTOG_NoMemory;\r | |
777 | if (cmp(delta, bs) > 0) {\r | |
778 | irv = STRTOG_Normal | STRTOG_Inexlo;\r | |
779 | goto drop_down;\r | |
780 | }\r | |
781 | break;\r | |
782 | }\r | |
783 | if (i == 0) {\r | |
784 | /* exactly half-way between */\r | |
785 | if (dsign) {\r | |
786 | if (denorm && all_on(rvb, rvbits)) {\r | |
787 | /*boundary case -- increment exponent*/\r | |
788 | rvb->wds = 1;\r | |
789 | rvb->x[0] = 1;\r | |
790 | rve = emin + nbits - (rvbits = 1);\r | |
791 | irv = STRTOG_Normal | STRTOG_Inexhi;\r | |
792 | denorm = 0;\r | |
793 | break;\r | |
794 | }\r | |
795 | irv = STRTOG_Normal | STRTOG_Inexlo;\r | |
796 | }\r | |
797 | else if (bbbits == 1) {\r | |
798 | irv = STRTOG_Normal;\r | |
799 | drop_down:\r | |
800 | /* boundary case -- decrement exponent */\r | |
801 | if (rve1 == emin) {\r | |
802 | irv = STRTOG_Normal | STRTOG_Inexhi;\r | |
803 | if (rvb->wds == 1 && rvb->x[0] == 1)\r | |
804 | sudden_underflow = 1;\r | |
805 | break;\r | |
806 | }\r | |
807 | rve -= nbits;\r | |
808 | rvb = set_ones(rvb, rvbits = nbits);\r | |
809 | if (rvb == NULL)\r | |
810 | return STRTOG_NoMemory;\r | |
811 | break;\r | |
812 | }\r | |
813 | else\r | |
814 | irv = STRTOG_Normal | STRTOG_Inexhi;\r | |
815 | if ((bbbits < nbits && !denorm) || !(rvb->x[0] & 1))\r | |
816 | break;\r | |
817 | if (dsign) {\r | |
818 | rvb = increment(rvb);\r | |
819 | if (rvb == NULL)\r | |
820 | return STRTOG_NoMemory;\r | |
821 | if ( (j = rvbits & kmask) !=0)\r | |
822 | j = ULbits - j;\r | |
823 | if (hi0bits(rvb->x[(unsigned int)(rvb->wds - 1)\r | |
824 | >> kshift])\r | |
825 | != j)\r | |
826 | rvbits++;\r | |
827 | irv = STRTOG_Normal | STRTOG_Inexhi;\r | |
828 | }\r | |
829 | else {\r | |
830 | if (bbbits == 1)\r | |
831 | goto undfl;\r | |
832 | decrement(rvb);\r | |
833 | irv = STRTOG_Normal | STRTOG_Inexlo;\r | |
834 | }\r | |
835 | break;\r | |
836 | }\r | |
837 | if ((dval(adj) = ratio(delta, bs)) <= 2.) {\r | |
838 | adj1:\r | |
839 | inex = STRTOG_Inexlo;\r | |
840 | if (dsign) {\r | |
841 | asub = 0;\r | |
842 | inex = STRTOG_Inexhi;\r | |
843 | }\r | |
844 | else if (denorm && bbbits <= 1) {\r | |
845 | undfl:\r | |
846 | rvb->wds = 0;\r | |
847 | rve = emin;\r | |
848 | irv = STRTOG_Underflow | STRTOG_Inexlo;\r | |
849 | break;\r | |
850 | }\r | |
851 | adj0 = dval(adj) = 1.;\r | |
852 | }\r | |
853 | else {\r | |
854 | adj0 = dval(adj) *= 0.5;\r | |
855 | if (dsign) {\r | |
856 | asub = 0;\r | |
857 | inex = STRTOG_Inexlo;\r | |
858 | }\r | |
859 | if (dval(adj) < 2147483647.) {\r | |
a0d36729 | 860 | L = (Long)adj0;\r |
2aa62f2b | 861 | adj0 -= L;\r |
862 | switch(rd) {\r | |
863 | case 0:\r | |
864 | if (adj0 >= .5)\r | |
865 | goto inc_L;\r | |
866 | break;\r | |
867 | case 1:\r | |
868 | if (asub && adj0 > 0.)\r | |
869 | goto inc_L;\r | |
870 | break;\r | |
871 | case 2:\r | |
872 | if (!asub && adj0 > 0.) {\r | |
a0d36729 | 873 | inc_L:\r |
2aa62f2b | 874 | L++;\r |
875 | inex = STRTOG_Inexact - inex;\r | |
876 | }\r | |
877 | }\r | |
878 | dval(adj) = (double)L;\r | |
879 | }\r | |
880 | }\r | |
881 | y = rve + rvbits;\r | |
882 | \r | |
883 | /* adj *= ulp(dval(rv)); */\r | |
884 | /* if (asub) rv -= adj; else rv += adj; */\r | |
885 | \r | |
886 | if (!denorm && rvbits < nbits) {\r | |
887 | rvb = lshift(rvb, j = nbits - rvbits);\r | |
888 | if (rvb == NULL)\r | |
889 | return STRTOG_NoMemory;\r | |
890 | rve -= j;\r | |
891 | rvbits = nbits;\r | |
892 | }\r | |
893 | ab = d2b(dval(adj), &abe, &abits);\r | |
894 | if (ab == NULL)\r | |
895 | return STRTOG_NoMemory;\r | |
896 | if (abe < 0)\r | |
897 | rshift(ab, -abe);\r | |
898 | else if (abe > 0)\r | |
899 | ab = lshift(ab, abe);\r | |
900 | rvb0 = rvb;\r | |
901 | if (asub) {\r | |
902 | /* rv -= adj; */\r | |
903 | j = hi0bits(rvb->x[rvb->wds-1]);\r | |
904 | rvb = diff(rvb, ab);\r | |
905 | if (rvb == NULL)\r | |
906 | return STRTOG_NoMemory;\r | |
907 | k = rvb0->wds - 1;\r | |
908 | if (denorm)\r | |
909 | /* do nothing */;\r | |
910 | else if (rvb->wds <= k\r | |
911 | || hi0bits( rvb->x[k]) >\r | |
912 | hi0bits(rvb0->x[k])) {\r | |
913 | /* unlikely; can only have lost 1 high bit */\r | |
914 | if (rve1 == emin) {\r | |
915 | --rvbits;\r | |
916 | denorm = 1;\r | |
917 | }\r | |
918 | else {\r | |
919 | rvb = lshift(rvb, 1);\r | |
920 | if (rvb == NULL)\r | |
921 | return STRTOG_NoMemory;\r | |
922 | --rve;\r | |
923 | --rve1;\r | |
924 | L = finished = 0;\r | |
925 | }\r | |
926 | }\r | |
927 | }\r | |
928 | else {\r | |
929 | rvb = sum(rvb, ab);\r | |
930 | if (rvb == NULL)\r | |
931 | return STRTOG_NoMemory;\r | |
932 | k = rvb->wds - 1;\r | |
933 | if (k >= rvb0->wds\r | |
934 | || hi0bits(rvb->x[k]) < hi0bits(rvb0->x[k])) {\r | |
935 | if (denorm) {\r | |
936 | if (++rvbits == nbits)\r | |
937 | denorm = 0;\r | |
938 | }\r | |
939 | else {\r | |
940 | rshift(rvb, 1);\r | |
941 | rve++;\r | |
942 | rve1++;\r | |
943 | L = 0;\r | |
944 | }\r | |
945 | }\r | |
946 | }\r | |
947 | Bfree(ab);\r | |
948 | Bfree(rvb0);\r | |
949 | if (finished)\r | |
950 | break;\r | |
951 | \r | |
952 | z = rve + rvbits;\r | |
953 | if (y == z && L) {\r | |
954 | /* Can we stop now? */\r | |
955 | tol = dval(adj) * 5e-16; /* > max rel error */\r | |
956 | dval(adj) = adj0 - .5;\r | |
957 | if (dval(adj) < -tol) {\r | |
958 | if (adj0 > tol) {\r | |
959 | irv |= inex;\r | |
960 | break;\r | |
961 | }\r | |
962 | }\r | |
963 | else if (dval(adj) > tol && adj0 < 1. - tol) {\r | |
964 | irv |= inex;\r | |
965 | break;\r | |
966 | }\r | |
967 | }\r | |
968 | bb0 = denorm ? 0 : trailz(rvb);\r | |
969 | Bfree(bb);\r | |
970 | Bfree(bd);\r | |
971 | Bfree(bs);\r | |
972 | Bfree(delta);\r | |
973 | }\r | |
974 | if (!denorm && (j = nbits - rvbits)) {\r | |
975 | if (j > 0)\r | |
976 | rvb = lshift(rvb, j);\r | |
977 | else\r | |
978 | rshift(rvb, -j);\r | |
979 | rve -= j;\r | |
980 | }\r | |
981 | *expt = rve;\r | |
982 | Bfree(bb);\r | |
983 | Bfree(bd);\r | |
984 | Bfree(bs);\r | |
985 | Bfree(bd0);\r | |
986 | Bfree(delta);\r | |
987 | if (rve > fpi->emax) {\r | |
988 | huge:\r | |
989 | rvb->wds = 0;\r | |
990 | irv = STRTOG_Infinite | STRTOG_Overflow | STRTOG_Inexhi;\r | |
991 | #ifndef NO_ERRNO\r | |
992 | errno = ERANGE;\r | |
993 | #endif\r | |
994 | #ifdef INFNAN_CHECK\r | |
995 | infnanexp:\r | |
996 | #endif\r | |
997 | *expt = fpi->emax + 1;\r | |
998 | }\r | |
999 | ret:\r | |
1000 | if (denorm) {\r | |
1001 | if (sudden_underflow) {\r | |
1002 | rvb->wds = 0;\r | |
1003 | irv = STRTOG_Underflow | STRTOG_Inexlo;\r | |
1004 | }\r | |
1005 | else {\r | |
1006 | irv = (irv & ~STRTOG_Retmask) |\r | |
1007 | (rvb->wds > 0 ? STRTOG_Denormal : STRTOG_Zero);\r | |
1008 | if (irv & STRTOG_Inexact)\r | |
1009 | irv |= STRTOG_Underflow;\r | |
1010 | }\r | |
1011 | }\r | |
1012 | if (se)\r | |
1013 | *se = __UNCONST(s);\r | |
1014 | if (sign)\r | |
1015 | irv |= STRTOG_Neg;\r | |
1016 | if (rvb) {\r | |
1017 | copybits(bits, nbits, rvb);\r | |
1018 | Bfree(rvb);\r | |
1019 | }\r | |
1020 | return irv;\r | |
1021 | }\r |