dfrem.c revision 1.1 1 1.1 fredette /* $NetBSD: dfrem.c,v 1.1 2002/06/05 01:04:24 fredette Exp $ */
2 1.1 fredette
3 1.1 fredette /* $OpenBSD: dfrem.c,v 1.4 2001/03/29 03:58:17 mickey Exp $ */
4 1.1 fredette
5 1.1 fredette /*
6 1.1 fredette * Copyright 1996 1995 by Open Software Foundation, Inc.
7 1.1 fredette * All Rights Reserved
8 1.1 fredette *
9 1.1 fredette * Permission to use, copy, modify, and distribute this software and
10 1.1 fredette * its documentation for any purpose and without fee is hereby granted,
11 1.1 fredette * provided that the above copyright notice appears in all copies and
12 1.1 fredette * that both the copyright notice and this permission notice appear in
13 1.1 fredette * supporting documentation.
14 1.1 fredette *
15 1.1 fredette * OSF DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE
16 1.1 fredette * INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
17 1.1 fredette * FOR A PARTICULAR PURPOSE.
18 1.1 fredette *
19 1.1 fredette * IN NO EVENT SHALL OSF BE LIABLE FOR ANY SPECIAL, INDIRECT, OR
20 1.1 fredette * CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
21 1.1 fredette * LOSS OF USE, DATA OR PROFITS, WHETHER IN ACTION OF CONTRACT,
22 1.1 fredette * NEGLIGENCE, OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION
23 1.1 fredette * WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
24 1.1 fredette *
25 1.1 fredette */
26 1.1 fredette /*
27 1.1 fredette * pmk1.1
28 1.1 fredette */
29 1.1 fredette /*
30 1.1 fredette * (c) Copyright 1986 HEWLETT-PACKARD COMPANY
31 1.1 fredette *
32 1.1 fredette * To anyone who acknowledges that this file is provided "AS IS"
33 1.1 fredette * without any express or implied warranty:
34 1.1 fredette * permission to use, copy, modify, and distribute this file
35 1.1 fredette * for any purpose is hereby granted without fee, provided that
36 1.1 fredette * the above copyright notice and this notice appears in all
37 1.1 fredette * copies, and that the name of Hewlett-Packard Company not be
38 1.1 fredette * used in advertising or publicity pertaining to distribution
39 1.1 fredette * of the software without specific, written prior permission.
40 1.1 fredette * Hewlett-Packard Company makes no representations about the
41 1.1 fredette * suitability of this software for any purpose.
42 1.1 fredette */
43 1.1 fredette
44 1.1 fredette
45 1.1 fredette #include "../spmath/float.h"
46 1.1 fredette #include "../spmath/dbl_float.h"
47 1.1 fredette
48 1.1 fredette /*
49 1.1 fredette * Double Precision Floating-point Remainder
50 1.1 fredette */
51 1.1 fredette int
52 1.1 fredette dbl_frem(srcptr1,srcptr2,dstptr,status)
53 1.1 fredette
54 1.1 fredette dbl_floating_point *srcptr1, *srcptr2, *dstptr;
55 1.1 fredette unsigned int *status;
56 1.1 fredette {
57 1.1 fredette register unsigned int opnd1p1, opnd1p2, opnd2p1, opnd2p2;
58 1.1 fredette register unsigned int resultp1, resultp2;
59 1.1 fredette register int opnd1_exponent, opnd2_exponent, dest_exponent, stepcount;
60 1.1 fredette register int roundup = FALSE;
61 1.1 fredette
62 1.1 fredette Dbl_copyfromptr(srcptr1,opnd1p1,opnd1p2);
63 1.1 fredette Dbl_copyfromptr(srcptr2,opnd2p1,opnd2p2);
64 1.1 fredette /*
65 1.1 fredette * check first operand for NaN's or infinity
66 1.1 fredette */
67 1.1 fredette if ((opnd1_exponent = Dbl_exponent(opnd1p1)) == DBL_INFINITY_EXPONENT) {
68 1.1 fredette if (Dbl_iszero_mantissa(opnd1p1,opnd1p2)) {
69 1.1 fredette if (Dbl_isnotnan(opnd2p1,opnd2p2)) {
70 1.1 fredette /* invalid since first operand is infinity */
71 1.1 fredette if (Is_invalidtrap_enabled())
72 1.1 fredette return(INVALIDEXCEPTION);
73 1.1 fredette Set_invalidflag();
74 1.1 fredette Dbl_makequietnan(resultp1,resultp2);
75 1.1 fredette Dbl_copytoptr(resultp1,resultp2,dstptr);
76 1.1 fredette return(NOEXCEPTION);
77 1.1 fredette }
78 1.1 fredette }
79 1.1 fredette else {
80 1.1 fredette /*
81 1.1 fredette * is NaN; signaling or quiet?
82 1.1 fredette */
83 1.1 fredette if (Dbl_isone_signaling(opnd1p1)) {
84 1.1 fredette /* trap if INVALIDTRAP enabled */
85 1.1 fredette if (Is_invalidtrap_enabled())
86 1.1 fredette return(INVALIDEXCEPTION);
87 1.1 fredette /* make NaN quiet */
88 1.1 fredette Set_invalidflag();
89 1.1 fredette Dbl_set_quiet(opnd1p1);
90 1.1 fredette }
91 1.1 fredette /*
92 1.1 fredette * is second operand a signaling NaN?
93 1.1 fredette */
94 1.1 fredette else if (Dbl_is_signalingnan(opnd2p1)) {
95 1.1 fredette /* trap if INVALIDTRAP enabled */
96 1.1 fredette if (Is_invalidtrap_enabled())
97 1.1 fredette return(INVALIDEXCEPTION);
98 1.1 fredette /* make NaN quiet */
99 1.1 fredette Set_invalidflag();
100 1.1 fredette Dbl_set_quiet(opnd2p1);
101 1.1 fredette Dbl_copytoptr(opnd2p1,opnd2p2,dstptr);
102 1.1 fredette return(NOEXCEPTION);
103 1.1 fredette }
104 1.1 fredette /*
105 1.1 fredette * return quiet NaN
106 1.1 fredette */
107 1.1 fredette Dbl_copytoptr(opnd1p1,opnd1p2,dstptr);
108 1.1 fredette return(NOEXCEPTION);
109 1.1 fredette }
110 1.1 fredette }
111 1.1 fredette /*
112 1.1 fredette * check second operand for NaN's or infinity
113 1.1 fredette */
114 1.1 fredette if ((opnd2_exponent = Dbl_exponent(opnd2p1)) == DBL_INFINITY_EXPONENT) {
115 1.1 fredette if (Dbl_iszero_mantissa(opnd2p1,opnd2p2)) {
116 1.1 fredette /*
117 1.1 fredette * return first operand
118 1.1 fredette */
119 1.1 fredette Dbl_copytoptr(opnd1p1,opnd1p2,dstptr);
120 1.1 fredette return(NOEXCEPTION);
121 1.1 fredette }
122 1.1 fredette /*
123 1.1 fredette * is NaN; signaling or quiet?
124 1.1 fredette */
125 1.1 fredette if (Dbl_isone_signaling(opnd2p1)) {
126 1.1 fredette /* trap if INVALIDTRAP enabled */
127 1.1 fredette if (Is_invalidtrap_enabled()) return(INVALIDEXCEPTION);
128 1.1 fredette /* make NaN quiet */
129 1.1 fredette Set_invalidflag();
130 1.1 fredette Dbl_set_quiet(opnd2p1);
131 1.1 fredette }
132 1.1 fredette /*
133 1.1 fredette * return quiet NaN
134 1.1 fredette */
135 1.1 fredette Dbl_copytoptr(opnd2p1,opnd2p2,dstptr);
136 1.1 fredette return(NOEXCEPTION);
137 1.1 fredette }
138 1.1 fredette /*
139 1.1 fredette * check second operand for zero
140 1.1 fredette */
141 1.1 fredette if (Dbl_iszero_exponentmantissa(opnd2p1,opnd2p2)) {
142 1.1 fredette /* invalid since second operand is zero */
143 1.1 fredette if (Is_invalidtrap_enabled()) return(INVALIDEXCEPTION);
144 1.1 fredette Set_invalidflag();
145 1.1 fredette Dbl_makequietnan(resultp1,resultp2);
146 1.1 fredette Dbl_copytoptr(resultp1,resultp2,dstptr);
147 1.1 fredette return(NOEXCEPTION);
148 1.1 fredette }
149 1.1 fredette
150 1.1 fredette /*
151 1.1 fredette * get sign of result
152 1.1 fredette */
153 1.1 fredette resultp1 = opnd1p1;
154 1.1 fredette
155 1.1 fredette /*
156 1.1 fredette * check for denormalized operands
157 1.1 fredette */
158 1.1 fredette if (opnd1_exponent == 0) {
159 1.1 fredette /* check for zero */
160 1.1 fredette if (Dbl_iszero_mantissa(opnd1p1,opnd1p2)) {
161 1.1 fredette Dbl_copytoptr(opnd1p1,opnd1p2,dstptr);
162 1.1 fredette return(NOEXCEPTION);
163 1.1 fredette }
164 1.1 fredette /* normalize, then continue */
165 1.1 fredette opnd1_exponent = 1;
166 1.1 fredette Dbl_normalize(opnd1p1,opnd1p2,opnd1_exponent);
167 1.1 fredette }
168 1.1 fredette else {
169 1.1 fredette Dbl_clear_signexponent_set_hidden(opnd1p1);
170 1.1 fredette }
171 1.1 fredette if (opnd2_exponent == 0) {
172 1.1 fredette /* normalize, then continue */
173 1.1 fredette opnd2_exponent = 1;
174 1.1 fredette Dbl_normalize(opnd2p1,opnd2p2,opnd2_exponent);
175 1.1 fredette }
176 1.1 fredette else {
177 1.1 fredette Dbl_clear_signexponent_set_hidden(opnd2p1);
178 1.1 fredette }
179 1.1 fredette
180 1.1 fredette /* find result exponent and divide step loop count */
181 1.1 fredette dest_exponent = opnd2_exponent - 1;
182 1.1 fredette stepcount = opnd1_exponent - opnd2_exponent;
183 1.1 fredette
184 1.1 fredette /*
185 1.1 fredette * check for opnd1/opnd2 < 1
186 1.1 fredette */
187 1.1 fredette if (stepcount < 0) {
188 1.1 fredette /*
189 1.1 fredette * check for opnd1/opnd2 > 1/2
190 1.1 fredette *
191 1.1 fredette * In this case n will round to 1, so
192 1.1 fredette * r = opnd1 - opnd2
193 1.1 fredette */
194 1.1 fredette if (stepcount == -1 &&
195 1.1 fredette Dbl_isgreaterthan(opnd1p1,opnd1p2,opnd2p1,opnd2p2)) {
196 1.1 fredette /* set sign */
197 1.1 fredette Dbl_allp1(resultp1) = ~Dbl_allp1(resultp1);
198 1.1 fredette /* align opnd2 with opnd1 */
199 1.1 fredette Dbl_leftshiftby1(opnd2p1,opnd2p2);
200 1.1 fredette Dbl_subtract(opnd2p1,opnd2p2,opnd1p1,opnd1p2,
201 1.1 fredette opnd2p1,opnd2p2);
202 1.1 fredette /* now normalize */
203 1.1 fredette while (Dbl_iszero_hidden(opnd2p1)) {
204 1.1 fredette Dbl_leftshiftby1(opnd2p1,opnd2p2);
205 1.1 fredette dest_exponent--;
206 1.1 fredette }
207 1.1 fredette Dbl_set_exponentmantissa(resultp1,resultp2,opnd2p1,opnd2p2);
208 1.1 fredette goto testforunderflow;
209 1.1 fredette }
210 1.1 fredette /*
211 1.1 fredette * opnd1/opnd2 <= 1/2
212 1.1 fredette *
213 1.1 fredette * In this case n will round to zero, so
214 1.1 fredette * r = opnd1
215 1.1 fredette */
216 1.1 fredette Dbl_set_exponentmantissa(resultp1,resultp2,opnd1p1,opnd1p2);
217 1.1 fredette dest_exponent = opnd1_exponent;
218 1.1 fredette goto testforunderflow;
219 1.1 fredette }
220 1.1 fredette
221 1.1 fredette /*
222 1.1 fredette * Generate result
223 1.1 fredette *
224 1.1 fredette * Do iterative subtract until remainder is less than operand 2.
225 1.1 fredette */
226 1.1 fredette while (stepcount-- > 0 && (Dbl_allp1(opnd1p1) || Dbl_allp2(opnd1p2))) {
227 1.1 fredette if (Dbl_isnotlessthan(opnd1p1,opnd1p2,opnd2p1,opnd2p2)) {
228 1.1 fredette Dbl_subtract(opnd1p1,opnd1p2,opnd2p1,opnd2p2,opnd1p1,opnd1p2);
229 1.1 fredette }
230 1.1 fredette Dbl_leftshiftby1(opnd1p1,opnd1p2);
231 1.1 fredette }
232 1.1 fredette /*
233 1.1 fredette * Do last subtract, then determine which way to round if remainder
234 1.1 fredette * is exactly 1/2 of opnd2
235 1.1 fredette */
236 1.1 fredette if (Dbl_isnotlessthan(opnd1p1,opnd1p2,opnd2p1,opnd2p2)) {
237 1.1 fredette Dbl_subtract(opnd1p1,opnd1p2,opnd2p1,opnd2p2,opnd1p1,opnd1p2);
238 1.1 fredette roundup = TRUE;
239 1.1 fredette }
240 1.1 fredette if (stepcount > 0 || Dbl_iszero(opnd1p1,opnd1p2)) {
241 1.1 fredette /* division is exact, remainder is zero */
242 1.1 fredette Dbl_setzero_exponentmantissa(resultp1,resultp2);
243 1.1 fredette Dbl_copytoptr(resultp1,resultp2,dstptr);
244 1.1 fredette return(NOEXCEPTION);
245 1.1 fredette }
246 1.1 fredette
247 1.1 fredette /*
248 1.1 fredette * Check for cases where opnd1/opnd2 < n
249 1.1 fredette *
250 1.1 fredette * In this case the result's sign will be opposite that of
251 1.1 fredette * opnd1. The mantissa also needs some correction.
252 1.1 fredette */
253 1.1 fredette Dbl_leftshiftby1(opnd1p1,opnd1p2);
254 1.1 fredette if (Dbl_isgreaterthan(opnd1p1,opnd1p2,opnd2p1,opnd2p2)) {
255 1.1 fredette Dbl_invert_sign(resultp1);
256 1.1 fredette Dbl_leftshiftby1(opnd2p1,opnd2p2);
257 1.1 fredette Dbl_subtract(opnd2p1,opnd2p2,opnd1p1,opnd1p2,opnd1p1,opnd1p2);
258 1.1 fredette }
259 1.1 fredette /* check for remainder being exactly 1/2 of opnd2 */
260 1.1 fredette else if (Dbl_isequal(opnd1p1,opnd1p2,opnd2p1,opnd2p2) && roundup) {
261 1.1 fredette Dbl_invert_sign(resultp1);
262 1.1 fredette }
263 1.1 fredette
264 1.1 fredette /* normalize result's mantissa */
265 1.1 fredette while (Dbl_iszero_hidden(opnd1p1)) {
266 1.1 fredette dest_exponent--;
267 1.1 fredette Dbl_leftshiftby1(opnd1p1,opnd1p2);
268 1.1 fredette }
269 1.1 fredette Dbl_set_exponentmantissa(resultp1,resultp2,opnd1p1,opnd1p2);
270 1.1 fredette
271 1.1 fredette /*
272 1.1 fredette * Test for underflow
273 1.1 fredette */
274 1.1 fredette testforunderflow:
275 1.1 fredette if (dest_exponent <= 0) {
276 1.1 fredette /* trap if UNDERFLOWTRAP enabled */
277 1.1 fredette if (Is_underflowtrap_enabled()) {
278 1.1 fredette /*
279 1.1 fredette * Adjust bias of result
280 1.1 fredette */
281 1.1 fredette Dbl_setwrapped_exponent(resultp1,dest_exponent,unfl);
282 1.1 fredette /* frem is always exact */
283 1.1 fredette Dbl_copytoptr(resultp1,resultp2,dstptr);
284 1.1 fredette return(UNDERFLOWEXCEPTION);
285 1.1 fredette }
286 1.1 fredette /*
287 1.1 fredette * denormalize result or set to signed zero
288 1.1 fredette */
289 1.1 fredette if (dest_exponent >= (1 - DBL_P)) {
290 1.1 fredette Dbl_rightshift_exponentmantissa(resultp1,resultp2,
291 1.1 fredette 1-dest_exponent);
292 1.1 fredette }
293 1.1 fredette else {
294 1.1 fredette Dbl_setzero_exponentmantissa(resultp1,resultp2);
295 1.1 fredette }
296 1.1 fredette }
297 1.1 fredette else Dbl_set_exponent(resultp1,dest_exponent);
298 1.1 fredette Dbl_copytoptr(resultp1,resultp2,dstptr);
299 1.1 fredette return(NOEXCEPTION);
300 1.1 fredette }
301