1*f1c0e920Sjsg /* $OpenBSD: dfmpy.c,v 1.6 2015/05/07 01:55:43 jsg Exp $ */
2c2feb252Smickey /*
3c2feb252Smickey (c) Copyright 1986 HEWLETT-PACKARD COMPANY
4c2feb252Smickey To anyone who acknowledges that this file is provided "AS IS"
5c2feb252Smickey without any express or implied warranty:
6c2feb252Smickey permission to use, copy, modify, and distribute this file
7c2feb252Smickey for any purpose is hereby granted without fee, provided that
8c2feb252Smickey the above copyright notice and this notice appears in all
9c2feb252Smickey copies, and that the name of Hewlett-Packard Company not be
10c2feb252Smickey used in advertising or publicity pertaining to distribution
11c2feb252Smickey of the software without specific, written prior permission.
12c2feb252Smickey Hewlett-Packard Company makes no representations about the
13c2feb252Smickey suitability of this software for any purpose.
14c2feb252Smickey */
15c2feb252Smickey /* @(#)dfmpy.c: Revision: 2.11.88.1 Date: 93/12/07 15:05:41 */
16b94afd46Smickey
17c2feb252Smickey #include "float.h"
18c2feb252Smickey #include "dbl_float.h"
198a472b3eSmickey
208a472b3eSmickey /*
218a472b3eSmickey * Double Precision Floating-point Multiply
228a472b3eSmickey */
238a472b3eSmickey
24b94afd46Smickey int
dbl_fmpy(srcptr1,srcptr2,dstptr,status)258a472b3eSmickey dbl_fmpy(srcptr1,srcptr2,dstptr,status)
268a472b3eSmickey dbl_floating_point *srcptr1, *srcptr2, *dstptr;
278a472b3eSmickey unsigned int *status;
288a472b3eSmickey {
298a472b3eSmickey register unsigned int opnd1p1, opnd1p2, opnd2p1, opnd2p2;
308a472b3eSmickey register unsigned int opnd3p1, opnd3p2, resultp1, resultp2;
318a472b3eSmickey register int dest_exponent, count;
32628bbdd4Smickey register int inexact = FALSE, guardbit = FALSE, stickybit = FALSE;
33628bbdd4Smickey int is_tiny;
348a472b3eSmickey
358a472b3eSmickey Dbl_copyfromptr(srcptr1,opnd1p1,opnd1p2);
368a472b3eSmickey Dbl_copyfromptr(srcptr2,opnd2p1,opnd2p2);
378a472b3eSmickey
388a472b3eSmickey /*
398a472b3eSmickey * set sign bit of result
408a472b3eSmickey */
418a472b3eSmickey if (Dbl_sign(opnd1p1) ^ Dbl_sign(opnd2p1))
428a472b3eSmickey Dbl_setnegativezerop1(resultp1);
438a472b3eSmickey else Dbl_setzerop1(resultp1);
448a472b3eSmickey /*
458a472b3eSmickey * check first operand for NaN's or infinity
468a472b3eSmickey */
478a472b3eSmickey if (Dbl_isinfinity_exponent(opnd1p1)) {
488a472b3eSmickey if (Dbl_iszero_mantissa(opnd1p1,opnd1p2)) {
498a472b3eSmickey if (Dbl_isnotnan(opnd2p1,opnd2p2)) {
508a472b3eSmickey if (Dbl_iszero_exponentmantissa(opnd2p1,opnd2p2)) {
518a472b3eSmickey /*
528a472b3eSmickey * invalid since operands are infinity
538a472b3eSmickey * and zero
548a472b3eSmickey */
558a472b3eSmickey if (Is_invalidtrap_enabled())
568a472b3eSmickey return(INVALIDEXCEPTION);
578a472b3eSmickey Set_invalidflag();
588a472b3eSmickey Dbl_makequietnan(resultp1,resultp2);
598a472b3eSmickey Dbl_copytoptr(resultp1,resultp2,dstptr);
608a472b3eSmickey return(NOEXCEPTION);
618a472b3eSmickey }
628a472b3eSmickey /*
638a472b3eSmickey * return infinity
648a472b3eSmickey */
658a472b3eSmickey Dbl_setinfinity_exponentmantissa(resultp1,resultp2);
668a472b3eSmickey Dbl_copytoptr(resultp1,resultp2,dstptr);
678a472b3eSmickey return(NOEXCEPTION);
688a472b3eSmickey }
698a472b3eSmickey }
708a472b3eSmickey else {
718a472b3eSmickey /*
728a472b3eSmickey * is NaN; signaling or quiet?
738a472b3eSmickey */
748a472b3eSmickey if (Dbl_isone_signaling(opnd1p1)) {
758a472b3eSmickey /* trap if INVALIDTRAP enabled */
768a472b3eSmickey if (Is_invalidtrap_enabled())
778a472b3eSmickey return(INVALIDEXCEPTION);
788a472b3eSmickey /* make NaN quiet */
798a472b3eSmickey Set_invalidflag();
808a472b3eSmickey Dbl_set_quiet(opnd1p1);
818a472b3eSmickey }
828a472b3eSmickey /*
838a472b3eSmickey * is second operand a signaling NaN?
848a472b3eSmickey */
858a472b3eSmickey else if (Dbl_is_signalingnan(opnd2p1)) {
868a472b3eSmickey /* trap if INVALIDTRAP enabled */
878a472b3eSmickey if (Is_invalidtrap_enabled())
888a472b3eSmickey return(INVALIDEXCEPTION);
898a472b3eSmickey /* make NaN quiet */
908a472b3eSmickey Set_invalidflag();
918a472b3eSmickey Dbl_set_quiet(opnd2p1);
928a472b3eSmickey Dbl_copytoptr(opnd2p1,opnd2p2,dstptr);
938a472b3eSmickey return(NOEXCEPTION);
948a472b3eSmickey }
958a472b3eSmickey /*
968a472b3eSmickey * return quiet NaN
978a472b3eSmickey */
988a472b3eSmickey Dbl_copytoptr(opnd1p1,opnd1p2,dstptr);
998a472b3eSmickey return(NOEXCEPTION);
1008a472b3eSmickey }
1018a472b3eSmickey }
1028a472b3eSmickey /*
1038a472b3eSmickey * check second operand for NaN's or infinity
1048a472b3eSmickey */
1058a472b3eSmickey if (Dbl_isinfinity_exponent(opnd2p1)) {
1068a472b3eSmickey if (Dbl_iszero_mantissa(opnd2p1,opnd2p2)) {
1078a472b3eSmickey if (Dbl_iszero_exponentmantissa(opnd1p1,opnd1p2)) {
1088a472b3eSmickey /* invalid since operands are zero & infinity */
1098a472b3eSmickey if (Is_invalidtrap_enabled())
1108a472b3eSmickey return(INVALIDEXCEPTION);
1118a472b3eSmickey Set_invalidflag();
1128a472b3eSmickey Dbl_makequietnan(opnd2p1,opnd2p2);
1138a472b3eSmickey Dbl_copytoptr(opnd2p1,opnd2p2,dstptr);
1148a472b3eSmickey return(NOEXCEPTION);
1158a472b3eSmickey }
1168a472b3eSmickey /*
1178a472b3eSmickey * return infinity
1188a472b3eSmickey */
1198a472b3eSmickey Dbl_setinfinity_exponentmantissa(resultp1,resultp2);
1208a472b3eSmickey Dbl_copytoptr(resultp1,resultp2,dstptr);
1218a472b3eSmickey return(NOEXCEPTION);
1228a472b3eSmickey }
1238a472b3eSmickey /*
1248a472b3eSmickey * is NaN; signaling or quiet?
1258a472b3eSmickey */
1268a472b3eSmickey if (Dbl_isone_signaling(opnd2p1)) {
1278a472b3eSmickey /* trap if INVALIDTRAP enabled */
1288a472b3eSmickey if (Is_invalidtrap_enabled()) return(INVALIDEXCEPTION);
1298a472b3eSmickey /* make NaN quiet */
1308a472b3eSmickey Set_invalidflag();
1318a472b3eSmickey Dbl_set_quiet(opnd2p1);
1328a472b3eSmickey }
1338a472b3eSmickey /*
1348a472b3eSmickey * return quiet NaN
1358a472b3eSmickey */
1368a472b3eSmickey Dbl_copytoptr(opnd2p1,opnd2p2,dstptr);
1378a472b3eSmickey return(NOEXCEPTION);
1388a472b3eSmickey }
1398a472b3eSmickey /*
1408a472b3eSmickey * Generate exponent
1418a472b3eSmickey */
1428a472b3eSmickey dest_exponent = Dbl_exponent(opnd1p1) + Dbl_exponent(opnd2p1) -DBL_BIAS;
1438a472b3eSmickey
1448a472b3eSmickey /*
1458a472b3eSmickey * Generate mantissa
1468a472b3eSmickey */
1478a472b3eSmickey if (Dbl_isnotzero_exponent(opnd1p1)) {
1488a472b3eSmickey /* set hidden bit */
1498a472b3eSmickey Dbl_clear_signexponent_set_hidden(opnd1p1);
1508a472b3eSmickey }
1518a472b3eSmickey else {
1528a472b3eSmickey /* check for zero */
1538a472b3eSmickey if (Dbl_iszero_mantissa(opnd1p1,opnd1p2)) {
1548a472b3eSmickey Dbl_setzero_exponentmantissa(resultp1,resultp2);
1558a472b3eSmickey Dbl_copytoptr(resultp1,resultp2,dstptr);
1568a472b3eSmickey return(NOEXCEPTION);
1578a472b3eSmickey }
1588a472b3eSmickey /* is denormalized, adjust exponent */
1598a472b3eSmickey Dbl_clear_signexponent(opnd1p1);
1608a472b3eSmickey Dbl_leftshiftby1(opnd1p1,opnd1p2);
1618a472b3eSmickey Dbl_normalize(opnd1p1,opnd1p2,dest_exponent);
1628a472b3eSmickey }
1638a472b3eSmickey /* opnd2 needs to have hidden bit set with msb in hidden bit */
1648a472b3eSmickey if (Dbl_isnotzero_exponent(opnd2p1)) {
1658a472b3eSmickey Dbl_clear_signexponent_set_hidden(opnd2p1);
1668a472b3eSmickey }
1678a472b3eSmickey else {
1688a472b3eSmickey /* check for zero */
1698a472b3eSmickey if (Dbl_iszero_mantissa(opnd2p1,opnd2p2)) {
1708a472b3eSmickey Dbl_setzero_exponentmantissa(resultp1,resultp2);
1718a472b3eSmickey Dbl_copytoptr(resultp1,resultp2,dstptr);
1728a472b3eSmickey return(NOEXCEPTION);
1738a472b3eSmickey }
1748a472b3eSmickey /* is denormalized; want to normalize */
1758a472b3eSmickey Dbl_clear_signexponent(opnd2p1);
1768a472b3eSmickey Dbl_leftshiftby1(opnd2p1,opnd2p2);
1778a472b3eSmickey Dbl_normalize(opnd2p1,opnd2p2,dest_exponent);
1788a472b3eSmickey }
1798a472b3eSmickey
1808a472b3eSmickey /* Multiply two source mantissas together */
1818a472b3eSmickey
1828a472b3eSmickey /* make room for guard bits */
1838a472b3eSmickey Dbl_leftshiftby7(opnd2p1,opnd2p2);
1848a472b3eSmickey Dbl_setzero(opnd3p1,opnd3p2);
1858a472b3eSmickey /*
1868a472b3eSmickey * Four bits at a time are inspected in each loop, and a
1878a472b3eSmickey * simple shift and add multiply algorithm is used.
1888a472b3eSmickey */
1898a472b3eSmickey for (count=1;count<=DBL_P;count+=4) {
1908a472b3eSmickey stickybit |= Dlow4p2(opnd3p2);
1918a472b3eSmickey Dbl_rightshiftby4(opnd3p1,opnd3p2);
1928a472b3eSmickey if (Dbit28p2(opnd1p2)) {
1938a472b3eSmickey /* Twoword_add should be an ADDC followed by an ADD. */
1948a472b3eSmickey Twoword_add(opnd3p1, opnd3p2, opnd2p1<<3 | opnd2p2>>29,
1958a472b3eSmickey opnd2p2<<3);
1968a472b3eSmickey }
1978a472b3eSmickey if (Dbit29p2(opnd1p2)) {
1988a472b3eSmickey Twoword_add(opnd3p1, opnd3p2, opnd2p1<<2 | opnd2p2>>30,
1998a472b3eSmickey opnd2p2<<2);
2008a472b3eSmickey }
2018a472b3eSmickey if (Dbit30p2(opnd1p2)) {
2028a472b3eSmickey Twoword_add(opnd3p1, opnd3p2, opnd2p1<<1 | opnd2p2>>31,
2038a472b3eSmickey opnd2p2<<1);
2048a472b3eSmickey }
2058a472b3eSmickey if (Dbit31p2(opnd1p2)) {
2068a472b3eSmickey Twoword_add(opnd3p1, opnd3p2, opnd2p1, opnd2p2);
2078a472b3eSmickey }
2088a472b3eSmickey Dbl_rightshiftby4(opnd1p1,opnd1p2);
2098a472b3eSmickey }
2108a472b3eSmickey if (Dbit3p1(opnd3p1)==0) {
2118a472b3eSmickey Dbl_leftshiftby1(opnd3p1,opnd3p2);
2128a472b3eSmickey }
2138a472b3eSmickey else {
2148a472b3eSmickey /* result mantissa >= 2. */
2158a472b3eSmickey dest_exponent++;
2168a472b3eSmickey }
2178a472b3eSmickey /* check for denormalized result */
2188a472b3eSmickey while (Dbit3p1(opnd3p1)==0) {
2198a472b3eSmickey Dbl_leftshiftby1(opnd3p1,opnd3p2);
2208a472b3eSmickey dest_exponent--;
2218a472b3eSmickey }
2228a472b3eSmickey /*
2238a472b3eSmickey * check for guard, sticky and inexact bits
2248a472b3eSmickey */
2258a472b3eSmickey stickybit |= Dallp2(opnd3p2) << 25;
2268a472b3eSmickey guardbit = (Dallp2(opnd3p2) << 24) >> 31;
2278a472b3eSmickey inexact = guardbit | stickybit;
2288a472b3eSmickey
2298a472b3eSmickey /* align result mantissa */
2308a472b3eSmickey Dbl_rightshiftby8(opnd3p1,opnd3p2);
2318a472b3eSmickey
2328a472b3eSmickey /*
2338a472b3eSmickey * round result
2348a472b3eSmickey */
2358a472b3eSmickey if (inexact && (dest_exponent>0 || Is_underflowtrap_enabled())) {
2368a472b3eSmickey Dbl_clear_signexponent(opnd3p1);
2378a472b3eSmickey switch (Rounding_mode()) {
2388a472b3eSmickey case ROUNDPLUS:
2398a472b3eSmickey if (Dbl_iszero_sign(resultp1))
2408a472b3eSmickey Dbl_increment(opnd3p1,opnd3p2);
2418a472b3eSmickey break;
2428a472b3eSmickey case ROUNDMINUS:
2438a472b3eSmickey if (Dbl_isone_sign(resultp1))
2448a472b3eSmickey Dbl_increment(opnd3p1,opnd3p2);
2458a472b3eSmickey break;
2468a472b3eSmickey case ROUNDNEAREST:
247628bbdd4Smickey if (guardbit &&
248628bbdd4Smickey (stickybit || Dbl_isone_lowmantissap2(opnd3p2)))
2498a472b3eSmickey Dbl_increment(opnd3p1,opnd3p2);
250628bbdd4Smickey break;
2518a472b3eSmickey }
2528a472b3eSmickey if (Dbl_isone_hidden(opnd3p1)) dest_exponent++;
2538a472b3eSmickey }
2548a472b3eSmickey Dbl_set_mantissa(resultp1,resultp2,opnd3p1,opnd3p2);
2558a472b3eSmickey
2568a472b3eSmickey /*
2578a472b3eSmickey * Test for overflow
2588a472b3eSmickey */
2598a472b3eSmickey if (dest_exponent >= DBL_INFINITY_EXPONENT) {
2608a472b3eSmickey /* trap if OVERFLOWTRAP enabled */
2618a472b3eSmickey if (Is_overflowtrap_enabled()) {
2628a472b3eSmickey /*
2638a472b3eSmickey * Adjust bias of result
2648a472b3eSmickey */
2658a472b3eSmickey Dbl_setwrapped_exponent(resultp1,dest_exponent,ovfl);
2668a472b3eSmickey Dbl_copytoptr(resultp1,resultp2,dstptr);
267b94afd46Smickey if (inexact) {
2688a472b3eSmickey if (Is_inexacttrap_enabled())
2698a472b3eSmickey return (OVERFLOWEXCEPTION | INEXACTEXCEPTION);
270b94afd46Smickey else
271b94afd46Smickey Set_inexactflag();
272b94afd46Smickey }
2738a472b3eSmickey return (OVERFLOWEXCEPTION);
2748a472b3eSmickey }
2758a472b3eSmickey inexact = TRUE;
2768a472b3eSmickey Set_overflowflag();
2778a472b3eSmickey /* set result to infinity or largest number */
2788a472b3eSmickey Dbl_setoverflow(resultp1,resultp2);
2798a472b3eSmickey }
2808a472b3eSmickey /*
2818a472b3eSmickey * Test for underflow
2828a472b3eSmickey */
2838a472b3eSmickey else if (dest_exponent <= 0) {
2848a472b3eSmickey /* trap if UNDERFLOWTRAP enabled */
2858a472b3eSmickey if (Is_underflowtrap_enabled()) {
2868a472b3eSmickey /*
2878a472b3eSmickey * Adjust bias of result
2888a472b3eSmickey */
2898a472b3eSmickey Dbl_setwrapped_exponent(resultp1,dest_exponent,unfl);
2908a472b3eSmickey Dbl_copytoptr(resultp1,resultp2,dstptr);
291b94afd46Smickey if (inexact) {
2928a472b3eSmickey if (Is_inexacttrap_enabled())
2938a472b3eSmickey return (UNDERFLOWEXCEPTION | INEXACTEXCEPTION);
294b94afd46Smickey else
295b94afd46Smickey Set_inexactflag();
296b94afd46Smickey }
2978a472b3eSmickey return (UNDERFLOWEXCEPTION);
2988a472b3eSmickey }
2998a472b3eSmickey
3008a472b3eSmickey /* Determine if should set underflow flag */
3018a472b3eSmickey is_tiny = TRUE;
3028a472b3eSmickey if (dest_exponent == 0 && inexact) {
3038a472b3eSmickey switch (Rounding_mode()) {
3048a472b3eSmickey case ROUNDPLUS:
3058a472b3eSmickey if (Dbl_iszero_sign(resultp1)) {
3068a472b3eSmickey Dbl_increment(opnd3p1,opnd3p2);
3078a472b3eSmickey if (Dbl_isone_hiddenoverflow(opnd3p1))
3088a472b3eSmickey is_tiny = FALSE;
3098a472b3eSmickey Dbl_decrement(opnd3p1,opnd3p2);
3108a472b3eSmickey }
3118a472b3eSmickey break;
3128a472b3eSmickey case ROUNDMINUS:
3138a472b3eSmickey if (Dbl_isone_sign(resultp1)) {
3148a472b3eSmickey Dbl_increment(opnd3p1,opnd3p2);
3158a472b3eSmickey if (Dbl_isone_hiddenoverflow(opnd3p1))
3168a472b3eSmickey is_tiny = FALSE;
3178a472b3eSmickey Dbl_decrement(opnd3p1,opnd3p2);
3188a472b3eSmickey }
3198a472b3eSmickey break;
3208a472b3eSmickey case ROUNDNEAREST:
3218a472b3eSmickey if (guardbit && (stickybit ||
3228a472b3eSmickey Dbl_isone_lowmantissap2(opnd3p2))) {
3238a472b3eSmickey Dbl_increment(opnd3p1,opnd3p2);
3248a472b3eSmickey if (Dbl_isone_hiddenoverflow(opnd3p1))
3258a472b3eSmickey is_tiny = FALSE;
3268a472b3eSmickey Dbl_decrement(opnd3p1,opnd3p2);
3278a472b3eSmickey }
3288a472b3eSmickey break;
3298a472b3eSmickey }
3308a472b3eSmickey }
3318a472b3eSmickey
3328a472b3eSmickey /*
3338a472b3eSmickey * denormalize result or set to signed zero
3348a472b3eSmickey */
3358a472b3eSmickey stickybit = inexact;
3368a472b3eSmickey Dbl_denormalize(opnd3p1,opnd3p2,dest_exponent,guardbit,
3378a472b3eSmickey stickybit,inexact);
3388a472b3eSmickey
3398a472b3eSmickey /* return zero or smallest number */
3408a472b3eSmickey if (inexact) {
3418a472b3eSmickey switch (Rounding_mode()) {
3428a472b3eSmickey case ROUNDPLUS:
3438a472b3eSmickey if (Dbl_iszero_sign(resultp1)) {
3448a472b3eSmickey Dbl_increment(opnd3p1,opnd3p2);
3458a472b3eSmickey }
3468a472b3eSmickey break;
3478a472b3eSmickey case ROUNDMINUS:
3488a472b3eSmickey if (Dbl_isone_sign(resultp1)) {
3498a472b3eSmickey Dbl_increment(opnd3p1,opnd3p2);
3508a472b3eSmickey }
3518a472b3eSmickey break;
3528a472b3eSmickey case ROUNDNEAREST:
3538a472b3eSmickey if (guardbit && (stickybit ||
3548a472b3eSmickey Dbl_isone_lowmantissap2(opnd3p2))) {
3558a472b3eSmickey Dbl_increment(opnd3p1,opnd3p2);
3568a472b3eSmickey }
3578a472b3eSmickey break;
3588a472b3eSmickey }
3598a472b3eSmickey if (is_tiny) Set_underflowflag();
3608a472b3eSmickey }
3618a472b3eSmickey Dbl_set_exponentmantissa(resultp1,resultp2,opnd3p1,opnd3p2);
3628a472b3eSmickey }
3638a472b3eSmickey else Dbl_set_exponent(resultp1,dest_exponent);
3648a472b3eSmickey /* check for inexact */
3658a472b3eSmickey Dbl_copytoptr(resultp1,resultp2,dstptr);
3668a472b3eSmickey if (inexact) {
3678a472b3eSmickey if (Is_inexacttrap_enabled()) return(INEXACTEXCEPTION);
3688a472b3eSmickey else Set_inexactflag();
3698a472b3eSmickey }
3708a472b3eSmickey return(NOEXCEPTION);
3718a472b3eSmickey }
372