diff options
Diffstat (limited to 'src/eris.lisp')
| -rw-r--r-- | src/eris.lisp | 41 |
1 files changed, 24 insertions, 17 deletions
diff --git a/src/eris.lisp b/src/eris.lisp index 196bcce..b23caac 100644 --- a/src/eris.lisp +++ b/src/eris.lisp @@ -151,29 +151,34 @@ versioning bytes are not supported by eris-cl." ;; These CHUNK- functions are written in order to allow processing files in ;; parallel. -(defun chunk-array (array block-size output-function secret &key pad) +(defun chunk-array (array block-size output-function secret &key pad (start 0) (end (length array))) "Split (SIMPLE-ARRAY (UNSIGNED-BYTE 8) that is a multiple of BLOCK-SIZE into chunks, output them and collect references. Returns a vector of references. +START and END behave as expected. Pass PAD as T if the output should be padded." (declare (type block-size block-size) (type octet-vector array)) - (let ((blocks (if pad - (/ (+ (length array) (- block-size (mod (length array) block-size))) block-size) - (/ (length array) block-size)))) - (let ((block (make-octet-vector block-size)) - (rks (make-array blocks :element-type 'octet-vector :initial-element null-secret))) - (loop for i from 0 below (1- blocks) - do (progn - (replace block array :start2 (* block-size i)) - (setf block (output-block rks i)))) - ;; handle last block - (replace block array :start2 (* block-size (1- blocks))) - (when pad - (setf (aref block (mod (length array) block-size)) #x80) - (fill block 0 :start (1+ (mod (length array) block-size)))) - (output-block rks (1- blocks)) - rks))) + (when (and (not pad) (zerop (- end start))) ;; need this because of the loop unrolling + (return-from chunk-array (make-array 0 :element-type 'octet-vector))) + + (let ((length (- end start))) + (let ((blocks (if pad + (/ (+ length (- block-size (mod length block-size))) block-size) + (/ length block-size)))) + (let ((block (make-octet-vector block-size)) + (rks (make-array blocks :element-type 'octet-vector :initial-element null-secret))) + (loop for i from 0 below (1- blocks) + do (progn + (replace block array :start2 (+ start (* block-size i))) + (setf block (output-block rks i)))) + ;; handle last block + (replace block array :start2 (+ start (* block-size (1- blocks)))) + (when pad + (setf (aref block (mod length block-size)) #x80) + (fill block 0 :start (1+ (mod length block-size)))) + (output-block rks (1- blocks)) + rks)))) ;; Implementation note: This is CHUNK-ARRAY but copypasted with (LENGTH ARRAY) @@ -185,6 +190,8 @@ Pass PAD as T if the output should be padded." read and should be a multiple of BLOCK-SIZE unless PAD is T." (declare (type block-size block-size) (type integer length)) + (when (and (not pad) (zerop length)) ;; need this because of the loop unrolling + (return-from chunk-stream (make-array 0 :element-type 'octet-vector))) (let ((blocks (if pad (/ (+ length (- block-size (mod length block-size))) block-size) (/ length block-size)))) |