annotate src/profile.c @ 1292:f3437b56874d

[xemacs-hg @ 2003-02-13 09:57:04 by ben] profile updates profile.c: Major reworking. Keep track of new information -- total function timing (includes descendants), GC usage, total GC usage (includes descendants). New functions to be called appropriately from eval.c, alloc.c to keep track of this information. Keep track of when we're actually in a function vs. in its profile, for more accurate timing counts. Track profile overhead separately. Create new mechanism for specifying "internal sections" that are tracked just like regular Lisp functions and even appear in the backtrace if `backtrace-with-internal-sections' is non-nil (t by default for error-checking builds). Add some KKCC information for the straight (non-Elisp) hash table used by profile, which contains Lisp objects in its keys -- but not used yet. Remove old ad-hoc methods for tracking garbage collection, redisplay (which was incorrect anyway when Lisp was called within these sections). Don't record any tick info when blocking under MS Windows, since the timer there is in real time rather than in process time. Make `start-profiling', `stop-profiling' interactive. Be consistent wrt. recursive functions and functions currently on the stack when starting or stopping -- together these make implementing the `total' values extremely difficult. When we start profiling, we act as if we just entered all the functions currently on the stack. Likewise when exiting. Create vars in_profile for tracking time spent inside of profiling, and profiling_lock for setting exclusive access to the main hash table when reading from it or modifying it. (protects against getting screwed up by the signal handle going off at the same time. profile.h: New file. Create macros for declaring internal profiling sections. lisp.h: Move profile-related stuff to profile.h. alloc.c: Keep track of total consing, for profile. Tell profile when we are consing. Use new profile-section method for noting garbage-collection. alloc.c: Abort if we attempt to call the allocator reentrantly. backtrace.h, eval.c: Add info for use by profile in the backtrace frame and transfer PUSH_BACKTRACE/POP_BACKTRACE from eval.c, for use with profile. elhash.c: Author comment. eval.c, lisp.h: New Lisp var `backtrace-with-internal-sections'. Set to t when error-checking is on. eval.c: When unwinding, eval.c: Report to profile when we are about-to-call and just-called wrt. a function. alloc.c, eval.c: Allow for "fake" backtrace frames, for internal sections (used by profile and `backtrace-with-internal-sections'. event-Xt.c, event-gtk.c, event-msw.c, event-tty.c: Record when we are actually blocking on an event, for profile's sake. event-stream.c: Record internal profiling sections for getting, dispatching events. extents.c: Record internal profiling sections for map_extents. hash.c, hash.h: Add pregrow_hash_table_if_necessary(). (Used in profile code since the signal handler is the main grower but can't allow a realloc(). We make sure, at critical points, that the table is large enough.) lread.c: Create internal profiling sections for `load' (which may be triggered internally by autoload, etc.). redisplay.c: Remove old profile_redisplay_flag. Use new macros to declare internal profiling section for redisplay. text.c: Use new macros to declare internal profiling sections for char-byte conversion and internal-external conversion. SEMI-UNRELATED CHANGES: ----------------------- text.c: Update the long comments.
author ben
date Thu, 13 Feb 2003 09:57:08 +0000
parents 37bdd24225ef
children 70921960b980
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Why the hell is XEmacs so fucking slow?
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
2 Copyright (C) 1996, 2002, 2003 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Copyright (C) 1998 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 #include "backtrace.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 #include "bytecode.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 #include "elhash.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 #include "hash.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #include "syssignal.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 #include "systime.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32
611
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 458
diff changeset
33 #ifndef HAVE_SETITIMER
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 458
diff changeset
34 #error Sorry charlie. We need a scalpel and all we have is a lawnmower.
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 458
diff changeset
35 #endif
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 458
diff changeset
36
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
37 #ifdef WIN32_ANY
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
38 int mswindows_is_blocking;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
39 #endif
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
40
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
41 /* Written by Ben Wing.
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
42
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
43 We implement our own profiling scheme so that we can determine
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 things like which Lisp functions are occupying the most time. Any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 standard OS-provided profiling works on C functions, which is
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
46 not always that useful -- and inconvenient, since it requires compiling
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
47 with profile info and can't be retrieved dynamically, as XEmacs is
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
48 running.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 The basic idea is simple. We set a profiling timer using setitimer
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
51 (ITIMER_PROF), which generates a SIGPROF every so often. (This runs not
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
52 in real time but rather when the process is executing or the system is
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
53 running on behalf of the process.) When the signal goes off, we see what
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
54 we're in, and add 1 to the count associated with that function.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
56 It would be nice to use the Lisp allocation mechanism etc. to keep track
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
57 of the profiling information (i.e. to use Lisp hash tables), but we
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
58 can't because that's not safe -- updating the timing information happens
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
59 inside of a signal handler, so we can't rely on not being in the middle
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
60 of Lisp allocation, garbage collection, malloc(), etc. Trying to make
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
61 it work would be much more work than it's worth. Instead we use a basic
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
62 (non-Lisp) hash table, which will not conflict with garbage collection
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
63 or anything else as long as it doesn't try to resize itself. Resizing
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
64 itself, however (which happens as a result of a puthash()), could be
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
65 deadly. To avoid this, we make sure, at points where it's safe
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
66 (e.g. profile_record_about_to_call() -- recording the entry into a
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
67 function call), that the table always has some breathing room in it so
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
68 that no resizes will occur until at least that many items are added.
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
69 This is safe because any new item to be added in the sigprof would
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
70 likely have the profile_record_about_to_call() called just before it,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
71 and the breathing room is checked.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
73 In general: any entry that the sigprof handler puts into the table comes
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
74 from a backtrace frame (except "Processing Events at Top Level", and
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
75 there's only one of those). Either that backtrace frame was added when
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
76 profiling was on (in which case profile_record_about_to_call() was
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
77 called and the breathing space updated), or when it was off -- and in
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
78 this case, no such frames can have been added since the last time
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
79 `start-profile' was called, so when `start-profile' is called we make
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
80 sure there is sufficient breathing room to account for all entries
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
81 currently on the stack.
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
82
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
83 Jan 1998: In addition to timing info, I have added code to remember call
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 counts of Lisp funcalls. The profile_increase_call_count()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 function is called from Ffuncall(), and serves to add data to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 Vcall_count_profile_table. This mechanism is much simpler and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 independent of the SIGPROF-driven one. It uses the Lisp allocation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 mechanism normally, since it is not called from a handler. It may
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 even be useful to provide a way to turn on only one profiling
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
90 mechanism, but I haven't done so yet. --hniksic
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
91
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
92 Dec 2002: Total overhaul of the interface, making it sane and easier to
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
93 use. --ben
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
94
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
95 Feb 2003: Lots of rewriting of the internal code. Add GC-consing-usage,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
96 total GC usage, and total timing to the information tracked. Track
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
97 profiling overhead and allow the ability to have internal sections
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
98 (e.g. internal-external conversion, byte-char conversion) that are
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
99 treated like Lisp functions for the purpose of profiling. --ben
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
101 BEWARE: If you are modifying this file, be *very* careful. Correctly
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
102 implementing the "total" values is very tricky due to the possibility of
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
103 recursion and of functions already on the stack when starting to
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
104 profile/still on the stack when stopping.
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
105 */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
106
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
107 /* We use a plain table here because we're recording inside of a signal
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
108 handler. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 static struct hash_table *big_profile_table;
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
110 Lisp_Object Vtotal_timing_profile_table;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 Lisp_Object Vcall_count_profile_table;
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
112 Lisp_Object Vtotal_gc_usage_profile_table;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
113 Lisp_Object Vgc_usage_profile_table;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
114
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
115 extern int lisp_eval_depth;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
116
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
117 extern EMACS_UINT total_consing;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
118 static volatile EMACS_UINT total_ticks;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 442
diff changeset
120 Fixnum default_profiling_interval;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 int profiling_active;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
124 static Lisp_Object QSprocessing_events_at_top_level;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
125 static Lisp_Object QSunknown, QSprofile_overhead;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
126
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
127 static Lisp_Object Qtiming, Qtotal_timing, Qcall_count;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
128 static Lisp_Object Qgc_usage, Qtotal_gc_usage;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
129
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
130 /* This needs to be >= the total number of defined internal sections,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
131 plus 1 or 2?? Set it extra big just to be ultra-paranoid. */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
132 #define EXTRA_BREATHING_ROOM 100
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
134 /* We use profiling_lock to prevent the signal handler from writing to
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
135 the table while another routine is operating on it. We also set
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
136 profiling_lock in case the timeout between signal calls is short
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
137 enough to catch us while we're already in there. */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
138 static volatile int profiling_lock;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
140 /* Whether we're in the process of doing *any* profiling-related stuff.
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
141 Used to indicate amount of time spent profiling. */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
142 static int in_profiling;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
143
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
144 #if 0 /* #### for KKCC, eventually */
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
145
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
146 static const struct memory_description hentry_description_1[] = {
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
147 { XD_LISP_OBJECT, offsetof (hentry, key) },
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
148 { XD_END }
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
149 };
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
150
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
151 static const struct sized_memory_description hentry_description = {
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
152 sizeof (hentry),
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
153 hentry_description_1
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
154 };
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
156 static const struct memory_description plain_hash_table_description_1[] = {
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
157 { XD_ELEMCOUNT, offsetof (struct hash_table, size) },
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
158 { XD_STRUCT_PTR, offsetof (struct hash_table, harray), XD_INDIRECT (0, 0),
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
159 &hentry_description },
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
160 { XD_END }
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
161 };
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
162
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
163 static const struct sized_memory_description plain_hash_table_description = {
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
164 sizeof (struct hash_table),
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
165 plain_hash_table_description_1
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
166 };
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
167
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
168 #endif /* 0 */
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
169
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
170 static void
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
171 create_timing_profile_table (void)
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
172 {
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
173 /* The hash code can safely be called from a signal handler except when
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
174 it has to grow the hash table. In this case, it calls realloc(),
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
175 which is not (in general) re-entrant. The way we deal with this is
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
176 documented at the top of this file. */
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
177 if (!big_profile_table)
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
178 big_profile_table = make_hash_table (2000);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
179 }
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
180
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
181 static void
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
182 create_profile_tables (void)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
183 {
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
184 create_timing_profile_table ();
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
185 if (NILP (Vtotal_timing_profile_table))
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
186 Vtotal_timing_profile_table =
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
187 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
188 if (NILP (Vcall_count_profile_table))
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
189 Vcall_count_profile_table =
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
190 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
191 if (NILP (Vgc_usage_profile_table))
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
192 Vgc_usage_profile_table =
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
193 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
194 if (NILP (Vtotal_gc_usage_profile_table))
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
195 Vtotal_gc_usage_profile_table =
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
196 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
197 }
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
198
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
199 static Lisp_Object
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
200 current_profile_function (void)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
201 {
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
202 Lisp_Object fun;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
203 struct backtrace *bt = backtrace_list;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
204
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
205 /* 2 because we set in_profiling when we entered the current routine. */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
206 if (in_profiling >= 2)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
207 return QSprofile_overhead;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
208
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
209 /* Find a function actually being called. Potentially (?) there could be
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
210 a number of non-calling funs -- calling foo autoloads, which tries to
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
211 call bar, but requires evalling its args first, which calls baz, ...
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
212 If profiling was not enabled when the function was called, just treat
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
213 the function as actually called, because the info about whether we've
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
214 finished the preamble will not have been recorded. */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
215 for (; bt && !bt->function_being_called; bt = bt->next)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
216 ;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
217
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
218 if (bt)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
219 {
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
220 fun = *bt->function;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
221
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
222 if (!SYMBOLP (fun)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
223 && !COMPILED_FUNCTIONP (fun)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
224 && !SUBRP (fun)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
225 && !CONSP (fun)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
226 && !STRINGP (fun))
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
227 fun = QSunknown;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
228 }
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
229 else
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
230 fun = QSprocessing_events_at_top_level;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
231 return fun;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
232 }
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
233
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
234 void
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
235 profile_record_consing (EMACS_INT size)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
236 {
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
237 Lisp_Object fun;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
238 Lisp_Object count;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
239
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
240 in_profiling++;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
241 fun = current_profile_function ();
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
242 count = Fgethash (fun, Vgc_usage_profile_table, Qzero);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
243 Fputhash (fun, make_int (size + XINT (count)), Vgc_usage_profile_table);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
244 in_profiling--;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
245 }
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
246
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
247 void
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
248 profile_record_unconsing (EMACS_INT size)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
249 {
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
250 /* If we don't want to record values less than 0, change this; but then
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
251 the totals won't be accurate. */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
252 profile_record_consing (-size);
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
253 }
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
254
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
255 inline static void
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
256 profile_sow_backtrace (struct backtrace *bt)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 {
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
258 bt->current_total_timing_val =
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
259 XINT (Fgethash (*bt->function, Vtotal_timing_profile_table, Qzero));
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
260 bt->current_total_gc_usage_val =
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
261 XINT (Fgethash (*bt->function, Vtotal_gc_usage_profile_table, Qzero));
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
262 bt->function_being_called = 1;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
263 /* Need to think carefully about the exact order of operations here
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
264 so that we don't end up with totals being less than function-only
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
265 values; */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
266 bt->total_consing_at_start = total_consing;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
267 /* Order of operation is tricky here because we want the total function
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
268 time to be as close as possible to (and absolutely not less than) the
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
269 function-only time. From the sigprof-handler's perspective, the
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
270 function is "entered" the moment we finish executing the
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
271 in_profiling-- statement below, and ends the moment we finish
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
272 executing the in_profiling++ statement in
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
273 profile_record_just_called(). By recording the tick value as close as
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
274 possible to the "in-function" window but not in it, we satisfy the
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
275 conditions just mentioned. */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
276 bt->total_ticks_at_start = total_ticks;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
277 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
279 void
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
280 profile_record_about_to_call (struct backtrace *bt)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
281 {
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
282 in_profiling++;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
283 profiling_lock = 1;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
284 /* See comments in create_timing_profile_table(). */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
285 pregrow_hash_table_if_necessary (big_profile_table, EXTRA_BREATHING_ROOM);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
286 profiling_lock = 0;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
287 Fputhash (*bt->function,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
288 make_int (1 + XINT (Fgethash (*bt->function,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
289 Vcall_count_profile_table,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
290 Qzero))),
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
291 Vcall_count_profile_table);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
292 /* This may be set if the function was in its preamble at the time that
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
293 `start-profiling' was called. If so, we shouldn't reset the values
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
294 because we may get inconsistent results, since we have already started
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
295 recording ticks and consing for the function. */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
296 if (!bt->function_being_called)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
297 profile_sow_backtrace (bt);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
298 in_profiling--;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
299 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
301 inline static void
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
302 profile_reap_backtrace (struct backtrace *bt)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
303 {
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
304 EMACS_UINT ticks;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
305 /* The following statement *MUST* come directly after the preceding one!
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
306 See the comment above. */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
307 ticks = total_ticks;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
308 /* We need to reset the "in-function" flag here. Otherwise the sigprof
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
309 handler will record more ticks for the function while the post-amble
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
310 is executing, and its value will be > our total value. */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
311 bt->function_being_called = 0;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
312 Fputhash (*bt->function,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
313 /* This works even when the total_ticks value has overwrapped.
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
314 Same for total_consing below. */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
315 make_int ((EMACS_INT) (ticks - bt->total_ticks_at_start)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
316 + bt->current_total_timing_val),
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
317 Vtotal_timing_profile_table);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
318 Fputhash (*bt->function,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
319 make_int ((EMACS_INT)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
320 (total_consing - bt->total_consing_at_start)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
321 + bt->current_total_gc_usage_val),
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
322 Vtotal_gc_usage_profile_table);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
323 }
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
324
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
325 void
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
326 profile_record_just_called (struct backtrace *bt)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
327 {
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
328 in_profiling++;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
329 profile_reap_backtrace (bt);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
330 in_profiling--;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
331 }
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
332
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
333 /* Called when unwinding the catch stack after a throw or signal, to
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
334 note that we are exiting the function. */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
335 void
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
336 profile_record_unwind (struct backtrace *bt)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
337 {
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
338 /* We may have thrown while still in a function's preamble. */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
339 if (bt->function_being_called)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
340 profile_record_just_called (bt);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 static SIGTYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 sigprof_handler (int signo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 {
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
346 #ifdef WIN32_ANY
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
347 /* Windows unfortunately does not have any such thing as setitimer
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
348 (ITIMER_PROF, ...), which runs in process time. Everything is real
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
349 time. So to get slightly more reasonable results, ignore completely
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
350 the times when we're blocking. Same applies, of course, to Cygwin. */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
351 if (mswindows_is_blocking)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
352 return;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
353 #endif
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
354
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
355 in_profiling++;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
356 total_ticks++;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
357
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 /* Don't do anything if we are shutting down, or are doing a maphash
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 or clrhash on the table. */
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
360 if (!profiling_lock && !preparing_for_armageddon)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 {
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
362 Lisp_Object fun = current_profile_function ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 /* If something below causes an error to be signaled, we'll
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 not correctly reset this flag. But we'll be in worse shape
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 than that anyways, since we'll longjmp back to the last
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 condition case. */
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
368 profiling_lock = 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 long count;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
372 const void *vval;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 if (gethash (LISP_TO_VOID (fun), big_profile_table, &vval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 count = (long) vval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 count++;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
379 vval = (const void *) count;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 puthash (LISP_TO_VOID (fun), (void *) vval, big_profile_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
383 profiling_lock = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 }
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
385 in_profiling--;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
388 DEFUN ("start-profiling", Fstart_profiling, 0, 1, "", /*
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 Start profiling, with profile queries every MICROSECS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 If MICROSECS is nil or omitted, the value of `default-profiling-interval'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 is used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
393 Information on function timings and call counts is currently recorded.
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
394 You can retrieve the recorded profiling info using `get-profiling-info',
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
395 or the higher-level function `profile-results'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 Starting and stopping profiling does not clear the currently recorded
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 info. Thus you can start and stop as many times as you want and everything
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
399 will be properly accumulated. (To clear, use `clear-profiling-info'.)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 (microsecs))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 int msecs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 struct itimerval foo;
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
406 int depth;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
408 if (profiling_active)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
409 return Qnil;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
410 depth = internal_bind_int (&in_profiling, 1 + in_profiling);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
411
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
412 create_profile_tables ();
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
413 /* See comments at top of file and in create_timing_profile_table().
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
414 We ensure enough breathing room for all entries currently on the
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
415 stack. */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
416 pregrow_hash_table_if_necessary (big_profile_table,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
417 EXTRA_BREATHING_ROOM + lisp_eval_depth);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 if (NILP (microsecs))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 msecs = default_profiling_interval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 CHECK_NATNUM (microsecs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 msecs = XINT (microsecs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 if (msecs <= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 msecs = 1000;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 611
diff changeset
429 set_timeout_signal (SIGPROF, sigprof_handler);
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
430 {
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
431 struct backtrace *bt = backtrace_list;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
432
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
433 /* When we begin profiling, pretend like we just entered all the
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
434 functions currently on the stack. When we stop profiling, do the
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
435 opposite. This ensures consistent values being recorded for both
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
436 function-only and total in such cases. */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
437 for (; bt; bt = bt->next)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
438 profile_sow_backtrace (bt);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
439 }
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
440 profiling_active = 1;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
441 profiling_lock = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 foo.it_value.tv_sec = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 foo.it_value.tv_usec = msecs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 EMACS_NORMALIZE_TIME (foo.it_value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 foo.it_interval = foo.it_value;
611
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 458
diff changeset
446 qxe_setitimer (ITIMER_PROF, &foo, 0);
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
447 unbind_to (depth);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
451 DEFUN ("stop-profiling", Fstop_profiling, 0, 0, "", /*
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 Stop profiling.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 /* This function does not GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 struct itimerval foo;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
459 if (!profiling_active)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
460 return Qnil;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
461 in_profiling++;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 foo.it_value.tv_sec = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 foo.it_value.tv_usec = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 foo.it_interval = foo.it_value;
611
38db05db9cb5 [xemacs-hg @ 2001-06-08 12:21:09 by ben]
ben
parents: 458
diff changeset
465 qxe_setitimer (ITIMER_PROF, &foo, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 profiling_active = 0;
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
467 {
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
468 struct backtrace *bt = backtrace_list;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
469
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
470 for (; bt; bt = bt->next)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
471 profile_reap_backtrace (bt);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
472 }
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 611
diff changeset
473 set_timeout_signal (SIGPROF, fatal_error_signal);
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
474 in_profiling--;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
478 DEFUN ("clear-profiling-info", Fclear_profiling_info, 0, 0, "", /*
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
479 Clear out the recorded profiling info.
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
480 This clears both the internal timing information and the call counts in
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
481 `call-count-profile-table'.
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
482 */
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
483 ())
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
484 {
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
485 in_profiling++;
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
486 /* This function does not GC */
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
487 if (big_profile_table)
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
488 {
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
489 profiling_lock = 1;
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
490 clrhash (big_profile_table);
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
491 profiling_lock = 0;
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
492 }
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
493 if (!NILP (Vtotal_timing_profile_table))
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
494 Fclrhash (Vtotal_timing_profile_table);
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
495 if (!NILP (Vcall_count_profile_table))
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
496 Fclrhash (Vcall_count_profile_table);
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
497 if (!NILP (Vgc_usage_profile_table))
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
498 Fclrhash (Vgc_usage_profile_table);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
499 if (!NILP (Vtotal_gc_usage_profile_table))
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
500 Fclrhash (Vtotal_gc_usage_profile_table);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
501 in_profiling--;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
502
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
503 return Qnil;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
504 }
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
505
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 struct get_profiling_info_closure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 {
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
508 Lisp_Object timing;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 static int
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
512 get_profiling_info_timing_maphash (const void *void_key,
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
513 void *void_val,
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
514 void *void_closure)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 /* This function does not GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 Lisp_Object key;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 struct get_profiling_info_closure *closure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 = (struct get_profiling_info_closure *) void_closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 EMACS_INT val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 771
diff changeset
522 key = VOID_TO_LISP (void_key);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 val = (EMACS_INT) void_val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
525 Fputhash (key, make_int (val), closure->timing);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
529 static Lisp_Object
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
530 copy_hash_table_or_blank (Lisp_Object table)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
531 {
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
532 return !NILP (table) ? Fcopy_hash_table (table) :
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
533 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
534 HASH_TABLE_EQ);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
535 }
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
536
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 DEFUN ("get-profiling-info", Fget_profiling_info, 0, 0, 0, /*
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
538 Return the currently recorded profiling info.
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
539 The format is a plist of symbols describing type of info recorded and
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
540 an associated type-specific entry. Currently, the following info types
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
541 are recorded
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
542
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
543 `timing'
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
544 A hash table of function descriptions (funcallable objects or strings
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
545 describing internal processing operations -- redisplay, garbage
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
546 collection, etc.), along with associated tick counts (the frequency of
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
547 ticks is controlled by `default-profiling-interval' or the argument to
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
548 `start-profiling').
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
549
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
550 `total-timing'
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
551 A hash table of function descriptions and associated timing count for
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
552 the function and all descendants.
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
553
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
554 `call-count'
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
555 A hash table of function descriptions and associated call counts.
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
556
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
557 `gc-usage'
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
558 A hash table of function descriptions and associated amount of consing.
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
559
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
560 `total-gc-usage'
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
561 A hash table of function descriptions and associated amount of consing
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
562 in the function and all descendants.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 /* This function does not GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 struct get_profiling_info_closure closure;
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
568 Lisp_Object retv;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
569 int depth = internal_bind_int (&in_profiling, 1 + in_profiling);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
570 const void *overhead;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
572 closure.timing =
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
573 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
574
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 if (big_profile_table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 {
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
577 int count = internal_bind_int ((int *) &profiling_lock, 1);
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
578 maphash (get_profiling_info_timing_maphash, big_profile_table, &closure);
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
579
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
580 /* OK, OK ... the total-timing table is not going to have an entry
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
581 for profile overhead, and it looks strange for it to come out 0,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
582 so make sure it looks reasonable. */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
583 if (!gethash (LISP_TO_VOID (QSprofile_overhead), big_profile_table,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
584 &overhead))
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
585 overhead = 0;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
586 Fputhash (QSprofile_overhead, make_int ((EMACS_INT) overhead),
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
587 Vtotal_timing_profile_table);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
588
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 613
diff changeset
589 unbind_to (count);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 }
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
591
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
592 retv = nconc2 (list6 (Qtiming, closure.timing, Qtotal_timing,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
593 copy_hash_table_or_blank (Vtotal_timing_profile_table),
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
594 Qcall_count,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
595 copy_hash_table_or_blank (Vcall_count_profile_table)),
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
596 list4 (Qgc_usage,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
597 copy_hash_table_or_blank (Vgc_usage_profile_table),
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
598 Qtotal_gc_usage,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
599 copy_hash_table_or_blank (Vtotal_gc_usage_profile_table
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
600 )));
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
601 unbind_to (depth);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
602 return retv;
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
603 }
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
604
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
605 static int
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
606 set_profiling_info_timing_maphash (Lisp_Object key,
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
607 Lisp_Object val,
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
608 void *void_closure)
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
609 {
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
610 /* This function does not GC */
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
611 if (!INTP (val))
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
612 invalid_argument_2
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
613 ("Function timing count is not an integer in given entry",
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
614 key, val);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
615
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
616 puthash (LISP_TO_VOID (key), (void *) XINT (val), big_profile_table);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
617
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
618 return 0;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
619 }
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
620
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
621 DEFUN ("set-profiling-info", Fset_profiling_info, 1, 1, 0, /*
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
622 Set the currently recorded profiling info.
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
623 INFO should be in the same format returned by `get-profiling-info',
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
624 as described there.
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
625 */
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
626 (info))
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
627 {
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
628 int depth;
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
629 /* This function does not GC */
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
630 Fclear_profiling_info ();
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
631
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
632 depth = internal_bind_int (&in_profiling, 1 + in_profiling);
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
633 {
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
634 EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, info)
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
635 {
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
636 if (EQ (key, Qtiming))
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
637 {
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
638 CHECK_HASH_TABLE (value);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
639 create_timing_profile_table ();
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
640 profiling_lock = 1;
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
641 elisp_maphash_unsafe (set_profiling_info_timing_maphash, value,
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
642 NULL);
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
643 profiling_lock = 0;
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
644 }
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
645 else if (EQ (key, Qcall_count))
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
646 Vcall_count_profile_table = Fcopy_hash_table (value);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
647 else if (EQ (key, Qtotal_timing))
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
648 Vtotal_timing_profile_table = Fcopy_hash_table (value);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
649 else if (EQ (key, Qgc_usage))
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
650 Vgc_usage_profile_table = Fcopy_hash_table (value);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
651 else if (EQ (key, Qtotal_gc_usage))
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
652 Vtotal_gc_usage_profile_table = Fcopy_hash_table (value);
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
653 else
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
654 invalid_constant ("Unrecognized profiling-info keyword", key);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
655 }
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
656 }
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
657
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
658 unbind_to (depth);
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
659 return Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 static int
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
663 mark_profiling_info_maphash (const void *void_key,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 void *void_val,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 void *void_closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 {
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
667 mark_object (VOID_TO_LISP (void_key));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 mark_profiling_info (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 /* This function does not GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 if (big_profile_table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 {
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
677 profiling_lock = 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 maphash (mark_profiling_info_maphash, big_profile_table, 0);
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
679 profiling_lock = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 DEFUN ("profiling-active-p", Fprofiling_active_p, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 Return non-nil if profiling information is currently being recorded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 return profiling_active ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 syms_of_profile (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 DEFSUBR (Fstart_profiling);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 DEFSUBR (Fstop_profiling);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 DEFSUBR (Fget_profiling_info);
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
697 DEFSUBR (Fset_profiling_info);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 DEFSUBR (Fclear_profiling_info);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 DEFSUBR (Fprofiling_active_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 vars_of_profile (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 DEFVAR_INT ("default-profiling-interval", &default_profiling_interval /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 Default CPU time in microseconds between profiling sampling.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 Used when the argument to `start-profiling' is nil or omitted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 Note that the time in question is CPU time (when the program is executing
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
709 or the kernel is executing on behalf of the program) and not real time, and
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
710 there is usually a machine-dependent limit on how small this value can be.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 default_profiling_interval = 1000;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
714 staticpro (&Vcall_count_profile_table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 Vcall_count_profile_table = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
717 staticpro (&Vgc_usage_profile_table);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
718 Vgc_usage_profile_table = Qnil;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
719
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
720 staticpro (&Vtotal_gc_usage_profile_table);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
721 Vtotal_gc_usage_profile_table = Qnil;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
722
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
723 staticpro (&Vtotal_timing_profile_table);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
724 Vtotal_timing_profile_table = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
726 #if 0
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
727 /* #### This is supposed to be for KKCC but KKCC doesn't use this stuff
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
728 currently. */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
729 dump_add_root_struct_ptr (&big_profile_table, &plain_hash_table_description);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
730 #endif /* 0 */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
731
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
732 profiling_lock = 0;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
733
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 613
diff changeset
734 QSunknown = build_msg_string ("(unknown)");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 staticpro (&QSunknown);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 QSprocessing_events_at_top_level =
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 613
diff changeset
737 build_msg_string ("(processing events at top level)");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 staticpro (&QSprocessing_events_at_top_level);
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
739 QSprofile_overhead = build_msg_string ("(profile overhead)");
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
740 staticpro (&QSprofile_overhead);
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
741
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
742 DEFSYMBOL (Qtiming);
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
743 DEFSYMBOL (Qtotal_timing);
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 853
diff changeset
744 DEFSYMBOL (Qcall_count);
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
745 DEFSYMBOL (Qgc_usage);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1123
diff changeset
746 DEFSYMBOL (Qtotal_gc_usage);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 }