diff --git a/compiler/generic/vm-tran.lisp b/compiler/generic/vm-tran.lisp index dab3d222aa2311949523269003c6f51f4563aae5..6a98f091728442dab4b634c9def69030b881c188 100644 --- a/compiler/generic/vm-tran.lisp +++ b/compiler/generic/vm-tran.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-tran.lisp,v 1.21 1990/11/25 20:59:40 ram Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-tran.lisp,v 1.22 1991/01/13 23:37:26 ram Exp $ ;;; ;;; This file contains impelemtentation-dependent transforms. ;;; @@ -229,6 +229,71 @@ ,@(forms) res)))) + +;;;; Bit vector hackery: + + +;;; SIMPLE-BIT-VECTOR bit-array operations are transformed to a word loop that +;;; does 32 bits at a time. +;;; +(loop for (bitfun wordfun) in + '((bit-and 32bit-logical-and) + (bit-ior 32bit-logical-or) + (bit-xor 32bit-logical-xor) + (bit-eqv 32bit-logical-eqv) + (bit-nand 32bit-logical-nand) + (bit-nor 32bit-logical-nor) + (bit-andc1 32bit-logical-andc1) + (bit-andc2 32bit-logical-andc2) + (bit-orc1 32bit-logical-orc1) + (bit-orc2 32bit-logical-orc2)) do + (deftransform bitfun + ((bit-array-1 bit-array-2 result-bit-array) + (simple-bit-vector simple-bit-vector simple-bit-vector) * + :eval-name t :node node :policy (>= speed space)) + `(progn + ,@(unless (policy node (zerop safety)) + '((unless (= (length bit-array-1) (length bit-array-2) + (length result-bit-array)) + (error "Argument and/or result bit arrays not the same length:~ + ~% ~S~% ~S ~% ~S" + bit-array-1 bit-array-2 result-bit-array)))) + (do ((index vm:vector-data-offset (1+ index)) + (end (+ vm:vector-data-offset + (truncate (the index + (+ (length bit-array-1) + vm:word-bits -1)) + vm:word-bits)))) + ((= index end) result-bit-array) + (declare (optimize (speed 3) (safety 0)) + (type index index end)) + (setf (%raw-bits result-bit-array index) + (,wordfun (%raw-bits bit-array-1 index) + (%raw-bits bit-array-2 index))))))) + +(deftransform bit-not + ((bit-array-1 result-bit-array) + (simple-bit-vector simple-bit-vector) * + :node node :policy (>= speed space)) + `(progn + ,@(unless (policy node (zerop safety)) + '((unless (= (length bit-array-1) (length bit-array-2) + (length result-bit-array)) + (error "Argument and result bit arrays not the same length:~ + ~% ~S~% ~S" + bit-array-1 result-bit-array)))) + (do ((index vm:vector-data-offset (1+ index)) + (end (+ vm:vector-data-offset + (truncate (the index + (+ (length bit-array-1) + vm:word-bits -1)) + vm:word-bits)))) + ((= index end) result-bit-array) + (declare (optimize (speed 3) (safety 0)) + (type index index end)) + (setf (%raw-bits result-bit-array index) + (32bit-logical-not (%raw-bits bit-array-1 index)))))) + ;;;; Primitive translator for byte-blt