[functional-tests] change btree functions to take a spine.
Also change the step-spine interface slightly.
This commit is contained in:
@@ -43,14 +43,15 @@
|
||||
(define super-block-only #f)
|
||||
|
||||
(define (dump-dev-tree cache root)
|
||||
(btree-each (btree-open device-details-vt cache root)
|
||||
(lambda (k v)
|
||||
(fmt #t
|
||||
"dev-id: " k "\n"
|
||||
" mapped blocks: " (ftype-ref ThinDeviceDetails (mapped-blocks) v) "\n"
|
||||
" transaction id: " (ftype-ref ThinDeviceDetails (transaction-id) v) "\n"
|
||||
" creation time: " (ftype-ref ThinDeviceDetails (creation-time) v) "\n"
|
||||
" snapshotted time: " (ftype-ref ThinDeviceDetails (snapshotted-time) v) "\n"))))
|
||||
(with-spine (sp cache 1)
|
||||
(btree-each (btree-open device-details-vt root) sp
|
||||
(lambda (k v)
|
||||
(fmt #t
|
||||
"dev-id: " k "\n"
|
||||
" mapped blocks: " (ftype-ref ThinDeviceDetails (mapped-blocks) v) "\n"
|
||||
" transaction id: " (ftype-ref ThinDeviceDetails (transaction-id) v) "\n"
|
||||
" creation time: " (ftype-ref ThinDeviceDetails (creation-time) v) "\n"
|
||||
" snapshotted time: " (ftype-ref ThinDeviceDetails (snapshotted-time) v) "\n")))))
|
||||
|
||||
(define-enumeration thin-check-element
|
||||
(quiet
|
||||
|
||||
@@ -1,19 +1,14 @@
|
||||
(library
|
||||
(thin mapping-tree)
|
||||
|
||||
(export mapping-tree-open
|
||||
mapping-tree-lookup
|
||||
(export mapping-tree-lookup
|
||||
mapping-tree-each)
|
||||
|
||||
(import (persistent-data btree)
|
||||
(bcache block-manager)
|
||||
(chezscheme)
|
||||
(srfi s8 receive))
|
||||
|
||||
(define-record-type mapping-tree (fields dev-tree))
|
||||
|
||||
(define (mapping-tree-open dev root)
|
||||
(make-mapping-tree (btree-open le64-vt dev root)))
|
||||
|
||||
;; (values <block> <time>)
|
||||
(define time-mask (- (fxsll 1 24) 1))
|
||||
|
||||
@@ -21,22 +16,25 @@
|
||||
(values (fxsrl bt 24) (fxlogand bt time-mask)))
|
||||
|
||||
;; FIXME: unpack the block time
|
||||
(define (mapping-tree-lookup mtree dev-id vblock default)
|
||||
(let* ((unique (gensym))
|
||||
(dev-tree (mapping-tree-dev-tree mtree))
|
||||
(root2 (btree-lookup dev-tree dev-id unique)))
|
||||
(if (eq? unique root2)
|
||||
default
|
||||
(btree-lookup (btree-open le64-vt (btree-bcache dev-tree) root2) vblock default))))
|
||||
(define (mapping-tree-lookup cache root dev-id vblock default)
|
||||
(with-spine (sp cache 1)
|
||||
(let* ((unique (gensym))
|
||||
(dev-tree (btree-open le64-vt root))
|
||||
(root2 (btree-lookup dev-tree sp dev-id unique)))
|
||||
(if (eq? unique root2)
|
||||
default
|
||||
(btree-lookup (btree-open le64-vt root2) sp vblock default)))))
|
||||
|
||||
;;; Visits every entry in the mapping tree calling (fn dev-id vblock pblock time).
|
||||
(define (mapping-tree-each mtree fn)
|
||||
(let ((dev-tree (mapping-tree-dev-tree mtree)))
|
||||
(define (mapping-tree-each cache root fn)
|
||||
(with-spine (sp cache 1)
|
||||
(let ((dev-tree (btree-open le64-vt root)))
|
||||
|
||||
(define (visit-dev dev-id mapping-root)
|
||||
(btree-each (btree-open le64-vt (btree-bcache dev-tree) mapping-root)
|
||||
(lambda (vblock mapping)
|
||||
(receive (block time) (unpack-block-time mapping)
|
||||
(fn dev-id vblock block time)))))
|
||||
(define (visit-dev dev-id mapping-root)
|
||||
(btree-each (btree-open le64-vt mapping-root)
|
||||
(lambda (vblock mapping)
|
||||
(receive (block time) (unpack-block-time mapping)
|
||||
(fn dev-id vblock block time)))))
|
||||
|
||||
(btree-each dev-tree visit-dev))))
|
||||
(btree-each dev-tree sp visit-dev))))
|
||||
)
|
||||
|
||||
@@ -4,7 +4,9 @@
|
||||
(export ThinSuperblock
|
||||
ThinDeviceDetails)
|
||||
|
||||
(import (chezscheme))
|
||||
(import (chezscheme)
|
||||
(bcache block-manager)
|
||||
(persistent-data btree))
|
||||
|
||||
(define $superblock-magic 27022010)
|
||||
(define $superblock-salt 160774)
|
||||
|
||||
Reference in New Issue
Block a user