diff --git a/compiler/sparc/arith.lisp b/compiler/sparc/arith.lisp index 2efd16f022ab8323cf417a212e4ecc052a7c7719..c268f96dc7b76284c2de6dcd1e906518a1eb76d1 100644 --- a/compiler/sparc/arith.lisp +++ b/compiler/sparc/arith.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/arith.lisp,v 1.19 2000/01/17 18:08:19 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/arith.lisp,v 1.20 2000/02/16 00:27:56 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -170,6 +170,10 @@ ;;; Special case fixnum + and - that trap on overflow. Useful when we ;;; don't know that the output type is a fixnum. +;;; I (toy@rtp.ericsson.se) took these out. They don't seem to be +;;; used anywhere at all. +#+nil +(progn (define-vop (+/fixnum fast-+/fixnum=>fixnum) (:policy :safe) (:results (r :scs (any-reg descriptor-reg))) @@ -202,83 +206,230 @@ (:generator 3 (inst tsubcctv r x (fixnum y)))) -;;; Shifting +) -(define-vop (fast-ash/unsigned=>unsigned) - (:note "inline ASH") - (:args (number :scs (unsigned-reg) :to :save) - (amount :scs (signed-reg immediate))) - (:arg-types unsigned-num signed-num) - (:results (result :scs (unsigned-reg))) - (:result-types unsigned-num) - (:translate ash) - (:policy :fast-safe) - (:temporary (:sc non-descriptor-reg) ndesc) - (:generator 3 - (sc-case amount - (signed-reg - (let ((positive (gen-label)) - (done (gen-label))) - (inst cmp amount) - (inst b :ge positive) - (inst neg ndesc amount) - (inst cmp ndesc 31) - (inst b :le done) - (inst srl result number ndesc) - (inst b done) - (inst srl result number 31) - - (emit-label positive) - ;; The result-type assures us that this shift will not overflow. - (inst sll result number amount) - - (emit-label done))) - - (immediate - (let ((amount (tn-value amount))) - (if (minusp amount) - (let ((amount (min 31 (- amount)))) - (inst srl result number amount)) - (inst sll result number amount))))))) - -(define-vop (fast-ash/signed=>signed) - (:note "inline ASH") - (:args (number :scs (signed-reg) :to :save) - (amount :scs (signed-reg immediate))) - (:arg-types signed-num signed-num) - (:results (result :scs (signed-reg))) - (:result-types signed-num) - (:translate ash) - (:policy :fast-safe) - (:temporary (:sc non-descriptor-reg) ndesc) - (:generator 3 - (sc-case amount - (signed-reg - (let ((positive (gen-label)) - (done (gen-label))) - (inst cmp amount) - (inst b :ge positive) - (inst neg ndesc amount) - (inst cmp ndesc 31) - (inst b :le done) - (inst sra result number ndesc) - (inst b done) - (inst sra result number 31) - - (emit-label positive) - ;; The result-type assures us that this shift will not overflow. - (inst sll result number amount) - - (emit-label done))) +;;; Truncate - (immediate - (let ((amount (tn-value amount))) - (if (minusp amount) - (let ((amount (min 31 (- amount)))) - (inst sra result number amount)) - (inst sll result number amount))))))) +;; This doesn't work for some reason. +#+nil +(define-vop (fast-v8-truncate/fixnum=>fixnum fast-safe-arith-op) + (:translate truncate) + (:args (x :scs (any-reg)) + (y :scs (any-reg))) + (:arg-types tagged-num tagged-num) + (:results (quo :scs (any-reg)) + (rem :scs (any-reg))) + (:result-types tagged-num tagged-num) + (:note "inline fixnum arithmetic") + (:temporary (:scs (any-reg) :target quo) q) + (:temporary (:scs (any-reg)) r) + (:temporary (:scs (signed-reg)) y-int) + (:vop-var vop) + (:save-p :compute-only) + (:guard (or (backend-featurep :sparc-v8) + (and (backend-featurep :sparc-v9) + (not (backend-featurep :sparc-64))))) + (:generator 12 + (let ((zero (generate-error-code vop division-by-zero-error x y))) + (inst cmp y zero-tn) + (inst b :eq zero) + ;; Extend the sign of X into the Y register + (inst sra r x 31) + (inst wry r) + ;; Remove tag bits so Q and R will be tagged correctly. + (inst sra y-int y 2) + (inst nop) + (inst nop) + + (inst sdiv q x y-int) ; Q is tagged. + ;; We have the quotient so we need to compute the remainder + (inst smul r q y-int) ; R is tagged + (inst sub rem x r) + (unless (location= quo q) + (move quo q))))) + +(define-vop (fast-v8-truncate/signed=>signed fast-safe-arith-op) + (:translate truncate) + (:args (x :scs (signed-reg)) + (y :scs (signed-reg))) + (:arg-types signed-num signed-num) + (:results (quo :scs (signed-reg)) + (rem :scs (signed-reg))) + (:result-types signed-num signed-num) + (:note "inline (signed-byte 32) arithmetic") + (:temporary (:scs (signed-reg) :target quo) q) + (:temporary (:scs (signed-reg)) r) + (:vop-var vop) + (:save-p :compute-only) + (:guard (or (backend-featurep :sparc-v8) + (and (backend-featurep :sparc-v9) + (not (backend-featurep :sparc-64))))) + (:generator 12 + (let ((zero (generate-error-code vop division-by-zero-error x y))) + (inst cmp y zero-tn) + (inst b :eq zero) + ;; Extend the sign of X into the Y register + (inst sra r x 31) + (inst wry r) + (inst nop) + (inst nop) + (inst nop) + + (inst sdiv q x y) + ;; We have the quotient so we need to compue the remainder + (inst smul r q y) ; rem + (inst sub rem x r) + (unless (location= quo q) + (move quo q))))) + +(define-vop (fast-v8-truncate/unsigned=>unsigned fast-safe-arith-op) + (:translate truncate) + (:args (x :scs (unsigned-reg)) + (y :scs (unsigned-reg))) + (:arg-types unsigned-num unsigned-num) + (:results (quo :scs (unsigned-reg)) + (rem :scs (unsigned-reg))) + (:result-types unsigned-num unsigned-num) + (:note "inline (unsigned-byte 32) arithmetic") + (:temporary (:scs (unsigned-reg) :target quo) q) + (:temporary (:scs (unsigned-reg)) r) + (:vop-var vop) + (:save-p :compute-only) + (:guard (or (backend-featurep :sparc-v8) + (and (backend-featurep :sparc-v9) + (not (backend-featurep :sparc-64))))) + (:generator 8 + (let ((zero (generate-error-code vop division-by-zero-error x y))) + (inst cmp y zero-tn) + (inst b :eq zero) + (inst wry zero-tn) ; Clear out high part + (inst nop) + (inst nop) + (inst nop) + + (inst udiv q x y) + ;; Compute remainder + (inst umul r q y) + (inst sub rem x r) + (unless (location= quo q) + (inst move quo q))))) + +(define-vop (fast-v9-truncate/signed=>signed fast-safe-arith-op) + (:translate truncate) + (:args (x :scs (signed-reg)) + (y :scs (signed-reg))) + (:arg-types signed-num signed-num) + (:results (quo :scs (signed-reg)) + (rem :scs (signed-reg))) + (:result-types signed-num signed-num) + (:note "inline (signed-byte 32) arithmetic") + (:temporary (:scs (signed-reg) :target quo) q) + (:temporary (:scs (signed-reg)) r) + (:vop-var vop) + (:save-p :compute-only) + (:guard (backend-featurep :sparc-64)) + (:generator 8 + (let ((zero (generate-error-code vop division-by-zero-error x y))) + (inst cmp y zero-tn) + (inst b :eq zero) + ;; Sign extend the numbers, just in case. + (inst sra x 0) + (inst sra y 0) + (inst sdivx q x y) + ;; Compute remainder + (inst mulx r q y) + (inst sub rem x r) + (unless (location= quo q) + (inst move quo q))))) + +(define-vop (fast-v9-truncate/unsigned=>unsigned fast-safe-arith-op) + (:translate truncate) + (:args (x :scs (unsigned-reg)) + (y :scs (unsigned-reg))) + (:arg-types unsigned-num unsigned-num) + (:results (quo :scs (unsigned-reg)) + (rem :scs (unsigned-reg))) + (:result-types unsigned-num unsigned-num) + (:note "inline (unsigned-byte 32) arithmetic") + (:temporary (:scs (unsigned-reg) :target quo) q) + (:temporary (:scs (unsigned-reg)) r) + (:vop-var vop) + (:save-p :compute-only) + (:guard (backend-featurep :sparc-64)) + (:generator 8 + (let ((zero (generate-error-code vop division-by-zero-error x y))) + (inst cmp y zero-tn) + (inst b :eq zero) + ;; Zap the higher 32 bits, just in case + (inst srl x 0) + (inst srl y 0) + (inst udivx q x y) + ;; Compute remainder + (inst mulx r q y) + (inst sub rem x r) + (unless (location= quo q) + (inst move quo q))))) +;;; Shifting +(macrolet + ((frob (name sc-type type shift-right-inst) + `(define-vop (,name) + (:note "inline ASH") + (:args (number :scs (,sc-type) :to :save) + (amount :scs (signed-reg immediate))) + (:arg-types ,type signed-num) + (:results (result :scs (,sc-type))) + (:result-types ,type) + (:translate ash) + (:policy :fast-safe) + (:temporary (:sc non-descriptor-reg) ndesc) + (:generator 3 + (sc-case amount + (signed-reg + (cond ((backend-featurep :sparc-v9) + (let ((done (gen-label)) + (positive (gen-label))) + (inst cmp amount) + (inst b :ge positive) + (inst neg ndesc amount) + ;; ndesc = max(-amount, 31) + (inst cmp ndesc 31) + (inst cmove :ge ndesc 31) + (inst b done) + (inst ,shift-right-inst result number ndesc) + (emit-label positive) + ;; The result-type assures us that this shift will not + ;; overflow. + (inst sll result number amount) + ;; We want a right shift of the appropriate size. + (emit-label done))) + (t + (let ((positive (gen-label)) + (done (gen-label))) + (inst cmp amount) + (inst b :ge positive) + (inst neg ndesc amount) + (inst cmp ndesc 31) + (inst b :le done) + (inst ,shift-right-inst result number ndesc) + (inst b done) + (inst ,shift-right-inst result number 31) + + (emit-label positive) + ;; The result-type assures us that this shift will not overflow. + (inst sll result number amount) + + (emit-label done))))) + + (immediate + (let ((amount (tn-value amount))) + (if (minusp amount) + (let ((amount (min 31 (- amount)))) + (inst ,shift-right-inst result number amount)) + (inst sll result number amount))))))))) + (frob fast-ash/signed=>signed signed-reg signed-num sra) + (frob fast-ash/unsigned=>unsigned unsigned-reg unsigned-num srl)) (define-vop (signed-byte-32-len) (:translate integer-length) @@ -337,20 +488,30 @@ (define-vop (fast-v8-*/fixnum=>fixnum fast-fixnum-binop) (:temporary (:scs (non-descriptor-reg)) temp) (:translate *) - (:guard (backend-featurep :sparc-v8)) - (:generator 4 + (:guard (or (backend-featurep :sparc-v8) + (and (backend-featurep :sparc-v9) + (not (backend-featurep :sparc-64))))) + (:generator 2 + ;; The cost here should be less than the cost for + ;; */signed=>signed. Why? A fixnum product using signed=>signed + ;; has to convert both args to signed-nums. But using this, we + ;; don't have to and that saves an instruction. (inst sra temp y 2) (inst smul r x temp))) (define-vop (fast-v8-*/signed=>signed fast-signed-binop) (:translate *) - (:guard (backend-featurep :sparc-v8)) + (:guard (or (backend-featurep :sparc-v8) + (and (backend-featurep :sparc-v9) + (not (backend-featurep :sparc-64))))) (:generator 3 (inst smul r x y))) (define-vop (fast-v8-*/unsigned=>unsigned fast-unsigned-binop) (:translate *) - (:guard (backend-featurep :sparc-v8)) + (:guard (or (backend-featurep :sparc-v8) + (and (backend-featurep :sparc-v9) + (not (backend-featurep :sparc-64))))) (:generator 3 (inst umul r x y))) @@ -635,6 +796,7 @@ (:args (digit :scs (unsigned-reg))) (:arg-types unsigned-num) (:results (result :scs (descriptor-reg))) + (:guard (not (backend-featurep :sparc-v9))) (:generator 3 (let ((done (gen-label))) (inst cmp digit) @@ -643,6 +805,34 @@ (load-symbol result t) (emit-label done)))) +(define-vop (v9-digit-0-or-plus-cmove) + (:translate bignum::%digit-0-or-plusp) + (:policy :fast-safe) + (:args (digit :scs (unsigned-reg))) + (:arg-types unsigned-num) + (:results (result :scs (descriptor-reg))) + (:guard (backend-featurep :sparc-v9)) + (:generator 3 + (inst cmp digit) + (load-symbol result t) + (inst cmove :lt result null-tn))) + +;; This doesn't work? +#+nil +(define-vop (v9-digit-0-or-plus-movr) + (:translate bignum::%digit-0-or-plusp) + (:policy :fast-safe) + (:args (digit :scs (unsigned-reg))) + (:arg-types unsigned-num) + (:results (result :scs (descriptor-reg))) + (:temporary (:scs (descriptor-reg)) temp) + (:guard (backend-featurep :sparc-v9)) + (:generator 2 + (load-symbol temp t) + (inst movr result null-tn digit :lz) + (inst movr result temp digit :gez))) + + (define-vop (add-w/carry) (:translate bignum::%add-with-carry) (:policy :fast-safe) @@ -688,6 +878,11 @@ (cond ((backend-featurep :sparc-64) ;; Take advantage of V9's 64-bit multiplier. ;; + ;; Make sure the multiplier and multiplicand are really + ;; unsigned 64-bit numbers. + (inst srl multiplier 0) + (inst srl multiplicand 0) + ;; Multiply the two numbers and put the result in ;; result-high. Copy the low 32-bits to result-low. Then ;; shift result-high so the high 32-bits end up in the low @@ -695,7 +890,8 @@ (inst mulx result-high multiplier multiplicand) (inst move result-low result-high) (inst srax result-high 32)) - ((backend-featurep :sparc-v8) + ((or (backend-featurep :sparc-v8) + (backend-featurep :sparc-v9)) ;; V8 has a multiply instruction. This should also work for ;; the V9, but umul and the Y register is deprecated on the ;; V9. @@ -784,7 +980,7 @@ (:generator 1 (inst sra digit fixnum 2))) -(define-vop (bignum-floor-v8) +(define-vop (bignum-floor) (:translate bignum::%floor) (:policy :fast-safe) (:args (div-high :scs (unsigned-reg) :target rem) @@ -794,7 +990,8 @@ (:results (quo :scs (unsigned-reg) :from (:argument 1)) (rem :scs (unsigned-reg) :from (:argument 0))) (:result-types unsigned-num unsigned-num) - (:guard (not (backend-featurep :sparc-64))) + (:guard (not (or (backend-featurep :sparc-v8) + (backend-featurep :sparc-v9)))) (:generator 300 (move rem div-high) (move quo div-low) @@ -809,6 +1006,36 @@ (inst addx rem rem)))) (inst not quo))) +(define-vop (bignum-floor-v8) + (:translate bignum::%floor) + (:policy :fast-safe) + (:args (div-high :scs (unsigned-reg) :target rem) + (div-low :scs (unsigned-reg) :target quo) + (divisor :scs (unsigned-reg))) + (:arg-types unsigned-num unsigned-num unsigned-num) + (:results (quo :scs (unsigned-reg) :from (:argument 1)) + (rem :scs (unsigned-reg) :from (:argument 0))) + (:result-types unsigned-num unsigned-num) + (:temporary (:scs (unsigned-reg) :target quo) q) + ;; This vop is for a v8 or v9, provided we're also not using + ;; sparc-64, for which there a special sparc-64 vop. + (:guard (or (backend-featurep :sparc-v8) + (and (backend-featurep :sparc-v9) + (not (backend-featurep :sparc-64))))) + (:generator 15 + (inst wry div-high) + (inst nop) + (inst nop) + (inst nop) + ;; Compute the quotient [Y, div-low] / divisor + (inst udiv q div-low divisor) + ;; Compute the remainder. The high part of the result is in the Y + ;; register. + (inst umul rem q divisor) + (inst sub rem div-low rem) + (unless (location= quo q) + (move quo q)))) + (define-vop (bignum-floor-v9) (:translate bignum::%floor) (:policy :fast-safe) @@ -890,3 +1117,44 @@ (define-static-function two-arg-and (x y) :translate logand) (define-static-function two-arg-ior (x y) :translate logior) (define-static-function two-arg-xor (x y) :translate logxor) + + +(defknown ext::is-plusp ((signed-byte 32)) + (member nil t) + (movable foldable flushable)) + +(define-vop (is-plusp) + (:translate ext::is-plusp) + (:policy :fast-safe) + (:args (num :scs (signed-reg))) + (:results (result :scs (descriptor-reg))) + (:arg-types signed-num) + (:temporary (:scs (descriptor-reg)) temp) + (:generator 2 + (load-symbol temp t) + (inst movr result null-tn num :lz) + (inst movr result temp num :gez))) + +(defknown ext::f-move (double-float double-float (signed-byte 32)) + double-float + (movable foldable flushable)) + +(define-vop (fmovr-test) + (:translate ext::f-move) + (:policy :fast-safe) + (:args (x :scs (double-reg)) + (y :scs (double-reg)) + (num :scs (signed-reg))) + (:results (result :scs (double-reg))) + (:arg-types double-float double-float signed-num) + (:result-types double-float) + (:generator 2 + (inst fmovrd result x num :lez) + (inst fmovrd result y num :gz) + (inst fcmpd x y :fcc1) + (inst cfmovd :le result x :fcc1) + (inst cfmovd :g result y :Fcc1))) + + + +