13e12c5d1SDavid du Colombier #include <math.h> 23e12c5d1SDavid du Colombier #include <errno.h> 33e12c5d1SDavid du Colombier #define _RESEARCH_SOURCE 43e12c5d1SDavid du Colombier #include <float.h> 53e12c5d1SDavid du Colombier 63e12c5d1SDavid du Colombier #define MASK 0x7ffL 73e12c5d1SDavid du Colombier #define SHIFT 20 83e12c5d1SDavid du Colombier #define BIAS 1022L 9eaba85aaSDavid du Colombier #define SIG 52 103e12c5d1SDavid du Colombier 113e12c5d1SDavid du Colombier typedef union 123e12c5d1SDavid du Colombier { 133e12c5d1SDavid du Colombier double d; 143e12c5d1SDavid du Colombier struct 153e12c5d1SDavid du Colombier { 163e12c5d1SDavid du Colombier #ifdef IEEE_8087 173e12c5d1SDavid du Colombier long ls; 183e12c5d1SDavid du Colombier long ms; 193e12c5d1SDavid du Colombier #else 203e12c5d1SDavid du Colombier long ms; 213e12c5d1SDavid du Colombier long ls; 223e12c5d1SDavid du Colombier #endif 233e12c5d1SDavid du Colombier }; 243e12c5d1SDavid du Colombier } Cheat; 253e12c5d1SDavid du Colombier 263e12c5d1SDavid du Colombier double frexp(double d,int * ep)273e12c5d1SDavid du Colombierfrexp(double d, int *ep) 283e12c5d1SDavid du Colombier { 29eaba85aaSDavid du Colombier Cheat x, a; 303e12c5d1SDavid du Colombier 313e12c5d1SDavid du Colombier *ep = 0; 32eaba85aaSDavid du Colombier /* order matters: only isNaN can operate on NaN */ 33eaba85aaSDavid du Colombier if(isNaN(d) || isInf(d, 0) || d == 0) 34eaba85aaSDavid du Colombier return d; 353e12c5d1SDavid du Colombier x.d = d; 36eaba85aaSDavid du Colombier a.d = fabs(d); 37eaba85aaSDavid du Colombier if((a.ms >> SHIFT) == 0){ /* normalize subnormal numbers */ 38eaba85aaSDavid du Colombier x.d = (double)(1ULL<<SIG) * d; 39eaba85aaSDavid du Colombier *ep = -SIG; 40eaba85aaSDavid du Colombier } 413e12c5d1SDavid du Colombier *ep = ((x.ms >> SHIFT) & MASK) - BIAS; 423e12c5d1SDavid du Colombier x.ms &= ~(MASK << SHIFT); 433e12c5d1SDavid du Colombier x.ms |= BIAS << SHIFT; 443e12c5d1SDavid du Colombier return x.d; 453e12c5d1SDavid du Colombier } 463e12c5d1SDavid du Colombier 473e12c5d1SDavid du Colombier double ldexp(double d,int e)483e12c5d1SDavid du Colombierldexp(double d, int e) 493e12c5d1SDavid du Colombier { 503e12c5d1SDavid du Colombier Cheat x; 513e12c5d1SDavid du Colombier 523e12c5d1SDavid du Colombier if(d == 0) 533e12c5d1SDavid du Colombier return 0; 543e12c5d1SDavid du Colombier x.d = d; 553e12c5d1SDavid du Colombier e += (x.ms >> SHIFT) & MASK; 563e12c5d1SDavid du Colombier if(e <= 0) 573e12c5d1SDavid du Colombier return 0; 583e12c5d1SDavid du Colombier if(e >= MASK){ 593e12c5d1SDavid du Colombier errno = ERANGE; 603e12c5d1SDavid du Colombier if(d < 0) 613e12c5d1SDavid du Colombier return -HUGE_VAL; 623e12c5d1SDavid du Colombier return HUGE_VAL; 633e12c5d1SDavid du Colombier } 643e12c5d1SDavid du Colombier x.ms &= ~(MASK << SHIFT); 653e12c5d1SDavid du Colombier x.ms |= (long)e << SHIFT; 663e12c5d1SDavid du Colombier return x.d; 673e12c5d1SDavid du Colombier } 683e12c5d1SDavid du Colombier 693e12c5d1SDavid du Colombier double modf(double d,double * ip)703e12c5d1SDavid du Colombiermodf(double d, double *ip) 713e12c5d1SDavid du Colombier { 72bd389b36SDavid du Colombier double f; 733e12c5d1SDavid du Colombier Cheat x; 743e12c5d1SDavid du Colombier int e; 753e12c5d1SDavid du Colombier 76*f1b2ee28SDavid du Colombier x.d = d; 77*f1b2ee28SDavid du Colombier e = (x.ms >> SHIFT) & MASK; 78*f1b2ee28SDavid du Colombier if(e == MASK){ 79*f1b2ee28SDavid du Colombier *ip = d; 80*f1b2ee28SDavid du Colombier if(x.ls != 0 || (x.ms & 0xfffffL) != 0) /* NaN */ 81*f1b2ee28SDavid du Colombier return d; 82*f1b2ee28SDavid du Colombier /* ±Inf */ 83*f1b2ee28SDavid du Colombier x.ms &= 0x80000000L; 84*f1b2ee28SDavid du Colombier return x.d; 85*f1b2ee28SDavid du Colombier } 863e12c5d1SDavid du Colombier if(d < 1) { 87bd389b36SDavid du Colombier if(d < 0) { 88bd389b36SDavid du Colombier f = modf(-d, ip); 89bd389b36SDavid du Colombier *ip = -*ip; 90bd389b36SDavid du Colombier return -f; 91bd389b36SDavid du Colombier } 923e12c5d1SDavid du Colombier *ip = 0; 933e12c5d1SDavid du Colombier return d; 943e12c5d1SDavid du Colombier } 95*f1b2ee28SDavid du Colombier e -= BIAS; 963e12c5d1SDavid du Colombier if(e <= SHIFT+1) { 973e12c5d1SDavid du Colombier x.ms &= ~(0x1fffffL >> e); 983e12c5d1SDavid du Colombier x.ls = 0; 993e12c5d1SDavid du Colombier } else 1003e12c5d1SDavid du Colombier if(e <= SHIFT+33) 1013e12c5d1SDavid du Colombier x.ls &= ~(0x7fffffffL >> (e-SHIFT-2)); 1023e12c5d1SDavid du Colombier *ip = x.d; 1033e12c5d1SDavid du Colombier return d - x.d; 1043e12c5d1SDavid du Colombier } 105