elephant-cvs February 2007

elephant-cvs@common-lisp.net

2 participants
167 discussions

[elephant-cvs] CVS elephant/src/elephant
by ieslick 14 Feb '07

14 Feb '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv23282/src/elephant Modified Files: controller.lisp package.lisp Log Message: User parameter if; deadlock detector param support --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/02/14 04:36:10 1.32 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/02/14 17:41:29 1.33 @@ -99,6 +99,15 @@ dep-list)) ;; +;; PER-USER INSTALLATION PARAMETERS +;; + +(defun get-user-configuration-parameter (name) + (elephant-system::get-config-option + name + (asdf:find-system :elephant))) + +;; ;; COMMON STORE CONTROLLER FUNCTIONALITY ;; @@ -128,6 +137,35 @@ (for garbage collection,) et cetera.")) ;; +;; Per-controller instance caching +;; + +(defun cache-instance (sc obj) + "Cache a persistent object with the controller." + (declare (type store-controller sc)) + (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!" + (declare (type store-controller sc) + (type fixnum oid)) + (let ((obj (get-cache oid (instance-cache sc)))) + (if obj obj + ;; Should get cached since make-instance calls cache-instance + (make-instance (handle-legacy-classes class-name nil) + :from-oid oid :sc sc)))) + +(defmethod flush-instance-cache ((sc store-controller)) + "Reset the instance cache (flush object lookups). Useful + for testing. Does not reclaim existing objects so there + will be duplicate instances with identical functionality" + (ele-with-lock ((instance-cache-lock sc)) + (setf (instance-cache sc) + (make-cache-table :test 'eql)))) + + +;; ;; Database versioning ;; @@ -240,35 +278,6 @@ (defun string-pair->symbol (name) (intern (string-upcase (cdr name)) (car name))) -;; -;; Per-controller instance caching -;; - -(defun cache-instance (sc obj) - "Cache a persistent object with the controller." - (declare (type store-controller sc)) - (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!" - (declare (type store-controller sc) - (type fixnum oid)) - (let ((obj (get-cache oid (instance-cache sc)))) - (if obj obj - ;; Should get cached since make-instance calls cache-instance - (make-instance (handle-legacy-classes class-name nil) - :from-oid oid :sc sc)))) - -(defmethod flush-instance-cache ((sc store-controller)) - "Reset the instance cache (flush object lookups). Useful - for testing. Does not reclaim existing objects so there - will be duplicate instances with identical functionality" - (ele-with-lock ((instance-cache-lock sc)) - (setf (instance-cache sc) - (make-cache-table :test 'eql)))) - - ;; ================================================================================ ;; ;; BACKEND STORE CONTROLLER PROTOCOL --- /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2007/02/08 23:07:19 1.12 +++ /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2007/02/14 17:41:29 1.13 @@ -36,6 +36,7 @@ #:controller-symbol-cache #:controller-symbol-id-cache #:controller-fast-symbols-p #:optimize-storage + #:get-user-configuration-parameter #:upgrade

1 0

[elephant-cvs] CVS elephant/src/contrib/eslick/db-lisp
by ieslick 14 Feb '07

14 Feb '07

Update of /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp In directory clnet:/tmp/cvs-serv2473 Removed Files: binary-data.lisp binary-types.lisp Log Message: Moving old files to archive

1 0

[elephant-cvs] CVS elephant/src/utils
by ieslick 14 Feb '07

14 Feb '07

Update of /project/elephant/cvsroot/elephant/src/utils In directory clnet:/tmp/cvs-serv697 Added Files: convenience.lisp os.lisp Log Message: Missing files from last checkin --- /project/elephant/cvsroot/elephant/src/utils/convenience.lisp 2007/02/14 04:38:56 NONE +++ /project/elephant/cvsroot/elephant/src/utils/convenience.lisp 2007/02/14 04:38:56 1.1 ;; Copyright Ian Eslick ;; License: LGPL ;; ;; A collection of handy utilities for compacting code complexity in elephant ;; (in-package :elephant-utils) (defmacro do-subsets ((subset subset-size list) &body body) "Look over subsets of the list" `(loop for ,subset in (subsets ,subset-size ,list) do ,@body)) (defun subsets (size list) "Generate subsets of size n from the list; the last subset has the remaining elements if size does not represent an equal division" (let ((subsets nil)) (loop for elt in list for i from 0 do (when (= 0 (mod i size)) (setf (car subsets) (nreverse (car subsets))) (push nil subsets)) (push elt (car subsets))) (setf (car subsets) (nreverse (car subsets))) (nreverse subsets))) (defun remove-keywords (key-names args) (loop for ( name val ) on args by #'cddr unless (member name key-names) append (list name val))) (defun concat-separated-strings (separator &rest lists) (format nil (concatenate 'string "~{~A~^" (string separator) "~}") (append-sublists lists))) (defun append-sublists (list) "Takes a list of lists and appends all sublists" (let ((results (car list))) (dolist (elem (cdr list) results) (setq results (append results elem))))) --- /project/elephant/cvsroot/elephant/src/utils/os.lisp 2007/02/14 04:38:56 NONE +++ /project/elephant/cvsroot/elephant/src/utils/os.lisp 2007/02/14 04:38:56 1.1 (in-package :elephant-utils) (defun launch-background-program (directory program &key (args nil)) "Launch a program in a specified directory - not all shell interfaces or OS's support this" #+(and allegro (not mswindows)) (excl:run-shell-command (concat-separated-strings " " (list program) args) :wait nil :directory directory) ;; #+(and allegro mswindows) ;; #+(and sbcl unix) ;; (sb-ext:start-process ... ;; #+(and openmcl unix) ;; #+lispworks ) (defun kill-background-program (pid) #+(and allegro (not mswindows)) (progn (excl.osi:kill pid 9) (system:reap-os-subprocess :pid pid)) ;; #+(and allegro mswindows) #+(and sbcl unix) (sb-ext:process-kill "/bin/kill" (list "-9" (format nil "~A" pid))) )

1 0

[elephant-cvs] CVS elephant/src/utils
by ieslick 14 Feb '07

14 Feb '07

Update of /project/elephant/cvsroot/elephant/src/utils In directory clnet:/tmp/cvs-serv32730/src/utils Modified Files: package.lisp Log Message: Documentation, optimizations, deadlock process, etc --- /project/elephant/cvsroot/elephant/src/utils/package.lisp 2007/02/12 20:37:02 1.2 +++ /project/elephant/cvsroot/elephant/src/utils/package.lisp 2007/02/14 04:36:13 1.3 @@ -26,4 +26,9 @@ #:ele-with-lock #:ele-make-fast-lock #:ele-with-fast-lock - #:ele-thread-hash-key)) + #:ele-thread-hash-key + #:launch-background-program + #:kill-background-program + #:do-subsets + #:subsets + #:remove-keywords))

1 0

[elephant-cvs] CVS elephant/src/memutil
by ieslick 14 Feb '07

14 Feb '07

Update of /project/elephant/cvsroot/elephant/src/memutil In directory clnet:/tmp/cvs-serv32730/src/memutil Modified Files: memutil.lisp Log Message: Documentation, optimizations, deadlock process, etc --- /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2007/02/08 23:07:19 1.22 +++ /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2007/02/14 04:36:13 1.23 @@ -709,6 +709,7 @@ (let* ((position (buffer-stream-position bs)) (size (buffer-stream-size bs)) (vlen (- size position))) + (assert (< (+ offset size) (length arry))) (if (>= vlen 0) (dotimes (i vlen arry) (setf (aref arry (+ i offset))

1 0

[elephant-cvs] CVS elephant/src/elephant
by ieslick 14 Feb '07

14 Feb '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv32730/src/elephant Modified Files: classes.lisp classindex.lisp collections.lisp controller.lisp metaclasses.lisp transactions.lisp Log Message: Documentation, optimizations, deadlock process, etc --- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/02/12 20:36:45 1.12 +++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/02/14 04:36:10 1.13 @@ -20,6 +20,8 @@ (defvar *debug-si* nil) +(declaim #-elephant-without-optimize (optimize (speed 3))) + (defmethod initialize-instance :before ((instance persistent) &rest initargs &key from-oid @@ -235,13 +237,11 @@ (defmethod slot-value-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition)) "Get the slot value from the database." - (declare (optimize (speed 3))) (let ((name (slot-definition-name slot-def))) (persistent-slot-reader (get-con instance) instance name))) (defmethod (setf slot-value-using-class) :around (new-value (class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition)) "Set the slot value in the database." - (declare (optimize (speed 3))) (if (indexed class) (indexed-slot-writer class instance slot-def new-value) (let ((name (slot-definition-name slot-def))) @@ -249,13 +249,11 @@ (defmethod slot-boundp-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition)) "Checks if the slot exists in the database." - (declare (optimize (speed 3))) (let ((name (slot-definition-name slot-def))) (persistent-slot-boundp (get-con instance) instance name))) (defmethod slot-boundp-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-name symbol)) "Checks if the slot exists in the database." - (declare (optimize (speed 3))) (loop for slot in (class-slots class) for matches-p = (eq (slot-definition-name slot) slot-name) until matches-p @@ -266,7 +264,6 @@ (defmethod slot-makunbound-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition)) "Deletes the slot from the database." - (declare (optimize (speed 3))) ;; NOTE: call remove-indexed-slot here instead? ;; (when (indexed slot-def) ;; (unregister-indexed-slot class (slot-definition-name slot-def))) @@ -322,8 +319,7 @@ #+(or cmu sbcl) (defun make-persistent-reader (name) (lambda (instance) - (declare (optimize (speed 3)) - (type persistent-object instance)) + (declare (type persistent-object instance)) (persistent-slot-reader (get-con instance) instance name))) #+(or cmu sbcl) @@ -336,8 +332,7 @@ #+(or cmu sbcl) (defun make-persistent-slot-boundp (name) (lambda (instance) - (declare (optimize (speed 3)) - (type persistent-object instance)) + (declare (type persistent-object instance)) (persistent-slot-boundp (get-con instance) instance name))) #+sbcl ;; CMU also? Old code follows... --- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/02/12 20:36:46 1.16 +++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/02/14 04:36:10 1.17 @@ -12,6 +12,8 @@ (in-package "ELEPHANT") +(declaim #-elephant-without-optimize (optimize (speed 3) (safety 1))) + ;; ;; User level class indexing control protocol ;; @@ -72,8 +74,7 @@ (con (get-con instance))) (declare (type fixnum oid)) (if (no-indexing-needed? class instance slot-def oid) - (ensure-transaction (:store-controller con) - (persistent-slot-writer con new-value instance slot-name)) + (persistent-slot-writer con new-value instance slot-name) (let ((class-idx (find-class-index class))) ;; (format t "Indexing object: ~A oid: ~A~%" instance oid) (ensure-transaction (:store-controller con) @@ -375,9 +376,7 @@ (get-instances-by-value (find-class class) slot-name value)) (defmethod get-instances-by-value ((class persistent-metaclass) slot-name value) -;; (declare -;; (optimize (speed 3) (safety 1) (space 1)) -;; (type (or string symbol) slot-name)) + (declare (type (or string symbol) slot-name)) (let ((instances nil)) (with-btree-cursor (cur (find-inverted-index class slot-name)) (multiple-value-bind (exists? skey val pkey) (cursor-pset cur value) @@ -405,9 +404,8 @@ (get-instances-by-range (find-class class) slot-name start end)) (defmethod get-instances-by-range ((class persistent-metaclass) idx-name start end) -;; (declare (optimize speed (safety 1) (space 1)) -;; (type fixnum start end) -;; (type string idx-name)) + (declare (type fixnum start end) + (type string idx-name)) (with-inverted-cursor (cur class idx-name) (labels ((next-range (instances) (multiple-value-bind (exists? skey val pkey) (cursor-pnext-nodup cur) @@ -429,23 +427,6 @@ (next-in-range skey (cons val nil)) nil))))) - -(defun subsets (size list) - (let ((subsets nil)) - (loop for elt in list - for i from 0 do - (when (= 0 (mod i size)) - (setf (car subsets) (nreverse (car subsets))) - (push nil subsets)) - (push elt (car subsets))) - (setf (car subsets) (nreverse (car subsets))) - (nreverse subsets))) - - -(defmacro do-subsets ((subset subset-size list) &body body) - `(loop for ,subset in (subsets ,subset-size ,list) do - ,@body)) - (defun drop-instances (instances &key (sc *store-controller*)) (when instances (assert (consp instances)) --- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/02/02 23:51:58 1.7 +++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/02/14 04:36:10 1.8 @@ -325,7 +325,7 @@ (defmethod map-btree (fn (btree btree)) "Like maphash. Default implementation - overridable" - (ensure-transaction (:store-controller (get-con btree)) + (with-transaction (:store-controller (get-con btree)) (with-btree-cursor (curs btree) (loop (multiple-value-bind (more k v) (cursor-next curs) @@ -338,15 +338,25 @@ (multiple-value-bind (valid k) (cursor-next cur) (cond ((not valid) ;; truly empty t) - ((eq k *elephant-properties-label*) ;; has properties + ((and (eq btree (controller-root (get-con btree))) + (eq k *elephant-properties-label*)) ;; has properties (not (cursor-next cur))) (t nil)))))) -(defun dump-btree (bt) +(defun print-btree-node (k v) + (format t "k ~A / v ~A~%" k v)) + +(defun dump-btree (bt &key (print-fn #'print-btree-node) (count nil)) + "Print the contents of a btree for easy inspection & debugging" (format t "DUMP ~A~%" bt) - (map-btree #'(lambda (k v) (format t "k ~A / v ~A~%" k v)) bt) - ) + (let ((i 0)) + (map-btree + (lambda (k v) + (when (and count (>= (incf i) count)) + (return-from dump-btree)) + (funcall print-fn k v)) + bt))) (defun btree-keys (bt) (format t "BTREE keys for ~A~%" bt) --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/02/12 20:36:46 1.31 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/02/14 04:36:10 1.32 @@ -193,7 +193,6 @@ (migrate target source) (close-store target))) - ;; ;; Modular serializer support and default serializers for a version ;; --- /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp 2006/04/26 17:53:44 1.7 +++ /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp 2007/02/14 04:36:10 1.8 @@ -20,6 +20,8 @@ (in-package "ELEPHANT") +(declaim #-elephant-without-optimize (optimize (speed 3) (safety 1))) + (defclass persistent () ((%oid :accessor oid :initarg :from-oid) (dbonnection-spec-pst :type (or list string) :accessor :dbcn-spc-pst :initarg :dbconnection-spec-pst)) --- /project/elephant/cvsroot/elephant/src/elephant/transactions.lisp 2007/02/02 23:51:58 1.5 +++ /project/elephant/cvsroot/elephant/src/elephant/transactions.lisp 2007/02/14 04:36:10 1.6 @@ -26,6 +26,39 @@ non-local exist, provides ACID properties for DB operations within the body and properly binds any relevant parameters.")) +;; Transaction architecture: +;; +;; User and designer considerations: +;; - *current-transaction* is reserved for use by dynamic transaction context. The default global +;; value must always be null (no transaction). Each backend can set it to a different parameter +;; within the dynamic context of an execute-transaction. +;; - Any closures returned from within a transaction cannot bind *current-transaction* +;; - Only a normal return value will result in the transaction being committed, any non-local exit +;; results in a transaction abort. If you want to do something more sophisticated, roll your own +;; using controller-start-transaction, etc. +;; - The body of a with or ensure transaction can take any action (throw, signal, error, etc) +;; knowing that the transaction will be aborted +;; +;; Designer considerations: +;; - with-transaction passes *current-transaction* or the user parameter to execute-transaction +;; in the parent keyword argument. Backends allowing nested transactions can treat the transaction +;; as a parent, otherwise they can reuse the current transaction by ignoring it (inheriting the dynamic +;; value of *current-transaction*) or rebinding the dynamic context (whatever makes coding easier). +;; - ensure-transaction uses *current-transaction* to determine if there is a current transaction +;; in progress. If so, it jumps to the body directly. Otherwise it executes the body in a +;; new transaction. +;; - execute-transaction contract: +;; - Backends must dynamically bind *current-transaction* to a meaningful identifier for the +;; transaction in progress and execute the provided closure in that context +;; - All non-local exists result in an abort; only regular return values result in a commit +;; - If a transaction is aborted due to a deadlock or read conflict, execute-transaction should +;; automatically retry with an appropriate default amount +;; - execute-transaction can take any number of backend-defined keywords, although designers should +;; make sure there are no semantic conflicts if there is a name overlap with existing backends +;; - A typical design approach is to make sure that the most primitive interfaces to the backend +;; database look at *current-transaction* to determine whether a transaction is active. Users code can also +;; access this parameter to check whether a transaction is active. + (defmacro with-transaction ((&rest keyargs &key (store-controller '*store-controller*) (parent '*current-transaction*) @@ -66,7 +99,13 @@ :retries ,retries ,@(remove-keywords '(:store-controller :parent :transaction :retries) keyargs)))))) - + +(defmacro with-batched-transaction ((batch size list &rest txn-options) &body body) + "Perform a set of DB operations over a list of elements in batches of size 'size'. + Pass specific transaction options after the list reference." + `(loop for ,batch in (subsets ,subset-size ,list) do + (with-transaction ,txn-options + ,@body))) ;; ;; An interface to manage transactions explicitly @@ -82,12 +121,3 @@ (defgeneric controller-abort-transaction (store-controller transaction &key &allow-other-keys) (:documentation "Abort an elephant transaction")) - -;; -;; Utility -; - -(defun remove-keywords (key-names args) - (loop for ( name val ) on args by #'cddr - unless (member name key-names) - append (list name val)))

1 0

[elephant-cvs] CVS elephant/src/db-bdb
by ieslick 14 Feb '07

14 Feb '07

Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv32730/src/db-bdb Modified Files: bdb-collections.lisp bdb-controller.lisp bdb-transactions.lisp package.lisp Log Message: Documentation, optimizations, deadlock process, etc --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2007/02/08 23:05:46 1.17 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2007/02/14 04:36:09 1.18 @@ -55,7 +55,6 @@ (defmethod (setf get-value) (value key (bt bdb-btree)) -;; (with-transaction () (let ((sc (get-con bt))) (with-buffer-streams (key-buf value-buf) (buffer-write-oid (oid bt) key-buf) @@ -63,26 +62,9 @@ (serialize value value-buf sc) (db-put-buffered (controller-btrees sc) key-buf value-buf))) -;; ) value) -;; (labels ((write-value () -;; (let ((sc (get-con bt))) -;; (with-buffer-streams (key-buf value-buf) -;; (buffer-write-oid (oid bt) key-buf) -;; (serialize key key-buf sc) -;; (serialize value value-buf sc) -;; (db-put-buffered (controller-btrees sc) -;; key-buf value-buf -;; :auto-commit *auto-commit*) -;; value)))) -;; (if (eq *current-transaction* 0) -;; (with-transaction (:store-controller (get-con bt)) -;; (write-value)) -;; (write-value)))) - (defmethod remove-kv (key (bt bdb-btree)) -;; (with-transaction (:store-controller (get-con bt)) (let ((sc (get-con bt)) ) (with-buffer-streams (key-buf) (buffer-write-oid (oid bt) key-buf) --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/02/04 04:34:56 1.22 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/02/14 04:36:10 1.23 @@ -231,47 +231,23 @@ (error "Unrecognized deadlock type '~A'" typestring)) (cdr result))) -(eval-when (compile load eval) - (when (find-package :port) - (pushnew :port *features*))) - -(defun launch-background-program (directory program &key (args nil)) - "Launch a program in a specified directory - not all shell interfaces - or OS's support this" - #+(and allegro (not mswindows)) - (apply #'excl:run-shell-command (funcall #'vector directory program) - args) - #-(and allegro (not mswindows)) - nil) - (defmethod start-deadlock-detector ((ctrl bdb-store-controller) &key (type :oldest) (time 0.1) log) - #+port (multiple-value-bind (str errstr pid) (launch-background-program (second (controller-spec ctrl)) (namestring - (make-pathname :directory '(:ABSOLUTE "usr" "local" "BerkeleyDB.4.3" "bin") + (make-pathname :directory '(:ABSOLUTE "opt" "local" "bin" "db45_deadlock") :name "db_deadlock")) :args `("-a" ,(lookup-deadlock-type type) "-t" ,(format nil "~D" time) ,@(when log (list "-L" (format nil "~A" log))))) - (declare (ignore errstr)) - (setf (controller-deadlock-pid ctrl) pid) - (setf (controller-deadlock-input ctrl) str))) + (declare (ignore str errstr)) + (setf (controller-deadlock-pid ctrl) pid))) (defmethod stop-deadlock-detector ((ctrl bdb-store-controller)) (when (controller-deadlock-pid ctrl) - (shell-kill (controller-deadlock-pid ctrl)) - (setf (controller-deadlock-pid ctrl) nil)) - (when (controller-deadlock-input ctrl) - (close (controller-deadlock-input ctrl)) - (setf (controller-deadlock-input ctrl) nil))) + (kill-background-program (controller-deadlock-pid ctrl)))) -(defmethod shell-kill (pid) - #+allegro (sys:reap-os-subprocess :pid pid :wait t) - #+(and (not allegro) port) (port:run-prog "kill" :wait t :args (list "-9" (format nil "~A" pid))) - #+(and sbcl linux) (sb-ext:process-kill "/bin/kill" (list "-9" (format nil "~A" pid)))) - ;; ;; Take advantage of release 4.4's compact storage feature. Hidden features of BDB only ;; --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-transactions.lisp 2007/02/13 16:49:32 1.6 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-transactions.lisp 2007/02/14 04:36:10 1.7 @@ -38,8 +38,7 @@ :txn-nosync txn-nosync :txn-nowait txn-nowait :txn-sync txn-sync)))) - (declare (type pointer-void txn) - (dynamic-extent txn)) + (declare (type pointer-void txn)) (let ((result (let ((*current-transaction* txn)) (declare (special *current-transaction*)) @@ -56,16 +55,6 @@ (return result)))) finally (error "Too many retries in transaction")))) -;; (with-bdb-transaction (:transaction ,transaction -;; :environment env -;; :parent ,parent -;; :degree-2 ,degree-2 -;; :dirty-read ,dirty-read -;; :txn-nosync ,txn-nosync -;; :txn-nowait ,txn-nowait -;; :txn-sync ,txn-sync -;; :retries ,retries) - (defmethod controller-start-transaction ((sc bdb-store-controller) &key parent @@ -85,101 +74,12 @@ :degree-2 degree-2)) -(defmethod controller-commit-transaction ((sc bdb-store-controller) transaction &key &allow-other-keys) +(defmethod controller-commit-transaction ((sc bdb-store-controller) transaction + &key txn-nosync txn-sync &allow-other-keys) (assert (not *current-transaction*)) - (db-transaction-commit transaction)) + (db-transaction-commit transaction :txn-nosync txn-nosync :txn-sync txn-sync)) (defmethod controller-abort-transaction ((sc bdb-store-controller) transaction &key &allow-other-keys) (assert (not *current-transaction*)) (db-transaction-abort transaction)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Old versions of with-transaction -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -#| -(defmacro with-transaction ((&key transaction environment - (parent '*current-transaction*) - (retries 100) - dirty-read read-uncommitted - txn-nosync txn-nowait txn-sync) - &body body) - (let ((txn (if transaction transaction (gensym))) - (count (gensym)) - (result (gensym)) - (success (gensym))) - `(loop - for ,count fixnum from 1 to ,retries - for ,success of-type boolean = nil - do - (with-alien ((,txn (* t) - (db-transaction-begin ,environment - :parent ,parent - :dirty-read (or ,dirty-read ,read-uncommitted) - :txn-nosync ,txn-nosync - :txn-nowait ,txn-nowait - :txn-sync ,txn-sync))) - (let ((,result - (let ((*current-transaction* ,txn)) - (declare (special *current-transaction*) - (dynamic-extent *current-transaction*)) - (catch 'transaction - (unwind-protect - (prog1 (progn ,@body) - (setq ,success t) - (db-transaction-commit :transaction ,txn - :txn-nosync ,txn-nosync - :txn-sync ,txn-sync)) - (unless ,success - (db-transaction-abort :transaction ,txn))))))) - (unless (and (eq ,result ,txn) (not ,success)) - (return ,result)))) - finally (error "Too many retries")))) - -(defmacro with-transaction ((&key transaction environment - (parent '*current-transaction*) - (retries 100) - degree-2 read-committed - dirty-read read-uncommitted - txn-nosync txn-nowait txn-sync) - &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." - (let ((txn (if transaction transaction (gensym))) - (count (gensym)) - (result (gensym)) - (success (gensym))) - `(loop - for ,count fixnum from 1 to ,retries - for ,success of-type boolean = nil - do - (let ((,txn - (db-transaction-begin ,environment - :parent ,parent - :degree-2 (or ,degree-2 ,read-committed) - :dirty-read (or ,dirty-read ,read-uncommitted) - :txn-nosync ,txn-nosync - :txn-nowait ,txn-nowait - :txn-sync ,txn-sync))) - (declare (type pointer-void ,txn) - (dynamic-extent ,txn)) - (let ((,result - (let ((*current-transaction* ,txn)) - (declare (special *current-transaction*) - (dynamic-extent *current-transaction*)) - (catch 'transaction - (unwind-protect - (prog1 (progn ,@body) - (setq ,success t) - (db-transaction-commit :transaction ,txn - :txn-nosync ,txn-nosync - :txn-sync ,txn-sync)) - (unless ,success - (db-transaction-abort :transaction ,txn))))))) - (unless (and (eq ,result ,txn) (not ,success)) - (return ,result)))) - finally (error "Too many retries")))) -|# --- /project/elephant/cvsroot/elephant/src/db-bdb/package.lisp 2006/12/16 19:35:10 1.3 +++ /project/elephant/cvsroot/elephant/src/db-bdb/package.lisp 2007/02/14 04:36:10 1.4 @@ -26,7 +26,7 @@ Elephant, but with some magic for Elephant. In general there is a 1-1 mapping from functions here and functions in Berkeley DB, so refer to their documentation for details.") - (:use common-lisp uffi elephant-memutil elephant-backend elephant) + (:use common-lisp uffi elephant-memutil elephant-backend elephant-utils elephant) #+cmu (:use alien) #+sbcl

1 0

[elephant-cvs] CVS elephant/src/contrib/eslick/db-lisp
by ieslick 14 Feb '07

14 Feb '07

Update of /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp In directory clnet:/tmp/cvs-serv32730/src/contrib/eslick/db-lisp Modified Files: TODO btree.lisp file.lisp pages.lisp Log Message: Documentation, optimizations, deadlock process, etc --- /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/TODO 2007/02/12 20:36:44 1.3 +++ /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/TODO 2007/02/14 04:36:09 1.4 @@ -1,8 +1,8 @@ Active TODO: - secondary indices -- lisp-based comparison function for serialized streams - variable size keys and values +- lisp-based comparison function for serialized streams - transaction logging and transactions - page-level locks (transactions are used to mark page-level rd/wr locks) --- /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/btree.lisp 2007/02/12 20:36:44 1.4 +++ /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/btree.lisp 2007/02/14 04:36:09 1.5 @@ -38,9 +38,9 @@ (#xFE . :root-as-leaf) (#xFF . :root))) -(defun get-type (byte) - (assert (<= byte (car (last *type-table*)))) - (cdr (assoc byte *type-table*))) +(defun get-type (id) + (assert (<= id (caar (last *type-table*)))) + (cdr (assoc id *type-table*))) (defun get-type-id (type-symbol) (loop for (id . symbol) in *type-table* do @@ -88,24 +88,24 @@ (def-field +free-list-next+ (1 4 0)) +(defconstant +root-key-start+ 23) (def-field +root-version+ (1 1 *db-version*)) (def-field +root-reserved+ (2 8 #xDEADBEEFDEADBEEF)) (def-field +root-alloc-pointer+ (10 4 0)) (def-field +root-free-pointer+ (14 4 0)) -(def-field +root-last-valid-byte+ (18 3 0)) +(def-field +root-last-valid-byte+ (18 3 +root-key-start+)) (def-field +root-num-keys+ (21 2 0)) -(defconstant +root-key-start+ 23) +(defconstant +index-key-start+ 14) (def-field +index-reserved+ (1 8 0)) -(def-field +index-last-valid-byte+ (9 3 0)) +(def-field +index-last-valid-byte+ (9 3 +index-key-start+)) (def-field +index-num-keys+ (12 2 0)) -(defconstant +index-key-start+ 14) +(defconstant +leaf-key-start+ 14) (def-field +leaf-prev+ (1 4 0)) (def-field +leaf-next+ (5 4 0)) -(def-field +leaf-last-valid-byte+ (9 3 0)) +(def-field +leaf-last-valid-byte+ (9 3 +leaf-key-start+)) (def-field +leaf-num-keys+ (12 2 0)) -(defconstant +leaf-key-start+ 14) (defun leaf-p (page) (or (eq (page-type page) :leaf) @@ -119,7 +119,9 @@ (write-page-type page (setf (page-type page) :root-as-leaf)) (write-field-default +root-version+ page) (write-field-default +root-reserved+ page) + (write-field-default +root-alloc-pointer+ page) (write-field-default +root-free-pointer+ page) + (write-field-default +root-last-valid-byte+ page) (write-field-default +root-num-keys+ page)) (defun initialize-index-page (page) @@ -143,36 +145,36 @@ (defparameter *max-key-size* 255) (defparameter *max-value-size* 255) -(defun read-pointer (page offset) +(defmethod read-pointer ((page buffer-page) offset) (read-integer page offset 4)) -(defun write-pointer (page offset pointer) +(defmethod write-pointer ((page buffer-page) offset pointer) (write-integer pointer page offset 4)) -(defmethod extract-key (page offset bs) +(defmethod extract-key ((page buffer-page) offset bs) (let ((klen (read-integer page offset 4))) (values (when (> klen 0) (read-buffer-stream page bs (+ offset 4) klen)) (read-pointer page (+ offset klen 4)) - (+ offset klen 8)))) + (+ klen 8)))) -(defmethod write-key (page offset bs pointer) +(defmethod write-key ((page buffer-page) offset (bs buffer-stream) pointer) (let ((klen (buffer-stream-size bs))) (assert (< klen *max-key-size*)) - (write-integer page offset klen 4) + (write-integer klen page offset) (write-buffer-stream page bs (+ offset 4)) (write-pointer page (+ offset (buffer-stream-size bs) 4) pointer))) -(defmethod extract-value (page offset bs) +(defmethod extract-value ((page buffer-page) offset (bs buffer-stream)) (let ((vlen (read-integer page offset))) (values (when (> vlen 0) (read-buffer-stream page bs (+ offset 4) vlen)) vlen))) -(defmethod write-value (page offset bs) +(defmethod write-value ((page buffer-page) offset bs) (let ((vlen (buffer-stream-size bs))) (assert (< vlen *max-value-size*)) - (write-integer page offset vlen 4) - (write-buffer-stream page bs offset))) + (write-integer vlen page offset 4) + (write-buffer-stream page bs (+ offset 4)))) -(defmethod skip-value (page offset) +(defmethod skip-value ((page buffer-page) offset) "Returns the offset after the value is consumed" (let ((vlen (read-integer page offset))) (+ offset vlen))) @@ -181,17 +183,42 @@ "Get the last valid page irrespective of page type" (case (page-type page) (:root (read-field +root-last-valid-byte+ page)) + (:root-as-leaf (read-field +root-last-valid-byte+ page)) (:index (read-field +index-last-valid-byte+ page)) (:leaf (read-field +leaf-last-valid-byte+ page)))) -(defun set-last-valid-byte (value page) +(defun set-last-valid-byte (page value) (case (page-type page) (:root (write-field +root-last-valid-byte+ page value)) + (:root-as-leaf (write-field +root-last-valid-byte+ page value)) (:index (write-field +index-last-valid-byte+ page value)) (:leaf (write-field +leaf-last-valid-byte+ page value)))) (defsetf last-valid-byte set-last-valid-byte) +(defun first-key-offset (page) + (case (page-type page) + (:root +root-key-start+) + (:root-as-leaf +root-key-start+) + (:index +index-key-start+) + (:leaf +leaf-key-start+))) + +(defmethod num-keys ((page buffer-page)) + (case (page-type page) + (:root (read-field +root-num-keys+ page)) + (:root-as-leaf (read-field +root-num-keys+ page)) + (:index (read-field +index-num-keys+ page)) + (:leaf (read-field +leaf-num-keys+ page)))) + +(defmethod set-num-keys ((page buffer-page) value) + (case (page-type page) + (:root (write-field +root-num-keys+ page value)) + (:root-as-leaf (write-field +root-num-keys+ page value)) + (:index (write-field +index-num-keys+ page value)) + (:leaf (write-field +leaf-num-keys+ page value)))) + +(defsetf num-keys set-num-keys) + ;; ;; Comparison functions ;; @@ -222,7 +249,7 @@ ;; BTREE Class and useful accessors ;; -(defclass btree () +(defclass lisp-btree () ((pool :accessor btree-buffer-pool :initarg :pool :documentation "Maintain a pool of memory pages") (primary-bfile :accessor btree-primary-file :initarg :bfile @@ -231,42 +258,43 @@ :documentation "The in-memory root of main BTree DB") (compare-fn :accessor btree-compare-fn :initarg :compare-fn))) -(defmethod btree-stream ((bt btree)) - (binary-file-stream (btree-file bt))) +(defmethod btree-stream ((bt lisp-btree)) + (binary-file-stream (btree-primary-file bt))) -(defmethod btree-get-page ((bt btree) position) +(defmethod btree-get-page ((bt lisp-btree) position) (get-page (btree-buffer-pool bt) (btree-stream bt) position)) -(defmethod btree-allocation-pointer ((bt btree)) +(defmethod btree-allocation-pointer ((bt lisp-btree)) (read-field +root-alloc-pointer+ (btree-root bt))) -(defmethod write-btree-allocation-pointer (value (bt btree)) +(defmethod write-btree-allocation-pointer (value (bt lisp-btree)) (write-field +root-alloc-pointer+ (btree-root bt) value)) (defsetf btree-allocation-pointer write-btree-allocation-pointer) -(defmethod btree-free-pointer ((bt btree)) +(defmethod btree-free-pointer ((bt lisp-btree)) (read-field +root-free-pointer+ (btree-root bt))) -(defmethod write-btree-free-pointer (value (bt btree)) +(defmethod write-btree-free-pointer (value (bt lisp-btree)) (write-field +root-alloc-pointer+ (btree-root bt) value)) (defsetf btree-free-pointer write-btree-free-pointer) + ;; ;; Manipulating backing store ;; ;; Physical operations (not init, no flush) -(defmethod pop-free-db-page ((bt btree)) +(defmethod pop-free-db-page ((bt lisp-btree)) "Take a page off the free list" (let* ((pop-page (btree-get-page bt (btree-free-pointer bt))) (new-top-page (btree-get-page bt (read-field +free-list-next+ pop-page)))) (setf (btree-free-pointer bt) (page-position new-top-page)) pop-page)) -(defmethod push-free-db-page ((bt btree) free-page) +(defmethod push-free-db-page ((bt lisp-btree) free-page) "Pushes an initialized (tagged) free page on the free list" (let ((new-top (page-position free-page)) (old-top-page (btree-get-page bt (btree-free-pointer bt)))) @@ -274,14 +302,14 @@ (setf (btree-free-pointer bt) new-top) free-page)) -(defmethod new-db-page ((bt btree)) +(defmethod new-db-page ((bt lisp-btree)) "Append a new page to the disk file" (let ((new-page-position (btree-allocation-pointer bt))) (incf (btree-allocation-pointer bt) (page-size (btree-root bt))) new-page-position)) -(defmethod get-free-db-page ((bt btree)) +(defmethod get-free-db-page ((bt lisp-btree)) "Get a fresh page from free list or by allocation" (if (> (btree-free-pointer bt) 0) (pop-free-db-page bt) @@ -303,17 +331,17 @@ ;; Logical operations -(defmethod free-page ((bt btree) page) +(defmethod free-page ((bt lisp-btree) page) "Free a page so it goes on the free list" (initialize-free-page page) (push-free-db-page bt page)) -(defmethod allocate-index-page ((bt btree)) +(defmethod allocate-index-page ((bt lisp-btree)) (let ((idx-page (get-free-db-page bt))) (initialize-index-page idx-page) idx-page)) -(defmethod allocate-leaf-page ((bt btree)) +(defmethod allocate-leaf-page ((bt lisp-btree)) (let ((leaf-page (get-free-db-page bt))) (initialize-leaf-page leaf-page) leaf-page)) @@ -350,6 +378,7 @@ (copy-region page start region-size offset) (write-key page start key-bs pointer) (setf (last-valid-byte page) (+ offset last-byte)) + (incf (num-keys page)) page)) (defun insert-key-and-value (page start key-bs pointer value-bs) @@ -364,6 +393,7 @@ (write-key page start key-bs pointer) (write-value page (+ start 8) value-bs) (setf (last-valid-byte page) (+ offset last-byte)) + (incf (num-keys page)) page)) (defun delete-key (page start) @@ -374,6 +404,7 @@ (offset (- (+ key-size 8)))) (copy-region page begin region-size offset) (setf (last-valid-byte page) (+ offset last-byte)) + (decf (num-keys page)) page)) (defun delete-key-and-value (page start) @@ -386,6 +417,7 @@ (offset (- delete-size))) (copy-region page begin region-size offset) (setf (last-valid-byte page) (+ offset last-byte)) + (decf (num-keys page)) page)) (defun replace-value (page vstart new-value) @@ -399,25 +431,12 @@ (copy-region page region-start region-length offset)) (write-value page vstart new-value))) - -(defun first-key-offset (page) - (case (page-type page) - (:root +root-key-start+) - (:index +index-key-start+) - (:leaf +leaf-key-start+))) - -(defun num-keys (page) - (case (page-type page) - (:root (read-field +root-num-keys+ page)) - (:index (read-field +index-num-keys+ page)) - (:leaf (read-field +leaf-num-keys+ page)))) - (defmacro scan-page-keys ((key-bs pointer position btree page) &body body) "Walks a page one key at a time returning the associated pointer and position after consuming the pointer. For leaf pages, this places it at the beginning of the value field. The body is not evaluated if there are zero keys." - (declare (ignorable btree)) + (declare (ignorable lisp-btree)) (assert (and (atom key-bs) (atom pointer) (atom position))) (let ((i (gensym)) (dbkey (gensym)) @@ -439,13 +458,20 @@ ;; Top-level initialization ;; -(defun open-btree-file (path &key +(defun open-lisp-btree (path &key (page-size *btree-page-size*) (cache-pages *btree-cache-size*) bpool - (compare-name 'lexical-compare-<)) - (let* ((new-p (probe-file path :follow-symlinks t)) - (bfile (open-binary-file path :if-does-not-exist :create)) + (compare-name 'lexical-compare-<) + (if-does-not-exist :create) + (if-exists :new-version)) + (let* ((new-p (or + (eq if-exists :overwrite) + (not (probe-file path :follow-symlinks t)))) + (bfile (make-instance 'binary-file + :path path + :if-exists if-exists + :if-does-not-exist if-does-not-exist)) (bpool (if bpool bpool (make-instance 'buffer-pool :pages cache-pages @@ -453,20 +479,20 @@ (root (make-instance 'buffer-page :type :root :page-size page-size)) - (btree (make-instance 'btree - :file bfile + (btree (make-instance 'lisp-btree + :root root :pool bpool - :root-page root + :bfile bfile :compare-fn compare-name))) (associate-page root (binary-file-stream bfile) 0) (if new-p (initialize-root-page root) (load-page root)) - (assert (root-page-p root)) + (assert (root-p root)) btree)) -(defun close-btree-file (btree) - (close-binary-file (btree-file btree)) +(defun close-lisp-btree (btree) + (close-file (btree-primary-file btree)) (setf (btree-buffer-pool btree) nil) (setf (btree-root btree) nil)) --- /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/file.lisp 2007/02/12 20:36:44 1.3 +++ /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/file.lisp 2007/02/14 04:36:09 1.4 @@ -20,12 +20,13 @@ ((path :initarg :path :initarg "" :accessor binary-file-path) (stream :initarg :stream :accessor binary-file-stream))) -(defmethod initialize-instance :after ((file binary-file) &key (if-does-not-exist :create)) +(defmethod initialize-instance :after ((file binary-file) &key (if-does-not-exist :create) (if-exists :new-version)) (assert (binary-file-path file)) (setf (binary-file-stream file) (open (binary-file-path file) :direction :io :element-type '(unsigned-byte 8) - :if-exists :overwrite :if-does-not-exist if-does-not-exist))) + :if-exists if-exists + :if-does-not-exist if-does-not-exist))) (defmethod close-file ((bf binary-file)) (close (binary-file-stream bf))) --- /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/pages.lisp 2007/02/12 20:36:44 1.3 +++ /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/pages.lisp 2007/02/14 04:36:09 1.4 @@ -28,13 +28,16 @@ (declare (type fixnum offset bytes) (type integer integer) (type (array (unsigned-byte 8)) array)) + (assert (< offset (length array))) (loop for i fixnum from 0 below bytes do (setf (aref array (+ offset i)) - (ldb (byte 8 (* i 8)) integer)))) + (ldb (byte 8 (* i 8)) integer))) + integer) (defun read-integer-from-array (array offset &optional (bytes 4)) (declare (type fixnum offset bytes) (type (array (unsigned-byte 8)) array)) + (assert (< offset (length array))) (let ((value 0)) (loop for i fixnum from 0 below bytes do (setf value (dpb (aref array (+ i offset)) (byte 8 (* i 8)) value)))

1 0

[elephant-cvs] CVS elephant
by ieslick 14 Feb '07

14 Feb '07

Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv32730 Modified Files: TODO config.sexp elephant.asd Log Message: Documentation, optimizations, deadlock process, etc --- /project/elephant/cvsroot/elephant/TODO 2007/02/12 20:36:43 1.47 +++ /project/elephant/cvsroot/elephant/TODO 2007/02/14 04:36:08 1.48 @@ -6,65 +6,72 @@ 0.6.1 - performance, safety and portability -------------------------------------------- -ALPHA RELEASE TASKS +TASKS TO GET TO ALPHA: + +Migration: +- Validate BDB migration 0.6.0->0.6.1 (Ian) +- Validate SQL migration 0.6.0->0.6.1 (Robert) +- Legacy conversions issue for SQL (and BDB?) due to package rename (both) -Bug and feature fixes: -~ Resolve duplicate sorting guarantee in btree interface; currently supported - by BDB but not SQL and it is not tested in the regression suite (Robert to comment) + +TASKS TO GET TO BETA: BDB Features/Cleanup: -- Trace all paths to db-put or db-delete and ensure that there is a check or a - default ensure-transaction around the primitive components - write a document - clarifying transaction design & assumptions in the backend] -- Determine how to detect deadlock conditions as an optional run-safe mode? -- Automatically run db_deadlock when opening a bdb backend? Requires path to - functions and ability to launch shell command. Closing the store stops the - sub-process. - Always support locks that timeout? Tradeoffs? - Figure out how to compact a specific btree and/or key-range using optimize-storage. Probably need to update keyword part of the API +- Perform checkpoints (prep for DCM functionality) +- Verify db_deadlock for other lisps (launch and kill background program I/F) +- Derived indices fail to re-connect, verify this -BETA RELEASE TASKS - -Lisp support: +Lisp Support: +- 64-bit lisp verification - Win32 builds - Windows support for asdf-based library builds? Include 32-bit dll in release? - Validate OpenMCL 1.1 on Mac OS X - Validate Lispworks -- 64-bit lisp verification Stability and Performance: +- Validate that migrate can use either O(c) or O(n/c) where c << n memory for large DBs - Review and address all NOTE comments in the code - Review SBCL string serialization performance - Improve SQL base-64 serializer performance? -Migration: -- Validate migration 0.6.0->0.6.1 -- Validate that migrate can use either O(c) or O(n/c) where c << n memory for large DBs - -FINAL RELEASE TASKS +TASKS TO GET TO FINAL RELEASE: Test coverage: -- Test for optimize storage method (just add probe-file methods to get file size) +- Test for optimize storage method (just add probe-file methods to get file size?) - Multi-threading stress tests? Ensure that there are conflicts and lots of serialization - happening concurrently to make sure that multi-threading is in good shape + happening concurrently to make sure that multi-threading is in good shape (Henrik's code) - Unicode tests - Test with UTF-16 and UTF-32 strings (construct with char-code?) - Ensure that variable length UTF-8 is automatically stored as UTF-16 Documentation: +- Add document section about backend interface: - Add notes about with/ensure-transaction usage (abort & commit behavior on exit) - Add notes about optimize-storage - Add notes about deadlock-detect +- Add notes about checkpoint (null in SQL?) - Add notes about new BDB 4.5 *auto-commit* behavior. Default for entire store-controller will auto create a transaction if none is active if open with :auto-commit t or will never auto-commit (regardless of operator flags) if it is not. Make sure open-store defaults to auto-commit and there is a flag to turn it off. +- More notes about transaction performance 0.6.1 - Features COMPLETED to date ---------------------------------- +February 13th, 2007: +x User choice to run db_deadlock when opening a bdb backend? Requires path to + functions and ability to launch shell command. Closing the store stops the sub-process. +x Resolve duplicate ordering issues (punting to future release; documentation fix) +x Trace all paths to db-put or db-delete and ensure that there is a check or a + default ensure-transaction around the primitive components - write a document + clarifying transaction design & assumptions in the backend + + February 9th, 2007 x Improve SQL secondary cursor performance (Robert) x Fix *dbconnection-spec* to support multiple controllers for multiple threads @@ -77,6 +84,7 @@ subtle issues in database metadata and the user of the serializer Feburary 2nd, 2007 checkins: +x Punted duplicate sorting to 0.7.0 x Support locks in serializer for all systems x Provide support for fast and slow critical sections by lisps: buffer-streams, circularity-arrays/hashes, shared controller side-effects... (see email) @@ -178,6 +186,7 @@ 0.7.0: Native Lisp Backend (beta), Fast In-Memory Operations ------------------------------------------------------------ + - Revisit duplicate sorting on primary key (artifact of btree index storage order) - Full support for DCM or integration of DCM functionality - Integrate prevalence-like in-memory database system for single image, multiple-thread operation @@ -193,7 +202,7 @@ instead of performance - Upgrade overall functionality - Solid garbage collection strategy - - 64-bit oids / 64-bit file sizes + - 64-bit oids / 64-bit file sizes? - class templates stored and cached - (From Ben's e-mail) We are storing persistent objects incorrectly. They should be stored only as OIDs, and we should have a separate OID->class table. This way --- /project/elephant/cvsroot/elephant/config.sexp 2007/02/02 23:51:58 1.5 +++ /project/elephant/cvsroot/elephant/config.sexp 2007/02/14 04:36:08 1.6 @@ -1,6 +1,7 @@ -((:berkeley-db-include-dir . "/usr/local/BerkeleyDB.4.5/") +((:berkeley-db-include-dir . "/opt/local/BerkeleyDB.4.5/") (:berkeley-db-lib-dir . "/opt/local/lib/db45/") - (:berkeley-db-lib . "/usr/local/BerkeleyDB.4.5/lib/libDB-4.5.dylib") + (:berkeley-db-lib . "/opt/local/BerkeleyDB.4.5/lib/libDB-4.5.dylib") + (:berkeley-db-deadlock . "/opt/local/bin/db45_deadlock") (:pthread-lib . nil) (:clsql-lib . nil)) --- /project/elephant/cvsroot/elephant/elephant.asd 2007/02/12 20:36:44 1.28 +++ /project/elephant/cvsroot/elephant/elephant.asd 2007/02/14 04:36:08 1.29 @@ -159,7 +159,9 @@ ((:module utils :components ((:file "package") - (:file "locks"))) + (:file "convenience") + (:file "locks") + (:file "os"))) (:module memutil :components ((:elephant-c-source "libmemutil")

1 0

[elephant-cvs] CVS elephant/src/elephant
by ieslick 13 Feb '07

13 Feb '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv12887/elephant Modified Files: serializer2.lisp Log Message: Minor edits and cleanup of serializer2 --- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/12 20:46:25 1.22 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/13 16:50:40 1.23 @@ -325,7 +325,7 @@ (if (< frob 0) (buffer-write-byte +negative-bignum+ bs) (buffer-write-byte +positive-bignum+ bs)) - (buffer-write-int needed bs) + (buffer-write-uint32 needed bs) (loop for i fixnum from 0 below word-size ;; this ldb is consing on CMUCL/OpenMCL! ;; there is an OpenMCL function which should work @@ -389,9 +389,9 @@ ((= tag +pathname+) (parse-namestring (or (%deserialize bs) ""))) ((= tag +positive-bignum+) - (deserialize-bignum bs (buffer-read-fixnum bs) t)) + (deserialize-bignum bs (buffer-read-fixnum32 bs) t)) ((= tag +negative-bignum+) - (deserialize-bignum bs (buffer-read-fixnum bs) nil)) + (deserialize-bignum bs (buffer-read-fixnum32 bs) nil)) ((= tag +rational+) (/ (the integer (%deserialize bs)) (the integer (%deserialize bs)))) @@ -496,8 +496,8 @@ (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)) +;; #+(or cmu sbcl allegro) (progn (setf (cdr int-byte-spec) (* 32 i)) int-byte-spec) + #+(or allegro sbcl cmu lispworks openmcl) (byte 32 (* 32 i)) with num integer = 0 do (setq num (dpb (buffer-read-uint bs) byte-spec num))

1 0

← Newer
1
...
5
6
7
8
9
10
11
...
17
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

elephant-cvs February 2007