pow.c 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630
  1. /* pow.c
  2. *
  3. * Power function
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * double x, y, z, pow();
  10. *
  11. * z = pow( x, y );
  12. *
  13. *
  14. *
  15. * DESCRIPTION:
  16. *
  17. * Computes x raised to the yth power. Analytically,
  18. *
  19. * x**y = exp( y log(x) ).
  20. *
  21. * Following Cody and Waite, this program uses a lookup table
  22. * of 2**-i/16 and pseudo extended precision arithmetic to
  23. * obtain an extra three bits of accuracy in both the logarithm
  24. * and the exponential.
  25. *
  26. *
  27. *
  28. * ACCURACY:
  29. *
  30. * Relative error:
  31. * arithmetic domain # trials peak rms
  32. * IEEE -26,26 30000 4.2e-16 7.7e-17
  33. * DEC -26,26 60000 4.8e-17 9.1e-18
  34. * 1/26 < x < 26, with log(x) uniformly distributed.
  35. * -26 < y < 26, y uniformly distributed.
  36. * IEEE 0,8700 30000 1.5e-14 2.1e-15
  37. * 0.99 < x < 1.01, 0 < y < 8700, uniformly distributed.
  38. *
  39. *
  40. * ERROR MESSAGES:
  41. *
  42. * message condition value returned
  43. * pow overflow x**y > MAXNUM INFINITY
  44. * pow underflow x**y < 1/MAXNUM 0.0
  45. * pow domain x<0 and y noninteger 0.0
  46. *
  47. */
  48. /*
  49. Cephes Math Library Release 2.8: June, 2000
  50. Copyright 1984, 1995, 2000 by Stephen L. Moshier
  51. */
  52. #include "mconf.h"
  53. static char fname[] = {"pow"};
  54. #define SQRTH 0.70710678118654752440
  55. #ifdef UNK
  56. static double P[] = {4.97778295871696322025E-1, 3.73336776063286838734E0,
  57. 7.69994162726912503298E0, 4.66651806774358464979E0};
  58. static double Q[] = {
  59. /* 1.00000000000000000000E0, */
  60. 9.33340916416696166113E0, 2.79999886606328401649E1,
  61. 3.35994905342304405431E1, 1.39995542032307539578E1};
  62. /* 2^(-i/16), IEEE precision */
  63. static double A[] = {1.00000000000000000000E0, 9.57603280698573700036E-1,
  64. 9.17004043204671215328E-1, 8.78126080186649726755E-1,
  65. 8.40896415253714502036E-1, 8.05245165974627141736E-1,
  66. 7.71105412703970372057E-1, 7.38413072969749673113E-1,
  67. 7.07106781186547572737E-1, 6.77127773468446325644E-1,
  68. 6.48419777325504820276E-1, 6.20928906036742001007E-1,
  69. 5.94603557501360513449E-1, 5.69394317378345782288E-1,
  70. 5.45253866332628844837E-1, 5.22136891213706877402E-1,
  71. 5.00000000000000000000E-1};
  72. static double B[] = {0.00000000000000000000E0, 1.64155361212281360176E-17,
  73. 4.09950501029074826006E-17, 3.97491740484881042808E-17,
  74. -4.83364665672645672553E-17, 1.26912513974441574796E-17,
  75. 1.99100761573282305549E-17, -1.52339103990623557348E-17,
  76. 0.00000000000000000000E0};
  77. static double R[] = {1.49664108433729301083E-5, 1.54010762792771901396E-4,
  78. 1.33335476964097721140E-3, 9.61812908476554225149E-3,
  79. 5.55041086645832347466E-2, 2.40226506959099779976E-1,
  80. 6.93147180559945308821E-1};
  81. #define douba(k) A[k]
  82. #define doubb(k) B[k]
  83. #define MEXP 16383.0
  84. #ifdef DENORMAL
  85. #define MNEXP -17183.0
  86. #else
  87. #define MNEXP -16383.0
  88. #endif
  89. #endif
  90. #ifdef DEC
  91. static unsigned short P[] = {
  92. 0037776, 0156313, 0175332, 0163602, 0040556, 0167577, 0052366, 0174245,
  93. 0040766, 0062753, 0175707, 0055564, 0040625, 0052035, 0131344, 0155636,
  94. };
  95. static unsigned short Q[] = {
  96. /*0040200,0000000,0000000,0000000,*/
  97. 0041025, 0052644, 0154404, 0105155, 0041337, 0177772, 0007016, 0047646,
  98. 0041406, 0062740, 0154273, 0020020, 0041137, 0177054, 0106127, 0044555,
  99. };
  100. static unsigned short A[] = {
  101. 0040200, 0000000, 0000000, 0000000, 0040165, 0022575, 0012444, 0103314,
  102. 0040152, 0140306, 0163735, 0022071, 0040140, 0146336, 0166052, 0112341,
  103. 0040127, 0042374, 0145326, 0116553, 0040116, 0022214, 0012437, 0102201,
  104. 0040105, 0063452, 0010525, 0003333, 0040075, 0004243, 0117530, 0006067,
  105. 0040065, 0002363, 0031771, 0157145, 0040055, 0054076, 0165102, 0120513,
  106. 0040045, 0177326, 0124661, 0050471, 0040036, 0172462, 0060221, 0120422,
  107. 0040030, 0033760, 0050615, 0134251, 0040021, 0141723, 0071653, 0010703,
  108. 0040013, 0112701, 0161752, 0105727, 0040005, 0125303, 0063714, 0044173,
  109. 0040000, 0000000, 0000000, 0000000};
  110. static unsigned short B[] = {
  111. 0000000, 0000000, 0000000, 0000000, 0021473, 0040265, 0153315, 0140671,
  112. 0121074, 0062627, 0042146, 0176454, 0121413, 0003524, 0136332, 0066212,
  113. 0121767, 0046404, 0166231, 0012553, 0121257, 0015024, 0002357, 0043574,
  114. 0021736, 0106532, 0043060, 0056206, 0121310, 0020334, 0165705, 0035326,
  115. 0000000, 0000000, 0000000, 0000000};
  116. static unsigned short R[] = {
  117. 0034173, 0014076, 0137624, 0115771, 0035041, 0076763, 0003744,
  118. 0111311, 0035656, 0141766, 0041127, 0074351, 0036435, 0112533,
  119. 0073611, 0116664, 0037143, 0054106, 0134040, 0152223, 0037565,
  120. 0176757, 0176026, 0025551, 0040061, 0071027, 0173721, 0147572};
  121. /*
  122. static double R[] = {
  123. 0.14928852680595608186e-4,
  124. 0.15400290440989764601e-3,
  125. 0.13333541313585784703e-2,
  126. 0.96181290595172416964e-2,
  127. 0.55504108664085595326e-1,
  128. 0.24022650695909537056e0,
  129. 0.69314718055994529629e0
  130. };
  131. */
  132. #define douba(k) (*(double *)&A[(k) << 2])
  133. #define doubb(k) (*(double *)&B[(k) << 2])
  134. #define MEXP 2031.0
  135. #define MNEXP -2031.0
  136. #endif
  137. #ifdef IBMPC
  138. static unsigned short P[] = {
  139. 0x5cf0, 0x7f5b, 0xdb99, 0x3fdf, 0xdf15, 0xea9e, 0xddef, 0x400d,
  140. 0xeb6f, 0x7f78, 0xccbd, 0x401e, 0x9b74, 0xb65c, 0xaa83, 0x4012,
  141. };
  142. static unsigned short Q[] = {
  143. /*0x0000,0x0000,0x0000,0x3ff0,*/
  144. 0x914e, 0x9b20, 0xaab4, 0x4022, 0xc9f5, 0x41c1, 0xffff, 0x403b,
  145. 0x6402, 0x1b17, 0xccbc, 0x4040, 0xe92e, 0x918a, 0xffc5, 0x402b,
  146. };
  147. static unsigned short A[] = {
  148. 0x0000, 0x0000, 0x0000, 0x3ff0, 0x90da, 0xa2a4, 0xa4af, 0x3fee, 0xa487,
  149. 0xdcfb, 0x5818, 0x3fed, 0x529c, 0xdd85, 0x199b, 0x3fec, 0xd3ad, 0x995a,
  150. 0xe89f, 0x3fea, 0xf090, 0x82a3, 0xc491, 0x3fe9, 0xa0db, 0x422a, 0xace5,
  151. 0x3fe8, 0x0187, 0x73eb, 0xa114, 0x3fe7, 0x3bcd, 0x667f, 0xa09e, 0x3fe6,
  152. 0x5429, 0xdd48, 0xab07, 0x3fe5, 0x2a27, 0xd536, 0xbfda, 0x3fe4, 0x3422,
  153. 0x4c12, 0xdea6, 0x3fe3, 0xb715, 0x0a31, 0x06fe, 0x3fe3, 0x6238, 0x6e75,
  154. 0x387a, 0x3fe2, 0x517b, 0x3c7d, 0x72b8, 0x3fe1, 0x890f, 0x6cf9, 0xb558,
  155. 0x3fe0, 0x0000, 0x0000, 0x0000, 0x3fe0};
  156. static unsigned short B[] = {
  157. 0x0000, 0x0000, 0x0000, 0x0000, 0x3707, 0xd75b, 0xed02, 0x3c72, 0xcc81,
  158. 0x345d, 0xa1cd, 0x3c87, 0x4b27, 0x5686, 0xe9f1, 0x3c86, 0x6456, 0x13b2,
  159. 0xdd34, 0xbc8b, 0x42e2, 0xafec, 0x4397, 0x3c6d, 0x82e4, 0xd231, 0xf46a,
  160. 0x3c76, 0x8a76, 0xb9d7, 0x9041, 0xbc71, 0x0000, 0x0000, 0x0000, 0x0000};
  161. static unsigned short R[] = {0x937f, 0xd7f2, 0x6307, 0x3eef, 0x9259, 0x60fc,
  162. 0x2fbe, 0x3f24, 0xef1d, 0xc84a, 0xd87e, 0x3f55,
  163. 0x33b7, 0x6ef1, 0xb2ab, 0x3f83, 0x1a92, 0xd704,
  164. 0x6b08, 0x3fac, 0xc56d, 0xff82, 0xbfbd, 0x3fce,
  165. 0x39ef, 0xfefa, 0x2e42, 0x3fe6};
  166. #define douba(k) (*(double *)&A[(k) << 2])
  167. #define doubb(k) (*(double *)&B[(k) << 2])
  168. #define MEXP 16383.0
  169. #ifdef DENORMAL
  170. #define MNEXP -17183.0
  171. #else
  172. #define MNEXP -16383.0
  173. #endif
  174. #endif
  175. #ifdef MIEEE
  176. static unsigned short P[] = {0x3fdf, 0xdb99, 0x7f5b, 0x5cf0, 0x400d, 0xddef,
  177. 0xea9e, 0xdf15, 0x401e, 0xccbd, 0x7f78, 0xeb6f,
  178. 0x4012, 0xaa83, 0xb65c, 0x9b74};
  179. static unsigned short Q[] = {0x4022, 0xaab4, 0x9b20, 0x914e, 0x403b, 0xffff,
  180. 0x41c1, 0xc9f5, 0x4040, 0xccbc, 0x1b17, 0x6402,
  181. 0x402b, 0xffc5, 0x918a, 0xe92e};
  182. static unsigned short A[] = {
  183. 0x3ff0, 0x0000, 0x0000, 0x0000, 0x3fee, 0xa4af, 0xa2a4, 0x90da, 0x3fed,
  184. 0x5818, 0xdcfb, 0xa487, 0x3fec, 0x199b, 0xdd85, 0x529c, 0x3fea, 0xe89f,
  185. 0x995a, 0xd3ad, 0x3fe9, 0xc491, 0x82a3, 0xf090, 0x3fe8, 0xace5, 0x422a,
  186. 0xa0db, 0x3fe7, 0xa114, 0x73eb, 0x0187, 0x3fe6, 0xa09e, 0x667f, 0x3bcd,
  187. 0x3fe5, 0xab07, 0xdd48, 0x5429, 0x3fe4, 0xbfda, 0xd536, 0x2a27, 0x3fe3,
  188. 0xdea6, 0x4c12, 0x3422, 0x3fe3, 0x06fe, 0x0a31, 0xb715, 0x3fe2, 0x387a,
  189. 0x6e75, 0x6238, 0x3fe1, 0x72b8, 0x3c7d, 0x517b, 0x3fe0, 0xb558, 0x6cf9,
  190. 0x890f, 0x3fe0, 0x0000, 0x0000, 0x0000};
  191. static unsigned short B[] = {
  192. 0x0000, 0x0000, 0x0000, 0x0000, 0x3c72, 0xed02, 0xd75b, 0x3707, 0x3c87,
  193. 0xa1cd, 0x345d, 0xcc81, 0x3c86, 0xe9f1, 0x5686, 0x4b27, 0xbc8b, 0xdd34,
  194. 0x13b2, 0x6456, 0x3c6d, 0x4397, 0xafec, 0x42e2, 0x3c76, 0xf46a, 0xd231,
  195. 0x82e4, 0xbc71, 0x9041, 0xb9d7, 0x8a76, 0x0000, 0x0000, 0x0000, 0x0000};
  196. static unsigned short R[] = {0x3eef, 0x6307, 0xd7f2, 0x937f, 0x3f24, 0x2fbe,
  197. 0x60fc, 0x9259, 0x3f55, 0xd87e, 0xc84a, 0xef1d,
  198. 0x3f83, 0xb2ab, 0x6ef1, 0x33b7, 0x3fac, 0x6b08,
  199. 0xd704, 0x1a92, 0x3fce, 0xbfbd, 0xff82, 0xc56d,
  200. 0x3fe6, 0x2e42, 0xfefa, 0x39ef};
  201. #define douba(k) (*(double *)&A[(k) << 2])
  202. #define doubb(k) (*(double *)&B[(k) << 2])
  203. #define MEXP 16383.0
  204. #ifdef DENORMAL
  205. #define MNEXP -17183.0
  206. #else
  207. #define MNEXP -16383.0
  208. #endif
  209. #endif
  210. /* log2(e) - 1 */
  211. #define LOG2EA 0.44269504088896340736
  212. #define F W
  213. #define Fa Wa
  214. #define Fb Wb
  215. #define G W
  216. #define Ga Wa
  217. #define Gb u
  218. #define H W
  219. #define Ha Wb
  220. #define Hb Wb
  221. #ifdef ANSIPROT
  222. extern double floor(double);
  223. extern double fabs(double);
  224. extern double frexp(double, int *);
  225. extern double ldexp(double, int);
  226. extern double polevl(double, void *, int);
  227. extern double p1evl(double, void *, int);
  228. extern double powi(double, int);
  229. extern int signbit(double);
  230. extern int isnan(double);
  231. extern int isfinite(double);
  232. static double reduc(double);
  233. #else
  234. double floor(), fabs(), frexp(), ldexp();
  235. double polevl(), p1evl(), powi();
  236. int signbit(), isnan(), isfinite();
  237. static double reduc();
  238. #endif
  239. extern double MAXNUM;
  240. #ifdef INFINITIES
  241. extern double INFINITY;
  242. #endif
  243. #ifdef NANS
  244. extern double NAN;
  245. #endif
  246. #ifdef MINUSZERO
  247. extern double NEGZERO;
  248. #endif
  249. double pow(x, y) double x, y;
  250. {
  251. double w, z, W, Wa, Wb, ya, yb, u;
  252. /* double F, Fa, Fb, G, Ga, Gb, H, Ha, Hb */
  253. double aw, ay, wy;
  254. int e, i, nflg, iyflg, yoddint;
  255. if (y == 0.0)
  256. return (1.0);
  257. #ifdef NANS
  258. if (isnan(x))
  259. return (x);
  260. if (isnan(y))
  261. return (y);
  262. #endif
  263. if (y == 1.0)
  264. return (x);
  265. #ifdef INFINITIES
  266. if (!isfinite(y) && (x == 1.0 || x == -1.0)) {
  267. mtherr("pow", DOMAIN);
  268. #ifdef NANS
  269. return (NAN);
  270. #else
  271. return (INFINITY);
  272. #endif
  273. }
  274. #endif
  275. if (x == 1.0)
  276. return (1.0);
  277. if (y >= MAXNUM) {
  278. #ifdef INFINITIES
  279. if (x > 1.0)
  280. return (INFINITY);
  281. #else
  282. if (x > 1.0)
  283. return (MAXNUM);
  284. #endif
  285. if (x > 0.0 && x < 1.0)
  286. return (0.0);
  287. if (x < -1.0) {
  288. #ifdef INFINITIES
  289. return (INFINITY);
  290. #else
  291. return (MAXNUM);
  292. #endif
  293. }
  294. if (x > -1.0 && x < 0.0)
  295. return (0.0);
  296. }
  297. if (y <= -MAXNUM) {
  298. if (x > 1.0)
  299. return (0.0);
  300. #ifdef INFINITIES
  301. if (x > 0.0 && x < 1.0)
  302. return (INFINITY);
  303. #else
  304. if (x > 0.0 && x < 1.0)
  305. return (MAXNUM);
  306. #endif
  307. if (x < -1.0)
  308. return (0.0);
  309. #ifdef INFINITIES
  310. if (x > -1.0 && x < 0.0)
  311. return (INFINITY);
  312. #else
  313. if (x > -1.0 && x < 0.0)
  314. return (MAXNUM);
  315. #endif
  316. }
  317. if (x >= MAXNUM) {
  318. #if INFINITIES
  319. if (y > 0.0)
  320. return (INFINITY);
  321. #else
  322. if (y > 0.0)
  323. return (MAXNUM);
  324. #endif
  325. return (0.0);
  326. }
  327. /* Set iyflg to 1 if y is an integer. */
  328. iyflg = 0;
  329. w = floor(y);
  330. if (w == y)
  331. iyflg = 1;
  332. /* Test for odd integer y. */
  333. yoddint = 0;
  334. if (iyflg) {
  335. ya = fabs(y);
  336. ya = floor(0.5 * ya);
  337. yb = 0.5 * fabs(w);
  338. if (ya != yb)
  339. yoddint = 1;
  340. }
  341. if (x <= -MAXNUM) {
  342. if (y > 0.0) {
  343. #ifdef INFINITIES
  344. if (yoddint)
  345. return (-INFINITY);
  346. return (INFINITY);
  347. #else
  348. if (yoddint)
  349. return (-MAXNUM);
  350. return (MAXNUM);
  351. #endif
  352. }
  353. if (y < 0.0) {
  354. #ifdef MINUSZERO
  355. if (yoddint)
  356. return (NEGZERO);
  357. #endif
  358. return (0.0);
  359. }
  360. }
  361. nflg = 0; /* flag = 1 if x<0 raised to integer power */
  362. if (x <= 0.0) {
  363. if (x == 0.0) {
  364. if (y < 0.0) {
  365. #ifdef MINUSZERO
  366. if (signbit(x) && yoddint)
  367. return (-INFINITY);
  368. #endif
  369. #ifdef INFINITIES
  370. return (INFINITY);
  371. #else
  372. return (MAXNUM);
  373. #endif
  374. }
  375. if (y > 0.0) {
  376. #ifdef MINUSZERO
  377. if (signbit(x) && yoddint)
  378. return (NEGZERO);
  379. #endif
  380. return (0.0);
  381. }
  382. return (1.0);
  383. } else {
  384. if (iyflg == 0) { /* noninteger power of negative number */
  385. mtherr(fname, DOMAIN);
  386. #ifdef NANS
  387. return (NAN);
  388. #else
  389. return (0.0L);
  390. #endif
  391. }
  392. nflg = 1;
  393. }
  394. }
  395. /* Integer power of an integer. */
  396. if (iyflg) {
  397. i = w;
  398. w = floor(x);
  399. if ((w == x) && (fabs(y) < 32768.0)) {
  400. w = powi(x, (int)y);
  401. return (w);
  402. }
  403. }
  404. if (nflg)
  405. x = fabs(x);
  406. /* For results close to 1, use a series expansion. */
  407. w = x - 1.0;
  408. aw = fabs(w);
  409. ay = fabs(y);
  410. wy = w * y;
  411. ya = fabs(wy);
  412. if ((aw <= 1.0e-3 && ay <= 1.0) || (ya <= 1.0e-3 && ay >= 1.0)) {
  413. z = (((((w * (y - 5.) / 720. + 1. / 120.) * w * (y - 4.) + 1. / 24.) * w *
  414. (y - 3.) +
  415. 1. / 6.) *
  416. w * (y - 2.) +
  417. 0.5) *
  418. w * (y - 1.)) *
  419. wy +
  420. wy + 1.;
  421. goto done;
  422. }
  423. /* These are probably too much trouble. */
  424. #if 0
  425. w = y * log(x);
  426. if (aw > 1.0e-3 && fabs(w) < 1.0e-3)
  427. {
  428. z = ((((((
  429. w/7. + 1.)*w/6. + 1.)*w/5. + 1.)*w/4. + 1.)*w/3. + 1.)*w/2. + 1.)*w + 1.;
  430. goto done;
  431. }
  432. if(ya <= 1.0e-3 && aw <= 1.0e-4)
  433. {
  434. z = (((((
  435. wy*1./720.
  436. + (-w*1./48. + 1./120.) )*wy
  437. + ((w*17./144. - 1./12.)*w + 1./24.) )*wy
  438. + (((-w*5./16. + 7./24.)*w - 1./4.)*w + 1./6.) )*wy
  439. + ((((w*137./360. - 5./12.)*w + 11./24.)*w - 1./2.)*w + 1./2.) )*wy
  440. + (((((-w*1./6. + 1./5.)*w - 1./4)*w + 1./3.)*w -1./2.)*w ) )*wy
  441. + wy + 1.0;
  442. goto done;
  443. }
  444. #endif
  445. /* separate significand from exponent */
  446. x = frexp(x, &e);
  447. #if 0
  448. /* For debugging, check for gross overflow. */
  449. if( (e * y) > (MEXP + 1024) )
  450. goto overflow;
  451. #endif
  452. /* Find significand of x in antilog table A[]. */
  453. i = 1;
  454. if (x <= douba(9))
  455. i = 9;
  456. if (x <= douba(i + 4))
  457. i += 4;
  458. if (x <= douba(i + 2))
  459. i += 2;
  460. if (x >= douba(1))
  461. i = -1;
  462. i += 1;
  463. /* Find (x - A[i])/A[i]
  464. * in order to compute log(x/A[i]):
  465. *
  466. * log(x) = log( a x/a ) = log(a) + log(x/a)
  467. *
  468. * log(x/a) = log(1+v), v = x/a - 1 = (x-a)/a
  469. */
  470. x -= douba(i);
  471. x -= doubb(i / 2);
  472. x /= douba(i);
  473. /* rational approximation for log(1+v):
  474. *
  475. * log(1+v) = v - v**2/2 + v**3 P(v) / Q(v)
  476. */
  477. z = x * x;
  478. w = x * (z * polevl(x, P, 3) / p1evl(x, Q, 4));
  479. w = w - ldexp(z, -1); /* w - 0.5 * z */
  480. /* Convert to base 2 logarithm:
  481. * multiply by log2(e)
  482. */
  483. w = w + LOG2EA * w;
  484. /* Note x was not yet added in
  485. * to above rational approximation,
  486. * so do it now, while multiplying
  487. * by log2(e).
  488. */
  489. z = w + LOG2EA * x;
  490. z = z + x;
  491. /* Compute exponent term of the base 2 logarithm. */
  492. w = -i;
  493. w = ldexp(w, -4); /* divide by 16 */
  494. w += e;
  495. /* Now base 2 log of x is w + z. */
  496. /* Multiply base 2 log by y, in extended precision. */
  497. /* separate y into large part ya
  498. * and small part yb less than 1/16
  499. */
  500. ya = reduc(y);
  501. yb = y - ya;
  502. F = z * y + w * yb;
  503. Fa = reduc(F);
  504. Fb = F - Fa;
  505. G = Fa + w * ya;
  506. Ga = reduc(G);
  507. Gb = G - Ga;
  508. H = Fb + Gb;
  509. Ha = reduc(H);
  510. w = ldexp(Ga + Ha, 4);
  511. /* Test the power of 2 for overflow */
  512. if (w > MEXP) {
  513. #ifndef INFINITIES
  514. mtherr(fname, OVERFLOW);
  515. #endif
  516. #ifdef INFINITIES
  517. if (nflg && yoddint)
  518. return (-INFINITY);
  519. return (INFINITY);
  520. #else
  521. if (nflg && yoddint)
  522. return (-MAXNUM);
  523. return (MAXNUM);
  524. #endif
  525. }
  526. if (w < (MNEXP - 1)) {
  527. #ifndef DENORMAL
  528. mtherr(fname, UNDERFLOW);
  529. #endif
  530. #ifdef MINUSZERO
  531. if (nflg && yoddint)
  532. return (NEGZERO);
  533. #endif
  534. return (0.0);
  535. }
  536. e = w;
  537. Hb = H - Ha;
  538. if (Hb > 0.0) {
  539. e += 1;
  540. Hb -= 0.0625;
  541. }
  542. /* Now the product y * log2(x) = Hb + e/16.0.
  543. *
  544. * Compute base 2 exponential of Hb,
  545. * where -0.0625 <= Hb <= 0.
  546. */
  547. z = Hb * polevl(Hb, R, 6); /* z = 2**Hb - 1 */
  548. /* Express e/16 as an integer plus a negative number of 16ths.
  549. * Find lookup table entry for the fractional power of 2.
  550. */
  551. if (e < 0)
  552. i = 0;
  553. else
  554. i = 1;
  555. i = e / 16 + i;
  556. e = 16 * i - e;
  557. w = douba(e);
  558. z = w + w * z; /* 2**-e * ( 1 + (2**Hb-1) ) */
  559. z = ldexp(z, i); /* multiply by integer power of 2 */
  560. done:
  561. /* Negate if odd integer power of negative number */
  562. if (nflg && yoddint) {
  563. #ifdef MINUSZERO
  564. if (z == 0.0)
  565. z = NEGZERO;
  566. else
  567. #endif
  568. z = -z;
  569. }
  570. return (z);
  571. }
  572. /* Find a multiple of 1/16 that is within 1/16 of x. */
  573. static double reduc(x) double x;
  574. {
  575. double t;
  576. t = ldexp(x, 4);
  577. t = floor(t);
  578. t = ldexp(t, -4);
  579. return (t);
  580. }