11:26 p.m.
At some point I got "Bad using clause" in the loop macro called from
profile-results.
Progressively evaluating macros allowed me to edebug more and more of
the problems in profile-results, but I got stuck at some point yesterday.
Adrian
----------------------------------------------------------------------------
Crash on third toggle:
Fatal error.
Your files have been auto-saved.
Use `M-x recover-session' to recover them.
Your version of XEmacs was distributed with a PROBLEMS file that may describe
your crash, and with luck a workaround. Please check it first, but do report
the crash anyway.
Please report this bug by invoking M-x report-emacs-bug, or by selecting
`Send Bug Report' from the Help menu. If that won't work, send ordinary
email to `xemacs-beta(a)xemacs.org'. *MAKE SURE* to include this entire
output from this crash, especially including the Lisp backtrace, as well as
the XEmacs configuration from M-x describe-installation (or equivalently,
the file `Installation' in the top of the build tree).
If you are fortunate enough to have some sort of debugging aid installed
on your system, for example Visual C++, and you can get a C stack backtrace,
*please* include it, as it will make our life far easier.
Lisp backtrace follows:
# (unwind-protect ...)
# (unwind-protect ...)
# (unwind-protect ...)
# (unwind-protect ...)
# (unwind-protect ...)
# (unwind-protect ...)
# (unwind-protect ...)
# (unwind-protect ...)
format("%s"
string = XSTRING_DATA (ls);
doprnt.c
emacs_doprnt_1(Lisp_Object {...}, const unsigned char * 0x0289dbd0, long 2, Lisp_Object
{...}, int 1, const Lisp_Object * 0x0082e20c, char * 0x0082e0d8) line 572 + 3 bytes
emacs_doprnt(Lisp_Object {...}, const unsigned char * 0x00000000, long 0, Lisp_Object
{...}, int 1, const Lisp_Object * 0x0082e20c) line 866 + 33 bytes
emacs_vsprintf_string_lisp(const char * 0x00000000, Lisp_Object {...}, int 1, const
Lisp_Object * 0x0082e20c) line 899 + 59 bytes
Fformat(int 2, Lisp_Object * 0x0082e208) line 2219 + 27 bytes
Ffuncall(int 3, Lisp_Object * 0x0082e204) line 3870 + 14 bytes
execute_optimized_program(const unsigned char * 0x02e6eeb0, int 4, Lisp_Object *
0x02ec4d18) line 823 + 16 bytes
funcall_compiled_function(Lisp_Object {...}, int 1, Lisp_Object * 0x0082e6dc) line 3460 +
35 bytes
Ffuncall(int 2, Lisp_Object * 0x0082e6d8) line 3886 + 17 bytes
mapcar1(long 127, Lisp_Object * 0x0082e6fc, Lisp_Object {...}, Lisp_Object {...}) line
3195 + 11 bytes
Fmapcar(Lisp_Object {...}, Lisp_Object {...}) line 3303 + 21 bytes
Ffuncall(int 3, Lisp_Object * 0x0082ea04) line 3847 + 120 bytes
execute_optimized_program(const unsigned char * 0x02e91b28, int 15, Lisp_Object *
0x02ec4e20) line 823 + 16 bytes
funcall_compiled_function(Lisp_Object {...}, int 3, Lisp_Object * 0x0082ee7c) line 3460 +
35 bytes
Ffuncall(int 4, Lisp_Object * 0x0082ee78) line 3886 + 17 bytes
execute_optimized_program(const unsigned char * 0x02e91b28, int 15, Lisp_Object *
0x02ec4e20) line 823 + 16 bytes
funcall_compiled_function(Lisp_Object {...}, int 0, Lisp_Object * 0x0082f2f4) line 3460 +
35 bytes
Ffuncall(int 1, Lisp_Object * 0x0082f2f0) line 3886 + 17 bytes
execute_optimized_program(const unsigned char * 0x02e3e038, int 2, Lisp_Object *
0x02e91a10) line 823 + 16 bytes
funcall_compiled_function(Lisp_Object {...}, int 0, Lisp_Object * 0x0082f760) line 3460 +
35 bytes
Ffuncall(int 1, Lisp_Object * 0x0082f75c) line 3886 + 17 bytes
apply1(Lisp_Object {...}, Lisp_Object {...}) line 4466 + 11 bytes
Fcall_interactively(Lisp_Object {...}, Lisp_Object {...}, Lisp_Object {...}) line 459 + 13
bytes
Fcommand_execute(Lisp_Object {...}, Lisp_Object {...}, Lisp_Object {...}) line 3114 + 17
bytes
execute_command_event(command_builder * 0x02398130, Lisp_Object {...}) line 4286 + 25
bytes
Fdispatch_event(Lisp_Object {...}) line 4598 + 92 bytes
Fcommand_loop_1() line 600 + 9 bytes
command_loop_1(Lisp_Object {...}) line 505 + 5 bytes
condition_case_1(Lisp_Object {...}, Lisp_Object (Lisp_Object)* 0x01074b1c
command_loop_1(Lisp_Object), Lisp_Object {...}, Lisp_Object (Lisp_Object, Lisp_Object)*
0x010747ac cmd_error(Lisp_Object, Lisp_Object), Lisp_Object {...}) line 1924 + 7 bytes
command_loop_3() line 262 + 35 bytes
command_loop_2(Lisp_Object {...}) line 277
internal_catch(Lisp_Object {...}, Lisp_Object (Lisp_Object)* 0x0107493c
command_loop_2(Lisp_Object), Lisp_Object {...}, int * volatile 0x00000000, Lisp_Object *
volatile 0x00000000, Lisp_Object * volatile 0x00000000) line 1530 + 7 bytes
initial_command_loop(Lisp_Object {...}) line 313 + 29 bytes
xemacs_21_5_b23_i586_pc_win32(int 1, unsigned short * * 0x0082ff18, unsigned short * *
0x00000000, int 0) line 2627
main(int 1, char * * 0x00f64220, char * * 0x00f62e40) line 3068
mainCRTStartup() line 338 + 17 bytes
KERNEL32! 7c816d4f()
----------------------------------------------------------------------------
New XEmacs, crash on second toggle:
Fatal error: assertion failed, file
c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\src\symbols.c, line 1116, ABORT()
Fatal error.
Your files have been auto-saved.
Use `M-x recover-session' to recover them.
Your version of XEmacs was distributed with a PROBLEMS file that may describe
your crash, and with luck a workaround. Please check it first, but do report
the crash anyway.
Please report this bug by invoking M-x report-emacs-bug, or by selecting
`Send Bug Report' from the Help menu. If that won't work, send ordinary
email to `xemacs-beta(a)xemacs.org'. *MAKE SURE* to include this entire
output from this crash, especially including the Lisp backtrace, as well as
the XEmacs configuration from M-x describe-installation (or equivalently,
the file `Installation' in the top of the build tree).
If you are fortunate enough to have some sort of debugging aid installed
on your system, for example Visual C++, and you can get a C stack backtrace,
*please* include it, as it will make our life far easier.
Lisp backtrace follows:
# (unwind-protect ...)
# (unwind-protect ...)
# (unwind-protect ...)
# (unwind-protect ...)
# (unwind-protect ...)
# (unwind-protect ...)
# (unwind-protect ...)
# bind (y x)
#<compiled-function (x y) "...(15)" [x timing assoc 0] 3>(#<INTERNAL
OBJECT (XEmacs bug?) (symbol-value-buffer-local type 39582780) 0x82fbe4> -11973120)
# (unwind-protect ...)
maphash(#<compiled-function (x y) "...(15)" [x timing assoc 0] 3>
#<hash-table test eq size 146/1777 data (if 0 event-type 0 itimer-time-difference 0
font-lock-pre-idle-hook 0 ...) 0x3a2d>)
# bind (table G94903 maxfunlen spaces-for-fun spaces-for-data total-gc-usage gc-usage
call-count total-timing timing standard-output sort-by stream info)
profile-results((timing #<hash-table test equal size 5/197 data (char-to-string 1
"(in redisplay)" 5 "next_event_internal()" 1 byte-code 1 ...)
0x3a29> total-timing #<hash-table test eq size 146/1777 data (if 0 event-type 0
itimer-time-difference 0 font-lock-pre-idle-hook 0 ...) 0x3a2d> call-count
#<hash-table test eq size 143/1777 data (if 1 event-type 6 itimer-time-difference 90
font-lock-pre-idle-hook 62 ...) 0x3a2c> gc-usage #<hash-table test eq size 45/1777
data (itimer-time-difference 5760 font-lock-pre-idle-hook 0 current-time 3024
paren-highlight 304 ...) 0x3a2b> total-gc-usage #<hash-table test eq size 145/1777
data (if -12 event-type 0 itimer-time-difference 5760 font-lock-pre-idle-hook 0 ...)
0x3a2a>) #<buffer "*Profiling Results*"> nil)
# bind (standard-output temp-buffer-show-function help-not-visible buffer-name
was-one-window winconfig sort-by stream info)
profile-results()
(progn (stop-profiling) (message "...Finished profiling") (profile-results))
(if (profiling-active-p) (progn (stop-profiling) (message "...Finished
profiling") (profile-results)) (message "Profiling...")
(clear-profiling-info) (start-profiling))
(lambda nil "Start profiling, or stop it and print results.\nThis lets you figure
out where time is being spent when executing Lisp code." (interactive) (if
(profiling-active-p) (progn (stop-profiling) (message "...Finished profiling")
(profile-results)) (message "Profiling...") (clear-profiling-info)
(start-profiling)))()
call-interactively(toggle-profiling)
(dispatch-event "[internal]")
# (condition-case ... . error)
# (catch top-level ...)
assert_failed(const char * 0x0125b924, int 1116, const char * 0x0125b91c) line 3916
do_symval_forwarding(Lisp_Object {...}, buffer * 0x00f6dc70, console * 0x02398088) line
1116 + 20 bytes
find_symbol_value_1(Lisp_Object {...}, buffer * 0x00f6dc70, console * 0x02398088, int 1,
Lisp_Object {...}, int 1) line 1584 + 17 bytes
find_symbol_value(Lisp_Object {...}) line 1660 + 30 bytes
Fsymbol_value(Lisp_Object {...}) line 1708 + 9 bytes
execute_optimized_program(const unsigned char * 0x02dcdf68, int 3, Lisp_Object *
0x02d5edd8) line 734 + 9 bytes
funcall_compiled_function(Lisp_Object {...}, int 2, Lisp_Object * 0x0082e66c) line 3460 +
35 bytes
Ffuncall(int 3, Lisp_Object * 0x0082e668) line 3886 + 17 bytes
Fmaphash(Lisp_Object {...}, Lisp_Object {...}) line 1382 + 11 bytes
Ffuncall(int 3, Lisp_Object * 0x0082e758) line 3847 + 120 bytes
execute_optimized_program(const unsigned char * 0x02d8bf50, int 15, Lisp_Object *
0x02d5ef38) line 823 + 16 bytes
funcall_compiled_function(Lisp_Object {...}, int 3, Lisp_Object * 0x0082ebdc) line 3460 +
35 bytes
Ffuncall(int 4, Lisp_Object * 0x0082ebd8) line 3886 + 17 bytes
execute_optimized_program(const unsigned char * 0x02d8bf50, int 15, Lisp_Object *
0x02d5ef38) line 823 + 16 bytes
funcall_compiled_function(Lisp_Object {...}, int 0, Lisp_Object * 0x0082ef7c) line 3460 +
35 bytes
Feval(Lisp_Object {...}) line 3668 + 20 bytes
Fprogn(Lisp_Object {...}) line 954 + 9 bytes
Feval(Lisp_Object {...}) line 3579 + 13 bytes
Fif(Lisp_Object {...}) line 870 + 9 bytes
Feval(Lisp_Object {...}) line 3579 + 13 bytes
Fprogn(Lisp_Object {...}) line 954 + 9 bytes
funcall_lambda(Lisp_Object {...}, int 0, Lisp_Object * 0x0082f760) line 4203 + 9 bytes
Ffuncall(int 1, Lisp_Object * 0x0082f75c) line 3896 + 17 bytes
apply1(Lisp_Object {...}, Lisp_Object {...}) line 4466 + 11 bytes
Fcall_interactively(Lisp_Object {...}, Lisp_Object {...}, Lisp_Object {...}) line 459 + 13
bytes
Fcommand_execute(Lisp_Object {...}, Lisp_Object {...}, Lisp_Object {...}) line 3114 + 17
bytes
execute_command_event(command_builder * 0x02398130, Lisp_Object {...}) line 4286 + 25
bytes
Fdispatch_event(Lisp_Object {...}) line 4598 + 92 bytes
Fcommand_loop_1() line 600 + 9 bytes
command_loop_1(Lisp_Object {...}) line 505 + 5 bytes
condition_case_1(Lisp_Object {...}, Lisp_Object (Lisp_Object)* 0x01074b1c
command_loop_1(Lisp_Object), Lisp_Object {...}, Lisp_Object (Lisp_Object, Lisp_Object)*
0x010747ac cmd_error(Lisp_Object, Lisp_Object), Lisp_Object {...}) line 1924 + 7 bytes
command_loop_3() line 262 + 35 bytes
command_loop_2(Lisp_Object {...}) line 277
internal_catch(Lisp_Object {...}, Lisp_Object (Lisp_Object)* 0x0107493c
command_loop_2(Lisp_Object), Lisp_Object {...}, int * volatile 0x00000000, Lisp_Object *
volatile 0x00000000, Lisp_Object * volatile 0x00000000) line 1530 + 7 bytes
initial_command_loop(Lisp_Object {...}) line 313 + 29 bytes
xemacs_21_5_b23_i586_pc_win32(int 1, unsigned short * * 0x0082ff18, unsigned short * *
0x00000000, int 0) line 2627
main(int 1, char * * 0x00f64220, char * * 0x00f62e40) line 3068
mainCRTStartup() line 338 + 17 bytes
KERNEL32! 7c816d4f()
----------------------------------------------------------------------------
Another XEmacs with profile.el instrumented
Fatal error: assertion failed, file
c:\Hacking\cvs.xemacs.org\XEmacs\xemacs-21.5-clean\src\symbols.c, line 1116, ABORT()
Fatal error.
Your files have been auto-saved.
Use `M-x recover-session' to recover them.
Your version of XEmacs was distributed with a PROBLEMS file that may describe
your crash, and with luck a workaround. Please check it first, but do report
the crash anyway.
Please report this bug by invoking M-x report-emacs-bug, or by selecting
`Send Bug Report' from the Help menu. If that won't work, send ordinary
email to `xemacs-beta(a)xemacs.org'. *MAKE SURE* to include this entire
output from this crash, especially including the Lisp backtrace, as well as
the XEmacs configuration from M-x describe-installation (or equivalently,
the file `Installation' in the top of the build tree).
If you are fortunate enough to have some sort of debugging aid installed
on your system, for example Visual C++, and you can get a C stack backtrace,
*please* include it, as it will make our life far easier.
Lisp backtrace follows:
# (unwind-protect ...)
# (unwind-protect ...)
# (unwind-protect ...)
# (unwind-protect ...)
# (unwind-protect ...)
# (unwind-protect ...)
# (unwind-protect ...)
(assoc x timing)
(not (assoc x timing))
(if (not (assoc x timing)) (push (cons x 0) timing))
# bind (y x)
(lambda (x y) (if (not (assoc x timing)) (push (cons x 0) timing)))(#<INTERNAL OBJECT
(XEmacs bug?) (symbol-value-buffer-local type 50234780) 0x82fbe4> -11971713)
# (unwind-protect ...)
maphash((lambda (x y) (if (not (assoc x timing)) (push (cons x 0) timing)))
#<hash-table test eq size 397/1777 data (if 0 buffer-substring 0 local-variable-p
0 event-type 0 ...) 0x4b62>)
# (catch --cl-block---cl-finish---- ...)
(catch (quote --cl-block---cl-finish----) (maphash (function (lambda (x y) (if (not
(assoc x timing)) (push (cons x 0) timing)))) table))
(cl-block-wrapper (catch (quote --cl-block---cl-finish----) (maphash (function (lambda
(x y) (if (not (assoc x timing)) (push (cons x 0) timing)))) table)))
(block --cl-finish-- (maphash (function (lambda (x y) (if (not (assoc x timing)) (push
(cons x 0) timing)))) table))
# (catch --cl-block-nil-- ...)
(catch (quote --cl-block-nil--) (block --cl-finish-- (maphash (function (lambda (x y)
(if (not (assoc x timing)) (push (cons x 0) timing)))) table)) nil)
(cl-block-wrapper (catch (quote --cl-block-nil--) (block --cl-finish-- (maphash
(function (lambda (x y) (if (not (assoc x timing)) (push (cons x 0) timing)))) table))
nil))
(block nil (block --cl-finish-- (maphash (function (lambda (x y) (if (not (assoc x
timing)) (push (cons x 0) timing)))) table)) nil)
(loop for x being the hash-key in table using (hash-value y) do (if (not (assoc x
timing)) (push (cons x 0) timing)))
(while (consp G26413) (setq table (car G26413)) (loop for x being the hash-key in table
using (hash-value y) do (if (not (assoc x timing)) (push (cons x 0) timing))) (setq G26413
(cdr G26413)))
# bind (table G26413)
(let* ((G26413 (list total-timing call-count gc-usage total-gc-usage)) (table
nil)) (while (consp G26413) (setq table (car G26413)) (loop for x being the hash-key in
table using (hash-value y) do (if (not (assoc x timing)) (push (cons x 0) timing))) (setq
G26413 (cdr G26413))) nil)
# (catch --cl-block-nil-- ...)
(catch (quote --cl-block-nil--) (let* ((G26413 (list total-timing call-count gc-usage
total-gc-usage)) (table nil)) (while (consp G26413) (setq table (car G26413)) (loop for x
being the hash-key in table using (hash-value y) do (if (not (assoc x timing)) (push (cons
x 0) timing))) (setq G26413 (cdr G26413))) nil))
(cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((G26413 (list total-timing
call-count gc-usage total-gc-usage)) (table nil)) (while (consp G26413) (setq table (car
G26413)) (loop for x being the hash-key in table using (hash-value y) do (if (not (assoc x
timing)) (push (cons x 0) timing))) (setq G26413 (cdr
G26413))) nil)))
(block nil (let* ((G26413 (list total-timing call-count gc-usage total-gc-usage)) (table
nil)) (while (consp G26413) (setq table (car G26413)) (loop for x being the hash-key in
table using (hash-value y) do (if (not (assoc x timing)) (push (cons x 0) timing))) (setq
G26413 (cdr G26413))) nil))
(loop for table in (list total-timing call-count gc-usage total-gc-usage) do (loop for x
being the hash-key in table using (hash-value y) do (if (not (assoc x timing)) (push (cons
x 0) timing))))
# bind (maxfunlen spaces-for-fun spaces-for-data total-gc-usage gc-usage call-count
total-timing timing standard-output)
(let* ((standard-output stream) (timing (if (consp (car info)) (copy-alist info) (loop
for x being the hash-key in (getf info (quote timing)) using (hash-value y) collect (cons
x y)))) (total-timing (if (boundp (quote call-count-profile-table)) (make-hash-table)
(getf info (quote total-timing)))) (call-count (if (boundp (quote
call-count-profile-table)) call-count-profile-table (getf info (quote call-count))))
(gc-usage (if (boundp (quote call-count-profile-table)) (make-hash-table) (getf info
(quote gc-usage)))) (total-gc-usage (if (boundp (quote call-count-profile-table))
(make-hash-table) (getf info (quote total-gc-usage)))) (spaces-for-data 41)
(spaces-for-fun (- 79 spaces-for-data)) maxfunlen) (loop for
table in (list total-timing call-count gc-usage total-gc-usage) do (loop for x being the
hash-key in table using (hash-value y) do (if (not (assoc x timing)) (push (cons x 0)
timing)))) (setq maxfunlen (apply (function max) (length "Function Name")
(mapcar (lambda (el) (let ((l (length (format "%s" (car el))))) (if (<= l
spaces-for-fun) l 0))) timing))) (princ (format "%-*sTicks/Total %%Usage Calls
GC-Usage/ Total\n" maxfunlen "Function Name")) (princ (make-string
maxfunlen
?=)) (princ "=====/===== ====== ===== ========/=======\n") (let ((timing-sum
(float (apply (function +) (mapcar (function cdr) timing)))) (calls-sum 0) (gc-sum
0)) (dolist (entry (nreverse (sort timing (cond ((eq sort-by (quote call-count)) (function
(lambda (a b) (< (or (gethash (car a) call-count) 0) (or (gethash (car b) call-count)
0))))) ((eq sort-by (quote gc-usage)) (function (lambda (a b) (< (or (gethash (car a)
gc-usage) 0) (or (gethash (car b) gc-usage) 0))))) (t (function cdr-less-than-cdr))))))
(princ (format "%-*s%5d/%5d %6.3f %s %s\n" maxfunlen (let ((str (format
"%s" (car entry)))) (if (<= (length str) maxfunlen) str (concat str
"\n" (make-string maxfunlen ?\ )))) (cdr entry) (or (gethash (car entry)
total-timing) 0) (if (zerop timing-sum) 0 (* 100 (/ (cdr entry) timing-sum))) (let ((count
(gethash (car entry) call-count))) (if count (format "%5d" count) "
")) (let ((gcval (or (gethash (car entry) gc-usage) 0)) (total-gcval (or
(gethash (car entry) total-gc-usage) 0))) (if (or (/= gcval 0) (/= total-gcval 0)) (format
"%8d/%7d" gcval total-gcval) " ")))) (incf calls-sum
(or (gethash (car entry) call-count 0))) (incf gc-sum (or (gethash (car entry) gc-usage
0)))) (princ (make-string (+ maxfunlen spaces-for-data) ?-)) (princ (format
"\n%-*s%7d %7.3f %5d %8d\n" (- maxfunlen 2) "Total" timing-sum
100.0 calls-sum gc-sum)) (princ (format "\n\nTicks/Total = Ticks this
function/this function and descendants\nCalls = Number of calls to this
function\nGC-Usage/Total = Lisp allocation this function/this function and
descendants\nOne
tick = %g ms\n" (/ default-profiling-interval 1000.0))) (and (boundp (quote
internal-error-checking)) (delq (quote quick-build) internal-error-checking)
(princ "\nWARNING: Error checking is turned on in this XEmacs. This might make\n
the measurements very unreliable.\n"))))
(if (not stream) (profile-displaying-temp-buffer "*Profiling Results*"
(profile-results info standard-output sort-by)) (let* ((standard-output stream) (timing
(if (consp (car info)) (copy-alist info) (loop for x being the hash-key in (getf info
(quote timing)) using (hash-value y) collect (cons x y)))) (total-timing
(if (boundp (quote call-count-profile-table)) (make-hash-table) (getf info (quote
total-timing)))) (call-count (if (boundp (quote call-count-profile-table))
call-count-profile-table (getf info (quote call-count)))) (gc-usage (if (boundp (quote
call-count-profile-table)) (make-hash-table) (getf info (quote gc-usage))))
(total-gc-usage (if (boundp (quote call-count-profile-table)) (make-hash-table)
(getf info (quote total-gc-usage)))) (spaces-for-data 41) (spaces-for-fun (- 79
spaces-for-data)) maxfunlen) (loop for table in (list total-timing call-count gc-usage
total-gc-usage) do (loop for x being the hash-key in table using (hash-value y) do (if
(not (assoc x timing)) (push (cons x 0) timing)))) (setq maxfunlen (apply (function max)
(length "Function Name") (mapcar (lambda (el) (let ((l (length (format
"%s" (car el))))) (if (<= l spaces-for-fun) l 0))) timing))) (princ (format
"%-*sTicks/Total %%Usage Calls GC-Usage/ Total\n" maxfunlen "Function
Name")) (princ (make-string maxfunlen ?=)) (princ "=====/===== ====== =====
========/=======\n") (let ((timing-sum (float (apply (function +) (mapcar (function
cdr) timing)))) (calls-sum 0) (gc-sum 0)) (dolist (entry (nreverse (sort timing (cond ((eq
sort-by (quote call-count)) (function (lambda (a b) (< (or (gethash
(car a) call-count) 0) (or (gethash (car b) call-count) 0))))) ((eq sort-by (quote
gc-usage)) (function (lambda (a b) (< (or (gethash (car a) gc-usage) 0) (or (gethash
(car b) gc-usage) 0))))) (t (function cdr-less-than-cdr)))))) (princ (format
"%-*s%5d/%5d %6.3f %s %s\n" maxfunlen (let ((str (format "%s" (car
entry)))) (if (<= (length str) maxfunlen) str (concat str "\n" (make-string
maxfunlen ?\ )))) (cdr entry) (or (gethash (car entry) total-timing) 0) (if (zerop
timing-sum) 0 (* 100 (/ (cdr entry) timing-sum))) (let ((count (gethash (car entry)
call-count))) (if count (format "%5d" count) " ")) (let ((gcval
(or (gethash (car entry) gc-usage) 0)) (total-gcval (or (gethash (car entry)
total-gc-usage) 0))) (if (or (/= gcval 0) (/= total-gcval 0)) (format "%8d/%7d"
gcval total-gcval) " ")))) (incf calls-sum (or (gethash (car
entry) call-count 0))) (incf gc-sum (or (gethash (car entry) gc-usage 0)))) (princ
(make-string (+ maxfunlen spaces-for-data) ?-)) (p!
rinc (format "\n%-*s%7d %7.3f %5d %8d\n" (- maxfunlen 2) "Total"
timing-sum 100.0 calls-sum gc-sum)) (princ (format "\n\nTicks/Total = Ticks this
function/this function and descendants\nCalls
= Number of calls to this function\nGC-Usage/Total = Lisp allocation this function/this
function and descendants\nOne tick = %g ms\n" (/ default-profiling-interval
1000.0))) (and (boundp (quote internal-error-checking)) (delq (quote quick-build)
internal-error-checking) (princ "\nWARNING: Error checking is turned on in this
XEmacs. This might make\n the measurements very unreliable.\n")))))
# bind (sort-by stream info)
profile-results((timing #<hash-table test equal size 29/197 data (dispatch-event 3
split-window 4 next-event 2 #<compiled-function (key value) "...(35)" [value
newval new key get-range-char-table multi map-char-table #<compiled-function (key1
value1) "...(19)" [value key1 key new char-syntax-from-code get-range-char-table
?＠ put-char-table nil] 5> char-syntax-from-code ?＠ put-char-table nil] 5>
2 ...) 0x4b5e> total-timing #<hash-table test eq size 397/1777 data (if 0
buffer-substring 0 local-variable-p 0 event-type 0 ...) 0x4b62> call-count
#<hash-table test eq size 397/1777 data (if 1 buffer-substring 4 local-variable-p 6
event-type 29 ...) 0x4b61> gc-usage #<hash-table test eq size 128/1777 data
(buffer-substring 120 pos-visible-in-window-p 1208 itimer-time-difference 6528
font-lock-pre-idle-hook 0 ...) 0x4b60> total-gc-usage #<hash-table test eq size
396/1777 data (if 1312 buffer-substring 120 local-variable-p 0 event-type 0 ...)
0x4b5f>) #<buffer "*Profiling Results*"> nil)
(progn (profile-results info standard-output sort-by))
(prog1 (progn (profile-results info standard-output sort-by)) (save-excursion
(set-buffer standard-output) (funcall mode-for-help)))
# bind (standard-output)
(with-output-to-temp-buffer buffer-name (prog1 (progn (profile-results info
standard-output sort-by)) (save-excursion (set-buffer standard-output) (funcall
mode-for-help))))
# bind (temp-buffer-show-function)
(let ((temp-buffer-show-function (if help-sticky-window (function (lambda (buffer)
(set-window-buffer help-sticky-window buffer))) temp-buffer-show-function)))
(with-output-to-temp-buffer buffer-name (prog1 (progn (profile-results info
standard-output sort-by)) (save-excursion (set-buffer standard-output) (funcall
mode-for-help)))))
(prog1 (let ((temp-buffer-show-function (if help-sticky-window (function (lambda
(buffer) (set-window-buffer help-sticky-window buffer))) temp-buffer-show-function)))
(with-output-to-temp-buffer buffer-name (prog1 (progn (profile-results
info standard-output sort-by)) (save-excursion (set-buffer standard-output) (funcall
mode-for-help))))) (let ((helpwin (get-buffer-window buffer-name))) (when helpwin (when
help-not-visible (with-current-buffer (window-buffer helpwin) (setq help-window-config
winconfig))) (when help-selects-help-window (select-window helpwin)) (cond ((eq helpwin
(selected-window)) (display-message (quote command)
(substitute-command-keys "Type \\[help-mode-quit] to remove window, \\[scroll-up] to
scroll the text."))) (was-one-window (display-message (quote command)
(substitute-command-keys "Type \\[delete-other-windows] to remove window,
\\[scroll-other-window] to scroll the text."))) (t (display-message (quote command)
(substitute-command-keys "Type \\[switch-to-buffer-other-window] to restore the other
window, \\[scroll-other-window] to scroll the text.")))))))
# bind (help-not-visible buffer-name was-one-window winconfig)
(let* ((winconfig (current-window-configuration)) (was-one-window (one-window-p))
(buffer-name "*Profiling Results*") (help-not-visible (not (and
(windows-of-buffer buffer-name) (memq (selected-frame) (mapcar (quote window-frame)
(windows-of-buffer buffer-name))))))) (help-register-and-maybe-prune-excess buffer-name)
(if (and help-sticky-window (or (not (windowp help-sticky-window)) (not (window-live-p
help-sticky-window)))) (setq help-sticky-window nil)) (prog1 (let
((temp-buffer-show-function (if help-sticky-window (function (lambda (buffer)
(set-window-buffer help-sticky-window buffer))) temp-buffer-show-function)))
(with-output-to-temp-buffer buffer-name (prog1 (progn (profile-results info
standard-output sort-by)) (save-excursion (set-buffer standard-output) (funcall
mode-for-help))))) (let ((helpwin (get-buffer-window buffer-name))) (when helpwin (when
help-not-visible (with-current-buffer (window-buffer helpwin) (setq help-window-config
winconfig))) (when help-selects-help-window (select-window helpwin)) (cond ((eq
helpwin (selected-window)) (display-message (quote command) (substitute-command-keys
"Type \\[help-mode-quit] to remove window, \\[scroll-up] to scroll the text.")))
(was-one-window (display-message (quote command) (substitute-command-keys
"Type \\[delete-other-windows] to remove window, \\[scroll-other-window] to scroll
the text."))) (t (display-message (quote command) (substitute-command-keys "Type
\\[switch-to-buffer-other-window] to restore the other window, \\[scroll-other-window] to
scroll the text."))))))))
(profile-displaying-temp-buffer "*Profiling Results*" (profile-results info
standard-output sort-by))
(if (not stream) (profile-displaying-temp-buffer "*Profiling Results*"
(profile-results info standard-output sort-by)) (let* ((standard-output stream) (timing
(if (consp (car info)) (copy-alist info) (loop for x being the hash-key in (getf info
(quote timing)) using (hash-value y) collect (cons x y)))) (total-timing
(if (boundp (quote call-count-profile-table)) (make-hash-table) (getf info (quote
total-timing)))) (call-count (if (boundp (quote call-count-profile-table))
call-count-profile-table (getf info (quote call-count)))) (gc-usage (if (boundp (quote
call-count-profile-table)) (make-hash-table) (getf info (quote gc-usage))))
(total-gc-usage (if (boundp (quote call-count-profile-table)) (make-hash-table)
(getf info (quote total-gc-usage)))) (spaces-for-data 41) (spaces-for-fun (- 79
spaces-for-data)) maxfunlen) (loop for table in (list total-timing call-count gc-usage
total-gc-usage) do (loop for x being the hash-key in table using (hash-value y) do (if
(not (assoc x timing)) (push (cons x 0) timing)))) (setq maxfunlen (apply (function max)
(length "Function Name") (mapcar (lambda (el) (let ((l (length (format
"%s" (car el))))) (if (<= l spaces-for-fun) l 0))) timing))) (princ (format
"%-*sTicks/Total %%Usage Calls GC-Usage/ Total\n" maxfunlen "Function
Name")) (princ (make-string maxfunlen ?=)) (princ "=====/===== ====== =====
========/=======\n") (let ((timing-sum (float (apply (function +) (mapcar (function
cdr) timing)))) (calls-sum 0) (gc-sum 0)) (dolist (entry (nreverse (sort timing (cond ((eq
sort-by (quote call-count)) (function (lambda (a b) (< (or (gethash
(car a) call-count) 0) (or (gethash (car b) call-count) 0))))) ((eq sort-by (quote
gc-usage)) (function (lambda (a b) (< (or (gethash (car a) gc-usage) 0) (or (gethash
(car b) gc-usage) 0))))) (t (function cdr-less-than-cdr)))))) (princ (format
"%-*s%5d/%5d %6.3f %s %s\n" maxfunlen (let ((str (format "%s" (car
entry)))) (if (<= (length str) maxfunlen) str (concat str "\n" (make-string
maxfunlen ?\ )))) (cdr entry) (or (gethash (car entry) total-timing) 0) (if (zerop
timing-sum) 0 (* 100 (/ (cdr entry) timing-sum))) (let ((count (gethash (car entry)
call-count))) (if count (format "%5d" count) " ")) (let ((gcval
(or (gethash (car entry) gc-usage) 0)) (total-gcval (or (gethash (car entry)
total-gc-usage) 0))) (if (or (/= gcval 0) (/= total-gcval 0)) (format "%8d/%7d"
gcval total-gcval) " ")))) (incf calls-sum (or (gethash (car
entry) call-count 0))) (incf gc-sum (or (gethash (car entry) gc-usage 0)))) (princ
(make-string (+ maxfunlen spaces-for-data) ?-)) (p!
rinc (format "\n%-*s%7d %7.3f %5d %8d\n" (- maxfunlen 2) "Total"
timing-sum 100.0 calls-sum gc-sum)) (princ (format "\n\nTicks/Total = Ticks this
function/this function and descendants\nCalls
= Number of calls to this function\nGC-Usage/Total = Lisp allocation this function/this
function and descendants\nOne tick = %g ms\n" (/ default-profiling-interval
1000.0))) (and (boundp (quote internal-error-checking)) (delq (quote quick-build)
internal-error-checking) (princ "\nWARNING: Error checking is turned on in this
XEmacs. This might make\n the measurements very unreliable.\n")))))
# bind (sort-by stream info)
(lambda (&optional info stream sort-by) "Print profiling info INFO to STREAM in
a pretty format.\nIf INFO is omitted, the current profiling info is retrieved
using\n `get-profiling-info'.\nIf STREAM is omitted, the results will be displayed in
a temp buffer\n using `with-output-to-temp-buffer'; otherwise, they will simply be\n
printed into STREAM. Use `standard-output' explicitly if you\n want
standard output.\nIf SORT-BY is `call-count' (interactively, the prefix arg), display
items\n sorted by call count rather than timing. If `gc-usage' (interactively,\n use
C-u C-u), sort by GC usage." (interactive (list nil nil (cond ((equal
current-prefix-arg (quote (16))) (quote gc-usage)) (current-prefix-arg (quote
call-count))))) (or info (setq info (get-profiling-info))) (if (not stream)
(profile-displaying-temp-buffer "*Profiling Results*" (profile-results info
standard-output sort-by)) (let* ((standard-output stream) (timing (if (consp (car info))
(copy-alist info) (loop for x being the hash-key in (getf info (quote timing))
using (hash-value y) collect (cons x y)))) (total-timing (if (boundp (quote
call-count-profile-table)) (make-hash-table) (getf info (quote total-timing))))
(call-count (if (boundp (quote call-count-profile-table)) call-count-profile-table (getf
info (quote call-count)))) (gc-usage (if (boundp (quote call-count-profile-table))
(make-hash-table) (getf info (quote gc-usage)))) (total-gc-usage (if (boundp (quote
call-count-profile-table)) (make-hash-table) (getf info (quote total-gc-usage))))
(spaces-for-data 41) (spaces-for-fun (- 79 spaces-for-data)) maxfunlen) (loop for table in
(list total-timing call-count gc-usage total-gc-usage)
do (loop for x being the hash-key in table using (hash-value y) do (if (not (assoc x
timing)) (push (cons x 0) timing)))) (setq maxfunlen (apply (function max)
(length "Function Name") (mapcar (lambda (el) (let ((l (length (format
"%s" (car el))))) (if (<= l spaces-for-fun) l 0))) timing))) (princ (format
"%-*sTicks/Total %%Usage Calls GC-Usage/ Total\n" maxfunlen "Function
Name")) (princ (make-string maxfunlen ?=)) (princ "=====/===== ====== =====
========/=======\n") (let
((timing-sum (float (apply (function +) (mapcar (function cdr) timing)))) (calls-sum 0)
(gc-sum 0)) (dolist (entry (nreverse (sort timing (cond ((eq sort-by (quote call-count))
(function (lambda (a b) (< (or (gethash (car a) call-count) 0)
(or (gethash (car b) call-count) 0))))) ((eq sort-by (quote gc-usage)) (function (lambda
(a b) (< (or (gethash (car a) gc-usage) 0) (or (gethash (car b) gc-usage) 0))))) (t
(function cdr-less-than-cdr)))))) (princ (format "%-*s%5d/%5d %6.3f %s %s\n"
maxfunlen (let ((str (format "%s" (car entry)))) (if (<= (length str)
maxfunlen) str (concat str "\n" (make-string maxfunlen ?\ )))) (cdr entry) (or
(gethash (car entry) total-timing) 0) (if (zerop timing-sum) 0 (* 100 (/ (cdr entry)
timing-sum))) (let ((count (gethash (car entry) call-count))) (if count (format
"%5d" count) " ")) (let ((gcval (or (gethash (car entry) gc-usage)
0)) (total-gcval (or (gethash (car entry) total-gc-usage) 0))) (if (or (/= gcval 0) (/=
total-gcval 0)) (format "%8d/%7d" gcval total-gcval) "
")))) (incf calls-sum (or (gethash (car entry) call-count 0))) (incf gc-sum (or
(gethash (car entry) gc-usage 0)))) (princ (make-string (+ maxfunlen spaces-for-data) ?-))
(princ (format "\n%-*s%7d %7.3f %5d %8d\n" (- maxfunlen 2)
"Total" timing-sum 100.0 calls-sum gc-sum)) (princ (format "\n\nTicks/Total
= Ticks this function/this function and descendants\nCalls = Number of calls
to this function\nGC-Usage/Total = Lisp allocation this function/this function and
descendants\nOne tick =!
%g ms\n" (/ default-profiling-interval 1000.0))) (and (boundp (quote
internal-error-checking)) (delq (quote quick-build) internal-error-checking) (princ
"\nWARNING: Error checking is turned on in this XEmacs.
This might make\n the measurements very unreliable.\n"))))))(nil nil nil)
call-interactively(profile-results)
command-execute(profile-results t)
# bind (_execute_command_keys_ _execute_command_name_ prefix-arg)
execute-extended-command(nil)
# bind (command-debug-status)
call-interactively(execute-extended-command)
(dispatch-event "[internal]")
# (condition-case ... . error)
# (catch top-level ...)
assert_failed(const char * 0x0125b924, int 1116, const char * 0x0125b91c) line 3916
do_symval_forwarding(Lisp_Object {...}, buffer * 0x0302e960, console * 0x02398088) line
1116 + 20 bytes
find_symbol_value_1(Lisp_Object {...}, buffer * 0x0302e960, console * 0x02398088, int 1,
Lisp_Object {...}, int 1) line 1584 + 17 bytes
find_symbol_value(Lisp_Object {...}) line 1660 + 30 bytes
Fsymbol_value(Lisp_Object {...}) line 1708 + 9 bytes
Feval(Lisp_Object {...}) line 3520 + 9 bytes
Feval(Lisp_Object {...}) line 3594 + 12 bytes
Feval(Lisp_Object {...}) line 3594 + 12 bytes
Fif(Lisp_Object {...}) line 869 + 9 bytes
Feval(Lisp_Object {...}) line 3579 + 13 bytes
Fprogn(Lisp_Object {...}) line 954 + 9 bytes
funcall_lambda(Lisp_Object {...}, int 2, Lisp_Object * 0x0082b364) line 4203 + 9 bytes
Ffuncall(int 3, Lisp_Object * 0x0082b360) line 3896 + 17 bytes
Fmaphash(Lisp_Object {...}, Lisp_Object {...}) line 1382 + 11 bytes
Feval(Lisp_Object {...}) line 3607 + 165 bytes
Fprogn(Lisp_Object {...}) line 954 + 9 bytes
internal_catch(Lisp_Object {...}, Lisp_Object (Lisp_Object)* 0x010944f9
Fprogn(Lisp_Object), Lisp_Object {...}, int * volatile 0x00000000, Lisp_Object * volatile
0x00000000, Lisp_Object * volatile 0x00000000) line 1530 + 7 bytes
Fcatch(Lisp_Object {...}) line 1484 + 24 bytes
Feval(Lisp_Object {...}) line 3579 + 13 bytes
Feval(Lisp_Object {...}) line 3594 + 12 bytes
Feval(Lisp_Object {...}) line 3692 + 37 bytes
Fprogn(Lisp_Object {...}) line 954 + 9 bytes
internal_catch(Lisp_Object {...}, Lisp_Object (Lisp_Object)* 0x010944f9
Fprogn(Lisp_Object), Lisp_Object {...}, int * volatile 0x00000000, Lisp_Object * volatile
0x00000000, Lisp_Object * volatile 0x00000000) line 1530 + 7 bytes
Fcatch(Lisp_Object {...}) line 1484 + 24 bytes
Feval(Lisp_Object {...}) line 3579 + 13 bytes
Feval(Lisp_Object {...}) line 3594 + 12 bytes
Feval(Lisp_Object {...}) line 3692 + 37 bytes
Feval(Lisp_Object {...}) line 3692 + 37 bytes
Fprogn(Lisp_Object {...}) line 954 + 9 bytes
Fwhile(Lisp_Object {...}) line 1140 + 9 bytes
Feval(Lisp_Object {...}) line 3579 + 13 bytes
Fprogn(Lisp_Object {...}) line 954 + 9 bytes
FletX(Lisp_Object {...}) line 1054 + 9 bytes
Feval(Lisp_Object {...}) line 3579 + 13 bytes
Fprogn(Lisp_Object {...}) line 954 + 9 bytes
internal_catch(Lisp_Object {...}, Lisp_Object (Lisp_Object)* 0x010944f9
Fprogn(Lisp_Object), Lisp_Object {...}, int * volatile 0x00000000, Lisp_Object * volatile
0x00000000, Lisp_Object * volatile 0x00000000) line 1530 + 7 bytes
Fcatch(Lisp_Object {...}) line 1484 + 24 bytes
Feval(Lisp_Object {...}) line 3579 + 13 bytes
Feval(Lisp_Object {...}) line 3594 + 12 bytes
Feval(Lisp_Object {...}) line 3692 + 37 bytes
Feval(Lisp_Object {...}) line 3692 + 37 bytes
Fprogn(Lisp_Object {...}) line 954 + 9 bytes
FletX(Lisp_Object {...}) line 1054 + 9 bytes
Feval(Lisp_Object {...}) line 3579 + 13 bytes
Fprogn(Lisp_Object {...}) line 954 + 9 bytes
Fif(Lisp_Object {...}) line 872 + 9 bytes
Feval(Lisp_Object {...}) line 3579 + 13 bytes
Fprogn(Lisp_Object {...}) line 954 + 9 bytes
funcall_lambda(Lisp_Object {...}, int 3, Lisp_Object * 0x0082d840) line 4203 + 9 bytes
Feval(Lisp_Object {...}) line 3719 + 20 bytes
Fprogn(Lisp_Object {...}) line 954 + 9 bytes
Feval(Lisp_Object {...}) line 3579 + 13 bytes
Fprog1(Lisp_Object {...}) line 976 + 12 bytes
Feval(Lisp_Object {...}) line 3579 + 13 bytes
Fprogn(Lisp_Object {...}) line 954 + 9 bytes
Fwith_output_to_temp_buffer(Lisp_Object {...}) line 831 + 12 bytes
Feval(Lisp_Object {...}) line 3579 + 13 bytes
Fprogn(Lisp_Object {...}) line 954 + 9 bytes
Flet(Lisp_Object {...}) line 1123 + 9 bytes
Feval(Lisp_Object {...}) line 3579 + 13 bytes
Fprog1(Lisp_Object {...}) line 976 + 12 bytes
Feval(Lisp_Object {...}) line 3579 + 13 bytes
Fprogn(Lisp_Object {...}) line 954 + 9 bytes
FletX(Lisp_Object {...}) line 1054 + 9 bytes
Feval(Lisp_Object {...}) line 3579 + 13 bytes
Feval(Lisp_Object {...}) line 3692 + 37 bytes
Fif(Lisp_Object {...}) line 870 + 9 bytes
Feval(Lisp_Object {...}) line 3579 + 13 bytes
Fprogn(Lisp_Object {...}) line 954 + 9 bytes
funcall_lambda(Lisp_Object {...}, int 3, Lisp_Object * 0x0082ee10) line 4203 + 9 bytes
Ffuncall(int 4, Lisp_Object * 0x0082ee0c) line 3896 + 17 bytes
Fapply(int 2, Lisp_Object * 0x0082eea4) line 4151 + 13 bytes
apply1(Lisp_Object {...}, Lisp_Object {...}) line 4471 + 11 bytes
Fcall_interactively(Lisp_Object {...}, Lisp_Object {...}, Lisp_Object {...}) line 459 + 13
bytes
Fcommand_execute(Lisp_Object {...}, Lisp_Object {...}, Lisp_Object {...}) line 3114 + 17
bytes
Ffuncall(int 3, Lisp_Object * 0x0082f2fc) line 3847 + 160 bytes
execute_optimized_program(const unsigned char * 0x02d79bd0, int 7, Lisp_Object *
0x014ea118) line 823 + 16 bytes
funcall_compiled_function(Lisp_Object {...}, int 1, Lisp_Object * 0x0082f758) line 3460 +
35 bytes
Ffuncall(int 2, Lisp_Object * 0x0082f754) line 3886 + 17 bytes
Fcall_interactively(Lisp_Object {...}, Lisp_Object {...}, Lisp_Object {...}) line 994 + 22
bytes
Fcommand_execute(Lisp_Object {...}, Lisp_Object {...}, Lisp_Object {...}) line 3114 + 17
bytes
execute_command_event(command_builder * 0x02398130, Lisp_Object {...}) line 4286 + 25
bytes
Fdispatch_event(Lisp_Object {...}) line 4598 + 92 bytes
Fcommand_loop_1() line 600 + 9 bytes
command_loop_1(Lisp_Object {...}) line 505 + 5 bytes
condition_case_1(Lisp_Object {...}, Lisp_Object (Lisp_Object)* 0x01074b1c
command_loop_1(Lisp_Object), Lisp_Object {...}, Lisp_Object (Lisp_Object, Lisp_Object)*
0x010747ac cmd_error(Lisp_Object, Lisp_Object), Lisp_Object {...}) line 1924 + 7 bytes
command_loop_3() line 262 + 35 bytes
command_loop_2(Lisp_Object {...}) line 277
internal_catch(Lisp_Object {...}, Lisp_Object (Lisp_Object)* 0x0107493c
command_loop_2(Lisp_Object), Lisp_Object {...}, int * volatile 0x00000000, Lisp_Object *
volatile 0x00000000, Lisp_Object * volatile 0x00000000) line 1530 + 7 bytes
initial_command_loop(Lisp_Object {...}) line 313 + 29 bytes
xemacs_21_5_b23_i586_pc_win32(int 1, unsigned short * * 0x0082ff18, unsigned short * *
0x00000000, int 0) line 2627
main(int 1, char * * 0x00f64220, char * * 0x00f62e40) line 3068
mainCRTStartup() line 338 + 17 bytes
KERNEL32! 7c816d4f()
--
Adrian Aichner
mailto:adrian＠xemacs.org
http://www.xemacs.org/