X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Farith.lisp;h=f8cb9aa1b44dce12979bf203c4cd2f3cb26bc6af;hb=7deecae2d959173eda6a153d490c752c32050a9e;hp=5a20c341a29a7a8215c2f9fc0e6cdc4415a951ba;hpb=6b2e5ac556aef4dbf54b60b9512edf1b9c5cc457;p=sbcl.git diff --git a/src/compiler/ppc/arith.lisp b/src/compiler/ppc/arith.lisp index 5a20c34..f8cb9aa 100644 --- a/src/compiler/ppc/arith.lisp +++ b/src/compiler/ppc/arith.lisp @@ -44,12 +44,12 @@ (define-vop (fast-lognot/fixnum fixnum-unop) (:translate lognot) - (:generator 2 - (inst xori res x (fixnumize -1)))) + (:generator 1 + (inst subfic res x (fixnumize -1)))) (define-vop (fast-lognot/signed signed-unop) (:translate lognot) - (:generator 1 + (:generator 2 (inst not res x))) ;;;; Binary fixnum operations. @@ -459,7 +459,7 @@ (:temporary (:scs (non-descriptor-reg)) temp) (:translate *) (:generator 2 - (inst srawi temp y 2) + (inst srawi temp y n-fixnum-tag-bits) (inst mullw r x temp))) (define-vop (fast-*-c/fixnum=>fixnum fast-fixnum-binop-c) @@ -661,8 +661,60 @@ (emit-label done)))) +;;;; %LDB + +(defknown %%ldb (integer unsigned-byte unsigned-byte) unsigned-byte + (movable foldable flushable always-translatable)) + +;;; only for constant folding within the compiler +(defun %%ldb (integer size posn) + (sb!kernel::%ldb size posn integer)) + +(define-vop (ldb-c/fixnum) + (:translate %%ldb) + (:args (x :scs (any-reg))) + (:arg-types tagged-num (:constant (integer 1 29)) (:constant (integer 0 29))) + (:info size posn) + (:results (res :scs (any-reg))) + (:result-types tagged-num) + (:policy :fast-safe) + (:generator 2 + (inst rlwinm res x + (mod (- 32 posn) 32) ; effectively rotate right + (- 32 size n-fixnum-tag-bits) + (- 31 n-fixnum-tag-bits)))) + +(define-vop (ldb-c/signed) + (:translate %%ldb) + (:args (x :scs (signed-reg))) + (:arg-types signed-num (:constant (integer 1 29)) (:constant (integer 0 29))) + (:info size posn) + (:results (res :scs (any-reg))) + (:result-types tagged-num) + (:policy :fast-safe) + (:generator 3 + (inst rlwinm res x + (mod (- (+ 32 n-fixnum-tag-bits) posn) 32) + (- 32 size n-fixnum-tag-bits) + (- 31 n-fixnum-tag-bits)))) + +(define-vop (ldb-c/unsigned) + (:translate %%ldb) + (:args (x :scs (unsigned-reg))) + (:arg-types unsigned-num (:constant (integer 1 29)) (:constant (integer 0 29))) + (:info size posn) + (:results (res :scs (any-reg))) + (:result-types tagged-num) + (:policy :fast-safe) + (:generator 3 + (inst rlwinm res x + (mod (- (+ 32 n-fixnum-tag-bits) posn) 32) + (- 32 size n-fixnum-tag-bits) + (- 31 n-fixnum-tag-bits)))) + + ;;;; Modular functions: -(define-modular-fun lognot-mod32 (x) lognot :unsigned 32) +(define-modular-fun lognot-mod32 (x) lognot :untagged nil 32) (define-vop (lognot-mod32/unsigned=>unsigned) (:translate lognot-mod32) (:args (x :scs (unsigned-reg))) @@ -693,7 +745,7 @@ (vop (symbolicate 'fast- fun '/unsigned=>unsigned)) (cvop (symbolicate 'fast- fun '-c/unsigned=>unsigned))) `(progn - (define-modular-fun ,mfun-name (x y) ,fun :unsigned 32) + (define-modular-fun ,mfun-name (x y) ,fun :untagged nil 32) (define-vop (,modvop ,vop) (:translate ,mfun-name)) ,@(when constantp @@ -702,7 +754,6 @@ (define-modular-backend + t) (define-modular-backend - t) (define-modular-backend * t) - (define-modular-backend logxor t) (define-modular-backend logeqv) (define-modular-backend lognand) (define-modular-backend lognor) @@ -753,6 +804,71 @@ (:arg-types unsigned-num (:constant (unsigned-byte 16))) (:info target not-p y)) +(macrolet ((define-logtest-vops () + `(progn + ,@(loop for suffix in '(/fixnum -c/fixnum + /signed -c/signed + /unsigned -c/unsigned) + for sc in '(any-reg any-reg + signed-reg signed-reg + unsigned-reg unsigned-reg) + for cost in '(4 3 6 5 6 5) + collect + `(define-vop (,(symbolicate "FAST-LOGTEST" suffix) + ,(symbolicate "FAST-CONDITIONAL" suffix)) + (:translate logtest) + (:temporary (:scs (,sc) :to (:result 0)) test) + (:generator ,cost + ;; We could be a lot more sophisticated here and + ;; check for possibilities with ANDIS.. + ,(if (string= "-C" suffix :end2 2) + `(inst andi. test x ,(if (eq suffix '-c/fixnum) + '(fixnumize y) + 'y)) + `(inst and. test x y)) + (inst b? (if not-p :eq :ne) target))))))) + (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)) + +;;; We only handle the constant cases because those are the only ones +;;; guaranteed to make it past COMBINATION-IMPLEMENTATION-STYLE. +;;; --njf, 06-02-2006 +(define-vop (fast-logbitp-c/fixnum fast-conditional-c/fixnum) + (:translate %logbitp) + (:arg-types tagged-num (:constant (integer 0 29))) + (:temporary (:scs (any-reg) :to (:result 0)) test) + (:generator 4 + (if (< y 14) + (inst andi. test x (ash 1 (+ y n-fixnum-tag-bits))) + (inst andis. test x (ash 1 (- y 14)))) + (inst b? (if not-p :eq :ne) target))) + +(define-vop (fast-logbitp-c/signed fast-conditional-c/signed) + (:translate %logbitp) + (:arg-types signed-num (:constant (integer 0 31))) + (:temporary (:scs (signed-reg) :to (:result 0)) test) + (:generator 4 + (if (< y 16) + (inst andi. test x (ash 1 y)) + (inst andis. test x (ash 1 (- y 16)))) + (inst b? (if not-p :eq :ne) target))) + +(define-vop (fast-logbitp-c/unsigned fast-conditional-c/unsigned) + (:translate %logbitp) + (:arg-types unsigned-num (:constant (integer 0 31))) + (:temporary (:scs (unsigned-reg) :to (:result 0)) test) + (:generator 4 + (if (< y 16) + (inst andi. test x (ash 1 y)) + (inst andis. test x (ash 1 (- y 16)))) + (inst b? (if not-p :eq :ne) target))) + (define-vop (fast-if-