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 () ,@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 () ,@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*))) - ,@body)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Utilities
;; get rid of spot idx and adjust the arrray (defun remove-indexed-element-and-adjust (idx array)
-
ieslick