sfsub.c revision 1.1.4.2 1 1.1.4.2 gehenna /* $NetBSD: sfsub.c,v 1.1.4.2 2002/07/14 17:47:49 gehenna Exp $ */
2 1.1.4.2 gehenna
3 1.1.4.2 gehenna /* $OpenBSD: sfsub.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_subtract: subtract two single precision values.
49 1.1.4.2 gehenna */
50 1.1.4.2 gehenna int
51 1.1.4.2 gehenna sgl_fsub(leftptr, rightptr, dstptr, status)
52 1.1.4.2 gehenna sgl_floating_point *leftptr, *rightptr, *dstptr;
53 1.1.4.2 gehenna unsigned int *status;
54 1.1.4.2 gehenna {
55 1.1.4.2 gehenna register unsigned int left, right, result, extent;
56 1.1.4.2 gehenna register unsigned int signless_upper_left, signless_upper_right, save;
57 1.1.4.2 gehenna
58 1.1.4.2 gehenna register int result_exponent, right_exponent, diff_exponent;
59 1.1.4.2 gehenna register int sign_save, jumpsize;
60 1.1.4.2 gehenna register int inexact = FALSE, underflowtrap;
61 1.1.4.2 gehenna
62 1.1.4.2 gehenna /* Create local copies of the numbers */
63 1.1.4.2 gehenna left = *leftptr;
64 1.1.4.2 gehenna right = *rightptr;
65 1.1.4.2 gehenna
66 1.1.4.2 gehenna /* A zero "save" helps discover equal operands (for later), *
67 1.1.4.2 gehenna * and is used in swapping operands (if needed). */
68 1.1.4.2 gehenna Sgl_xortointp1(left,right,/*to*/save);
69 1.1.4.2 gehenna
70 1.1.4.2 gehenna /*
71 1.1.4.2 gehenna * check first operand for NaN's or infinity
72 1.1.4.2 gehenna */
73 1.1.4.2 gehenna if ((result_exponent = Sgl_exponent(left)) == SGL_INFINITY_EXPONENT)
74 1.1.4.2 gehenna {
75 1.1.4.2 gehenna if (Sgl_iszero_mantissa(left))
76 1.1.4.2 gehenna {
77 1.1.4.2 gehenna if (Sgl_isnotnan(right))
78 1.1.4.2 gehenna {
79 1.1.4.2 gehenna if (Sgl_isinfinity(right) && save==0)
80 1.1.4.2 gehenna {
81 1.1.4.2 gehenna /*
82 1.1.4.2 gehenna * invalid since operands are same signed infinity's
83 1.1.4.2 gehenna */
84 1.1.4.2 gehenna if (Is_invalidtrap_enabled()) return(INVALIDEXCEPTION);
85 1.1.4.2 gehenna Set_invalidflag();
86 1.1.4.2 gehenna Sgl_makequietnan(result);
87 1.1.4.2 gehenna *dstptr = result;
88 1.1.4.2 gehenna return(NOEXCEPTION);
89 1.1.4.2 gehenna }
90 1.1.4.2 gehenna /*
91 1.1.4.2 gehenna * return infinity
92 1.1.4.2 gehenna */
93 1.1.4.2 gehenna *dstptr = left;
94 1.1.4.2 gehenna return(NOEXCEPTION);
95 1.1.4.2 gehenna }
96 1.1.4.2 gehenna }
97 1.1.4.2 gehenna else
98 1.1.4.2 gehenna {
99 1.1.4.2 gehenna /*
100 1.1.4.2 gehenna * is NaN; signaling or quiet?
101 1.1.4.2 gehenna */
102 1.1.4.2 gehenna if (Sgl_isone_signaling(left))
103 1.1.4.2 gehenna {
104 1.1.4.2 gehenna /* trap if INVALIDTRAP enabled */
105 1.1.4.2 gehenna if (Is_invalidtrap_enabled()) return(INVALIDEXCEPTION);
106 1.1.4.2 gehenna /* make NaN quiet */
107 1.1.4.2 gehenna Set_invalidflag();
108 1.1.4.2 gehenna Sgl_set_quiet(left);
109 1.1.4.2 gehenna }
110 1.1.4.2 gehenna /*
111 1.1.4.2 gehenna * is second operand a signaling NaN?
112 1.1.4.2 gehenna */
113 1.1.4.2 gehenna else if (Sgl_is_signalingnan(right))
114 1.1.4.2 gehenna {
115 1.1.4.2 gehenna /* trap if INVALIDTRAP enabled */
116 1.1.4.2 gehenna if (Is_invalidtrap_enabled()) return(INVALIDEXCEPTION);
117 1.1.4.2 gehenna /* make NaN quiet */
118 1.1.4.2 gehenna Set_invalidflag();
119 1.1.4.2 gehenna Sgl_set_quiet(right);
120 1.1.4.2 gehenna *dstptr = right;
121 1.1.4.2 gehenna return(NOEXCEPTION);
122 1.1.4.2 gehenna }
123 1.1.4.2 gehenna /*
124 1.1.4.2 gehenna * return quiet NaN
125 1.1.4.2 gehenna */
126 1.1.4.2 gehenna *dstptr = left;
127 1.1.4.2 gehenna return(NOEXCEPTION);
128 1.1.4.2 gehenna }
129 1.1.4.2 gehenna } /* End left NaN or Infinity processing */
130 1.1.4.2 gehenna /*
131 1.1.4.2 gehenna * check second operand for NaN's or infinity
132 1.1.4.2 gehenna */
133 1.1.4.2 gehenna if (Sgl_isinfinity_exponent(right))
134 1.1.4.2 gehenna {
135 1.1.4.2 gehenna if (Sgl_iszero_mantissa(right))
136 1.1.4.2 gehenna {
137 1.1.4.2 gehenna /* return infinity */
138 1.1.4.2 gehenna Sgl_invert_sign(right);
139 1.1.4.2 gehenna *dstptr = right;
140 1.1.4.2 gehenna return(NOEXCEPTION);
141 1.1.4.2 gehenna }
142 1.1.4.2 gehenna /*
143 1.1.4.2 gehenna * is NaN; signaling or quiet?
144 1.1.4.2 gehenna */
145 1.1.4.2 gehenna if (Sgl_isone_signaling(right))
146 1.1.4.2 gehenna {
147 1.1.4.2 gehenna /* trap if INVALIDTRAP enabled */
148 1.1.4.2 gehenna if (Is_invalidtrap_enabled()) return(INVALIDEXCEPTION);
149 1.1.4.2 gehenna /* make NaN quiet */
150 1.1.4.2 gehenna Set_invalidflag();
151 1.1.4.2 gehenna Sgl_set_quiet(right);
152 1.1.4.2 gehenna }
153 1.1.4.2 gehenna /*
154 1.1.4.2 gehenna * return quiet NaN
155 1.1.4.2 gehenna */
156 1.1.4.2 gehenna *dstptr = right;
157 1.1.4.2 gehenna return(NOEXCEPTION);
158 1.1.4.2 gehenna } /* End right NaN or Infinity processing */
159 1.1.4.2 gehenna
160 1.1.4.2 gehenna /* Invariant: Must be dealing with finite numbers */
161 1.1.4.2 gehenna
162 1.1.4.2 gehenna /* Compare operands by removing the sign */
163 1.1.4.2 gehenna Sgl_copytoint_exponentmantissa(left,signless_upper_left);
164 1.1.4.2 gehenna Sgl_copytoint_exponentmantissa(right,signless_upper_right);
165 1.1.4.2 gehenna
166 1.1.4.2 gehenna /* sign difference selects sub or add operation. */
167 1.1.4.2 gehenna if(Sgl_ismagnitudeless(signless_upper_left,signless_upper_right))
168 1.1.4.2 gehenna {
169 1.1.4.2 gehenna /* Set the left operand to the larger one by XOR swap *
170 1.1.4.2 gehenna * First finish the first word using "save" */
171 1.1.4.2 gehenna Sgl_xorfromintp1(save,right,/*to*/right);
172 1.1.4.2 gehenna Sgl_xorfromintp1(save,left,/*to*/left);
173 1.1.4.2 gehenna result_exponent = Sgl_exponent(left);
174 1.1.4.2 gehenna Sgl_invert_sign(left);
175 1.1.4.2 gehenna }
176 1.1.4.2 gehenna /* Invariant: left is not smaller than right. */
177 1.1.4.2 gehenna
178 1.1.4.2 gehenna if((right_exponent = Sgl_exponent(right)) == 0)
179 1.1.4.2 gehenna {
180 1.1.4.2 gehenna /* Denormalized operands. First look for zeroes */
181 1.1.4.2 gehenna if(Sgl_iszero_mantissa(right))
182 1.1.4.2 gehenna {
183 1.1.4.2 gehenna /* right is zero */
184 1.1.4.2 gehenna if(Sgl_iszero_exponentmantissa(left))
185 1.1.4.2 gehenna {
186 1.1.4.2 gehenna /* Both operands are zeros */
187 1.1.4.2 gehenna Sgl_invert_sign(right);
188 1.1.4.2 gehenna if(Is_rounding_mode(ROUNDMINUS))
189 1.1.4.2 gehenna {
190 1.1.4.2 gehenna Sgl_or_signs(left,/*with*/right);
191 1.1.4.2 gehenna }
192 1.1.4.2 gehenna else
193 1.1.4.2 gehenna {
194 1.1.4.2 gehenna Sgl_and_signs(left,/*with*/right);
195 1.1.4.2 gehenna }
196 1.1.4.2 gehenna }
197 1.1.4.2 gehenna else
198 1.1.4.2 gehenna {
199 1.1.4.2 gehenna /* Left is not a zero and must be the result. Trapped
200 1.1.4.2 gehenna * underflows are signaled if left is denormalized. Result
201 1.1.4.2 gehenna * is always exact. */
202 1.1.4.2 gehenna if( (result_exponent == 0) && Is_underflowtrap_enabled() )
203 1.1.4.2 gehenna {
204 1.1.4.2 gehenna /* need to normalize results mantissa */
205 1.1.4.2 gehenna sign_save = Sgl_signextendedsign(left);
206 1.1.4.2 gehenna Sgl_leftshiftby1(left);
207 1.1.4.2 gehenna Sgl_normalize(left,result_exponent);
208 1.1.4.2 gehenna Sgl_set_sign(left,/*using*/sign_save);
209 1.1.4.2 gehenna Sgl_setwrapped_exponent(left,result_exponent,unfl);
210 1.1.4.2 gehenna *dstptr = left;
211 1.1.4.2 gehenna /* inexact = FALSE */
212 1.1.4.2 gehenna return(UNDERFLOWEXCEPTION);
213 1.1.4.2 gehenna }
214 1.1.4.2 gehenna }
215 1.1.4.2 gehenna *dstptr = left;
216 1.1.4.2 gehenna return(NOEXCEPTION);
217 1.1.4.2 gehenna }
218 1.1.4.2 gehenna
219 1.1.4.2 gehenna /* Neither are zeroes */
220 1.1.4.2 gehenna Sgl_clear_sign(right); /* Exponent is already cleared */
221 1.1.4.2 gehenna if(result_exponent == 0 )
222 1.1.4.2 gehenna {
223 1.1.4.2 gehenna /* Both operands are denormalized. The result must be exact
224 1.1.4.2 gehenna * and is simply calculated. A sum could become normalized and a
225 1.1.4.2 gehenna * difference could cancel to a true zero. */
226 1.1.4.2 gehenna if( (/*signed*/int) save >= 0 )
227 1.1.4.2 gehenna {
228 1.1.4.2 gehenna Sgl_subtract(left,/*minus*/right,/*into*/result);
229 1.1.4.2 gehenna if(Sgl_iszero_mantissa(result))
230 1.1.4.2 gehenna {
231 1.1.4.2 gehenna if(Is_rounding_mode(ROUNDMINUS))
232 1.1.4.2 gehenna {
233 1.1.4.2 gehenna Sgl_setone_sign(result);
234 1.1.4.2 gehenna }
235 1.1.4.2 gehenna else
236 1.1.4.2 gehenna {
237 1.1.4.2 gehenna Sgl_setzero_sign(result);
238 1.1.4.2 gehenna }
239 1.1.4.2 gehenna *dstptr = result;
240 1.1.4.2 gehenna return(NOEXCEPTION);
241 1.1.4.2 gehenna }
242 1.1.4.2 gehenna }
243 1.1.4.2 gehenna else
244 1.1.4.2 gehenna {
245 1.1.4.2 gehenna Sgl_addition(left,right,/*into*/result);
246 1.1.4.2 gehenna if(Sgl_isone_hidden(result))
247 1.1.4.2 gehenna {
248 1.1.4.2 gehenna *dstptr = result;
249 1.1.4.2 gehenna return(NOEXCEPTION);
250 1.1.4.2 gehenna }
251 1.1.4.2 gehenna }
252 1.1.4.2 gehenna if(Is_underflowtrap_enabled())
253 1.1.4.2 gehenna {
254 1.1.4.2 gehenna /* need to normalize result */
255 1.1.4.2 gehenna sign_save = Sgl_signextendedsign(result);
256 1.1.4.2 gehenna Sgl_leftshiftby1(result);
257 1.1.4.2 gehenna Sgl_normalize(result,result_exponent);
258 1.1.4.2 gehenna Sgl_set_sign(result,/*using*/sign_save);
259 1.1.4.2 gehenna Sgl_setwrapped_exponent(result,result_exponent,unfl);
260 1.1.4.2 gehenna *dstptr = result;
261 1.1.4.2 gehenna /* inexact = FALSE */
262 1.1.4.2 gehenna return(UNDERFLOWEXCEPTION);
263 1.1.4.2 gehenna }
264 1.1.4.2 gehenna *dstptr = result;
265 1.1.4.2 gehenna return(NOEXCEPTION);
266 1.1.4.2 gehenna }
267 1.1.4.2 gehenna right_exponent = 1; /* Set exponent to reflect different bias
268 1.1.4.2 gehenna * with denomalized numbers. */
269 1.1.4.2 gehenna }
270 1.1.4.2 gehenna else
271 1.1.4.2 gehenna {
272 1.1.4.2 gehenna Sgl_clear_signexponent_set_hidden(right);
273 1.1.4.2 gehenna }
274 1.1.4.2 gehenna Sgl_clear_exponent_set_hidden(left);
275 1.1.4.2 gehenna diff_exponent = result_exponent - right_exponent;
276 1.1.4.2 gehenna
277 1.1.4.2 gehenna /*
278 1.1.4.2 gehenna * Special case alignment of operands that would force alignment
279 1.1.4.2 gehenna * beyond the extent of the extension. A further optimization
280 1.1.4.2 gehenna * could special case this but only reduces the path length for this
281 1.1.4.2 gehenna * infrequent case.
282 1.1.4.2 gehenna */
283 1.1.4.2 gehenna if(diff_exponent > SGL_THRESHOLD)
284 1.1.4.2 gehenna {
285 1.1.4.2 gehenna diff_exponent = SGL_THRESHOLD;
286 1.1.4.2 gehenna }
287 1.1.4.2 gehenna
288 1.1.4.2 gehenna /* Align right operand by shifting to right */
289 1.1.4.2 gehenna Sgl_right_align(/*operand*/right,/*shifted by*/diff_exponent,
290 1.1.4.2 gehenna /*and lower to*/extent);
291 1.1.4.2 gehenna
292 1.1.4.2 gehenna /* Treat sum and difference of the operands separately. */
293 1.1.4.2 gehenna if( (/*signed*/int) save >= 0 )
294 1.1.4.2 gehenna {
295 1.1.4.2 gehenna /*
296 1.1.4.2 gehenna * Difference of the two operands. Their can be no overflow. A
297 1.1.4.2 gehenna * borrow can occur out of the hidden bit and force a post
298 1.1.4.2 gehenna * normalization phase.
299 1.1.4.2 gehenna */
300 1.1.4.2 gehenna Sgl_subtract_withextension(left,/*minus*/right,/*with*/extent,/*into*/result);
301 1.1.4.2 gehenna if(Sgl_iszero_hidden(result))
302 1.1.4.2 gehenna {
303 1.1.4.2 gehenna /* Handle normalization */
304 1.1.4.2 gehenna /* A straight foward algorithm would now shift the result
305 1.1.4.2 gehenna * and extension left until the hidden bit becomes one. Not
306 1.1.4.2 gehenna * all of the extension bits need participate in the shift.
307 1.1.4.2 gehenna * Only the two most significant bits (round and guard) are
308 1.1.4.2 gehenna * needed. If only a single shift is needed then the guard
309 1.1.4.2 gehenna * bit becomes a significant low order bit and the extension
310 1.1.4.2 gehenna * must participate in the rounding. If more than a single
311 1.1.4.2 gehenna * shift is needed, then all bits to the right of the guard
312 1.1.4.2 gehenna * bit are zeros, and the guard bit may or may not be zero. */
313 1.1.4.2 gehenna sign_save = Sgl_signextendedsign(result);
314 1.1.4.2 gehenna Sgl_leftshiftby1_withextent(result,extent,result);
315 1.1.4.2 gehenna
316 1.1.4.2 gehenna /* Need to check for a zero result. The sign and exponent
317 1.1.4.2 gehenna * fields have already been zeroed. The more efficient test
318 1.1.4.2 gehenna * of the full object can be used.
319 1.1.4.2 gehenna */
320 1.1.4.2 gehenna if(Sgl_iszero(result))
321 1.1.4.2 gehenna /* Must have been "x-x" or "x+(-x)". */
322 1.1.4.2 gehenna {
323 1.1.4.2 gehenna if(Is_rounding_mode(ROUNDMINUS)) Sgl_setone_sign(result);
324 1.1.4.2 gehenna *dstptr = result;
325 1.1.4.2 gehenna return(NOEXCEPTION);
326 1.1.4.2 gehenna }
327 1.1.4.2 gehenna result_exponent--;
328 1.1.4.2 gehenna /* Look to see if normalization is finished. */
329 1.1.4.2 gehenna if(Sgl_isone_hidden(result))
330 1.1.4.2 gehenna {
331 1.1.4.2 gehenna if(result_exponent==0)
332 1.1.4.2 gehenna {
333 1.1.4.2 gehenna /* Denormalized, exponent should be zero. Left operand *
334 1.1.4.2 gehenna * was normalized, so extent (guard, round) was zero */
335 1.1.4.2 gehenna goto underflow;
336 1.1.4.2 gehenna }
337 1.1.4.2 gehenna else
338 1.1.4.2 gehenna {
339 1.1.4.2 gehenna /* No further normalization is needed. */
340 1.1.4.2 gehenna Sgl_set_sign(result,/*using*/sign_save);
341 1.1.4.2 gehenna Ext_leftshiftby1(extent);
342 1.1.4.2 gehenna goto round;
343 1.1.4.2 gehenna }
344 1.1.4.2 gehenna }
345 1.1.4.2 gehenna
346 1.1.4.2 gehenna /* Check for denormalized, exponent should be zero. Left *
347 1.1.4.2 gehenna * operand was normalized, so extent (guard, round) was zero */
348 1.1.4.2 gehenna if(!(underflowtrap = Is_underflowtrap_enabled()) &&
349 1.1.4.2 gehenna result_exponent==0) goto underflow;
350 1.1.4.2 gehenna
351 1.1.4.2 gehenna /* Shift extension to complete one bit of normalization and
352 1.1.4.2 gehenna * update exponent. */
353 1.1.4.2 gehenna Ext_leftshiftby1(extent);
354 1.1.4.2 gehenna
355 1.1.4.2 gehenna /* Discover first one bit to determine shift amount. Use a
356 1.1.4.2 gehenna * modified binary search. We have already shifted the result
357 1.1.4.2 gehenna * one position right and still not found a one so the remainder
358 1.1.4.2 gehenna * of the extension must be zero and simplifies rounding. */
359 1.1.4.2 gehenna /* Scan bytes */
360 1.1.4.2 gehenna while(Sgl_iszero_hiddenhigh7mantissa(result))
361 1.1.4.2 gehenna {
362 1.1.4.2 gehenna Sgl_leftshiftby8(result);
363 1.1.4.2 gehenna if((result_exponent -= 8) <= 0 && !underflowtrap)
364 1.1.4.2 gehenna goto underflow;
365 1.1.4.2 gehenna }
366 1.1.4.2 gehenna /* Now narrow it down to the nibble */
367 1.1.4.2 gehenna if(Sgl_iszero_hiddenhigh3mantissa(result))
368 1.1.4.2 gehenna {
369 1.1.4.2 gehenna /* The lower nibble contains the normalizing one */
370 1.1.4.2 gehenna Sgl_leftshiftby4(result);
371 1.1.4.2 gehenna if((result_exponent -= 4) <= 0 && !underflowtrap)
372 1.1.4.2 gehenna goto underflow;
373 1.1.4.2 gehenna }
374 1.1.4.2 gehenna /* Select case were first bit is set (already normalized)
375 1.1.4.2 gehenna * otherwise select the proper shift. */
376 1.1.4.2 gehenna if((jumpsize = Sgl_hiddenhigh3mantissa(result)) > 7)
377 1.1.4.2 gehenna {
378 1.1.4.2 gehenna /* Already normalized */
379 1.1.4.2 gehenna if(result_exponent <= 0) goto underflow;
380 1.1.4.2 gehenna Sgl_set_sign(result,/*using*/sign_save);
381 1.1.4.2 gehenna Sgl_set_exponent(result,/*using*/result_exponent);
382 1.1.4.2 gehenna *dstptr = result;
383 1.1.4.2 gehenna return(NOEXCEPTION);
384 1.1.4.2 gehenna }
385 1.1.4.2 gehenna Sgl_sethigh4bits(result,/*using*/sign_save);
386 1.1.4.2 gehenna switch(jumpsize)
387 1.1.4.2 gehenna {
388 1.1.4.2 gehenna case 1:
389 1.1.4.2 gehenna {
390 1.1.4.2 gehenna Sgl_leftshiftby3(result);
391 1.1.4.2 gehenna result_exponent -= 3;
392 1.1.4.2 gehenna break;
393 1.1.4.2 gehenna }
394 1.1.4.2 gehenna case 2:
395 1.1.4.2 gehenna case 3:
396 1.1.4.2 gehenna {
397 1.1.4.2 gehenna Sgl_leftshiftby2(result);
398 1.1.4.2 gehenna result_exponent -= 2;
399 1.1.4.2 gehenna break;
400 1.1.4.2 gehenna }
401 1.1.4.2 gehenna case 4:
402 1.1.4.2 gehenna case 5:
403 1.1.4.2 gehenna case 6:
404 1.1.4.2 gehenna case 7:
405 1.1.4.2 gehenna {
406 1.1.4.2 gehenna Sgl_leftshiftby1(result);
407 1.1.4.2 gehenna result_exponent -= 1;
408 1.1.4.2 gehenna break;
409 1.1.4.2 gehenna }
410 1.1.4.2 gehenna }
411 1.1.4.2 gehenna if(result_exponent > 0)
412 1.1.4.2 gehenna {
413 1.1.4.2 gehenna Sgl_set_exponent(result,/*using*/result_exponent);
414 1.1.4.2 gehenna *dstptr = result; /* Sign bit is already set */
415 1.1.4.2 gehenna return(NOEXCEPTION);
416 1.1.4.2 gehenna }
417 1.1.4.2 gehenna /* Fixup potential underflows */
418 1.1.4.2 gehenna underflow:
419 1.1.4.2 gehenna if(Is_underflowtrap_enabled())
420 1.1.4.2 gehenna {
421 1.1.4.2 gehenna Sgl_set_sign(result,sign_save);
422 1.1.4.2 gehenna Sgl_setwrapped_exponent(result,result_exponent,unfl);
423 1.1.4.2 gehenna *dstptr = result;
424 1.1.4.2 gehenna /* inexact = FALSE */
425 1.1.4.2 gehenna return(UNDERFLOWEXCEPTION);
426 1.1.4.2 gehenna }
427 1.1.4.2 gehenna /*
428 1.1.4.2 gehenna * Since we cannot get an inexact denormalized result,
429 1.1.4.2 gehenna * we can now return.
430 1.1.4.2 gehenna */
431 1.1.4.2 gehenna Sgl_right_align(result,/*by*/(1-result_exponent),extent);
432 1.1.4.2 gehenna Sgl_clear_signexponent(result);
433 1.1.4.2 gehenna Sgl_set_sign(result,sign_save);
434 1.1.4.2 gehenna *dstptr = result;
435 1.1.4.2 gehenna return(NOEXCEPTION);
436 1.1.4.2 gehenna } /* end if(hidden...)... */
437 1.1.4.2 gehenna /* Fall through and round */
438 1.1.4.2 gehenna } /* end if(save >= 0)... */
439 1.1.4.2 gehenna else
440 1.1.4.2 gehenna {
441 1.1.4.2 gehenna /* Add magnitudes */
442 1.1.4.2 gehenna Sgl_addition(left,right,/*to*/result);
443 1.1.4.2 gehenna if(Sgl_isone_hiddenoverflow(result))
444 1.1.4.2 gehenna {
445 1.1.4.2 gehenna /* Prenormalization required. */
446 1.1.4.2 gehenna Sgl_rightshiftby1_withextent(result,extent,extent);
447 1.1.4.2 gehenna Sgl_arithrightshiftby1(result);
448 1.1.4.2 gehenna result_exponent++;
449 1.1.4.2 gehenna } /* end if hiddenoverflow... */
450 1.1.4.2 gehenna } /* end else ...sub magnitudes... */
451 1.1.4.2 gehenna
452 1.1.4.2 gehenna /* Round the result. If the extension is all zeros,then the result is
453 1.1.4.2 gehenna * exact. Otherwise round in the correct direction. No underflow is
454 1.1.4.2 gehenna * possible. If a postnormalization is necessary, then the mantissa is
455 1.1.4.2 gehenna * all zeros so no shift is needed. */
456 1.1.4.2 gehenna round:
457 1.1.4.2 gehenna if(Ext_isnotzero(extent))
458 1.1.4.2 gehenna {
459 1.1.4.2 gehenna inexact = TRUE;
460 1.1.4.2 gehenna switch(Rounding_mode())
461 1.1.4.2 gehenna {
462 1.1.4.2 gehenna case ROUNDNEAREST: /* The default. */
463 1.1.4.2 gehenna if(Ext_isone_sign(extent))
464 1.1.4.2 gehenna {
465 1.1.4.2 gehenna /* at least 1/2 ulp */
466 1.1.4.2 gehenna if(Ext_isnotzero_lower(extent) ||
467 1.1.4.2 gehenna Sgl_isone_lowmantissa(result))
468 1.1.4.2 gehenna {
469 1.1.4.2 gehenna /* either exactly half way and odd or more than 1/2ulp */
470 1.1.4.2 gehenna Sgl_increment(result);
471 1.1.4.2 gehenna }
472 1.1.4.2 gehenna }
473 1.1.4.2 gehenna break;
474 1.1.4.2 gehenna
475 1.1.4.2 gehenna case ROUNDPLUS:
476 1.1.4.2 gehenna if(Sgl_iszero_sign(result))
477 1.1.4.2 gehenna {
478 1.1.4.2 gehenna /* Round up positive results */
479 1.1.4.2 gehenna Sgl_increment(result);
480 1.1.4.2 gehenna }
481 1.1.4.2 gehenna break;
482 1.1.4.2 gehenna
483 1.1.4.2 gehenna case ROUNDMINUS:
484 1.1.4.2 gehenna if(Sgl_isone_sign(result))
485 1.1.4.2 gehenna {
486 1.1.4.2 gehenna /* Round down negative results */
487 1.1.4.2 gehenna Sgl_increment(result);
488 1.1.4.2 gehenna }
489 1.1.4.2 gehenna
490 1.1.4.2 gehenna case ROUNDZERO:;
491 1.1.4.2 gehenna /* truncate is simple */
492 1.1.4.2 gehenna } /* end switch... */
493 1.1.4.2 gehenna if(Sgl_isone_hiddenoverflow(result)) result_exponent++;
494 1.1.4.2 gehenna }
495 1.1.4.2 gehenna if(result_exponent == SGL_INFINITY_EXPONENT)
496 1.1.4.2 gehenna {
497 1.1.4.2 gehenna /* Overflow */
498 1.1.4.2 gehenna if(Is_overflowtrap_enabled())
499 1.1.4.2 gehenna {
500 1.1.4.2 gehenna Sgl_setwrapped_exponent(result,result_exponent,ovfl);
501 1.1.4.2 gehenna *dstptr = result;
502 1.1.4.2 gehenna if (inexact) {
503 1.1.4.2 gehenna if (Is_inexacttrap_enabled())
504 1.1.4.2 gehenna return(OVERFLOWEXCEPTION | INEXACTEXCEPTION);
505 1.1.4.2 gehenna else Set_inexactflag();
506 1.1.4.2 gehenna }
507 1.1.4.2 gehenna return(OVERFLOWEXCEPTION);
508 1.1.4.2 gehenna }
509 1.1.4.2 gehenna else
510 1.1.4.2 gehenna {
511 1.1.4.2 gehenna Set_overflowflag();
512 1.1.4.2 gehenna inexact = TRUE;
513 1.1.4.2 gehenna Sgl_setoverflow(result);
514 1.1.4.2 gehenna }
515 1.1.4.2 gehenna }
516 1.1.4.2 gehenna else Sgl_set_exponent(result,result_exponent);
517 1.1.4.2 gehenna *dstptr = result;
518 1.1.4.2 gehenna if(inexact) {
519 1.1.4.2 gehenna if(Is_inexacttrap_enabled()) return(INEXACTEXCEPTION);
520 1.1.4.2 gehenna else Set_inexactflag();
521 1.1.4.2 gehenna }
522 1.1.4.2 gehenna return(NOEXCEPTION);
523 1.1.4.2 gehenna }
524