From dfd78c5b087dd3319a66405a43e3beb382191f13 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Tue, 2 Mar 1993 15:53:52 +0000 Subject: [PATCH] Improved usefulness of CODE-BREAKDOWN :HOW :FILE by subdividing the files by package. --- code/room.lisp | 69 ++++++++++++++++++++++++++++++++------------------ 1 file changed, 44 insertions(+), 25 deletions(-) diff --git a/code/room.lisp b/code/room.lisp index 7125ebf13..d2f9b5f4c 100644 --- a/code/room.lisp +++ b/code/room.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/room.lisp,v 1.20 1993/02/27 01:11:28 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/room.lisp,v 1.21 1993/03/02 15:53:52 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -756,37 +756,56 @@ (defun code-breakdown (space &key (how :package)) (declare (type spaces space) (type (member :file :package) how)) - (let ((info (make-hash-table :test (if (eq how :package) #'equal #'eq)))) + (let ((packages (make-hash-table :test #'equal))) (map-allocated-objects #'(lambda (obj type size) (when (eql type code-header-type) (let* ((dinfo (%code-debug-info obj)) - (name (if dinfo - (ecase how - (:package (c::compiled-debug-info-package dinfo)) - (:file - (let ((source - (first (c::compiled-debug-info-source - dinfo)))) - (if (eq (c::debug-source-from source) - :file) - (c::debug-source-name source) - "FROM LISP")))) + (package (if dinfo + (c::compiled-debug-info-package dinfo) + "UNKNOWN")) + (pkg-info (or (gethash package packages) + (setf (gethash package packages) + (make-hash-table :test #'equal)))) + (file (if dinfo + (let ((source + (first (c::compiled-debug-info-source + dinfo)))) + (if (eq (c::debug-source-from source) + :file) + (c::debug-source-name source) + "FROM LISP")) "UNKNOWN")) - (found (or (gethash name info) - (setf (gethash name info) (cons 0 0))))) - (incf (car found)) - (incf (cdr found) size)))) + (file-info (or (gethash file pkg-info) + (setf (gethash file pkg-info) + (cons 0 0))))) + (incf (car file-info)) + (incf (cdr file-info) size)))) space) - (collect ((res)) - (maphash #'(lambda (k v) - (res (list v k))) - info) - (loop for ((count . size) name) in (sort (res) #'> :key #'cdar) do - (format t "~40@A: ~:D bytes, ~:D object~:P.~%" - (subseq name (max (- (length name) 40) 0)) - size count)))) + (let ((res ())) + (do-hash (pkg pkg-info packages) + (let ((pkg-res ()) + (pkg-count 0) + (pkg-size 0)) + (do-hash (file file-info pkg-info) + (incf pkg-count (car file-info)) + (incf pkg-size (cdr file-info)) + (push (list file file-info) pkg-res)) + (push (cons pkg-count pkg-size) pkg-res) + (push pkg pkg-res) + (push pkg-res res))) + + (loop for (pkg (pkg-count . pkg-size) . files) in + (sort res #'> :key #'(lambda (x) (cdr (second x)))) do + (format t "~%Package ~A: ~32T~9:D bytes, ~9:D object~:P.~%" + pkg pkg-size pkg-count) + (when (eq how :file) + (loop for (file (file-count . file-size)) in + (sort files #'> :key #'(lambda (x) (cdr (second x)))) do + (format t "~30@A: ~9:D bytes, ~9:D object~:P.~%" + (file-namestring file) file-size file-count)))))) + (values)) -- GitLab