0.8.21.5:

[sbcl.git] / contrib / sb-md5 / md5.lisp

diff --git a/contrib/sb-md5/md5.lisp b/contrib/sb-md5/md5.lisp
index e362f74..eb7c7d5 100644 (file)
--- a/contrib/sb-md5/md5.lisp
+++ b/contrib/sb-md5/md5.lisp
@@ -40,7 +40,7 @@
    #:md5-state #:md5-state-p #:make-md5-state
    #:update-md5-state #:finalize-md5-state
    ;; High-Level functions on sequences, streams and files
-   #:md5sum-sequence #:md5sum-stream #:md5sum-file))
+   #:md5sum-sequence #:md5sum-string #:md5sum-stream #:md5sum-file))
 
 (in-package :SB-MD5)
 
@@ -81,10 +81,7 @@ where a is the intended low-order byte and d the high-order byte."
   #+cmu
   (kernel:32bit-logical-or (kernel:32bit-logical-and x y)
                           (kernel:32bit-logical-andc1 x z))
-  #+sbcl
-  (sb-kernel:32bit-logical-or (sb-kernel:32bit-logical-and x y)
-                             (sb-kernel:32bit-logical-andc1 x z))
-  #-(or cmu sbcl)
+  #-cmu
   (logior (logand x y) (logandc1 x z)))
 
 (defun g (x y z)
@@ -93,10 +90,7 @@ where a is the intended low-order byte and d the high-order byte."
   #+cmu
   (kernel:32bit-logical-or (kernel:32bit-logical-and x z)
                           (kernel:32bit-logical-andc2 y z))
-  #+sbcl
-  (sb-kernel:32bit-logical-or (sb-kernel:32bit-logical-and x z)
-                             (sb-kernel:32bit-logical-andc2 y z))
-  #-(or cmu sbcl)
+  #-cmu
   (logior (logand x z) (logandc2 y z)))
 
 (defun h (x y z)
@@ -104,9 +98,7 @@ where a is the intended low-order byte and d the high-order byte."
           (optimize (speed 3) (safety 0) (space 0) (debug 0)))
   #+cmu
   (kernel:32bit-logical-xor x (kernel:32bit-logical-xor y z))
-  #+sbcl
-  (sb-kernel:32bit-logical-xor x (sb-kernel:32bit-logical-xor y z))  
-  #-(or cmu sbcl)
+  #-cmu
   (logxor x y z))
 
 (defun i (x y z)
@@ -114,9 +106,7 @@ where a is the intended low-order byte and d the high-order byte."
           (optimize (speed 3) (safety 0) (space 0) (debug 0)))
   #+cmu
   (kernel:32bit-logical-xor y (kernel:32bit-logical-orc2 x z))
-  #+sbcl
-  (sb-kernel:32bit-logical-xor y (sb-kernel:32bit-logical-orc2 x z))  
-  #-(or cmu sbcl)
+  #-cmu
   (ldb (byte 32 0) (logxor y (logorc2 x z))))
 
 (declaim (inline mod32+)
@@ -129,11 +119,11 @@ where a is the intended low-order byte and d the high-order byte."
 (define-compiler-macro mod32+ (a b)
   `(ext:truly-the ub32 (+ ,a ,b)))
 
+;;; Dunno why we need this, but without it MOD32+ wasn't being
+;;; inlined.  Oh well.  -- CSR, 2003-09-14
 #+sbcl
-;;; FIXME: Check whether this actually does the right thing on the
-;;; alpha.
 (define-compiler-macro mod32+ (a b)
-  `(sb-ext:truly-the ub32 (+ ,a ,b)))
+  `(ldb (byte 32 0) (+ ,a ,b)))
 
 (declaim (inline rol32)
         (ftype (function (ub32 (unsigned-byte 5)) ub32) rol32))
@@ -287,11 +277,7 @@ starting from offset into the given 16 word MD5 block."
    block (* vm:vector-data-offset vm:word-bits)
    (* 64 vm:byte-bits))
   #+(and :sbcl :little-endian)
-  (sb-kernel:bit-bash-copy
-   buffer (+ (* sb-vm:vector-data-offset sb-vm:n-word-bits)
-            (* offset sb-vm:n-byte-bits))
-   block (* sb-vm:vector-data-offset sb-vm:n-word-bits)
-   (* 64 sb-vm:n-byte-bits))
+  (sb-kernel:ub8-bash-copy buffer offset block 0 64)
   #-(or (and :sbcl :little-endian) (and :cmu :little-endian))
   (loop for i of-type (integer 0 16) from 0
        for j of-type (integer 0 #.most-positive-fixnum)
@@ -316,11 +302,7 @@ offset into the given 16 word MD5 block."
    block (* vm:vector-data-offset vm:word-bits)
    (* 64 vm:byte-bits))
   #+(and :sbcl :little-endian)
-  (sb-kernel:bit-bash-copy
-   buffer (+ (* sb-vm:vector-data-offset sb-vm:n-word-bits)
-            (* offset sb-vm:n-byte-bits))
-   block (* sb-vm:vector-data-offset sb-vm:n-word-bits)
-   (* 64 sb-vm:n-byte-bits))
+  (sb-kernel:ub8-bash-copy buffer offset block 0 64)
   #-(or (and :sbcl :little-endian) (and :cmu :little-endian))
   (loop for i of-type (integer 0 16) from 0
        for j of-type (integer 0 #.most-positive-fixnum)
@@ -390,12 +372,7 @@ starting at buffer-offset."
             (* buffer-offset vm:byte-bits))
    (* count vm:byte-bits))
   #+sbcl
-  (sb-kernel:bit-bash-copy
-   from (+ (* sb-vm:vector-data-offset sb-vm:n-word-bits)
-          (* from-offset sb-vm:n-byte-bits))
-   buffer (+ (* sb-vm:vector-data-offset sb-vm:n-word-bits)
-            (* buffer-offset sb-vm:n-byte-bits))
-   (* count sb-vm:n-byte-bits))
+  (sb-kernel:ub8-bash-copy from from-offset buffer buffer-offset count)
   #-(or cmu sbcl)
   (etypecase from
     (simple-string
@@ -526,10 +503,9 @@ The resulting MD5 message-digest is returned as an array of sixteen
 ;;; High-Level Drivers
 
 (defun md5sum-sequence (sequence &key (start 0) end)
-  "Calculate the MD5 message-digest of data in sequence.  On CMU CL
-this works for all sequences whose element-type is supported by the
-underlying MD5 routines, on other implementations it only works for 1d
-simple-arrays with such element types."
+  "Calculate the MD5 message-digest of data bounded by START and END
+in SEQUENCE , which must be a vector with element-type (UNSIGNED-BYTE
+8)."
   (declare (optimize (speed 3) (space 0) (debug 0))
           (type vector sequence) (type fixnum start))
   (let ((state (make-md5-state)))
@@ -546,6 +522,18 @@ simple-arrays with such element types."
       (update-md5-state state sequence :start start :end real-end))
     (finalize-md5-state state)))
 
+(defun md5sum-string (string &key (external-format :default) (start 0) end)
+  "Calculate the MD5 message-digest of the binary representation
+of STRING (as octets) in EXTERNAL-FORMAT. The boundaries START
+and END refer to character positions in the string, not to octets
+in the resulting binary representation."
+  (declare (optimize (speed 3) (space 0) (debug 0))
+           (type string string))
+  (md5sum-sequence
+   (sb-ext:string-to-octets string
+                            :external-format external-format
+                            :start start :end end)))
+
 (defconstant +buffer-size+ (* 128 1024)
   "Size of internal buffer to use for md5sum-stream and md5sum-file
 operations.  This should be a multiple of 64, the MD5 block size.")
@@ -553,8 +541,8 @@ operations.  This should be a multiple of 64, the MD5 block size.")
 (deftype buffer-index () `(integer 0 ,+buffer-size+))
 
 (defun md5sum-stream (stream)
-  "Calculate an MD5 message-digest of the contents of stream.  Its
-element-type has to be either (unsigned-byte 8) or character."
+  "Calculate an MD5 message-digest of the contents of STREAM, whose
+element-type has to be (UNSIGNED-BYTE 8)."
   (declare (optimize (speed 3) (space 0) (debug 0)))
   (let ((state (make-md5-state)))
     (declare (type md5-state state))