204 |
(defvar elp-master nil |
(defvar elp-master nil |
205 |
"Master function symbol.") |
"Master function symbol.") |
206 |
|
|
207 |
|
(defvar elp-not-profilable |
208 |
|
'(elp-wrapper elp-elapsed-time error call-interactively apply current-time interactive-p) |
209 |
|
"List of functions that cannot be profiled. |
210 |
|
Those functions are used internally by the profiling code and profiling |
211 |
|
them would thus lead to infinite recursion.") |
212 |
|
|
213 |
|
(defun elp-not-profilable-p (fun) |
214 |
|
(or (memq fun elp-not-profilable) |
215 |
|
(keymapp fun) |
216 |
|
(condition-case nil |
217 |
|
(when (subrp (symbol-function fun)) |
218 |
|
(eq 'unevalled (cdr (subr-arity (symbol-function fun))))) |
219 |
|
(error nil)))) |
220 |
|
|
221 |
|
|
222 |
;;;###autoload |
;;;###autoload |
223 |
(defun elp-instrument-function (funsym) |
(defun elp-instrument-function (funsym) |
236 |
(let* ((funguts (symbol-function funsym)) |
(let* ((funguts (symbol-function funsym)) |
237 |
(infovec (vector 0 0 funguts)) |
(infovec (vector 0 0 funguts)) |
238 |
(newguts '(lambda (&rest args)))) |
(newguts '(lambda (&rest args)))) |
239 |
|
;; We cannot profile functions used internally during profiling. |
240 |
|
(when (elp-not-profilable-p funsym) |
241 |
|
(error "ELP cannot profile the function: %s" funsym)) |
242 |
;; we cannot profile macros |
;; we cannot profile macros |
243 |
(and (eq (car-safe funguts) 'macro) |
(and (eq (car-safe funguts) 'macro) |
244 |
(error "ELP cannot profile macro: %s" funsym)) |
(error "ELP cannot profile macro: %s" funsym)) |
254 |
;; put rest of newguts together |
;; put rest of newguts together |
255 |
(if (commandp funsym) |
(if (commandp funsym) |
256 |
(setq newguts (append newguts '((interactive))))) |
(setq newguts (append newguts '((interactive))))) |
257 |
(setq newguts (append newguts (list |
(setq newguts (append newguts `((elp-wrapper |
258 |
(list 'elp-wrapper |
(quote ,funsym) |
259 |
(list 'quote funsym) |
,(when (commandp funsym) |
260 |
(list 'and |
'(interactive-p)) |
261 |
'(interactive-p) |
args)))) |
|
(not (not (commandp funsym)))) |
|
|
'args)))) |
|
262 |
;; to record profiling times, we set the symbol's function |
;; to record profiling times, we set the symbol's function |
263 |
;; definition so that it runs the elp-wrapper function with the |
;; definition so that it runs the elp-wrapper function with the |
264 |
;; function symbol as an argument. We place the old function |
;; function symbol as an argument. We place the old function |
294 |
(fset funsym newguts))) |
(fset funsym newguts))) |
295 |
|
|
296 |
;; add this function to the instrumentation list |
;; add this function to the instrumentation list |
297 |
(or (memq funsym elp-all-instrumented-list) |
(unless (memq funsym elp-all-instrumented-list) |
298 |
(setq elp-all-instrumented-list |
(push funsym elp-all-instrumented-list)))) |
|
(cons funsym elp-all-instrumented-list))))) |
|
299 |
|
|
300 |
(defun elp-restore-function (funsym) |
(defun elp-restore-function (funsym) |
301 |
"Restore an instrumented function to its original definition. |
"Restore an instrumented function to its original definition. |
351 |
'intern |
'intern |
352 |
(all-completions |
(all-completions |
353 |
prefix obarray |
prefix obarray |
354 |
(function |
(lambda (sym) |
355 |
(lambda (sym) |
(and (fboundp sym) |
356 |
(and (fboundp sym) |
(not (or (memq (car-safe (symbol-function sym)) '(autoload macro)) |
357 |
(not (memq (car-safe (symbol-function sym)) '(autoload macro)))) |
(elp-not-profilable-p sym))))))))) |
|
)) |
|
|
)))) |
|
358 |
|
|
359 |
(defun elp-restore-list (&optional list) |
(defun elp-restore-list (&optional list) |
360 |
"Restore the original definitions for all functions in `elp-function-list'. |
"Restore the original definitions for all functions in `elp-function-list'. |