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