thin-provisioning-tools/functional-tests/cache-xml.scm

48 lines
1.5 KiB
Scheme
Raw Normal View History

2017-08-17 19:16:01 +05:30
(library
(cache-xml)
(export generate-xml)
(import (rnrs)
(list-utils)
(loops)
(generators)
(xml)
(fmt fmt)
(srfi s27 random-bits)
(only (srfi s1 lists) iota))
(define (make-enum-vector count)
(let ((v (make-vector count)))
(upto (n count)
(vector-set! v n n))
v))
(define (vector-swap! v n m)
(let ((tmp (vector-ref v n)))
(vector-set! v n (vector-ref v m))
(vector-set! v m tmp)))
(define (rnd b e)
(+ b (random-integer (- e b))))
(define (vector-partial-shuffle! v count)
(let ((len (vector-length v)))
(upto (n count)
(vector-swap! v n (rnd n len)))))
;;---------------------------------------------------------
(define (generate-xml block-size nr-origin-blocks nr-cache-blocks)
(tag 'superblock `((uuid . "")
(block-size . ,block-size)
(nr-cache-blocks . ,nr-cache-blocks)
(policy . "smq")
(hint-width . 4))
;; FIXME: what a waste of memory
(let ((v (make-enum-vector nr-origin-blocks)))
(vector-partial-shuffle! v nr-cache-blocks)
(vcat (map (lambda (cblock)
(tag 'mapping `((cache-block . ,cblock)
(origin-block . ,(vector-ref v cblock))
(dirty . "true"))))
(iota nr-cache-blocks)))))))