Mercurial > hg > xemacs-beta

comparison lisp/prim/profile.el @ 199:169c0442b401 r20-3b26

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b26
author cvs
date Mon, 13 Aug 2007 10:00:33 +0200
parents 8eaf7971accc
children eb5470882647
comparison
equal deleted inserted replaced
198:a94d4839ade3 199:169c0442b401
1 ;;; profile.el --- basic profiling commands for XEmacs 1 ;;; profile.el --- basic profiling commands for XEmacs
2 2
3 ;; Copyright (C) 1996 Ben Wing. 3 ;; Copyright (C) 1996 Ben Wing, (C) 1997 Free Software Foundation.
4 4
5 ;; Maintainer: XEmacs Development Team 5 ;; Maintainer: XEmacs Development Team
6 ;; Keywords: internal 6 ;; Keywords: internal
7 7
8 ;; This file is part of XEmacs. 8 ;; This file is part of XEmacs.
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 ;; `profile' macro and `profile-key-sequence' added in June 1997 by 29 ;; In addition to Lisp-based `elp', XEmacs contains a set of
30 ;; hniksic. 30 ;; primitives able to profile evaluation of Lisp functions, created by
31 ;; the illustrious Ben Wing. The functions in this file can be used
32 ;; to gain easy access to the internal profiling functions.
33
34 ;; The profiler works by catching "ticks" (actually SIGPROF signals),
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
37 ;; functions, and values being the number of ticks per function. From
38 ;; this, `pretty-print-profiling-info' easily extracts the total
39 ;; number of ticks, and the percentage CPU time of each function.
40
41 ;; Unless stated otherwise, profiling info is being accumulated (the
42 ;; current info is returned by `get-profiling-info'). Use
43 ;; `clear-profiling-info' to break the accumulation chain.
44
45 ;; Caveats (ELP users should read this):
46 ;; 1) The time reported is function time, rather than
47 ;; function+descendants time;
48 ;; 2) The Time/ms is CPU time (user+kernel), not the real time;
49 ;; 3) Only the actuall funcalls are profiled. If a subr Ffoo calls
50 ;; Fbar using Fbar (), only Ffoo will appear in the profile.
51
52 ;; A typical profiling session consists of using `clear-profiling-info'
53 ;; followed by `profile' or `profile-key-sequence', followed by
54 ;; `pretty-print-profiling-info'.
55
56 ;; For instance, to see where Gnus spends time when generating Summary
57 ;; buffer, go to the group buffer, and press `M-x clear-profiling-info'
58 ;; followed by `M-x profile-key-sequence RET SPC'.
31 59
32 60
33 ;;; Code: 61 ;;; Code:
34 62
35 ;;;###autoload 63 ;;;###autoload
36 (defun pretty-print-profiling-info (&optional info stream) 64 (defun pretty-print-profiling-info (&optional info stream)
37 "Print profiling info INFO to STREAM in a pretty format. 65 "Print profiling info INFO to STREAM in a pretty format.
38 If INFO is omitted, the current profiling info is retrieved using 66 If INFO is omitted, the current profiling info is retrieved using
39 `get-profiling-info'. 67 `get-profiling-info'.
40 If STREAM is omitted, either current buffer or standard output are used, 68 If STREAM is omitted, either a *Profiling Results* buffer or standard
41 depending on whether the function was called interactively or not." 69 output are used, depending on whether the function was called
70 interactively or not."
42 (interactive) 71 (interactive)
43 (if info 72 (setq info (if info
44 (setq info (copy-alist info)) 73 (copy-alist info)
45 (setq info (get-profiling-info))) 74 (get-profiling-info)))
46 (let ((standard-output (or stream (if (interactive-p) 75 (when (and (not stream)
47 (current-buffer) 76 (interactive-p))
48 standard-output)))) 77 (pop-to-buffer (get-buffer-create "*Profiling Results*"))
78 (erase-buffer))
79 (let* ((standard-output (or stream (if (interactive-p)
80 (current-buffer)
81 standard-output)))
82 (maxfunlen (max (length "Function Name")
83 (apply 'max (mapcar (lambda (sym)
84 (length (symbol-name
85 (car sym))))
86 info))))
87 (formatstr (format "%%-%ds" maxfunlen)))
49 (setq info (nreverse (sort info #'cdr-less-than-cdr))) 88 (setq info (nreverse (sort info #'cdr-less-than-cdr)))
50 (princ "Function Count %\n") 89 (princ (format (concat formatstr " Ticks %%/Total\n")
51 (princ "---------------------------------------------------------------------\n") 90 "Function Name"))
91 (princ (make-string maxfunlen ?=))
92 (princ " ===== =======\n")
52 (let ((sum 0.0)) 93 (let ((sum 0.0))
53 (dolist (info2 info) 94 (dolist (info2 info)
54 (incf sum (cdr info2))) 95 (incf sum (cdr info2)))
55 (while info 96 (while info
56 (let ((f (caar info))) 97 (let ((f (caar info)))
57 (princ (format "%-50s%10d %6.3f\n" f (cdar info) 98 (princ (format (concat formatstr " %-5d %-6.3f\n")
58 (* 100 (/ (cdar info) sum))))) 99 f (cdar info) (* 100 (/ (cdar info) sum)))))
59 (pop info))))) 100 (pop info))
101 (princ (make-string maxfunlen ?-))
102 (princ "--------------------\n")
103 (princ (format (concat formatstr " %-5d %-6.2f\n")
104 "Total" sum 100.0))
105 (princ (format "\n\nOne tick = %g ms\n"
106 (/ default-profiling-interval 1000.0)))))
107 (when (and (not stream)
108 (interactive-p))
109 (goto-char (point-min))))
60 110
111 ;; Is it really necessary for this to be a macro?
61 ;;;###autoload 112 ;;;###autoload
62 (defmacro profile (&rest forms) 113 (defmacro profile (&rest forms)
63 "Turn on profiling, execute FORMS and restore profiling state. 114 "Turn on profiling, execute FORMS and restore profiling state.
64 Profiling state here means that if profiling was not in effect when 115 Profiling state here means that if profiling was not in effect when
65 PROFILE was called, it will be turned off after FORMS are evaluated. 116 PROFILE was called, it will be turned off after FORMS are evaluated.