February 2007 - elephant-cvs@common-lisp.net

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

08 Feb '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv2451/src/elephant Modified Files: migrate.lisp package.lisp serializer1.lisp Removed Files: serializer2-locks.lisp Log Message: Checkpoint checkin of db-lisp --- /project/elephant/cvsroot/elephant/src/elephant/migrate.lisp 2006/04/26 17:53:44 1.4 +++ /project/elephant/cvsroot/elephant/src/elephant/migrate.lisp 2007/02/08 23:07:18 1.5 @@ -129,7 +129,8 @@ ;; indexed persistent objects which (see below) are not copied by default ;; so we do the slot updates here (map-btree (lambda (classname classidx) - ;; Class indexes should never be copied already + ;; Class indexes should never be copied already; this checks + ;; for users breaking the class-index abstraction (assert (not (object-was-copied-p classidx))) (let ((newcidx (with-transaction (:store-controller dst) @@ -145,9 +146,9 @@ ;; Add the class index to the class root (with-transaction (:store-controller dst) (setf (get-value classname (controller-class-root dst)) newcidx)) - ;; Update the class to point at all it's new objects in the new store + ;; Update the class to point at objects in the new store (setf (%index-cache (find-class classname)) newcidx) - ;; Migrate the indexes' objects + ;; Migrate the index objects (copy-cindex-contents newcidx classidx) ;; And remember the class index just incase it's indexed elswhere ;; (and trips the assert above) --- /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2007/02/04 04:34:57 1.11 +++ /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2007/02/08 23:07:19 1.12 @@ -37,6 +37,8 @@ #:controller-fast-symbols-p #:optimize-storage + #:upgrade + #:controller-version #:controller-serializer-version #:controller-serialize #:controller-deserialize #:serialize-database-version-key --- /project/elephant/cvsroot/elephant/src/elephant/serializer1.lisp 2007/02/05 03:18:22 1.6 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer1.lisp 2007/02/08 23:07:19 1.7 @@ -291,6 +291,7 @@ (type buffer-stream bs)) (let ((tag (buffer-read-byte bs))) (declare (type foreign-char tag)) + (format t "Tag: ~A~%" tag) (cond ((= tag +fixnum+) (buffer-read-fixnum bs))

1 0

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

08 Feb '07

Update of /project/elephant/cvsroot/elephant/src/memutil In directory clnet:/tmp/cvs-serv2451/src/memutil Modified Files: memutil.lisp Log Message: Checkpoint checkin of db-lisp --- /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2007/02/03 14:07:01 1.21 +++ /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2007/02/08 23:07:19 1.22 @@ -41,6 +41,8 @@ #:reset-buffer-stream #:buffer-stream-buffer #:buffer-stream-length #:buffer-stream-size + #:buffer-read-to-array-offset #:buffer-write-from-array-offset + #:buffer-write-byte #:buffer-write-float #:buffer-write-double #:buffer-write-string #:buffer-write-int32 #:buffer-write-uint32 @@ -700,6 +702,26 @@ (dotimes (i writable bs) (buffer-write-byte (aref bv i) bs)))) +(defun buffer-read-to-array-offset (arry offset bs) + "Buffer relative; read contents of buffer-stream and write them into array at offset" + (declare (type buffer-stream bs) + (type fixnum offset)) + (let* ((position (buffer-stream-position bs)) + (size (buffer-stream-size bs)) + (vlen (- size position))) + (if (>= vlen 0) + (dotimes (i vlen arry) + (setf (aref arry (+ i offset)) + (buffer-read-byte bs)))))) + +(defun buffer-write-from-array-offset (arry offset length bs) + "Buffer relative; write array contents into buffer stream" + (declare (type fixnum offset) + (type buffer-stream bs)) + (dotimes (i length arry) + (buffer-write-byte (aref arry (+ i offset)) bs))) + + ;; ;; Compatibility ;;

1 0

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

08 Feb '07

Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv2451 Modified Files: TODO UPGRADE-BDB Log Message: Checkpoint checkin of db-lisp --- /project/elephant/cvsroot/elephant/TODO 2007/02/05 19:33:10 1.45 +++ /project/elephant/cvsroot/elephant/TODO 2007/02/08 23:07:18 1.46 @@ -9,12 +9,12 @@ ALPHA RELEASE TASKS Bug and feature fixes: +- Validate migration 0.6.0->0.6.1 +- Fix cur-del2 failure under SBCL (robert to reproduce and fix) ~ Resolve duplicate sorting guarantee in btree interface; currently supported - by BDB but not SQL and it is not tested in the regression suite (Robert) + by BDB but not SQL and it is not tested in the regression suite (Robert to comment) - Fix *dbconnection-spec* to support multiple controllers for multiple threads - for CLSQL backend -- Validate migration 0.6.0->0.6.1 -- Fix cur-del2 failure under SBCL + for CLSQL backend (Robert) BDB Features/Cleanup: - Trace all paths to db-put or db-delete and ensure that there is a check or a @@ -57,7 +57,6 @@ - Ensure that variable length UTF-8 is automatically stored as UTF-16 Documentation: -- Migrate code base to Darcs and create tickets in TRAC - Add notes about with/ensure-transaction usage (abort & commit behavior on exit) - Add notes about optimize-storage - Add notes about deadlock-detect @@ -128,6 +127,9 @@ 0.6.2 - Advanded work, low-hanging fruit (Summer '07) -------------------------------------------------- + +Migrate code base to Darcs and create feature/bug tickets in TRAC + Storage and Indexing: - Add :inverse-reader to slot options to create a named method that indexes into objects based on slot values. Is this a GF or defun? Do we dispatch on class name or bake it in? @@ -175,7 +177,22 @@ 0.7.0: Native Lisp Backend (beta), Fast In-Memory Operations ------------------------------------------------------------ - Full support for DCM or integration of DCM functionality - - Integrate prevalence-like in-memory database system for single image, multiple-thread operation + - Integrate prevalence-like in-memory database system for single image, + multiple-thread operation + - Richer set of policy decisions on per-class basis + - Concurrent mode (for backends that allow multiple processes to connect, current default) + - Single-user mode (cache values in instance slots for fast reads, write-through) + - Backing store mode (read/write to normal slots except on object creation or synch) + (in-memory slot indexing, on disk class) + (works for any backend) + - Backing-store mode + - Controller 'switches' + - NoSynch - allow transactions to be lost on failure but maintains consistency + instead of performance + - Upgrade overall functionality + - Solid garbage collection strategy + - 64-bit oids / 64-bit file sizes + - class templates stored and cached - (From Ben's e-mail) We are storing persistent objects incorrectly. They should be stored only as OIDs, and we should have a separate OID->class table. This way change-class can be handled correctly. This also non-trivially compresses storage @@ -183,24 +200,16 @@ [Ian comment: only problem with this is an extra access to oid table each time a class is deserialized and overall storage is constant. Would make it easy to invalidate objects though!] - - Richer set of policy decisions on per-class basis - - Concurrent mode (for backends that allow multiple processes to connect, current default) - - Single-user mode (cache values in instance slots for fast reads, write-through) - - Backing store mode (read/write to normal slots except on object creation or synch) - (in-memory slot indexing, on disk class) - (works for any backend) - - Backing-store mode - - Controller 'switches' - - NoSynch - allow transactions to be lost on failure but maintains consistency instead of performance - Usage model examples -0.7.1 - Elephant/BDB/SQL Production Release +0.7.1 - Elephant BDB/SQL/Lisp Production Release -------------------------------------------------- - More work on testing, examples and documentation - Intent is for this to be a major, long-term supported release prior to work on the new backend (i.e. patches against this release for bugs rather than only available in latest development tree) + 0.8.0 - Supporting Tools Release -------------------------------------------------- - Add special support (if any) for persistent graph structures & queries --- /project/elephant/cvsroot/elephant/UPGRADE-BDB 2006/09/04 00:09:11 1.1 +++ /project/elephant/cvsroot/elephant/UPGRADE-BDB 2007/02/08 23:07:18 1.2 @@ -1,46 +1,42 @@ -Version 0.6.0 of Elephant using the BDB backend depends on Berkeley DB 4.3. As for September 3rd, 2006, -the current CVS is now dependant on Berkeley DB 4.4. If you already have a database based on 0.6.0 or a HEAD prior to September 3rd, you'll need to take the following steps to upgrade your BDB databases to work with my latest checkin. +Elephant 0.6.1 depends on Berkeley DB 4.5. -(NOTE: Allegro users may have additional work to do, please check e-mail logs on this topic) +------------------------------------ +Upgrading from 0.6 / Berkeley DB 4.3 +------------------------------------ -1) Install BDB 4.4.20 or later just as you installed BDB 4.3 +1) Install BDB 4.5 (keep 4.3 around for now) -2) Pull the latest HEAD from CVS +2) Update my-config.sexp to point to the appropriate BDB 4.5 directories -3) Update config.lisp and Makefile in elephant root to point to the appropriate directories +3) Upgrade your database directory to 4.5 -4) Rebuild elephant C libraries +3a) Run db43_recover in your 0.6 database +3b) Optional: run db43_archive -d to remove all logs not part of a checkpoint + This will make catastrophic recovery impossible, but reduces the amount of data you + have to backup. +3c) Backup your db files and remaining logs +3d) Run db45_checkpoint -1 in your 0.6 database directory -In the root directory: -> make clean -> make -> make bdb +4) Migrate 0.6 data to a new 0.6.1 database -5) Upgrade your database directory (only log files need updating) +4a) Open your old database: (setf sc (open-store '(:BDB "/Users/me/db/ele060/"))) +4b) Run upgrade: (upgrade sc '(:BDB "/Users/me/db/ele061/")) -From Sleepycat documentation: +5) Test your new application and report any bugs that arise to elephant-devel(a)common-lisp.net - 1. Shut down the old version of the application. - 2. Run recovery on the database environment using the DB_ENV->open method or the db_recover utility. - 3. Remove any Berkeley DB environment using the DB_ENV->remove method or an appropriate system utility. - 4. Archive the database environment for catastrophic recovery. See Archival procedures for more information. - 5. Recompile and install the new version of the application. - 6. Force a checkpoint using the DB_ENV->txn_checkpoint method or the db_checkpoint utility. - 7. Restart the application. +NOTE 1: close-store may fail when closing the old 0.6 database, this is OK +NOTE 2: 64-bit lisps will not successfully upgrade 32-bit 0.6 databases. Use a 32-bit + version of your lisp to update to 0.6.1 and then open that database in your 64-bit + lisp. There should be no compatibility problems. Best to test your application on + a 32-bit lisp if you can, just to be sure. -A known good procedure: +------------------------------------ +Upgrading from 0.5 / Berkeley DB 4.3 +------------------------------------ - 1. Cleanly exit lisp/elephant application - 2. Run 'db_recover' in database directory using 4.3 tools - 3. This will remove the environment - 3.b (optional) Run 'db_checkpoint -1' and 'db_archive -d' to checkpoint and update db files to latest log. This will - snapshot the DB and allow you to backup less data, but it makes catastrophic recovery to any time - before the snapshot impossible as you are deleting history with the '-d' option so exclude that if you - are conservative or aren't sure what you're doing. - 4. Copy your database files and all log files to a backup - 5. Run 'db_checkpoint -1' using 4.4 tools (ignore error message) - 6. Restart lisp, reload application and ensure that the latest elephant source has been fully recompiled +Follow the upgrade procedures outlined in Elephant 0.6.0 to migrate your database +from 0.5 to 0.6. Then follow the above procedures for upgradeing from an 0.6 database. -6) Connect to your DB, all should be well! - -This procedure worked for my Mac OS X upgrade from BDB 4.3 using the latest HEAD on a very large, complex DB. +NOTE: It may not take much work to make 0.6.1 upgrade directly from 0.5.0. However +there are so few 0.5.0 users that it wasn't deemed worth the work given that +there's an upgrade path available. \ No newline at end of file

1 0

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

08 Feb '07

Update of /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp In directory clnet:/tmp/cvs-serv2282/contrib/eslick/db-lisp Modified Files: btree.lisp package.lisp pages.lisp Log Message: Removing vestigial directory --- /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/btree.lisp 2007/02/08 15:57:19 1.2 +++ /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/btree.lisp 2007/02/08 23:05:46 1.3 @@ -7,7 +7,8 @@ '((0 . :unknown) (1 . :index) (2 . :leaf) - (3 . :blob))) + (3 . :overflow) + (#xFF . :root))) (defun get-type (byte) (assert (<= byte (car (last *type-table*)))) @@ -41,9 +42,27 @@ ;; Indexes: ;; +type = root +endian-tag = 0xDAF00F00 (32-bit) +db_version = 0-6-1 (48 bit) +free-data-block = page-ptr (32-bits) +num-keys - int32 + +type = index +num-keys - int32 +serialized-key - buffer-stream +page-pointer (int32-page) +serialized-key - buffer-stream +page-pointer (int32-page) +... +type - leaf +num-elts - ;; User Operations: +;; btree-open +(defun open-btree-file (path &key page-size (create t)) + ;; btree-create ;; btree-search --- /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/package.lisp 2007/02/08 15:57:19 1.2 +++ /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/package.lisp 2007/02/08 23:05:46 1.3 @@ -3,9 +3,3 @@ (defpackage :db-lisp (:use :cl :elephant :elephant-backend :elephant-memutil)) -;; file - open/close binary files -;; octet-stream - read/write binary buffers -;; binary-fields - macro package for reading/writing lisp arrays -;; pages - binary pages read/written to and from stream; simple metadata -;; includes a simple LRU page-caching scheme using linked-lists -;; btree - btrees implemented on top of pages --- /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/pages.lisp 2007/02/08 15:57:19 1.1 +++ /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/pages.lisp 2007/02/08 23:05:46 1.2 @@ -1,6 +1,31 @@ (in-package :db-lisp) ;; +;; Utilities +;; + +(defun copy-slots (obj1 obj2 slotnames) + (loop for slotname in slotnames do + (setf (slot-value obj2 slotname) (slot-value obj1 slotname)))) + +(defun write-integer-to-array (integer array offset &optional (bytes 4)) + (declare (type fixnum offset bytes) + (type integer integer) + (type (array (unsigned-byte 8)) array)) + (loop for i fixnum from 0 below bytes do + (setf (aref array (+ offset i)) + (ldb (byte 8 (* i 8)) integer)))) + +(defun read-integer-from-array (array offset &optional (bytes 4)) + (declare (type fixnum offset bytes) + (type (array (unsigned-byte 8)) array)) + (let ((value 0)) + (loop for i fixnum from 0 below bytes do + (setf value (dpb (aref array (+ i offset)) (byte 8 (* i 8)) value))) + value)) + + +;; ;; Mixins ;; @@ -53,14 +78,15 @@ ;; Primitive read-write of buffer-pages ;; -;; ;; Read/Write fixnums -;; -(defun write-fixnum (page offset fix &optional (bytes 4)) - (loop for i from 0 below bytes do - (setf (aref (page-buffer page) (+ offset i)) - (ldb (byte 8 (* i 8)) fix)))) +(defmethod write-integer (fixnum page offset &optional (bytes 4)) + (declare (type fixnum fixnum offset bytes)) + (write-fixnum-to-array fixnum (page-buffer page) offset bytes)) + +(defmethod read-integer (page offset &optional (bytes 4)) + (declare (type fixnum offset bytes)) + (read-integer-from-array (page-buffer page) offset bytes)) ;; NOTE: Redo memutil/serializer primitives here? @@ -182,9 +208,11 @@ (defmethod cache-page ((pool buffer-pool) page) (push page (gethash (page-position page) (pool-hash pool)))) +;; ------------------------------------------------------------------------ ;; ;; User cache operations ;; +;; ------------------------------------------------------------------------ (defmethod get-page ((pool buffer-pool) stream position) (touch-page

1 0

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

08 Feb '07

Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv2282/db-bdb Modified Files: bdb-collections.lisp Log Message: Removing vestigial directory --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2007/02/04 10:08:27 1.16 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2007/02/08 23:05:46 1.17 @@ -306,17 +306,17 @@ (defmethod cursor-first ((cursor bdb-cursor)) (let ((sc (get-con (cursor-btree cursor)))) - (with-buffer-streams (key-buf value-buf) - (buffer-write-oid (cursor-oid cursor) key-buf) - (multiple-value-bind (key val) - (db-cursor-set-buffered (cursor-handle cursor) - key-buf value-buf :set-range t) - (if (and key (= (buffer-read-oid key) (cursor-oid cursor))) - (progn (setf (cursor-initialized-p cursor) t) - (values t - (deserialize key sc) - (deserialize val sc))) - (setf (cursor-initialized-p cursor) nil)))))) + (with-buffer-streams (key-buf value-buf) + (buffer-write-oid (cursor-oid cursor) key-buf) + (multiple-value-bind (key val) + (db-cursor-set-buffered (cursor-handle cursor) + key-buf value-buf :set-range t) + (if (and key (= (buffer-read-oid key) (cursor-oid cursor))) + (progn (setf (cursor-initialized-p cursor) t) + (values t + (deserialize key sc) + (deserialize val sc))) + (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-last ((cursor bdb-cursor)) "A fast cursor last, but a bit 'hackish' by exploiting oid ordering"

1 0

[elephant-cvs] CVS elephant/src/db-clsql
by rread 08 Feb '07

08 Feb '07

Update of /project/elephant/cvsroot/elephant/src/db-clsql In directory clnet:/tmp/cvs-serv26423/src/db-clsql Modified Files: sql-collections.lisp sql-controller.lisp Log Message: More robust upgrade mechanism, one bug fix, better user of PK --- /project/elephant/cvsroot/elephant/src/db-clsql/sql-collections.lisp 2007/02/02 23:51:58 1.9 +++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-collections.lisp 2007/02/08 22:33:35 1.10 @@ -526,7 +526,7 @@ (let ((cur-pk (get-current-key cursor))) (decf (:sql-crsr-ck cursor)) (if (equal cur-pk (get-current-key cursor)) - (decf (:dp-nmbr cursor)) + (setf (:dp-nmbr cursor) (max 0 (- (:dp-nmbr cursor) 1))) (setf (:dp-nmbr cursor) (sql-get-from-clcn-cnt (cursor-oid cursor) (get-current-key cursor) @@ -593,12 +593,13 @@ (setf (:sql-crsr-ck cursor) (- (length (:sql-crsr-ks cursor)) 1)) (setf (:dp-nmbr cursor) + (max 0 (- (sql-get-from-clcn-cnt (cursor-oid cursor) (get-current-key cursor) (get-con (cursor-btree cursor)) ) - 1)) + 1))) (assert (>= (:dp-nmbr cursor) 0)) (setf (cursor-initialized-p cursor) t) (has-key-value-scnd cursor :returnpk returnpk) @@ -615,10 +616,11 @@ (progn (setf (:sql-crsr-ck cursor) (- (:sql-crsr-ck cursor) (+ 1 (:dp-nmbr cursor)))) (setf (:dp-nmbr cursor) + (max 0 (- (sql-get-from-clcn-cnt (cursor-oid cursor) (get-current-key cursor) (get-con (cursor-btree cursor)) -) 1)) + ) 1))) (has-key-value-scnd cursor :returnpk returnpk)) (cursor-last-x cursor :returnpk returnpk))) --- /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp 2007/02/07 22:54:12 1.17 +++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp 2007/02/08 22:33:35 1.18 @@ -34,13 +34,13 @@ ( ;; (db :accessor controller-db :initarg :db :initform nil) (dbcons :accessor controller-db-table :initarg :db :initform nil) + (uses-pk :accessor uses-pk-of :initarg :uses-pk) ) (:documentation "Class of objects responsible for the book-keeping of holding DB handles, the cache, table creation, counters, locks, the root (for garbage collection,) et cetera. This is the Postgresql-specific subclass of store-controller.")) - ;; This should be much more elegant --- but as of Feb. 6, SBCL 1.0.2 has a weird, ;; unpleasant bug when ASDF tries to load this stuff. ;; (defvar *thread-table-lock* nil) @@ -300,6 +300,20 @@ (clsql:table-exists-p [keyvalue] :database con :owner :all) ) +;; Our goal here is to see if the "pk" column exists.... +;; if it does, we can use a certain optimization the sql-get-from-clcn-nth. +;; Post 6.1 versions should have it, but 6.0 versions won't. +;; My goal here is to be as robust as possible; there is no portable way +;; to add a column nicely. If you want to upgrade (which will really only +;; help if you use duplicate keys), then do a migration from your old repository +;; to a new repository. +(defun query-uses-pk (con) + ;; we want to use ":owner :all" because we don't really care who created + ;; the table, as long as we have the rights we need! + (member "pk" (clsql:list-attributes [keyvalue] :database con :owner :all) + :test 'equal) + ) + ;; This is just an initial version; it is possible that ;; we might someday wish to use blobs instead; certainly, I am @@ -320,6 +334,8 @@ ;; CREATE-SEQUENCE and SEQUENCE-NEXT. That would solve our problem! ;; ALL OF THIS needs to be inside a transaction. + +;; At one time this was conditional, but all NEW repositories should have this. (clsql::create-sequence [serial] :database con) (clsql::query (format nil "create table keyvalue ( @@ -329,19 +345,17 @@ value varchar )") :database con) +;; (clsql::create-table [keyvalue] +;; ;; This is most likely to work with any database system.. +;; '( +;; ([clctn_id] integer :not-null) +;; ([key] text :not-null) +;; ([value] text) +;; ) +;; :database con) - ;; (clsql::create-table [keyvalue] - - ;; ;; This is most likely to work with any database system.. - ;; '( - ;; ([clctn_id] integer :not-null) - ;; ([key] text :not-null) - ;; ([value] text) - ;; ) - ;; :database con) - - ;; :constraints '("PRIMARY KEY (clctn_id key)" - ;; "UNIQUE (clctn_id,key)") +;; :constraints '("PRIMARY KEY (clctn_id key)" +;; "UNIQUE (clctn_id,key)") ;; apparently in postgres this is failing pretty awfully because ;; sequence-exists-p return nil and then we get an error that the sequence exists! @@ -412,8 +426,9 @@ ;; Now we should make sure that the KEYVALUE table exists, and, if ;; it does not, we need to create it.. (unless (keyvalue-table-exists con) - (with-transaction (:store-controller sc) - (create-keyvalue-table con))) + (with-transaction (:store-controller sc) + (create-keyvalue-table con))) + (setf (uses-pk-of sc) (query-uses-pk con)) (unless (version-table-exists con) (with-transaction (:store-controller sc) (create-version-table con))) @@ -450,8 +465,6 @@ (defmethod reconnect-controller ((sc sql-store-controller)) (clsql:reconnect :database (controller-db sc) :force nil) -;; (setf (controller-db sc) -;; (clsql:reconnect :database (controller-db sc))) ) (defmethod close-controller ((sc sql-store-controller)) @@ -543,17 +556,21 @@ (let* ((con (controller-db sc)) (kbs (serialize-to-base64-string key sc)) - (offsetquery (format nil "select value from keyvalue where clctn_id = ~A and key = '~A' order by pk offset ~A limit 1 " - clcn - kbs - n)) + (offsetquery (if (uses-pk-of sc) + (format nil "select value from keyvalue where clctn_id = ~A and key = '~A' order by pk offset ~A limit 1 " + clcn + kbs + n) + nil)) (tuples - (clsql::query offsetquery :database con) -;; (clsql::select [value] -;; :from [keyvalue] -;; :where [and [= [clctn_id] clcn] [= [key] kbs]] -;; :database con -;; ) + (if (uses-pk-of sc) + (clsql::query offsetquery :database con) + (clsql::select [value] + :from [keyvalue] + :where [and [= [clctn_id] clcn] [= [key] kbs]] + :database con + ) + ) ) ) ;; Get the lowest value by sorting and taking the first value; @@ -565,21 +582,22 @@ ;; that efficiently without changing the database structure; ;; but that's OK, I could add a column to support that ;; relatively easily later on. - (if tuples - (values (deserialize-from-base64-string (caar tuples) sc) - t) - (values nil nil)) - -;; (if (< n (length tuples)) -;; (values (nth n (sort -;; (mapcar -;; #'(lambda (x) -;; (deserialize-from-base64-string (car x) sc)) -;; tuples) -;; #'my-generic-less-than)) -;; t) -;; (values nil nil)) -)) + (if (uses-pk-of sc) + (if tuples + (values (deserialize-from-base64-string (caar tuples) sc) + t) + (values nil nil)) + (if (< n (length tuples)) + (values (nth n (sort + (mapcar + #'(lambda (x) + (deserialize-from-base64-string (car x) sc)) + tuples) + #'my-generic-less-than)) + t) + (values nil nil)) + ) + )) (defun sql-get-from-clcn-cnt (clcn key sc) (assert (integerp clcn)) @@ -597,11 +615,20 @@ (assert (integerp clcn)) (let* ((con (controller-db sc)) (tuples - (clsql::select [pk] [key] [value] + (if (uses-pk-of sc) + (clsql::select [pk] [key] [value] :from [keyvalue] :where [and [= [clctn_id] clcn]] :database con - ))) + ) + (clsql::select [key] [value] + :from [keyvalue] + :where [and [= [clctn_id] clcn]] + :database con + ) + ) + ) + ) (mapcar #'(lambda (x) (mapcar #'(lambda (q) (deserialize-from-base64-string q :sc sc)) x)) tuples))) @@ -678,24 +705,11 @@ (if (or (null to-remove) (my-generic-less-than (car tuple) to-remove)) (setf to-remove (car tuple)))) - ;; (nth 0 (sort - ;; (mapcar - ;; #'(lambda (x) - ;; (deserialize-from-base64-string (car x) :sc sc)) - ;; tuples) - ;; #'my-generic-less-than))))) - ;; (format t "to-remove = ~A~%" to-remove) (clsql::delete-records :from [keyvalue] :where [and [= [clctn_id] clcn] [= [key] kbs] [= [value] to-remove]] :database con ) - ;; (format t "After deletion = ~A~%" - ;; (clsql::select [value] - ;; :from [keyvalue] - ;; :where [and [= [clctn_id] clcn] [= [key] kbs]] - ;; :database con - ;; )) ) ) )

1 0

[elephant-cvs] CVS elephant/tests
by rread 08 Feb '07

08 Feb '07

Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv26423/tests Modified Files: testindexing.lisp Log Message: More robust upgrade mechanism, one bug fix, better user of PK --- /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2007/02/07 22:54:13 1.25 +++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2007/02/08 22:33:35 1.26 @@ -204,9 +204,6 @@ (defclass idx-five-del () ((slot1 :initarg :slot1 :initform 1 :accessor slot1)) (:metaclass persistent-metaclass)) - (format t "r1 = ~A~%" r1) - (format t "r1 = ~A~%" (get-index (get-value 'idx-five-del (elephant::controller-class-root *store-controller*)) - 'slot1)) (values (eq (length r1) 1) (signals-error (get-instances-by-value 'idx-five-del 'slot1 1))

1 0

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

08 Feb '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv28359 Modified Files: serializer2.lisp Log Message: Last of Henrik's changes --- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/08 15:51:01 1.19 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/08 15:58:26 1.20 @@ -165,7 +165,7 @@ (%serialize (frob) (etypecase frob (fixnum - (if (< #.most-positive-fixnum +2^32+) ;; should be compiled away + (if (< #.most-positive-fixnum +2^31+) ;; should be compiled away (progn (buffer-write-byte +fixnum32+ bs) (buffer-write-int32 frob bs))

1 0

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

08 Feb '07

Update of /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp In directory clnet:/tmp/cvs-serv28034 Modified Files: TODO btree.lisp file.lisp octet-stream.lisp package.lisp Added Files: pages.lisp Removed Files: buffers.lisp Log Message: Working changes for db-lisp backend --- /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/TODO 2007/02/04 10:17:20 1.1 +++ /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/TODO 2007/02/08 15:57:19 1.2 @@ -1,4 +1,34 @@ +High level lisp backend design: +- Page storage, layout policy; lisp array or foreign data? + - key length limits + - ordering functions + - secondary index functions +- Locking policy (in-memory) + - blocking or optimistic concurrency + - how to signal +- Transaction ids +- Logging transactions and side effects + +Performance considerations: +- Slot access is usually local to objects +- Variable length objects are fundamental +- How to handle large blobs? + +Foreign array blocks? Faster copies, +avoid GC overhead, easy to write to +disk, static type, fast pointer ops. + +Aligned data types to simplify pointers + +Index pages (btree catalogs) +Object pages (sequences of slots) +Blob pages + +PTHREAD mutex speed + +=========================== + A lisp backend will need: - read/write binary sequences - move/cache binary pages to/from disk --- /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/btree.lisp 2007/02/04 10:17:20 1.1 +++ /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/btree.lisp 2007/02/08 15:57:19 1.2 @@ -1,2 +1,55 @@ (in-package :db-lisp) +;; Data layout +;; - page types: index, leaf, blobs + +(defparameter *type-table* + '((0 . :unknown) + (1 . :index) + (2 . :leaf) + (3 . :blob))) + +(defun get-type (byte) + (assert (<= byte (car (last *type-table*)))) + (cdr (assoc byte *type-table*))) + +(defun get-type-id (type-symbol) + (loop for (id symbol) in *type-table* do + (when (eq type-symbol symbol) + (return id)) + finally (error "Invalid page type identifier"))) + +;; +;; Read/Write references +;; + +;; +;; Page headers +;; + +(defun read-page-header (page) + (with-buffer-streams (header) + (buffer-write-from-array-offset (page-buffer page) 0 1 header) + (setf (page-type page) (get-type (buffer-read-byte header))))) + +(defun write-page-header (page) + (with-buffer-streams (header) + (buffer-write-byte (get-type-id (page-type page)) header) + (buffer-read-to-array-offset (page-buffer page) 0 header))) + +;; +;; Indexes: +;; + + + +;; User Operations: +;; btree-create + +;; btree-search +;; btree-insert + +;; Internal operations: +;; btree-split-child +;; btree-insert-nonfull + --- /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/file.lisp 2007/02/04 10:17:20 1.1 +++ /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/file.lisp 2007/02/08 15:57:19 1.2 @@ -2,17 +2,17 @@ (in-package :db-lisp) (defclass binary-file () - ((stream :initarg :stream :initform nil - :accessor binary-file-stream))) + ((path :initarg :path :initarg "" :accessor binary-file-path) + (stream :initarg :stream :accessor binary-file-stream))) -(defun open-binary-file (dir name &optional (if-does-not-exist :create)) - (let ((stream (open (make-pathname :directory dir :name name) +(defun open-binary-file (path &optional (if-does-not-exist :create)) + (let ((stream (open path :direction :io :element-type '(unsigned-byte 8) :if-exists :overwrite :if-does-not-exist if-does-not-exist))) (when stream - (make-instance 'binary-file :stream stream)))) + (make-instance 'binary-file :path path :stream stream)))) -(defmethod close-file ((bf binary-file)) +(defmethod close-binary-file ((bf binary-file)) (close (binary-file-stream bf))) --- /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/octet-stream.lisp 2007/02/04 10:17:20 1.1 +++ /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/octet-stream.lisp 2007/02/08 15:57:19 1.2 @@ -174,7 +174,7 @@ (make-instance 'octet-output-stream :buffer (make-array 128 :element-type '(unsigned-byte 8)))) -(defclass octet-io-stream (octet-output-stream octet-input-stream) +(defclass octet-io-stream (octet-output-stream octet-input-stream) ((limit :accessor limit-p :initarg :limit))) (defmethod #.*stream-write-byte-function* ((stream octet-io-stream) integer) --- /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/package.lisp 2007/02/04 10:17:20 1.1 +++ /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/package.lisp 2007/02/08 15:57:19 1.2 @@ -1,72 +1,11 @@ (in-package :cl-user) -(defpackage :rucksack-elephant - (:use :cl :rucksack) - (:export - ;; controller - #:open-rucksack #:close-rucksack #:with-rucksack #:current-rucksack - #:rucksack #:standard-rucksack - #:rucksack-cache - #:rucksack-directory - #:rucksack-commit #:rucksack-rollback - #:add-rucksack-root #:map-rucksack-roots #:rucksack-roots - #:commit #:rollback - ;; class indexing -;; #:add-class-index #:add-slot-index -;; #:remove-class-index #:remove-slot-index -;; #:map-class-indexes #:map-slot-indexes - #:rucksack-add-class-index #:rucksack-add-slot-index - #:rucksack-make-class-index - #:rucksack-remove-class-index #:rucksack-remove-slot-index - #:rucksack-class-index #:rucksack-slot-index - #:rucksack-map-class-indexes #:rucksack-map-slot-indexes - #:rucksack-maybe-index-changed-slot #:rucksack-maybe-index-new-object - #:rucksack-map-class #:rucksack-map-slot - ;; Transactions -;; #:current-transaction -;; #:transaction-start #:transaction-commit #:transaction-rollback -;; #:with-transaction -;; #:transaction #:standard-transaction -;; #:transaction-start-1 #:transaction-commit-1 -;; #:transaction-id - ;; Conditions - #:rucksack-error #:simple-rucksack-error #:transaction-conflict - #:btree-error #:btree-search-error #:btree-insertion-error - #:btree-key-already-present-error #:btree-type-error - #:btree-error-btree #:btree-error-key #:btree-error-value - ;; Heaps - #:heap #:free-list-heap #:mark-and-sweep-heap #:simple-free-list-heap - #:open-heap #:close-heap - #:heap-stream #:heap-end - ;; BTree IF -;; #:btree - #:btree-key< #:btree-key= #:btree-value= - #:btree-max-node-size #:btree-unique-keys-p - #:btree-key-type #:btree-value-type - #:btree-node-class #:btree-node - ;; Indexes - #:map-index #:index-insert #:index-delete #:make-index - ;; BTrees - #:btree-search #:btree-insert -;; #:map-btree - - ;; Objects -;; #:persistent-object - #:persistent-data #:persistent-array #:persistent-cons - #:object-id - #:p-cons #:p-array - #:p-eql - #:p-car #:p-cdr #:p-list - #:p-make-array #:p-aref #:p-array-dimensions - #:p-length #:p-find #:p-replace #:p-position - )) - (defpackage :db-lisp - (:use :cl :elephant :elephant-backend :rucksack-elephant)) + (:use :cl :elephant :elephant-backend :elephant-memutil)) -;; file -;; octet-stream -;; binary-data -;; binary-types -;; buffers -;; btree +;; file - open/close binary files +;; octet-stream - read/write binary buffers +;; binary-fields - macro package for reading/writing lisp arrays +;; pages - binary pages read/written to and from stream; simple metadata +;; includes a simple LRU page-caching scheme using linked-lists +;; btree - btrees implemented on top of pages --- /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/pages.lisp 2007/02/08 15:57:20 NONE +++ /project/elephant/cvsroot/elephant/src/contrib/eslick/db-lisp/pages.lisp 2007/02/08 15:57:20 1.1 (in-package :db-lisp) ;; ;; Mixins ;; (defclass doubly-linked-list-mixin () ((next :accessor dlist-next :initform nil) (prev :accessor dlist-prev :initform nil))) (defmethod link-node ((node doubly-linked-list-mixin) before after) "Insert page into doubly linked list" (unless (null before) (setf (dlist-next before) node)) (setf (dlist-next node) after) (setf (dlist-prev node) before) (unless (null after) (setf (page-prev after) ndoe)) node) (defmethod unlink-node ((node doubly-linked-list-mixin)) "Remove page from linked list; return next" (unless (null (dlist-next node)) (setf (dlist-prev (dlist-next node)) (dlist-prev node))) (unless (null (dlist-prev node)) (setf (dlist-next (dlist-prev node)) (dlist-next node))) node) ;; ============================================================================ ;; ;; Buffer-Page -- Maintains a page of binary data ;; ;; ============================================================================ (defclass buffer-page (doubly-linked-list-mixin) ((position :accessor page-position :initarg :position :initform -1) ;; position (type :accessor page-type :initarg :type :initform :unknown) (size :accessor page-size :initarg :page-size :initform 4096) (dirty-p :accessor page-dirty-p :initform nil) (buffer :accessor page-buffer :type (simple-array (unsigned-byte 8) (*))) (stream :accessor page-stream-store)) (:documentation "A buffer-page is an in-memory buffer containing the contents of a random access stream (usually a file).")) (defmethod initialize-instance :after ((page buffer-page) &rest initargs) (declare (ignore initargs)) (setf (page-buffer page) (make-array (page-size page) :element-type '(unsigned-byte 8)))) ;; ;; Primitive read-write of buffer-pages ;; ;; ;; Read/Write fixnums ;; (defun write-fixnum (page offset fix &optional (bytes 4)) (loop for i from 0 below bytes do (setf (aref (page-buffer page) (+ offset i)) (ldb (byte 8 (* i 8)) fix)))) ;; NOTE: Redo memutil/serializer primitives here? (defmethod copy-page ((page1 buffer-page) (page2 buffer-page)) (copy-slots page1 page2 '(position type size dirty-p stream)) (loop for (i fixnum) from 0 below (page-size page2) do (setf (aref (page-buffer page2) i) (aref (page-buffer page1) i)))) ;; ;; Read-write buffer-pages from buffer-streams ;; (defmethod write-buffer-stream ((page buffer-page) (bs buffer-stream) offset) "Put contents of buffer stream into the page at offset; return the buffer-stream" (buffer-read-to-array-offset (page-buffer page) offset bs) bs) (defmethod read-buffer-stream ((page buffer-page) (bs buffer-stream) offset length) "Put array contents at offset into buffer-stream and return stream" (declare (type fixnum offset length)) (buffer-write-from-array-offset (page-buffer page) offset length bs) bs) ;; ;; Page-level IO with backing stream store ;; (defmethod associate-page ((page associated-buffer-page) (stream stream) position) (setf (page-file-position page) position) (setf (page-stream-store page) stream)) (defmethod seek-to-page ((page buffer-page)) (file-position (page-stream page) (page-position page))) (defmethod load-page ((page buffer-page)) (seek-to-page page) (read-sequence (page-buffer page) str)) (defmethod flush-page ((page buffer-page)) (seek-to-page page) (write-sequence (page-buffer page) str)) (defmethod zero-page ((page buffer-page) &optional (value 0)) (loop for i from 0 upto (1- (length (page-buffer page))) do (setf (aref (page-buffer page) i) value)) page) ;; ============================================================================ ;; ;; Caching buffer pool ;; ;; ============================================================================ (defparameter *default-buffer-pool-pages* 4000) (defparameter *default-page-size* 4096) (defclass buffer-pool () ((lock :accessor pool-lock :initarg :lock :initform nil) (page-count :accessor pool-pages :initarg :pages :initform *default-buffer-pool-pages*) (page-size :accessor pool-page-size :initarg :page-size :initform *default-page-size*) (free-list :accessor pool-free-list :initform nil) (active-list :accessor pool-active-list :initform nil) (least-recently-used :accessor pool-lru-page :initform nil) (hash :accessor pool-hash :initform nil))) (defmethod initialize-instance :after ((pool buffer-pool) &rest rest) "Create a set of pages to populate the pool" (declare (ignore rest)) (labels ((make-page () (make-instance 'buffer-page :page-size (pool-page-size pool)))) (unless (= (pool-pages pool) 0) (setf (pool-free-list pool) (make-page))) (let ((prior (pool-free-list pool))) (dotimes (i (pool-pages pool) pool) (setf prior (link-page (make-page) prior nil)))))) ;; ;; Pool level operations ;; (defmethod eject-page ((pool buffer-pool)) "Eject the least recently used, unwritten page, from the cache" (assert (not (null (pool-lru-page pool)))) (let ((lru (pool-lru-page pool))) (setf (pool-lru-page pool) (dlist-prev (unlink-page lru))) (loop until (or (null lru) (not (dirty-p lru))) do (setf lru (dlist-prev lru))) (when (null lru) (error "No unwritten pages available to eject! Memory exhausted!")) lru)) (defun pop-free-list (pool) (let ((page (pool-free-list pool))) (setf (pool-free-list pool) (dlist-next page)) (unlink-node page))) (defun push-free-list (page pool) (link-node page nil (pool-free-list pool)) (setf (pool-free-list pool) page)) (defun push-active-list (page pool) (link-node page nil (pool-active-list pool)) (setf (pool-active-list pool) page)) (defun touch-page (page pool) (push-active-list (unlink-node page))) (defmethod get-empty-page ((pool buffer-pool) position) (if (null (pool-free-list pool)) (eject-page pool) (pop-free-list pool))) (defmethod lookup-page ((pool buffer-pool) position stream) (let ((pages (gethash position (pool-hash pool)))) (find stream pages :key #'page-stream-store))) (defmethod cache-page ((pool buffer-pool) page) (push page (gethash (page-position page) (pool-hash pool)))) ;; ;; User cache operations ;; (defmethod get-page ((pool buffer-pool) stream position) (touch-page (or (lookup-page pool) (cache-page pool (load-page (associate-page (get-empty-page pool) stream position)))) pool))

1 0

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

08 Feb '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv27108 Modified Files: serializer2.lisp Log Message: Missing checking from Henrik's changes --- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/05 19:33:11 1.18 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/08 15:51:01 1.19 @@ -21,9 +21,6 @@ #+cmu (:import-from :bignum %bignum-ref) - #+sbcl - (:import-from :sb-bignum - %bignum-ref) (:import-from :elephant *circularity-initial-hash-size* get-cached-instance @@ -44,7 +41,7 @@ (inline serialize deserialize slots-and-values deserialize-bignum - #+(or sbcl cmu) %bignum-ref))) + #+cmu %bignum-ref))) (uffi:def-type foreign-char :char) @@ -329,14 +326,14 @@ (buffer-write-byte +positive-bignum+ bs)) (buffer-write-int needed bs) (loop for i fixnum from 0 below word-size - ;; this ldb is consing on CMUCL! + ;; this ldb is consing on CMUCL/OpenMCL! ;; there is an OpenMCL function which should work ;; and non-cons do - #+(or cmu sbcl) - (buffer-write-uint (%bignum-ref num i) bs) - #+(or lispworks openmcl allegro) - (buffer-write-uint (ldb (byte 32 (* 32 i)) num) bs) + #+cmu + (buffer-write-uint32 (%bignum-ref num i) bs) ;; should fail under 64-bit CMU + #-cmu + (buffer-write-uint32 (ldb (byte 32 (* 32 i)) num) bs) ))) ;;;

1 0