Permalink
Browse files

break out core of (UPDATE-DIGEST (X VECTOR)) to a common function

This change requires making the code more generic at a slight runtime
performance cost.  I think the assembly changes will at least compensate
for this change on appropriate implementations.  For those
implementations where said assembly changes do not exist, patches
welcome.  (Those implementations may not have cared terribly much about
the performance of Ironclad, anyway.)
  • Loading branch information...
1 parent 23d0714 commit 15a5721f2ecd19efd3d297f472ff0e7068a3e8c7 @froydnj committed Sep 11, 2010
View
@@ -186,6 +186,59 @@
rest
body)))))))))
+;;; common superclass (superstructure?) for MD5-style digest functions
+
+(defstruct (mdx
+ (:constructor nil)
+ (:copier nil))
+ ;; This is technically an (UNSIGNED-BYTE 61). But the type-checking
+ ;; penalties that imposes on a good 32-bit implementation are
+ ;; significant. We've opted to omit the type declaration here. If
+ ;; you really need to digest exabytes of data, I'm sure we can work
+ ;; something out.
+ (amount 0)
+ ;; Most "64-bit" digest functions (e.g. SHA512) will need to override
+ ;; this initial value in an &AUX.
+ (buffer (make-array 64 :element-type '(unsigned-byte 8)) :read-only t
+ :type simple-octet-vector)
+ ;; This fixed type should be big enough for "64-bit" digest functions.
+ (buffer-index 0 :type (integer 0 128)))
+
+(declaim (inline mdx-updater))
+(defun mdx-updater (state compressor seq start end)
+ (declare (type mdx state))
+ (declare (type function compressor))
+ (declare (type index start end))
+ (let* ((buffer (mdx-buffer state))
+ (buffer-index (mdx-buffer-index state))
+ (buffer-length (length buffer))
+ (length (- end start)))
+ (declare (type fixnum length))
+ (unless (zerop buffer-index)
+ (let ((amount (min (- buffer-length buffer-index)
+ length)))
+ (copy-to-buffer seq start amount buffer buffer-index)
+ (setq start (+ start amount))
+ (let ((new-index (logand (+ buffer-index amount)
+ (1- buffer-length))))
+ (when (zerop new-index)
+ (funcall compressor state buffer 0))
+ (when (>= start end)
+ (setf (mdx-buffer-index state) new-index)
+ (incf (mdx-amount state) length)
+ (return-from mdx-updater state)))))
+ (loop until (< (- end start) buffer-length)
+ do (funcall compressor state seq start)
+ (setq start (the fixnum (+ start buffer-length)))
+ finally (return
+ (let ((amount (- end start)))
+ (unless (zerop amount)
+ (copy-to-buffer seq start amount buffer 0)
+ (setf (mdx-buffer-index state) amount))
+ (incf (mdx-amount state) length)
+ state)))))
+(declaim (notinline mdx-updater))
+
;;; high-level generic function drivers
;;; These three functions are intended to be one-shot ways to digest
View
@@ -28,16 +28,18 @@
(defmacro workref (regs i) `(aref ,regs (+ ,i 32)))
) ; EVAL-WHEN
-(defun update-md2-regs (regs buffer checksum)
+(defun update-md2-regs (regs buffer offset checksum)
(declare (type (simple-array (unsigned-byte 8) (48)) regs)
- (type (simple-array (unsigned-byte 8) (16)) buffer checksum)
+ (type (simple-array (unsigned-byte 8) (16)) checksum)
+ (type simple-octet-vector buffer)
#.(burn-baby-burn))
(let ((x 0))
(declare (type (unsigned-byte 8) x))
;; save original input and prepare encryption block
(dotimes (i 16)
- (setf (workref regs i) (logxor (stateref regs i) (aref buffer i))
- (blockref regs i) (aref buffer i)))
+ (setf (workref regs i)
+ (logxor (stateref regs i) (aref buffer (+ i offset)))
+ (blockref regs i) (aref buffer (+ i offset))))
;; encrypt block
(dotimes (i 18)
(dotimes (j 48)
@@ -48,7 +50,8 @@
(setf x (aref checksum 15))
(dotimes (i 16)
(setf x (logxor (aref checksum i)
- (aref +md2-permutation+ (logxor (aref buffer i) x)))
+ (aref +md2-permutation+
+ (logxor (aref buffer (+ i offset)) x)))
(aref checksum i) x))))
(declaim (inline md2regs-digest))
@@ -68,17 +71,17 @@
:initial-element 0) 0)))))
(defstruct (md2
- (:constructor %make-md2-digest nil)
+ (:constructor %make-md2-digest
+ (&aux (buffer (make-array 16 :element-type '(unsigned-byte 8)
+ :initial-element 0))))
(:constructor %make-md2-state
(regs checksum buffer buffer-index))
- (:copier nil))
+ (:copier nil)
+ (:include mdx))
(regs (make-array 48 :element-type '(unsigned-byte 8) :initial-element 0)
:type (simple-array (unsigned-byte 8) (48)) :read-only t)
(checksum (make-array 16 :element-type '(unsigned-byte 8) :initial-element 0)
- :type (simple-array (unsigned-byte 8) (16)) :read-only t)
- (buffer (make-array 16 :element-type '(unsigned-byte 8) :initial-element 0)
- :type (simple-array (unsigned-byte 8) (16)) :read-only t)
- (buffer-index 0 :type (mod 16)))
+ :type (simple-array (unsigned-byte 8) (16)) :read-only t))
(defmethod reinitialize-instance ((state md2) &rest initargs)
(declare (ignore initargs))
@@ -103,36 +106,13 @@
(md2-buffer-index state)))))
(define-digest-updater md2
- (let* ((regs (md2-regs state))
- (checksum (md2-checksum state))
- (buffer (md2-buffer state))
- (buffer-index (md2-buffer-index state))
- (length (- end start)))
- ;; handle the remaining buffered input
- (unless (zerop buffer-index)
- (let ((amount (min (- 16 buffer-index) length)))
- (dotimes (i amount)
- (setf (aref buffer (+ i buffer-index)) (aref sequence (+ start i))))
- (incf start amount)
- (let ((new-index (mod (+ buffer-index amount) 16)))
- (when (zerop new-index)
- (update-md2-regs regs buffer checksum))
- (when (>= start end)
- (setf (md2-buffer-index state) new-index)
- (return-from update-digest state)))))
- (loop for offset from start below end by 16
- until (< (- end offset) 16)
- do
- (dotimes (i 16)
- (setf (aref buffer i) (aref sequence (+ offset i))))
- (update-md2-regs regs buffer checksum)
- finally
- (let ((amount (- end offset)))
- (unless (zerop amount)
- (dotimes (i amount)
- (setf (aref buffer i) (aref sequence (+ offset i))))
- (setf (md2-buffer-index state) amount))
- state))))
+ (flet ((compress (state sequence offset)
+ (update-md2-regs (md2-regs state)
+ sequence offset
+ (md2-checksum state))))
+ (declare (dynamic-extent #'compress))
+ (declare (notinline mdx-updater))
+ (mdx-updater state #'compress sequence start end)))
(define-digest-finalizer (md2 16)
(let* ((regs (md2-regs state))
@@ -143,11 +123,11 @@
;; pad with appropriate padding
(dotimes (i pad-amount)
(setf (aref buffer (+ buffer-index i)) pad-amount))
- (update-md2-regs regs buffer checksum)
+ (update-md2-regs regs buffer 0 checksum)
;; extend the message with the checksum
(dotimes (i 16)
(setf (aref buffer i) (aref checksum i)))
- (update-md2-regs regs buffer checksum)
+ (update-md2-regs regs buffer 0 checksum)
(finalize-registers state regs)))
(defdigest md2 :digest-length 16 :block-length 16)
View
@@ -63,14 +63,11 @@
(defstruct (md4
(:constructor %make-md4-digest nil)
(:constructor %make-md4-state (regs amount block buffer buffer-index))
- (:copier nil))
+ (:copier nil)
+ (:include mdx))
(regs (initial-md4-regs) :type md4-regs :read-only t)
- (amount 0 :type (unsigned-byte 64))
(block (make-array 16 :element-type '(unsigned-byte 32))
- :type (simple-array (unsigned-byte 32) (16)) :read-only t)
- (buffer (make-array 64 :element-type '(unsigned-byte 8))
- :type (simple-array (unsigned-byte 8) (64)) :read-only t)
- (buffer-index 0 :type (integer 0 63)))
+ :type (simple-array (unsigned-byte 32) (16)) :read-only t))
(defmethod reinitialize-instance ((state md4) &rest initargs)
(declare (ignore initargs))
@@ -99,41 +96,13 @@
"Update the given md4-state from sequence, which is either a
simple-string or a simple-array with element-type (unsigned-byte 8),
bounded by start and end, which must be numeric bounding-indices."
- (let ((regs (md4-regs state))
- (block (md4-block state))
- (buffer (md4-buffer state))
- (buffer-index (md4-buffer-index state))
- (length (- end start)))
- (declare (type md4-regs regs) (type fixnum length)
- (type (integer 0 63) buffer-index)
- (type (simple-array (unsigned-byte 32) (16)) block)
- (type (simple-array (unsigned-byte 8) (64)) buffer))
- ;; Handle old rest
- (unless (zerop buffer-index)
- (let ((amount (min (- 64 buffer-index) length)))
- (declare (type (integer 0 63) amount))
- (copy-to-buffer sequence start amount buffer buffer-index)
- (setq start (the fixnum (+ start amount)))
- (let ((new-index (mod (+ buffer-index amount) 64)))
- (when (zerop new-index)
- (fill-block-ub8-le block buffer 0)
- (update-md4-block regs block))
- (when (>= start end)
- (setf (md4-buffer-index state) new-index)
- (incf (md4-amount state) length)
- (return-from update-digest state)))))
- (loop for offset of-type index from start below end by 64
- until (< (- end offset) 64)
- do
- (fill-block-ub8-le block sequence offset)
- (update-md4-block regs block)
- finally
- (let ((amount (- end offset)))
- (unless (zerop amount)
- (copy-to-buffer sequence offset amount buffer 0))
- (setf (md4-buffer-index state) amount)))
- (incf (md4-amount state) length)
- state))
+ (flet ((compress (state sequence offset)
+ (let ((block (md4-block state)))
+ (fill-block-ub8-le block sequence offset)
+ (update-md4-block (md4-regs state) block))))
+ (declare (dynamic-extent #'compress))
+ (declare (notinline mdx-updater))
+ (mdx-updater state #'compress sequence start end)))
(define-digest-finalizer (md4 16)
"If the given md4-state has not already been finalized, finalize it,
View
@@ -142,14 +142,11 @@ accordingly."
(defstruct (md5
(:constructor %make-md5-digest nil)
(:constructor %make-md5-state (regs amount block buffer buffer-index))
- (:copier nil))
+ (:copier nil)
+ (:include mdx))
(regs (initial-md5-regs) :type md5-regs :read-only t)
- (amount 0 :type (unsigned-byte 64))
(block (make-array 16 :element-type '(unsigned-byte 32))
- :type (simple-array (unsigned-byte 32) (16)) :read-only t)
- (buffer (make-array 64 :element-type '(unsigned-byte 8))
- :type (simple-array (unsigned-byte 8) (64)) :read-only t)
- (buffer-index 0 :type (integer 0 63)))
+ :type (simple-array (unsigned-byte 32) (16)) :read-only t))
(defmethod reinitialize-instance ((state md5) &rest initargs)
(declare (ignore initargs))
@@ -178,41 +175,13 @@ accordingly."
"Update the given md5-state from sequence, which is either a
simple-string or a simple-array with element-type (unsigned-byte 8),
bounded by start and end, which must be numeric bounding-indices."
- (let* ((regs (md5-regs state))
- (block (md5-block state))
- (buffer (md5-buffer state))
- (buffer-index (md5-buffer-index state))
- (length (- end start)))
- (declare (type md5-regs regs) (type fixnum length)
- (type (integer 0 63) buffer-index)
- (type (simple-array (unsigned-byte 32) (16)) block)
- (type (simple-array (unsigned-byte 8) (64)) buffer))
- ;; Handle old rest
- (unless (zerop buffer-index)
- (let ((amount (min (- 64 buffer-index) length)))
- (declare (type (integer 0 63) amount))
- (copy-to-buffer sequence start amount buffer buffer-index)
- (setq start (the fixnum (+ start amount)))
- (let ((new-index (mod (+ buffer-index amount) 64)))
- (when (zerop new-index)
- (fill-block-ub8-le block buffer 0)
- (update-md5-block regs block))
- (when (>= start end)
- (setf (md5-buffer-index state) new-index)
- (incf (md5-amount state) length)
- (return-from update-digest state)))))
- (loop for offset of-type index from start below end by 64
- until (< (- end offset) 64)
- do
- (fill-block-ub8-le block sequence offset)
- (update-md5-block regs block)
- finally
- (let ((amount (- end offset)))
- (unless (zerop amount)
- (copy-to-buffer sequence offset amount buffer 0))
- (setf (md5-buffer-index state) amount)))
- (incf (md5-amount state) length)
- state))
+ (flet ((compress (state sequence offset)
+ (let ((block (md5-block state)))
+ (fill-block-ub8-le block sequence offset)
+ (update-md5-block (md5-regs state) block))))
+ (declare (dynamic-extent #'compress))
+ (declare (notinline mdx-updater))
+ (mdx-updater state #'compress sequence start end)))
(define-digest-finalizer (md5 16)
"If the given md5-state has not already been finalized, finalize it,
@@ -128,14 +128,11 @@
(defstruct (ripemd-128
(:constructor %make-ripemd-128-digest nil)
(:constructor %make-ripemd-128-state (regs amount block buffer buffer-index))
- (:copier nil))
+ (:copier nil)
+ (:include mdx))
(regs (initial-ripemd-128-regs) :type ripemd-128-regs :read-only t)
- (amount 0 :type (unsigned-byte 64))
(block (make-array 16 :element-type '(unsigned-byte 32))
- :type (simple-array (unsigned-byte 32) (16)) :read-only t)
- (buffer (make-array 64 :element-type '(unsigned-byte 8))
- :type (simple-array (unsigned-byte 8) (64)) :read-only t)
- (buffer-index 0 :type (integer 0 63)))
+ :type (simple-array (unsigned-byte 32) (16)) :read-only t))
(defmethod reinitialize-instance ((state ripemd-128) &rest initargs)
(declare (ignore initargs))
@@ -164,41 +161,13 @@
"Update the given ripemd-128-state from sequence, which is either a
simple-string or a simple-array with element-type (unsigned-byte 8),
bounded by start and end, which must be numeric bounding-indices."
- (let ((regs (ripemd-128-regs state))
- (block (ripemd-128-block state))
- (buffer (ripemd-128-buffer state))
- (buffer-index (ripemd-128-buffer-index state))
- (length (- end start)))
- (declare (type ripemd-128-regs regs) (type fixnum length)
- (type (integer 0 63) buffer-index)
- (type (simple-array (unsigned-byte 32) (16)) block)
- (type (simple-array (unsigned-byte 8) (64)) buffer))
- ;; Handle old rest
- (unless (zerop buffer-index)
- (let ((amount (min (- 64 buffer-index) length)))
- (declare (type (integer 0 63) amount))
- (copy-to-buffer sequence start amount buffer buffer-index)
- (setq start (the fixnum (+ start amount)))
- (let ((new-index (mod (+ buffer-index amount) 64)))
- (when (zerop new-index)
- (fill-block-ub8-le block buffer 0)
- (update-ripemd-128-block regs block))
- (when (>= start end)
- (setf (ripemd-128-buffer-index state) new-index)
- (incf (ripemd-128-amount state) length)
- (return-from update-digest state)))))
- (loop for offset of-type index from start below end by 64
- until (< (- end offset) 64)
- do
- (fill-block-ub8-le block sequence offset)
- (update-ripemd-128-block regs block)
- finally
- (let ((amount (- end offset)))
- (unless (zerop amount)
- (copy-to-buffer sequence offset amount buffer 0))
- (setf (ripemd-128-buffer-index state) amount)))
- (incf (ripemd-128-amount state) length)
- state))
+ (flet ((compress (state sequence offset)
+ (let ((block (ripemd-128-block state)))
+ (fill-block-ub8-le block sequence offset)
+ (update-ripemd-128-block (ripemd-128-regs state) block))))
+ (declare (dynamic-extent #'compress))
+ (declare (notinline mdx-updater))
+ (mdx-updater state #'compress sequence start end)))
(define-digest-finalizer (ripemd-128 16)
"If the given ripemd-128-state has not already been finalized, finalize it,
Oops, something went wrong.

0 comments on commit 15a5721

Please sign in to comment.