s_modfl.c revision 285830
1193156Snwhitehorn/*-
2193156Snwhitehorn * Copyright (c) 2007 David Schultz <das@FreeBSD.ORG>
3193156Snwhitehorn * All rights reserved.
4193156Snwhitehorn *
5193156Snwhitehorn * Redistribution and use in source and binary forms, with or without
6193156Snwhitehorn * modification, are permitted provided that the following conditions
7193156Snwhitehorn * are met:
8193156Snwhitehorn * 1. Redistributions of source code must retain the above copyright
9193156Snwhitehorn *    notice, this list of conditions and the following disclaimer.
10193156Snwhitehorn * 2. Redistributions in binary form must reproduce the above copyright
11193156Snwhitehorn *    notice, this list of conditions and the following disclaimer in the
12193156Snwhitehorn *    documentation and/or other materials provided with the distribution.
13193156Snwhitehorn *
14193156Snwhitehorn * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
15193156Snwhitehorn * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
16193156Snwhitehorn * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
17193156Snwhitehorn * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
18193156Snwhitehorn * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
19193156Snwhitehorn * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
20193156Snwhitehorn * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
21193156Snwhitehorn * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
22193156Snwhitehorn * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
23193156Snwhitehorn * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
24193156Snwhitehorn * SUCH DAMAGE.
25193156Snwhitehorn *
26227843Smarius * Derived from s_modf.c, which has the following Copyright:
27227843Smarius * ====================================================
28227843Smarius * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
29193156Snwhitehorn *
30193156Snwhitehorn * Developed at SunPro, a Sun Microsystems, Inc. business.
31193156Snwhitehorn * Permission to use, copy, modify, and distribute this
32193156Snwhitehorn * software is freely granted, provided that this notice
33193156Snwhitehorn * is preserved.
34193156Snwhitehorn * ====================================================
35193156Snwhitehorn *
36193156Snwhitehorn * $FreeBSD: releng/10.2/lib/msun/src/s_modfl.c 165855 2007-01-07 07:54:21Z das $
37193156Snwhitehorn */
38193156Snwhitehorn
39193156Snwhitehorn#include <float.h>
40193156Snwhitehorn#include <math.h>
41193156Snwhitehorn#include <sys/types.h>
42193156Snwhitehorn
43193156Snwhitehorn#include "fpmath.h"
44193156Snwhitehorn
45193156Snwhitehorn#if LDBL_MANL_SIZE > 32
46193156Snwhitehorn#define	MASK	((uint64_t)-1)
47193156Snwhitehorn#else
48193156Snwhitehorn#define	MASK	((uint32_t)-1)
49193156Snwhitehorn#endif
50193156Snwhitehorn/* Return the last n bits of a word, representing the fractional part. */
51193156Snwhitehorn#define	GETFRAC(bits, n)	((bits) & ~(MASK << (n)))
52193156Snwhitehorn/* The number of fraction bits in manh, not counting the integer bit */
53193156Snwhitehorn#define	HIBITS	(LDBL_MANT_DIG - LDBL_MANL_SIZE)
54193156Snwhitehorn
55193156Snwhitehornstatic const long double zero[] = { 0.0L, -0.0L };
56193156Snwhitehorn
57193156Snwhitehornlong double
58193156Snwhitehornmodfl(long double x, long double *iptr)
59193156Snwhitehorn{
60193156Snwhitehorn	union IEEEl2bits ux;
61193156Snwhitehorn	int e;
62193156Snwhitehorn
63193156Snwhitehorn	ux.e = x;
64193156Snwhitehorn	e = ux.bits.exp - LDBL_MAX_EXP + 1;
65193156Snwhitehorn	if (e < HIBITS) {			/* Integer part is in manh. */
66227843Smarius		if (e < 0) {			/* |x|<1 */
67193156Snwhitehorn			*iptr = zero[ux.bits.sign];
68193156Snwhitehorn			return (x);
69193156Snwhitehorn		} else {
70193156Snwhitehorn			if ((GETFRAC(ux.bits.manh, HIBITS - 1 - e) |
71193156Snwhitehorn			     ux.bits.manl) == 0) {	/* X is an integer. */
72193156Snwhitehorn				*iptr = x;
73193156Snwhitehorn				return (zero[ux.bits.sign]);
74193156Snwhitehorn			} else {
75193156Snwhitehorn				/* Clear all but the top e+1 bits. */
76193156Snwhitehorn				ux.bits.manh >>= HIBITS - 1 - e;
77193156Snwhitehorn				ux.bits.manh <<= HIBITS - 1 - e;
78193156Snwhitehorn				ux.bits.manl = 0;
79193156Snwhitehorn				*iptr = ux.e;
80193156Snwhitehorn				return (x - ux.e);
81193156Snwhitehorn			}
82193156Snwhitehorn		}
83193156Snwhitehorn	} else if (e >= LDBL_MANT_DIG - 1) {	/* x has no fraction part. */
84193156Snwhitehorn		*iptr = x;
85193156Snwhitehorn		if (x != x)			/* Handle NaNs. */
86193156Snwhitehorn			return (x);
87193156Snwhitehorn		return (zero[ux.bits.sign]);
88193156Snwhitehorn	} else {				/* Fraction part is in manl. */
89193156Snwhitehorn		if (GETFRAC(ux.bits.manl, LDBL_MANT_DIG - 1 - e) == 0) {
90193156Snwhitehorn			/* x is integral. */
91193156Snwhitehorn			*iptr = x;
92193156Snwhitehorn			return (zero[ux.bits.sign]);
93193156Snwhitehorn		} else {
94193156Snwhitehorn			/* Clear all but the top e+1 bits. */
95193156Snwhitehorn			ux.bits.manl >>= LDBL_MANT_DIG - 1 - e;
96193156Snwhitehorn			ux.bits.manl <<= LDBL_MANT_DIG - 1 - e;
97193156Snwhitehorn			*iptr = ux.e;
98193156Snwhitehorn			return (x - ux.e);
99193156Snwhitehorn		}
100193156Snwhitehorn	}
101193156Snwhitehorn}
102193156Snwhitehorn