Mercurial > hg > xemacs-beta
diff src/eval.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 | 465bd3c7d932 |
| children | 671b65f2b075 |
line wrap: on
line diff
--- a/src/eval.c Wed Feb 12 22:52:33 2003 +0000 +++ b/src/eval.c Thu Feb 13 09:57:08 2003 +0000 @@ -1,7 +1,7 @@ /* Evaluator for XEmacs Lisp interpreter. Copyright (C) 1985-1987, 1992-1994 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2000, 2001, 2002 Ben Wing. + Copyright (C) 2000, 2001, 2002, 2003 Ben Wing. This file is part of XEmacs. @@ -147,23 +147,11 @@ #include "frame.h" #include "lstream.h" #include "opaque.h" +#include "profile.h" #include "window.h" struct backtrace *backtrace_list; -/* Note: you must always fill in all of the fields in a backtrace structure - before pushing them on the backtrace_list. The profiling code depends - on this. */ - -#define PUSH_BACKTRACE(bt) do { \ - (bt).next = backtrace_list; \ - backtrace_list = &(bt); \ -} while (0) - -#define POP_BACKTRACE(bt) do { \ - backtrace_list = (bt).next; \ -} while (0) - /* Macros for calling subrs with an argument list whose length is only known at runtime. See EXFUN and DEFUN for similar hackery. */ @@ -292,7 +280,7 @@ Fixnum max_specpdl_size; /* Depth in Lisp evaluations and function calls. */ -static int lisp_eval_depth; +int lisp_eval_depth; /* Maximum allowed depth in Lisp evaluations and function calls. */ Fixnum max_lisp_eval_depth; @@ -300,6 +288,8 @@ /* Nonzero means enter debugger before next function call */ static int debug_on_next_call; +int backtrace_with_internal_sections; + /* List of conditions (non-nil atom means all) which cause a backtrace if an error is handled by the command loop's error handler. */ Lisp_Object Vstack_trace_on_error; @@ -1595,7 +1585,16 @@ #endif /* Former code */ UNWIND_GCPRO_TO (c->gcpro); - backtrace_list = c->backlist; + if (profiling_active) + { + while (backtrace_list != c->backlist) + { + profile_record_unwind (backtrace_list); + backtrace_list = backtrace_list->next; + } + } + else + backtrace_list = c->backlist; lisp_eval_depth = c->lisp_eval_depth; #ifdef DEFEND_AGAINST_THROW_RECURSION @@ -1706,7 +1705,7 @@ /************************************************************************/ -/* Signalling and trapping errors */ +/* Trapping errors */ /************************************************************************/ static Lisp_Object @@ -3092,11 +3091,14 @@ backtrace.args = &cmd; backtrace.nargs = 1; backtrace.evalargs = 0; - backtrace.pdlcount = specpdl_depth(); + backtrace.pdlcount = specpdl_depth (); backtrace.debug_on_exit = 0; + backtrace.function_being_called = 0; PUSH_BACKTRACE (backtrace); + PROFILE_ENTER_FUNCTION (); final = Fcall_interactively (cmd, record_flag, keys); + PROFILE_EXIT_FUNCTION (); POP_BACKTRACE (backtrace); return final; @@ -3535,14 +3537,12 @@ backtrace.nargs = UNEVALLED; backtrace.evalargs = 1; backtrace.debug_on_exit = 0; + backtrace.function_being_called = 0; PUSH_BACKTRACE (backtrace); if (debug_on_next_call) do_debug_on_call (Qt); - if (profiling_active) - profile_increase_call_count (original_fun); - /* At this point, only original_fun and original_args have values that will be used below. */ retry: @@ -3559,8 +3559,10 @@ if (max_args == UNEVALLED) /* Optimize for the common case */ { backtrace.evalargs = 0; + PROFILE_ENTER_FUNCTION (); val = (((Lisp_Object (*) (Lisp_Object)) subr_function (subr)) (original_args)); + PROFILE_EXIT_FUNCTION (); } else if (nargs <= max_args) { @@ -3586,7 +3588,9 @@ backtrace.args = args; backtrace.nargs = nargs; + PROFILE_ENTER_FUNCTION (); FUNCALL_SUBR (val, subr, args, max_args); + PROFILE_EXIT_FUNCTION (); UNGCPRO; } @@ -3611,8 +3615,10 @@ backtrace.args = args; backtrace.nargs = nargs; + PROFILE_ENTER_FUNCTION (); val = (((Lisp_Object (*) (int, Lisp_Object *)) subr_function (subr)) (nargs, args)); + PROFILE_EXIT_FUNCTION (); UNGCPRO; } @@ -3643,7 +3649,9 @@ backtrace.nargs = nargs; backtrace.evalargs = 0; + PROFILE_ENTER_FUNCTION (); val = funcall_compiled_function (fun, nargs, args); + PROFILE_EXIT_FUNCTION (); /* Do the debug-on-exit now, while args is still GCPROed. */ if (backtrace.debug_on_exit) @@ -3665,7 +3673,9 @@ } else if (EQ (funcar, Qmacro)) { + PROFILE_ENTER_FUNCTION (); val = Feval (apply1 (XCDR (fun), original_args)); + PROFILE_EXIT_FUNCTION (); } else if (EQ (funcar, Qlambda)) { @@ -3690,7 +3700,9 @@ backtrace.nargs = nargs; backtrace.evalargs = 0; + PROFILE_ENTER_FUNCTION (); val = funcall_lambda (fun, nargs, args); + PROFILE_EXIT_FUNCTION (); /* Do the debug-on-exit now, while args is still GCPROed. */ if (backtrace.debug_on_exit) @@ -3745,6 +3757,7 @@ struct backtrace backtrace; int fun_nargs = nargs - 1; Lisp_Object *fun_args = args + 1; + Lisp_Object orig_fun; QUIT; @@ -3781,25 +3794,24 @@ Qunbound); } - backtrace.pdlcount = specpdl_depth(); + backtrace.pdlcount = specpdl_depth (); backtrace.function = &args[0]; backtrace.args = fun_args; backtrace.nargs = fun_nargs; backtrace.evalargs = 0; backtrace.debug_on_exit = 0; + backtrace.function_being_called = 0; PUSH_BACKTRACE (backtrace); if (debug_on_next_call) do_debug_on_call (Qlambda); + orig_fun = args[0]; + retry: fun = args[0]; - /* It might be useful to place this *after* all the checks. */ - if (profiling_active) - profile_increase_call_count (fun); - /* We could call indirect_function directly, but profiling shows this is worth optimizing by partially unrolling the loop. */ if (SYMBOLP (fun)) @@ -3822,7 +3834,9 @@ if (fun_nargs == max_args) /* Optimize for the common case */ { funcall_subr: + PROFILE_ENTER_FUNCTION (); FUNCALL_SUBR (val, subr, fun_args, max_args); + PROFILE_EXIT_FUNCTION (); } else if (fun_nargs < subr->min_args) { @@ -3843,7 +3857,9 @@ } else if (max_args == MANY) { + PROFILE_ENTER_FUNCTION (); val = SUBR_FUNCTION (subr, MANY) (fun_nargs, fun_args); + PROFILE_EXIT_FUNCTION (); } else if (max_args == UNEVALLED) /* Can't funcall a special form */ { @@ -3857,7 +3873,9 @@ } else if (COMPILED_FUNCTIONP (fun)) { + PROFILE_ENTER_FUNCTION (); val = funcall_compiled_function (fun, fun_nargs, fun_args); + PROFILE_EXIT_FUNCTION (); } else if (CONSP (fun)) { @@ -3865,7 +3883,9 @@ if (EQ (funcar, Qlambda)) { + PROFILE_ENTER_FUNCTION (); val = funcall_lambda (fun, fun_nargs, fun_args); + PROFILE_EXIT_FUNCTION (); } else if (EQ (funcar, Qautoload)) { @@ -6056,6 +6076,15 @@ if (printing_bindings) write_c_string (stream, ")\n"); } +static Lisp_Object +backtrace_unevalled_args (Lisp_Object *args) +{ + if (args) + return *args; + else + return list1 (build_string ("[internal]")); +} + DEFUN ("backtrace", Fbacktrace, 0, 2, "", /* Print a trace of Lisp function calls currently active. Optional arg STREAM specifies the output stream to send the backtrace to, @@ -6135,7 +6164,9 @@ write_c_string (stream, backlist->debug_on_exit ? "* " : " "); if (backlist->nargs == UNEVALLED) { - Fprin1 (Fcons (*backlist->function, *backlist->args), stream); + Fprin1 (Fcons (*backlist->function, + backtrace_unevalled_args (backlist->args)), + stream); write_c_string (stream, "\n"); /* from FSFmacs 19.30 */ } else @@ -6213,7 +6244,8 @@ if (!backlist) return Qnil; if (backlist->nargs == UNEVALLED) - return Fcons (Qnil, Fcons (*backlist->function, *backlist->args)); + return Fcons (Qnil, Fcons (*backlist->function, + backtrace_unevalled_args (backlist->args))); else { if (backlist->nargs == MANY) @@ -6514,6 +6546,19 @@ Non-nil means enter debugger before next `eval', `apply' or `funcall'. */ ); + DEFVAR_BOOL ("backtrace-with-interal-sections", + &backtrace_with_internal_sections /* +Non-nil means backtraces will contain additional information indicating +when particular sections of the C code have been entered, e.g. redisplay(), +byte-char conversion, internal-external conversion, etc. This can be +particularly useful when XEmacs crashes, in helping to pinpoint the problem. +*/ ); +#ifdef ERROR_CHECK_STRUCTURES + backtrace_with_internal_sections = 1; +#else + backtrace_with_internal_sections = 0; +#endif + DEFVAR_LISP ("debugger", &Vdebugger /* Function to call to invoke debugger. If due to frame exit, args are `exit' and the value being returned;