xref: /original-bsd/usr.bin/f77/libF77/r_mod.c (revision 2d1a7683)
1 /*-
2  * Copyright (c) 1980 The Regents of the University of California.
3  * All rights reserved.
4  *
5  * %sccs.include.proprietary.c%
6  */
7 
8 #ifndef lint
9 static char sccsid[] = "@(#)r_mod.c	5.6 (Berkeley) 04/12/91";
10 #endif /* not lint */
11 
12 #ifndef tahoe
13 float flt_retval;
14 
15 float r_mod(x,y)
16 float *x, *y;
17 {
18 double floor(), quotient = *x / *y;
19 if (quotient >= 0.0)
20 	quotient = floor(quotient);
21 else
22 	quotient = -floor(-quotient);
23 flt_retval = *x - (*y) * quotient ;
24 return(flt_retval);
25 }
26 
27 #else
28 
29 /*   THIS IS BASED ON THE TAHOE REPR. FOR FLOATING POINT */
30 #include <tahoe/math/FP.h>
31 
32 double r_mod(x,y)
33 float *x, *y;
34 {
35 double floor(), quotient = *x / *y;
36 if (quotient >= 0.0)
37 	quotient = floor(quotient);
38 else {
39 	*(unsigned long *)&quotient ^= SIGN_BIT;
40 	quotient = floor(quotient);
41 	if (quotient != 0)
42 		*(unsigned long *)&quotient ^= SIGN_BIT;
43 	}
44 return(*x - (*y) * quotient );
45 }
46 #endif
47