From ace140856e6b3f92bb06597092a59753f1e59142 Mon Sep 17 00:00:00 2001 From: Nathan Froyd Date: Wed, 4 Aug 2004 22:15:31 +0000 Subject: [PATCH] 0.8.13.26: * Rename {32,64}BIT-LOGICAL-FOO to WORD-LOGICAL-FOO in all ports. This builds and passes all tests on x86, but I am unsure about its effects on other ports. * Declare SB!VM:WORD with DEF!TYPE so it is known to both the host compiler and the cross-compiler (and we can use it in DEFKNOWN declarations, e.g.) * Fix errors in debug.impure.lisp test --- NEWS | 5 ++ package-data-list.lisp-expr | 16 +++--- src/code/bit-bash.lisp | 110 ++++++++++++++++++------------------- src/code/unix.lisp | 4 +- src/compiler/alpha/arith.lisp | 24 ++++---- src/compiler/generic/vm-fndb.lisp | 12 ++-- src/compiler/generic/vm-tran.lisp | 24 ++++---- src/compiler/generic/vm-type.lisp | 2 +- src/compiler/hppa/arith.lisp | 30 +++++----- src/compiler/mips/arith.lisp | 34 ++++++------ src/compiler/ppc/arith.lisp | 22 ++++---- src/compiler/sparc/arith.lisp | 22 ++++---- src/compiler/x86-64/arith.lisp | 36 ++++++------ src/compiler/x86/arith.lisp | 36 ++++++------ tests/debug.impure.lisp | 9 +-- version.lisp-expr | 2 +- 16 files changed, 198 insertions(+), 190 deletions(-) diff --git a/NEWS b/NEWS index 93611aa..931edba 100644 --- a/NEWS +++ b/NEWS @@ -1,4 +1,9 @@ changes in sbcl-0.8.14 relative to sbcl-0.8.13: + * incompatible change: the internal functions + SB-KERNEL:32BIT-LOGICAL-FOO, intended for providing efficient + logical operations on (UNSIGNED-BYTE 32) values, have been renamed + to SB-KERNEL:WORD-LOGICAL-FOO. Modular arithmetic should be used + instead of the old functions. * new feature: on platforms where "dladdr" is available foreign function names now appear in backtraces. (based on Helmut Eller's work for CMUCL) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 44bd7d8..ca10143 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1001,7 +1001,7 @@ retained, possibly temporariliy, because it might be used internally." ;; * Pull special case implementations of sequence functions (e.g. ;; %MAP-TO-LIST-ARITY-1 and %FIND-POSITION-IF-NOT) and ;; other sequence function implementation grot into SB-SEQ. - ;; * Pull all the math stuff (%ACOS, %COSH, 32BIT-LOGICAL-AND...) + ;; * Pull all the math stuff (%ACOS, %COSH, WORD-LOGICAL-AND...) ;; into SB-MATH. ;; * Pull all the array stuff (%ARRAY-DATA-VECTOR, %RAW-REF-LONG, ;; WITH-ARRAY-DATA, ALLOCATE-VECTOR, HAIRY-DATA-VECTOR-REF...) @@ -1071,13 +1071,13 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "*CONTROL-STACK-EXHAUSTION-SAP*" "*UNIVERSAL-TYPE*" "*UNIVERSAL-FUN-TYPE*" "*UNPARSE-FUN-TYPE-SIMPLIFY*" "*WILD-TYPE*" - "32BIT-LOGICAL-AND" "32BIT-LOGICAL-ANDC1" - "32BIT-LOGICAL-ANDC2" - "32BIT-LOGICAL-EQV" "32BIT-LOGICAL-NAND" - "32BIT-LOGICAL-NOR" - "32BIT-LOGICAL-NOT" "32BIT-LOGICAL-OR" - "32BIT-LOGICAL-ORC1" - "32BIT-LOGICAL-ORC2" "32BIT-LOGICAL-XOR" + "WORD-LOGICAL-AND" "WORD-LOGICAL-ANDC1" + "WORD-LOGICAL-ANDC2" + "WORD-LOGICAL-EQV" "WORD-LOGICAL-NAND" + "WORD-LOGICAL-NOR" + "WORD-LOGICAL-NOT" "WORD-LOGICAL-OR" + "WORD-LOGICAL-ORC1" + "WORD-LOGICAL-ORC2" "WORD-LOGICAL-XOR" "ALIEN-TYPE-TYPE" "ALIEN-TYPE-TYPE-ALIEN-TYPE" "ALIEN-TYPE-TYPE-P" "ALLOCATE-VECTOR" diff --git a/src/code/bit-bash.lisp b/src/code/bit-bash.lisp index 23f58ec..66cfb57 100644 --- a/src/code/bit-bash.lisp +++ b/src/code/bit-bash.lisp @@ -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,7 +109,7 @@ (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 3) #!+alpha (ash (ash address -2) 2)) (+ (* (logand address 3) n-byte-bits) offset)))) @@ -151,9 +151,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 +161,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 +174,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 +219,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 +241,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 +261,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 +284,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 +301,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 +314,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 +330,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 +358,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 +380,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 +388,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 +407,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 +432,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 diff --git a/src/code/unix.lisp b/src/code/unix.lisp index c1b32ab..43376d3 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -968,7 +968,9 @@ previous timer after the body has finished executing" `(multiple-value-bind (,word ,bit) (floor ,offset 32) (setf (deref (slot ,fd-set 'fds-bits) ,word) (logand (deref (slot ,fd-set 'fds-bits) ,word) - (sb!kernel:32bit-logical-not + ;; FIXME: This may not be quite right for 64-bit + ;; ports of SBCL. --njf, 2004-08-04 + (sb!kernel:word-logical-not (truly-the (unsigned-byte 32) (ash 1 ,bit)))))))) ;;; not checked for linux... diff --git a/src/compiler/alpha/arith.lisp b/src/compiler/alpha/arith.lisp index 186d062..d054afc 100644 --- a/src/compiler/alpha/arith.lisp +++ b/src/compiler/alpha/arith.lisp @@ -595,41 +595,41 @@ (emit-label done) (move res result)))) -(define-source-transform 32bit-logical-not (x) +(define-source-transform word-logical-not (x) `(logand (lognot (the (unsigned-byte 32) ,x)) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-and ((x y)) +(deftransform word-logical-and ((x y)) '(logand x y)) -(define-source-transform 32bit-logical-nand (x y) - `(32bit-logical-not (32bit-logical-and ,x ,y))) +(define-source-transform word-logical-nand (x y) + `(word-logical-not (word-logical-and ,x ,y))) -(deftransform 32bit-logical-or ((x y)) +(deftransform word-logical-or ((x y)) '(logior x y)) -(define-source-transform 32bit-logical-nor (x y) +(define-source-transform word-logical-nor (x y) `(logand (lognor (the (unsigned-byte 32) ,x) (the (unsigned-byte 32) ,y)) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-xor ((x y)) +(deftransform word-logical-xor ((x y)) '(logxor x y)) -(define-source-transform 32bit-logical-eqv (x y) +(define-source-transform word-logical-eqv (x y) `(logand (logeqv (the (unsigned-byte 32) ,x) (the (unsigned-byte 32) ,y)) #.(1- (ash 1 32)))) -(define-source-transform 32bit-logical-orc1 (x y) +(define-source-transform word-logical-orc1 (x y) `(logand (logorc1 (the (unsigned-byte 32) ,x) (the (unsigned-byte 32) ,y)) #.(1- (ash 1 32)))) -(define-source-transform 32bit-logical-orc2 (x y) +(define-source-transform word-logical-orc2 (x y) `(logand (logorc2 (the (unsigned-byte 32) ,x) (the (unsigned-byte 32) ,y)) #.(1- (ash 1 32)))) -(define-source-transform 32bit-logical-andc1 (x y) +(define-source-transform word-logical-andc1 (x y) `(logandc1 (the (unsigned-byte 32) ,x) (the (unsigned-byte 32) ,y))) -(define-source-transform 32bit-logical-andc2 (x y) +(define-source-transform word-logical-andc2 (x y) `(logandc2 (the (unsigned-byte 32) ,x) (the (unsigned-byte 32) ,y))) (define-vop (shift-towards-someplace) diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp index f5b74b3..e2264f1 100644 --- a/src/compiler/generic/vm-fndb.lisp +++ b/src/compiler/generic/vm-fndb.lisp @@ -174,14 +174,14 @@ sb!vm:word (foldable flushable movable)) -(defknown 32bit-logical-not (sb!vm:word) sb!vm:word +(defknown word-logical-not (sb!vm:word) sb!vm:word (foldable flushable movable)) -(defknown (32bit-logical-and 32bit-logical-nand - 32bit-logical-or 32bit-logical-nor - 32bit-logical-xor 32bit-logical-eqv - 32bit-logical-andc1 32bit-logical-andc2 - 32bit-logical-orc1 32bit-logical-orc2) +(defknown (word-logical-and word-logical-nand + word-logical-or word-logical-nor + word-logical-xor word-logical-eqv + word-logical-andc1 word-logical-andc2 + word-logical-orc1 word-logical-orc2) (sb!vm:word sb!vm:word) sb!vm:word (foldable flushable movable)) diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp index 461138e..29c5c06 100644 --- a/src/compiler/generic/vm-tran.lisp +++ b/src/compiler/generic/vm-tran.lisp @@ -258,16 +258,16 @@ (setf (%raw-bits result-bit-array index) (,',wordfun (%raw-bits bit-array-1 index) (%raw-bits bit-array-2 index)))))))))) - (def bit-and 32bit-logical-and) - (def bit-ior 32bit-logical-or) - (def bit-xor 32bit-logical-xor) - (def bit-eqv 32bit-logical-eqv) - (def bit-nand 32bit-logical-nand) - (def bit-nor 32bit-logical-nor) - (def bit-andc1 32bit-logical-andc1) - (def bit-andc2 32bit-logical-andc2) - (def bit-orc1 32bit-logical-orc1) - (def bit-orc2 32bit-logical-orc2)) + (def bit-and word-logical-and) + (def bit-ior word-logical-or) + (def bit-xor word-logical-xor) + (def bit-eqv word-logical-eqv) + (def bit-nand word-logical-nand) + (def bit-nor word-logical-nor) + (def bit-andc1 word-logical-andc1) + (def bit-andc2 word-logical-andc2) + (def bit-orc1 word-logical-orc1) + (def bit-orc2 word-logical-orc2)) (deftransform bit-not ((bit-array result-bit-array) @@ -296,12 +296,12 @@ sb!vm:n-word-bits)))) ((= index end-1) (setf (%raw-bits result-bit-array index) - (32bit-logical-not (%raw-bits bit-array index))) + (word-logical-not (%raw-bits bit-array index))) result-bit-array) (declare (optimize (speed 3) (safety 0)) (type index index end-1)) (setf (%raw-bits result-bit-array index) - (32bit-logical-not (%raw-bits bit-array index)))))))) + (word-logical-not (%raw-bits bit-array index)))))))) (deftransform bit-vector-= ((x y) (simple-bit-vector simple-bit-vector)) `(and (= (length x) (length y)) diff --git a/src/compiler/generic/vm-type.lisp b/src/compiler/generic/vm-type.lisp index fc763a3..6c9658e 100644 --- a/src/compiler/generic/vm-type.lisp +++ b/src/compiler/generic/vm-type.lisp @@ -16,7 +16,7 @@ ;;;; FIXME: I'm not sure where to put this. -- WHN 19990817 -(deftype sb!vm:word () `(unsigned-byte ,sb!vm:n-word-bits)) +(def!type sb!vm:word () `(unsigned-byte ,sb!vm:n-word-bits)) ;;;; implementation-dependent DEFTYPEs diff --git a/src/compiler/hppa/arith.lisp b/src/compiler/hppa/arith.lisp index 94f54c1..880be1f 100644 --- a/src/compiler/hppa/arith.lisp +++ b/src/compiler/hppa/arith.lisp @@ -633,38 +633,38 @@ ;;;; 32-bit logical operations -(define-source-transform 32bit-logical-not (x) +(define-source-transform word-logical-not (x) `(logand (lognot (the (unsigned-byte 32) ,x)) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-and ((x y)) +(deftransform word-logical-and ((x y)) '(logand x y)) -(define-source-transform 32bit-logical-nand (x y) - `(32bit-logical-not (32bit-logical-and ,x ,y))) +(define-source-transform word-logical-nand (x y) + `(word-logical-not (word-logical-and ,x ,y))) -(deftransform 32bit-logical-or ((x y)) +(deftransform word-logical-or ((x y)) '(logior x y)) -(define-source-transform 32bit-logical-nor (x y) +(define-source-transform word-logical-nor (x y) `(logand (lognor (the (unsigned-byte 32) ,x) (the (unsigned-byte 32) ,y)) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-xor ((x y)) +(deftransform word-logical-xor ((x y)) '(logxor x y)) -(define-source-transform 32bit-logical-eqv (x y) - `(32bit-logical-not (32bit-logical-xor ,x ,y))) +(define-source-transform word-logical-eqv (x y) + `(word-logical-not (word-logical-xor ,x ,y))) -(define-source-transform 32bit-logical-orc1 (x y) - `(32bit-logical-or (32bit-logical-not ,x) ,y)) +(define-source-transform word-logical-orc1 (x y) + `(word-logical-or (word-logical-not ,x) ,y)) -(define-source-transform 32bit-logical-orc2 (x y) - `(32bit-logical-or ,x (32bit-logical-not ,y))) +(define-source-transform word-logical-orc2 (x y) + `(word-logical-or ,x (word-logical-not ,y))) -(deftransform 32bit-logical-andc1 (x y) +(deftransform word-logical-andc1 (x y) '(logandc1 x y)) -(deftransform 32bit-logical-andc2 (x y) +(deftransform word-logical-andc2 (x y) '(logandc2 x y)) (define-vop (shift-towards-someplace) diff --git a/src/compiler/mips/arith.lisp b/src/compiler/mips/arith.lisp index 9188d98..41db1f6 100644 --- a/src/compiler/mips/arith.lisp +++ b/src/compiler/mips/arith.lisp @@ -616,39 +616,39 @@ (emit-label done) (move result res)))) -(define-source-transform 32bit-logical-not (x) +(define-source-transform word-logical-not (x) `(logand (lognot (the (unsigned-byte 32) ,x)) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-and ((x y)) +(deftransform word-logical-and ((x y)) '(logand x y)) -(define-source-transform 32bit-logical-nand (x y) - `(32bit-logical-not (32bit-logical-and ,x ,y))) +(define-source-transform word-logical-nand (x y) + `(word-logical-not (word-logical-and ,x ,y))) -(deftransform 32bit-logical-or ((x y)) +(deftransform word-logical-or ((x y)) '(logior x y)) -(define-source-transform 32bit-logical-nor (x y) +(define-source-transform word-logical-nor (x y) `(logand (lognor (the (unsigned-byte 32) ,x) (the (unsigned-byte 32) ,y)) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-xor ((x y)) +(deftransform word-logical-xor ((x y)) '(logxor x y)) -(define-source-transform 32bit-logical-eqv (x y) - `(32bit-logical-not (32bit-logical-xor ,x ,y))) +(define-source-transform word-logical-eqv (x y) + `(word-logical-not (word-logical-xor ,x ,y))) -(define-source-transform 32bit-logical-orc1 (x y) - `(32bit-logical-or (32bit-logical-not ,x) ,y)) +(define-source-transform word-logical-orc1 (x y) + `(word-logical-or (word-logical-not ,x) ,y)) -(define-source-transform 32bit-logical-orc2 (x y) - `(32bit-logical-or ,x (32bit-logical-not ,y))) +(define-source-transform word-logical-orc2 (x y) + `(word-logical-or ,x (word-logical-not ,y))) -(define-source-transform 32bit-logical-andc1 (x y) - `(32bit-logical-and (32bit-logical-not ,x) ,y)) +(define-source-transform word-logical-andc1 (x y) + `(word-logical-and (word-logical-not ,x) ,y)) -(define-source-transform 32bit-logical-andc2 (x y) - `(32bit-logical-and ,x (32bit-logical-not ,y))) +(define-source-transform word-logical-andc2 (x y) + `(word-logical-and ,x (word-logical-not ,y))) (define-vop (shift-towards-someplace) (:policy :fast-safe) diff --git a/src/compiler/ppc/arith.lisp b/src/compiler/ppc/arith.lisp index 9004b6d..8141ec4 100644 --- a/src/compiler/ppc/arith.lisp +++ b/src/compiler/ppc/arith.lisp @@ -703,37 +703,37 @@ (emit-label done) (move result res)))) -(define-source-transform 32bit-logical-not (x) +(define-source-transform word-logical-not (x) `(logand (lognot (the (unsigned-byte 32) ,x)) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-and ((x y)) +(deftransform word-logical-and ((x y)) '(logand x y)) -(deftransform 32bit-logical-nand ((x y)) +(deftransform word-logical-nand ((x y)) '(logand (lognand x y) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-or ((x y)) +(deftransform word-logical-or ((x y)) '(logior x y)) -(deftransform 32bit-logical-nor ((x y)) +(deftransform word-logical-nor ((x y)) '(logand (lognor x y) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-xor ((x y)) +(deftransform word-logical-xor ((x y)) '(logxor x y)) -(deftransform 32bit-logical-eqv ((x y)) +(deftransform word-logical-eqv ((x y)) '(logand (logeqv x y) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-orc1 ((x y)) +(deftransform word-logical-orc1 ((x y)) '(logand (logorc1 x y) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-orc2 ((x y)) +(deftransform word-logical-orc2 ((x y)) '(logand (logorc2 x y) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-andc1 ((x y)) +(deftransform word-logical-andc1 ((x y)) '(logand (logandc1 x y) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-andc2 ((x y)) +(deftransform word-logical-andc2 ((x y)) '(logand (logandc2 x y) #.(1- (ash 1 32)))) (define-vop (shift-towards-someplace) diff --git a/src/compiler/sparc/arith.lisp b/src/compiler/sparc/arith.lisp index 1bff8c8..c722d15 100644 --- a/src/compiler/sparc/arith.lisp +++ b/src/compiler/sparc/arith.lisp @@ -825,37 +825,37 @@ (emit-label done) (move result res)))) -(define-source-transform 32bit-logical-not (x) +(define-source-transform word-logical-not (x) `(logand (lognot (the (unsigned-byte 32) ,x)) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-and ((x y)) +(deftransform word-logical-and ((x y)) '(logand x y)) -(deftransform 32bit-logical-nand ((x y)) +(deftransform word-logical-nand ((x y)) '(logand (lognand x y) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-or ((x y)) +(deftransform word-logical-or ((x y)) '(logior x y)) -(deftransform 32bit-logical-nor ((x y)) +(deftransform word-logical-nor ((x y)) '(logand (lognor x y) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-xor ((x y)) +(deftransform word-logical-xor ((x y)) '(logxor x y)) -(deftransform 32bit-logical-eqv ((x y)) +(deftransform word-logical-eqv ((x y)) '(logand (logeqv x y) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-orc1 ((x y)) +(deftransform word-logical-orc1 ((x y)) '(logand (logorc1 x y) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-orc2 ((x y)) +(deftransform word-logical-orc2 ((x y)) '(logand (logorc2 x y) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-andc1 ((x y)) +(deftransform word-logical-andc1 ((x y)) '(logand (logandc1 x y) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-andc2 ((x y)) +(deftransform word-logical-andc2 ((x y)) '(logand (logandc2 x y) #.(1- (ash 1 32)))) (define-vop (shift-towards-someplace) diff --git a/src/compiler/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp index eaef9b4..0ac6aee 100644 --- a/src/compiler/x86-64/arith.lisp +++ b/src/compiler/x86-64/arith.lisp @@ -1206,38 +1206,38 @@ (move result prev) (inst shrd result next :cl))) -(define-source-transform 64bit-logical-not (x) +(define-source-transform word-logical-not (x) `(logand (lognot (the (unsigned-byte 64) ,x)) #.(1- (ash 1 64)))) -(deftransform 64bit-logical-and ((x y)) +(deftransform word-logical-and ((x y)) '(logand x y)) -(define-source-transform 64bit-logical-nand (x y) - `(64bit-logical-not (64bit-logical-and ,x ,y))) +(define-source-transform word-logical-nand (x y) + `(word-logical-not (word-logical-and ,x ,y))) -(deftransform 64bit-logical-or ((x y)) +(deftransform word-logical-or ((x y)) '(logior x y)) -(define-source-transform 64bit-logical-nor (x y) - `(64bit-logical-not (64bit-logical-or ,x ,y))) +(define-source-transform word-logical-nor (x y) + `(word-logical-not (word-logical-or ,x ,y))) -(deftransform 64bit-logical-xor ((x y)) +(deftransform word-logical-xor ((x y)) '(logxor x y)) -(define-source-transform 64bit-logical-eqv (x y) - `(64bit-logical-not (64bit-logical-xor ,x ,y))) +(define-source-transform word-logical-eqv (x y) + `(word-logical-not (word-logical-xor ,x ,y))) -(define-source-transform 64bit-logical-orc1 (x y) - `(64bit-logical-or (64bit-logical-not ,x) ,y)) +(define-source-transform word-logical-orc1 (x y) + `(word-logical-or (word-logical-not ,x) ,y)) -(define-source-transform 64bit-logical-orc2 (x y) - `(64bit-logical-or ,x (64bit-logical-not ,y))) +(define-source-transform word-logical-orc2 (x y) + `(word-logical-or ,x (word-logical-not ,y))) -(define-source-transform 64bit-logical-andc1 (x y) - `(64bit-logical-and (64bit-logical-not ,x) ,y)) +(define-source-transform word-logical-andc1 (x y) + `(word-logical-and (word-logical-not ,x) ,y)) -(define-source-transform 64bit-logical-andc2 (x y) - `(64bit-logical-and ,x (64bit-logical-not ,y))) +(define-source-transform word-logical-andc2 (x y) + `(word-logical-and ,x (word-logical-not ,y))) ;;; Only the lower 6 bits of the shift amount are significant. (define-vop (shift-towards-someplace) diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp index 25d7091..76d39af 100644 --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -1164,38 +1164,38 @@ (move result prev) (inst shrd result next :cl))) -(define-source-transform 32bit-logical-not (x) +(define-source-transform word-logical-not (x) `(logand (lognot (the (unsigned-byte 32) ,x)) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-and ((x y)) +(deftransform word-logical-and ((x y)) '(logand x y)) -(define-source-transform 32bit-logical-nand (x y) - `(32bit-logical-not (32bit-logical-and ,x ,y))) +(define-source-transform word-logical-nand (x y) + `(word-logical-not (word-logical-and ,x ,y))) -(deftransform 32bit-logical-or ((x y)) +(deftransform word-logical-or ((x y)) '(logior x y)) -(define-source-transform 32bit-logical-nor (x y) - `(32bit-logical-not (32bit-logical-or ,x ,y))) +(define-source-transform word-logical-nor (x y) + `(word-logical-not (word-logical-or ,x ,y))) -(deftransform 32bit-logical-xor ((x y)) +(deftransform word-logical-xor ((x y)) '(logxor x y)) -(define-source-transform 32bit-logical-eqv (x y) - `(32bit-logical-not (32bit-logical-xor ,x ,y))) +(define-source-transform word-logical-eqv (x y) + `(word-logical-not (word-logical-xor ,x ,y))) -(define-source-transform 32bit-logical-orc1 (x y) - `(32bit-logical-or (32bit-logical-not ,x) ,y)) +(define-source-transform word-logical-orc1 (x y) + `(word-logical-or (word-logical-not ,x) ,y)) -(define-source-transform 32bit-logical-orc2 (x y) - `(32bit-logical-or ,x (32bit-logical-not ,y))) +(define-source-transform word-logical-orc2 (x y) + `(word-logical-or ,x (word-logical-not ,y))) -(define-source-transform 32bit-logical-andc1 (x y) - `(32bit-logical-and (32bit-logical-not ,x) ,y)) +(define-source-transform word-logical-andc1 (x y) + `(word-logical-and (word-logical-not ,x) ,y)) -(define-source-transform 32bit-logical-andc2 (x y) - `(32bit-logical-and ,x (32bit-logical-not ,y))) +(define-source-transform word-logical-andc2 (x y) + `(word-logical-and ,x (word-logical-not ,y))) ;;; Only the lower 5 bits of the shift amount are significant. (define-vop (shift-towards-someplace) diff --git a/tests/debug.impure.lisp b/tests/debug.impure.lisp index 9acd873..a1d1e19 100644 --- a/tests/debug.impure.lisp +++ b/tests/debug.impure.lisp @@ -126,7 +126,7 @@ #-alpha ; bug 346 (progn (flet ((test-function () - (declare (optimize (speed 1) (debug 2))) ; tail call elimination + (declare (optimize (speed 2) (debug 1))) ; tail call elimination (/ 42 0))) (assert (verify-backtrace #'test-function '/))) @@ -136,9 +136,10 @@ (assert (verify-backtrace #'test-function '/)))) #-(or x86 alpha) ; bug 61 -(defun throw-test () - (throw 'no-such-tag t)) -(assert (verify-backtrace #'throw-test 'throw-test)) +(progn + (defun throw-test () + (throw 'no-such-tag t)) + (assert (verify-backtrace #'throw-test 'throw-test))) ;;; success (quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index b61054c..ca728cc 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -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.13.25" +"0.8.13.26" -- 1.7.10.4