mprec.c 19 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027
  1. /****************************************************************
  2. *
  3. * The author of this software is David M. Gay.
  4. *
  5. * Copyright (c) 1991 by AT&T.
  6. *
  7. * Permission to use, copy, modify, and distribute this software for any
  8. * purpose without fee is hereby granted, provided that this entire notice
  9. * is included in all copies of any software which is or includes a copy
  10. * or modification of this software and in all copies of the supporting
  11. * documentation for such software.
  12. *
  13. * THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
  14. * WARRANTY. IN PARTICULAR, NEITHER THE AUTHOR NOR AT&T MAKES ANY
  15. * REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
  16. * OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
  17. *
  18. ***************************************************************/
  19. /* Please send bug reports to
  20. David M. Gay
  21. AT&T Bell Laboratories, Room 2C-463
  22. 600 Mountain Avenue
  23. Murray Hill, NJ 07974-2070
  24. U.S.A.
  25. dmg@research.att.com or research!dmg
  26. */
  27. /* strtod for IEEE-, VAX-, and IBM-arithmetic machines.
  28. *
  29. * This strtod returns a nearest machine number to the input decimal
  30. * string (or sets errno to ERANGE). With IEEE arithmetic, ties are
  31. * broken by the IEEE round-even rule. Otherwise ties are broken by
  32. * biased rounding (add half and chop).
  33. *
  34. * Inspired loosely by William D. Clinger's paper "How to Read Floating
  35. * Point Numbers Accurately" [Proc. ACM SIGPLAN '90, pp. 92-101].
  36. *
  37. * Modifications:
  38. *
  39. * 1. We only require IEEE, IBM, or VAX double-precision
  40. * arithmetic (not IEEE double-extended).
  41. * 2. We get by with floating-point arithmetic in a case that
  42. * Clinger missed -- when we're computing d * 10^n
  43. * for a small integer d and the integer n is not too
  44. * much larger than 22 (the maximum integer k for which
  45. * we can represent 10^k exactly), we may be able to
  46. * compute (d*10^k) * 10^(e-k) with just one roundoff.
  47. * 3. Rather than a bit-at-a-time adjustment of the binary
  48. * result in the hard case, we use floating-point
  49. * arithmetic to determine the adjustment to within
  50. * one bit; only in really hard cases do we need to
  51. * compute a second residual.
  52. * 4. Because of 3., we don't need a large table of powers of 10
  53. * for ten-to-e (just some small tables, e.g. of 10^k
  54. * for 0 <= k <= 22).
  55. */
  56. /*
  57. * #define IEEE_8087 for IEEE-arithmetic machines where the least
  58. * significant byte has the lowest address.
  59. * #define IEEE_MC68k for IEEE-arithmetic machines where the most
  60. * significant byte has the lowest address.
  61. * #define Sudden_Underflow for IEEE-format machines without gradual
  62. * underflow (i.e., that flush to zero on underflow).
  63. * #define IBM for IBM mainframe-style floating-point arithmetic.
  64. * #define VAX for VAX-style floating-point arithmetic.
  65. * #define Unsigned_Shifts if >> does treats its left operand as unsigned.
  66. * #define No_leftright to omit left-right logic in fast floating-point
  67. * computation of dtoa.
  68. * #define Check_FLT_ROUNDS if FLT_ROUNDS can assume the values 2 or 3.
  69. * #define RND_PRODQUOT to use rnd_prod and rnd_quot (assembly routines
  70. * that use extended-precision instructions to compute rounded
  71. * products and quotients) with IBM.
  72. * #define ROUND_BIASED for IEEE-format with biased rounding.
  73. * #define Inaccurate_Divide for IEEE-format with correctly rounded
  74. * products but inaccurate quotients, e.g., for Intel i860.
  75. * #define Just_16 to store 16 bits per 32-bit long when doing high-precision
  76. * integer arithmetic. Whether this speeds things up or slows things
  77. * down depends on the machine and the number being converted.
  78. */
  79. /*#include <_ansi.h>*/
  80. #include <assert.h>
  81. #include <stdlib.h>
  82. #include <string.h>
  83. /* #include <reent.h> */
  84. #include "mprec.h"
  85. /* reent.c knows this value */
  86. /* #define _Kmax 15 */
  87. #define _reent _Jv_reent
  88. #define _Bigint _Jv_Bigint
  89. #undef _REENT_CHECK_MP
  90. #define _REENT_CHECK_MP(x)
  91. #undef _REENT_MP_FREELIST
  92. #define _REENT_MP_FREELIST(x) ((x)->_freelist)
  93. #undef _REENT_MP_P5S
  94. #define _REENT_MP_P5S(x) ((x)->_p5s)
  95. #undef __ULong
  96. #define __ULong unsigned long
  97. #undef __Long
  98. #define __Long long
  99. static void *
  100. mprec_calloc (void *ignore, size_t x1, size_t x2)
  101. {
  102. char *result = (char *) malloc (x1 * x2);
  103. memset (result, 0, x1 * x2);
  104. return result;
  105. }
  106. _Bigint *
  107. _DEFUN (Balloc, (ptr, k), struct _reent *ptr _AND int k)
  108. {
  109. int x;
  110. _Bigint *rv ;
  111. int new_k = k + 1;
  112. _REENT_CHECK_MP(ptr);
  113. if (_REENT_MP_FREELIST(ptr) == NULL)
  114. {
  115. /* Allocate a list of pointers to the mprec objects */
  116. _REENT_MP_FREELIST(ptr) = (struct _Bigint **) mprec_calloc (ptr,
  117. sizeof (struct _Bigint *),
  118. new_k);
  119. if (_REENT_MP_FREELIST(ptr) == NULL)
  120. {
  121. return NULL;
  122. }
  123. ptr->_max_k = new_k;
  124. }
  125. else if (new_k > ptr->_max_k)
  126. {
  127. struct _Bigint **new_list
  128. = (struct _Bigint **) realloc (ptr->_freelist,
  129. new_k * sizeof (struct _Bigint *));
  130. memset (&new_list[ptr->_max_k], 0,
  131. (new_k - ptr->_max_k) * sizeof (struct _Bigint *));
  132. ptr->_freelist = new_list;
  133. ptr->_max_k = new_k;
  134. }
  135. assert (k <= ptr->_max_k);
  136. if ((rv = _REENT_MP_FREELIST(ptr)[k]) != 0)
  137. {
  138. _REENT_MP_FREELIST(ptr)[k] = rv->_next;
  139. }
  140. else
  141. {
  142. x = 1 << k;
  143. /* Allocate an mprec Bigint and stick in in the freelist */
  144. rv = (_Bigint *) mprec_calloc (ptr,
  145. 1,
  146. sizeof (_Bigint) +
  147. (x-1) * sizeof(rv->_x));
  148. if (rv == NULL) return NULL;
  149. rv->_k = k;
  150. rv->_maxwds = x;
  151. }
  152. rv->_sign = rv->_wds = 0;
  153. return rv;
  154. }
  155. void
  156. _DEFUN (Bfree, (ptr, v), struct _reent *ptr _AND _Bigint * v)
  157. {
  158. _REENT_CHECK_MP(ptr);
  159. if (v)
  160. {
  161. v->_next = _REENT_MP_FREELIST(ptr)[v->_k];
  162. _REENT_MP_FREELIST(ptr)[v->_k] = v;
  163. }
  164. }
  165. _Bigint *
  166. _DEFUN (multadd, (ptr, b, m, a),
  167. struct _reent *ptr _AND
  168. _Bigint * b _AND
  169. int m _AND
  170. int a)
  171. {
  172. int i, wds;
  173. __ULong *x, y;
  174. #ifdef Pack_32
  175. __ULong xi, z;
  176. #endif
  177. _Bigint *b1;
  178. wds = b->_wds;
  179. x = b->_x;
  180. i = 0;
  181. do
  182. {
  183. #ifdef Pack_32
  184. xi = *x;
  185. y = (xi & 0xffff) * m + a;
  186. z = (xi >> 16) * m + (y >> 16);
  187. a = (int) (z >> 16);
  188. *x++ = (z << 16) + (y & 0xffff);
  189. #else
  190. y = *x * m + a;
  191. a = (int) (y >> 16);
  192. *x++ = y & 0xffff;
  193. #endif
  194. }
  195. while (++i < wds);
  196. if (a)
  197. {
  198. if (wds >= b->_maxwds)
  199. {
  200. b1 = Balloc (ptr, b->_k + 1);
  201. Bcopy (b1, b);
  202. Bfree (ptr, b);
  203. b = b1;
  204. }
  205. b->_x[wds++] = a;
  206. b->_wds = wds;
  207. }
  208. return b;
  209. }
  210. _Bigint *
  211. _DEFUN (s2b, (ptr, s, nd0, nd, y9),
  212. struct _reent * ptr _AND
  213. _CONST char *s _AND
  214. int nd0 _AND
  215. int nd _AND
  216. __ULong y9)
  217. {
  218. _Bigint *b;
  219. int i, k;
  220. __Long x, y;
  221. x = (nd + 8) / 9;
  222. for (k = 0, y = 1; x > y; y <<= 1, k++);
  223. #ifdef Pack_32
  224. b = Balloc (ptr, k);
  225. b->_x[0] = y9;
  226. b->_wds = 1;
  227. #else
  228. b = Balloc (ptr, k + 1);
  229. b->_x[0] = y9 & 0xffff;
  230. b->_wds = (b->_x[1] = y9 >> 16) ? 2 : 1;
  231. #endif
  232. i = 9;
  233. if (9 < nd0)
  234. {
  235. s += 9;
  236. do
  237. b = multadd (ptr, b, 10, *s++ - '0');
  238. while (++i < nd0);
  239. s++;
  240. }
  241. else
  242. s += 10;
  243. for (; i < nd; i++)
  244. b = multadd (ptr, b, 10, *s++ - '0');
  245. return b;
  246. }
  247. int
  248. _DEFUN (hi0bits,
  249. (x), register __ULong x)
  250. {
  251. register int k = 0;
  252. if (!(x & 0xffff0000))
  253. {
  254. k = 16;
  255. x <<= 16;
  256. }
  257. if (!(x & 0xff000000))
  258. {
  259. k += 8;
  260. x <<= 8;
  261. }
  262. if (!(x & 0xf0000000))
  263. {
  264. k += 4;
  265. x <<= 4;
  266. }
  267. if (!(x & 0xc0000000))
  268. {
  269. k += 2;
  270. x <<= 2;
  271. }
  272. if (!(x & 0x80000000))
  273. {
  274. k++;
  275. if (!(x & 0x40000000))
  276. return 32;
  277. }
  278. return k;
  279. }
  280. int
  281. _DEFUN (lo0bits, (y), __ULong *y)
  282. {
  283. register int k;
  284. register __ULong x = *y;
  285. if (x & 7)
  286. {
  287. if (x & 1)
  288. return 0;
  289. if (x & 2)
  290. {
  291. *y = x >> 1;
  292. return 1;
  293. }
  294. *y = x >> 2;
  295. return 2;
  296. }
  297. k = 0;
  298. if (!(x & 0xffff))
  299. {
  300. k = 16;
  301. x >>= 16;
  302. }
  303. if (!(x & 0xff))
  304. {
  305. k += 8;
  306. x >>= 8;
  307. }
  308. if (!(x & 0xf))
  309. {
  310. k += 4;
  311. x >>= 4;
  312. }
  313. if (!(x & 0x3))
  314. {
  315. k += 2;
  316. x >>= 2;
  317. }
  318. if (!(x & 1))
  319. {
  320. k++;
  321. x >>= 1;
  322. if (!x & 1)
  323. return 32;
  324. }
  325. *y = x;
  326. return k;
  327. }
  328. _Bigint *
  329. _DEFUN (i2b, (ptr, i), struct _reent * ptr _AND int i)
  330. {
  331. _Bigint *b;
  332. b = Balloc (ptr, 1);
  333. b->_x[0] = i;
  334. b->_wds = 1;
  335. return b;
  336. }
  337. _Bigint *
  338. _DEFUN (mult, (ptr, a, b), struct _reent * ptr _AND _Bigint * a _AND _Bigint * b)
  339. {
  340. _Bigint *c;
  341. int k, wa, wb, wc;
  342. __ULong carry, y, z;
  343. __ULong *x, *xa, *xae, *xb, *xbe, *xc, *xc0;
  344. #ifdef Pack_32
  345. __ULong z2;
  346. #endif
  347. if (a->_wds < b->_wds)
  348. {
  349. c = a;
  350. a = b;
  351. b = c;
  352. }
  353. k = a->_k;
  354. wa = a->_wds;
  355. wb = b->_wds;
  356. wc = wa + wb;
  357. if (wc > a->_maxwds)
  358. k++;
  359. c = Balloc (ptr, k);
  360. for (x = c->_x, xa = x + wc; x < xa; x++)
  361. *x = 0;
  362. xa = a->_x;
  363. xae = xa + wa;
  364. xb = b->_x;
  365. xbe = xb + wb;
  366. xc0 = c->_x;
  367. #ifdef Pack_32
  368. for (; xb < xbe; xb++, xc0++)
  369. {
  370. if ((y = *xb & 0xffff) != 0)
  371. {
  372. x = xa;
  373. xc = xc0;
  374. carry = 0;
  375. do
  376. {
  377. z = (*x & 0xffff) * y + (*xc & 0xffff) + carry;
  378. carry = z >> 16;
  379. z2 = (*x++ >> 16) * y + (*xc >> 16) + carry;
  380. carry = z2 >> 16;
  381. Storeinc (xc, z2, z);
  382. }
  383. while (x < xae);
  384. *xc = carry;
  385. }
  386. if ((y = *xb >> 16) != 0)
  387. {
  388. x = xa;
  389. xc = xc0;
  390. carry = 0;
  391. z2 = *xc;
  392. do
  393. {
  394. z = (*x & 0xffff) * y + (*xc >> 16) + carry;
  395. carry = z >> 16;
  396. Storeinc (xc, z, z2);
  397. z2 = (*x++ >> 16) * y + (*xc & 0xffff) + carry;
  398. carry = z2 >> 16;
  399. }
  400. while (x < xae);
  401. *xc = z2;
  402. }
  403. }
  404. #else
  405. for (; xb < xbe; xc0++)
  406. {
  407. if (y = *xb++)
  408. {
  409. x = xa;
  410. xc = xc0;
  411. carry = 0;
  412. do
  413. {
  414. z = *x++ * y + *xc + carry;
  415. carry = z >> 16;
  416. *xc++ = z & 0xffff;
  417. }
  418. while (x < xae);
  419. *xc = carry;
  420. }
  421. }
  422. #endif
  423. for (xc0 = c->_x, xc = xc0 + wc; wc > 0 && !*--xc; --wc);
  424. c->_wds = wc;
  425. return c;
  426. }
  427. _Bigint *
  428. _DEFUN (pow5mult,
  429. (ptr, b, k), struct _reent * ptr _AND _Bigint * b _AND int k)
  430. {
  431. _Bigint *b1, *p5, *p51;
  432. int i;
  433. static _CONST int p05[3] = {5, 25, 125};
  434. if ((i = k & 3) != 0)
  435. b = multadd (ptr, b, p05[i - 1], 0);
  436. if (!(k >>= 2))
  437. return b;
  438. _REENT_CHECK_MP(ptr);
  439. if (!(p5 = _REENT_MP_P5S(ptr)))
  440. {
  441. /* first time */
  442. p5 = _REENT_MP_P5S(ptr) = i2b (ptr, 625);
  443. p5->_next = 0;
  444. }
  445. for (;;)
  446. {
  447. if (k & 1)
  448. {
  449. b1 = mult (ptr, b, p5);
  450. Bfree (ptr, b);
  451. b = b1;
  452. }
  453. if (!(k >>= 1))
  454. break;
  455. if (!(p51 = p5->_next))
  456. {
  457. p51 = p5->_next = mult (ptr, p5, p5);
  458. p51->_next = 0;
  459. }
  460. p5 = p51;
  461. }
  462. return b;
  463. }
  464. _Bigint *
  465. _DEFUN (lshift, (ptr, b, k), struct _reent * ptr _AND _Bigint * b _AND int k)
  466. {
  467. int i, k1, n, n1;
  468. _Bigint *b1;
  469. __ULong *x, *x1, *xe, z;
  470. #ifdef Pack_32
  471. n = k >> 5;
  472. #else
  473. n = k >> 4;
  474. #endif
  475. k1 = b->_k;
  476. n1 = n + b->_wds + 1;
  477. for (i = b->_maxwds; n1 > i; i <<= 1)
  478. k1++;
  479. b1 = Balloc (ptr, k1);
  480. x1 = b1->_x;
  481. for (i = 0; i < n; i++)
  482. *x1++ = 0;
  483. x = b->_x;
  484. xe = x + b->_wds;
  485. #ifdef Pack_32
  486. if (k &= 0x1f)
  487. {
  488. k1 = 32 - k;
  489. z = 0;
  490. do
  491. {
  492. *x1++ = *x << k | z;
  493. z = *x++ >> k1;
  494. }
  495. while (x < xe);
  496. if ((*x1 = z) != 0)
  497. ++n1;
  498. }
  499. #else
  500. if (k &= 0xf)
  501. {
  502. k1 = 16 - k;
  503. z = 0;
  504. do
  505. {
  506. *x1++ = *x << k & 0xffff | z;
  507. z = *x++ >> k1;
  508. }
  509. while (x < xe);
  510. if (*x1 = z)
  511. ++n1;
  512. }
  513. #endif
  514. else
  515. do
  516. *x1++ = *x++;
  517. while (x < xe);
  518. b1->_wds = n1 - 1;
  519. Bfree (ptr, b);
  520. return b1;
  521. }
  522. int
  523. _DEFUN (cmp, (a, b), _Bigint * a _AND _Bigint * b)
  524. {
  525. __ULong *xa, *xa0, *xb, *xb0;
  526. int i, j;
  527. i = a->_wds;
  528. j = b->_wds;
  529. #ifdef DEBUG
  530. if (i > 1 && !a->_x[i - 1])
  531. Bug ("cmp called with a->_x[a->_wds-1] == 0");
  532. if (j > 1 && !b->_x[j - 1])
  533. Bug ("cmp called with b->_x[b->_wds-1] == 0");
  534. #endif
  535. if (i -= j)
  536. return i;
  537. xa0 = a->_x;
  538. xa = xa0 + j;
  539. xb0 = b->_x;
  540. xb = xb0 + j;
  541. for (;;)
  542. {
  543. if (*--xa != *--xb)
  544. return *xa < *xb ? -1 : 1;
  545. if (xa <= xa0)
  546. break;
  547. }
  548. return 0;
  549. }
  550. _Bigint *
  551. _DEFUN (diff, (ptr, a, b), struct _reent * ptr _AND
  552. _Bigint * a _AND _Bigint * b)
  553. {
  554. _Bigint *c;
  555. int i, wa, wb;
  556. __Long borrow, y; /* We need signed shifts here. */
  557. __ULong *xa, *xae, *xb, *xbe, *xc;
  558. #ifdef Pack_32
  559. __Long z;
  560. #endif
  561. i = cmp (a, b);
  562. if (!i)
  563. {
  564. c = Balloc (ptr, 0);
  565. c->_wds = 1;
  566. c->_x[0] = 0;
  567. return c;
  568. }
  569. if (i < 0)
  570. {
  571. c = a;
  572. a = b;
  573. b = c;
  574. i = 1;
  575. }
  576. else
  577. i = 0;
  578. c = Balloc (ptr, a->_k);
  579. c->_sign = i;
  580. wa = a->_wds;
  581. xa = a->_x;
  582. xae = xa + wa;
  583. wb = b->_wds;
  584. xb = b->_x;
  585. xbe = xb + wb;
  586. xc = c->_x;
  587. borrow = 0;
  588. #ifdef Pack_32
  589. do
  590. {
  591. y = (*xa & 0xffff) - (*xb & 0xffff) + borrow;
  592. borrow = y >> 16;
  593. Sign_Extend (borrow, y);
  594. z = (*xa++ >> 16) - (*xb++ >> 16) + borrow;
  595. borrow = z >> 16;
  596. Sign_Extend (borrow, z);
  597. Storeinc (xc, z, y);
  598. }
  599. while (xb < xbe);
  600. while (xa < xae)
  601. {
  602. y = (*xa & 0xffff) + borrow;
  603. borrow = y >> 16;
  604. Sign_Extend (borrow, y);
  605. z = (*xa++ >> 16) + borrow;
  606. borrow = z >> 16;
  607. Sign_Extend (borrow, z);
  608. Storeinc (xc, z, y);
  609. }
  610. #else
  611. do
  612. {
  613. y = *xa++ - *xb++ + borrow;
  614. borrow = y >> 16;
  615. Sign_Extend (borrow, y);
  616. *xc++ = y & 0xffff;
  617. }
  618. while (xb < xbe);
  619. while (xa < xae)
  620. {
  621. y = *xa++ + borrow;
  622. borrow = y >> 16;
  623. Sign_Extend (borrow, y);
  624. *xc++ = y & 0xffff;
  625. }
  626. #endif
  627. while (!*--xc)
  628. wa--;
  629. c->_wds = wa;
  630. return c;
  631. }
  632. double
  633. _DEFUN (ulp, (_x), double _x)
  634. {
  635. union double_union x, a;
  636. register int32_t L;
  637. x.d = _x;
  638. L = (word0 (x) & Exp_mask) - (P - 1) * Exp_msk1;
  639. #ifndef Sudden_Underflow
  640. if (L > 0)
  641. {
  642. #endif
  643. #ifdef IBM
  644. L |= Exp_msk1 >> 4;
  645. #endif
  646. word0 (a) = L;
  647. #ifndef _DOUBLE_IS_32BITS
  648. word1 (a) = 0;
  649. #endif
  650. #ifndef Sudden_Underflow
  651. }
  652. else
  653. {
  654. L = -L >> Exp_shift;
  655. if (L < Exp_shift)
  656. {
  657. word0 (a) = 0x80000 >> L;
  658. #ifndef _DOUBLE_IS_32BITS
  659. word1 (a) = 0;
  660. #endif
  661. }
  662. else
  663. {
  664. word0 (a) = 0;
  665. L -= Exp_shift;
  666. #ifndef _DOUBLE_IS_32BITS
  667. word1 (a) = L >= 31 ? 1 : 1 << (31 - L);
  668. #endif
  669. }
  670. }
  671. #endif
  672. return a.d;
  673. }
  674. double
  675. _DEFUN (b2d, (a, e),
  676. _Bigint * a _AND int *e)
  677. {
  678. __ULong *xa, *xa0, w, y, z;
  679. int k;
  680. union double_union d;
  681. #ifdef VAX
  682. __ULong d0, d1;
  683. #else
  684. #define d0 word0(d)
  685. #define d1 word1(d)
  686. #endif
  687. xa0 = a->_x;
  688. xa = xa0 + a->_wds;
  689. y = *--xa;
  690. #ifdef DEBUG
  691. if (!y)
  692. Bug ("zero y in b2d");
  693. #endif
  694. k = hi0bits (y);
  695. *e = 32 - k;
  696. #ifdef Pack_32
  697. if (k < Ebits)
  698. {
  699. d0 = Exp_1 | y >> (Ebits - k);
  700. w = xa > xa0 ? *--xa : 0;
  701. #ifndef _DOUBLE_IS_32BITS
  702. d1 = y << ((32 - Ebits) + k) | w >> (Ebits - k);
  703. #endif
  704. goto ret_d;
  705. }
  706. z = xa > xa0 ? *--xa : 0;
  707. if (k -= Ebits)
  708. {
  709. d0 = Exp_1 | y << k | z >> (32 - k);
  710. y = xa > xa0 ? *--xa : 0;
  711. #ifndef _DOUBLE_IS_32BITS
  712. d1 = z << k | y >> (32 - k);
  713. #endif
  714. }
  715. else
  716. {
  717. d0 = Exp_1 | y;
  718. #ifndef _DOUBLE_IS_32BITS
  719. d1 = z;
  720. #endif
  721. }
  722. #else
  723. if (k < Ebits + 16)
  724. {
  725. z = xa > xa0 ? *--xa : 0;
  726. d0 = Exp_1 | y << k - Ebits | z >> Ebits + 16 - k;
  727. w = xa > xa0 ? *--xa : 0;
  728. y = xa > xa0 ? *--xa : 0;
  729. d1 = z << k + 16 - Ebits | w << k - Ebits | y >> 16 + Ebits - k;
  730. goto ret_d;
  731. }
  732. z = xa > xa0 ? *--xa : 0;
  733. w = xa > xa0 ? *--xa : 0;
  734. k -= Ebits + 16;
  735. d0 = Exp_1 | y << k + 16 | z << k | w >> 16 - k;
  736. y = xa > xa0 ? *--xa : 0;
  737. d1 = w << k + 16 | y << k;
  738. #endif
  739. ret_d:
  740. #ifdef VAX
  741. word0 (d) = d0 >> 16 | d0 << 16;
  742. word1 (d) = d1 >> 16 | d1 << 16;
  743. #else
  744. #undef d0
  745. #undef d1
  746. #endif
  747. return d.d;
  748. }
  749. _Bigint *
  750. _DEFUN (d2b,
  751. (ptr, _d, e, bits),
  752. struct _reent * ptr _AND
  753. double _d _AND
  754. int *e _AND
  755. int *bits)
  756. {
  757. union double_union d;
  758. _Bigint *b;
  759. int de, i, k;
  760. __ULong *x, y, z;
  761. #ifdef VAX
  762. __ULong d0, d1;
  763. #endif
  764. d.d = _d;
  765. #ifdef VAX
  766. d0 = word0 (d) >> 16 | word0 (d) << 16;
  767. d1 = word1 (d) >> 16 | word1 (d) << 16;
  768. #else
  769. #define d0 word0(d)
  770. #define d1 word1(d)
  771. d.d = _d;
  772. #endif
  773. #ifdef Pack_32
  774. b = Balloc (ptr, 1);
  775. #else
  776. b = Balloc (ptr, 2);
  777. #endif
  778. x = b->_x;
  779. z = d0 & Frac_mask;
  780. d0 &= 0x7fffffff; /* clear sign bit, which we ignore */
  781. #ifdef Sudden_Underflow
  782. de = (int) (d0 >> Exp_shift);
  783. #ifndef IBM
  784. z |= Exp_msk11;
  785. #endif
  786. #else
  787. if ((de = (int) (d0 >> Exp_shift)) != 0)
  788. z |= Exp_msk1;
  789. #endif
  790. #ifdef Pack_32
  791. #ifndef _DOUBLE_IS_32BITS
  792. if (d1)
  793. {
  794. y = d1;
  795. k = lo0bits (&y);
  796. if (k)
  797. {
  798. x[0] = y | z << (32 - k);
  799. z >>= k;
  800. }
  801. else
  802. x[0] = y;
  803. i = b->_wds = (x[1] = z) ? 2 : 1;
  804. }
  805. else
  806. #endif
  807. {
  808. #ifdef DEBUG
  809. if (!z)
  810. Bug ("Zero passed to d2b");
  811. #endif
  812. k = lo0bits (&z);
  813. x[0] = z;
  814. i = b->_wds = 1;
  815. #ifndef _DOUBLE_IS_32BITS
  816. k += 32;
  817. #endif
  818. }
  819. #else
  820. if (d1)
  821. {
  822. y = d1;
  823. k = lo0bits (&y);
  824. if (k)
  825. if (k >= 16)
  826. {
  827. x[0] = y | z << 32 - k & 0xffff;
  828. x[1] = z >> k - 16 & 0xffff;
  829. x[2] = z >> k;
  830. i = 2;
  831. }
  832. else
  833. {
  834. x[0] = y & 0xffff;
  835. x[1] = y >> 16 | z << 16 - k & 0xffff;
  836. x[2] = z >> k & 0xffff;
  837. x[3] = z >> k + 16;
  838. i = 3;
  839. }
  840. else
  841. {
  842. x[0] = y & 0xffff;
  843. x[1] = y >> 16;
  844. x[2] = z & 0xffff;
  845. x[3] = z >> 16;
  846. i = 3;
  847. }
  848. }
  849. else
  850. {
  851. #ifdef DEBUG
  852. if (!z)
  853. Bug ("Zero passed to d2b");
  854. #endif
  855. k = lo0bits (&z);
  856. if (k >= 16)
  857. {
  858. x[0] = z;
  859. i = 0;
  860. }
  861. else
  862. {
  863. x[0] = z & 0xffff;
  864. x[1] = z >> 16;
  865. i = 1;
  866. }
  867. k += 32;
  868. }
  869. while (!x[i])
  870. --i;
  871. b->_wds = i + 1;
  872. #endif
  873. #ifndef Sudden_Underflow
  874. if (de)
  875. {
  876. #endif
  877. #ifdef IBM
  878. *e = (de - Bias - (P - 1) << 2) + k;
  879. *bits = 4 * P + 8 - k - hi0bits (word0 (d) & Frac_mask);
  880. #else
  881. *e = de - Bias - (P - 1) + k;
  882. *bits = P - k;
  883. #endif
  884. #ifndef Sudden_Underflow
  885. }
  886. else
  887. {
  888. *e = de - Bias - (P - 1) + 1 + k;
  889. #ifdef Pack_32
  890. *bits = 32 * i - hi0bits (x[i - 1]);
  891. #else
  892. *bits = (i + 2) * 16 - hi0bits (x[i]);
  893. #endif
  894. }
  895. #endif
  896. return b;
  897. }
  898. #undef d0
  899. #undef d1
  900. double
  901. _DEFUN (ratio, (a, b), _Bigint * a _AND _Bigint * b)
  902. {
  903. union double_union da, db;
  904. int k, ka, kb;
  905. da.d = b2d (a, &ka);
  906. db.d = b2d (b, &kb);
  907. #ifdef Pack_32
  908. k = ka - kb + 32 * (a->_wds - b->_wds);
  909. #else
  910. k = ka - kb + 16 * (a->_wds - b->_wds);
  911. #endif
  912. #ifdef IBM
  913. if (k > 0)
  914. {
  915. word0 (da) += (k >> 2) * Exp_msk1;
  916. if (k &= 3)
  917. da.d *= 1 << k;
  918. }
  919. else
  920. {
  921. k = -k;
  922. word0 (db) += (k >> 2) * Exp_msk1;
  923. if (k &= 3)
  924. db.d *= 1 << k;
  925. }
  926. #else
  927. if (k > 0)
  928. word0 (da) += k * Exp_msk1;
  929. else
  930. {
  931. k = -k;
  932. word0 (db) += k * Exp_msk1;
  933. }
  934. #endif
  935. return da.d / db.d;
  936. }
  937. _CONST double
  938. tens[] =
  939. {
  940. 1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9,
  941. 1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19,
  942. 1e20, 1e21, 1e22, 1e23, 1e24
  943. };
  944. #if !defined(_DOUBLE_IS_32BITS) && !defined(__v800)
  945. _CONST double bigtens[] =
  946. {1e16, 1e32, 1e64, 1e128, 1e256};
  947. _CONST double tinytens[] =
  948. {1e-16, 1e-32, 1e-64, 1e-128, 1e-256};
  949. #else
  950. _CONST double bigtens[] =
  951. {1e16, 1e32};
  952. _CONST double tinytens[] =
  953. {1e-16, 1e-32};
  954. #endif
  955. double
  956. _DEFUN (_mprec_log10, (dig),
  957. int dig)
  958. {
  959. double v = 1.0;
  960. if (dig < 24)
  961. return tens[dig];
  962. while (dig > 0)
  963. {
  964. v *= 10;
  965. dig--;
  966. }
  967. return v;
  968. }