54 lines
1.6 KiB
Scheme
54 lines
1.6 KiB
Scheme
(library
|
|
(block-io)
|
|
(export metadata-block-size
|
|
open-metadata
|
|
with-metadata
|
|
read-block)
|
|
(import (rnrs)
|
|
(fmt fmt))
|
|
|
|
;;;---------------------------------------------------
|
|
;;; TODO:
|
|
;;; - implement a little block cache.
|
|
;;; - writes
|
|
;;; - zero blocks
|
|
;;; - prefetching
|
|
;;;---------------------------------------------------
|
|
|
|
(define metadata-block-size 4096)
|
|
|
|
(define (open-metadata path)
|
|
(open-file-input-port path (file-options) (buffer-mode none)))
|
|
|
|
(define-syntax with-metadata
|
|
(syntax-rules ()
|
|
((_ (port path) body ...) (let ((port (open-metadata path)))
|
|
(dynamic-wind
|
|
(lambda () #f)
|
|
(lambda () body ...)
|
|
(lambda () (close-port port)))))))
|
|
|
|
;; FIXME: return our own condition?
|
|
(define (io-error msg)
|
|
(raise (condition
|
|
(make-error)
|
|
(make-message-condition msg))))
|
|
|
|
;;; Returns a boolean indicating success
|
|
(define (read-exact! port offset len bv start)
|
|
(set-port-position! port offset)
|
|
(let ((nr (get-bytevector-n! port bv start len)))
|
|
(and (not (eof-object? nr))
|
|
(= len nr))))
|
|
|
|
;;; Returns a 4k bytevector or #f
|
|
(define (read-exact port offset len)
|
|
(let ((bv (make-bytevector len)))
|
|
(if (read-exact! port offset len bv 0) bv #f)))
|
|
|
|
(define (read-block port b)
|
|
(or (read-exact port (* b metadata-block-size) metadata-block-size)
|
|
(io-error (fmt #f (dsp "Unable to read metadata block: ") (num b))))))
|
|
|
|
|