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

Modified Files: los0.lisp Log Message: Add dynamic-unwind-next-shallow.

Date: Fri Nov 12 21:55:49 2004 Author: ffjeld

Index: movitz/losp/los0.lisp diff -u movitz/losp/los0.lisp:1.25 movitz/losp/los0.lisp:1.26 --- movitz/losp/los0.lisp:1.25 Fri Nov 12 17:25:09 2004 +++ movitz/losp/los0.lisp Fri Nov 12 21:55:49 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 1 18:08:32 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: los0.lisp,v 1.25 2004/11/12 16:25:09 ffjeld Exp $ +;;;; $Id: los0.lisp,v 1.26 2004/11/12 20:55:49 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -1530,6 +1530,47 @@ (:stc) (:ret)))

+(define-primitive-function dynamic-unwind-next-shallow (dynamic-env) + "Locate the next unwind-protect entry between here and dynamic-env/EAX. +If no such entry is found, return (same) dynamic-env in EAX and CF=0. +Otherwise return the unwind-protect entry in EAX and CF=1. Preserve EDX. +Point is: Return the 'next step' in unwinding towards dynamic-env. +Note that it's an error if dynamic-env isn't in the current dynamic environment, +it's supposed to have been found by e.g. dynamic-locate-catch-tag." + ;; XXX: Not really sure if there's any point in the CF return value, + ;; because I don't think there's ever any need to know whether + ;; the returned entry is an unwind-protect or the actual target. + (with-inline-assembly (:returns :nothing) + (:locally (:bound (:edi (:edi-offset stack-bottom)) :eax)) + (:locally (:movl :eax (:edi (:edi-offset scratch2)))) ; Free up EAX + ;; (:globally (:movl (:edi (:edi-offset unwind-protect-tag)) :ebx)) + (:locally (:movl (:edi (:edi-offset dynamic-env)) :ecx)) + + search-loop + (:jecxz '(:sub-program () (:int 63))) + (:locally (:bound (:edi (:edi-offset stack-bottom)) :ecx)) + + (:locally (:cmpl :ecx (:edi (:edi-offset scratch2)))) + (:je 'found-dynamic-env) + + (:movl (:ecx 4) :ebx) + (:globally (:cmpl :ebx (:edi (:edi-offset unwind-protect-tag)))) + (:je 'found-unwind-protect) + + ;; If this entry is a dynamic variable binding, uninstall it. + (:movl (:ecx) :eax) ; symbol? + (:testb 3 :al) ; + (:jz 'not-variable-binding) ; not symbol? + (:movl :ebx (:eax (:offset movitz-symbol value))) ; uninstall. + not-variable-binding + (:movl (:ecx 12) :ecx) ; proceed search + (:jmp 'search-loop) + found-unwind-protect + (:stc) + found-dynamic-env + (:movl :ecx :eax) + (:ret))) + (define-primitive-function dynamic-load-shallow (symbol) "Load the dynamic value of SYMBOL into EAX." (with-inline-assembly (:returns :multiple-values) @@ -1560,6 +1601,7 @@ (setf (%run-time-context-slot ',slot) (symbol-value ',function))))) (list (install muerte:dynamic-variable-install dynamic-variable-install-shallow) (install muerte:dynamic-variable-uninstall dynamic-variable-uninstall-shallow) + (install muerte::dynamic-unwind-next dynamic-unwind-next-shallow) (install muerte::dynamic-store dynamic-store-shallow) (install muerte::dynamic-load-unprotected dynamic-load-unprotected-shallow) (prog1 (install muerte::dynamic-load dynamic-load-shallow)