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@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@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@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)))) ,@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@common-lisp.net" :maintainer "Sean Ross sross@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)