thin-provisioning-tools/functional-tests/mapping-tree.scm
Joe Thornber 7f7a7d6605 [functional tests] start thinking about a block cache interface.
I want to use FFI to link with a C library containing the actual block
cache, io engine and crc32 code.
2017-08-14 10:05:38 +01:00

43 lines
1.4 KiB
Scheme

(library
(mapping-tree)
(export mapping-tree-open
mapping-tree-lookup
mapping-tree-each)
(import (btree)
(chezscheme)
(srfi s8 receive))
(define-record-type mapping-tree (fields dev-tree))
(define (mapping-tree-open dev root)
(make-mapping-tree (btree-open le64-type dev root)))
;; (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 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-type (btree-dev dev-tree) root2) 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 (visit-dev dev-id mapping-root)
(btree-each (btree-open le64-type (btree-dev dev-tree) mapping-root)
(lambda (vblock mapping)
(receive (block time) (unpack-block-time mapping)
(fn dev-id vblock block time)))))
(btree-each dev-tree visit-dev))))