Update of /project/cl-store/cvsroot/cl-store/cmucl In directory common-lisp.net:/tmp/cvs-serv6638/cmucl
Modified Files: custom-xml.lisp custom.lisp Added Files: .cvsignore Log Message: Changelog 2004-10-06 Date: Wed Oct 6 16:41:07 2004 Author: sross
Index: cl-store/cmucl/custom-xml.lisp diff -u cl-store/cmucl/custom-xml.lisp:1.1 cl-store/cmucl/custom-xml.lisp:1.2 --- cl-store/cmucl/custom-xml.lisp:1.1 Mon Aug 30 17:10:22 2004 +++ cl-store/cmucl/custom-xml.lisp Wed Oct 6 16:41:07 2004 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;; See the file LICENCE for licence information.
-(in-package :cl-store) +(in-package :cl-store-xml)
(defstore-xml (obj structure-object stream) @@ -11,6 +11,27 @@
(defrestore-xml (structure-object place) (restore-xml-type-object place)) + + +(defstore-xml (obj single-float stream) + (with-tag ("SINGLE-FLOAT" stream) + (princ-and-store "BITS" (kernel::single-float-bits obj) + stream))) + +(defrestore-xml (single-float stream) + (kernel::make-single-float + (restore-first (get-child "BITS" stream)))) + +(defstore-xml (obj double-float stream) + (with-tag ("DOUBLE-FLOAT" stream) + (princ-and-store "HIGH-BITS" (kernel::double-float-high-bits obj) + stream) + (princ-and-store "LOW-BITS" (kernel::double-float-low-bits obj) + stream))) + +(defrestore-xml (double-float stream) + (kernel::make-double-float (restore-first (get-child "HIGH-BITS" stream)) + (restore-first (get-child "LOW-BITS" stream))))
;; EOF
Index: cl-store/cmucl/custom.lisp diff -u cl-store/cmucl/custom.lisp:1.1 cl-store/cmucl/custom.lisp:1.2 --- cl-store/cmucl/custom.lisp:1.1 Mon Aug 30 17:10:22 2004 +++ cl-store/cmucl/custom.lisp Wed Oct 6 16:41:07 2004 @@ -4,6 +4,35 @@ (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))) + +(defvar *cmucl-float-restorers* + (list (cons 0 'cmucl-restore-single-float) + (cons 1 'cmucl-restore-double-float))) + +(defrestore-cl-store (float stream) + (let ((byte (read-byte stream))) + (aif (cdr (assoc byte *cmucl-float-restorers*)) + (funcall it stream) + (restore-error "Unknown float type designator ~S." byte)))) + +;; Custom Structures (defstore-cl-store (obj structure-object stream) (output-type-code +structure-object-code+ stream) (store-type-object obj stream))