Home | History | Annotate | Line # | Download | only in spmath
      1  1.5     skrll /*	$NetBSD: dfrem.c,v 1.5 2012/02/04 17:03:09 skrll 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.2     lukem #include <sys/cdefs.h>
     45  1.5     skrll __KERNEL_RCSID(0, "$NetBSD: dfrem.c,v 1.5 2012/02/04 17:03:09 skrll Exp $");
     46  1.1  fredette 
     47  1.1  fredette #include "../spmath/float.h"
     48  1.1  fredette #include "../spmath/dbl_float.h"
     49  1.1  fredette 
     50  1.1  fredette /*
     51  1.1  fredette  *  Double Precision Floating-point Remainder
     52  1.1  fredette  */
     53  1.1  fredette int
     54  1.5     skrll dbl_frem(dbl_floating_point *srcptr1, dbl_floating_point *srcptr2,
     55  1.5     skrll    dbl_floating_point *dstptr, 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.4   thorpej 	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.4   thorpej 		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