[elephant-cvs] CVS elephant/src/elephant

[ieslick]

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) , at body)
+  #+cmu `(mp:with-lock-held (,lock) , at body)
+  #+sbcl `(sb-thread:with-mutex (,lock) , at body)
+  #+lispworks `(mp:with-lock (,lock) , at body)
+  #+mcl `(ccl:with-lock-grabbed (,lock) , at body)
+  #-(or allegro sbcl cmu lispworks mcl) `(progn , at 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