Mercurial > hg > xemacs-beta

comparison lisp/prim/profile.el @ 207:e45d5e7c476e r20-4b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b2
author cvs
date Mon, 13 Aug 2007 10:03:52 +0200
parents 850242ba4a81
children
comparison
equal deleted inserted replaced
206:d3e9274cbc4e 207:e45d5e7c476e
24 24
25 ;;; Synched up with: Not in FSF. 25 ;;; Synched up with: Not in FSF.
26 26
27 ;;; Commentary: 27 ;;; Commentary:
28 28
29 ;; In addition to Lisp-based `elp', XEmacs contains a set of 29 ;; In addition to Lisp-based `elp', XEmacs provides a set of
30 ;; primitives able to profile evaluation of Lisp functions, created by 30 ;; primitives able to profile evaluation of Lisp functions, created by
31 ;; the illustrious Ben Wing. The functions in this file can be used 31 ;; the illustrious Ben Wing. The functions in this file can be used
32 ;; to gain easy access to the internal profiling functions. 32 ;; to gain easy access to the internal profiling functions.
33 33
34 ;; The profiler works by catching "ticks" (actually SIGPROF signals), 34 ;; The profiler works by catching "ticks" (actually SIGPROF signals),
35 ;; and looking at the current Lisp function, at the time of each tick. 35 ;; and looking at the current Lisp function, at the time of each tick.
36 ;; The output of this process is an alist with keys being the 36 ;; The output of this process is an alist with keys being the
37 ;; functions, and values being the number of ticks per function. From 37 ;; functions, and values being the number of ticks per function. From
38 ;; this, `profiling-results' easily extracts the total number of 38 ;; this, `profiling-results' easily extracts the total number of
39 ;; ticks, and the percentage CPU time of each function. 39 ;; Unless stated otherwise, profiling info is being accumulated
40 40 ;; incrementally through several profile runs (the current info is
41 ;; Unless stated otherwise, profiling info is being accumulated (the 41 ;; always available by `get-profiling-info'). Use
42 ;; current info is returned by `get-profiling-info'). Use
43 ;; `clear-profiling-info' to break the accumulation chain. 42 ;; `clear-profiling-info' to break the accumulation chain.
44 43
45 ;; Caveats (ELP users should read this): 44 ;; Caveats (ELP users should read this):
46 ;; 1) The time reported is function time, rather than 45 ;; 1) The time reported is function time, rather than
47 ;; function+descendants time; 46 ;; function+descendants time;
48 ;; 2) The Time/ms is CPU time (user+kernel), not the real time; 47 ;; 2) Each tick is equivalent to 1ms (which can be changed), but this
48 ;; is CPU time (user+kernel), not the real time;
49 ;; 3) Only the actuall funcalls are profiled. If a subr Ffoo calls 49 ;; 3) Only the actuall funcalls are profiled. If a subr Ffoo calls
50 ;; Fbar using Fbar (), only Ffoo will appear in the profile. 50 ;; Fbar using Fbar (), only Ffoo will appear in the profile.
51 51
52 ;; A typical profiling session consists of using `clear-profiling-info' 52 ;; A typical profiling session consists of using `clear-profiling-info'
53 ;; followed by `profile' or `profile-key-sequence', followed by 53 ;; followed by `profile' or `profile-key-sequence', followed by
57 ;; buffer, go to the group buffer, and press `M-x clear-profiling-info' 57 ;; buffer, go to the group buffer, and press `M-x clear-profiling-info'
58 ;; followed by `M-x profile-key-sequence RET SPC'. 58 ;; followed by `M-x profile-key-sequence RET SPC'.
59 59
60 60
61 ;;; Code: 61 ;;; Code:
62
63 (defun profile-align (form width)
64 ;; Bletch! this is what (format "%-*s" width form) should do.
65 (let ((printed-form (format "%s" form)))
66 (concat printed-form
67 (make-string (max 0 (- width (length printed-form))) ?\ ))))
68 62
69 ;;;###autoload 63 ;;;###autoload
70 (defun profile-results (&optional info stream) 64 (defun profile-results (&optional info stream)
71 "Print profiling info INFO to STREAM in a pretty format. 65 "Print profiling info INFO to STREAM in a pretty format.
72 If INFO is omitted, the current profiling info is retrieved using 66 If INFO is omitted, the current profiling info is retrieved using
86 (current-buffer) 80 (current-buffer)
87 standard-output))) 81 standard-output)))
88 ;; Calculate the longest function 82 ;; Calculate the longest function
89 (maxfunlen (apply #'max 83 (maxfunlen (apply #'max
90 (length "Function Name") 84 (length "Function Name")
91 (mapcar (lambda (el) 85 (mapcar
92 ;; Functions longer than 40 86 (lambda (el)
93 ;; characters don't qualify 87 ;; Functions longer than 50 characters (usually
94 (let ((l (length (format "%s" (car el))))) 88 ;; anonymous functions) don't qualify
95 (if (< l 40) 89 (let ((l (length (format "%s" (car el)))))
96 l 0))) 90 (if (< l 50)
97 info)))) 91 l 0)))
98 (princ (format "%s Ticks %%/Total\n" 92 info))))
99 (profile-align "Function Name" maxfunlen))) 93 (princ (format "%-*s Ticks %%/Total\n" maxfunlen "Function Name"))
100 (princ (make-string maxfunlen ?=)) 94 (princ (make-string maxfunlen ?=))
101 (princ " ===== =======\n") 95 (princ " ===== =======\n")
102 (let ((sum (float (apply #'+ (mapcar #'cdr info))))) 96 (let ((sum (float (apply #'+ (mapcar #'cdr info)))))
103 (dolist (entry (nreverse (sort info #'cdr-less-than-cdr))) 97 (dolist (entry (nreverse (sort info #'cdr-less-than-cdr)))
104 (princ (format "%s %-5d %-6.3f\n" 98 (princ (format "%-*s %-5d %-6.3f\n"
105 (profile-align (car entry) maxfunlen) 99 maxfunlen (car entry) (cdr entry)
106 (cdr entry) (* 100 (/ (cdr entry) sum))))) 100 (* 100 (/ (cdr entry) sum)))))
107 (princ (make-string maxfunlen ?-)) 101 (princ (make-string maxfunlen ?-))
108 (princ "--------------------\n") 102 (princ "--------------------\n")
109 (princ (format "%s %-5d %-6.2f\n" 103 (princ (format "%-*s %-5d %-6.2f\n" maxfunlen "Total" sum 100.0))
110 (profile-align "Total" maxfunlen) sum 100.0))
111 (princ (format "\n\nOne tick = %g ms\n" 104 (princ (format "\n\nOne tick = %g ms\n"
112 (/ default-profiling-interval 1000.0))))) 105 (/ default-profiling-interval 1000.0)))))
113 (when (and (not stream) 106 (when (and (not stream)
114 (interactive-p)) 107 (interactive-p))
115 (goto-char (point-min)))) 108 (goto-char (point-min))))