Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl
In directory sc8-pr-cvs1:/tmp/cvs-serv24646

Modified Files:
	version.lisp-expr 
Log Message:
0.8.2.24:
        * Quick trick to optimize NJF's SHA1 portable implementation:
          replace LOGNOT with 32BIT-LOGICAL-NOT when its DEST is
          LOGAND with an argument of type (UNSIGNED-BYTE 32).


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.1152
retrieving revision 1.1153
diff -u -d -r1.1152 -r1.1153
--- version.lisp-expr	10 Aug 2003 19:25:02 -0000	1.1152
+++ version.lisp-expr	11 Aug 2003 06:22:15 -0000	1.1153
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.2.23"
+"0.8.2.24"

Update of /cvsroot/sbcl/sbcl/src/compiler/generic
In directory sc8-pr-cvs1:/tmp/cvs-serv24646/src/compiler/generic

Modified Files:
	vm-tran.lisp 
Log Message:
0.8.2.24:
        * Quick trick to optimize NJF's SHA1 portable implementation:
          replace LOGNOT with 32BIT-LOGICAL-NOT when its DEST is
          LOGAND with an argument of type (UNSIGNED-BYTE 32).


Index: vm-tran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/vm-tran.lisp,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -d -r1.30 -r1.31
--- vm-tran.lisp	17 Jul 2003 15:00:53 -0000	1.30
+++ vm-tran.lisp	11 Aug 2003 06:22:15 -0000	1.31
@@ -389,3 +389,22 @@
   '(and (= (double-float-low-bits x) (double-float-low-bits y))
 	(= (double-float-high-bits x) (double-float-high-bits y))))
 
+
+;;;; 32-bit operations
+(deftransform lognot ((x) ((unsigned-byte 32)) *
+                      :node node
+                      :result result)
+  "32-bit implementation"
+  (let ((dest (continuation-dest result)))
+    (unless (and (combination-p dest)
+                 (eq (continuation-fun-name (combination-fun dest))
+                     'logand))
+      (give-up-ir1-transform))
+    (unless (some (lambda (arg)
+                    (csubtypep (continuation-type arg)
+                               (specifier-type '(unsigned-byte 32))))
+                  (combination-args dest))
+      (give-up-ir1-transform))
+    (setf (node-derived-type node)
+          (values-specifier-type '(values (unsigned-byte 32) &optional)))
+    '(32bit-logical-not x)))