From 05b7fa51f3566702fdf9ee30d04731419468a0d9 Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Thu, 21 May 1992 22:48:47 +0000 Subject: [PATCH] Added :non-local-entry code location kind, and changed dump-block-locations to skip emitting the :block-start location if the first location in the block is a :non-local-entry. Also, allow code locations to be emitted at raw (index) positions instead of always requiring that a label be created. --- compiler/debug-dump.lisp | 29 +++++++++++++++++------------ 1 file changed, 17 insertions(+), 12 deletions(-) diff --git a/compiler/debug-dump.lisp b/compiler/debug-dump.lisp index 3ee15b270..26b89dd93 100644 --- a/compiler/debug-dump.lisp +++ b/compiler/debug-dump.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/debug-dump.lisp,v 1.27 1991/12/14 18:16:16 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/debug-dump.lisp,v 1.28 1992/05/21 22:48:47 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -26,7 +26,7 @@ (deftype location-kind () '(member :unknown-return :known-return :internal-error :non-local-exit - :block-start :call-site :single-value-return)) + :block-start :call-site :single-value-return :non-local-entry)) ;;; The Location-Info structure holds the information what we need about @@ -39,7 +39,7 @@ (kind nil :type location-kind) ;; ;; The label pointing to the interesting code location. - (label nil :type label) + (label nil :type (or label index)) ;; ;; The VOP that emitted this location (for node, save-set, ir2-block, etc.) (vop nil :type vop)) @@ -52,7 +52,8 @@ ;;; thus want debug info. ;;; (defun note-debug-location (vop label kind) - (declare (type vop vop) (type label label) (type location-kind kind)) + (declare (type vop vop) (type (or label index) label) + (type location-kind kind)) (setf (ir2-block-locations (vop-block vop)) (nconc (ir2-block-locations (vop-block vop)) (list (make-location-info kind label vop)))) @@ -193,14 +194,18 @@ ;;; (defun dump-block-locations (block locations tlf-num var-locs) (declare (type cblock block) (list locations)) - (write-var-integer (1+ (length locations)) *byte-buffer*) - (let ((2block (block-info block))) - (dump-1-location (continuation-next (block-start block)) - 2block :block-start tlf-num - (ir2-block-%label 2block) - (ir2-block-live-out 2block) - var-locs - nil)) + (if (and locations + (eq (location-kind (first locations)) + :non-local-entry)) + (write-var-integer (length locations) *byte-buffer*) + (let ((2block (block-info block))) + (write-var-integer (+ (length locations) 1) *byte-buffer*) + (dump-1-location (continuation-next (block-start block)) + 2block :block-start tlf-num + (ir2-block-%label 2block) + (ir2-block-live-out 2block) + var-locs + nil))) (dolist (loc locations) (dump-location-from-info loc tlf-num var-locs)) (undefined-value)) -- GitLab