[bpt/emacs.git] / lisp / emacs-lisp / profile.el

;;; profile.el --- generate run time measurements of Emacs Lisp functions

;; Copyright (C) 1992, 1994, 1998 Free Software Foundation, Inc.

;; Author: Boaz Ben-Zvi <boaz@lcs.mit.edu>
;; Created: 07 Feb 1992
;; Version: 1.0
;; Adapted-By: ESR
;; Keywords: lisp, tools

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; 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, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; DESCRIPTION:
;; ------------
;;   This program can be used to monitor running time performance of Emacs Lisp
;; functions.  It takes a list of functions and report the real time spent
;; inside these functions.  (Actually, for each function it reports the amount
;; of time spent while at least one instance of that function is on the call
;; stack.  So if profiled function FOO calls profiled function BAR, the time
;; spent inside BAR is credited to both functions.)

;; HOW TO USE:
;; -----------
;;   Set the variable  profile-functions-list  to the list of functions
;; (as symbols) You want to profile. Call  M-x  profile-functions to set
;; this list on and start using your program.  Note that profile-functions
;; MUST be called AFTER all the functions in profile-functions-list have
;; been loaded !!   (This call modifies the code of the profiled functions.
;; Hence if you reload these functions, you need to call  profile-functions
;; again! ).
;;   To display the results do  M-x  profile-results .  For example:
;;-------------------------------------------------------------------
;;  (setq profile-functions-list '(sokoban-set-mode-line sokoban-load-game
;;	                          sokoban-move-vertical sokoban-move))
;;  (load "sokoban")
;;  M-x profile-functions
;;     ...  I play the sokoban game ..........
;;  M-x profile-results
;;
;;      Function                     Time (Seconds.Useconds)
;;      ========                     =======================
;;      sokoban-move                     0.539088
;;      sokoban-move-vertical            0.410130
;;      sokoban-load-game                0.453235
;;      sokoban-set-mode-line            1.949203
;;-----------------------------------------------------
;; To clear all the settings to profile use profile-finish.
;; To set one function at a time (instead of or in addition to setting the
;; above list and  M-x profile-functions) use M-x profile-a-function.

;;; Code:

;;;
;;;  User modifiable VARIABLES
;;;

(defvar profile-functions-list nil "*List of functions to profile.")
(defvar profile-buffer "*profile*"
  "Name of profile buffer.")
(defvar profile-distinct nil
  "If non-nil, each time slice gets credited to at most one function.
\(Namely, the most recent one in the call stack.)  If nil, then the
time reported for a function includes the entire time from beginning
to end, even if it called some other function that was also profiled.")

;;;
;;; V A R I A B L E S
;;;

(defvar profile-time-list nil
  "List of cumulative calls and time for each profiled function.
Each element looks like (FUN NCALLS SEC . USEC).")
(defvar profile-init-list nil
  "List of entry time for each function.
Both how many times invoked and real time of start.
Each element looks like (FUN DEPTH HISEC LOSEC USEC), where DEPTH is
the current recursion depth, and HISEC, LOSEC, and USEC represent the
starting time of the call (or of the outermost recursion).")
(defvar profile-max-fun-name 0
  "Max length of name of any function profiled.")
(defvar profile-call-stack nil
  "A list of the profiled functions currently executing.
Used only when profile-distinct is non-nil.")
(defvar profile-last-time nil
  "The start time of the current time slice.
Used only when profile-distinct is non-nil.")

(defconst profile-million 1000000)

;;;
;;; F U N C T I O N S
;;;

(defun profile-functions (&optional flist)
  "Profile all the functions listed in `profile-functions-list'.
With argument FLIST, use the list FLIST instead."
  (interactive "P")
  (mapcar 'profile-a-function (or flist profile-functions-list)))

(defun profile-print (entry)
  "Print one ENTRY (from `profile-time-list')."
  (let* ((calls (car (cdr entry)))
	 (timec (cdr (cdr entry)))
	 (avgtime (and (not (zerop calls))
		       (/ (+ (car timec)
			     (/ (cdr timec) (float profile-million)))
			  calls))))
    (insert (format (concat "%-"
			    (int-to-string profile-max-fun-name)
			    "s %7d %10d.%06d")
		    (car entry) calls (car timec) (cdr timec))
	    (if (null avgtime)
		"\n"
	      (format " %18.6f\n" avgtime)))))

(defun profile-results ()
  "Display profiling results in the buffer `*profile*'.
\(The buffer name comes from `profile-buffer'.)"
  (interactive)
  (switch-to-buffer profile-buffer)
  (erase-buffer)
  (insert "Function" (make-string (- profile-max-fun-name 6) ? ))
  (insert " Calls  Total time (sec)  Avg time per call\n")
  (insert (make-string profile-max-fun-name ?=) "  ")
  (insert "======  ================  =================\n")
  (mapcar 'profile-print profile-time-list))

(defun profile-add-time (dest now prev)
  "Add to DEST the difference between timestamps NOW and PREV.
DEST is a pair (SEC . USEC) which is modified in place.
NOW and PREV are triples as returned by `current-time'."
  (let ((sec (+ (car dest)
		(* 65536 (- (car now) (car prev)))
		(- (cadr now) (cadr prev))))
	(usec (+ (cdr dest)
		 (- (car (cddr now)) (car (cddr prev))))))
    (if (< usec 0)
	(setq sec (1- sec)
	      usec (+ usec profile-million))
      (if (>= usec profile-million)
	  (setq sec (1+ sec)
		usec (- usec profile-million))))
    (setcar dest sec)
    (setcdr dest usec)))

(defun profile-function-prolog (fun)
  "Mark the beginning of a call to function FUN."
  (if profile-distinct
      (let ((profile-time (current-time)))
	(if profile-call-stack
	    (profile-add-time (cdr (cdr (assq (car profile-call-stack)
					      profile-time-list)))
			      profile-time profile-last-time))
	(setq profile-call-stack (cons fun profile-call-stack)
	      profile-last-time profile-time))
    (let ((profile-time (current-time))
	  (init-time (cdr (assq fun profile-init-list))))
      (if (null init-time) (error "Function %s missing from list" fun))
      (if (not (zerop (car init-time)));; is it a recursive call ?
	  (setcar init-time (1+ (car init-time)))
	(setcar init-time 1)		; mark first entry
	(setcdr init-time profile-time)))))

(defun profile-function-epilog (fun)
  "Mark the end of a call to function FUN."
  (if profile-distinct
      (let ((profile-time (current-time))
	    (accum (cdr (assq fun profile-time-list))))
	(setcar accum (1+ (car accum)))
	(profile-add-time (cdr accum) profile-time profile-last-time)
	(setq profile-call-stack (cdr profile-call-stack)
	      profile-last-time profile-time))
    (let ((profile-time (current-time))
	  (init-time (cdr (assq fun profile-init-list)))
	  (accum (cdr (assq fun profile-time-list))))
      (if (or (null init-time)
	      (null accum))
	  (error "Function %s missing from list" fun))
      (setcar init-time (1- (car init-time))) ; pop one level in recursion
      ;; Update only if we've finished the outermost recursive call
      (when (zerop (car init-time))
	(setcar accum (1+ (car accum)))
	(profile-add-time (cdr accum) profile-time (cdr init-time))))))

(defun profile-convert-byte-code (function)
  (let ((defn (symbol-function function)))
    (if (byte-code-function-p defn)
	;; It is a compiled code object.
	(let* ((contents (append defn nil))
	       (body
		(list (list 'byte-code (nth 1 contents)
			    (nth 2 contents) (nth 3 contents)))))
	  (if (nthcdr 5 contents)
	      (setq body (cons (list 'interactive (nth 5 contents)) body)))
	  (if (nth 4 contents)
	      ;; Use `documentation' here, to get the actual string,
	      ;; in case the compiled function has a reference
	      ;; to the .elc file.
	      (setq body (cons (documentation function) body)))
	  (fset function (cons 'lambda (cons (car contents) body)))))))

(defun profile-a-function (fun)
  "Profile the function FUN."
  (interactive "aFunction to profile: ")
  (let ((def (symbol-function fun)))
    (when (eq (car-safe def) 'autoload)
      (load (car (cdr def)))
      (setq def (symbol-function fun)))
    (fetch-bytecode def))
  (profile-convert-byte-code fun)
  (let ((def (symbol-function fun)) (funlen (length (symbol-name fun))))
    (or (eq (car def) 'lambda)
	(error "To profile: %s must be a user-defined function" fun))
    (setq profile-time-list		; add a new entry
	  (cons (cons fun (cons 0 (cons 0 0))) profile-time-list))
    (setq profile-init-list		; add a new entry
	  (cons (cons fun (cons 0 nil)) profile-init-list))
    (if (< profile-max-fun-name funlen) (setq profile-max-fun-name funlen))
    (fset fun (profile-fix-fun fun def))))

(defun profile-fix-fun (fun def)
  "Take function FUN and return it fixed for profiling.
DEF is (symbol-function FUN)."
  (if (< (length def) 3)
      def		; nothing to change
    (let ((prefix (list (car def) (car (cdr def))))
	  (suffix (cdr (cdr def))))
      ;; Skip the doc string, if there is a string
      ;; which serves only as a doc string,
      ;; and put it in PREFIX.
      (if (and (stringp (car suffix)) (cdr suffix))
	  (setq prefix (nconc prefix (list (car suffix)))
		suffix (cdr suffix)))
      ;; Check for an interactive spec.
      ;; If found, put it into PREFIX and skip it.
      (if (and (listp (car suffix))
	       (eq (car (car suffix)) 'interactive))
	  (setq prefix (nconc prefix (list (car suffix)))
		suffix (cdr suffix)))
      (if (eq (car-safe (car suffix)) 'profile-function-prolog)
	  def				; already profiled
	;; Prepare new function definition.
	;; If you change this structure, also change profile-restore-fun.
	(nconc prefix
	       (list (list 'profile-function-prolog
			   (list 'quote fun))
		     (list 'unwind-protect
			   (cons 'progn suffix)
			   (list 'profile-function-epilog
				 (list 'quote fun)))))))))

(defun profile-restore-fun (fun)
  "Restore profiled function FUN to its original state."
  (let ((def (symbol-function fun)) body index)
    ;; move index beyond header
    (setq index (cdr-safe def))
    (if (stringp (car (cdr index)))
	(setq index (cdr index)))
    (if (eq (car-safe (car (cdr index))) 'interactive)
	(setq index (cdr index)))
    (if (eq (car-safe (car (cdr index))) 'profile-function-prolog)
	(setcdr index (cdr (car (cdr (car (cdr (cdr index))))))))))

(defun profile-finish ()
  "Stop profiling functions.  Clear all the settings."
  (interactive)
  (while profile-time-list
    (profile-restore-fun (car (car profile-time-list)))
    (setq profile-time-list (cdr profile-time-list)))
  (setq profile-max-fun-name 0)
  (setq profile-init-list nil))

(provide 'profile)

;;; profile.el ends here
Commit	Line	Data
76550a57	1	;;; profile.el --- generate run time measurements of Emacs Lisp functions
4821e2af	2
c7f8bd78	3	;; Copyright (C) 1992, 1994, 1998 Free Software Foundation, Inc.
9750e079	4
4821e2af	5	;; Author: Boaz Ben-Zvi <boaz@lcs.mit.edu>
e5167999	6	;; Created: 07 Feb 1992
4821e2af ER	7	;; Version: 1.0
4821e2af ER	8	;; Adapted-By: ESR
d7b4d18f	9	;; Keywords: lisp, tools
ecb4184d	10
ecb4184d ER	11	;; This file is part of GNU Emacs.
	12
	13	;; GNU Emacs is free software; you can redistribute it and/or modify
	14	;; it under the terms of the GNU General Public License as published by
e5167999	15	;; the Free Software Foundation; either version 2, or (at your option)
ecb4184d ER	16	;; any later version.
	17
	18	;; GNU Emacs is distributed in the hope that it will be useful,
	19	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	20	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	21	;; GNU General Public License for more details.
	22
	23	;; You should have received a copy of the GNU General Public License
b578f267 EN	24	;; along with GNU Emacs; see the file COPYING. If not, write to the
	25	;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
	26	;; Boston, MA 02111-1307, USA.
ecb4184d	27
4821e2af	28	;;; Commentary:
ecb4184d	29
b578f267 EN	30	;; DESCRIPTION:
	31	;; ------------
	32	;; This program can be used to monitor running time performance of Emacs Lisp
c7f8bd78 KH	33	;; functions. It takes a list of functions and report the real time spent
	34	;; inside these functions. (Actually, for each function it reports the amount
	35	;; of time spent while at least one instance of that function is on the call
	36	;; stack. So if profiled function FOO calls profiled function BAR, the time
	37	;; spent inside BAR is credited to both functions.)
ecb4184d	38
b578f267 EN	39	;; HOW TO USE:
	40	;; -----------
	41	;; Set the variable profile-functions-list to the list of functions
c7f8bd78 KH	42	;; (as symbols) You want to profile. Call M-x profile-functions to set
	43	;; this list on and start using your program. Note that profile-functions
	44	;; MUST be called AFTER all the functions in profile-functions-list have
b578f267	45	;; been loaded !! (This call modifies the code of the profiled functions.
c7f8bd78	46	;; Hence if you reload these functions, you need to call profile-functions
b578f267 EN	47	;; again! ).
	48	;; To display the results do M-x profile-results . For example:
	49	;;-------------------------------------------------------------------
c7f8bd78	50	;; (setq profile-functions-list '(sokoban-set-mode-line sokoban-load-game
b578f267 EN	51	;; sokoban-move-vertical sokoban-move))
	52	;; (load "sokoban")
	53	;; M-x profile-functions
	54	;; ... I play the sokoban game ..........
	55	;; M-x profile-results
	56	;;
	57	;; Function Time (Seconds.Useconds)
	58	;; ======== =======================
	59	;; sokoban-move 0.539088
	60	;; sokoban-move-vertical 0.410130
	61	;; sokoban-load-game 0.453235
	62	;; sokoban-set-mode-line 1.949203
	63	;;-----------------------------------------------------
c7f8bd78 KH	64	;; To clear all the settings to profile use profile-finish.
c7f8bd78 KH	65	;; To set one function at a time (instead of or in addition to setting the
b578f267	66	;; above list and M-x profile-functions) use M-x profile-a-function.
ecb4184d	67
4821e2af ER	68	;;; Code:
4821e2af ER	69
ecb4184d ER	70	;;;
	71	;;; User modifiable VARIABLES
	72	;;;
	73
c7f8bd78 KH	74	(defvar profile-functions-list nil "*List of functions to profile.")
	75	(defvar profile-buffer "profile"
	76	"Name of profile buffer.")
	77	(defvar profile-distinct nil
	78	"If non-nil, each time slice gets credited to at most one function.
	79	\(Namely, the most recent one in the call stack.) If nil, then the
	80	time reported for a function includes the entire time from beginning
	81	to end, even if it called some other function that was also profiled.")
ecb4184d ER	82
	83	;;;
	84	;;; V A R I A B L E S
	85	;;;
	86
c7f8bd78 KH	87	(defvar profile-time-list nil
	88	"List of cumulative calls and time for each profiled function.
	89	Each element looks like (FUN NCALLS SEC . USEC).")
ecb4184d	90	(defvar profile-init-list nil
c7f8bd78 KH	91	"List of entry time for each function.
	92	Both how many times invoked and real time of start.
	93	Each element looks like (FUN DEPTH HISEC LOSEC USEC), where DEPTH is
	94	the current recursion depth, and HISEC, LOSEC, and USEC represent the
	95	starting time of the call (or of the outermost recursion).")
	96	(defvar profile-max-fun-name 0
	97	"Max length of name of any function profiled.")
	98	(defvar profile-call-stack nil
	99	"A list of the profiled functions currently executing.
	100	Used only when profile-distinct is non-nil.")
	101	(defvar profile-last-time nil
	102	"The start time of the current time slice.
	103	Used only when profile-distinct is non-nil.")
ecb4184d	104
51eb91c2 RS	105	(defconst profile-million 1000000)
51eb91c2 RS	106
ecb4184d ER	107	;;;
	108	;;; F U N C T I O N S
	109	;;;
	110
	111	(defun profile-functions (&optional flist)
52fb15fa	112	"Profile all the functions listed in `profile-functions-list'.
ecb4184d	113	With argument FLIST, use the list FLIST instead."
37ae4d5c	114	(interactive "P")
c7f8bd78	115	(mapcar 'profile-a-function (or flist profile-functions-list)))
ecb4184d ER	116
ecb4184d ER	117	(defun profile-print (entry)
184c7493	118	"Print one ENTRY (from `profile-time-list')."
37ae4d5c RS	119	(let* ((calls (car (cdr entry)))
37ae4d5c RS	120	(timec (cdr (cdr entry)))
c7f8bd78 KH	121	(avgtime (and (not (zerop calls))
	122	(/ (+ (car timec)
	123	(/ (cdr timec) (float profile-million)))
	124	calls))))
37ae4d5c RS	125	(insert (format (concat "%-"
37ae4d5c RS	126	(int-to-string profile-max-fun-name)
c7f8bd78	127	"s %7d %10d.%06d")
37ae4d5c	128	(car entry) calls (car timec) (cdr timec))
c7f8bd78	129	(if (null avgtime)
37ae4d5c	130	"\n"
c7f8bd78	131	(format " %18.6f\n" avgtime)))))
ecb4184d ER	132
ecb4184d ER	133	(defun profile-results ()
184c7493 RS	134	"Display profiling results in the buffer `profile'.
	135	\(The buffer name comes from `profile-buffer'.)"
	136	(interactive)
37ae4d5c RS	137	(switch-to-buffer profile-buffer)
	138	(erase-buffer)
	139	(insert "Function" (make-string (- profile-max-fun-name 6) ? ))
	140	(insert " Calls Total time (sec) Avg time per call\n")
	141	(insert (make-string profile-max-fun-name ?=) " ")
	142	(insert "====== ================ =================\n")
	143	(mapcar 'profile-print profile-time-list))
ecb4184d	144
c7f8bd78 KH	145	(defun profile-add-time (dest now prev)
	146	"Add to DEST the difference between timestamps NOW and PREV.
	147	DEST is a pair (SEC . USEC) which is modified in place.
	148	NOW and PREV are triples as returned by `current-time'."
	149	(let ((sec (+ (car dest)
	150	(* 65536 (- (car now) (car prev)))
	151	(- (cadr now) (cadr prev))))
	152	(usec (+ (cdr dest)
	153	(- (car (cddr now)) (car (cddr prev))))))
	154	(if (< usec 0)
	155	(setq sec (1- sec)
	156	usec (+ usec profile-million))
	157	(if (>= usec profile-million)
	158	(setq sec (1+ sec)
	159	usec (- usec profile-million))))
	160	(setcar dest sec)
	161	(setcdr dest usec)))
	162
	163	(defun profile-function-prolog (fun)
	164	"Mark the beginning of a call to function FUN."
	165	(if profile-distinct
	166	(let ((profile-time (current-time)))
	167	(if profile-call-stack
	168	(profile-add-time (cdr (cdr (assq (car profile-call-stack)
	169	profile-time-list)))
	170	profile-time profile-last-time))
	171	(setq profile-call-stack (cons fun profile-call-stack)
	172	profile-last-time profile-time))
	173	(let ((profile-time (current-time))
	174	(init-time (cdr (assq fun profile-init-list))))
	175	(if (null init-time) (error "Function %s missing from list" fun))
	176	(if (not (zerop (car init-time)));; is it a recursive call ?
	177	(setcar init-time (1+ (car init-time)))
	178	(setcar init-time 1) ; mark first entry
	179	(setcdr init-time profile-time)))))
	180
	181	(defun profile-function-epilog (fun)
	182	"Mark the end of a call to function FUN."
	183	(if profile-distinct
	184	(let ((profile-time (current-time))
	185	(accum (cdr (assq fun profile-time-list))))
	186	(setcar accum (1+ (car accum)))
	187	(profile-add-time (cdr accum) profile-time profile-last-time)
	188	(setq profile-call-stack (cdr profile-call-stack)
	189	profile-last-time profile-time))
	190	(let ((profile-time (current-time))
	191	(init-time (cdr (assq fun profile-init-list)))
	192	(accum (cdr (assq fun profile-time-list))))
	193	(if (or (null init-time)
	194	(null accum))
	195	(error "Function %s missing from list" fun))
	196	(setcar init-time (1- (car init-time))) ; pop one level in recursion
	197	;; Update only if we've finished the outermost recursive call
	198	(when (zerop (car init-time))
	199	(setcar accum (1+ (car accum)))
	200	(profile-add-time (cdr accum) profile-time (cdr init-time))))))
ecb4184d	201
61939396 RS	202	(defun profile-convert-byte-code (function)
	203	(let ((defn (symbol-function function)))
	204	(if (byte-code-function-p defn)
	205	;; It is a compiled code object.
	206	(let* ((contents (append defn nil))
	207	(body
	208	(list (list 'byte-code (nth 1 contents)
	209	(nth 2 contents) (nth 3 contents)))))
	210	(if (nthcdr 5 contents)
	211	(setq body (cons (list 'interactive (nth 5 contents)) body)))
	212	(if (nth 4 contents)
	213	;; Use `documentation' here, to get the actual string,
	214	;; in case the compiled function has a reference
	215	;; to the .elc file.
	216	(setq body (cons (documentation function) body)))
	217	(fset function (cons 'lambda (cons (car contents) body)))))))
	218
ecb4184d	219	(defun profile-a-function (fun)
184c7493 RS	220	"Profile the function FUN."
184c7493 RS	221	(interactive "aFunction to profile: ")
c7f8bd78 KH	222	(let ((def (symbol-function fun)))
	223	(when (eq (car-safe def) 'autoload)
	224	(load (car (cdr def)))
	225	(setq def (symbol-function fun)))
	226	(fetch-bytecode def))
61939396	227	(profile-convert-byte-code fun)
184c7493	228	(let ((def (symbol-function fun)) (funlen (length (symbol-name fun))))
c7f8bd78 KH	229	(or (eq (car def) 'lambda)
c7f8bd78 KH	230	(error "To profile: %s must be a user-defined function" fun))
184c7493	231	(setq profile-time-list ; add a new entry
37ae4d5c	232	(cons (cons fun (cons 0 (cons 0 0))) profile-time-list))
184c7493	233	(setq profile-init-list ; add a new entry
c7f8bd78	234	(cons (cons fun (cons 0 nil)) profile-init-list))
184c7493 RS	235	(if (< profile-max-fun-name funlen) (setq profile-max-fun-name funlen))
184c7493 RS	236	(fset fun (profile-fix-fun fun def))))
ecb4184d ER	237
ecb4184d ER	238	(defun profile-fix-fun (fun def)
52fb15fa	239	"Take function FUN and return it fixed for profiling.
184c7493	240	DEF is (symbol-function FUN)."
1fdd3601	241	(if (< (length def) 3)
c7f8bd78	242	def ; nothing to change
1fdd3601 KH	243	(let ((prefix (list (car def) (car (cdr def))))
1fdd3601 KH	244	(suffix (cdr (cdr def))))
52fb15fa RS	245	;; Skip the doc string, if there is a string
	246	;; which serves only as a doc string,
	247	;; and put it in PREFIX.
1fdd3601 KH	248	(if (and (stringp (car suffix)) (cdr suffix))
	249	(setq prefix (nconc prefix (list (car suffix)))
	250	suffix (cdr suffix)))
52fb15fa	251	;; Check for an interactive spec.
1fdd3601	252	;; If found, put it into PREFIX and skip it.
c7f8bd78	253	(if (and (listp (car suffix))
1fdd3601 KH	254	(eq (car (car suffix)) 'interactive))
	255	(setq prefix (nconc prefix (list (car suffix)))
	256	suffix (cdr suffix)))
c7f8bd78	257	(if (eq (car-safe (car suffix)) 'profile-function-prolog)
1fdd3601	258	def ; already profiled
52fb15fa	259	;; Prepare new function definition.
c7f8bd78	260	;; If you change this structure, also change profile-restore-fun.
52fb15fa	261	(nconc prefix
c7f8bd78	262	(list (list 'profile-function-prolog
1fdd3601	263	(list 'quote fun))
c7f8bd78 KH	264	(list 'unwind-protect
	265	(cons 'progn suffix)
	266	(list 'profile-function-epilog
	267	(list 'quote fun)))))))))
ecb4184d ER	268
ecb4184d ER	269	(defun profile-restore-fun (fun)
184c7493	270	"Restore profiled function FUN to its original state."
c7f8bd78	271	(let ((def (symbol-function fun)) body index)
184c7493	272	;; move index beyond header
c7f8bd78 KH	273	(setq index (cdr-safe def))
c7f8bd78 KH	274	(if (stringp (car (cdr index)))
184c7493	275	(setq index (cdr index)))
c7f8bd78 KH	276	(if (eq (car-safe (car (cdr index))) 'interactive)
	277	(setq index (cdr index)))
	278	(if (eq (car-safe (car (cdr index))) 'profile-function-prolog)
	279	(setcdr index (cdr (car (cdr (car (cdr (cdr index))))))))))
ecb4184d ER	280
ecb4184d ER	281	(defun profile-finish ()
184c7493 RS	282	"Stop profiling functions. Clear all the settings."
184c7493 RS	283	(interactive)
c7f8bd78 KH	284	(while profile-time-list
	285	(profile-restore-fun (car (car profile-time-list)))
	286	(setq profile-time-list (cdr profile-time-list)))
184c7493	287	(setq profile-max-fun-name 0)
184c7493	288	(setq profile-init-list nil))
ecb4184d	289
896546cd RS	290	(provide 'profile)
896546cd RS	291
76550a57	292	;;; profile.el ends here