vault: speed up allocation, truncate, and readdir hot paths (P2)
ober
fc38237ed5bae03146a4f64108025d3dcd29ef8e
--- a/lib/jerboa-fuse/vault.sls +++ b/lib/jerboa-fuse/vault.sls @@ -25,7 +25,9 @@ (mutable bitmap-start) (mutable bitmap-nblocks) (mutable generation) (mutable policy-block) (mutable bitmap) (mutable bitmap-dirty?) (mutable next-fh) (mutable open-fhs) - (mutable access) (mutable header-bv) (mutable mutex))) + (mutable access) (mutable header-bv) (mutable mutex) + (mutable bitmap-alloc-hint))) + (def *zero-block* (make-bytevector BLOCK-PAYLOAD 0)) (def (read-inode vault block-num) (let ([payload (blockstore-read-block (vault-state-bs vault) @@ -82,8 +84,9 @@ (let* ([total (blockstore-total-blocks (vault-state-bs vault))] [bm (vault-state-bitmap vault)] - [bm-bytes (bytevector-length bm)]) - (let loop ([byte-idx 0]) + [bm-bytes (bytevector-length bm)] + [start (vault-state-bitmap-alloc-hint vault)]) + (let loop ([byte-idx start]) (cond [(>= (* byte-idx 8) total) #f] [(>= byte-idx bm-bytes) #f] @@ -99,9 +102,18 @@ (bitwise-and (bytevector-u8-ref bm byte-idx) (bitwise-arithmetic-shift-left 1 bit)))) - (begin (bitmap-set! vault n #t) n) + (begin + (vault-state-bitmap-alloc-hint-set! + vault + byte-idx) + (bitmap-set! vault n #t) + n) (bit-loop (+ bit 1))))))])))) - (def (bitmap-free! vault n) (bitmap-set! vault n #f)) + (def (bitmap-free! vault n) + (let ([byte (quotient n 8)]) + (when (< byte (vault-state-bitmap-alloc-hint vault)) + (vault-state-bitmap-alloc-hint-set! vault byte))) + (bitmap-set! vault n #f)) (def (flush-bitmap! vault) (when (vault-state-bitmap-dirty? vault) (let ([bm (vault-state-bitmap vault)] @@ -299,40 +311,49 @@ (vault-state-bs vault) phys)]) (when pay - (let loop ([i last-boff]) - (when (< i BLOCK-PAYLOAD) - (bytevector-u8-set! pay i 0) - (loop (+ i 1)))) + (bytevector-copy! *zero-block* 0 pay last-boff + (- BLOCK-PAYLOAD last-boff)) (blockstore-write-block! (vault-state-bs vault) phys pay)))))) - (let loop ([i (+ last-lidx 1)]) - (when (<= i max-lidx) - (let ([phys (resolve-data-block vault inode i)]) - (when phys - (bitmap-free! vault phys) - (if (< i DIRECT-BLOCKS) - (vector-set! - (vault-inode-direct inode) - i - VAULT-BLOCK-INVALID) - (let ([ind-blk (vault-inode-indirect inode)]) - (when (not (= ind-blk VAULT-BLOCK-INVALID)) - (let ([ind-pay (blockstore-read-block - (vault-state-bs vault) - ind-blk)]) - (when ind-pay - (let ([ptr-idx (- i DIRECT-BLOCKS)]) + (let* ([free-start (+ last-lidx 1)] + [direct-end (min max-lidx (- DIRECT-BLOCKS 1))]) + (let loop ([i free-start]) + (when (<= i direct-end) + (let ([phys (vector-ref (vault-inode-direct inode) i)]) + (when (not (= phys VAULT-BLOCK-INVALID)) + (bitmap-free! vault phys) + (vector-set! + (vault-inode-direct inode) + i + VAULT-BLOCK-INVALID))) + (loop (+ i 1)))) + (let ([ind-blk (vault-inode-indirect inode)]) + (when (and (not (= ind-blk VAULT-BLOCK-INVALID)) + (>= max-lidx DIRECT-BLOCKS)) + (let* ([ptr-lo (max 0 (- free-start DIRECT-BLOCKS))] + [ptr-hi (min (- PTRS-PER-BLOCK 1) + (- max-lidx DIRECT-BLOCKS))]) + (when (<= ptr-lo ptr-hi) + (let ([ind-pay (blockstore-read-block + (vault-state-bs vault) + ind-blk)]) + (when ind-pay + (let loop ([p ptr-lo]) + (when (<= p ptr-hi) + (let ([phys (bv-u64le ind-pay (* p 8))]) + (when (not (= phys VAULT-BLOCK-INVALID)) + (bitmap-free! vault phys) (bv-set-u64le! ind-pay - (* ptr-idx 8) - VAULT-BLOCK-INVALID) - (blockstore-write-block! - (vault-state-bs vault) - ind-blk - ind-pay))))))))) - (loop (+ i 1)))) + (* p 8) + VAULT-BLOCK-INVALID))) + (loop (+ p 1)))) + (blockstore-write-block! + (vault-state-bs vault) + ind-blk + ind-pay)))))))) (vault-inode-size-set! inode new-size))] [else (vault-inode-size-set! inode new-size)]) (vault-inode-ctime-set! inode (time-second (current-time))) @@ -425,10 +446,8 @@ (string=? (utf8->string nbv) name)) (begin (let ([off (* slot DIRENT-SIZE)]) - (let zero-loop ([i 0]) - (when (< i DIRENT-SIZE) - (bytevector-u8-set! pay (+ off i) 0) - (zero-loop (+ i 1))))) + (bytevector-copy! *zero-block* 0 pay off + DIRENT-SIZE)) (blockstore-write-block! (vault-state-bs vault) phys @@ -513,7 +532,7 @@ [bm (make-bytevector bm-bytes 0)] [vault (make-vault-state bs #f root-block bitmap-start bitmap-nblks 0 VAULT-BLOCK-INVALID bm #f 1 (make-eq-hashtable) #f - #f (make-mutex))]) + #f (make-mutex) 0)]) (bitmap-set! vault 0 #t) (bitmap-set! vault 1 #t) (let loop ([i 0]) @@ -580,8 +599,8 @@ (bytevector-fill! pk 0) (make-vault-state bs #f root-block bitmap-start bitmap-nblks generation policy-block bm #f 1 - (make-eq-hashtable) #f hdr-bv - (make-mutex)))))))))))) + (make-eq-hashtable) #f hdr-bv (make-mutex) + 0))))))))))) (def (vault-close! vault) (with-mutex (vault-state-mutex vault) (when (blockstore-key-live? (vault-state-bs vault)) @@ -691,44 +710,50 @@ (let ([inode (read-inode vault ino)]) (if (and inode (= (vault-inode-type inode) INODE-TYPE-DIR)) (let* ([entries (dir-list vault inode)] - [base (list - (make-fuse-dirent ino 1 DT-DIR ".") - (make-fuse-dirent ino 2 DT-DIR ".."))] + [base (append + (if (> 1 offset) + (list + (make-fuse-dirent ino 1 DT-DIR ".")) + '()) + (if (> 2 offset) + (list + (make-fuse-dirent ino 2 DT-DIR "..")) + '()))] [children (let loop ([es entries] [i 3] [acc '()]) (if (null? es) (reverse acc) (let* ([e (car es)] [cblk (car e)] - [cname (cdr e)] - [child (read-inode - vault - cblk)] - [dtype (if child - (cond - [(= (vault-inode-type - child) - INODE-TYPE-DIR) - DT-DIR] - [(= (vault-inode-type - child) - INODE-TYPE-SYMLINK) - DT-LNK] - [else DT-REG]) - DT-UNKNOWN)]) - (loop - (cdr es) - (+ i 1) - (cons - (make-fuse-dirent - cblk - i - dtype - cname) - acc)))))] - [all (append base children)]) - (filter - (lambda (d) (> (fuse-dirent-off d) offset)) - all)) + [cname (cdr e)]) + (if (<= i offset) + (loop (cdr es) (+ i 1) acc) + (let* ([child (read-inode + vault + cblk)] + [dtype (if child + (cond + [(= (vault-inode-type + child) + INODE-TYPE-DIR) + DT-DIR] + [(= (vault-inode-type + child) + INODE-TYPE-SYMLINK) + DT-LNK] + [else + DT-REG]) + DT-UNKNOWN)]) + (loop + (cdr es) + (+ i 1) + (cons + (make-fuse-dirent + cblk + i + dtype + cname) + acc)))))))]) + (append base children)) '()))))) (def (make-vault-open vault) (lambda (ino flags ctx) --- a/src/jerboa-fuse/vault.ss +++ b/src/jerboa-fuse/vault.ss @@ -63,7 +63,13 @@ (mutable open-fhs) ;; eq-hashtable: fh -> inode-block-num (mutable access) ;; access-controller (or #f) (mutable header-bv) ;; cached raw header (for lock/unlock re-derive) - (mutable mutex))) + (mutable mutex) + (mutable bitmap-alloc-hint))) ;; first-free byte hint for bitmap-alloc! + + ;; A shared zero buffer used to zero ranges via bytevector-copy! (Chez's + ;; bytevector-fill! takes no start/end). Big enough for a full block tail or a + ;; dirent slot; only ever read as a copy source, never mutated. + (def *zero-block* (make-bytevector BLOCK-PAYLOAD 0)) ;; ====================================================================== ;; Inode read/write @@ -138,11 +144,16 @@ (vault-state-bitmap-dirty?-set! vault #t))) (def (bitmap-alloc! vault) - ;; Linear scan: find first free bit, mark it used, return block number. + ;; Scan from a cached first-free byte hint instead of byte 0, so sequential + ;; allocation is O(1) amortized rather than O(n) per alloc (O(n^2) for an + ;; N-block file). The hint is a lower bound on the first free byte: + ;; bitmap-free! lowers it when a block before it is freed, so no free block + ;; is ever skipped. (let* ([total (blockstore-total-blocks (vault-state-bs vault))] [bm (vault-state-bitmap vault)] - [bm-bytes (bytevector-length bm)]) - (let loop ([byte-idx 0]) + [bm-bytes (bytevector-length bm)] + [start (vault-state-bitmap-alloc-hint vault)]) + (let loop ([byte-idx start]) (cond [(>= (* byte-idx 8) total) #f] ;; vault full [(>= byte-idx bm-bytes) #f] @@ -157,11 +168,16 @@ (zero? (bitwise-and (bytevector-u8-ref bm byte-idx) (bitwise-arithmetic-shift-left 1 bit)))) (begin + (vault-state-bitmap-alloc-hint-set! vault byte-idx) (bitmap-set! vault n #t) n) (bit-loop (+ bit 1))))))])))) (def (bitmap-free! vault n) + ;; Lower the alloc hint so a freed block before it is reconsidered. + (let ([byte (quotient n 8)]) + (when (< byte (vault-state-bitmap-alloc-hint vault)) + (vault-state-bitmap-alloc-hint-set! vault byte))) (bitmap-set! vault n #f)) (def (flush-bitmap! vault) @@ -339,27 +355,37 @@ (when phys (let ([pay (blockstore-read-block (vault-state-bs vault) phys)]) (when pay - (let loop ([i last-boff]) - (when (< i BLOCK-PAYLOAD) - (bytevector-u8-set! pay i 0) - (loop (+ i 1)))) + (bytevector-copy! *zero-block* 0 pay last-boff (- BLOCK-PAYLOAD last-boff)) (blockstore-write-block! (vault-state-bs vault) phys pay)))))) - ;; Free blocks beyond last-lidx, iterating all indices (sparse-aware) - (let loop ([i (+ last-lidx 1)]) - (when (<= i max-lidx) - (let ([phys (resolve-data-block vault inode i)]) - (when phys - (bitmap-free! vault phys) - (if (< i DIRECT-BLOCKS) - (vector-set! (vault-inode-direct inode) i VAULT-BLOCK-INVALID) - (let ([ind-blk (vault-inode-indirect inode)]) - (when (not (= ind-blk VAULT-BLOCK-INVALID)) - (let ([ind-pay (blockstore-read-block (vault-state-bs vault) ind-blk)]) - (when ind-pay - (let ([ptr-idx (- i DIRECT-BLOCKS)]) - (bv-set-u64le! ind-pay (* ptr-idx 8) VAULT-BLOCK-INVALID) - (blockstore-write-block! (vault-state-bs vault) ind-blk ind-pay))))))))) - (loop (+ i 1)))) + ;; Free blocks beyond last-lidx. Direct-range blocks are freed via the + ;; direct vector; the indirect block (if any) is read once, its + ;; freed-range pointers cleared in place, and written once (was a + ;; read-modify-write of the indirect block per pointer). + (let* ([free-start (+ last-lidx 1)] + [direct-end (min max-lidx (- DIRECT-BLOCKS 1))]) + (let loop ([i free-start]) + (when (<= i direct-end) + (let ([phys (vector-ref (vault-inode-direct inode) i)]) + (when (not (= phys VAULT-BLOCK-INVALID)) + (bitmap-free! vault phys) + (vector-set! (vault-inode-direct inode) i VAULT-BLOCK-INVALID))) + (loop (+ i 1)))) + (let ([ind-blk (vault-inode-indirect inode)]) + (when (and (not (= ind-blk VAULT-BLOCK-INVALID)) + (>= max-lidx DIRECT-BLOCKS)) + (let* ([ptr-lo (max 0 (- free-start DIRECT-BLOCKS))] + [ptr-hi (min (- PTRS-PER-BLOCK 1) (- max-lidx DIRECT-BLOCKS))]) + (when (<= ptr-lo ptr-hi) + (let ([ind-pay (blockstore-read-block (vault-state-bs vault) ind-blk)]) + (when ind-pay + (let loop ([p ptr-lo]) + (when (<= p ptr-hi) + (let ([phys (bv-u64le ind-pay (* p 8))]) + (when (not (= phys VAULT-BLOCK-INVALID)) + (bitmap-free! vault phys) + (bv-set-u64le! ind-pay (* p 8) VAULT-BLOCK-INVALID))) + (loop (+ p 1)))) + (blockstore-write-block! (vault-state-bs vault) ind-blk ind-pay)))))))) (vault-inode-size-set! inode new-size))] [else ;; Extend: just update size (data blocks will read as zeros) @@ -436,10 +462,7 @@ ;; Zero this slot (begin (let ([off (* slot DIRENT-SIZE)]) - (let zero-loop ([i 0]) - (when (< i DIRENT-SIZE) - (bytevector-u8-set! pay (+ off i) 0) - (zero-loop (+ i 1))))) + (bytevector-copy! *zero-block* 0 pay off DIRENT-SIZE)) (blockstore-write-block! (vault-state-bs vault) phys pay) (set! found? #t)) (slot-loop (+ slot 1)))))))) @@ -527,7 +550,8 @@ bm #f 1 (make-eq-hashtable) #f ;; access controller #f ;; header-bv (not needed for create) - (make-mutex))]) + (make-mutex) + 0)]) ;; bitmap-alloc-hint ;; Mark blocks 0 (superblock), 1 (root inode), 2...(1+bitmap-nblks) (bitmap) (bitmap-set! vault 0 #t) ;; superblock (bitmap-set! vault 1 #t) ;; root inode @@ -609,7 +633,8 @@ bm #f 1 (make-eq-hashtable) #f ;; access controller hdr-bv ;; cached header for lock/unlock - (make-mutex)))))))))))) + (make-mutex) + 0))))))))))) ;; bitmap-alloc-hint)) ;; ====================================================================== ;; vault-close! @@ -742,25 +767,29 @@ (let ([inode (read-inode vault ino)]) (if (and inode (= (vault-inode-type inode) INODE-TYPE-DIR)) (let* ([entries (dir-list vault inode)] - [base (list (make-fuse-dirent ino 1 DT-DIR ".") - (make-fuse-dirent ino 2 DT-DIR ".."))] + ;; Honor the readdir offset cookie: skip "." / ".." / children + ;; at or before `offset` while building, instead of building the + ;; whole list and filtering it afterwards. + [base (append (if (> 1 offset) (list (make-fuse-dirent ino 1 DT-DIR ".")) '()) + (if (> 2 offset) (list (make-fuse-dirent ino 2 DT-DIR "..")) '()))] [children (let loop ([es entries] [i 3] [acc '()]) (if (null? es) (reverse acc) (let* ([e (car es)] [cblk (car e)] - [cname (cdr e)] - [child (read-inode vault cblk)] - [dtype (if child - (cond - [(= (vault-inode-type child) INODE-TYPE-DIR) DT-DIR] - [(= (vault-inode-type child) INODE-TYPE-SYMLINK) DT-LNK] - [else DT-REG]) - DT-UNKNOWN)]) - (loop (cdr es) (+ i 1) - (cons (make-fuse-dirent cblk i dtype cname) acc)))))] - [all (append base children)]) - (filter (lambda (d) (> (fuse-dirent-off d) offset)) all)) + [cname (cdr e)]) + (if (<= i offset) + (loop (cdr es) (+ i 1) acc) + (let* ([child (read-inode vault cblk)] + [dtype (if child + (cond + [(= (vault-inode-type child) INODE-TYPE-DIR) DT-DIR] + [(= (vault-inode-type child) INODE-TYPE-SYMLINK) DT-LNK] + [else DT-REG]) + DT-UNKNOWN)]) + (loop (cdr es) (+ i 1) + (cons (make-fuse-dirent cblk i dtype cname) acc)))))))]) + (append base children)) '()))))) (def (make-vault-open vault)