X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Farith.lisp;h=d0436d5d99b948b32fc01269d19f0ee562346d6e;hb=5d04a95274c9ddaebbcd6ddffc5d646e2c25598c;hp=37cc2a2b9b905416ecd1f548eea5eda5fa801024;hpb=f7aa9f04c9d2124f094f4b9e857e8ce3b92035e4;p=sbcl.git diff --git a/src/compiler/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp index 37cc2a2..d0436d5 100644 --- a/src/compiler/x86-64/arith.lisp +++ b/src/compiler/x86-64/arith.lisp @@ -1,4 +1,4 @@ -;;;; the VM definition of arithmetic VOPs for the x86 +;;;; the VM definition of arithmetic VOPs for the x86-64 ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. @@ -46,13 +46,13 @@ (define-vop (fast-lognot/fixnum fixnum-unop) (:translate lognot) - (:generator 2 + (:generator 1 (move res x) (inst xor res (fixnumize -1)))) (define-vop (fast-lognot/signed signed-unop) (:translate lognot) - (:generator 1 + (:generator 2 (move res x) (inst not res))) @@ -432,7 +432,7 @@ (:vop-var vop) (:save-p :compute-only) (:generator 31 - (let ((zero (generate-error-code vop division-by-zero-error x y))) + (let ((zero (generate-error-code vop 'division-by-zero-error x y))) (if (sc-is y any-reg) (inst test y y) ; smaller instruction (inst cmp y 0)) @@ -487,7 +487,7 @@ (:vop-var vop) (:save-p :compute-only) (:generator 33 - (let ((zero (generate-error-code vop division-by-zero-error x y))) + (let ((zero (generate-error-code vop 'division-by-zero-error x y))) (if (sc-is y unsigned-reg) (inst test y y) ; smaller instruction (inst cmp y 0)) @@ -538,7 +538,7 @@ (:vop-var vop) (:save-p :compute-only) (:generator 33 - (let ((zero (generate-error-code vop division-by-zero-error x y))) + (let ((zero (generate-error-code vop 'division-by-zero-error x y))) (if (sc-is y signed-reg) (inst test y y) ; smaller instruction (inst cmp y 0)) @@ -600,19 +600,20 @@ (inst lea result (make-ea :qword :index number :scale 8))) (t (move result number) - (cond ((plusp amount) - ;; We don't have to worry about overflow because of the - ;; result type restriction. - (inst shl result amount)) - (t - ;; Since the shift instructions take the shift amount - ;; modulo 64 we must special case amounts of 64 and more. - ;; Because fixnums have only 61 bits, the result is 0 or - ;; -1 for all amounts of 60 or more, so use this as the - ;; limit instead. - (inst sar result (min (- n-word-bits n-fixnum-tag-bits 1) - (- amount))) - (inst and result (lognot fixnum-tag-mask)))))))) + (cond ((< -64 amount 64) + ;; this code is used both in ASH and ASH-SMOD61, so + ;; be careful + (if (plusp amount) + (inst shl result amount) + (progn + (inst sar result (- amount)) + (inst and result (lognot fixnum-tag-mask))))) + ((plusp amount) + (if (sc-is result any-reg) + (inst xor result result) + (inst mov result 0))) + (t (inst sar result 63) + (inst and result (lognot fixnum-tag-mask)))))))) (define-vop (fast-ash-left/fixnum=>fixnum) (:translate ash) @@ -918,7 +919,9 @@ (:result-types unsigned-num) (:generator 28 (move res arg) - (inst cmp res 0) + (if (sc-is res unsigned-reg) + (inst test res res) + (inst cmp res 0)) (inst jmp :ge POS) (inst not res) POS @@ -1238,7 +1241,7 @@ (sc-is r signed-stack)) (location= x r))))) (:info y) - (:arg-types untagged-num (:constant (or (unsigned-byte 64) (signed-byte 64)))) + (:arg-types untagged-num (:constant (or (unsigned-byte 31) (signed-byte 32)))) (:results (r :scs (unsigned-reg signed-reg) :from (:argument 0) :load-if (not (and (or (sc-is x unsigned-stack) (sc-is x signed-stack)) @@ -1262,8 +1265,8 @@ (svop61f (intern (format nil "FAST-~S-SMOD61/FIXNUM=>FIXNUM" name))) (svop61cf (intern (format nil "FAST-~S-SMOD61-C/FIXNUM=>FIXNUM" name)))) `(progn - (define-modular-fun ,fun64 (x y) ,name :unsigned 64) - (define-modular-fun ,sfun61 (x y) ,name :signed 61) + (define-modular-fun ,fun64 (x y) ,name :untagged nil 64) + (define-modular-fun ,sfun61 (x y) ,name :tagged t 61) (define-mod-binop (,vop64u ,vopu) ,fun64) (define-vop (,vop64f ,vopf) (:translate ,fun64)) (define-vop (,svop61f ,vopf) (:translate ,sfun61)) @@ -1306,19 +1309,19 @@ (signed-byte 61) (foldable flushable movable)) -(define-modular-fun-optimizer %lea ((base index scale disp) :unsigned :width width) +(define-modular-fun-optimizer %lea ((base index scale disp) :untagged nil :width width) (when (and (<= width 64) (constant-lvar-p scale) (constant-lvar-p disp)) - (cut-to-width base :unsigned width) - (cut-to-width index :unsigned width) + (cut-to-width base :untagged width nil) + (cut-to-width index :untagged width nil) 'sb!vm::%lea-mod64)) -(define-modular-fun-optimizer %lea ((base index scale disp) :signed :width width) +(define-modular-fun-optimizer %lea ((base index scale disp) :tagged t :width width) (when (and (<= width 61) (constant-lvar-p scale) (constant-lvar-p disp)) - (cut-to-width base :signed width) - (cut-to-width index :signed width) + (cut-to-width base :tagged width t) + (cut-to-width index :tagged width t) 'sb!vm::%lea-smod61)) #+sb-xc-host @@ -1352,7 +1355,7 @@ (:translate %lea-smod61)) ;;; logical operations -(define-modular-fun lognot-mod64 (x) lognot :unsigned 64) +(define-modular-fun lognot-mod64 (x) lognot :untagged nil 64) (define-vop (lognot-mod64/unsigned=>unsigned) (:translate lognot-mod64) (:args (x :scs (unsigned-reg unsigned-stack) :target r @@ -1370,20 +1373,6 @@ (move r x) (inst not r))) -(define-modular-fun logxor-mod64 (x y) logxor :unsigned 64) -(define-mod-binop (fast-logxor-mod64/word=>unsigned - fast-logxor/unsigned=>unsigned) - logxor-mod64) -(define-mod-binop-c (fast-logxor-mod64-c/word=>unsigned - fast-logxor-c/unsigned=>unsigned) - logxor-mod64) -(define-vop (fast-logxor-mod64/fixnum=>fixnum - fast-logxor/fixnum=>fixnum) - (:translate logxor-mod64)) -(define-vop (fast-logxor-mod64-c/fixnum=>fixnum - fast-logxor-c/fixnum=>fixnum) - (:translate logxor-mod64)) - (define-source-transform logeqv (&rest args) (if (oddp (length args)) `(logxor ,@args) @@ -1413,7 +1402,9 @@ (define-full-reffer bignum-ref * bignum-digits-offset other-pointer-lowtag (unsigned-reg) unsigned-num sb!bignum:%bignum-ref) - +(define-full-reffer+offset bignum--ref-with-offset * bignum-digits-offset + other-pointer-lowtag (unsigned-reg) unsigned-num + sb!bignum:%bignum-ref-with-offset) (define-full-setter bignum-set * bignum-digits-offset other-pointer-lowtag (unsigned-reg) unsigned-num sb!bignum:%bignum-set)