From 20efae3e935ecdaeb736e6a23a504079954d6242 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Fri, 6 Aug 1993 13:10:12 +0000 Subject: [PATCH] Export dyncount-info type & predicate. Move reporting stuff to code/cprofile. --- compiler/dyncount.lisp | 159 ++--------------------------------------- 1 file changed, 4 insertions(+), 155 deletions(-) diff --git a/compiler/dyncount.lisp b/compiler/dyncount.lisp index e55465308..299e432c5 100644 --- a/compiler/dyncount.lisp +++ b/compiler/dyncount.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/dyncount.lisp,v 1.8 1993/08/04 15:54:15 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dyncount.lisp,v 1.9 1993/08/06 13:10:12 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -15,11 +15,9 @@ ;;; (in-package "C") -(export '(*collect-dynamic-statistics* dyncount-info-counts - dyncount-info-costs)) - -(export '(count-me)) - +(export '(*collect-dynamic-statistics* + dyncount-info-counts dyncount-info-costs dyncount-info + dyncount-info-p count-me)) (defvar *collect-dynamic-statistics* nil "When T, emit extra code to collect dynamic statistics about vop usages.") @@ -35,156 +33,7 @@ (costs (required-argument) :type (simple-array (unsigned-byte 32) (*))) (counts (required-argument) :type (simple-array (unsigned-byte 32) (*)))) - (defprinter dyncount-info for costs counts) - -;;; FIND-INFO-FOR -- Interface -;;; -;;; Return the DYNCOUNT-INFO for FUNCTION. -;;; -(defun find-info-for (function) - (declare (type function function)) - (let* ((function (%closure-function function)) - (component (di::function-code-header function))) - (do ((end (get-header-data component)) - (i vm:code-constants-offset (1+ i))) - ((= end i)) - (let ((constant (code-header-ref component i))) - (when (dyncount-info-p constant) - (return constant)))))) - -;; -(defun clear-dyncount-info (info) - (declare (type dyncount-info info)) - (declare (optimize (speed 3) (safety 0))) - (let ((counts (dyncount-info-counts info))) - (dotimes (i (length counts)) - (setf (aref counts i) 0)))) - -;; -(defun dyncount-total-cost (info) - (let ((costs (dyncount-info-costs info)) - (counts (dyncount-info-counts info)) - (sum 0)) - (dotimes (i (length costs)) - (incf sum (* (aref costs i) (aref counts i)))) - sum)) - -;;; FUNCTION-CYCLES -- External. -;;; -;;; When passed a function FUNCTION-CYCLES returns the number of cycles the -;;; function has executed. :clear t clears the costs. -;;; -(defun function-cycles (function &key (clear nil) (verbose nil)) - (let ((info (find-info-for function))) - (when info - (when verbose - (let* ((object (di::compiled-debug-function-component - (di::function-debug-function function))) - (map (di::get-debug-info-function-map - (kernel:code-header-ref object 3))) - (i 0)) - (map 'list - #'(lambda (e) - (when (compiled-debug-function-p e) - (di:do-debug-function-blocks - (ee (di::make-compiled-debug-function e object)) - (let ((cl (di::compiled-debug-block-code-locations ee))) - (cond ((di:debug-block-elsewhere-p ee) - #+nil (format t "Elsewhere~&")) - (t - (format t "Kind: ~S, Cost: ~S~&" - (compiled-debug-function-kind e) - (* (aref (dyncount-info-costs info) i) - (aref (dyncount-info-counts info) i))) - (incf i) - (debug::print-code-location-source-form - (svref cl 0) 0) - (format t "~&"))))))) - map))) - (format t "~S~&" (dyncount-total-cost info)) - (when clear - (clear-dyncount-info info))))) - -;;; GET-SPACE-LIST -- Internal. -;;; -;;; -(defun get-space-list (spaces clear) - (locally - (declare (optimize (speed 3) (safety 0)) - (inline vm::map-allocated-objects)) - (without-gcing - (let ((list nil)) - (dolist (space spaces) - (vm::map-allocated-objects - #'(lambda (object type-code size) - (declare (ignore type-code size)) - (when (kernel:code-component-p object) - (let ((info (kernel:code-header-ref object 5)) - (j 0) - (sum 0) - (alist)) - (declare (fixnum j)) - (when (dyncount-info-p info) - (let* ((debug-info (kernel:code-header-ref object 3)) - (map (di::get-debug-info-function-map debug-info))) - (declare (vector map)) - (dotimes (i (length map)) - (declare (fixnum i)) - (let ((e (svref map i))) - (when (compiled-debug-function-p e) - (let ((fn (di::make-compiled-debug-function - e object))) - (di:do-debug-function-blocks (blk fn) - (unless (di:debug-block-elsewhere-p blk) - (incf sum - (* (aref (dyncount-info-costs info) j) - (aref (dyncount-info-counts info) j))) - (incf j))) - (let ((a (find (di:debug-function-name fn) - alist :key #'car))) - (cond (a (incf (third a) sum)) - (t - (push (list (di:debug-function-name fn) - (compiled-debug-info-package - debug-info) - sum) - alist))) - (setf sum 0))))))) - (when clear - (clear-dyncount-info info))) - (dolist (e alist) - (push e list))))) - space)) - list)))) - -;;; GET-STATS -- External. -;;; -;;; Returns the cycles of all the functions in the spaces. -;;; -(defun get-stats (&key (spaces '(:dynamic)) (clear nil) (top-n 10) (cost 0)) - (let ((list (stable-sort (sort (get-space-list spaces clear) - #'> :key #'third) #'string< :key #'second)) - (package-name "") - (i 0) - (other 0)) - (dolist (e list) - (unless (string= package-name (second e)) - (setf package-name (second e)) - (when (> other cost) - (format t " ~10:D: Other~&" other)) - (setf i 0) - (setf other 0) - (when (> (third e) cost) - (format t "Package: ~A~&" package-name))) - (cond ((< i top-n) - (when (> (third e) cost) - (format t " ~10:D: ~S~&" (third e) (first e)))) - (t - (incf other (third e)))) - (incf i)) - (when (> other cost) - (format t " ~10:D: Other~&" other)))) -- GitLab