Re: More info on toggle-profiling crashes

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&#39;. *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&#39;. *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&#39;. *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) ?-)) (!

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) ?-)) (!

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()