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

[Frode Vatvedt Fjeld]

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

Modified Files:
	inspect.lisp 
Log Message:
Teach stack-frame-call-site about DIT-frames.

Date: Wed Feb  2 10:12:54 2005
Author: ffjeld

Index: movitz/losp/muerte/inspect.lisp
diff -u movitz/losp/muerte/inspect.lisp:1.46 movitz/losp/muerte/inspect.lisp:1.47
--- movitz/losp/muerte/inspect.lisp:1.46	Tue Jan 25 14:49:51 2005
+++ movitz/losp/muerte/inspect.lisp	Wed Feb  2 10:12:54 2005
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Fri Oct 24 09:50:41 2003
 ;;;;                
-;;;; $Id: inspect.lisp,v 1.46 2005/01/25 13:49:51 ffjeld Exp $
+;;;; $Id: inspect.lisp,v 1.47 2005/02/02 09:12:54 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -70,12 +70,19 @@
   (let ((uplink (stack-frame-uplink stack frame)))
     (when (and uplink (not (= 0 uplink)))
       (let ((funobj (stack-frame-funobj stack uplink)))
-	(when (typep funobj 'function)
+	(cond
+	 ((typep funobj 'function)
 	  (let* ((code-vector (funobj-code-vector funobj))
 		 (eip (stack-frame-ref stack frame 1 :unsigned-byte32))
 		 (delta (- eip 8 (* #.movitz::+movitz-fixnum-factor+ (object-location code-vector)))))
 	    (when (below delta (length code-vector))
-	      (values delta code-vector funobj))))))))
+	      (values delta code-vector funobj))))
+	 ((eq 0 funobj)
+	  (let* ((code-vector (symbol-value 'default-interrupt-trampoline))
+		 (eip (stack-frame-ref stack frame 1 :unsigned-byte32))
+		 (delta (- eip 8 (* #.movitz::+movitz-fixnum-factor+ (object-location code-vector)))))
+	    (when (below delta (length code-vector))
+	      (values delta code-vector funobj)))))))))
 
 (defun stack-frame-ref (stack frame index &optional (type ':lisp))
   "If stack is provided, stack-frame is an index into that stack vector.