Skip to content
Snippets Groups Projects
Commit d5fdc0e8 authored by toy's avatar toy
Browse files

o Use the constants for the fixnum tag stuff and fixnum size.

o Always allocate 2 words for bignums even if we don't need both
  words.  (GC will take care of the extra word.)
parent 03d40783
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -36,17 +36,17 @@
(:temp lra descriptor-reg lra-offset) (:temp lra descriptor-reg lra-offset)
(:temp nargs any-reg nargs-offset) (:temp nargs any-reg nargs-offset)
(:temp ocfp any-reg ocfp-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 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 b :ne DO-STATIC-FUN)
(inst nop) (inst nop)
(inst addcc temp x y) (inst addcc temp x y)
(inst b :vc done) (inst b :vc done)
(inst nop) (inst nop)
(inst sra temp x 2) (inst sra temp x fixnum-tag-bits)
(inst sra temp2 y 2) (inst sra temp2 y fixnum-tag-bits)
(inst add temp2 temp) (inst add temp2 temp)
(with-fixed-allocation (res temp bignum-type (1+ bignum-digits-offset)) (with-fixed-allocation (res temp bignum-type (1+ bignum-digits-offset))
(storew temp2 res bignum-digits-offset other-pointer-type)) (storew temp2 res bignum-digits-offset other-pointer-type))
...@@ -80,17 +80,17 @@ ...@@ -80,17 +80,17 @@
(:temp lra descriptor-reg lra-offset) (:temp lra descriptor-reg lra-offset)
(:temp nargs any-reg nargs-offset) (:temp nargs any-reg nargs-offset)
(:temp ocfp any-reg ocfp-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 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 b :ne DO-STATIC-FUN)
(inst nop) (inst nop)
(inst subcc temp x y) (inst subcc temp x y)
(inst b :vc done) (inst b :vc done)
(inst nop) (inst nop)
(inst sra temp x 2) (inst sra temp x fixnum-tag-bits)
(inst sra temp2 y 2) (inst sra temp2 y fixnum-tag-bits)
(inst sub temp2 temp temp2) (inst sub temp2 temp temp2)
(with-fixed-allocation (res temp bignum-type (1+ bignum-digits-offset)) (with-fixed-allocation (res temp bignum-type (1+ bignum-digits-offset))
(storew temp2 res bignum-digits-offset other-pointer-type)) (storew temp2 res bignum-digits-offset other-pointer-type))
...@@ -130,15 +130,15 @@ ...@@ -130,15 +130,15 @@
(:temp nargs any-reg nargs-offset) (:temp nargs any-reg nargs-offset)
(:temp ocfp any-reg ocfp-offset)) (:temp ocfp any-reg ocfp-offset))
;; If either arg is not a fixnum, call the static function. ;; 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 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 b :ne DO-STATIC-FUN)
(inst nop) (inst nop)
;; Remove the tag from one arg so that the result will have the correct ;; Remove the tag from one arg so that the result will have the correct
;; fixnum tag. ;; 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 ;; Compute the produce temp * y and return the double-word product
;; in hi:lo. ;; in hi:lo.
(cond ((backend-featurep :sparc-64) (cond ((backend-featurep :sparc-64)
...@@ -175,10 +175,11 @@ ...@@ -175,10 +175,11 @@
(inst b :eq LOW-FITS-IN-FIXNUM) (inst b :eq LOW-FITS-IN-FIXNUM)
;; Shift the double word hi:lo down two bits to get rid of the fixnum tag. ;; Shift the double word hi:lo down two bits to get rid of the fixnum tag.
(inst sll temp hi 30) (inst sll temp hi 30)
(inst srl lo 2) (inst srl lo fixnum-tag-bits)
(inst or lo temp) (inst or lo temp)
(inst sra hi 2) (inst sra hi fixnum-tag-bits)
;; Allocate a BIGNUM for the result. ;; Allocate a BIGNUM for the result.
#+nil
(pseudo-atomic (:extra (pad-data-block (1+ bignum-digits-offset))) (pseudo-atomic (:extra (pad-data-block (1+ bignum-digits-offset)))
(let ((one-word (gen-label))) (let ((one-word (gen-label)))
(inst or res alloc-tn other-pointer-type) (inst or res alloc-tn other-pointer-type)
...@@ -195,6 +196,25 @@ ...@@ -195,6 +196,25 @@
(emit-label one-word) (emit-label one-word)
(storew temp res 0 other-pointer-type) (storew temp res 0 other-pointer-type)
(storew lo res bignum-digits-offset 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 ;; Out of here
(lisp-return lra :offset 2) (lisp-return lra :offset 2)
...@@ -413,9 +433,9 @@ ...@@ -413,9 +433,9 @@
(:temp nargs any-reg nargs-offset) (:temp nargs any-reg nargs-offset)
(:temp ocfp any-reg ocfp-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 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 b :eq DO-COMPARE)
(inst cmp x y) (inst cmp x y)
...@@ -455,9 +475,9 @@ ...@@ -455,9 +475,9 @@
(:temp ocfp any-reg ocfp-offset)) (:temp ocfp any-reg ocfp-offset))
(inst cmp x y) (inst cmp x y)
(inst b :eq RETURN-T) (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 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 b :ne DO-STATIC-FN)
(inst nop) (inst nop)
...@@ -490,9 +510,9 @@ ...@@ -490,9 +510,9 @@
(:temp lra descriptor-reg lra-offset) (:temp lra descriptor-reg lra-offset)
(:temp nargs any-reg nargs-offset) (:temp nargs any-reg nargs-offset)
(:temp ocfp any-reg ocfp-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 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 b :ne DO-STATIC-FN)
(inst cmp x y) (inst cmp x y)
(inst b :eq RETURN-T) (inst b :eq RETURN-T)
...@@ -528,9 +548,9 @@ ...@@ -528,9 +548,9 @@
(:temp ocfp any-reg ocfp-offset)) (:temp ocfp any-reg ocfp-offset))
(inst cmp x y) (inst cmp x y)
(inst b :eq RETURN-NIL) (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 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 b :ne DO-STATIC-FN)
(inst nop) (inst nop)
......
...@@ -5,11 +5,11 @@ ...@@ -5,11 +5,11 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (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 ;;; This file contains the SPARC VM definition of operand loading/saving and
;;; the Move VOP. ;;; the Move VOP.
...@@ -155,7 +155,7 @@ ...@@ -155,7 +155,7 @@
(:arg-types tagged-num) (:arg-types tagged-num)
(:note "fixnum untagging") (:note "fixnum untagging")
(:generator 1 (:generator 1
(inst sra y x 2))) (inst sra y x fixnum-tag-bits)))
;;; ;;;
(define-move-vop move-to-word/fixnum :move (define-move-vop move-to-word/fixnum :move
(any-reg descriptor-reg) (signed-reg unsigned-reg)) (any-reg descriptor-reg) (signed-reg unsigned-reg))
...@@ -180,9 +180,9 @@ ...@@ -180,9 +180,9 @@
(:temporary (:scs (non-descriptor-reg)) temp) (:temporary (:scs (non-descriptor-reg)) temp)
(:generator 4 (:generator 4
(let ((done (gen-label))) (let ((done (gen-label)))
(inst andcc temp x 3) (inst andcc temp x fixnum-tag-mask)
(inst b :eq done) (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) (loadw y x bignum-digits-offset other-pointer-type)
...@@ -202,7 +202,7 @@ ...@@ -202,7 +202,7 @@
(:result-types tagged-num) (:result-types tagged-num)
(:note "fixnum tagging") (:note "fixnum tagging")
(:generator 1 (:generator 1
(inst sll y x 2))) (inst sll y x fixnum-tag-bits)))
;;; ;;;
(define-move-vop move-from-word/fixnum :move (define-move-vop move-from-word/fixnum :move
(signed-reg unsigned-reg) (any-reg descriptor-reg)) (signed-reg unsigned-reg) (any-reg descriptor-reg))
...@@ -220,12 +220,12 @@ ...@@ -220,12 +220,12 @@
(move x arg) (move x arg)
(let ((fixnum (gen-label)) (let ((fixnum (gen-label))
(done (gen-label))) (done (gen-label)))
(inst sra temp x 29) (inst sra temp x positive-fixnum-bits)
(inst cmp temp) (inst cmp temp)
(inst b :eq fixnum) (inst b :eq fixnum)
(inst orncc temp zero-tn temp) (inst orncc temp zero-tn temp)
(inst b :eq done) (inst b :eq done)
(inst sll y x 2) (inst sll y x fixnum-tag-bits)
(with-fixed-allocation (with-fixed-allocation
(y temp bignum-type (1+ bignum-digits-offset)) (y temp bignum-type (1+ bignum-digits-offset))
...@@ -234,7 +234,7 @@ ...@@ -234,7 +234,7 @@
(inst nop) (inst nop)
(emit-label fixnum) (emit-label fixnum)
(inst sll y x 2) (inst sll y x fixnum-tag-bits)
(emit-label done)))) (emit-label done))))
;;; ;;;
(define-move-vop move-from-signed :move (define-move-vop move-from-signed :move
...@@ -254,21 +254,23 @@ ...@@ -254,21 +254,23 @@
(let ((done (gen-label)) (let ((done (gen-label))
(one-word (gen-label)) (one-word (gen-label))
(initial-alloc (pad-data-block (1+ bignum-digits-offset)))) (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 cmp temp)
(inst b :eq done) (inst b :eq done)
(inst sll y x 2) (inst sll y x fixnum-tag-bits)
(pseudo-atomic (:extra initial-alloc) ;; We always allocate 2 words even if we don't need it. (The
(inst or y alloc-tn other-pointer-type) ;; 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 cmp x)
(inst b :ge one-word) (inst b :ge one-word)
(inst li temp (logior (ash 1 type-bits) bignum-type)) (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)) (inst li temp (logior (ash 2 type-bits) bignum-type))
(emit-label one-word) (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 temp y 0 other-pointer-type)
(storew x y bignum-digits-offset other-pointer-type)) (storew x y bignum-digits-offset other-pointer-type))
(emit-label done)))) (emit-label done))))
......
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