Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv25325/src

Modified Files: controller.lisp Log Message: doc-strings table-layout for btrees better with-open-store macro

Date: Thu Sep 16 06:15:32 2004 Author: blee

Index: elephant/src/controller.lisp diff -u elephant/src/controller.lisp:1.9 elephant/src/controller.lisp:1.10 --- elephant/src/controller.lisp:1.9 Sat Sep 4 10:28:44 2004 +++ elephant/src/controller.lisp Thu Sep 16 06:15:31 2004 @@ -49,12 +49,16 @@ (environment :type (or null pointer-void) :accessor controller-environment) (db :type (or null pointer-void) :accessor controller-db) + (btrees :type (or null pointer-void) :accessor controller-btrees) + (indices :type (or null pointer-void) :accessor controller-indices) + (indices-assoc :type (or null pointer-void) + :accessor controller-indices-assoc) (root :reader controller-root) (instance-cache :accessor instance-cache :initform (make-cache-table :test 'eql))) - (:documentation "Class of objects responsible for handling -the book-keeping of holding DB handles, the cache, table -creation, counters, locks, the root and garbage collection, + (:documentation "Class of objects responsible for the +book-keeping of holding DB handles, the cache, table +creation, counters, locks, the root (for garbage collection,) et cetera."))

(defgeneric cache-instance (sc obj)) @@ -65,26 +69,24 @@

(defun add-to-root (key value &key (store-controller *store-controller*)) "Add an arbitrary persistent thing to the root, so you can -retrieve it in a later session. Keys may be arbitrary -persistables as well (though note collection key semantics!) -N.B. this means it (and everything it points to) won't get -gc'd." +retrieve it in a later session. N.B. this means it (and +everything it points to) won't get gc'd." (setf (get-value key (controller-root store-controller)) value))

-(defmethod get-from-root (key &key (store-controller *store-controller*)) - "Get a persistent thing from the root." +(defun get-from-root (key &key (store-controller *store-controller*)) + "Get a something from the root." (get-value key (controller-root store-controller)))

-(defmethod remove-from-root (key &key (store-controller *store-controller*)) - "Get a persistent thing from the root." +(defun remove-from-root (key &key (store-controller *store-controller*)) + "Remove something from the root." (remove-kv key (controller-root store-controller)))

(defmethod cache-instance ((sc store-controller) obj) - "Register an instance of a user persistent-class with the -controller." + "Cache a persistent object with the controller." (setf (get-cache (oid obj) (instance-cache sc)) obj))

(defmethod get-cached-instance ((sc store-controller) oid class-name) + "Get a cached instance, or instantiate!" (let ((obj (get-cache oid (instance-cache sc)))) (if obj obj ;; Should get cached since make-instance calls cache-instance @@ -111,6 +113,7 @@ (defvar %oid-lock-length 16)

(defmethod next-oid ((sc store-controller)) + "Get the next OID." (sleepycat::next-counter (controller-environment sc) (controller-db sc) *current-transaction* @@ -128,19 +131,46 @@ (db-env-open env (controller-path sc) :create t :init-txn t :init-lock t :init-mpool t :init-log t :thread thread :recover recover :recover-fatal recover-fatal) - (let ((db (db-create env))) + (let ((db (db-create env)) + (btrees (db-create env)) + (indices (db-create env)) + (indices-assoc (db-create env))) (setf (controller-db sc) db) (db-open db :file "%ELEPHANT" :database "%ELEPHANTDB" :auto-commit t :type DB-BTREE :create t :thread thread) + + (setf (controller-btrees sc) btrees) + (sleepycat::db-set-lisp-compare btrees) + (db-open btrees :file "%ELEPHANT" :database "%ELEPHANTBTREES" + :auto-commit t :type DB-BTREE :create t :thread thread) + + (setf (controller-indices sc) indices) + (sleepycat::db-set-lisp-compare indices) + (sleepycat::db-set-lisp-dup-compare indices) + (db-set-flags indices :dup-sort t) + (db-open indices :file "%ELEPHANT" :database "%ELEPHANTINDICES" + :auto-commit t :type DB-BTREE :create t :thread thread) + + (setf (controller-indices-assoc sc) indices-assoc) + (sleepycat::db-set-lisp-compare indices-assoc) + (sleepycat::db-set-lisp-dup-compare indices-assoc) + (db-set-flags indices-assoc :dup-sort t) + (db-open indices-assoc :file "%ELEPHANT" :database "%ELEPHANTINDICES" + :auto-commit t :type DB-UNKNOWN :thread thread :rdonly t) + (sleepycat::db-fake-associate btrees indices-assoc :auto-commit t) + (let ((root (make-instance 'btree :from-oid -1))) (setf (slot-value sc 'root) root) - (let ((*auto-commit* t)) - (unless (db-get-key-buffered db %oid-entry %oid-entry-length) - (buffer-write-int 0 *out-buf*) - (db-put-buffered db %oid-entry %oid-entry-length - (buffer-stream-buffer *out-buf*) 4 - :auto-commit t) - (finish-buffer *out-buf*))) + (with-transaction () + (with-buffer-streams (key-buf value-buf) + (let ((key-b (buffer-stream-buffer key-buf))) + (setf (buffer-stream-buffer key-buf) %oid-entry) + (setf (sleepycat::buffer-stream-size key-buf) %oid-entry-length) + (unless (db-get-key-buffered db key-buf value-buf) + (reset-buffer-stream value-buf) + (buffer-write-int 0 value-buf) + (db-put-buffered db key-buf value-buf)) + (setf (buffer-stream-buffer key-buf) key-b)))) sc))))

(defmethod close-controller ((sc store-controller)) @@ -151,7 +181,13 @@ (setf (slot-value sc 'root) nil) ;; clean instance cache (setf (instance-cache sc) (make-cache-table :test 'eql)) - ;; close environment + ;; close handles / environment + (db-close (controller-indices-assoc sc)) + (setf (controller-indices-assoc sc) nil) + (db-close (controller-indices sc)) + (setf (controller-indices sc) nil) + (db-close (controller-btrees sc)) + (setf (controller-btrees sc) nil) (db-close (controller-db sc)) (setf (controller-db sc) nil) (db-env-close (controller-environment sc)) @@ -160,6 +196,8 @@

(defmacro with-open-controller ((&optional (sc '*store-controller*)) &body body) + "Executes body with the specified controller open, closing +the controller unconditionally on exit." `(unwind-protect (progn (let (*store-controller* (open-controller ,sc)) @@ -167,21 +205,24 @@ ,@body)) (close-controller ,sc)))

-(defun open-store (path) +(defun open-store (path &key (recover nil) + (recover-fatal nil) (thread t)) + "Conveniently open a store controller." (setq *store-controller* (make-instance 'store-controller :path path)) - (open-controller *store-controller*)) + (open-controller *store-controller* :recover recover + :recover-fatal recover-fatal :thread thread))

(defun close-store () + "Conveniently close the store controller." (close-controller *store-controller*))

(defmacro with-open-store ((path) &body body) - (let ((sc (gensym))) - `(let ((,sc (make-instance 'store-controller :path ,path))) - (unwind-protect - (progn - (let ((*store-controller* ,sc)) - (declare (special *store-controller*)) - (open-controller *store-controller*) - ,@body)) - (close-controller ,sc))))) + "Executes the body with an open controller, +unconditionally closing the controller on exit." + `(let ((*store-controller* (make-instance 'store-controller :path ,path))) + (declare (special *store-controller*)) + (open-controller *store-controller*) + (unwind-protect + (progn ,@body) + (close-controller *store-controller*))))