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