[elephant-cvs] CVS elephant/src/db-bdb
ieslick
ieslick at common-lisp.net
Mon Jan 22 22:22:35 UTC 2007
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 at common-lisp.net>
;;;
;;; part of
;;;
;;; Elephant: an object-oriented database for Common Lisp
;;;
;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee
;;; <ablumberg at common-lisp.net> <blee at 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*)))
More information about the Elephant-cvs
mailing list