[elephant-cvs] CVS update: elephant/src/elephant.lisp

[blee at common-lisp.net]

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 at 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)
-    , at body))
+(in-package "ELE")
\ No newline at end of file