sfmpy.c revision 1.1.4.2 1 1.1.4.2 gehenna /* $NetBSD: sfmpy.c,v 1.1.4.2 2002/07/14 17:47:48 gehenna Exp $ */
2 1.1.4.2 gehenna
3 1.1.4.2 gehenna /* $OpenBSD: sfmpy.c,v 1.4 2001/03/29 03:58:19 mickey Exp $ */
4 1.1.4.2 gehenna
5 1.1.4.2 gehenna /*
6 1.1.4.2 gehenna * Copyright 1996 1995 by Open Software Foundation, Inc.
7 1.1.4.2 gehenna * All Rights Reserved
8 1.1.4.2 gehenna *
9 1.1.4.2 gehenna * Permission to use, copy, modify, and distribute this software and
10 1.1.4.2 gehenna * its documentation for any purpose and without fee is hereby granted,
11 1.1.4.2 gehenna * provided that the above copyright notice appears in all copies and
12 1.1.4.2 gehenna * that both the copyright notice and this permission notice appear in
13 1.1.4.2 gehenna * supporting documentation.
14 1.1.4.2 gehenna *
15 1.1.4.2 gehenna * OSF DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE
16 1.1.4.2 gehenna * INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
17 1.1.4.2 gehenna * FOR A PARTICULAR PURPOSE.
18 1.1.4.2 gehenna *
19 1.1.4.2 gehenna * IN NO EVENT SHALL OSF BE LIABLE FOR ANY SPECIAL, INDIRECT, OR
20 1.1.4.2 gehenna * CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
21 1.1.4.2 gehenna * LOSS OF USE, DATA OR PROFITS, WHETHER IN ACTION OF CONTRACT,
22 1.1.4.2 gehenna * NEGLIGENCE, OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION
23 1.1.4.2 gehenna * WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
24 1.1.4.2 gehenna *
25 1.1.4.2 gehenna */
26 1.1.4.2 gehenna /*
27 1.1.4.2 gehenna * pmk1.1
28 1.1.4.2 gehenna */
29 1.1.4.2 gehenna /*
30 1.1.4.2 gehenna * (c) Copyright 1986 HEWLETT-PACKARD COMPANY
31 1.1.4.2 gehenna *
32 1.1.4.2 gehenna * To anyone who acknowledges that this file is provided "AS IS"
33 1.1.4.2 gehenna * without any express or implied warranty:
34 1.1.4.2 gehenna * permission to use, copy, modify, and distribute this file
35 1.1.4.2 gehenna * for any purpose is hereby granted without fee, provided that
36 1.1.4.2 gehenna * the above copyright notice and this notice appears in all
37 1.1.4.2 gehenna * copies, and that the name of Hewlett-Packard Company not be
38 1.1.4.2 gehenna * used in advertising or publicity pertaining to distribution
39 1.1.4.2 gehenna * of the software without specific, written prior permission.
40 1.1.4.2 gehenna * Hewlett-Packard Company makes no representations about the
41 1.1.4.2 gehenna * suitability of this software for any purpose.
42 1.1.4.2 gehenna */
43 1.1.4.2 gehenna
44 1.1.4.2 gehenna #include "../spmath/float.h"
45 1.1.4.2 gehenna #include "../spmath/sgl_float.h"
46 1.1.4.2 gehenna
47 1.1.4.2 gehenna /*
48 1.1.4.2 gehenna * Single Precision Floating-point Multiply
49 1.1.4.2 gehenna */
50 1.1.4.2 gehenna int
51 1.1.4.2 gehenna sgl_fmpy(srcptr1,srcptr2,dstptr,status)
52 1.1.4.2 gehenna
53 1.1.4.2 gehenna sgl_floating_point *srcptr1, *srcptr2, *dstptr;
54 1.1.4.2 gehenna unsigned int *status;
55 1.1.4.2 gehenna {
56 1.1.4.2 gehenna register unsigned int opnd1, opnd2, opnd3, result;
57 1.1.4.2 gehenna register int dest_exponent, count;
58 1.1.4.2 gehenna register int inexact = FALSE, guardbit = FALSE, stickybit = FALSE;
59 1.1.4.2 gehenna int is_tiny;
60 1.1.4.2 gehenna
61 1.1.4.2 gehenna opnd1 = *srcptr1;
62 1.1.4.2 gehenna opnd2 = *srcptr2;
63 1.1.4.2 gehenna /*
64 1.1.4.2 gehenna * set sign bit of result
65 1.1.4.2 gehenna */
66 1.1.4.2 gehenna if (Sgl_sign(opnd1) ^ Sgl_sign(opnd2)) Sgl_setnegativezero(result);
67 1.1.4.2 gehenna else Sgl_setzero(result);
68 1.1.4.2 gehenna /*
69 1.1.4.2 gehenna * check first operand for NaN's or infinity
70 1.1.4.2 gehenna */
71 1.1.4.2 gehenna if (Sgl_isinfinity_exponent(opnd1)) {
72 1.1.4.2 gehenna if (Sgl_iszero_mantissa(opnd1)) {
73 1.1.4.2 gehenna if (Sgl_isnotnan(opnd2)) {
74 1.1.4.2 gehenna if (Sgl_iszero_exponentmantissa(opnd2)) {
75 1.1.4.2 gehenna /*
76 1.1.4.2 gehenna * invalid since operands are infinity
77 1.1.4.2 gehenna * and zero
78 1.1.4.2 gehenna */
79 1.1.4.2 gehenna if (Is_invalidtrap_enabled())
80 1.1.4.2 gehenna return(INVALIDEXCEPTION);
81 1.1.4.2 gehenna Set_invalidflag();
82 1.1.4.2 gehenna Sgl_makequietnan(result);
83 1.1.4.2 gehenna *dstptr = result;
84 1.1.4.2 gehenna return(NOEXCEPTION);
85 1.1.4.2 gehenna }
86 1.1.4.2 gehenna /*
87 1.1.4.2 gehenna * return infinity
88 1.1.4.2 gehenna */
89 1.1.4.2 gehenna Sgl_setinfinity_exponentmantissa(result);
90 1.1.4.2 gehenna *dstptr = result;
91 1.1.4.2 gehenna return(NOEXCEPTION);
92 1.1.4.2 gehenna }
93 1.1.4.2 gehenna }
94 1.1.4.2 gehenna else {
95 1.1.4.2 gehenna /*
96 1.1.4.2 gehenna * is NaN; signaling or quiet?
97 1.1.4.2 gehenna */
98 1.1.4.2 gehenna if (Sgl_isone_signaling(opnd1)) {
99 1.1.4.2 gehenna /* trap if INVALIDTRAP enabled */
100 1.1.4.2 gehenna if (Is_invalidtrap_enabled())
101 1.1.4.2 gehenna return(INVALIDEXCEPTION);
102 1.1.4.2 gehenna /* make NaN quiet */
103 1.1.4.2 gehenna Set_invalidflag();
104 1.1.4.2 gehenna Sgl_set_quiet(opnd1);
105 1.1.4.2 gehenna }
106 1.1.4.2 gehenna /*
107 1.1.4.2 gehenna * is second operand a signaling NaN?
108 1.1.4.2 gehenna */
109 1.1.4.2 gehenna else if (Sgl_is_signalingnan(opnd2)) {
110 1.1.4.2 gehenna /* trap if INVALIDTRAP enabled */
111 1.1.4.2 gehenna if (Is_invalidtrap_enabled())
112 1.1.4.2 gehenna return(INVALIDEXCEPTION);
113 1.1.4.2 gehenna /* make NaN quiet */
114 1.1.4.2 gehenna Set_invalidflag();
115 1.1.4.2 gehenna Sgl_set_quiet(opnd2);
116 1.1.4.2 gehenna *dstptr = opnd2;
117 1.1.4.2 gehenna return(NOEXCEPTION);
118 1.1.4.2 gehenna }
119 1.1.4.2 gehenna /*
120 1.1.4.2 gehenna * return quiet NaN
121 1.1.4.2 gehenna */
122 1.1.4.2 gehenna *dstptr = opnd1;
123 1.1.4.2 gehenna return(NOEXCEPTION);
124 1.1.4.2 gehenna }
125 1.1.4.2 gehenna }
126 1.1.4.2 gehenna /*
127 1.1.4.2 gehenna * check second operand for NaN's or infinity
128 1.1.4.2 gehenna */
129 1.1.4.2 gehenna if (Sgl_isinfinity_exponent(opnd2)) {
130 1.1.4.2 gehenna if (Sgl_iszero_mantissa(opnd2)) {
131 1.1.4.2 gehenna if (Sgl_iszero_exponentmantissa(opnd1)) {
132 1.1.4.2 gehenna /* invalid since operands are zero & infinity */
133 1.1.4.2 gehenna if (Is_invalidtrap_enabled())
134 1.1.4.2 gehenna return(INVALIDEXCEPTION);
135 1.1.4.2 gehenna Set_invalidflag();
136 1.1.4.2 gehenna Sgl_makequietnan(opnd2);
137 1.1.4.2 gehenna *dstptr = opnd2;
138 1.1.4.2 gehenna return(NOEXCEPTION);
139 1.1.4.2 gehenna }
140 1.1.4.2 gehenna /*
141 1.1.4.2 gehenna * return infinity
142 1.1.4.2 gehenna */
143 1.1.4.2 gehenna Sgl_setinfinity_exponentmantissa(result);
144 1.1.4.2 gehenna *dstptr = result;
145 1.1.4.2 gehenna return(NOEXCEPTION);
146 1.1.4.2 gehenna }
147 1.1.4.2 gehenna /*
148 1.1.4.2 gehenna * is NaN; signaling or quiet?
149 1.1.4.2 gehenna */
150 1.1.4.2 gehenna if (Sgl_isone_signaling(opnd2)) {
151 1.1.4.2 gehenna /* trap if INVALIDTRAP enabled */
152 1.1.4.2 gehenna if (Is_invalidtrap_enabled()) return(INVALIDEXCEPTION);
153 1.1.4.2 gehenna
154 1.1.4.2 gehenna /* make NaN quiet */
155 1.1.4.2 gehenna Set_invalidflag();
156 1.1.4.2 gehenna Sgl_set_quiet(opnd2);
157 1.1.4.2 gehenna }
158 1.1.4.2 gehenna /*
159 1.1.4.2 gehenna * return quiet NaN
160 1.1.4.2 gehenna */
161 1.1.4.2 gehenna *dstptr = opnd2;
162 1.1.4.2 gehenna return(NOEXCEPTION);
163 1.1.4.2 gehenna }
164 1.1.4.2 gehenna /*
165 1.1.4.2 gehenna * Generate exponent
166 1.1.4.2 gehenna */
167 1.1.4.2 gehenna dest_exponent = Sgl_exponent(opnd1) + Sgl_exponent(opnd2) - SGL_BIAS;
168 1.1.4.2 gehenna
169 1.1.4.2 gehenna /*
170 1.1.4.2 gehenna * Generate mantissa
171 1.1.4.2 gehenna */
172 1.1.4.2 gehenna if (Sgl_isnotzero_exponent(opnd1)) {
173 1.1.4.2 gehenna /* set hidden bit */
174 1.1.4.2 gehenna Sgl_clear_signexponent_set_hidden(opnd1);
175 1.1.4.2 gehenna }
176 1.1.4.2 gehenna else {
177 1.1.4.2 gehenna /* check for zero */
178 1.1.4.2 gehenna if (Sgl_iszero_mantissa(opnd1)) {
179 1.1.4.2 gehenna Sgl_setzero_exponentmantissa(result);
180 1.1.4.2 gehenna *dstptr = result;
181 1.1.4.2 gehenna return(NOEXCEPTION);
182 1.1.4.2 gehenna }
183 1.1.4.2 gehenna /* is denormalized, adjust exponent */
184 1.1.4.2 gehenna Sgl_clear_signexponent(opnd1);
185 1.1.4.2 gehenna Sgl_leftshiftby1(opnd1);
186 1.1.4.2 gehenna Sgl_normalize(opnd1,dest_exponent);
187 1.1.4.2 gehenna }
188 1.1.4.2 gehenna /* opnd2 needs to have hidden bit set with msb in hidden bit */
189 1.1.4.2 gehenna if (Sgl_isnotzero_exponent(opnd2)) {
190 1.1.4.2 gehenna Sgl_clear_signexponent_set_hidden(opnd2);
191 1.1.4.2 gehenna }
192 1.1.4.2 gehenna else {
193 1.1.4.2 gehenna /* check for zero */
194 1.1.4.2 gehenna if (Sgl_iszero_mantissa(opnd2)) {
195 1.1.4.2 gehenna Sgl_setzero_exponentmantissa(result);
196 1.1.4.2 gehenna *dstptr = result;
197 1.1.4.2 gehenna return(NOEXCEPTION);
198 1.1.4.2 gehenna }
199 1.1.4.2 gehenna /* is denormalized; want to normalize */
200 1.1.4.2 gehenna Sgl_clear_signexponent(opnd2);
201 1.1.4.2 gehenna Sgl_leftshiftby1(opnd2);
202 1.1.4.2 gehenna Sgl_normalize(opnd2,dest_exponent);
203 1.1.4.2 gehenna }
204 1.1.4.2 gehenna
205 1.1.4.2 gehenna /* Multiply two source mantissas together */
206 1.1.4.2 gehenna
207 1.1.4.2 gehenna Sgl_leftshiftby4(opnd2); /* make room for guard bits */
208 1.1.4.2 gehenna Sgl_setzero(opnd3);
209 1.1.4.2 gehenna /*
210 1.1.4.2 gehenna * Four bits at a time are inspected in each loop, and a
211 1.1.4.2 gehenna * simple shift and add multiply algorithm is used.
212 1.1.4.2 gehenna */
213 1.1.4.2 gehenna for (count=1;count<SGL_P;count+=4) {
214 1.1.4.2 gehenna stickybit |= Slow4(opnd3);
215 1.1.4.2 gehenna Sgl_rightshiftby4(opnd3);
216 1.1.4.2 gehenna if (Sbit28(opnd1)) Sall(opnd3) += (Sall(opnd2) << 3);
217 1.1.4.2 gehenna if (Sbit29(opnd1)) Sall(opnd3) += (Sall(opnd2) << 2);
218 1.1.4.2 gehenna if (Sbit30(opnd1)) Sall(opnd3) += (Sall(opnd2) << 1);
219 1.1.4.2 gehenna if (Sbit31(opnd1)) Sall(opnd3) += Sall(opnd2);
220 1.1.4.2 gehenna Sgl_rightshiftby4(opnd1);
221 1.1.4.2 gehenna }
222 1.1.4.2 gehenna /* make sure result is left-justified */
223 1.1.4.2 gehenna if (Sgl_iszero_sign(opnd3)) {
224 1.1.4.2 gehenna Sgl_leftshiftby1(opnd3);
225 1.1.4.2 gehenna }
226 1.1.4.2 gehenna else {
227 1.1.4.2 gehenna /* result mantissa >= 2. */
228 1.1.4.2 gehenna dest_exponent++;
229 1.1.4.2 gehenna }
230 1.1.4.2 gehenna /* check for denormalized result */
231 1.1.4.2 gehenna while (Sgl_iszero_sign(opnd3)) {
232 1.1.4.2 gehenna Sgl_leftshiftby1(opnd3);
233 1.1.4.2 gehenna dest_exponent--;
234 1.1.4.2 gehenna }
235 1.1.4.2 gehenna /*
236 1.1.4.2 gehenna * check for guard, sticky and inexact bits
237 1.1.4.2 gehenna */
238 1.1.4.2 gehenna stickybit |= Sgl_all(opnd3) << (SGL_BITLENGTH - SGL_EXP_LENGTH + 1);
239 1.1.4.2 gehenna guardbit = Sbit24(opnd3);
240 1.1.4.2 gehenna inexact = guardbit | stickybit;
241 1.1.4.2 gehenna
242 1.1.4.2 gehenna /* re-align mantissa */
243 1.1.4.2 gehenna Sgl_rightshiftby8(opnd3);
244 1.1.4.2 gehenna
245 1.1.4.2 gehenna /*
246 1.1.4.2 gehenna * round result
247 1.1.4.2 gehenna */
248 1.1.4.2 gehenna if (inexact && (dest_exponent>0 || Is_underflowtrap_enabled())) {
249 1.1.4.2 gehenna Sgl_clear_signexponent(opnd3);
250 1.1.4.2 gehenna switch (Rounding_mode()) {
251 1.1.4.2 gehenna case ROUNDPLUS:
252 1.1.4.2 gehenna if (Sgl_iszero_sign(result))
253 1.1.4.2 gehenna Sgl_increment(opnd3);
254 1.1.4.2 gehenna break;
255 1.1.4.2 gehenna case ROUNDMINUS:
256 1.1.4.2 gehenna if (Sgl_isone_sign(result))
257 1.1.4.2 gehenna Sgl_increment(opnd3);
258 1.1.4.2 gehenna break;
259 1.1.4.2 gehenna case ROUNDNEAREST:
260 1.1.4.2 gehenna if (guardbit &&
261 1.1.4.2 gehenna (stickybit || Sgl_isone_lowmantissa(opnd3)))
262 1.1.4.2 gehenna Sgl_increment(opnd3);
263 1.1.4.2 gehenna break;
264 1.1.4.2 gehenna }
265 1.1.4.2 gehenna if (Sgl_isone_hidden(opnd3)) dest_exponent++;
266 1.1.4.2 gehenna }
267 1.1.4.2 gehenna Sgl_set_mantissa(result,opnd3);
268 1.1.4.2 gehenna
269 1.1.4.2 gehenna /*
270 1.1.4.2 gehenna * Test for overflow
271 1.1.4.2 gehenna */
272 1.1.4.2 gehenna if (dest_exponent >= SGL_INFINITY_EXPONENT) {
273 1.1.4.2 gehenna /* trap if OVERFLOWTRAP enabled */
274 1.1.4.2 gehenna if (Is_overflowtrap_enabled()) {
275 1.1.4.2 gehenna /*
276 1.1.4.2 gehenna * Adjust bias of result
277 1.1.4.2 gehenna */
278 1.1.4.2 gehenna Sgl_setwrapped_exponent(result,dest_exponent,ovfl);
279 1.1.4.2 gehenna *dstptr = result;
280 1.1.4.2 gehenna if (inexact) {
281 1.1.4.2 gehenna if (Is_inexacttrap_enabled())
282 1.1.4.2 gehenna return(OVERFLOWEXCEPTION | INEXACTEXCEPTION);
283 1.1.4.2 gehenna else Set_inexactflag();
284 1.1.4.2 gehenna }
285 1.1.4.2 gehenna return(OVERFLOWEXCEPTION);
286 1.1.4.2 gehenna }
287 1.1.4.2 gehenna inexact = TRUE;
288 1.1.4.2 gehenna Set_overflowflag();
289 1.1.4.2 gehenna /* set result to infinity or largest number */
290 1.1.4.2 gehenna Sgl_setoverflow(result);
291 1.1.4.2 gehenna }
292 1.1.4.2 gehenna /*
293 1.1.4.2 gehenna * Test for underflow
294 1.1.4.2 gehenna */
295 1.1.4.2 gehenna else if (dest_exponent <= 0) {
296 1.1.4.2 gehenna /* trap if UNDERFLOWTRAP enabled */
297 1.1.4.2 gehenna if (Is_underflowtrap_enabled()) {
298 1.1.4.2 gehenna /*
299 1.1.4.2 gehenna * Adjust bias of result
300 1.1.4.2 gehenna */
301 1.1.4.2 gehenna Sgl_setwrapped_exponent(result,dest_exponent,unfl);
302 1.1.4.2 gehenna *dstptr = result;
303 1.1.4.2 gehenna if (inexact) {
304 1.1.4.2 gehenna if (Is_inexacttrap_enabled())
305 1.1.4.2 gehenna return(UNDERFLOWEXCEPTION | INEXACTEXCEPTION);
306 1.1.4.2 gehenna else Set_inexactflag();
307 1.1.4.2 gehenna }
308 1.1.4.2 gehenna return(UNDERFLOWEXCEPTION);
309 1.1.4.2 gehenna }
310 1.1.4.2 gehenna
311 1.1.4.2 gehenna /* Determine if should set underflow flag */
312 1.1.4.2 gehenna is_tiny = TRUE;
313 1.1.4.2 gehenna if (dest_exponent == 0 && inexact) {
314 1.1.4.2 gehenna switch (Rounding_mode()) {
315 1.1.4.2 gehenna case ROUNDPLUS:
316 1.1.4.2 gehenna if (Sgl_iszero_sign(result)) {
317 1.1.4.2 gehenna Sgl_increment(opnd3);
318 1.1.4.2 gehenna if (Sgl_isone_hiddenoverflow(opnd3))
319 1.1.4.2 gehenna is_tiny = FALSE;
320 1.1.4.2 gehenna Sgl_decrement(opnd3);
321 1.1.4.2 gehenna }
322 1.1.4.2 gehenna break;
323 1.1.4.2 gehenna case ROUNDMINUS:
324 1.1.4.2 gehenna if (Sgl_isone_sign(result)) {
325 1.1.4.2 gehenna Sgl_increment(opnd3);
326 1.1.4.2 gehenna if (Sgl_isone_hiddenoverflow(opnd3))
327 1.1.4.2 gehenna is_tiny = FALSE;
328 1.1.4.2 gehenna Sgl_decrement(opnd3);
329 1.1.4.2 gehenna }
330 1.1.4.2 gehenna break;
331 1.1.4.2 gehenna case ROUNDNEAREST:
332 1.1.4.2 gehenna if (guardbit && (stickybit ||
333 1.1.4.2 gehenna Sgl_isone_lowmantissa(opnd3))) {
334 1.1.4.2 gehenna Sgl_increment(opnd3);
335 1.1.4.2 gehenna if (Sgl_isone_hiddenoverflow(opnd3))
336 1.1.4.2 gehenna is_tiny = FALSE;
337 1.1.4.2 gehenna Sgl_decrement(opnd3);
338 1.1.4.2 gehenna }
339 1.1.4.2 gehenna break;
340 1.1.4.2 gehenna }
341 1.1.4.2 gehenna }
342 1.1.4.2 gehenna
343 1.1.4.2 gehenna /*
344 1.1.4.2 gehenna * denormalize result or set to signed zero
345 1.1.4.2 gehenna */
346 1.1.4.2 gehenna stickybit = inexact;
347 1.1.4.2 gehenna Sgl_denormalize(opnd3,dest_exponent,guardbit,stickybit,inexact);
348 1.1.4.2 gehenna
349 1.1.4.2 gehenna /* return zero or smallest number */
350 1.1.4.2 gehenna if (inexact) {
351 1.1.4.2 gehenna switch (Rounding_mode()) {
352 1.1.4.2 gehenna case ROUNDPLUS:
353 1.1.4.2 gehenna if (Sgl_iszero_sign(result))
354 1.1.4.2 gehenna Sgl_increment(opnd3);
355 1.1.4.2 gehenna break;
356 1.1.4.2 gehenna case ROUNDMINUS:
357 1.1.4.2 gehenna if (Sgl_isone_sign(result))
358 1.1.4.2 gehenna Sgl_increment(opnd3);
359 1.1.4.2 gehenna break;
360 1.1.4.2 gehenna case ROUNDNEAREST:
361 1.1.4.2 gehenna if (guardbit && (stickybit ||
362 1.1.4.2 gehenna Sgl_isone_lowmantissa(opnd3)))
363 1.1.4.2 gehenna Sgl_increment(opnd3);
364 1.1.4.2 gehenna break;
365 1.1.4.2 gehenna }
366 1.1.4.2 gehenna if (is_tiny) Set_underflowflag();
367 1.1.4.2 gehenna }
368 1.1.4.2 gehenna Sgl_set_exponentmantissa(result,opnd3);
369 1.1.4.2 gehenna }
370 1.1.4.2 gehenna else Sgl_set_exponent(result,dest_exponent);
371 1.1.4.2 gehenna *dstptr = result;
372 1.1.4.2 gehenna
373 1.1.4.2 gehenna /* check for inexact */
374 1.1.4.2 gehenna if (inexact) {
375 1.1.4.2 gehenna if (Is_inexacttrap_enabled()) return(INEXACTEXCEPTION);
376 1.1.4.2 gehenna else Set_inexactflag();
377 1.1.4.2 gehenna }
378 1.1.4.2 gehenna return(NOEXCEPTION);
379 1.1.4.2 gehenna }
380