[ieeefp-tests-cvs] CVS update: ieeefp-tests/ieee754/ieee754-cmucl.lisp

[Raymond Toy]

Update of /project/ieeefp-tests/cvsroot/ieeefp-tests/ieee754
In directory common-lisp.net:/tmp/cvs-serv6045/ieee754

Modified Files:
	ieee754-cmucl.lisp 
Log Message:
First pass at some of the IEEE754 recommended functions.  Simple tests
work, but still need to write a test-suite for these.

Date: Wed Jun 16 19:59:42 2004
Author: rtoy

Index: ieeefp-tests/ieee754/ieee754-cmucl.lisp
diff -u ieeefp-tests/ieee754/ieee754-cmucl.lisp:1.1 ieeefp-tests/ieee754/ieee754-cmucl.lisp:1.2
--- ieeefp-tests/ieee754/ieee754-cmucl.lisp:1.1	Tue Jun  8 06:44:43 2004
+++ ieeefp-tests/ieee754/ieee754-cmucl.lisp	Wed Jun 16 19:59:42 2004
@@ -30,3 +30,78 @@
 		   precision))
   (apply #'ext:set-floating-point-modes args))
 
+
+;;; IEEE754 recommended functions
+
+(defun copysign (x y)
+  "Copy the sign of Y to X and return the result"
+  (float-sign y x))
+
+(defun scalb (x n)
+  "Compute x*2^n, without roundoff"
+  (scale-float x n))
+
+(defun finitep (x)
+  "Returns non-NIL if X is a finite value"
+  ;; What are we supposed to do when X is a NaN?
+  (not (ext:float-infinity-p x)))
+
+(defun nanp (x)
+  "Returns non-NIL if X is a NaN"
+  (ext:float-nan-p x))
+
+(defun logb (x)
+  "Return the unbiased exponent of X, except for the following:
+
+   NaN             NaN
+   +infinity       +infinity
+   0               -infinity, signaling division by zero
+
+   Also, 0 < scalb(x, -logb(x)) < 2, when x is positive and finite; it
+   is less than 1 only when x is denormalized."
+  (cond ((nanp x)
+	 x)
+	((not (finitep x))
+	 x)
+	((zerop x)
+	 ;; Need to signal division by zero, if enabled; otherwise,
+	 ;; return -infinity.
+	 (/ -1 x))
+	(t
+	 ;; Finite x.  DECODE-FLOAT is basically what we want, except
+	 ;; it's one too big.  And it's also too small for
+	 ;; denormalized numbers.  We need to clip at the least
+	 ;; exponent for normalized floats.
+	 (multiple-value-bind (f e s)
+	     (decode-float x)
+	   (declare (ignore f s))
+	   (max (1- e)
+		(etypecase x
+		  (single-float -126)
+		  (double-float -1022)))))))
+
+(defun nextafter (x y)
+  "The next double float after X in the direction of Y, with the
+following exceptions:
+
+  X = Y                 returns X, unchanged
+  X or Y is quiet NaN   returns the NaN
+
+  Overflow is signaled if nextafter would overflow; underflow is
+signaled if nextafter would underflow.  In both cases, inexact
+is signaled."
+
+  ;; What are we supposed to do if x or y is a signaling NaN?
+  (cond ((= x y)
+	 x)
+	((nanp x)
+	 x)
+	((nanp y)
+	 y)
+	(t
+	 (multiple-value-bind (f e s)
+	     (integer-decode-float x)
+	   (if (>= y 0)
+	       (incf f)
+	       (decf f))
+	   (* s (scale-float (float f x) e))))))