[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