From 891ad8e1dc5e81fe85e6b09edbb2c4c6e42fb27a Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Mon, 19 Mar 1990 17:16:54 +0000
Subject: [PATCH] Fixed bind and unbind to store the symbol and value in
 different slots.

Added unbind-to-here.
---
 compiler/mips/cell.lisp | 33 ++++++++++++++++++++++++++++-----
 1 file changed, 28 insertions(+), 5 deletions(-)

diff --git a/compiler/mips/cell.lisp b/compiler/mips/cell.lisp
index ae6d38191..8ecacf5e6 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:
-- 
GitLab