From de2d816c0a71e6027a0a6c8c8472087d1095bed2 Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Mon, 22 Jun 1992 13:51:30 +0000 Subject: [PATCH] Added CODE-LOCATION-KIND. --- code/debug-int.lisp | 29 ++++++++++++++++++++++++++--- 1 file changed, 26 insertions(+), 3 deletions(-) diff --git a/code/debug-int.lisp b/code/debug-int.lisp index 59fd9a3ee..244b4f1b8 100644 --- a/code/debug-int.lisp +++ b/code/debug-int.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.49 1992/06/22 11:17:39 hallgren Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.50 1992/06/22 13:51:30 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -52,8 +52,8 @@ code-location-debug-function code-location-debug-block code-location-top-level-form-offset code-location-form-number - code-location-debug-source code-location code-location-p - code-location-unknown-p code-location= + code-location-debug-source code-location-kind + code-location code-location-p code-location-unknown-p code-location= debug-source-from debug-source-name debug-source-created debug-source-compiled debug-source-root-number @@ -2222,6 +2222,29 @@ (interpreted-code-location-ir1-node code-location))))))) (t form-num)))) +;;; CODE-LOCATION-KIND -- Public +;;; +(defun code-location-kind (code-location) + "Return the kind of CODE-LOCATION, one of: + :interpreted, :unknown-return, :known-return, :internal-error, + :non-local-exit, :block-start, :call-site, :single-value-return, + :non-local-entry" + (when (code-location-unknown-p code-location) + (error 'unknown-code-location :code-location code-location)) + (etypecase code-location + (compiled-code-location + (let ((kind (compiled-code-location-kind code-location))) + (cond ((not (eq kind :unparsed)) kind) + ((not (fill-in-code-location code-location)) + ;; This check should be unnecessary. We're missing + ;; debug info the compiler should have dumped. + (error "Unknown code location? It should be known.")) + (t + (compiled-code-location-kind code-location))))) + (interpreted-code-location + :interpreted))) + + ;;; COMPILED-CODE-LOCATION-LIVE-SET -- Internal. ;;; ;;; This returns the code-location's live-set if it is available. If there -- GitLab