Update of /cvsroot/sbcl/sbcl/src/compiler/generic
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv12727/src/compiler/generic
Modified Files:
vm-tran.lisp
Log Message:
0.9.15.8:
Improve COUNT on bitvectors.
... pull conditionals out of the inner loop, similar to the recent
changes for BIGNUM-LOGCOUNT;
... while we're at it, change a few ='s in loop termination
conditions to >= for better type inference and code generation.
Index: vm-tran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/vm-tran.lisp,v
retrieving revision 1.69
retrieving revision 1.70
diff -u -d -r1.69 -r1.70
--- vm-tran.lisp 21 Nov 2005 14:00:30 -0000 1.69
+++ vm-tran.lisp 29 Jul 2006 22:59:05 -0000 1.70
@@ -260,7 +260,7 @@
;; epilogue. - CSR, 2002-04-24
(truncate (truly-the index (1- length))
sb!vm:n-word-bits))))
- ((= index end-1)
+ ((>= index end-1)
(setf (%raw-bits result-bit-array index)
(,',wordfun (%raw-bits bit-array-1 index)
(%raw-bits bit-array-2 index)))
@@ -306,7 +306,7 @@
;; the epilogue. - CSR, 2002-04-24
(truncate (truly-the index (1- length))
sb!vm:n-word-bits))))
- ((= index end-1)
+ ((>= index end-1)
(setf (%raw-bits result-bit-array index)
(word-logical-not (%raw-bits bit-array index)))
result-bit-array)
@@ -322,7 +322,7 @@
(do* ((i sb!vm:vector-data-offset (+ i 1))
(end-1 (+ sb!vm:vector-data-offset
(floor (1- length) sb!vm:n-word-bits))))
- ((= i end-1)
+ ((>= i end-1)
(let* ((extra (1+ (mod (1- length) sb!vm:n-word-bits)))
(mask (ash #.(1- (ash 1 sb!vm:n-word-bits))
(- extra sb!vm:n-word-bits)))
@@ -362,7 +362,7 @@
(end-1 (+ sb!vm:vector-data-offset
(truncate (truly-the index (1- length))
sb!vm:n-word-bits))))
- ((= index end-1)
+ ((>= index end-1)
(let* ((extra (1+ (mod (1- length) sb!vm:n-word-bits)))
(mask (ash #.(1- (ash 1 sb!vm:n-word-bits))
(- extra sb!vm:n-word-bits)))
@@ -374,24 +374,17 @@
(%raw-bits sequence index))))
(declare (type (integer 1 #.sb!vm:n-word-bits) extra))
(declare (type sb!vm:word mask bits))
- ;; could consider LOGNOT for the zero case instead of
- ;; doing the subtraction...
- (incf count ,(if (constant-lvar-p item)
- (if (zerop (lvar-value item))
- '(- extra (logcount bits))
- '(logcount bits))
- '(if (zerop item)
- (- extra (logcount bits))
- (logcount bits))))))
+ (incf count (logcount bits))
+ ,(if (constant-lvar-p item)
+ (if (zerop (lvar-value item))
+ '(- length count)
+ 'count)
+ '(if (zerop item)
+ (- length count)
+ count))))
(declare (type index index count end-1)
(optimize (speed 3) (safety 0)))
- (incf count ,(if (constant-lvar-p item)
- (if (zerop (lvar-value item))
- '(- sb!vm:n-word-bits (logcount (%raw-bits sequence index)))
- '(logcount (%raw-bits sequence index)))
- '(if (zerop item)
- (- sb!vm:n-word-bits (logcount (%raw-bits sequence index)))
- (logcount (%raw-bits sequence index)))))))))
+ (incf count (logcount (%raw-bits sequence index)))))))
(deftransform fill ((sequence item) (simple-bit-vector bit) *
:policy (>= speed space))
@@ -411,7 +404,7 @@
;; in the epilogue. - CSR, 2002-04-24
(truncate (truly-the index (1- length))
sb!vm:n-word-bits))))
- ((= index end-1)
+ ((>= index end-1)
(setf (%raw-bits sequence index) value)
sequence)
(declare (optimize (speed 3) (safety 0))
@@ -435,7 +428,7 @@
(truncate length sb!vm:n-word-bytes)
(do ((index sb!vm:vector-data-offset (1+ index))
(end (+ times sb!vm:vector-data-offset)))
- ((= index end)
+ ((>= index end)
(let ((place (* times sb!vm:n-word-bytes)))
(declare (fixnum place))
(dotimes (j rem sequence)
|