[movitz-cvs] CVS update: movitz/losp/muerte/basic-functions.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	basic-functions.lisp 
Log Message:
Changed exact-throw, the basic operator for dynamic control transfer,
quite a bit. The (ill-specified) primitive-function
dynamic-locate-catch-tag is removed, its essential job is now
performed by the normal function find-catch-tag.

Date: Fri Nov 12 15:51:56 2004
Author: ffjeld

Index: movitz/losp/muerte/basic-functions.lisp
diff -u movitz/losp/muerte/basic-functions.lisp:1.13 movitz/losp/muerte/basic-functions.lisp:1.14
--- movitz/losp/muerte/basic-functions.lisp:1.13	Tue Jul 13 04:26:24 2004
+++ movitz/losp/muerte/basic-functions.lisp	Fri Nov 12 15:51:56 2004
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Tue Sep  4 18:41:57 2001
 ;;;;                
-;;;; $Id: basic-functions.lisp,v 1.13 2004/07/13 02:26:24 ffjeld Exp $
+;;;; $Id: basic-functions.lisp,v 1.14 2004/11/12 14:51:56 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -27,6 +27,26 @@
 
 (defun not (x)
   (not x))
+
+(defun find-catch-tag (catch-tag)
+  "Find the dynamic-env slot that matches the catch-tag, or 0 if unseen."
+  (with-inline-assembly (:returns :eax)
+    (:load-lexical (:lexical-binding catch-tag) :eax)
+    (:locally (:movl (:edi (:edi-offset dynamic-env)) :ecx))
+    (:jecxz 'search-done)
+   search-loop
+    (:cmpl :eax (:ecx 4))		; Does tag match entry?
+    (:jne 'search-next)			; if not, goto next.
+    (:testl 3 (:ecx))			; Is this really a catch entry?
+    (:jz 'search-done)			; if yes, we have found it.
+   search-next
+    (:movl (:ecx 12) :ecx)
+    (:testl :ecx :ecx)
+    (:jnz 'search-loop)
+    ;; Search failed, ECX=0
+   search-done
+    (:movl :ecx :eax)))
+    
 
 (defmacro numargs ()
   `(with-inline-assembly (:returns :ecx)