elephant-cvs January 2007

elephant-cvs@common-lisp.net

2 participants
37 discussions

[elephant-cvs] CVS elephant/src/db-bdb
by ieslick 31 Jan '07

31 Jan '07

Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv9434/src/db-bdb Modified Files: bdb-controller.lisp berkeley-db.lisp Log Message: Unsure why this doesn't compile, probably due to strings, but I'll comment it out for now --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/01/31 20:05:37 1.17 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/01/31 22:24:16 1.18 @@ -136,8 +136,8 @@ (setf (slot-value sc 'class-root) (make-instance 'bdb-btree :from-oid -2 :sc sc)) - (when errfile - (db-set-error-file (controller-db sc) errfile)) +;; (when errfile +;; (db-set-error-file (controller-db sc) errfile)) (when deadlock-detect (start-deadlock-detector sc)) --- /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2007/01/31 20:05:37 1.5 +++ /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2007/01/31 22:24:16 1.6 @@ -485,13 +485,13 @@ :flags (force) :documentation "Make a checkpoint.") -(def-function ("db_set_error_file" %db-set-error-file) - ((db :pointer-void) - (file :cstring))) - -(defun db-set-error-file (db filename) - (with-cstrings ((fname filename)) - (%db-set-error-file db fname))) +;;(def-function ("db_set_error_file" %db-set-error-file) +;; ((db :pointer-void) +;; (file :cstring))) + +;;(defun db-set-error-file (db filename) +;; (with-cstrings ((fname filename)) +;; (%db-set-error-file db fname))) ;; Database

1 0

[elephant-cvs] CVS elephant/src/db-bdb
by ieslick 31 Jan '07

31 Jan '07

Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv24260/src/db-bdb Modified Files: bdb-collections.lisp bdb-controller.lisp berkeley-db.lisp libberkeley-db.c Removed Files: bdb-symbol-tables.lisp Log Message: Upgrade to BDB 4.5; green on Allegro 8.0/Mac OS X --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2006/12/16 19:35:10 1.11 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2007/01/31 20:05:37 1.12 @@ -19,6 +19,8 @@ (in-package :db-bdb) +(declaim #-elephant-without-optimize (optimize (speed 3) (safety 1) (space 0) (debug 0))) + (defclass bdb-btree (btree) () (:documentation "A BerkleyDB implementation of a BTree")) @@ -32,7 +34,6 @@ (make-instance 'bdb-btree :sc sc)) (defmethod get-value (key (bt bdb-btree)) - (declare (optimize (speed 3) (space 0) (safety 0))) (let ((sc (get-con bt))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (oid bt) key-buf) @@ -43,7 +44,6 @@ (values nil nil)))))) (defmethod existsp (key (bt bdb-btree)) - (declare (optimize (speed 3) (safety 0) (space 0))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (oid bt) key-buf) (serialize key key-buf (get-con bt)) @@ -55,8 +55,6 @@ (defmethod (setf get-value) (value key (bt bdb-btree)) - (declare (optimize (speed 3) (safety 0) (space 0))) - (assert (or *auto-commit* (not (eq *current-transaction* 0)))) ;; (with-transaction () (let ((sc (get-con bt))) (with-buffer-streams (key-buf value-buf) @@ -64,8 +62,7 @@ (serialize key key-buf sc) (serialize value value-buf sc) (db-put-buffered (controller-btrees sc) - key-buf value-buf - :auto-commit *auto-commit*))) + key-buf value-buf))) ;; ) value) @@ -85,15 +82,13 @@ ;; (write-value)))) (defmethod remove-kv (key (bt bdb-btree)) - (declare (optimize (speed 3) (space 0) (safety 0))) - (assert (or *auto-commit* (not (eq *current-transaction* 0)))) ;; (with-transaction (:store-controller (get-con bt)) (let ((sc (get-con bt)) ) (with-buffer-streams (key-buf) (buffer-write-int (oid bt) key-buf) (serialize key key-buf sc) (db-delete-buffered (controller-btrees sc) - key-buf :auto-commit *auto-commit*)))) + key-buf)))) ;; Secondary indices @@ -216,7 +211,6 @@ (defmethod remove-kv (key (bt bdb-indexed-btree)) "Remove a key / value pair, and update secondary indices." - (declare (optimize (speed 3))) (let ((sc (get-con bt))) (with-buffer-streams (key-buf secondary-buf) (buffer-write-int (oid bt) key-buf) @@ -252,7 +246,6 @@ (defmethod get-value (key (bt bdb-btree-index)) "Get the value in the primary DB from a secondary key." - (declare (optimize (speed 3))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (oid bt) key-buf) (serialize key key-buf (get-con bt)) @@ -263,7 +256,6 @@ (values nil nil))))) (defmethod get-primary-key (key (bt btree-index)) - (declare (optimize (speed 3))) (let ((sc (get-con bt))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (oid bt) key-buf) @@ -282,19 +274,16 @@ (defmethod make-cursor ((bt bdb-btree)) "Make a cursor from a btree." - (declare (optimize (speed 3))) (make-instance 'bdb-cursor :btree bt :handle (db-cursor (controller-btrees (get-con bt))) :oid (oid bt))) (defmethod cursor-close ((cursor bdb-cursor)) - (declare (optimize (speed 3))) (db-cursor-close (cursor-handle cursor)) (setf (cursor-initialized-p cursor) nil)) (defmethod cursor-duplicate ((cursor bdb-cursor)) - (declare (optimize (speed 3))) (make-instance (type-of cursor) :initialized-p (cursor-initialized-p cursor) :oid (cursor-oid cursor) @@ -303,7 +292,6 @@ :position (cursor-initialized-p cursor)))) (defmethod cursor-current ((cursor bdb-cursor)) - (declare (optimize (speed 3))) (when (cursor-initialized-p cursor) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf value-buf) @@ -317,7 +305,6 @@ (setf (cursor-initialized-p cursor) nil))))))) (defmethod cursor-first ((cursor bdb-cursor)) - (declare (optimize (speed 3))) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (cursor-oid cursor) key-buf) @@ -333,7 +320,6 @@ ;;A bit of a hack..... (defmethod cursor-last ((cursor bdb-cursor)) - (declare (optimize (speed 3))) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (+ (cursor-oid cursor) 1) key-buf) @@ -361,7 +347,6 @@ (setf (cursor-initialized-p cursor) nil))))))) (defmethod cursor-next ((cursor bdb-cursor)) - (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf value-buf) @@ -375,7 +360,6 @@ (cursor-first cursor))) (defmethod cursor-prev ((cursor bdb-cursor)) - (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf value-buf) @@ -389,7 +373,6 @@ (cursor-last cursor)))) (defmethod cursor-set ((cursor bdb-cursor) key) - (declare (optimize (speed 3))) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (cursor-oid cursor) key-buf) @@ -404,7 +387,6 @@ (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-set-range ((cursor bdb-cursor) key) - (declare (optimize (speed 3))) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (cursor-oid cursor) key-buf) @@ -419,7 +401,6 @@ (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-get-both ((cursor bdb-cursor) key value) - (declare (optimize (speed 3))) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (cursor-oid cursor) key-buf) @@ -435,7 +416,6 @@ (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-get-both-range ((cursor bdb-cursor) key value) - (declare (optimize (speed 3))) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (cursor-oid cursor) key-buf) @@ -450,7 +430,6 @@ (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-delete ((cursor bdb-cursor)) - (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (with-buffer-streams (key-buf value-buf) (multiple-value-bind (key val) @@ -469,7 +448,6 @@ "Put by cursor. Not particularly useful since primaries don't support duplicates. Currently doesn't properly move the cursor." - (declare (optimize (speed 3))) (if key-specified-p (setf (get-value key (cursor-btree cursor)) value) (if (cursor-initialized-p cursor) @@ -493,7 +471,6 @@ (defmethod make-cursor ((bt bdb-btree-index)) "Make a secondary-cursor from a secondary index." - (declare (optimize (speed 3))) (make-instance 'bdb-secondary-cursor :btree bt :handle (db-cursor @@ -502,7 +479,6 @@ (defmethod cursor-pcurrent ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (when (cursor-initialized-p cursor) (with-buffer-streams (key-buf pkey-buf value-buf) (multiple-value-bind (key pkey val) @@ -519,7 +495,6 @@ (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-pfirst ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (with-buffer-streams (key-buf pkey-buf value-buf) (buffer-write-int (cursor-oid cursor) key-buf) (multiple-value-bind (key pkey val) @@ -536,7 +511,6 @@ ;;A bit of a hack..... (defmethod cursor-plast ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf pkey-buf value-buf) (buffer-write-int (+ (cursor-oid cursor) 1) key-buf) @@ -568,7 +542,6 @@ (setf (cursor-initialized-p cursor) nil))))))) (defmethod cursor-pnext ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (with-buffer-streams (key-buf pkey-buf value-buf) (multiple-value-bind (key pkey val) @@ -583,7 +556,6 @@ (cursor-pfirst cursor))) (defmethod cursor-pprev ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (with-buffer-streams (key-buf pkey-buf value-buf) (multiple-value-bind (key pkey val) @@ -598,7 +570,6 @@ (cursor-plast cursor))) (defmethod cursor-pset ((cursor bdb-secondary-cursor) key) - (declare (optimize (speed 3))) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf pkey-buf value-buf) (buffer-write-int (cursor-oid cursor) key-buf) @@ -615,7 +586,6 @@ (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-pset-range ((cursor bdb-secondary-cursor) key) - (declare (optimize (speed 3))) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf pkey-buf value-buf) (buffer-write-int (cursor-oid cursor) key-buf) @@ -631,7 +601,6 @@ (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-pget-both ((cursor bdb-secondary-cursor) key pkey) - (declare (optimize (speed 3))) (with-buffer-streams (key-buf pkey-buf value-buf) (let ((primary-oid (oid (primary (cursor-btree cursor)))) (sc (get-con (cursor-btree cursor)))) @@ -649,7 +618,6 @@ (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-pget-both-range ((cursor bdb-secondary-cursor) key pkey) - (declare (optimize (speed 3))) (with-buffer-streams (key-buf pkey-buf value-buf) (let ((primary-oid (oid (primary (cursor-btree cursor)))) (sc (get-con (cursor-btree cursor)))) @@ -668,7 +636,6 @@ (defmethod cursor-delete ((cursor bdb-secondary-cursor)) "Delete by cursor: deletes ALL secondary indices." - (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (with-buffer-streams (key-buf pkey-buf value-buf) (multiple-value-bind (key pkey val) @@ -706,7 +673,6 @@ (error "Puts are forbidden on secondary indices. Try adding to the primary.")) (defmethod cursor-next-dup ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (when (cursor-initialized-p cursor) (with-buffer-streams (key-buf value-buf) (multiple-value-bind (key val) @@ -718,7 +684,6 @@ (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-next-nodup ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (with-buffer-streams (key-buf value-buf) (multiple-value-bind (key val) @@ -731,7 +696,6 @@ (cursor-first cursor))) (defmethod cursor-prev-nodup ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (with-buffer-streams (key-buf value-buf) (multiple-value-bind (key val) @@ -744,7 +708,6 @@ (cursor-last cursor))) (defmethod cursor-pnext-dup ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (when (cursor-initialized-p cursor) (with-buffer-streams (key-buf pkey-buf value-buf) (multiple-value-bind (key pkey val) @@ -757,7 +720,6 @@ (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-pnext-nodup ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (with-buffer-streams (key-buf pkey-buf value-buf) (multiple-value-bind (key pkey val) @@ -771,16 +733,15 @@ (cursor-pfirst cursor))) (defmethod cursor-pprev-nodup ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (with-buffer-streams (key-buf pkey-buf value-buf) (multiple-value-bind (key pkey val) (db-cursor-pmove-buffered (cursor-handle cursor) key-buf pkey-buf value-buf :prev-nodup t) (if (and key (= (buffer-read-int key) (cursor-oid cursor))) - (values t (deserialize key (get-con (cursor-btree cursor))) + (values t (deserialize key (get-con (cursor-btree cursor))) (deserialize val (get-con (cursor-btree cursor))) - (progn (buffer-read-int pkey) + (progn (buffer-read-int pkey) (deserialize pkey (get-con (cursor-btree cursor))))) (setf (cursor-initialized-p cursor) nil)))) (cursor-plast cursor))) --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/01/26 14:41:08 1.16 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/01/31 20:05:37 1.17 @@ -19,6 +19,8 @@ (in-package :db-bdb) +(declaim #-elephant-without-optimize (optimize (speed 3) (safety 1) (space 0) (debug 0))) + (defclass bdb-store-controller (store-controller) ((db :type (or null pointer-void) :accessor controller-db :initform '()) (environment :type (or null pointer-void) @@ -61,15 +63,15 @@ ;; Open/close ;; -(defmethod open-controller ((sc bdb-store-controller) &key (recover t) - (recover-fatal nil) (thread t) +(defmethod open-controller ((sc bdb-store-controller) &key (recover nil) + (recover-fatal nil) (thread t) (errfile nil) (deadlock-detect nil)) (let ((env (db-env-create))) - ;; thread stuff? (setf (controller-environment sc) env) + (db-env-set-flags env 0 :auto-commit t) (db-env-open env (namestring (second (controller-spec sc))) - :create t :init-txn t :init-lock t - :init-mpool t :init-log t :thread thread + :create t :init-rep nil :init-mpool t :thread thread + :init-lock t :init-log t :init-txn t :recover recover :recover-fatal recover-fatal ) (db-env-set-timeout env 100000 :set-transaction-timeout t) @@ -99,7 +101,7 @@ (db-bdb::db-set-lisp-dup-compare indices-assoc (controller-serializer-version sc)) (db-set-flags indices-assoc :dup-sort t) (db-open indices-assoc :file "%ELEPHANT" :database "%ELEPHANTINDICES" - :auto-commit t :type DB-UNKNOWN :thread thread :rdonly t) + :auto-commit t :type DB-UNKNOWN :thread thread) ;; :rdonly t) (db-bdb::db-fake-associate btrees indices-assoc :auto-commit t) (let ((db (db-create env))) @@ -134,18 +136,14 @@ (setf (slot-value sc 'class-root) (make-instance 'bdb-btree :from-oid -2 :sc sc)) + (when errfile + (db-set-error-file (controller-db sc) errfile)) + (when deadlock-detect (start-deadlock-detector sc)) sc))) -;; NOTE: This was the easist way to do this. A BDB hash table would be better -;; and perhaps generally a better thing to export; however I don't want to -;; go through the effort at this time. - -(defparameter *symbol-to-id-table-oid* -3) -(defparameter *id-to-symbol-table-oid* -4) - (defmethod close-controller ((sc bdb-store-controller)) (when (slot-value sc 'root) (stop-deadlock-detector sc) --- /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2007/01/22 22:22:35 1.4 +++ /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2007/01/31 20:05:37 1.5 @@ -77,80 +77,85 @@ ;; eventually write a macro which generates a custom flag function. ;; -;I don't like the UFFI syntax for enumerations +;; Current header file version required: Berkeley DB 4.5 + +;; I don't like the UFFI syntax for enumerations (defconstant DB-BTREE 1) (defconstant DB-HASH 2) (defconstant DB-RECNO 3) (defconstant DB-QUEUE 4) (defconstant DB-UNKNOWN 5) -(defconstant DB_CREATE #x00000001) (defconstant DB_LOCK_NOWAIT #x00000002) + +(defconstant DB_CREATE #x00000001) (defconstant DB_FORCE #x00000004) -(defconstant DB_NOMMAP #x00000008) -(defconstant DB_RDONLY #x00000010) -(defconstant DB_RECOVER #x00000020) -(defconstant DB_THREAD #x00000040) -(defconstant DB_TRUNCATE #x00000080) -(defconstant DB_TXN_NOSYNC #x00000100) -(defconstant DB_EXCL #x00002000) +(defconstant DB_MULTIVERSION #x00000008) +(defconstant DB_NOMMAP #x00000010) +(defconstant DB_RDONLY #x00000020) +(defconstant DB_RECOVER #x00000040) +(defconstant DB_THREAD #x00000080) +(defconstant DB_TRUNCATE #x00000100) +(defconstant DB_TXN_NOSYNC #x00000200) +(defconstant DB_TXN_NOT_DURABLE #x00000400) +(defconstant DB_TXN_WRITE_NOSYNC #x00000800) + +(defconstant DB_EXCL #x00004000) -(defconstant DB_TXN_NOWAIT #x00002000) -(defconstant DB_TXN_SYNC #x00004000) +(defconstant DB_TXN_NOWAIT #x00004000) +(defconstant DB_TXN_SYNC #x00008000) -(defconstant DB_DUP #x00004000) -(defconstant DB_DUPSORT #x00008000) +(defconstant DB_DUP #x00008000) +(defconstant DB_DUPSORT #x00010000) (defconstant DB_JOINENV #x00000000) -(defconstant DB_INIT_CDB #x00002000) -(defconstant DB_INIT_LOCK #x00004000) -(defconstant DB_INIT_LOG #x00008000) -(defconstant DB_INIT_MPOOL #x00010000) -(defconstant DB_INIT_REP #x00020000) -(defconstant DB_INIT_TXN #x00040000) -(defconstant DB_LOCKDOWN #x00080000) -(defconstant DB_PRIVATE #x00100000) -(defconstant DB_RECOVER_FATAL #x00200000) -(defconstant DB_SYSTEM_MEM #x00800000) -(defconstant DB_AUTO_COMMIT #x01000000) -(defconstant DB_READ_COMMITTED #x02000000) -(defconstant DB_DEGREE_2 #x02000000) ;; DEPRECATED, now called DB_READ_COMMITTED -(defconstant DB_READ_UNCOMMITTED #x04000000) -(defconstant DB_DIRTY_READ #x04000000) ;; DEPRECATED, now called DB_READ_UNCOMMITTED - -(defconstant DB_CURRENT 7) -(defconstant DB_FIRST 9) -(defconstant DB_GET_BOTH 10) -(defconstant DB_GET_BOTH_RANGE 12) -(defconstant DB_LAST 17) -(defconstant DB_NEXT 18) -(defconstant DB_NEXT_DUP 19) -(defconstant DB_NEXT_NODUP 20) -(defconstant DB_PREV 25) -(defconstant DB_PREV_NODUP 26) -(defconstant DB_SET 28) -(defconstant DB_SET_RANGE 30) +(defconstant DB_INIT_CDB #x00004000) +(defconstant DB_INIT_LOCK #x00008000) +(defconstant DB_INIT_LOG #x00010000) +(defconstant DB_INIT_MPOOL #x00020000) +(defconstant DB_INIT_REP #x00040000) +(defconstant DB_INIT_TXN #x00080000) +(defconstant DB_LOCKDOWN #x00100000) +(defconstant DB_PRIVATE #x00200000) +(defconstant DB_RECOVER_FATAL #x00400000) +(defconstant DB_REGISTER #x00800000) +(defconstant DB_SYSTEM_MEM #x01000000) +(defconstant DB_AUTO_COMMIT #x02000000) +(defconstant DB_READ_COMMITTED #x04000000) +(defconstant DB_DEGREE_2 #x04000000) ;; DEPRECATED, now called DB_READ_COMMITTED +(defconstant DB_READ_UNCOMMITTED #x08000000) +(defconstant DB_DIRTY_READ #x08000000) ;; DEPRECATED, now called DB_READ_UNCOMMITTED (defconstant DB_AFTER 1) (defconstant DB_BEFORE 3) -(defconstant DB_KEYFIRST 15) -(defconstant DB_KEYLAST 16) +(defconstant DB_CURRENT 6) +(defconstant DB_FIRST 7) +(defconstant DB_GET_BOTH 8) +(defconstant DB_GET_BOTH_RANGE 10) +(defconstant DB_LAST 15) +(defconstant DB_NEXT 16) +(defconstant DB_NEXT_DUP 17) +(defconstant DB_NEXT_NODUP 18) +(defconstant DB_PREV 23) +(defconstant DB_PREV_NODUP 24) +(defconstant DB_SET 25) +(defconstant DB_SET_RANGE 27) + +(defconstant DB_NODUPDATA 19) +(defconstant DB_NOOVERWRITE 20) +(defconstant DB_NOSYNC 21) -(defconstant DB_NODUPDATA 21) -(defconstant DB_NOOVERWRITE 22) -(defconstant DB_NOSYNC 23) - -(defconstant DB_POSITION 24) +(defconstant DB_POSITION 22) (defconstant DB_SEQ_DEC #x00000001) (defconstant DB_SEQ_INC #x00000002) (defconstant DB_SEQ_WRAP #x00000008) -(defconstant DB_SET_LOCK_TIMEOUT 29) -(defconstant DB_SET_TXN_TIMEOUT 33) +(defconstant DB_SET_LOCK_TIMEOUT 26) +(defconstant DB_SET_TXN_TIMEOUT 30) -(defconstant DB_FREELIST_ONLY #x00002000) -(defconstant DB_FREE_SPACE #x00004000) +(defconstant DB_FREELIST_ONLY #x00004000) +(defconstant DB_FREE_SPACE #x00008000) (defconstant DB_KEYEMPTY -30997) (defconstant DB_KEYEXIST -30996) @@ -256,7 +261,7 @@ (documentation nil) (transaction nil)) (let ((wname (if (listp names) (first names) names)) - (fname (if (listp names) (second names) + (fname (if (listp names) (second names) (intern (concatenate 'string "%" (symbol-name names))))) (wrapper-args (make-wrapper-args args flags keys)) (fun-args (make-fun-args args flags)) @@ -480,6 +485,14 @@ :flags (force) :documentation "Make a checkpoint.") +(def-function ("db_set_error_file" %db-set-error-file) + ((db :pointer-void) + (file :cstring))) + +(defun db-set-error-file (db filename) + (with-cstrings ((fname filename)) + (%db-set-error-file db fname))) + ;; Database (eval-when (:compile-toplevel :load-toplevel) @@ -1882,8 +1895,7 @@ :returning :int) (defun next-counter (env db parent key key-size lockid lockid-size) - "Get the next element in the counter. To be deprecated -when 4.3 is released." + "Get the next element in the counter. To be deprecated when 4.3 is released." (let ((ret (%next-counter env db parent key key-size lockid lockid-size))) (if (< ret 0) (error 'db-error :errno ret) --- /project/elephant/cvsroot/elephant/src/db-bdb/libberkeley-db.c 2007/01/22 16:17:43 1.6 +++ /project/elephant/cvsroot/elephant/src/db-bdb/libberkeley-db.c 2007/01/31 20:05:37 1.7 @@ -56,6 +56,7 @@ */ #include <stdint.h> +#include <stdio.h> #include <string.h> #include <wchar.h> @@ -173,7 +174,7 @@ DB_ENV *db_env_cr(u_int32_t flags, int *errno) { DB_ENV *envp; *errno = db_env_create(&envp, flags); - return envp; + return envp; } char * db_strerr(int error) { @@ -215,6 +216,7 @@ return dbenv->txn_checkpoint(dbenv, kbyte, min, flags); } + /* Database */ DB *db_cr(DB_ENV *dbenv, u_int32_t flags, int *errno) { @@ -265,6 +267,10 @@ return db->get_pagesize(db, pagesizep); } +void db_set_error_file(DB *db, char *filename) { + return db->set_errfile(db, fopen(filename, "w+")); +} + /* Accessors */ /* We manage our own buffers (DB_DBT_USERMEM). */

1 0

[elephant-cvs] CVS elephant/src/elephant
by ieslick 31 Jan '07

31 Jan '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv24260/src/elephant Modified Files: collections.lisp controller.lisp serializer2.lisp Log Message: Upgrade to BDB 4.5; green on Allegro 8.0/Mac OS X --- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2006/06/19 01:03:30 1.5 +++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/01/31 20:05:38 1.6 @@ -135,7 +135,6 @@ (defmethod remove-kv (key (bt btree-index)) "Remove a key / value from the PRIMARY by a secondary lookup, updating ALL other secondary indices." - (declare (optimize (speed 3))) (remove-kv (get-primary-key key bt) (primary bt))) --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/01/26 14:41:13 1.25 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/01/31 20:05:38 1.26 @@ -139,7 +139,7 @@ ;; (defclass store-controller () - ((spec :type (or pathname string (simple-array character)) + ((spec :type list :accessor controller-spec :initarg :spec :documentation "Backend create functions should pass in :spec during make-instance") --- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/01/25 18:18:00 1.6 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/01/31 20:05:38 1.7 @@ -20,7 +20,7 @@ (:use :cl :elephant :elephant-memutil) (:import-from :elephant *circularity-initial-hash-size* - *resourced-byte-spec* + #+(or cmu sbcl allegro) get-cached-instance controller-symbol-cache controller-symbol-id-cache

1 0

[elephant-cvs] CVS elephant/src/memutil
by ieslick 31 Jan '07

31 Jan '07

Update of /project/elephant/cvsroot/elephant/src/memutil In directory clnet:/tmp/cvs-serv24260/src/memutil Modified Files: memutil.lisp Log Message: Upgrade to BDB 4.5; green on Allegro 8.0/Mac OS X --- /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2007/01/20 22:12:18 1.14 +++ /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2007/01/31 20:05:38 1.15 @@ -82,7 +82,7 @@ (length :int)) :returning :void)) -(eval-when (compile) +(eval-when (:compile-toplevel) (declaim #-elephant-without-optimize (optimize (speed 3) (safety 1) (space 0) (debug 0)) (inline read-int read-uint read-float read-double

1 0

[elephant-cvs] CVS elephant
by ieslick 31 Jan '07

31 Jan '07

Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv24260 Modified Files: TODO ele-bdb.asd Log Message: Upgrade to BDB 4.5; green on Allegro 8.0/Mac OS X --- /project/elephant/cvsroot/elephant/TODO 2007/01/25 18:17:59 1.37 +++ /project/elephant/cvsroot/elephant/TODO 2007/01/31 20:05:37 1.38 @@ -7,14 +7,13 @@ -------------------------------------------- Active tasks: -- Speed up symbol storage and reference using symbol id's - - Fast symbols are property tag in DB (so code doesn't corrupt DB) - Full 64-bit support (arrays, native 64-bit fixnums, etc) - Set parameter at startup based on *features* - Mark fixnums appropriately: 32-bit lisps can decode 64-bit fixnums as bignums (two 32-bit entities) - propogate assumptions to bignum byte specs - are there other fixed assumptions? - char vs. uint8 in buffer-stream to read-out (See Marco e-mail) + - Ensure serialization is thread-safe and reasonably efficient - Provide support for fast and slow critical sections by lisps: buffer-streams, circularity-arrays/hashes, shared controller side-effects... (see email) @@ -69,6 +68,7 @@ - Cleaner failure modes if operations are performed without repository or without transaction or auto-commit (auto-commit solved by 4.4?) - Review and address all NOTE comments in the code +- Use SWIG and CFFI to better track changes in defconstant? RELEASE ISSUES @@ -81,8 +81,6 @@ - Validate migration 0.6.0->0.6.1 - Validate that migrate can use either O(c) or O(n/c) where c << n memory - Windows support for asdf-based library builds? Include dll? -- Allow dump of fast-symbol tables for low-level reconstruction in case of - catastrophic errors Documentation: - Migrate code base to SVN and create tickets in TRAC @@ -99,7 +97,6 @@ January 22, 2006 checkins: x Modularize serializers for easy upgrade -x Implement backend support for symbol-table protocol x MCL 1.1 unicode support; clean up other lisp support for unicode x Simplify user-specific configuration parameters using config.sexp and my-config.sexp x Ensure thread safety in buffer-stream allocation! --- /project/elephant/cvsroot/elephant/ele-bdb.asd 2007/01/21 21:20:03 1.15 +++ /project/elephant/cvsroot/elephant/ele-bdb.asd 2007/01/31 20:05:37 1.16 @@ -63,7 +63,6 @@ (:bdb-c-source "libberkeley-db") (:file "berkeley-db") (:file "bdb-controller") - (:file "bdb-symbol-tables") (:file "bdb-slots") (:file "bdb-collections") (:file "bdb-transactions"))

1 0

[elephant-cvs] CVS elephant
by ieslick 29 Jan '07

29 Jan '07

Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv26676 Modified Files: elephant.asd Log Message: Build support for 64-bit compilation or OpenMCL 1.1 on OS X --- /project/elephant/cvsroot/elephant/elephant.asd 2007/01/25 18:17:59 1.24 +++ /project/elephant/cvsroot/elephant/elephant.asd 2007/01/29 15:15:04 1.25 @@ -109,6 +109,7 @@ (list #-(or darwin macosx darwin-host) "-shared" #+(or darwin macosx darwin-host) "-bundle" + #+(or x8664-target) "-arch x86_64" "-Wall" "-fPIC" "-O3"

1 0

[elephant-cvs] CVS elephant/src/elephant
by rread 26 Jan '07

26 Jan '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv22773/src/elephant Modified Files: backend.lisp controller.lisp serializer.lisp Log Message: Repairing the use of the serializer for the SQL side --- /project/elephant/cvsroot/elephant/src/elephant/backend.lisp 2007/01/25 19:37:53 1.6 +++ /project/elephant/cvsroot/elephant/src/elephant/backend.lisp 2007/01/26 14:41:13 1.7 @@ -39,6 +39,7 @@ #:*elephant-code-version* #:store-controller #:open-controller + #:database-version #:close-controller #:controller-serialize #:controller-deserialize @@ -95,6 +96,7 @@ #:*elephant-code-version* #:store-controller #:open-controller + #:database-version #:close-controller #:controller-serialize #:controller-deserialize @@ -136,4 +138,4 @@ #:register-backend-con-init #:lookup-backend-con-init )) - \ No newline at end of file + --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/01/25 19:37:53 1.24 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/01/26 14:41:13 1.25 @@ -112,8 +112,9 @@ (assert (consp spec)) (setq *store-controller* (get-controller spec)) (load-user-configuration *store-controller*) + (apply #'open-controller *store-controller* args) (initialize-serializer *store-controller*) - (apply #'open-controller *store-controller* args)) + ) (defun close-store (&optional sc) "Conveniently close the store controller." @@ -178,24 +179,7 @@ (setf (controller-serialize sc) 'elephant-serializer2::serialize) (setf (controller-deserialize sc) 'elephant-serializer2::deserialize)))) -;; -;; VERSIONING -;; -(defmethod database-version ((sc store-controller)) - "A version determination for a given store - controller that is independant of the serializer as the - serializer is dispatched based on the code version which is a - list of the form '(0 6 0)" - (let ((version (controller-version-cached sc))) - (if version version - (let ((path (make-pathname :name "VERSION" :defaults (second (controller-spec sc))))) - (if (probe-file path) - (with-open-file (stream path :direction :input) - (setf (controller-version-cached sc) (read stream))) - (with-open-file (stream path :direction :output) - (setf (controller-version-cached sc) - (write *elephant-code-version* :stream stream)))))))) (defun prior-version-p (v1 v2) "Is v1 an equal or earlier version than v2" @@ -258,6 +242,15 @@ (intern (string-upcase (cdr name)) (car name))) + +;; +;; VERSIONING +;; + +(defgeneric database-version (sc) + (:documentation "Backends implement this to store the serializer version") + ) + ;; ;; STORE CONTROLLER PROTOCOL ;; --- /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2007/01/21 21:20:04 1.17 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2007/01/26 14:41:13 1.18 @@ -36,19 +36,24 @@ (with-buffer-streams (out-buf) (cl-base64::usb8-array-to-base64-string (elephant-memutil::buffer-read-byte-vector - (serialize x out-buf sc))))) + (serialize x out-buf sc))) + ) +) (defun convert-buffer-to-base64-string (bs sc) (declare (ignore sc)) (cl-base64::usb8-array-to-base64-string - (elephant-memutil::buffer-read-byte-vector bs))) + (elephant-memutil::buffer-read-byte-vector bs) +) +) (defun deserialize-from-base64-string (x sc) (with-buffer-streams (other) (deserialize (elephant-memutil::buffer-write-byte-vector other - (cl-base64::base64-string-to-usb8-array x)) + (cl-base64::base64-string-to-usb8-array x) + ) sc) ))

1 0

[elephant-cvs] CVS elephant/src/db-clsql
by rread 26 Jan '07

26 Jan '07

Update of /project/elephant/cvsroot/elephant/src/db-clsql In directory clnet:/tmp/cvs-serv22773/src/db-clsql Modified Files: sql-collections.lisp sql-controller.lisp Log Message: Repairing the use of the serializer for the SQL side --- /project/elephant/cvsroot/elephant/src/db-clsql/sql-collections.lisp 2007/01/19 21:03:30 1.7 +++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-collections.lisp 2007/01/26 14:41:08 1.8 @@ -27,19 +27,17 @@ ;; Somehow I suspect that what I am getting back here ;; is actually the main key... - (let* ((sc (get-con bt)) - (con (controller-db sc))) - (let ((pk (sql-get-from-clcn (oid bt) key sc con))) + (let* ((sc (get-con bt))) + (let ((pk (sql-get-from-clcn (oid bt) key sc))) (if pk - (sql-get-from-clcn (oid (primary bt)) pk sc con)) + (sql-get-from-clcn (oid (primary bt)) pk sc)) ))) (defmethod get-primary-key (key (bt sql-btree-index)) (declare (optimize (speed 3))) (let* ((sc (get-con bt)) - (con (controller-db sc)) ) - (sql-get-from-clcn (oid bt) key sc con))) + (sql-get-from-clcn (oid bt) key sc))) ;; My basic strategy is to keep track of a current key @@ -321,9 +319,8 @@ (let* ((cur-pk (aref (:sql-crsr-ks cursor) (:sql-crsr-ck cursor))) (sc (get-con (cursor-btree cursor))) - (con (controller-db sc)) (indexed-pk (sql-get-from-clcn-nth (cursor-oid cursor) cur-pk - sc con + sc (:dp-nmbr cursor)))) (if indexed-pk (let ((v (get-value indexed-pk (primary (cursor-btree cursor))))) @@ -533,8 +530,7 @@ (setf (:dp-nmbr cursor) (sql-get-from-clcn-cnt (cursor-oid cursor) (get-current-key cursor) - (controller-db (get-con (cursor-btree cursor))) - + (get-con (cursor-btree cursor)) )))) (has-key-value-scnd cursor :returnpk returnpk)) (cursor-last-x cursor :returnpk returnpk))) @@ -600,7 +596,7 @@ (- (sql-get-from-clcn-cnt (cursor-oid cursor) (get-current-key cursor) - (controller-db (get-con (cursor-btree cursor))) + (get-con (cursor-btree cursor)) ) 1)) (assert (>= (:dp-nmbr cursor) 0)) @@ -621,7 +617,7 @@ (setf (:dp-nmbr cursor) (- (sql-get-from-clcn-cnt (cursor-oid cursor) (get-current-key cursor) - (controller-db (get-con (cursor-btree cursor))) + (get-con (cursor-btree cursor)) ) 1)) (has-key-value-scnd cursor :returnpk returnpk)) (cursor-last-x cursor :returnpk returnpk))) --- /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp 2006/11/11 18:41:11 1.12 +++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp 2007/01/26 14:41:08 1.13 @@ -59,33 +59,29 @@ ) (defmethod get-value (key (bt sql-btree)) - (let* ((sc (get-con bt)) - (con (controller-db sc))) - (sql-get-from-clcn (oid bt) key sc con) + (let* ((sc (get-con bt))) + (sql-get-from-clcn (oid bt) key sc) ) ) (defmethod (setf get-value) (value key (bt sql-btree)) - (let* ((sc (get-con bt)) - (con (controller-db sc))) - (sql-add-to-clcn (oid bt) key value sc con) + (let* ((sc (get-con bt))) + (sql-add-to-clcn (oid bt) key value sc) ) ) (defmethod existsp (key (bt sql-btree)) - (let* ((sc (get-con bt)) - (con (controller-db sc))) - (sql-from-clcn-existsp (oid bt) key con) + (let* ((sc (get-con bt))) + (sql-from-clcn-existsp (oid bt) key sc) ) ) (defmethod remove-kv (key (bt sql-btree)) - (let* ((sc (get-con bt)) - (con (controller-db sc))) + (let* ((sc (get-con bt))) (sql-remove-one-from-clcn (oid bt) key sc - con)) + )) ) @@ -129,8 +125,7 @@ ) (defmethod add-index ((bt sql-indexed-btree) &key index-name key-form populate) - (let* ((sc (get-con bt)) - (con (controller-db sc))) + (let* ((sc (get-con bt))) (if (and (not (null index-name)) (symbolp index-name) (or (symbolp key-form) (listp key-form))) (let ((indices (indices bt)) @@ -146,15 +141,15 @@ #'(lambda (k v) (multiple-value-bind (index? secondary-key) (funcall key-fn index k v) -;; This is a slow, DB cycle intensive operation. It could chunked somehow, -;; I think, probably making it 10 times faster. + ;; This is a slow, DB cycle intensive operation. It could chunked somehow, + ;; I think, probably making it 10 times faster. (when index? (unless (sql-from-clcn-key-and-value-existsp - (oid index) secondary-key k con) + (oid index) secondary-key k sc) (sql-add-to-clcn (oid index) secondary-key k - sc con :insert-only t)) + sc :insert-only t)) ))) bt)))) index) @@ -163,7 +158,6 @@ (defmethod (setf get-value) (value key (bt sql-indexed-btree)) "Set a key / value pair, and update secondary indices." (let* ((sc (get-con bt)) - (con (controller-db sc)) (indices (indices-cache bt))) (with-transaction (:store-controller sc) (maphash @@ -174,15 +168,15 @@ (when index? ;; This duplicates values that are already there... (unless (sql-from-clcn-key-and-value-existsp - (oid index) secondary-key key con) + (oid index) secondary-key key sc) (sql-add-to-clcn (oid index) secondary-key key - sc con :insert-only t)) + sc :insert-only t)) ))) indices) ;; Now we place the actual value - (sql-add-to-clcn (oid bt) key value sc con) + (sql-add-to-clcn (oid bt) key value sc) ) value)) @@ -191,7 +185,7 @@ (declare (optimize (speed 3))) (let* ( (sc (get-con bt)) - (con (controller-db sc))) + ) (with-transaction (:store-controller sc) (let ((value (get-value key bt))) (when value @@ -209,13 +203,13 @@ (sql-remove-key-and-value-from-clcn (oid index) secondary-key key - con) + sc) ;; And furthermore, we have to remove the index entry ;; (remove-kv secondary-key index) ))) indices) ;; Now we place the actual value - (sql-remove-from-clcn (oid bt) key sc con)) + (sql-remove-from-clcn (oid bt) key sc)) ) value)))) @@ -233,6 +227,22 @@ ;; way to recover from that automatically. If it ;; does not exist, return nil so we can create it later! + +(defun version-table-exists (con) + ;; we want to use ":owner :all" because we don't really care who created + ;; the table, as long as we have the rights we need! + (clsql:table-exists-p [version] :database con :owner :all) + ) + +(defun create-version-table (con) + ;; ALL OF THIS needs to be inside a transaction. + (clsql::create-table [version] + '( + ([serializerversion] text :not-null) + ) :database con + ) + ) + ;; These functions are probably not cross-database portable... (defun keyvalue-table-exists (con) ;; we want to use ":owner :all" because we don't really care who created @@ -240,6 +250,7 @@ (clsql:table-exists-p [keyvalue] :database con :owner :all) ) + ;; This is just an initial version; it is possible that ;; we might someday wish to use blobs instead; certainly, I am ;; storing blobs now in the Berkeley-db and we meed to make sure @@ -260,12 +271,15 @@ ;; ALL OF THIS needs to be inside a transaction. (clsql::create-table [keyvalue] - '( - ([clctn_id] integer :not-null) - ([key] text :not-null) - ([value] text) - ) :database con - ) + + ;; This is most likely to work with any database system.. + '( + ([clctn_id] integer :not-null) + ([key] text :not-null) + ([value] text) + ) + :database con) + ;; :constraints '("PRIMARY KEY (clctn_id key)" ;; "UNIQUE (clctn_id,key)") @@ -278,22 +292,46 @@ ;;) ;; (unless (index-exists-p [idx_clctn_id]) (clsql::create-index [idx_clctn_id] :on [keyvalue] - :attributes '([clctn_id]) - :database con) + :attributes '([clctn_id]) + :database con) ;; ) ;; (unless (index-exists-p [idx_key]) (clsql::create-index [idx_key] :on [keyvalue] - :attributes '([key]) - :database con) + :attributes '([key]) + :database con) ;;) ;; This is actually unique ;; (unless (index-exists-p [idx_both]) (clsql:create-index [idx_both] :on [keyvalue] - :attributes '([clctn_id] [key]) - :database con) + :attributes '([clctn_id] [key]) + :database con) ;;) ) +(defmethod database-version ((sc sql-store-controller)) + "A version determination for a given store + controller that is independant of the serializer as the + serializer is dispatched based on the code version which is a + list of the form '(0 6 0)" + (let* ((con (controller-db sc)) + (version (elephant::controller-version-cached sc))) + (if version version + (let ((tuples + (clsql::select [serializerversion] + :from [version] + :database con))) + ;; The table should exists, but there may or may not be a record there... + (setf (elephant::controller-version-cached sc) + (if tuples + (read-from-string (caar tuples)) + (clsql::insert-records :into [version] + :attributes '(serializerversion) + :values (list (format nil "~A" *elephant-code-version*)) + :database con) + ) + ))))) + + (defmethod open-controller ((sc sql-store-controller) ;; At present these three have no meaning &key @@ -304,14 +342,18 @@ (the sql-store-controller (let* ((dbtype (car (second (controller-spec sc)))) (con (clsql:connect (cdr (second (controller-spec sc))) - :database-type dbtype - :if-exists :old))) + :database-type dbtype + :if-exists :old))) (setf (slot-value sc 'db) con) ;; Now we should make sure that the KEYVALUE table exists, and, if ;; it does not, we need to create it.. (unless (keyvalue-table-exists con) (with-transaction (:store-controller sc) (create-keyvalue-table con))) + (unless (version-table-exists con) + (with-transaction (:store-controller sc) + (create-version-table con))) + (elephant::initialize-serializer sc) ;; These should get oid 0 and 1 respectively (setf (slot-value sc 'root) (make-instance 'sql-btree :sc sc :from-oid 0)) (setf (slot-value sc 'class-root) (make-instance 'sql-indexed-btree :sc sc :from-oid 1)) @@ -322,7 +364,7 @@ (defmethod reconnect-controller ((sc sql-store-controller)) (setf (controller-db sc) (clsql:reconnect :database (controller-db sc))) -) + ) (defmethod close-controller ((sc sql-store-controller)) (when (slot-value sc 'db) ;; close the connection @@ -337,7 +379,7 @@ (defmethod next-oid ((sc sql-store-controller )) (let ((con (controller-db sc))) (clsql:sequence-next [persistent_seq] - :database con)) + :database con)) ) ;; if add-to-root is a method, then we can make it class dependent... @@ -348,39 +390,39 @@ ;; a proper method myself, but I will give it a name so it doesn't ;; conflict with 'add-to-root. 'add-to-root can remain a convenience symbol, ;; that will end up calling this routine! -(defun sql-add-to-root (key value pgsc con) - (sql-add-to-clcn 0 key value pgsc con) +(defun sql-add-to-root (key value sc) + (sql-add-to-clcn 0 key value sc) ) -(defun sql-add-to-clcn (clcn key value sc con - &key (insert-only nil)) +(defun sql-add-to-clcn (clcn key value sc + &key (insert-only nil)) (declare (ignore sc)) (assert (integerp clcn)) - (let ( + (let ((con (controller-db sc)) (vbs - (serialize-to-base64-string value)) + (serialize-to-base64-string value sc)) (kbs - (serialize-to-base64-string key)) + (serialize-to-base64-string key sc)) ) - (if (and (not insert-only) (sql-from-clcn-existsp clcn key con)) + (if (and (not insert-only) (sql-from-clcn-existsp clcn key sc)) (clsql::update-records [keyvalue] - :av-pairs `((key ,kbs) - (clctn_id ,clcn) - (value ,vbs)) - :where [and [= [clctn_id] clcn] [= [key] kbs]] - :database con) + :av-pairs `((key ,kbs) + (clctn_id ,clcn) + (value ,vbs)) + :where [and [= [clctn_id] clcn] [= [key] kbs]] + :database con) (clsql::insert-records :into [keyvalue] - :attributes '(key clctn_id value) - :values (list kbs clcn vbs) - :database con - )) + :attributes '(key clctn_id value) + :values (list kbs clcn vbs) + :database con + )) ) value ) -(defun sql-get-from-root (key sc con) - (sql-get-from-clcn 0 key sc con) +(defun sql-get-from-root (key sc) + (sql-get-from-clcn 0 key sc) ) ;; This is a major difference betwen SQL and BDB: @@ -399,22 +441,29 @@ ;; To do that I have to read in all of the values and deserialized them ;; This could be a good reason to keep the oids out, and separte, in ;; a separate column. -(defun sql-get-from-clcn (clcn key sc con) +(defun sql-get-from-clcn (clcn key sc) (assert (integerp clcn)) - (sql-get-from-clcn-nth clcn key sc con 0) + (sql-get-from-clcn-nth clcn key sc 0) ) -(defun sql-get-from-clcn-nth (clcn key sc con n) +(defun sql-get-from-clcn-nth (clcn key sc n) (assert (and (integerp clcn) (integerp n))) - (let* ( + (let* ((con (controller-db sc)) (kbs - (serialize-to-base64-string key)) + (serialize-to-base64-string key sc)) + (offsetquery (format nil "select value from keyvalue where clctn_id = ~A and key = '~A' order by value offset ~A limit 1 " + clcn + kbs + n)) (tuples - (clsql::select [value] - :from [keyvalue] - :where [and [= [clctn_id] clcn] [= [key] kbs]] - :database con - ))) +;; (clsql::query offsetquery :database con) + (clsql::select [value] + :from [keyvalue] + :where [and [= [clctn_id] clcn] [= [key] kbs]] + :database con + ) + ) + ) ;; Get the lowest value by sorting and taking the first value; ;; this isn't a very good way to do things... ;; Note also that this will be extremely inefficient if @@ -424,95 +473,101 @@ ;; that efficiently without changing the database structure; ;; but that's OK, I could add a column to support that ;; relatively easily later on. +;; (if (and (> (length tuples) 1)) +;; (format t "l = ~A~%" (length tuples)) +;; ) (if (< n (length tuples)) +;; (values (deserialize-from-base64-string (car (nth n tuples)) sc) +;; t) (values (nth n (sort (mapcar #'(lambda (x) - (deserialize-from-base64-string (car x) :sc sc)) + (deserialize-from-base64-string (car x) sc)) tuples) #'my-generic-less-than)) t) (values nil nil)))) -(defun sql-get-from-clcn-cnt (clcn key con) +(defun sql-get-from-clcn-cnt (clcn key sc) (assert (integerp clcn)) - (let* ( - (kbs (serialize-to-base64-string key)) + (let* ((con (controller-db sc)) + (kbs (serialize-to-base64-string key sc)) (tuples (clsql::select [count [value]] - :from [keyvalue] [244 lines skipped]

1 0

[elephant-cvs] CVS elephant/src/db-bdb
by rread 26 Jan '07

26 Jan '07

Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv22773/src/db-bdb Modified Files: bdb-controller.lisp Log Message: Repairing the use of the serializer for the SQL side --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/01/19 21:03:29 1.15 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/01/26 14:41:08 1.16 @@ -271,4 +271,20 @@ :free-space free-space))) (values (deserialize end ctrl)))) +;; Store the serializer version. For BDB this can be in a file; different backends +;; may require a different approach. +(defmethod database-version ((sc bdb-store-controller)) + "A version determination for a given store + controller that is independant of the serializer as the + serializer is dispatched based on the code version which is a + list of the form '(0 6 0)" + (let ((version (elephant::controller-version-cached sc))) + (if version version + (let ((path (make-pathname :name "VERSION" :defaults (second (controller-spec sc))))) + (if (probe-file path) + (with-open-file (stream path :direction :input) + (setf (elephant::controller-version-cached sc) (read stream))) + (with-open-file (stream path :direction :output) + (setf (elephant::controller-version-cached sc) + (write *elephant-code-version* :stream stream))))))))

1 0

[elephant-cvs] CVS elephant/src/elephant
by ieslick 25 Jan '07

25 Jan '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv11335/src/elephant Modified Files: backend.lisp controller.lisp Log Message: Minor fixes for symbol id removal checkin --- /project/elephant/cvsroot/elephant/src/elephant/backend.lisp 2006/12/16 19:35:10 1.5 +++ /project/elephant/cvsroot/elephant/src/elephant/backend.lisp 2007/01/25 19:37:53 1.6 @@ -79,9 +79,6 @@ #:register-backend-con-init #:lookup-backend-con-init ) - (:import-from :elephant-serializer2 - #:serialize-symbol-complete - ) (:export ;; Variables #:*cachesize* --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/01/25 18:18:00 1.23 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/01/25 19:37:53 1.24 @@ -164,9 +164,8 @@ ;; User configuration parameters for the controller (defun load-user-configuration (controller) - ;; Fast symbols - (setf (controller-fast-symbols-p controller) - (elephant-system::get-config-option :fast-symbols (asdf:find-system :elephant)))) + ;; Placeholder + nil) (defun initialize-serializer (sc) "Establish serializer version on controller startup"

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

elephant-cvs January 2007