[cl-store-cvs] CVS update: cl-store/ChangeLog cl-store/README cl-store/backends.lisp cl-store/circularities.lisp cl-store/cl-store.asd cl-store/default-backend.lisp cl-store/package.lisp cl-store/plumbing.lisp cl-store/tests.lisp cl-store/utils.lisp cl-store/xml-backend.lisp
Sean Ross
sross at common-lisp.net
Mon Nov 1 14:30:32 UTC 2004
Update of /project/cl-store/cvsroot/cl-store
In directory common-lisp.net:/tmp/cvs-serv26326
Modified Files:
ChangeLog README backends.lisp circularities.lisp cl-store.asd
default-backend.lisp package.lisp plumbing.lisp tests.lisp
utils.lisp xml-backend.lisp
Log Message:
Removed old documentation, added new docs.
Date: Mon Nov 1 15:30:19 2004
Author: sross
Index: cl-store/ChangeLog
diff -u cl-store/ChangeLog:1.11 cl-store/ChangeLog:1.12
--- cl-store/ChangeLog:1.11 Wed Oct 13 14:35:57 2004
+++ cl-store/ChangeLog Mon Nov 1 15:30:18 2004
@@ -1,3 +1,14 @@
+2004-11-01 Sean Ross <sross at common-lisp.net>
+ * default-backend.lisp: Changed storing of sizes of integers
+ and strings from store-32-bit to store-object. Changed all
+ instances of store-32-byte to store-32-bit.
+ Added a simple function storing method.
+ * docs/cl-store.texi: New documentation.
+
+
+2004-10-21 Sean Ross <sross at common-lisp.net>
+ * package.lisp, acl/custom.lisp: Added support for Allegro CL.
+
2004-10-13 Sean Ross <sross at common-lisp.net>
* cl-store.asd: New Version (0.3)
* circularities.lisp, default-backend.lisp, xml-backend.lisp:
Index: cl-store/README
diff -u cl-store/README:1.9 cl-store/README:1.10
--- cl-store/README:1.9 Wed Oct 13 14:35:57 2004
+++ cl-store/README Mon Nov 1 15:30:18 2004
@@ -1,36 +1,15 @@
README for Package CL-STORE.
Author: Sean Ross
Homepage: http://www.common-lisp.net/project/cl-store/
-Version: 0.3
+Version: 0.3.2
0. About.
CL-STORE is an portable serialization package which
should give you the ability to store all common-lisp
data types (well not all yet) into streams.
+ See the cl-store manual (docs/cl-store.texi) for more in depth information.
-
-1. Installation.
- The first thing you need is a common-lisp, CL-STORE currently
- supports SBCL, CMUCL, Lispworks, CLISP and OpenMCL.
-
- Hopefully you've asdf-install to install this in which case
- all should be fine.
-
- Otherwise symlink cl-store.asd to somewhere on asdf:*central-registry*
- and run (asdf:oos 'asdf:load-op :cl-store).
-
- The xml backend can be loaded with (asdf:oos 'asdf:loaded :cl-store-xml).
- This requires xmls which can be found on http://www.cliki.net and
- is asdf-installable.
-
- Run (asdf:oos 'asdf:test-op :cl-store) and (asdf:oos 'asdf:test-op :cl-store-xml)
- to make sure that everything works. Running these tests will try to
- load the RT package, which is asdf-installable.
- If anything breaks drop me a line, see
- http://www.common-lisp.net/project/cl-store/ for mailing-lists.
-
-
-2. Usage
+1. Usage
The main entry points are
- [Function] cl-store:store (obj place &optional (backend *default-backend*)) i
=> obj
@@ -48,70 +27,10 @@
- cl-store:restore is setfable, which I think makes
for a great serialized hit counter.
eg. (incf (restore place))
-
NOTE.
All errors signalled within store and restore can
be handled by catching store-error and restore-error respectively.
-
-3. Extending
- CL-STORE is more or less extensible. Using defstore-<backend-name>
- and defrestore-<backend-name> allows you to customize the storing
- and restoring of your own classes.
-
- contrived eg.
-
- (in-package :cl-user)
-
- (use-package :cl-store)
-
- (setf *default-backend* *cl-store-backend*)
-
- (defclass random-obj () ((a :accessor a :initarg :a)))
-
- (defvar *random-obj-code* (register-code 110 'random-obj))
-
- (defstore-cl-store (obj random-obj stream)
- (output-type-code *random-obj-code* stream)
- (store-object (a obj) stream))
-
- (defrestore-cl-store (random-obj stream)
- (random (restore-object stream)))
-
- (store (make-instance 'random-obj :a 10) "/tmp/random")
-
- (restore "/tmp/random")
- => ; some number from 0 to 9
-
-
-4. Backends
- CL-STORE now has a concept of backends, suggested by Robert Sedgewick.
- Two backends are in releases now, a default backend which is much
- what cl-store used to be (pre 0.2) and an xml backend which writes out
- xml to character streams.
-
- Store and Restore now take an optional backend argument which
- currently can be one of *default-backend*, *xml-backend* or
- a self defined backend.
-
- The xml written out is not very human readable.
- I recommend using a tool like tidy <http://tidy.sourceforge.net/>
- to view it in a nice format.
-
-
-5. Issues
- There are a number of issues with CL-STORE as it stands.
-
- - Functions, closures and anything remotely funcallable is unserializable.
- - MOP classes are largely unsupported at the moment.
- - Structure instances are not supported in MCL, OpenMCL and Clisp.
- - Structure definitions aren't supported at all.
- - No documentation.
- - Older cmucl versions, where (eq 'cl:class 'pcl::class)
- returns nil, cannot store classes obtained using cl:find-class.
- The solution for this is to use pcl::find-class.
-
-
Enjoy
Sean.
Index: cl-store/backends.lisp
diff -u cl-store/backends.lisp:1.2 cl-store/backends.lisp:1.3
--- cl-store/backends.lisp:1.2 Wed Oct 6 16:41:03 2004
+++ cl-store/backends.lisp Mon Nov 1 15:30:18 2004
@@ -7,7 +7,7 @@
;; in default-backend.lisp and xml-backend.lisp
(in-package :cl-store)
-(declaim (optimize (speed 3) (safety 0) (debug 0)))
+;;(declaim (optimize (speed 3) (safety 0) (debug 0)))
(defun required-arg (name)
Index: cl-store/circularities.lisp
diff -u cl-store/circularities.lisp:1.9 cl-store/circularities.lisp:1.10
--- cl-store/circularities.lisp:1.9 Wed Oct 13 14:35:57 2004
+++ cl-store/circularities.lisp Mon Nov 1 15:30:18 2004
@@ -19,24 +19,19 @@
;; programs according to the Hyperspec(notes in EQ).
(in-package :cl-store)
-(declaim (optimize (speed 3) (safety 0) (debug 0)))
+;;(declaim (optimize (speed 3) (safety 0) (debug 0)))
-(defvar *referrer-string* "%%Referrer-"
- "String which will be interned to create a symbol we
- can recognize as a referrer.")
-
-(defvar *prefix-setters*
- '(slot-value aref row-major-aref)
- "Setfable places which take the object to set before the
- rest of the arguments.")
+(defvar *postfix-setters* '(gethash)
+ "Setfable places which take the object to set after
+ the rest of the arguments.")
(defun get-setf-place (place obj)
"Return a legal setf form for setting PLACE in OBJ, see *prefix-setters*."
(declare (type (or cons symbol) place))
(cond ((atom place) `(,place ,obj))
- ((member (car place) *prefix-setters*)
- `(,(car place) ,obj ,@(cdr place)))
- (t `(, at place ,obj))))
+ ((member (car place) *postfix-setters*)
+ `(, at place ,obj))
+ (t `(,(car place) ,obj ,@(cdr place)))))
;; The definitions for setting and setting-hash sits in resolving-object.
Index: cl-store/cl-store.asd
diff -u cl-store/cl-store.asd:1.11 cl-store/cl-store.asd:1.12
--- cl-store/cl-store.asd:1.11 Wed Oct 13 14:35:57 2004
+++ cl-store/cl-store.asd Mon Nov 1 15:30:18 2004
@@ -14,7 +14,8 @@
"File containing implementation dependent code which may or may not be there."))
(defun lisp-system-shortname ()
- #+mcl mcl #+lispworks :lispworks #+cmu :cmucl #+clisp :clisp #+sbcl :sbcl)
+ #+mcl :mcl #+lispworks :lispworks #+cmu :cmucl #+clisp :clisp #+sbcl :sbcl
+ #+allegro :acl)
(defmethod component-pathname ((component non-required-file))
(let ((pathname (call-next-method))
@@ -39,7 +40,7 @@
:name "CL-STORE"
:author "Sean Ross <sdr at jhb.ucs.co.za>"
:maintainer "Sean Ross <sdr at jhb.ucs.co.za>"
- :version "0.3"
+ :version "0.3.2"
:description "Serialization package"
:long-description "Portable CL Package to serialize data types"
:licence "MIT"
@@ -69,4 +70,4 @@
(error "Test-op Failed.")))
-;; EOF
\ No newline at end of file
+;; EOF
Index: cl-store/default-backend.lisp
diff -u cl-store/default-backend.lisp:1.9 cl-store/default-backend.lisp:1.10
--- cl-store/default-backend.lisp:1.9 Wed Oct 13 14:35:57 2004
+++ cl-store/default-backend.lisp Mon Nov 1 15:30:18 2004
@@ -2,53 +2,58 @@
;; See the file LICENCE for licence information.
;; The cl-store backend.
-;; TODO: Change condition storing in lispworks to ignore reporter-function
(in-package :cl-store)
-(declaim (optimize (speed 3) (safety 0) (debug 0)))
+;;(declaim (optimize (speed 3) (safety 0) (debug 0)))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar *cl-store-backend*
- (defbackend cl-store :magic-number 1347635532
+ (defbackend cl-store :magic-number 1347643724
:stream-type 'binary
- :old-magic-numbers (1912923 1886611788)
+ :old-magic-numbers (1912923 1886611788 1347635532)
:extends resolving-backend
:fields ((restorers :accessor restorers :initform (make-hash-table)))))
- (defun register-code (code name)
- (setf (gethash code (restorers *cl-store-backend*))
- name)
+ (defun register-code (code name &optional (errorp t))
+ (aif (and (gethash code (restorers *cl-store-backend*)) errorp)
+ (error "Code ~A is already defined for ~A." code name)
+ (setf (gethash code (restorers *cl-store-backend*))
+ name))
code))
;; Type code constants
-(defconstant +referrer-code+ (register-code 1 'referrer))
-(defconstant +values-code+ (register-code 2 'values-object))
-(defconstant +integer-code+ (register-code 4 'integer))
-(defconstant +simple-string-code+ (register-code 5 'simple-string))
-(defconstant +float-code+ (register-code 6 'float))
-(defconstant +ratio-code+ (register-code 7 'ratio))
-(defconstant +character-code+ (register-code 8 'character))
-(defconstant +complex-code+ (register-code 9 'complex))
-(defconstant +symbol-code+ (register-code 10 'symbol))
-(defconstant +cons-code+ (register-code 11 'cons))
-(defconstant +pathname-code+ (register-code 12 'pathname))
-(defconstant +hash-table-code+ (register-code 13 'hash-table))
-(defconstant +standard-object-code+ (register-code 14 'standard-object))
-(defconstant +condition-code+ (register-code 15 'condition))
-(defconstant +structure-object-code+ (register-code 16 'structure-object))
-(defconstant +standard-class-code+ (register-code 17 'standard-class))
-(defconstant +built-in-class-code+ (register-code 18 'built-in-class))
-(defconstant +array-code+ (register-code 19 'array))
-(defconstant +simple-vector-code+ (register-code 20 'simple-vector))
-(defconstant +package-code+ (register-code 21 'package))
+(defconstant +referrer-code+ (register-code 1 'referrer nil))
+(defconstant +values-code+ (register-code 2 'values-object nil))
+(defconstant +integer-code+ (register-code 4 'integer nil))
+(defconstant +simple-string-code+ (register-code 5 'simple-string nil))
+(defconstant +float-code+ (register-code 6 'float nil))
+(defconstant +ratio-code+ (register-code 7 'ratio nil))
+(defconstant +character-code+ (register-code 8 'character nil))
+(defconstant +complex-code+ (register-code 9 'complex nil))
+(defconstant +symbol-code+ (register-code 10 'symbol nil))
+(defconstant +cons-code+ (register-code 11 'cons nil))
+(defconstant +pathname-code+ (register-code 12 'pathname nil))
+(defconstant +hash-table-code+ (register-code 13 'hash-table nil))
+(defconstant +standard-object-code+ (register-code 14 'standard-object nil))
+(defconstant +condition-code+ (register-code 15 'condition nil))
+(defconstant +structure-object-code+ (register-code 16 'structure-object nil))
+(defconstant +standard-class-code+ (register-code 17 'standard-class nil))
+(defconstant +built-in-class-code+ (register-code 18 'built-in-class nil))
+(defconstant +array-code+ (register-code 19 'array nil))
+(defconstant +simple-vector-code+ (register-code 20 'simple-vector nil))
+(defconstant +package-code+ (register-code 21 'package nil))
;; Used by lispworks
-(defconstant +positive-infinity-code+ (register-code 22 'positive-infinity))
-(defconstant +negative-infinity-code+ (register-code 23 'negative-infinity))
-(defconstant +float-nan-code+ (register-code 25 'nan-float))
+(defconstant +positive-infinity-code+ (register-code 22 'positive-infinity nil))
+(defconstant +negative-infinity-code+ (register-code 23 'negative-infinity nil))
-;; new storing for 32 byte ints
-(defconstant +32-byte-integer-code+ (register-code 24 '32-byte-integer))
+;; new storing for 32 bit ints
+(defconstant +32-bit-integer-code+ (register-code 24 '32-bit-integer nil))
+
+;; More for lispworks
+(defconstant +float-nan-code+ (register-code 25 'nan-float nil))
+
+(defconstant +function-code+ (register-code 26 'function nil))
;; setups for type code mapping
@@ -72,14 +77,14 @@
;; referrer, Required for a resolving backend
(defmethod store-referrer (ref stream (backend cl-store-backend))
(output-type-code +referrer-code+ stream)
- (store-32-byte ref stream))
+ (store-32-bit ref stream))
(defrestore-cl-store (referrer stream)
- (make-referrer :val (read-32-byte stream nil)))
+ (make-referrer :val (read-32-bit stream nil)))
;; integers
-;; The theory is that most numbers will fit in 32 bytes
+;; The theory is that most numbers will fit in 32 bits
;; so we try and cater for them
;; We need this for circularity stuff.
@@ -87,22 +92,26 @@
(let ((readers (restorer-funs backend)))
(or (eq fn (lookup-reader 'integer readers))
(eq fn (lookup-reader 'character readers))
- (eq fn (lookup-reader '32-byte-integer readers))
+ (eq fn (lookup-reader '32-bit-integer readers))
(eq fn (lookup-reader 'symbol readers)))))
(defstore-cl-store (obj integer stream)
(if (typep obj '(signed-byte 32))
- (store-32-byte-integer obj stream)
+ (store-32-bit-integer obj stream)
(store-arbitrary-integer obj stream)))
-(defun store-32-byte-integer (obj stream)
- (output-type-code +32-byte-integer-code+ stream)
+
+
+
+;; Should be 32-bit
+(defun store-32-bit-integer (obj stream)
+ (output-type-code +32-bit-integer-code+ stream)
(write-byte (if (minusp obj) 1 0) stream)
- (store-32-byte (abs obj) stream))
+ (store-32-bit (abs obj) stream))
-(defrestore-cl-store (32-byte-integer stream)
+(defrestore-cl-store (32-bit-integer stream)
(funcall (if (zerop (read-byte stream)) #'+ #'-)
- (read-32-byte stream nil)))
+ (read-32-bit stream nil)))
(defun store-arbitrary-integer (obj stream)
(output-type-code +integer-code+ stream)
@@ -112,18 +121,18 @@
until (zerop n)
do (push n collect)
finally (progn
- (store-32-byte (if (minusp obj)
+ (store-object (if (minusp obj)
(- counter)
counter)
stream)
(dolist (num collect)
- (store-32-byte num stream)))))
+ (store-32-bit num stream)))))
(defrestore-cl-store (integer buff)
- (let ((count (read-32-byte buff))
+ (let ((count (restore-object buff))
(result 0))
(loop repeat (abs count) do
- (setf result (+ (ash result 32) (read-32-byte buff nil))))
+ (setf result (+ (ash result 32) (read-32-bit buff nil))))
(if (minusp count)
(- result)
result)))
@@ -137,13 +146,14 @@
`(simple-array standard-char (*)))
(defun output-simple-standard-string (obj stream)
- (store-32-byte (length obj) stream)
- (dotimes (x (length obj))
- (write-byte (char-code (schar obj x)) stream)))
+ (store-object (length obj) stream)
+ (loop for x across obj do
+ (write-byte (char-code x) stream)))
(defun restore-simple-standard-string (stream)
- (let* ((length (read-32-byte stream nil))
- (res (make-string length #+lispworks :element-type #+lispworks 'character)))
+ (let* ((length (restore-object stream))
+ (res (make-string length
+ #+lispworks :element-type #+lispworks 'character)))
(dotimes (x length)
(setf (schar res x) (code-char (read-byte stream))))
res))
@@ -166,7 +176,8 @@
;; with floats which supports infinities.
;; Lispworks uses a slightly different version as well
;; manually handling negative and positive infinity
-#-(or lispworks cmu sbcl)
+;; Allegro uses excl:double-float-to-shorts and friends
+#-(or lispworks cmu sbcl allegro)
(defstore-cl-store (obj float stream)
(output-type-code +float-code+ stream)
(multiple-value-bind (significand exponent sign)
@@ -176,7 +187,7 @@
(store-object exponent stream)
(store-object sign stream)))
-#-(or cmu sbcl)
+#-(or cmu sbcl allegro)
(defrestore-cl-store (float stream)
(float (* (get-float-type (read-byte stream))
(* (restore-object stream)
@@ -308,6 +319,7 @@
(output-type-code +standard-object-code+ stream)
(store-type-object obj stream))
+#-lispworks
(defstore-cl-store (obj condition stream)
(output-type-code +condition-code+ stream)
(store-type-object obj stream))
@@ -324,6 +336,7 @@
(setting (slot-value slot-name) (restore-object stream)))))
new-instance))
+#-lispworks
(defrestore-cl-store (condition stream)
(restore-type-object stream))
@@ -415,8 +428,8 @@
res))
-;; clisp doesn't have the class simple-vector
-#-clisp
+;; clisp and allegro doesn't have the class simple-vector
+#-(or clisp allegro)
(defstore-cl-store (obj simple-vector stream)
(output-type-code +simple-vector-code+ stream)
(let ((size (length obj)))
@@ -424,7 +437,7 @@
(loop for x across obj do
(store-object x stream))))
-#-clisp
+#-(or clisp allegro)
(defrestore-cl-store (simple-vector stream)
(let* ((size (restore-object stream))
(res (make-array size)))
@@ -445,7 +458,6 @@
(defrestore-cl-store (package stream)
(find-package (restore-object stream)))
-(setf *default-backend* (find-backend 'cl-store))
;; multiple values
@@ -456,5 +468,22 @@
(defrestore-cl-store (values-object stream)
(apply #'values (restore-object stream)))
+
+
+;; Function storing hack.
+;; This just stores the function name if we can find it
+;; or signals a store-error.
+(defstore-cl-store (obj function stream)
+ (output-type-code +function-code+ stream)
+ (multiple-value-bind (l cp name) (function-lambda-expression obj)
+ (declare (ignore l cp))
+ (if (and name (symbolp name))
+ (store-object name stream)
+ (store-error "Unable to determine function name for ~A." obj))))
+
+(defrestore-cl-store (function stream)
+ (fdefinition (restore-object stream)))
+
+(setf *default-backend* (find-backend 'cl-store))
;; EOF
Index: cl-store/package.lisp
diff -u cl-store/package.lisp:1.12 cl-store/package.lisp:1.13
--- cl-store/package.lisp:1.12 Wed Oct 13 14:35:57 2004
+++ cl-store/package.lisp Mon Nov 1 15:30:18 2004
@@ -24,7 +24,8 @@
#:slot-definition-readers #:slot-definition-writers
#:class-direct-superclasses #:class-direct-slots
#:ensure-class #:make-referrer #:setting-hash
- #:multiple-value-store)
+ #:multiple-value-store #:*postfix-setters* #:caused-by
+ #:store-32-bit #:read-32-bit)
#+sbcl (:import-from #:sb-mop
#:slot-definition-name
@@ -112,5 +113,24 @@
#:class-direct-slots
#:class-slots
#:class-direct-superclasses
- #:ensure-class))
+ #:ensure-class)
+
+ #+allegro (:import-from #:mop
+ #:slot-definition-name
+ #:slot-value-using-class
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:compute-slots
+ #:slot-definition-initform
+ #:slot-definition-initargs
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-type
+ #:slot-definition-writers
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-superclasses
+ #:class-slots
+ #:ensure-class)
+ )
;; EOF
Index: cl-store/plumbing.lisp
diff -u cl-store/plumbing.lisp:1.4 cl-store/plumbing.lisp:1.5
--- cl-store/plumbing.lisp:1.4 Wed Oct 13 14:35:58 2004
+++ cl-store/plumbing.lisp Mon Nov 1 15:30:18 2004
@@ -5,12 +5,11 @@
;;
(in-package :cl-store)
-(declaim (optimize (speed 3) (safety 0) (debug 0)))
-
+;;(declaim (optimize (speed 3) (safety 0) (debug 0)))
(defvar *nuke-existing-classes* nil
"Do we overwrite existing class definitions on restoration.")
-(defvar *store-class-superclasses* t
+(defvar *store-class-superclasses* nil
"Whether or not to store the superclasses of a stored class.")
(defvar *store-class-slots* t
"Whether or not to serialize slots which are class allocated.")
@@ -99,7 +98,7 @@
(when code
(ecase (stream-type backend)
(character (store-string-code code stream))
- (integer (store-32-byte code stream))))))
+ (integer (store-32-bit code stream))))))
@@ -147,8 +146,7 @@
(:documentation "Wrapped by restore. Override this to do custom restoration")
(:method ((place stream) (backend t))
"Restore the object found in stream PLACE using backend BACKEND.
- Checks stream-element-type and magic-number and
- invokes backend-restore-object"
+ Checks the magic-number and invokes backend-restore-object"
(check-magic-number place backend)
(backend-restore-object place backend))
(:method ((place string) (backend t))
@@ -187,7 +185,7 @@
(let ((magic-number (magic-number backend)))
(when magic-number
(let ((val (ecase (stream-type backend)
- (integer (read-32-byte stream))
+ (integer (read-32-bit stream nil))
(character (retrieve-string-code stream)))))
(cond ((eql val magic-number) nil)
((member val (old-magic-numbers backend))
Index: cl-store/tests.lisp
diff -u cl-store/tests.lisp:1.8 cl-store/tests.lisp:1.9
--- cl-store/tests.lisp:1.8 Wed Oct 13 14:35:58 2004
+++ cl-store/tests.lisp Mon Nov 1 15:30:18 2004
@@ -64,7 +64,7 @@
(deftestit double-float.6 most-negative-double-float)
;; infinite floats
-#+(or sbcl cmu lispworks)
+#+(or sbcl cmu lispworks allegro)
(progn
#+sbcl (sb-int:set-floating-point-modes :traps nil)
#+cmu (ext:set-floating-point-modes :traps nil)
@@ -257,9 +257,10 @@
(deftest condition.2
(handler-case (car (read-from-string "3"))
- (type-error (c)
+ (#-allegro type-error #+allegro simple-error (c)
(store c *test-file*)
- (typep (restore *test-file*) 'type-error)))
+ (typep (restore *test-file*)
+ #-allegro 'type-error #+allegro 'simple-error)))
t)
;; structure-object
@@ -286,9 +287,8 @@
(deftestit pathname.1 #P"/home/foo")
(deftestit pathname.2 (make-pathname :name "foo"))
-(deftestit pathname.3 (make-pathname :name "foo" :type "bar"
- #-clisp :device #-clisp "foobar"
- ))
+(deftestit pathname.3 (make-pathname :name "foo" :type "bar"))
+
;; circular objects
Index: cl-store/utils.lisp
diff -u cl-store/utils.lisp:1.5 cl-store/utils.lisp:1.6
--- cl-store/utils.lisp:1.5 Wed Oct 13 14:35:58 2004
+++ cl-store/utils.lisp Mon Nov 1 15:30:18 2004
@@ -3,7 +3,7 @@
;; Miscellaneous utilities used throughout the package.
(in-package :cl-store)
-(declaim (optimize (speed 3) (safety 0) (debug 0)))
+;;(declaim (optimize (speed 3) (safety 0) (debug 0)))
(defmacro aif (test then &optional else)
@@ -48,7 +48,7 @@
(1 1.0d0)))
-(defun store-32-byte (obj stream)
+(defun store-32-bit (obj stream)
"Write OBJ down STREAM as a 32 byte integer."
(write-byte (ldb (byte 8 0) obj) stream)
(write-byte (ldb (byte 8 8) obj) stream)
@@ -56,7 +56,7 @@
(write-byte (+ 0 (ldb (byte 8 24) obj)) stream))
-(defun read-32-byte (buf &optional (signed t))
+(defun read-32-bit (buf &optional (signed t))
"Read a signed or unsigned byte off STREAM."
(let ((byte1 (read-byte buf))
(byte2 (read-byte buf))
Index: cl-store/xml-backend.lisp
diff -u cl-store/xml-backend.lisp:1.5 cl-store/xml-backend.lisp:1.6
--- cl-store/xml-backend.lisp:1.5 Wed Oct 13 14:35:58 2004
+++ cl-store/xml-backend.lisp Mon Nov 1 15:30:18 2004
@@ -117,8 +117,8 @@
;; simple-string
(defun xml-dump-simple-string (string place)
- (princ-xml "SIMPLE-STRING" string place))
-
+ (with-tag ("SIMPLE-STRING" place)
+ (format place "~S" string)))
(defstore-xml (obj string stream)
(if (typep obj 'simple-standard-string)
@@ -126,7 +126,7 @@
(xml-dump-array obj stream)))
(defrestore-xml (simple-string place)
- (third place))
+ (read-from-string (third place)))
;; float
@@ -425,7 +425,7 @@
(restore-first value)))))))
-#-clisp
+#-(or allegro clisp)
(defstore-xml (obj simple-vector stream)
(with-tag ("SIMPLE-VECTOR" stream)
(princ-and-store "LENGTH" (length obj) stream)
@@ -433,7 +433,7 @@
(loop for x across obj do
(princ-and-store "ELEMENT" x stream)))))
-#-clisp
+#-(or allegro clisp)
(defrestore-xml (simple-vector place)
(let* ((size (restore-first (get-child "LENGTH" place)))
(res (make-array size)))
More information about the Cl-store-cvs
mailing list