dtoa.c 34 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816
  1. /* derived from /netlib/fp/dtoa.c assuming IEEE, Standard C */
  2. /* kudos to dmg@bell-labs.com, gripes to ehg@bell-labs.com */
  3. #include "lib9.h"
  4. #ifdef __APPLE__
  5. #pragma clang diagnostic ignored "-Wlogical-op-parentheses"
  6. #pragma clang diagnostic ignored "-Wparentheses"
  7. #endif
  8. #define ACQUIRE_DTOA_LOCK(n) /*nothing*/
  9. #define FREE_DTOA_LOCK(n) /*nothing*/
  10. /* let's provide reasonable defaults for usual implementation of IEEE f.p. */
  11. #ifndef DBL_DIG
  12. #define DBL_DIG 15
  13. #endif
  14. #ifndef DBL_MAX_10_EXP
  15. #define DBL_MAX_10_EXP 308
  16. #endif
  17. #ifndef DBL_MAX_EXP
  18. #define DBL_MAX_EXP 1024
  19. #endif
  20. #ifndef FLT_RADIX
  21. #define FLT_RADIX 2
  22. #endif
  23. #ifndef FLT_ROUNDS
  24. #define FLT_ROUNDS 1
  25. #endif
  26. #ifndef Storeinc
  27. #define Storeinc(a,b,c) (*a++ = b << 16 | c & 0xffff)
  28. #endif
  29. #define Sign_Extend(a,b) if (b < 0) a |= 0xffff0000;
  30. #ifdef USE_FPdbleword
  31. #define word0(x) ((FPdbleword*)&x)->hi
  32. #define word1(x) ((FPdbleword*)&x)->lo
  33. #else
  34. #ifdef __LITTLE_ENDIAN
  35. #define word0(x) ((unsigned long *)&x)[1]
  36. #define word1(x) ((unsigned long *)&x)[0]
  37. #else
  38. #define word0(x) ((unsigned long *)&x)[0]
  39. #define word1(x) ((unsigned long *)&x)[1]
  40. #endif
  41. #endif
  42. /* #define P DBL_MANT_DIG */
  43. /* Ten_pmax = floor(P*log(2)/log(5)) */
  44. /* Bletch = (highest power of 2 < DBL_MAX_10_EXP) / 16 */
  45. /* Quick_max = floor((P-1)*log(FLT_RADIX)/log(10) - 1) */
  46. /* Int_max = floor(P*log(FLT_RADIX)/log(10) - 1) */
  47. #define Exp_shift 20
  48. #define Exp_shift1 20
  49. #define Exp_msk1 0x100000
  50. #define Exp_msk11 0x100000
  51. #define Exp_mask 0x7ff00000
  52. #define P 53
  53. #define Bias 1023
  54. #define Emin (-1022)
  55. #define Exp_1 0x3ff00000
  56. #define Exp_11 0x3ff00000
  57. #define Ebits 11
  58. #define Frac_mask 0xfffff
  59. #define Frac_mask1 0xfffff
  60. #define Ten_pmax 22
  61. #define Bletch 0x10
  62. #define Bndry_mask 0xfffff
  63. #define Bndry_mask1 0xfffff
  64. #define LSB 1
  65. #define Sign_bit 0x80000000
  66. #define Log2P 1
  67. #define Tiny0 0
  68. #define Tiny1 1
  69. #define Quick_max 14
  70. #define Int_max 14
  71. #define Infinite(x) (word0(x) == 0x7ff00000) /* sufficient test for here */
  72. #define Avoid_Underflow
  73. #define rounded_product(a,b) a *= b
  74. #define rounded_quotient(a,b) a /= b
  75. #define Big0 (Frac_mask1 | Exp_msk1*(DBL_MAX_EXP+Bias-1))
  76. #define Big1 0xffffffff
  77. #define Kmax 15
  78. struct
  79. Bigint {
  80. struct Bigint *next;
  81. int k, maxwds, sign, wds;
  82. unsigned long x[1];
  83. };
  84. typedef struct Bigint Bigint;
  85. static Bigint *freelist[Kmax+1];
  86. static Bigint *
  87. Balloc(int k)
  88. {
  89. int x;
  90. Bigint * rv;
  91. ACQUIRE_DTOA_LOCK(0);
  92. if (rv = freelist[k]) {
  93. freelist[k] = rv->next;
  94. } else {
  95. x = 1 << k;
  96. rv = (Bigint * )malloc(sizeof(Bigint) + (x - 1) * sizeof(unsigned long));
  97. if(rv == nil)
  98. return nil;
  99. rv->k = k;
  100. rv->maxwds = x;
  101. }
  102. FREE_DTOA_LOCK(0);
  103. rv->sign = rv->wds = 0;
  104. return rv;
  105. }
  106. static void
  107. Bfree(Bigint *v)
  108. {
  109. if (v) {
  110. ACQUIRE_DTOA_LOCK(0);
  111. v->next = freelist[v->k];
  112. freelist[v->k] = v;
  113. FREE_DTOA_LOCK(0);
  114. }
  115. }
  116. #define Bcopy(x,y) memcpy((char *)&x->sign, (char *)&y->sign, \
  117. y->wds*sizeof(long) + 2*sizeof(int))
  118. static Bigint *
  119. multadd(Bigint *b, int m, int a) /* multiply by m and add a */
  120. {
  121. int i, wds;
  122. unsigned long * x, y;
  123. unsigned long xi, z;
  124. Bigint * b1;
  125. wds = b->wds;
  126. x = b->x;
  127. i = 0;
  128. do {
  129. xi = *x;
  130. y = (xi & 0xffff) * m + a;
  131. z = (xi >> 16) * m + (y >> 16);
  132. a = (int)(z >> 16);
  133. *x++ = (z << 16) + (y & 0xffff);
  134. } while (++i < wds);
  135. if (a) {
  136. if (wds >= b->maxwds) {
  137. b1 = Balloc(b->k + 1);
  138. Bcopy(b1, b);
  139. Bfree(b);
  140. b = b1;
  141. }
  142. b->x[wds++] = a;
  143. b->wds = wds;
  144. }
  145. return b;
  146. }
  147. static Bigint *
  148. s2b(const char *s, int nd0, int nd, unsigned long y9)
  149. {
  150. Bigint * b;
  151. int i, k;
  152. long x, y;
  153. x = (nd + 8) / 9;
  154. for (k = 0, y = 1; x > y; y <<= 1, k++)
  155. ;
  156. b = Balloc(k);
  157. b->x[0] = y9;
  158. b->wds = 1;
  159. i = 9;
  160. if (9 < nd0) {
  161. s += 9;
  162. do
  163. b = multadd(b, 10, *s++ - '0');
  164. while (++i < nd0);
  165. s++;
  166. } else
  167. s += 10;
  168. for (; i < nd; i++)
  169. b = multadd(b, 10, *s++ - '0');
  170. return b;
  171. }
  172. static int
  173. hi0bits(register unsigned long x)
  174. {
  175. register int k = 0;
  176. if (!(x & 0xffff0000)) {
  177. k = 16;
  178. x <<= 16;
  179. }
  180. if (!(x & 0xff000000)) {
  181. k += 8;
  182. x <<= 8;
  183. }
  184. if (!(x & 0xf0000000)) {
  185. k += 4;
  186. x <<= 4;
  187. }
  188. if (!(x & 0xc0000000)) {
  189. k += 2;
  190. x <<= 2;
  191. }
  192. if (!(x & 0x80000000)) {
  193. k++;
  194. if (!(x & 0x40000000))
  195. return 32;
  196. }
  197. return k;
  198. }
  199. static int
  200. lo0bits(unsigned long *y)
  201. {
  202. register int k;
  203. register unsigned long x = *y;
  204. if (x & 7) {
  205. if (x & 1)
  206. return 0;
  207. if (x & 2) {
  208. *y = x >> 1;
  209. return 1;
  210. }
  211. *y = x >> 2;
  212. return 2;
  213. }
  214. k = 0;
  215. if (!(x & 0xffff)) {
  216. k = 16;
  217. x >>= 16;
  218. }
  219. if (!(x & 0xff)) {
  220. k += 8;
  221. x >>= 8;
  222. }
  223. if (!(x & 0xf)) {
  224. k += 4;
  225. x >>= 4;
  226. }
  227. if (!(x & 0x3)) {
  228. k += 2;
  229. x >>= 2;
  230. }
  231. if (!(x & 1)) {
  232. k++;
  233. x >>= 1;
  234. if (!x & 1)
  235. return 32;
  236. }
  237. *y = x;
  238. return k;
  239. }
  240. static Bigint *
  241. i2b(int i)
  242. {
  243. Bigint * b;
  244. b = Balloc(1);
  245. b->x[0] = i;
  246. b->wds = 1;
  247. return b;
  248. }
  249. static Bigint *
  250. mult(Bigint *a, Bigint *b)
  251. {
  252. Bigint * c;
  253. int k, wa, wb, wc;
  254. unsigned long carry, y, z;
  255. unsigned long * x, *xa, *xae, *xb, *xbe, *xc, *xc0;
  256. unsigned long z2;
  257. if (a->wds < b->wds) {
  258. c = a;
  259. a = b;
  260. b = c;
  261. }
  262. k = a->k;
  263. wa = a->wds;
  264. wb = b->wds;
  265. wc = wa + wb;
  266. if (wc > a->maxwds)
  267. k++;
  268. c = Balloc(k);
  269. for (x = c->x, xa = x + wc; x < xa; x++)
  270. *x = 0;
  271. xa = a->x;
  272. xae = xa + wa;
  273. xb = b->x;
  274. xbe = xb + wb;
  275. xc0 = c->x;
  276. for (; xb < xbe; xb++, xc0++) {
  277. if (y = *xb & 0xffff) {
  278. x = xa;
  279. xc = xc0;
  280. carry = 0;
  281. do {
  282. z = (*x & 0xffff) * y + (*xc & 0xffff) + carry;
  283. carry = z >> 16;
  284. z2 = (*x++ >> 16) * y + (*xc >> 16) + carry;
  285. carry = z2 >> 16;
  286. Storeinc(xc, z2, z);
  287. } while (x < xae);
  288. *xc = carry;
  289. }
  290. if (y = *xb >> 16) {
  291. x = xa;
  292. xc = xc0;
  293. carry = 0;
  294. z2 = *xc;
  295. do {
  296. z = (*x & 0xffff) * y + (*xc >> 16) + carry;
  297. carry = z >> 16;
  298. Storeinc(xc, z, z2);
  299. z2 = (*x++ >> 16) * y + (*xc & 0xffff) + carry;
  300. carry = z2 >> 16;
  301. } while (x < xae);
  302. *xc = z2;
  303. }
  304. }
  305. for (xc0 = c->x, xc = xc0 + wc; wc > 0 && !*--xc; --wc)
  306. ;
  307. c->wds = wc;
  308. return c;
  309. }
  310. static Bigint *p5s;
  311. static Bigint *
  312. pow5mult(Bigint *b, int k)
  313. {
  314. Bigint * b1, *p5, *p51;
  315. int i;
  316. static int p05[3] = {
  317. 5, 25, 125 };
  318. if (i = k & 3)
  319. b = multadd(b, p05[i-1], 0);
  320. if (!(k >>= 2))
  321. return b;
  322. if (!(p5 = p5s)) {
  323. /* first time */
  324. ACQUIRE_DTOA_LOCK(1);
  325. if (!(p5 = p5s)) {
  326. p5 = p5s = i2b(625);
  327. p5->next = 0;
  328. }
  329. FREE_DTOA_LOCK(1);
  330. }
  331. for (; ; ) {
  332. if (k & 1) {
  333. b1 = mult(b, p5);
  334. Bfree(b);
  335. b = b1;
  336. }
  337. if (!(k >>= 1))
  338. break;
  339. if (!(p51 = p5->next)) {
  340. ACQUIRE_DTOA_LOCK(1);
  341. if (!(p51 = p5->next)) {
  342. p51 = p5->next = mult(p5, p5);
  343. p51->next = 0;
  344. }
  345. FREE_DTOA_LOCK(1);
  346. }
  347. p5 = p51;
  348. }
  349. return b;
  350. }
  351. static Bigint *
  352. lshift(Bigint *b, int k)
  353. {
  354. int i, k1, n, n1;
  355. Bigint * b1;
  356. unsigned long * x, *x1, *xe, z;
  357. n = k >> 5;
  358. k1 = b->k;
  359. n1 = n + b->wds + 1;
  360. for (i = b->maxwds; n1 > i; i <<= 1)
  361. k1++;
  362. b1 = Balloc(k1);
  363. x1 = b1->x;
  364. for (i = 0; i < n; i++)
  365. *x1++ = 0;
  366. x = b->x;
  367. xe = x + b->wds;
  368. if (k &= 0x1f) {
  369. k1 = 32 - k;
  370. z = 0;
  371. do {
  372. *x1++ = *x << k | z;
  373. z = *x++ >> k1;
  374. } while (x < xe);
  375. if (*x1 = z)
  376. ++n1;
  377. } else
  378. do
  379. *x1++ = *x++;
  380. while (x < xe);
  381. b1->wds = n1 - 1;
  382. Bfree(b);
  383. return b1;
  384. }
  385. static int
  386. cmp(Bigint *a, Bigint *b)
  387. {
  388. unsigned long * xa, *xa0, *xb, *xb0;
  389. int i, j;
  390. i = a->wds;
  391. j = b->wds;
  392. if (i -= j)
  393. return i;
  394. xa0 = a->x;
  395. xa = xa0 + j;
  396. xb0 = b->x;
  397. xb = xb0 + j;
  398. for (; ; ) {
  399. if (*--xa != *--xb)
  400. return * xa < *xb ? -1 : 1;
  401. if (xa <= xa0)
  402. break;
  403. }
  404. return 0;
  405. }
  406. static Bigint *
  407. diff(Bigint *a, Bigint *b)
  408. {
  409. Bigint * c;
  410. int i, wa, wb;
  411. long borrow, y; /* We need signed shifts here. */
  412. unsigned long * xa, *xae, *xb, *xbe, *xc;
  413. long z;
  414. i = cmp(a, b);
  415. if (!i) {
  416. c = Balloc(0);
  417. c->wds = 1;
  418. c->x[0] = 0;
  419. return c;
  420. }
  421. if (i < 0) {
  422. c = a;
  423. a = b;
  424. b = c;
  425. i = 1;
  426. } else
  427. i = 0;
  428. c = Balloc(a->k);
  429. c->sign = i;
  430. wa = a->wds;
  431. xa = a->x;
  432. xae = xa + wa;
  433. wb = b->wds;
  434. xb = b->x;
  435. xbe = xb + wb;
  436. xc = c->x;
  437. borrow = 0;
  438. do {
  439. y = (*xa & 0xffff) - (*xb & 0xffff) + borrow;
  440. borrow = y >> 16;
  441. Sign_Extend(borrow, y);
  442. z = (*xa++ >> 16) - (*xb++ >> 16) + borrow;
  443. borrow = z >> 16;
  444. Sign_Extend(borrow, z);
  445. Storeinc(xc, z, y);
  446. } while (xb < xbe);
  447. while (xa < xae) {
  448. y = (*xa & 0xffff) + borrow;
  449. borrow = y >> 16;
  450. Sign_Extend(borrow, y);
  451. z = (*xa++ >> 16) + borrow;
  452. borrow = z >> 16;
  453. Sign_Extend(borrow, z);
  454. Storeinc(xc, z, y);
  455. }
  456. while (!*--xc)
  457. wa--;
  458. c->wds = wa;
  459. return c;
  460. }
  461. static double
  462. ulp(double x)
  463. {
  464. register long L;
  465. double a;
  466. L = (word0(x) & Exp_mask) - (P - 1) * Exp_msk1;
  467. #ifndef Sudden_Underflow
  468. if (L > 0) {
  469. #endif
  470. word0(a) = L;
  471. word1(a) = 0;
  472. #ifndef Sudden_Underflow
  473. } else {
  474. L = -L >> Exp_shift;
  475. if (L < Exp_shift) {
  476. word0(a) = 0x80000 >> L;
  477. word1(a) = 0;
  478. } else {
  479. word0(a) = 0;
  480. L -= Exp_shift;
  481. word1(a) = L >= 31 ? 1 : 1 << 31 - L;
  482. }
  483. }
  484. #endif
  485. return a;
  486. }
  487. static double
  488. b2d(Bigint *a, int *e)
  489. {
  490. unsigned long * xa, *xa0, w, y, z;
  491. int k;
  492. double d;
  493. #define d0 word0(d)
  494. #define d1 word1(d)
  495. xa0 = a->x;
  496. xa = xa0 + a->wds;
  497. y = *--xa;
  498. k = hi0bits(y);
  499. *e = 32 - k;
  500. if (k < Ebits) {
  501. d0 = Exp_1 | y >> Ebits - k;
  502. w = xa > xa0 ? *--xa : 0;
  503. d1 = y << (32 - Ebits) + k | w >> Ebits - k;
  504. goto ret_d;
  505. }
  506. z = xa > xa0 ? *--xa : 0;
  507. if (k -= Ebits) {
  508. d0 = Exp_1 | y << k | z >> 32 - k;
  509. y = xa > xa0 ? *--xa : 0;
  510. d1 = z << k | y >> 32 - k;
  511. } else {
  512. d0 = Exp_1 | y;
  513. d1 = z;
  514. }
  515. ret_d:
  516. #undef d0
  517. #undef d1
  518. return d;
  519. }
  520. static Bigint *
  521. d2b(double d, int *e, int *bits)
  522. {
  523. Bigint * b;
  524. int de, i, k;
  525. unsigned long * x, y, z;
  526. #define d0 word0(d)
  527. #define d1 word1(d)
  528. b = Balloc(1);
  529. x = b->x;
  530. z = d0 & Frac_mask;
  531. d0 &= 0x7fffffff; /* clear sign bit, which we ignore */
  532. #ifdef Sudden_Underflow
  533. de = (int)(d0 >> Exp_shift);
  534. z |= Exp_msk11;
  535. #else
  536. if (de = (int)(d0 >> Exp_shift))
  537. z |= Exp_msk1;
  538. #endif
  539. if (y = d1) {
  540. if (k = lo0bits(&y)) {
  541. x[0] = y | z << 32 - k;
  542. z >>= k;
  543. } else
  544. x[0] = y;
  545. i = b->wds = (x[1] = z) ? 2 : 1;
  546. } else {
  547. k = lo0bits(&z);
  548. x[0] = z;
  549. i = b->wds = 1;
  550. k += 32;
  551. }
  552. #ifndef Sudden_Underflow
  553. if (de) {
  554. #endif
  555. *e = de - Bias - (P - 1) + k;
  556. *bits = P - k;
  557. #ifndef Sudden_Underflow
  558. } else {
  559. *e = de - Bias - (P - 1) + 1 + k;
  560. *bits = 32 * i - hi0bits(x[i-1]);
  561. }
  562. #endif
  563. return b;
  564. }
  565. #undef d0
  566. #undef d1
  567. static double
  568. ratio(Bigint *a, Bigint *b)
  569. {
  570. double da, db;
  571. int k, ka, kb;
  572. da = b2d(a, &ka);
  573. db = b2d(b, &kb);
  574. k = ka - kb + 32 * (a->wds - b->wds);
  575. if (k > 0)
  576. word0(da) += k * Exp_msk1;
  577. else {
  578. k = -k;
  579. word0(db) += k * Exp_msk1;
  580. }
  581. return da / db;
  582. }
  583. static const double
  584. tens[] = {
  585. 1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9,
  586. 1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19,
  587. 1e20, 1e21, 1e22
  588. };
  589. static const double
  590. bigtens[] = {
  591. 1e16, 1e32, 1e64, 1e128, 1e256 };
  592. static const double tinytens[] = {
  593. 1e-16, 1e-32, 1e-64, 1e-128,
  594. 9007199254740992.e-256
  595. };
  596. /* The factor of 2^53 in tinytens[4] helps us avoid setting the underflow */
  597. /* flag unnecessarily. It leads to a song and dance at the end of strtod. */
  598. #define Scale_Bit 0x10
  599. #define n_bigtens 5
  600. #define NAN_WORD0 0x7ff80000
  601. #define NAN_WORD1 0
  602. static int
  603. match(const char **sp, char *t)
  604. {
  605. int c, d;
  606. const char * s = *sp;
  607. while (d = *t++) {
  608. if ((c = *++s) >= 'A' && c <= 'Z')
  609. c += 'a' - 'A';
  610. if (c != d)
  611. return 0;
  612. }
  613. *sp = s + 1;
  614. return 1;
  615. }
  616. double
  617. strtod(const char *s00, char **se)
  618. {
  619. int scale;
  620. int bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, dsign,
  621. e, e1, esign, i, j, k, nd, nd0, nf, nz, nz0, sign;
  622. const char * s, *s0, *s1;
  623. double aadj, aadj1, adj, rv, rv0;
  624. long L;
  625. unsigned long y, z;
  626. Bigint * bb, *bb1, *bd, *bd0, *bs, *delta;
  627. sign = nz0 = nz = 0;
  628. rv = 0.;
  629. for (s = s00; ; s++)
  630. switch (*s) {
  631. case '-':
  632. sign = 1;
  633. /* no break */
  634. case '+':
  635. if (*++s)
  636. goto break2;
  637. /* no break */
  638. case 0:
  639. s = s00;
  640. goto ret;
  641. case '\t':
  642. case '\n':
  643. case '\v':
  644. case '\f':
  645. case '\r':
  646. case ' ':
  647. continue;
  648. default:
  649. goto break2;
  650. }
  651. break2:
  652. if (*s == '0') {
  653. nz0 = 1;
  654. while (*++s == '0')
  655. ;
  656. if (!*s)
  657. goto ret;
  658. }
  659. s0 = s;
  660. y = z = 0;
  661. for (nd = nf = 0; (c = *s) >= '0' && c <= '9'; nd++, s++)
  662. if (nd < 9)
  663. y = 10 * y + c - '0';
  664. else if (nd < 16)
  665. z = 10 * z + c - '0';
  666. nd0 = nd;
  667. if (c == '.') {
  668. c = *++s;
  669. if (!nd) {
  670. for (; c == '0'; c = *++s)
  671. nz++;
  672. if (c > '0' && c <= '9') {
  673. s0 = s;
  674. nf += nz;
  675. nz = 0;
  676. goto have_dig;
  677. }
  678. goto dig_done;
  679. }
  680. for (; c >= '0' && c <= '9'; c = *++s) {
  681. have_dig:
  682. nz++;
  683. if (c -= '0') {
  684. nf += nz;
  685. for (i = 1; i < nz; i++)
  686. if (nd++ < 9)
  687. y *= 10;
  688. else if (nd <= DBL_DIG + 1)
  689. z *= 10;
  690. if (nd++ < 9)
  691. y = 10 * y + c;
  692. else if (nd <= DBL_DIG + 1)
  693. z = 10 * z + c;
  694. nz = 0;
  695. }
  696. }
  697. }
  698. dig_done:
  699. e = 0;
  700. if (c == 'e' || c == 'E') {
  701. if (!nd && !nz && !nz0) {
  702. s = s00;
  703. goto ret;
  704. }
  705. s00 = s;
  706. esign = 0;
  707. switch (c = *++s) {
  708. case '-':
  709. esign = 1;
  710. case '+':
  711. c = *++s;
  712. }
  713. if (c >= '0' && c <= '9') {
  714. while (c == '0')
  715. c = *++s;
  716. if (c > '0' && c <= '9') {
  717. L = c - '0';
  718. s1 = s;
  719. while ((c = *++s) >= '0' && c <= '9')
  720. L = 10 * L + c - '0';
  721. if (s - s1 > 8 || L > 19999)
  722. /* Avoid confusion from exponents
  723. * so large that e might overflow.
  724. */
  725. e = 19999; /* safe for 16 bit ints */
  726. else
  727. e = (int)L;
  728. if (esign)
  729. e = -e;
  730. } else
  731. e = 0;
  732. } else
  733. s = s00;
  734. }
  735. if (!nd) {
  736. if (!nz && !nz0) {
  737. /* Check for Nan and Infinity */
  738. switch (c) {
  739. case 'i':
  740. case 'I':
  741. if (match(&s, "nfinity")) {
  742. word0(rv) = 0x7ff00000;
  743. word1(rv) = 0;
  744. goto ret;
  745. }
  746. break;
  747. case 'n':
  748. case 'N':
  749. if (match(&s, "an")) {
  750. word0(rv) = NAN_WORD0;
  751. word1(rv) = NAN_WORD1;
  752. goto ret;
  753. }
  754. }
  755. s = s00;
  756. }
  757. goto ret;
  758. }
  759. e1 = e -= nf;
  760. /* Now we have nd0 digits, starting at s0, followed by a
  761. * decimal point, followed by nd-nd0 digits. The number we're
  762. * after is the integer represented by those digits times
  763. * 10**e */
  764. if (!nd0)
  765. nd0 = nd;
  766. k = nd < DBL_DIG + 1 ? nd : DBL_DIG + 1;
  767. rv = y;
  768. if (k > 9)
  769. rv = tens[k - 9] * rv + z;
  770. bd0 = 0;
  771. if (nd <= DBL_DIG
  772. && FLT_ROUNDS == 1
  773. ) {
  774. if (!e)
  775. goto ret;
  776. if (e > 0) {
  777. if (e <= Ten_pmax) {
  778. /* rv = */ rounded_product(rv, tens[e]);
  779. goto ret;
  780. }
  781. i = DBL_DIG - nd;
  782. if (e <= Ten_pmax + i) {
  783. /* A fancier test would sometimes let us do
  784. * this for larger i values.
  785. */
  786. e -= i;
  787. rv *= tens[i];
  788. /* rv = */ rounded_product(rv, tens[e]);
  789. goto ret;
  790. }
  791. } else if (e >= -Ten_pmax) {
  792. /* rv = */ rounded_quotient(rv, tens[-e]);
  793. goto ret;
  794. }
  795. }
  796. e1 += nd - k;
  797. scale = 0;
  798. /* Get starting approximation = rv * 10**e1 */
  799. if (e1 > 0) {
  800. if (i = e1 & 15)
  801. rv *= tens[i];
  802. if (e1 &= ~15) {
  803. if (e1 > DBL_MAX_10_EXP) {
  804. ovfl:
  805. /* Can't trust HUGE_VAL */
  806. word0(rv) = Exp_mask;
  807. word1(rv) = 0;
  808. if (bd0)
  809. goto retfree;
  810. goto ret;
  811. }
  812. if (e1 >>= 4) {
  813. for (j = 0; e1 > 1; j++, e1 >>= 1)
  814. if (e1 & 1)
  815. rv *= bigtens[j];
  816. /* The last multiplication could overflow. */
  817. word0(rv) -= P * Exp_msk1;
  818. rv *= bigtens[j];
  819. if ((z = word0(rv) & Exp_mask)
  820. > Exp_msk1 * (DBL_MAX_EXP + Bias - P))
  821. goto ovfl;
  822. if (z > Exp_msk1 * (DBL_MAX_EXP + Bias - 1 - P)) {
  823. /* set to largest number */
  824. /* (Can't trust DBL_MAX) */
  825. word0(rv) = Big0;
  826. word1(rv) = Big1;
  827. } else
  828. word0(rv) += P * Exp_msk1;
  829. }
  830. }
  831. } else if (e1 < 0) {
  832. e1 = -e1;
  833. if (i = e1 & 15)
  834. rv /= tens[i];
  835. if (e1 &= ~15) {
  836. e1 >>= 4;
  837. if (e1 >= 1 << n_bigtens)
  838. goto undfl;
  839. if (e1 & Scale_Bit)
  840. scale = P;
  841. for (j = 0; e1 > 0; j++, e1 >>= 1)
  842. if (e1 & 1)
  843. rv *= tinytens[j];
  844. if (!rv) {
  845. undfl:
  846. rv = 0.;
  847. if (bd0)
  848. goto retfree;
  849. goto ret;
  850. }
  851. }
  852. }
  853. /* Now the hard part -- adjusting rv to the correct value.*/
  854. /* Put digits into bd: true value = bd * 10^e */
  855. bd0 = s2b(s0, nd0, nd, y);
  856. for (; ; ) {
  857. bd = Balloc(bd0->k);
  858. Bcopy(bd, bd0);
  859. bb = d2b(rv, &bbe, &bbbits); /* rv = bb * 2^bbe */
  860. bs = i2b(1);
  861. if (e >= 0) {
  862. bb2 = bb5 = 0;
  863. bd2 = bd5 = e;
  864. } else {
  865. bb2 = bb5 = -e;
  866. bd2 = bd5 = 0;
  867. }
  868. if (bbe >= 0)
  869. bb2 += bbe;
  870. else
  871. bd2 -= bbe;
  872. bs2 = bb2;
  873. #ifdef Sudden_Underflow
  874. j = P + 1 - bbbits;
  875. #else
  876. i = bbe + bbbits - 1; /* logb(rv) */
  877. if (i < Emin) /* denormal */
  878. j = bbe + (P - Emin);
  879. else
  880. j = P + 1 - bbbits;
  881. #endif
  882. bb2 += j;
  883. bd2 += j;
  884. bd2 += scale;
  885. i = bb2 < bd2 ? bb2 : bd2;
  886. if (i > bs2)
  887. i = bs2;
  888. if (i > 0) {
  889. bb2 -= i;
  890. bd2 -= i;
  891. bs2 -= i;
  892. }
  893. if (bb5 > 0) {
  894. bs = pow5mult(bs, bb5);
  895. bb1 = mult(bs, bb);
  896. Bfree(bb);
  897. bb = bb1;
  898. }
  899. if (bb2 > 0)
  900. bb = lshift(bb, bb2);
  901. if (bd5 > 0)
  902. bd = pow5mult(bd, bd5);
  903. if (bd2 > 0)
  904. bd = lshift(bd, bd2);
  905. if (bs2 > 0)
  906. bs = lshift(bs, bs2);
  907. delta = diff(bb, bd);
  908. dsign = delta->sign;
  909. delta->sign = 0;
  910. i = cmp(delta, bs);
  911. if (i < 0) {
  912. /* Error is less than half an ulp -- check for
  913. * special case of mantissa a power of two.
  914. */
  915. if (dsign || word1(rv) || word0(rv) & Bndry_mask
  916. || (word0(rv) & Exp_mask) <= Exp_msk1
  917. ) {
  918. if (!delta->x[0] && delta->wds == 1)
  919. dsign = 2;
  920. break;
  921. }
  922. delta = lshift(delta, Log2P);
  923. if (cmp(delta, bs) > 0)
  924. goto drop_down;
  925. break;
  926. }
  927. if (i == 0) {
  928. /* exactly half-way between */
  929. if (dsign) {
  930. if ((word0(rv) & Bndry_mask1) == Bndry_mask1
  931. && word1(rv) == 0xffffffff) {
  932. /*boundary case -- increment exponent*/
  933. word0(rv) = (word0(rv) & Exp_mask)
  934. + Exp_msk1
  935. ;
  936. word1(rv) = 0;
  937. dsign = 0;
  938. break;
  939. }
  940. } else if (!(word0(rv) & Bndry_mask) && !word1(rv)) {
  941. dsign = 2;
  942. drop_down:
  943. /* boundary case -- decrement exponent */
  944. #ifdef Sudden_Underflow
  945. L = word0(rv) & Exp_mask;
  946. if (L <= Exp_msk1)
  947. goto undfl;
  948. L -= Exp_msk1;
  949. #else
  950. L = (word0(rv) & Exp_mask) - Exp_msk1;
  951. #endif
  952. word0(rv) = L | Bndry_mask1;
  953. word1(rv) = 0xffffffff;
  954. break;
  955. }
  956. if (!(word1(rv) & LSB))
  957. break;
  958. if (dsign)
  959. rv += ulp(rv);
  960. else {
  961. rv -= ulp(rv);
  962. #ifndef Sudden_Underflow
  963. if (!rv)
  964. goto undfl;
  965. #endif
  966. }
  967. dsign = 1 - dsign;
  968. break;
  969. }
  970. if ((aadj = ratio(delta, bs)) <= 2.) {
  971. if (dsign)
  972. aadj = aadj1 = 1.;
  973. else if (word1(rv) || word0(rv) & Bndry_mask) {
  974. #ifndef Sudden_Underflow
  975. if (word1(rv) == Tiny1 && !word0(rv))
  976. goto undfl;
  977. #endif
  978. aadj = 1.;
  979. aadj1 = -1.;
  980. } else {
  981. /* special case -- power of FLT_RADIX to be */
  982. /* rounded down... */
  983. if (aadj < 2. / FLT_RADIX)
  984. aadj = 1. / FLT_RADIX;
  985. else
  986. aadj *= 0.5;
  987. aadj1 = -aadj;
  988. }
  989. } else {
  990. aadj *= 0.5;
  991. aadj1 = dsign ? aadj : -aadj;
  992. if (FLT_ROUNDS == 0)
  993. aadj1 += 0.5;
  994. }
  995. y = word0(rv) & Exp_mask;
  996. /* Check for overflow */
  997. if (y == Exp_msk1 * (DBL_MAX_EXP + Bias - 1)) {
  998. rv0 = rv;
  999. word0(rv) -= P * Exp_msk1;
  1000. adj = aadj1 * ulp(rv);
  1001. rv += adj;
  1002. if ((word0(rv) & Exp_mask) >=
  1003. Exp_msk1 * (DBL_MAX_EXP + Bias - P)) {
  1004. if (word0(rv0) == Big0 && word1(rv0) == Big1)
  1005. goto ovfl;
  1006. word0(rv) = Big0;
  1007. word1(rv) = Big1;
  1008. goto cont;
  1009. } else
  1010. word0(rv) += P * Exp_msk1;
  1011. } else {
  1012. #ifdef Sudden_Underflow
  1013. if ((word0(rv) & Exp_mask) <= P * Exp_msk1) {
  1014. rv0 = rv;
  1015. word0(rv) += P * Exp_msk1;
  1016. adj = aadj1 * ulp(rv);
  1017. rv += adj;
  1018. if ((word0(rv) & Exp_mask) <= P * Exp_msk1) {
  1019. if (word0(rv0) == Tiny0
  1020. && word1(rv0) == Tiny1)
  1021. goto undfl;
  1022. word0(rv) = Tiny0;
  1023. word1(rv) = Tiny1;
  1024. goto cont;
  1025. } else
  1026. word0(rv) -= P * Exp_msk1;
  1027. } else {
  1028. adj = aadj1 * ulp(rv);
  1029. rv += adj;
  1030. }
  1031. #else
  1032. /* Compute adj so that the IEEE rounding rules will
  1033. * correctly round rv + adj in some half-way cases.
  1034. * If rv * ulp(rv) is denormalized (i.e.,
  1035. * y <= (P-1)*Exp_msk1), we must adjust aadj to avoid
  1036. * trouble from bits lost to denormalization;
  1037. * example: 1.2e-307 .
  1038. */
  1039. if (y <= (P - 1) * Exp_msk1 && aadj >= 1.) {
  1040. aadj1 = (double)(int)(aadj + 0.5);
  1041. if (!dsign)
  1042. aadj1 = -aadj1;
  1043. }
  1044. adj = aadj1 * ulp(rv);
  1045. rv += adj;
  1046. #endif
  1047. }
  1048. z = word0(rv) & Exp_mask;
  1049. if (!scale)
  1050. if (y == z) {
  1051. /* Can we stop now? */
  1052. L = aadj;
  1053. aadj -= L;
  1054. /* The tolerances below are conservative. */
  1055. if (dsign || word1(rv) || word0(rv) & Bndry_mask) {
  1056. if (aadj < .4999999 || aadj > .5000001)
  1057. break;
  1058. } else if (aadj < .4999999 / FLT_RADIX)
  1059. break;
  1060. }
  1061. cont:
  1062. Bfree(bb);
  1063. Bfree(bd);
  1064. Bfree(bs);
  1065. Bfree(delta);
  1066. }
  1067. if (scale) {
  1068. if ((word0(rv) & Exp_mask) <= P * Exp_msk1
  1069. && word1(rv) & 1
  1070. && dsign != 2)
  1071. if (dsign)
  1072. rv += ulp(rv);
  1073. else
  1074. word1(rv) &= ~1;
  1075. word0(rv0) = Exp_1 - P * Exp_msk1;
  1076. word1(rv0) = 0;
  1077. rv *= rv0;
  1078. }
  1079. retfree:
  1080. Bfree(bb);
  1081. Bfree(bd);
  1082. Bfree(bs);
  1083. Bfree(bd0);
  1084. Bfree(delta);
  1085. ret:
  1086. if (se)
  1087. *se = (char *)s;
  1088. return sign ? -rv : rv;
  1089. }
  1090. static int
  1091. quorem(Bigint *b, Bigint *S)
  1092. {
  1093. int n;
  1094. long borrow, y;
  1095. unsigned long carry, q, ys;
  1096. unsigned long * bx, *bxe, *sx, *sxe;
  1097. long z;
  1098. unsigned long si, zs;
  1099. n = S->wds;
  1100. if (b->wds < n)
  1101. return 0;
  1102. sx = S->x;
  1103. sxe = sx + --n;
  1104. bx = b->x;
  1105. bxe = bx + n;
  1106. q = *bxe / (*sxe + 1); /* ensure q <= true quotient */
  1107. if (q) {
  1108. borrow = 0;
  1109. carry = 0;
  1110. do {
  1111. si = *sx++;
  1112. ys = (si & 0xffff) * q + carry;
  1113. zs = (si >> 16) * q + (ys >> 16);
  1114. carry = zs >> 16;
  1115. y = (*bx & 0xffff) - (ys & 0xffff) + borrow;
  1116. borrow = y >> 16;
  1117. Sign_Extend(borrow, y);
  1118. z = (*bx >> 16) - (zs & 0xffff) + borrow;
  1119. borrow = z >> 16;
  1120. Sign_Extend(borrow, z);
  1121. Storeinc(bx, z, y);
  1122. } while (sx <= sxe);
  1123. if (!*bxe) {
  1124. bx = b->x;
  1125. while (--bxe > bx && !*bxe)
  1126. --n;
  1127. b->wds = n;
  1128. }
  1129. }
  1130. if (cmp(b, S) >= 0) {
  1131. q++;
  1132. borrow = 0;
  1133. carry = 0;
  1134. bx = b->x;
  1135. sx = S->x;
  1136. do {
  1137. si = *sx++;
  1138. ys = (si & 0xffff) + carry;
  1139. zs = (si >> 16) + (ys >> 16);
  1140. carry = zs >> 16;
  1141. y = (*bx & 0xffff) - (ys & 0xffff) + borrow;
  1142. borrow = y >> 16;
  1143. Sign_Extend(borrow, y);
  1144. z = (*bx >> 16) - (zs & 0xffff) + borrow;
  1145. borrow = z >> 16;
  1146. Sign_Extend(borrow, z);
  1147. Storeinc(bx, z, y);
  1148. } while (sx <= sxe);
  1149. bx = b->x;
  1150. bxe = bx + n;
  1151. if (!*bxe) {
  1152. while (--bxe > bx && !*bxe)
  1153. --n;
  1154. b->wds = n;
  1155. }
  1156. }
  1157. return q;
  1158. }
  1159. static char *
  1160. rv_alloc(int i)
  1161. {
  1162. int j, k, *r;
  1163. j = sizeof(unsigned long);
  1164. for (k = 0;
  1165. sizeof(Bigint) - sizeof(unsigned long) - sizeof(int) + j <= i;
  1166. j <<= 1)
  1167. k++;
  1168. r = (int * )Balloc(k);
  1169. *r = k;
  1170. return
  1171. (char *)(r + 1);
  1172. }
  1173. static char *
  1174. nrv_alloc(char *s, char **rve, int n)
  1175. {
  1176. char *rv, *t;
  1177. t = rv = rv_alloc(n);
  1178. while (*t = *s++)
  1179. t++;
  1180. if (rve)
  1181. *rve = t;
  1182. return rv;
  1183. }
  1184. /* freedtoa(s) must be used to free values s returned by dtoa
  1185. * when MULTIPLE_THREADS is #defined. It should be used in all cases,
  1186. * but for consistency with earlier versions of dtoa, it is optional
  1187. * when MULTIPLE_THREADS is not defined.
  1188. */
  1189. void
  1190. freedtoa(char *s)
  1191. {
  1192. Bigint * b = (Bigint * )((int *)s - 1);
  1193. b->maxwds = 1 << (b->k = *(int * )b);
  1194. Bfree(b);
  1195. }
  1196. /* dtoa for IEEE arithmetic (dmg): convert double to ASCII string.
  1197. *
  1198. * Inspired by "How to Print Floating-Point Numbers Accurately" by
  1199. * Guy L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90, pp. 92-101].
  1200. *
  1201. * Modifications:
  1202. * 1. Rather than iterating, we use a simple numeric overestimate
  1203. * to determine k = floor(log10(d)). We scale relevant
  1204. * quantities using O(log2(k)) rather than O(k) multiplications.
  1205. * 2. For some modes > 2 (corresponding to ecvt and fcvt), we don't
  1206. * try to generate digits strictly left to right. Instead, we
  1207. * compute with fewer bits and propagate the carry if necessary
  1208. * when rounding the final digit up. This is often faster.
  1209. * 3. Under the assumption that input will be rounded nearest,
  1210. * mode 0 renders 1e23 as 1e23 rather than 9.999999999999999e22.
  1211. * That is, we allow equality in stopping tests when the
  1212. * round-nearest rule will give the same floating-point value
  1213. * as would satisfaction of the stopping test with strict
  1214. * inequality.
  1215. * 4. We remove common factors of powers of 2 from relevant
  1216. * quantities.
  1217. * 5. When converting floating-point integers less than 1e16,
  1218. * we use floating-point arithmetic rather than resorting
  1219. * to multiple-precision integers.
  1220. * 6. When asked to produce fewer than 15 digits, we first try
  1221. * to get by with floating-point arithmetic; we resort to
  1222. * multiple-precision integer arithmetic only if we cannot
  1223. * guarantee that the floating-point calculation has given
  1224. * the correctly rounded result. For k requested digits and
  1225. * "uniformly" distributed input, the probability is
  1226. * something like 10^(k-15) that we must resort to the long
  1227. * calculation.
  1228. */
  1229. char *
  1230. dtoa(double d, int mode, int ndigits, int *decpt, int *sign, char **rve)
  1231. {
  1232. /* Arguments ndigits, decpt, sign are similar to those
  1233. of ecvt and fcvt; trailing zeros are suppressed from
  1234. the returned string. If not null, *rve is set to point
  1235. to the end of the return value. If d is +-Infinity or NaN,
  1236. then *decpt is set to 9999.
  1237. mode:
  1238. 0 ==> shortest string that yields d when read in
  1239. and rounded to nearest.
  1240. 1 ==> like 0, but with Steele & White stopping rule;
  1241. e.g. with IEEE P754 arithmetic , mode 0 gives
  1242. 1e23 whereas mode 1 gives 9.999999999999999e22.
  1243. 2 ==> max(1,ndigits) significant digits. This gives a
  1244. return value similar to that of ecvt, except
  1245. that trailing zeros are suppressed.
  1246. 3 ==> through ndigits past the decimal point. This
  1247. gives a return value similar to that from fcvt,
  1248. except that trailing zeros are suppressed, and
  1249. ndigits can be negative.
  1250. 4-9 should give the same return values as 2-3, i.e.,
  1251. 4 <= mode <= 9 ==> same return as mode
  1252. 2 + (mode & 1). These modes are mainly for
  1253. debugging; often they run slower but sometimes
  1254. faster than modes 2-3.
  1255. 4,5,8,9 ==> left-to-right digit generation.
  1256. 6-9 ==> don't try fast floating-point estimate
  1257. (if applicable).
  1258. Values of mode other than 0-9 are treated as mode 0.
  1259. Sufficient space is allocated to the return value
  1260. to hold the suppressed trailing zeros.
  1261. */
  1262. int bbits, b2, b5, be, dig, i, ieps, ilim, ilim0, ilim1,
  1263. j, j1, k, k0, k_check, leftright, m2, m5, s2, s5,
  1264. spec_case, try_quick;
  1265. long L;
  1266. #ifndef Sudden_Underflow
  1267. int denorm;
  1268. unsigned long x;
  1269. #endif
  1270. Bigint * b, *b1, *delta, *mlo, *mhi, *S;
  1271. double d2, ds, eps;
  1272. char *s, *s0;
  1273. if (word0(d) & Sign_bit) {
  1274. /* set sign for everything, including 0's and NaNs */
  1275. *sign = 1;
  1276. word0(d) &= ~Sign_bit; /* clear sign bit */
  1277. } else
  1278. *sign = 0;
  1279. if ((word0(d) & Exp_mask) == Exp_mask) {
  1280. /* Infinity or NaN */
  1281. *decpt = 9999;
  1282. if (!word1(d) && !(word0(d) & 0xfffff))
  1283. return nrv_alloc("Infinity", rve, 8);
  1284. return nrv_alloc("NaN", rve, 3);
  1285. }
  1286. if (!d) {
  1287. *decpt = 1;
  1288. return nrv_alloc("0", rve, 1);
  1289. }
  1290. b = d2b(d, &be, &bbits);
  1291. #ifdef Sudden_Underflow
  1292. i = (int)(word0(d) >> Exp_shift1 & (Exp_mask >> Exp_shift1));
  1293. #else
  1294. if (i = (int)(word0(d) >> Exp_shift1 & (Exp_mask >> Exp_shift1))) {
  1295. #endif
  1296. word0(d2) = (word0(d) & Frac_mask1) | Exp_11;
  1297. word1(d2) = word1(d);
  1298. /* log(x) ~=~ log(1.5) + (x-1.5)/1.5
  1299. * log10(x) = log(x) / log(10)
  1300. * ~=~ log(1.5)/log(10) + (x-1.5)/(1.5*log(10))
  1301. * log10(d) = (i-Bias)*log(2)/log(10) + log10(d2)
  1302. *
  1303. * This suggests computing an approximation k to log10(d) by
  1304. *
  1305. * k = (i - Bias)*0.301029995663981
  1306. * + ( (d2-1.5)*0.289529654602168 + 0.176091259055681 );
  1307. *
  1308. * We want k to be too large rather than too small.
  1309. * The error in the first-order Taylor series approximation
  1310. * is in our favor, so we just round up the constant enough
  1311. * to compensate for any error in the multiplication of
  1312. * (i - Bias) by 0.301029995663981; since |i - Bias| <= 1077,
  1313. * and 1077 * 0.30103 * 2^-52 ~=~ 7.2e-14,
  1314. * adding 1e-13 to the constant term more than suffices.
  1315. * Hence we adjust the constant term to 0.1760912590558.
  1316. * (We could get a more accurate k by invoking log10,
  1317. * but this is probably not worthwhile.)
  1318. */
  1319. i -= Bias;
  1320. #ifndef Sudden_Underflow
  1321. denorm = 0;
  1322. } else {
  1323. /* d is denormalized */
  1324. i = bbits + be + (Bias + (P - 1) - 1);
  1325. x = i > 32 ? word0(d) << 64 - i | word1(d) >> i - 32
  1326. : word1(d) << 32 - i;
  1327. d2 = x;
  1328. word0(d2) -= 31 * Exp_msk1; /* adjust exponent */
  1329. i -= (Bias + (P - 1) - 1) + 1;
  1330. denorm = 1;
  1331. }
  1332. #endif
  1333. ds = (d2 - 1.5) * 0.289529654602168 + 0.1760912590558 + i * 0.301029995663981;
  1334. k = (int)ds;
  1335. if (ds < 0. && ds != k)
  1336. k--; /* want k = floor(ds) */
  1337. k_check = 1;
  1338. if (k >= 0 && k <= Ten_pmax) {
  1339. if (d < tens[k])
  1340. k--;
  1341. k_check = 0;
  1342. }
  1343. j = bbits - i - 1;
  1344. if (j >= 0) {
  1345. b2 = 0;
  1346. s2 = j;
  1347. } else {
  1348. b2 = -j;
  1349. s2 = 0;
  1350. }
  1351. if (k >= 0) {
  1352. b5 = 0;
  1353. s5 = k;
  1354. s2 += k;
  1355. } else {
  1356. b2 -= k;
  1357. b5 = -k;
  1358. s5 = 0;
  1359. }
  1360. if (mode < 0 || mode > 9)
  1361. mode = 0;
  1362. try_quick = 1;
  1363. if (mode > 5) {
  1364. mode -= 4;
  1365. try_quick = 0;
  1366. }
  1367. leftright = 1;
  1368. switch (mode) {
  1369. case 0:
  1370. case 1:
  1371. ilim = ilim1 = -1;
  1372. i = 18;
  1373. ndigits = 0;
  1374. break;
  1375. case 2:
  1376. leftright = 0;
  1377. /* no break */
  1378. case 4:
  1379. if (ndigits <= 0)
  1380. ndigits = 1;
  1381. ilim = ilim1 = i = ndigits;
  1382. break;
  1383. case 3:
  1384. leftright = 0;
  1385. /* no break */
  1386. case 5:
  1387. i = ndigits + k + 1;
  1388. ilim = i;
  1389. ilim1 = i - 1;
  1390. if (i <= 0)
  1391. i = 1;
  1392. }
  1393. s = s0 = rv_alloc(i);
  1394. if (ilim >= 0 && ilim <= Quick_max && try_quick) {
  1395. /* Try to get by with floating-point arithmetic. */
  1396. i = 0;
  1397. d2 = d;
  1398. k0 = k;
  1399. ilim0 = ilim;
  1400. ieps = 2; /* conservative */
  1401. if (k > 0) {
  1402. ds = tens[k&0xf];
  1403. j = k >> 4;
  1404. if (j & Bletch) {
  1405. /* prevent overflows */
  1406. j &= Bletch - 1;
  1407. d /= bigtens[n_bigtens-1];
  1408. ieps++;
  1409. }
  1410. for (; j; j >>= 1, i++)
  1411. if (j & 1) {
  1412. ieps++;
  1413. ds *= bigtens[i];
  1414. }
  1415. d /= ds;
  1416. } else if (j1 = -k) {
  1417. d *= tens[j1 & 0xf];
  1418. for (j = j1 >> 4; j; j >>= 1, i++)
  1419. if (j & 1) {
  1420. ieps++;
  1421. d *= bigtens[i];
  1422. }
  1423. }
  1424. if (k_check && d < 1. && ilim > 0) {
  1425. if (ilim1 <= 0)
  1426. goto fast_failed;
  1427. ilim = ilim1;
  1428. k--;
  1429. d *= 10.;
  1430. ieps++;
  1431. }
  1432. eps = ieps * d + 7.;
  1433. word0(eps) -= (P - 1) * Exp_msk1;
  1434. if (ilim == 0) {
  1435. S = mhi = 0;
  1436. d -= 5.;
  1437. if (d > eps)
  1438. goto one_digit;
  1439. if (d < -eps)
  1440. goto no_digits;
  1441. goto fast_failed;
  1442. }
  1443. /* Generate ilim digits, then fix them up. */
  1444. eps *= tens[ilim-1];
  1445. for (i = 1; ; i++, d *= 10.) {
  1446. L = d;
  1447. d -= L;
  1448. *s++ = '0' + (int)L;
  1449. if (i == ilim) {
  1450. if (d > 0.5 + eps)
  1451. goto bump_up;
  1452. else if (d < 0.5 - eps) {
  1453. while (*--s == '0')
  1454. ;
  1455. s++;
  1456. goto ret1;
  1457. }
  1458. break;
  1459. }
  1460. }
  1461. fast_failed:
  1462. s = s0;
  1463. d = d2;
  1464. k = k0;
  1465. ilim = ilim0;
  1466. }
  1467. /* Do we have a "small" integer? */
  1468. if (be >= 0 && k <= Int_max) {
  1469. /* Yes. */
  1470. ds = tens[k];
  1471. if (ndigits < 0 && ilim <= 0) {
  1472. S = mhi = 0;
  1473. if (ilim < 0 || d <= 5 * ds)
  1474. goto no_digits;
  1475. goto one_digit;
  1476. }
  1477. for (i = 1; ; i++) {
  1478. L = d / ds;
  1479. d -= L * ds;
  1480. *s++ = '0' + (int)L;
  1481. if (i == ilim) {
  1482. d += d;
  1483. if (d > ds || d == ds && L & 1) {
  1484. bump_up:
  1485. while (*--s == '9')
  1486. if (s == s0) {
  1487. k++;
  1488. *s = '0';
  1489. break;
  1490. }
  1491. ++ * s++;
  1492. }
  1493. break;
  1494. }
  1495. if (!(d *= 10.))
  1496. break;
  1497. }
  1498. goto ret1;
  1499. }
  1500. m2 = b2;
  1501. m5 = b5;
  1502. mhi = mlo = 0;
  1503. if (leftright) {
  1504. if (mode < 2) {
  1505. i =
  1506. #ifndef Sudden_Underflow
  1507. denorm ? be + (Bias + (P - 1) - 1 + 1) :
  1508. #endif
  1509. 1 + P - bbits;
  1510. } else {
  1511. j = ilim - 1;
  1512. if (m5 >= j)
  1513. m5 -= j;
  1514. else {
  1515. s5 += j -= m5;
  1516. b5 += j;
  1517. m5 = 0;
  1518. }
  1519. if ((i = ilim) < 0) {
  1520. m2 -= i;
  1521. i = 0;
  1522. }
  1523. }
  1524. b2 += i;
  1525. s2 += i;
  1526. mhi = i2b(1);
  1527. }
  1528. if (m2 > 0 && s2 > 0) {
  1529. i = m2 < s2 ? m2 : s2;
  1530. b2 -= i;
  1531. m2 -= i;
  1532. s2 -= i;
  1533. }
  1534. if (b5 > 0) {
  1535. if (leftright) {
  1536. if (m5 > 0) {
  1537. mhi = pow5mult(mhi, m5);
  1538. b1 = mult(mhi, b);
  1539. Bfree(b);
  1540. b = b1;
  1541. }
  1542. if (j = b5 - m5)
  1543. b = pow5mult(b, j);
  1544. } else
  1545. b = pow5mult(b, b5);
  1546. }
  1547. S = i2b(1);
  1548. if (s5 > 0)
  1549. S = pow5mult(S, s5);
  1550. /* Check for special case that d is a normalized power of 2. */
  1551. spec_case = 0;
  1552. if (mode < 2) {
  1553. if (!word1(d) && !(word0(d) & Bndry_mask)
  1554. #ifndef Sudden_Underflow
  1555. && word0(d) & Exp_mask
  1556. #endif
  1557. ) {
  1558. /* The special case */
  1559. b2 += Log2P;
  1560. s2 += Log2P;
  1561. spec_case = 1;
  1562. }
  1563. }
  1564. /* Arrange for convenient computation of quotients:
  1565. * shift left if necessary so divisor has 4 leading 0 bits.
  1566. *
  1567. * Perhaps we should just compute leading 28 bits of S once
  1568. * and for all and pass them and a shift to quorem, so it
  1569. * can do shifts and ors to compute the numerator for q.
  1570. */
  1571. if (i = ((s5 ? 32 - hi0bits(S->x[S->wds-1]) : 1) + s2) & 0x1f)
  1572. i = 32 - i;
  1573. if (i > 4) {
  1574. i -= 4;
  1575. b2 += i;
  1576. m2 += i;
  1577. s2 += i;
  1578. } else if (i < 4) {
  1579. i += 28;
  1580. b2 += i;
  1581. m2 += i;
  1582. s2 += i;
  1583. }
  1584. if (b2 > 0)
  1585. b = lshift(b, b2);
  1586. if (s2 > 0)
  1587. S = lshift(S, s2);
  1588. if (k_check) {
  1589. if (cmp(b, S) < 0) {
  1590. k--;
  1591. b = multadd(b, 10, 0); /* we botched the k estimate */
  1592. if (leftright)
  1593. mhi = multadd(mhi, 10, 0);
  1594. ilim = ilim1;
  1595. }
  1596. }
  1597. if (ilim <= 0 && mode > 2) {
  1598. if (ilim < 0 || cmp(b, S = multadd(S, 5, 0)) <= 0) {
  1599. /* no digits, fcvt style */
  1600. no_digits:
  1601. k = -1 - ndigits;
  1602. goto ret;
  1603. }
  1604. one_digit:
  1605. *s++ = '1';
  1606. k++;
  1607. goto ret;
  1608. }
  1609. if (leftright) {
  1610. if (m2 > 0)
  1611. mhi = lshift(mhi, m2);
  1612. /* Compute mlo -- check for special case
  1613. * that d is a normalized power of 2.
  1614. */
  1615. mlo = mhi;
  1616. if (spec_case) {
  1617. mhi = Balloc(mhi->k);
  1618. Bcopy(mhi, mlo);
  1619. mhi = lshift(mhi, Log2P);
  1620. }
  1621. for (i = 1; ; i++) {
  1622. dig = quorem(b, S) + '0';
  1623. /* Do we yet have the shortest decimal string
  1624. * that will round to d?
  1625. */
  1626. j = cmp(b, mlo);
  1627. delta = diff(S, mhi);
  1628. j1 = delta->sign ? 1 : cmp(b, delta);
  1629. Bfree(delta);
  1630. if (j1 == 0 && !mode && !(word1(d) & 1)) {
  1631. if (dig == '9')
  1632. goto round_9_up;
  1633. if (j > 0)
  1634. dig++;
  1635. *s++ = dig;
  1636. goto ret;
  1637. }
  1638. if (j < 0 || j == 0 && !mode
  1639. && !(word1(d) & 1)
  1640. ) {
  1641. if (j1 > 0) {
  1642. b = lshift(b, 1);
  1643. j1 = cmp(b, S);
  1644. if ((j1 > 0 || j1 == 0 && dig & 1)
  1645. && dig++ == '9')
  1646. goto round_9_up;
  1647. }
  1648. *s++ = dig;
  1649. goto ret;
  1650. }
  1651. if (j1 > 0) {
  1652. if (dig == '9') { /* possible if i == 1 */
  1653. round_9_up:
  1654. *s++ = '9';
  1655. goto roundoff;
  1656. }
  1657. *s++ = dig + 1;
  1658. goto ret;
  1659. }
  1660. *s++ = dig;
  1661. if (i == ilim)
  1662. break;
  1663. b = multadd(b, 10, 0);
  1664. if (mlo == mhi)
  1665. mlo = mhi = multadd(mhi, 10, 0);
  1666. else {
  1667. mlo = multadd(mlo, 10, 0);
  1668. mhi = multadd(mhi, 10, 0);
  1669. }
  1670. }
  1671. } else
  1672. for (i = 1; ; i++) {
  1673. *s++ = dig = quorem(b, S) + '0';
  1674. if (i >= ilim)
  1675. break;
  1676. b = multadd(b, 10, 0);
  1677. }
  1678. /* Round off last digit */
  1679. b = lshift(b, 1);
  1680. j = cmp(b, S);
  1681. if (j > 0 || j == 0 && dig & 1) {
  1682. roundoff:
  1683. while (*--s == '9')
  1684. if (s == s0) {
  1685. k++;
  1686. *s++ = '1';
  1687. goto ret;
  1688. }
  1689. ++ * s++;
  1690. } else {
  1691. while (*--s == '0')
  1692. ;
  1693. s++;
  1694. }
  1695. ret:
  1696. Bfree(S);
  1697. if (mhi) {
  1698. if (mlo && mlo != mhi)
  1699. Bfree(mlo);
  1700. Bfree(mhi);
  1701. }
  1702. ret1:
  1703. Bfree(b);
  1704. *s = 0;
  1705. *decpt = k + 1;
  1706. if (rve)
  1707. *rve = s;
  1708. return s0;
  1709. }