Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv32683
Modified Files: bdb-symbol-tables.lisp berkeley-db.lisp Added Files: bdb-slots.lisp Log Message: Added missing file
--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-symbol-tables.lisp 2007/01/19 21:03:29 1.1 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-symbol-tables.lisp 2007/01/22 22:22:35 1.2 @@ -34,18 +34,18 @@ the persistent tables." (reset-buffer-stream valbuf) ;; Just to avoid any contamination ;; (with-transaction (:txn-nosync t :dirty-read t) - (format t "getting next symid") +;; (format t "getting next symid") (let ((id (next-symid sc))) ;; allocate a new unique id ;; Update symbol->id table - (format t "Writing sym->id: ~A -> ~A~%" symbol id) +;; (format t "Writing sym->id: ~A -> ~A~%" symbol id) (buffer-write-int id valbuf) - (format t "Putting id into table location~%") +;; (format t "Putting id into table location~%") (db-put-buffered (controller-btrees sc) keybuf valbuf :auto-commit *auto-commit*) ;; Write id->symbol table (reset-buffer-stream keybuf) (reset-buffer-stream valbuf) - (format t "Writing id->sym: ~A -> ~A~%" id symbol) +;; (format t "Writing id->sym: ~A -> ~A~%" id symbol) (buffer-write-int *id-to-symbol-table-oid* keybuf) (buffer-write-int id keybuf) (serialize-symbol-complete symbol valbuf) @@ -59,13 +59,13 @@ (defmethod lookup-persistent-symbol ((sc bdb-store-controller) id) "Lookup the ID associated with a symbol" (with-buffer-streams (keybuf valbuf) - (format t "Looking up: ~A~%" id) +;; (format t "Looking up: ~A~%" id) (buffer-write-int *id-to-symbol-table-oid* keybuf) (buffer-write-int id keybuf) - (format t "Get for id: ~A~%" id) +;; (format t "Get for id: ~A~%" id) (let ((buf (db-get-key-buffered (controller-btrees sc) keybuf valbuf))) - (format t "Got buf: ~A~%" buf) +;; (format t "Got buf: ~A~%" buf) (if buf (values (deserialize buf sc) T) (error "Invalid ID - no persistent mapping for ID")))))
--- /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2007/01/20 22:12:17 1.3 +++ /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2007/01/22 22:22:35 1.4 @@ -19,7 +19,9 @@
(in-package :db-bdb)
-(declaim (inline %db-get-key-buffered db-get-key-buffered +(declaim + #-elephant-without-optimize (optimize (speed 3) (safety 0)) + (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 @@ -617,8 +619,7 @@ a buffer-stream. Space for the value is passed in as a buffer-stream. On success the buffer-stream is returned for decoding, or NIL if nothing was found." - (declare (optimize (speed 3) (safety 0)) - (type pointer-void db transaction) + (declare (type pointer-void db transaction) (type buffer-stream key-buffer-stream value-buffer-stream) (type boolean auto-commit get-both degree-2 read-committed dirty-read read-uncommitted)) (loop @@ -668,8 +669,7 @@ string. Space for the value is passed in as a buffer-stream. On success the buffer-stream is returned for decoding, or NIL if nothing was found." - (declare (optimize (speed 3) (safety 0)) - (type pointer-void db transaction) + (declare (type pointer-void db transaction) (type string key) (type buffer-stream value-buffer-stream) (type fixnum key-size) @@ -708,8 +708,7 @@ "Get a key / value pair from a DB. The key is passed as a string, and the value is returned as a string. If nothing is found, NIL is returned." - (declare (optimize (speed 3) (safety 0)) - (type pointer-void db transaction) + (declare (type pointer-void db transaction) (type string key) (type fixnum key-size) (type boolean auto-commit get-both degree-2 read-committed @@ -759,8 +758,7 @@ "Put a key / value pair into a DB. The pair are encoded in buffer-streams. T on success, or nil if the key already exists and EXISTS-ERROR-P is NIL." - (declare (optimize (speed 3) (safety 0)) - (type pointer-void db transaction) + (declare (type pointer-void db transaction) (type buffer-stream key-buffer-stream value-buffer-stream) (type boolean auto-commit exists-error-p)) (let ((errno @@ -794,8 +792,7 @@ (value-size (length value)) (transaction *current-transaction*)) :cstrings (key value) - :declarations (declare (optimize (speed 3) (safety 0)) - (type pointer-void db transaction) + :declarations (declare (type pointer-void db transaction) (type string key value) (type fixnum key-size value-size) (type boolean auto-commit)) @@ -816,8 +813,7 @@ "Delete a key / value pair from a DB. The key is encoded in a buffer-stream. T on success, NIL if the key wasn't found." - (declare (optimize (speed 3) (safety 0)) - (type pointer-void db transaction) + (declare (type pointer-void db transaction) (type buffer-stream key-buffer-stream) (type boolean auto-commit)) (let ((errno (%db-delete-buffered db transaction @@ -846,8 +842,7 @@ (transaction *current-transaction*)) "Delete a key / value pair from a DB. The key is a string. T on success, NIL if the key wasn't found." - (declare (optimize (speed 3) (safety 0)) - (type pointer-void db transaction) (type string key) + (declare (type pointer-void db transaction) (type string key) (type fixnum key-size) (type boolean auto-commit)) (with-cstrings ((key key)) (let ((errno @@ -878,8 +873,7 @@ duplicates. The key and value are encoded as buffer-streams. T on success, NIL if the key / value pair wasn't found." - (declare (optimize (speed 3) (safety 0)) - (type pointer-void db transaction) + (declare (type pointer-void db transaction) (type buffer-stream key-buffer-stream value-buffer-stream)) (let ((errno (%db-delete-kv db transaction (buffer-stream-buffer key-buffer-stream) @@ -913,8 +907,7 @@
(defun db-compact (db start stop end &key (transaction *current-transaction*) freelist-only free-space) - (declare (optimize (speed 3) (safety 2)) - (type pointer-void db transaction) + (declare (type pointer-void db transaction) (type buffer-stream start stop) (type boolean freelist-only free-space)) (loop @@ -953,8 +946,7 @@ (defun db-cursor (db &key (transaction *current-transaction*) degree-2 read-committed dirty-read read-uncommitted) "Create a cursor." - (declare (optimize (speed 3) (safety 0)) - (type pointer-void db) + (declare (type pointer-void db) (type boolean degree-2 read-committed dirty-read read-uncommitted) (type pointer-int *errno-buffer*)) (let* ((curs (%db-cursor db transaction (flags :degree-2 (or degree-2 read-committed) @@ -979,8 +971,7 @@
(defun db-cursor-delete (cursor) "Delete by cursor." - (declare (optimize (speed 3) (safety 0)) - (type pointer-void cursor)) + (declare (type pointer-void cursor)) (let ((errno (%db-cursor-delete cursor 0))) (declare (type fixnum errno)) (cond ((= errno 0) t) @@ -1000,8 +991,7 @@
(defun db-cursor-duplicate (cursor &key (position t)) "Duplicate a cursor." - (declare (optimize (speed 3) (safety 0)) - (type pointer-void cursor)) + (declare (type pointer-void cursor)) (let* ((newc (%db-cursor-dup cursor (flags :position position) *errno-buffer*)) (errno (deref-array *errno-buffer* '(:array :int) 0))) @@ -1031,8 +1021,7 @@ "Move a cursor, returning the key / value pair found. Supports current, first, last, next, next-dup, next-nodup, prev, prev-nodup." - (declare (optimize (speed 3) (safety 0)) - (type pointer-void cursor) + (declare (type pointer-void cursor) (type buffer-stream key-buffer-stream value-buffer-stream) (type boolean current first last next next-dup next-nodup prev prev-nodup dirty-read read-uncommitted)) @@ -1077,8 +1066,7 @@ &key set set-range dirty-read read-uncommitted) "Move a cursor to a key, returning the key / value pair found. Supports set and set-range." - (declare (optimize (speed 3) (safety 0)) - (type pointer-void cursor) + (declare (type pointer-void cursor) (type buffer-stream key-buffer-stream value-buffer-stream) (type boolean set set-range dirty-read read-uncommitted)) (loop @@ -1118,8 +1106,7 @@ &key get-both get-both-range dirty-read read-uncommitted) "Move a cursor to a key / value pair, returning the key / value pair found. Supports get-both and get-both-range." - (declare (optimize (speed 3) (safety 0)) - (type pointer-void cursor) + (declare (type pointer-void cursor) (type buffer-stream key-buffer-stream value-buffer-stream) (type boolean get-both get-both-range dirty-read read-uncommitted)) (loop @@ -1180,8 +1167,7 @@ "Move a secondary cursor, returning the key / value / primary triple found. Supports current, first, last, next, next-dup, next-nodup, prev, prev-nodup." - (declare (optimize (speed 3) (safety 0)) - (type pointer-void cursor) + (declare (type pointer-void cursor) (type buffer-stream key-buffer-stream pkey-buffer-stream value-buffer-stream) (type boolean current first last next next-dup next-nodup prev @@ -1236,8 +1222,7 @@ &key set set-range dirty-read) "Move a secondary cursor tp a key, returning the key / value / primary triple found. Supports set, set-range." - (declare (optimize (speed 3) (safety 0)) - (type pointer-void cursor) + (declare (type pointer-void cursor) (type buffer-stream key-buffer-stream pkey-buffer-stream value-buffer-stream) (type boolean set set-range dirty-read)) @@ -1288,8 +1273,7 @@ "Move a secondary cursor tp a key / primary pair, returning the key / value / primary triple found. Supports get, get-range." - (declare (optimize (speed 3) (safety 0)) - (type pointer-void cursor) + (declare (type pointer-void cursor) (type buffer-stream key-buffer-stream pkey-buffer-stream value-buffer-stream) (type boolean get-both get-both-range dirty-read)) @@ -1346,8 +1330,7 @@ &key after before current keyfirst keylast no-dup-data exists-error-p) "Put by cursor. The key and value are encoded as buffer-streams." - (declare (optimize (speed 3) (safety 0)) - (type pointer-void cursor) + (declare (type pointer-void cursor) (type buffer-stream key-buffer-stream value-buffer-stream) (type boolean after before current keyfirst keylast no-dup-data exists-error-p)) @@ -1385,8 +1368,7 @@ degree-2 read-committed dirty-read read-uncommitted txn-nosync txn-nowait txn-sync) "Start a transaction. Transactions may be nested." - (declare (optimize (speed 3) (safety 0)) - (type pointer-void env parent) + (declare (type pointer-void env parent) (type boolean degree-2 read-committed dirty-read read-uncommitted txn-nosync txn-nowait txn-sync) (type pointer-int *errno-buffer*)) @@ -1411,8 +1393,7 @@
(wrap-errno (db-transaction-abort %db-txn-abort) (transaction) :keys ((transaction *current-transaction*)) - :declarations (declare (optimize (speed 3) (safety 0)) - (type pointer-void transaction)) + :declarations (declare (type pointer-void transaction)) :documentation "Abort a transaction.")
(def-function ("db_txn_commit" %db-txn-commit) @@ -1423,8 +1404,7 @@ (wrap-errno (db-transaction-commit %db-txn-commit) (transaction flags) :keys ((transaction *current-transaction*)) :flags (txn-nosync txn-sync) - :declarations (declare (optimize (speed 3) (safety 0)) - (type pointer-void transaction) + :declarations (declare (type pointer-void transaction) (type boolean txn-nosync txn-sync)) :documentation "Commit a transaction.")
@@ -1523,7 +1503,6 @@
(defun db-transaction-id (&optional (transaction *current-transaction*)) "Returns the ID of the transaction (for locking purposes.)" - (declare (optimize (speed 3))) (%db-transaction-id transaction))
(def-function ("db_env_lock_id" %db-env-lock-id) @@ -1715,8 +1694,7 @@
(defun db-sequence-create (db) "Create a new sequence." - (declare (optimize (speed 3) (safety 0)) - (type pointer-void db) + (declare (type pointer-void db) (type pointer-int *errno-buffer*)) (let* ((seq (%db-sequence-create db 0 *errno-buffer*)) @@ -1763,8 +1741,7 @@ (defun db-sequence-get (sequence delta &key auto-commit txn-nosync (transaction *current-transaction*)) "Get the next element." - (declare (optimize (speed 3) (safety 0)) - (type pointer-void sequence transaction) + (declare (type pointer-void sequence transaction) (type fixnum delta) (type boolean auto-commit txn-nosync)) (multiple-value-bind @@ -1792,8 +1769,7 @@ (defun db-sequence-get-fixnum (sequence delta &key auto-commit txn-nosync (transaction *current-transaction*)) "Get the next element as a fixnum." - (declare (optimize (speed 3) (safety 0)) - (type pointer-void sequence transaction) + (declare (type pointer-void sequence transaction) (type fixnum delta) (type boolean auto-commit txn-nosync)) (multiple-value-bind
--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-slots.lisp 2007/01/22 22:22:35 NONE +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-slots.lisp 2007/01/22 22:22:35 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; bdb-slots.lisp -- Implement the slot protocol ;;; ;;; Initial version 8/26/2004 by Ben Lee ;;; blee@common-lisp.net ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee ;;; ablumberg@common-lisp.net blee@common-lisp.net ;;; ;;; Elephant users are granted the rights to distribute and use this software ;;; as governed by the terms of the Lisp Lesser GNU Public License ;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;
(in-package :db-bdb)
;; ;; Persistent slot protocol implementation ;;
(defmethod persistent-slot-reader ((sc bdb-store-controller) instance name) ;; (declare (optimize (speed 3) (safety 1) (space 1))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (oid instance) key-buf) (serialize name key-buf sc) (let ((buf (db-get-key-buffered (controller-db sc) key-buf value-buf))) (if buf (deserialize buf sc) #+cmu (error 'unbound-slot :instance instance :slot name) #-cmu (error 'unbound-slot :instance instance :name name)))))
(defmethod persistent-slot-writer ((sc bdb-store-controller) new-value instance name) ;; (declare (optimize (speed 3) (safety 1) (space 1))) ;; (format t "psw -- sc: ~A ct: ~A ac: ~A~%" *store-controller* *current-transaction* *auto-commit*) (with-buffer-streams (key-buf value-buf) (buffer-write-int (oid instance) key-buf) (serialize name key-buf sc) (serialize new-value value-buf sc) (db-put-buffered (controller-db sc) key-buf value-buf :transaction *current-transaction* :auto-commit *auto-commit*) new-value))
(defmethod persistent-slot-boundp ((sc bdb-store-controller) instance name) ;; (declare (optimize (speed 3) (safety 1) (space 1))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (oid instance) key-buf) (serialize name key-buf sc) (let ((buf (db-get-key-buffered (controller-db sc) key-buf value-buf))) (if buf t nil))))
(defmethod persistent-slot-makunbound ((sc bdb-store-controller) instance name) ;; (declare (optimize (speed 3) (safety 1) (space 1))) (with-buffer-streams (key-buf) (buffer-write-int (oid instance) key-buf) (serialize name key-buf sc) (db-delete-buffered (controller-db sc) key-buf :transaction *current-transaction* :auto-commit *auto-commit*)))