aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/emacs-lisp/elp.el
diff options
context:
space:
mode:
authorStefan Monnier <[email protected]>2001-11-17 00:58:21 +0000
committerStefan Monnier <[email protected]>2001-11-17 00:58:21 +0000
commit5848fe5ca03835a8f6a0223aec1b1d1c21345435 (patch)
treec62542327c2dcd32301699100e967dd2a52cd289 /lisp/emacs-lisp/elp.el
parentfef3407e0a974d248ad3eceabcc8436dc57a268b (diff)
(elp-not-profilable): New var.
(elp-not-profilable-p): New function. (elp-instrument-function): Use it. Use backquotes and push.
Diffstat (limited to 'lisp/emacs-lisp/elp.el')
-rw-r--r--lisp/emacs-lisp/elp.el44
1 files changed, 28 insertions, 16 deletions
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index f2f484f3e8..0b081b8e90 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -204,6 +204,20 @@ 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))))
+
;;;###autoload
(defun elp-instrument-function (funsym)
@@ -222,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))
@@ -237,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
@@ -279,9 +294,8 @@ FUNSYM must be a symbol of a defined function."
(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.
@@ -337,12 +351,10 @@ For example, to instrument all ELP functions, do the following:
'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'.