Update documentation and version number for upcoming 2.0.3 release.

Add support for other implementations (flexi-streams dependency).

NEWS

@@ -1,3 +1,30 @@
+Release 2.0.3
+=============
+
+ * Add support for md5sum-string for other implementations through
+   through flexi-streams.  Patch supplied by Daniel Kochmanski.
+
+
+Release 2.0.2
+=============
+
+ * This release adds support for LispWorks 7.0, reworking the fixes
+   for 64-bit implementations of Lispworks in 2.0.1 and incorrect
+   use of the sys:simple-int32-vector type.  Patch supplied by
+   Martin Simmons from LispWorks.
+
+ * Minor fix to prevent style-warnings for implementations with no
+   support for md5sum-string.
+
+
+Release 2.0.1
+=============
+
+ * This release fixes problems on 64-bit implementations of Lispworks,
+   where sys:int32 arithmetic can overflow 32-bit values and hence
+   yield wrong results.
+
+
 Release 2.0.0
 =============
 

md5.asd

@@ -14,6 +14,10 @@
   :author "Pierre R. Mai <pmai@pmsf.de>"
   :maintainer "Pierre R. Mai <pmai@pmsf.de>"
   :licence "Public Domain"
-  :version "2.0.0"
-  #+sbcl :depends-on #+sbcl ("sb-rotate-byte")
+  :version "2.0.3"
+  :depends-on (#+sbcl "sb-rotate-byte"
+               #-(or :cmu :sbcl
+                     (and :lispworks (not :lispworks4))
+                     :ccl :allegro)
+               "flexi-streams")
   :components ((:file "md5")))

md5.lisp

@@ -87,7 +87,14 @@
 #+(and :lispworks (or (not :lispworks4) :lispworks4.4))
 (eval-when (:compile-toplevel :execute)
   (defparameter *old-features* *features*)
-  (pushnew :lw-int32 *features*))
+  (pushnew :lw-int32 *features*)
+  (defmacro lw-int32-no-overflow (value)
+    ;; Prevent overflow in 64-bit prior to LispWorks 7.0.
+    #+(and :lispworks-64bit (or :lispworks5 :lispworks6))
+    `(sys:int32>> (sys:int32<< ,value #.(sys:integer-to-int32 32))
+                  #.(sys:integer-to-int32 32))
+    #-(and :lispworks-64bit (or :lispworks5 :lispworks6))
+    value))
 
 ;;; Section 2:  Basic Datatypes
 
@@ -101,14 +108,16 @@
     "Assemble an ub32 value from the given (unsigned-byte 8) values,
 where a is the intended low-order byte and d the high-order byte."
     #+lw-int32
-    `(sys:int32-logior (sys:int32<< ,d 24)
+    `(lw-int32-no-overflow
+      (sys:int32-logior (sys:int32<< ,d 24)
                         (sys:int32-logior (sys:int32<< ,c 16)
-                                         (sys:int32-logior (sys:int32<< ,b 8) ,a)))
+                                          (sys:int32-logior (sys:int32<< ,b 8) ,a))))
     #-lw-int32
     `(the ub32 (logior (ash ,d 24) (ash ,c 16) (ash ,b 8) ,a))))
 
 (deftype ub32-vector (length)
-  #+lw-int32 `(sys:simple-int32-vector ,length)
+  #+lw-int32 (declare (ignore length))
+  #+lw-int32 'sys:simple-int32-vector
   #-lw-int32 `(simple-array (unsigned-byte 32) (,length)))
 
 (defmacro make-ub32-vector (length &rest args)
@@ -164,7 +173,7 @@ where a is the intended low-order byte and d the high-order byte."
   #+cmu
   (kernel:32bit-logical-xor y (kernel:32bit-logical-orc2 x z))
   #+lw-int32
-  (sys:int32-logxor y (sys:int32-logorc2 x z))
+  (lw-int32-no-overflow (sys:int32-logxor y (sys:int32-logorc2 x z)))
   #-(or :cmu :lw-int32)
   (ldb (byte 32 0) (logxor y (logorc2 x z))))
 
@@ -173,8 +182,10 @@ where a is the intended low-order byte and d the high-order byte."
 (defun mod32+ (a b)
   (declare (type ub32 a b)
            (optimize (speed 3) (safety 0) (space 0) (debug 0) #+lw-int32 (float 0)))
-  #+lw-int32 (sys:int32+ a b)
-  #-lw-int32 (ldb (byte 32 0) (+ a b)))
+  #+lw-int32
+  (lw-int32-no-overflow (sys:int32+ a b))
+  #-lw-int32
+  (ldb (byte 32 0) (+ a b)))
 
 #+cmu
 (define-compiler-macro mod32+ (a b)
@@ -209,7 +220,8 @@ where a is the intended low-order byte and d the high-order byte."
   #+sbcl
   (sb-rotate-byte:rotate-byte s (byte 32 0) a)
   #+lw-int32
-  (sys:int32-logior (sys:int32<< a s) (int32>>logical a (- 32 s)))
+  (sys:int32-logior (lw-int32-no-overflow (sys:int32<< a s))
+                    (int32>>logical a (- 32 s)))
   #-(or :cmu :sbcl :lw-int32)
   (logior (ldb (byte 32 0) (ash a s)) (ash a (- s 32))))
 
@@ -428,7 +440,7 @@ in `regs'.  Returns a (simple-array (unsigned-byte 8) (16))."
     (declare (type (simple-array (unsigned-byte 8) (16)) result))
     (macrolet ((frob (reg offset)
                  (let ((var (gensym)))
-                   `(let ((,var #+lw-int32 (sys:int32-to-integer ,reg)
+                   `(let ((,var #+lw-int32 (ldb (byte 32 0) (sys:int32-to-integer ,reg))
                                 #-lw-int32 ,reg))
                       (declare (type (unsigned-byte 32) ,var))
                       (setf
@@ -444,6 +456,9 @@ in `regs'.  Returns a (simple-array (unsigned-byte 8) (16))."
 
 ;;; Mid-Level Drivers
 
+(locally
+  (declare (optimize (speed 3) (safety 1) (space 0) (debug 1)
+                     #+lw-int32 (float 0)))
 (defstruct (md5-state
              (:constructor make-md5-state ())
              (:copier))
@@ -456,6 +471,7 @@ in `regs'.  Returns a (simple-array (unsigned-byte 8) (16))."
          :type (simple-array (unsigned-byte 8) (64)))
   (buffer-index 0 :type (integer 0 63))
   (finalized-p nil))
+)
 
 (declaim (inline copy-to-buffer))
 (defun copy-to-buffer (from from-offset count buffer buffer-offset)
@@ -660,7 +676,8 @@ positions in the string, not to octets in the resulting binary
 representation.  The permissible external format specifiers are
 determined by the underlying implementation."
   (declare (optimize (speed 3) (safety 3) (space 0) (debug 1))
-           (type string string) (type fixnum start))
+           (type string string) (type fixnum start)
+           (ignorable external-format))
   (locally
     (declare (optimize (safety 1) (debug 0)))
     #+cmu
@@ -694,7 +711,12 @@ determined by the underlying implementation."
     #-(or :cmu :sbcl (and :lispworks (not :lispworks4)) :ccl :allegro)
     (if (<= char-code-limit 256)
         (md5sum-sequence string :start start :end end)
-        (error "md5:md5sum-string is not supported for your implementation."))))
+        (md5sum-sequence
+         (flexi-streams:string-to-octets string
+                                         :external-format
+                                         (if (eq external-format :default)
+                                             :UTF-8
+                                             external-format))))))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defconstant +buffer-size+ (* 128 1024)