From 90ddb7f5b243c602bae38e3d278d4a1f49981274 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Thu, 25 Apr 2024 02:06:24 +0300 Subject: [PATCH] debug-dump: name COMPILED-DEBUG-INFO by its first entry. No "DEFUN FUN", more chances for debug-funs to reuse the name. --- src/compiler/debug-dump.lisp | 31 +++++++++++++++---------------- src/compiler/dfo.lisp | 4 +--- 2 files changed, 16 insertions(+), 19 deletions(-) diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp index c8617850f..997af521f 100644 --- a/src/compiler/debug-dump.lisp +++ b/src/compiler/debug-dump.lisp @@ -981,29 +981,28 @@ (*contexts* (make-array 10 :fill-pointer 0 :adjustable t)) - (name (let* ((2comp (component-info component)) - (entries (ir2-component-entries 2comp))) - ;; COMPONENT-NAME is often not useful, and sometimes completely fubar. - ;; Function names, on the other hand, are seldom unhelpful, - ;; so if there's only one function, pick that as the component name. - ;; Otherwise preserve whatever crummy name was already assigned. - (or (and (not (cdr entries)) - (entry-info-name (car entries))) - (component-name component)))) + (lambdas (sort (copy-list (component-lambdas component)) + #'< + :key (lambda (lambda) + (label-position (block-label (lambda-block lambda)))))) + (name (loop for lambda in lambdas + for entry = (leaf-info lambda) + when entry + return + (entry-info-name entry))) (*debug-component-name* name)) (declare (special *debug-component-name*)) - (dolist (lambda (component-lambdas component)) + (dolist (lambda lambdas) (unless (empty-fun-p lambda) (clrhash var-locs) (push (cons (label-position (block-label (lambda-block lambda))) (compute-1-debug-fun lambda var-locs)) dfuns))) - (let ((sorted (sort dfuns #'< :key #'car))) - (make-compiled-debug-info - :name name - :package *package* - :fun-map (compute-packed-debug-funs sorted) - :contexts (compact-vector *contexts*))))) + (make-compiled-debug-info + :name name + :package *package* + :fun-map (compute-packed-debug-funs (nreverse dfuns)) + :contexts (compact-vector *contexts*)))) ;;; Write BITS out to BYTE-BUFFER in backend byte order. The length of ;;; BITS must be evenly divisible by eight. diff --git a/src/compiler/dfo.lisp b/src/compiler/dfo.lisp index 089238f86..dbe318a46 100644 --- a/src/compiler/dfo.lisp +++ b/src/compiler/dfo.lisp @@ -377,9 +377,7 @@ (non-top component)) ((or (some #'has-xep-or-nlx funs) (and has-top (rest funs))) - (setf (component-name component) - (possibly-base-stringize - (find-component-name component))) + (setf (component-name component) (find-component-name component)) (non-top component) (when has-top (setf (component-kind component) :complex-toplevel))) -- 2.11.4.GIT