emo
/
thin-provisioning-tools
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

[functional-tests/btree] btree-walk-and-count + stop using a spine.

This commit is contained in:
Joe Thornber 2017-11-24 11:10:41 +00:00
parent 80d8a5b684
commit 29e92772a9
1 changed files with 33 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
functional-tests/persistent-data/btree.scm
View File

@ -7,6 +7,7 @@
btree-open btree-open
btree-lookup btree-lookup
btree-each btree-each
btree-each-and-count
le64-vt le64-vt
define-value-type define-value-type
@ -149,35 +150,46 @@
default))))))) default)))))))
;;;;---------------------------------------------- ;;;;----------------------------------------------
;;;; Walking the btree ;;; Walk btree, counting metadata references
;;; (inc-fn <block>)
;;; (fn key value)
;;;;---------------------------------------------- ;;;;----------------------------------------------
(define (btree-each-and-count tree cache fn inc-fn)
;;; Calls (fn key value) on every entry of the btree.
(define (btree-each tree sp fn)
(let ((vt (btree-value-type tree))) (let ((vt (btree-value-type tree)))
(define (visit-leaf nr-entries keys vals) (define (visit-leaf nr-entries keys vals)
(let loop ((index 0)) (let loop ((index 0))
(when (< index nr-entries) (when (< index nr-entries)
(fn (key-at keys index) (vt 'ref vals index)) (fn (key-at keys index) (vt 'ref vals index))
(loop (+ 1 index))))) (loop (+ 1 index)))))
(define (visit-internal nr-entries keys vals) (define (visit-internal nr-entries keys vals)
(let loop ((index 0)) (let loop ((index 0))
(when (< index nr-entries) (when (< index nr-entries)
(visit-node (le64-vt 'ref vals index)) (visit-node (le64-vt 'ref vals index))
(loop (+ 1 index))))) (loop (+ 1 index)))))
(define (visit-node root) (define (select-visitor header)
(spine-step sp (b root (get-flags)) (if (internal-node? header)
(let* ((header (block->header b)) visit-internal
(nr-entries (ftype-ref BTreeNodeHeader (nr-entries) header)) visit-leaf))
(keys (block->keys b))
(vals (block->values b vt))) (define (visit-node bi)
((if (internal-node? header) (with-block (b cache bi (get-flags))
visit-internal (let* ((header (block->header b))
visit-leaf) nr-entries keys vals)))) (nr-entries (ftype-ref BTreeNodeHeader (nr-entries) header))
(keys (block->keys b))
(vals (block->values b vt)))
(inc-fn bi)
((select-visitor header) nr-entries keys vals))))
(visit-node (btree-root tree)))) (visit-node (btree-root tree))))
;;; Calls (fn key value) on every entry of the btree.
(define (btree-each tree cache fn)
(define (noop bi) 'nil)
(btree-each-and-count tree cache fn noop))
) )