Skip to content
Snippets Groups Projects
Commit d2f0c163 authored by dtc's avatar dtc
Browse files

- Use the "inc" instruction for addition of constant 1.

- Use "test x x" for comparison with constant 0.

- With the improvement of targeting by the packer some time ago it was
possible to remove some VOPS SC hacks. In many cases it is better to
not list a stack SC in the list of operand preferred SCs so the
compiler can account for the extra cost making it more likely to use
registers. Some hacks are still necessary here though.

- Some style cleanups
parent 66b48696
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/arith.lisp,v 1.2 1997/02/05 15:34:11 pw Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/arith.lisp,v 1.3 1997/02/10 15:45:17 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -16,6 +16,7 @@ ...@@ -16,6 +16,7 @@
;;; Written by William Lott. ;;; Written by William Lott.
;;; ;;;
;;; Debugged by Paul F. Werkowski Spring/Summer 1995. ;;; Debugged by Paul F. Werkowski Spring/Summer 1995.
;;; Enhancements/debugging by Douglas T. Crosher 1996,1997.
;;; ;;;
(in-package :x86) (in-package :x86)
...@@ -78,12 +79,14 @@ ...@@ -78,12 +79,14 @@
(:args (x :target r :scs (any-reg) (:args (x :target r :scs (any-reg)
:load-if (not (and (sc-is x immediate-stack) :load-if (not (and (sc-is x immediate-stack)
(sc-is y any-reg) (sc-is y any-reg)
(sc-is r immediate-stack)
(location= x r)))) (location= x r))))
(y :scs (any-reg immediate-stack))) (y :scs (any-reg immediate-stack)))
(:arg-types tagged-num tagged-num) (:arg-types tagged-num tagged-num)
(:results (r :scs (any-reg) :from (:argument 0) (:results (r :scs (any-reg) :from (:argument 0)
:load-if (not (and (sc-is x immediate-stack) :load-if (not (and (sc-is x immediate-stack)
(sc-is y any-reg) (sc-is y any-reg)
(sc-is r immediate-stack)
(location= x r))))) (location= x r)))))
(:result-types tagged-num) (:result-types tagged-num)
(:note "inline fixnum arithmetic")) (:note "inline fixnum arithmetic"))
...@@ -92,12 +95,14 @@ ...@@ -92,12 +95,14 @@
(:args (x :target r :scs (unsigned-reg) (:args (x :target r :scs (unsigned-reg)
:load-if (not (and (sc-is x unsigned-stack) :load-if (not (and (sc-is x unsigned-stack)
(sc-is y unsigned-reg) (sc-is y unsigned-reg)
(sc-is r unsigned-stack)
(location= x r)))) (location= x r))))
(y :scs (unsigned-reg unsigned-stack))) (y :scs (unsigned-reg unsigned-stack)))
(:arg-types unsigned-num unsigned-num) (:arg-types unsigned-num unsigned-num)
(:results (r :scs (unsigned-reg) :from (:argument 0) (:results (r :scs (unsigned-reg) :from (:argument 0)
:load-if (not (and (sc-is x unsigned-stack) :load-if (not (and (sc-is x unsigned-stack)
(sc-is y unsigned-reg) (sc-is y unsigned-reg)
(sc-is r unsigned-stack)
(location= x r))))) (location= x r)))))
(:result-types unsigned-num) (:result-types unsigned-num)
(:note "inline (unsigned-byte 32) arithmetic")) (:note "inline (unsigned-byte 32) arithmetic"))
...@@ -106,12 +111,14 @@ ...@@ -106,12 +111,14 @@
(:args (x :target r :scs (signed-reg) (:args (x :target r :scs (signed-reg)
:load-if (not (and (sc-is x signed-stack) :load-if (not (and (sc-is x signed-stack)
(sc-is y signed-reg) (sc-is y signed-reg)
(sc-is r signed-stack)
(location= x r)))) (location= x r))))
(y :scs (signed-reg signed-stack))) (y :scs (signed-reg signed-stack)))
(:arg-types signed-num signed-num) (:arg-types signed-num signed-num)
(:results (r :scs (signed-reg) :from (:argument 0) (:results (r :scs (signed-reg) :from (:argument 0)
:load-if (not (and (sc-is x signed-stack) :load-if (not (and (sc-is x signed-stack)
(sc-is y signed-reg) (sc-is y signed-reg)
(sc-is r signed-stack)
(location= x r))))) (location= x r)))))
(:result-types signed-num) (:result-types signed-num)
(:note "inline (signed-byte 32) arithmetic")) (:note "inline (signed-byte 32) arithmetic"))
...@@ -200,27 +207,27 @@ ...@@ -200,27 +207,27 @@
;;; register load, otherwise it uses add. ;;; register load, otherwise it uses add.
(define-vop (fast-+/fixnum=>fixnum fast-safe-arith-op) (define-vop (fast-+/fixnum=>fixnum fast-safe-arith-op)
(:translate +) (:translate +)
(:args (x :target r :scs (any-reg) (:args (x :scs (any-reg) :target r
:load-if (not (and (sc-is x immediate-stack) :load-if (not (and (sc-is x immediate-stack)
(sc-is y any-reg) (sc-is y any-reg)
(sc-is r immediate-stack)
(location= x r)))) (location= x r))))
(y :scs (any-reg immediate-stack))) (y :scs (any-reg immediate-stack)))
(:arg-types tagged-num tagged-num) (:arg-types tagged-num tagged-num)
(:results (r :scs (any-reg) :from (:argument 0) (:results (r :scs (any-reg) :from (:argument 0)
:load-if (not (and (sc-is x immediate-stack) :load-if (not (and (sc-is x immediate-stack)
(sc-is y any-reg) (sc-is y any-reg)
(sc-is r immediate-stack)
(location= x r))))) (location= x r)))))
(:result-types tagged-num) (:result-types tagged-num)
(:note "inline fixnum arithmetic") (:note "inline fixnum arithmetic")
(:generator 2 (:generator 2
(if (and (sc-is x any-reg) (cond ((and (sc-is x any-reg) (sc-is y any-reg) (sc-is r any-reg)
(sc-is y any-reg) (not (location= x r)))
(sc-is r any-reg) (inst lea r (make-ea :dword :base x :index y :scale 1)))
(not (location= x r))) (t
(inst lea r (make-ea :dword :base x :index y :scale 1)) (move r x)
(progn (inst add r y)))))
(move r x)
(inst add r y)))))
(define-vop (fast-+-c/fixnum=>fixnum fast-safe-arith-op) (define-vop (fast-+-c/fixnum=>fixnum fast-safe-arith-op)
(:translate +) (:translate +)
...@@ -232,19 +239,18 @@ ...@@ -232,19 +239,18 @@
(:result-types tagged-num) (:result-types tagged-num)
(:note "inline fixnum arithmetic") (:note "inline fixnum arithmetic")
(:generator 1 (:generator 1
(if (and (sc-is x any-reg) (cond ((and (sc-is x any-reg) (sc-is r any-reg) (not (location= x r)))
(sc-is r any-reg) (inst lea r (make-ea :dword :base x :disp (fixnum y))))
(not (location= x r))) (t
(inst lea r (make-ea :dword :base x :disp (fixnum y))) (move r x)
(progn (inst add r (fixnum y))))))
(move r x)
(inst add r (fixnum y))))))
(define-vop (fast-+/signed=>signed fast-safe-arith-op) (define-vop (fast-+/signed=>signed fast-safe-arith-op)
(:translate +) (:translate +)
(:args (x :target r :scs (signed-reg) (:args (x :scs (signed-reg) :target r
:load-if (not (and (sc-is x signed-stack) :load-if (not (and (sc-is x signed-stack)
(sc-is y signed-reg) (sc-is y signed-reg)
(sc-is r signed-stack)
(location= x r)))) (location= x r))))
(y :scs (signed-reg signed-stack))) (y :scs (signed-reg signed-stack)))
(:arg-types signed-num signed-num) (:arg-types signed-num signed-num)
...@@ -255,14 +261,12 @@ ...@@ -255,14 +261,12 @@
(:result-types signed-num) (:result-types signed-num)
(:note "inline (signed-byte 32) arithmetic") (:note "inline (signed-byte 32) arithmetic")
(:generator 5 (:generator 5
(if (and (sc-is x signed-reg) (cond ((and (sc-is x signed-reg) (sc-is y signed-reg) (sc-is r signed-reg)
(sc-is y signed-reg) (not (location= x r)))
(sc-is r signed-reg) (inst lea r (make-ea :dword :base x :index y :scale 1)))
(not (location= x r))) (t
(inst lea r (make-ea :dword :base x :index y :scale 1)) (move r x)
(progn (inst add r y)))))
(move r x)
(inst add r y)))))
(define-vop (fast-+-c/signed=>signed fast-safe-arith-op) (define-vop (fast-+-c/signed=>signed fast-safe-arith-op)
(:translate +) (:translate +)
...@@ -274,37 +278,38 @@ ...@@ -274,37 +278,38 @@
(:result-types signed-num) (:result-types signed-num)
(:note "inline (signed-byte 32) arithmetic") (:note "inline (signed-byte 32) arithmetic")
(:generator 4 (:generator 4
(if (and (sc-is x signed-reg) (cond ((and (sc-is x signed-reg) (sc-is r signed-reg)
(sc-is r signed-reg) (not (location= x r)))
(not (location= x r))) (inst lea r (make-ea :dword :base x :disp y)))
(inst lea r (make-ea :dword :base x :disp y)) (t
(progn (move r x)
(move r x) (if (= y 1)
(inst add r y))))) (inst inc r)
(inst add r y))))))
(define-vop (fast-+/unsigned=>unsigned fast-safe-arith-op) (define-vop (fast-+/unsigned=>unsigned fast-safe-arith-op)
(:translate +) (:translate +)
(:args (x :target r :scs (unsigned-reg) (:args (x :scs (unsigned-reg) :target r
:load-if (not (and (sc-is x unsigned-stack) :load-if (not (and (sc-is x unsigned-stack)
(sc-is y unsigned-reg) (sc-is y unsigned-reg)
(sc-is r unsigned-stack)
(location= x r)))) (location= x r))))
(y :scs (unsigned-reg unsigned-stack))) (y :scs (unsigned-reg unsigned-stack)))
(:arg-types unsigned-num unsigned-num) (:arg-types unsigned-num unsigned-num)
(:results (r :scs (unsigned-reg) :from (:argument 0) (:results (r :scs (unsigned-reg) :from (:argument 0)
:load-if (not (and (sc-is x unsigned-stack) :load-if (not (and (sc-is x unsigned-stack)
(sc-is y unsigned-reg) (sc-is y unsigned-reg)
(sc-is r unsigned-stack)
(location= x r))))) (location= x r)))))
(:result-types unsigned-num) (:result-types unsigned-num)
(:note "inline (unsigned-byte 32) arithmetic") (:note "inline (unsigned-byte 32) arithmetic")
(:generator 5 (:generator 5
(if (and (sc-is x unsigned-reg) (cond ((and (sc-is x unsigned-reg) (sc-is y unsigned-reg)
(sc-is y unsigned-reg) (sc-is r unsigned-reg) (not (location= x r)))
(sc-is r unsigned-reg) (inst lea r (make-ea :dword :base x :index y :scale 1)))
(not (location= x r))) (t
(inst lea r (make-ea :dword :base x :index y :scale 1)) (move r x)
(progn (inst add r y)))))
(move r x)
(inst add r y)))))
(define-vop (fast-+-c/unsigned=>unsigned fast-safe-arith-op) (define-vop (fast-+-c/unsigned=>unsigned fast-safe-arith-op)
(:translate +) (:translate +)
...@@ -316,13 +321,14 @@ ...@@ -316,13 +321,14 @@
(:result-types unsigned-num) (:result-types unsigned-num)
(:note "inline (unsigned-byte 32) arithmetic") (:note "inline (unsigned-byte 32) arithmetic")
(:generator 4 (:generator 4
(if (and (sc-is x unsigned-reg) (cond ((and (sc-is x unsigned-reg) (sc-is r unsigned-reg)
(sc-is r unsigned-reg) (not (location= x r)))
(not (location= x r))) (inst lea r (make-ea :dword :base x :disp y)))
(inst lea r (make-ea :dword :base x :disp y)) (t
(progn (move r x)
(move r x) (if (= y 1)
(inst add r y))))) (inst inc r)
(inst add r y))))))
;;;; Multiplication and division. ;;;; Multiplication and division.
...@@ -330,7 +336,7 @@ ...@@ -330,7 +336,7 @@
(define-vop (fast-*/fixnum=>fixnum fast-safe-arith-op) (define-vop (fast-*/fixnum=>fixnum fast-safe-arith-op)
(:translate *) (:translate *)
;; We need different loading characteristics. ;; We need different loading characteristics.
(:args (x :scs (any-reg immediate-stack) :target r) (:args (x :scs (any-reg) :target r)
(y :scs (any-reg immediate-stack))) (y :scs (any-reg immediate-stack)))
(:arg-types tagged-num tagged-num) (:arg-types tagged-num tagged-num)
(:results (r :scs (any-reg) :from (:argument 0))) (:results (r :scs (any-reg) :from (:argument 0)))
...@@ -344,7 +350,7 @@ ...@@ -344,7 +350,7 @@
(define-vop (fast-*/fixnum=>fixnum-c fast-safe-arith-op) (define-vop (fast-*/fixnum=>fixnum-c fast-safe-arith-op)
(:translate *) (:translate *)
;; We need different loading characteristics. ;; We need different loading characteristics.
(:args (x :target r :scs (any-reg immediate-stack))) (:args (x :scs (any-reg immediate-stack)))
(:info y) (:info y)
(:arg-types tagged-num (:constant (signed-byte 30))) (:arg-types tagged-num (:constant (signed-byte 30)))
(:results (r :scs (any-reg))) (:results (r :scs (any-reg)))
...@@ -356,7 +362,7 @@ ...@@ -356,7 +362,7 @@
(define-vop (fast-*/signed=>signed fast-safe-arith-op) (define-vop (fast-*/signed=>signed fast-safe-arith-op)
(:translate *) (:translate *)
;; We need different loading characteristics. ;; We need different loading characteristics.
(:args (x :scs (signed-reg signed-stack) :target r) (:args (x :scs (signed-reg) :target r)
(y :scs (signed-reg signed-stack))) (y :scs (signed-reg signed-stack)))
(:arg-types signed-num signed-num) (:arg-types signed-num signed-num)
(:results (r :scs (signed-reg) :from (:argument 0))) (:results (r :scs (signed-reg) :from (:argument 0)))
...@@ -369,7 +375,7 @@ ...@@ -369,7 +375,7 @@
(define-vop (fast-*/signed=>signed-c fast-safe-arith-op) (define-vop (fast-*/signed=>signed-c fast-safe-arith-op)
(:translate *) (:translate *)
;; We need different loading characteristics. ;; We need different loading characteristics.
(:args (x :target r :scs (signed-reg signed-stack))) (:args (x :scs (signed-reg signed-stack)))
(:info y) (:info y)
(:arg-types signed-num (:constant (signed-byte 32))) (:arg-types signed-num (:constant (signed-byte 32)))
(:results (r :scs (signed-reg))) (:results (r :scs (signed-reg)))
...@@ -381,7 +387,7 @@ ...@@ -381,7 +387,7 @@
(define-vop (fast-truncate/signed=>signed fast-safe-arith-op) (define-vop (fast-truncate/signed=>signed fast-safe-arith-op)
(:translate truncate) (:translate truncate)
(:args (x :scs (signed-reg signed-stack) :target eax) (:args (x :scs (signed-reg) :target eax)
(y :scs (signed-reg signed-stack))) (y :scs (signed-reg signed-stack)))
(:arg-types signed-num signed-num) (:arg-types signed-num signed-num)
(:temporary (:sc dword-reg :offset eax-offset :target quo (:temporary (:sc dword-reg :offset eax-offset :target quo
...@@ -390,8 +396,8 @@ ...@@ -390,8 +396,8 @@
(:temporary (:sc dword-reg :offset edx-offset :target rem (:temporary (:sc dword-reg :offset edx-offset :target rem
:from (:argument 0) :to (:result 1)) :from (:argument 0) :to (:result 1))
edx) edx)
(:results (quo :scs (signed-reg signed-stack)) (:results (quo :scs (signed-reg))
(rem :scs (signed-reg signed-stack))) (rem :scs (signed-reg)))
(:result-types signed-num signed-num) (:result-types signed-num signed-num)
(:note "inline (signed-byte 32) arithmetic") (:note "inline (signed-byte 32) arithmetic")
(:vop-var vop) (:vop-var vop)
...@@ -452,14 +458,16 @@ ...@@ -452,14 +458,16 @@
:target result :target result
:load-if :load-if
(not (and (sc-is number signed-stack unsigned-stack) (not (and (sc-is number signed-stack unsigned-stack)
(location= number result)))) (sc-is result signed-stack unsigned-stack)
(location= number result))))
(amount :scs (unsigned-reg) :target ecx)) (amount :scs (unsigned-reg) :target ecx))
(:arg-types (:or signed-num unsigned-num) positive-fixnum) (:arg-types (:or signed-num unsigned-num) positive-fixnum)
(:temporary (:sc dword-reg :offset ecx-offset :from (:argument 1)) ecx) (:temporary (:sc dword-reg :offset ecx-offset :from (:argument 1)) ecx)
(:results (result :scs (signed-reg unsigned-reg) (:results (result :scs (signed-reg unsigned-reg)
:from (:argument 0) :from (:argument 0)
:load-if :load-if
(not (and (sc-is result signed-stack unsigned-stack) (not (and (sc-is number signed-stack unsigned-stack)
(sc-is result signed-stack unsigned-stack)
(location= number result))))) (location= number result)))))
(:result-types (:or signed-num unsigned-num)) (:result-types (:or signed-num unsigned-num))
(:translate ash) (:translate ash)
...@@ -509,7 +517,7 @@ ...@@ -509,7 +517,7 @@
(:translate integer-length) (:translate integer-length)
(:note "inline (signed-byte 32) integer-length") (:note "inline (signed-byte 32) integer-length")
(:policy :fast-safe) (:policy :fast-safe)
(:args (arg :scs (signed-reg signed-stack))) (:args (arg :scs (signed-reg) :target res))
(:arg-types signed-num) (:arg-types signed-num)
(:results (res :scs (any-reg))) (:results (res :scs (any-reg)))
(:result-types positive-fixnum) (:result-types positive-fixnum)
...@@ -625,21 +633,19 @@ ...@@ -625,21 +633,19 @@
`(progn `(progn
,@(mapcar ,@(mapcar
#'(lambda (suffix cost signed) #'(lambda (suffix cost signed)
(unless (and (member suffix '(/fixnum -c/fixnum)) `(define-vop (,(intern (format nil "~:@(FAST-IF-~A~A~)"
(eq tran 'eql)) tran suffix))
`(define-vop (,(intern (format nil "~:@(FAST-IF-~A~A~)" ,(intern
tran suffix)) (format nil "~:@(FAST-CONDITIONAL~A~)"
,(intern suffix)))
(format nil "~:@(FAST-CONDITIONAL~A~)" (:translate ,tran)
suffix))) (:generator ,cost
(:translate ,tran) (inst cmp x
(:generator ,cost ,(if (eq suffix '-c/fixnum) '(fixnum y) 'y))
(inst cmp x (inst jmp (if not-p
,(if (eq suffix '-c/fixnum) '(fixnum y) 'y)) ,(if signed not-cond not-unsigned)
(inst jmp (if not-p ,(if signed cond unsigned))
,(if signed not-cond not-unsigned) target))))
,(if signed cond unsigned))
target)))))
'(/fixnum -c/fixnum /signed -c/signed /unsigned -c/unsigned) '(/fixnum -c/fixnum /signed -c/signed /unsigned -c/unsigned)
'(4 3 6 5 6 5) '(4 3 6 5 6 5)
'(t t t t nil nil)))) '(t t t t nil nil))))
...@@ -648,7 +654,35 @@ ...@@ -648,7 +654,35 @@
(define-conditional-vop > :g :a :le :be) (define-conditional-vop > :g :a :le :be)
(define-conditional-vop eql :e :e :ne :ne) (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)))
(define-vop (fast-if-eql-c/signed fast-conditional-c/signed)
(:translate eql)
(:generator 5
(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)))
(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)))
(define-vop (fast-if-eql-c/unsigned fast-conditional-c/unsigned)
(:translate eql)
(:generator 5
(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)))
;;; EQL/FIXNUM is funny because the first arg can be of any type, not just a ;;; EQL/FIXNUM is funny because the first arg can be of any type, not just a
;;; known fixnum. ;;; known fixnum.
...@@ -673,7 +707,9 @@ ...@@ -673,7 +707,9 @@
(inst jmp (if not-p :ne :e) target))) (inst jmp (if not-p :ne :e) target)))
;;; ;;;
(define-vop (generic-eql/fixnum fast-eql/fixnum) (define-vop (generic-eql/fixnum fast-eql/fixnum)
(:args (x :scs (any-reg descriptor-reg)) (:args (x :scs (any-reg descriptor-reg)
:load-if (not (and (sc-is x descriptor-stack)
(sc-is y any-reg))))
(y :scs (any-reg immediate-stack))) (y :scs (any-reg immediate-stack)))
(:arg-types * tagged-num) (:arg-types * tagged-num)
(:variant-cost 7)) (:variant-cost 7))
...@@ -684,7 +720,10 @@ ...@@ -684,7 +720,10 @@
(:info target not-p y) (:info target not-p y)
(:translate eql) (:translate eql)
(:generator 2 (:generator 2
(inst cmp x (fixnum y)) (cond ((and (sc-is x any-reg) (zerop y))
(inst test x x)) ; Smaller instruction
(t
(inst cmp x (fixnum y))))
(inst jmp (if not-p :ne :e) target))) (inst jmp (if not-p :ne :e) target)))
;;; ;;;
(define-vop (generic-eql-c/fixnum fast-eql-c/fixnum) (define-vop (generic-eql-c/fixnum fast-eql-c/fixnum)
...@@ -713,14 +752,17 @@ ...@@ -713,14 +752,17 @@
(define-vop (32bit-logical) (define-vop (32bit-logical)
(:args (x :scs (unsigned-reg) :target r (:args (x :scs (unsigned-reg) :target r
:load-if (not (and (sc-is x unsigned-stack) :load-if (not (and (sc-is x unsigned-stack)
(sc-is r unsigned-stack)
(location= x r)))) (location= x r))))
(y :scs (unsigned-reg) (y :scs (unsigned-reg)
:load-if (or (not (sc-is y unsigned-stack)) :load-if (or (not (sc-is y unsigned-stack))
(and (sc-is x unsigned-stack) (and (sc-is x unsigned-stack)
(sc-is y unsigned-stack)
(location= x r))))) (location= x r)))))
(:arg-types unsigned-num unsigned-num) (:arg-types unsigned-num unsigned-num)
(:results (r :scs (unsigned-reg) :from (:argument 0) (:results (r :scs (unsigned-reg) :from (:argument 0)
:load-if (not (and (sc-is x unsigned-stack) :load-if (not (and (sc-is x unsigned-stack)
(sc-is r unsigned-stack)
(location= x r))))) (location= x r)))))
(:result-types unsigned-num) (:result-types unsigned-num)
(:policy :fast-safe)) (:policy :fast-safe))
...@@ -729,10 +771,12 @@ ...@@ -729,10 +771,12 @@
(:translate 32bit-logical-not) (:translate 32bit-logical-not)
(:args (x :scs (unsigned-reg) :target r (:args (x :scs (unsigned-reg) :target r
:load-if (not (and (sc-is x unsigned-stack) :load-if (not (and (sc-is x unsigned-stack)
(sc-is r unsigned-stack)
(location= x r))))) (location= x r)))))
(:arg-types unsigned-num) (:arg-types unsigned-num)
(:results (r :scs (unsigned-reg) (:results (r :scs (unsigned-reg)
:load-if (not (and (sc-is x unsigned-stack) :load-if (not (and (sc-is x unsigned-stack)
(sc-is r unsigned-stack)
(location= x r))))) (location= x r)))))
(:result-types unsigned-num) (:result-types unsigned-num)
(:policy :fast-safe) (:policy :fast-safe)
...@@ -780,7 +824,6 @@ ...@@ -780,7 +824,6 @@
`(32bit-logical-and ,x (32bit-logical-not ,y))) `(32bit-logical-and ,x (32bit-logical-not ,y)))
;;; Only the lower 5 bits of the shift amount are significant. ;;; Only the lower 5 bits of the shift amount are significant.
(define-vop (shift-towards-someplace) (define-vop (shift-towards-someplace)
(:policy :fast-safe) (:policy :fast-safe)
(:args (num :scs (unsigned-reg) :target r) (:args (num :scs (unsigned-reg) :target r)
...@@ -883,7 +926,7 @@ ...@@ -883,7 +926,7 @@
(define-vop (bignum-mult-and-add-3-arg) (define-vop (bignum-mult-and-add-3-arg)
(:translate bignum::%multiply-and-add) (:translate bignum::%multiply-and-add)
(:policy :fast-safe) (:policy :fast-safe)
(:args (x :scs (unsigned-reg unsigned-stack) :target eax) (:args (x :scs (unsigned-reg) :target eax)
(y :scs (unsigned-reg unsigned-stack)) (y :scs (unsigned-reg unsigned-stack))
(carry-in :scs (unsigned-reg unsigned-stack))) (carry-in :scs (unsigned-reg unsigned-stack)))
(:arg-types unsigned-num unsigned-num unsigned-num) (:arg-types unsigned-num unsigned-num unsigned-num)
...@@ -891,8 +934,8 @@ ...@@ -891,8 +934,8 @@
:to (:result 1) :target lo) eax) :to (:result 1) :target lo) eax)
(:temporary (:sc unsigned-reg :offset edx-offset :from (:argument 1) (:temporary (:sc unsigned-reg :offset edx-offset :from (:argument 1)
:to (:result 0) :target hi) edx) :to (:result 0) :target hi) edx)
(:results (hi :scs (unsigned-reg unsigned-stack)) (:results (hi :scs (unsigned-reg))
(lo :scs (unsigned-reg unsigned-stack))) (lo :scs (unsigned-reg)))
(:result-types unsigned-num unsigned-num) (:result-types unsigned-num unsigned-num)
(:generator 20 (:generator 20
(move eax x) (move eax x)
...@@ -905,7 +948,7 @@ ...@@ -905,7 +948,7 @@
(define-vop (bignum-mult-and-add-4-arg) (define-vop (bignum-mult-and-add-4-arg)
(:translate bignum::%multiply-and-add) (:translate bignum::%multiply-and-add)
(:policy :fast-safe) (:policy :fast-safe)
(:args (x :scs (unsigned-reg unsigned-stack) :target eax) (:args (x :scs (unsigned-reg) :target eax)
(y :scs (unsigned-reg unsigned-stack)) (y :scs (unsigned-reg unsigned-stack))
(prev :scs (unsigned-reg unsigned-stack)) (prev :scs (unsigned-reg unsigned-stack))
(carry-in :scs (unsigned-reg unsigned-stack))) (carry-in :scs (unsigned-reg unsigned-stack)))
...@@ -914,8 +957,8 @@ ...@@ -914,8 +957,8 @@
:to (:result 1) :target lo) eax) :to (:result 1) :target lo) eax)
(:temporary (:sc unsigned-reg :offset edx-offset :from (:argument 1) (:temporary (:sc unsigned-reg :offset edx-offset :from (:argument 1)
:to (:result 0) :target hi) edx) :to (:result 0) :target hi) edx)
(:results (hi :scs (unsigned-reg unsigned-stack)) (:results (hi :scs (unsigned-reg))
(lo :scs (unsigned-reg unsigned-stack))) (lo :scs (unsigned-reg)))
(:result-types unsigned-num unsigned-num) (:result-types unsigned-num unsigned-num)
(:generator 20 (:generator 20
(move eax x) (move eax x)
...@@ -931,15 +974,15 @@ ...@@ -931,15 +974,15 @@
(define-vop (bignum-mult) (define-vop (bignum-mult)
(:translate bignum::%multiply) (:translate bignum::%multiply)
(:policy :fast-safe) (:policy :fast-safe)
(:args (x :scs (unsigned-reg unsigned-stack) :target eax) (:args (x :scs (unsigned-reg) :target eax)
(y :scs (unsigned-reg unsigned-stack))) (y :scs (unsigned-reg unsigned-stack)))
(:arg-types unsigned-num unsigned-num) (:arg-types unsigned-num unsigned-num)
(:temporary (:sc unsigned-reg :offset eax-offset :from (:argument 0) (:temporary (:sc unsigned-reg :offset eax-offset :from (:argument 0)
:to (:result 1) :target lo) eax) :to (:result 1) :target lo) eax)
(:temporary (:sc unsigned-reg :offset edx-offset :from (:argument 1) (:temporary (:sc unsigned-reg :offset edx-offset :from (:argument 1)
:to (:result 0) :target hi) edx) :to (:result 0) :target hi) edx)
(:results (hi :scs (unsigned-reg unsigned-stack)) (:results (hi :scs (unsigned-reg))
(lo :scs (unsigned-reg unsigned-stack))) (lo :scs (unsigned-reg)))
(:result-types unsigned-num unsigned-num) (:result-types unsigned-num unsigned-num)
(:generator 20 (:generator 20
(move eax x) (move eax x)
...@@ -965,7 +1008,9 @@ ...@@ -965,7 +1008,9 @@
(:args (fixnum :scs (any-reg immediate-stack) :target digit)) (:args (fixnum :scs (any-reg immediate-stack) :target digit))
(:arg-types tagged-num) (:arg-types tagged-num)
(:results (digit :scs (unsigned-reg) (:results (digit :scs (unsigned-reg)
:load-if (not (location= fixnum digit)))) :load-if (not (and (sc-is fixnum immediate-stack)
(sc-is digit unsigned-stack)
(location= fixnum digit)))))
(:result-types unsigned-num) (:result-types unsigned-num)
(:generator 1 (:generator 1
(move digit fixnum) (move digit fixnum)
...@@ -974,16 +1019,16 @@ ...@@ -974,16 +1019,16 @@
(define-vop (bignum-floor) (define-vop (bignum-floor)
(:translate bignum::%floor) (:translate bignum::%floor)
(:policy :fast-safe) (:policy :fast-safe)
(:args (div-high :scs (unsigned-reg unsigned-stack) :target edx) (:args (div-high :scs (unsigned-reg) :target edx)
(div-low :scs (unsigned-reg unsigned-stack) :target eax) (div-low :scs (unsigned-reg) :target eax)
(divisor :scs (unsigned-reg unsigned-stack))) (divisor :scs (unsigned-reg unsigned-stack)))
(:arg-types unsigned-num unsigned-num unsigned-num) (:arg-types unsigned-num unsigned-num unsigned-num)
(:temporary (:sc unsigned-reg :offset eax-offset :from (:argument 1) (:temporary (:sc unsigned-reg :offset eax-offset :from (:argument 1)
:to (:result 0) :target quo) eax) :to (:result 0) :target quo) eax)
(:temporary (:sc unsigned-reg :offset edx-offset :from (:argument 0) (:temporary (:sc unsigned-reg :offset edx-offset :from (:argument 0)
:to (:result 1) :target rem) edx) :to (:result 1) :target rem) edx)
(:results (quo :scs (unsigned-reg unsigned-stack)) (:results (quo :scs (unsigned-reg))
(rem :scs (unsigned-reg unsigned-stack))) (rem :scs (unsigned-reg)))
(:result-types unsigned-num unsigned-num) (:result-types unsigned-num unsigned-num)
(:generator 300 (:generator 300
(move edx div-high) (move edx div-high)
...@@ -998,7 +1043,8 @@ ...@@ -998,7 +1043,8 @@
(:args (digit :scs (unsigned-reg unsigned-stack) :target res)) (:args (digit :scs (unsigned-reg unsigned-stack) :target res))
(:arg-types unsigned-num) (:arg-types unsigned-num)
(:results (res :scs (any-reg signed-reg) (:results (res :scs (any-reg signed-reg)
:load-if (not (and (sc-is res immediate-stack signed-stack) :load-if (not (and (sc-is digit unsigned-stack)
(sc-is res immediate-stack signed-stack)
(location= digit res))))) (location= digit res)))))
(:result-types signed-num) (:result-types signed-num)
(:generator 1 (:generator 1
...@@ -1010,7 +1056,7 @@ ...@@ -1010,7 +1056,7 @@
(:translate bignum::%ashr) (:translate bignum::%ashr)
(:policy :fast-safe) (:policy :fast-safe)
(:args (digit :scs (unsigned-reg unsigned-stack) :target result) (:args (digit :scs (unsigned-reg unsigned-stack) :target result)
(count :scs (unsigned-reg unsigned-stack) :target ecx)) (count :scs (unsigned-reg) :target ecx))
(:arg-types unsigned-num positive-fixnum) (:arg-types unsigned-num positive-fixnum)
(:temporary (:sc dword-reg :offset ecx-offset :from (:argument 1)) ecx) (:temporary (:sc dword-reg :offset ecx-offset :from (:argument 1)) ecx)
(:results (result :scs (unsigned-reg) :from (:argument 0) (:results (result :scs (unsigned-reg) :from (:argument 0)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment