From 1ca02b016cddad0800852a9d8fe7a3cb6cc7a01d Mon Sep 17 00:00:00 2001 From: Nathan Froyd Date: Sat, 7 Aug 2004 02:24:48 +0000 Subject: [PATCH] 0.8.13.35: * SB!VM:WORD-LOGICAL-FOO transforms were being defined per-backend, when in reality they can be shared. Make it so. * The `length' slot in SB!VM:PRIM-SLOT-OBJECT wasn't being used; delete it, but retain the :LENGTH option in SB!VM:DEFINE-PRIMITIVE-OBJECT, because that *is* being used. (mostly to generate offsets for GENESIS header files) --- src/compiler/alpha/arith.lisp | 37 ---------------------------- src/compiler/generic/vm-macs.lisp | 5 ++-- src/compiler/generic/vm-tran.lisp | 48 ++++++++++++++++++++++++++++++++++--- src/compiler/hppa/arith.lisp | 36 ---------------------------- src/compiler/mips/arith.lisp | 34 -------------------------- src/compiler/ppc/arith.lisp | 33 ------------------------- src/compiler/sparc/arith.lisp | 33 ------------------------- src/compiler/x86-64/arith.lisp | 33 ------------------------- src/compiler/x86/arith.lisp | 33 ------------------------- version.lisp-expr | 2 +- 10 files changed, 48 insertions(+), 246 deletions(-) diff --git a/src/compiler/alpha/arith.lisp b/src/compiler/alpha/arith.lisp index d054afc..b39ba7b 100644 --- a/src/compiler/alpha/arith.lisp +++ b/src/compiler/alpha/arith.lisp @@ -595,43 +595,6 @@ (emit-label done) (move res result)))) -(define-source-transform word-logical-not (x) - `(logand (lognot (the (unsigned-byte 32) ,x)) #.(1- (ash 1 32)))) - -(deftransform word-logical-and ((x y)) - '(logand x y)) - -(define-source-transform word-logical-nand (x y) - `(word-logical-not (word-logical-and ,x ,y))) - -(deftransform word-logical-or ((x y)) - '(logior 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 word-logical-xor ((x y)) - '(logxor 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 word-logical-orc1 (x y) - `(logand (logorc1 (the (unsigned-byte 32) ,x) (the (unsigned-byte 32) ,y)) - #.(1- (ash 1 32)))) - -(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 word-logical-andc1 (x y) - `(logandc1 (the (unsigned-byte 32) ,x) (the (unsigned-byte 32) ,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) (:policy :fast-safe) (:args (num :scs (unsigned-reg)) diff --git a/src/compiler/generic/vm-macs.lisp b/src/compiler/generic/vm-macs.lisp index ef031a9..66d399a 100644 --- a/src/compiler/generic/vm-macs.lisp +++ b/src/compiler/generic/vm-macs.lisp @@ -33,14 +33,13 @@ (remove-keywords (cddr options) keywords))))) (def!struct (prim-object-slot - (:constructor make-slot (name docs rest-p offset length options)) + (:constructor make-slot (name docs rest-p offset options)) (:make-load-form-fun just-dump-it-normally) (:conc-name slot-)) (name nil :type symbol) (docs nil :type (or null simple-string)) (rest-p nil :type (member t nil)) (offset 0 :type fixnum) - (length 1 :type fixnum) (options nil :type list)) (def!struct (primitive-object (:make-load-form-fun just-dump-it-normally)) @@ -79,7 +78,7 @@ (set-known nil set-known-p) set-trans &allow-other-keys) (if (atom spec) (list spec) spec) - (slots (make-slot slot-name docs rest-p offset length + (slots (make-slot slot-name docs rest-p offset (remove-keywords options '(:docs :rest-p :length)))) (let ((offset-sym (symbolicate name "-" slot-name diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp index 29c5c06..6a3e942 100644 --- a/src/compiler/generic/vm-tran.lisp +++ b/src/compiler/generic/vm-tran.lisp @@ -487,14 +487,56 @@ (defknown ,name (integer (integer 0)) (unsigned-byte ,width) (foldable flushable movable)) (define-modular-fun-optimizer ash ((integer count) :width width) - (when (and (<= width 32) + (when (and (<= width ,width) (constant-lvar-p count) ;? (plusp (lvar-value count))) (cut-to-width integer width) ',name)) (setf (gethash ',name *modular-versions*) `(ash ,',width))))) - #!-alpha (def sb!vm::ash-left-mod32 32) - #!+alpha (def sb!vm::ash-left-mod64 64)) + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) + (def sb!vm::ash-left-mod32 32) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + (def sb!vm::ash-left-mod64 64)) + + +;;;; word-wise logical operations + +;;; These transforms assume the presence of modular arithmetic to +;;; generate efficient code. + +(define-source-transform word-logical-not (x) + `(logand (lognot (the sb!vm:word ,x) #.(1- (ash 1 sb!vm:n-word-bits))))) + +(deftransform word-logical-and ((x y)) + '(logand x y)) + +(deftransform word-logical-nand ((x y)) + '(logand (lognand x y) #.(1- (ash 1 sb!vm:n-word-bits)))) + +(deftransform word-logical-or ((x y)) + '(logior x y)) + +(deftransform word-logical-nor ((x y)) + '(logand (lognor x y) #.(1- (ash 1 sb!vm:n-word-bits)))) + +(deftransform word-logical-xor ((x y)) + '(logxor x y)) + +(deftransform word-logical-eqv ((x y)) + '(logand (logeqv x y) #.(1- (ash 1 sb!vm:n-word-bits)))) + +(deftransform word-logical-orc1 ((x y)) + '(logand (logorc1 x y) #.(1- (ash 1 sb!vm:n-word-bits)))) + +(deftransform word-logical-orc2 ((x y)) + '(logand (logorc2 x y) #.(1- (ash 1 sb!vm:n-word-bits)))) + +(deftransform word-logical-andc1 ((x y)) + '(logand (logandc1 x y) #.(1- (ash 1 sb!vm:n-word-bits)))) + +(deftransform word-logical-andc2 ((x y)) + '(logand (logandc2 x y) #.(1- (ash 1 sb!vm:n-word-bits)))) + ;;; There are two different ways the multiplier can be recoded. The ;;; more obvious is to shift X by the correct amount for each bit set diff --git a/src/compiler/hppa/arith.lisp b/src/compiler/hppa/arith.lisp index 880be1f..dafcd2a 100644 --- a/src/compiler/hppa/arith.lisp +++ b/src/compiler/hppa/arith.lisp @@ -631,42 +631,6 @@ (define-source-transform lognor (x y) `(lognot (logior ,x y))) -;;;; 32-bit logical operations - -(define-source-transform word-logical-not (x) - `(logand (lognot (the (unsigned-byte 32) ,x)) #.(1- (ash 1 32)))) - -(deftransform word-logical-and ((x y)) - '(logand x y)) - -(define-source-transform word-logical-nand (x y) - `(word-logical-not (word-logical-and ,x ,y))) - -(deftransform word-logical-or ((x y)) - '(logior 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 word-logical-xor ((x y)) - '(logxor x y)) - -(define-source-transform word-logical-eqv (x y) - `(word-logical-not (word-logical-xor ,x ,y))) - -(define-source-transform word-logical-orc1 (x y) - `(word-logical-or (word-logical-not ,x) ,y)) - -(define-source-transform word-logical-orc2 (x y) - `(word-logical-or ,x (word-logical-not ,y))) - -(deftransform word-logical-andc1 (x y) - '(logandc1 x y)) - -(deftransform word-logical-andc2 (x y) - '(logandc2 x y)) - (define-vop (shift-towards-someplace) (:policy :fast-safe) (:args (num :scs (unsigned-reg)) diff --git a/src/compiler/mips/arith.lisp b/src/compiler/mips/arith.lisp index 41db1f6..61d6c29 100644 --- a/src/compiler/mips/arith.lisp +++ b/src/compiler/mips/arith.lisp @@ -616,40 +616,6 @@ (emit-label done) (move result res)))) -(define-source-transform word-logical-not (x) - `(logand (lognot (the (unsigned-byte 32) ,x)) #.(1- (ash 1 32)))) - -(deftransform word-logical-and ((x y)) - '(logand x y)) - -(define-source-transform word-logical-nand (x y) - `(word-logical-not (word-logical-and ,x ,y))) - -(deftransform word-logical-or ((x y)) - '(logior 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 word-logical-xor ((x y)) - '(logxor x y)) - -(define-source-transform word-logical-eqv (x y) - `(word-logical-not (word-logical-xor ,x ,y))) - -(define-source-transform word-logical-orc1 (x y) - `(word-logical-or (word-logical-not ,x) ,y)) - -(define-source-transform word-logical-orc2 (x y) - `(word-logical-or ,x (word-logical-not ,y))) - -(define-source-transform word-logical-andc1 (x y) - `(word-logical-and (word-logical-not ,x) ,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) (:args (num :scs (unsigned-reg)) diff --git a/src/compiler/ppc/arith.lisp b/src/compiler/ppc/arith.lisp index 8141ec4..df34914 100644 --- a/src/compiler/ppc/arith.lisp +++ b/src/compiler/ppc/arith.lisp @@ -703,39 +703,6 @@ (emit-label done) (move result res)))) -(define-source-transform word-logical-not (x) - `(logand (lognot (the (unsigned-byte 32) ,x)) #.(1- (ash 1 32)))) - -(deftransform word-logical-and ((x y)) - '(logand x y)) - -(deftransform word-logical-nand ((x y)) - '(logand (lognand x y) #.(1- (ash 1 32)))) - -(deftransform word-logical-or ((x y)) - '(logior x y)) - -(deftransform word-logical-nor ((x y)) - '(logand (lognor x y) #.(1- (ash 1 32)))) - -(deftransform word-logical-xor ((x y)) - '(logxor x y)) - -(deftransform word-logical-eqv ((x y)) - '(logand (logeqv x y) #.(1- (ash 1 32)))) - -(deftransform word-logical-orc1 ((x y)) - '(logand (logorc1 x y) #.(1- (ash 1 32)))) - -(deftransform word-logical-orc2 ((x y)) - '(logand (logorc2 x y) #.(1- (ash 1 32)))) - -(deftransform word-logical-andc1 ((x y)) - '(logand (logandc1 x y) #.(1- (ash 1 32)))) - -(deftransform word-logical-andc2 ((x y)) - '(logand (logandc2 x y) #.(1- (ash 1 32)))) - (define-vop (shift-towards-someplace) (:policy :fast-safe) (:args (num :scs (unsigned-reg)) diff --git a/src/compiler/sparc/arith.lisp b/src/compiler/sparc/arith.lisp index c722d15..f1f8536 100644 --- a/src/compiler/sparc/arith.lisp +++ b/src/compiler/sparc/arith.lisp @@ -825,39 +825,6 @@ (emit-label done) (move result res)))) -(define-source-transform word-logical-not (x) - `(logand (lognot (the (unsigned-byte 32) ,x)) #.(1- (ash 1 32)))) - -(deftransform word-logical-and ((x y)) - '(logand x y)) - -(deftransform word-logical-nand ((x y)) - '(logand (lognand x y) #.(1- (ash 1 32)))) - -(deftransform word-logical-or ((x y)) - '(logior x y)) - -(deftransform word-logical-nor ((x y)) - '(logand (lognor x y) #.(1- (ash 1 32)))) - -(deftransform word-logical-xor ((x y)) - '(logxor x y)) - -(deftransform word-logical-eqv ((x y)) - '(logand (logeqv x y) #.(1- (ash 1 32)))) - -(deftransform word-logical-orc1 ((x y)) - '(logand (logorc1 x y) #.(1- (ash 1 32)))) - -(deftransform word-logical-orc2 ((x y)) - '(logand (logorc2 x y) #.(1- (ash 1 32)))) - -(deftransform word-logical-andc1 ((x y)) - '(logand (logandc1 x y) #.(1- (ash 1 32)))) - -(deftransform word-logical-andc2 ((x y)) - '(logand (logandc2 x y) #.(1- (ash 1 32)))) - (define-vop (shift-towards-someplace) (:policy :fast-safe) (:args (num :scs (unsigned-reg)) diff --git a/src/compiler/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp index 0ac6aee..f549575 100644 --- a/src/compiler/x86-64/arith.lisp +++ b/src/compiler/x86-64/arith.lisp @@ -1206,39 +1206,6 @@ (move result prev) (inst shrd result next :cl))) -(define-source-transform word-logical-not (x) - `(logand (lognot (the (unsigned-byte 64) ,x)) #.(1- (ash 1 64)))) - -(deftransform word-logical-and ((x y)) - '(logand x y)) - -(define-source-transform word-logical-nand (x y) - `(word-logical-not (word-logical-and ,x ,y))) - -(deftransform word-logical-or ((x y)) - '(logior x y)) - -(define-source-transform word-logical-nor (x y) - `(word-logical-not (word-logical-or ,x ,y))) - -(deftransform word-logical-xor ((x y)) - '(logxor x y)) - -(define-source-transform word-logical-eqv (x y) - `(word-logical-not (word-logical-xor ,x ,y))) - -(define-source-transform word-logical-orc1 (x y) - `(word-logical-or (word-logical-not ,x) ,y)) - -(define-source-transform word-logical-orc2 (x y) - `(word-logical-or ,x (word-logical-not ,y))) - -(define-source-transform word-logical-andc1 (x y) - `(word-logical-and (word-logical-not ,x) ,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) (:policy :fast-safe) diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp index 76d39af..9e8e07e 100644 --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -1164,39 +1164,6 @@ (move result prev) (inst shrd result next :cl))) -(define-source-transform word-logical-not (x) - `(logand (lognot (the (unsigned-byte 32) ,x)) #.(1- (ash 1 32)))) - -(deftransform word-logical-and ((x y)) - '(logand x y)) - -(define-source-transform word-logical-nand (x y) - `(word-logical-not (word-logical-and ,x ,y))) - -(deftransform word-logical-or ((x y)) - '(logior x y)) - -(define-source-transform word-logical-nor (x y) - `(word-logical-not (word-logical-or ,x ,y))) - -(deftransform word-logical-xor ((x y)) - '(logxor x y)) - -(define-source-transform word-logical-eqv (x y) - `(word-logical-not (word-logical-xor ,x ,y))) - -(define-source-transform word-logical-orc1 (x y) - `(word-logical-or (word-logical-not ,x) ,y)) - -(define-source-transform word-logical-orc2 (x y) - `(word-logical-or ,x (word-logical-not ,y))) - -(define-source-transform word-logical-andc1 (x y) - `(word-logical-and (word-logical-not ,x) ,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) (:policy :fast-safe) diff --git a/version.lisp-expr b/version.lisp-expr index e0c261c..64ed6cb 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.34" +"0.8.13.35" -- 1.7.10.4