Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv32168/src
Modified Files: elephant.lisp Log Message: updates, split off utils.lisp, sbcl imports for MOP
Date: Sun Aug 29 09:53:27 2004 Author: blee
Index: elephant/src/elephant.lisp diff -u elephant/src/elephant.lisp:1.4 elephant/src/elephant.lisp:1.5 --- elephant/src/elephant.lisp:1.4 Sat Aug 28 08:40:18 2004 +++ elephant/src/elephant.lisp Sun Aug 29 09:53:27 2004 @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; -;;; elephant.lisp -- package definition and utilities +;;; elephant.lisp -- package definition ;;; ;;; Initial version 8/26/2004 by Ben Lee ;;; blee@common-lisp.net @@ -41,33 +41,90 @@ (:use common-lisp sleepycat) (:shadow with-transaction) (:export *store-controller* *current-transaction* *auto-commit* + open-store close-store store-controller open-controller close-controller with-open-controller controller-path controller-environment - controller-db controller-root - add-to-root get-from-root + controller-db controller-root add-to-root get-from-root persistent persistent-object persistent-metaclass persistent-collection btree get-value remove-kv db-transaction-begin db-transaction-abort db-transaction-commit with-transaction + db-env-set-lock-detect db-env-get-lock-detect + db-transaction-id db-env-lock-id db-env-lock-id-free + db-env-lock-get db-env-lock-put with-lock db-env-set-timeout db-env-get-timeout db-env-set-flags db-env-get-flags - db-env-set-lock-detect db-env-get-lock-detect + run-elephant-thread ) #+cmu (:import-from :pcl + validate-superclass slot-definition-name + standard-slot-definition + standard-direct-slot-definition + standard-effective-slot-definition + initialize-internal-slot-functions + direct-slot-definition-class + compute-effective-slot-definition-initargs + effective-slot-definition-class + slot-definition-name + slot-definition-reader-function + slot-definition-writer-function + compute-effective-slot-definition + class-slots + slot-value-using-class + slot-definition-allocation compute-slots) - ;; Hopefully SBCL = CMUCL except for package names (both using Gerd's PCL) + #+cmu + (:import-from :ext + make-weak-pointer weak-pointer-value finalize) + #+sbcl (:import-from :sb-mop + validate-superclass slot-definition-name - compute-slots) - #+openmcl - (:import-from :openmcl-mop + standard-slot-definition + standard-direct-slot-definition + standard-effective-slot-definition + direct-slot-definition-class + effective-slot-definition-class slot-definition-name - compute-slots) + compute-effective-slot-definition + class-slots + slot-value-using-class + slot-definition-allocation + compute-slots) + #+sbcl + (:import-from :sb-pcl + initialize-internal-slot-functions + compute-effective-slot-definition-initargs + slot-definition-reader-function + slot-definition-writer-function) + #+sbcl + (:import-from :sb-ext + make-weak-pointer weak-pointer-value finalize) + #+allegro (:import-from :clos + validate-superclass + slot-definition-name + standard-slot-definition + slot-definition-initargs + standard-direct-slot-definition + standard-effective-slot-definition + direct-slot-definition-class + effective-slot-definition-class + slot-definition-name + compute-effective-slot-definition + class-slots + slot-value-using-class + slot-definition-allocation + compute-slots) + #+allegro + (:import-from :excl + compute-effective-slot-definition-initargs) + #+openmcl + (:import-from :openmcl-mop slot-definition-name compute-slots) #+lispworks @@ -77,68 +134,4 @@
)
-(in-package "ELEPHANT") - -;; Thread-local specials which control Elephant - -(defparameter *store-controller* nil - "The store controller which persistent objects talk to.") -(defvar *auto-commit* T) - - -;; Portable value-weak hash-tables for the cache: when the -;; values are collected, the entries (keys) should be -;; flushed from the table too - -(defun make-cache-table (&rest args) - #+(or cmu sbcl scl) - (apply #'make-hash-table args) - #+allegro - (apply #'make-hash-table :values :weak args) - #+lispworks - (apply #'make-hash-table :weak-kind :value args) - #-(or cmu sbcl scl allegro lispworks) - (apply #'make-hash-table args) - ) - -(defun get-cache (key cache) - #+(or cmu sbcl scl) - (let ((val (gethash key cache))) - (if val (values (ext:weak-pointer-value val) t) - (values nil nil))) - #-(or cmu sbcl scl) - (gethash key cache) - ) - -(defun setf-cache (key cache value) - #+(or cmu sbcl scl) - (let ((w (ext:make-weak-pointer value))) - (ext:finalize value #'(lambda () (remhash key cache))) - (setf (gethash key cache) w) - value) - #+allegro - (progn - (excl:schedule-finalization value #'(lambda () (remhash key cache))) - (setf (gethash key cache) value)) - #-(or cmu sbcl scl allegro) - (setf (gethash key cache) value) - ) - -(defsetf get-cache setf-cache) - -;; Good defaults for elephant -(defmacro with-transaction ((&key transaction - (environment (controller-environment - *store-controller*)) - (parent '*current-transaction*) - dirty-read txn-nosync - txn-nowait txn-sync) - &body body) - `(sleepycat:with-transaction (:transaction ,transaction - :environment ,environment - :parent ,parent - :dirty-read ,dirty-read - :txn-nosync ,txn-nosync - :txn-nowait ,txn-nowait - :txn-sync ,txn-sync) - ,@body)) +(in-package "ELE") \ No newline at end of file