Update of /project/cl-store/cvsroot/cl-store/cmucl In directory common-lisp.net:/tmp/cvs-serv11891/cmucl

Modified Files: custom.lisp Log Message: Changelog 2005-02-11 Date: Fri Feb 11 13:00:39 2005 Author: sross

Index: cl-store/cmucl/custom.lisp diff -u cl-store/cmucl/custom.lisp:1.5 cl-store/cmucl/custom.lisp:1.6 --- cl-store/cmucl/custom.lisp:1.5 Thu Dec 2 11:31:59 2004 +++ cl-store/cmucl/custom.lisp Fri Feb 11 13:00:39 2005 @@ -3,29 +3,31 @@

(in-package :cl-store)

-(defstore-cl-store (obj float stream) - (output-type-code +float-code+ stream) - (write-byte (float-type obj) stream) - (etypecase obj - (single-float (store-object (kernel:single-float-bits obj) - stream)) - (double-float (store-object (kernel:double-float-high-bits obj) - stream) - (store-object (kernel:double-float-low-bits obj) - stream)))) - -(defun cmucl-restore-single-float (stream) - (kernel:make-single-float (restore-object stream))) - -(defun cmucl-restore-double-float (stream) - (kernel:make-double-float (restore-object stream) - (restore-object stream))) - -(defrestore-cl-store (float stream) - (let ((byte (read-byte stream))) - (ecase byte - (0 (cmucl-restore-single-float stream)) - (1 (cmucl-restore-double-float stream))))) +(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+))) + +

;; Custom Structures (defstore-cl-store (obj structure-object stream) @@ -34,9 +36,6 @@

(defrestore-cl-store (structure-object stream) (restore-type-object stream)) - - -

;; Structure definitions (defun get-layout (obj)