fs: per-parent children index + amortized FUSE write buffer
ober
490587e0abe91d134ca72619a3f80eb72400b72c
--- a/protonstorage/drive/fs.ss +++ b/protonstorage/drive/fs.ss @@ -42,13 +42,14 @@ (defstruct proton-drive-fs (session share-id root-link entries entries-by-ino entries-by-name + children-by-parent reader writer mkdirer deleter renamer counters pending-by-fh)) (defstruct proton-drive-fs-entry (ino name link parent type size)) (defstruct proton-drive-pending-write - (fh parent-entry entry name buffer committed?)) + (fh parent-entry entry name buffer size committed?)) (def (jmaybe obj key . default) (let ([fallback (if (null? default) #f (car default))]) @@ -193,6 +194,24 @@ entry) (cons entry entries)) + (def (index-add-child! fs entry) + (let ([children (proton-drive-fs-children-by-parent fs)] + [parent (proton-drive-fs-entry-parent entry)]) + (hash-put! children parent + (cons entry (hash-ref children parent '()))))) + + (def (index-remove-child! fs entry) + (let ([children (proton-drive-fs-children-by-parent fs)] + [parent (proton-drive-fs-entry-parent entry)] + [ino (proton-drive-fs-entry-ino entry)]) + (hash-put! children parent + (let loop ([xs (hash-ref children parent '())] [acc '()]) + (cond + [(null? xs) (reverse acc)] + [(= (proton-drive-fs-entry-ino (car xs)) ino) + (loop (cdr xs) acc)] + [else (loop (cdr xs) (cons (car xs) acc))]))))) + (def (register-entry-in-fs! fs entry) (hash-put! (proton-drive-fs-entries-by-ino fs) (proton-drive-fs-entry-ino entry) @@ -205,6 +224,7 @@ (proton-drive-fs-entries-set! fs (cons entry (proton-drive-fs-entries fs))) + (index-add-child! fs entry) entry) (def (remove-entry-from-list entry entries) @@ -226,9 +246,11 @@ (proton-drive-fs-entries-set! fs (remove-entry-from-list entry (proton-drive-fs-entries fs))) + (index-remove-child! fs entry) entry) (def (update-entry-name-parent! fs entry new-parent new-name result) + (index-remove-child! fs entry) (hash-remove! (proton-drive-fs-entries-by-name fs) (name-key (proton-drive-fs-entry-parent entry) @@ -245,6 +267,7 @@ (proton-drive-fs-entry-parent entry) (proton-drive-fs-entry-name entry)) entry) + (index-add-child! fs entry) entry) (def (fs-counter-next! fs key) @@ -276,16 +299,26 @@ (hash-put! by-link root-id root-entry))) (let loop ([xs links] [next-ino 2] [acc entries]) (if (null? xs) - (let ([counters (make-hash-table)]) + (let ([all-entries (reverse acc)] + [counters (make-hash-table)] + [children-by-parent (make-hash-table)]) (hash-put! counters 'next-ino next-ino) (hash-put! counters 'next-fh 1) + (let build ([es all-entries]) + (unless (null? es) + (let ([e (car es)] + [parent (proton-drive-fs-entry-parent (car es))]) + (hash-put! children-by-parent parent + (cons e (hash-ref children-by-parent parent '())))) + (build (cdr es)))) (make-proton-drive-fs session share-id root-link - (reverse acc) + all-entries by-ino by-name + children-by-parent reader writer mkdirer @@ -381,11 +414,11 @@ (entry-attr fs entry))) (def (children-of fs ino) - (let loop ([xs (proton-drive-fs-entries fs)] [acc '()]) + (let loop ([xs (hash-ref (proton-drive-fs-children-by-parent fs) ino '())] + [acc '()]) (cond [(null? xs) (reverse acc)] - [(and (= (proton-drive-fs-entry-parent (car xs)) ino) - (not (= (proton-drive-fs-entry-ino (car xs)) ino))) + [(not (= (proton-drive-fs-entry-ino (car xs)) ino)) (loop (cdr xs) (cons (car xs) acc))] [else (loop (cdr xs) acc)]))) @@ -475,14 +508,24 @@ (bytevector-copy! old 0 out 0 copy-len)) out)) - (def (bytevector-write-at old data offset) - (let* ([old-len (bytevector-length old)] - [write-len (bytevector-length data)] - [new-end (+ offset write-len)] - [new-len (max old-len new-end)] - [out (resize-bytevector old new-len)]) - (bytevector-copy! data 0 out offset write-len) - out)) + ;; Grow the pending-write buffer to hold at least min-cap bytes, doubling + ;; capacity so sequential writes amortize to O(n) instead of copying the + ;; whole buffer on every write. The logical content is buffer[0..size); + ;; the spare capacity beyond size is always zero. + (def (pending-ensure-capacity! pending min-cap) + (let* ([buf (proton-drive-pending-write-buffer pending)] + [cap (bytevector-length buf)]) + (if (>= cap min-cap) + buf + (let grow ([new-cap (max 1 cap)]) + (if (>= new-cap min-cap) + (let ([new-buf (make-bytevector new-cap 0)] + [size (proton-drive-pending-write-size pending)]) + (when (> size 0) + (bytevector-copy! buf 0 new-buf 0 size)) + (proton-drive-pending-write-buffer-set! pending new-buf) + new-buf) + (grow (* new-cap 2))))))) (def (entry-path fs entry) (if (= (proton-drive-fs-entry-ino entry) FUSE-ROOT-ID) @@ -506,6 +549,7 @@ entry name (make-bytevector 0) + 0 #f)]) (hash-put! (proton-drive-fs-pending-by-fh fs) fh pending) fh)) @@ -544,17 +588,18 @@ (def (fuse-write fs ino fh data offset ctx) (let ([pending (hash-ref (proton-drive-fs-pending-by-fh fs) fh #f)]) (and pending - (let ([buffer - (bytevector-write-at - (proton-drive-pending-write-buffer pending) - data - offset)]) - (proton-drive-pending-write-buffer-set! pending buffer) + (let* ([write-len (bytevector-length data)] + [new-end (+ offset write-len)] + [old-size (proton-drive-pending-write-size pending)] + [new-size (max old-size new-end)] + [buf (pending-ensure-capacity! pending new-end)]) + (bytevector-copy! data 0 buf offset write-len) + (proton-drive-pending-write-size-set! pending new-size) (proton-drive-pending-write-committed?-set! pending #f) (proton-drive-fs-entry-size-set! (proton-drive-pending-write-entry pending) - (bytevector-length buffer)) - (bytevector-length data))))) + new-size) + write-len)))) (def (pending-commit! fs pending ctx) (if (proton-drive-pending-write-committed? pending) @@ -564,7 +609,10 @@ (let* ([entry (proton-drive-pending-write-entry pending)] [parent-entry (proton-drive-pending-write-parent-entry pending)] - [data (proton-drive-pending-write-buffer pending)] + [data + (resize-bytevector + (proton-drive-pending-write-buffer pending) + (proton-drive-pending-write-size pending))] [name (proton-drive-pending-write-name pending)] [result (writer @@ -617,6 +665,7 @@ (resize-bytevector (proton-drive-pending-write-buffer pending) size)) + (proton-drive-pending-write-size-set! pending size) (proton-drive-pending-write-committed?-set! pending #f) (proton-drive-fs-entry-size-set! entry size)] [(proton-drive-fs-writer fs)