xemacs-devel / elp.el

Diff from to
 ;;; 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-1996 Barry A. Warsaw
-;; Maintainer:
+;; Author:        Barry A. Warsaw
+;; Maintainer:    FSF
+;;                XEmacs Development Team <>
 ;; Created:       26-Feb-1994
-;; Version:       2.37
-;; Last Modified: 1996/10/23 04:06:58
 ;; Keywords:      debugging lisp tools
 ;; This file is part of GNU Emacs.
 ;; GNU General Public License for more details.
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 ;;; Commentary:
 ;;   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
 ;; 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.  You cannot profile anything longer than ~18
-;; hours since I throw away the most significant 16 bits of seconds
-;; returned by current-time: 2^16 == 65536 seconds == ~1092 minutes ==
-;; ~18 hours.  I doubt you will ever want to profile stuff on the
-;; order of 18 hours anyway.
+;; affect accuracy too.
 ;;; Background:
 ;; 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
   "Emacs Lisp Profiler"
   :group 'lisp)
 (defcustom elp-function-list nil
   "*List of functions to profile.
 Used by the command `elp-instrument-list'."
 of times will be displayed in the output buffer.  If nil, all
 functions will be displayed."
   :type '(choice integer
-		 (const :tag "All" nil))
+		 (const :tag "Show All" nil))
   :group 'elp)
 (defcustom elp-use-standard-output nil
   :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
   :type 'boolean
 ;; end of user configuration variables
-(defconst elp-version "2.37"
-  "ELP version number.")
-(defconst elp-help-address ""
-  "Address accepting submissions of bug reports and questions.")
 (defvar elp-results-buffer "*ELP Profiling Results*"
   "Buffer name for outputting profiling results.")
 (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))))
 (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
+    ;; 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.
 Argument FUNSYM is the symbol of a defined function."
     ;; we don't want to destroy the new definition.  can it ever be
     ;; the case that a lisp function can be compiled instrumented?
     (and info
-	 (not (compiled-function-p (symbol-function funsym)))
+	 (functionp funsym)
+	 (not (byte-code-function-p (symbol-function funsym)))
 	 (assq 'elp-wrapper (symbol-function funsym))
 	 (fset funsym (aref info 2)))))
     \\[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"))
-   (mapcar 'intern (all-completions prefix obarray
-				    (function
+   (mapcar
+    'intern
+    (all-completions
+     prefix obarray
 				     (lambda (sym)
 				       (and (fboundp sym)
-					    (not (eq (car-safe
-						      (symbol-function sym))
-						     'macro)))))))))
+	    (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
 	elp-record-p t))
-(defsubst elp-get-time ()
-  ;; get current time in seconds and microseconds. I throw away the
-  ;; most significant 16 bits of seconds since I doubt we'll ever want
-  ;; to profile lisp on the order of 18 hours. See notes at top of file.
-  (let ((now (current-time)))
-    (+ (float (nth 1 now)) (/ (float (nth 2 now)) 1000000.0))))
+(defsubst elp-elapsed-time (start end)
+  (+ (* (- (car end) (car start)) 65536.0)
+     (- (car (cdr end)) (car (cdr start)))
+     (/ (- (car (cdr (cdr end))) (car (cdr (cdr start)))) 1000000.0)))
 (defun elp-wrapper (funsym interactive-p args)
   "This function has been instrumented for profiling by the ELP.
 	 (func (aref info 2))
     (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.
 		  (call-interactively func)
 		(apply func args)))
       ;; we are recording times
-      (let ((enter-time (elp-get-time)))
+      (let (enter-time exit-time)
 	;; increment the call-counter
 	(aset info 0 (1+ (aref info 0)))
 	;; now call the old symbol function, checking to see if it
 	;; should be called interactively.  make sure we return the
 	;; correct value
-	(setq result
 	      (if interactive-p
-		  (call-interactively func)
-		(apply func args)))
+	    (setq enter-time (current-time)
+		  result (call-interactively func)
+		  exit-time (current-time))
+	  (setq enter-time (current-time)
+		result (apply func args)
+		exit-time (current-time)))
 	;; calculate total time in function
-	(aset info 1 (+ (aref info 1) (- (elp-get-time) enter-time)))
+	(aset info 1 (+ (aref info 1) (elp-elapsed-time enter-time exit-time)))
     ;; turn off recording if this is the master function
     (if (and elp-master
     (and elp-reset-after-results
-;;  (require 'reporter))
-(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))
 (provide 'elp)