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))