[functional-tests] Move mapping tree to metadata, and add functions for device-tree

This commit is contained in:
Joe Thornber 2017-10-04 10:40:25 +01:00
parent 48b3ac960c
commit 3b30d9e225
2 changed files with 79 additions and 73 deletions

View File

@ -1,40 +0,0 @@
(library
(thin mapping-tree)
(export mapping-tree-lookup
mapping-tree-each)
(import (persistent-data btree)
(bcache block-manager)
(chezscheme)
(srfi s8 receive))
;; (values <block> <time>)
(define time-mask (- (fxsll 1 24) 1))
(define (unpack-block-time bt)
(values (fxsrl bt 24) (fxlogand bt time-mask)))
;; FIXME: unpack the block time
(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 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 mapping-root)
(lambda (vblock mapping)
(receive (block time) (unpack-block-time mapping)
(fn dev-id vblock block time)))))
(btree-each dev-tree sp visit-dev))))
)

View File

@ -2,19 +2,27 @@
(thin metadata)
(export ThinSuperblock
ThinDeviceDetails)
ThinDeviceDetails
block->superblock
mapping-tree-lookup
mapping-tree-each
unpack-block-time
device-tree-lookup
device-tree-each)
(import (chezscheme)
(bcache block-manager)
(persistent-data btree))
(persistent-data btree)
(srfi s8 receive))
(define $superblock-magic 27022010)
(define $superblock-salt 160774)
(define $uuid-size 16)
(define $space-map-root-size 128)
(define-compound-value-type device-details-vt ThinDeviceDetails)
(define (block->superblock b)
(make-ftype-pointer ThinSuperblock (block-data b)))
@ -51,5 +59,43 @@
(creation-time unsigned-32)
(snapshotted-time unsigned-32)))))
;; (values <block> <time>)
(define time-mask (- (fxsll 1 24) 1))
(define (unpack-block-time bt)
(values (fxsrl bt 24) (fxlogand bt time-mask)))
;; FIXME: unpack the block time
(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 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 mapping-root)
(lambda (vblock mapping)
(receive (block time) (unpack-block-time mapping)
(fn dev-id vblock block time)))))
(btree-each dev-tree sp visit-dev))))
(define-compound-value-type device-details-vt ThinDeviceDetails)
(define (device-tree-lookup cache root dev-id default)
(with-spine (sp cache 1)
(btree-lookup (btree-open device-details-vt root) sp dev-id default)))
(define (device-tree-each cache root fn)
(with-spine (sp cache 1)
(btree-each (btree-open device-details-vt root) sp fn)))
)