diff --git a/assembly/sparc/arith.lisp b/assembly/sparc/arith.lisp index d0828e5007a91d8698bf29f0fac90b7fbe5a7ea3..1d1bc900c38b4054aba68be290a882160a99906d 100644 --- a/assembly/sparc/arith.lisp +++ b/assembly/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/assembly/sparc/arith.lisp,v 1.15 2000/02/12 13:51:22 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/sparc/arith.lisp,v 1.16 2001/05/18 16:25:36 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -36,17 +36,17 @@ (:temp lra descriptor-reg lra-offset) (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) - (inst andcc zero-tn x 3) + (inst andcc zero-tn x fixnum-tag-mask) (inst b :ne DO-STATIC-FUN) - (inst andcc zero-tn y 3) + (inst andcc zero-tn y fixnum-tag-mask) (inst b :ne DO-STATIC-FUN) (inst nop) (inst addcc temp x y) (inst b :vc done) (inst nop) - (inst sra temp x 2) - (inst sra temp2 y 2) + (inst sra temp x fixnum-tag-bits) + (inst sra temp2 y fixnum-tag-bits) (inst add temp2 temp) (with-fixed-allocation (res temp bignum-type (1+ bignum-digits-offset)) (storew temp2 res bignum-digits-offset other-pointer-type)) @@ -80,17 +80,17 @@ (:temp lra descriptor-reg lra-offset) (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) - (inst andcc zero-tn x 3) + (inst andcc zero-tn x fixnum-tag-mask) (inst b :ne DO-STATIC-FUN) - (inst andcc zero-tn y 3) + (inst andcc zero-tn y fixnum-tag-mask) (inst b :ne DO-STATIC-FUN) (inst nop) (inst subcc temp x y) (inst b :vc done) (inst nop) - (inst sra temp x 2) - (inst sra temp2 y 2) + (inst sra temp x fixnum-tag-bits) + (inst sra temp2 y fixnum-tag-bits) (inst sub temp2 temp temp2) (with-fixed-allocation (res temp bignum-type (1+ bignum-digits-offset)) (storew temp2 res bignum-digits-offset other-pointer-type)) @@ -130,15 +130,15 @@ (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) ;; If either arg is not a fixnum, call the static function. - (inst andcc zero-tn x 3) + (inst andcc zero-tn x fixnum-tag-mask) (inst b :ne DO-STATIC-FUN) - (inst andcc zero-tn y 3) + (inst andcc zero-tn y fixnum-tag-mask) (inst b :ne DO-STATIC-FUN) (inst nop) ;; Remove the tag from one arg so that the result will have the correct ;; fixnum tag. - (inst sra temp x 2) + (inst sra temp x fixnum-tag-bits) ;; Compute the produce temp * y and return the double-word product ;; in hi:lo. (cond ((backend-featurep :sparc-64) @@ -175,10 +175,11 @@ (inst b :eq LOW-FITS-IN-FIXNUM) ;; Shift the double word hi:lo down two bits to get rid of the fixnum tag. (inst sll temp hi 30) - (inst srl lo 2) + (inst srl lo fixnum-tag-bits) (inst or lo temp) - (inst sra hi 2) + (inst sra hi fixnum-tag-bits) ;; Allocate a BIGNUM for the result. + #+nil (pseudo-atomic (:extra (pad-data-block (1+ bignum-digits-offset))) (let ((one-word (gen-label))) (inst or res alloc-tn other-pointer-type) @@ -195,6 +196,25 @@ (emit-label one-word) (storew temp res 0 other-pointer-type) (storew lo res bignum-digits-offset other-pointer-type))) + ;; Always allocate 2 words for the bignum result, even if we only + ;; need one. The copying GC will take care of the extra word if it + ;; isn't needed. + (with-fixed-allocation + (res temp bignum-type (+ 2 bignum-digits-offset)) + (let ((one-word (gen-label))) + (inst or res alloc-tn other-pointer-type) + ;; We start out assuming that we need one word. Is that correct? + (inst sra temp lo 31) + (inst xorcc temp hi) + (inst b :eq one-word) + (inst li temp (logior (ash 1 type-bits) bignum-type)) + ;; Need 2 words. Set the header appropriately, and save the + ;; high and low parts. + (inst li temp (logior (ash 2 type-bits) bignum-type)) + (storew hi res (1+ bignum-digits-offset) other-pointer-type) + (emit-label one-word) + (storew temp res 0 other-pointer-type) + (storew lo res bignum-digits-offset other-pointer-type))) ;; Out of here (lisp-return lra :offset 2) @@ -413,9 +433,9 @@ (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) - (inst andcc zero-tn x 3) + (inst andcc zero-tn x fixnum-tag-mask) (inst b :ne DO-STATIC-FN) - (inst andcc zero-tn y 3) + (inst andcc zero-tn y fixnum-tag-mask) (inst b :eq DO-COMPARE) (inst cmp x y) @@ -455,9 +475,9 @@ (:temp ocfp any-reg ocfp-offset)) (inst cmp x y) (inst b :eq RETURN-T) - (inst andcc zero-tn x 3) + (inst andcc zero-tn x fixnum-tag-mask) (inst b :eq RETURN-NIL) - (inst andcc zero-tn y 3) + (inst andcc zero-tn y fixnum-tag-mask) (inst b :ne DO-STATIC-FN) (inst nop) @@ -490,9 +510,9 @@ (:temp lra descriptor-reg lra-offset) (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) - (inst andcc zero-tn x 3) + (inst andcc zero-tn x fixnum-tag-mask) (inst b :ne DO-STATIC-FN) - (inst andcc zero-tn y 3) + (inst andcc zero-tn y fixnum-tag-mask) (inst b :ne DO-STATIC-FN) (inst cmp x y) (inst b :eq RETURN-T) @@ -528,9 +548,9 @@ (:temp ocfp any-reg ocfp-offset)) (inst cmp x y) (inst b :eq RETURN-NIL) - (inst andcc zero-tn x 3) + (inst andcc zero-tn x fixnum-tag-mask) (inst b :ne DO-STATIC-FN) - (inst andcc zero-tn y 3) + (inst andcc zero-tn y fixnum-tag-mask) (inst b :ne DO-STATIC-FN) (inst nop) diff --git a/compiler/sparc/move.lisp b/compiler/sparc/move.lisp index ca1955009170bf93f3a1cd79df51eea1fe542a44..6272c8a4caac056229e9570402be04fc78fdfe4d 100644 --- a/compiler/sparc/move.lisp +++ b/compiler/sparc/move.lisp @@ -5,11 +5,11 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/move.lisp,v 1.6 1995/12/14 18:11:28 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/move.lisp,v 1.7 2001/05/18 16:25:36 toy Exp $") ;;; ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/move.lisp,v 1.6 1995/12/14 18:11:28 ram Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/move.lisp,v 1.7 2001/05/18 16:25:36 toy Exp $ ;;; ;;; This file contains the SPARC VM definition of operand loading/saving and ;;; the Move VOP. @@ -155,7 +155,7 @@ (:arg-types tagged-num) (:note "fixnum untagging") (:generator 1 - (inst sra y x 2))) + (inst sra y x fixnum-tag-bits))) ;;; (define-move-vop move-to-word/fixnum :move (any-reg descriptor-reg) (signed-reg unsigned-reg)) @@ -180,9 +180,9 @@ (:temporary (:scs (non-descriptor-reg)) temp) (:generator 4 (let ((done (gen-label))) - (inst andcc temp x 3) + (inst andcc temp x fixnum-tag-mask) (inst b :eq done) - (inst sra y x 2) + (inst sra y x fixnum-tag-bits) (loadw y x bignum-digits-offset other-pointer-type) @@ -202,7 +202,7 @@ (:result-types tagged-num) (:note "fixnum tagging") (:generator 1 - (inst sll y x 2))) + (inst sll y x fixnum-tag-bits))) ;;; (define-move-vop move-from-word/fixnum :move (signed-reg unsigned-reg) (any-reg descriptor-reg)) @@ -220,12 +220,12 @@ (move x arg) (let ((fixnum (gen-label)) (done (gen-label))) - (inst sra temp x 29) + (inst sra temp x positive-fixnum-bits) (inst cmp temp) (inst b :eq fixnum) (inst orncc temp zero-tn temp) (inst b :eq done) - (inst sll y x 2) + (inst sll y x fixnum-tag-bits) (with-fixed-allocation (y temp bignum-type (1+ bignum-digits-offset)) @@ -234,7 +234,7 @@ (inst nop) (emit-label fixnum) - (inst sll y x 2) + (inst sll y x fixnum-tag-bits) (emit-label done)))) ;;; (define-move-vop move-from-signed :move @@ -254,21 +254,23 @@ (let ((done (gen-label)) (one-word (gen-label)) (initial-alloc (pad-data-block (1+ bignum-digits-offset)))) - (inst sra temp x 29) + (inst sra temp x positive-fixnum-bits) (inst cmp temp) (inst b :eq done) - (inst sll y x 2) - - (pseudo-atomic (:extra initial-alloc) - (inst or y alloc-tn other-pointer-type) + (inst sll y x fixnum-tag-bits) + + ;; We always allocate 2 words even if we don't need it. (The + ;; copying GC will take care of freeing the unused extra word.) + (with-fixed-allocation + (y temp bignum-type (+ 2 bignum-digits-offset)) (inst cmp x) (inst b :ge one-word) (inst li temp (logior (ash 1 type-bits) bignum-type)) - (inst add alloc-tn - (- (pad-data-block (+ bignum-digits-offset 2)) - (pad-data-block (+ bignum-digits-offset 1)))) (inst li temp (logior (ash 2 type-bits) bignum-type)) (emit-label one-word) + ;; Set the header word, then the actual digit. The extra + ;; digit, if any, is automatically set to zero, so we don't + ;; have to. (storew temp y 0 other-pointer-type) (storew x y bignum-digits-offset other-pointer-type)) (emit-label done))))