diff options
Diffstat (limited to 'src/eris-decode.lisp')
| -rw-r--r-- | src/eris-decode.lisp | 43 |
1 files changed, 25 insertions, 18 deletions
diff --git a/src/eris-decode.lisp b/src/eris-decode.lisp index b660cae..fe2dcbe 100644 --- a/src/eris-decode.lisp +++ b/src/eris-decode.lisp @@ -49,7 +49,8 @@ fetched from a trusted party.") (root :accessor root :type high-block :initarg :root :documentation "A list of blocks, starting from the root to the level 1 block.") (buffer :accessor buffer :initarg :buffer :type buffer) (eof :accessor eof :initarg :eof :type integer) - (nonce-array :accessor nonce-array :initarg :nonce-array :type simple-array))) + (nonce-array :accessor nonce-array :initarg :nonce-array :type simple-array)) + (:documentation "Class representing the stream object that decodes an ERIS read capability.")) (defun initialize-nonce-array (level) (let ((array (make-array (1+ level)))) @@ -68,11 +69,12 @@ fetched from a trusted party.") (defun unpad-buffer (buffer) (with-slots (eof data) buffer - (setf eof - (unpad-block data)))) + (setf eof (unpad-block data)))) -(defun ls (level block-size) - (declare ;; (type (unsigned-byte 8) level) +(defun local-range (level block-size) + "Given a level and a block-size, determine the range of bytes that it +represents." + (declare (type fixnum level) (type block-size block-size)) (ecase block-size (1024 (expt 2 (+ 10 (* level 4)))) @@ -81,7 +83,7 @@ fetched from a trusted party.") (defun find-eof (root get-block block-size level) "Find the end of file in a given tree." ;; The standard states that: - ;; If 64 bytes of zeroes are encountered the rest of the node MUST be checked to be all zeroes + ;; "If 64 bytes of zeroes are encountered the rest of the node MUST be checked to be all zeroes" ;; This procedure processes the block from right to left so it's not really applicable here (flet ((find-last-reference (block) @@ -97,10 +99,14 @@ fetched from a trusted party.") do (setf position (+ position (unpad-block block))) and return position else - do (setf position (+ position (* block-pos (ls (1- local-level) block-size))))))) + do (setf position (+ position (* block-pos (local-range (1- local-level) block-size))))))) (defun advance-next-block (stream) - "Advance to the next block. This function is called by update-buffer." + "Advance to the next block. + +This function walks the tree in order to get the next block, which is then put +in the buffer object of the STREAM. It sets the EOF indicator of the buffer if +it is necessary and sets the position in the buffer to 0." (declare (optimize (speed 3) (debug 0))) (with-slots (buffer position eof block-size root get-block nonce-array) stream (declare (type integer position eof) @@ -122,8 +128,8 @@ fetched from a trusted party.") (funcall get-block (reference kr) (key kr) (svref nonce-array level))))))) (process-block (reverse root) (/ block-size 64) 0) ;; process the blocks from level 0 up ;; setf the buffer data to the level 0 block - (setf (data buffer) - (data (car (last root)))) + (setf (data buffer) (data (car (last root))) + (pos buffer) 0) ;; if the EOF block is reached, unpad it. (when (= (- eof (mod eof block-size)) position) (unpad-buffer buffer))))) @@ -148,8 +154,7 @@ fetched from a trusted party.") (+ start seq-bytes)) ((eql eof (length data)) ;; seq is larger or equal than buffer case (replace sequence data :start1 start :end1 end :start2 pos) - (setf pos 0 - (pos stream) (+ (pos stream) buffer-bytes)) + (setf (pos stream) (+ (pos stream) buffer-bytes)) (advance-next-block stream) (read-to-seq sequence buf :start (+ start buffer-bytes) :end end :stream stream)) (t ;; if there is an eof in the buffer @@ -167,8 +172,8 @@ fetched from a trusted party.") (loop with update-tree = nil for blocks = root then (cdr blocks) for level = (level (car blocks)) ;; then (decf level) - for position = new-pos then (mod position (ls (1- level) block-size)) ;; local position - for block-position = (floor (/ position (ls (1- level) block-size))) ;; the position of the block + for position = new-pos then (mod position (local-range (1- level) block-size)) ;; local position + for block-position = (floor (/ position (local-range (1- level) block-size))) ;; the position of the block for lower-block = (second blocks) when (> block-position (/ block-size 64)) do (error 'eof :eof new-pos :position (pos stream)) @@ -209,11 +214,14 @@ gethash. The keyword argument CACHE-CAPACITY indicates the amount of blocks stored in the cache." + (declare (type read-capability read-capability) + (type function fetch-function) + (type integer cache-capacity)) (with-slots (level block-size root-reference-pair) read-capability (let* ((get-block (cached-lambda (:cache-class 'lru-cache - :capacity cache-capacity - :table (make-hash-table :size (1+ cache-capacity) :test #'equalp)) - (reference key &optional nonce) + :capacity cache-capacity + :table (make-hash-table :size (1+ cache-capacity) :test #'equalp)) + (reference key &optional nonce) (let* ((block (funcall fetch-function reference))) (unless block (error 'missing-block :reference reference)) (hash-check block reference) @@ -291,7 +299,6 @@ the new position is beyond the end of file.." (with-slots (pos eof data) buffer (cond ((eql pos block-size) - (setf pos 0) (advance-next-block stream) (stream-read-byte stream)) ((eql pos eof) |