Actually this release was the first public release. It switches over to

using kernel:32bit-logical-* instead of the silly signed-byte acrobatics
that were previously needed to get the various logical and ash operations
optimized.  Also added rudimentary file-comment.
This commit is contained in:
2001-11-14 23:46:29 +01:00
parent 084b01d33a
commit 576ae1de32

View File

@ -1,3 +1,6 @@
;;;; This code implements MD5 checksums as defined in RFC 1321
;;;; It was written by Pierre R. Mai and placed into the public domain.
(defpackage :MD5 (:use :CL) (defpackage :MD5 (:use :CL)
(:export (:export
;; Low-Level types and functions ;; Low-Level types and functions
@ -18,42 +21,31 @@
;;; Section 3.4: Auxilliary functions ;;; Section 3.4: Auxilliary functions
(deftype ub32 () `(unsigned-byte 32)) (deftype ub32 () `(unsigned-byte 32))
(deftype sb32 () `(signed-byte 32))
(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))
(defmacro the-usb32 (x)
`(ext:truly-the sb32 (ext:truly-the ub32 ,x)))
(defmacro the-sb32 (x)
`(ext:truly-the sb32 ,x))
(defmacro the-ub32 (x)
`(ext:truly-the ub32 ,x))
(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))) (optimize (speed 3) (safety 0) (space 0) (debug 0)))
(the-ub32 (logior (the-sb32 (logand (the-usb32 x) (the-usb32 y))) (kernel:32bit-logical-or (kernel:32bit-logical-and x y)
(the-sb32 (logandc1 (the-usb32 x) (the-usb32 z)))))) (kernel:32bit-logical-andc1 x z)))
(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))) (optimize (speed 3) (safety 0) (space 0) (debug 0)))
(the-ub32 (logior (the-sb32 (logand (the-usb32 x) (the-usb32 z))) (kernel:32bit-logical-or (kernel:32bit-logical-and x z)
(the-sb32 (logandc2 (the-usb32 y) (the-usb32 z)))))) (kernel:32bit-logical-andc2 y z)))
(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))) (optimize (speed 3) (safety 0) (space 0) (debug 0)))
(the-ub32 (logxor (the-usb32 x) (the-usb32 y) (the-usb32 z)))) (kernel:32bit-logical-xor x (kernel:32bit-logical-xor y z)))
(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))) (optimize (speed 3) (safety 0) (space 0) (debug 0)))
(the-ub32 (logxor (the-usb32 y) (kernel:32bit-logical-xor y (kernel:32bit-logical-orc2 x z)))
(the-sb32 (logorc2 (the-usb32 x) (the-usb32 z))))))
(declaim (inline mod32+ rol32) (declaim (inline mod32+ rol32)
(ftype (function (ub32 ub32) ub32) mod32+)) (ftype (function (ub32 ub32) ub32) mod32+))
@ -65,8 +57,8 @@
(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))) (optimize (speed 3) (safety 0) (space 0) (debug 0)))
(ext:truly-the ub32 (logior (kernel:shift-towards-end a s) (kernel:32bit-logical-or (kernel:shift-towards-end a s)
(ash a (- s 32))))) (ash a (- s 32))))
(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