[elephant-cvs] CVS elephant/src/contrib/eslick/db-lisp
ieslick
ieslick at common-lisp.net
Thu Feb 8 15:57:20 UTC 2007
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))
More information about the Elephant-cvs
mailing list