OSCL/md5
2
0
Fork 0
mirror of https://github.com/pmai/md5.git synced 2025-12-21 22:44:29 +01:00
Code Issues Packages Projects Releases Wiki Activity

Remove historical tabs from source code.

Browse Source
This commit is contained in:
Pierre R. Mai
2012-10-22 14:45:06 +02:00
parent 2d2ea145bf
commit 55b8b3ff8c
1 changed files with 105 additions and 105 deletions
Download Patch File Download Diff File Expand all files Collapse all files

210
md5.lisp
View File

@ -106,14 +106,14 @@ where a is the intended low-order byte and d the high-order byte."
;;; Section 3.4: Auxilliary functions ;;; Section 3.4: Auxilliary functions
(declaim (inline f g h i) (declaim (inline f g h i)
(ftype (function (ub32 ub32 ub32) ub32) f g h i)) (ftype (function (ub32 ub32 ub32) ub32) f g h i))
(defun f (x y z) (defun f (x y z)
(declare (type ub32 x y z) (declare (type ub32 x y z)
(optimize (speed 3) (safety 0) (space 0) (debug 0) #+lw-int32 (float 0))) (optimize (speed 3) (safety 0) (space 0) (debug 0) #+lw-int32 (float 0)))
#+cmu #+cmu
(kernel:32bit-logical-or (kernel:32bit-logical-and x y) (kernel:32bit-logical-or (kernel:32bit-logical-and x y)
(kernel:32bit-logical-andc1 x z)) (kernel:32bit-logical-andc1 x z))
#+lw-int32 #+lw-int32
(sys:int32-logior (sys:int32-logand x y) (sys:int32-logandc1 x z)) (sys:int32-logior (sys:int32-logand x y) (sys:int32-logandc1 x z))
#-(or :cmu :lw-int32) #-(or :cmu :lw-int32)
@ -121,10 +121,10 @@ where a is the intended low-order byte and d the high-order byte."
(defun g (x y z) (defun g (x y z)
(declare (type ub32 x y z) (declare (type ub32 x y z)
(optimize (speed 3) (safety 0) (space 0) (debug 0) #+lw-int32 (float 0))) (optimize (speed 3) (safety 0) (space 0) (debug 0) #+lw-int32 (float 0)))
#+cmu #+cmu
(kernel:32bit-logical-or (kernel:32bit-logical-and x z) (kernel:32bit-logical-or (kernel:32bit-logical-and x z)
(kernel:32bit-logical-andc2 y z)) (kernel:32bit-logical-andc2 y z))
#+lw-int32 #+lw-int32
(sys:int32-logior (sys:int32-logand x z) (sys:int32-logandc2 y z)) (sys:int32-logior (sys:int32-logand x z) (sys:int32-logandc2 y z))
#-(or :cmu :lw-int32) #-(or :cmu :lw-int32)
@ -132,7 +132,7 @@ where a is the intended low-order byte and d the high-order byte."
(defun h (x y z) (defun h (x y z)
(declare (type ub32 x y z) (declare (type ub32 x y z)
(optimize (speed 3) (safety 0) (space 0) (debug 0) #+lw-int32 (float 0))) (optimize (speed 3) (safety 0) (space 0) (debug 0) #+lw-int32 (float 0)))
#+cmu #+cmu
(kernel:32bit-logical-xor x (kernel:32bit-logical-xor y z)) (kernel:32bit-logical-xor x (kernel:32bit-logical-xor y z))
#+lw-int32 #+lw-int32
@ -142,7 +142,7 @@ where a is the intended low-order byte and d the high-order byte."
(defun i (x y z) (defun i (x y z)
(declare (type ub32 x y z) (declare (type ub32 x y z)
(optimize (speed 3) (safety 0) (space 0) (debug 0) #+lw-int32 (float 0))) (optimize (speed 3) (safety 0) (space 0) (debug 0) #+lw-int32 (float 0)))
#+cmu #+cmu
(kernel:32bit-logical-xor y (kernel:32bit-logical-orc2 x z)) (kernel:32bit-logical-xor y (kernel:32bit-logical-orc2 x z))
#+lw-int32 #+lw-int32
@ -151,7 +151,7 @@ where a is the intended low-order byte and d the high-order byte."
(ldb (byte 32 0) (logxor y (logorc2 x z)))) (ldb (byte 32 0) (logxor y (logorc2 x z))))
(declaim (inline mod32+) (declaim (inline mod32+)
(ftype (function (ub32 ub32) ub32) mod32+)) (ftype (function (ub32 ub32) ub32) mod32+))
(defun mod32+ (a b) (defun mod32+ (a b)
(declare (type ub32 a b) (declare (type ub32 a b)
(optimize (speed 3) (safety 0) (space 0) (debug 0) #+lw-int32 (float 0))) (optimize (speed 3) (safety 0) (space 0) (debug 0) #+lw-int32 (float 0)))
@ -170,7 +170,7 @@ where a is the intended low-order byte and d the high-order byte."
#+lw-int32 #+lw-int32
(declaim (inline int32>>logical) (declaim (inline int32>>logical)
(ftype (function (sys:int32 (unsigned-byte 5)) sys:int32) int32>>logical)) (ftype (function (sys:int32 (unsigned-byte 5)) sys:int32) int32>>logical))
#+lw-int32 #+lw-int32
(defun int32>>logical (a s) (defun int32>>logical (a s)
(declare (type ub32 a) (type (unsigned-byte 5) s) (declare (type ub32 a) (type (unsigned-byte 5) s)
@ -180,10 +180,10 @@ where a is the intended low-order byte and d the high-order byte."
(sys:int32>> a s))) (sys:int32>> a s)))
(declaim (inline rol32) (declaim (inline rol32)
(ftype (function (ub32 (unsigned-byte 5)) ub32) rol32)) (ftype (function (ub32 (unsigned-byte 5)) ub32) rol32))
(defun rol32 (a s) (defun rol32 (a s)
(declare (type ub32 a) (type (unsigned-byte 5) s) (declare (type ub32 a) (type (unsigned-byte 5) s)
(optimize (speed 3) (safety 0) (space 0) (debug 0) #+lw-int32 (float 0))) (optimize (speed 3) (safety 0) (space 0) (debug 0) #+lw-int32 (float 0)))
#+cmu #+cmu
(kernel:32bit-logical-or #+little-endian (kernel:shift-towards-end a s) (kernel:32bit-logical-or #+little-endian (kernel:shift-towards-end a s)
#+big-endian (kernel:shift-towards-start a s) #+big-endian (kernel:shift-towards-start a s)
@ -199,44 +199,44 @@ where a is the intended low-order byte and d the high-order byte."
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *t* (make-array 64 :element-type 'ub32 (defparameter *t* (make-array 64 :element-type 'ub32
:initial-contents :initial-contents
(loop for i from 1 to 64 (loop for i from 1 to 64
collect collect
(truncate (truncate
(* 4294967296 (* 4294967296
(abs (sin (float i 0.0d0))))))))) (abs (sin (float i 0.0d0)))))))))
;;; Section 3.4: Helper Macro for single round definitions ;;; Section 3.4: Helper Macro for single round definitions
#-lw-int32 #-lw-int32
(defmacro with-md5-round ((op block) &rest clauses) (defmacro with-md5-round ((op block) &rest clauses)
(loop for (a b c d k s i) in clauses (loop for (a b c d k s i) in clauses
collect collect
`(setq ,a (mod32+ ,b (rol32 (mod32+ (mod32+ ,a (,op ,b ,c ,d)) `(setq ,a (mod32+ ,b (rol32 (mod32+ (mod32+ ,a (,op ,b ,c ,d))
(mod32+ (ub32-aref ,block ,k) (mod32+ (ub32-aref ,block ,k)
,(aref *t* (1- i)))) ,(aref *t* (1- i))))
,s))) ,s)))
into result into result
finally finally
(return `(progn ,@result)))) (return `(progn ,@result))))
#+lw-int32 #+lw-int32
(defmacro with-md5-round ((op block) &rest clauses) (defmacro with-md5-round ((op block) &rest clauses)
(loop for (a b c d k s i) in clauses (loop for (a b c d k s i) in clauses
collect collect
`(setq ,a (mod32+ ,b (rol32 (mod32+ (mod32+ ,a (,op ,b ,c ,d)) `(setq ,a (mod32+ ,b (rol32 (mod32+ (mod32+ ,a (,op ,b ,c ,d))
(mod32+ (ub32-aref ,block ,k) (mod32+ (ub32-aref ,block ,k)
(sys:integer-to-int32 (sys:integer-to-int32
,(let ((t-val (aref *t* (1- i)))) ,(let ((t-val (aref *t* (1- i))))
(dpb (ldb (byte 32 0) t-val) (dpb (ldb (byte 32 0) t-val)
(byte 32 0) (byte 32 0)
(if (logbitp 31 t-val) (if (logbitp 31 t-val)
-1 -1
0)))))) 0))))))
,s))) ,s)))
into result into result
finally finally
(return `(progn ,@result)))) (return `(progn ,@result))))
;;; Section 3.3: (Initial) MD5 Working Set ;;; Section 3.3: (Initial) MD5 Working Set
@ -273,9 +273,9 @@ registers A, B, C and D."
(let ((regs (make-ub32-vector 4))) (let ((regs (make-ub32-vector 4)))
(declare (type md5-regs regs)) (declare (type md5-regs regs))
(setf (md5-regs-a regs) +md5-magic-a+ (setf (md5-regs-a regs) +md5-magic-a+
(md5-regs-b regs) +md5-magic-b+ (md5-regs-b regs) +md5-magic-b+
(md5-regs-c regs) +md5-magic-c+ (md5-regs-c regs) +md5-magic-c+
(md5-regs-d regs) +md5-magic-d+) (md5-regs-d regs) +md5-magic-d+)
regs)) regs))
;;; Section 3.4: Operation on 16-Word Blocks ;;; Section 3.4: Operation on 16-Word Blocks
@ -289,10 +289,10 @@ registers A, B, C and D."
word block of input, and updates the working state in A, B, C, and D word block of input, and updates the working state in A, B, C, and D
accordingly." accordingly."
(declare (type md5-regs regs) (declare (type md5-regs regs)
(type md5-block block) (type md5-block block)
(optimize (speed 3) (safety 0) (space 0) (debug 0) #+lw-int32 (float 0))) (optimize (speed 3) (safety 0) (space 0) (debug 0) #+lw-int32 (float 0)))
(let ((A (md5-regs-a regs)) (B (md5-regs-b regs)) (let ((A (md5-regs-a regs)) (B (md5-regs-b regs))
(C (md5-regs-c regs)) (D (md5-regs-d regs))) (C (md5-regs-c regs)) (D (md5-regs-d regs)))
(declare (type ub32 A B C D)) (declare (type ub32 A B C D))
;; Round 1 ;; Round 1
(with-md5-round (f block) (with-md5-round (f block)
@ -320,9 +320,9 @@ accordingly."
(A B C D 4 6 61)(D A B C 11 10 62)(C D A B 2 15 63)(B C D A 9 21 64)) (A B C D 4 6 61)(D A B C 11 10 62)(C D A B 2 15 63)(B C D A 9 21 64))
;; Update and return ;; Update and return
(setf (md5-regs-a regs) (mod32+ (md5-regs-a regs) A) (setf (md5-regs-a regs) (mod32+ (md5-regs-a regs) A)
(md5-regs-b regs) (mod32+ (md5-regs-b regs) B) (md5-regs-b regs) (mod32+ (md5-regs-b regs) B)
(md5-regs-c regs) (mod32+ (md5-regs-c regs) C) (md5-regs-c regs) (mod32+ (md5-regs-c regs) C)
(md5-regs-d regs) (mod32+ (md5-regs-d regs) D)) (md5-regs-d regs) (mod32+ (md5-regs-d regs) D))
regs)) regs))
;;; Section 3.4: Converting 8bit-vectors into 16-Word Blocks ;;; Section 3.4: Converting 8bit-vectors into 16-Word Blocks
@ -332,9 +332,9 @@ accordingly."
"Convert a complete 64 (unsigned-byte 8) input vector segment "Convert a complete 64 (unsigned-byte 8) input vector segment
starting from offset into the given 16 word MD5 block." starting from offset into the given 16 word MD5 block."
(declare (type (integer 0 #.(- most-positive-fixnum 64)) offset) (declare (type (integer 0 #.(- most-positive-fixnum 64)) offset)
(type md5-block block) (type md5-block block)
(type (simple-array (unsigned-byte 8) (*)) buffer) (type (simple-array (unsigned-byte 8) (*)) buffer)
(optimize (speed 3) (safety 0) (space 0) (debug 0) (optimize (speed 3) (safety 0) (space 0) (debug 0)
#+lw-int32 (float 0) #+lw-int32 (hcl:fixnum-safety 0))) #+lw-int32 (float 0) #+lw-int32 (hcl:fixnum-safety 0)))
#+(and :cmu :little-endian) #+(and :cmu :little-endian)
(kernel:bit-bash-copy (kernel:bit-bash-copy
@ -345,22 +345,22 @@ starting from offset into the given 16 word MD5 block."
(sb-kernel:ub8-bash-copy buffer offset block 0 64) (sb-kernel:ub8-bash-copy buffer offset block 0 64)
#-(or (and :sbcl :little-endian) (and :cmu :little-endian)) #-(or (and :sbcl :little-endian) (and :cmu :little-endian))
(loop for i of-type (integer 0 16) from 0 (loop for i of-type (integer 0 16) from 0
for j of-type (integer 0 #.most-positive-fixnum) for j of-type (integer 0 #.most-positive-fixnum)
from offset to (+ offset 63) by 4 from offset to (+ offset 63) by 4
do do
(setf (ub32-aref block i) (setf (ub32-aref block i)
(assemble-ub32 (aref buffer j) (assemble-ub32 (aref buffer j)
(aref buffer (+ j 1)) (aref buffer (+ j 1))
(aref buffer (+ j 2)) (aref buffer (+ j 2))
(aref buffer (+ j 3)))))) (aref buffer (+ j 3))))))
(defun fill-block-char (block buffer offset) (defun fill-block-char (block buffer offset)
"Convert a complete 64 character input string segment starting from "Convert a complete 64 character input string segment starting from
offset into the given 16 word MD5 block." offset into the given 16 word MD5 block."
(declare (type (integer 0 #.(- most-positive-fixnum 64)) offset) (declare (type (integer 0 #.(- most-positive-fixnum 64)) offset)
(type md5-block block) (type md5-block block)
(type simple-string buffer) (type simple-string buffer)
(optimize (speed 3) (safety 0) (space 0) (debug 0) (optimize (speed 3) (safety 0) (space 0) (debug 0)
#+lw-int32 (float 0) #+lw-int32 (hcl:fixnum-safety 0))) #+lw-int32 (float 0) #+lw-int32 (hcl:fixnum-safety 0)))
#+(and :cmu :little-endian) #+(and :cmu :little-endian)
(kernel:bit-bash-copy (kernel:bit-bash-copy
@ -371,14 +371,14 @@ offset into the given 16 word MD5 block."
(sb-kernel:ub8-bash-copy buffer offset block 0 64) (sb-kernel:ub8-bash-copy buffer offset block 0 64)
#-(or (and :sbcl :little-endian) (and :cmu :little-endian)) #-(or (and :sbcl :little-endian) (and :cmu :little-endian))
(loop for i of-type (integer 0 16) from 0 (loop for i of-type (integer 0 16) from 0
for j of-type (integer 0 #.most-positive-fixnum) for j of-type (integer 0 #.most-positive-fixnum)
from offset to (+ offset 63) by 4 from offset to (+ offset 63) by 4
do do
(setf (ub32-aref block i) (setf (ub32-aref block i)
(assemble-ub32 (char-code (schar buffer j)) (assemble-ub32 (char-code (schar buffer j))
(char-code (schar buffer (+ j 1))) (char-code (schar buffer (+ j 1)))
(char-code (schar buffer (+ j 2))) (char-code (schar buffer (+ j 2)))
(char-code (schar buffer (+ j 3))))))) (char-code (schar buffer (+ j 3)))))))
(defun fill-block (block buffer offset) (defun fill-block (block buffer offset)
"Convert a complete 64 byte input vector segment into the given 16 "Convert a complete 64 byte input vector segment into the given 16
@ -386,9 +386,9 @@ word MD5 block. This currently works on (unsigned-byte 8) and
character simple-arrays, via the functions `fill-block-ub8' and character simple-arrays, via the functions `fill-block-ub8' and
`fill-block-char' respectively." `fill-block-char' respectively."
(declare (type (integer 0 #.(- most-positive-fixnum 64)) offset) (declare (type (integer 0 #.(- most-positive-fixnum 64)) offset)
(type md5-block block) (type md5-block block)
(type (simple-array * (*)) buffer) (type (simple-array * (*)) buffer)
(optimize (speed 3) (safety 0) (space 0) (debug 0) (optimize (speed 3) (safety 0) (space 0) (debug 0)
#+lw-int32 (float 0) #+lw-int32 (hcl:fixnum-safety 0))) #+lw-int32 (float 0) #+lw-int32 (hcl:fixnum-safety 0)))
(etypecase buffer (etypecase buffer
((simple-array (unsigned-byte 8) (*)) ((simple-array (unsigned-byte 8) (*))
@ -404,19 +404,19 @@ character simple-arrays, via the functions `fill-block-ub8' and
in regs. Returns a (simple-array (unsigned-byte 8) (16))." in regs. Returns a (simple-array (unsigned-byte 8) (16))."
(declare (optimize (speed 3) (safety 0) (space 0) (debug 0) (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)
#+lw-int32 (float 0) #+lw-int32 (hcl:fixnum-safety 0)) #+lw-int32 (float 0) #+lw-int32 (hcl:fixnum-safety 0))
(type md5-regs regs)) (type md5-regs regs))
(let ((result (make-array 16 :element-type '(unsigned-byte 8)))) (let ((result (make-array 16 :element-type '(unsigned-byte 8))))
(declare (type (simple-array (unsigned-byte 8) (16)) result)) (declare (type (simple-array (unsigned-byte 8) (16)) result))
(macrolet ((frob (reg offset) (macrolet ((frob (reg offset)
(let ((var (gensym))) (let ((var (gensym)))
`(let ((,var #+lw-int32 (sys:int32-to-integer ,reg) `(let ((,var #+lw-int32 (sys:int32-to-integer ,reg)
#-lw-int32 ,reg)) #-lw-int32 ,reg))
(declare (type (unsigned-byte 32) ,var)) (declare (type (unsigned-byte 32) ,var))
(setf (setf
(aref result ,offset) (ldb (byte 8 0) ,var) (aref result ,offset) (ldb (byte 8 0) ,var)
(aref result ,(+ offset 1)) (ldb (byte 8 8) ,var) (aref result ,(+ offset 1)) (ldb (byte 8 8) ,var)
(aref result ,(+ offset 2)) (ldb (byte 8 16) ,var) (aref result ,(+ offset 2)) (ldb (byte 8 16) ,var)
(aref result ,(+ offset 3)) (ldb (byte 8 24) ,var)))))) (aref result ,(+ offset 3)) (ldb (byte 8 24) ,var))))))
(frob (md5-regs-a regs) 0) (frob (md5-regs-a regs) 0)
(frob (md5-regs-b regs) 4) (frob (md5-regs-b regs) 4)
(frob (md5-regs-c regs) 8) (frob (md5-regs-c regs) 8)
@ -426,15 +426,15 @@ in regs. Returns a (simple-array (unsigned-byte 8) (16))."
;;; Mid-Level Drivers ;;; Mid-Level Drivers
(defstruct (md5-state (defstruct (md5-state
(:constructor make-md5-state ()) (:constructor make-md5-state ())
(:copier)) (:copier))
(regs (initial-md5-regs) :type md5-regs :read-only t) (regs (initial-md5-regs) :type md5-regs :read-only t)
(amount 0 :type (amount 0 :type
#-md5-small-length (integer 0 *) #-md5-small-length (integer 0 *)
#+md5-small-length (unsigned-byte 29)) #+md5-small-length (unsigned-byte 29))
(block (make-ub32-vector 16) :read-only t :type md5-block) (block (make-ub32-vector 16) :read-only t :type md5-block)
(buffer (make-array 64 :element-type '(unsigned-byte 8)) :read-only t (buffer (make-array 64 :element-type '(unsigned-byte 8)) :read-only t
:type (simple-array (unsigned-byte 8) (64))) :type (simple-array (unsigned-byte 8) (64)))
(buffer-index 0 :type (integer 0 63)) (buffer-index 0 :type (integer 0 63))
(finalized-p nil)) (finalized-p nil))
@ -445,15 +445,15 @@ from-offset and copying count elements into the 64 byte buffer
starting at buffer-offset." starting at buffer-offset."
(declare (optimize (speed 3) (safety 0) (space 0) (debug 0) (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)
#+lw-int32 (float 0) #+lw-int32 (hcl:fixnum-safety 0)) #+lw-int32 (float 0) #+lw-int32 (hcl:fixnum-safety 0))
(type (unsigned-byte 29) from-offset) (type (unsigned-byte 29) from-offset)
(type (integer 0 63) count buffer-offset) (type (integer 0 63) count buffer-offset)
(type (simple-array * (*)) from) (type (simple-array * (*)) from)
(type (simple-array (unsigned-byte 8) (64)) buffer)) (type (simple-array (unsigned-byte 8) (64)) buffer))
#+cmu #+cmu
(kernel:bit-bash-copy (kernel:bit-bash-copy
from (+ (* vm:vector-data-offset vm:word-bits) (* from-offset vm:byte-bits)) from (+ (* vm:vector-data-offset vm:word-bits) (* from-offset vm:byte-bits))
buffer (+ (* vm:vector-data-offset vm:word-bits) buffer (+ (* vm:vector-data-offset vm:word-bits)
(* buffer-offset vm:byte-bits)) (* buffer-offset vm:byte-bits))
(* count vm:byte-bits)) (* count vm:byte-bits))
#+sbcl #+sbcl
(sb-kernel:ub8-bash-copy from from-offset buffer buffer-offset count) (sb-kernel:ub8-bash-copy from from-offset buffer buffer-offset count)
@ -461,28 +461,28 @@ starting at buffer-offset."
(etypecase from (etypecase from
(simple-string (simple-string
(loop for buffer-index of-type (integer 0 64) from buffer-offset (loop for buffer-index of-type (integer 0 64) from buffer-offset
for from-index of-type fixnum from from-offset for from-index of-type fixnum from from-offset
below (+ from-offset count) below (+ from-offset count)
do do
(setf (aref buffer buffer-index) (setf (aref buffer buffer-index)
(char-code (schar (the simple-string from) from-index))))) (char-code (schar (the simple-string from) from-index)))))
((simple-array (unsigned-byte 8) (*)) ((simple-array (unsigned-byte 8) (*))
(loop for buffer-index of-type (integer 0 64) from buffer-offset (loop for buffer-index of-type (integer 0 64) from buffer-offset
for from-index of-type fixnum from from-offset for from-index of-type fixnum from from-offset
below (+ from-offset count) below (+ from-offset count)
do do
(setf (aref buffer buffer-index) (setf (aref buffer buffer-index)
(aref (the (simple-array (unsigned-byte 8) (*)) from) (aref (the (simple-array (unsigned-byte 8) (*)) from)
from-index)))))) from-index))))))
(defun update-md5-state (state sequence &key (start 0) (end (length sequence))) (defun update-md5-state (state sequence &key (start 0) (end (length sequence)))
"Update the given md5-state from sequence, which is either a "Update the given md5-state from sequence, which is either a
simple-string or a simple-array with element-type (unsigned-byte 8), simple-string or a simple-array with element-type (unsigned-byte 8),
bounded by start and end, which must be numeric bounding-indices." bounded by start and end, which must be numeric bounding-indices."
(declare (type md5-state state) (declare (type md5-state state)
(type (simple-array * (*)) sequence) (type (simple-array * (*)) sequence)
(type fixnum start end) (type fixnum start end)
(optimize (speed 3) (safety 1) (space 0) (debug 1) (optimize (speed 3) (safety 1) (space 0) (debug 1)
#+lw-int32 (float 0) #+lw-int32 (hcl:fixnum-safety 0))) #+lw-int32 (float 0) #+lw-int32 (hcl:fixnum-safety 0)))
(locally (locally
(declare (optimize (safety 0) (debug 0))) (declare (optimize (safety 0) (debug 0)))
@ -556,7 +556,7 @@ The resulting MD5 message-digest is returned as an array of sixteen
(unsigned-byte 8) values. Calling `update-md5-state' after a call to (unsigned-byte 8) values. Calling `update-md5-state' after a call to
`finalize-md5-state' results in unspecified behaviour." `finalize-md5-state' results in unspecified behaviour."
(declare (type md5-state state) (declare (type md5-state state)
(optimize (speed 3) (safety 1) (space 0) (debug 1) #+lw-int32 (float 0))) (optimize (speed 3) (safety 1) (space 0) (debug 1) #+lw-int32 (float 0)))
(locally (locally
(declare (optimize (safety 0) (debug 0))) (declare (optimize (safety 0) (debug 0)))
(or (md5-state-finalized-p state) (or (md5-state-finalized-p state)
@ -600,7 +600,7 @@ this works for all sequences whose element-type is supported by the
underlying MD5 routines, on other implementations it only works for 1d underlying MD5 routines, on other implementations it only works for 1d
simple-arrays with such element types." simple-arrays with such element types."
(declare (optimize (speed 3) (safety 3) (space 0) (debug 1)) (declare (optimize (speed 3) (safety 3) (space 0) (debug 1))
(type vector sequence) (type fixnum start)) (type vector sequence) (type fixnum start))
(locally (locally
(declare (optimize (safety 1) (debug 0))) (declare (optimize (safety 1) (debug 0)))
(let ((state (make-md5-state))) (let ((state (make-md5-state)))
@ -841,10 +841,10 @@ according to my additional test suite")
(map 'list #'identity md5-digest-inc)) (map 'list #'identity md5-digest-inc))
do do
(format (format
*trace-output* *trace-output*
"~2&Test-Case ~D:~% Input: ~S~% Required: ~A~% Returned: ~A~% ~ "~2&Test-Case ~D:~% Input: ~S~% Required: ~A~% Returned: ~A~% ~
Returned incrementally: ~A~%" Returned incrementally: ~A~%"
count source md5-string md5-result-string md5-result-string-inc) count source md5-string md5-result-string md5-result-string-inc)
when (and (string= md5-string md5-result-string) when (and (string= md5-string md5-result-string)
(string= md5-string md5-result-string-inc)) (string= md5-string md5-result-string-inc))
do (format *trace-output* " OK~%") do (format *trace-output* " OK~%")