X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-md5%2Fmd5.lisp;h=ab006e978465551da528de1118709f5070903381;hb=ad3beba970fab6e451a461c9f9b14faf4ef17718;hp=8563c8a4af03c57d9ce9fc8babb6da4bb286abd1;hpb=257680b92edd0f8a698325790c082303a1493c7b;p=sbcl.git diff --git a/contrib/sb-md5/md5.lisp b/contrib/sb-md5/md5.lisp index 8563c8a..ab006e9 100644 --- a/contrib/sb-md5/md5.lisp +++ b/contrib/sb-md5/md5.lisp @@ -277,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) @@ -306,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) @@ -380,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 @@ -519,29 +506,37 @@ The resulting MD5 message-digest is returned as an array of sixteen "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))) - (declare (type md5-state state)) - #+cmu - (lisp::with-array-data ((data sequence) (real-start start) (real-end end)) - (update-md5-state state data :start real-start :end real-end)) - #+sbcl - (sb-kernel:with-array-data ((data sequence) (real-start start) (real-end end)) - (update-md5-state state data :start real-start :end real-end)) - #-(or cmu sbcl) - (let ((real-end (or end (length sequence)))) - (declare (type fixnum real-end)) - (update-md5-state state sequence :start start :end real-end)) - (finalize-md5-state state))) + (declare (optimize (speed 3) (safety 3) (space 0) (debug 1)) + (type (vector (unsigned-byte 8)) sequence) (type fixnum start)) + (locally + (declare (optimize (safety 1) (debug 0))) + (let ((state (make-md5-state))) + (declare (type md5-state state)) + #+cmu + (lisp::with-array-data ((data sequence) (real-start start) (real-end end)) + (update-md5-state state data :start real-start :end real-end)) + #+sbcl + (sb-kernel:with-array-data ((data sequence) (real-start start) (real-end end)) + (update-md5-state state data :start real-start :end real-end)) + #-(or cmu sbcl) + (let ((real-end (or end (length sequence)))) + (declare (type fixnum real-end)) + (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) - (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))) + "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) (safety 3) (space 0) (debug 1)) + (type string string) (type fixnum start)) + (locally + (declare (optimize (safety 1) (debug 0))) + (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 @@ -552,37 +547,44 @@ operations. This should be a multiple of 64, the MD5 block size.") (defun md5sum-stream (stream) "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)) - (cond - ((equal (stream-element-type stream) '(unsigned-byte 8)) - (let ((buffer (make-array +buffer-size+ - :element-type '(unsigned-byte 8)))) - (declare (type (simple-array (unsigned-byte 8) (#.+buffer-size+)) - buffer)) - (loop for bytes of-type buffer-index = (read-sequence buffer stream) - do (update-md5-state state buffer :end bytes) - until (< bytes +buffer-size+) - finally - (return (finalize-md5-state state))))) - ((equal (stream-element-type stream) 'character) - (let ((buffer (make-string +buffer-size+))) - (declare (type (simple-string #.+buffer-size+) buffer)) - (loop for bytes of-type buffer-index = (read-sequence buffer stream) - do (update-md5-state state buffer :end bytes) - until (< bytes +buffer-size+) - finally - (return (finalize-md5-state state))))) - (t - (error "Unsupported stream element-type ~S for stream ~S." - (stream-element-type stream) stream))))) + (declare (optimize (speed 3) (safety 3) (space 0) (debug 1))) + (declare (type stream stream)) + (locally + (declare (optimize (safety 1) (debug 0))) + (let ((state (make-md5-state))) + (declare (type md5-state state)) + (cond + ((equal (stream-element-type stream) '(unsigned-byte 8)) + (let ((buffer (make-array +buffer-size+ + :element-type '(unsigned-byte 8)))) + (declare (type (simple-array (unsigned-byte 8) (#.+buffer-size+)) + buffer)) + (loop for bytes of-type buffer-index = (read-sequence buffer stream) + do (update-md5-state state buffer :end bytes) + until (< bytes +buffer-size+) + finally + (return (finalize-md5-state state))))) + #+(or) + ((equal (stream-element-type stream) 'character) + (let ((buffer (make-string +buffer-size+))) + (declare (type (simple-string #.+buffer-size+) buffer)) + (loop for bytes of-type buffer-index = (read-sequence buffer stream) + do (update-md5-state state buffer :end bytes) + until (< bytes +buffer-size+) + finally + (return (finalize-md5-state state))))) + (t + (error "Unsupported stream element-type ~S for stream ~S." + (stream-element-type stream) stream)))))) (defun md5sum-file (pathname) - "Calculate the MD5 message-digest of the file specified by pathname." - (declare (optimize (speed 3) (space 0) (debug 0))) - (with-open-file (stream pathname :element-type '(unsigned-byte 8)) - (md5sum-stream stream))) + "Calculate the MD5 message-digest of the file designated by +pathname." + (declare (optimize (speed 3) (safety 3) (space 0) (debug 1))) + (locally + (declare (optimize (safety 1) (debug 0))) + (with-open-file (stream pathname :element-type '(unsigned-byte 8)) + (md5sum-stream stream)))) #+cmu (eval-when (:compile-toplevel :execute) @@ -594,4 +596,4 @@ element-type has to be (UNSIGNED-BYTE 8)." #+sbcl (eval-when (:compile-toplevel) - (setq *features* *old-features*)) \ No newline at end of file + (setq *features* *old-features*))