Update of /project/ieeefp-tests/cvsroot/ieeefp-tests/ieee754 In directory common-lisp.net:/tmp/cvs-serv4938 Modified Files: ieee754-abcl.lisp Log Message: Single float support, comparison operators. Date: Thu Aug 25 17:27:45 2005 Author: pgraves Index: ieeefp-tests/ieee754/ieee754-abcl.lisp diff -u ieeefp-tests/ieee754/ieee754-abcl.lisp:1.3 ieeefp-tests/ieee754/ieee754-abcl.lisp:1.4 --- ieeefp-tests/ieee754/ieee754-abcl.lisp:1.3 Tue Jun 15 21:58:31 2004 +++ ieeefp-tests/ieee754/ieee754-abcl.lisp Thu Aug 25 17:27:45 2005 @@ -1,27 +1,48 @@ (in-package "IEEE754-INTERNALS") -(defvar ieeefp-tests:*float-types* (list :double)) +(defvar ieeefp-tests:*float-types* (list :single :double)) (defvar ieeefp-tests:*rounding-modes* (list :nearest)) (defun make-single-float (x) - (error "Not supported.")) + (sys:make-single-float x)) (defun make-double-float (x) - (sys::make-double-float x)) + (sys:make-double-float x)) (defun single-float-bits (x) - (error "Not supported.")) + (declare (type single-float x)) + (ldb (byte 32 0) (sys:single-float-bits x))) (defun double-float-bits (x) (declare (type double-float x)) (ldb (byte 64 0) - (logior (ash (sys::double-float-high-bits x) 32) - (sys::double-float-low-bits x)))) + (logior (ash (sys:double-float-high-bits x) 32) + (sys:double-float-low-bits x)))) (defun set-floating-point-modes (&rest args &key traps accrued-exceptions current-exceptions rounding-mode precision) - (declare (ignore traps accrued-exceptions current-exceptions rounding-mode - precision)) + (declare (ignore args traps accrued-exceptions current-exceptions + rounding-mode precision)) ;; Not supported. ) + +(macrolet + ((def (x &body body) + `(defun ,x (x y) + (declare (type float x y)) + ,@body))) + (def = (cl:= x y)) + (def ?<> (not (= x y))) + (def > (cl:> x y)) + (def >= (cl:>= x y)) + (def < (cl:< x y)) + (def <= (cl:<= x y)) + (def ? (or (sys:float-nan-p x) (sys:float-nan-p y))) + (def <> (or (< x y) (> x y))) + (def <=> (or (< x y) (= x y) (> x y))) + (def ?> (or (? x y) (> x y))) + (def ?>= (or (? x y) (>= x y))) + (def ?< (or (? x y) (< x y))) + (def ?<= (or (? x y) (<= x y))) + (def ?= (or (? x y) (= x y))))