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))))