1;;; profile.el --- Emacs profiler (OBSOLETE; use elp.el instead) 2 3;; Copyright (C) 1992, 1994, 1998, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Boaz Ben-Zvi <boaz@lcs.mit.edu> 7;; Created: 07 Feb 1992 8;; Version: 1.0 9;; Adapted-By: ESR 10;; Keywords: lisp, tools 11 12;; This file is part of GNU Emacs. 13 14;; GNU Emacs is free software; you can redistribute it and/or modify 15;; it under the terms of the GNU General Public License as published by 16;; the Free Software Foundation; either version 2, or (at your option) 17;; any later version. 18 19;; GNU Emacs is distributed in the hope that it will be useful, 20;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 22;; GNU General Public License for more details. 23 24;; You should have received a copy of the GNU General Public License 25;; along with GNU Emacs; see the file COPYING. If not, write to the 26;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 27;; Boston, MA 02110-1301, USA. 28 29;;; Commentary: 30 31;; DESCRIPTION: 32;; ------------ 33;; This program can be used to monitor running time performance of Emacs Lisp 34;; functions. It takes a list of functions and report the real time spent 35;; inside these functions. (Actually, for each function it reports the amount 36;; of time spent while at least one instance of that function is on the call 37;; stack. So if profiled function FOO calls profiled function BAR, the time 38;; spent inside BAR is credited to both functions.) 39 40;; HOW TO USE: 41;; ----------- 42;; Set the variable profile-functions-list to the list of functions 43;; (as symbols) You want to profile. Call M-x profile-functions to set 44;; this list on and start using your program. Note that profile-functions 45;; MUST be called AFTER all the functions in profile-functions-list have 46;; been loaded !! (This call modifies the code of the profiled functions. 47;; Hence if you reload these functions, you need to call profile-functions 48;; again! ). 49;; To display the results do M-x profile-results . For example: 50;;------------------------------------------------------------------- 51;; (setq profile-functions-list '(sokoban-set-mode-line sokoban-load-game 52;; sokoban-move-vertical sokoban-move)) 53;; (load "sokoban") 54;; M-x profile-functions 55;; ... I play the sokoban game .......... 56;; M-x profile-results 57;; 58;; Function Time (Seconds.Useconds) 59;; ======== ======================= 60;; sokoban-move 0.539088 61;; sokoban-move-vertical 0.410130 62;; sokoban-load-game 0.453235 63;; sokoban-set-mode-line 1.949203 64;;----------------------------------------------------- 65;; To clear all the settings to profile use profile-finish. 66;; To set one function at a time (instead of or in addition to setting the 67;; above list and M-x profile-functions) use M-x profile-a-function. 68 69;;; Code: 70 71;;; 72;;; User modifiable VARIABLES 73;;; 74 75(defvar profile-functions-list nil "*List of functions to profile.") 76(defvar profile-buffer "*profile*" 77 "Name of profile buffer.") 78(defvar profile-distinct nil 79 "If non-nil, each time slice gets credited to at most one function. 80\(Namely, the most recent one in the call stack.) If nil, then the 81time reported for a function includes the entire time from beginning 82to end, even if it called some other function that was also profiled.") 83 84;;; 85;;; V A R I A B L E S 86;;; 87 88(defvar profile-time-list nil 89 "List of cumulative calls and time for each profiled function. 90Each element looks like (FUN NCALLS SEC . USEC).") 91(defvar profile-init-list nil 92 "List of entry time for each function. 93Both how many times invoked and real time of start. 94Each element looks like (FUN DEPTH HISEC LOSEC USEC), where DEPTH is 95the current recursion depth, and HISEC, LOSEC, and USEC represent the 96starting time of the call (or of the outermost recursion).") 97(defvar profile-max-fun-name 0 98 "Max length of name of any function profiled.") 99(defvar profile-call-stack nil 100 "A list of the profiled functions currently executing. 101Used only when profile-distinct is non-nil.") 102(defvar profile-last-time nil 103 "The start time of the current time slice. 104Used only when profile-distinct is non-nil.") 105 106(defconst profile-million 1000000) 107 108;;; 109;;; F U N C T I O N S 110;;; 111 112(defun profile-functions (&optional flist) 113 "Profile all the functions listed in `profile-functions-list'. 114With argument FLIST, use the list FLIST instead." 115 (interactive "P") 116 (mapcar 'profile-a-function (or flist profile-functions-list))) 117 118(defun profile-print (entry) 119 "Print one ENTRY (from `profile-time-list')." 120 (let* ((calls (car (cdr entry))) 121 (timec (cdr (cdr entry))) 122 (avgtime (and (not (zerop calls)) 123 (/ (+ (car timec) 124 (/ (cdr timec) (float profile-million))) 125 calls)))) 126 (insert (format (concat "%-" 127 (int-to-string profile-max-fun-name) 128 "s %7d %10d.%06d") 129 (car entry) calls (car timec) (cdr timec)) 130 (if (null avgtime) 131 "\n" 132 (format " %18.6f\n" avgtime))))) 133 134(defun profile-results () 135 "Display profiling results in the buffer `*profile*'. 136\(The buffer name comes from `profile-buffer'.)" 137 (interactive) 138 (switch-to-buffer profile-buffer) 139 (erase-buffer) 140 (insert "Function" (make-string (- profile-max-fun-name 6) ? )) 141 (insert " Calls Total time (sec) Avg time per call\n") 142 (insert (make-string profile-max-fun-name ?=) " ") 143 (insert "====== ================ =================\n") 144 (mapcar 'profile-print profile-time-list)) 145 146(defun profile-add-time (dest now prev) 147 "Add to DEST the difference between timestamps NOW and PREV. 148DEST is a pair (SEC . USEC) which is modified in place. 149NOW and PREV are triples as returned by `current-time'." 150 (let ((sec (+ (car dest) 151 (* 65536 (- (car now) (car prev))) 152 (- (cadr now) (cadr prev)))) 153 (usec (+ (cdr dest) 154 (- (car (cddr now)) (car (cddr prev)))))) 155 (if (< usec 0) 156 (setq sec (1- sec) 157 usec (+ usec profile-million)) 158 (if (>= usec profile-million) 159 (setq sec (1+ sec) 160 usec (- usec profile-million)))) 161 (setcar dest sec) 162 (setcdr dest usec))) 163 164(defun profile-function-prolog (fun) 165 "Mark the beginning of a call to function FUN." 166 (if profile-distinct 167 (let ((profile-time (current-time))) 168 (if profile-call-stack 169 (profile-add-time (cdr (cdr (assq (car profile-call-stack) 170 profile-time-list))) 171 profile-time profile-last-time)) 172 (setq profile-call-stack (cons fun profile-call-stack) 173 profile-last-time profile-time)) 174 (let ((profile-time (current-time)) 175 (init-time (cdr (assq fun profile-init-list)))) 176 (if (null init-time) (error "Function %s missing from list" fun)) 177 (if (not (zerop (car init-time)));; is it a recursive call ? 178 (setcar init-time (1+ (car init-time))) 179 (setcar init-time 1) ; mark first entry 180 (setcdr init-time profile-time))))) 181 182(defun profile-function-epilog (fun) 183 "Mark the end of a call to function FUN." 184 (if profile-distinct 185 (let ((profile-time (current-time)) 186 (accum (cdr (assq fun profile-time-list)))) 187 (setcar accum (1+ (car accum))) 188 (profile-add-time (cdr accum) profile-time profile-last-time) 189 (setq profile-call-stack (cdr profile-call-stack) 190 profile-last-time profile-time)) 191 (let ((profile-time (current-time)) 192 (init-time (cdr (assq fun profile-init-list))) 193 (accum (cdr (assq fun profile-time-list)))) 194 (if (or (null init-time) 195 (null accum)) 196 (error "Function %s missing from list" fun)) 197 (setcar init-time (1- (car init-time))) ; pop one level in recursion 198 ;; Update only if we've finished the outermost recursive call 199 (when (zerop (car init-time)) 200 (setcar accum (1+ (car accum))) 201 (profile-add-time (cdr accum) profile-time (cdr init-time)))))) 202 203(defun profile-convert-byte-code (function) 204 (let ((defn (symbol-function function))) 205 (if (byte-code-function-p defn) 206 ;; It is a compiled code object. 207 (let* ((contents (append defn nil)) 208 (body 209 (list (list 'byte-code (nth 1 contents) 210 (nth 2 contents) (nth 3 contents))))) 211 (if (nthcdr 5 contents) 212 (setq body (cons (list 'interactive (nth 5 contents)) body))) 213 (if (nth 4 contents) 214 ;; Use `documentation' here, to get the actual string, 215 ;; in case the compiled function has a reference 216 ;; to the .elc file. 217 (setq body (cons (documentation function) body))) 218 (fset function (cons 'lambda (cons (car contents) body))))))) 219 220(defun profile-a-function (fun) 221 "Profile the function FUN." 222 (interactive "aFunction to profile: ") 223 (let ((def (symbol-function fun))) 224 (when (eq (car-safe def) 'autoload) 225 (load (car (cdr def))) 226 (setq def (symbol-function fun))) 227 (fetch-bytecode def)) 228 (profile-convert-byte-code fun) 229 (let ((def (symbol-function fun)) (funlen (length (symbol-name fun)))) 230 (or (eq (car def) 'lambda) 231 (error "To profile: %s must be a user-defined function" fun)) 232 (setq profile-time-list ; add a new entry 233 (cons (cons fun (cons 0 (cons 0 0))) profile-time-list)) 234 (setq profile-init-list ; add a new entry 235 (cons (cons fun (cons 0 nil)) profile-init-list)) 236 (if (< profile-max-fun-name funlen) (setq profile-max-fun-name funlen)) 237 (fset fun (profile-fix-fun fun def)))) 238 239(defun profile-fix-fun (fun def) 240 "Take function FUN and return it fixed for profiling. 241DEF is (symbol-function FUN)." 242 (if (< (length def) 3) 243 def ; nothing to change 244 (let ((prefix (list (car def) (car (cdr def)))) 245 (suffix (cdr (cdr def)))) 246 ;; Skip the doc string, if there is a string 247 ;; which serves only as a doc string, 248 ;; and put it in PREFIX. 249 (if (and (stringp (car suffix)) (cdr suffix)) 250 (setq prefix (nconc prefix (list (car suffix))) 251 suffix (cdr suffix))) 252 ;; Check for an interactive spec. 253 ;; If found, put it into PREFIX and skip it. 254 (if (and (listp (car suffix)) 255 (eq (car (car suffix)) 'interactive)) 256 (setq prefix (nconc prefix (list (car suffix))) 257 suffix (cdr suffix))) 258 (if (eq (car-safe (car suffix)) 'profile-function-prolog) 259 def ; already profiled 260 ;; Prepare new function definition. 261 ;; If you change this structure, also change profile-restore-fun. 262 (nconc prefix 263 (list (list 'profile-function-prolog 264 (list 'quote fun)) 265 (list 'unwind-protect 266 (cons 'progn suffix) 267 (list 'profile-function-epilog 268 (list 'quote fun))))))))) 269 270(defun profile-restore-fun (fun) 271 "Restore profiled function FUN to its original state." 272 (let ((def (symbol-function fun)) body index) 273 ;; move index beyond header 274 (setq index (cdr-safe def)) 275 (if (stringp (car (cdr index))) 276 (setq index (cdr index))) 277 (if (eq (car-safe (car (cdr index))) 'interactive) 278 (setq index (cdr index))) 279 (if (eq (car-safe (car (cdr index))) 'profile-function-prolog) 280 (setcdr index (cdr (car (cdr (car (cdr (cdr index)))))))))) 281 282(defun profile-finish () 283 "Stop profiling functions. Clear all the settings." 284 (interactive) 285 (while profile-time-list 286 (profile-restore-fun (car (car profile-time-list))) 287 (setq profile-time-list (cdr profile-time-list))) 288 (setq profile-max-fun-name 0) 289 (setq profile-init-list nil)) 290 291(provide 'profile) 292 293;;; arch-tag: 816f97e8-efff-4da2-9a95-7bc392f58b19 294;;; profile.el ends here 295