double __x2y2m1 (double x, double y) { double vals[4]; SET_RESTORE_ROUND (FE_TONEAREST); mul_split (&vals[1], &vals[0], x, x); mul_split (&vals[3], &vals[2], y, y); if (x >= 0.75) vals[1] -= 1.0; else { vals[1] -= 0.5; vals[3] -= 0.5; } qsort (vals, 4, sizeof (double), compare); /* Add up the values so that each element of VALS has absolute value at most equal to the last set bit of the next nonzero element. */ for (size_t i = 0; i <= 2; i++) { add_split (&vals[i + 1], &vals[i], vals[i + 1], vals[i]); qsort (vals + i + 1, 3 - i, sizeof (double), compare); } /* Now any error from this addition will be small. */ return vals[3] + vals[2] + vals[1] + vals[0]; }
double __gamma_product (double x, double x_eps, int n, double *eps) { SET_RESTORE_ROUND (FE_TONEAREST); double ret = x; *eps = x_eps / x; for (int i = 1; i < n; i++) { *eps += x_eps / (x + i); double lo; mul_split (&ret, &lo, ret, x + i); *eps += lo / ret; } return ret; }
long double __x2y2m1l (long double x, long double y) { double vals[12]; SET_RESTORE_ROUND (FE_TONEAREST); union ibm_extended_long_double xu, yu; xu.d = x; yu.d = y; if (fabs (xu.dd[1]) < 0x1p-500) xu.dd[1] = 0.0; if (fabs (yu.dd[1]) < 0x1p-500) yu.dd[1] = 0.0; mul_split (&vals[1], &vals[0], xu.dd[0], xu.dd[0]); mul_split (&vals[3], &vals[2], xu.dd[0], xu.dd[1]); vals[2] *= 2.0; vals[3] *= 2.0; mul_split (&vals[5], &vals[4], xu.dd[1], xu.dd[1]); mul_split (&vals[7], &vals[6], yu.dd[0], yu.dd[0]); mul_split (&vals[9], &vals[8], yu.dd[0], yu.dd[1]); vals[8] *= 2.0; vals[9] *= 2.0; mul_split (&vals[11], &vals[10], yu.dd[1], yu.dd[1]); if (xu.dd[0] >= 0.75) vals[1] -= 1.0; else { vals[1] -= 0.5; vals[7] -= 0.5; } qsort (vals, 12, sizeof (double), compare); /* Add up the values so that each element of VALS has absolute value at most equal to the last set bit of the next nonzero element. */ for (size_t i = 0; i <= 10; i++) { add_split (&vals[i + 1], &vals[i], vals[i + 1], vals[i]); qsort (vals + i + 1, 11 - i, sizeof (double), compare); } /* Now any error from this addition will be small. */ long double retval = (long double) vals[11]; for (size_t i = 10; i != (size_t) -1; i--) retval += (long double) vals[i]; return retval; }
double SECTION __ieee754_pow(double x, double y) { double z,a,aa,error, t,a1,a2,y1,y2; #if 0 double gor=1.0; #endif mynumber u,v; int k; int4 qx,qy; v.x=y; u.x=x; if (v.i[LOW_HALF] == 0) { /* of y */ qx = u.i[HIGH_HALF]&0x7fffffff; /* Checking if x is not too small to compute */ if (((qx==0x7ff00000)&&(u.i[LOW_HALF]!=0))||(qx>0x7ff00000)) return NaNQ.x; if (y == 1.0) return x; if (y == 2.0) return x*x; if (y == -1.0) return 1.0/x; if (y == 0) return 1.0; } /* else */ if(((u.i[HIGH_HALF]>0 && u.i[HIGH_HALF]<0x7ff00000)|| /* x>0 and not x->0 */ (u.i[HIGH_HALF]==0 && u.i[LOW_HALF]!=0)) && /* 2^-1023< x<= 2^-1023 * 0x1.0000ffffffff */ (v.i[HIGH_HALF]&0x7fffffff) < 0x4ff00000) { /* if y<-1 or y>1 */ double retval; SET_RESTORE_ROUND (FE_TONEAREST); /* Avoid internal underflow for tiny y. The exact value of y does not matter if |y| <= 2**-64. */ if (ABS (y) < 0x1p-64) y = y < 0 ? -0x1p-64 : 0x1p-64; z = log1(x,&aa,&error); /* x^y =e^(y log (X)) */ t = y*134217729.0; y1 = t - (t-y); y2 = y - y1; t = z*134217729.0; a1 = t - (t-z); a2 = (z - a1)+aa; a = y1*a1; aa = y2*a1 + y*a2; a1 = a+aa; a2 = (a-a1)+aa; error = error*ABS(y); t = __exp1(a1,a2,1.9e16*error); /* return -10 or 0 if wasn't computed exactly */ retval = (t>0)?t:power1(x,y); return retval; } if (x == 0) { if (((v.i[HIGH_HALF] & 0x7fffffff) == 0x7ff00000 && v.i[LOW_HALF] != 0) || (v.i[HIGH_HALF] & 0x7fffffff) > 0x7ff00000) return y; if (ABS(y) > 1.0e20) return (y>0)?0:1.0/0.0; k = checkint(y); if (k == -1) return y < 0 ? 1.0/x : x; else return y < 0 ? 1.0/0.0 : 0.0; /* return 0 */ } qx = u.i[HIGH_HALF]&0x7fffffff; /* no sign */ qy = v.i[HIGH_HALF]&0x7fffffff; /* no sign */ if (qx >= 0x7ff00000 && (qx > 0x7ff00000 || u.i[LOW_HALF] != 0)) return NaNQ.x; if (qy >= 0x7ff00000 && (qy > 0x7ff00000 || v.i[LOW_HALF] != 0)) return x == 1.0 ? 1.0 : NaNQ.x; /* if x<0 */ if (u.i[HIGH_HALF] < 0) { k = checkint(y); if (k==0) { if (qy == 0x7ff00000) { if (x == -1.0) return 1.0; else if (x > -1.0) return v.i[HIGH_HALF] < 0 ? INF.x : 0.0; else return v.i[HIGH_HALF] < 0 ? 0.0 : INF.x; } else if (qx == 0x7ff00000) return y < 0 ? 0.0 : INF.x; return NaNQ.x; /* y not integer and x<0 */ } else if (qx == 0x7ff00000) { if (k < 0) return y < 0 ? nZERO.x : nINF.x; else return y < 0 ? 0.0 : INF.x; } return (k==1)?__ieee754_pow(-x,y):-__ieee754_pow(-x,y); /* if y even or odd */ } /* x>0 */ if (qx == 0x7ff00000) /* x= 2^-0x3ff */ {if (y == 0) return NaNQ.x; return (y>0)?x:0; } if (qy > 0x45f00000 && qy < 0x7ff00000) { if (x == 1.0) return 1.0; if (y>0) return (x>1.0)?huge*huge:tiny*tiny; if (y<0) return (x<1.0)?huge*huge:tiny*tiny; } if (x == 1.0) return 1.0; if (y>0) return (x>1.0)?INF.x:0; if (y<0) return (x<1.0)?INF.x:0; return 0; /* unreachable, to make the compiler happy */ }
/* An ultimate power routine. Given two IEEE double machine numbers y, x it computes the correctly rounded (to nearest) value of X^y. */ double SECTION __ieee754_pow (double x, double y) { double z, a, aa, error, t, a1, a2, y1, y2; mynumber u, v; int k; int4 qx, qy; v.x = y; u.x = x; if (v.i[LOW_HALF] == 0) { /* of y */ qx = u.i[HIGH_HALF] & 0x7fffffff; /* Is x a NaN? */ if ((((qx == 0x7ff00000) && (u.i[LOW_HALF] != 0)) || (qx > 0x7ff00000)) && (y != 0 || issignaling (x))) return x + x; if (y == 1.0) return x; if (y == 2.0) return x * x; if (y == -1.0) return 1.0 / x; if (y == 0) return 1.0; } /* else */ if (((u.i[HIGH_HALF] > 0 && u.i[HIGH_HALF] < 0x7ff00000) || /* x>0 and not x->0 */ (u.i[HIGH_HALF] == 0 && u.i[LOW_HALF] != 0)) && /* 2^-1023< x<= 2^-1023 * 0x1.0000ffffffff */ (v.i[HIGH_HALF] & 0x7fffffff) < 0x4ff00000) { /* if y<-1 or y>1 */ double retval; { SET_RESTORE_ROUND (FE_TONEAREST); /* Avoid internal underflow for tiny y. The exact value of y does not matter if |y| <= 2**-64. */ if (fabs (y) < 0x1p-64) y = y < 0 ? -0x1p-64 : 0x1p-64; z = log1 (x, &aa, &error); /* x^y =e^(y log (X)) */ t = y * CN; y1 = t - (t - y); y2 = y - y1; t = z * CN; a1 = t - (t - z); a2 = (z - a1) + aa; a = y1 * a1; aa = y2 * a1 + y * a2; a1 = a + aa; a2 = (a - a1) + aa; error = error * fabs (y); t = __exp1 (a1, a2, 1.9e16 * error); /* return -10 or 0 if wasn't computed exactly */ retval = (t > 0) ? t : power1 (x, y); } if (isinf (retval)) retval = huge * huge; else if (retval == 0) retval = tiny * tiny; else math_check_force_underflow_nonneg (retval); return retval; } if (x == 0) { if (((v.i[HIGH_HALF] & 0x7fffffff) == 0x7ff00000 && v.i[LOW_HALF] != 0) || (v.i[HIGH_HALF] & 0x7fffffff) > 0x7ff00000) /* NaN */ return y + y; if (fabs (y) > 1.0e20) return (y > 0) ? 0 : 1.0 / 0.0; k = checkint (y); if (k == -1) return y < 0 ? 1.0 / x : x; else return y < 0 ? 1.0 / 0.0 : 0.0; /* return 0 */ } qx = u.i[HIGH_HALF] & 0x7fffffff; /* no sign */ qy = v.i[HIGH_HALF] & 0x7fffffff; /* no sign */ if (qx >= 0x7ff00000 && (qx > 0x7ff00000 || u.i[LOW_HALF] != 0)) /* NaN */ return x + y; if (qy >= 0x7ff00000 && (qy > 0x7ff00000 || v.i[LOW_HALF] != 0)) /* NaN */ return x == 1.0 && !issignaling (y) ? 1.0 : y + y; /* if x<0 */ if (u.i[HIGH_HALF] < 0) { k = checkint (y); if (k == 0) { if (qy == 0x7ff00000) { if (x == -1.0) return 1.0; else if (x > -1.0) return v.i[HIGH_HALF] < 0 ? INF.x : 0.0; else return v.i[HIGH_HALF] < 0 ? 0.0 : INF.x; } else if (qx == 0x7ff00000) return y < 0 ? 0.0 : INF.x; return (x - x) / (x - x); /* y not integer and x<0 */ } else if (qx == 0x7ff00000) { if (k < 0) return y < 0 ? nZERO.x : nINF.x; else return y < 0 ? 0.0 : INF.x; } /* if y even or odd */ if (k == 1) return __ieee754_pow (-x, y); else { double retval; { SET_RESTORE_ROUND (FE_TONEAREST); retval = -__ieee754_pow (-x, y); } if (isinf (retval)) retval = -huge * huge; else if (retval == 0) retval = -tiny * tiny; return retval; } } /* x>0 */ if (qx == 0x7ff00000) /* x= 2^-0x3ff */ return y > 0 ? x : 0; if (qy > 0x45f00000 && qy < 0x7ff00000) { if (x == 1.0) return 1.0; if (y > 0) return (x > 1.0) ? huge * huge : tiny * tiny; if (y < 0) return (x < 1.0) ? huge * huge : tiny * tiny; } if (x == 1.0) return 1.0; if (y > 0) return (x > 1.0) ? INF.x : 0; if (y < 0) return (x < 1.0) ? INF.x : 0; return 0; /* unreachable, to make the compiler happy */ }
double SECTION __ieee754_atan2 (double y, double x) { int i, de, ux, dx, uy, dy; static const int pr[MM] = { 6, 8, 10, 20, 32 }; double ax, ay, u, du, u9, ua, v, vv, dv, t1, t2, t3, t7, t8, z, zz, cor, s1, ss1, s2, ss2; #ifndef DLA_FMS double t4, t5, t6; #endif number num; static const int ep = 59768832, /* 57*16**5 */ em = -59768832; /* -57*16**5 */ /* x=NaN or y=NaN */ num.d = x; ux = num.i[HIGH_HALF]; dx = num.i[LOW_HALF]; if ((ux & 0x7ff00000) == 0x7ff00000) { if (((ux & 0x000fffff) | dx) != 0x00000000) return x + y; } num.d = y; uy = num.i[HIGH_HALF]; dy = num.i[LOW_HALF]; if ((uy & 0x7ff00000) == 0x7ff00000) { if (((uy & 0x000fffff) | dy) != 0x00000000) return y + y; } /* y=+-0 */ if (uy == 0x00000000) { if (dy == 0x00000000) { if ((ux & 0x80000000) == 0x00000000) return 0; else return opi.d; } } else if (uy == 0x80000000) { if (dy == 0x00000000) { if ((ux & 0x80000000) == 0x00000000) return -0.0; else return mopi.d; } } /* x=+-0 */ if (x == 0) { if ((uy & 0x80000000) == 0x00000000) return hpi.d; else return mhpi.d; } /* x=+-INF */ if (ux == 0x7ff00000) { if (dx == 0x00000000) { if (uy == 0x7ff00000) { if (dy == 0x00000000) return qpi.d; } else if (uy == 0xfff00000) { if (dy == 0x00000000) return mqpi.d; } else { if ((uy & 0x80000000) == 0x00000000) return 0; else return -0.0; } } } else if (ux == 0xfff00000) { if (dx == 0x00000000) { if (uy == 0x7ff00000) { if (dy == 0x00000000) return tqpi.d; } else if (uy == 0xfff00000) { if (dy == 0x00000000) return mtqpi.d; } else { if ((uy & 0x80000000) == 0x00000000) return opi.d; else return mopi.d; } } } /* y=+-INF */ if (uy == 0x7ff00000) { if (dy == 0x00000000) return hpi.d; } else if (uy == 0xfff00000) { if (dy == 0x00000000) return mhpi.d; } SET_RESTORE_ROUND (FE_TONEAREST); /* either x/y or y/x is very close to zero */ ax = (x < 0) ? -x : x; ay = (y < 0) ? -y : y; de = (uy & 0x7ff00000) - (ux & 0x7ff00000); if (de >= ep) { return ((y > 0) ? hpi.d : mhpi.d); } else if (de <= em) { if (x > 0) { double ret; if ((z = ay / ax) < TWOM1022) ret = normalized (ax, ay, y, z); else ret = signArctan2 (y, z); if (fabs (ret) < DBL_MIN) { double vret = ret ? ret : DBL_MIN; double force_underflow = vret * vret; math_force_eval (force_underflow); } return ret; } else { return ((y > 0) ? opi.d : mopi.d); } } /* if either x or y is extremely close to zero, scale abs(x), abs(y). */ if (ax < twom500.d || ay < twom500.d) { ax *= two500.d; ay *= two500.d; } /* Likewise for large x and y. */ if (ax > two500.d || ay > two500.d) { ax *= twom500.d; ay *= twom500.d; } /* x,y which are neither special nor extreme */ if (ay < ax) { u = ay / ax; EMULV (ax, u, v, vv, t1, t2, t3, t4, t5); du = ((ay - v) - vv) / ax; } else { u = ax / ay; EMULV (ay, u, v, vv, t1, t2, t3, t4, t5); du = ((ax - v) - vv) / ay; } if (x > 0) { /* (i) x>0, abs(y)< abs(x): atan(ay/ax) */ if (ay < ax) { if (u < inv16.d) { v = u * u; zz = du + u * v * (d3.d + v * (d5.d + v * (d7.d + v * (d9.d + v * (d11.d + v * d13.d))))); if ((z = u + (zz - u1.d * u)) == u + (zz + u1.d * u)) return signArctan2 (y, z); MUL2 (u, du, u, du, v, vv, t1, t2, t3, t4, t5, t6, t7, t8); s1 = v * (f11.d + v * (f13.d + v * (f15.d + v * (f17.d + v * f19.d)))); ADD2 (f9.d, ff9.d, s1, 0, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (f7.d, ff7.d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (f5.d, ff5.d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (f3.d, ff3.d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); MUL2 (u, du, s1, ss1, s2, ss2, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (u, du, s2, ss2, s1, ss1, t1, t2); if ((z = s1 + (ss1 - u5.d * s1)) == s1 + (ss1 + u5.d * s1)) return signArctan2 (y, z); return atan2Mp (x, y, pr); } i = (TWO52 + TWO8 * u) - TWO52; i -= 16; t3 = u - cij[i][0].d; EADD (t3, du, v, dv); t1 = cij[i][1].d; t2 = cij[i][2].d; zz = v * t2 + (dv * t2 + v * v * (cij[i][3].d + v * (cij[i][4].d + v * (cij[i][5].d + v * cij[i][6].d)))); if (i < 112) { if (i < 48) u9 = u91.d; /* u < 1/4 */ else u9 = u92.d; } /* 1/4 <= u < 1/2 */ else { if (i < 176) u9 = u93.d; /* 1/2 <= u < 3/4 */ else u9 = u94.d; } /* 3/4 <= u <= 1 */ if ((z = t1 + (zz - u9 * t1)) == t1 + (zz + u9 * t1)) return signArctan2 (y, z); t1 = u - hij[i][0].d; EADD (t1, du, v, vv); s1 = v * (hij[i][11].d + v * (hij[i][12].d + v * (hij[i][13].d + v * (hij[i][14].d + v * hij[i][15].d)))); ADD2 (hij[i][9].d, hij[i][10].d, s1, 0, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][7].d, hij[i][8].d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][5].d, hij[i][6].d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][3].d, hij[i][4].d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][1].d, hij[i][2].d, s1, ss1, s2, ss2, t1, t2); if ((z = s2 + (ss2 - ub.d * s2)) == s2 + (ss2 + ub.d * s2)) return signArctan2 (y, z); return atan2Mp (x, y, pr); } /* (ii) x>0, abs(x)<=abs(y): pi/2-atan(ax/ay) */ if (u < inv16.d) { v = u * u; zz = u * v * (d3.d + v * (d5.d + v * (d7.d + v * (d9.d + v * (d11.d + v * d13.d))))); ESUB (hpi.d, u, t2, cor); t3 = ((hpi1.d + cor) - du) - zz; if ((z = t2 + (t3 - u2.d)) == t2 + (t3 + u2.d)) return signArctan2 (y, z); MUL2 (u, du, u, du, v, vv, t1, t2, t3, t4, t5, t6, t7, t8); s1 = v * (f11.d + v * (f13.d + v * (f15.d + v * (f17.d + v * f19.d)))); ADD2 (f9.d, ff9.d, s1, 0, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (f7.d, ff7.d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (f5.d, ff5.d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (f3.d, ff3.d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); MUL2 (u, du, s1, ss1, s2, ss2, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (u, du, s2, ss2, s1, ss1, t1, t2); SUB2 (hpi.d, hpi1.d, s1, ss1, s2, ss2, t1, t2); if ((z = s2 + (ss2 - u6.d)) == s2 + (ss2 + u6.d)) return signArctan2 (y, z); return atan2Mp (x, y, pr); } i = (TWO52 + TWO8 * u) - TWO52; i -= 16; v = (u - cij[i][0].d) + du; zz = hpi1.d - v * (cij[i][2].d + v * (cij[i][3].d + v * (cij[i][4].d + v * (cij[i][5].d + v * cij[i][6].d)))); t1 = hpi.d - cij[i][1].d; if (i < 112) ua = ua1.d; /* w < 1/2 */ else ua = ua2.d; /* w >= 1/2 */ if ((z = t1 + (zz - ua)) == t1 + (zz + ua)) return signArctan2 (y, z); t1 = u - hij[i][0].d; EADD (t1, du, v, vv); s1 = v * (hij[i][11].d + v * (hij[i][12].d + v * (hij[i][13].d + v * (hij[i][14].d + v * hij[i][15].d)))); ADD2 (hij[i][9].d, hij[i][10].d, s1, 0, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][7].d, hij[i][8].d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][5].d, hij[i][6].d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][3].d, hij[i][4].d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][1].d, hij[i][2].d, s1, ss1, s2, ss2, t1, t2); SUB2 (hpi.d, hpi1.d, s2, ss2, s1, ss1, t1, t2); if ((z = s1 + (ss1 - uc.d)) == s1 + (ss1 + uc.d)) return signArctan2 (y, z); return atan2Mp (x, y, pr); } /* (iii) x<0, abs(x)< abs(y): pi/2+atan(ax/ay) */ if (ax < ay) { if (u < inv16.d) { v = u * u; zz = u * v * (d3.d + v * (d5.d + v * (d7.d + v * (d9.d + v * (d11.d + v * d13.d))))); EADD (hpi.d, u, t2, cor); t3 = ((hpi1.d + cor) + du) + zz; if ((z = t2 + (t3 - u3.d)) == t2 + (t3 + u3.d)) return signArctan2 (y, z); MUL2 (u, du, u, du, v, vv, t1, t2, t3, t4, t5, t6, t7, t8); s1 = v * (f11.d + v * (f13.d + v * (f15.d + v * (f17.d + v * f19.d)))); ADD2 (f9.d, ff9.d, s1, 0, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (f7.d, ff7.d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (f5.d, ff5.d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (f3.d, ff3.d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); MUL2 (u, du, s1, ss1, s2, ss2, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (u, du, s2, ss2, s1, ss1, t1, t2); ADD2 (hpi.d, hpi1.d, s1, ss1, s2, ss2, t1, t2); if ((z = s2 + (ss2 - u7.d)) == s2 + (ss2 + u7.d)) return signArctan2 (y, z); return atan2Mp (x, y, pr); } i = (TWO52 + TWO8 * u) - TWO52; i -= 16; v = (u - cij[i][0].d) + du; zz = hpi1.d + v * (cij[i][2].d + v * (cij[i][3].d + v * (cij[i][4].d + v * (cij[i][5].d + v * cij[i][6].d)))); t1 = hpi.d + cij[i][1].d; if (i < 112) ua = ua1.d; /* w < 1/2 */ else ua = ua2.d; /* w >= 1/2 */ if ((z = t1 + (zz - ua)) == t1 + (zz + ua)) return signArctan2 (y, z); t1 = u - hij[i][0].d; EADD (t1, du, v, vv); s1 = v * (hij[i][11].d + v * (hij[i][12].d + v * (hij[i][13].d + v * (hij[i][14].d + v * hij[i][15].d)))); ADD2 (hij[i][9].d, hij[i][10].d, s1, 0, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][7].d, hij[i][8].d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][5].d, hij[i][6].d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][3].d, hij[i][4].d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][1].d, hij[i][2].d, s1, ss1, s2, ss2, t1, t2); ADD2 (hpi.d, hpi1.d, s2, ss2, s1, ss1, t1, t2); if ((z = s1 + (ss1 - uc.d)) == s1 + (ss1 + uc.d)) return signArctan2 (y, z); return atan2Mp (x, y, pr); } /* (iv) x<0, abs(y)<=abs(x): pi-atan(ax/ay) */ if (u < inv16.d) { v = u * u; zz = u * v * (d3.d + v * (d5.d + v * (d7.d + v * (d9.d + v * (d11.d + v * d13.d))))); ESUB (opi.d, u, t2, cor); t3 = ((opi1.d + cor) - du) - zz; if ((z = t2 + (t3 - u4.d)) == t2 + (t3 + u4.d)) return signArctan2 (y, z); MUL2 (u, du, u, du, v, vv, t1, t2, t3, t4, t5, t6, t7, t8); s1 = v * (f11.d + v * (f13.d + v * (f15.d + v * (f17.d + v * f19.d)))); ADD2 (f9.d, ff9.d, s1, 0, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (f7.d, ff7.d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (f5.d, ff5.d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (f3.d, ff3.d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); MUL2 (u, du, s1, ss1, s2, ss2, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (u, du, s2, ss2, s1, ss1, t1, t2); SUB2 (opi.d, opi1.d, s1, ss1, s2, ss2, t1, t2); if ((z = s2 + (ss2 - u8.d)) == s2 + (ss2 + u8.d)) return signArctan2 (y, z); return atan2Mp (x, y, pr); } i = (TWO52 + TWO8 * u) - TWO52; i -= 16; v = (u - cij[i][0].d) + du; zz = opi1.d - v * (cij[i][2].d + v * (cij[i][3].d + v * (cij[i][4].d + v * (cij[i][5].d + v * cij[i][6].d)))); t1 = opi.d - cij[i][1].d; if (i < 112) ua = ua1.d; /* w < 1/2 */ else ua = ua2.d; /* w >= 1/2 */ if ((z = t1 + (zz - ua)) == t1 + (zz + ua)) return signArctan2 (y, z); t1 = u - hij[i][0].d; EADD (t1, du, v, vv); s1 = v * (hij[i][11].d + v * (hij[i][12].d + v * (hij[i][13].d + v * (hij[i][14].d + v * hij[i][15].d)))); ADD2 (hij[i][9].d, hij[i][10].d, s1, 0, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][7].d, hij[i][8].d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][5].d, hij[i][6].d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][3].d, hij[i][4].d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][1].d, hij[i][2].d, s1, ss1, s2, ss2, t1, t2); SUB2 (opi.d, opi1.d, s2, ss2, s1, ss1, t1, t2); if ((z = s1 + (ss1 - uc.d)) == s1 + (ss1 + uc.d)) return signArctan2 (y, z); return atan2Mp (x, y, pr); }
/* routine computes the correctly rounded (to nearest) value of atan(x). */ double atan (double x) { double cor, s1, ss1, s2, ss2, t1, t2, t3, t7, t8, t9, t10, u, u2, u3, v, vv, w, ww, y, yy, z, zz; #ifndef DLA_FMS double t4, t5, t6; #endif int i, ux, dx; static const int pr[M] = { 6, 8, 10, 32 }; number num; num.d = x; ux = num.i[HIGH_HALF]; dx = num.i[LOW_HALF]; /* x=NaN */ if (((ux & 0x7ff00000) == 0x7ff00000) && (((ux & 0x000fffff) | dx) != 0x00000000)) return x + x; /* Regular values of x, including denormals +-0 and +-INF */ SET_RESTORE_ROUND (FE_TONEAREST); u = (x < 0) ? -x : x; if (u < C) { if (u < B) { if (u < A) { math_check_force_underflow_nonneg (u); return x; } else { /* A <= u < B */ v = x * x; yy = d11.d + v * d13.d; yy = d9.d + v * yy; yy = d7.d + v * yy; yy = d5.d + v * yy; yy = d3.d + v * yy; yy *= x * v; if ((y = x + (yy - U1 * x)) == x + (yy + U1 * x)) return y; EMULV (x, x, v, vv, t1, t2, t3, t4, t5); /* v+vv=x^2 */ s1 = f17.d + v * f19.d; s1 = f15.d + v * s1; s1 = f13.d + v * s1; s1 = f11.d + v * s1; s1 *= v; ADD2 (f9.d, ff9.d, s1, 0, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (f7.d, ff7.d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (f5.d, ff5.d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (f3.d, ff3.d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); MUL2 (x, 0, s1, ss1, s2, ss2, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (x, 0, s2, ss2, s1, ss1, t1, t2); if ((y = s1 + (ss1 - U5 * s1)) == s1 + (ss1 + U5 * s1)) return y; return atanMp (x, pr); } } else { /* B <= u < C */ i = (TWO52 + TWO8 * u) - TWO52; i -= 16; z = u - cij[i][0].d; yy = cij[i][5].d + z * cij[i][6].d; yy = cij[i][4].d + z * yy; yy = cij[i][3].d + z * yy; yy = cij[i][2].d + z * yy; yy *= z; t1 = cij[i][1].d; if (i < 112) { if (i < 48) u2 = U21; /* u < 1/4 */ else u2 = U22; } /* 1/4 <= u < 1/2 */ else { if (i < 176) u2 = U23; /* 1/2 <= u < 3/4 */ else u2 = U24; } /* 3/4 <= u <= 1 */ if ((y = t1 + (yy - u2 * t1)) == t1 + (yy + u2 * t1)) return __signArctan (x, y); z = u - hij[i][0].d; s1 = hij[i][14].d + z * hij[i][15].d; s1 = hij[i][13].d + z * s1; s1 = hij[i][12].d + z * s1; s1 = hij[i][11].d + z * s1; s1 *= z; ADD2 (hij[i][9].d, hij[i][10].d, s1, 0, s2, ss2, t1, t2); MUL2 (z, 0, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][7].d, hij[i][8].d, s1, ss1, s2, ss2, t1, t2); MUL2 (z, 0, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][5].d, hij[i][6].d, s1, ss1, s2, ss2, t1, t2); MUL2 (z, 0, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][3].d, hij[i][4].d, s1, ss1, s2, ss2, t1, t2); MUL2 (z, 0, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][1].d, hij[i][2].d, s1, ss1, s2, ss2, t1, t2); if ((y = s2 + (ss2 - U6 * s2)) == s2 + (ss2 + U6 * s2)) return __signArctan (x, y); return atanMp (x, pr); } } else { if (u < D) { /* C <= u < D */ w = 1 / u; EMULV (w, u, t1, t2, t3, t4, t5, t6, t7); ww = w * ((1 - t1) - t2); i = (TWO52 + TWO8 * w) - TWO52; i -= 16; z = (w - cij[i][0].d) + ww; yy = cij[i][5].d + z * cij[i][6].d; yy = cij[i][4].d + z * yy; yy = cij[i][3].d + z * yy; yy = cij[i][2].d + z * yy; yy = HPI1 - z * yy; t1 = HPI - cij[i][1].d; if (i < 112) u3 = U31; /* w < 1/2 */ else u3 = U32; /* w >= 1/2 */ if ((y = t1 + (yy - u3)) == t1 + (yy + u3)) return __signArctan (x, y); DIV2 (1, 0, u, 0, w, ww, t1, t2, t3, t4, t5, t6, t7, t8, t9, t10); t1 = w - hij[i][0].d; EADD (t1, ww, z, zz); s1 = hij[i][14].d + z * hij[i][15].d; s1 = hij[i][13].d + z * s1; s1 = hij[i][12].d + z * s1; s1 = hij[i][11].d + z * s1; s1 *= z; ADD2 (hij[i][9].d, hij[i][10].d, s1, 0, s2, ss2, t1, t2); MUL2 (z, zz, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][7].d, hij[i][8].d, s1, ss1, s2, ss2, t1, t2); MUL2 (z, zz, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][5].d, hij[i][6].d, s1, ss1, s2, ss2, t1, t2); MUL2 (z, zz, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][3].d, hij[i][4].d, s1, ss1, s2, ss2, t1, t2); MUL2 (z, zz, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (hij[i][1].d, hij[i][2].d, s1, ss1, s2, ss2, t1, t2); SUB2 (HPI, HPI1, s2, ss2, s1, ss1, t1, t2); if ((y = s1 + (ss1 - U7)) == s1 + (ss1 + U7)) return __signArctan (x, y); return atanMp (x, pr); } else { if (u < E) { /* D <= u < E */ w = 1 / u; v = w * w; EMULV (w, u, t1, t2, t3, t4, t5, t6, t7); yy = d11.d + v * d13.d; yy = d9.d + v * yy; yy = d7.d + v * yy; yy = d5.d + v * yy; yy = d3.d + v * yy; yy *= w * v; ww = w * ((1 - t1) - t2); ESUB (HPI, w, t3, cor); yy = ((HPI1 + cor) - ww) - yy; if ((y = t3 + (yy - U4)) == t3 + (yy + U4)) return __signArctan (x, y); DIV2 (1, 0, u, 0, w, ww, t1, t2, t3, t4, t5, t6, t7, t8, t9, t10); MUL2 (w, ww, w, ww, v, vv, t1, t2, t3, t4, t5, t6, t7, t8); s1 = f17.d + v * f19.d; s1 = f15.d + v * s1; s1 = f13.d + v * s1; s1 = f11.d + v * s1; s1 *= v; ADD2 (f9.d, ff9.d, s1, 0, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (f7.d, ff7.d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (f5.d, ff5.d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (f3.d, ff3.d, s1, ss1, s2, ss2, t1, t2); MUL2 (v, vv, s2, ss2, s1, ss1, t1, t2, t3, t4, t5, t6, t7, t8); MUL2 (w, ww, s1, ss1, s2, ss2, t1, t2, t3, t4, t5, t6, t7, t8); ADD2 (w, ww, s2, ss2, s1, ss1, t1, t2); SUB2 (HPI, HPI1, s1, ss1, s2, ss2, t1, t2); if ((y = s2 + (ss2 - U8)) == s2 + (ss2 + U8)) return __signArctan (x, y); return atanMp (x, pr); } else { /* u >= E */ if (x > 0) return HPI; else return MHPI; } } } }