134122Sbostic /* 234122Sbostic * Copyright (c) 1985 Regents of the University of California. 3*34401Sbostic * All rights reserved. 4*34401Sbostic * 5*34401Sbostic * Redistribution and use in source and binary forms are permitted 6*34401Sbostic * provided that this notice is preserved and that due credit is given 7*34401Sbostic * to the University of California at Berkeley. The name of the University 8*34401Sbostic * may not be used to endorse or promote products derived from this 9*34401Sbostic * software without specific prior written permission. This software 10*34401Sbostic * is provided ``as is'' without express or implied warranty. 11*34401Sbostic * 12*34401Sbostic * All recipients should regard themselves as participants in an ongoing 13*34401Sbostic * research project and hence should feel obligated to report their 14*34401Sbostic * experiences (good or bad) with these elementary function codes, using 15*34401Sbostic * the sendbug(8) program, to the authors. 1634122Sbostic */ 1724596Szliu 1834122Sbostic #ifndef lint 19*34401Sbostic static char sccsid[] = "@(#)floor.c 5.3 (Berkeley) 05/21/88"; 2034122Sbostic #endif /* not lint */ 2134122Sbostic 22*34401Sbostic #if defined(vax)||defined(tahoe) 23*34401Sbostic #ifdef vax 24*34401Sbostic #define _0x(A,B) 0x/**/A/**/B 25*34401Sbostic #else /* vax */ 26*34401Sbostic #define _0x(A,B) 0x/**/B/**/A 27*34401Sbostic #endif /* vax */ 28*34401Sbostic static long Lx[] = {_0x(0000,5c00),_0x(0000,0000)}; /* 2**55 */ 29*34401Sbostic #define L *(double *) Lx 30*34401Sbostic #else /* defined(vax)||defined(tahoe) */ 31*34401Sbostic static double L = 4503599627370496.0E0; /* 2**52 */ 32*34401Sbostic #endif /* defined(vax)||defined(tahoe) */ 33*34401Sbostic 3424596Szliu /* 35*34401Sbostic * floor(x) := the largest integer no larger than x; 36*34401Sbostic * ceil(x) := -floor(-x), for all real x. 37*34401Sbostic * 38*34401Sbostic * Note: Inexact will be signaled if x is not an integer, as is 39*34401Sbostic * customary for IEEE 754. No other signal can be emitted. 4024596Szliu */ 4124596Szliu double 42*34401Sbostic floor(x) 43*34401Sbostic double x; 4424596Szliu { 45*34401Sbostic double y,ceil(); 4624596Szliu 47*34401Sbostic if ( 48*34401Sbostic #if !defined(vax)&&!defined(tahoe) 49*34401Sbostic x != x || /* NaN */ 50*34401Sbostic #endif /* !defined(vax)&&!defined(tahoe) */ 51*34401Sbostic x >= L) /* already an even integer */ 52*34401Sbostic return x; 53*34401Sbostic else if (x < (double)0) 54*34401Sbostic return -ceil(-x); 55*34401Sbostic else { /* now 0 <= x < L */ 56*34401Sbostic y = L+x; /* destructive store must be forced */ 57*34401Sbostic y -= L; /* an integer, and |x-y| < 1 */ 58*34401Sbostic return x < y ? y-(double)1 : y; 59*34401Sbostic } 6024596Szliu } 6124596Szliu 6224596Szliu double 63*34401Sbostic ceil(x) 64*34401Sbostic double x; 6524596Szliu { 66*34401Sbostic double y,floor(); 67*34401Sbostic 68*34401Sbostic if ( 69*34401Sbostic #if !defined(vax)&&!defined(tahoe) 70*34401Sbostic x != x || /* NaN */ 71*34401Sbostic #endif /* !defined(vax)&&!defined(tahoe) */ 72*34401Sbostic x >= L) /* already an even integer */ 73*34401Sbostic return x; 74*34401Sbostic else if (x < (double)0) 75*34401Sbostic return -floor(-x); 76*34401Sbostic else { /* now 0 <= x < L */ 77*34401Sbostic y = L+x; /* destructive store must be forced */ 78*34401Sbostic y -= L; /* an integer, and |x-y| < 1 */ 79*34401Sbostic return x > y ? y+(double)1 : y; 80*34401Sbostic } 8124596Szliu } 8224596Szliu 8331853Szliu #ifndef national /* rint() is in ./NATIONAL/support.s */ 8424596Szliu /* 8524596Szliu * algorithm for rint(x) in pseudo-pascal form ... 8624596Szliu * 8724596Szliu * real rint(x): real x; 8824596Szliu * ... delivers integer nearest x in direction of prevailing rounding 8924596Szliu * ... mode 9024596Szliu * const L = (last consecutive integer)/2 9124596Szliu * = 2**55; for VAX D 9224596Szliu * = 2**52; for IEEE 754 Double 9324596Szliu * real s,t; 9424596Szliu * begin 9524596Szliu * if x != x then return x; ... NaN 9624596Szliu * if |x| >= L then return x; ... already an integer 9724596Szliu * s := copysign(L,x); 9824596Szliu * t := x + s; ... = (x+s) rounded to integer 9924596Szliu * return t - s 10024596Szliu * end; 10124596Szliu * 10224596Szliu * Note: Inexact will be signaled if x is not an integer, as is 10324596Szliu * customary for IEEE 754. No other signal can be emitted. 10424596Szliu */ 10524596Szliu double 10624596Szliu rint(x) 10724596Szliu double x; 10824596Szliu { 10924596Szliu double s,t,one = 1.0,copysign(); 11031853Szliu #if !defined(vax)&&!defined(tahoe) 11124596Szliu if (x != x) /* NaN */ 11224596Szliu return (x); 11331853Szliu #endif /* !defined(vax)&&!defined(tahoe) */ 11424596Szliu if (copysign(x,one) >= L) /* already an integer */ 11524596Szliu return (x); 11624596Szliu s = copysign(L,x); 11724596Szliu t = x + s; /* x+s rounded to integer */ 11824596Szliu return (t - s); 11924596Szliu } 12031853Szliu #endif /* not national */ 121