]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/elp.el
Add new maintainer (deego).
[gnu-emacs] / lisp / emacs-lisp / elp.el
index d6bac0697a63791013193207e9d7e8c81d6664ef..01544e3aa14e51fe0d50a4dc334e4eca56d969ff 100644 (file)
@@ -1,13 +1,11 @@
 ;;; elp.el --- Emacs Lisp Profiler
 
-;; Copyright (C) 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1994,1995,1997,1998, 2001 Free Software Foundation, Inc.
 
-;; Author:        1994-1997 Barry A. Warsaw
-;; Maintainer:    tools-help@python.org
-;; Created:       26-Feb-1994
-;; Version:       2.39
-;; Last Modified: 1997/02/28 18:15:35
-;; Keywords:      debugging lisp tools
+;; Author: Barry A. Warsaw
+;; Maintainer: FSF
+;; Created: 26-Feb-1994
+;; Keywords: debugging lisp tools
 
 ;; This file is part of GNU Emacs.
 
@@ -40,7 +38,7 @@
 ;; elp-reset-all.
 ;;
 ;; You can also instrument all functions in a package, provided that
-;; the package follows the GNU coding standard of a common textural
+;; the package follows the GNU coding standard of a common textual
 ;; prefix.  Use M-x elp-instrument-package for this.
 ;;
 ;; If you want to sort the results, set elp-sort-by-function to some
 ;; elp-restore-function.  The other instrument, restore, and reset
 ;; functions are provided for symmetry.
 
-;; Note that there are plenty of factors that could make the times
-;; reported unreliable, including the accuracy and granularity of your
-;; system clock, and the overhead spent in lisp calculating and
-;; recording the intervals.  The latter I figure is pretty constant
-;; so, while the times may not be entirely accurate, I think they'll
-;; give you a good feel for the relative amount of work spent in the
-;; various lisp routines you are profiling.  Note further that times
-;; are calculated using wall-clock time, so other system load will
-;; affect accuracy too.
-
 ;; Here is a list of variable you can use to customize elp:
 ;;   elp-function-list
 ;;   elp-reset-after-results
 ;;   elp-set-master
 ;;   elp-unset-master
 ;;   elp-results
-;;   elp-submit-bug-report
 
 ;; Note that there are plenty of factors that could make the times
 ;; reported unreliable, including the accuracy and granularity of your
 
 ;;; Background:
 
-;; This program is based on the only two existing Emacs Lisp profilers
-;; that I'm aware of, Boaz Ben-Zvi's profile.el, and Root Boy Jim's
-;; profiler.el.  Both were written for Emacs 18 and both were pretty
-;; good first shots at profiling, but I found that they didn't provide
-;; the functionality or interface that I wanted.  So I wrote this.
-;; I've tested elp in Emacs 19 and in XEmacs.  There's no point in
-;; even trying to make this work with Emacs 18.
+;; This program was inspired by the only two existing Emacs Lisp
+;; profilers that I'm aware of, Boaz Ben-Zvi's profile.el, and Root
+;; Boy Jim's profiler.el. Both were written for Emacs 18 and both were
+;; pretty good first shots at profiling, but I found that they didn't
+;; provide the functionality or interface that I wanted, so I wrote
+;; this.  I've tested elp in XEmacs 19 and Emacs 19.  There's no point
+;; in even trying to make this work with Emacs 18.
 
 ;; Unlike previous profilers, elp uses Emacs 19's built-in function
 ;; current-time to return interval times.  This obviates the need for
 ;;; Code:
 
 \f
-;; start user configuration variables
+;; start of user configuration variables
 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
 
-(defvar elp-function-list nil
-  "*List of function to profile.
-Used by the command `elp-instrument-list'.")
+(defgroup elp nil
+  "Emacs Lisp Profiler"
+  :group 'lisp)
+
+(defcustom elp-function-list nil
+  "*List of functions to profile.
+Used by the command `elp-instrument-list'."
+  :type '(repeat function)
+  :group 'elp)
 
-(defvar elp-reset-after-results t
+(defcustom elp-reset-after-results t
   "*Non-nil means reset all profiling info after results are displayed.
-Results are displayed with the `elp-results' command.")
+Results are displayed with the `elp-results' command."
+  :type 'boolean
+  :group 'elp)
 
-(defvar elp-sort-by-function 'elp-sort-by-total-time
+(defcustom elp-sort-by-function 'elp-sort-by-total-time
   "*Non-nil specifies elp results sorting function.
 These functions are currently available:
 
@@ -163,33 +158,36 @@ interface specified by the PRED argument for the `sort' defun.  Each
 \"element of LIST\" is really a 4 element vector where element 0 is
 the call count, element 1 is the total time spent in the function,
 element 2 is the average time spent in the function, and element 3 is
-the symbol's name string.")
+the symbol's name string."
+  :type 'function
+  :group 'elp)
 
-(defvar elp-report-limit 1
+(defcustom elp-report-limit 1
   "*Prevents some functions from being displayed in the results buffer.
 If a number, no function that has been called fewer than that number
 of times will be displayed in the output buffer.  If nil, all
-functions will be displayed.")
-
-(defvar elp-use-standard-output nil
-  "*Non-nil says to output to `standard-output' instead of a buffer.")
-
-(defvar elp-recycle-buffers-p t
-  "*Nil says to not recycle the `elp-results-buffer'.
+functions will be displayed."
+  :type '(choice integer
+                (const :tag "Show All" nil))
+  :group 'elp)
+
+(defcustom elp-use-standard-output nil
+  "*Non-nil says to output to `standard-output' instead of a buffer."
+  :type 'boolean
+  :group 'elp)
+
+(defcustom elp-recycle-buffers-p t
+  "*nil says to not recycle the `elp-results-buffer'.
 In other words, a new unique buffer is create every time you run
-\\[elp-results].")
+\\[elp-results]."
+  :type 'boolean
+  :group 'elp)
 
 
 ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 ;; end of user configuration variables
 
 \f
-(defconst elp-version "2.39"
-  "ELP version number.")
-
-(defconst elp-help-address "tools-help@python.org"
-  "Address accepting submissions of bug reports and questions.")
-
 (defvar elp-results-buffer "*ELP Profiling Results*"
   "Buffer name for outputting profiling results.")
 
@@ -206,6 +204,21 @@ This variable is set by the master function.")
 (defvar elp-master nil
   "Master function symbol.")
 
+(defvar elp-not-profilable
+  '(elp-wrapper elp-elapsed-time error call-interactively apply current-time interactive-p)
+  "List of functions that cannot be profiled.
+Those functions are used internally by the profiling code and profiling
+them would thus lead to infinite recursion.")
+
+(defun elp-not-profilable-p (fun)
+  (or (memq fun elp-not-profilable)
+      (keymapp fun)
+      (condition-case nil
+         (when (subrp (symbol-function fun))
+           (eq 'unevalled (cdr (subr-arity (symbol-function fun)))))
+       (error nil))))
+
+\f
 ;;;###autoload
 (defun elp-instrument-function (funsym)
   "Instrument FUNSYM for profiling.
@@ -223,6 +236,9 @@ FUNSYM must be a symbol of a defined function."
   (let* ((funguts (symbol-function funsym))
         (infovec (vector 0 0 funguts))
         (newguts '(lambda (&rest args))))
+    ;; We cannot profile functions used internally during profiling.
+    (when (elp-not-profilable-p funsym)
+      (error "ELP cannot profile the function: %s" funsym))
     ;; we cannot profile macros
     (and (eq (car-safe funguts) 'macro)
         (error "ELP cannot profile macro: %s" funsym))
@@ -238,13 +254,11 @@ FUNSYM must be a symbol of a defined function."
     ;; put rest of newguts together
     (if (commandp funsym)
        (setq newguts (append newguts '((interactive)))))
-    (setq newguts (append newguts (list
-                                  (list 'elp-wrapper
-                                        (list 'quote funsym)
-                                        (list 'and
-                                              '(interactive-p)
-                                              (not (not (commandp funsym))))
-                                        'args))))
+    (setq newguts (append newguts `((elp-wrapper
+                                    (quote ,funsym)
+                                    ,(when (commandp funsym)
+                                       '(interactive-p))
+                                    args))))
     ;; to record profiling times, we set the symbol's function
     ;; definition so that it runs the elp-wrapper function with the
     ;; function symbol as an argument.  We place the old function
@@ -267,17 +281,22 @@ FUNSYM must be a symbol of a defined function."
     ;; put the info vector on the property list
     (put funsym elp-timer-info-property infovec)
 
-    ;; set the symbol's new profiling function definition to run
-    ;; elp-wrapper
-    (fset funsym newguts)
+    ;; Set the symbol's new profiling function definition to run
+    ;; elp-wrapper.
+    (let ((advice-info (get funsym 'ad-advice-info)))
+      (if advice-info
+         (progn
+           ;; If function is advised, don't let Advice change
+           ;; its definition from under us during the `fset'.
+           (put funsym 'ad-advice-info nil)
+           (fset funsym newguts)
+           (put funsym 'ad-advice-info advice-info))
+       (fset funsym newguts)))
 
     ;; add this function to the instrumentation list
-    (or (memq funsym elp-all-instrumented-list)
-       (setq elp-all-instrumented-list
-             (cons funsym elp-all-instrumented-list)))
-    ))
+    (unless (memq funsym elp-all-instrumented-list)
+      (push funsym elp-all-instrumented-list))))
 
-;;;###autoload
 (defun elp-restore-function (funsym)
   "Restore an instrumented function to its original definition.
 Argument FUNSYM is the symbol of a defined function."
@@ -306,7 +325,7 @@ Argument FUNSYM is the symbol of a defined function."
     ;; the case that a lisp function can be compiled instrumented?
     (and info
         (functionp funsym)
-        (not (compiled-function-p (symbol-function funsym)))
+        (not (byte-code-function-p (symbol-function funsym)))
         (assq 'elp-wrapper (symbol-function funsym))
         (fset funsym (aref info 2)))))
 
@@ -325,14 +344,17 @@ For example, to instrument all ELP functions, do the following:
 
     \\[elp-instrument-package] RET elp- RET"
   (interactive "sPrefix of package to instrument: ")
+  (if (zerop (length prefix))
+      (error "Instrumenting all Emacs functions would render Emacs unusable"))
   (elp-instrument-list
-   (mapcar 'intern
-          (all-completions prefix obarray
-                           (function
-                            (lambda (sym)
-                              (and (fboundp sym)
-                                   (not (memq (car-safe (symbol-function sym))
-                                              '(autoload macro))))))))))
+   (mapcar
+    'intern
+    (all-completions
+     prefix obarray
+     (lambda (sym)
+       (and (fboundp sym)
+           (not (or (memq (car-safe (symbol-function sym)) '(autoload macro))
+                    (elp-not-profilable-p sym)))))))))
 
 (defun elp-restore-list (&optional list)
   "Restore the original definitions for all functions in `elp-function-list'.
@@ -352,7 +374,7 @@ Use optional LIST if provided instead."
   (interactive "aFunction to reset: ")
   (let ((info (get funsym elp-timer-info-property)))
     (or info
-       (error "%s is not instrumented for profiling." funsym))
+       (error "%s is not instrumented for profiling" funsym))
     (aset info 0 0)                    ;reset call counter
     (aset info 1 0.0)                  ;reset total time
     ;; don't muck with aref 2 as that is the old symbol definition
@@ -407,7 +429,7 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
         (func (aref info 2))
         result)
     (or func
-       (error "%s is not instrumented for profiling." funsym))
+       (error "%s is not instrumented for profiling" funsym))
     (if (not elp-record-p)
        ;; when not recording, just call the original function symbol
        ;; and return the results.
@@ -576,24 +598,9 @@ displayed."
     (and elp-reset-after-results
         (elp-reset-all))))
 
-\f
-(eval-when-compile
- (require 'reporter))
-
-;;;###autoload
-(defun elp-submit-bug-report ()
-  "Submit via mail, a bug report on elp."
-  (interactive)
-  (and
-   (y-or-n-p "Do you want to submit a report on elp? ")
-   (require 'reporter)
-   (reporter-submit-bug-report
-    elp-help-address (concat "elp " elp-version)
-    '(elp-report-limit
-      elp-reset-after-results
-      elp-sort-by-function))))
-
+(defun elp-unload-hook ()
+  (elp-restore-all))
 \f
 (provide 'elp)
 
-;; elp.el ends here
+;;; elp.el ends here