Raymond Toy pushed to branch master at cmucl / cmucl

Commits: a70248dd by Raymond Toy at 2023-08-19T13:38:11+00:00 Fix #249: Replace lea instruction for arithmetic

- - - - - 5b3e11f9 by Raymond Toy at 2023-08-19T13:38:34+00:00 Merge branch 'issue-249-replace-lea-in-arith' into 'master'

Fix #249: Replace lea instruction for arithmetic

Closes #249

See merge request cmucl/cmucl!163 - - - - -

1 changed file:

- src/compiler/x86/arith.lisp

Changes:

===================================== src/compiler/x86/arith.lisp ===================================== @@ -196,143 +196,13 @@

-;(define-binop + 4 add) +(define-binop + 4 add) (define-binop - 4 sub) (define-binop logand 2 and) (define-binop logior 2 or) (define-binop logxor 2 xor)

-;;; Special handling of add on the x86; can use lea to avoid a -;;; register load, otherwise it uses add. -(define-vop (fast-+/fixnum=>fixnum fast-safe-arith-op) - (:translate +) - (:args (x :scs (any-reg) :target r - :load-if (not (and (sc-is x control-stack) - (sc-is y any-reg) - (sc-is r control-stack) - (location= x r)))) - (y :scs (any-reg control-stack))) - (:arg-types tagged-num tagged-num) - (:results (r :scs (any-reg) :from (:argument 0) - :load-if (not (and (sc-is x control-stack) - (sc-is y any-reg) - (sc-is r control-stack) - (location= x r))))) - (:result-types tagged-num) - (:note _N"inline fixnum arithmetic") - (:generator 2 - (cond ((and (sc-is x any-reg) (sc-is y any-reg) (sc-is r any-reg) - (not (location= x r))) - (inst lea r (make-ea :dword :base x :index y :scale 1))) - (t - (move r x) - (inst add r y))))) - -(define-vop (fast-+-c/fixnum=>fixnum fast-safe-arith-op) - (:translate +) - (:args (x :target r :scs (any-reg control-stack))) - (:info y) - (:arg-types tagged-num (:constant (signed-byte 30))) - (:results (r :scs (any-reg) - :load-if (not (location= x r)))) - (:result-types tagged-num) - (:note _N"inline fixnum arithmetic") - (:generator 1 - (cond ((and (sc-is x any-reg) (sc-is r any-reg) (not (location= x r))) - (inst lea r (make-ea :dword :base x :disp (fixnumize y)))) - (t - (move r x) - (inst add r (fixnumize y)))))) - -(define-vop (fast-+/signed=>signed fast-safe-arith-op) - (:translate +) - (:args (x :scs (signed-reg) :target r - :load-if (not (and (sc-is x signed-stack) - (sc-is y signed-reg) - (sc-is r signed-stack) - (location= x r)))) - (y :scs (signed-reg signed-stack))) - (:arg-types signed-num signed-num) - (:results (r :scs (signed-reg) :from (:argument 0) - :load-if (not (and (sc-is x signed-stack) - (sc-is y signed-reg) - (location= x r))))) - (:result-types signed-num) - (:note _N"inline (signed-byte 32) arithmetic") - (:generator 5 - (cond ((and (sc-is x signed-reg) (sc-is y signed-reg) (sc-is r signed-reg) - (not (location= x r))) - (inst lea r (make-ea :dword :base x :index y :scale 1))) - (t - (move r x) - (inst add r y))))) - -(define-vop (fast-+-c/signed=>signed fast-safe-arith-op) - (:translate +) - (:args (x :target r :scs (signed-reg signed-stack))) - (:info y) - (:arg-types signed-num (:constant (signed-byte 32))) - (:results (r :scs (signed-reg) - :load-if (not (location= x r)))) - (:result-types signed-num) - (:note _N"inline (signed-byte 32) arithmetic") - (:generator 4 - (cond ((and (sc-is x signed-reg) (sc-is r signed-reg) - (not (location= x r))) - (inst lea r (make-ea :dword :base x :disp y))) - (t - (move r x) - (if (= y 1) - (inst inc r) - (inst add r y)))))) - -(define-vop (fast-+/unsigned=>unsigned fast-safe-arith-op) - (:translate +) - (:args (x :scs (unsigned-reg) :target r - :load-if (not (and (sc-is x unsigned-stack) - (sc-is y unsigned-reg) - (sc-is r unsigned-stack) - (location= x r)))) - (y :scs (unsigned-reg unsigned-stack))) - (:arg-types unsigned-num unsigned-num) - (:results (r :scs (unsigned-reg) :from (:argument 0) - :load-if (not (and (sc-is x unsigned-stack) - (sc-is y unsigned-reg) - (sc-is r unsigned-stack) - (location= x r))))) - (:result-types unsigned-num) - (:note _N"inline (unsigned-byte 32) arithmetic") - (:generator 5 - (cond ((and (sc-is x unsigned-reg) (sc-is y unsigned-reg) - (sc-is r unsigned-reg) (not (location= x r))) - (inst lea r (make-ea :dword :base x :index y :scale 1))) - (t - (move r x) - (inst add r y))))) - -(define-vop (fast-+-c/unsigned=>unsigned fast-safe-arith-op) - (:translate +) - (:args (x :target r :scs (unsigned-reg unsigned-stack))) - (:info y) - (:arg-types unsigned-num (:constant (unsigned-byte 32))) - (:results (r :scs (unsigned-reg) - :load-if (not (location= x r)))) - (:result-types unsigned-num) - (:note _N"inline (unsigned-byte 32) arithmetic") - (:generator 4 - (cond ((and (sc-is x unsigned-reg) - (sc-is r unsigned-reg) - (not (location= x r)) - (valid-displacement-p y)) - (inst lea r (make-ea :dword :base x :disp y))) - (t - (move r x) - (if (= y 1) - (inst inc r) - (inst add r y)))))) - - ;;;; Special logand cases: (logand signed unsigned) => unsigned

(define-vop (fast-logand/signed-unsigned=>unsigned @@ -641,25 +511,18 @@ (:result-types tagged-num) (:note _N"inline ASH") (:generator 2 - (cond ((and (= amount 1) (not (location= number result))) - (inst lea result (make-ea :dword :index number :scale 2))) - ((and (= amount 2) (not (location= number result))) - (inst lea result (make-ea :dword :index number :scale 4))) - ((and (= amount 3) (not (location= number result))) - (inst lea result (make-ea :dword :index number :scale 8))) + (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 - (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 - ;; If the amount is greater than 31, only shift by 31. We - ;; have to do this because the shift instructions only look - ;; at the low five bits of the result. - (inst sar result (min 31 (- amount))) - ;; Fixnum correction. - (inst and result #xfffffffc))))))) + ;; If the amount is greater than 31, only shift by 31. We + ;; have to do this because the shift instructions only look + ;; at the low five bits of the result. + (inst sar result (min 31 (- amount))) + ;; Fixnum correction. + (inst and result #xfffffffc)))))

(define-vop (fast-ash-left/fixnum=>fixnum) (:translate ash) @@ -699,22 +562,15 @@ (:result-types unsigned-num) (:note _N"inline ASH") (:generator 3 - (cond ((and (= amount 1) (not (location= number result))) - (inst lea result (make-ea :dword :index number :scale 2))) - ((and (= amount 2) (not (location= number result))) - (inst lea result (make-ea :dword :index number :scale 4))) - ((and (= amount 3) (not (location= number result))) - (inst lea result (make-ea :dword :index number :scale 8))) + (move result number) + (cond ((plusp amount) + ;; We don't have to worry about overflow because of the + ;; result type restriction. + (inst shl result amount)) + ((< amount -31) + (inst mov result 0)) (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)) - ((< amount -31) - (inst mov result 0)) - (t - (inst shr result (- amount)))))))) + (inst shr result (- amount))))))

(define-vop (fast-ash-c/signed=>signed) (:translate ash) @@ -732,23 +588,16 @@ (:result-types signed-num) (:note _N"inline ASH") (:generator 3 - (cond ((and (= amount 1) (not (location= number result))) - (inst lea result (make-ea :dword :index number :scale 2))) - ((and (= amount 2) (not (location= number result))) - (inst lea result (make-ea :dword :index number :scale 4))) - ((and (= amount 3) (not (location= number result))) - (inst lea result (make-ea :dword :index number :scale 8))) + (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 - (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 - ;; If the amount is greater than 31, only shift by 31. We - ;; have to do this because the shift instructions only look - ;; at the low five bits of the result. - (inst sar result (min 31 (- amount))))))))) + ;; If the amount is greater than 31, only shift by 31. We + ;; have to do this because the shift instructions only look + ;; at the low five bits of the result. + (inst sar result (min 31 (- amount)))))))

(define-vop (fast-ash-c/fixnum=>signed) (:translate ash) @@ -767,23 +616,16 @@ (:note "inline ASH") (:generator 1 (let ((shift (- amount vm:fixnum-tag-bits))) - (cond ((and (= shift 1) (not (location= number result))) - (inst lea result (make-ea :dword :index number :scale 2))) - ((and (= shift 2) (not (location= number result))) - (inst lea result (make-ea :dword :index number :scale 4))) - ((and (= shift 3) (not (location= number result))) - (inst lea result (make-ea :dword :index number :scale 8))) + (move result number) + (cond ((plusp shift) + ;; We don't have to worry about overflow because of the + ;; result type restriction. + (inst shl result shift)) (t - (move result number) - (cond ((plusp shift) - ;; We don't have to worry about overflow because of the - ;; result type restriction. - (inst shl result shift)) - (t - ;; If the shift is greater than 31, only shift by 31. We - ;; have to do this because the shift instructions only look - ;; at the low five bits of the result. - (inst sar result (min 31 (- shift)))))))))) + ;; If the shift is greater than 31, only shift by 31. We + ;; have to do this because the shift instructions only look + ;; at the low five bits of the result. + (inst sar result (min 31 (- shift))))))))

(define-vop (fast-ash-left/unsigned=>unsigned) (:translate ash) @@ -1907,4 +1749,4 @@ vm:other-pointer-type)) s1))) ) - \ No newline at end of file +

View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/181508a9edeaf570fd3f7a8...