diff options
| author | Richard M. Stallman | 1996-06-28 07:32:38 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1996-06-28 07:32:38 +0000 |
| commit | 37ae4d5c39d84a696ab19c149e326a624651b99c (patch) | |
| tree | 82afb0e3f03a85832909785f1e31694ce8e8ebb7 | |
| parent | 74d6e31c969884662ba7421169d8b5d025dac02d (diff) | |
| download | emacs-37ae4d5c39d84a696ab19c149e326a624651b99c.tar.gz emacs-37ae4d5c39d84a696ab19c149e326a624651b99c.zip | |
(profile-functions): No need to assume that the
current buffer is writable.
(profile-print, profile-results): Changed to display number of
calls and average time per call.
(profile-update-function): Update the number of calls.
(profile-a-function): Init the number of calls.
| -rw-r--r-- | lisp/emacs-lisp/profile.el | 69 |
1 files changed, 36 insertions, 33 deletions
diff --git a/lisp/emacs-lisp/profile.el b/lisp/emacs-lisp/profile.el index 272833dbd2c..224e5527602 100644 --- a/lisp/emacs-lisp/profile.el +++ b/lisp/emacs-lisp/profile.el | |||
| @@ -83,7 +83,7 @@ | |||
| 83 | 83 | ||
| 84 | (defvar profile-timer-process nil "Process running the timer.") | 84 | (defvar profile-timer-process nil "Process running the timer.") |
| 85 | (defvar profile-time-list nil | 85 | (defvar profile-time-list nil |
| 86 | "List of accumulative time for each profiled function.") | 86 | "List of cumulative calls and time for each profiled function.") |
| 87 | (defvar profile-init-list nil | 87 | (defvar profile-init-list nil |
| 88 | "List of entry time for each function. \n\ | 88 | "List of entry time for each function. \n\ |
| 89 | Both how many times invoked and real time of start.") | 89 | Both how many times invoked and real time of start.") |
| @@ -99,7 +99,7 @@ Both how many times invoked and real time of start.") | |||
| 99 | (defun profile-functions (&optional flist) | 99 | (defun profile-functions (&optional flist) |
| 100 | "Profile all the functions listed in `profile-functions-list'.\n\ | 100 | "Profile all the functions listed in `profile-functions-list'.\n\ |
| 101 | With argument FLIST, use the list FLIST instead." | 101 | With argument FLIST, use the list FLIST instead." |
| 102 | (interactive "*P") | 102 | (interactive "P") |
| 103 | (if (null flist) (setq flist profile-functions-list)) | 103 | (if (null flist) (setq flist profile-functions-list)) |
| 104 | (mapcar 'profile-a-function flist)) | 104 | (mapcar 'profile-a-function flist)) |
| 105 | 105 | ||
| @@ -115,34 +115,33 @@ With argument FLIST, use the list FLIST instead." | |||
| 115 | 115 | ||
| 116 | (defun profile-print (entry) | 116 | (defun profile-print (entry) |
| 117 | "Print one ENTRY (from `profile-time-list')." | 117 | "Print one ENTRY (from `profile-time-list')." |
| 118 | (let ((time (cdr entry)) str (offset 5)) | 118 | (let* ((calls (car (cdr entry))) |
| 119 | (insert (format "%s" (car entry)) space) | 119 | (timec (cdr (cdr entry))) |
| 120 | (move-to-column ref-column) | 120 | (time (+ (car timec) (/ (cdr timec) (float profile-million)))) |
| 121 | (setq str (int-to-string (car time))) | 121 | (avgtime 0.0)) |
| 122 | (insert str) | 122 | (insert (format (concat "%-" |
| 123 | (if (>= (length str) offset) nil | 123 | (int-to-string profile-max-fun-name) |
| 124 | (move-to-column ref-column) | 124 | "s%8d%11d.%06d") |
| 125 | (insert (substring spaces 0 (- offset (length str)))) | 125 | (car entry) calls (car timec) (cdr timec)) |
| 126 | (forward-char (length str))) | 126 | (if (zerop calls) |
| 127 | (setq str (int-to-string (cdr time))) | 127 | "\n" |
| 128 | (insert "." (substring "000000" 0 (- 6 (length str))) str "\n"))) | 128 | (format "%12d.%06d\n" |
| 129 | 129 | (truncate (setq avgtime (/ time calls))) | |
| 130 | (defconst spaces " ") | 130 | (truncate (* (- avgtime (ftruncate avgtime)) |
| 131 | profile-million)))) | ||
| 132 | ))) | ||
| 131 | 133 | ||
| 132 | (defun profile-results () | 134 | (defun profile-results () |
| 133 | "Display profiling results in the buffer `*profile*'. | 135 | "Display profiling results in the buffer `*profile*'. |
| 134 | \(The buffer name comes from `profile-buffer'.)" | 136 | \(The buffer name comes from `profile-buffer'.)" |
| 135 | (interactive) | 137 | (interactive) |
| 136 | (let* ((ref-column (+ 8 profile-max-fun-name)) | 138 | (switch-to-buffer profile-buffer) |
| 137 | (space (substring spaces 0 ref-column))) | 139 | (erase-buffer) |
| 138 | (switch-to-buffer profile-buffer) | 140 | (insert "Function" (make-string (- profile-max-fun-name 6) ? )) |
| 139 | (erase-buffer) | 141 | (insert " Calls Total time (sec) Avg time per call\n") |
| 140 | (insert "Function" space) | 142 | (insert (make-string profile-max-fun-name ?=) " ") |
| 141 | (move-to-column ref-column) | 143 | (insert "====== ================ =================\n") |
| 142 | (insert "Time (Seconds.Useconds)\n" "========" space ) | 144 | (mapcar 'profile-print profile-time-list)) |
| 143 | (move-to-column ref-column) | ||
| 144 | (insert "=======================\n") | ||
| 145 | (mapcar 'profile-print profile-time-list))) | ||
| 146 | 145 | ||
| 147 | (defun profile-reset-timer () | 146 | (defun profile-reset-timer () |
| 148 | (process-send-string profile-timer-process "z\n")) | 147 | (process-send-string profile-timer-process "z\n")) |
| @@ -197,12 +196,16 @@ With argument FLIST, use the list FLIST instead." | |||
| 197 | ;; assumes that profile-time contains the current time | 196 | ;; assumes that profile-time contains the current time |
| 198 | (let ((init-time (profile-find-function fun profile-init-list)) | 197 | (let ((init-time (profile-find-function fun profile-init-list)) |
| 199 | (accum (profile-find-function fun profile-time-list)) | 198 | (accum (profile-find-function fun profile-time-list)) |
| 200 | sec usec) | 199 | calls time sec usec) |
| 201 | (if (or (null init-time) | 200 | (if (or (null init-time) |
| 202 | (null accum)) (error "Function %s missing from list" fun)) | 201 | (null accum)) (error "Function %s missing from list" fun)) |
| 202 | (setq calls (car accum)) | ||
| 203 | (setq time (cdr accum)) | ||
| 203 | (setcar init-time (1- (car init-time))) ; pop one level in recursion | 204 | (setcar init-time (1- (car init-time))) ; pop one level in recursion |
| 204 | (if (not (zerop (car init-time))) | 205 | (if (not (zerop (car init-time))) |
| 205 | nil ; in some recursion level, do not update accum. time | 206 | nil ; in some recursion level, |
| 207 | ; do not update cumulated time | ||
| 208 | (setcar accum (1+ calls)) | ||
| 206 | (setq init-time (cdr init-time)) | 209 | (setq init-time (cdr init-time)) |
| 207 | (setq sec (- (car profile-time) (car init-time)) | 210 | (setq sec (- (car profile-time) (car init-time)) |
| 208 | usec (- (cdr profile-time) (cdr init-time))) | 211 | usec (- (cdr profile-time) (cdr init-time))) |
| @@ -211,11 +214,11 @@ With argument FLIST, use the list FLIST instead." | |||
| 211 | (if (>= usec 0) nil | 214 | (if (>= usec 0) nil |
| 212 | (setq usec (+ usec profile-million)) | 215 | (setq usec (+ usec profile-million)) |
| 213 | (setq sec (1- sec))) | 216 | (setq sec (1- sec))) |
| 214 | (setcar accum (+ sec (car accum))) | 217 | (setcar time (+ sec (car time))) |
| 215 | (setcdr accum (+ usec (cdr accum))) | 218 | (setcdr time (+ usec (cdr time))) |
| 216 | (if (< (cdr accum) profile-million) nil | 219 | (if (< (cdr time) profile-million) nil |
| 217 | (setcar accum (1+ (car accum))) | 220 | (setcar time (1+ (car time))) |
| 218 | (setcdr accum (- (cdr accum) profile-million))) | 221 | (setcdr time (- (cdr time) profile-million))) |
| 219 | ))) | 222 | ))) |
| 220 | 223 | ||
| 221 | (defun profile-convert-byte-code (function) | 224 | (defun profile-convert-byte-code (function) |
| @@ -243,7 +246,7 @@ With argument FLIST, use the list FLIST instead." | |||
| 243 | (if (eq (car def) 'lambda) nil | 246 | (if (eq (car def) 'lambda) nil |
| 244 | (error "To profile: %s must be a user-defined function" fun)) | 247 | (error "To profile: %s must be a user-defined function" fun)) |
| 245 | (setq profile-time-list ; add a new entry | 248 | (setq profile-time-list ; add a new entry |
| 246 | (cons (cons fun (cons 0 0)) profile-time-list)) | 249 | (cons (cons fun (cons 0 (cons 0 0))) profile-time-list)) |
| 247 | (setq profile-init-list ; add a new entry | 250 | (setq profile-init-list ; add a new entry |
| 248 | (cons (cons fun (cons 0 (cons 0 0))) profile-init-list)) | 251 | (cons (cons fun (cons 0 (cons 0 0))) profile-init-list)) |
| 249 | (if (< profile-max-fun-name funlen) (setq profile-max-fun-name funlen)) | 252 | (if (< profile-max-fun-name funlen) (setq profile-max-fun-name funlen)) |