Update of /project/cl-store/cvsroot/cl-store/cmucl In directory clnet:/tmp/cvs-serv7536/cmucl

Modified Files: custom.lisp Log Message: Changelog 2006-12-13

--- /project/cl-store/cvsroot/cl-store/cmucl/custom.lisp 2005/02/11 12:00:39 1.6 +++ /project/cl-store/cvsroot/cl-store/cmucl/custom.lisp 2006/12/14 18:15:43 1.7 @@ -3,31 +3,16 @@

(in-package :cl-store)

-(defvar +single-positive-infinity+ most-positive-single-float) -(defvar +single-negative-infinity+ most-negative-single-float) -(defvar +single-nan+) - -(defvar +double-positive-infinity+ most-positive-double-float) -(defvar +double-negative-infinity+ most-negative-double-float) -(defvar +double-nan+) - -(ext:with-float-traps-masked (:overflow :invalid) - (setf +single-positive-infinity+ (expt +single-positive-infinity+ 2)) - (setf +single-negative-infinity+ (expt +single-negative-infinity+ 3)) - (setf +single-nan+ (/ +single-negative-infinity+ +single-negative-infinity+)) - (setf +double-positive-infinity+ (expt +double-positive-infinity+ 2)) - (setf +double-negative-infinity+ (expt +double-negative-infinity+ 3)) - (setf +double-nan+ (/ +double-negative-infinity+ +double-negative-infinity+))) - -(setf *special-floats* - (list (cons +double-positive-infinity+ +positive-double-infinity-code+) - (cons +single-positive-infinity+ +positive-infinity-code+) - (cons +single-negative-infinity+ +negative-infinity-code+) - (cons +double-negative-infinity+ +negative-double-infinity-code+) - (cons +single-nan+ +float-nan-code+) - (cons +double-nan+ +float-double-nan-code+))) - - +; special floats +(defun create-float-values (value &rest codes) + "Returns a alist of special float to float code mappings." + (ext:with-float-traps-masked (:overflow :invalid) + (let ((neg-inf (expt value 3))) + (mapcar 'cons + (list (expt (abs value) 2) + neg-inf + (/ neg-inf neg-inf)) + codes))))

;; Custom Structures (defstore-cl-store (obj structure-object stream)