dfmpy.c revision 1.1 1 1.1 fredette /* $NetBSD: dfmpy.c,v 1.1 2002/06/05 01:04:24 fredette Exp $ */
2 1.1 fredette
3 1.1 fredette /* $OpenBSD: dfmpy.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 #include "../spmath/float.h"
45 1.1 fredette #include "../spmath/dbl_float.h"
46 1.1 fredette
47 1.1 fredette /*
48 1.1 fredette * Double Precision Floating-point Multiply
49 1.1 fredette */
50 1.1 fredette
51 1.1 fredette int
52 1.1 fredette dbl_fmpy(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 opnd3p1, opnd3p2, resultp1, resultp2;
59 1.1 fredette register int dest_exponent, count;
60 1.1 fredette register int inexact = FALSE, guardbit = FALSE, stickybit = FALSE;
61 1.1 fredette int is_tiny;
62 1.1 fredette
63 1.1 fredette Dbl_copyfromptr(srcptr1,opnd1p1,opnd1p2);
64 1.1 fredette Dbl_copyfromptr(srcptr2,opnd2p1,opnd2p2);
65 1.1 fredette
66 1.1 fredette /*
67 1.1 fredette * set sign bit of result
68 1.1 fredette */
69 1.1 fredette if (Dbl_sign(opnd1p1) ^ Dbl_sign(opnd2p1))
70 1.1 fredette Dbl_setnegativezerop1(resultp1);
71 1.1 fredette else Dbl_setzerop1(resultp1);
72 1.1 fredette /*
73 1.1 fredette * check first operand for NaN's or infinity
74 1.1 fredette */
75 1.1 fredette if (Dbl_isinfinity_exponent(opnd1p1)) {
76 1.1 fredette if (Dbl_iszero_mantissa(opnd1p1,opnd1p2)) {
77 1.1 fredette if (Dbl_isnotnan(opnd2p1,opnd2p2)) {
78 1.1 fredette if (Dbl_iszero_exponentmantissa(opnd2p1,opnd2p2)) {
79 1.1 fredette /*
80 1.1 fredette * invalid since operands are infinity
81 1.1 fredette * and zero
82 1.1 fredette */
83 1.1 fredette if (Is_invalidtrap_enabled())
84 1.1 fredette return(INVALIDEXCEPTION);
85 1.1 fredette Set_invalidflag();
86 1.1 fredette Dbl_makequietnan(resultp1,resultp2);
87 1.1 fredette Dbl_copytoptr(resultp1,resultp2,dstptr);
88 1.1 fredette return(NOEXCEPTION);
89 1.1 fredette }
90 1.1 fredette /*
91 1.1 fredette * return infinity
92 1.1 fredette */
93 1.1 fredette Dbl_setinfinity_exponentmantissa(resultp1,resultp2);
94 1.1 fredette Dbl_copytoptr(resultp1,resultp2,dstptr);
95 1.1 fredette return(NOEXCEPTION);
96 1.1 fredette }
97 1.1 fredette }
98 1.1 fredette else {
99 1.1 fredette /*
100 1.1 fredette * is NaN; signaling or quiet?
101 1.1 fredette */
102 1.1 fredette if (Dbl_isone_signaling(opnd1p1)) {
103 1.1 fredette /* trap if INVALIDTRAP enabled */
104 1.1 fredette if (Is_invalidtrap_enabled())
105 1.1 fredette return(INVALIDEXCEPTION);
106 1.1 fredette /* make NaN quiet */
107 1.1 fredette Set_invalidflag();
108 1.1 fredette Dbl_set_quiet(opnd1p1);
109 1.1 fredette }
110 1.1 fredette /*
111 1.1 fredette * is second operand a signaling NaN?
112 1.1 fredette */
113 1.1 fredette else if (Dbl_is_signalingnan(opnd2p1)) {
114 1.1 fredette /* trap if INVALIDTRAP enabled */
115 1.1 fredette if (Is_invalidtrap_enabled())
116 1.1 fredette return(INVALIDEXCEPTION);
117 1.1 fredette /* make NaN quiet */
118 1.1 fredette Set_invalidflag();
119 1.1 fredette Dbl_set_quiet(opnd2p1);
120 1.1 fredette Dbl_copytoptr(opnd2p1,opnd2p2,dstptr);
121 1.1 fredette return(NOEXCEPTION);
122 1.1 fredette }
123 1.1 fredette /*
124 1.1 fredette * return quiet NaN
125 1.1 fredette */
126 1.1 fredette Dbl_copytoptr(opnd1p1,opnd1p2,dstptr);
127 1.1 fredette return(NOEXCEPTION);
128 1.1 fredette }
129 1.1 fredette }
130 1.1 fredette /*
131 1.1 fredette * check second operand for NaN's or infinity
132 1.1 fredette */
133 1.1 fredette if (Dbl_isinfinity_exponent(opnd2p1)) {
134 1.1 fredette if (Dbl_iszero_mantissa(opnd2p1,opnd2p2)) {
135 1.1 fredette if (Dbl_iszero_exponentmantissa(opnd1p1,opnd1p2)) {
136 1.1 fredette /* invalid since operands are zero & infinity */
137 1.1 fredette if (Is_invalidtrap_enabled())
138 1.1 fredette return(INVALIDEXCEPTION);
139 1.1 fredette Set_invalidflag();
140 1.1 fredette Dbl_makequietnan(opnd2p1,opnd2p2);
141 1.1 fredette Dbl_copytoptr(opnd2p1,opnd2p2,dstptr);
142 1.1 fredette return(NOEXCEPTION);
143 1.1 fredette }
144 1.1 fredette /*
145 1.1 fredette * return infinity
146 1.1 fredette */
147 1.1 fredette Dbl_setinfinity_exponentmantissa(resultp1,resultp2);
148 1.1 fredette Dbl_copytoptr(resultp1,resultp2,dstptr);
149 1.1 fredette return(NOEXCEPTION);
150 1.1 fredette }
151 1.1 fredette /*
152 1.1 fredette * is NaN; signaling or quiet?
153 1.1 fredette */
154 1.1 fredette if (Dbl_isone_signaling(opnd2p1)) {
155 1.1 fredette /* trap if INVALIDTRAP enabled */
156 1.1 fredette if (Is_invalidtrap_enabled()) return(INVALIDEXCEPTION);
157 1.1 fredette /* make NaN quiet */
158 1.1 fredette Set_invalidflag();
159 1.1 fredette Dbl_set_quiet(opnd2p1);
160 1.1 fredette }
161 1.1 fredette /*
162 1.1 fredette * return quiet NaN
163 1.1 fredette */
164 1.1 fredette Dbl_copytoptr(opnd2p1,opnd2p2,dstptr);
165 1.1 fredette return(NOEXCEPTION);
166 1.1 fredette }
167 1.1 fredette /*
168 1.1 fredette * Generate exponent
169 1.1 fredette */
170 1.1 fredette dest_exponent = Dbl_exponent(opnd1p1) + Dbl_exponent(opnd2p1) -DBL_BIAS;
171 1.1 fredette
172 1.1 fredette /*
173 1.1 fredette * Generate mantissa
174 1.1 fredette */
175 1.1 fredette if (Dbl_isnotzero_exponent(opnd1p1)) {
176 1.1 fredette /* set hidden bit */
177 1.1 fredette Dbl_clear_signexponent_set_hidden(opnd1p1);
178 1.1 fredette }
179 1.1 fredette else {
180 1.1 fredette /* check for zero */
181 1.1 fredette if (Dbl_iszero_mantissa(opnd1p1,opnd1p2)) {
182 1.1 fredette Dbl_setzero_exponentmantissa(resultp1,resultp2);
183 1.1 fredette Dbl_copytoptr(resultp1,resultp2,dstptr);
184 1.1 fredette return(NOEXCEPTION);
185 1.1 fredette }
186 1.1 fredette /* is denormalized, adjust exponent */
187 1.1 fredette Dbl_clear_signexponent(opnd1p1);
188 1.1 fredette Dbl_leftshiftby1(opnd1p1,opnd1p2);
189 1.1 fredette Dbl_normalize(opnd1p1,opnd1p2,dest_exponent);
190 1.1 fredette }
191 1.1 fredette /* opnd2 needs to have hidden bit set with msb in hidden bit */
192 1.1 fredette if (Dbl_isnotzero_exponent(opnd2p1)) {
193 1.1 fredette Dbl_clear_signexponent_set_hidden(opnd2p1);
194 1.1 fredette }
195 1.1 fredette else {
196 1.1 fredette /* check for zero */
197 1.1 fredette if (Dbl_iszero_mantissa(opnd2p1,opnd2p2)) {
198 1.1 fredette Dbl_setzero_exponentmantissa(resultp1,resultp2);
199 1.1 fredette Dbl_copytoptr(resultp1,resultp2,dstptr);
200 1.1 fredette return(NOEXCEPTION);
201 1.1 fredette }
202 1.1 fredette /* is denormalized; want to normalize */
203 1.1 fredette Dbl_clear_signexponent(opnd2p1);
204 1.1 fredette Dbl_leftshiftby1(opnd2p1,opnd2p2);
205 1.1 fredette Dbl_normalize(opnd2p1,opnd2p2,dest_exponent);
206 1.1 fredette }
207 1.1 fredette
208 1.1 fredette /* Multiply two source mantissas together */
209 1.1 fredette
210 1.1 fredette /* make room for guard bits */
211 1.1 fredette Dbl_leftshiftby7(opnd2p1,opnd2p2);
212 1.1 fredette Dbl_setzero(opnd3p1,opnd3p2);
213 1.1 fredette /*
214 1.1 fredette * Four bits at a time are inspected in each loop, and a
215 1.1 fredette * simple shift and add multiply algorithm is used.
216 1.1 fredette */
217 1.1 fredette for (count=1;count<=DBL_P;count+=4) {
218 1.1 fredette stickybit |= Dlow4p2(opnd3p2);
219 1.1 fredette Dbl_rightshiftby4(opnd3p1,opnd3p2);
220 1.1 fredette if (Dbit28p2(opnd1p2)) {
221 1.1 fredette /* Twoword_add should be an ADDC followed by an ADD. */
222 1.1 fredette Twoword_add(opnd3p1, opnd3p2, opnd2p1<<3 | opnd2p2>>29,
223 1.1 fredette opnd2p2<<3);
224 1.1 fredette }
225 1.1 fredette if (Dbit29p2(opnd1p2)) {
226 1.1 fredette Twoword_add(opnd3p1, opnd3p2, opnd2p1<<2 | opnd2p2>>30,
227 1.1 fredette opnd2p2<<2);
228 1.1 fredette }
229 1.1 fredette if (Dbit30p2(opnd1p2)) {
230 1.1 fredette Twoword_add(opnd3p1, opnd3p2, opnd2p1<<1 | opnd2p2>>31,
231 1.1 fredette opnd2p2<<1);
232 1.1 fredette }
233 1.1 fredette if (Dbit31p2(opnd1p2)) {
234 1.1 fredette Twoword_add(opnd3p1, opnd3p2, opnd2p1, opnd2p2);
235 1.1 fredette }
236 1.1 fredette Dbl_rightshiftby4(opnd1p1,opnd1p2);
237 1.1 fredette }
238 1.1 fredette if (Dbit3p1(opnd3p1)==0) {
239 1.1 fredette Dbl_leftshiftby1(opnd3p1,opnd3p2);
240 1.1 fredette }
241 1.1 fredette else {
242 1.1 fredette /* result mantissa >= 2. */
243 1.1 fredette dest_exponent++;
244 1.1 fredette }
245 1.1 fredette /* check for denormalized result */
246 1.1 fredette while (Dbit3p1(opnd3p1)==0) {
247 1.1 fredette Dbl_leftshiftby1(opnd3p1,opnd3p2);
248 1.1 fredette dest_exponent--;
249 1.1 fredette }
250 1.1 fredette /*
251 1.1 fredette * check for guard, sticky and inexact bits
252 1.1 fredette */
253 1.1 fredette stickybit |= Dallp2(opnd3p2) << 25;
254 1.1 fredette guardbit = (Dallp2(opnd3p2) << 24) >> 31;
255 1.1 fredette inexact = guardbit | stickybit;
256 1.1 fredette
257 1.1 fredette /* align result mantissa */
258 1.1 fredette Dbl_rightshiftby8(opnd3p1,opnd3p2);
259 1.1 fredette
260 1.1 fredette /*
261 1.1 fredette * round result
262 1.1 fredette */
263 1.1 fredette if (inexact && (dest_exponent>0 || Is_underflowtrap_enabled())) {
264 1.1 fredette Dbl_clear_signexponent(opnd3p1);
265 1.1 fredette switch (Rounding_mode()) {
266 1.1 fredette case ROUNDPLUS:
267 1.1 fredette if (Dbl_iszero_sign(resultp1))
268 1.1 fredette Dbl_increment(opnd3p1,opnd3p2);
269 1.1 fredette break;
270 1.1 fredette case ROUNDMINUS:
271 1.1 fredette if (Dbl_isone_sign(resultp1))
272 1.1 fredette Dbl_increment(opnd3p1,opnd3p2);
273 1.1 fredette break;
274 1.1 fredette case ROUNDNEAREST:
275 1.1 fredette if (guardbit &&
276 1.1 fredette (stickybit || Dbl_isone_lowmantissap2(opnd3p2)))
277 1.1 fredette Dbl_increment(opnd3p1,opnd3p2);
278 1.1 fredette break;
279 1.1 fredette }
280 1.1 fredette if (Dbl_isone_hidden(opnd3p1)) dest_exponent++;
281 1.1 fredette }
282 1.1 fredette Dbl_set_mantissa(resultp1,resultp2,opnd3p1,opnd3p2);
283 1.1 fredette
284 1.1 fredette /*
285 1.1 fredette * Test for overflow
286 1.1 fredette */
287 1.1 fredette if (dest_exponent >= DBL_INFINITY_EXPONENT) {
288 1.1 fredette /* trap if OVERFLOWTRAP enabled */
289 1.1 fredette if (Is_overflowtrap_enabled()) {
290 1.1 fredette /*
291 1.1 fredette * Adjust bias of result
292 1.1 fredette */
293 1.1 fredette Dbl_setwrapped_exponent(resultp1,dest_exponent,ovfl);
294 1.1 fredette Dbl_copytoptr(resultp1,resultp2,dstptr);
295 1.1 fredette if (inexact) {
296 1.1 fredette if (Is_inexacttrap_enabled())
297 1.1 fredette return (OVERFLOWEXCEPTION | INEXACTEXCEPTION);
298 1.1 fredette else
299 1.1 fredette Set_inexactflag();
300 1.1 fredette }
301 1.1 fredette return (OVERFLOWEXCEPTION);
302 1.1 fredette }
303 1.1 fredette inexact = TRUE;
304 1.1 fredette Set_overflowflag();
305 1.1 fredette /* set result to infinity or largest number */
306 1.1 fredette Dbl_setoverflow(resultp1,resultp2);
307 1.1 fredette }
308 1.1 fredette /*
309 1.1 fredette * Test for underflow
310 1.1 fredette */
311 1.1 fredette else if (dest_exponent <= 0) {
312 1.1 fredette /* trap if UNDERFLOWTRAP enabled */
313 1.1 fredette if (Is_underflowtrap_enabled()) {
314 1.1 fredette /*
315 1.1 fredette * Adjust bias of result
316 1.1 fredette */
317 1.1 fredette Dbl_setwrapped_exponent(resultp1,dest_exponent,unfl);
318 1.1 fredette Dbl_copytoptr(resultp1,resultp2,dstptr);
319 1.1 fredette if (inexact) {
320 1.1 fredette if (Is_inexacttrap_enabled())
321 1.1 fredette return (UNDERFLOWEXCEPTION | INEXACTEXCEPTION);
322 1.1 fredette else
323 1.1 fredette Set_inexactflag();
324 1.1 fredette }
325 1.1 fredette return (UNDERFLOWEXCEPTION);
326 1.1 fredette }
327 1.1 fredette
328 1.1 fredette /* Determine if should set underflow flag */
329 1.1 fredette is_tiny = TRUE;
330 1.1 fredette if (dest_exponent == 0 && inexact) {
331 1.1 fredette switch (Rounding_mode()) {
332 1.1 fredette case ROUNDPLUS:
333 1.1 fredette if (Dbl_iszero_sign(resultp1)) {
334 1.1 fredette Dbl_increment(opnd3p1,opnd3p2);
335 1.1 fredette if (Dbl_isone_hiddenoverflow(opnd3p1))
336 1.1 fredette is_tiny = FALSE;
337 1.1 fredette Dbl_decrement(opnd3p1,opnd3p2);
338 1.1 fredette }
339 1.1 fredette break;
340 1.1 fredette case ROUNDMINUS:
341 1.1 fredette if (Dbl_isone_sign(resultp1)) {
342 1.1 fredette Dbl_increment(opnd3p1,opnd3p2);
343 1.1 fredette if (Dbl_isone_hiddenoverflow(opnd3p1))
344 1.1 fredette is_tiny = FALSE;
345 1.1 fredette Dbl_decrement(opnd3p1,opnd3p2);
346 1.1 fredette }
347 1.1 fredette break;
348 1.1 fredette case ROUNDNEAREST:
349 1.1 fredette if (guardbit && (stickybit ||
350 1.1 fredette Dbl_isone_lowmantissap2(opnd3p2))) {
351 1.1 fredette Dbl_increment(opnd3p1,opnd3p2);
352 1.1 fredette if (Dbl_isone_hiddenoverflow(opnd3p1))
353 1.1 fredette is_tiny = FALSE;
354 1.1 fredette Dbl_decrement(opnd3p1,opnd3p2);
355 1.1 fredette }
356 1.1 fredette break;
357 1.1 fredette }
358 1.1 fredette }
359 1.1 fredette
360 1.1 fredette /*
361 1.1 fredette * denormalize result or set to signed zero
362 1.1 fredette */
363 1.1 fredette stickybit = inexact;
364 1.1 fredette Dbl_denormalize(opnd3p1,opnd3p2,dest_exponent,guardbit,
365 1.1 fredette stickybit,inexact);
366 1.1 fredette
367 1.1 fredette /* return zero or smallest number */
368 1.1 fredette if (inexact) {
369 1.1 fredette switch (Rounding_mode()) {
370 1.1 fredette case ROUNDPLUS:
371 1.1 fredette if (Dbl_iszero_sign(resultp1)) {
372 1.1 fredette Dbl_increment(opnd3p1,opnd3p2);
373 1.1 fredette }
374 1.1 fredette break;
375 1.1 fredette case ROUNDMINUS:
376 1.1 fredette if (Dbl_isone_sign(resultp1)) {
377 1.1 fredette Dbl_increment(opnd3p1,opnd3p2);
378 1.1 fredette }
379 1.1 fredette break;
380 1.1 fredette case ROUNDNEAREST:
381 1.1 fredette if (guardbit && (stickybit ||
382 1.1 fredette Dbl_isone_lowmantissap2(opnd3p2))) {
383 1.1 fredette Dbl_increment(opnd3p1,opnd3p2);
384 1.1 fredette }
385 1.1 fredette break;
386 1.1 fredette }
387 1.1 fredette if (is_tiny) Set_underflowflag();
388 1.1 fredette }
389 1.1 fredette Dbl_set_exponentmantissa(resultp1,resultp2,opnd3p1,opnd3p2);
390 1.1 fredette }
391 1.1 fredette else Dbl_set_exponent(resultp1,dest_exponent);
392 1.1 fredette /* check for inexact */
393 1.1 fredette Dbl_copytoptr(resultp1,resultp2,dstptr);
394 1.1 fredette if (inexact) {
395 1.1 fredette if (Is_inexacttrap_enabled()) return(INEXACTEXCEPTION);
396 1.1 fredette else Set_inexactflag();
397 1.1 fredette }
398 1.1 fredette return(NOEXCEPTION);
399 1.1 fredette }
400