strtod.c 23 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105
  1. /****************************************************************
  2. The author of this software is David M. Gay.
  3. Copyright (C) 1998-2001 by Lucent Technologies
  4. All Rights Reserved
  5. Permission to use, copy, modify, and distribute this software and
  6. its documentation for any purpose and without fee is hereby
  7. granted, provided that the above copyright notice appear in all
  8. copies and that both that the copyright notice and this
  9. permission notice and warranty disclaimer appear in supporting
  10. documentation, and that the name of Lucent or any of its entities
  11. not be used in advertising or publicity pertaining to
  12. distribution of the software without specific, written prior
  13. permission.
  14. LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
  15. INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
  16. IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
  17. SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  18. WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
  19. IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
  20. ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
  21. THIS SOFTWARE.
  22. ****************************************************************/
  23. /* Please send bug reports to David M. Gay (dmg at acm dot org,
  24. * with " at " changed at "@" and " dot " changed to "."). */
  25. #include "gdtoaimp.h"
  26. #ifndef NO_FENV_H
  27. #include <fenv.h>
  28. #endif
  29. #ifdef USE_LOCALE
  30. #include "locale.h"
  31. #endif
  32. #ifdef IEEE_Arith
  33. #ifndef NO_IEEE_Scale
  34. #define Avoid_Underflow
  35. #undef tinytens
  36. /* The factor of 2^106 in tinytens[4] helps us avoid setting the underflow */
  37. /* flag unnecessarily. It leads to a song and dance at the end of strtod. */
  38. static CONST double tinytens[] = { 1e-16, 1e-32, 1e-64, 1e-128,
  39. 9007199254740992.*9007199254740992.e-256
  40. };
  41. #endif
  42. #endif
  43. #ifdef Honor_FLT_ROUNDS
  44. #undef Check_FLT_ROUNDS
  45. #define Check_FLT_ROUNDS
  46. #else
  47. #define Rounding Flt_Rounds
  48. #endif
  49. #ifdef Avoid_Underflow /*{*/
  50. static double
  51. sulp
  52. #ifdef KR_headers
  53. (x, scale) U *x; int scale;
  54. #else
  55. (U *x, int scale)
  56. #endif
  57. {
  58. U u;
  59. double rv;
  60. int i;
  61. rv = ulp(x);
  62. if (!scale || (i = 2*P + 1 - ((word0(x) & Exp_mask) >> Exp_shift)) <= 0)
  63. return rv; /* Is there an example where i <= 0 ? */
  64. word0(&u) = Exp_1 + (i << Exp_shift);
  65. word1(&u) = 0;
  66. return rv * u.d;
  67. }
  68. #endif /*}*/
  69. double
  70. strtod
  71. #ifdef KR_headers
  72. (s00, se) CONST char *s00; char **se;
  73. #else
  74. (CONST char *s00, char **se)
  75. #endif
  76. {
  77. #ifdef Avoid_Underflow
  78. int scale;
  79. #endif
  80. int bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, decpt, dsign,
  81. e, e1, esign, i, j, k, nd, nd0, nf, nz, nz0, sign;
  82. CONST char *s, *s0, *s1;
  83. double aadj;
  84. Long L;
  85. U adj, aadj1, rv, rv0;
  86. ULong y, z;
  87. Bigint *bb = NULL, *bb1, *bd = NULL, *bd0 = NULL, *bs = NULL, *delta = NULL;
  88. #ifdef Avoid_Underflow
  89. ULong Lsb, Lsb1;
  90. #endif
  91. #ifdef SET_INEXACT
  92. int inexact, oldinexact;
  93. #endif
  94. #ifdef USE_LOCALE /*{{*/
  95. #ifdef NO_LOCALE_CACHE
  96. char *decimalpoint = localeconv()->decimal_point;
  97. int dplen = strlen(decimalpoint);
  98. #else
  99. char *decimalpoint;
  100. static char *decimalpoint_cache;
  101. static int dplen;
  102. if (!(s0 = decimalpoint_cache)) {
  103. s0 = localeconv()->decimal_point;
  104. if ((decimalpoint_cache = (char*)MALLOC(strlen(s0) + 1))) {
  105. strlcpy(decimalpoint_cache, s0, strlen(s0) + 1);
  106. s0 = decimalpoint_cache;
  107. }
  108. dplen = strlen(s0);
  109. }
  110. decimalpoint = (char*)s0;
  111. #endif /*NO_LOCALE_CACHE*/
  112. #else /*USE_LOCALE}{*/
  113. #define dplen 1
  114. #endif /*USE_LOCALE}}*/
  115. #ifdef Honor_FLT_ROUNDS /*{*/
  116. int Rounding;
  117. #ifdef Trust_FLT_ROUNDS /*{{ only define this if FLT_ROUNDS really works! */
  118. Rounding = Flt_Rounds;
  119. #else /*}{*/
  120. Rounding = 1;
  121. switch(fegetround()) {
  122. case FE_TOWARDZERO: Rounding = 0; break;
  123. case FE_UPWARD: Rounding = 2; break;
  124. case FE_DOWNWARD: Rounding = 3;
  125. }
  126. #endif /*}}*/
  127. #endif /*}*/
  128. sign = nz0 = nz = decpt = 0;
  129. dval(&rv) = 0.;
  130. for(s = s00;;s++) switch(*s) {
  131. case '-':
  132. sign = 1;
  133. /* no break */
  134. case '+':
  135. if (*++s)
  136. goto break2;
  137. /* no break */
  138. case 0:
  139. goto ret0;
  140. case '\t':
  141. case '\n':
  142. case '\v':
  143. case '\f':
  144. case '\r':
  145. case ' ':
  146. continue;
  147. default:
  148. goto break2;
  149. }
  150. break2:
  151. if (*s == '0') {
  152. #ifndef NO_HEX_FP /*{*/
  153. {
  154. static FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, SI };
  155. Long exp;
  156. ULong bits[2];
  157. switch(s[1]) {
  158. case 'x':
  159. case 'X':
  160. {
  161. #ifdef Honor_FLT_ROUNDS
  162. FPI fpi1 = fpi;
  163. fpi1.rounding = Rounding;
  164. #else
  165. #define fpi1 fpi
  166. #endif
  167. switch((i = gethex(&s, &fpi1, &exp, &bb, sign)) & STRTOG_Retmask) {
  168. case STRTOG_NoMemory:
  169. goto ovfl;
  170. case STRTOG_NoNumber:
  171. s = s00;
  172. sign = 0;
  173. case STRTOG_Zero:
  174. break;
  175. default:
  176. if (bb) {
  177. copybits(bits, fpi.nbits, bb);
  178. Bfree(bb);
  179. }
  180. ULtod(((U*)&rv)->L, bits, exp, i);
  181. }}
  182. goto ret;
  183. }
  184. }
  185. #endif /*}*/
  186. nz0 = 1;
  187. while(*++s == '0') ;
  188. if (!*s)
  189. goto ret;
  190. }
  191. s0 = s;
  192. y = z = 0;
  193. for(nd = nf = 0; (c = *s) >= '0' && c <= '9'; nd++, s++)
  194. if (nd < 9)
  195. y = 10*y + c - '0';
  196. else if (nd < 16)
  197. z = 10*z + c - '0';
  198. nd0 = nd;
  199. #ifdef USE_LOCALE
  200. if (c == *decimalpoint) {
  201. for(i = 1; decimalpoint[i]; ++i)
  202. if (s[i] != decimalpoint[i])
  203. goto dig_done;
  204. s += i;
  205. c = *s;
  206. #else
  207. if (c == '.') {
  208. c = *++s;
  209. #endif
  210. decpt = 1;
  211. if (!nd) {
  212. for(; c == '0'; c = *++s)
  213. nz++;
  214. if (c > '0' && c <= '9') {
  215. s0 = s;
  216. nf += nz;
  217. nz = 0;
  218. goto have_dig;
  219. }
  220. goto dig_done;
  221. }
  222. for(; c >= '0' && c <= '9'; c = *++s) {
  223. have_dig:
  224. nz++;
  225. if (c -= '0') {
  226. nf += nz;
  227. for(i = 1; i < nz; i++)
  228. if (nd++ < 9)
  229. y *= 10;
  230. else if (nd <= DBL_DIG + 1)
  231. z *= 10;
  232. if (nd++ < 9)
  233. y = 10*y + c;
  234. else if (nd <= DBL_DIG + 1)
  235. z = 10*z + c;
  236. nz = 0;
  237. }
  238. }
  239. }/*}*/
  240. dig_done:
  241. e = 0;
  242. if (c == 'e' || c == 'E') {
  243. if (!nd && !nz && !nz0) {
  244. goto ret0;
  245. }
  246. s00 = s;
  247. esign = 0;
  248. switch(c = *++s) {
  249. case '-':
  250. esign = 1;
  251. case '+':
  252. c = *++s;
  253. }
  254. if (c >= '0' && c <= '9') {
  255. while(c == '0')
  256. c = *++s;
  257. if (c > '0' && c <= '9') {
  258. L = c - '0';
  259. s1 = s;
  260. while((c = *++s) >= '0' && c <= '9')
  261. L = 10*L + c - '0';
  262. if (s - s1 > 8 || L > 19999)
  263. /* Avoid confusion from exponents
  264. * so large that e might overflow.
  265. */
  266. e = 19999; /* safe for 16 bit ints */
  267. else
  268. e = (int)L;
  269. if (esign)
  270. e = -e;
  271. }
  272. else
  273. e = 0;
  274. }
  275. else
  276. s = s00;
  277. }
  278. if (!nd) {
  279. if (!nz && !nz0) {
  280. #ifdef INFNAN_CHECK
  281. /* Check for Nan and Infinity */
  282. ULong bits[2];
  283. static FPI fpinan = /* only 52 explicit bits */
  284. { 52, 1-1023-53+1, 2046-1023-53+1, 1, SI };
  285. if (!decpt)
  286. switch(c) {
  287. case 'i':
  288. case 'I':
  289. if (match(&s,"nf")) {
  290. --s;
  291. if (!match(&s,"inity"))
  292. ++s;
  293. word0(&rv) = 0x7ff00000;
  294. word1(&rv) = 0;
  295. goto ret;
  296. }
  297. break;
  298. case 'n':
  299. case 'N':
  300. if (match(&s, "an")) {
  301. #ifndef No_Hex_NaN
  302. if (*s == '(' /*)*/
  303. && hexnan(&s, &fpinan, bits)
  304. == STRTOG_NaNbits) {
  305. word0(&rv) = 0x7ff00000 | bits[1];
  306. word1(&rv) = bits[0];
  307. }
  308. else {
  309. #endif
  310. word0(&rv) = NAN_WORD0;
  311. word1(&rv) = NAN_WORD1;
  312. #ifndef No_Hex_NaN
  313. }
  314. #endif
  315. goto ret;
  316. }
  317. }
  318. #endif /* INFNAN_CHECK */
  319. ret0:
  320. s = s00;
  321. sign = 0;
  322. }
  323. goto ret;
  324. }
  325. e1 = e -= nf;
  326. /* Now we have nd0 digits, starting at s0, followed by a
  327. * decimal point, followed by nd-nd0 digits. The number we're
  328. * after is the integer represented by those digits times
  329. * 10**e */
  330. if (!nd0)
  331. nd0 = nd;
  332. k = nd < DBL_DIG + 1 ? nd : DBL_DIG + 1;
  333. dval(&rv) = y;
  334. if (k > 9) {
  335. #ifdef SET_INEXACT
  336. if (k > DBL_DIG)
  337. oldinexact = get_inexact();
  338. #endif
  339. dval(&rv) = tens[k - 9] * dval(&rv) + z;
  340. }
  341. if (nd <= DBL_DIG
  342. #ifndef RND_PRODQUOT
  343. #ifndef Honor_FLT_ROUNDS
  344. && Flt_Rounds == 1
  345. #endif
  346. #endif
  347. ) {
  348. if (!e)
  349. goto ret;
  350. #ifndef ROUND_BIASED_without_Round_Up
  351. if (e > 0) {
  352. if (e <= Ten_pmax) {
  353. #ifdef VAX
  354. goto vax_ovfl_check;
  355. #else
  356. #ifdef Honor_FLT_ROUNDS
  357. /* round correctly FLT_ROUNDS = 2 or 3 */
  358. if (sign) {
  359. rv.d = -rv.d;
  360. sign = 0;
  361. }
  362. #endif
  363. /* rv = */ rounded_product(dval(&rv), tens[e]);
  364. goto ret;
  365. #endif
  366. }
  367. i = DBL_DIG - nd;
  368. if (e <= Ten_pmax + i) {
  369. /* A fancier test would sometimes let us do
  370. * this for larger i values.
  371. */
  372. #ifdef Honor_FLT_ROUNDS
  373. /* round correctly FLT_ROUNDS = 2 or 3 */
  374. if (sign) {
  375. rv.d = -rv.d;
  376. sign = 0;
  377. }
  378. #endif
  379. e -= i;
  380. dval(&rv) *= tens[i];
  381. #ifdef VAX
  382. /* VAX exponent range is so narrow we must
  383. * worry about overflow here...
  384. */
  385. vax_ovfl_check:
  386. word0(&rv) -= P*Exp_msk1;
  387. /* rv = */ rounded_product(dval(&rv), tens[e]);
  388. if ((word0(&rv) & Exp_mask)
  389. > Exp_msk1*(DBL_MAX_EXP+Bias-1-P))
  390. goto ovfl;
  391. word0(&rv) += P*Exp_msk1;
  392. #else
  393. /* rv = */ rounded_product(dval(&rv), tens[e]);
  394. #endif
  395. goto ret;
  396. }
  397. }
  398. #ifndef Inaccurate_Divide
  399. else if (e >= -Ten_pmax) {
  400. #ifdef Honor_FLT_ROUNDS
  401. /* round correctly FLT_ROUNDS = 2 or 3 */
  402. if (sign) {
  403. rv.d = -rv.d;
  404. sign = 0;
  405. }
  406. #endif
  407. /* rv = */ rounded_quotient(dval(&rv), tens[-e]);
  408. goto ret;
  409. }
  410. #endif
  411. #endif /* ROUND_BIASED_without_Round_Up */
  412. }
  413. e1 += nd - k;
  414. #ifdef IEEE_Arith
  415. #ifdef SET_INEXACT
  416. inexact = 1;
  417. if (k <= DBL_DIG)
  418. oldinexact = get_inexact();
  419. #endif
  420. #ifdef Avoid_Underflow
  421. scale = 0;
  422. #endif
  423. #ifdef Honor_FLT_ROUNDS
  424. if (Rounding >= 2) {
  425. if (sign)
  426. Rounding = Rounding == 2 ? 0 : 2;
  427. else
  428. if (Rounding != 2)
  429. Rounding = 0;
  430. }
  431. #endif
  432. #endif /*IEEE_Arith*/
  433. /* Get starting approximation = rv * 10**e1 */
  434. if (e1 > 0) {
  435. if ( (i = e1 & 15) !=0)
  436. dval(&rv) *= tens[i];
  437. if (e1 &= ~15) {
  438. if (e1 > DBL_MAX_10_EXP) {
  439. ovfl:
  440. /* Can't trust HUGE_VAL */
  441. #ifdef IEEE_Arith
  442. #ifdef Honor_FLT_ROUNDS
  443. switch(Rounding) {
  444. case 0: /* toward 0 */
  445. case 3: /* toward -infinity */
  446. word0(&rv) = Big0;
  447. word1(&rv) = Big1;
  448. break;
  449. default:
  450. word0(&rv) = Exp_mask;
  451. word1(&rv) = 0;
  452. }
  453. #else /*Honor_FLT_ROUNDS*/
  454. word0(&rv) = Exp_mask;
  455. word1(&rv) = 0;
  456. #endif /*Honor_FLT_ROUNDS*/
  457. #ifdef SET_INEXACT
  458. /* set overflow bit */
  459. dval(&rv0) = 1e300;
  460. dval(&rv0) *= dval(&rv0);
  461. #endif
  462. #else /*IEEE_Arith*/
  463. word0(&rv) = Big0;
  464. word1(&rv) = Big1;
  465. #endif /*IEEE_Arith*/
  466. range_err:
  467. if (bd0) {
  468. Bfree(bb);
  469. Bfree(bd);
  470. Bfree(bs);
  471. Bfree(bd0);
  472. Bfree(delta);
  473. }
  474. #ifndef NO_ERRNO
  475. errno = ERANGE;
  476. #endif
  477. goto ret;
  478. }
  479. e1 >>= 4;
  480. for(j = 0; e1 > 1; j++, e1 >>= 1)
  481. if (e1 & 1)
  482. dval(&rv) *= bigtens[j];
  483. /* The last multiplication could overflow. */
  484. word0(&rv) -= P*Exp_msk1;
  485. dval(&rv) *= bigtens[j];
  486. if ((z = word0(&rv) & Exp_mask)
  487. > Exp_msk1*(DBL_MAX_EXP+Bias-P))
  488. goto ovfl;
  489. if (z > Exp_msk1*(DBL_MAX_EXP+Bias-1-P)) {
  490. /* set to largest number */
  491. /* (Can't trust DBL_MAX) */
  492. word0(&rv) = Big0;
  493. word1(&rv) = Big1;
  494. }
  495. else
  496. word0(&rv) += P*Exp_msk1;
  497. }
  498. }
  499. else if (e1 < 0) {
  500. e1 = -e1;
  501. if ( (i = e1 & 15) !=0)
  502. dval(&rv) /= tens[i];
  503. if (e1 >>= 4) {
  504. if (e1 >= 1 << n_bigtens)
  505. goto undfl;
  506. #ifdef Avoid_Underflow
  507. if (e1 & Scale_Bit)
  508. scale = 2*P;
  509. for(j = 0; e1 > 0; j++, e1 >>= 1)
  510. if (e1 & 1)
  511. dval(&rv) *= tinytens[j];
  512. if (scale && (j = 2*P + 1 - ((word0(&rv) & Exp_mask)
  513. >> Exp_shift)) > 0) {
  514. /* scaled rv is denormal; zap j low bits */
  515. if (j >= 32) {
  516. word1(&rv) = 0;
  517. if (j >= 53)
  518. word0(&rv) = (P+2)*Exp_msk1;
  519. else
  520. word0(&rv) &= 0xffffffff << (j-32);
  521. }
  522. else
  523. word1(&rv) &= 0xffffffff << j;
  524. }
  525. #else
  526. for(j = 0; e1 > 1; j++, e1 >>= 1)
  527. if (e1 & 1)
  528. dval(&rv) *= tinytens[j];
  529. /* The last multiplication could underflow. */
  530. dval(&rv0) = dval(&rv);
  531. dval(&rv) *= tinytens[j];
  532. if (!dval(&rv)) {
  533. dval(&rv) = 2.*dval(&rv0);
  534. dval(&rv) *= tinytens[j];
  535. #endif
  536. if (!dval(&rv)) {
  537. undfl:
  538. dval(&rv) = 0.;
  539. goto range_err;
  540. }
  541. #ifndef Avoid_Underflow
  542. word0(&rv) = Tiny0;
  543. word1(&rv) = Tiny1;
  544. /* The refinement below will clean
  545. * this approximation up.
  546. */
  547. }
  548. #endif
  549. }
  550. }
  551. /* Now the hard part -- adjusting rv to the correct value.*/
  552. /* Put digits into bd: true value = bd * 10^e */
  553. bd0 = s2b(s0, nd0, nd, y, dplen);
  554. if (bd0 == NULL)
  555. goto ovfl;
  556. for(;;) {
  557. bd = Balloc(bd0->k);
  558. if (bd == NULL)
  559. goto ovfl;
  560. Bcopy(bd, bd0);
  561. bb = d2b(dval(&rv), &bbe, &bbbits); /* rv = bb * 2^bbe */
  562. if (bb == NULL)
  563. goto ovfl;
  564. bs = i2b(1);
  565. if (bs == NULL)
  566. goto ovfl;
  567. if (e >= 0) {
  568. bb2 = bb5 = 0;
  569. bd2 = bd5 = e;
  570. }
  571. else {
  572. bb2 = bb5 = -e;
  573. bd2 = bd5 = 0;
  574. }
  575. if (bbe >= 0)
  576. bb2 += bbe;
  577. else
  578. bd2 -= bbe;
  579. bs2 = bb2;
  580. #ifdef Honor_FLT_ROUNDS
  581. if (Rounding != 1)
  582. bs2++;
  583. #endif
  584. #ifdef Avoid_Underflow
  585. Lsb = LSB;
  586. Lsb1 = 0;
  587. j = bbe - scale;
  588. i = j + bbbits - 1; /* logb(rv) */
  589. j = P + 1 - bbbits;
  590. if (i < Emin) { /* denormal */
  591. i = Emin - i;
  592. j -= i;
  593. if (i < 32)
  594. Lsb <<= i;
  595. else
  596. Lsb1 = Lsb << (i-32);
  597. }
  598. #else /*Avoid_Underflow*/
  599. #ifdef Sudden_Underflow
  600. #ifdef IBM
  601. j = 1 + 4*P - 3 - bbbits + ((bbe + bbbits - 1) & 3);
  602. #else
  603. j = P + 1 - bbbits;
  604. #endif
  605. #else /*Sudden_Underflow*/
  606. j = bbe;
  607. i = j + bbbits - 1; /* logb(&rv) */
  608. if (i < Emin) /* denormal */
  609. j += P - Emin;
  610. else
  611. j = P + 1 - bbbits;
  612. #endif /*Sudden_Underflow*/
  613. #endif /*Avoid_Underflow*/
  614. bb2 += j;
  615. bd2 += j;
  616. #ifdef Avoid_Underflow
  617. bd2 += scale;
  618. #endif
  619. i = bb2 < bd2 ? bb2 : bd2;
  620. if (i > bs2)
  621. i = bs2;
  622. if (i > 0) {
  623. bb2 -= i;
  624. bd2 -= i;
  625. bs2 -= i;
  626. }
  627. if (bb5 > 0) {
  628. bs = pow5mult(bs, bb5);
  629. if (bs == NULL)
  630. goto ovfl;
  631. bb1 = mult(bs, bb);
  632. if (bb1 == NULL)
  633. goto ovfl;
  634. Bfree(bb);
  635. bb = bb1;
  636. }
  637. if (bb2 > 0) {
  638. bb = lshift(bb, bb2);
  639. if (bb == NULL)
  640. goto ovfl;
  641. }
  642. if (bd5 > 0) {
  643. bd = pow5mult(bd, bd5);
  644. if (bd == NULL)
  645. goto ovfl;
  646. }
  647. if (bd2 > 0) {
  648. bd = lshift(bd, bd2);
  649. if (bd == NULL)
  650. goto ovfl;
  651. }
  652. if (bs2 > 0) {
  653. bs = lshift(bs, bs2);
  654. if (bs == NULL)
  655. goto ovfl;
  656. }
  657. delta = diff(bb, bd);
  658. if (delta == NULL)
  659. goto ovfl;
  660. dsign = delta->sign;
  661. delta->sign = 0;
  662. i = cmp(delta, bs);
  663. #ifdef Honor_FLT_ROUNDS
  664. if (Rounding != 1) {
  665. if (i < 0) {
  666. /* Error is less than an ulp */
  667. if (!delta->x[0] && delta->wds <= 1) {
  668. /* exact */
  669. #ifdef SET_INEXACT
  670. inexact = 0;
  671. #endif
  672. break;
  673. }
  674. if (Rounding) {
  675. if (dsign) {
  676. dval(&adj) = 1.;
  677. goto apply_adj;
  678. }
  679. }
  680. else if (!dsign) {
  681. dval(&adj) = -1.;
  682. if (!word1(&rv)
  683. && !(word0(&rv) & Frac_mask)) {
  684. y = word0(&rv) & Exp_mask;
  685. #ifdef Avoid_Underflow
  686. if (!scale || y > 2*P*Exp_msk1)
  687. #else
  688. if (y)
  689. #endif
  690. {
  691. delta = lshift(delta,Log2P);
  692. if (delta == NULL)
  693. goto ovfl;
  694. if (cmp(delta, bs) <= 0)
  695. dval(&adj) = -0.5;
  696. }
  697. }
  698. apply_adj:
  699. #ifdef Avoid_Underflow
  700. if (scale && (y = word0(&rv) & Exp_mask)
  701. <= 2*P*Exp_msk1)
  702. word0(&adj) += (2*P+1)*Exp_msk1 - y;
  703. #else
  704. #ifdef Sudden_Underflow
  705. if ((word0(&rv) & Exp_mask) <=
  706. P*Exp_msk1) {
  707. word0(&rv) += P*Exp_msk1;
  708. dval(&rv) += adj*ulp(&rv);
  709. word0(&rv) -= P*Exp_msk1;
  710. }
  711. else
  712. #endif /*Sudden_Underflow*/
  713. #endif /*Avoid_Underflow*/
  714. dval(&rv) += adj.d*ulp(&rv);
  715. }
  716. break;
  717. }
  718. dval(&adj) = ratio(delta, bs);
  719. if (adj.d < 1.)
  720. dval(&adj) = 1.;
  721. if (adj.d <= 0x7ffffffe) {
  722. /* dval(&adj) = Rounding ? ceil(&adj) : floor(&adj); */
  723. y = adj.d;
  724. if (y != adj.d) {
  725. if (!((Rounding>>1) ^ dsign))
  726. y++;
  727. dval(&adj) = y;
  728. }
  729. }
  730. #ifdef Avoid_Underflow
  731. if (scale && (y = word0(&rv) & Exp_mask) <= 2*P*Exp_msk1)
  732. word0(&adj) += (2*P+1)*Exp_msk1 - y;
  733. #else
  734. #ifdef Sudden_Underflow
  735. if ((word0(&rv) & Exp_mask) <= P*Exp_msk1) {
  736. word0(&rv) += P*Exp_msk1;
  737. dval(&adj) *= ulp(&rv);
  738. if (dsign)
  739. dval(&rv) += adj;
  740. else
  741. dval(&rv) -= adj;
  742. word0(&rv) -= P*Exp_msk1;
  743. goto cont;
  744. }
  745. #endif /*Sudden_Underflow*/
  746. #endif /*Avoid_Underflow*/
  747. dval(&adj) *= ulp(&rv);
  748. if (dsign) {
  749. if (word0(&rv) == Big0 && word1(&rv) == Big1)
  750. goto ovfl;
  751. dval(&rv) += adj.d;
  752. }
  753. else
  754. dval(&rv) -= adj.d;
  755. goto cont;
  756. }
  757. #endif /*Honor_FLT_ROUNDS*/
  758. if (i < 0) {
  759. /* Error is less than half an ulp -- check for
  760. * special case of mantissa a power of two.
  761. */
  762. if (dsign || word1(&rv) || word0(&rv) & Bndry_mask
  763. #ifdef IEEE_Arith
  764. #ifdef Avoid_Underflow
  765. || (word0(&rv) & Exp_mask) <= (2*P+1)*Exp_msk1
  766. #else
  767. || (word0(&rv) & Exp_mask) <= Exp_msk1
  768. #endif
  769. #endif
  770. ) {
  771. #ifdef SET_INEXACT
  772. if (!delta->x[0] && delta->wds <= 1)
  773. inexact = 0;
  774. #endif
  775. break;
  776. }
  777. if (!delta->x[0] && delta->wds <= 1) {
  778. /* exact result */
  779. #ifdef SET_INEXACT
  780. inexact = 0;
  781. #endif
  782. break;
  783. }
  784. delta = lshift(delta,Log2P);
  785. if (delta == NULL)
  786. goto ovfl;
  787. if (cmp(delta, bs) > 0)
  788. goto drop_down;
  789. break;
  790. }
  791. if (i == 0) {
  792. /* exactly half-way between */
  793. if (dsign) {
  794. if ((word0(&rv) & Bndry_mask1) == Bndry_mask1
  795. && word1(&rv) == (
  796. #ifdef Avoid_Underflow
  797. (scale && (y = word0(&rv) & Exp_mask) <= 2*P*Exp_msk1)
  798. ? (0xffffffff & (0xffffffff << (2*P+1-(y>>Exp_shift)))) :
  799. #endif
  800. 0xffffffff)) {
  801. /*boundary case -- increment exponent*/
  802. if (word0(&rv) == Big0 && word1(&rv) == Big1)
  803. goto ovfl;
  804. word0(&rv) = (word0(&rv) & Exp_mask)
  805. + Exp_msk1
  806. #ifdef IBM
  807. | Exp_msk1 >> 4
  808. #endif
  809. ;
  810. word1(&rv) = 0;
  811. #ifdef Avoid_Underflow
  812. dsign = 0;
  813. #endif
  814. break;
  815. }
  816. }
  817. else if (!(word0(&rv) & Bndry_mask) && !word1(&rv)) {
  818. drop_down:
  819. /* boundary case -- decrement exponent */
  820. #ifdef Sudden_Underflow /*{{*/
  821. L = word0(&rv) & Exp_mask;
  822. #ifdef IBM
  823. if (L < Exp_msk1)
  824. #else
  825. #ifdef Avoid_Underflow
  826. if (L <= (scale ? (2*P+1)*Exp_msk1 : Exp_msk1))
  827. #else
  828. if (L <= Exp_msk1)
  829. #endif /*Avoid_Underflow*/
  830. #endif /*IBM*/
  831. goto undfl;
  832. L -= Exp_msk1;
  833. #else /*Sudden_Underflow}{*/
  834. #ifdef Avoid_Underflow
  835. if (scale) {
  836. L = word0(&rv) & Exp_mask;
  837. if (L <= (2*P+1)*Exp_msk1) {
  838. if (L > (P+2)*Exp_msk1)
  839. /* round even ==> */
  840. /* accept rv */
  841. break;
  842. /* rv = smallest denormal */
  843. goto undfl;
  844. }
  845. }
  846. #endif /*Avoid_Underflow*/
  847. L = (word0(&rv) & Exp_mask) - Exp_msk1;
  848. #endif /*Sudden_Underflow}}*/
  849. word0(&rv) = L | Bndry_mask1;
  850. word1(&rv) = 0xffffffff;
  851. #ifdef IBM
  852. goto cont;
  853. #else
  854. break;
  855. #endif
  856. }
  857. #ifndef ROUND_BIASED
  858. #ifdef Avoid_Underflow
  859. if (Lsb1) {
  860. if (!(word0(&rv) & Lsb1))
  861. break;
  862. }
  863. else if (!(word1(&rv) & Lsb))
  864. break;
  865. #else
  866. if (!(word1(&rv) & LSB))
  867. break;
  868. #endif
  869. #endif
  870. if (dsign)
  871. #ifdef Avoid_Underflow
  872. dval(&rv) += sulp(&rv, scale);
  873. #else
  874. dval(&rv) += ulp(&rv);
  875. #endif
  876. #ifndef ROUND_BIASED
  877. else {
  878. #ifdef Avoid_Underflow
  879. dval(&rv) -= sulp(&rv, scale);
  880. #else
  881. dval(&rv) -= ulp(&rv);
  882. #endif
  883. #ifndef Sudden_Underflow
  884. if (!dval(&rv))
  885. goto undfl;
  886. #endif
  887. }
  888. #ifdef Avoid_Underflow
  889. dsign = 1 - dsign;
  890. #endif
  891. #endif
  892. break;
  893. }
  894. if ((aadj = ratio(delta, bs)) <= 2.) {
  895. if (dsign)
  896. aadj = dval(&aadj1) = 1.;
  897. else if (word1(&rv) || word0(&rv) & Bndry_mask) {
  898. #ifndef Sudden_Underflow
  899. if (word1(&rv) == Tiny1 && !word0(&rv))
  900. goto undfl;
  901. #endif
  902. aadj = 1.;
  903. dval(&aadj1) = -1.;
  904. }
  905. else {
  906. /* special case -- power of FLT_RADIX to be */
  907. /* rounded down... */
  908. if (aadj < 2./FLT_RADIX)
  909. aadj = 1./FLT_RADIX;
  910. else
  911. aadj *= 0.5;
  912. dval(&aadj1) = -aadj;
  913. }
  914. }
  915. else {
  916. aadj *= 0.5;
  917. dval(&aadj1) = dsign ? aadj : -aadj;
  918. #ifdef Check_FLT_ROUNDS
  919. switch(Rounding) {
  920. case 2: /* towards +infinity */
  921. dval(&aadj1) -= 0.5;
  922. break;
  923. case 0: /* towards 0 */
  924. case 3: /* towards -infinity */
  925. dval(&aadj1) += 0.5;
  926. }
  927. #else
  928. if (Flt_Rounds == 0)
  929. dval(&aadj1) += 0.5;
  930. #endif /*Check_FLT_ROUNDS*/
  931. }
  932. y = word0(&rv) & Exp_mask;
  933. /* Check for overflow */
  934. if (y == Exp_msk1*(DBL_MAX_EXP+Bias-1)) {
  935. dval(&rv0) = dval(&rv);
  936. word0(&rv) -= P*Exp_msk1;
  937. dval(&adj) = dval(&aadj1) * ulp(&rv);
  938. dval(&rv) += dval(&adj);
  939. if ((word0(&rv) & Exp_mask) >=
  940. Exp_msk1*(DBL_MAX_EXP+Bias-P)) {
  941. if (word0(&rv0) == Big0 && word1(&rv0) == Big1)
  942. goto ovfl;
  943. word0(&rv) = Big0;
  944. word1(&rv) = Big1;
  945. goto cont;
  946. }
  947. else
  948. word0(&rv) += P*Exp_msk1;
  949. }
  950. else {
  951. #ifdef Avoid_Underflow
  952. if (scale && y <= 2*P*Exp_msk1) {
  953. if (aadj <= 0x7fffffff) {
  954. if ((z = aadj) <= 0)
  955. z = 1;
  956. aadj = z;
  957. dval(&aadj1) = dsign ? aadj : -aadj;
  958. }
  959. word0(&aadj1) += (2*P+1)*Exp_msk1 - y;
  960. }
  961. dval(&adj) = dval(&aadj1) * ulp(&rv);
  962. dval(&rv) += dval(&adj);
  963. #else
  964. #ifdef Sudden_Underflow
  965. if ((word0(&rv) & Exp_mask) <= P*Exp_msk1) {
  966. dval(&rv0) = dval(&rv);
  967. word0(&rv) += P*Exp_msk1;
  968. dval(&adj) = dval(&aadj1) * ulp(&rv);
  969. dval(&rv) += dval(&adj);
  970. #ifdef IBM
  971. if ((word0(&rv) & Exp_mask) < P*Exp_msk1)
  972. #else
  973. if ((word0(&rv) & Exp_mask) <= P*Exp_msk1)
  974. #endif
  975. {
  976. if (word0(&rv0) == Tiny0
  977. && word1(&rv0) == Tiny1)
  978. goto undfl;
  979. word0(&rv) = Tiny0;
  980. word1(&rv) = Tiny1;
  981. goto cont;
  982. }
  983. else
  984. word0(&rv) -= P*Exp_msk1;
  985. }
  986. else {
  987. dval(&adj) = dval(&aadj1) * ulp(&rv);
  988. dval(&rv) += dval(&adj);
  989. }
  990. #else /*Sudden_Underflow*/
  991. /* Compute dval(&adj) so that the IEEE rounding rules will
  992. * correctly round rv + dval(&adj) in some half-way cases.
  993. * If rv * ulp(&rv) is denormalized (i.e.,
  994. * y <= (P-1)*Exp_msk1), we must adjust aadj to avoid
  995. * trouble from bits lost to denormalization;
  996. * example: 1.2e-307 .
  997. */
  998. if (y <= (P-1)*Exp_msk1 && aadj > 1.) {
  999. dval(&aadj1) = (double)(int)(aadj + 0.5);
  1000. if (!dsign)
  1001. dval(&aadj1) = -dval(&aadj1);
  1002. }
  1003. dval(&adj) = dval(&aadj1) * ulp(&rv);
  1004. dval(&rv) += adj;
  1005. #endif /*Sudden_Underflow*/
  1006. #endif /*Avoid_Underflow*/
  1007. }
  1008. z = word0(&rv) & Exp_mask;
  1009. #ifndef SET_INEXACT
  1010. #ifdef Avoid_Underflow
  1011. if (!scale)
  1012. #endif
  1013. if (y == z) {
  1014. /* Can we stop now? */
  1015. L = (Long)aadj;
  1016. aadj -= L;
  1017. /* The tolerances below are conservative. */
  1018. if (dsign || word1(&rv) || word0(&rv) & Bndry_mask) {
  1019. if (aadj < .4999999 || aadj > .5000001)
  1020. break;
  1021. }
  1022. else if (aadj < .4999999/FLT_RADIX)
  1023. break;
  1024. }
  1025. #endif
  1026. cont:
  1027. Bfree(bb);
  1028. Bfree(bd);
  1029. Bfree(bs);
  1030. Bfree(delta);
  1031. }
  1032. Bfree(bb);
  1033. Bfree(bd);
  1034. Bfree(bs);
  1035. Bfree(bd0);
  1036. Bfree(delta);
  1037. #ifdef SET_INEXACT
  1038. if (inexact) {
  1039. if (!oldinexact) {
  1040. word0(&rv0) = Exp_1 + (70 << Exp_shift);
  1041. word1(&rv0) = 0;
  1042. dval(&rv0) += 1.;
  1043. }
  1044. }
  1045. else if (!oldinexact)
  1046. clear_inexact();
  1047. #endif
  1048. #ifdef Avoid_Underflow
  1049. if (scale) {
  1050. word0(&rv0) = Exp_1 - 2*P*Exp_msk1;
  1051. word1(&rv0) = 0;
  1052. dval(&rv) *= dval(&rv0);
  1053. #ifndef NO_ERRNO
  1054. /* try to avoid the bug of testing an 8087 register value */
  1055. #ifdef IEEE_Arith
  1056. if (!(word0(&rv) & Exp_mask))
  1057. #else
  1058. if (word0(&rv) == 0 && word1(&rv) == 0)
  1059. #endif
  1060. errno = ERANGE;
  1061. #endif
  1062. }
  1063. #endif /* Avoid_Underflow */
  1064. #ifdef SET_INEXACT
  1065. if (inexact && !(word0(&rv) & Exp_mask)) {
  1066. /* set underflow bit */
  1067. dval(&rv0) = 1e-300;
  1068. dval(&rv0) *= dval(&rv0);
  1069. }
  1070. #endif
  1071. ret:
  1072. if (se)
  1073. *se = (char *)s;
  1074. return sign ? -dval(&rv) : dval(&rv);
  1075. }