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@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.