From sross at common-lisp.net  Wed Nov 30 09:50:02 2005
From: sross at common-lisp.net (Sean Ross)
Date: Wed, 30 Nov 2005 10:50:02 +0100 (CET)
Subject: [cl-store-cvs] CVS update: cl-store/ChangeLog
	cl-store/backends.lisp cl-store/cl-store.asd
	cl-store/default-backend.lisp cl-store/package.lisp
	cl-store/plumbing.lisp cl-store/utils.lisp 
Message-ID: <20051130095002.6FD2F88579@common-lisp.net>

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

Modified Files:
	ChangeLog backends.lisp cl-store.asd default-backend.lisp 
	package.lisp plumbing.lisp utils.lisp 
Log Message:
Changelog 2005-11-30
Date: Wed Nov 30 10:49:56 2005
Author: sross

Index: cl-store/ChangeLog
diff -u cl-store/ChangeLog:1.37 cl-store/ChangeLog:1.38
--- cl-store/ChangeLog:1.37	Thu Oct  6 09:49:45 2005
+++ cl-store/ChangeLog	Wed Nov 30 10:49:56 2005
@@ -1,3 +1,12 @@
+2005-11-30 Sean Ross <sross at common-lisp.net>
+	* package.lisp: Added imports for MCL (from Gary King)
+	* backends.lisp: Changed definition of the defstore-? and
+	defrestore-? macros to work with lispworks dspecs.
+	* default-backend.lisp: Fixed the *sbcl-readtable* to copy
+	the default readtable.
+	* plumbing.lisp: Changed cl-store-error to extend directly from error
+	and removed error from restore-error and store-error's precedence list.
+	 
 2005-10-06 Sean Ross <sross at common-lisp.net>
 	* backends.lisp: Fixed type definition for 
 	compatible-magic-numbers from integer to list.
@@ -7,7 +16,8 @@
 	* sbcl/custom.lisp: sb-kernel:instance is no
 	longer a class (since 0.9.5.3 or so). Fixed
 	definition of *sbcl-struct-inherits* to work 
-	with or without this class. Reported by Rafa?? Strzali??ski.
+	with or without this class. 
+	Reported by Rafa?? Strzali??ski.
 	
 2005-09-20 Sean Ross <sross at common-lisp.net>
 	* default-backend.lisp: Changed storing and restoring


Index: cl-store/backends.lisp
diff -u cl-store/backends.lisp:1.12 cl-store/backends.lisp:1.13
--- cl-store/backends.lisp:1.12	Thu Oct  6 09:49:46 2005
+++ cl-store/backends.lisp	Wed Nov 30 10:49:56 2005
@@ -43,6 +43,23 @@
     (symbol (find-backend designator t))
     (backend designator)))
 
+
+#+lispworks
+(defun get-store-macro (name)
+  "Return the defstore-? macro which will be used by a custom backend"
+  (let ((macro-name (symbolicate 'defstore- name)))
+    `(defmacro ,macro-name ((var type stream &optional qualifier) 
+                            &body body)
+       (with-gensyms (gbackend)
+         `(dspec:def (,',macro-name (,var ,type ,stream))
+            (defmethod internal-store-object ,@(if qualifier (list qualifier) nil)
+              ((,gbackend ,',name) (,var ,type) ,stream)
+              ,(format nil "Definition for storing an object of type ~A with ~
+ backend ~A" type ',name)
+              (declare (ignorable ,gbackend))
+              , at body))))))
+
+#-lispworks
 (defun get-store-macro (name)
   "Return the defstore-? macro which will be used by a custom backend"
   (let ((macro-name (symbolicate 'defstore- name)))
@@ -50,12 +67,25 @@
                             &body body)
        (with-gensyms (gbackend)
          `(defmethod internal-store-object ,@(if qualifier (list qualifier) nil)
-            ((,gbackend ,',name) (,var ,type) ,stream)
-            ,(format nil "Definition for storing an object of type ~A with ~
+              ((,gbackend ,',name) (,var ,type) ,stream)
+              ,(format nil "Definition for storing an object of type ~A with ~
  backend ~A" type ',name)
-            (declare (ignorable ,gbackend))
-            , at body)))))
+              (declare (ignorable ,gbackend))
+              , at body)))))
+
+#+lispworks
+(defun get-restore-macro (name)
+  "Return the defrestore-? macro which will be used by a custom backend"
+  (let ((macro-name (symbolicate 'defrestore- name)))
+    `(defmacro ,macro-name ((type place &optional qualifier) &body body)
+       (with-gensyms (gbackend gtype)
+         `(dspec:def (,',macro-name (,type ,place))
+            (defmethod internal-restore-object ,@(if qualifier (list qualifier) nil)
+              ((,gbackend ,',name) (,gtype (eql ',type)) (,place t))
+              (declare (ignorable ,gbackend ,gtype))
+              , at body))))))
 
+#-lispworks
 (defun get-restore-macro (name)
   "Return the defrestore-? macro which will be used by a custom backend"
   (let ((macro-name (symbolicate 'defrestore- name)))
@@ -66,6 +96,7 @@
             (declare (ignorable ,gbackend ,gtype))
             , at body)))))
 
+
 (defun register-backend (name class magic-number stream-type old-magic-numbers 
                               compatible-magic-numbers)
   (declare (type symbol name))
@@ -87,6 +118,23 @@
     (:documentation ,(format nil "Autogenerated cl-store class for backend ~(~A~)."
                              name))))
 
+
+#+lispworks
+(defun get-dspec-alias-and-parser (name)
+  (let ((store-name (symbolicate 'defstore- name))
+        (restore-name (symbolicate 'defrestore- name)))
+    `( (dspec:define-dspec-alias ,store-name (arglist)
+         `(method cl-store::internal-store-object ,arglist))
+       (dspec:define-form-parser ,store-name (arglist)
+         `(,,store-name ,arglist))
+
+       (dspec:define-dspec-alias ,restore-name (arglist)
+         `(method cl-store::internal-restore-object ,arglist))
+
+       (dspec:define-form-parser ,restore-name (arglist)
+         `(,,restore-name ,arglist)))))
+
+
 (defmacro defbackend (name &key (stream-type ''(unsigned-byte 8))
                            (magic-number nil) fields (extends '(backend))
                            (old-magic-numbers nil) (compatible-magic-numbers nil))
@@ -98,6 +146,7 @@
   (assert (symbolp name))
   `(eval-when (:load-toplevel :execute)
      (eval-when (:compile-toplevel :load-toplevel :execute)
+       #+lispworks ,@(get-dspec-alias-and-parser name)
        ,(get-class-form name fields extends)
        ,(get-store-macro name)
        ,(get-restore-macro name))


Index: cl-store/cl-store.asd
diff -u cl-store/cl-store.asd:1.34 cl-store/cl-store.asd:1.35
--- cl-store/cl-store.asd:1.34	Thu Oct  6 09:53:04 2005
+++ cl-store/cl-store.asd	Wed Nov 30 10:49:56 2005
@@ -40,19 +40,20 @@
   :name "CL-STORE"
   :author "Sean Ross <sdr at jhb.ucs.co.za>"
   :maintainer "Sean Ross <sdr at jhb.ucs.co.za>"
-  :version "0.6.4"
+  :version "0.6.8"
   :description "Serialization package"
   :long-description "Portable CL Package to serialize data"
   :licence "MIT"
+  :serial t
   :components ((:file "package")
                #+(and clisp (not mop))
-               (:non-required-file "mop" :depends-on ("package"))
-               (:file "utils" :depends-on ("package"))
-               (:file "backends" :depends-on ("utils"))
-               (:file "plumbing" :depends-on ("backends"))
-               (:file "circularities" :depends-on ("plumbing"))
-               (:file "default-backend" :depends-on ("circularities"))
-               (:non-required-file "custom" :depends-on ("default-backend"))))
+               (:non-required-file "mop")
+               (:file "utils")
+               (:file "backends")
+               (:file "plumbing")
+               (:file "circularities")
+               (:file "default-backend")
+               (:non-required-file "custom")))
 
 (defmethod perform :after ((o load-op) (c (eql (find-system :cl-store))))
   (provide 'cl-store))


Index: cl-store/default-backend.lisp
diff -u cl-store/default-backend.lisp:1.32 cl-store/default-backend.lisp:1.33
--- cl-store/default-backend.lisp:1.32	Tue Oct  4 10:10:26 2005
+++ cl-store/default-backend.lisp	Wed Nov 30 10:49:56 2005
@@ -13,6 +13,7 @@
                                 :initform (make-hash-table :size 100))))
 
 
+
 (defun register-code (code name &optional (errorp t))
   (aif (and (gethash code (restorers (find-backend 'cl-store))) errorp)
        (error "Code ~A is already defined for ~A." code name)
@@ -245,7 +246,6 @@
   (/ (the integer (restore-object stream))
      (the integer (restore-object stream))))
 
-
 ;; chars
 (defstore-cl-store (obj character stream)
   (output-type-code +character-code+ stream)    
@@ -689,7 +689,7 @@
         name)))
 
 #+sbcl
-(defvar *sbcl-readtable* (copy-readtable *readtable*))
+(defvar *sbcl-readtable* (copy-readtable nil))
 #+sbcl
 (set-macro-character #\# #'(lambda (c s) 
                              (declare (ignore c s))
@@ -710,9 +710,10 @@
                  (*readtable* *sbcl-readtable*))
              (unless (string= new-name "")
                (handler-case (read-from-string new-name)
-                 (error (c) (declare (ignore c))
-                        (store-error "Unable to determine function name for ~A."
-                                     obj))))))
+                 (error (c) 
+                   (declare (ignore c))
+                   (store-error "Unable to determine function name for ~A."
+                                obj))))))
           (t (store-error "Unable to determine function name for ~A."
                           obj)))))
   


Index: cl-store/package.lisp
diff -u cl-store/package.lisp:1.22 cl-store/package.lisp:1.23
--- cl-store/package.lisp:1.22	Thu Sep  1 12:24:55 2005
+++ cl-store/package.lisp	Wed Nov 30 10:49:56 2005
@@ -1,6 +1,8 @@
 ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;; See the file LICENCE for licence information.
-(in-package :cl-store.system)
+
+;(in-package :cl-store.system)
+
 (defpackage #:cl-store
   (:use #:cl) 
   (:export #:backend #:magic-number #:stream-type
@@ -93,6 +95,24 @@
                           #:class-direct-superclasses
                           #:class-slots
                           #:ensure-class)
+
+  #+digitool (:import-from #:ccl
+                           #:generic-function-name
+                           #:slot-definition-name
+                           #:slot-definition-allocation
+                           #:compute-slots
+                           #:slot-definition
+                           #: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)
   
   #+(and clisp (not mop)) (:import-from #:clos
                         #:slot-value


Index: cl-store/plumbing.lisp
diff -u cl-store/plumbing.lisp:1.18 cl-store/plumbing.lisp:1.19
--- cl-store/plumbing.lisp:1.18	Tue Oct  4 10:10:26 2005
+++ cl-store/plumbing.lisp	Wed Nov 30 10:49:56 2005
@@ -34,7 +34,7 @@
        (apply #'format stream (format-string condition) 
               (format-args condition))))
 
-(define-condition cl-store-error (condition)
+(define-condition cl-store-error (error)
   ((caused-by :accessor caused-by :initarg :caused-by 
               :initform nil)
    (format-string :accessor format-string :initarg :format-string 
@@ -43,11 +43,11 @@
   (:report cl-store-report)
   (:documentation "Root cl-store condition"))
 
-(define-condition store-error (error cl-store-error)
+(define-condition store-error (cl-store-error)
   ()
   (:documentation "Error thrown when storing an object fails."))
 
-(define-condition restore-error (error cl-store-error)
+(define-condition restore-error (cl-store-error)
   ()
   (:documentation "Error thrown when restoring an object fails."))
 
@@ -76,8 +76,7 @@
           (*current-backend* backend)
           (*read-eval* nil))
      (handler-bind ((error (lambda (c)
-                             (signal (make-condition 'store-error 
-                                                     :caused-by c)))))
+                             (signal 'store-error :caused-by c))))
        (backend-store backend place obj)))))
 
 
@@ -141,8 +140,7 @@
            (*current-backend* backend)
            (*read-eval* nil))
       (handler-bind ((error (lambda (c)
-                              (signal (make-condition 'restore-error
-                                                      :caused-by c)))))
+                              (signal 'restore-error :caused-by c))))
         (backend-restore backend place)))))
 
   


Index: cl-store/utils.lisp
diff -u cl-store/utils.lisp:1.19 cl-store/utils.lisp:1.20
--- cl-store/utils.lisp:1.19	Fri Sep  9 16:59:17 2005
+++ cl-store/utils.lisp	Wed Nov 30 10:49:56 2005
@@ -125,16 +125,6 @@
           (logior (ash -1 32) ret)
           ret))))
 
-
-(defun store-string-code (string stream)
-  "Write length of STRING then STRING into stream"
-  (declare (simple-string string) (stream stream))
-  (format stream "~S" string))
-
-(defun retrieve-string-code (stream)
-  "Retrieve a String written by store-string-code from STREAM"
-  (read stream))
-
 (defun kwd (name)
   (values (intern (string-upcase name) :keyword)))
 



From sross at common-lisp.net  Wed Nov 30 09:50:02 2005
From: sross at common-lisp.net (Sean Ross)
Date: Wed, 30 Nov 2005 10:50:02 +0100 (CET)
Subject: [cl-store-cvs] CVS update: cl-store/doc/cl-store.texi 
Message-ID: <20051130095002.AFC5A8858C@common-lisp.net>

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

Modified Files:
	cl-store.texi 
Log Message:
Changelog 2005-11-30
Date: Wed Nov 30 10:49:59 2005
Author: sross

Index: cl-store/doc/cl-store.texi
diff -u cl-store/doc/cl-store.texi:1.12 cl-store/doc/cl-store.texi:1.13
--- cl-store/doc/cl-store.texi:1.12	Thu Sep  1 12:24:59 2005
+++ cl-store/doc/cl-store.texi	Wed Nov 30 10:49:59 2005
@@ -755,6 +755,14 @@
 @item  Due to the fact that function's aren't fully supported CLOS Classes initfunction slot cannot be serialized.
 @end itemize
 
+ at section Delivery with Lispworks
+Restoring lists in delivered images can be problematic since the tree shaker
+can remove the symbol cl:nil (this seems to only happen with delivery-level > 4). 
+To work around this add the following keywords to the delivery call.
+ at lisp
+  :packages-to-keep '(:cl)
+  :keep-symbols '(cl:nil)
+ at end lisp
 
 @section Regarding String Serialization
 Users are required to be extremely careful when serializing strings from one