diff --git a/compiler/mips/cell.lisp b/compiler/mips/cell.lisp
index ae6d381910eee68cd9ad44e824a5e171f8e6be94..8ecacf5e6def6c717eb5e063655233426a24cd24 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.22 1990/03/18 23:29:25 ch Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/cell.lisp,v 1.23 1990/03/19 17:16:54 wlott Exp $
 ;;;
 ;;;    This file contains the VM definition of various primitive memory access
 ;;; VOPs for the MIPS.
@@ -434,7 +434,7 @@
   (:generator 5
     (loadw temp symbol vm:symbol-value-slot vm:other-pointer-type)
     (inst addiu bsp-tn bsp-tn (* 2 vm:word-bytes))
-    (storew temp bsp-tn (- binding-symbol-slot binding-size))
+    (storew temp bsp-tn (- binding-value-slot binding-size))
     (storew symbol bsp-tn (- binding-symbol-slot binding-size))
     (storew val symbol vm:symbol-value-slot vm:other-pointer-type)))
 
@@ -442,16 +442,39 @@
 (define-vop (unbind)
   (:temporary (:scs (descriptor-reg)) symbol value)
   (:generator 0
-    (let ((skip (gen-label)))
+    (loadw symbol bsp-tn (- binding-symbol-slot binding-size))
+    (loadw value bsp-tn (- binding-value-slot binding-size))
+    (storew value symbol vm:symbol-value-slot vm:other-pointer-type)
+    (storew zero-tn bsp-tn (- binding-symbol-slot binding-size))
+    (inst addiu bsp-tn bsp-tn (* -2 vm:word-bytes))))
+
+
+(define-vop (unbind-to-here)
+  (:args (arg :scs (descriptor-reg any-reg) :target where))
+  (:temporary (:scs (descriptor-reg any-reg) :type fixnum :from (:argument 0))
+	      where)
+  (:temporary (:scs (descriptor-reg)) symbol value)
+  (:generator 0
+    (let ((loop (gen-label))
+	  (skip (gen-label))
+	  (done (gen-label)))
+      (move where arg)
+      (inst beq where bsp-tn done)
       (loadw symbol bsp-tn (- binding-symbol-slot binding-size))
+
+      (emit-label loop)
       (inst beq symbol zero-tn skip)
       (loadw value bsp-tn (- binding-symbol-slot binding-size))
       (storew value symbol vm:symbol-value-slot vm:other-pointer-type)
       (storew zero-tn bsp-tn (- binding-symbol-slot binding-size))
 
       (emit-label skip)
-      (inst addiu bsp-tn bsp-tn (* -2 vm:word-bytes)))))
-      
+      (inst addiu bsp-tn bsp-tn (* -2 vm:word-bytes))
+      (inst bne where bsp-tn loop)
+      (loadw symbol bsp-tn (- binding-symbol-slot binding-size))
+
+      (emit-label done))))
+
 
 
 ;;;; Structure hackery: