August 2004 - elephant-cvs@common-lisp.net

[elephant-cvs] CVS update: elephant/src/sleepycat.lisp
by blee＠common-lisp.net 29 Aug '04

29 Aug '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv32447/src Modified Files: sleepycat.lisp Log Message: linux / sbcl, reorg Date: Sun Aug 29 09:55:29 2004 Author: blee Index: elephant/src/sleepycat.lisp diff -u elephant/src/sleepycat.lisp:1.4 elephant/src/sleepycat.lisp:1.5 --- elephant/src/sleepycat.lisp:1.4 Sat Aug 28 08:41:49 2004 +++ elephant/src/sleepycat.lisp Sun Aug 29 09:55:29 2004 @@ -67,6 +67,49 @@ (in-package "SLEEPYCAT") +(eval-when (:compile-toplevel :load-toplevel) + ;; UFFI + ;;(asdf:operate 'asdf:load-op :uffi) + + ;; DSO loading + + ;; Under linux you need to load some kind of pthread + ;; library. I can't figure out which is the right one. + ;; This one worked for me. There are known issues with + ;; Red Hat and Berkeley DB, search google. + #+linux + (uffi:load-foreign-library "/lib/tls/libpthread.so.0" :module "pthread") + + (uffi:load-foreign-library "/usr/local/lib/db42/libdb.so" + :module "sleepycat") + (uffi:load-foreign-library + "/home/ben/lisp/elephant/libsleepycat.so" +;; "/usr/local/share/common-lisp/elephant/libsleepycat.so" + :module "libsleepycat") + + (def-type pointer-int (* :int)) + (def-type pointer-void :pointer-void) + (def-foreign-type array-or-pointer-char + #+allegro (:array :char) + #+(or cmu sbcl scl) (* :char)) + (def-type array-or-pointer-char array-or-pointer-char) + (def-enum DBTYPE ((:BTREE 1) :HASH :QUEUE :RECNO :UNKNOWN)) +) + +(declaim (inline read-int read-uint read-float read-double + write-int write-uint write-float write-double + offset-char-pointer copy-str-to-buf copy-bufs + %db-get-key-buffered db-get-key-buffered + %db-get-buffered db-get-buffered db-get + %db-put-buffered db-put-buffered + %db-put db-put + %db-delete db-delete-buffered db-delete + %db-txn-begin db-transaction-begin + %db-txn-abort db-transaction-abort + %db-txn-commit db-transaction-commit + %db-transaction-id + flags)) + ;; Constants and Flags ;; eventually write a macro which generates a custom flag function. @@ -112,41 +155,9 @@ (defconstant DB_LOCK_NOTGRANTED -30994) (defconstant DB_NOTFOUND -30990) +(defconstant +NULL-VOID+ (make-null-pointer :void)) +(defconstant +NULL-CHAR+ (make-null-pointer :char)) -(eval-when (:compile-toplevel :load-toplevel) - ;; UFFI - ;;(asdf:operate 'asdf:load-op :uffi) - - ;; DSO loading - (defconstant +path-to-libsleepycat+ - "/home/ben/lisp/elephant/libsleepycat.so") - (defconstant +path-to-sleepycat+ - "/usr/local/lib/db42/libdb.so") - (uffi:load-foreign-library +path-to-sleepycat+ :module "sleepycat") - (uffi:load-foreign-library +path-to-libsleepycat+ :module "libsleepycat") - - (def-type pointer-int (* :int)) - (def-type pointer-void :pointer-void) - (def-foreign-type array-or-pointer-char - #+allegro (:array :char) - #+(or cmu sbcl scl) (* :char)) - (def-type array-or-pointer-char array-or-pointer-char) - (def-enum DBTYPE ((:BTREE 1) :HASH :QUEUE :RECNO :UNKNOWN)) -) - -(declaim (inline read-int read-uint read-float read-double - write-int write-uint write-float write-double - offset-char-pointer copy-str-to-buf copy-bufs - %db-get-key-buffered db-get-key-buffered - %db-get-buffered db-get-buffered db-get - %db-put-buffered db-put-buffered - %db-put db-put - %db-delete db-delete-buffered db-delete - %db-txn-begin db-transaction-begin - %db-txn-abort db-transaction-abort - %db-txn-commit db-transaction-commit - %db-transaction-id - flags)) ;; Buffer management / pointer arithmetic @@ -280,16 +291,13 @@ ;; Thread local storage (special variables) -(defconstant +NULL-VOID+ (make-null-pointer :void)) -(defconstant +NULL-CHAR+ (make-null-pointer :char)) +(declaim (type array-or-pointer-char *get-buffer*) + (type fixnum *get-buffer-length*)) (defvar *current-transaction* +NULL-VOID+) (defvar *errno-buffer* (allocate-foreign-object :int 1)) -(declaim (type array-or-pointer-char *get-buffer*) - (type fixnum *get-buffer-length*)) - (defvar *get-buffer* (allocate-foreign-object :char 1)) (defvar *get-buffer-length* 0) @@ -1035,7 +1043,7 @@ (let ((ret (%next-counter env db key key-length lockid lockid-length))) (if (< ret 0) (error 'db-error :errno ret) - ret)))) + ret))) ;; Misc

1 0

[elephant-cvs] CVS update: elephant/src/serializer.lisp
by blee＠common-lisp.net 29 Aug '04

29 Aug '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv32420/src Modified Files: serializer.lisp Log Message: split off utils.lisp, cleanup Date: Sun Aug 29 09:54:46 2004 Author: blee Index: elephant/src/serializer.lisp diff -u elephant/src/serializer.lisp:1.4 elephant/src/serializer.lisp:1.5 --- elephant/src/serializer.lisp:1.4 Sat Aug 28 08:41:00 2004 +++ elephant/src/serializer.lisp Sun Aug 29 09:54:46 2004 @@ -37,18 +37,10 @@ ;;; (in-package "ELEPHANT") -(eval-when (:compile-toplevel :load-toplevel :execute) - (use-package "UFFI")) (declaim (inline int-byte-spec - ;resize-buffer-stream - finish-buffer - buffer-write-byte buffer-write-int buffer-write-uint - buffer-write-float buffer-write-double buffer-write-string - buffer-read-byte buffer-read-fixnum buffer-read-int - buffer-read-uint buffer-read-float buffer-read-double - buffer-read-string ;serialize deserialize + slots-and-values deserialize-bignum)) (def-type foreign-char :char) @@ -75,26 +67,6 @@ (defconstant +fill-pointer-p+ #x40) (defconstant +adjustable-p+ #x80) -; a stream-like interface for our buffers. ultimately we -; might want a gray / simple -stream for real, for now who -; cares? - -(defstruct buffer-stream - (buffer (allocate-foreign-object :char 1) :type array-or-pointer-char) - (length 0 :type fixnum) - (position 0 :type fixnum)) - -;; Some thread-local storage - -(declaim (type buffer-stream *out-buf* *key-buf* *in-buf*) - (type fixnum *lisp-obj-id*) - (type hash-table *circularity-hash*)) - -(defvar *out-buf* (make-buffer-stream)) -(defvar *key-buf* (make-buffer-stream)) -(defvar *in-buf* (make-buffer-stream)) -(defvar *lisp-obj-id* 0) -(defvar *circularity-hash* (make-hash-table :test 'eq)) (defun serialize (frob bs) (declare (optimize (speed 3) (safety 0))) @@ -227,6 +199,7 @@ (finish-buffer bs))) (defun slots-and-values (o) + (declare (optimize (speed 3) (safety 0))) (loop for sd in (compute-slots (class-of o)) for slot-name = (slot-definition-name sd) with ret = () @@ -345,205 +318,6 @@ finally (return (if positive num (- num))))) - -;; Stream-like buffer interface - -(eval-when (:compile-toplevel :load-toplevel) - (defun process-struct-slot-defs (slot-defs struct) - (loop for def in slot-defs - collect (list (first def) (list (second def) struct))))) - -(defmacro with-struct-slots (slot-defs struct &body body) - `(symbol-macrolet ,(process-struct-slot-defs slot-defs struct) - ,@body)) - -(declaim (type array-or-pointer-char *buffer* *key-buffer*) - (type fixnum *buffer-length* *buffer-position* - *key-buffer-length* *key-buffer-position*)) - -(defun resize-buffer-stream (bs length) - (declare (optimize (speed 3) (safety 0)) - (type buffer-stream bs) - (type fixnum length)) - (with-struct-slots ((buf buffer-stream-buffer) - (pos buffer-stream-position) - (len buffer-stream-length)) - bs - (when (> length len) - (let ((newlen (max length (* len 2)))) - (declare (type fixnum newlen)) - (let ((newbuf (allocate-foreign-object :char newlen))) - (copy-bufs newbuf 0 buf 0 len) - (free-foreign-object buf) - (setf buf newbuf) - (setf len newlen) - nil))))) - -(defun finish-buffer (bs) - (declare (optimize (speed 3) (safety 0)) - (type buffer-stream bs)) - (with-struct-slots ((buf buffer-stream-buffer) - (pos buffer-stream-position)) - bs - (let ((length pos)) - (setf pos 0) - length))) - -(defun buffer-write-byte (b bs) - (declare (optimize (speed 3) (safety 0)) - (type buffer-stream bs) - (type (unsigned-byte 8) b)) - (with-struct-slots ((buf buffer-stream-buffer) - (pos buffer-stream-position) - (len buffer-stream-length)) - bs - (let ((needed (+ pos 1))) - (when (> needed len) - (resize-buffer-stream bs needed)) - (setf (deref-array buf '(:array :char) pos) b) - (setf pos needed)))) - -(defun buffer-write-int (i bs) - (declare (optimize (speed 3) (safety 0)) - (type buffer-stream bs) - (type (signed-byte 32) i)) - (with-struct-slots ((buf buffer-stream-buffer) - (pos buffer-stream-position) - (len buffer-stream-length)) - bs - (let ((needed (+ pos 4))) - (when (> needed len) - (resize-buffer-stream bs needed)) - (write-int buf i pos) - (setf pos needed) - nil))) - -(defun buffer-write-uint (u bs) - (declare (optimize (speed 3) (safety 0)) - (type buffer-stream bs) - (type (unsigned-byte 32) u)) - (with-struct-slots ((buf buffer-stream-buffer) - (pos buffer-stream-position) - (len buffer-stream-length)) - bs - (let ((needed (+ pos 4))) - (when (> needed len) - (resize-buffer-stream bs needed)) - (write-uint buf u pos) - (setf pos needed) - nil))) - -(defun buffer-write-float (d bs) - (declare (optimize (speed 3) (safety 0)) - (type buffer-stream bs) - (type single-float d)) - (with-struct-slots ((buf buffer-stream-buffer) - (pos buffer-stream-position) - (len buffer-stream-length)) - bs - (let ((needed (+ pos 4))) - (when (> needed len) - (resize-buffer-stream bs needed)) - (write-float buf d pos) - (setf pos needed) - nil))) - -(defun buffer-write-double (d bs) - (declare (optimize (speed 3) (safety 0)) - (type buffer-stream bs) - (type double-float d)) - (with-struct-slots ((buf buffer-stream-buffer) - (pos buffer-stream-position) - (len buffer-stream-length)) - bs - (let ((needed (+ pos 8))) - (when (> needed len) - (resize-buffer-stream bs needed)) - (write-double buf d pos) - (setf pos needed) - nil))) - -(defun buffer-write-string (s bs) - (declare (optimize (speed 3) (safety 0)) - (type buffer-stream bs) - (type string s)) - (with-struct-slots ((buf buffer-stream-buffer) - (pos buffer-stream-position) - (len buffer-stream-length)) - bs - (let* ((str-bytes (byte-length s)) - (needed (+ pos str-bytes))) - (declare (type fixnum str-bytes needed) - (dynamic-extent str-bytes needed)) - (when (> needed len) - (resize-buffer-stream bs needed)) - (copy-str-to-buf buf pos s 0 str-bytes) - (setf pos needed) - nil))) - -(defun buffer-read-byte (bs) - (declare (optimize (speed 3) (safety 0)) - (type buffer-stream bs)) - (let ((pos (buffer-stream-position bs))) - (incf (buffer-stream-position bs)) - (deref-array (buffer-stream-buffer bs) '(:array :char) pos))) - -(defun buffer-read-fixnum (bs) - (declare (optimize (speed 3) (safety 0)) - (type buffer-stream bs)) - (let ((pos (buffer-stream-position bs))) - (setf (buffer-stream-position bs) (+ pos 4)) - (the fixnum (read-int (buffer-stream-buffer bs) pos)))) - -(defun buffer-read-int (bs) - (declare (optimize (speed 3) (safety 0)) - (type buffer-stream bs)) - (let ((pos (buffer-stream-position bs))) - (setf (buffer-stream-position bs) (+ pos 4)) - (the (signed-byte 32) (read-int (buffer-stream-buffer bs) pos)))) - -(defun buffer-read-uint (bs) - (declare (optimize (speed 3) (safety 0)) - (type buffer-stream bs)) - (let ((pos (buffer-stream-position bs))) - (setf (buffer-stream-position bs) (+ pos 4)) - (the (unsigned-byte 32)(read-uint (buffer-stream-buffer bs) pos)))) - -(defun buffer-read-float (bs) - (declare (optimize (speed 3) (safety 0)) - (type buffer-stream bs)) - (let ((pos (buffer-stream-position bs))) - (setf (buffer-stream-position bs) (+ pos 4)) - (read-float (buffer-stream-buffer bs) pos))) - -(defun buffer-read-double (bs) - (declare (optimize (speed 3) (safety 0)) - (type buffer-stream bs)) - (let ((pos (buffer-stream-position bs))) - (setf (buffer-stream-position bs) (+ pos 8)) - (read-double (buffer-stream-buffer bs) pos))) - -(defun buffer-read-string (bs length) - (declare (optimize (speed 3) (safety 0)) - (type buffer-stream bs) - (type fixnum length)) - (let ((pos (buffer-stream-position bs))) - (setf (buffer-stream-position bs) (+ pos length)) - ;; wide!!! - #+(and allegro ics) - (excl:native-to-string - (offset-char-pointer (buffer-stream-buffer bs) pos) - :length length - :external-format :unicode) - #+lispworks - (fli:convert-from-foreign-string - (offset-char-pointer (buffer-stream-buffer bs) pos) - :length length :external-format :unicode :null-terminated-p nil) - #-(or lispworks (and allegro ics)) - (convert-from-foreign-string - (offset-char-pointer (buffer-stream-buffer bs) pos) - :length length :null-terminated-p nil))) - ;; array type tags (declaim (type hash-table array-type-to-byte byte-to-array-type)) @@ -578,11 +352,6 @@ (defun byte-from-array-type (ty) (the (unsigned-byte 8) (gethash ty array-type-to-byte))) - -;(defconstant +cl-store+ (char-code #\o)) - -#+(or cmu scl sbcl allegro) -(defvar *resourced-byte-spec* (byte 32 0)) (defun int-byte-spec (position) (declare (optimize (speed 3) (safety 0))

1 0

[elephant-cvs] CVS update: elephant/src/libsleepycat.c
by blee＠common-lisp.net 29 Aug '04

29 Aug '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv32393/src Modified Files: libsleepycat.c Log Message: next_counter: release lock on error, DB_TXN_NOSYNC (speed!) Date: Sun Aug 29 09:54:13 2004 Author: blee Index: elephant/src/libsleepycat.c diff -u elephant/src/libsleepycat.c:1.4 elephant/src/libsleepycat.c:1.5 --- elephant/src/libsleepycat.c:1.4 Sat Aug 28 08:40:33 2004 +++ elephant/src/libsleepycat.c Sun Aug 29 09:54:13 2004 @@ -85,7 +85,7 @@ /* Sleepycat stuff */ -#include <db42/db.h> +#include <db.h> /* Environment */ @@ -417,7 +417,7 @@ DB_LOCK lock; DBT DBTKey, DBTData; DB_TXN *tid; - int counter, tries, ret, t_ret; + int counter, tries, ret, t_ret, lockheld; u_int32_t id; /* Initialization. */ @@ -428,9 +428,12 @@ DBTKey.size = key_length; DBTData.data = lockid; DBTData.size = lockid_length; + tries = 0; loop: + lockheld = 0; + /* Begin the transaction. */ if ((ret = env->txn_begin(env, NULL, &tid, 0)) != 0) { env->err(env, ret, "DB_ENV->txn_begin"); @@ -442,6 +445,8 @@ if ((ret = env->lock_get(env, id, 0, &DBTData, DB_LOCK_WRITE, &lock)) != 0) goto fail; + lockheld = 1; + memset(&DBTData, 0, sizeof(DBTData)); DBTData.data = &counter; DBTData.ulen = sizeof(counter); @@ -462,7 +467,7 @@ if ((ret = env->lock_put(env, &lock)) != 0) goto fail; - if ((ret = tid->commit(tid, 0)) != 0) { + if ((ret = tid->commit(tid, DB_TXN_NOSYNC)) != 0) { env->err(env, ret, "DB_TXN->commit"); return (-2); } @@ -470,12 +475,16 @@ fail: + if (lockheld) + if ((ret = env->lock_put(env, &lock)) != 0) + return (-3); + /* Abort and retry the operation. */ if ((t_ret = tid->abort(tid)) != 0) { env->err(env, t_ret, "DB_TXN->abort"); - return (-3); + return (-4); } if (tries++ == 100) - return (-4); + return (-5); goto loop; }

1 0

[elephant-cvs] CVS update: elephant/src/elephant.lisp
by blee＠common-lisp.net 29 Aug '04

29 Aug '04

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(a)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

1 0

[elephant-cvs] CVS update: elephant/INSTALL
by blee＠common-lisp.net 29 Aug '04

29 Aug '04

Update of /project/elephant/cvsroot/elephant In directory common-lisp.net:/tmp/cvs-serv30665 Modified Files: INSTALL Log Message: open/close-store Date: Sun Aug 29 09:52:34 2004 Author: blee Index: elephant/INSTALL diff -u elephant/INSTALL:1.2 elephant/INSTALL:1.3 --- elephant/INSTALL:1.2 Sun Aug 29 09:43:19 2004 +++ elephant/INSTALL Sun Aug 29 09:52:34 2004 @@ -101,10 +101,7 @@ CL-USER> (use-package "ELE") T -CL-USER> (setq *store-controller* (make-instance 'store-controller :path "/home/ben/testdb")) -#<STORE-CONTROLLER {489C1EDD}> - -CL-USER> (open-controller *store-controller*) +CL-USER> (open-store "/home/ben/testdb") #<STORE-CONTROLLER {489C1EDD}> CL-USER> (setq *auto-commit* T) @@ -121,7 +118,7 @@ NIL NIL -CL-USER> (close-controller *store-controller*) +CL-USER> (close-store) NIL CL-USER> (quit) @@ -145,14 +142,13 @@ CL-USER> (use-package "ELE") T -CL-USER> (setq *store-controller* (make-instance 'store-controller :path "/home/ben/testdb")) -#<STORE-CONTROLLER {4895EE5D}> - -CL-USER> (open-controller *store-controller*) -#<STORE-CONTROLLER {4895EE5D}> +CL-USER> (open-store "/home/ben/testdb") CL-USER> (get-from-root *store-controller* "my key") "my string" T + +CL-USER> (close-store) +NIL CL-USER>

1 0

[elephant-cvs] CVS update: elephant/TUTORIAL
by blee＠common-lisp.net 29 Aug '04

29 Aug '04

Update of /project/elephant/cvsroot/elephant In directory common-lisp.net:/tmp/cvs-serv30637 Modified Files: TUTORIAL Log Message: open/close-store Date: Sun Aug 29 09:51:02 2004 Author: blee Index: elephant/TUTORIAL diff -u elephant/TUTORIAL:1.2 elephant/TUTORIAL:1.3 --- elephant/TUTORIAL:1.2 Sun Aug 29 09:45:09 2004 +++ elephant/TUTORIAL Sun Aug 29 09:51:02 2004 @@ -43,33 +43,37 @@ To create a store controller, try -* (setq *store-controller* (make-instance 'store-controller :path "testdb")) +* (open-controller "testdb") => #<STORE-CONTROLLER {49252F75}> The store controller holds the handles to the database -environment and tables, and some other bookkeeping. +environment and tables, and some other bookkeeping. If for +some reason you need to run recovery on the database (see +sleepycat docs) you can specify that with the :recover and +:recover-fatal keys. + +Alternatively, + +* (setq *store-controller* (make-instance 'store-controller :path "testdb")) +=> #<STORE-CONTROLLER {49252F75}> * (open-controller *store-controller*) => #<STORE-CONTROLLER {49252F75}> -opens the environment and database. If for some reason you -need to run recovery on the database (see sleepycat docs) -you can specify that with the :recover and :recover-fatal -keys. - -"close-controller" closes the handles. Don't forget to do -this or else you may need to run recovery later. There is a -"with-open-controller" macro. In practice, since opening -and closing a controller is very expensive, it's probably -not all that practical. - -*store-controller* is a special which is exported from the -elephant package. The persistent-* objects (see below) use -the *store-controller* special. (This is in part because -slot accessors can't take additional arguments.) If for -some reason you want to operate on 2 store controllers, -you'll have to do that by flipping the *store-controller* -special. +opens the environment and database. *store-controller* is a +special which is exported from the elephant package. The +persistent-* objects (see below) use the *store-controller* +special. (This is in part because slot accessors can't take +additional arguments.) If for some reason you want to +operate on 2 store controllers, you'll have to do that by +flipping the *store-controller* special. + +"close-store" closes the store controller. Alternatively +"close-controller" can be called on a handle. Don't forget +to do this or else you may need to run recovery later. +There is a "with-open-controller" macro. In practice, since +opening and closing a controller is very expensive, it's +probably not all that practical. Store controllers are by default thread-safe (set by the :thread key). Recovery should only be run when there are no

1 0

[elephant-cvs] CVS update: elephant/src/controller.lisp
by blee＠common-lisp.net 29 Aug '04

29 Aug '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv30603/src Modified Files: controller.lisp Log Message: missing generic warnings, open/close-store Date: Sun Aug 29 09:48:34 2004 Author: blee Index: elephant/src/controller.lisp diff -u elephant/src/controller.lisp:1.4 elephant/src/controller.lisp:1.5 --- elephant/src/controller.lisp:1.4 Sat Aug 28 08:39:56 2004 +++ elephant/src/controller.lisp Sun Aug 29 09:48:34 2004 @@ -53,6 +53,15 @@ creation, counters, locks, the root and garbage collection, et cetera.")) +(defgeneric add-to-root (sc key value)) +(defgeneric get-from-root (sc key)) +(defgeneric remove-from-root (sc key)) +(defgeneric cache-instance (sc obj)) +(defgeneric get-cached-instance (sc oid class-name)) +(defgeneric next-oid (sc)) +(defgeneric open-controller (sc &key recover recover-fatal thread)) +(defgeneric close-controller (sc)) + (defmethod add-to-root ((sc store-controller) key value) "Add an arbitrary persistent thing to the root, so you can retrieve it in a later session. Keys may be arbitrary @@ -154,3 +163,9 @@ ,@body) (close-controller ,sc))) +(defun open-store (path) + (setq *store-controller* (make-instance 'store-controller :path path)) + (open-controller *store-controller*)) + +(defun close-store () + (close-controller *store-controller*)) \ No newline at end of file

1 0

[elephant-cvs] CVS update: elephant/src/collections.lisp
by blee＠common-lisp.net 29 Aug '04

29 Aug '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv30576/src Modified Files: collections.lisp Log Message: missing generic warnings Date: Sun Aug 29 09:48:04 2004 Author: blee Index: elephant/src/collections.lisp diff -u elephant/src/collections.lisp:1.4 elephant/src/collections.lisp:1.5 --- elephant/src/collections.lisp:1.4 Sat Aug 28 08:39:30 2004 +++ elephant/src/collections.lisp Sun Aug 29 09:48:04 2004 @@ -39,15 +39,16 @@ (in-package "ELEPHANT") ;;; collection types -;;; abstract hash-like collections -;;; equal hashing (except probably for array, hashe, instance keys!) -(defclass persistent-collection (persistent) ()) - -;(defgeneric get-value (key ht &rest args)) -;(defgeneric remove-kv (key ht &rest args)) +;;; we're slot-less +(defclass persistent-collection (persistent) + ()) ;;; btree access (defclass btree (persistent-collection) ()) + +(defgeneric get-value (key ht)) +(defgeneric (setf get-value) (value key ht)) +(defgeneric remove-kv (key ht &key transaction auto-commit)) (defmethod get-value (key (ht btree)) (declare (optimize (speed 3) (safety 0) (space 3)))

1 0

[elephant-cvs] CVS update: elephant/src/utils.lisp
by blee＠common-lisp.net 29 Aug '04

29 Aug '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv30549/src Added Files: utils.lisp Log Message: initial version Date: Sun Aug 29 09:47:33 2004 Author: blee

1 0

[elephant-cvs] CVS update: elephant/src/metaclasses.lisp
by blee＠common-lisp.net 29 Aug '04

29 Aug '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv30485/src Added Files: metaclasses.lisp Log Message: andrew's new stuff, work for sbcl Date: Sun Aug 29 09:47:00 2004 Author: blee

1 0