From: Martin Cracauer Date: Thu, 11 Apr 2013 15:34:03 +0000 (-0400) Subject: LOGBITP and LOGTEST optimizations from x86. X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=7a2a31f9407a7da9d26cf1bc91c302461823719f;p=sbcl.git LOGBITP and LOGTEST optimizations from x86. Copy Nathan Froyd's optimizations for LOGBITP and LOGTEST on x86 architecture into x86-64. Committing change submitted by Doug Katzman. --- diff --git a/NEWS b/NEWS index 91ec2be..0c96a2a 100644 --- a/NEWS +++ b/NEWS @@ -8,6 +8,7 @@ changes relative to sbcl-1.1.6 Signal a style-warning instead when trying to set documentation of NIL for all other documentation types. Reported by Zach Beane. Regression since 2e52fa05. + * LOGBITP and LOGTEST optimizations from x86 ported to x86_64. changes in sbcl-1.1.6 relative to sbcl-1.1.5: * enhancement: the continuable error when defknown-ing over extant diff --git a/src/compiler/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp index 9d48e29..dc33d2c 100644 --- a/src/compiler/x86-64/arith.lisp +++ b/src/compiler/x86-64/arith.lisp @@ -1155,6 +1155,79 @@ constant shift greater than word length"))) (:arg-types unsigned-num (:constant (unsigned-byte 64))) (:info y)) +;; Stolen liberally from the x86 32-bit implementation. +(macrolet ((define-logtest-vops () + `(progn + ,@(loop for suffix in '(/fixnum -c/fixnum + /signed -c/signed + /unsigned -c/unsigned) + for cost in '(4 3 6 5 6 5) + collect + `(define-vop (,(symbolicate "FAST-LOGTEST" suffix) + ,(symbolicate "FAST-CONDITIONAL" suffix)) + (:translate logtest) + (:conditional :ne) + (:generator ,cost + (emit-optimized-test-inst x + ,(if (eq suffix '-c/fixnum) + ;; See whether (fixnumize y) fits in signed 32 + ;; to avoid chip's sign-extension of imm32 val. + `(if (typep y 'short-tagged-num) + (fixnumize y) + (register-inline-constant :qword (fixnumize y))) + `(cond ((typep y '(signed-byte 32)) ; same + y) + ((typep y '(or (unsigned-byte 64) (signed-byte 64))) + (register-inline-constant :qword y)) + (t + y)))))))))) + (define-logtest-vops)) + +(defknown %logbitp (integer unsigned-byte) boolean + (movable foldable flushable always-translatable)) + +;;; only for constant folding within the compiler +(defun %logbitp (integer index) + (logbitp index integer)) + +;;; too much work to do the non-constant case (maybe?) +(define-vop (fast-logbitp-c/fixnum fast-conditional-c/fixnum) + (:translate %logbitp) + (:conditional :c) + (:arg-types tagged-num (:constant (integer 0 #.(- 63 n-fixnum-tag-bits)))) + (:generator 4 + (inst bt x (+ y n-fixnum-tag-bits)))) + +(define-vop (fast-logbitp/signed fast-conditional/signed) + (:args (x :scs (signed-reg signed-stack)) + (y :scs (signed-reg))) + (:translate %logbitp) + (:conditional :c) + (:generator 6 + (inst bt x y))) + +(define-vop (fast-logbitp-c/signed fast-conditional-c/signed) + (:translate %logbitp) + (:conditional :c) + (:arg-types signed-num (:constant (integer 0 63))) + (:generator 5 + (inst bt x y))) + +(define-vop (fast-logbitp/unsigned fast-conditional/unsigned) + (:args (x :scs (unsigned-reg unsigned-stack)) + (y :scs (unsigned-reg))) + (:translate %logbitp) + (:conditional :c) + (:generator 6 + (inst bt x y))) + +(define-vop (fast-logbitp-c/unsigned fast-conditional-c/unsigned) + (:translate %logbitp) + (:conditional :c) + (:arg-types unsigned-num (:constant (integer 0 63))) + (:generator 5 + (inst bt x y))) + (macrolet ((define-conditional-vop (tran cond unsigned not-cond not-unsigned) `(progn ,@(mapcar diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp index 15efc7d..0a982cd 100644 --- a/src/compiler/x86-64/insts.lisp +++ b/src/compiler/x86-64/insts.lisp @@ -2262,6 +2262,27 @@ (t (error "bogus operands for TEST: ~S and ~S" this that))))))) +;;; Emit the most compact form of the test immediate instruction, +;;; using an 8 bit test when the immediate is only 8 bits and the +;;; value is one of the four low registers (rax, rbx, rcx, rdx) or the +;;; control stack. +(defun emit-optimized-test-inst (x y) + (typecase y + ((unsigned-byte 7) + (let ((offset (tn-offset x))) + (cond ((and (sc-is x any-reg descriptor-reg) + (or (= offset rax-offset) (= offset rbx-offset) + (= offset rcx-offset) (= offset rdx-offset))) + (inst test (reg-in-size x :byte) y)) + ((sc-is x control-stack) + (inst test (make-ea :byte :base rbp-tn + :disp (frame-byte-offset offset)) + y)) + (t + (inst test x y))))) + (t + (inst test x y)))) + (define-instruction or (segment dst src) (:printer-list (arith-inst-printer-list #b001)) diff --git a/src/compiler/x86-64/vm.lisp b/src/compiler/x86-64/vm.lisp index 9295e4e..6c44424 100644 --- a/src/compiler/x86-64/vm.lisp +++ b/src/compiler/x86-64/vm.lisp @@ -555,5 +555,33 @@ (def!constant cfp-offset rbp-offset) ; pfw - needed by stuff in /code (!def-vm-support-routine combination-implementation-style (node) - (declare (type sb!c::combination node) (ignore node)) - (values :default nil)) + (declare (type sb!c::combination node)) + (flet ((valid-funtype (args result) + (sb!c::valid-fun-use node + (sb!c::specifier-type + `(function ,args ,result))))) + (case (sb!c::combination-fun-source-name node) + (logtest + (cond + ((or (valid-funtype '(fixnum fixnum) '*) + ;; todo: nothing prevents this from testing an unsigned word against + ;; a signed word, except for the mess of VOPs it would demand + (valid-funtype '((signed-byte 64) (signed-byte 64)) '*) + (valid-funtype '((unsigned-byte 64) (unsigned-byte 64)) '*)) + (values :direct nil)) + (t + (values :default nil)))) + (logbitp + (cond + ((or (and (valid-funtype '#.`((integer 0 ,(- 63 n-fixnum-tag-bits)) + fixnum) '*) + (sb!c::constant-lvar-p + (first (sb!c::basic-combination-args node)))) + (valid-funtype '((integer 0 63) (signed-byte 64)) '*) + (valid-funtype '((integer 0 63) (unsigned-byte 64)) '*)) + (values :transform '(lambda (index integer) + (%logbitp integer index)))) + (t + (values :default nil)))) + (t + (values :default nil)))))