xref: /plan9-contrib/sys/src/ape/lib/ap/plan9/frexp.c (revision f1b2ee28c1dcb21e637a95dfec1fecc82992b275)
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 Colombier frexp(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 Colombier ldexp(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 Colombier modf(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