From ieslick at common-lisp.net Fri Nov 10 01:48:49 2006 From: ieslick at common-lisp.net (ieslick) Date: Thu, 9 Nov 2006 20:48:49 -0500 (EST) Subject: [elephant-cvs] CVS elephant Message-ID: <20061110014849.44D124734C@common-lisp.net> Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv12829 Modified Files: README TODO elephant.asd Log Message: Minor edits only, checkpointing after unrolling some experiments. --- /project/elephant/cvsroot/elephant/README 2004/09/19 17:40:29 1.4 +++ /project/elephant/cvsroot/elephant/README 2006/11/10 01:48:49 1.5 @@ -40,6 +40,15 @@ http://www.common-lisp.net/project/elephant +------------------ +Supported Lisps +------------------ +CMUCL Linux (lightly tested) +SBCL Linux Mac (heavily tested) +Allegro Linux Mac cygwin? (heavily tested) +CLISP Linux Mac cygwin (lightly tested) +MCL Mac (lightly tested) + ----------------------------- Copyright, License + Warrenty ----------------------------- --- /project/elephant/cvsroot/elephant/TODO 2006/09/04 05:42:43 1.25 +++ /project/elephant/cvsroot/elephant/TODO 2006/11/10 01:48:49 1.26 @@ -7,6 +7,10 @@ ----------------------------------------------------------- Bugs or Observations: +- New build interface +- 64-bit support (from Marco) +- pthreads issue? +- MCL compatibility issues Stability: - Review all the NOTE comments in the code @@ -80,7 +84,7 @@ 0.6.1 - Features COMPLETED to date ---------------------------------- -x Ensure serialization is multi-threaded and efficient +x Ensure serialization is multi-threaded and efficient x Determine how to detect deadlock conditions as an optional run-safe mode? x BDB overwrite of values makes DB grow [So far I can only find that it grows on the 2nd write, but not after that...artifact of @@ -90,9 +94,9 @@ x Update to support BDB 4.4 x Add ability from within lisp to reclaim DB space after deleting btree key-value pairs - 0.6.2 - Advanded work, low-hanging fruit (Fall '06) -------------------------------------------------- + - Class option MOP add-on to support declared persistent baseclass slots for standard base classes - Port elephant to closer-to-MOP to make it easier to support additional lisps and to seriously clean up metaclasses.lisp and classes.lisp protocols - A wrapper around migration that emulates a stop-and-copy GC @@ -136,20 +140,21 @@ - Intent is for this to be a major, long-term supported release prior to work on the new backend -0.7.2 - Additional Tools +0.8.0 - Native Backend +-------------------------------------------------- + - A native lisp backend controller (Ian) + - Native persistent hashes (easy for BDB; can do on SQL backends?) + - Support for cheap persistent sets (medium? can do on SQL?) + +0.9.0 - Supporting Tools Release -------------------------------------------------- + - Document DCM? - Add needed support (if any) for persistent graph structures & queries (Ian on a branch) - Simple object query language (Ian - orthogonal, on main branch) - Repository browser (Ian - orthogonal, on main branch) (a simple REPL tool to see what classes are in a repository and what state they're in...useful for long-lived repositories) -0.8.0 - Native Backend & Datastructure Library ( --------------------------------------------------- - - A native lisp backend controller (Ian) - - Native BDB persistent hashes (easy; can do on SQL backends?) - - Support for cheap persistent sets (medium? can do on SQL?) - - Usage model examples --- /project/elephant/cvsroot/elephant/elephant.asd 2006/06/01 12:55:43 1.18 +++ /project/elephant/cvsroot/elephant/elephant.asd 2006/11/10 01:48:49 1.19 @@ -113,8 +113,6 @@ (:file "backend")) :serial t :depends-on (memutil))))) - :depends-on (:uffi)) - - + :depends-on (:uffi :closer-mop)) From ieslick at common-lisp.net Fri Nov 10 01:48:49 2006 From: ieslick at common-lisp.net (ieslick) Date: Thu, 9 Nov 2006 20:48:49 -0500 (EST) Subject: [elephant-cvs] CVS elephant/src/db-bdb Message-ID: <20061110014849.8459948000@common-lisp.net> Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv12829/src/db-bdb Modified Files: sleepycat.lisp Log Message: Minor edits only, checkpointing after unrolling some experiments. --- /project/elephant/cvsroot/elephant/src/db-bdb/sleepycat.lisp 2006/09/05 03:23:16 1.7 +++ /project/elephant/cvsroot/elephant/src/db-bdb/sleepycat.lisp 2006/11/10 01:48:49 1.8 @@ -50,40 +50,28 @@ ;; (eval-when (:compile-toplevel :load-toplevel) - - ;; - ;; Under Linux we need pthreads! - ;; - #+linux - (unless - (uffi:load-foreign-library + (unless + (uffi:load-foreign-library elephant::*sleepycat-pthreads-path* :module "pthread") - (error "Couldn't load libpthread!")) - - ;; - ;; Our interface library requires that the main Berkeley DB library be loaded - ;; + (error "Couldn't load pthread")) (unless (uffi:load-foreign-library elephant::*sleepycat-foreign-library-path* :module "sleepycat") - (error "Couldn't load libdb (Sleepycat)!")) - - ;; - ;; Our local interface library - ;; + (error "Couldn't load libdb (Sleepycat)!")) (unless (uffi:load-foreign-library - (merge-pathnames + (merge-pathnames (make-pathname :name "libsleepycat" :type *c-library-extension*) - (merge-pathnames "src/db-bdb/" + (merge-pathnames "src/db-bdb/" (asdf:component-pathname (asdf:find-system 'elephant)))) :module "libsleepycat") - (error "Couldn't load src/db-bdb/libsleepycat.~A!" elephant-memutil::*c-library-extension*)) + (error "Couldn't load libdb (Sleepycat)!"))) + ;; Error handling ;; I put this here so we could validate that the library was loaded @@ -104,7 +92,6 @@ (format stream "Berkeley DB error: ~A" (db-strerror (db-error-errno condition))))) (:documentation "Berkeley DB / Sleepycat errors.")) - ) ;; ;; Constants and Flags From ieslick at common-lisp.net Fri Nov 10 01:48:49 2006 From: ieslick at common-lisp.net (ieslick) Date: Thu, 9 Nov 2006 20:48:49 -0500 (EST) Subject: [elephant-cvs] CVS elephant/src/elephant Message-ID: <20061110014849.B850A48000@common-lisp.net> Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv12829/src/elephant Modified Files: controller.lisp variables.lisp Log Message: Minor edits only, checkpointing after unrolling some experiments. --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2006/09/04 05:01:06 1.13 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2006/11/10 01:48:49 1.14 @@ -29,7 +29,6 @@ ;; Dynamic tracking of active connections - (defparameter *elephant-backends* '((:bdb (:ele-bdb)) (:clsql (:ele-clsql)) @@ -110,6 +109,54 @@ ;; ================================================ ;; +;; Callback hooks for persistent variables +;; + +(defvar *variable-hooks* nil + "An alist (specs -> varlist) where varlist is tuple of + lisp name, store name (auto) and policy") + +;;(defun add-hook (name spec) +;; (if (assoc spec *variable-hooks* :test #'equal) +;; (push name (assoc spec *variable-hooks* :test #'equal)) +;; (push (cons spec (list name)) *variable-hooks*))) + +;;(defun remove-hook (name spec) +;; (if (assoc spec *variable-hooks* :test #'equal) +;; (setf (assoc spec *variable-hooks* :test #'equal) +;; (remove name (assoc spec *variable-hooks* :test #'equal))) +;; (error "No hooks declared on ~A" spec))) + +;; (defmacro defpvar (name spec (policy &rest accessors) initial-value &optional (documentation nil)) +;; `(progn +;; (defvar ,name ,initial-value ,documentation) +;; (add-hook ,name ,spec) +;; ,(case policy +;; (:wrap-mutators +;; `(progn +;; ,(loop for accessor in accessors do +;; (let ((gf (ensure-generic-function +;; `(defmethod ,accessor :after ( + +;; (defpvar *agencies* (:wrap-mutators +;; 'add-agent +;; 'remove-agent +;; 'clear-agents) +;; nil +;; "test") + +;; (defmethod add-agent (agent) +;; (push agent *agencies*)) + +;; (defmethod remove-agent (agent) +;; (setf *agencies* (remove agent *agencies*))) + +;; (defmethod clear-agents (agent) +;; (setf *agencies* nil)) + + + +;; ;; Open a Store ;; --- /project/elephant/cvsroot/elephant/src/elephant/variables.lisp 2006/09/05 03:23:17 1.4 +++ /project/elephant/cvsroot/elephant/src/elephant/variables.lisp 2006/11/10 01:48:49 1.5 @@ -69,7 +69,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Thread-local specials -(defparameter *store-controller* nil +(defvar *store-controller* nil "The store controller which persistent objects talk to.") ;; Specials which control persistent objects From ieslick at common-lisp.net Fri Nov 10 01:48:49 2006 From: ieslick at common-lisp.net (ieslick) Date: Thu, 9 Nov 2006 20:48:49 -0500 (EST) Subject: [elephant-cvs] CVS elephant/src/memutil Message-ID: <20061110014849.E879B48000@common-lisp.net> Update of /project/elephant/cvsroot/elephant/src/memutil In directory clnet:/tmp/cvs-serv12829/src/memutil Modified Files: memutil.lisp Log Message: Minor edits only, checkpointing after unrolling some experiments. --- /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2006/09/04 00:09:16 1.9 +++ /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2006/11/10 01:48:49 1.10 @@ -70,7 +70,7 @@ (unless (uffi:load-foreign-library (merge-pathnames - (make-pathname :name "libmemutil" :type *c-library-extension* ) + (make-pathname :name "libmemutil" :type *c-library-extension*) (merge-pathnames "src/memutil/" (asdf:component-pathname (asdf:find-system 'elephant)))) :module "libmemutil") From ieslick at common-lisp.net Sat Nov 11 06:27:38 2006 From: ieslick at common-lisp.net (ieslick) Date: Sat, 11 Nov 2006 01:27:38 -0500 (EST) Subject: [elephant-cvs] CVS elephant/src/db-bdb Message-ID: <20061111062738.27E6B710EA@common-lisp.net> Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv5313/src/db-bdb Modified Files: sleepycat.lisp Log Message: Removed config.lisp and all Makefile related build options. The build is now entirely driven from the elephant.asd and ele-bdb.asd files with a simple user customization file, config.sexp, that should be copied to my-config.sexp and customized to the user's environment. Thanks to pinterface for the initial patch supporting this approach. Foreign library loading is also controlled from the asd files now at system load time rather than at compile time. --- /project/elephant/cvsroot/elephant/src/db-bdb/sleepycat.lisp 2006/11/10 01:48:49 1.8 +++ /project/elephant/cvsroot/elephant/src/db-bdb/sleepycat.lisp 2006/11/11 06:27:37 1.9 @@ -50,32 +50,7 @@ ;; (eval-when (:compile-toplevel :load-toplevel) - #+linux - (unless - (uffi:load-foreign-library - elephant::*sleepycat-pthreads-path* - :module "pthread") - (error "Couldn't load pthread")) - - (unless - (uffi:load-foreign-library - elephant::*sleepycat-foreign-library-path* - :module "sleepycat") - (error "Couldn't load libdb (Sleepycat)!")) - - (unless - (uffi:load-foreign-library - (merge-pathnames - (make-pathname :name "libsleepycat" :type *c-library-extension*) - (merge-pathnames "src/db-bdb/" - (asdf:component-pathname (asdf:find-system 'elephant)))) - :module "libsleepycat") - (error "Couldn't load libdb (Sleepycat)!"))) - - - ;; Error handling - ;; I put this here so we could validate that the library was loaded - + (def-function ("db_strerr" %db-strerror) ((error :int)) :returning :cstring) @@ -93,6 +68,8 @@ (db-strerror (db-error-errno condition))))) (:documentation "Berkeley DB / Sleepycat errors.")) + ) + ;; ;; Constants and Flags ;; eventually write a macro which generates a custom flag function. From ieslick at common-lisp.net Sat Nov 11 06:27:37 2006 From: ieslick at common-lisp.net (ieslick) Date: Sat, 11 Nov 2006 01:27:37 -0500 (EST) Subject: [elephant-cvs] CVS elephant Message-ID: <20061111062737.1CDF1710D2@common-lisp.net> Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv5313 Modified Files: CREDITS INSTALL NEWS README TODO ele-bdb.asd elephant.asd Removed Files: Makefile config.lisp Log Message: Removed config.lisp and all Makefile related build options. The build is now entirely driven from the elephant.asd and ele-bdb.asd files with a simple user customization file, config.sexp, that should be copied to my-config.sexp and customized to the user's environment. Thanks to pinterface for the initial patch supporting this approach. Foreign library loading is also controlled from the asd files now at system load time rather than at compile time. --- /project/elephant/cvsroot/elephant/CREDITS 2006/02/14 15:28:32 1.7 +++ /project/elephant/cvsroot/elephant/CREDITS 2006/11/11 06:27:37 1.8 @@ -2,12 +2,11 @@ Authors: Andrew Blumberg and Ben Lee and -Current maintainer: Robert L. Read - +Current maintainers: Robert L. Read + Ian S. Eslick http://www.common-lisp.net/project/elephant - The CL-SQL based backend was written by Robert L. Read. Thanks to: @@ -24,7 +23,7 @@ Rafal Strzalinski for the Makefile and package patch -Bill Clementson for Win32 help and publicity +Bill Clementson for Win32 help and for publicity The common-lisp.net people for hosting @@ -41,15 +40,20 @@ Paul Foley for his berkeley-db package (which we didn't use, once we settled on UFFI) -Various other people whom I'm forgetting who answered my -many idiotic questions - Dan Knapp fixed the fact that nil's were indistinguishable from unbound slots, and proved the system works with SQLite3. Tayssir John Gabbour has found two bugs on Feb. 14, 2006. -Ian Eslick wrote src/indexing.lisp, which added major -convenience features for automatically indexing the a slot -in a class. +Ian Eslick wrote src/indexing.lisp, which added major convenience +features for automatically indexing on slot values in a class. He is +also responsible for the refactoring and most of the bug fixes in the +0.6.0 release. + +Vladimir Sedach for the upgrade to Berkeley DB 4.4. + +pinterface at gmail.com provided the basic support in the .asd +files for removing the Makefile from the build process. + +Marco Baringer provided a partial patch for 64-bit support. --- /project/elephant/cvsroot/elephant/INSTALL 2006/02/22 20:18:51 1.17 +++ /project/elephant/cvsroot/elephant/INSTALL 2006/11/11 06:27:37 1.18 @@ -46,11 +46,11 @@ Long Instructions ----------------- -I assume you have a supported lisp with asdf. +For SBCL, CMUCL, Allegro 7.0+, MCL and CLISP: 0) Unpack Elephant. I put mine in the directory -/usr/local/share/common-lisp/elephant-0.3/ +/usr/local/share/common-lisp/elephant-0.6/ 1) Install ASDF. @@ -59,7 +59,7 @@ 2) Install UFFI. -3) Install a backend: Either Berkeley DB 4.3, PostGresql, or SQLite 3. +3) Install a backend: Either Berkeley DB 4.4, PostGresql, or SQLite 3. ------- SQL @@ -69,31 +69,27 @@ other the heading "SQL-BACK-END". ------------- -Berkeley 4.3: +Berkeley 4.4: ------------- +(Note: 0.6.0 users used 4.3; upgrade to 4.4 and run 0.6.1+ and + your existing DB will automatically upgrade when the DB is opened) + Under Un*x, you may actually already have this installed, though it may be compiled with funny options, so if things don't work you may want to try to start from scratch. FreeBSD has a port for this, as I'm sure do other BSDs (including Darwin/Fink.) Take note of where libdb.so and db.h are installed, usually: - /usr/local/BerekleyDB.4.3/lib/libdb.so and - /usr/local/BerekleyDB.4.3/include/db.h, or - - /usr/local/lib/db42/libdb.so and - /usr/local/include/db42/db.h.) - -a) Edit Makefile variable DB43DIR and DB43INC, DB43LIB if necessary - -This makes sure that the build process can find your files. -You can test that the build works by calling: + /usr/local/BerekleyDB.4.4/lib/libdb.so and + /usr/local/BerekleyDB.4.4/include/db.h, or -'make bdb'. + /usr/local/lib/db44/libdb.so and + /usr/local/include/db44/db.h.) -b) Also edit the variable *sleepycat-foreign-library-path* in +a) Site specific configuration - config.lisp + config.sexp to point to your local distribution of the Berkeley DB libraries --- /project/elephant/cvsroot/elephant/NEWS 2005/11/23 18:17:52 1.8 +++ /project/elephant/cvsroot/elephant/NEWS 2006/11/11 06:27:37 1.9 @@ -1,3 +1,9 @@ +April, 2006 - Elephant 0.6.0 released by +Robert Read and Ian Eslick. Supports class slot +indexing and benefits from a clean refactoring +of backends and a host of other small changes. +This is a solid BETA release. + November 30, 2005 - Elephant 0.3.0 released by the new maintainer, Robert L. Read, providing support for relational database backends, repository --- /project/elephant/cvsroot/elephant/README 2006/11/10 01:48:49 1.5 +++ /project/elephant/cvsroot/elephant/README 2006/11/11 06:27:37 1.6 @@ -67,11 +67,14 @@ HTML docs and texinfo sources can be found in the docs/ directory. ------- -Design ------- +------------------------ +Design and Development +------------------------ -See NOTES. +See NOTES for some design internals. + +If you want to contribute, see TODO for current feature release plans +and other things that need to be done. ------- Authors --- /project/elephant/cvsroot/elephant/TODO 2006/11/10 01:48:49 1.26 +++ /project/elephant/cvsroot/elephant/TODO 2006/11/11 06:27:37 1.27 @@ -1,5 +1,5 @@ -September 1st, 2006 +Last updated: November 11, 2006 Ongoing release plan notes: @@ -7,10 +7,9 @@ ----------------------------------------------------------- Bugs or Observations: -- New build interface - 64-bit support (from Marco) -- pthreads issue? -- MCL compatibility issues +? MCL compatibility issues +- Windows support for asdf-based library builds? Stability: - Review all the NOTE comments in the code @@ -35,6 +34,7 @@ Multi-threading operation: - Make elephant threads appropriately bind dynamic variables - Verify that operations such as indexing are thread safe +- Verify that serialization is thread safe BDB Features: ~ Automatically run db_deadlock when opening a bdb backend? Requires path to @@ -57,8 +57,6 @@ - Reclaim table storage on index drop? It's nice to be able to reconnect sometimes! Perhaps an API command that allows explicit dropping of tables for a class and a policy parameter that determines if this is the default? -- Should we delete slot-values in the db when redefining classes, currently those values - stay around - probably indefinitely unless we GC Performance: - Metering and understanding locking issues. Large transactions seem @@ -84,6 +82,7 @@ 0.6.1 - Features COMPLETED to date ---------------------------------- +x New build interface; all-lisp compilation (sans win32) x Ensure serialization is multi-threaded and efficient x Determine how to detect deadlock conditions as an optional run-safe mode? x BDB overwrite of values makes DB grow @@ -93,6 +92,9 @@ [Ditto above] x Update to support BDB 4.4 x Add ability from within lisp to reclaim DB space after deleting btree key-value pairs +x Should we delete slot-values in the db when redefining classes, currently those values + 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) 0.6.2 - Advanded work, low-hanging fruit (Fall '06) -------------------------------------------------- --- /project/elephant/cvsroot/elephant/ele-bdb.asd 2006/06/01 12:55:43 1.10 +++ /project/elephant/cvsroot/elephant/ele-bdb.asd 2006/11/11 06:27:37 1.11 @@ -19,65 +19,47 @@ (in-package :cl-user) (defpackage ele-bdb-system - (:use :cl :asdf)) + (:use :cl :asdf :elephant-system)) (in-package :ele-bdb-system) -(eval-when (:compile-toplevel :load-toplevel :execute) - ;; We need this dependency satisfied to compute what to do for C files - (unless (find-package 'uffi) - (asdf:operate 'asdf:load-op 'uffi))) - -(defclass bdb-c-source (c-source-file) - ()) - -(defparameter *root-dir* (pathname-directory *load-truename*)) - -(defparameter *library-file-dir* (append (pathname-directory *load-truename*) - (list "src" "db-bdb"))) - -;; Compile foreign library on non-win32 platforms - -(defmethod output-files ((o compile-op) (c bdb-c-source)) - (let ((library-file-type - (funcall (intern (symbol-name '#:default-foreign-library-type) - (symbol-name '#:uffi))))) - (list (make-pathname :name (component-name c) - :type library-file-type - :directory *library-file-dir*)))) - -(defmethod perform ((o compile-op) (c bdb-c-source)) - (unless (operation-done-p o c) - #-(or win32 windows) - (unless (zerop (uffi:run-shell-command - (format nil - #-freebsd "cd ~A; make bdb" - #+freebsd "cd ~A; gmake bdb" - (make-pathname :directory *root-dir*)))) - (format t "Couldn't build library from libsleepycat.c via 'make bdb'~%") - (error 'operation-error :component c :operation o)))) - -(defmethod operation-done-p ((o compile-op) (c bdb-c-source)) - (or (let ((lib (make-pathname :defaults (component-pathname c) - :type (uffi:default-foreign-library-type)))) - (and (probe-file lib) (probe-file (component-pathname c)) - (> (file-write-date lib) (file-write-date (component-pathname c))))))) - -;; Load op - ensure that foreign library is loaded - -(defmethod perform ((o load-op) (c bdb-c-source)) - "Nothing to do!" - t) - -(defmethod operation-done-p ((o load-op) (c bdb-c-source)) - "Operation is done when the foreign library is loaded which should - happen when we compile the interface lisp file" - (and (and (find-package '#:sleepycat) - (ignore-errors - (symbol-function (intern (symbol-name '#:%db-strerror) - (find-package '#:sleepycat))))) - t)) - +;; +;; User parameters (bdb root and pthread, if necessary) +;; + +(defparameter *bdb-config* nil) + +(defun get-config-option (option component) + (unless *bdb-config* + (with-open-file (config (make-pathname :defaults (asdf:component-pathname + (asdf:component-system component)) + :name "my-config" + :type "sexp")) + (setf *bdb-config* (read config)))) + (cdr (assoc option *bdb-config*))) + +;; +;; Compile bdb lib and load libraries +;; + +(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"))) + (append (list (format nil "-L~A" lib) (format nil "-I~A" include)) + (call-next-method) + (list "-ldb")))) + +(defmethod foreign-libraries-to-load-first ((c bdb-c-source)) + (remove-if #'(lambda (x) (null (car x))) + (list + (cons (get-config-option :pthread-lib c) "pthread") + (cons (get-config-option :sleepycat-lib c) "sleepycat")))) + +;; +;; System definition +;; (defsystem ele-bdb :name "elephant" @@ -101,4 +83,3 @@ :serial t)))) :depends-on (:uffi :elephant)) - --- /project/elephant/cvsroot/elephant/elephant.asd 2006/11/10 01:48:49 1.19 +++ /project/elephant/cvsroot/elephant/elephant.asd 2006/11/11 06:27:37 1.20 @@ -19,63 +19,113 @@ (in-package :cl-user) (defpackage elephant-system - (:use :cl :asdf)) + (:use :cl :asdf) + (:export :elephant-c-source :compiler-options :foreign-libraries-to-load-first)) (in-package :elephant-system) -(eval-when (:compile-toplevel :load-toplevel :execute) - ;; We need this dependency satisfied to compute what to do for C files - (unless (find-package 'uffi) - (asdf:operate 'asdf:load-op 'uffi))) - -(defclass elephant-util-c-source (c-source-file) - ()) - -(defparameter *root-dir* (pathname-directory *load-truename*)) - -(defparameter *library-file-dir* (append (pathname-directory *load-truename*) - (list "src" "memutil"))) - -;; Compile foreign library on non-win32 platforms - -(defmethod output-files ((o compile-op) (c elephant-util-c-source)) - (let* ((library-file-type - (funcall (intern (symbol-name '#:default-foreign-library-type) - (symbol-name '#:uffi))))) - (list (make-pathname :name (component-name c) - :type library-file-type - :directory *library-file-dir*)))) - -(defmethod perform ((o compile-op) (c elephant-util-c-source)) - (unless (operation-done-p o c) - #-(or win32 windows) - (unless (zerop (uffi:run-shell-command - (format nil - #-freebsd "cd ~A; make" - #+freebsd "cd ~A; gmake" - (make-pathname :directory *root-dir*)))) - (error 'operation-error :component c :operation o)))) - -(defmethod operation-done-p ((o compile-op) (c elephant-util-c-source)) - (or (let ((lib (make-pathname :defaults (component-pathname c) - :type (uffi:default-foreign-library-type)))) - (and (probe-file lib) (probe-file (component-pathname c)) - (> (file-write-date lib) (file-write-date (component-pathname c))))))) - -;; Load op - ensure that foreign library is loaded - -(defmethod perform ((o load-op) (c elephant-util-c-source)) - "Nothing to do!" - t) - -(defmethod operation-done-p ((o load-op) (c elephant-util-c-source)) - "Operation is done when the foreign library is loaded which should - happen when we compile the interface lisp file" - (and (find-package "ELEPHANT-MEMUTIL") - (ignore-errors - (symbol-function (intern "COPY-BUFS" - (find-package "ELEPHANT-MEMUTIL")))) - t)) +;; +;; Simple lisp/asdf-based make utility for elephant c files +;; + +(defvar *c-compilers* + '((:gcc . "/usr/bin/gcc") + (:msvc . "")) + "Associate compilers with platforms for compiling libmemutil/libsleepycat") + +(defvar *compiler* + #-(or win32 windows) :gcc + #+(or win32 windows) :msvc) + +(defgeneric compiler-options (compiler c-source-file &key input-file output-file) + (:documentation "Returns a list of options to pass to ")) + +(defgeneric foreign-libraries-to-load-first (c-source-file) + (:documentation "Provides an alist of foreign-libraries to load and the modules to load them into. Similar to (input-files load-op), but much more specific")) + + +(defun uffi-funcall (fn &rest args) + "Simplify uffi funcall, first ensure uffi is loaded" + (unless (find-package :uffi) + (asdf:operate 'asdf:load-op :uffi)) + (apply (find-symbol (symbol-name fn) (symbol-name :uffi)) args)) + +;; +;; Basic utilities for elephant c files +;; + +(defclass elephant-c-source (c-source-file) ()) + +;; COMPILE + +(defmethod output-files ((o compile-op) (c elephant-c-source)) + "Compute the output files (for dependency tracking), here we assume + a library with the same name and a platform dependant extension" + (list (make-pathname :name (component-name c) + :type (uffi-funcall :default-foreign-library-type) + :defaults (component-pathname c)))) + +(defmethod perform ((o compile-op) (c elephant-c-source)) + "Run the appropriate compiler for this platform on the source, getting + the specific options from 'compiler-options method. Default options + can be overridden or augmented by subclass methods" + (unless (zerop (run-shell-command + "~A ~{~A ~}" + (cdr (assoc *compiler* *c-compilers*)) + (compiler-options + *compiler* + c + :input-file (namestring (component-pathname c)) + :output-file (namestring (first (output-files o c)))))) + (error 'operation-error :component c :operation o))) + +(defmethod operation-done-p ((o compile-op) (c elephant-c-source)) + "Is the first generated library more recent than the source file?" + (let ((lib (first (output-files o c)))) + (and (probe-file (component-pathname c)) + (probe-file lib) + (> (file-write-date lib) (file-write-date (component-pathname c)))))) + +(defmethod compiler-options ((compiler (eql :gcc)) (c elephant-c-source) &key input-file output-file) + "Default compile and link options to create a library; no -L or -I options included; math lib as default" + (unless (and input-file output-file) + (error "Must specify both input and output files")) + (list + #-(or darwin macosx) "-shared" + #+(or darwin macosx) "-bundle" + "-Wall" + "-fPIC" + "-O3" + "-o" output-file + input-file + "-lm")) + +(defmethod compiler-options ((compiler (eql :msvc)) (c elephant-c-source) &key input-file output-file) + (error "MSVC compiler option not supported yet")) + +;; LOAD + +(defmethod perform ((o load-op) (c elephant-c-source)) + ;; Load any required external libraries + (dolist (file+module (foreign-libraries-to-load-first c)) + (destructuring-bind (file . module) file+module + (or (uffi-funcall :load-foreign-library file :module module) + (error "Could not load ~A into ~A" file module)))) + ;; Load the compiled libraries + (dolist (file (output-files (make-instance 'compile-op) c)) + (format t "~A" file) + (or (uffi-funcall :load-foreign-library file :module (component-name c)) + (error "Could not load ~A" file)))) + +(defmethod operation-done-p ((o load-op) (c elephant-c-source)) + nil) + +(defmethod foreign-libraries-to-load-first ((c elephant-c-source)) + nil) + +;; +;; System definition +;; (defsystem elephant :name "elephant" @@ -90,13 +140,12 @@ :components ((:module memutil :components - ((:elephant-util-c-source "libmemutil") + ((:elephant-c-source "libmemutil") (:file "memutil")) :serial t) (:module elephant :components ((:file "package") - (:file "config" :pathname "../../config.lisp") (:file "variables") #+cmu (:file "cmu-mop-patches") #+openmcl (:file "openmcl-mop-patches") @@ -113,6 +162,5 @@ (:file "backend")) :serial t :depends-on (memutil))))) - :depends-on (:uffi :closer-mop)) - + :depends-on (:uffi)) From ieslick at common-lisp.net Sat Nov 11 06:27:38 2006 From: ieslick at common-lisp.net (ieslick) Date: Sat, 11 Nov 2006 01:27:38 -0500 (EST) Subject: [elephant-cvs] CVS elephant/src/elephant Message-ID: <20061111062738.7F39E71035@common-lisp.net> Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv5313/src/elephant Modified Files: controller.lisp package.lisp Log Message: Removed config.lisp and all Makefile related build options. The build is now entirely driven from the elephant.asd and ele-bdb.asd files with a simple user customization file, config.sexp, that should be copied to my-config.sexp and customized to the user's environment. Thanks to pinterface for the initial patch supporting this approach. Foreign library loading is also controlled from the asd files now at system load time rather than at compile time. --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2006/11/10 01:48:49 1.14 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2006/11/11 06:27:38 1.15 @@ -23,12 +23,6 @@ ;; TRACKING THE OBJECT STORE ;; -;; This list contains functions that take one arugment, -;; the "spec", and will construct an appropriate store -;; controller from it. - -;; Dynamic tracking of active connections - (defparameter *elephant-backends* '((:bdb (:ele-bdb)) (:clsql (:ele-clsql)) --- /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2006/09/04 00:09:15 1.2 +++ /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2006/11/11 06:27:38 1.3 @@ -28,7 +28,7 @@ (:export #:*store-controller* #:*current-transaction* #:*auto-commit* #:*elephant-lib-path* - #:store-controller + #:store-controller #:controller-root #:controller-class-root #:open-store #:close-store #:with-open-store #:add-to-root #:get-from-root #:remove-from-root #:root-existsp #:flush-instance-cache #:optimize-storage From ieslick at common-lisp.net Sat Nov 11 06:27:38 2006 From: ieslick at common-lisp.net (ieslick) Date: Sat, 11 Nov 2006 01:27:38 -0500 (EST) Subject: [elephant-cvs] CVS elephant/src/memutil Message-ID: <20061111062738.EE899751A1@common-lisp.net> Update of /project/elephant/cvsroot/elephant/src/memutil In directory clnet:/tmp/cvs-serv5313/src/memutil Modified Files: memutil.lisp Log Message: Removed config.lisp and all Makefile related build options. The build is now entirely driven from the elephant.asd and ele-bdb.asd files with a simple user customization file, config.sexp, that should be copied to my-config.sexp and customized to the user's environment. Thanks to pinterface for the initial patch supporting this approach. Foreign library loading is also controlled from the asd files now at system load time rather than at compile time. --- /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2006/11/10 01:48:49 1.10 +++ /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2006/11/11 06:27:38 1.11 @@ -63,19 +63,6 @@ (proclaim '(optimize (ext:inhibit-warnings 3)))) (eval-when (:compile-toplevel :load-toplevel) - (defparameter *c-library-extension* - #+(or darwin macosx) "dylib" - #-(or darwin macosx) "so") - - (unless - (uffi:load-foreign-library - (merge-pathnames - (make-pathname :name "libmemutil" :type *c-library-extension*) - (merge-pathnames "src/memutil/" - (asdf:component-pathname (asdf:find-system 'elephant)))) - :module "libmemutil") - (error "Couldn't load src/memutil/libmemutil.~A in!" *c-library-extension*)) - (def-type pointer-int (* :int)) (def-type pointer-void :pointer-void) (def-foreign-type array-or-pointer-char From ieslick at common-lisp.net Sat Nov 11 15:30:26 2006 From: ieslick at common-lisp.net (ieslick) Date: Sat, 11 Nov 2006 10:30:26 -0500 (EST) Subject: [elephant-cvs] CVS elephant Message-ID: <20061111153026.110AA36009@common-lisp.net> Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv27982 Modified Files: TODO Log Message: Type declaration fixes for openmcl --- /project/elephant/cvsroot/elephant/TODO 2006/11/11 06:27:37 1.27 +++ /project/elephant/cvsroot/elephant/TODO 2006/11/11 15:30:25 1.28 @@ -7,9 +7,9 @@ ----------------------------------------------------------- Bugs or Observations: -- 64-bit support (from Marco) -? MCL compatibility issues -- Windows support for asdf-based library builds? +x 64-bit support (from Marco) +x Windows support for asdf-based library builds? +x MCL 1.1 unicode support Stability: - Review all the NOTE comments in the code @@ -95,6 +95,7 @@ x Should we delete slot-values in the db when redefining classes, currently those values 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 0.6.2 - Advanded work, low-hanging fruit (Fall '06) -------------------------------------------------- From ieslick at common-lisp.net Sat Nov 11 15:30:26 2006 From: ieslick at common-lisp.net (ieslick) Date: Sat, 11 Nov 2006 10:30:26 -0500 (EST) Subject: [elephant-cvs] CVS elephant/src/db-clsql Message-ID: <20061111153026.42EFD36009@common-lisp.net> Update of /project/elephant/cvsroot/elephant/src/db-clsql In directory clnet:/tmp/cvs-serv27982/src/db-clsql Modified Files: sql-collections.lisp Log Message: Type declaration fixes for openmcl --- /project/elephant/cvsroot/elephant/src/db-clsql/sql-collections.lisp 2006/02/22 20:18:51 1.4 +++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-collections.lisp 2006/11/11 15:30:26 1.5 @@ -48,7 +48,7 @@ ;; in a different ordering is a nice feature to have here. (defclass sql-cursor (cursor) ((keys :accessor :sql-crsr-ks :initarg :sql-cursor-keys :initform '()) - (curkey :accessor :sql-crsr-ck :initarg :sql-cursor-curkey :initform -1 :type integer)) + (curkey :accessor :sql-crsr-ck :initarg :sql-cursor-curkey :initform -1 :type (or null integer))) (:documentation "A SQL cursor for traversing (primary) BTrees.")) (defmethod make-cursor ((bt sql-btree)) From ieslick at common-lisp.net Sat Nov 11 15:30:26 2006 From: ieslick at common-lisp.net (ieslick) Date: Sat, 11 Nov 2006 10:30:26 -0500 (EST) Subject: [elephant-cvs] CVS elephant/src/elephant Message-ID: <20061111153026.7BF2E36009@common-lisp.net> Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv27982/src/elephant Modified Files: controller.lisp serializer.lisp Log Message: Type declaration fixes for openmcl --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2006/11/11 06:27:38 1.15 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2006/11/11 15:30:26 1.16 @@ -184,7 +184,7 @@ ;; (defclass store-controller () - ((spec :type (or pathname string) + ((spec :type (or pathname string (simple-array character)) :accessor controller-spec :initarg :spec :documentation "Backend create functions should pass in :spec during make-instance") --- /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2006/09/05 03:23:17 1.12 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2006/11/11 15:30:26 1.13 @@ -362,7 +362,6 @@ (if maybe-package-name (intern name (find-package maybe-package-name)) (make-symbol name)))) - #+(or lispworks (and allegro ics)) ((= tag +ucs2-symbol+) (let ((name (buffer-read-ucs2-string bs (buffer-read-fixnum bs))) (maybe-package-name (%deserialize bs))) @@ -379,7 +378,6 @@ (make-symbol name)))) ((= tag +ucs1-string+) (buffer-read-ucs1-string bs (buffer-read-fixnum bs))) - #+(or lispworks (and allegro ics)) ((= tag +ucs2-string+) (buffer-read-ucs2-string bs (buffer-read-fixnum bs))) #+(and sbcl sb-unicode) @@ -399,7 +397,6 @@ ((= tag +ucs1-pathname+) (parse-namestring (or (buffer-read-ucs1-string bs (buffer-read-fixnum bs)) ""))) - #+(or lispworks (and allegro ics)) ((= tag +ucs2-pathname+) (parse-namestring (or (buffer-read-ucs2-string bs (buffer-read-fixnum bs)) ""))) From ieslick at common-lisp.net Sat Nov 11 15:33:33 2006 From: ieslick at common-lisp.net (ieslick) Date: Sat, 11 Nov 2006 10:33:33 -0500 (EST) Subject: [elephant-cvs] CVS elephant Message-ID: <20061111153333.6158B702EA@common-lisp.net> Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv28483 Modified Files: TODO Log Message: Type declaration fixes for openmcl; unwind accidental changes --- /project/elephant/cvsroot/elephant/TODO 2006/11/11 15:30:25 1.28 +++ /project/elephant/cvsroot/elephant/TODO 2006/11/11 15:33:33 1.29 @@ -9,7 +9,7 @@ Bugs or Observations: x 64-bit support (from Marco) x Windows support for asdf-based library builds? -x MCL 1.1 unicode support +x MCL 1.1 unicode support; rationalize other lisp support for unicode Stability: - Review all the NOTE comments in the code From ieslick at common-lisp.net Sat Nov 11 17:36:49 2006 From: ieslick at common-lisp.net (ieslick) Date: Sat, 11 Nov 2006 12:36:49 -0500 (EST) Subject: [elephant-cvs] CVS elephant/tests/testsleepycat Message-ID: <20061111173649.583A56F23E@common-lisp.net> Update of /project/elephant/cvsroot/elephant/tests/testsleepycat In directory clnet:/tmp/cvs-serv11931/testsleepycat Removed Files: PLACEHOLDER.txt README Log Message: Remove sleepycat names - first of a series of checkins From ieslick at common-lisp.net Sat Nov 11 17:37:11 2006 From: ieslick at common-lisp.net (ieslick) Date: Sat, 11 Nov 2006 12:37:11 -0500 (EST) Subject: [elephant-cvs] CVS elephant/tests/testbdb Message-ID: <20061111173711.DA1BA7615E@common-lisp.net> Update of /project/elephant/cvsroot/elephant/tests/testbdb In directory clnet:/tmp/cvs-serv12114/testbdb Log Message: Directory /project/elephant/cvsroot/elephant/tests/testbdb added to the repository From ieslick at common-lisp.net Sat Nov 11 18:41:10 2006 From: ieslick at common-lisp.net (ieslick) Date: Sat, 11 Nov 2006 13:41:10 -0500 (EST) Subject: [elephant-cvs] CVS elephant Message-ID: <20061111184110.59A58A0F1@common-lisp.net> 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"))))) From ieslick at common-lisp.net Sat Nov 11 18:41:10 2006 From: ieslick at common-lisp.net (ieslick) Date: Sat, 11 Nov 2006 13:41:10 -0500 (EST) Subject: [elephant-cvs] CVS elephant/src/db-bdb Message-ID: <20061111184110.E21EDA0F2@common-lisp.net> Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv20360/src/db-bdb Modified Files: bdb-collections.lisp bdb-controller.lisp bdb-transactions.lisp package.lisp Added Files: libberkeley-db.c libberkeley-db.def Removed Files: libsleepycat.c libsleepycat.def sleepycat.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-bdb/bdb-collections.lisp 2006/09/04 04:56:50 1.9 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2006/11/11 18:41:10 1.10 @@ -17,7 +17,7 @@ ;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;; -(in-package "SLEEPYCAT") +(in-package :db-bdb) (defclass bdb-btree (btree) () (:documentation "A BerkleyDB implementation of a BTree")) --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2006/09/05 03:23:16 1.12 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2006/11/11 18:41:10 1.13 @@ -17,7 +17,7 @@ ;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;; -(in-package "SLEEPYCAT") +(in-package :db-bdb) (defclass bdb-store-controller (store-controller) ((db :type (or null pointer-void) :accessor controller-db :initform '()) @@ -78,24 +78,24 @@ :auto-commit t :type DB-BTREE :create t :thread thread) (setf (controller-btrees sc) btrees) - (sleepycat::db-set-lisp-compare btrees) + (db-bdb::db-set-lisp-compare btrees) (db-open btrees :file "%ELEPHANT" :database "%ELEPHANTBTREES" :auto-commit t :type DB-BTREE :create t :thread thread) (setf (controller-indices sc) indices) - (sleepycat::db-set-lisp-compare indices) - (sleepycat::db-set-lisp-dup-compare indices) + (db-bdb::db-set-lisp-compare indices) + (db-bdb::db-set-lisp-dup-compare indices) (db-set-flags indices :dup-sort t) (db-open indices :file "%ELEPHANT" :database "%ELEPHANTINDICES" :auto-commit t :type DB-BTREE :create t :thread thread) (setf (controller-indices-assoc sc) indices-assoc) - (sleepycat::db-set-lisp-compare indices-assoc) - (sleepycat::db-set-lisp-dup-compare indices-assoc) + (db-bdb::db-set-lisp-compare indices-assoc) + (db-bdb::db-set-lisp-dup-compare indices-assoc) (db-set-flags indices-assoc :dup-sort t) (db-open indices-assoc :file "%ELEPHANT" :database "%ELEPHANTINDICES" :auto-commit t :type DB-UNKNOWN :thread thread :rdonly t) - (sleepycat::db-fake-associate btrees indices-assoc :auto-commit t) + (db-bdb::db-fake-associate btrees indices-assoc :auto-commit t) (let ((db (db-create env))) (setf (controller-oid-db sc) db) --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-transactions.lisp 2006/04/26 19:19:12 1.3 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-transactions.lisp 2006/11/11 18:41:10 1.4 @@ -17,7 +17,7 @@ ;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;; -(in-package "SLEEPYCAT") +(in-package :db-bdb) (defmethod execute-transaction ((sc bdb-store-controller) txn-fn &key @@ -60,7 +60,7 @@ (return result)))) finally (error "Too many retries in transaction")))) -;; (with-sleepycat-transaction (:transaction ,transaction +;; (with-bdb-transaction (:transaction ,transaction ;; :environment env ;; :parent ,parent ;; :degree-2 ,degree-2 --- /project/elephant/cvsroot/elephant/src/db-bdb/package.lisp 2006/02/19 04:53:00 1.1 +++ /project/elephant/cvsroot/elephant/src/db-bdb/package.lisp 2006/11/11 18:41:10 1.2 @@ -19,13 +19,13 @@ (in-package :cl-user) -(defpackage sleepycat - (:documentation "A low-level UFFI-based interface to - Berkeley DB / Sleepycat to implement the elephant front-end - framework. Uses the libsleepycat.c wrapper. Partly intended - to be usable outside Elephant, but with some magic for Elephant. - In general there is a 1-1 mapping from functions here and - functions in Sleepycat, so refer to their documentation for details.") +(defpackage db-bdb + (:documentation "A low-level UFFI-based interface to Berkeley + DB to implement the elephant front-end framework. Uses the + libelebdb.c wrapper. Partly intended to be usable outside + 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 elephant-backend) #+cmu (:use alien) --- /project/elephant/cvsroot/elephant/src/db-bdb/libberkeley-db.c 2006/11/11 18:41:10 NONE +++ /project/elephant/cvsroot/elephant/src/db-bdb/libberkeley-db.c 2006/11/11 18:41:10 1.1 /* ;;; ;;; libsleepycat.c -- C wrappers for Sleepycat for FFI ;;; ;;; Initial version 8/26/2004 by Ben Lee ;;; ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee ;;; ;;; ;;; This program is released under the following license ;;; ("GPL"). For differenct licensing terms, contact the ;;; copyright holders. ;;; ;;; This program is free software; you can redistribute it ;;; and/or modify it under the terms of the GNU General ;;; Public License as published by the Free Software ;;; Foundation; either version 2 of the License, or (at ;;; your option) any later version. ;;; ;;; This program is distributed in the hope that it will be ;;; useful, but WITHOUT ANY WARRANTY; without even the ;;; implied warranty of MERCHANTABILITY or FITNESS FOR A ;;; PARTICULAR PURPOSE. See the GNU General Public License ;;; for more details. ;;; ;;; The GNU General Public License can be found in the file ;;; LICENSE which should have been distributed with this ;;; code. It can also be found at ;;; ;;; http://www.opensource.org/licenses/gpl-license.php ;;; ;;; You should have received a copy of the GNU General ;;; Public License along with this program; if not, write ;;; to the Free Software Foundation, Inc., 59 Temple Place, ;;; Suite 330, Boston, MA 02111-1307 USA ;;; ;;; Portions of this program (namely the C unicode string ;;; sorter) are derived from IBM's ICU: ;;; ;;; http://oss.software.ibm.com/icu/ ;;; ;;; Copyright (c) 1995-2003 International Business Machines ;;; Corporation and others All rights reserved. ;;; ;;; ICU's copyright, license and warranty can be found at ;;; ;;; http://oss.software.ibm.com/cvs/icu/~checkout~/icu/license.html ;;; ;;; or in the file LICENSE. ;;; */ #include #include /* Some utility stuff used to be here but has been placed in libmemutil.c */ /* Pointer arithmetic utility functions */ /* should these be in network-byte order? probably not..... */ /* Pointer arithmetic utility functions */ /* should these be in network-byte order? probably not..... */ int read_int(char *buf, int offset) { int i; memcpy(&i, buf+offset, sizeof(int)); return i; } unsigned int read_uint(char *buf, int offset) { unsigned int ui; memcpy(&ui, buf+offset, sizeof(unsigned int)); return ui; } float read_float(char *buf, int offset) { float f; memcpy(&f, buf+offset, sizeof(float)); return f; } double read_double(char *buf, int offset) { double d; memcpy(&d, buf+offset, sizeof(double)); return d; } void write_int(char *buf, int num, int offset) { memcpy(buf+offset, &num, sizeof(int)); } void write_uint(char *buf, unsigned int num, int offset) { memcpy(buf+offset, &num, sizeof(unsigned int)); } void write_float(char *buf, float num, int offset) { memcpy(buf+offset, &num, sizeof(float)); } void write_double(char *buf, double num, int offset) { memcpy(buf+offset, &num, sizeof(double)); } char *offset_charp(char *p, int offset) { return p + offset; } void copy_buf(char *dest, int dest_offset, char *src, int src_offset, int length) { memcpy(dest + dest_offset, src + src_offset, length); } /* Berkeley DB stuff */ #include /* Environment */ /* All "creation" functions return the create object, not the errno. This simplifies FFI handling. */ /* These next two functions are also needed because in db42 these are #define macros */ DB_ENV *db_env_cr(u_int32_t flags, int *errno) { DB_ENV *envp; *errno = db_env_create(&envp, flags); return envp; } char * db_strerr(int error) { return db_strerror(error); } int db_env_close(DB_ENV *env, u_int32_t flags) { return env->close(env, flags); } int db_env_open(DB_ENV *env, char *home, u_int32_t flags, int mode) { return env->open(env, home, flags, mode); } int db_env_dbremove(DB_ENV *env, DB_TXN *txnid, char *file, char *database, u_int32_t flags) { return env->dbremove(env, txnid, file, database, flags); } int db_env_dbrename(DB_ENV *env, DB_TXN *txnid, char *file, char *database, char *newname, u_int32_t flags) { return env->dbrename(env, txnid, file, database, newname, flags); } int db_env_remove(DB_ENV *env, char *home, u_int32_t flags) { return env->remove(env, home, flags); } int db_env_set_flags(DB_ENV *dbenv, u_int32_t flags, int onoff) { return dbenv->set_flags(dbenv, flags, onoff); } int db_env_get_flags(DB_ENV *dbenv, u_int32_t *flagsp) { return dbenv->get_flags(dbenv, flagsp); } /* Database */ DB *db_cr(DB_ENV *dbenv, u_int32_t flags, int *errno) { DB *dbp; *errno = db_create(&dbp, dbenv, flags); return dbp; } int db_close(DB *db, u_int32_t flags) { return db->close(db, flags); } int db_open(DB *db, DB_TXN *txnid, char *file, char *database, DBTYPE type, u_int32_t flags, int mode) { return db->open(db, txnid, file, database, type, flags, mode); } int db_remove(DB *db, char *file, char *database, u_int32_t flags) { return db->remove(db, file, database, flags); } int db_rename(DB *db, char *file, char *database, char *newname, u_int32_t flags) { return db->rename(db, file, database, newname, flags); } int db_sync(DB *db, u_int32_t flags) { return db->sync(db, flags); } int db_truncate(DB *db, DB_TXN *txnid, u_int32_t *countp, u_int32_t flags) { return db->truncate(db, txnid, countp, flags); } int db_set_flags(DB *db, u_int32_t flags) { return db->set_flags(db, flags); } int db_get_flags(DB *db, u_int32_t *flagsp) { return db->get_flags(db, flagsp); } int db_set_pagesize(DB *db, u_int32_t pagesize) { return db->set_pagesize(db, pagesize); } int db_get_pagesize(DB *db, u_int32_t *pagesizep) { return db->get_pagesize(db, pagesizep); } int db_set_bt_compare(DB *db, int (*bt_compare_fcn)(DB *db, const DBT *dbt1, const DBT *dbt2)) { return db->set_bt_compare(db, bt_compare_fcn); } int db_set_dup_compare(DB *db, int (*dup_compare_fcn)(DB *db, const DBT *dbt1, const DBT *dbt2)) { return db->set_dup_compare(db, dup_compare_fcn); } #define type_numeric(c) ((c)<8) #include double read_num(char *buf); int case_cmp(const char *a, int32_t length1, const char *b, int32_t length2); int lex_cmp(const char *a, int32_t length1, const char *b, int32_t length2); int utf16_cmp(const char *s1, int32_t length1, const char *s2, int32_t length2); /* Inspired by the BDB docs. We have to memcpy to insure memory alignment. */ int lisp_compare(DB *dbp, const DBT *a, const DBT *b) { int difference; double ddifference; char *ad, *bd, at, bt; ad = (char*)a->data; bd = (char*)b->data; /* Compare OIDs. */ difference = read_int(ad, 0) - read_int(bd, 0); if (difference) return difference; /* Have a type tag? */ if (a->size == 4) if (b->size == 4) return 0; else return -1; else if (b->size == 4) return 1; at = ad[4]; bt = bd[4]; /* Compare numerics. */ if (type_numeric(at) && type_numeric(bt)) { ddifference = read_num(ad+4) - read_num(bd+4); if (ddifference > 0) return 1; else if (ddifference < 0) return -1; return 0; } /* Compare types. */ difference = at - bt; if (difference) return difference; /* Same type! */ switch (at) { case 8: /* nil */ return 0; case 9: /* 8-bit symbol */ case 10: /* 8-bit string */ case 11: /* 8-bit pathname */ return case_cmp(ad+9, read_int(ad, 5), bd+9, read_int(bd, 5)); case 12: /* 16-bit symbol */ case 13: /* 16-bit string */ case 14: /* 16-bit pathname */ return utf16_cmp(ad+9, read_int(ad, 5), bd+9, read_int(bd, 5)); case 20: case 21: case 22: return wcs_cmp(ad+9, read_int(ad, 5), bd+9, read_int(bd, 5)); default: return lex_cmp(ad+5, (a->size)-5, bd+5, (b->size)-5); } } int db_set_lisp_compare(DB *db) { return db->set_bt_compare(db, &lisp_compare); } int db_set_lisp_dup_compare(DB *db) { return db->set_dup_compare(db, &lisp_compare); } #ifndef exp2 #define exp2(c) (pow(2,(c))) #endif double read_num(char *buf) { char *limit; double i, result, denom; switch (buf[0]) { case 1: case 2: return (double)read_int(buf, 1); case 3: return (double)read_float(buf, 1); case 4: return read_double(buf, 1); case 5: result = 0; buf += 5; limit = buf + read_uint(buf, -4); for(i=0 ; buf < limit; i++, buf = buf+4) { result -= exp2(i*32) * read_uint(buf, 0); } return result; case 6: result = 0; buf += 5; limit = buf + read_uint(buf, -4); for(i=0 ; buf < limit; i++, buf = buf+4) { result += exp2(i*32) * read_uint(buf, 0); } return result; case 7: default: switch ((++buf)[0]) { case 1: result = (double)read_int(++buf, 0); buf += 4; break; case 5: result = 0; buf += 5; limit = buf + read_uint(buf, -4); for(i=0 ; buf < limit; i++, buf = buf+4) { result -= exp2(i*32) - read_uint(buf, 0); } break; case 6: default: result = 0; buf += 5; limit = buf + read_uint(buf, -4); for(i=0 ; buf < limit; i++, buf = buf+4) { result += exp2(i*32) * read_uint(buf, 0); } break; } switch (buf[0]) { case 1: return result / read_int(++buf, 0); case 5: denom = 0; buf += 5; limit = buf + read_uint(buf, -4); for(i=0 ; buf < limit; i++, buf = buf+4) { denom -= exp2(i*32) * read_uint(buf, 0); } return result / denom; case 6: default: denom = 0; buf += 5; limit = buf + read_uint(buf, -4); for(i=0 ; buf < limit; i++, buf = buf+4) { denom += exp2(i*32) * read_uint(buf, 0); } return result / denom; } } } #ifdef WIN32 #define strncasecmp _strnicmp typedef unsigned short uint16_t; #endif int case_cmp(const char *a, int32_t length1, const char *b, int32_t length2) { int min, sizediff, diff; sizediff = length1 - length2; min = sizediff > 0 ? length2 : length1; diff = strncasecmp(a, b, min); if (diff == 0) return sizediff; return diff; } int wcs_cmp(const wchar_t *a, int32_t length1, [627 lines skipped] --- /project/elephant/cvsroot/elephant/src/db-bdb/libberkeley-db.def 2006/11/11 18:41:10 NONE +++ /project/elephant/cvsroot/elephant/src/db-bdb/libberkeley-db.def 2006/11/11 18:41:10 1.1 [700 lines skipped] From ieslick at common-lisp.net Sat Nov 11 18:41:11 2006 From: ieslick at common-lisp.net (ieslick) Date: Sat, 11 Nov 2006 13:41:11 -0500 (EST) Subject: [elephant-cvs] CVS elephant/src/db-clsql Message-ID: <20061111184111.379C014007@common-lisp.net> 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 ;;; ;;; ;;; 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)) From ieslick at common-lisp.net Sat Nov 11 18:41:11 2006 From: ieslick at common-lisp.net (ieslick) Date: Sat, 11 Nov 2006 13:41:11 -0500 (EST) Subject: [elephant-cvs] CVS elephant/src/memutil Message-ID: <20061111184111.6A01D14008@common-lisp.net> 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 ;;; From ieslick at common-lisp.net Sat Nov 11 18:41:11 2006 From: ieslick at common-lisp.net (ieslick) Date: Sat, 11 Nov 2006 13:41:11 -0500 (EST) Subject: [elephant-cvs] CVS elephant/tests Message-ID: <20061111184111.B40A414007@common-lisp.net> 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 ;;; ;;; ;;; 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)))) |# From ieslick at common-lisp.net Sat Nov 11 18:41:14 2006 From: ieslick at common-lisp.net (ieslick) Date: Sat, 11 Nov 2006 13:41:14 -0500 (EST) Subject: [elephant-cvs] CVS elephant/tests/testbdb Message-ID: <20061111184114.0CB761E06F@common-lisp.net> 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. From ieslick at common-lisp.net Sat Nov 11 18:43:31 2006 From: ieslick at common-lisp.net (ieslick) Date: Sat, 11 Nov 2006 13:43:31 -0500 (EST) Subject: [elephant-cvs] CVS elephant/src/db-bdb Message-ID: <20061111184331.2B5B21E001@common-lisp.net> 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 ;;; ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee ;;; ;;; ;;; 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 , at flags , at 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 , at 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 , at 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] From ieslick at common-lisp.net Sat Nov 11 18:45:04 2006 From: ieslick at common-lisp.net (ieslick) Date: Sat, 11 Nov 2006 13:45:04 -0500 (EST) Subject: [elephant-cvs] CVS elephant Message-ID: <20061111184504.7FE452B13C@common-lisp.net> 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 ;;; ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee ;;; ;;; ;;; This program is released under the following license ;;; ("LLGPL"). ;;; (defsystem ele-postgresql :name "ele-postgresql" :author "Robert L. Read " :version "0.6.0" :maintainer "Robert L. Read " :licence "GPL" :description "PostgreSQL based Object respository for Common Lisp" :components ((:module :src :components ())) :depends-on (:ele-clsql :clsql-postgresql-socket)) From ieslick at common-lisp.net Sat Nov 11 22:53:13 2006 From: ieslick at common-lisp.net (ieslick) Date: Sat, 11 Nov 2006 17:53:13 -0500 (EST) Subject: [elephant-cvs] CVS elephant/src/elephant Message-ID: <20061111225313.861477615E@common-lisp.net> 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 From ieslick at common-lisp.net Sat Nov 11 22:53:13 2006 From: ieslick at common-lisp.net (ieslick) Date: Sat, 11 Nov 2006 17:53:13 -0500 (EST) Subject: [elephant-cvs] CVS elephant/src/memutil Message-ID: <20061111225313.BEE847615E@common-lisp.net> 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) From ieslick at common-lisp.net Sat Nov 11 22:53:13 2006 From: ieslick at common-lisp.net (ieslick) Date: Sat, 11 Nov 2006 17:53:13 -0500 (EST) Subject: [elephant-cvs] CVS elephant/tests Message-ID: <20061111225313.EE43F76282@common-lisp.net> 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")