;;; elp.el --- Emacs Lisp Profiler
-;; Copyright (C) 1994,1995,1997,1998 Free Software Foundation, Inc.
+;; Copyright (C) 1994,1995,1997,1998, 2001 Free Software Foundation, Inc.
-;; Author: 1994-1998 Barry A. Warsaw
-;; Maintainer: FSF
-;; Created: 26-Feb-1994
-;; 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.
;; 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
:group 'elp)
(defcustom elp-recycle-buffers-p t
- "*Nil says to not recycle the `elp-results-buffer'.
+ "*nil says to not recycle the `elp-results-buffer'.
In other words, a new unique buffer is create every time you run
\\[elp-results]."
:type 'boolean
(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)
(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))
;; 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
;; 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))))
(defun elp-restore-function (funsym)
"Restore an instrumented function to its original definition.
\\[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))))
- ))
- ))))
+ (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'.
(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
(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.
\f
(provide 'elp)
-;; elp.el ends here
+;;; elp.el ends here
HCoop / bpt / emacs.git / blobdiff