X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Farith.lisp;h=f615ebd6f1c4021c3555c3e0cb8d95b2d7d4503e;hb=3b7fca49cbf6c48605e7ebc1f57caa3255ca5cfd;hp=3e55ac2d36b9f4e34108a5f8f8e4109416cee975;hpb=906ecd4ef2d10aca23e1081f03c13fe2f932ed89;p=sbcl.git diff --git a/src/compiler/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp index 3e55ac2..f615ebd 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 @@ -1005,8 +1008,8 @@ ;;;; binary conditional VOPs (define-vop (fast-conditional) - (:conditional) - (:info target not-p) + (:conditional :e) + (:info) (:effects) (:affected) (:policy :fast-safe)) @@ -1025,7 +1028,7 @@ (define-vop (fast-conditional-c/fixnum fast-conditional/fixnum) (:args (x :scs (any-reg control-stack))) (:arg-types tagged-num (:constant (signed-byte 29))) - (:info target not-p y)) + (:info y)) (define-vop (fast-conditional/signed fast-conditional) (:args (x :scs (signed-reg) @@ -1038,7 +1041,7 @@ (define-vop (fast-conditional-c/signed fast-conditional/signed) (:args (x :scs (signed-reg signed-stack))) (:arg-types signed-num (:constant (signed-byte 31))) - (:info target not-p y)) + (:info y)) (define-vop (fast-conditional/unsigned fast-conditional) (:args (x :scs (unsigned-reg) @@ -1051,7 +1054,7 @@ (define-vop (fast-conditional-c/unsigned fast-conditional/unsigned) (:args (x :scs (unsigned-reg unsigned-stack))) (:arg-types unsigned-num (:constant (unsigned-byte 31))) - (:info target not-p y)) + (:info y)) (macrolet ((define-conditional-vop (tran cond unsigned not-cond not-unsigned) `(progn @@ -1065,19 +1068,12 @@ (format nil "~:@(FAST-CONDITIONAL~A~)" suffix))) (:translate ,tran) + (:conditional ,(if signed cond unsigned)) (:generator ,cost (inst cmp x ,(if (eq suffix '-c/fixnum) '(fixnumize y) - 'y)) - (inst jmp (if not-p - ,(if signed - not-cond - not-unsigned) - ,(if signed - cond - unsigned)) - target)))) + 'y))))) '(/fixnum -c/fixnum /signed -c/signed /unsigned -c/unsigned) ; '(/fixnum /signed /unsigned) '(4 3 6 5 6 5) @@ -1089,8 +1085,7 @@ (define-vop (fast-if-eql/signed fast-conditional/signed) (:translate eql) (:generator 6 - (inst cmp x y) - (inst jmp (if not-p :ne :e) target))) + (inst cmp x y))) (define-vop (fast-if-eql-c/signed fast-conditional-c/signed) (:translate eql) @@ -1098,14 +1093,12 @@ (cond ((and (sc-is x signed-reg) (zerop y)) (inst test x x)) ; smaller instruction (t - (inst cmp x y))) - (inst jmp (if not-p :ne :e) target))) + (inst cmp x y))))) (define-vop (fast-if-eql/unsigned fast-conditional/unsigned) (:translate eql) (:generator 6 - (inst cmp x y) - (inst jmp (if not-p :ne :e) target))) + (inst cmp x y))) (define-vop (fast-if-eql-c/unsigned fast-conditional-c/unsigned) (:translate eql) @@ -1113,8 +1106,7 @@ (cond ((and (sc-is x unsigned-reg) (zerop y)) (inst test x x)) ; smaller instruction (t - (inst cmp x y))) - (inst jmp (if not-p :ne :e) target))) + (inst cmp x y))))) ;;; EQL/FIXNUM is funny because the first arg can be of any type, not just a ;;; known fixnum. @@ -1134,8 +1126,8 @@ (:note "inline fixnum comparison") (:translate eql) (:generator 4 - (inst cmp x y) - (inst jmp (if not-p :ne :e) target))) + (inst cmp x y))) + (define-vop (generic-eql/fixnum fast-eql/fixnum) (:args (x :scs (any-reg descriptor-reg) :load-if (not (and (sc-is x control-stack) @@ -1144,18 +1136,16 @@ (:arg-types * tagged-num) (:variant-cost 7)) - (define-vop (fast-eql-c/fixnum fast-conditional/fixnum) (:args (x :scs (any-reg control-stack))) (:arg-types tagged-num (:constant (signed-byte 29))) - (:info target not-p y) + (:info y) (:translate eql) (:generator 2 (cond ((and (sc-is x any-reg) (zerop y)) (inst test x x)) ; smaller instruction (t - (inst cmp x (fixnumize y)))) - (inst jmp (if not-p :ne :e) target))) + (inst cmp x (fixnumize y)))))) (define-vop (generic-eql-c/fixnum fast-eql-c/fixnum) (:args (x :scs (any-reg descriptor-reg control-stack))) @@ -1164,21 +1154,6 @@ ;;;; 32-bit logical operations -(define-vop (merge-bits) - (:translate merge-bits) - (:args (shift :scs (signed-reg unsigned-reg) :target ecx) - (prev :scs (unsigned-reg) :target result) - (next :scs (unsigned-reg))) - (:arg-types tagged-num unsigned-num unsigned-num) - (:temporary (:sc signed-reg :offset ecx-offset :from (:argument 0)) ecx) - (:results (result :scs (unsigned-reg) :from (:argument 1))) - (:result-types unsigned-num) - (:policy :fast-safe) - (:generator 4 - (move ecx shift) - (move result prev) - (inst shrd result next :cl))) - ;;; Only the lower 6 bits of the shift amount are significant. (define-vop (shift-towards-someplace) (:policy :fast-safe) @@ -1262,8 +1237,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 +1281,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 +1327,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 +1345,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) @@ -1424,11 +1385,9 @@ (:policy :fast-safe) (:args (digit :scs (unsigned-reg))) (:arg-types unsigned-num) - (:conditional) - (:info target not-p) + (:conditional :ns) (:generator 3 - (inst or digit digit) - (inst jmp (if not-p :s :ns) target))) + (inst or digit digit))) ;;; For add and sub with carry the sc of carry argument is any-reg so