[cl-store-cvs] CVS cl-store

sross sross at common-lisp.net
Tue Jan 23 15:37:17 UTC 2007


Update of /project/cl-store/cvsroot/cl-store
In directory clnet:/tmp/cvs-serv5685

Modified Files:
	ChangeLog circularities.lisp cl-store.asd default-backend.lisp 
	package.lisp tests.lisp 
Log Message:
Changelog 2007-01-23

--- /project/cl-store/cvsroot/cl-store/ChangeLog	2007/01/22 17:59:20	1.46
+++ /project/cl-store/cvsroot/cl-store/ChangeLog	2007/01/23 15:37:17	1.47
@@ -1,3 +1,9 @@
+2007-01-23 Sean Ross <sross at common-lisp.net>
+	* circularities.lisp: Renamed with-grouped-serialization to with-serialization-unit
+	and added two keyword args to allow removal of *grouped-restore-hash* and 
+	*grouped-store-hash* special vars as exported symbols.
+	* default-backend.lisp: Changed defvars of register-types to defparameters.
+
 2007-01-22 Sean Ross <sross at common-lisp.net>
 	* utils.lisp, circularities.lisp, tests.lisp 
 	* stop store-32-bit from creating an intermediary object
@@ -6,7 +12,7 @@
 	create-serialize-hash, with-grouped-serialization, *grouped-store-hash*
 	and *grouped-restore-hash*.
 	* conditionalize some forms which were preventing ABCL from running the tests.
-	* 
+	
 	
 2006-12-16 Sean Ross <sross at common-lisp.net>
 	* circularities.lisp: Bug fix from Alex Mizrahi. Change *restored-values*
--- /project/cl-store/cvsroot/cl-store/circularities.lisp	2007/01/22 17:59:20	1.26
+++ /project/cl-store/cvsroot/cl-store/circularities.lisp	2007/01/23 15:37:17	1.27
@@ -105,9 +105,14 @@
 (defun create-serialize-hash ()
   (make-hash-table :test #'eql :size *store-hash-size*))
 
-(defmacro with-grouped-serialization (() &body body)
-  `(let ((*grouped-store-hash* (create-serialize-hash))
-         (*grouped-restore-hash* (create-serialize-hash)))
+(defmacro with-serialization-unit ((&key store-hash restore-hash)
+                                   &body body)
+  "Executes body in a single serialization unit allowing various internal data
+structures to be reused.
+The keys store-hash and restore-hash are expected to be either nil or
+hash-tables as produced by the function create-serialize-hash."
+  `(let ((*grouped-store-hash* (or ,store-hash (create-serialize-hash)))
+         (*grouped-restore-hash* (or ,restore-hash (create-serialize-hash))))
      , at body))
 
 (defun get-store-hash ()
--- /project/cl-store/cvsroot/cl-store/cl-store.asd	2006/12/16 13:55:00	1.42
+++ /project/cl-store/cvsroot/cl-store/cl-store.asd	2007/01/23 15:37:17	1.43
@@ -45,7 +45,7 @@
   :name "CL-STORE"
   :author "Sean Ross <sross at common-lisp.net>"
   :maintainer "Sean Ross <sross at common-lisp.net>"
-  :version "0.7.6"
+  :version "0.7.9"
   :description "Serialization package"
   :long-description "Portable CL Package to serialize data"
   :licence "MIT"
--- /project/cl-store/cvsroot/cl-store/default-backend.lisp	2006/12/14 18:15:41	1.37
+++ /project/cl-store/cvsroot/cl-store/default-backend.lisp	2007/01/23 15:37:17	1.38
@@ -22,42 +22,42 @@
 
 
 ;;  Type code constants
-(defvar +referrer-code+ (register-code 1 'referrer))
-(defvar +special-float-code+ (register-code 2 'special-float))
-(defvar +unicode-string-code+ (register-code 3 'unicode-string))
-(defvar +integer-code+ (register-code 4 'integer))
-(defvar +simple-string-code+ (register-code 5 'simple-string))
-(defvar +float-code+ (register-code 6 'float))
-(defvar +ratio-code+ (register-code 7 'ratio))
-(defvar +character-code+ (register-code 8 'character))
-(defvar +complex-code+ (register-code 9 'complex))
-(defvar +symbol-code+ (register-code 10 'symbol))
-(defvar +cons-code+ (register-code 11 'cons))
-(defvar +pathname-code+ (register-code 12 'pathname))
-(defvar +hash-table-code+ (register-code 13 'hash-table))
-(defvar +standard-object-code+ (register-code 14 'standard-object))
-(defvar +condition-code+ (register-code 15 'condition))
-(defvar +structure-object-code+ (register-code 16 'structure-object))
-(defvar +standard-class-code+ (register-code 17 'standard-class))
-(defvar +built-in-class-code+ (register-code 18 'built-in-class))
-(defvar +array-code+ (register-code 19 'array))
-(defvar +simple-vector-code+ (register-code 20 'simple-vector))
-(defvar +package-code+ (register-code 21 'package))
+(defparameter +referrer-code+ (register-code 1 'referrer))
+(defparameter +special-float-code+ (register-code 2 'special-float))
+(defparameter +unicode-string-code+ (register-code 3 'unicode-string))
+(defparameter +integer-code+ (register-code 4 'integer))
+(defparameter +simple-string-code+ (register-code 5 'simple-string))
+(defparameter +float-code+ (register-code 6 'float))
+(defparameter +ratio-code+ (register-code 7 'ratio))
+(defparameter +character-code+ (register-code 8 'character))
+(defparameter +complex-code+ (register-code 9 'complex))
+(defparameter +symbol-code+ (register-code 10 'symbol))
+(defparameter +cons-code+ (register-code 11 'cons))
+(defparameter +pathname-code+ (register-code 12 'pathname))
+(defparameter +hash-table-code+ (register-code 13 'hash-table))
+(defparameter +standard-object-code+ (register-code 14 'standard-object))
+(defparameter +condition-code+ (register-code 15 'condition))
+(defparameter +structure-object-code+ (register-code 16 'structure-object))
+(defparameter +standard-class-code+ (register-code 17 'standard-class))
+(defparameter +built-in-class-code+ (register-code 18 'built-in-class))
+(defparameter +array-code+ (register-code 19 'array))
+(defparameter +simple-vector-code+ (register-code 20 'simple-vector))
+(defparameter +package-code+ (register-code 21 'package))
 
 ;; fast storing for 32 bit ints
-(defvar +32-bit-integer-code+ (register-code 24 '32-bit-integer nil))
+(defparameter +32-bit-integer-code+ (register-code 24 '32-bit-integer))
 
-(defvar +function-code+ (register-code 26 'function nil))
-(defvar +gf-code+ (register-code 27 'generic-function nil))
+(defparameter +function-code+ (register-code 26 'function nil))
+(defparameter +gf-code+ (register-code 27 'generic-function nil))
 
 ;; Used by SBCL and CMUCL.
-(defvar +structure-class-code+ (register-code 28 'structure-class nil))
-(defvar +struct-def-code+ (register-code 29 'struct-def nil))
+(defparameter +structure-class-code+ (register-code 28 'structure-class nil))
+(defparameter +struct-def-code+ (register-code 29 'struct-def nil))
 
-(defvar +gensym-code+ (register-code 30 'gensym nil))
+(defparameter +gensym-code+ (register-code 30 'gensym nil))
 
-(defvar +unicode-base-string-code+ (register-code 34 'unicode-base-string nil))
-(defvar +simple-base-string-code+ (register-code 35 'simple-base-string nil))
+(defparameter +unicode-base-string-code+ (register-code 34 'unicode-base-string nil))
+(defparameter +simple-base-string-code+ (register-code 35 'simple-base-string nil))
 
 ;; setups for type code mapping
 (defun output-type-code (code stream)
@@ -216,7 +216,7 @@
                             (write-byte type stream)
                             (return-from body)))))
         (multiple-value-setq (significand exponent sign)
-          (integer-decode-float obj))
+            (integer-decode-float obj))
         (output-type-code +float-code+ stream)
         (write-byte (float-type obj) stream)
         (store-object significand stream)
--- /project/cl-store/cvsroot/cl-store/package.lisp	2007/01/22 17:59:20	1.25
+++ /project/cl-store/cvsroot/cl-store/package.lisp	2007/01/23 15:37:17	1.26
@@ -29,8 +29,7 @@
 
            ;; Hooks into lower level circularity tracking
            ;; to reduce consing.
-           #:with-grouped-serialization #:create-serialize-hash
-           #:*grouped-store-hash* #:*grouped-restore-hash*)
+           #:with-serialization-unit #:create-serialize-hash)
   
   #+sbcl (:import-from #:sb-mop
                        #:generic-function-name
--- /project/cl-store/cvsroot/cl-store/tests.lisp	2007/01/22 17:59:20	1.30
+++ /project/cl-store/cvsroot/cl-store/tests.lisp	2007/01/23 15:37:17	1.31
@@ -573,7 +573,7 @@
 ;; custom storing
 (defclass random-obj () ((size :accessor size :initarg :size)))
 
-(defvar *random-obj-code* (register-code 100 'random-obj))
+(defparameter *random-obj-code* (register-code 100 'random-obj))
 
 (defstore-cl-store (obj random-obj buff)
   (output-type-code *random-obj-code* buff)
@@ -645,8 +645,8 @@
 
 
 
-(deftest grouped-serialization
-         (with-grouped-serialization ()
+(deftest serialization-unit.1
+         (with-serialization-unit ()
            (with-open-file (outs *test-file* :element-type '(unsigned-byte 8)
                                  :if-exists :supersede :direction :output)
              (dotimes (x 100)




More information about the Cl-store-cvs mailing list