X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fbit-bash.lisp;h=0ca7ed615652d93550fc68d32d791662466aa795;hb=f1b3993e92da7522403803d5f9a187ae28f90a73;hp=93124063d4e6c7182ca1a1dd0b1feab1201e3de8;hpb=820cc1dc03ecac1eda3d817ae2833ae8939a2fd1;p=sbcl.git diff --git a/src/code/bit-bash.lisp b/src/code/bit-bash.lisp index 9312406..0ca7ed6 100644 --- a/src/code/bit-bash.lisp +++ b/src/code/bit-bash.lisp @@ -17,7 +17,7 @@ (defconstant unit-bits n-word-bits) ;;; the maximum number of bits that can be dealt with in a single call -(defconstant max-bits (ash most-positive-fixnum -2)) +(defconstant max-bits (ash sb!xc:most-positive-fixnum -2)) (deftype unit () `(unsigned-byte ,unit-bits)) @@ -42,17 +42,17 @@ (macrolet ((def (name &rest args) `(defun ,name ,args (,name ,@args)))) - (def 32bit-logical-not x) - (def 32bit-logical-and x y) - (def 32bit-logical-or x y) - (def 32bit-logical-xor x y) - (def 32bit-logical-nor x y) - (def 32bit-logical-eqv x y) - (def 32bit-logical-nand x y) - (def 32bit-logical-andc1 x y) - (def 32bit-logical-andc2 x y) - (def 32bit-logical-orc1 x y) - (def 32bit-logical-orc2 x y)) + (def word-logical-not x) + (def word-logical-and x y) + (def word-logical-or x y) + (def word-logical-xor x y) + (def word-logical-nor x y) + (def word-logical-eqv x y) + (def word-logical-nand x y) + (def word-logical-andc1 x y) + (def word-logical-andc2 x y) + (def word-logical-orc1 x y) + (def word-logical-orc2 x y)) ;;; Shift NUMBER by the low-order bits of COUNTOID, adding zero bits ;;; at the "end" and removing bits from the "start". On big-endian @@ -109,24 +109,27 @@ (type index offset) (values system-area-pointer index)) (let ((address (sap-int sap))) - (values (int-sap #!-alpha (32bit-logical-andc2 address 3) + (values (int-sap #!-alpha (word-logical-andc2 address + sb!vm::fixnum-tag-mask) #!+alpha (ash (ash address -2) 2)) - (+ (* (logand address 3) n-byte-bits) offset)))) + (+ (* (logand address sb!vm::fixnum-tag-mask) n-byte-bits) + offset)))) #!-sb-fluid (declaim (inline word-sap-ref %set-word-sap-ref)) (defun word-sap-ref (sap offset) (declare (type system-area-pointer sap) (type index offset) - (values (unsigned-byte 32)) + (values sb!vm:word) (optimize (speed 3) (safety 0) #-sb-xc-host (inhibit-warnings 3))) - (sap-ref-32 sap (the index (ash offset 2)))) + (sap-ref-word sap (the index (ash offset sb!vm::n-fixnum-tag-bits)))) (defun %set-word-sap-ref (sap offset value) (declare (type system-area-pointer sap) (type index offset) - (type (unsigned-byte 32) value) - (values (unsigned-byte 32)) + (type sb!vm:word value) + (values sb!vm:word) (optimize (speed 3) (safety 0) (inhibit-warnings 3))) - (setf (sap-ref-32 sap (the index (ash offset 2))) value)) + (setf (sap-ref-word sap (the index (ash offset sb!vm::n-fixnum-tag-bits))) + value)) ;;;; CONSTANT-BIT-BASH @@ -151,9 +154,9 @@ (let ((mask (shift-towards-end (start-mask length) dst-bit-offset))) (declare (type unit mask)) - (32bit-logical-or - (32bit-logical-and value mask) - (32bit-logical-andc2 + (word-logical-or + (word-logical-and value mask) + (word-logical-andc2 (funcall dst-ref-fn dst dst-word-offset) mask)))))) (let ((interior (floor (- length final-bits) unit-bits))) @@ -161,9 +164,9 @@ (let ((mask (end-mask (- dst-bit-offset)))) (declare (type unit mask)) (funcall dst-set-fn dst dst-word-offset - (32bit-logical-or - (32bit-logical-and value mask) - (32bit-logical-andc2 + (word-logical-or + (word-logical-and value mask) + (word-logical-andc2 (funcall dst-ref-fn dst dst-word-offset) mask)))) (incf dst-word-offset)) @@ -174,9 +177,9 @@ (let ((mask (start-mask final-bits))) (declare (type unit mask)) (funcall dst-set-fn dst dst-word-offset - (32bit-logical-or - (32bit-logical-and value mask) - (32bit-logical-andc2 + (word-logical-or + (word-logical-and value mask) + (word-logical-andc2 (funcall dst-ref-fn dst dst-word-offset) mask))))))))) (values)) @@ -219,7 +222,7 @@ (funcall dst-set-fn dst dst-word-offset (if (zerop src-bit-offset) (funcall src-ref-fn src src-word-offset) - (32bit-logical-or + (word-logical-or (shift-towards-start (funcall src-ref-fn src src-word-offset) src-bit-offset) @@ -241,7 +244,7 @@ ;; the first word. (let ((src-bit-shift (- src-bit-offset dst-bit-offset))) (if (> (+ src-bit-offset length) unit-bits) - (32bit-logical-or + (word-logical-or (shift-towards-start (funcall src-ref-fn src src-word-offset) src-bit-shift) @@ -261,9 +264,9 @@ (declare (type unit mask orig value)) ;; Replace the dst word. (funcall dst-set-fn dst dst-word-offset - (32bit-logical-or - (32bit-logical-and value mask) - (32bit-logical-andc2 orig mask))))))) + (word-logical-or + (word-logical-and value mask) + (word-logical-andc2 orig mask))))))) ((= src-bit-offset dst-bit-offset) ;; The source and dst are aligned, so we don't need to shift ;; anything. But we have to pick the direction of the loop in @@ -284,8 +287,8 @@ (value (funcall src-ref-fn src src-word-offset))) (declare (type unit mask orig value)) (funcall dst-set-fn dst dst-word-offset - (32bit-logical-or (32bit-logical-and value mask) - (32bit-logical-andc2 orig mask)))) + (word-logical-or (word-logical-and value mask) + (word-logical-andc2 orig mask)))) (incf src-word-offset) (incf dst-word-offset)) ;; Just copy the interior words. @@ -301,9 +304,9 @@ (value (funcall src-ref-fn src src-word-offset))) (declare (type unit mask orig value)) (funcall dst-set-fn dst dst-word-offset - (32bit-logical-or - (32bit-logical-and value mask) - (32bit-logical-andc2 orig mask)))))) + (word-logical-or + (word-logical-and value mask) + (word-logical-andc2 orig mask)))))) (t ;; We need to loop from right to left. (incf dst-word-offset words) @@ -314,9 +317,9 @@ (value (funcall src-ref-fn src src-word-offset))) (declare (type unit mask orig value)) (funcall dst-set-fn dst dst-word-offset - (32bit-logical-or - (32bit-logical-and value mask) - (32bit-logical-andc2 orig mask))))) + (word-logical-or + (word-logical-and value mask) + (word-logical-andc2 orig mask))))) (dotimes (i interior) (decf src-word-offset) (decf dst-word-offset) @@ -330,9 +333,9 @@ (value (funcall src-ref-fn src src-word-offset))) (declare (type unit mask orig value)) (funcall dst-set-fn dst dst-word-offset - (32bit-logical-or - (32bit-logical-and value mask) - (32bit-logical-andc2 orig mask)))))))))) + (word-logical-or + (word-logical-and value mask) + (word-logical-andc2 orig mask)))))))))) (t ;; They aren't aligned. (multiple-value-bind (words final-bits) @@ -358,18 +361,18 @@ (get-next-src)) (let ((mask (end-mask (- dst-bit-offset))) (orig (funcall dst-ref-fn dst dst-word-offset)) - (value (32bit-logical-or + (value (word-logical-or (shift-towards-start prev src-shift) (shift-towards-end next (- src-shift))))) (declare (type unit mask orig value)) (funcall dst-set-fn dst dst-word-offset - (32bit-logical-or - (32bit-logical-and value mask) - (32bit-logical-andc2 orig mask))) + (word-logical-or + (word-logical-and value mask) + (word-logical-andc2 orig mask))) (incf dst-word-offset))) (dotimes (i interior) (get-next-src) - (let ((value (32bit-logical-or + (let ((value (word-logical-or (shift-towards-end next (- src-shift)) (shift-towards-start prev src-shift)))) (declare (type unit value)) @@ -380,7 +383,7 @@ (if (> (+ final-bits src-shift) unit-bits) (progn (get-next-src) - (32bit-logical-or + (word-logical-or (shift-towards-end next (- src-shift)) (shift-towards-start prev src-shift))) (shift-towards-start next src-shift))) @@ -388,9 +391,9 @@ (orig (funcall dst-ref-fn dst dst-word-offset))) (declare (type unit mask orig value)) (funcall dst-set-fn dst dst-word-offset - (32bit-logical-or - (32bit-logical-and value mask) - (32bit-logical-andc2 orig mask)))))))) + (word-logical-or + (word-logical-and value mask) + (word-logical-andc2 orig mask)))))))) (t ;; We need to loop from right to left. (incf dst-word-offset words) @@ -407,20 +410,20 @@ (unless (zerop final-bits) (when (> final-bits (- unit-bits src-shift)) (get-next-src)) - (let ((value (32bit-logical-or + (let ((value (word-logical-or (shift-towards-end next (- src-shift)) (shift-towards-start prev src-shift))) (mask (start-mask final-bits)) (orig (funcall dst-ref-fn dst dst-word-offset))) (declare (type unit mask orig value)) (funcall dst-set-fn dst dst-word-offset - (32bit-logical-or - (32bit-logical-and value mask) - (32bit-logical-andc2 orig mask))))) + (word-logical-or + (word-logical-and value mask) + (word-logical-andc2 orig mask))))) (decf dst-word-offset) (dotimes (i interior) (get-next-src) - (let ((value (32bit-logical-or + (let ((value (word-logical-or (shift-towards-end next (- src-shift)) (shift-towards-start prev src-shift)))) (declare (type unit value)) @@ -432,14 +435,14 @@ (setf next prev prev 0)) (let ((mask (end-mask (- dst-bit-offset))) (orig (funcall dst-ref-fn dst dst-word-offset)) - (value (32bit-logical-or + (value (word-logical-or (shift-towards-start prev src-shift) (shift-towards-end next (- src-shift))))) (declare (type unit mask orig value)) (funcall dst-set-fn dst dst-word-offset - (32bit-logical-or - (32bit-logical-and value mask) - (32bit-logical-andc2 orig mask))))))))))))))) + (word-logical-or + (word-logical-and value mask) + (word-logical-andc2 orig mask))))))))))))))) (values)) ;;;; the actual bashers