diff --git a/compiler/mips/cell.lisp b/compiler/mips/cell.lisp
index e2460097531eb9e316a0029b9d9d486f62950f97..165afee4da92fcbea04daa727d5eb1e1f72a4648 100644
--- a/compiler/mips/cell.lisp
+++ b/compiler/mips/cell.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/cell.lisp,v 1.9 1990/02/20 18:21:28 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/cell.lisp,v 1.10 1990/02/20 19:34:59 wlott Exp $
 ;;;
 ;;;    This file contains the VM definition of various primitive memory access
 ;;; VOPs for the MIPS.
@@ -77,21 +77,26 @@
 	      (getf props :set-vop)
 	      (getf props :setf-vop)
 	      (getf props :set-trans)
-	      (getf props :docs)))))
+	      (getf props :docs)
+	      (getf props :init :zero)))))
 
-(defmacro defslots ((name &key (header t) (lowtag 0)) &rest slots)
+(defmacro defslots ((name &key header (lowtag 0) alloc-vop alloc-trans)
+		    &rest slots)
   (let ((compile-time nil)
 	(load-time nil)
 	(index (if header 1 0))
 	(slot-names (if header '(header)))
-	(did-rest nil))
+	(did-rest nil)
+	(init-forms nil)
+	(init-args nil)
+	(need-unbound-marker nil))
     (dolist (slot slots)
       (when did-rest
 	(error "Rest slot ~S in defslots of ~S is not the last one."
 	       did-rest name))
       (multiple-value-bind
 	  (slot-name rest boxed ref-vop ref-trans
-		     set-vop setf-vop set-trans docs)
+		     set-vop setf-vop set-trans docs init)
 	  (parse-slot slot)
 	(let ((const (intern (concatenate 'simple-string
 					  (string name)
@@ -115,60 +120,119 @@
 		     (:variant ,const ,lowtag)
 		     ,@(when ref-trans
 			 `((:translate ,ref-trans))))
-		  load-time)))
+		  load-time))
+	  (case init
+	    (:zero)
+	    (:null
+	     (push `(storew null-tn result ,const ,lowtag) init-forms))
+	    (:unbound
+	     (setf need-unbound-marker t)
+	     (push `(storew temp result ,const ,lowtag) init-forms))
+	    (:arg
+	     (push slot-name init-args)
+	     (push `(storew ,slot-name result ,const ,lowtag) init-forms))))
 	(push (if (or (not boxed) rest)
 		  `(,slot-name
 		    ,@(if (not boxed) '(:boxed nil))
 		    ,@(if rest '(:rest t)))
 		  slot-name)
 	      slot-names)
-	(when rest
-	  (setf did-rest slot-name)))
-      (incf index))
-    (unless did-rest
-      (push `(defconstant ,(intern (concatenate 'simple-string
-						(string name)
-						"-SIZE"))
-	       ,index
+	(if rest
+	    (setf did-rest slot-name)
+	    (incf index))))
+    (let ((size (intern (concatenate 'simple-string
+				     (string name)
+				     (if did-rest "-BASE-SIZE" "-SIZE")))))
+      (push `(defconstant ,size ,index
 	       ,(format nil
-		  "Number of slots used by each ~S~@[ including the header~]."
-		  name header))
-	    compile-time))
+			"Number of slots used by each ~S~
+			~@[ including the header~]~@[ excluding any data~]."
+			name header did-rest))
+	    compile-time)
+      (when alloc-vop
+	(push `(define-vop (,alloc-vop)
+		 (:args ,@(when did-rest
+			    `((extra-words :scs (any-reg descriptor-reg))))
+			,@(mapcar #'(lambda (name)
+				      `(,name :scs (any-reg descriptor-reg)))
+				  (nreverse init-args)))
+		 (:temporary (:scs (non-descriptor-reg) :type random)
+			     ndescr
+			     ,@(when (or need-unbound-marker header did-rest)
+				 '(temp)))
+		 (:temporary (:scs (descriptor-reg) :to (:result 0)
+				   :target real-result) result)
+		 (:results (real-result :scs (descriptor-reg)))
+		 (:policy fast-safe)
+		 ,@(when alloc-trans
+		     `((:translate ,alloc-trans)))
+		 (:generator 37
+		   (pseudo-atomic (ndescr)
+		     (inst addiu result alloc-tn ,lowtag)
+		     ,@(cond ((and header did-rest)
+			      `((inst addiu temp extra-words ,size)
+				(inst addu alloc-tn alloc-tn temp)
+				(inst sll temp temp
+				      (- vm:type-bits vm:word-bits))
+				(inst ori temp temp ,header)
+				(storew temp result 0 ,lowtag)
+				(inst addiu alloc-tn alloc-tn vm:lowtag-mask)
+				(loadi temp (lognot vm:lowtag-mask))
+				(inst and alloc-tn alloc-tn temp)))
+			     (did-rest
+			      (error ":REST T with no header in ~S?" name))
+			     (header
+			      `((inst addiu alloc-tn alloc-tn
+				      (vm:pad-data-block ,size))
+				(loadi temp (logior (ash ,size vm:type-bits)
+						    ,header))
+				(storew temp result 0 ,lowtag)))
+			     (t
+			      `((inst addiu alloc-tn alloc-tn
+				      (vm:pad-data-block ,size)))))
+		     ,@(when need-unbound-marker
+			 `((loadi temp vm:unbound-marker-type)))
+		     ,@(nreverse init-forms)
+		     (move real-results result))))
+	      load-time)))
     `(progn
        (eval-when (compile load eval)
 	 ,@(nreverse compile-time))
        ,@(nreverse load-time)
        (defconstant ,(intern (concatenate 'simple-string
-					   (string name)
-					   "-STRUCTURE"))
+					  (string name)
+					  "-STRUCTURE"))
 	 ',(reverse slot-names)))))
 
-(defslots (cons :lowtag list-pointer-type :header nil)
+(defslots (cons :lowtag list-pointer-type
+		:alloc-vop cons-vop :alloc-trans cons)
   (car :ref-vop car :ref-trans car
-       :setf-vop set-car :set-trans %rplaca)
+       :setf-vop set-car :set-trans %rplaca
+       :init :arg)
   (cdr :ref-vop cdr :ref-trans cdr
-       :setf-vop set-cdr :set-trans %rplacd))
+       :setf-vop set-cdr :set-trans %rplacd
+       :init :arg))
 
 
-(defslots (bignum :lowtag other-pointer-type)
+(defslots (bignum :lowtag other-pointer-type :header bignum-type)
   (digits :rest t :boxed nil))
 
-(defslots (ratio :lowtag other-pointer-type)
+(defslots (ratio :lowtag other-pointer-type :header ratio-type)
   numerator
   denominator)
 
-(defslots (single-float :lowtag other-pointer-type)
+(defslots (single-float :lowtag other-pointer-type :header single-float-type)
   value)
 
-(defslots (double-float :lowtag other-pointer-type)
+(defslots (double-float :lowtag other-pointer-type :header double-float-type)
   value
   more-value)
 
-(defslots (complex :lowtag other-pointer-type)
+(defslots (complex :lowtag other-pointer-type :header complex-type)
   real
   imag)
 
-(defslots (array :lowtag other-pointer-type)
+(defslots (array :lowtag other-pointer-type :header t)
   fill-pointer
   elements
   data
@@ -176,17 +240,18 @@
   displaced-p
   (dimensions :rest t))
 
-(defslots (vector :lowtag other-pointer-type)
+(defslots (vector :lowtag other-pointer-type :header t)
   length
   (data :rest t :boxed nil))
 
-(defslots (code :lowtag other-pointer-type)
+(defslots (code :lowtag other-pointer-type :header t)
   code-size
   entry-points
   debug-info
   (constants :rest t))
 
-(defslots (function-header :lowtag function-pointer-type)
+(defslots (function-header :lowtag function-pointer-type
+			   :header function-header-type)
   self
   next
   name
@@ -194,24 +259,29 @@
   type
   (code :rest t :boxed nil))
 
-(defslots (return-pc :lowtag other-pointer-type)
+(defslots (return-pc :lowtag other-pointer-type :header t)
   (return-point :boxed nil :rest t))
 
-(defslots (closure :lowtag function-pointer-type)
-  function
+(defslots (closure :lowtag function-pointer-type :header closure-header-type
+		   :alloc-vop make-closure)
+  (function :init :arg)
   (info :rest t :set-vop closure-init :ref-vop closure-ref))
 
-(defslots (value-cell :lowtag other-pointer-type)
-  (value :set-vop value-cell-set :ref-vop value-cell-ref))
+(defslots (value-cell :lowtag other-pointer-type :header value-cell-type
+		      :alloc-vop make-value-cell)
+  (value :set-vop value-cell-set :ref-vop value-cell-ref :init :arg))
 
-(defslots (symbol :lowtag other-pointer-type)
-  (value :setf-vop set :set-trans set)
-  (function :setf-vop set-symbol-function :set-trans %sp-set-definition)
+(defslots (symbol :lowtag other-pointer-type :header symbol-header-type
+		  :alloc-vop make-symbol-vop :alloc-trans %make-symbol)
+  (value :setf-vop set :set-trans set :init :unbound)
+  (function :setf-vop set-symbol-function :set-trans %sp-set-definition
+	    :init :unbound)
   (plist :ref-vop symbol-plist :ref-trans symbol-plist
-	 :setf-vop set-symbol-plist :set-trans %sp-set-plist)
-  (name :ref-vop symbol-name :ref-trans symbol-name)
+	 :setf-vop set-symbol-plist :set-trans %sp-set-plist
+	 :init :null)
+  (name :ref-vop symbol-name :ref-trans symbol-name :init :arg)
   (package :ref-vop symbol-package :ref-trans symbol-package
-	   :setf-vop set-package))
+	   :setf-vop set-package :init :null))