Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv10674/src/elephant

Modified Files: serializer.lisp variables.lisp Log Message: Extended thread support in thread-safe serializer to other lisps

--- /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2006/09/04 05:01:06 1.11 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2006/09/05 03:23:17 1.12 @@ -60,25 +60,75 @@ (defconstant +fill-pointer-p+ #x40) (defconstant +adjustable-p+ #x80)

+;; +;; This may be overkill, but is intended to avoid continually allocating +;; hashes each time we serialize an object. I added some adaptation +;; to keep it from dropping and re-allocating if the user continually saves +;; large collections of objects. However the defaults should handle most +;; apps just fine. The queue is useful because a system with 10 threads +;; will need 10 circularity queues if it is storing large objects +;; + (defvar *circularity-hash-queue* nil "Circularity ids for the serializer.")

+;; quick portability hack, do we need to import 'port' or some +;; other thread layer to the elephant dependency list? + +(defun ele-make-lock () + #+allegro (mp::make-process-lock) + #+cmu (mp:make-lock) + #+sbcl (sb-thread:make-mutex) + #+mcl (ccl:make-lock) + #+lispworks (mp:make-lock) + #-(or allegro sbcl cmu lispworks mcl) nil ) + +(defmacro ele-with-lock ((lock) &body body) + #+allegro `(mp:with-process-lock (,lock) ,@body) + #+cmu `(mp:with-lock-held (,lock) ,@body) + #+sbcl `(sb-thread:with-mutex (,lock) ,@body) + #+lispworks `(mp:with-lock (,lock) ,@body) + #+mcl `(ccl:with-lock-grabbed (,lock) ,@body) + #-(or allegro sbcl cmu lispworks mcl) `(progn ,@body) ) + (defvar *circularity-lock* - #+allegro (mp::make-process-lock)) + (ele-make-lock)) + +(defun drop-circularity-hash-p (hash) + "This allows us to tune our memory usage to the application. + If grow-ceiling-p is enabled then we'll slowly adapt to + a growing demand so we balance GC load and reserved memory" + (if (> (hash-table-size hash) *circularity-max-hash-size*) + (if (and *circularity-grow-ceiling-p* + (>= (incf *circularity-adapt-count*) + *circularity-adapt-step-size*)) + (progn + (setf *circularity-max-hash-size* + (ceiling (* *circularity-growth-factor* + *circularity-max-hash-size*))) + nil) + t) + (progn + (decf *circularity-adapt-count* 0.5) + nil)))

(defun get-circularity-hash () - (if *circularity-hash-queue* - (#+allegro - mp::with-process-lock (*circularity-lock*) - (pop *circularity-hash-queue*)) - (make-hash-table :test 'eq :size 50))) + (if (not *circularity-hash-queue*) + (make-hash-table :test 'eq :size 50) + (if *circularity-lock* + (ele-with-lock (*circularity-lock*) + (pop *circularity-hash-queue*)) + (pop *circularity-hash-queue*))))

(defun release-circularity-hash (hash) - (unless (> (hash-table-size hash) 100) + (unless (drop-circularity-hash-p hash) (clrhash hash) - (#+allegro - mp::with-process-lock (*circularity-lock*) - (push hash *circularity-hash-queue*)))) + (if *circularity-lock* + (ele-with-lock (*circularity-lock*) + (push hash *circularity-hash-queue*)) + (push hash *circularity-hash-queue*)))) + +

(defun serialize (frob bs) "Serialize a lisp value into a buffer-stream." --- /project/elephant/cvsroot/elephant/src/elephant/variables.lisp 2006/09/04 00:09:15 1.3 +++ /project/elephant/cvsroot/elephant/src/elephant/variables.lisp 2006/09/05 03:23:17 1.4 @@ -43,6 +43,29 @@ Users attempting to directly write this variable will run into an error")

+;;;;;;;;;;;;;;;;; +;;;; Serializer optimization parameters + +(defvar *circularity-initial-hash-size* 50 + "This is the default size of the circularity cache used in the serializer") +(defvar *circularity-max-hash-size* 100 + "This is the largest hash table that is maintained by the serializer. Larger + hash tables are dropped from the has queue assuming that it was a one of + transaction or an error.") +(defparameter *circularity-grow-ceiling-p* t + "This enables the system to slowly adapt to larger-than-average lists or other + collections of objects (like large trees) to avoid continually GC'ing large + data structures and reducing total copying over time") +(defparameter *circularity-adapt-step-size* 4 + "How many times we see something over the max in succession before we adapt + to a larger maximum size") +(defparameter *circularity-growth-factor* 0.5 + "How much to increase the max size after each adaptation step") +(defvar *circularity-adapt-count* 0 + "Maintains a count of how many times we've seen a hash table over the appropriate + size. This is reduced by 1/2 each time we don't have one that is oversized.") + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Thread-local specials