diff --git a/assembly/sparc/alloc.lisp b/assembly/sparc/alloc.lisp
index d728770d0e71b73f0b3dfc734dce04a21eb85b17..8addc66d5f37dd5f5cee85071a8ff410abc09c07 100644
--- a/assembly/sparc/alloc.lisp
+++ b/assembly/sparc/alloc.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/sparc/alloc.lisp,v 1.1 1990/11/22 11:49:39 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/sparc/alloc.lisp,v 1.2 1992/03/11 21:40:59 wlott Exp $
 ;;;
 ;;; Stuff to handle allocating simple objects.
 ;;;
@@ -46,6 +46,8 @@
 	defined for ~S."
 	       (args) (primitive-object-name obj)))
       (when alloc-vop
+	(when (and variable-length (not header))
+	  (error "Can't allocate variable-length objects with no header."))
 	`(define-assembly-routine
 	     (,alloc-vop
 	      (:cost 35)
@@ -63,27 +65,29 @@
 		,@(when (or need-unbound-marker header variable-length)
 		    '((:temp temp non-descriptor-reg nl1-offset)))
 		(:res result descriptor-reg a0-offset))
-	   (pseudo-atomic (ndescr)
-	     (inst add result alloc-tn ,lowtag)
-	     ,@(cond ((and header variable-length)
-		      `((inst add temp extra-words (fixnum (1- ,size)))
-			(inst add alloc-tn alloc-tn temp)
-			(inst sll temp temp (- type-bits word-shift))
-			(inst or temp temp ,header)
-			(storew temp result 0 ,lowtag)
-			(inst add alloc-tn (+ (fixnum 1) lowtag-mask))
-			(inst and alloc-tn (lognot lowtag-mask))))
-		     (variable-length
-		      (error ":REST-P T with no header in ~S?"
-			     (primitive-object-name obj)))
-		     (header
-		      `((inst add alloc-tn (pad-data-block ,size))
-			(inst li temp
-			      ,(logior (ash (1- size) type-bits)
-				       (symbol-value header)))
-			(storew temp result 0 ,lowtag)))
-		     (t
-		      `((inst add alloc-tn (pad-data-block ,size)))))
-	     ,@(when need-unbound-marker
-		 `((inst li temp unbound-marker-type)))
-	     ,@(init-forms)))))))
+	   (let ((alloc ,(if variable-length
+			     0
+			     `(pad-data-block ,size))))
+	     (pseudo-atomic (:extra alloc)
+	       ,@(if (logbitp 2 (eval lowtag))
+		     `((inst or result alloc-tn ,lowtag))
+		     `((inst andn result alloc-tn lowtag-mask)
+		       (inst or result ,lowtag)))
+	       ,@(cond (variable-length
+			`((inst add temp extra-words (* (1+ ,size) word-bytes))
+			  (inst andn temp 7)
+			  (inst add alloc-tn temp)
+			  (inst sll temp extra-words (- type-bits word-shift))
+			  (inst add temp (+ (ash (1- ,size) type-bits)
+					    header))
+			  (storew temp result 0 ,lowtag)))
+		       (header
+			`((inst li temp
+				,(logior (ash (1- size) type-bits)
+					 (symbol-value header)))
+			  (storew temp result 0 ,lowtag)))
+		       (t
+			nil))
+	       ,@(when need-unbound-marker
+		   `((inst li temp unbound-marker-type)))
+	       ,@(init-forms))))))))
diff --git a/assembly/sparc/array.lisp b/assembly/sparc/array.lisp
index c7e972aa764737a8c1b22d36ffd6f39c23bcbaee..69a0513b2d321ca184e683d4213321e928dba3ce 100644
--- a/assembly/sparc/array.lisp
+++ b/assembly/sparc/array.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/sparc/array.lisp,v 1.2 1990/11/30 16:45:44 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/sparc/array.lisp,v 1.3 1992/03/11 21:41:02 wlott Exp $
 ;;;
 ;;;    This file contains the support routines for arrays and vectors.
 ;;;
@@ -29,12 +29,11 @@
 
 			  (:temp ndescr non-descriptor-reg nl0-offset)
 			  (:temp vector descriptor-reg a3-offset))
-  (pseudo-atomic (ndescr)
+  (pseudo-atomic ()
     (inst or vector alloc-tn vm:other-pointer-type)
-    (inst add alloc-tn alloc-tn (+ (1- (ash 1 vm:lowtag-bits))
-				   (* vm:vector-data-offset vm:word-bytes)))
-    (inst add alloc-tn alloc-tn words)
-    (inst and alloc-tn alloc-tn (lognot vm:lowtag-mask))
+    (inst add ndescr words (* (1+ vm:vector-data-offset) vm:word-bytes))
+    (inst andn ndescr 7)
+    (inst add alloc-tn ndescr)
     (inst srl ndescr type vm:word-shift)
     (storew ndescr vector 0 vm:other-pointer-type)
     (storew length vector vm:vector-length-slot vm:other-pointer-type))