[elephant-cvs] CVS elephant/src/elephant
ieslick
ieslick at common-lisp.net
Fri Feb 2 23:52:00 UTC 2007
Update of /project/elephant/cvsroot/elephant/src/elephant
In directory clnet:/tmp/cvs-serv3271/src/elephant
Modified Files:
backend.lisp classes.lisp classindex-utils.lisp
classindex.lisp collections.lisp controller.lisp package.lisp
serializer.lisp serializer2.lisp transactions.lisp
unicode2.lisp variables.lisp
Log Message:
Large changeset to enable thread safety; more *auto-commit* removal; sql class-root fix; new transaction model; cleaned up defaults for *store-controller*
--- /project/elephant/cvsroot/elephant/src/elephant/backend.lisp 2007/01/26 14:41:13 1.7
+++ /project/elephant/cvsroot/elephant/src/elephant/backend.lisp 2007/02/02 23:51:58 1.8
@@ -67,9 +67,7 @@
#:cursor-oid
#:cursor-initialized-p
;; Transactions
- #:*transaction-stack*
#:*current-transaction*
- #:*auto-commit*
#:execute-transaction
#:controller-start-transaction
#:controller-commit-transaction
--- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2006/04/26 17:53:44 1.9
+++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/02/02 23:51:58 1.10
@@ -166,7 +166,7 @@
(setf (slot-value-using-class class instance slot-def)
(getf initargs initarg))
(return t))))
- (with-transaction (:store-controller (get-con instance))
+ (ensure-transaction (:store-controller (get-con instance))
(loop for slot-def in (class-slots class)
unless (initialize-from-initarg slot-def)
when (member (slot-definition-name slot-def) persistent-slot-inits :test #'eq)
@@ -214,7 +214,7 @@
;; Apply default values for unbound & new slots (updates class index)
(apply #'shared-initialize current (append new-persistent-slots retained-unbound-slots) initargs)
;; Copy values from old class (NOTE: should delete discarded slots?) (updates class index)
- (with-transaction (:store-controller (get-con current))
+ (ensure-transaction (:store-controller (get-con current))
(loop for slot-def in (class-slots new-class)
when (member (slot-definition-name slot-def) retained-persistent-slots)
do (setf (slot-value-using-class new-class
--- /project/elephant/cvsroot/elephant/src/elephant/classindex-utils.lisp 2006/04/26 17:53:44 1.3
+++ /project/elephant/cvsroot/elephant/src/elephant/classindex-utils.lisp 2007/02/02 23:51:58 1.4
@@ -346,6 +346,7 @@
(dump-class-index class)
(map-btree
#'(lambda (k v)
+ (declare (ignore v))
(dump-class-index k)
)
bt))
--- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2006/07/21 16:32:45 1.14
+++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/02/02 23:51:58 1.15
@@ -74,8 +74,7 @@
(if (no-indexing-needed? class instance slot-def oid)
(with-transaction (:store-controller con)
(persistent-slot-writer con new-value instance slot-name))
- (let ((class-idx (find-class-index class))
- (*auto-commit* nil))
+ (let ((class-idx (find-class-index class)))
;; (format t "Indexing object: ~A oid: ~A~%" instance oid)
(with-transaction (:store-controller con)
;; NOTE: Quick and dirty hack to ensure consistency -- needs performance improvement
--- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/01/31 20:05:38 1.6
+++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/02/02 23:51:58 1.7
@@ -325,14 +325,15 @@
(defmethod map-btree (fn (btree btree))
"Like maphash. Default implementation - overridable"
- (with-btree-cursor (curs btree)
- (loop
- (multiple-value-bind (more k v) (cursor-next curs)
- (unless more (return nil))
- (funcall fn k v)))))
+ (ensure-transaction (:store-controller (get-con btree))
+ (with-btree-cursor (curs btree)
+ (loop
+ (multiple-value-bind (more k v) (cursor-next curs)
+ (unless more (return nil))
+ (funcall fn k v))))))
(defmethod empty-btree-p ((btree btree))
- (with-transaction (:store-controller (get-con btree))
+ (ensure-transaction (:store-controller (get-con btree))
(with-btree-cursor (cur btree)
(multiple-value-bind (valid k) (cursor-next cur)
(cond ((not valid) ;; truly empty
--- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/01/31 20:05:38 1.26
+++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/02/02 23:51:58 1.27
@@ -20,7 +20,7 @@
(in-package "ELEPHANT")
;;
-;; TRACKING THE OBJECT STORE
+;; TRACKING OBJECT STORES
;;
(defparameter *elephant-backends*
@@ -39,6 +39,7 @@
(gethash name *elephant-controller-init*))
(defvar *dbconnection-spec* (make-hash-table :test 'equal))
+(defvar *dbconnection-lock* (ele-make-lock))
(defmethod get-con ((instance persistent) &optional (sc *store-controller*))
"This is used to find and validate the connection spec
@@ -77,7 +78,8 @@
(let ((init (lookup-backend-con-init (first spec))))
(unless init (error "Store controller init function not registered for backend ~A." (car spec)))
(let ((sc (funcall (symbol-function init) spec)))
- (setf (gethash spec *dbconnection-spec*) sc)
+ (ele-with-lock (*dbconnection-lock*)
+ (setf (gethash spec *dbconnection-spec*) sc))
sc)))
@@ -108,21 +110,25 @@
;;
(defun open-store (spec &rest args)
- "Conveniently open a store controller."
+ "Conveniently open a store controller. Set *store-controller* to the new controller
+ unless it is already set (opening a second controller means you must keep track of
+ controllers yourself. *store-controller* is a convenience variable for single-store
+ applications"
(assert (consp spec))
- (setq *store-controller* (get-controller spec))
- (load-user-configuration *store-controller*)
- (apply #'open-controller *store-controller* args)
- (initialize-serializer *store-controller*)
- )
+ (let ((controller (get-controller spec)))
+ (unless *store-controller*
+ (setq *store-controller* controller))
+ (load-user-configuration controller)
+ (apply #'open-controller controller args)
+ (initialize-serializer controller)
+ controller))
(defun close-store (&optional sc)
"Conveniently close the store controller."
- (declare (special *store-controller*))
- (if (or sc *store-controller*)
- (progn
- (close-controller (or sc *store-controller*))
- (setf *store-controller* nil))))
+ (when (or sc *store-controller*)
+ (close-controller (or sc *store-controller*)))
+ (unless sc
+ (setf *store-controller* nil)))
(defmacro with-open-store ((spec) &body body)
"Executes the body with an open controller,
@@ -144,13 +150,15 @@
:initarg :spec
:documentation "Backend create functions should pass in :spec during make-instance")
;; Generic support for the object, indexing and root protocols
- (instance-cache :accessor instance-cache :initform (make-cache-table :test 'eql)
- :documentation "This is an instance cache and part of the metaclass
- protocol. Backends should not override")
(root :reader controller-root
:documentation "This should be a persistent btree instantiated by the backend")
(class-root :reader controller-class-root
:documentation "This should be a persistent indexed btree instantiated by the backend")
+ (instance-cache :accessor instance-cache :initform (make-cache-table :test 'eql)
+ :documentation "This is an instance cache and part of the metaclass
+ protocol. Backends should not override")
+ (instance-cache-lock :accessor instance-cache-lock :initform (ele-make-lock)
+ :documentation "Protection for updates to the cache from multiple threads")
;; Upgradable serializer strategy
(database-version :accessor controller-version-cached :initform nil)
(serializer-version :accessor controller-serializer-version :initform nil)
@@ -166,6 +174,7 @@
(defun load-user-configuration (controller)
;; Placeholder
+ (declare (ignorable controller))
nil)
(defun initialize-serializer (sc)
@@ -199,7 +208,8 @@
(defun cache-instance (sc obj)
"Cache a persistent object with the controller."
(declare (type store-controller sc))
- (setf (get-cache (oid obj) (instance-cache sc)) obj))
+ (ele-with-lock ((instance-cache-lock sc))
+ (setf (get-cache (oid obj) (instance-cache sc)) obj)))
(defun get-cached-instance (sc oid class-name)
"Get a cached instance, or instantiate!"
@@ -215,8 +225,9 @@
"Reset the instance cache (flush object lookups). Useful
for testing. Does not reclaim existing objects so there
will be duplicate instances with identical functionality"
- (setf (instance-cache sc)
- (make-cache-table :test 'eql)))
+ (ele-with-lock ((instance-cache-lock sc))
+ (setf (instance-cache sc)
+ (make-cache-table :test 'eql))))
(defparameter *legacy-conversions-db*
'((("elephant" . "bdb-btree") . ("sleepycat" . "bdb-btree"))
--- /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2007/01/22 23:11:08 1.8
+++ /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2007/02/02 23:51:58 1.9
@@ -25,8 +25,9 @@
(:documentation
"Elephant: an object-oriented database for Common Lisp with
multiple backends for Berkeley DB, SQL and others.")
- (:export #:*store-controller* #:*current-transaction* #:*auto-commit*
- #:*elephant-lib-path* #:*elephant-code-version* #:*fast-symbols*
+ (:export #:*store-controller* #:*current-transaction*
+ #:*elephant-lib-path* #:*elephant-code-version*
+ #:with-elephant-variables
#:store-controller #:controller-root #:controller-class-root
#:controller-version #:controller-serializer-version
@@ -38,7 +39,7 @@
#:controller-fast-symbols-p
#:optimize-storage
- #:with-transaction
+ #:with-transaction #:ensure-transaction
#:start-ele-transaction #:commit-transaction #:abort-transaction
#:persistent #:persistent-object #:persistent-metaclass
--- /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2007/02/02 22:39:23 1.19
+++ /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2007/02/02 23:51:58 1.20
@@ -170,6 +170,8 @@
(the (unsigned-byte 8) (gethash ty array-type-to-byte)))
(defun int-byte-spec (position)
+ "Shared byte-spec peformance hack; not thread safe so removed
+ from use for serializer2"
(declare (optimize (speed 3) (safety 0))
(type (unsigned-byte 24) position))
#+(or cmu sbcl allegro)
--- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/01 15:19:50 1.9
+++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/02 23:51:58 1.10
@@ -36,8 +36,7 @@
(eval-when (compile)
(declaim #-elephant-without-optimize (optimize (speed 3) (safety 1) (space 0) (debug 0))
- (inline int-byte-spec
- serialize deserialize
+ (inline serialize deserialize
slots-and-values
deserialize-bignum)))
@@ -310,8 +309,11 @@
(type buffer-stream bs))
(let* ((num (abs frob))
(word-size (ceiling (/ (integer-length num) 32)))
- (needed (* word-size 4)))
- (declare (type fixnum word-size needed))
+ (needed (* word-size 4))
+ (byte-spec (byte 32 0)))
+ (declare (type fixnum word-size needed)
+ (type cons byte-spec)
+ (ignorable byte-spec))
(if (< frob 0)
(buffer-write-byte +negative-bignum+ bs)
(buffer-write-byte +positive-bignum+ bs))
@@ -321,10 +323,11 @@
;; there is an OpenMCL function which should work
;; and non-cons
do
- #+(or cmu sbcl)
- (buffer-write-uint (ldb (int-byte-spec i) num) bs) ;; (%bignum-ref num i) bs)
- #+(or allegro lispworks openmcl)
- (buffer-write-uint (ldb (int-byte-spec i) num) bs))))
+ #+(or cmu sbcl allegro)
+ (progn (setf (cdr byte-spec) (* 32 i))
+ (buffer-write-uint (ldb byte-spec num) bs)) ;; (%bignum-ref num i) bs)
+ #+(or lispworks openmcl)
+ (buffer-write-uint (ldb (byte 32 (* 32 i)) num) bs))))
;;;
;;; DESERIALIZER
@@ -480,9 +483,15 @@
(declare (type buffer-stream bs)
(type fixnum length)
(type boolean positive))
- (loop for i from 0 below (/ length 4)
- for byte-spec = (int-byte-spec i)
- with num integer = 0
- do
- (setq num (dpb (buffer-read-uint bs) byte-spec num))
- finally (return (if positive num (- num)))))
\ No newline at end of file
+ (let ((int-byte-spec (byte 32 0)))
+ (declare (dynamic-extent int-byte-spec)
+ (ignorable int-byte-spec))
+ (loop for i from 0 below (/ length 4)
+ for byte-spec =
+ #+(or cmu sbcl allegro) (progn (setf (cdr int-byte-spec) (* 32 i)) int-byte-spec)
+ #+(or lispworks openmcl) (byte 32 (* 32 i))
+ with num integer = 0
+ do
+ (setq num (dpb (buffer-read-uint bs) byte-spec num))
+ finally
+ (return (if positive num (- num))))))
\ No newline at end of file
--- /project/elephant/cvsroot/elephant/src/elephant/transactions.lisp 2006/12/16 19:35:10 1.4
+++ /project/elephant/cvsroot/elephant/src/elephant/transactions.lisp 2007/02/02 23:51:58 1.5
@@ -24,36 +24,52 @@
"This is an interface to the backend's transaction function. The
body should be executed in a dynamic environment that protects against
non-local exist, provides ACID properties for DB operations within the
- body and properly bind any relevant parameters."))
+ body and properly binds any relevant parameters."))
-;; Good defaults for bdb elephant
-(defmacro with-transaction ((&key (store-controller '*store-controller*)
- transaction
- environment
- (parent '*current-transaction*)
- degree-2 dirty-read txn-nosync
- txn-nowait txn-sync
- (retries 200))
- &body body)
+(defmacro with-transaction ((&rest keyargs &key
+ (store-controller '*store-controller*)
+ (parent '*current-transaction*)
+ (retries 200)
+ &allow-other-keys)
+ &body body)
"Execute a body with a transaction in place. On success,
the transaction is committed. Otherwise, the transaction is
aborted. If the body deadlocks, the body is re-executed in
a new transaction, retrying a fixed number of iterations.
- *auto-commit* is false for the body of the transaction."
+ If nested, the backend must support nested transactions."
`(funcall #'execute-transaction ,store-controller
(lambda () , at body)
- :transaction ,transaction
- :environment ,environment
:parent ,parent
:retries ,retries
- :degree-2 ,degree-2
- :dirty-read ,dirty-read
- :txn-nosync ,txn-nosync
- :txn-nowait ,txn-nowait
- :txn-sync ,txn-sync))
+ ,@(remove-keywords '(:store-controller :parent :retries)
+ keyargs)))
+
+(defmacro ensure-transaction ((&rest keyargs &key
+ (store-controller '*store-controller*)
+ (transaction '*current-transaction*)
+ (retries 200)
+ &allow-other-keys)
+ &body body)
+ "Execute the body with the existing transaction, or a new transaction if
+ none is currently running. This allows sequences of database actions to
+ be run atomically whether there is or is not an existing transaction
+ (rather than relying on auto-commit). with-transaction nests transactions
+ where as ensure-transaction can be part of an enclosing, flat transaction"
+ (let ((txn-fn (gensym)))
+ `(let ((,txn-fn (lambda () , at body)))
+ (if ,transaction
+ (funcall ,txn-fn)
+ (funcall #'execute-transaction ,store-controller
+ ,txn-fn
+ :parent nil
+ :transaction nil
+ :retries ,retries
+ ,@(remove-keywords '(:store-controller :parent :transaction :retries)
+ keyargs))))))
+
;;
-;; An interface to manage transactions explicitely
+;; An interface to manage transactions explicitly
;;
;; Controller methods to implement
@@ -61,43 +77,17 @@
(defgeneric controller-start-transaction (store-controller &key &allow-other-keys)
(:documentation "Start an elephant transaction"))
-(defgeneric controller-commit-transaction (store-controller &key &allow-other-keys)
+(defgeneric controller-commit-transaction (store-controller transaction &key &allow-other-keys)
(:documentation "Commit an elephant transaction"))
-(defgeneric controller-abort-transaction (store-controller &key &allow-other-keys)
+(defgeneric controller-abort-transaction (store-controller transaction &key &allow-other-keys)
(:documentation "Abort an elephant transaction"))
;;
-;; User Interface
-;;
+;; Utility
+;
-(defun start-ele-transaction (&key (store-controller *store-controller*)
- (parent *current-transaction*)
- degree-2
- dirty-read
- txn-nosync
- txn-nowait
- txn-sync)
- "Start a transaction. May be nested but not interleaved."
- (vector-push-extend *current-transaction* *transaction-stack*)
- (setq *current-transaction*
- (controller-start-transaction store-controller
- :parent parent
- :degree-2 degree-2
- :dirty-read dirty-read
- :txn-nosync txn-nosync
- :txn-nowait txn-nowait
- :txn-sync txn-sync)))
-
-(defun commit-transaction (&key (store-controller *store-controller*) txn-nosync txn-sync &allow-other-keys)
- "Commit the current transaction."
- (controller-commit-transaction store-controller
- :transaction *current-transaction*
- :txn-nosync txn-nosync
- :txn-sync txn-sync)
- (setq *current-transaction* (vector-pop *transaction-stack*)))
-
-(defun abort-transaction (&key (store-controller *store-controller*) &allow-other-keys)
- "Abort the current transaction."
- (controller-abort-transaction store-controller :transaction *current-transaction*)
- (setq *current-transaction* (vector-pop *transaction-stack*)))
+(defun remove-keywords (key-names args)
+ (loop for ( name val ) on args by #'cddr
+ unless (member name key-names)
+ append (list name val)))
--- /project/elephant/cvsroot/elephant/src/elephant/unicode2.lisp 2007/01/25 18:18:00 1.2
+++ /project/elephant/cvsroot/elephant/src/elephant/unicode2.lisp 2007/02/02 23:51:58 1.3
@@ -23,6 +23,8 @@
(in-package :elephant-serializer2)
+(declaim #-elephant-without-optimize (optimize (speed 3) (safety 1) (space 0)))
+
;;
;; Serialize string: simplify store by discovering utf8/utf16 and utf32; trade off
;; storage for computation time. Unicode makes fast memcpy too complicated so we'll
@@ -31,8 +33,7 @@
(defun serialize-string (string bstream)
"Try to write each format type and bail if code is too big"
- (declare (optimize (speed 3) (safety 0))
- (type buffer-stream bstream)
+ (declare (type buffer-stream bstream)
(type string string))
(cond ((and (not (equal "" string)) (< (char-code (char string 0)) #x7F))
(serialize-to-utf8 string bstream))
@@ -46,8 +47,7 @@
(defun serialize-to-utf8 (string bstream)
"Standard serialization"
- (declare (optimize (speed 3) (safety 0))
- (type buffer-stream bstream)
+ (declare (type buffer-stream bstream)
(type string string))
(elephant-memutil::with-struct-slots ((buffer buffer-stream-buffer)
(size buffer-stream-size)
@@ -63,7 +63,7 @@
(succeed ()
(return-from serialize-to-utf8 t)))
(buffer-write-byte +utf8-string+ bstream)
- (buffer-write-int characters bstream)
+ (buffer-write-int32 characters bstream)
(let ((needed (+ size characters)))
(declare (type fixnum needed))
(when (> needed allocated)
@@ -86,8 +86,7 @@
(defun serialize-to-utf16le (string bstream)
"Serialize to utf16le compliant format unless contains code pages > 0"
- (declare (optimize (speed 3) (safety 0))
- (type buffer-stream bstream)
+ (declare (type buffer-stream bstream)
(type string string))
(elephant-memutil::with-struct-slots ((buffer buffer-stream-buffer)
(size buffer-stream-size)
@@ -103,7 +102,7 @@
(succeed ()
(return-from serialize-to-utf16le t)))
(buffer-write-byte +utf16-string+ bstream)
- (buffer-write-int characters bstream)
+ (buffer-write-int32 characters bstream)
(let ((needed (+ size (* characters 2))))
(when (> needed allocated)
(resize-buffer-stream bstream needed))
@@ -129,16 +128,15 @@
(defun serialize-to-utf32le (string bstream)
"Serialize to utf32 compliant format unless contains code pages > 0"
- (declare (optimize (speed 3) (safety 0))
- (type buffer-stream bstream)
- (type string string))
+ (declare (type buffer-stream bstream)
+ (type string string))
(elephant-memutil::with-struct-slots ((buffer buffer-stream-buffer)
(size buffer-stream-size)
(allocated buffer-stream-length))
bstream
(let* ((characters (length string)))
(buffer-write-byte +utf32-string+ bstream)
- (buffer-write-int characters bstream)
+ (buffer-write-int32 characters bstream)
(let ((needed (+ size (* 4 characters))))
(when (> needed allocated)
(resize-buffer-stream bstream needed))
@@ -197,24 +195,24 @@
(defgeneric deserialize-string (type bstream &optional temp-string))
(defmethod deserialize-string ((type (eql :utf8)) bstream &optional temp-string)
- (declare (optimize (speed 3) (safety 0))
- (type buffer-stream bs))
+ (declare (type buffer-stream bstream))
;; Default char-code method
- (let* ((length (buffer-read-int bstream))
+ (let* ((length (buffer-read-int32 bstream))
(pos (elephant-memutil::buffer-stream-position bstream)))
(incf (elephant-memutil::buffer-stream-position bstream) length)
(progn
(let ((string (or temp-string (make-string length :element-type 'character))))
(loop for i fixnum from 0 below length do
- (setf (schar string i)
- (code-char (uffi:deref-array (buffer-stream-buffer bstream) '(:array :unsigned-byte) (+ pos i)))))
+ (setf (char string i)
+ (code-char (uffi:deref-array (buffer-stream-buffer bstream)
+ '(:array :unsigned-byte)
+ (+ pos i)))))
(the simple-string string)))))
(defmethod deserialize-string ((type (eql :utf16le)) bstream &optional temp-string)
"All returned strings are simple-strings for, uh, simplicity"
- (declare (optimize (speed 3) (safety 0))
- (type buffer-stream bs))
- (let* ((length (buffer-read-int bstream))
+ (declare (type buffer-stream bstream))
+ (let* ((length (buffer-read-int32 bstream))
(string (or temp-string (make-string length :element-type 'character)))
(pos (elephant-memutil::buffer-stream-position bstream))
(code 0))
@@ -233,9 +231,10 @@
(the simple-string string)))
(defmethod deserialize-string ((type (eql :utf32le)) bstream &optional temp-string)
+ (declare (type buffer-stream bstream))
(macrolet ((next-byte (offset)
`(uffi:deref-array (buffer-stream-buffer bstream) '(:array :unsigned-byte) (+ (* i 4) pos ,offset))))
- (let* ((length (buffer-read-int bstream))
+ (let* ((length (buffer-read-int32 bstream))
(string (or temp-string (make-string length :element-type 'character)))
(pos (elephant-memutil::buffer-stream-position bstream))
(code 0))
--- /project/elephant/cvsroot/elephant/src/elephant/variables.lisp 2007/01/22 23:11:08 1.9
+++ /project/elephant/cvsroot/elephant/src/elephant/variables.lisp 2007/02/02 23:51:58 1.10
@@ -17,17 +17,9 @@
;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;
-
(in-package "ELEPHANT")
-(declaim (type fixnum *lisp-obj-id*)
- (type hash-table *circularity-hash*)
- (type boolean *auto-commit*))
-
-(defvar *cachesize* 100
- "Size of the OID sequence cache.")
-
-;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Versioning Support
(defvar *elephant-code-version* '(0 6 1)
@@ -43,12 +35,21 @@
Users attempting to directly write this variable will run into an
error")
-;;;;;;;;;;;;;;;;;
-;;;; Serializer optimization parameters
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Optimization parameters
+
+(defvar *cachesize* 100
+ "Size of the OID sequence cache.")
(defvar *circularity-initial-hash-size* 50
"This is the default size of the circularity cache used in the serializer")
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Legacy Thread-local specials
+
+#+(or cmu sbcl allegro)
+(defvar *resourced-byte-spec* (byte 32 0)
+ "Byte specs on CMUCL, SBCL and Allegro are conses.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Thread-local specials
@@ -56,35 +57,11 @@
(defvar *store-controller* nil
"The store controller which persistent objects talk to.")
-;; Specials which control persistent objects
-(defvar *auto-commit* T
- "Commit things not in transactions?")
-
-(defvar *transaction-stack* (make-array 0 :adjustable t :fill-pointer t)
- "Used if the user manually creates transactions.")
-
-(defvar *current-transaction* +NULL-VOID+
+(defvar *current-transaction* nil
"The transaction which is currently in effect.")
-#+(or cmu sbcl allegro)
-(defvar *resourced-byte-spec* (byte 32 0)
- "Byte specs on CMUCL, SBCL and Allegro are conses.")
-
-;;
-;; Thread-specific specials
-;;
-
-;; NOTE: how to handle (*errno-buffer* (allocate-foreign-object :int 1))
-(defparameter *elephant-thread-local-vars*
- '((*store-controller* *store-controller*)
- (*current-transaction* +NULL-VOID+)
- (*transaction-stack* (make-array 0 :adjustable t :fill-pointer t))
- #+(or cmu sbcl allegro) (*resourced-byte-spec* (byte 32 0))))
-
-(defmacro with-elephant-variables (&body body)
- `(let ,*elephant-thread-local-vars*
- (declare (special ,(mapcar #'car *elephant-thread-local-vars*)))
- , at body))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Utilities
;; get rid of spot idx and adjust the arrray
(defun remove-indexed-element-and-adjust (idx array)
More information about the Elephant-cvs
mailing list