[cl-store-cvs] CVS update: cl-store/sbcl/custom.lisp
Sean Ross
sross at common-lisp.net
Wed Nov 10 10:43:36 UTC 2004
Update of /project/cl-store/cvsroot/cl-store/sbcl
In directory common-lisp.net:/tmp/cvs-serv7159/sbcl
Modified Files:
custom.lisp
Log Message:
Changelog 2004-11-10
Date: Wed Nov 10 11:43:34 2004
Author: sross
Index: cl-store/sbcl/custom.lisp
diff -u cl-store/sbcl/custom.lisp:1.2 cl-store/sbcl/custom.lisp:1.3
--- cl-store/sbcl/custom.lisp:1.2 Wed Oct 6 16:41:45 2004
+++ cl-store/sbcl/custom.lisp Wed Nov 10 11:43:33 2004
@@ -7,7 +7,7 @@
;; Custom float storing
(defstore-cl-store (obj float stream)
- (output-type-code +float-code+ stream)
+ (output-type-code +float-code+ stream)
(write-byte (float-type obj) stream)
(etypecase obj
(single-float (store-object (sb-kernel:single-float-bits obj)
@@ -18,20 +18,21 @@
stream))))
(defun sbcl-restore-single-float (stream)
- (sb-kernel:make-single-float (restore-object stream)))
+ (sb-kernel:make-single-float (the integer (restore-object stream))))
(defun sbcl-restore-double-float (stream)
- (sb-kernel:make-double-float (restore-object stream)
- (restore-object stream)))
+ (sb-kernel:make-double-float (the integer (restore-object stream))
+ (the integer (restore-object stream))))
(defvar *sbcl-float-restorers*
- (list (cons 0 'sbcl-restore-single-float)
- (cons 1 'sbcl-restore-double-float)))
+ (list (cons 0 #'sbcl-restore-single-float)
+ (cons 1 #'sbcl-restore-double-float)))
(defrestore-cl-store (float stream)
(let ((byte (read-byte stream)))
- (aif (cdr (assoc byte *sbcl-float-restorers*))
- (funcall it stream)
+ (declare (type (integer 0 1) byte))
+ (aif (cdr (assoc byte *sbcl-float-restorers* :test #'=))
+ (funcall (the function it) stream)
(restore-error "Unknown float type designator ~S." byte))))
More information about the Cl-store-cvs
mailing list