Update version number for upcoming 2.0.2 release.

This change fixes deviations on 64-bit implementations of LispWorks,
where sys:int32 arithmetic is not performed modulo 2^32, but rather
overflows to 64-bit values, yielding wrong results.

NEWS

@@ -1,3 +1,23 @@
+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,6 @@
   :author "Pierre R. Mai <pmai@pmsf.de>"
   :maintainer "Pierre R. Mai <pmai@pmsf.de>"
   :licence "Public Domain"
-  :version "2.0.0"
+  :version "2.0.2"
   #+sbcl :depends-on #+sbcl ("sb-rotate-byte")
   :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