md5.lisp

(defpackage :md5
  (:use :cl)
  (:shadow :cl
           :count
           :block)
  (:export :init
           :update
           :digest
           :hexdigest))
(in-package :md5)

(deftype u8 () '(unsigned-byte 8))
(deftype u32 () '(unsigned-byte 32))

(declaim (inline mod32+)
         (ftype (function (u32 u32) u32) mod32+))
(defun mod32+ (x y)
  (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)))
  (ldb (byte 32 0) (+ x y)))

(declaim (inline rol32)
         (ftype (function (u32 (unsigned-byte 5)) u32) rol32))
(defun rol32 (x n)
  (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)))
  (logior (ldb (byte 32 0) (ash x n)) (ash x (- n 32))))

(defmacro incf32 (place &optional (delta 1))
  `(setf ,place (mod32+ ,place ,delta)))

(declaim (inline arraycopy))
(defun arraycopy (src src-off dst dst-off len)
  (declare (fixnum len src-off dst-off)
           ((simple-array u8 (*)) src dst)
           (optimize (speed 3) (safety 0) (space 0) (debug 0)))
  (dotimes (i len)
    (setf (aref dst (+ dst-off i)) (aref src (+ src-off i)))))

(defun u32-array (&rest items)
  (make-array (length items)
              :element-type 'u32
              :initial-contents items))

(defmacro u8->u32 (a b c d)
  `(the u32 (logior (ash ,d 24) (ash ,c 16) (ash ,b 8) ,a)))

(defconstant +reg-a+ (u8->u32 #x01 #x23 #x45 #x67))
(defconstant +reg-b+ (u8->u32 #x89 #xab #xcd #xef))
(defconstant +reg-c+ (u8->u32 #xfe #xdc #xba #x98))
(defconstant +reg-d+ (u8->u32 #x76 #x54 #x32 #x10))

(defparameter *padding*
  (make-array 64 :element-type 'u8
              :initial-contents
              '(#x80 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
                0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
                0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defparameter *t*
    (make-array 64 :element-type 'u32
                :initial-contents
                (loop for i from 1 to 64
                   collect (truncate
                            (* 4294967296
                               (abs (sin (float i 0.0d0)))))))))

(defmacro with-round ((op block) &body clauses)
  (loop for (a b c d k s i) in clauses
       collect `(setq ,a (mod32+ ,b (rol32 (mod32+ (mod32+ ,a (,op ,b ,c ,d))
                                                   (mod32+ (aref ,block ,k)
                                                           ,(aref *t* (1- i))))
                                           ,s)))
       into results
       finally (return `(progn ,@results))))

(declaim (inline f g h i)
         (ftype (function (u32 u32 u32) u32) f g h i))
(defun f (x y z)
  (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)))
  (logior (logand x y) (logandc1 x z)))

(defun g (x y z)
  (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)))
  (logior (logand x z) (logandc2 y z)))

(defun h (x y z)
  (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)))
  (logxor x y z))

(defun i (x y z)
  (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)))
  (ldb (byte 32 0) (logxor y (logorc2 x z))))

;; (array u8 64) -> (array u32 16)
(defun decode (input output off)
  (declare ((simple-array u8 (64)) input)
           ((simple-array u32 (16)) output)
           (fixnum off))
  (loop for i from 0
       for j from off below (+ off 64) by 4
       do (setf (aref output i)
                (logior (aref input j)
                        (ash (aref input (+ j 1)) 8)
                        (ash (aref input (+ j 2)) 16)
                        (ash (aref input (+ j 3)) 24)))))

;; (array u32) -> (array u8)
(defun encode (input)
  (let* ((len (ash (length input) 2))  ;; length * 4
         (output (make-array len :element-type 'u8)))
    (declare ((simple-array u32 (*)) input)
             ((simple-array u8 (*)) output))
    (loop for i from 0
       for j from 0 below len by 4
       do (let ((x (aref input i)))
            (setf (aref output j) (logand x #xff)
                  (aref output (+ j 1)) (logand (ash x -8) #xff)
                  (aref output (+ j 2)) (logand (ash x -16) #xff)
                  (aref output (+ j 3)) (logand (ash x -24) #xff))))
    output))

(defun transform (state block)
  (declare ((simple-array u32 (4)) state)
           ((simple-array u32 (16)) block)
           (optimize (speed 3) (safety 0) (space 0) (debug 0)))

  (let ((a (aref state 0))
        (b (aref state 1))
        (c (aref state 2))
        (d (aref state 3)))

    ;; Round 1
    (with-round (f block)
      (a b c d  0  7  1) (d a b c  1 12  2) (c d a b  2 17  3) (b c d a  3 22  4)
      (a b c d  4  7  5) (d a b c  5 12  6) (c d a b  6 17  7) (b c d a  7 22  8)
      (a b c d  8  7  9) (d a b c  9 12 10) (c d a b 10 17 11) (b c d a 11 22 12)
      (a b c d 12  7 13) (d a b c 13 12 14) (c d a b 14 17 15) (b c d a 15 22 16))

    ;; Round 2
    (with-round (g block)
      (a b c d  1  5 17) (d a b c  6  9 18) (c d a b 11 14 19) (b c d a  0 20 20)
      (a b c d  5  5 21) (d a b c 10  9 22) (c d a b 15 14 23) (b c d a  4 20 24)
      (a b c d  9  5 25) (d a b c 14  9 26) (c d a b  3 14 27) (b c d a  8 20 28)
      (a b c d 13  5 29) (d a b c  2  9 30) (c d a b  7 14 31) (b c d a 12 20 32))

    ;; Round 3
    (with-round (h block)
      (a b c d  5  4 33) (d a b c  8 11 34) (c d a b 11 16 35) (b c d a 14 23 36)
      (a b c d  1  4 37) (d a b c  4 11 38) (c d a b  7 16 39) (b c d a 10 23 40)
      (a b c d 13  4 41) (d a b c  0 11 42) (c d a b  3 16 43) (b c d a  6 23 44)
      (a b c d  9  4 45) (d a b c 12 11 46) (c d a b 15 16 47) (b c d a  2 23 48))

    ;; Round 4
    (with-round (i block)
      (a b c d  0  6 49) (d a b c  7 10 50) (c d a b 14 15 51) (b c d a  5 21 52)
      (a b c d 12  6 53) (d a b c  3 10 54) (c d a b 10 15 55) (b c d a  1 21 56)
      (a b c d  8  6 57) (d a b c 15 10 58) (c d a b  6 15 59) (b c d a 13 21 60)
      (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))

    (incf32 (aref state 0) a)
    (incf32 (aref state 1) b)
    (incf32 (aref state 2) c)
    (incf32 (aref state 3) d)))

(defstruct (md5-context (:constructor %make-md5-context)
                        (:conc-name ""))
  (state nil :type (simple-array u32 (4)))
  (count nil :type fixnum)
  (buffer nil :type (simple-array u8 (64)))
  (block nil :type (simple-array u32 (16)))
  (computed nil))

(defun make-md5-context ()
  (%make-md5-context :state (make-array 4
                                       :element-type 'u32
                                       :initial-contents (list +reg-a+ +reg-b+ +reg-c+ +reg-d+))
                    :count 0
                    :buffer (make-array 64 :element-type 'u8)
                    :block (make-array 16 :element-type 'u32)
                    :computed nil))

(defun %init (ctx)
  (declare (md5-context ctx))
  (flet ((fill-zero (array)
           (dotimes (i (length array))
             (setf (aref array i) 0))))
    (setf (aref (state ctx) 0) +reg-a+
          (aref (state ctx) 1) +reg-b+
          (aref (state ctx) 2) +reg-c+
          (aref (state ctx) 3) +reg-d+)
    (setf (count ctx) 0)
    (fill-zero (buffer ctx))
    (fill-zero (block ctx))
    (setf (computed ctx) nil)))

(defun init (&optional ctx)
  (if ctx
      (%init ctx)
      (make-md5-context)))

(defun update (ctx input &key off len)
  (declare (md5-context ctx))
  (let* ((off (or off 0))
         (len (or len (- (length input) off)))
         (idx (logand (count ctx) #x3f))
         (block (block ctx)))
    (incf32 (count ctx) len)
    (let ((part-len (- 64 idx)))
      (if (< len part-len)
          (arraycopy input 0 (buffer ctx) idx len)
          (progn
            (arraycopy input 0 (buffer ctx) idx part-len)
            (decode (buffer ctx) block 0)
            (transform (state ctx) block)
            (loop for i from part-len by 64
               while (< (+ i 63) len)
               do (progn
                    (decode input block i)
                    (transform (state ctx) block))
               finally (arraycopy input i (buffer ctx) 0 (- len i))))))
    ctx))

(defun digest (ctx)
  (declare (md5-context ctx))
  (or (computed ctx)
      (let* ((bits-count (ldb (byte 64 0) (ash (count ctx) 3)))
             (count-array (u32-array (ldb (byte 32 0) bits-count)
                                     (ldb (byte 32 32) bits-count)))
             (bits (encode count-array))
             (idx (logand (count ctx) #x3f)) ;; count MOD 64
             (pad-len (if (< idx 56) (- 56 idx) (- 120 idx))))
        (update ctx *padding* :len pad-len)
        (update ctx bits)
        (setf (computed ctx)
              (encode (state ctx))))))

(defun hexdigest (ctx)
  (declare (md5-context ctx))
  (hexdigest-bytes (digest ctx)))

(let ((digits "0123456789abcdef"))
  (defun hexdigest-bytes (bytes)
    (declare ((simple-array u8 (16)) bytes))
    (let* ((hex (make-string 32)))
      (declare ((string 32) hex))
      (loop for i from 0 below 16
         for j from 0 by 2
         do (let ((b (aref bytes i)))
              (setf (aref hex j)      (schar digits (logand (ash b -4) #xf))
                    (aref hex (1+ j)) (schar digits (logand b #xf)))))
      hex)))

;;;
;;; test
;;;
(defmacro testcase (input output)
  `(cons ,(sb-ext:string-to-octets input) ,output))

(defun run-test ()
  (flet ((run (&rest testcases)
           (loop for (arg . expected) in testcases
              do (let ((ctx (init)))
                   (update ctx arg)
                   (let ((actual (hexdigest ctx)))
                     (unless (equal actual expected)
                       (warn "expected ~S but was ~S" expected actual)))))))
    (run
     ;; rfc 1321 tests
     (testcase "" "d41d8cd98f00b204e9800998ecf8427e")
     (testcase "a" "0cc175b9c0f1b6a831c399e269772661")
     (testcase "abc" "900150983cd24fb0d6963f7d28e17f72")
     (testcase "message digest" "f96b697d7cb7938d525a2f31aaf161d0")
     (testcase "abcdefghijklmnopqrstuvwxyz" "c3fcd3d76192e4007dfb496cca67e13b")
     (testcase "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" "d174ab98d277d9f5a5611c2c9f419d9f")
     (testcase "12345678901234567890123456789012345678901234567890123456789012345678901234567890" "57edf4a22be3c955ac49da2e2107b67a")

     ;; sb-md5 tests
     (testcase "1631901HERR BUCHHEISTERCITROEN NORD1043360796beckenbauer" "d734945e5930bb28859ccd13c830358b")
     (testcase "" "d41d8cd98f00b204e9800998ecf8427e")
     (testcase "a" "0cc175b9c0f1b6a831c399e269772661")
     (testcase "aa" "4124bc0a9335c27f086f24ba207a4912")
     (testcase "aaa" "47bce5c74f589f4867dbd57e9ca9f808")
     (testcase "aaaa" "74b87337454200d4d33f80c4663dc5e5")
     (testcase "aaaaa" "594f803b380a41396ed63dca39503542")
     (testcase "aaaaaa" "0b4e7a0e5fe84ad35fb5f95b9ceeac79")
     (testcase "aaaaaaa" "5d793fc5b00a2348c3fb9ab59e5ca98a")
     (testcase "aaaaaaaa" "3dbe00a167653a1aaee01d93e77e730e")
     (testcase "aaaaaaaaa" "552e6a97297c53e592208cf97fbb3b60")
     (testcase "aaaaaaaaaa" "e09c80c42fda55f9d992e59ca6b3307d")
     (testcase "aaaaaaaaaaa" "d57f21e6a273781dbf8b7657940f3b03")
     (testcase "aaaaaaaaaaaa" "45e4812014d83dde5666ebdf5a8ed1ed")
     (testcase "aaaaaaaaaaaaa" "c162de19c4c3731ca3428769d0cd593d")
     (testcase "aaaaaaaaaaaaaa" "451599a5f9afa91a0f2097040a796f3d")
     (testcase "aaaaaaaaaaaaaaa" "12f9cf6998d52dbe773b06f848bb3608")
     (testcase "aaaaaaaaaaaaaaaa" "23ca472302f49b3ea5592b146a312da0")
     (testcase "aaaaaaaaaaaaaaaaa" "88e42e96cc71151b6e1938a1699b0a27")
     (testcase "aaaaaaaaaaaaaaaaaa" "2c60c24e7087e18e45055a33f9a5be91")
     (testcase "aaaaaaaaaaaaaaaaaaa" "639d76897485360b3147e66e0a8a3d6c")
     (testcase "aaaaaaaaaaaaaaaaaaaa" "22d42eb002cefa81e9ad604ea57bc01d")
     (testcase "aaaaaaaaaaaaaaaaaaaaa" "bd049f221af82804c5a2826809337c9b")
     (testcase "aaaaaaaaaaaaaaaaaaaaaa" "ff49cfac3968dbce26ebe7d4823e58bd")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaa" "d95dbfee231e34cccb8c04444412ed7d")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaa" "40edae4bad0e5bf6d6c2dc5615a86afb")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaa" "a5a8bfa3962f49330227955e24a2e67c")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaa" "ae791f19bdf77357ff10bb6b0e97e121")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaa" "aaab9c59a88bf0bdfcb170546c5459d6")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaa" "b0f0545856af1a340acdedce23c54b97")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "f7ce3d7d44f3342107d884bfa90c966a")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "59e794d45697b360e18ba972bada0123")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "3b0845db57c200be6052466f87b2198a")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "5eca9bd3eb07c006cd43ae48dfde7fd3")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "b4f13cb081e412f44e99742cb128a1a5")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "4c660346451b8cf91ef50f4634458d41")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "11db24dc3f6c2145701db08625dd6d76")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "80dad3aad8584778352c68ab06250327")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "1227fe415e79db47285cb2689c93963f")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "8e084f489f1bdf08c39f98ff6447ce6d")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "08b2f2b0864bac1ba1585043362cbec9")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "4697843037d962f62a5a429e611e0f5f")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "10c4da18575c092b486f8ab96c01c02f")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "af205d729450b663f48b11d839a1c8df")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "0d3f91798fac6ee279ec2485b25f1124")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "4c3c7c067634daec9716a80ea886d123")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "d1e358e6e3b707282cdd06e919f7e08c")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "8c6ded4f0af86e0a7e301f8a716c4363")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "4c2d8bcb02d982d7cb77f649c0a2dea8")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "bdb662f765cd310f2a547cab1cfecef6")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "08ff5f7301d30200ab89169f6afdb7af")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "6eb6a030bcce166534b95bc2ab45d9cf")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "1bb77918e5695c944be02c16ae29b25e")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "b6fe77c19f0f0f4946c761d62585bfea")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "e9e7e260dce84ffa6e0e7eb5fd9d37fc")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "eced9e0b81ef2bba605cbc5e2e76a1d0")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "ef1772b6dff9a122358552954ad0df65")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "3b0c8ac703f828b04c6c197006d17218")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "652b906d60af96844ebd21b674f35e93")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "dc2f2f2462a0d72358b2f99389458606")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "762fc2665994b217c52c3c2eb7d9f406")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "cc7ed669cf88f201c3297c6a91e1d18d")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "cced11f7bbbffea2f718903216643648")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "24612f0ce2c9d2cf2b022ef1e027a54f")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "b06521f39153d618550606be297466d5")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "014842d480b571495a4a0363793f7367")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "c743a45e0d2e6a95cb859adae0248435")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "def5d97e01e1219fb2fc8da6c4d6ba2f")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "92cb737f8687ccb93022fdb411a77cca")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "a0d1395c7fb36247bfe2d49376d9d133")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "ab75504250558b788f99d1ebd219abf2"))))

;; REPL: (require 'sb-md5)
(defun run-test-sb-md5 ()
  (flet ((run (&rest testcases)
           (loop for (arg . expected) in testcases
              do (let ((ctx (sb-md5:make-md5-state)))
                   (sb-md5:update-md5-state ctx arg)
                   (let ((actual (hexdigest-bytes (sb-md5:finalize-md5-state ctx))))
                     (unless (equal actual expected)
                       (warn "expected ~S but was ~S" expected actual)))))))
    (run
     ;; rfc 1321 tests
     (testcase "" "d41d8cd98f00b204e9800998ecf8427e")
     (testcase "a" "0cc175b9c0f1b6a831c399e269772661")
     (testcase "abc" "900150983cd24fb0d6963f7d28e17f72")
     (testcase "message digest" "f96b697d7cb7938d525a2f31aaf161d0")
     (testcase "abcdefghijklmnopqrstuvwxyz" "c3fcd3d76192e4007dfb496cca67e13b")
     (testcase "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" "d174ab98d277d9f5a5611c2c9f419d9f")
     (testcase "12345678901234567890123456789012345678901234567890123456789012345678901234567890" "57edf4a22be3c955ac49da2e2107b67a")

     ;; sb-md5 tests
     (testcase "1631901HERR BUCHHEISTERCITROEN NORD1043360796beckenbauer" "d734945e5930bb28859ccd13c830358b")
     (testcase "" "d41d8cd98f00b204e9800998ecf8427e")
     (testcase "a" "0cc175b9c0f1b6a831c399e269772661")
     (testcase "aa" "4124bc0a9335c27f086f24ba207a4912")
     (testcase "aaa" "47bce5c74f589f4867dbd57e9ca9f808")
     (testcase "aaaa" "74b87337454200d4d33f80c4663dc5e5")
     (testcase "aaaaa" "594f803b380a41396ed63dca39503542")
     (testcase "aaaaaa" "0b4e7a0e5fe84ad35fb5f95b9ceeac79")
     (testcase "aaaaaaa" "5d793fc5b00a2348c3fb9ab59e5ca98a")
     (testcase "aaaaaaaa" "3dbe00a167653a1aaee01d93e77e730e")
     (testcase "aaaaaaaaa" "552e6a97297c53e592208cf97fbb3b60")
     (testcase "aaaaaaaaaa" "e09c80c42fda55f9d992e59ca6b3307d")
     (testcase "aaaaaaaaaaa" "d57f21e6a273781dbf8b7657940f3b03")
     (testcase "aaaaaaaaaaaa" "45e4812014d83dde5666ebdf5a8ed1ed")
     (testcase "aaaaaaaaaaaaa" "c162de19c4c3731ca3428769d0cd593d")
     (testcase "aaaaaaaaaaaaaa" "451599a5f9afa91a0f2097040a796f3d")
     (testcase "aaaaaaaaaaaaaaa" "12f9cf6998d52dbe773b06f848bb3608")
     (testcase "aaaaaaaaaaaaaaaa" "23ca472302f49b3ea5592b146a312da0")
     (testcase "aaaaaaaaaaaaaaaaa" "88e42e96cc71151b6e1938a1699b0a27")
     (testcase "aaaaaaaaaaaaaaaaaa" "2c60c24e7087e18e45055a33f9a5be91")
     (testcase "aaaaaaaaaaaaaaaaaaa" "639d76897485360b3147e66e0a8a3d6c")
     (testcase "aaaaaaaaaaaaaaaaaaaa" "22d42eb002cefa81e9ad604ea57bc01d")
     (testcase "aaaaaaaaaaaaaaaaaaaaa" "bd049f221af82804c5a2826809337c9b")
     (testcase "aaaaaaaaaaaaaaaaaaaaaa" "ff49cfac3968dbce26ebe7d4823e58bd")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaa" "d95dbfee231e34cccb8c04444412ed7d")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaa" "40edae4bad0e5bf6d6c2dc5615a86afb")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaa" "a5a8bfa3962f49330227955e24a2e67c")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaa" "ae791f19bdf77357ff10bb6b0e97e121")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaa" "aaab9c59a88bf0bdfcb170546c5459d6")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaa" "b0f0545856af1a340acdedce23c54b97")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "f7ce3d7d44f3342107d884bfa90c966a")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "59e794d45697b360e18ba972bada0123")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "3b0845db57c200be6052466f87b2198a")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "5eca9bd3eb07c006cd43ae48dfde7fd3")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "b4f13cb081e412f44e99742cb128a1a5")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "4c660346451b8cf91ef50f4634458d41")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "11db24dc3f6c2145701db08625dd6d76")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "80dad3aad8584778352c68ab06250327")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "1227fe415e79db47285cb2689c93963f")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "8e084f489f1bdf08c39f98ff6447ce6d")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "08b2f2b0864bac1ba1585043362cbec9")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "4697843037d962f62a5a429e611e0f5f")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "10c4da18575c092b486f8ab96c01c02f")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "af205d729450b663f48b11d839a1c8df")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "0d3f91798fac6ee279ec2485b25f1124")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "4c3c7c067634daec9716a80ea886d123")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "d1e358e6e3b707282cdd06e919f7e08c")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "8c6ded4f0af86e0a7e301f8a716c4363")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "4c2d8bcb02d982d7cb77f649c0a2dea8")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "bdb662f765cd310f2a547cab1cfecef6")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "08ff5f7301d30200ab89169f6afdb7af")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "6eb6a030bcce166534b95bc2ab45d9cf")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "1bb77918e5695c944be02c16ae29b25e")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "b6fe77c19f0f0f4946c761d62585bfea")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "e9e7e260dce84ffa6e0e7eb5fd9d37fc")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "eced9e0b81ef2bba605cbc5e2e76a1d0")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "ef1772b6dff9a122358552954ad0df65")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "3b0c8ac703f828b04c6c197006d17218")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "652b906d60af96844ebd21b674f35e93")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "dc2f2f2462a0d72358b2f99389458606")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "762fc2665994b217c52c3c2eb7d9f406")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "cc7ed669cf88f201c3297c6a91e1d18d")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "cced11f7bbbffea2f718903216643648")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "24612f0ce2c9d2cf2b022ef1e027a54f")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "b06521f39153d618550606be297466d5")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "014842d480b571495a4a0363793f7367")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "c743a45e0d2e6a95cb859adae0248435")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "def5d97e01e1219fb2fc8da6c4d6ba2f")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "92cb737f8687ccb93022fdb411a77cca")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "a0d1395c7fb36247bfe2d49376d9d133")
     (testcase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "ab75504250558b788f99d1ebd219abf2"))))

#|
MD5> (progn (sb-ext:gc :full t) (time (loop repeat 10000 do (run-test))))
Evaluation took:
  0.765 seconds of real time
  0.767122 seconds of total run time (0.751498 user, 0.015624 system)
  [ Run times consist of 0.036 seconds GC time, and 0.732 seconds non-GC time. ]
  100.26% CPU
  1,907,924,506 processor cycles
  449,308,272 bytes consed
  
NIL
MD5> (progn (sb-ext:gc :full t) (time (loop repeat 10000 do (run-test-sb-md5))))
Evaluation took:
  0.741 seconds of real time
  0.744269 seconds of total run time (0.728191 user, 0.016078 system)
  [ Run times consist of 0.035 seconds GC time, and 0.710 seconds non-GC time. ]
  100.40% CPU
  1,848,789,150 processor cycles
  574,083,520 bytes consed
  
NIL
|#