annotate lisp/emacs-lisp/profile.el @ 655:02591d9e7ad3

Initial revision
author Eric S. Raymond <esr@snark.thyrsus.com>
date Sat, 30 May 1992 18:52:42 +0000
parents
children 71d052f72ac1
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1 ;;; profile.el -- generate run time measurements of elisp functions
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2 ;;;
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
3 ;;; Author: Boaz Ben-Zvi <boaz@lcs.mit.edu>
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
4 ;;; Created: Feb. 7, 1992
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
5 ;;; Last Modified: Feb. 7, 1992
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
6 ;;; Version: 1.0
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
7
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
8 ;; Copyright (C) 1992 Free Software Foundation, Inc.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
9
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
10 ;; This file is part of GNU Emacs.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
11
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
13 ;; it under the terms of the GNU General Public License as published by
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
14 ;; the Free Software Foundation; either version 1, or (at your option)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
15 ;; any later version.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
16
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
17 ;; GNU Emacs is distributed in the hope that it will be useful,
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
20 ;; GNU General Public License for more details.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
21
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
23 ;; along with GNU Emacs; see the file COPYING. If not, write to
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
25
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
26
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
27 ; DESCRIPTION:
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
28 ; ------------
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
29 ; This program can be used to monitor running time performance of elisp
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
30 ; functions. It takes a list of functions and report the real time spent
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
31 ; inside these functions. It runs a process with a separate timer program.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
32 ; Caveat: the C code included with this package requires BSD-compatible
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
33 ; time-of-day functions. If you're running an AT&T version prior to SVr4,
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
34 ; you may have difficulty getting it to work. Your X library may supply
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
35 ; the required routines if the standard C library does not.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
36
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
37 ; HOW TO USE:
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
38 ; -----------
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
39 ; Set the variable profile-functions-list to the list of functions
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
40 ; (as symbols) You want to profile. Call M-x profile-functions to set
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
41 ; this list on and start using your program. Note that profile-functions
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
42 ; MUST be called AFTER all the functions in profile-functions-list have
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
43 ; been loaded !! (This call modifies the code of the profiled functions.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
44 ; Hence if you reload these functions, you need to call profile-functions
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
45 ; again! ).
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
46 ; To display the results do M-x profile-results . For example:
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
47 ;-------------------------------------------------------------------
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
48 ; (setq profile-functions-list '(sokoban-set-mode-line sokoban-load-game
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
49 ; sokoban-move-vertical sokoban-move))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
50 ; (load "sokoban")
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
51 ; M-x profile-functions
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
52 ; ... I play the sokoban game ..........
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
53 ; M-x profile-results
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
54 ;
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
55 ; Function Time (Seconds.Useconds)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
56 ; ======== =======================
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
57 ; sokoban-move 0.539088
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
58 ; sokoban-move-vertical 0.410130
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
59 ; sokoban-load-game 0.453235
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
60 ; sokoban-set-mode-line 1.949203
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
61 ;-----------------------------------------------------
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
62 ; To clear all the settings to profile use profile-finish.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
63 ; To set one function at a time (instead of or in addition to setting the
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
64 ; above list and M-x profile-functions ) use M-x profile-a-function .
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
65
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
66 ; HOW TO INSTALL:
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
67 ; ---------------
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
68 ; First you need to compile and install the following C program in your
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
69 ; path under the name "emacs-timer" (or set the variable
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
70 ; profile-timer-program to whatever name you picked).
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
71 ;
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
72 ;/**
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
73 ; ** To be run as an emacs process. Input string that starts with:
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
74 ; ** 'z' -- resets the watch (to zero).
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
75 ; ** 'p' -- return time (on stdout) as string with format <sec>.<micro-sec>
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
76 ; ** 'q' -- exit.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
77 ; **
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
78 ; ** abstraction : a stopwatch
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
79 ; ** operations: reset_watch, get_time
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
80 ; */
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
81 ;#include <strings.h>
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
82 ;#include <sys/time.h>
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
83 ;#include <stdio.h>
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
84 ;static struct timeval TV1,TV2;
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
85 ;static struct timezone *tzp = (struct timezone *) NULL; /* no need timezone */
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
86 ;static int watch_not_started = 1 ; /* flag */
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
87 ;static char time_string[30]
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
88 ;
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
89 ;int reset_watch() /* this call resets the stopwatch to zero */
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
90 ;{
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
91 ; gettimeofday(&TV1, tzp) ;
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
92 ; watch_not_started = 0;
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
93 ;}
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
94 ;
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
95 ;char *get_time()
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
96 ; /* this call returns the time since the last reset_watch() call. The time
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
97 ; is returned as a string with the format <seconds>.<micro-seconds>
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
98 ; If reset_watch() was not called yet, returns NULL */
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
99 ;{
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
100 ; char *result = time_string ;
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
101 ; int i;
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
102 ; if (watch_not_started) return((char *) 0); /* call reset_watch first ! */
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
103 ; gettimeofday(&TV2, tzp);
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
104 ; if ( TV1.tv_usec > TV2.tv_usec )
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
105 ; {
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
106 ; TV2.tv_usec += 1000000;
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
107 ; TV2.tv_sec--;
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
108 ; }
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
109 ; sprintf(result,"%lu.%6lu",
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
110 ; TV2.tv_sec - TV1.tv_sec, TV2.tv_usec - TV1.tv_usec);
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
111 ; for (result = index(result,'.') + 1 ; *result == ' ' ; result++ )
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
112 ; *result = '0';
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
113 ; return(time_string);
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
114 ;}
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
115 ;
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
116 ;void main()
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
117 ;{
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
118 ; char inp[10];
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
119 ; while (1)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
120 ; {
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
121 ; gets(inp);
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
122 ; switch (inp[0])
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
123 ; {
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
124 ; case 'z': reset_watch();
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
125 ; break;
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
126 ; case 'p': puts(get_time());
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
127 ; break;
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
128 ; case 'q': exit(0);
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
129 ; }
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
130 ; }
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
131 ;}
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
132 ; -------- end of clip ----------------
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
133
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
134 ;;;
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
135 ;;; User modifiable VARIABLES
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
136 ;;;
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
137
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
138 (defvar profile-functions-list nil "*List of functions to profile")
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
139 (defvar profile-timer-program "emacs-timer" "*Name of the timer program")
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
140
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
141 ;;;
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
142 ;;; V A R I A B L E S
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
143 ;;;
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
144
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
145 (defvar profile-timer-process nil "Process running the timer")
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
146 (defvar profile-time-list nil
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
147 "List of accumulative time for each profiled function")
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
148 (defvar profile-init-list nil
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
149 "List of entry time for each function. \n\
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
150 Both how many times invoked and real time of start.")
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
151 (defvar profile-max-fun-name 0 "Max length of name of any function profiled")
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
152 (defvar profile-temp-result- nil "Should NOT be used anywhere else")
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
153 (defvar profile-time (cons 0 0) "Used to return result from a filter")
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
154 (defvar profile-buffer "*profile*" "Name of profile buffer")
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
155
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
156 ;;;
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
157 ;;; F U N C T I O N S
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
158 ;;;
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
159
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
160 (defun profile-functions (&optional flist)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
161 "Profile all the functions listed in profile-functions-list.\n\
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
162 With argument FLIST, use the list FLIST instead."
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
163 (interactive "*P")
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
164 (if (null flist) (setq flist profile-functions-list))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
165 (mapcar 'profile-a-function flist))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
166
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
167 (defun profile-filter (process input)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
168 "Filter for the timer process. Sets profile-time to the returned time."
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
169 (if (zerop (string-match "\\." input))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
170 (error "Bad output from %s" profile-timer-program)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
171 (setcar profile-time
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
172 (string-to-int (substring input 0 (match-beginning 0))))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
173 (setcdr profile-time
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
174 (string-to-int (substring input (match-end 0))))))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
175
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
176
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
177 (defun profile-print (entry)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
178 "Print one ENTRY (from profile-time-list) ."
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
179 (let ((time (cdr entry)) str (offset 5))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
180 (insert (format "%s" (car entry)) space)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
181 (move-to-column ref-column)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
182 (setq str (int-to-string (car time)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
183 (insert str)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
184 (if (>= (length str) offset) nil
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
185 (move-to-column ref-column)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
186 (insert (substring spaces 0 (- offset (length str))))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
187 (forward-char (length str)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
188 (setq str (int-to-string (cdr time)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
189 (insert "." (substring "000000" 0 (- 6 (length str))) str "\n")
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
190 ))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
191
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
192 (defconst spaces " ")
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
193
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
194 (defun profile-results ()
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
195 "Display profiling results in profile-buffer ."
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
196 (interactive)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
197 (let* ((ref-column (+ 8 profile-max-fun-name))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
198 (space (substring spaces 0 ref-column)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
199 (switch-to-buffer profile-buffer)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
200 (erase-buffer)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
201 (insert "Function" space)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
202 (move-to-column ref-column)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
203 (insert "Time (Seconds.Useconds)\n" "========" space )
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
204 (move-to-column ref-column)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
205 (insert "=======================\n")
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
206 (mapcar 'profile-print profile-time-list)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
207
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
208 (defun profile-reset-timer ()
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
209 (process-send-string profile-timer-process "z\n"))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
210
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
211 (defun profile-check-zero-init-times (entry)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
212 "If ENTRY has non zero time, give an error."
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
213 (let ((time (cdr (cdr entry))))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
214 (if (and (zerop (car time)) (zerop (cdr time))) nil ; OK
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
215 (error "Process timer died while making performance profile."))))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
216
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
217 (defun profile-get-time ()
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
218 "Get time from timer process into profile-time ."
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
219 ;; first time or if process dies
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
220 (if (and (processp profile-timer-process)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
221 (eq 'run (process-status profile-timer-process))) nil
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
222 (setq profile-timer-process ;; [re]start the timer process
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
223 (start-process "timer"
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
224 (get-buffer-create profile-buffer)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
225 profile-timer-program))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
226 (set-process-filter profile-timer-process 'profile-filter)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
227 (process-kill-without-query profile-timer-process)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
228 (profile-reset-timer)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
229 ;; check if timer died during time measurement
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
230 (mapcar 'profile-check-zero-init-times profile-init-list))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
231 ;; make timer process return current time
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
232 (process-send-string profile-timer-process "p\n")
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
233 (accept-process-output))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
234
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
235 (defun profile-find-function (fun flist)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
236 "Linear search for FUN in FLIST ."
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
237 (if (null flist) nil
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
238 (if (eq fun (car (car flist))) (cdr (car flist))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
239 (profile-find-function fun (cdr flist)))))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
240
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
241 (defun profile-start-function (fun)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
242 "On entry, keep current time for function FUN."
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
243 ;; assumes that profile-time contains the current time
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
244 (let ((init-time (profile-find-function fun profile-init-list)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
245 (if (null init-time) (error "Function %s missing from list" fun))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
246 (if (not (zerop (car init-time))) ;; is it a recursive call ?
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
247 (setcar init-time (1+ (car init-time)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
248 (setcar init-time 1) ; mark first entry
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
249 (setq init-time (cdr init-time))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
250 (setcar init-time (car profile-time))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
251 (setcdr init-time (cdr profile-time)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
252 ))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
253
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
254 (defconst profile-million 1000000)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
255
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
256 (defun profile-update-function (fun)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
257 "When the call to the function FUN is finished, add its run time."
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
258 ;; assumes that profile-time contains the current time
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
259 (let ((init-time (profile-find-function fun profile-init-list))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
260 (accum (profile-find-function fun profile-time-list))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
261 sec usec)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
262 (if (or (null init-time)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
263 (null accum)) (error "Function %s missing from list" fun))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
264 (setcar init-time (1- (car init-time))) ; pop one level in recursion
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
265 (if (not (zerop (car init-time)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
266 nil ; in some recursion level, do not update accum. time
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
267 (setq init-time (cdr init-time))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
268 (setq sec (- (car profile-time) (car init-time))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
269 usec (- (cdr profile-time) (cdr init-time)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
270 (setcar init-time 0) ; reset time to check for error
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
271 (setcdr init-time 0) ; in case timer process dies
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
272 (if (>= usec 0) nil
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
273 (setq usec (+ usec profile-million))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
274 (setq sec (1- sec)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
275 (setcar accum (+ sec (car accum)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
276 (setcdr accum (+ usec (cdr accum)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
277 (if (< (cdr accum) profile-million) nil
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
278 (setcar accum (1+ (car accum)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
279 (setcdr accum (- (cdr accum) profile-million)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
280 )))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
281
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
282 (defun profile-a-function (fun)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
283 "Profile the function FUN"
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
284 (interactive "aFunction to profile: ")
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
285 (let ((def (symbol-function fun)) (funlen (length (symbol-name fun))))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
286 (if (eq (car def) 'lambda) nil
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
287 (error "To profile: %s must be a user-defined function" fun))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
288 (setq profile-time-list ; add a new entry
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
289 (cons (cons fun (cons 0 0)) profile-time-list))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
290 (setq profile-init-list ; add a new entry
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
291 (cons (cons fun (cons 0 (cons 0 0))) profile-init-list))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
292 (if (< profile-max-fun-name funlen) (setq profile-max-fun-name funlen))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
293 (fset fun (profile-fix-fun fun def))))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
294
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
295 (defun profile-fix-fun (fun def)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
296 "Take function FUN and return it fixed for profiling.\n\
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
297 DEF is (symbol-function FUN) ."
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
298 (let (prefix first second third (count 2) inter suffix)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
299 (if (< (length def) 3) nil ; nothing to see
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
300 (setq first (car def) second (car (cdr def))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
301 third (car (nthcdr 2 def)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
302 (setq prefix (list first second))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
303 (if (and (stringp third) (< (length def) 3)) nil ; nothing to see
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
304 (if (not (stringp third)) (setq inter third)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
305 (setq count 3 ; suffix to start after doc string
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
306 prefix (nconc prefix (list third))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
307 inter (car (nthcdr 3 def))) ; fourth sexp
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
308 )
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
309 (if (not (and (listp inter)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
310 (eq (car inter) 'interactive))) nil
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
311 (setq prefix (nconc prefix (list inter)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
312 (setq count (1+ count))) ; skip this sexp for suffix
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
313 (setq suffix (nthcdr count def))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
314 (if (equal (car suffix) '(profile-get-time)) nil ;; already set
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
315 ;; prepare new function
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
316 (nconc prefix
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
317 (list '(profile-get-time)) ; read time
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
318 (list (list 'profile-start-function
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
319 (list 'quote fun)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
320 (list (list 'setq 'profile-temp-result-
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
321 (nconc (list 'progn) suffix)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
322 (list '(profile-get-time)) ; read time
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
323 (list (list 'profile-update-function
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
324 (list 'quote fun)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
325 (list 'profile-temp-result-)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
326 ))))))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
327
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
328 (defun profile-restore-fun (fun)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
329 "Restore profiled function FUN to its original state."
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
330 (let ((def (symbol-function (car fun))) body index)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
331 ;; move index beyond header
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
332 (setq index (cdr def))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
333 (if (stringp (car (cdr index))) (setq index (cdr index)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
334 (if (and (listp (car (cdr index)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
335 (eq (car (car (cdr index))) 'interactive))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
336 (setq index (cdr index)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
337 (setq body (car (nthcdr 3 index)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
338 (if (and (listp body) ; the right element ?
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
339 (eq (car (cdr body)) 'profile-temp-result-))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
340 (setcdr index (cdr (car (cdr (cdr body))))))))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
341
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
342 (defun profile-finish ()
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
343 "Stop profiling functions. Clear all the settings."
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
344 (interactive)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
345 (mapcar 'profile-restore-fun profile-time-list)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
346 (setq profile-max-fun-name 0)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
347 (setq profile-time-list nil)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
348 (setq profile-init-list nil))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
349
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
350 (defun profile-quit ()
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
351 "Kill the timer process."
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
352 (interactive)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
353 (process-send-string profile-timer-process "q\n"))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
354
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
355 ;; profile.el ends here