[movitz-cvs] CVS update: movitz/special-operators.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz
In directory common-lisp.net:/tmp/cvs-serv6279

Modified Files:
	special-operators.lisp 
Log Message:
Re-working of non-local control transfer so as to comply with the
stack discipline.

Date: Fri Sep 17 13:12:49 2004
Author: ffjeld

Index: movitz/special-operators.lisp
diff -u movitz/special-operators.lisp:1.38 movitz/special-operators.lisp:1.39
--- movitz/special-operators.lisp:1.38	Wed Sep 15 12:22:52 2004
+++ movitz/special-operators.lisp	Fri Sep 17 13:12:49 2004
@@ -8,7 +8,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Fri Nov 24 16:22:59 2000
 ;;;;                
-;;;; $Id: special-operators.lisp,v 1.38 2004/09/15 10:22:52 ffjeld Exp $
+;;;; $Id: special-operators.lisp,v 1.39 2004/09/17 11:12:49 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -1178,9 +1178,14 @@
   (destructuring-bind (tag context value-form)
       (cdr form)
     (let* ((local-env (make-local-movitz-environment env funobj :type 'let-env))
-	   (dynamic-slot-binding (movitz-env-add-binding local-env
-							 (make-instance 'located-binding
-							   :name (gensym "dynamic-slot-")))))
+	   (dynamic-slot-binding
+	    (movitz-env-add-binding local-env
+				    (make-instance 'located-binding
+				      :name (gensym "dynamic-slot-"))))
+	   (next-continuation-step-binding
+	    (movitz-env-add-binding local-env
+				    (make-instance 'located-binding
+				      :name (gensym "continuation-step-")))))
       (with-labels (throw (save-tag-var save-context-var))
 	(compiler-values ()
 	  :returns :non-local-exit
@@ -1196,7 +1201,9 @@
 				       (:globally (:call (:edi (:edi-offset dynamic-locate-catch-tag))))
 				       (:jnc '(:sub-program () (:int 108)))
 				       (:store-lexical ,dynamic-slot-binding :eax :type t)
-				       )))) ; save dynamic-slot in EBP
+				       (:globally (:call (:edi (:edi-offset dynamic-unwind-next))))
+				       (:store-lexical ,next-continuation-step-binding :eax :type t)
+				       ))))
 			;; now outside of m-v-prog1's cloak, with final dynamic-slot in ESP..
 			;; ..unwind it and transfer control.
 			;;
@@ -1207,11 +1214,14 @@
 ;;;			`((:load-lexical ,dynamic-slot-binding :edx)
 ;;;			  ())
 			`((:load-lexical ,dynamic-slot-binding :edx)
+			  (:locally (:movl :edx (:edi (:edi-offset raw-scratch0)))) ; final continuation
+			  (:load-lexical ,next-continuation-step-binding :edx) ; next continuation-step
 			  (:locally (:movl :esi (:edi (:edi-offset scratch1))))
+			  (:locally (:movl :edx (:edi (:edi-offset dynamic-env)))) ; exit dynamic-env
 			  (:movl :edx :esp) ; enter non-local jump stack mode.
 			  
 			  (:movl (:esp) :edx) ; target stack-frame EBP
-			  (:movl (:edx -4) :esi) ; get target funobj into EDX
+			  (:movl (:edx -4) :esi) ; get target funobj into ESI
 			  
 			  (:movl (:esp 8) :edx) ; target jumper number
 			  (:jmp (:esi :edx ,(slot-offset 'movitz-funobj 'constant0))))))))))
@@ -1293,7 +1303,8 @@
 			  :form body)
 			`((:leal (:esp ,(+ -12 -4 (* 4 entry-size))) :esp)
 			  ,exit-point
+			  (:movl (:esp 12) :edx)
+			  (:locally (:movl :edx (:edi (:edi-offset dynamic-env))))
 			  (:popl :ebp)
-			  (:leal (:esp 8) :esp)
-			  (:locally (:popl (:edi (:edi-offset dynamic-env))))
+			  (:leal (:esp 12) :esp)
 			  )))))))