Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv4428/src/db-bdb
Modified Files: bdb-controller.lisp berkeley-db.lisp libberkeley-db.c Added Files: bdb-symbol-tables.lisp Log Message: Added missing file; Henrik's fixes to ele-bdb and clsql cursor-pset
--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2006/12/16 19:35:10 1.14 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/01/19 21:03:29 1.15 @@ -57,16 +57,6 @@ (string t) (otherwise nil))))
-(defmethod controller-version ((sc store-controller)) - (let ((version (controller-version 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) - (read stream)) - (with-open-file (stream path :direction :output) - (write *elephant-code-version* :stream stream))))))) - ;; ;; Open/close ;; --- /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2006/11/11 18:43:31 1.1 +++ /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2007/01/19 21:03:29 1.2 @@ -1673,10 +1673,11 @@ :returning :int)
(def-function ("db_set_lisp_compare" %db-set-lisp-compare) - ((db :pointer-void)) + ((db :pointer-void) + (version :int)) :returning :int)
-(wrap-errno db-set-lisp-compare (db) :documentation +(wrap-errno db-set-lisp-compare (db version) :documentation "Sets the Btree comparision function to a hand-cooked function for Elephant to compare lisp values.")
@@ -1686,10 +1687,11 @@ :returning :int)
(def-function ("db_set_lisp_dup_compare" %db-set-lisp-dup-compare) - ((db :pointer-void)) + ((db :pointer-void) + (version :int)) :returning :int)
-(wrap-errno db-set-lisp-dup-compare (db) :documentation +(wrap-errno db-set-lisp-dup-compare (db version) :documentation "Sets the duplicate comparision function to a hand-cooked function for Elephant to compare lisp values.")
--- /project/elephant/cvsroot/elephant/src/db-bdb/libberkeley-db.c 2007/01/16 18:02:27 1.3 +++ /project/elephant/cvsroot/elephant/src/db-bdb/libberkeley-db.c 2007/01/19 21:03:29 1.4 @@ -873,8 +873,8 @@ void db_multiple_key_next(void *pointer, DBT *data, unsigned char **key, u_int32_t *ret_key_size, unsigned char **result, u_int32_t *result_size) { - DB_MULTIPLE_KEY_NEXT(pointer, data, - *key, *ret_key_size, + DB_MULTIPLE_KEY_NEXT(pointer, data, + *key, *ret_key_size, *result, *result_size); }
--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-symbol-tables.lisp 2007/01/19 21:03:30 NONE +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-symbol-tables.lisp 2007/01/19 21:03:30 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; controller.lisp -- Lisp interface to a Berkeley DB store ;;; ;;; Initial version 8/26/2004 by Ben Lee ;;; blee@common-lisp.net ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee ;;; ablumberg@common-lisp.net blee@common-lisp.net ;;; ;;; Elephant users are granted the rights to distribute and use this software ;;; as governed by the terms of the Lisp Lesser GNU Public License ;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;
(in-package :db-bdb)
(defmethod lookup-persistent-symbol-id ((sc bdb-store-controller) symbol) "Look up and create id association for symbol" (with-buffer-streams (keybuf valbuf) (buffer-write-int *symbol-to-id-table-oid* keybuf) (serialize-symbol-complete symbol keybuf) (let ((buf (db-get-key-buffered (controller-btrees sc) keybuf valbuf))) (if buf (values (buffer-read-int buf) T) (values (create-persistent-symbol sc symbol keybuf valbuf) t)))))
(defun create-persistent-symbol (sc symbol keybuf valbuf) "Takes an symbol->id table + symbol keybuf, allocates an ID and updates the persistent tables." (reset-buffer-stream valbuf) ;; Just to avoid any contamination ;; (with-transaction (:txn-nosync t :dirty-read t) (format t "getting next symid") (let ((id (next-symid sc))) ;; allocate a new unique id ;; Update symbol->id table (format t "Writing sym->id: ~A -> ~A~%" symbol id) (buffer-write-int id valbuf) (format t "Putting id into table location~%") (db-put-buffered (controller-btrees sc) keybuf valbuf :auto-commit *auto-commit*) ;; Write id->symbol table (reset-buffer-stream keybuf) (reset-buffer-stream valbuf) (format t "Writing id->sym: ~A -> ~A~%" id symbol) (buffer-write-int *id-to-symbol-table-oid* keybuf) (buffer-write-int id keybuf) (serialize-symbol-complete symbol valbuf) (db-put-buffered (controller-btrees sc) keybuf valbuf :auto-commit *auto-commit*) id) ;; ) )
(defmethod lookup-persistent-symbol ((sc bdb-store-controller) id) "Lookup the ID associated with a symbol" (with-buffer-streams (keybuf valbuf) (format t "Looking up: ~A~%" id) (buffer-write-int *id-to-symbol-table-oid* keybuf) (buffer-write-int id keybuf) (format t "Get for id: ~A~%" id) (let ((buf (db-get-key-buffered (controller-btrees sc) keybuf valbuf))) (format t "Got buf: ~A~%" buf) (if buf (values (deserialize buf sc) T) (error "Invalid ID - no persistent mapping for ID")))))
;; ;; Stress test ;;
(defun stress-test (iters syms) (loop for i fixnum from 0 upto iters do (format t "Iteration ~A~%" i) ;; (with-transaction () ;; (print *current-transaction*) (loop for i fixnum from 0 upto (length syms) do (add-to-root (nth i syms) (nth i syms)))))
(defun make-syms (num &aux list) (loop for i fixnum from 0 below num do (let* ((str (format nil "test~A" i)) (sym (intern str))) (push sym list))) (nreverse list))