diff --git a/compiler/mips/alloc.lisp b/compiler/mips/alloc.lisp
index b4886807d7d4d8abfecfa06f4c9f9a50eee56e22..378190af1198186a0d5e875b65b7b3cd71a230c6 100644
--- a/compiler/mips/alloc.lisp
+++ b/compiler/mips/alloc.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/alloc.lisp,v 1.4 1990/04/24 02:55:22 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/alloc.lisp,v 1.5 1990/05/25 12:24:49 wlott Exp $
 ;;;
 ;;; Allocation VOPs for the MIPS port.
 ;;;
@@ -73,3 +73,29 @@
 
 (define-vop (list* list-or-list*)
   (:variant t))
+
+
+(define-vop (allocate-code-object)
+  (:args (boxed-arg :scs (any-reg))
+	 (unboxed-arg :scs (any-reg)))
+  (:results (result :scs (descriptor-reg)))
+  (:temporary (:scs (non-descriptor-reg)) ndescr)
+  (:temporary (:scs (any-reg) :from (:argument 0)) boxed)
+  (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) unboxed)
+  (:generator 100
+    (inst li ndescr (lognot vm:lowtag-mask))
+    (inst addu boxed boxed-arg (fixnum 1))
+    (inst and boxed ndescr)
+    (inst srl unboxed unboxed-arg vm:word-shift)
+    (inst addu unboxed unboxed vm:lowtag-mask)
+    (inst and unboxed ndescr)
+    (pseudo-atomic (ndesrc)
+      (inst addu result alloc-tn vm:other-pointer-type)
+      (inst addu alloc-tn boxed)
+      (inst addu alloc-tn unboxed)
+      (inst sll ndescr boxed (- vm:type-bits vm:word-shift))
+      (inst or ndescr vm:code-header-type)
+      (storew ndescr result 0 vm:other-pointer-type)
+      (storew unboxed result vm:code-code-size-slot vm:other-pointer-type)
+      (storew null-tn result vm:code-entry-points-slot vm:other-pointer-type)
+      (storew null-tn result vm:code-debug-info-slot vm:other-pointer-type))))