diff --git a/compiler/mips/alloc.lisp b/compiler/mips/alloc.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..2eeb98dd88e3db612e43698695254d162b16d990
--- /dev/null
+++ b/compiler/mips/alloc.lisp
@@ -0,0 +1,72 @@
+;;; -*- Package: C -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the Spice Lisp project at
+;;; Carnegie-Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of Spice Lisp, please contact
+;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; **********************************************************************
+;;;
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/alloc.lisp,v 1.1 1990/02/27 00:16:55 wlott Exp $
+;;;
+;;; Allocation VOPs for the MIPS port.
+;;;
+;;; Written by William Lott.
+;;; 
+
+(define-vop (list-or-list*)
+  (:args (things :more t))
+  (:temporary (:scs (descriptor-reg) :type list) ptr)
+  (:temporary (:scs (descriptor-reg)) temp)
+  (:temporary (:scs (descriptor-reg) :type list :to (:result 0) :target result)
+	      res)
+  (:temporary (:scs (non-descriptor-reg) :type random) ndescr)
+  (:info num)
+  (:results (result :scs (descriptor-reg)))
+  (:variant-vars star)
+  (:policy :safe)
+  (:generator 0
+    (cond ((zerop num)
+	   (move result null-tn))
+	  ((and star (= num 1))
+	   (move result (tn-ref-tn things)))
+	  (t
+	   (macrolet
+	       ((store-car (tn list &optional (slot vm:cons-car-slot))
+		  `(let ((reg
+			  (sc-case ,tn
+			    ((any-reg descriptor-reg) ,tn)
+			    (zero zero-tn)
+			    (null null-tn)
+			    (control-stack
+			     (load-stack-tn temp ,tn)
+			     temp))))
+		     (storew reg ,list ,slot vm:list-pointer-type))))
+	     (let ((cons-cells (if star (1- num) num)))
+	       (pseudo-atomic (ndescr)
+		 (inst addiu res alloc-tn vm:list-pointer-type)
+		 (inst addiu alloc-tn alloc-tn
+		       (* (vm:pad-data-block vm:cons-size) cons-cells)))
+	       (move ptr res)
+	       (dotimes (i (1- cons-cells))
+		 (store-car (tn-ref-tn things) ptr)
+		 (setf things (tn-ref-across things))
+		 (inst addiu ptr ptr (vm:pad-data-block vm:cons-size))
+		 (storew ptr ptr
+			 (- vm:cons-cdr-slot (vm:pad-data-block vm:cons-size))
+			 vm:list-pointer-type))
+	       (store-car (tn-ref-tn things) ptr)
+	       (cond (star
+		      (setf things (tn-ref-across things))
+		      (store-car (tn-ref-tn things) ptr vm:cons-cdr-slot))
+		     (t
+		      (storew null-tn ptr
+			      vm:cons-cdr-slot vm:list-pointer-type)))
+	       (assert (null (tn-ref-across things)))
+	       (move result res)))))))
+
+(define-vop (list list-or-list*)
+  (:variant nil))
+
+(define-vop (list* list-or-list*)
+  (:variant t))