From 1b6691e8535c63c8905d3a887bb702fea0ae26ee Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Wed, 13 Oct 2004 15:47:17 +0000 Subject: [PATCH] Apply Helmut Eller's patch (cmucl-imp, 2004/10/05) to make backtrace through assembly functions a bit smarter. DEBUG-FUNCTION-FROM-PC modified so that it recognizes assembly routines and simply returns a BOGUS-DEBUG-FUNCTION in that case. --- code/debug-int.lisp | 50 +++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 46 insertions(+), 4 deletions(-) diff --git a/code/debug-int.lisp b/code/debug-int.lisp index ecdedcc4f..43e9e4051 100644 --- a/code/debug-int.lisp +++ b/code/debug-int.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.114 2004/10/13 13:50:16 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.115 2004/10/13 15:47:17 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1204,6 +1204,34 @@ (declare (ignore ra)) "Foreign function call land") +(defun assembly-routines-p (component) + "Return t if COMPONENT contains code from assembly routines." + (let ((start (sap-int (kernel:code-instructions component)))) + (maphash (lambda (_ addr) + (declare (ignore _)) + (when (= addr start) + (return-from assembly-routines-p t))) + lisp::*assembler-routines*))) + +(defun find-assembly-routine-name (component pc) + "Return the name of the assembly routine at offset PC in COMPONENT. +The result is a symbol or nil if the routine cannot be found." + (let* ((start (sap-int (kernel:code-instructions component))) + (end (+ start (* (kernel::%code-code-size component) + vm:word-bytes))) + (routines `((#:end . ,end)))) + ;; collect the assembly routines in the component + (maphash (lambda (name addr) + (when (<= start addr end) + (push (cons name addr) routines))) + lisp::*assembler-routines*) + ;; sort them and return the name for the routine at PC + (let ((routines (sort routines #'< :key #'cdr)) + (addr (+ start pc))) + (loop for ((r1 . addr1) (r2 . addr2)) on routines + while r2 + when (<= addr1 addr addr2) return r1)))) + ;;; COMPUTE-CALLING-FRAME -- Internal. ;;; ;;; This returns a frame for the one existing in time immediately prior to the @@ -1259,7 +1287,12 @@ (make-bogus-debug-function "Bogus stack frame")) (t - (debug-function-from-pc code pc-offset))))) + (handler-case + (debug-function-from-pc code pc-offset) + (no-debug-info () + (make-bogus-debug-function + (format nil "no debug info: ~A:~A" + code pc-offset)))))))) (make-compiled-frame caller up-frame d-fun (code-location-from-pc d-fun pc-offset escaped) @@ -1310,7 +1343,12 @@ (make-bogus-debug-function "Bogus stack frame")) (t - (debug-function-from-pc code pc-offset))))) + (handler-case + (debug-function-from-pc code pc-offset) + (no-debug-info () + (make-bogus-debug-function + (format nil "no debug info: ~A:~A" + code pc-offset)))))))) (make-compiled-frame caller up-frame d-fun (code-location-from-pc d-fun pc-offset escaped) @@ -1665,7 +1703,11 @@ (let ((info (kernel:%code-debug-info component))) (cond ((not info) - (debug-signal 'no-debug-info)) + (cond ((assembly-routines-p component) + (make-bogus-debug-function + (format nil "assembly routine: ~S" + (find-assembly-routine-name component pc)))) + (t (debug-signal 'no-debug-info)))) ((eq info :bogus-lra) (make-bogus-debug-function "Function End Breakpoint")) (t -- GitLab