[functional-tests] change btree functions to take a spine.

Also change the step-spine interface slightly.
This commit is contained in:
Joe Thornber
2017-09-14 16:09:43 +01:00
parent 48ae5beead
commit 4d3733d0e7
6 changed files with 80 additions and 83 deletions

View File

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

View File

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

View File

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