Mercurial > hg > xemacs-beta
changeset 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 | 3d99b5e6c6ec |
| children | 8134b2a31572 |
| files | src/ChangeLog src/alloc.c src/backtrace.h src/depend src/elhash.c src/eval.c src/event-Xt.c src/event-gtk.c src/event-msw.c src/event-stream.c src/event-tty.c src/extents.c src/hash.c src/hash.h src/lisp.h src/lread.c src/profile.c src/profile.h src/redisplay.c src/text.c src/unicode.c |
| diffstat | 21 files changed, 1190 insertions(+), 244 deletions(-) [+] |
line wrap: on
line diff
--- a/src/ChangeLog Wed Feb 12 22:52:33 2003 +0000 +++ b/src/ChangeLog Thu Feb 13 09:57:08 2003 +0000 @@ -1,3 +1,165 @@ +2003-02-13 Ben Wing <ben@xemacs.org> + + * unicode.c (utf_16_detect): + Don't get snafued w/division-by-zero. + +2003-02-12 Ben Wing <ben@xemacs.org> + + * profile.c: + * profile.c (create_profile_tables): + * profile.c (current_profile_function): + * profile.c (profile_record_consing): + * profile.c (profile_record_about_to_call): + * profile.c (profile_record_just_called): + * profile.c (sigprof_handler): + * profile.c (Fstart_profiling): + * profile.c (Fstop_profiling): + * profile.c (Fclear_profiling_info): + * profile.c (copy_hash_table_or_blank): + * profile.c (Fget_profiling_info): + * profile.c (set_profiling_info_timing_maphash): + * profile.c (Fset_profiling_info): + * profile.c (mark_profiling_info_maphash): + * profile.c (mark_profiling_info): + * profile.c (vars_of_profile): + 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: + * alloc.c (INCREMENT_CONS_COUNTER_1): + * alloc.c (DECREMENT_CONS_COUNTER): + * alloc.c (garbage_collect_1): + * alloc.c (vars_of_alloc): + Keep track of total consing, for profile. + Tell profile when we are consing. + Use new profile-section method for noting garbage-collection. + + * alloc.c (xmalloc): + * alloc.c (xcalloc): + * alloc.c (xrealloc): + * alloc.c (endif): + Abort if we attempt to call the allocator reentrantly. + + * backtrace.h: + * backtrace.h (FSET_FAST_UNSAFE): + * 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 (vars_of_eval): + * lisp.h: + New Lisp var `backtrace-with-internal-sections'. Set to t when + error-checking is on. + + * eval.c: + * eval.c (unwind_to_catch): + When unwinding, + + * eval.c (Fcommand_execute): + * eval.c (Feval): + * eval.c (Ffuncall): + Report to profile when we are about-to-call and just-called wrt. a + function. + + * alloc.c (garbage_collect_1): + * eval.c (backtrace_unevalled_args): + * eval.c (Fbacktrace): + * eval.c (Fbacktrace_frame): + Allow for "fake" backtrace frames, for internal sections (used by + profile and `backtrace-with-internal-sections'. + + * event-Xt.c: + * event-Xt.c (emacs_Xt_next_event): + * event-gtk.c: + * event-gtk.c (emacs_gtk_next_event): + * event-msw.c: + * event-msw.c (mswindows_need_event): + * event-tty.c: + * event-tty.c (emacs_tty_next_event): + Record when we are actually blocking on an event, for profile's sake. + + * event-stream.c: + * event-stream.c (next_event_internal): + * event-stream.c (Fnext_event): + * event-stream.c (execute_internal_event): + * event-stream.c (Fdispatch_event): + * event-stream.c (syms_of_event_stream): + * event-stream.c (vars_of_event_stream): + Record internal profiling sections for getting, dispatching events. + + * extents.c: + * extents.c (map_extents): + * extents.c (vars_of_extents): + Record internal profiling sections for map_extents. + + * hash.c: Author comment. + * hash.c (grow_hash_table): + * 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: + * lread.c (Fload_internal): + * lread.c (done): New. + * lread.c (syms_of_lread): + * lread.c (vars_of_lread): + Create internal profiling sections for `load' (which may be triggered + internally by autoload, etc.). + + * redisplay.c: + * redisplay.c (redisplay_without_hooks): + * redisplay.c (vars_of_redisplay): + Remove old profile_redisplay_flag. Use new macros to declare + internal profiling section for redisplay. + + * text.c (charbpos_to_bytebpos_func): + * text.c (bytebpos_to_charbpos_func): + * text.c (dfc_convert_to_external_format): + * text.c (dfc_convert_to_internal_format): + * text.c (vars_of_text): + 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. + 2003-02-07 Mike Sperber <mike@xemacs.org> * scrollbar.c (specifier_vars_of_scrollbar):
--- a/src/alloc.c Wed Feb 12 22:52:33 2003 +0000 +++ b/src/alloc.c Thu Feb 13 09:57:08 2003 +0000 @@ -56,6 +56,7 @@ #include "opaque.h" #include "lstream.h" #include "process.h" +#include "profile.h" #include "redisplay.h" #include "specifier.h" #include "sysfile.h" @@ -92,6 +93,8 @@ /* Number of bytes of consing done since the last gc */ static EMACS_INT consing_since_gc; +EMACS_UINT total_consing; + int need_to_garbage_collect; int need_to_check_c_alloca; int need_to_signal_post_gc; @@ -105,6 +108,9 @@ do \ { \ consing_since_gc += (size); \ + total_consing += (size); \ + if (profiling_active) \ + profile_record_consing (size); \ recompute_need_to_garbage_collect (); \ } while (0) @@ -143,6 +149,9 @@ #define DECREMENT_CONS_COUNTER(size) do { \ consing_since_gc -= (size); \ + total_consing -= (size); \ + if (profiling_active) \ + profile_record_unconsing (size); \ if (consing_since_gc < 0) \ consing_since_gc = 0; \ recompute_need_to_garbage_collect (); \ @@ -190,6 +199,8 @@ static const Char_ASCII gc_default_message[] = "Garbage collecting"; Lisp_Object Qgarbage_collecting; +static Lisp_Object QSin_garbage_collection; + /* Non-zero means we're in the process of doing the dump */ int purify_flag; @@ -302,11 +313,21 @@ /* like malloc and realloc but check for no memory left. */ +static int in_malloc; + #undef xmalloc void * xmalloc (Bytecount size) { - void *val = malloc (size); + void *val; +#ifdef ERROR_CHECK_MALLOC + assert (!in_malloc); + in_malloc = 1; +#endif + val = malloc (size); +#ifdef ERROR_CHECK_MALLOC + in_malloc = 0; +#endif if (!val && (size != 0)) memory_full (); set_alloc_mins_and_maxes (val, size); return val; @@ -316,7 +337,15 @@ static void * xcalloc (Elemcount nelem, Bytecount elsize) { - void *val = calloc (nelem, elsize); + void *val; +#ifdef ERROR_CHECK_MALLOC + assert (!in_malloc); + in_malloc = 1; +#endif + val= calloc (nelem, elsize); +#ifdef ERROR_CHECK_MALLOC + in_malloc = 0; +#endif if (!val && (nelem != 0)) memory_full (); set_alloc_mins_and_maxes (val, nelem * elsize); @@ -333,7 +362,14 @@ void * xrealloc (void *block, Bytecount size) { +#ifdef ERROR_CHECK_MALLOC + assert (!in_malloc); + in_malloc = 1; +#endif block = realloc (block, size); +#ifdef ERROR_CHECK_MALLOC + in_malloc = 0; +#endif if (!block && (size != 0)) memory_full (); set_alloc_mins_and_maxes (block, size); @@ -353,8 +389,13 @@ the one that comes with Solaris 2.3. FMH!! */ assert (block != (void *) 0xDEADBEEF); assert (block); + assert (!in_malloc); + in_malloc = 1; #endif /* ERROR_CHECK_MALLOC */ free (block); +#ifdef ERROR_CHECK_MALLOC + in_malloc = 0; +#endif } #ifdef ERROR_CHECK_GC @@ -4363,6 +4404,7 @@ int cursor_changed; Lisp_Object pre_gc_cursor; struct gcpro gcpro1; + PROFILE_DECLARE (); assert (!in_display || gc_currently_forbidden); @@ -4372,6 +4414,8 @@ || preparing_for_armageddon) return; + PROFILE_RECORD_ENTERING_SECTION (QSin_garbage_collection); + /* We used to call selected_frame() here. The following functions cannot be called inside GC @@ -4530,7 +4574,9 @@ int i; mark_object (*backlist->function); - if (nargs < 0 /* nargs == UNEVALLED || nargs == MANY */) + if (nargs < 0 /* nargs == UNEVALLED || nargs == MANY */ + /* might be fake (internal profiling entry) */ + && backlist->args) mark_object (backlist->args[0]); else for (i = 0; i < nargs; i++) @@ -4620,6 +4666,8 @@ need_to_signal_post_gc = 1; funcall_allocation_flag = 1; + PROFILE_RECORD_EXITING_SECTION (QSin_garbage_collection); + return; } @@ -5148,6 +5196,9 @@ void vars_of_alloc (void) { + QSin_garbage_collection = build_msg_string ("(in garbage collection)"); + staticpro (&QSin_garbage_collection); + DEFVAR_INT ("gc-cons-threshold", &gc_cons_threshold /* *Number of bytes of consing between garbage collections. \"Consing\" is a misnomer in that this actually counts allocation
--- a/src/backtrace.h Wed Feb 12 22:52:33 2003 +0000 +++ b/src/backtrace.h Thu Feb 13 09:57:08 2003 +0000 @@ -1,6 +1,6 @@ /* The lisp stack. Copyright (C) 1985, 1986, 1987, 1992, 1993 Free Software Foundation, Inc. - Copyright (C) 2002 Ben Wing. + Copyright (C) 2002, 2003 Ben Wing. This file is part of XEmacs. @@ -63,6 +63,51 @@ char evalargs; /* Nonzero means call value of debugger when done with this operation. */ char debug_on_exit; + + /* All the rest is information for the use of the profiler. The only + thing that eval.c does is set the first value to 0 so that it can + be relied upon. */ + + /* ----------------------------------------------------------------- */ + + /* 0 = profiling not turned on when function called. + Since profiling can be turned on and off dynamically, we can't + always count on having info recorded when a function was called + and need to take evasive action if necessary. + 1 = profiling turned on but function not yet actually called. Lots of + stuff can happen between when a function is pushed onto the + backtrace list and when it's actually called (e.g. evalling its + arguments, autoloading, etc.). For greater accuracy we don't + treat the preamble stuff as part of the function itself. + 2 = profiling turned on, function called. + */ + char function_being_called; + /* The trick here is handling recursive functions and dealing with the + dynamicity of in-profile/not-in-profile. I used to just use a bunch + of hash tables for all info but that fails in the presence of + recursive functions because they can modify values out from under + you. The algorithm here is that we record the total_ticks and + total_consing, as well as the current values of `total-timing' and + `total-gc-usage' for the OBJ -- that's because recursive functions, + which get called later and exit early, will go ahead and modify the + `total-timing' and `total-gc-usage' for the fun, even though it's + not "correct" because the outer function is still running. However, + if we ask for profiling info at this point, at least we're getting + SOME info. + + So ... On entry, we record these four values. On exit, we compute + an offset from the recorded value to the current value and then + store it into the appropriate hash table entry, using the recorded + value in the entry rather than the actual one. (Inner recursive + functions may have added their own values to the total-counts, and + we want to subsume them, not add to them.) + + #### Also we need to go through the backtrace list during + stop-profiling and record values, just like for unwind_to. */ + EMACS_INT current_total_timing_val; + EMACS_INT current_total_gc_usage_val; + EMACS_UINT total_ticks_at_start; + EMACS_UINT total_consing_at_start; }; /* This structure helps implement the `catch' and `throw' control @@ -349,4 +394,17 @@ Fset (FFU_sym, FFU_newval); \ } while (0) +/* 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) + #endif /* INCLUDED_backtrace_h_ */
--- a/src/depend Wed Feb 12 22:52:33 2003 +0000 +++ b/src/depend Thu Feb 13 09:57:08 2003 +0000 @@ -50,7 +50,7 @@ console-gtk.o: $(LISP_H) conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h process.h redisplay.h device-gtk.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h device-impl.h device.h devslots.h elhash.h events.h faces.h frame-impl.h frame.h frameslots.h gccache-gtk.h glyphs-gtk.h glyphs.h gtk-xemacs.h objects-gtk.h objects.h redisplay.h scrollbar.h specifier.h sysdep.h sysfile.h systime.h window-impl.h window.h winslots.h dialog-gtk.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h events.h frame.h gui-gtk.h gui.h opaque.h redisplay.h scrollbar.h systime.h window.h -event-gtk.o: $(LISP_H) blocktype.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h commands.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console-tty.h console.h device-impl.h device.h devslots.h dragdrop.h elhash.h event-gtk.h events.h file-coding.h frame-impl.h frame.h frameslots.h gtk-xemacs.h lstream.h objects-gtk.h objects.h offix-types.h offix.h process.h redisplay.h scrollbar.h sysproc.h syssignal.h systime.h systty.h window.h xintrinsic.h +event-gtk.o: $(LISP_H) blocktype.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h commands.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console-tty.h console.h device-impl.h device.h devslots.h dragdrop.h elhash.h event-gtk.h event-xlike-inc.c events.h file-coding.h frame-impl.h frame.h frameslots.h gtk-xemacs.h lstream.h objects-gtk.h objects.h offix-types.h offix.h process.h redisplay.h scrollbar.h sysproc.h syssignal.h systime.h systty.h window.h xintrinsic.h frame-gtk.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h device-impl.h device.h devslots.h dragdrop.h events.h extents.h faces.h frame-impl.h frame.h frameslots.h glyphs-gtk.h glyphs.h gtk-xemacs.h objects-gtk-impl.h objects-gtk.h objects-impl.h objects.h redisplay.h scrollbar-gtk.h scrollbar.h specifier.h sysdll.h systime.h ui-gtk.h window-impl.h window.h winslots.h gccache-gtk.o: $(LISP_H) gccache-gtk.h hash.h glyphs-gtk.o: $(LISP_H) bitmaps.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console.h device-impl.h device.h devslots.h faces.h file-coding.h frame-impl.h frame.h frameslots.h glyphs-gtk.h glyphs.h gui-gtk.h gui.h imgproc.h insdel.h lstream.h objects-gtk-impl.h objects-gtk.h objects-impl.h objects.h opaque.h redisplay.h scrollbar.h specifier.h sysdll.h sysfile.h ui-gtk.h window-impl.h window.h winslots.h @@ -85,7 +85,7 @@ EmacsShell-sub.o: EmacsShell.h EmacsShellP.h config.h xintrinsic.h xintrinsicp.h EmacsShell.o: EmacsShell.h ExternalShell.h config.h xintrinsicp.h abbrev.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h insdel.h redisplay.h scrollbar.h syntax.h window.h -alloc.o: $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h coding-system-slots.h conslots.h console-impl.h console-stream.h console.h device.h elhash.h events.h extents-impl.h extents.h file-coding.h frame-impl.h frame.h frameslots.h glyphs.h lstream.h opaque.h process.h redisplay.h scrollbar.h specifier.h sysdep.h sysfile.h systime.h window-impl.h window.h winslots.h +alloc.o: $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h coding-system-slots.h conslots.h console-impl.h console-stream.h console.h device.h elhash.h events.h extents-impl.h extents.h file-coding.h frame-impl.h frame.h frameslots.h glyphs.h lstream.h opaque.h process.h profile.h redisplay.h scrollbar.h specifier.h sysdep.h sysfile.h systime.h window-impl.h window.h winslots.h alloca.o: $(LISP_H) balloon_help.o: balloon_help.h config.h xintrinsic.h blocktype.o: $(LISP_H) blocktype.h @@ -119,12 +119,13 @@ emacs.o: $(LISP_H) backtrace.h buffer.h bufslots.h casetab.h charset.h chartab.h commands.h console-msw.h console.h frame.h intl-auto-encap-win32.h paths.h process.h redisplay.h sysdep.h sysdll.h sysfile.h sysproc.h syssignal.h systime.h systty.h syswindows.h emodules.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h console.h emodules.h file-coding.h frame.h insdel.h lstream.h redisplay.h scrollbar.h sysdep.h sysdll.h window.h esd.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h miscplay.h sound.h sysfile.h -eval.o: $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h commands.h conslots.h console-impl.h console.h device.h frame.h lstream.h opaque.h redisplay.h scrollbar.h window.h -event-Xt.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h Emacs.ad.h EmacsFrame.h blocktype.h charset.h coding-system-slots.h conslots.h console-impl.h console-tty.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h dragdrop.h elhash.h events.h file-coding.h frame-impl.h frame.h frameslots.h glyphs.h lstream.h objects-x.h objects.h offix-types.h offix.h process.h redisplay.h scrollbar.h specifier.h sysproc.h syssignal.h systime.h systty.h window-impl.h window.h winslots.h xintrinsic.h xintrinsicp.h -event-stream.o: $(LISP_H) blocktype.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h commands.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h elhash.h events.h file-coding.h frame-impl.h frame.h frameslots.h gui.h insdel.h keymap.h lstream.h macros.h menubar.h process.h redisplay.h scrollbar.h sysdep.h sysfile.h syssignal.h systime.h window-impl.h window.h winslots.h +eval.o: $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h commands.h conslots.h console-impl.h console.h device.h frame.h lstream.h opaque.h profile.h redisplay.h scrollbar.h window.h +event-Xt.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h Emacs.ad.h EmacsFrame.h blocktype.h charset.h coding-system-slots.h conslots.h console-impl.h console-tty.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h dragdrop.h elhash.h event-xlike-inc.c events.h file-coding.h frame-impl.h frame.h frameslots.h glyphs.h lstream.h objects-x.h objects.h offix-types.h offix.h process.h redisplay.h scrollbar.h specifier.h sysproc.h syssignal.h systime.h systty.h window-impl.h window.h winslots.h xintrinsic.h xintrinsicp.h +event-stream.o: $(LISP_H) backtrace.h blocktype.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h commands.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h elhash.h events.h file-coding.h frame-impl.h frame.h frameslots.h gui.h insdel.h keymap.h lstream.h macros.h menubar.h process.h profile.h redisplay.h scrollbar.h sysdep.h sysfile.h syssignal.h systime.h window-impl.h window.h winslots.h event-unixoid.o: $(LISP_H) conslots.h console-impl.h console-stream-impl.h console-stream.h console-tty-impl.h console-tty.h console.h device-impl.h device.h devslots.h events.h lstream.h process.h sysdep.h sysfile.h sysproc.h syssignal.h systime.h systty.h +event-xlike-inc.o: events.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console-tty-impl.h console-tty.h console.h device.h events.h extents.h frame-impl.h frame.h frameslots.h glyphs.h keymap.h lstream.h redisplay.h scrollbar.h specifier.h systime.h systty.h toolbar.h window-impl.h window.h winslots.h -extents.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h console.h debug.h device.h elhash.h extents-impl.h extents.h faces.h frame.h glyphs.h gutter.h insdel.h keymap.h opaque.h process.h redisplay.h scrollbar.h specifier.h window-impl.h window.h winslots.h +extents.o: $(LISP_H) backtrace.h buffer.h bufslots.h casetab.h charset.h chartab.h console.h debug.h device.h elhash.h extents-impl.h extents.h faces.h frame.h glyphs.h gutter.h insdel.h keymap.h opaque.h process.h profile.h redisplay.h scrollbar.h specifier.h window-impl.h window.h winslots.h faces.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h elhash.h extents-impl.h extents.h faces.h frame-impl.h frame.h frameslots.h glyphs.h objects-impl.h objects.h redisplay.h scrollbar.h specifier.h window-impl.h window.h winslots.h file-coding.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h elhash.h file-coding.h insdel.h lstream.h opaque.h fileio.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h console.h device.h events.h file-coding.h frame.h insdel.h intl-auto-encap-win32.h lstream.h ndir.h process.h redisplay.h scrollbar.h sysdep.h sysdir.h sysfile.h sysproc.h syspwd.h syssignal.h systime.h syswindows.h window-impl.h window.h winslots.h @@ -168,7 +169,7 @@ libsst.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h libsst.h sound.h sysfile.h line-number.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h line-number.h linuxplay.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h miscplay.h sound.h sysfile.h syssignal.h systty.h -lread.o: $(LISP_H) buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h coding-system-slots.h elhash.h file-coding.h intl-auto-encap-win32.h lstream.h opaque.h sysfile.h sysfloat.h syswindows.h +lread.o: $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h coding-system-slots.h elhash.h file-coding.h intl-auto-encap-win32.h lstream.h opaque.h profile.h sysfile.h sysfloat.h syswindows.h lstream.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h insdel.h lstream.h sysfile.h macros.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h conslots.h console-impl.h console.h device.h events.h frame.h keymap.h macros.h redisplay.h scrollbar.h systime.h window.h malloc.o: config.h getpagesize.h syssignal.h @@ -194,7 +195,7 @@ rangetab.o: $(LISP_H) rangetab.h realpath.o: $(LISP_H) intl-auto-encap-win32.h ndir.h sysdir.h sysfile.h syswindows.h redisplay-output.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h faces.h frame-impl.h frame.h frameslots.h glyphs.h gutter.h redisplay.h scrollbar.h specifier.h window-impl.h window.h winslots.h -redisplay.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h commands.h conslots.h console-impl.h console-tty.h console.h debug.h device-impl.h device.h devslots.h elhash.h events.h extents-impl.h extents.h faces.h file-coding.h frame-impl.h frame.h frameslots.h glyphs.h gui.h gutter.h insdel.h line-number.h menubar.h objects-impl.h objects.h process.h redisplay.h scrollbar.h specifier.h sysfile.h systime.h systty.h toolbar.h window-impl.h window.h winslots.h +redisplay.o: $(LISP_H) backtrace.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h commands.h conslots.h console-impl.h console-tty.h console.h debug.h device-impl.h device.h devslots.h elhash.h events.h extents-impl.h extents.h faces.h file-coding.h frame-impl.h frame.h frameslots.h glyphs.h gui.h gutter.h insdel.h line-number.h menubar.h objects-impl.h objects.h process.h profile.h redisplay.h scrollbar.h specifier.h sysfile.h systime.h systty.h toolbar.h window-impl.h window.h winslots.h regex.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h regex.h syntax.h scrollbar.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h frame-impl.h frame.h frameslots.h glyphs.h gutter.h redisplay.h scrollbar.h specifier.h window-impl.h window.h winslots.h search.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h insdel.h opaque.h regex.h syntax.h @@ -213,11 +214,11 @@ symbols.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console.h elhash.h syntax.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h extents.h syntax.h sysdep.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console-stream-impl.h console-stream.h console-tty-impl.h console-tty.h console.h device-impl.h device.h devslots.h events.h frame.h intl-auto-encap-win32.h ndir.h process.h redisplay.h scrollbar.h sysdep.h sysdir.h sysfile.h sysproc.h syspwd.h syssignal.h systime.h systty.h syswait.h syswindows.h window.h -sysdll.o: config.h sysdll.h +sysdll.o: $(LISP_H) sysdll.h termcap.o: $(LISP_H) console.h device.h terminfo.o: config.h tests.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h elhash.h lstream.h opaque.h -text.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h file-coding.h lstream.h +text.o: $(LISP_H) backtrace.h buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h file-coding.h lstream.h profile.h toolbar-common.o: $(LISP_H) charset.h conslots.h console-gtk-impl.h console-gtk.h console-impl.h console-x-impl.h console-x.h console.h device-impl.h device.h devslots.h faces.h frame-impl.h frame.h frameslots.h glyphs.h redisplay.h scrollbar.h specifier.h toolbar-common.h toolbar.h window-impl.h window.h winslots.h xintrinsic.h toolbar.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h frame-impl.h frame.h frameslots.h glyphs.h redisplay.h scrollbar.h specifier.h toolbar.h window-impl.h window.h winslots.h tooltalk.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h elhash.h process.h syssignal.h tooltalk.h
--- a/src/elhash.c Wed Feb 12 22:52:33 2003 +0000 +++ b/src/elhash.c Thu Feb 13 09:57:08 2003 +0000 @@ -22,6 +22,27 @@ /* Synched up with: Not in FSF. */ +/* Author: Lost in the mists of history. At least back to Lucid 19.3, + circa Sep 1992. Early hash table implementation allowed only `eq' as a + test -- other tests possible only when these objects were created from + the C code. + + Expansion to allow general `equal'-test Lisp-creatable tables, and hash + methods for the various Lisp objects in existence at the time, added + during 19.12 I think (early 1995?), by Ben Wing. + + Weak hash tables added by Jamie (maybe?) early on, perhaps around 19.6, + maybe earlier; again, only possible through the C code, and only + supported fully weak hash tables. Expansion to other kinds of weakness, + and exporting of the interface to Lisp, by Ben Wing during 19.12 + (early-mid 1995) or maybe 19.13 cycle (mid 1995). + + Expansion to full Common Lisp spec and interface, redoing of the + implementation, by Martin Buchholz, 1997? (Former hash table + implementation used "double hashing", I'm pretty sure, and was weirdly + tied into the generic hash.c code. Martin completely separated them.) +*/ + /* This file implements the hash table lisp object type. This implementation was mostly written by Martin Buchholz in 1997.
--- 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;
--- a/src/event-Xt.c Wed Feb 12 22:52:33 2003 +0000 +++ b/src/event-Xt.c Thu Feb 13 09:57:08 2003 +0000 @@ -67,6 +67,10 @@ #include "offix.h" #endif +#ifdef WIN32_ANY +extern int mswindows_is_blocking; +#endif + /* used in glyphs-x.c */ void enqueue_focus_event (Widget wants_it, Lisp_Object frame, int in_p); static void handle_focus_event_1 (struct frame *f, int in_p); @@ -2790,10 +2794,13 @@ However, we can't just not process any events at all, because that will make sit-for etc. hang. So we go ahead and process the non-X kinds of events. */ - XtInputMask pending_value = XtAppPending (Xt_app_con); - - if (pending_value & (XtIMTimer | XtIMAlternateInput)) - XtAppProcessEvent (Xt_app_con, XtIMTimer | XtIMAlternateInput); +#ifdef WIN32_ANY + mswindows_is_blocking = 1; +#endif + XtAppProcessEvent (Xt_app_con, XtIMTimer | XtIMAlternateInput); +#ifdef WIN32_ANY + mswindows_is_blocking = 0; +#endif } else { @@ -2829,7 +2836,13 @@ /* emacs may be exiting */ XFlush (DEVICE_X_DISPLAY (d)); } +#ifdef WIN32_ANY + mswindows_is_blocking = 1; +#endif XtAppProcessEvent (Xt_app_con, XtIMAll); +#ifdef WIN32_ANY + mswindows_is_blocking = 0; +#endif } } }
--- a/src/event-gtk.c Wed Feb 12 22:52:33 2003 +0000 +++ b/src/event-gtk.c Thu Feb 13 09:57:08 2003 +0000 @@ -68,6 +68,10 @@ static struct event_stream *gtk_event_stream; +#ifdef WIN32_ANY +extern int mswindows_is_blocking; +#endif + /* Do we accept events sent by other clients? */ int gtk_allow_sendevents; @@ -1158,7 +1162,13 @@ !process_events_occurred && !tty_events_occurred) { - gtk_main_iteration(); +#ifdef WIN32_ANY + mswindows_is_blocking = 1; +#endif + gtk_main_iteration (); +#ifdef WIN32_ANY + mswindows_is_blocking = 0; +#endif } if (!NILP (dispatch_event_queue))
--- a/src/event-msw.c Wed Feb 12 22:52:33 2003 +0000 +++ b/src/event-msw.c Thu Feb 13 09:57:08 2003 +0000 @@ -175,6 +175,8 @@ static DWORD mswindows_last_mouse_button_state; +extern int mswindows_is_blocking; + #ifndef CYGWIN /* Skips past slurp, shove, or winsock streams */ @@ -1360,7 +1362,9 @@ FD_CLR (windows_fd, &temp_mask); } + mswindows_is_blocking = 1; active = select (MAXDESC, &temp_mask, 0, 0, pointer_to_this); + mswindows_is_blocking = 0; if (active == 0) { @@ -1535,10 +1539,15 @@ qxePeekMessage (&msg, 0, 0, 0, PM_NOREMOVE)) active = WAIT_OBJECT_0 + mswindows_waitable_count; else - active = MsgWaitForMultipleObjects (mswindows_waitable_count, - mswindows_waitable_handles, - FALSE, badly_p ? INFINITE : 0, - what_events); + { + mswindows_is_blocking = 1; + active = MsgWaitForMultipleObjects (mswindows_waitable_count, + mswindows_waitable_handles, + FALSE, + badly_p ? INFINITE : 0, + what_events); + mswindows_is_blocking = 0; + } } __except (GetExceptionCode () == EXCEPTION_BREAKPOINT ? EXCEPTION_CONTINUE_EXECUTION :
--- a/src/event-stream.c Wed Feb 12 22:52:33 2003 +0000 +++ b/src/event-stream.c Thu Feb 13 09:57:08 2003 +0000 @@ -90,6 +90,7 @@ #include "macros.h" /* for defining_keyboard_macro */ #include "menubar.h" /* #### for evil kludges. */ #include "process.h" +#include "profile.h" #include "window-impl.h" #include "sysdep.h" /* init_poll_for_quit() */ @@ -249,6 +250,9 @@ /* the number of keyboard characters read. callint.c wants this. */ Charcount num_input_chars; +static Lisp_Object Qnext_event, Qdispatch_event, QSnext_event_internal; +static Lisp_Object QSexecute_internal_event; + #ifdef DEBUG_XEMACS Fixnum debug_emacs_events; @@ -2103,8 +2107,12 @@ next_event_internal (Lisp_Object target_event, int allow_queued) { struct gcpro gcpro1; + PROFILE_DECLARE (); + QUIT; + PROFILE_RECORD_ENTERING_SECTION (QSnext_event_internal); + assert (NILP (XEVENT_NEXT (target_event))); GCPRO1 (target_event); @@ -2158,6 +2166,8 @@ } UNGCPRO; + + PROFILE_RECORD_EXITING_SECTION (QSnext_event_internal); } void @@ -2228,6 +2238,7 @@ int store_this_key = 0; struct gcpro gcpro1; int depth; + PROFILE_DECLARE (); GCPRO1 (event); @@ -2252,6 +2263,8 @@ invalid_operation ("Attempt to call next-event inside menu callback", Qunbound); + PROFILE_RECORD_ENTERING_SECTION (Qnext_event); + depth = begin_dont_check_for_quit (); if (NILP (event)) @@ -2477,6 +2490,8 @@ Vquit_flag = Qnil; /* see begin_dont_check_for_quit() */ unbind_to (depth); + PROFILE_RECORD_EXITING_SECTION (Qnext_event); + UNGCPRO; return event; @@ -3022,35 +3037,39 @@ static void execute_internal_event (Lisp_Object event) { + PROFILE_DECLARE (); + /* events on dead channels get silently eaten */ if (object_dead_p (XEVENT (event)->channel)) return; + PROFILE_RECORD_ENTERING_SECTION (QSexecute_internal_event); + /* This function can GC */ switch (XEVENT_TYPE (event)) { case empty_event: - return; + goto done; case eval_event: { call1 (XEVENT_EVAL_FUNCTION (event), XEVENT_EVAL_OBJECT (event)); - return; + goto done; } case magic_eval_event: { XEVENT_MAGIC_EVAL_INTERNAL_FUNCTION (event) XEVENT_MAGIC_EVAL_OBJECT (event); - return; + goto done; } case pointer_motion_event: { if (!NILP (Vmouse_motion_handler)) call1 (Vmouse_motion_handler, event); - return; + goto done; } case process_event: @@ -3142,7 +3161,7 @@ */ status_notify (); } - return; + goto done; } case timeout_event: @@ -3152,14 +3171,17 @@ if (!NILP (EVENT_TIMEOUT_FUNCTION (e))) call1 (EVENT_TIMEOUT_FUNCTION (e), EVENT_TIMEOUT_OBJECT (e)); - return; + goto done; } case magic_event: event_stream_handle_magic_event (XEVENT (event)); - return; + goto done; default: abort (); } + + done: + PROFILE_RECORD_EXITING_SECTION (QSexecute_internal_event); } @@ -4341,6 +4363,7 @@ Lisp_Event *ev; Lisp_Object console; Lisp_Object channel; + PROFILE_DECLARE (); CHECK_LIVE_EVENT (event); ev = XEVENT (event); @@ -4350,6 +4373,8 @@ if (object_dead_p (channel)) return Qnil; + PROFILE_RECORD_ENTERING_SECTION (Qdispatch_event); + /* Some events don't have channels (e.g. eval events). */ console = CDFW_CONSOLE (channel); if (NILP (console)) @@ -4548,6 +4573,8 @@ execute_internal_event (event); break; } + + PROFILE_RECORD_EXITING_SECTION (Qdispatch_event); return Qnil; } @@ -4818,6 +4845,9 @@ DEFSYMBOL (Qself_insert_defer_undo); DEFSYMBOL (Qcancel_mode_internal); + + DEFSYMBOL (Qnext_event); + DEFSYMBOL (Qdispatch_event); } void @@ -4874,6 +4904,11 @@ last_point_position_buffer = Qnil; staticpro (&last_point_position_buffer); + QSnext_event_internal = build_string ("next_event_internal()"); + staticpro (&QSnext_event_internal); + QSexecute_internal_event = build_string ("execute_internal_event()"); + staticpro (&QSexecute_internal_event); + DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes /* *Nonzero means echo unfinished commands after this many seconds of pause. */ );
--- a/src/event-tty.c Wed Feb 12 22:52:33 2003 +0000 +++ b/src/event-tty.c Thu Feb 13 09:57:08 2003 +0000 @@ -41,6 +41,10 @@ static struct event_stream *tty_event_stream; +#ifdef WIN32_ANY +extern int mswindows_is_blocking; +#endif + /************************************************************************/ /* timeout events */ @@ -118,7 +122,13 @@ pointer_to_this = &select_time_to_block; } +#ifdef WIN32_ANY + mswindows_is_blocking = 1; +#endif ndesc = select (MAXDESC, &temp_mask, 0, 0, pointer_to_this); +#ifdef WIN32_ANY + mswindows_is_blocking = 0; +#endif if (ndesc > 0) { /* Look for a TTY event */
--- a/src/extents.c Wed Feb 12 22:52:33 2003 +0000 +++ b/src/extents.c Thu Feb 13 09:57:08 2003 +0000 @@ -1,6 +1,6 @@ /* Copyright (c) 1994, 1995 Free Software Foundation, Inc. Copyright (c) 1995 Sun Microsystems, Inc. - Copyright (c) 1995, 1996, 2000, 2002 Ben Wing. + Copyright (c) 1995, 1996, 2000, 2002, 2003 Ben Wing. This file is part of XEmacs. @@ -226,6 +226,7 @@ #include "keymap.h" #include "opaque.h" #include "process.h" +#include "profile.h" #include "redisplay.h" #include "gutter.h" @@ -429,6 +430,9 @@ #define DE_MUST_BE_ATTACHED 2 Lisp_Object Vlast_highlighted_extent; + +Lisp_Object QSin_map_extents_internal; + Fixnum mouse_highlight_priority; Lisp_Object Qextentp; @@ -2121,8 +2125,9 @@ Extent_List_Marker *posm = 0; /* marker for extent list, if ME_MIGHT_MODIFY_EXTENTS */ /* count and struct for unwind-protect, if ME_MIGHT_THROW */ - int count = 0; + int count = specpdl_depth (); struct map_extents_struct closure; + PROFILE_DECLARE (); #ifdef ERROR_CHECK_EXTENTS assert (from <= to); @@ -2139,10 +2144,12 @@ } el = buffer_or_string_extent_list (obj); - if (!el || !extent_list_num_els(el)) + if (!el || !extent_list_num_els (el)) return; el = 0; + PROFILE_RECORD_ENTERING_SECTION (QSin_map_extents_internal); + st = buffer_or_string_bytexpos_to_memxpos (obj, from); en = buffer_or_string_bytexpos_to_memxpos (obj, to); @@ -2166,7 +2173,6 @@ /* The mapping function might throw past us so we need to use an unwind_protect() to eliminate the internal extent and range that we use. */ - count = specpdl_depth (); closure.range = range; closure.mkr = 0; record_unwind_protect (map_extents_unwind, @@ -2431,10 +2437,7 @@ /* ---------- Finished looping. ---------- */ } - if (flags & ME_MIGHT_THROW) - /* This deletes the range extent and frees the marker. */ - unbind_to (count); - else + if (!(flags & ME_MIGHT_THROW)) { /* Delete them ourselves */ if (range) @@ -2442,6 +2445,11 @@ if (posm) extent_list_delete_marker (el, posm); } + + /* This deletes the range extent and frees the marker, if ME_MIGHT_THROW. */ + unbind_to (count); + + PROFILE_RECORD_EXITING_SECTION (QSin_map_extents_internal); } /* ------------------------------- */ @@ -7421,4 +7429,7 @@ staticpro (&Vextent_face_reverse_memoize_hash_table); Vextent_face_reverse_memoize_hash_table = make_lisp_hash_table (100, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ); -} + + QSin_map_extents_internal = build_msg_string ("(in map-extents-internal)"); + staticpro (&QSin_map_extents_internal); +}
--- a/src/hash.c Wed Feb 12 22:52:33 2003 +0000 +++ b/src/hash.c Thu Feb 13 09:57:08 2003 +0000 @@ -1,5 +1,6 @@ /* Hash tables. Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. + Copyright (C) 2003 Ben Wing. This file is part of XEmacs. @@ -20,6 +21,9 @@ /* Synched up with: Not in FSF. */ +/* Author: Lost in the mists of history. At least back to Lucid 19.3, + circa Sep 1992. */ + #include <config.h> #include "lisp.h" #include "hash.h" @@ -207,6 +211,15 @@ } void +pregrow_hash_table_if_necessary (struct hash_table *hash_table, + Elemcount breathing_room) +{ + Elemcount comfortable_size = COMFORTABLE_SIZE (hash_table->fullness); + if (hash_table->size < comfortable_size - breathing_room) + grow_hash_table (hash_table, comfortable_size + 1); +} + +void puthash (const void *key, void *contents, struct hash_table *hash_table) { if (!key)
--- a/src/hash.h Wed Feb 12 22:52:33 2003 +0000 +++ b/src/hash.h Thu Feb 13 09:57:08 2003 +0000 @@ -1,4 +1,5 @@ -/* This file is part of XEmacs. +/* Copyright (C) 2003 Ben Wing. +This file is part of XEmacs. XEmacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the @@ -78,4 +79,10 @@ void map_remhash (remhash_predicate predicate, struct hash_table *hash_table, void *arg); +/* Grow the table if it has less than BREATHING_ROOM elements that can be + added before a resize will be triggered. After the grow, the table can + hold at least BREATHING_ROOM elements (and probably a lot more) before + needing resizing again. */ +void pregrow_hash_table_if_necessary (struct hash_table *hash_table, + Elemcount breathing_room); #endif /* INCLUDED_hash_h_ */
--- a/src/lisp.h Wed Feb 12 22:52:33 2003 +0000 +++ b/src/lisp.h Thu Feb 13 09:57:08 2003 +0000 @@ -1,7 +1,7 @@ /* Fundamental definitions for XEmacs Lisp interpreter. Copyright (C) 1985-1987, 1992-1995 Free Software Foundation, Inc. Copyright (C) 1993-1996 Richard Mlynarik. - Copyright (C) 1995, 1996, 2000, 2001, 2002 Ben Wing. + Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003 Ben Wing. This file is part of XEmacs. @@ -4036,6 +4036,7 @@ void warn_when_safe_lispobj (Lisp_Object, Lisp_Object, Lisp_Object); void warn_when_safe (Lisp_Object, Lisp_Object, const CIbyte *, ...) PRINTF_ARGS (3, 4); +extern int backtrace_with_internal_sections; /* Defined in event-stream.c */ @@ -4460,12 +4461,6 @@ void float_to_string (char *, double); void internal_object_printer (Lisp_Object, Lisp_Object, int); -/* Defined in profile.c */ -void mark_profiling_info (void); -void profile_increase_call_count (Lisp_Object); -extern int profiling_active; -extern int profiling_redisplay_flag; - /* Defined in rangetab.c */ EXFUN (Fclear_range_table, 1); EXFUN (Fget_range_table, 3);
--- a/src/lread.c Wed Feb 12 22:52:33 2003 +0000 +++ b/src/lread.c Thu Feb 13 09:57:08 2003 +0000 @@ -30,9 +30,10 @@ #include "buffer.h" #include "bytecode.h" #include "elhash.h" +#include "file-coding.h" #include "lstream.h" #include "opaque.h" -#include "file-coding.h" +#include "profile.h" #include "sysfile.h" #include "sysfloat.h" @@ -59,8 +60,7 @@ Lisp_Object Qvariable_domain; /* I18N3 */ Lisp_Object Vvalues, Vstandard_input, Vafter_load_alist; Lisp_Object Qcurrent_load_list; -Lisp_Object Qload, Qload_file_name; -Lisp_Object Qfset; +Lisp_Object Qload, Qload_file_name, Qload_internal, Qfset; /* Hash-table that maps directory names to hashes of their contents. */ static Lisp_Object Vlocate_file_hash_table; @@ -497,6 +497,7 @@ Lisp_Object older = Qnil; Lisp_Object handler = Qnil; Lisp_Object found = Qnil; + Lisp_Object retval; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; int reading_elc = 0; int from_require = EQ (nomessage, Qrequire); @@ -504,15 +505,20 @@ struct stat s1, s2; Ibyte *spaces = alloca_ibytes (load_in_progress * 2 + 10); int i; + PROFILE_DECLARE (); GCPRO4 (file, newer, older, found); CHECK_STRING (file); + PROFILE_RECORD_ENTERING_SECTION (Qload_internal); + /* If file name is magic, call the handler. */ handler = Ffind_file_name_handler (file, Qload); if (!NILP (handler)) - RETURN_UNGCPRO (call5 (handler, Qload, file, noerror, - nomessage, nosuffix)); + { + retval = call5 (handler, Qload, file, noerror, nomessage, nosuffix); + goto done; + } /* Do this after the handler to avoid the need to gcpro noerror, nomessage and nosuffix. @@ -551,8 +557,8 @@ signal_error (Qfile_error, "Cannot open load file", file); else { - UNGCPRO; - return Qnil; + retval = Qnil; + goto done; } } @@ -751,8 +757,11 @@ if (!noninteractive) PRINT_LOADING_MESSAGE ("done"); + retval = Qt; +done: + PROFILE_RECORD_EXITING_SECTION (Qload_internal); UNGCPRO; - return Qt; + return retval; } @@ -3016,6 +3025,7 @@ DEFSYMBOL (Qcurrent_load_list); DEFSYMBOL (Qload); DEFSYMBOL (Qload_file_name); + DEFSYMBOL (Qload_internal); DEFSYMBOL (Qfset); #ifdef LISP_BACKQUOTES @@ -3206,7 +3216,7 @@ #endif /* So that early-early stuff will work */ - Ffset (Qload, intern ("load-internal")); + Ffset (Qload, Qload_internal); #ifdef FEATUREP_SYNTAX DEFSYMBOL (Qfeaturep);
--- a/src/profile.c Wed Feb 12 22:52:33 2003 +0000 +++ b/src/profile.c Thu Feb 13 09:57:08 2003 +0000 @@ -1,5 +1,5 @@ /* Why the hell is XEmacs so fucking slow? - Copyright (C) 1996, 2002 Ben Wing. + Copyright (C) 1996, 2002, 2003 Ben Wing. Copyright (C) 1998 Free Software Foundation, Inc. This file is part of XEmacs. @@ -34,129 +34,340 @@ #error Sorry charlie. We need a scalpel and all we have is a lawnmower. #endif -/* We implement our own profiling scheme so that we can determine +#ifdef WIN32_ANY +int mswindows_is_blocking; +#endif + +/* Written by Ben Wing. + + We implement our own profiling scheme so that we can determine things like which Lisp functions are occupying the most time. Any standard OS-provided profiling works on C functions, which is - somewhat useless. + not always that useful -- and inconvenient, since it requires compiling + with profile info and can't be retrieved dynamically, as XEmacs is + running. The basic idea is simple. We set a profiling timer using setitimer - (ITIMER_PROF), which generates a SIGPROF every so often. (This - runs not in real time but rather when the process is executing or - the system is running on behalf of the process.) When the signal - goes off, we see what we're in, and add 1 to the count associated - with that function. + (ITIMER_PROF), which generates a SIGPROF every so often. (This runs not + in real time but rather when the process is executing or the system is + running on behalf of the process.) When the signal goes off, we see what + we're in, and add 1 to the count associated with that function. - It would be nice to use the Lisp allocation mechanism etc. to keep - track of the profiling information, but we can't because that's not - safe, and trying to make it safe would be much more work than it's - worth. + It would be nice to use the Lisp allocation mechanism etc. to keep track + of the profiling information (i.e. to use Lisp hash tables), but we + can't because that's not safe -- updating the timing information happens + inside of a signal handler, so we can't rely on not being in the middle + of Lisp allocation, garbage collection, malloc(), etc. Trying to make + it work would be much more work than it's worth. Instead we use a basic + (non-Lisp) hash table, which will not conflict with garbage collection + or anything else as long as it doesn't try to resize itself. Resizing + itself, however (which happens as a result of a puthash()), could be + deadly. To avoid this, we make sure, at points where it's safe + (e.g. profile_record_about_to_call() -- recording the entry into a + function call), that the table always has some breathing room in it so + that no resizes will occur until at least that many items are added. + This is safe because any new item to be added in the sigprof would + likely have the profile_record_about_to_call() called just before it, + and the breathing room is checked. - Jan 1998: In addition to this, I have added code to remember call + In general: any entry that the sigprof handler puts into the table comes + from a backtrace frame (except "Processing Events at Top Level", and + there's only one of those). Either that backtrace frame was added when + profiling was on (in which case profile_record_about_to_call() was + called and the breathing space updated), or when it was off -- and in + this case, no such frames can have been added since the last time + `start-profile' was called, so when `start-profile' is called we make + sure there is sufficient breathing room to account for all entries + currently on the stack. + + Jan 1998: In addition to timing info, I have added code to remember call counts of Lisp funcalls. The profile_increase_call_count() function is called from Ffuncall(), and serves to add data to Vcall_count_profile_table. This mechanism is much simpler and independent of the SIGPROF-driven one. It uses the Lisp allocation mechanism normally, since it is not called from a handler. It may even be useful to provide a way to turn on only one profiling - mechanism, but I haven't done so yet. --hniksic */ + mechanism, but I haven't done so yet. --hniksic + + Dec 2002: Total overhaul of the interface, making it sane and easier to + use. --ben + + Feb 2003: Lots of rewriting of the internal code. Add GC-consing-usage, + total GC usage, and total timing to the information tracked. Track + profiling overhead and allow the ability to have internal sections + (e.g. internal-external conversion, byte-char conversion) that are + treated like Lisp functions for the purpose of profiling. --ben + BEWARE: If you are modifying this file, be *very* careful. Correctly + implementing the "total" values is very tricky due to the possibility of + recursion and of functions already on the stack when starting to + profile/still on the stack when stopping. +*/ + +/* We use a plain table here because we're recording inside of a signal + handler. */ static struct hash_table *big_profile_table; +Lisp_Object Vtotal_timing_profile_table; Lisp_Object Vcall_count_profile_table; +Lisp_Object Vtotal_gc_usage_profile_table; +Lisp_Object Vgc_usage_profile_table; + +extern int lisp_eval_depth; + +extern EMACS_UINT total_consing; +static volatile EMACS_UINT total_ticks; Fixnum default_profiling_interval; int profiling_active; -/* The normal flag in_display is used as a critical-section flag - and is not set the whole time we're in redisplay. */ -int profiling_redisplay_flag; +static Lisp_Object QSprocessing_events_at_top_level; +static Lisp_Object QSunknown, QSprofile_overhead; + +static Lisp_Object Qtiming, Qtotal_timing, Qcall_count; +static Lisp_Object Qgc_usage, Qtotal_gc_usage; + +/* This needs to be >= the total number of defined internal sections, + plus 1 or 2?? Set it extra big just to be ultra-paranoid. */ +#define EXTRA_BREATHING_ROOM 100 -static Lisp_Object QSin_redisplay; -static Lisp_Object QSin_garbage_collection; -static Lisp_Object QSprocessing_events_at_top_level; -static Lisp_Object QSunknown; +/* We use profiling_lock to prevent the signal handler from writing to + the table while another routine is operating on it. We also set + profiling_lock in case the timeout between signal calls is short + enough to catch us while we're already in there. */ +static volatile int profiling_lock; -static Lisp_Object Qtiming, Qcall_count; +/* Whether we're in the process of doing *any* profiling-related stuff. + Used to indicate amount of time spent profiling. */ +static int in_profiling; + +#if 0 /* #### for KKCC, eventually */ -/* We use inside_profiling to prevent the handler from writing to - the table while another routine is operating on it. We also set - inside_profiling in case the timeout between signal calls is short - enough to catch us while we're already in there. */ -static volatile int inside_profiling; +static const struct memory_description hentry_description_1[] = { + { XD_LISP_OBJECT, offsetof (hentry, key) }, + { XD_END } +}; + +static const struct sized_memory_description hentry_description = { + sizeof (hentry), + hentry_description_1 +}; -static void -create_call_count_profile_table (void) -{ - if (NILP (Vcall_count_profile_table)) - Vcall_count_profile_table = - make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); -} +static const struct memory_description plain_hash_table_description_1[] = { + { XD_ELEMCOUNT, offsetof (struct hash_table, size) }, + { XD_STRUCT_PTR, offsetof (struct hash_table, harray), XD_INDIRECT (0, 0), + &hentry_description }, + { XD_END } +}; + +static const struct sized_memory_description plain_hash_table_description = { + sizeof (struct hash_table), + plain_hash_table_description_1 +}; + +#endif /* 0 */ static void create_timing_profile_table (void) { - /* #### The hash code can safely be called from a signal handler - except when it has to grow the hash table. In this case, it calls - realloc(), which is not (in general) re-entrant. We'll just be - sleazy and make the table large enough that it (hopefully) won't - need to be realloc()ed. */ + /* The hash code can safely be called from a signal handler except when + it has to grow the hash table. In this case, it calls realloc(), + which is not (in general) re-entrant. The way we deal with this is + documented at the top of this file. */ if (!big_profile_table) - big_profile_table = make_hash_table (10000); + big_profile_table = make_hash_table (2000); +} + +static void +create_profile_tables (void) +{ + create_timing_profile_table (); + if (NILP (Vtotal_timing_profile_table)) + Vtotal_timing_profile_table = + make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + if (NILP (Vcall_count_profile_table)) + Vcall_count_profile_table = + make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + if (NILP (Vgc_usage_profile_table)) + Vgc_usage_profile_table = + make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + if (NILP (Vtotal_gc_usage_profile_table)) + Vtotal_gc_usage_profile_table = + make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); +} + +static Lisp_Object +current_profile_function (void) +{ + Lisp_Object fun; + struct backtrace *bt = backtrace_list; + + /* 2 because we set in_profiling when we entered the current routine. */ + if (in_profiling >= 2) + return QSprofile_overhead; + + /* Find a function actually being called. Potentially (?) there could be + a number of non-calling funs -- calling foo autoloads, which tries to + call bar, but requires evalling its args first, which calls baz, ... + If profiling was not enabled when the function was called, just treat + the function as actually called, because the info about whether we've + finished the preamble will not have been recorded. */ + for (; bt && !bt->function_being_called; bt = bt->next) + ; + + if (bt) + { + fun = *bt->function; + + if (!SYMBOLP (fun) + && !COMPILED_FUNCTIONP (fun) + && !SUBRP (fun) + && !CONSP (fun) + && !STRINGP (fun)) + fun = QSunknown; + } + else + fun = QSprocessing_events_at_top_level; + return fun; +} + +void +profile_record_consing (EMACS_INT size) +{ + Lisp_Object fun; + Lisp_Object count; + + in_profiling++; + fun = current_profile_function (); + count = Fgethash (fun, Vgc_usage_profile_table, Qzero); + Fputhash (fun, make_int (size + XINT (count)), Vgc_usage_profile_table); + in_profiling--; +} + +void +profile_record_unconsing (EMACS_INT size) +{ + /* If we don't want to record values less than 0, change this; but then + the totals won't be accurate. */ + profile_record_consing (-size); } -/* Increase the value of OBJ in Vcall_count_profile_table hash table. - If the hash table is nil, create it first. */ -void -profile_increase_call_count (Lisp_Object obj) +inline static void +profile_sow_backtrace (struct backtrace *bt) { - Lisp_Object count; + bt->current_total_timing_val = + XINT (Fgethash (*bt->function, Vtotal_timing_profile_table, Qzero)); + bt->current_total_gc_usage_val = + XINT (Fgethash (*bt->function, Vtotal_gc_usage_profile_table, Qzero)); + bt->function_being_called = 1; + /* Need to think carefully about the exact order of operations here + so that we don't end up with totals being less than function-only + values; */ + bt->total_consing_at_start = total_consing; + /* Order of operation is tricky here because we want the total function + time to be as close as possible to (and absolutely not less than) the + function-only time. From the sigprof-handler's perspective, the + function is "entered" the moment we finish executing the + in_profiling-- statement below, and ends the moment we finish + executing the in_profiling++ statement in + profile_record_just_called(). By recording the tick value as close as + possible to the "in-function" window but not in it, we satisfy the + conditions just mentioned. */ + bt->total_ticks_at_start = total_ticks; +} - create_call_count_profile_table (); +void +profile_record_about_to_call (struct backtrace *bt) +{ + in_profiling++; + profiling_lock = 1; + /* See comments in create_timing_profile_table(). */ + pregrow_hash_table_if_necessary (big_profile_table, EXTRA_BREATHING_ROOM); + profiling_lock = 0; + Fputhash (*bt->function, + make_int (1 + XINT (Fgethash (*bt->function, + Vcall_count_profile_table, + Qzero))), + Vcall_count_profile_table); + /* This may be set if the function was in its preamble at the time that + `start-profiling' was called. If so, we shouldn't reset the values + because we may get inconsistent results, since we have already started + recording ticks and consing for the function. */ + if (!bt->function_being_called) + profile_sow_backtrace (bt); + in_profiling--; +} - count = Fgethash (obj, Vcall_count_profile_table, Qzero); - if (!INTP (count)) - count = Qzero; - Fputhash (obj, make_int (1 + XINT (count)), Vcall_count_profile_table); +inline static void +profile_reap_backtrace (struct backtrace *bt) +{ + EMACS_UINT ticks; + /* The following statement *MUST* come directly after the preceding one! + See the comment above. */ + ticks = total_ticks; + /* We need to reset the "in-function" flag here. Otherwise the sigprof + handler will record more ticks for the function while the post-amble + is executing, and its value will be > our total value. */ + bt->function_being_called = 0; + Fputhash (*bt->function, + /* This works even when the total_ticks value has overwrapped. + Same for total_consing below. */ + make_int ((EMACS_INT) (ticks - bt->total_ticks_at_start) + + bt->current_total_timing_val), + Vtotal_timing_profile_table); + Fputhash (*bt->function, + make_int ((EMACS_INT) + (total_consing - bt->total_consing_at_start) + + bt->current_total_gc_usage_val), + Vtotal_gc_usage_profile_table); +} + +void +profile_record_just_called (struct backtrace *bt) +{ + in_profiling++; + profile_reap_backtrace (bt); + in_profiling--; +} + +/* Called when unwinding the catch stack after a throw or signal, to + note that we are exiting the function. */ +void +profile_record_unwind (struct backtrace *bt) +{ + /* We may have thrown while still in a function's preamble. */ + if (bt->function_being_called) + profile_record_just_called (bt); } static SIGTYPE sigprof_handler (int signo) { +#ifdef WIN32_ANY + /* Windows unfortunately does not have any such thing as setitimer + (ITIMER_PROF, ...), which runs in process time. Everything is real + time. So to get slightly more reasonable results, ignore completely + the times when we're blocking. Same applies, of course, to Cygwin. */ + if (mswindows_is_blocking) + return; +#endif + + in_profiling++; + total_ticks++; + /* Don't do anything if we are shutting down, or are doing a maphash or clrhash on the table. */ - if (!inside_profiling && !preparing_for_armageddon) + if (!profiling_lock && !preparing_for_armageddon) { - Lisp_Object fun; + Lisp_Object fun = current_profile_function (); /* If something below causes an error to be signaled, we'll not correctly reset this flag. But we'll be in worse shape than that anyways, since we'll longjmp back to the last condition case. */ - inside_profiling = 1; - - if (profiling_redisplay_flag) - fun = QSin_redisplay; - else if (gc_in_progress) - fun = QSin_garbage_collection; - else if (backtrace_list) - { - fun = *backtrace_list->function; - - if (!SYMBOLP (fun) - && !COMPILED_FUNCTIONP (fun) - && !SUBRP (fun) - && !CONSP (fun)) - fun = QSunknown; - } - else - fun = QSprocessing_events_at_top_level; + profiling_lock = 1; { - /* #### see comment about memory allocation in start-profiling. - Allocating memory in a signal handler is BAD BAD BAD. - If you are using the non-mmap rel-alloc code, you might - lose because of this. Even worse, if the memory allocation - fails, the `error' generated whacks everything hard. */ long count; const void *vval; @@ -169,34 +380,41 @@ puthash (LISP_TO_VOID (fun), (void *) vval, big_profile_table); } - inside_profiling = 0; + profiling_lock = 0; } + in_profiling--; } -DEFUN ("start-profiling", Fstart_profiling, 0, 1, 0, /* +DEFUN ("start-profiling", Fstart_profiling, 0, 1, "", /* Start profiling, with profile queries every MICROSECS. If MICROSECS is nil or omitted, the value of `default-profiling-interval' is used. Information on function timings and call counts is currently recorded. -You can retrieve the recorded profiling info using `get-profiling-info'. +You can retrieve the recorded profiling info using `get-profiling-info', +or the higher-level function `profile-results'. Starting and stopping profiling does not clear the currently recorded info. Thus you can start and stop as many times as you want and everything -will be properly accumulated. +will be properly accumulated. (To clear, use `clear-profiling-info'.) */ (microsecs)) { /* This function can GC */ int msecs; struct itimerval foo; + int depth; - /* #### The hash code can safely be called from a signal handler - except when it has to grow the hash table. In this case, it calls - realloc(), which is not (in general) re-entrant. We'll just be - sleazy and make the table large enough that it (hopefully) won't - need to be realloc()ed. */ - create_timing_profile_table (); + if (profiling_active) + return Qnil; + depth = internal_bind_int (&in_profiling, 1 + in_profiling); + + create_profile_tables (); + /* See comments at top of file and in create_timing_profile_table(). + We ensure enough breathing room for all entries currently on the + stack. */ + pregrow_hash_table_if_necessary (big_profile_table, + EXTRA_BREATHING_ROOM + lisp_eval_depth); if (NILP (microsecs)) msecs = default_profiling_interval; @@ -209,17 +427,28 @@ msecs = 1000; set_timeout_signal (SIGPROF, sigprof_handler); + { + struct backtrace *bt = backtrace_list; + + /* When we begin profiling, pretend like we just entered all the + functions currently on the stack. When we stop profiling, do the + opposite. This ensures consistent values being recorded for both + function-only and total in such cases. */ + for (; bt; bt = bt->next) + profile_sow_backtrace (bt); + } + profiling_active = 1; + profiling_lock = 0; foo.it_value.tv_sec = 0; foo.it_value.tv_usec = msecs; EMACS_NORMALIZE_TIME (foo.it_value); foo.it_interval = foo.it_value; - profiling_active = 1; - inside_profiling = 0; qxe_setitimer (ITIMER_PROF, &foo, 0); + unbind_to (depth); return Qnil; } -DEFUN ("stop-profiling", Fstop_profiling, 0, 0, 0, /* +DEFUN ("stop-profiling", Fstop_profiling, 0, 0, "", /* Stop profiling. */ ()) @@ -227,12 +456,22 @@ /* This function does not GC */ struct itimerval foo; + if (!profiling_active) + return Qnil; + in_profiling++; foo.it_value.tv_sec = 0; foo.it_value.tv_usec = 0; foo.it_interval = foo.it_value; qxe_setitimer (ITIMER_PROF, &foo, 0); profiling_active = 0; + { + struct backtrace *bt = backtrace_list; + + for (; bt; bt = bt->next) + profile_reap_backtrace (bt); + } set_timeout_signal (SIGPROF, fatal_error_signal); + in_profiling--; return Qnil; } @@ -243,15 +482,24 @@ */ ()) { + in_profiling++; /* This function does not GC */ if (big_profile_table) { - inside_profiling = 1; + profiling_lock = 1; clrhash (big_profile_table); - inside_profiling = 0; + profiling_lock = 0; } + if (!NILP (Vtotal_timing_profile_table)) + Fclrhash (Vtotal_timing_profile_table); if (!NILP (Vcall_count_profile_table)) Fclrhash (Vcall_count_profile_table); + if (!NILP (Vgc_usage_profile_table)) + Fclrhash (Vgc_usage_profile_table); + if (!NILP (Vtotal_gc_usage_profile_table)) + Fclrhash (Vtotal_gc_usage_profile_table); + in_profiling--; + return Qnil; } @@ -278,6 +526,14 @@ return 0; } +static Lisp_Object +copy_hash_table_or_blank (Lisp_Object table) +{ + return !NILP (table) ? Fcopy_hash_table (table) : + make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, + HASH_TABLE_EQ); +} + DEFUN ("get-profiling-info", Fget_profiling_info, 0, 0, 0, /* Return the currently recorded profiling info. The format is a plist of symbols describing type of info recorded and @@ -285,41 +541,67 @@ are recorded `timing' - A hash table of funcallable objects or strings describing internal processing - operations \(redisplay, garbage collection, etc.), along with associated - tick counts (the frequency of ticks is controlled by - `default-profiling-interval' or the argument to `start-profiling'). + A hash table of function descriptions (funcallable objects or strings + describing internal processing operations -- redisplay, garbage + collection, etc.), along with associated tick counts (the frequency of + ticks is controlled by `default-profiling-interval' or the argument to + `start-profiling'). + +`total-timing' + A hash table of function descriptions and associated timing count for + the function and all descendants. `call-count' - A hash table of funcallable objects and associated call counts. + A hash table of function descriptions and associated call counts. + +`gc-usage' + A hash table of function descriptions and associated amount of consing. + +`total-gc-usage' + A hash table of function descriptions and associated amount of consing + in the function and all descendants. */ ()) { /* This function does not GC */ struct get_profiling_info_closure closure; + Lisp_Object retv; + int depth = internal_bind_int (&in_profiling, 1 + in_profiling); + const void *overhead; closure.timing = make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); if (big_profile_table) { - int count = internal_bind_int ((int *) &inside_profiling, 1); + int count = internal_bind_int ((int *) &profiling_lock, 1); maphash (get_profiling_info_timing_maphash, big_profile_table, &closure); + + /* OK, OK ... the total-timing table is not going to have an entry + for profile overhead, and it looks strange for it to come out 0, + so make sure it looks reasonable. */ + if (!gethash (LISP_TO_VOID (QSprofile_overhead), big_profile_table, + &overhead)) + overhead = 0; + Fputhash (QSprofile_overhead, make_int ((EMACS_INT) overhead), + Vtotal_timing_profile_table); + unbind_to (count); } - return list4 (Qtiming, closure.timing, Qcall_count, - !NILP (Vcall_count_profile_table) ? - Fcopy_hash_table (Vcall_count_profile_table) : - make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, - HASH_TABLE_EQ)); + retv = nconc2 (list6 (Qtiming, closure.timing, Qtotal_timing, + copy_hash_table_or_blank (Vtotal_timing_profile_table), + Qcall_count, + copy_hash_table_or_blank (Vcall_count_profile_table)), + list4 (Qgc_usage, + copy_hash_table_or_blank (Vgc_usage_profile_table), + Qtotal_gc_usage, + copy_hash_table_or_blank (Vtotal_gc_usage_profile_table + ))); + unbind_to (depth); + return retv; } -struct set_profiling_info_closure -{ - Lisp_Object timing; -}; - static int set_profiling_info_timing_maphash (Lisp_Object key, Lisp_Object val, @@ -343,9 +625,11 @@ */ (info)) { + int depth; /* This function does not GC */ Fclear_profiling_info (); + depth = internal_bind_int (&in_profiling, 1 + in_profiling); { EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, info) { @@ -353,18 +637,25 @@ { CHECK_HASH_TABLE (value); create_timing_profile_table (); + profiling_lock = 1; elisp_maphash_unsafe (set_profiling_info_timing_maphash, value, NULL); + profiling_lock = 0; } else if (EQ (key, Qcall_count)) - { - Vcall_count_profile_table = Fcopy_hash_table (value); - } + Vcall_count_profile_table = Fcopy_hash_table (value); + else if (EQ (key, Qtotal_timing)) + Vtotal_timing_profile_table = Fcopy_hash_table (value); + else if (EQ (key, Qgc_usage)) + Vgc_usage_profile_table = Fcopy_hash_table (value); + else if (EQ (key, Qtotal_gc_usage)) + Vtotal_gc_usage_profile_table = Fcopy_hash_table (value); else invalid_constant ("Unrecognized profiling-info keyword", key); } } + unbind_to (depth); return Qnil; } @@ -373,10 +664,7 @@ void *void_val, void *void_closure) { - Lisp_Object key; - - key = VOID_TO_LISP (void_key); - mark_object (key); + mark_object (VOID_TO_LISP (void_key)); return 0; } @@ -386,9 +674,9 @@ /* This function does not GC */ if (big_profile_table) { - inside_profiling = 1; + profiling_lock = 1; maphash (mark_profiling_info_maphash, big_profile_table, 0); - inside_profiling = 0; + profiling_lock = 0; } } @@ -426,18 +714,34 @@ staticpro (&Vcall_count_profile_table); Vcall_count_profile_table = Qnil; - inside_profiling = 0; + staticpro (&Vgc_usage_profile_table); + Vgc_usage_profile_table = Qnil; + + staticpro (&Vtotal_gc_usage_profile_table); + Vtotal_gc_usage_profile_table = Qnil; + + staticpro (&Vtotal_timing_profile_table); + Vtotal_timing_profile_table = Qnil; - QSin_redisplay = build_msg_string ("(in redisplay)"); - staticpro (&QSin_redisplay); - QSin_garbage_collection = build_msg_string ("(in garbage collection)"); - staticpro (&QSin_garbage_collection); +#if 0 + /* #### This is supposed to be for KKCC but KKCC doesn't use this stuff + currently. */ + dump_add_root_struct_ptr (&big_profile_table, &plain_hash_table_description); +#endif /* 0 */ + + profiling_lock = 0; + QSunknown = build_msg_string ("(unknown)"); staticpro (&QSunknown); QSprocessing_events_at_top_level = build_msg_string ("(processing events at top level)"); staticpro (&QSprocessing_events_at_top_level); + QSprofile_overhead = build_msg_string ("(profile overhead)"); + staticpro (&QSprofile_overhead); DEFSYMBOL (Qtiming); + DEFSYMBOL (Qtotal_timing); DEFSYMBOL (Qcall_count); + DEFSYMBOL (Qgc_usage); + DEFSYMBOL (Qtotal_gc_usage); }
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/profile.h Thu Feb 13 09:57:08 2003 +0000 @@ -0,0 +1,97 @@ +/* Profiling. + Copyright (C) 2003 Ben Wing. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +/* Authorship: + + Ben Wing: Feb 2003. + */ + +#include "backtrace.h" + +void mark_profiling_info (void); +void profile_record_unwind (struct backtrace *); +void profile_record_about_to_call (struct backtrace *); +void profile_record_just_called (struct backtrace *); +void profile_record_consing (EMACS_INT size); +void profile_record_unconsing (EMACS_INT size); +extern int profiling_active; + +/* We call about_to_call() and just_called() depending on the current + *dynamic* value of profiling_active (which could change as a result of + calling the function) but if we push a backtrace, we must pop it later, + so we need to remember the status of this. */ +#define PROFILE_DECLARE() \ +int do_backtrace = profiling_active || backtrace_with_internal_sections; \ +struct backtrace backtrace + +/* As just mentioned, we rely on the dynamic value of profiling_active. + This ensures correct behavior (e.g. we never modify the profiling info + when profiling is not active) because we seed and reap all functions + currently on the stack when starting and stopping. See + `start-profiling'. */ +#define PROFILE_ENTER_FUNCTION() \ +do \ +{ \ + if (profiling_active) \ + profile_record_about_to_call (&backtrace); \ +} \ +while (0) + +#define PROFILE_EXIT_FUNCTION() \ +do \ +{ \ + if (profiling_active) \ + profile_record_just_called (&backtrace); \ +} \ +while (0) + +/* We are entering a section that we would like to record profile information + about. We put this information into the backtrace list, just like + normal functions do. That is one easy way to make sure that we always + record info on the innermost section or function, whether section or + function. (To do this, we always need some sort of collusion between + profile and eval; this is one way.) */ + +#define PROFILE_RECORD_ENTERING_SECTION(var) \ +do \ +{ \ + if (do_backtrace) \ + { \ + backtrace.function = &var; \ + backtrace.args = NULL; \ + backtrace.nargs = UNEVALLED; \ + backtrace.evalargs = 0; \ + backtrace.pdlcount = specpdl_depth (); \ + backtrace.debug_on_exit = 0; \ + backtrace.function_being_called = 0; \ + PUSH_BACKTRACE (backtrace); \ + } \ + PROFILE_ENTER_FUNCTION (); \ +} while (0) + +#define PROFILE_RECORD_EXITING_SECTION(var) \ +do \ +{ \ + PROFILE_EXIT_FUNCTION (); \ + if (do_backtrace) \ + POP_BACKTRACE (backtrace); \ +} while (0)
--- a/src/redisplay.c Wed Feb 12 22:52:33 2003 +0000 +++ b/src/redisplay.c Thu Feb 13 09:57:08 2003 +0000 @@ -69,6 +69,7 @@ #include "menubar.h" #include "objects-impl.h" #include "process.h" +#include "profile.h" #include "redisplay.h" #include "toolbar.h" #include "window-impl.h" @@ -500,6 +501,8 @@ Lisp_Object Vuse_left_overflow, Vuse_right_overflow; Lisp_Object Vtext_cursor_visible_p; +static Lisp_Object QSin_redisplay; + int column_number_start_at_one; Lisp_Object Qtop_bottom; @@ -6860,10 +6863,9 @@ { Lisp_Object devcons, concons; int size_change_failed = 0; - int count = specpdl_depth (); - - if (profiling_active) - internal_bind_int (&profiling_redisplay_flag, 1); + PROFILE_DECLARE (); + + PROFILE_RECORD_ENTERING_SECTION (QSin_redisplay); if (asynch_device_change_pending) handle_asynch_device_change (); @@ -6911,10 +6913,11 @@ reset_buffer_changes (); done: - unbind_to (count); #ifdef ERROR_CHECK_DISPLAY sledgehammer_check_redisplay_structs (); #endif /* ERROR_CHECK_DISPLAY */ + + PROFILE_RECORD_EXITING_SECTION (QSin_redisplay); } /* Note: All places in the C code that call redisplay() are prepared @@ -9655,6 +9658,8 @@ void vars_of_redisplay (void) { + QSin_redisplay = build_msg_string ("(in redisplay)"); + staticpro (&QSin_redisplay); #if 0 staticpro (&last_arrow_position);
--- a/src/text.c Wed Feb 12 22:52:33 2003 +0000 +++ b/src/text.c Thu Feb 13 09:57:08 2003 +0000 @@ -1,6 +1,6 @@ /* Buffer manipulation primitives for XEmacs. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 1996, 2000, 2001, 2002 Ben Wing. + Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003 Ben Wing. Copyright (C) 1999 Martin Buchholz. This file is part of XEmacs. @@ -32,6 +32,7 @@ #include "charset.h" #include "file-coding.h" #include "lstream.h" +#include "profile.h" /************************************************************************/ @@ -40,19 +41,71 @@ /* ========================================================================== - 1. Character Sets + 1. Intro to Characters, Character Sets, and Encodings ========================================================================== - A character set (or "charset") is an ordered set of characters. - A character (which is, BTW, a surprisingly complex concept) is, in a written representation of text, the most basic written unit that has a meaning of its own. It's comparable to a phoneme when analyzing words - in spoken speech. Just like with a phoneme (which is an abstract - concept, and is represented in actual spoken speech by one or more - allophones, ...&&#### finish this., a character is actually an abstract - concept + in spoken speech (for example, the sound of `t' in English, which in + fact has different pronunciations in different words -- aspirated in + `time', unaspirated in `stop', unreleased or even pronounced as a + glottal stop in `button', etc. -- but logically is a single concept). + Like a phoneme, a character is an abstract concept defined by its + *meaning*. The character `lowercase f', for example, can always be used + to represent the first letter in the word `fill', regardless of whether + it's drawn upright or italic, whether the `fi' combination is drawn as a + single ligature, whether there are serifs on the bottom of the vertical + stroke, etc. (These different appearances of a single character are + often called "graphs" or "glyphs".) Our concern when representing text + is on representing the abstract characters, and not on their exact + appearance. + + A character set (or "charset"), as we define it, is a set of characters, + each with an associated number (or set of numbers -- see below), called + a "code point". It's important to understand that a character is not + defined by any number attached to it, but by its meaning. For example, + ASCII and EBCDIC are two charsets containing exactly the same characters + (lowercase and uppercase letters, numbers 0 through 9, particular + punctuation marks) but with different numberings. The `comma' character + in ASCII and EBCDIC, for instance, is the same character despite having + a different numbering. Conversely, when comparing ASCII and JIS-Roman, + which look the same except that the latter has a yen sign substituted + for the backslash, we would say that the backslash and yen sign are + *not* the same characters, despite having the same number (95) and + despite the fact that all other characters are present in both charsets, + with the same numbering. ASCII and JIS-Roman, then, do *not* have + exactly the same characters in them (ASCII has a backslash character but + no yen-sign character, and vice-versa for JIS-Roman), unlike ASCII and + EBCDIC, even though the numberings in ASCII and JIS-Roman are closer. + + It's also important to distinguish between charsets and encodings. For + a simple charset like ASCII, there is only one encoding normally used -- + each character is represented by a single byte, with the same value as + its code point. For more complicated charsets, however, things are not + so obvious. Unicode version 2, for example, is a large charset with + thousands of characters, each indexed by a 16-bit number, often + represented in hex, e.g. 0x05D0 for the Hebrew letter "aleph". One + obvious encoding uses two bytes per character (actually two encodings, + depending on which of the two possible byte orderings is chosen). This + encoding is convenient for internal processing of Unicode text; however, + it's incompatible with ASCII, so a different encoding, e.g. UTF-8, is + usually used for external text, for example files or e-mail. UTF-8 + represents Unicode characters with one to three bytes (often extended to + six bytes to handle characters with up to 31-bit indices). Unicode + characters 00 to 7F (identical with ASCII) are directly represented with + one byte, and other characters with two or more bytes, each in the range + 80 to FF. + + In general, a single encoding may be able to represent more than one + charset. + + See also man/lispref/mule.texi. + ========================================================================== + 2. Character Sets + ========================================================================== + A particular character in a charset is indexed using one or more "position codes", which are non-negative integers. The number of position codes needed to identify a particular @@ -131,7 +184,7 @@ This is a bit ad-hoc but gets the job done. ========================================================================== - 2. Encodings + 3. Encodings ========================================================================== An "encoding" is a way of numerically representing @@ -212,7 +265,7 @@ Initially, Printing-ASCII is invoked. ========================================================================== - 3. Internal Mule Encodings + 4. Internal Mule Encodings ========================================================================== In XEmacs/Mule, each character set is assigned a unique number, @@ -336,7 +389,7 @@ of the search string and &&#### finish this. ========================================================================== - 4. Buffer Positions and Other Typedefs + 5. Buffer Positions and Other Typedefs ========================================================================== A. Buffer Positions @@ -383,7 +436,7 @@ B. Other Typedefs Ichar: - ------- + ------ This typedef represents a single Emacs character, which can be ASCII, ISO-8859, or some extended character, as would typically be used for Kanji. Note that the representation of a character @@ -405,7 +458,7 @@ the standard 8-bit representation of ASCII/ISO-8859-1. Ibyte: - -------- + ------ The data in a buffer or string is logically made up of Ibyte objects, where a Ibyte takes up the same amount of space as a char. (It is declared differently, though, to catch invalid @@ -428,8 +481,8 @@ within the string, you need merely use standard searching routines. - array of char: - -------------- + Extbyte: + -------- Strings that go in or out of Emacs are in "external format", typedef'ed as an array of char or a char *. There is more than one external format (JIS, EUC, etc.) but they all @@ -515,26 +568,27 @@ case. #### unfinished ========================================================================== - 5. Miscellaneous + 6. Miscellaneous ========================================================================== A. Unicode Support - Adding Unicode support is very desirable. Unicode will likely be a - very common representation in the future, and thus we should - represent Unicode characters using three bytes instead of four. - This means we need to find leading bytes for Unicode. Given that - there are 65,536 characters in Unicode and we can attach 96x96 = - 9,216 characters per leading byte, we need eight leading bytes for - Unicode. We currently have four free (0x9A - 0x9D), and with a - little bit of rearranging we can get five: ASCII doesn't really - need to take up a leading byte. (We could just as well use 0x7F, - with a little change to the functions that assume that 0x80 is the - lowest leading byte.) This means we still need to dump three - leading bytes and move them into private space. The CNS charsets - are good candidates since they are rarely used, and - JAPANESE_JISX0208_1978 is becoming less and less used and could - also be dumped. + Unicode support is very desirable. Currrently we know how to handle + externally-encoded Unicode data in various encodings -- UTF-16, UTF-8, + etc. However, we really need to represent Unicode characters internally + as-is, rather than converting to some language-specific character set. + For efficiency, we should represent Unicode characters using 3 bytes + rather than 4. This means we need to find leading bytes for Unicode. + Given that there are 65,536 characters in Unicode and we can attach + 96x96 = 9,216 characters per leading byte, we need eight leading bytes + for Unicode. We currently have four free (0x9A - 0x9D), and with a + little bit of rearranging we can get five: ASCII doesn't really need to + take up a leading byte. (We could just as well use 0x7F, with a little + change to the functions that assume that 0x80 is the lowest leading + byte.) This means we still need to dump three leading bytes and move + them into private space. The CNS charsets are good candidates since + they are rarely used, and JAPANESE_JISX0208_1978 is becoming less and + less used and could also be dumped. B. Composite Characters @@ -624,6 +678,9 @@ #endif /* MULE */ +Lisp_Object QSin_char_byte_conversion; +Lisp_Object QSin_internal_external_conversion; + /************************************************************************/ /* qxestr***() functions */ @@ -1599,6 +1656,7 @@ Bytebpos retval; int diff_so_far; int add_to_cache = 0; + PROFILE_DECLARE (); /* Check for some cached positions, for speed. */ if (x == BUF_PT (buf)) @@ -1608,6 +1666,8 @@ if (x == BUF_BEGV (buf)) return BYTE_BUF_BEGV (buf); + PROFILE_RECORD_ENTERING_SECTION (QSin_char_byte_conversion); + bufmin = buf->text->mule_bufmin; bufmax = buf->text->mule_bufmax; bytmin = buf->text->mule_bytmin; @@ -1858,6 +1918,8 @@ buf->text->mule_bytebpos_cache[replace_loc] = retval; } + PROFILE_RECORD_EXITING_SECTION (QSin_char_byte_conversion); + return retval; } @@ -1876,6 +1938,7 @@ Charbpos retval; int diff_so_far; int add_to_cache = 0; + PROFILE_DECLARE (); /* Check for some cached positions, for speed. */ if (x == BYTE_BUF_PT (buf)) @@ -1885,6 +1948,8 @@ if (x == BYTE_BUF_BEGV (buf)) return BUF_BEGV (buf); + PROFILE_RECORD_ENTERING_SECTION (QSin_char_byte_conversion); + bufmin = buf->text->mule_bufmin; bufmax = buf->text->mule_bufmax; bytmin = buf->text->mule_bytmin; @@ -2135,6 +2200,8 @@ buf->text->mule_bytebpos_cache[replace_loc] = x; } + PROFILE_RECORD_EXITING_SECTION (QSin_char_byte_conversion); + return retval; } @@ -2759,8 +2826,13 @@ /* It's guaranteed that many callers are not prepared for GC here, esp. given that this code conversion occurs in many very hidden places. */ - int count = begin_gc_forbidden (); + int count; Extbyte_dynarr *conversion_out_dynarr; + PROFILE_DECLARE (); + + PROFILE_RECORD_ENTERING_SECTION (QSin_internal_external_conversion); + + count = begin_gc_forbidden (); type_checking_assert (((source_type == DFC_TYPE_DATA) || @@ -2945,6 +3017,8 @@ Dynarr_add (conversion_out_dynarr, '\0'); sink->data.ptr = Dynarr_atp (conversion_out_dynarr, 0); } + + PROFILE_RECORD_EXITING_SECTION (QSin_internal_external_conversion); } void @@ -2957,8 +3031,13 @@ /* It's guaranteed that many callers are not prepared for GC here, esp. given that this code conversion occurs in many very hidden places. */ - int count = begin_gc_forbidden (); + int count; Ibyte_dynarr *conversion_in_dynarr; + PROFILE_DECLARE (); + + PROFILE_RECORD_ENTERING_SECTION (QSin_internal_external_conversion); + + count = begin_gc_forbidden (); type_checking_assert ((source_type == DFC_TYPE_DATA || @@ -3010,7 +3089,8 @@ #endif } #ifdef HAVE_WIN32_CODING_SYSTEMS - /* Optimize the common case involving Unicode where only ASCII/Latin-1 is involved */ + /* Optimize the common case involving Unicode where only ASCII/Latin-1 is + involved */ else if (source_type != DFC_TYPE_LISP_LSTREAM && sink_type != DFC_TYPE_LISP_LSTREAM && dfc_coding_system_is_unicode (coding_system)) @@ -3135,6 +3215,8 @@ Dynarr_add (conversion_in_dynarr, '\0'); sink->data.ptr = Dynarr_atp (conversion_in_dynarr, 0); } + + PROFILE_RECORD_EXITING_SECTION (QSin_internal_external_conversion); } @@ -3668,6 +3750,12 @@ { reinit_vars_of_text (); + QSin_char_byte_conversion = build_msg_string ("(in char-byte conversion)"); + staticpro (&QSin_char_byte_conversion); + QSin_internal_external_conversion = + build_msg_string ("(in internal-external conversion)"); + staticpro (&QSin_internal_external_conversion); + #ifdef ENABLE_COMPOSITE_CHARS /* #### not dumped properly */ composite_char_row_next = 32;
--- a/src/unicode.c Wed Feb 12 22:52:33 2003 +0000 +++ b/src/unicode.c Thu Feb 13 09:57:08 2003 +0000 @@ -2076,7 +2076,8 @@ /* #### FUCKME! There should really be an ASCII detector. This would rule out the need to have this built-in here as well. --ben */ - int pct_ascii = ((100 * data->num_ascii) / data->byteno); + int pct_ascii = data->byteno ? (100 * data->num_ascii) / data->byteno + : 100; if (pct_ascii > 90) SET_DET_RESULTS (st, utf_16, DET_QUITE_IMPROBABLE);