November 2006 - elephant-cvs@common-lisp.net

[elephant-cvs] CVS elephant/src/elephant
by ieslick 11 Nov '06

11 Nov '06

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv14219/src/elephant Modified Files: serializer.lisp Log Message: Fix bug where BDB tests failing with running SQL backend tests; initial x86/64-bit support for CMUCL/SBCL --- /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2006/11/11 15:30:26 1.13 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2006/11/11 22:53:13 1.14 @@ -140,7 +140,7 @@ ((%serialize (frob) (declare (optimize (speed 3) (safety 0))) (etypecase frob - (fixnum + ((integer #.(- 1 (expt 2 31)) #.(1- (expt 2 31))) ;; fixnum (buffer-write-byte +fixnum+ bs) (buffer-write-int frob bs)) (null @@ -240,7 +240,7 @@ ;; and non-cons do #+(or cmu sbcl) - (buffer-write-uint (%bignum-ref num i) bs) + (buffer-write-uint (ldb (int-byte-spec i) num) bs) ;; (%bignum-ref num i) bs) #+(or allegro lispworks openmcl) (buffer-write-uint (ldb (int-byte-spec i) num) bs)))) (rational

1 0

[elephant-cvs] CVS elephant/src/memutil
by ieslick 11 Nov '06

11 Nov '06

Update of /project/elephant/cvsroot/elephant/src/memutil In directory clnet:/tmp/cvs-serv14219/src/memutil Modified Files: memutil.lisp Log Message: Fix bug where BDB tests failing with running SQL backend tests; initial x86/64-bit support for CMUCL/SBCL --- /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2006/11/11 06:27:38 1.11 +++ /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2006/11/11 22:53:13 1.12 @@ -164,7 +164,7 @@ (type fixnum offset)) (the (signed-byte 32) (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) - (* integer))))) + (* (signed 32))))) #+(or cmu sbcl) (defun read-uint (buf offset) @@ -204,7 +204,7 @@ (type (signed-byte 32) num) (type fixnum offset)) (setf (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) - (* integer))) num)) + (* (signed 32)))) num)) #+(or cmu sbcl) (defun write-uint (buf num offset)

1 0

[elephant-cvs] CVS elephant/tests
by ieslick 11 Nov '06

11 Nov '06

Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv14219/tests Modified Files: testbdb.lisp Log Message: Fix bug where BDB tests failing with running SQL backend tests; initial x86/64-bit support for CMUCL/SBCL --- /project/elephant/cvsroot/elephant/tests/testbdb.lisp 2006/11/11 18:41:11 1.1 +++ /project/elephant/cvsroot/elephant/tests/testbdb.lisp 2006/11/11 22:53:13 1.2 @@ -11,7 +11,7 @@ ;;; 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 "ELE-TESTS") +(in-package :ele-tests) (defvar env) @@ -29,7 +29,10 @@ (deftest prepares-bdb (progn - (if (find-package :db-bdb) + (setq db nil) + (if (and (find-package :db-bdb) + (eq (first (elephant::controller-spec *store-controller*)) + :BDB)) (finishes (prepare-bdb)) (progn (format t "Berkeley DB not loaded, so not runnning test prepares-bdb~%") @@ -77,11 +80,11 @@ finally (db-bdb::db-sequence-remove seq :auto-commit t)))) (deftest test-seq1 - (if (not (find-package :db-bdb)) + (if (not db) (progn (format t "Berkeley db not loaded, so not runnning test test-seq1~%") - t) - (finishes (test-sequence1))) + t) + (finishes (test-sequence1))) t) (defun test-sequence2 () @@ -118,8 +121,8 @@ (if (not db) (progn (format t "Berkeley DB not open, so not runnning test cleanup-bdb~%") - t) - (finishes (cleanup-bdb))) + t) + (finishes (cleanup-bdb))) t) ;;(unuse-package "DB-BDB")

1 0

[elephant-cvs] CVS elephant
by ieslick 11 Nov '06

11 Nov '06

Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv20911 Added Files: config.sexp ele-postgresql.asd Log Message: Missing files from prior checkins -- config.sexp for new build and ele-postgresql from backend cleanup (might even be missing 0.6.0 file) --- /project/elephant/cvsroot/elephant/config.sexp 2006/11/11 18:45:04 NONE +++ /project/elephant/cvsroot/elephant/config.sexp 2006/11/11 18:45:04 1.1 ((:berkeley-db-root . "/usr/local/BerkeleyDB.4.4/") (:berkeley-db-lib . "/usr/local/BerkeleyDB.4.4/lib/libDB-4.4.dylib") (:pthread-lib . nil) (:clsql-lib . nil)) ;; Typical pthread settings are: /lib/tls/libpthread.so.0 ;; nil means that the library in question is not loaded ;; NOTE: The latest SBCL on linux no longer needs the pthread library, ;; it is statically linked against it now with the new thread support--- /project/elephant/cvsroot/elephant/ele-postgresql.asd 2006/11/11 18:45:04 NONE +++ /project/elephant/cvsroot/elephant/ele-postgresql.asd 2006/11/11 18:45:04 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; ele-postgresql.asd -- ASDF system definition for ;;; a PostgreSQL based back-end for Elephant ;;; ;;; Initial version 10/12/2005 by Robert L. Read ;;; <read(a)robertlread.net> ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee ;;; <ablumberg(a)common-lisp.net> <blee(a)common-lisp.net> ;;; ;;; This program is released under the following license ;;; ("LLGPL"). ;;; (defsystem ele-postgresql :name "ele-postgresql" :author "Robert L. Read <read(a)robertlread.net>" :version "0.6.0" :maintainer "Robert L. Read <read(a)robertlread.net>" :licence "GPL" :description "PostgreSQL based Object respository for Common Lisp" :components ((:module :src :components ())) :depends-on (:ele-clsql :clsql-postgresql-socket))

1 0

[elephant-cvs] CVS elephant/src/db-bdb
by ieslick 11 Nov '06

11 Nov '06

Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv20735 Added Files: berkeley-db.lisp Log Message: Added a missing file from sleepycat rename --- /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2006/11/11 18:43:31 NONE +++ /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2006/11/11 18:43:31 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; berkeley-db.lisp -- FFI interface to Berkeley DB ;;; ;;; Initial version 9/10/2004 by Ben Lee ;;; <blee(a)common-lisp.net> ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee ;;; <ablumberg(a)common-lisp.net> <blee(a)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) (declaim (inline %db-get-key-buffered db-get-key-buffered %db-get-buffered db-get-buffered db-get %db-put-buffered db-put-buffered %db-put db-put %db-delete db-delete-buffered db-delete %db-delete-kv db-delete-kv-buffered %db-cursor db-cursor %db-cursor-close db-cursor-close %db-cursor-duplicate db-cursor-duplicate %db-cursor-get-key-buffered db-cursor-move-buffered db-cursor-set-buffered db-cursor-get-both-buffered %db-cursor-pget-key-buffered db-cursor-pmove-buffered db-cursor-pset-buffered db-cursor-pget-both-buffered %db-cursor-put-buffered db-cursor-put-buffered %db-cursor-delete db-cursor-delete %db-txn-begin db-transaction-begin %db-txn-abort db-transaction-abort %db-txn-commit db-transaction-commit %db-transaction-id %db-sequence-get db-sequence-get %db-sequence-get-lower db-sequence-get-fixnum )) ;; ;; EXTERNAL LIBRARY DEPENDENCIES - LOAD DURING LOAD/COMPILATION ;; (eval-when (:compile-toplevel :load-toplevel) (def-function ("db_strerr" %db-strerror) ((error :int)) :returning :cstring) (defun db-strerror (errno) "Get the string error associated with an error number." (convert-from-cstring (%db-strerror errno))) (define-condition db-error (error) ((errno :type fixnum :initarg :errno :reader db-error-errno)) (:report (lambda (condition stream) (declare (type db-error condition) (type stream stream)) (format stream "Berkeley DB error: ~A" (db-strerror (db-error-errno condition))))) (:documentation "Berkeley DB errors.")) ) ;; ;; Constants and Flags ;; eventually write a macro which generates a custom flag function. ;; ;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_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_TXN_NOWAIT #x00002000) (defconstant DB_TXN_SYNC #x00004000) (defconstant DB_DUP #x00004000) (defconstant DB_DUPSORT #x00008000) (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_AFTER 1) (defconstant DB_BEFORE 3) (defconstant DB_KEYFIRST 15) (defconstant DB_KEYLAST 16) (defconstant DB_NODUPDATA 21) (defconstant DB_NOOVERWRITE 22) (defconstant DB_NOSYNC 23) (defconstant DB_POSITION 24) (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_FREELIST_ONLY #x00002000) (defconstant DB_FREE_SPACE #x00004000) (defconstant DB_KEYEMPTY -30997) (defconstant DB_KEYEXIST -30996) (defconstant DB_LOCK_DEADLOCK -30995) (defconstant DB_LOCK_NOTGRANTED -30994) (defconstant DB_NOTFOUND -30989) (defconstant DB_LOCK_DEFAULT 1) (defconstant DB_LOCK_EXPIRE 2) (defconstant DB_LOCK_MAXLOCKS 3) (defconstant DB_LOCK_MAXWRITE 4) (defconstant DB_LOCK_MINLOCKS 5) (defconstant DB_LOCK_MINWRITE 6) (defconstant DB_LOCK_OLDEST 7) (defconstant DB_LOCK_RANDOM 8) (defconstant DB_LOCK_YOUNGEST 9) (def-enum DB-LOCKOP ((:DUMP 0) :GET :GET-TIMEOUT :INHERIT :PUT :PUT-ALL :PUT-OBJ :PUT-READ :TIMEOUT :TRADE :UPGRADE-WRITE)) (def-enum DB-LOCKMODE ((:NG 0) :READ :WRITE :WAIT :IWRITE :IREAD :IWR :DIRTY :WWRITE)) (def-struct DB-LOCK (off :unsigned-int) (ndx :unsigned-int) (gen :unsigned-int) (mode DB-LOCKMODE)) #+openmcl (ccl:def-foreign-type DB-LOCK (:struct DB-LOCK)) (def-struct DB-LOCKREQ (op DB-LOCKOP) (mode DB-LOCKMODE) (timeout :unsigned-int) (obj (:array :char)) (lock (* DB-LOCK))) #+openmcl (ccl:def-foreign-type DB-LOCKREQ (:struct DB-LOCKREQ)) (defconstant +2^32+ 4294967296) (defconstant +2^64+ 18446744073709551616) (defconstant +2^32-1+ (1- +2^32+)) (defmacro make-64-bit-integer (high32 low32) `(+ ,low32 (ash ,high32 32))) (defmacro high32 (int64) `(ash ,int64 -32)) (defmacro low32 (int64) `(logand ,int64 +2^32-1+)) (defmacro split-64-bit-integer (int64) `(values (ash ,int64 -32) (logand ,int64 +2^32-1+))) ;; Wrapper macro -- handles errno return values ;; makes flags into keywords ;; makes keyword args, cstring wrappers (defvar *errno-buffer* (allocate-foreign-object :int 1)) (eval-when (:compile-toplevel) (defun make-wrapper-args (args flags keys) (if (or flags keys) (append (remove-keys (remove 'flags args) keys) `(&key ,@flags ,@keys)) (remove 'flags args))) (defun remove-keys (args keys) (if keys (loop for key in keys for kw = (if (atom key) key (first key)) for wrapper-args = (remove kw args) then (remove kw wrapper-args) finally (return wrapper-args)) args)) (defun make-fun-args (args flags) (if flags (substitute (cons 'flags (symbols-to-kw-pairs flags)) 'flags args) (substitute 0 'flags args))) (defun make-out-args (count) (loop for i from 1 to count collect (gensym))) (defun symbols-to-kw-pairs (symbols) (loop for symbol in symbols append (list (intern (symbol-name symbol) "KEYWORD") symbol))) (defun symbols-to-pairs (symbols) (loop for symbol in symbols collect (list symbol symbol))) ) (defmacro wrap-errno (names args &key (keys nil) (flags nil) (cstrings nil) (outs 1) (declarations nil) (documentation nil) (transaction nil)) (let ((wname (if (listp names) (first names) 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)) (errno (gensym))) (if (> outs 1) (let ((out-args (make-out-args outs))) `(defun ,wname ,wrapper-args ,@(if documentation (list documentation) (values)) ,@(if declarations (list declarations) (values)) (with-cstrings ,(symbols-to-pairs cstrings) (multiple-value-bind ,out-args (,fname ,@fun-args) (let ((,errno ,(first out-args))) (declare (type fixnum ,errno)) (cond ((= ,errno 0) (values ,@(rest out-args))) ,@(if transaction (list `((or (= ,errno DB_LOCK_DEADLOCK) (= ,errno DB_LOCK_NOTGRANTED)) (throw 'transaction ,transaction))) (values)) (t (error 'db-error :errno ,errno)))))))) `(defun ,wname ,wrapper-args ,@(if documentation (list documentation) (values)) ,@(if declarations (list declarations) (values)) (with-cstrings ,(symbols-to-pairs cstrings) (let ((,errno (,fname ,@fun-args))) (declare (type fixnum ,errno)) (cond ((= ,errno 0) nil) ,@(if transaction (list `((or (= ,errno DB_LOCK_DEADLOCK) (= ,errno DB_LOCK_NOTGRANTED)) (throw 'transaction ,transaction))) (values)) (t (error 'db-error :errno ,errno))))))))) (defmacro flags (&key auto-commit joinenv init-cdb init-lock init-log init-mpool init-rep init-txn recover recover-fatal lockdown private system-mem thread force create excl nommap degree-2 read-committed dirty-read read-uncommitted rdonly truncate txn-nosync txn-nowait txn-sync lock-nowait dup dup-sort current first get-both get-both-range last next next-dup next-nodup prev prev-nodup set set-range after before keyfirst keylast freelist-only free-space no-dup-data no-overwrite nosync position seq-dec seq-inc seq-wrap set-lock-timeout set-transaction-timeout) (let ((flags (gensym))) `(let ((,flags 0)) (declare (type fixnum ,flags)) ,@(when auto-commit `((when ,auto-commit (setq ,flags (logior ,flags DB_AUTO_COMMIT))))) ,@(when joinenv `((when ,joinenv (setq ,flags (logior ,flags DB_JOINENV))))) ,@(when init-cdb `((when ,init-cdb (setq ,flags (logior ,flags DB_INIT_CDB))))) ,@(when init-lock `((when ,init-lock (setq ,flags (logior ,flags DB_INIT_LOCK))))) ,@(when init-log `((when ,init-log (setq ,flags (logior ,flags DB_INIT_LOG))))) ,@(when init-mpool `((when ,init-mpool (setq ,flags (logior ,flags DB_INIT_MPOOL))))) ,@(when init-rep `((when ,init-rep (setq ,flags (logior ,flags DB_INIT_REP))))) ,@(when init-txn `((when ,init-txn (setq ,flags (logior ,flags DB_INIT_TXN))))) ,@(when recover `((when ,recover (setq ,flags (logior ,flags DB_RECOVER))))) ,@(when recover-fatal `((when ,recover-fatal (setq ,flags (logior ,flags DB_RECOVER_FATAL))))) ,@(when lockdown `((when ,lockdown (setq ,flags (logior ,flags DB_LOCKDOWN))))) ,@(when private `((when ,private (setq ,flags (logior ,flags DB_PRIVATE))))) ,@(when system-mem `((when ,system-mem (setq ,flags (logior ,flags DB_SYSTEM_MEM))))) ,@(when thread `((when ,thread (setq ,flags (logior ,flags DB_THREAD))))) ,@(when force `((when ,force (setq ,flags (logior ,flags DB_FORCE))))) ,@(when degree-2 `((when ,degree-2 (setq ,flags (logior ,flags DB_DEGREE_2))))) ,@(when read-committed `((when ,read-committed (setq ,flags (logior ,flags DB_READ_COMMITTED))))) ,@(when dirty-read `((when ,dirty-read (setq ,flags (logior ,flags DB_DIRTY_READ))))) ,@(when read-uncommitted `((when ,read-uncommitted (setq ,flags (logior ,flags DB_READ_UNCOMMITTED))))) ,@(when create `((when ,create (setq ,flags (logior ,flags DB_CREATE))))) ,@(when excl `((when ,excl (setq ,flags (logior ,flags DB_EXCL))))) ,@(when nommap `((when ,nommap (setq ,flags (logior ,flags DB_NOMMAP))))) ,@(when rdonly `((when ,rdonly (setq ,flags (logior ,flags DB_RDONLY))))) ,@(when truncate `((when ,truncate (setq ,flags (logior ,flags DB_TRUNCATE))))) ,@(when txn-nosync `((when ,txn-nosync (setq ,flags (logior ,flags DB_TXN_NOSYNC))))) ,@(when txn-nowait `((when ,txn-nowait (setq ,flags (logior ,flags DB_TXN_NOWAIT))))) ,@(when txn-sync `((when ,txn-sync (setq ,flags (logior ,flags DB_TXN_SYNC))))) ,@(when freelist-only `((when ,freelist-only (setq ,flags (logior ,flags DB_FREELIST_ONLY))))) ,@(when free-space `((when ,free-space (setq ,flags (logior ,flags DB_FREE_SPACE))))) ,@(when lock-nowait `((when ,lock-nowait (setq ,flags (logior ,flags DB_LOCK_NOWAIT))))) ,@(when dup `((when ,dup (setq ,flags (logior ,flags DB_DUP))))) ,@(when dup-sort `((when ,dup-sort (setq ,flags (logior ,flags DB_DUPSORT))))) ,@(when current `((when ,current (setq ,flags (logior ,flags DB_CURRENT))))) ,@(when first `((when ,first (setq ,flags (logior ,flags DB_FIRST))))) ,@(when get-both `((when ,get-both (setq ,flags (logior ,flags DB_GET_BOTH))))) ,@(when get-both-range `((when ,get-both-range (setq ,flags (logior ,flags DB_GET_BOTH_RANGE))))) ,@(when last `((when ,last (setq ,flags (logior ,flags DB_LAST))))) ,@(when next `((when ,next (setq ,flags (logior ,flags DB_NEXT))))) ,@(when next-dup `((when ,next-dup (setq ,flags (logior ,flags DB_NEXT_DUP))))) ,@(when next-nodup `((when ,next-nodup (setq ,flags (logior ,flags DB_NEXT_NODUP))))) ,@(when prev `((when ,prev (setq ,flags (logior ,flags DB_PREV))))) ,@(when prev-nodup `((when ,prev-nodup (setq ,flags (logior ,flags DB_PREV_NODUP))))) ,@(when set `((when ,set (setq ,flags (logior ,flags DB_SET))))) ,@(when set-range `((when ,set-range (setq ,flags (logior ,flags DB_SET_RANGE))))) ,@(when after `((when ,after (setq ,flags (logior ,flags DB_AFTER))))) ,@(when before `((when ,before (setq ,flags (logior ,flags DB_BEFORE))))) ,@(when keyfirst `((when ,keyfirst (setq ,flags (logior ,flags DB_KEYFIRST))))) ,@(when keylast `((when ,keylast (setq ,flags (logior ,flags DB_KEYLAST))))) ,@(when no-dup-data `((when ,no-dup-data (setq ,flags (logior ,flags DB_NODUPDATA))))) ,@(when no-overwrite `((when ,no-overwrite (setq ,flags (logior ,flags DB_NOOVERWRITE))))) ,@(when nosync `((when ,nosync (setq ,flags (logior ,flags DB_NOSYNC))))) ,@(when position `((when ,position (setq ,flags (logior ,flags DB_POSITION))))) ,@(when seq-dec `((when ,seq-dec (setq ,flags (logior ,flags DB_SEQ_DEC))))) ,@(when seq-inc `((when ,seq-inc (setq ,flags (logior ,flags DB_SEQ_INC))))) ,@(when seq-wrap `((when ,seq-wrap (setq ,flags (logior ,flags DB_SEQ_WRAP))))) ,@(when set-lock-timeout `((when ,set-lock-timeout (setq ,flags (logior ,flags DB_SET_LOCK_TIMEOUT))))) ,@(when set-transaction-timeout `((when ,set-transaction-timeout (setq ,flags (logior ,flags DB_SET_TXN_TIMEOUT))))) ,flags))) ;; Environment (def-function ("db_env_cr" %db-env-create) ((flags :unsigned-int) (errno :int :out)) :returning :pointer-void) (defun db-env-create () "Create an environment handle." (multiple-value-bind (env errno) (%db-env-create 0) (declare (type fixnum errno)) (if (= errno 0) env (error 'db-error :errno errno)))) (def-function ("db_env_close" %db-env-close) ((dbenvp :pointer-void) (flags :unsigned-int)) :returning :int) (wrap-errno db-env-close (dbenvp flags) :documentation "Close an environment handle.") (def-function ("db_env_open" %db-env-open) ((dbenvp :pointer-void) (home :cstring) (flags :unsigned-int) (mode :int)) :returning :int) (wrap-errno db-env-open (dbenvp home flags mode) :flags (init-cdb init-lock init-log [1502 lines skipped]

1 0

[elephant-cvs] CVS elephant/tests/testbdb
by ieslick 11 Nov '06

11 Nov '06

Update of /project/elephant/cvsroot/elephant/tests/testbdb In directory clnet:/tmp/cvs-serv20360/tests/testbdb Added Files: PLACEHOLDER.txt README Log Message: Remove all references to sleepycat; change to bdb db-bdb or berkeley-db; passes all test for BDB and SQLite on Allegro/Mac OS/32-bit --- /project/elephant/cvsroot/elephant/tests/testbdb/PLACEHOLDER.txt 2006/11/11 18:41:14 NONE +++ /project/elephant/cvsroot/elephant/tests/testbdb/PLACEHOLDER.txt 2006/11/11 18:41:14 1.1 --- /project/elephant/cvsroot/elephant/tests/testbdb/README 2006/11/11 18:41:14 NONE +++ /project/elephant/cvsroot/elephant/tests/testbdb/README 2006/11/11 18:41:14 1.1 This directory needs to exists for the tests to go smoothly.

1 0

[elephant-cvs] CVS elephant/src/db-clsql
by ieslick 11 Nov '06

11 Nov '06

Update of /project/elephant/cvsroot/elephant/src/db-clsql In directory clnet:/tmp/cvs-serv20360/src/db-clsql Modified Files: sql-collections.lisp sql-controller.lisp sql-transaction.lisp Added Files: package.lisp Log Message: Remove all references to sleepycat; change to bdb db-bdb or berkeley-db; passes all test for BDB and SQLite on Allegro/Mac OS/32-bit --- /project/elephant/cvsroot/elephant/src/db-clsql/sql-collections.lisp 2006/11/11 15:30:26 1.5 +++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-collections.lisp 2006/11/11 18:41:11 1.6 @@ -17,7 +17,7 @@ ;;; (http://opensource.franz.com/preamble.html) also known as the LLGPL. ;;; -(in-package "ELEPHANT-CLSQL") +(in-package :db-clsql) (defmethod get-value (key (bt sql-btree-index)) "Get the value in the primary DB from a secondary key." --- /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp 2006/04/27 01:34:49 1.11 +++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp 2006/11/11 18:41:11 1.12 @@ -16,13 +16,7 @@ ;;; (http://opensource.franz.com/preamble.html) also known as the LLGPL. ;;; -(in-package "ELEPHANT") - -(defpackage elephant-clsql - (:use :common-lisp :uffi :cl-base64 - :elephant :elephant-memutil :elephant-backend )) - -(in-package "ELEPHANT-CLSQL") +(in-package :db-clsql) ;; ;; The main SQL Controller Class --- /project/elephant/cvsroot/elephant/src/db-clsql/sql-transaction.lisp 2006/02/19 16:22:40 1.2 +++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-transaction.lisp 2006/11/11 18:41:11 1.3 @@ -17,7 +17,7 @@ ;;; (http://opensource.franz.com/preamble.html) also known as the LLGPL. ;;; -(in-package "ELEPHANT-CLSQL") +(in-package :db-clsql) (defmethod execute-transaction ((sc sql-store-controller) txn-fn &key &allow-other-keys) "Execute a body with a transaction in place. On success, --- /project/elephant/cvsroot/elephant/src/db-clsql/package.lisp 2006/11/11 18:41:11 NONE +++ /project/elephant/cvsroot/elephant/src/db-clsql/package.lisp 2006/11/11 18:41:11 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; sql-controller.lisp -- Interface to a CLSQL based object store. ;;; ;;; Initial version 10/12/2005 by Robert L. Read ;;; <read(a)robertlread.net> ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; Copyright (c) 2005 by Robert L. Read ;;; ;;; 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 :elephant) (defpackage db-clsql (:use :common-lisp :uffi :cl-base64 :elephant :elephant-memutil :elephant-backend))

1 0

[elephant-cvs] CVS elephant/src/memutil
by ieslick 11 Nov '06

11 Nov '06

Update of /project/elephant/cvsroot/elephant/src/memutil In directory clnet:/tmp/cvs-serv20360/src/memutil Modified Files: libmemutil.c Log Message: Remove all references to sleepycat; change to bdb db-bdb or berkeley-db; passes all test for BDB and SQLite on Allegro/Mac OS/32-bit --- /project/elephant/cvsroot/elephant/src/memutil/libmemutil.c 2006/02/19 04:53:02 1.1 +++ /project/elephant/cvsroot/elephant/src/memutil/libmemutil.c 2006/11/11 18:41:11 1.2 @@ -1,6 +1,6 @@ /* ;;; -;;; libsleepycat.c -- C wrappers for Sleepycat for FFI +;;; libsleepycat.c -- C wrappers for memory mgmt for BDB backend & others ;;; ;;; Initial version 8/26/2004 by Ben Lee ;;; <blee(a)common-lisp.net>

1 0

[elephant-cvs] CVS elephant/tests
by ieslick 11 Nov '06

11 Nov '06

Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv20360/tests Modified Files: delscript.sh elephant-tests.lisp testcollections.lisp testsorter.lisp Added Files: testbdb.lisp Removed Files: testsleepycat.lisp Log Message: Remove all references to sleepycat; change to bdb db-bdb or berkeley-db; passes all test for BDB and SQLite on Allegro/Mac OS/32-bit --- /project/elephant/cvsroot/elephant/tests/delscript.sh 2006/09/04 05:01:07 1.1 +++ /project/elephant/cvsroot/elephant/tests/delscript.sh 2006/11/11 18:41:11 1.2 @@ -4,6 +4,6 @@ rm testdb2/__* rm testdb2/%* rm testdb2/log* -rm testsleepycat/testsleepycat -rm testsleepycat/__* -rm testsleepycat/log* \ No newline at end of file +rm testbdb/testsbdb +rm testbdb/__* +rm testbdb/log* \ No newline at end of file --- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2006/03/07 14:12:22 1.20 +++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2006/11/11 18:41:11 1.21 @@ -66,7 +66,7 @@ (merge-pathnames #p"tests/testdb/" (asdf:component-pathname (asdf:find-system 'elephant-tests))))) - "The primary test spec for testing sleepycat") + "The primary test spec for testing berkeley db backends") (defvar *testbdb-spec2* `(:bdb @@ -110,7 +110,7 @@ (defun do-backend-tests (&optional (spec *default-spec*)) "Will test a specific backend based on the spec. Note, - if you run a :bdb backend test it will load sleepycat + if you run a :bdb backend test it will load berkeley db specific tests which should silently succeed if you test another backend" (when (and (consp spec) (symbolp (car spec))) @@ -178,10 +178,10 @@ (class-slots (find-class class-name)))) -(defvar *sleepycatdb-spec* +(defvar *bdb-spec* `(:bdb . ,(namestring (merge-pathnames - #p"tests/testsleepycat/" + #p"tests/testbdb/" (asdf:component-pathname (asdf:find-system 'elephant-tests)))))) --- /project/elephant/cvsroot/elephant/tests/testcollections.lisp 2006/02/19 04:53:02 1.12 +++ /project/elephant/cvsroot/elephant/tests/testcollections.lisp 2006/11/11 18:41:11 1.13 @@ -705,7 +705,7 @@ ;; This test not only does not work, it appears to -;; hang sleepycat forcing a recovery!?!?!?! +;; hang BDB forcing a recovery!?!?!?! ;; (deftest cursor-put ;; (let* ((ibt (make-indexed-btree *store-controller*))) ;; (let ( --- /project/elephant/cvsroot/elephant/tests/testsorter.lisp 2006/02/04 22:25:10 1.2 +++ /project/elephant/cvsroot/elephant/tests/testsorter.lisp 2006/11/11 18:41:11 1.3 @@ -27,9 +27,9 @@ (serialize a as) (serialize b bs) (< (lisp-compare (buffer-stream-buffer as) - (sleepycat::buffer-stream-size as) + (db-bdb::buffer-stream-size as) (buffer-stream-buffer bs) - (sleepycat::buffer-stream-size bs)) 0))) + (db-bdb::buffer-stream-size bs)) 0))) (defun lisp-cmp1 (a b) (with-buffer-streams (as bs) @@ -38,9 +38,9 @@ (serialize a as) (serialize b bs) (lisp-compare (buffer-stream-buffer as) - (sleepycat::buffer-stream-size as) + (db-bdb::buffer-stream-size as) (buffer-stream-buffer bs) - (sleepycat::buffer-stream-size bs)))) + (db-bdb::buffer-stream-size bs)))) (defvar myvec) (setq myvec (list 1 1/2 (- (expt 10 29)) (expt 10 29) most-positive-fixnum --- /project/elephant/cvsroot/elephant/tests/testbdb.lisp 2006/11/11 18:41:11 NONE +++ /project/elephant/cvsroot/elephant/tests/testbdb.lisp 2006/11/11 18:41:11 1.1 ;;; testbdb.lisp ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee ;;; <ablumberg(a)common-lisp.net> <blee(a)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 "ELE-TESTS") (defvar env) (defvar db) (defun prepare-bdb () (setq env (db-bdb::db-env-create)) (db-bdb::db-env-open env (cdr *bdb-spec*) :create t :init-txn t :init-lock t :init-mpool t :init-log t :thread t :recover-fatal t) (setq db (db-bdb::db-create env)) (db-bdb::db-open db :file "testsbdb" :database "bar" :type DB-BDB::DB-BTREE :auto-commit t :create t :thread t)) (deftest prepares-bdb (progn (if (find-package :db-bdb) (finishes (prepare-bdb)) (progn (format t "Berkeley DB not loaded, so not runnning test prepares-bdb~%") t))) t) #| (deftest put-alot (finishes (loop for key in keys do (db-bdb::db-put db key key :auto-commit t))) t) (defun get-alot () (loop for key in keys always (string= key (db-bdb::db-get db key)))) (deftest put-right (get-alot) t) (deftest put-alot-b (finishes (with-transaction (:environment env) (loop for key in keys do (db-bdb::db-put db key key)))) t) (deftest put-right-b (get-alot) t) |# (defun test-sequence1 () (let ((seq (db-bdb::db-sequence-create db))) (db-bdb::db-sequence-set-cachesize seq 1000) (db-bdb::db-sequence-set-flags seq :seq-inc t :seq-wrap t) (db-bdb::db-sequence-set-range seq 0 most-positive-fixnum) (db-bdb::db-sequence-initial-value seq (- most-positive-fixnum 99)) (db-bdb::db-sequence-open seq "testseq1" :auto-commit t :create t :thread t) (loop for i = (db-bdb::db-sequence-get-fixnum seq 1 :auto-commit t :txn-nosync t) for j from (- most-positive-fixnum 99) to most-positive-fixnum while (> i 0) do (assert (= i j)) finally (db-bdb::db-sequence-remove seq :auto-commit t)))) (deftest test-seq1 (if (not (find-package :db-bdb)) (progn (format t "Berkeley db not loaded, so not runnning test test-seq1~%") t) (finishes (test-sequence1))) t) (defun test-sequence2 () (let ((seq (db-bdb::db-sequence-create db))) (db-bdb::db-sequence-set-cachesize seq 1000) (db-bdb::db-sequence-set-flags seq :seq-dec t :seq-wrap t) (db-bdb::db-sequence-set-range seq most-negative-fixnum 0) (db-bdb::db-sequence-initial-value seq (+ most-negative-fixnum 99)) (db-bdb::db-sequence-open seq "testseq2" :auto-commit t :create t :thread t) (loop for i = (db-bdb::db-sequence-get-fixnum seq 1 :auto-commit t :txn-nosync t) for j from (+ most-negative-fixnum 99) downto most-negative-fixnum while (< i 0) do (assert (= i j)) finally (db-bdb::db-sequence-remove seq :auto-commit t)))) (deftest test-seq2 (if (not db) (progn (format t "BDB db not valid, so not runnning test test-seq2~%") t) (finishes (test-sequence2))) t) (defun cleanup-bdb () (db-bdb::db-close db) (db-bdb::db-env-dbremove env "testsbdb" :database "bar") (db-bdb::db-env-close env) (setq env (db-bdb::db-env-create)) (db-bdb::db-env-remove env "test")) (deftest cleansup-bdb (if (not db) (progn (format t "Berkeley DB not open, so not runnning test cleanup-bdb~%") t) (finishes (cleanup-bdb))) t) ;;(unuse-package "DB-BDB") ;;(use-package "ELE") #| (defun txn-alot (iters) (loop for i from 1 to iters do (with-transaction (:environment env) (db-put db "mykey" "mydatum")))) (defun get-alot-b (keys) (loop for key in keys do (db-get-buffered db key))) (defun foreign-test (ln iters) (with-transaction (:environment env) (loop for i fixnum from 1 to iters with write-buf of-type array-or-pointer-char = (uffi:allocate-foreign-object :char ln) with str string = (make-string ln :initial-element #\c) with key-buf of-type array-or-pointer-char = (uffi:allocate-foreign-object :char 2) do (copy-str-to-buf "fs" key-buf) (copy-str-to-buf str write-buf) (db-put-buffered db key-buf 2 write-buf ln) finally (progn (uffi:free-foreign-object write-buf) (uffi:free-foreign-object key-buf))))) (defun cstring-test (ln iters) (with-transaction (:environment env) (loop for i fixnum from 1 to iters with str string = (make-string ln :initial-element #\c) do (db-put db "fs" str)))) |#

1 0

[elephant-cvs] CVS elephant
by ieslick 11 Nov '06

11 Nov '06

Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv20360 Modified Files: INSTALL TODO TUTORIAL ele-bdb.asd ele-clsql.asd elephant-tests.asd Log Message: Remove all references to sleepycat; change to bdb db-bdb or berkeley-db; passes all test for BDB and SQLite on Allegro/Mac OS/32-bit --- /project/elephant/cvsroot/elephant/INSTALL 2006/11/11 06:27:37 1.18 +++ /project/elephant/cvsroot/elephant/INSTALL 2006/11/11 18:41:10 1.19 @@ -91,19 +91,14 @@ config.sexp -to point to your local distribution of the Berkeley DB libraries - -Darwin / OS X ---------------- -You need to have the developer tools installed. In the Makefile and -ele-bdb.lib there are commented-out lines showing settings that some -users have used for OS X; if you are using that I assume you will -have to comment out the appropriate lines and uncomment those examples. +Which contains an alist providing string paths pointing to the root +of the Berkeley DB distribution :berkeley-db-root, the library to load +:berkeley-db-lib and the pthreads library if you're running linux :pthread-lib. For Win32 (directions courtesy of Bill Clementson): --------------------------------------------------- -Create an MSVC dll project and add src/db-bdb/libsleepycat.c, -src/db-bdb/libsleepycat.def and the Berkeley DB libdb43.lib files +Create an MSVC dll project and add src/db-bdb/libberkeley-db.c, +src/db-bdb/libberkeley-db.def and the Berkeley DB libdb43.lib files to the project (should be in the build_win32/release folder) Add the Berkeley DB dbinc include files directory and the @@ -114,7 +109,7 @@ Build the Elephant DLL file Since you've statically included libdb43.lib inside -libsleepycat.c, it may or may not be necessary to load +libberkeley-db.c, it may or may not be necessary to load libdb43.dll into Lisp (see below.) @@ -140,7 +135,7 @@ To test the load process explicitly the following asdf files are provided: -if you are using Sleepycat / Berkeley DB, type: +if you are using Berkeley DB, type: (asdf:operate 'asdf:load-op :ele-bdb) if you are using CL-SQL, type: --- /project/elephant/cvsroot/elephant/TODO 2006/11/11 15:33:33 1.29 +++ /project/elephant/cvsroot/elephant/TODO 2006/11/11 18:41:10 1.30 @@ -3,8 +3,8 @@ Ongoing release plan notes: -0.6.1 - performance, safety and portability (end of Summer?) ------------------------------------------------------------ +0.6.1 - performance, safety and portability +-------------------------------------------- Bugs or Observations: x 64-bit support (from Marco) @@ -12,16 +12,14 @@ x MCL 1.1 unicode support; rationalize other lisp support for unicode Stability: -- Review all the NOTE comments in the code - Remove build gensym warnings in sleepycat -- Remove sleepycat name. Change sleepycat to db-bdb to reflect oracle ownership and avoid - confusion for new users - Delete persistent slot values from the slot store with remove-kv to ensure that there's no data left lying around if you define then redefine a class and add back a persistent slot name that you thought was deleted and it gets the old value by default. - Cleaner failure modes if operations are performed without repository or without transaction or auto-commit (Both) +- Review all the NOTE comments in the code Store variables: - Think through default *store-controller* vs. explicit parameter passing @@ -96,6 +94,8 @@ stay around - probably indefinitely unless we GC (no, we'll resolve this with a stop-and-copy GC - need to make migration bookkeeping more efficient) x MCL type-declaration compatibility +x Remove sleepycat name. Change sleepycat to db-bdb to reflect oracle ownership and avoid + confusion for new users 0.6.2 - Advanded work, low-hanging fruit (Fall '06) -------------------------------------------------- --- /project/elephant/cvsroot/elephant/TUTORIAL 2006/02/15 01:54:07 1.7 +++ /project/elephant/cvsroot/elephant/TUTORIAL 2006/11/11 18:41:10 1.8 @@ -3,7 +3,7 @@ ======== -------------------------------- -What is Sleepycat / Berkeley DB? +What is Berkeley DB? -------------------------------- When someone says "database," most people think of SQL @@ -14,7 +14,7 @@ many features. While you don't need to understand Sleepycat to use Elephant, reading the docs will certainly help you. -http://www.sleepycat.com +http://www.oracle.com/database/berkeley-db.html --------------- Getting Started @@ -27,7 +27,7 @@ Assuming you've managed to install Elephant properly, -* if you are using Sleepycat / Berkeley DB, type: +* if you are using Berkeley DB, type: (asdf:operate 'asdf:load-op :ele-bdb) * or if you are using CL-SQL, type: @@ -56,7 +56,7 @@ The store controller holds the handles to the database environment and tables, and some other bookkeeping. If for some reason you need to run recovery on the database (see -sleepycat docs) you can specify that with the :recover and +Berkeley DB docs) you can specify that with the :recover and :recover-fatal keys. Alternatively, @@ -250,7 +250,7 @@ Note that the database is read every time you access a slot. This is a feature, not a bug, especially in concurrent situations: you want the most recent commits, right? -(Sleepycat will give isolation inside of transactions, +(Berkeley DB will give isolation inside of transactions, though.) In particular, if your slot value is not an immediate value, reading will cons the value. Gets are not an expensive operation (I can do a million reads in 30 @@ -315,7 +315,7 @@ The btrees class are to hash-tables as persistent-objects are to ordinary objects. btrees have a hash-table-like interface, but store their keys and values directy in a -Sleepycat btree. Btrees may be persisted simply by their +BDB btree. Btrees may be persisted simply by their OID. Hence they have all the nice properties of persistent objects: identity, fast serialization / deserialization, no merge conflicts..... @@ -345,13 +345,13 @@ Threading --------- -Sleepycat plays well with threads and processes. The store +Berkeley DB plays well with threads and processes. The store controller is thread-safe by default, that is, can be shared amongst threads. Transactions may not be shared amongst threads except serially. One thing which is NOT thread and process safe is recovery, which should be run when no one is else is talking to the database environment. Consult the -Sleepycat docs for more information. +Berkeley DB docs for more information. Elephant uses some specials to hold parameters and buffers. If you're using a natively threaded lisp, you can initialize @@ -391,12 +391,12 @@ * (db-env-set-flags (controller-environment *store-controller*) 1 :txn-nosync t) -or look at other flags in the sleepycat docs. This will +or look at other flags in the Berkeley DB docs. This will greatly increase your throughput at the cost of some durability; I get around a 100x improvement. This can be recovered with judicious use of checkpointing and replication, though this is currently not supported by -Elephant -- see the sleepycat docs. +Elephant -- see the Berkeley DB docs. The serializer is definitely fast on fixnums, strings, and persistent things. It is fairly fast but consing with --- /project/elephant/cvsroot/elephant/ele-bdb.asd 2006/11/11 06:27:37 1.11 +++ /project/elephant/cvsroot/elephant/ele-bdb.asd 2006/11/11 18:41:10 1.12 @@ -45,8 +45,8 @@ (defclass bdb-c-source (elephant-c-source) ()) (defmethod compiler-options ((compiler (eql :gcc)) (c bdb-c-source) &key &allow-other-keys) - (let* ((include (merge-pathnames (get-config-option :sleepycat-root c) "include")) - (lib (merge-pathnames (get-config-option :sleepycat-root c) "lib"))) + (let* ((include (merge-pathnames (get-config-option :berkeley-db-root c) "include")) + (lib (merge-pathnames (get-config-option :berkeley-db-root c) "lib"))) (append (list (format nil "-L~A" lib) (format nil "-I~A" include)) (call-next-method) (list "-ldb")))) @@ -55,7 +55,7 @@ (remove-if #'(lambda (x) (null (car x))) (list (cons (get-config-option :pthread-lib c) "pthread") - (cons (get-config-option :sleepycat-lib c) "sleepycat")))) + (cons (get-config-option :berkeley-db-lib c) "berkeley-db")))) ;; ;; System definition @@ -75,8 +75,8 @@ ((:module :db-bdb :components ((:file "package") - (:bdb-c-source "libsleepycat") - (:file "sleepycat") + (:bdb-c-source "libberkeley-db") + (:file "berkeley-db") (:file "bdb-controller") (:file "bdb-transactions") (:file "bdb-collections")) --- /project/elephant/cvsroot/elephant/ele-clsql.asd 2006/02/22 20:18:51 1.7 +++ /project/elephant/cvsroot/elephant/ele-clsql.asd 2006/11/11 18:41:10 1.8 @@ -53,7 +53,8 @@ :components ((:module :db-clsql :components - ((:file "sql-controller") + ((:file "package") + (:file "sql-controller") (:file "sql-transaction") (:file "sql-collections")) :serial t)))) --- /project/elephant/cvsroot/elephant/elephant-tests.asd 2006/02/19 04:52:58 1.6 +++ /project/elephant/cvsroot/elephant/elephant-tests.asd 2006/11/11 18:41:10 1.7 @@ -74,6 +74,6 @@ :components ((:module :tests :components - ((:file "testsleepycat"))))) + ((:file "testbdb")))))

1 0