Rewrite sampler to use Elisp hash-tables.
* src/profiler.c: Remove filtering functionality. (is_in_trace, Qgc): Remove vars. (make_log, record_backtrace, Fsample_profiler_log): Rewrite, using Elisp hash-tables. (approximate_median, evict_lower_half): New functions. (cpu_log): Rename from sample_log. (cpu_gc_count): New var. (Fsample_profiler_reset, Fmemory_profiler_reset): Remove. (sigprof_handler): Add count to cpu_gc_count during GC, detected via backtrace_list. (block_sigprof, unblock_sigprof): Remove. (gc_probe, mark_profiler): Remove functions. (syms_of_profiler): Staticpro cpu_log and memory_log. * lisp/profiler.el (profiler-sample-interval): Move before first use. Change default to 1ms. (profiler-entry=, profiler-backtrace-reverse, profiler-log-fixup-slot) (profiler-calltree-elapsed<, profiler-calltree-elapsed>): Remove functions. (profiler-entry-format): Don't use type-of. (profiler-slot, profiler-log): Remove structs. (profiler-log-timestamp, profiler-log-type, profiler-log-diff-p): Redefine for new log representation. (profiler-log-diff, profiler-log-fixup, profiler-calltree-build-1): Rewrite for new log representation. (profiler-calltree): Remove `elapsed' fields. (profiler-calltree-count<, profiler-report-make-entry-part): Remove gc special case. (profiler-calltree-find): Use equal. (profiler-calltree-walk): Remove `args'; rely on closures instead. (profiler-calltree-compute-percentages-1): Remove; inlined. (profiler-calltree-compute-percentages): Simplify. (profiler-report-log, profiler-report-reversed) (profiler-report-order): Use defvar-local. (profiler-report-line-format): Remove `elapsed', do a bit of CSE. (profiler-report-mode-map): Remove up/down bindings. (profiler-report-make-buffer-name): Simplify by CSE. (profiler-report-mode): Remove redundant code. (profiler-report-expand-entry, profiler-report-collapse-entry): Use inhibit-read-only. (profiler-report-render-calltree-1): Simplify by CSE. (profiler-reset): Rewrite for new subroutines. (profiler--report-cpu): Rename from sample-profiler-report. (profiler--report-memory): Rename from memory-profiler-report. * src/alloc.c (Fgarbage_collect): Record itself in backtrace_list. Don't set is_in_trace any more. Don't call mark_profiler. Only call gc_probe for the memory profiler. (syms_of_alloc): Define Qautomatic_gc. * src/lisp.h (SXHASH_COMBINE): Move back to... * src/fns.c (SXHASH_COMBINE): ...here. * src/xdisp.c (Qautomatic_redisplay): New constant. (redisplay_internal): Record itself in backtrace_list. (syms_of_xdisp): Define Qautomatic_redisplay. * .dir-locals.el (indent-tabs-mode): Remove personal preference.
This commit is contained in:
Stefan Monnier
parent
0970d85fef
commit
3d80c99f38
10 changed files with 429 additions and 1124 deletions
|
|
@ -1,5 +1,4 @@
|
|||
((nil . ((tab-width . 8)
|
||||
(indent-tabs-mode . t)
|
||||
(sentence-end-double-space . t)
|
||||
(fill-column . 70)))
|
||||
(c-mode . ((c-file-style . "GNU")))
|
||||
|
|
|
|||
|
|
@ -1,3 +1,7 @@
|
|||
2012-09-24 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* .dir-locals.el (indent-tabs-mode): Remove personal preference.
|
||||
|
||||
2012-08-21 Paul Eggert <eggert@cs.ucla.edu>
|
||||
|
||||
Merge from gnulib, incorporating:
|
||||
|
|
|
|||
|
|
@ -1,3 +1,35 @@
|
|||
2012-09-24 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* profiler.el (profiler-sample-interval): Move before first use.
|
||||
Change default to 1ms.
|
||||
(profiler-entry=, profiler-backtrace-reverse, profiler-log-fixup-slot)
|
||||
(profiler-calltree-elapsed<, profiler-calltree-elapsed>): Remove functions.
|
||||
(profiler-entry-format): Don't use type-of.
|
||||
(profiler-slot, profiler-log): Remove structs.
|
||||
(profiler-log-timestamp, profiler-log-type, profiler-log-diff-p):
|
||||
Redefine for new log representation.
|
||||
(profiler-log-diff, profiler-log-fixup, profiler-calltree-build-1):
|
||||
Rewrite for new log representation.
|
||||
(profiler-calltree): Remove `elapsed' fields.
|
||||
(profiler-calltree-count<, profiler-report-make-entry-part):
|
||||
Remove gc special case.
|
||||
(profiler-calltree-find): Use equal.
|
||||
(profiler-calltree-walk): Remove `args'; rely on closures instead.
|
||||
(profiler-calltree-compute-percentages-1): Remove; inlined.
|
||||
(profiler-calltree-compute-percentages): Simplify.
|
||||
(profiler-report-log, profiler-report-reversed)
|
||||
(profiler-report-order): Use defvar-local.
|
||||
(profiler-report-line-format): Remove `elapsed', do a bit of CSE.
|
||||
(profiler-report-mode-map): Remove up/down bindings.
|
||||
(profiler-report-make-buffer-name): Simplify by CSE.
|
||||
(profiler-report-mode): Remove redundant code.
|
||||
(profiler-report-expand-entry, profiler-report-collapse-entry):
|
||||
Use inhibit-read-only.
|
||||
(profiler-report-render-calltree-1): Simplify by CSE.
|
||||
(profiler-reset): Rewrite for new subroutines.
|
||||
(profiler--report-cpu): Rename from sample-profiler-report.
|
||||
(profiler--report-memory): Rename from memory-profiler-report.
|
||||
|
||||
2012-08-22 Tomohiro Matsuyama <tomo@cx4a.org>
|
||||
|
||||
* profiler.el: Switch to cl-lib.
|
||||
|
|
@ -35,8 +67,8 @@
|
|||
* window.el (window-point-1, set-window-point-1): Remove.
|
||||
(window-in-direction, record-window-buffer)
|
||||
(set-window-buffer-start-and-point, split-window-below)
|
||||
(window--state-get-1, display-buffer-record-window): Replace
|
||||
calls to window-point-1 and set-window-point-1 by calls to
|
||||
(window--state-get-1, display-buffer-record-window):
|
||||
Replace calls to window-point-1 and set-window-point-1 by calls to
|
||||
window-point and set-window-point respectively.
|
||||
|
||||
2012-08-21 Glenn Morris <rgm@gnu.org>
|
||||
|
|
@ -154,8 +186,8 @@
|
|||
(yank-excluded-properties): Add font-lock-face and category.
|
||||
(yank): Doc fix.
|
||||
|
||||
* subr.el (remove-yank-excluded-properties): Obey
|
||||
yank-handled-properties. The special handling of font-lock-face
|
||||
* subr.el (remove-yank-excluded-properties):
|
||||
Obey yank-handled-properties. The special handling of font-lock-face
|
||||
and category is now done this way, instead of being hard-coded.
|
||||
(insert-for-yank-1): Remove font-lock-face handling.
|
||||
(yank-handle-font-lock-face-property)
|
||||
|
|
@ -169,8 +201,8 @@
|
|||
|
||||
2012-08-17 Michael Albinus <michael.albinus@gmx.de>
|
||||
|
||||
* net/tramp-sh.el (tramp-sh-handle-start-file-process): Eliminate
|
||||
superfluous prompt. (Bug#12203)
|
||||
* net/tramp-sh.el (tramp-sh-handle-start-file-process):
|
||||
Eliminate superfluous prompt. (Bug#12203)
|
||||
|
||||
2012-08-17 Chong Yidong <cyd@gnu.org>
|
||||
|
||||
|
|
@ -197,8 +229,8 @@
|
|||
(next-buffer, previous-buffer, split-window, balance-windows-2)
|
||||
(set-window-text-height, window-buffer-height)
|
||||
(fit-window-to-buffer, shrink-window-if-larger-than-buffer)
|
||||
(truncated-partial-width-window-p): Minor code adjustments. In
|
||||
doc-strings state whether the argument window has to denote a
|
||||
(truncated-partial-width-window-p): Minor code adjustments.
|
||||
In doc-strings state whether the argument window has to denote a
|
||||
live, valid or any window.
|
||||
|
||||
2012-08-16 Phil Sainty <psainty@orcon.net.nz> (tiny change)
|
||||
|
|
|
|||
364
lisp/profiler.el
364
lisp/profiler.el
|
|
@ -32,7 +32,11 @@
|
|||
:group 'lisp
|
||||
:prefix "profiler-")
|
||||
|
||||
|
||||
(defcustom profiler-sample-interval 1
|
||||
"Default sample interval in millisecond."
|
||||
:type 'integer
|
||||
:group 'profiler)
|
||||
|
||||
;;; Utilities
|
||||
|
||||
(defun profiler-ensure-string (object)
|
||||
|
|
@ -90,55 +94,34 @@
|
|||
|
||||
;;; Entries
|
||||
|
||||
(defun profiler-entry= (entry1 entry2)
|
||||
"Return t if ENTRY1 and ENTRY2 are same."
|
||||
(or (eq entry1 entry2)
|
||||
(and (stringp entry1)
|
||||
(stringp entry2)
|
||||
(string= entry1 entry2))))
|
||||
|
||||
(defun profiler-entry-format (entry)
|
||||
"Format ENTRY in human readable string. ENTRY would be a
|
||||
function name of a function itself."
|
||||
(cond ((and (consp entry)
|
||||
(or (eq (car entry) 'lambda)
|
||||
(eq (car entry) 'closure)))
|
||||
(format "#<closure 0x%x>" (sxhash entry)))
|
||||
((eq (type-of entry) 'compiled-function)
|
||||
(cond ((memq (car-safe entry) '(closure lambda))
|
||||
(format "#<lambda 0x%x>" (sxhash entry)))
|
||||
((byte-code-function-p entry)
|
||||
(format "#<compiled 0x%x>" (sxhash entry)))
|
||||
((subrp entry)
|
||||
(subr-name entry))
|
||||
((symbolp entry)
|
||||
(symbol-name entry))
|
||||
((stringp entry)
|
||||
entry)
|
||||
((or (subrp entry) (symbolp entry) (stringp entry))
|
||||
(format "%s" entry))
|
||||
(t
|
||||
(format "#<unknown 0x%x>" (sxhash entry)))))
|
||||
|
||||
|
||||
;;; Backtrace data structure
|
||||
|
||||
(defun profiler-backtrace-reverse (backtrace)
|
||||
(cl-case (car backtrace)
|
||||
((t gc)
|
||||
;; Make sure Others node and GC node always be at top.
|
||||
(cons (car backtrace)
|
||||
(reverse (cdr backtrace))))
|
||||
(t (reverse backtrace))))
|
||||
|
||||
|
||||
;;; Slot data structure
|
||||
|
||||
(cl-defstruct (profiler-slot (:type list)
|
||||
(:constructor profiler-make-slot))
|
||||
backtrace count elapsed)
|
||||
|
||||
|
||||
;;; Log data structure
|
||||
|
||||
(cl-defstruct (profiler-log (:type list)
|
||||
(:constructor profiler-make-log))
|
||||
type diff-p timestamp slots)
|
||||
;; The C code returns the log in the form of a hash-table where the keys are
|
||||
;; vectors (of size profiler-max-stack-depth, holding truncated
|
||||
;; backtraces, where the first element is the top of the stack) and
|
||||
;; the values are integers (which count how many times this backtrace
|
||||
;; has been seen, multiplied by a "weight factor" which is either the
|
||||
;; sample-interval or the memory being allocated).
|
||||
;; We extend it by adding a few other entries to the hash-table, most notably:
|
||||
;; - Key `type' has a value indicating the kind of log (`memory' or `cpu').
|
||||
;; - Key `timestamp' has a value giving the time when the log was obtained.
|
||||
;; - Key `diff-p' indicates if this log represents a diff between two logs.
|
||||
|
||||
(defun profiler-log-timestamp (log) (gethash 'timestamp log))
|
||||
(defun profiler-log-type (log) (gethash 'type log))
|
||||
(defun profiler-log-diff-p (log) (gethash 'diff-p log))
|
||||
|
||||
(defun profiler-log-diff (log1 log2)
|
||||
"Compare LOG1 with LOG2 and return a diff log. Both logs must
|
||||
|
|
@ -146,16 +129,17 @@ be same type."
|
|||
(unless (eq (profiler-log-type log1)
|
||||
(profiler-log-type log2))
|
||||
(error "Can't compare different type of logs"))
|
||||
(let ((slots (profiler-log-slots log2)))
|
||||
(dolist (slot (profiler-log-slots log1))
|
||||
(push (profiler-make-slot :backtrace (profiler-slot-backtrace slot)
|
||||
:count (- (profiler-slot-count slot))
|
||||
:elapsed (- (profiler-slot-elapsed slot)))
|
||||
slots))
|
||||
(profiler-make-log :type (profiler-log-type log1)
|
||||
:diff-p t
|
||||
:timestamp (current-time)
|
||||
:slots slots)))
|
||||
(let ((newlog (make-hash-table :test 'equal)))
|
||||
;; Make a copy of `log1' into `newlog'.
|
||||
(maphash (lambda (backtrace count) (puthash backtrace count newlog))
|
||||
log1)
|
||||
(puthash 'diff-p t newlog)
|
||||
(maphash (lambda (backtrace count)
|
||||
(when (vectorp backtrace)
|
||||
(puthash backtrace (- (gethash backtrace log1 0) count)
|
||||
newlog)))
|
||||
log2)
|
||||
newlog))
|
||||
|
||||
(defun profiler-log-fixup-entry (entry)
|
||||
(if (symbolp entry)
|
||||
|
|
@ -165,21 +149,16 @@ be same type."
|
|||
(defun profiler-log-fixup-backtrace (backtrace)
|
||||
(mapcar 'profiler-log-fixup-entry backtrace))
|
||||
|
||||
(defun profiler-log-fixup-slot (slot)
|
||||
(let ((backtrace (profiler-slot-backtrace slot)))
|
||||
(profiler-make-slot :backtrace (profiler-log-fixup-backtrace backtrace)
|
||||
:count (profiler-slot-count slot)
|
||||
:elapsed (profiler-slot-elapsed slot))))
|
||||
|
||||
(defun profiler-log-fixup (log)
|
||||
"Fixup LOG so that the log could be serialized into file."
|
||||
(cl-loop for slot in (profiler-log-slots log)
|
||||
collect (profiler-log-fixup-slot slot) into slots
|
||||
finally return
|
||||
(profiler-make-log :type (profiler-log-type log)
|
||||
:diff-p (profiler-log-diff-p log)
|
||||
:timestamp (profiler-log-timestamp log)
|
||||
:slots slots)))
|
||||
(let ((newlog (make-hash-table :test 'equal)))
|
||||
(maphash (lambda (backtrace count)
|
||||
(puthash (if (not (vectorp backtrace))
|
||||
backtrace
|
||||
(profiler-log-fixup-backtrace backtrace))
|
||||
count newlog))
|
||||
log)
|
||||
newlog))
|
||||
|
||||
(defun profiler-log-write-file (log filename &optional confirm)
|
||||
"Write LOG into FILENAME."
|
||||
|
|
@ -201,7 +180,6 @@ be same type."
|
|||
(cl-defstruct (profiler-calltree (:constructor profiler-make-calltree))
|
||||
entry
|
||||
(count 0) (count-percent "")
|
||||
(elapsed 0) (elapsed-percent "")
|
||||
parent children)
|
||||
|
||||
(defun profiler-calltree-leaf-p (tree)
|
||||
|
|
@ -210,25 +188,12 @@ be same type."
|
|||
(defun profiler-calltree-count< (a b)
|
||||
(cond ((eq (profiler-calltree-entry a) t) t)
|
||||
((eq (profiler-calltree-entry b) t) nil)
|
||||
((eq (profiler-calltree-entry a) 'gc) t)
|
||||
((eq (profiler-calltree-entry b) 'gc) nil)
|
||||
(t (< (profiler-calltree-count a)
|
||||
(profiler-calltree-count b)))))
|
||||
|
||||
(defun profiler-calltree-count> (a b)
|
||||
(not (profiler-calltree-count< a b)))
|
||||
|
||||
(defun profiler-calltree-elapsed< (a b)
|
||||
(cond ((eq (profiler-calltree-entry a) t) t)
|
||||
((eq (profiler-calltree-entry b) t) nil)
|
||||
((eq (profiler-calltree-entry a) 'gc) t)
|
||||
((eq (profiler-calltree-entry b) 'gc) nil)
|
||||
(t (< (profiler-calltree-elapsed a)
|
||||
(profiler-calltree-elapsed b)))))
|
||||
|
||||
(defun profiler-calltree-elapsed> (a b)
|
||||
(not (profiler-calltree-elapsed< a b)))
|
||||
|
||||
(defun profiler-calltree-depth (tree)
|
||||
(let ((parent (profiler-calltree-parent tree)))
|
||||
(if (null parent)
|
||||
|
|
@ -239,58 +204,47 @@ be same type."
|
|||
"Return a child tree of ENTRY under TREE."
|
||||
;; OPTIMIZED
|
||||
(let (result (children (profiler-calltree-children tree)))
|
||||
;; FIXME: Use `assoc'.
|
||||
(while (and children (null result))
|
||||
(let ((child (car children)))
|
||||
(when (profiler-entry= (profiler-calltree-entry child) entry)
|
||||
(when (equal (profiler-calltree-entry child) entry)
|
||||
(setq result child))
|
||||
(setq children (cdr children))))
|
||||
result))
|
||||
|
||||
(defun profiler-calltree-walk (calltree function &rest args)
|
||||
(apply function calltree args)
|
||||
(defun profiler-calltree-walk (calltree function)
|
||||
(funcall function calltree)
|
||||
(dolist (child (profiler-calltree-children calltree))
|
||||
(apply 'profiler-calltree-walk child function args)))
|
||||
(profiler-calltree-walk child function)))
|
||||
|
||||
(defun profiler-calltree-build-1 (tree log &optional reverse)
|
||||
(dolist (slot (profiler-log-slots log))
|
||||
(let ((backtrace (profiler-slot-backtrace slot))
|
||||
(count (profiler-slot-count slot))
|
||||
(elapsed (profiler-slot-elapsed slot))
|
||||
(node tree))
|
||||
(dolist (entry (if reverse
|
||||
backtrace
|
||||
(profiler-backtrace-reverse backtrace)))
|
||||
(let ((child (profiler-calltree-find node entry)))
|
||||
(unless child
|
||||
(setq child (profiler-make-calltree :entry entry :parent node))
|
||||
(push child (profiler-calltree-children node)))
|
||||
(cl-incf (profiler-calltree-count child) count)
|
||||
(cl-incf (profiler-calltree-elapsed child) elapsed)
|
||||
(setq node child))))))
|
||||
|
||||
(defun profiler-calltree-compute-percentages-1 (node total-count total-elapsed)
|
||||
(unless (zerop total-count)
|
||||
(setf (profiler-calltree-count-percent node)
|
||||
(profiler-format-percent (profiler-calltree-count node)
|
||||
total-count)))
|
||||
(unless (zerop total-elapsed)
|
||||
(setf (profiler-calltree-elapsed-percent node)
|
||||
(profiler-format-percent (profiler-calltree-elapsed node)
|
||||
total-elapsed))))
|
||||
(maphash
|
||||
(lambda (backtrace count)
|
||||
(when (vectorp backtrace)
|
||||
(let ((node tree)
|
||||
(max (length backtrace)))
|
||||
(dotimes (i max)
|
||||
(let ((entry (aref backtrace (if reverse i (- max i 1)))))
|
||||
(when entry
|
||||
(let ((child (profiler-calltree-find node entry)))
|
||||
(unless child
|
||||
(setq child (profiler-make-calltree
|
||||
:entry entry :parent node))
|
||||
(push child (profiler-calltree-children node)))
|
||||
(cl-incf (profiler-calltree-count child) count)
|
||||
(setq node child))))))))
|
||||
log))
|
||||
|
||||
(defun profiler-calltree-compute-percentages (tree)
|
||||
(let ((total-count 0)
|
||||
(total-elapsed 0))
|
||||
(let ((total-count 0))
|
||||
(dolist (child (profiler-calltree-children tree))
|
||||
(if (eq (profiler-calltree-entry child) 'gc)
|
||||
(profiler-calltree-compute-percentages child)
|
||||
(cl-incf total-count (profiler-calltree-count child))
|
||||
(cl-incf total-elapsed (profiler-calltree-elapsed child))))
|
||||
(dolist (child (profiler-calltree-children tree))
|
||||
(unless (eq (profiler-calltree-entry child) 'gc)
|
||||
(profiler-calltree-walk
|
||||
child 'profiler-calltree-compute-percentages-1
|
||||
total-count total-elapsed)))))
|
||||
(cl-incf total-count (profiler-calltree-count child)))
|
||||
(unless (zerop total-count)
|
||||
(profiler-calltree-walk
|
||||
tree (lambda (node)
|
||||
(setf (profiler-calltree-count-percent node)
|
||||
(profiler-format-percent (profiler-calltree-count node)
|
||||
total-count)))))))
|
||||
|
||||
(cl-defun profiler-calltree-build (log &key reverse)
|
||||
(let ((tree (profiler-make-calltree)))
|
||||
|
|
@ -332,14 +286,14 @@ be same type."
|
|||
(19 right ((14 right profiler-format-nbytes)
|
||||
(5 right)))))
|
||||
|
||||
(defvar profiler-report-log nil
|
||||
(defvar-local profiler-report-log nil
|
||||
"The current profiler log.")
|
||||
|
||||
(defvar profiler-report-reversed nil
|
||||
(defvar-local profiler-report-reversed nil
|
||||
"True if calltree is rendered in bottom-up. Do not touch this
|
||||
variable directly.")
|
||||
|
||||
(defvar profiler-report-order nil
|
||||
(defvar-local profiler-report-order nil
|
||||
"The value can be `ascending' or `descending'. Do not touch
|
||||
this variable directly.")
|
||||
|
||||
|
|
@ -347,8 +301,6 @@ this variable directly.")
|
|||
(let ((string (cond
|
||||
((eq entry t)
|
||||
"Others")
|
||||
((eq entry 'gc)
|
||||
"Garbage Collection")
|
||||
((and (symbolp entry)
|
||||
(fboundp entry))
|
||||
(propertize (symbol-name entry)
|
||||
|
|
@ -357,7 +309,7 @@ this variable directly.")
|
|||
'help-echo "mouse-2 or RET jumps to definition"))
|
||||
(t
|
||||
(profiler-entry-format entry)))))
|
||||
(propertize string 'entry entry)))
|
||||
(propertize string 'profiler-entry entry)))
|
||||
|
||||
(defun profiler-report-make-name-part (tree)
|
||||
(let* ((entry (profiler-calltree-entry tree))
|
||||
|
|
@ -377,31 +329,18 @@ this variable directly.")
|
|||
(defun profiler-report-line-format (tree)
|
||||
(let ((diff-p (profiler-log-diff-p profiler-report-log))
|
||||
(name-part (profiler-report-make-name-part tree))
|
||||
(elapsed (profiler-calltree-elapsed tree))
|
||||
(elapsed-percent (profiler-calltree-elapsed-percent tree))
|
||||
(count (profiler-calltree-count tree))
|
||||
(count-percent (profiler-calltree-count-percent tree)))
|
||||
(cl-ecase (profiler-log-type profiler-report-log)
|
||||
(sample
|
||||
(if diff-p
|
||||
(profiler-format profiler-report-sample-line-format
|
||||
name-part
|
||||
(list (if (> elapsed 0)
|
||||
(format "+%s" elapsed)
|
||||
elapsed)
|
||||
""))
|
||||
(profiler-format profiler-report-sample-line-format
|
||||
name-part (list elapsed elapsed-percent))))
|
||||
(memory
|
||||
(if diff-p
|
||||
(profiler-format profiler-report-memory-line-format
|
||||
name-part
|
||||
(list (if (> count 0)
|
||||
(format "+%s" count)
|
||||
count)
|
||||
""))
|
||||
(profiler-format profiler-report-memory-line-format
|
||||
name-part (list count count-percent)))))))
|
||||
(profiler-format (cl-ecase (profiler-log-type profiler-report-log)
|
||||
(cpu profiler-report-sample-line-format)
|
||||
(memory profiler-report-memory-line-format))
|
||||
name-part
|
||||
(if diff-p
|
||||
(list (if (> count 0)
|
||||
(format "+%s" count)
|
||||
count)
|
||||
"")
|
||||
(list count count-percent)))))
|
||||
|
||||
(defun profiler-report-insert-calltree (tree)
|
||||
(let ((line (profiler-report-line-format tree)))
|
||||
|
|
@ -416,10 +355,13 @@ this variable directly.")
|
|||
|
||||
(defvar profiler-report-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
;; FIXME: Add menu.
|
||||
(define-key map "n" 'profiler-report-next-entry)
|
||||
(define-key map "p" 'profiler-report-previous-entry)
|
||||
(define-key map [down] 'profiler-report-next-entry)
|
||||
(define-key map [up] 'profiler-report-previous-entry)
|
||||
;; I find it annoying more than helpful to not be able to navigate
|
||||
;; normally with the cursor keys. --Stef
|
||||
;; (define-key map [down] 'profiler-report-next-entry)
|
||||
;; (define-key map [up] 'profiler-report-previous-entry)
|
||||
(define-key map "\r" 'profiler-report-toggle-entry)
|
||||
(define-key map "\t" 'profiler-report-toggle-entry)
|
||||
(define-key map "i" 'profiler-report-toggle-entry)
|
||||
|
|
@ -437,10 +379,9 @@ this variable directly.")
|
|||
map))
|
||||
|
||||
(defun profiler-report-make-buffer-name (log)
|
||||
(let ((time (format-time-string "%Y-%m-%d %T" (profiler-log-timestamp log))))
|
||||
(cl-ecase (profiler-log-type log)
|
||||
(sample (format "*CPU-Profiler-Report %s*" time))
|
||||
(memory (format "*Memory-Profiler-Report %s*" time)))))
|
||||
(format "*%s-Profiler-Report %s*"
|
||||
(cl-ecase (profiler-log-type log) (cpu 'CPU) (memory 'Memory))
|
||||
(format-time-string "%Y-%m-%d %T" (profiler-log-timestamp log))))
|
||||
|
||||
(defun profiler-report-setup-buffer (log)
|
||||
"Make a buffer for LOG and return it."
|
||||
|
|
@ -455,10 +396,6 @@ this variable directly.")
|
|||
|
||||
(define-derived-mode profiler-report-mode special-mode "Profiler-Report"
|
||||
"Profiler Report Mode."
|
||||
(make-local-variable 'profiler-report-log)
|
||||
(make-local-variable 'profiler-report-reversed)
|
||||
(make-local-variable 'profiler-report-order)
|
||||
(use-local-map profiler-report-mode-map)
|
||||
(setq buffer-read-only t
|
||||
buffer-undo-list t
|
||||
truncate-lines t))
|
||||
|
|
@ -470,7 +407,8 @@ this variable directly.")
|
|||
(get-text-property (point) 'calltree))
|
||||
|
||||
(defun profiler-report-move-to-entry ()
|
||||
(let ((point (next-single-property-change (line-beginning-position) 'entry)))
|
||||
(let ((point (next-single-property-change (line-beginning-position)
|
||||
'profiler-entry)))
|
||||
(if point
|
||||
(goto-char point)
|
||||
(back-to-indentation))))
|
||||
|
|
@ -496,7 +434,7 @@ this variable directly.")
|
|||
(line-end-position) t)
|
||||
(let ((tree (profiler-report-calltree-at-point)))
|
||||
(when tree
|
||||
(let ((buffer-read-only nil))
|
||||
(let ((inhibit-read-only t))
|
||||
(replace-match (concat profiler-report-open-mark " "))
|
||||
(forward-line)
|
||||
(profiler-report-insert-calltree-children tree)
|
||||
|
|
@ -514,7 +452,7 @@ this variable directly.")
|
|||
(start (line-beginning-position 2))
|
||||
d)
|
||||
(when tree
|
||||
(let ((buffer-read-only nil))
|
||||
(let ((inhibit-read-only t))
|
||||
(replace-match (concat profiler-report-closed-mark " "))
|
||||
(while (and (eq (forward-line) 0)
|
||||
(let ((child (get-text-property (point) 'calltree)))
|
||||
|
|
@ -549,29 +487,25 @@ otherwise collapse."
|
|||
(require 'help-fns)
|
||||
(describe-function entry)))))
|
||||
|
||||
(cl-defun profiler-report-render-calltree-1 (log &key reverse (order 'descending))
|
||||
(cl-defun profiler-report-render-calltree-1
|
||||
(log &key reverse (order 'descending))
|
||||
(let ((calltree (profiler-calltree-build profiler-report-log
|
||||
:reverse reverse)))
|
||||
(cl-ecase (profiler-log-type log)
|
||||
(sample
|
||||
(setq header-line-format
|
||||
(setq header-line-format
|
||||
(cl-ecase (profiler-log-type log)
|
||||
(cpu
|
||||
(profiler-report-header-line-format
|
||||
profiler-report-sample-line-format
|
||||
"Function" (list "Time (ms)" "%")))
|
||||
(let ((predicate (cl-ecase order
|
||||
(ascending 'profiler-calltree-elapsed<)
|
||||
(descending 'profiler-calltree-elapsed>))))
|
||||
(profiler-calltree-sort calltree predicate)))
|
||||
(memory
|
||||
(setq header-line-format
|
||||
(memory
|
||||
(profiler-report-header-line-format
|
||||
profiler-report-memory-line-format
|
||||
"Function" (list "Bytes" "%")))
|
||||
(let ((predicate (cl-ecase order
|
||||
(ascending 'profiler-calltree-count<)
|
||||
(descending 'profiler-calltree-count>))))
|
||||
(profiler-calltree-sort calltree predicate))))
|
||||
(let ((buffer-read-only nil))
|
||||
"Function" (list "Bytes" "%")))))
|
||||
(let ((predicate (cl-ecase order
|
||||
(ascending #'profiler-calltree-count<)
|
||||
(descending #'profiler-calltree-count>))))
|
||||
(profiler-calltree-sort calltree predicate))
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)
|
||||
(profiler-report-insert-calltree-children calltree)
|
||||
(goto-char (point-min))
|
||||
|
|
@ -632,19 +566,15 @@ otherwise collapse."
|
|||
|
||||
;;; Profiler commands
|
||||
|
||||
(defcustom profiler-sample-interval 10
|
||||
"Default sample interval in millisecond."
|
||||
:type 'integer
|
||||
:group 'profiler)
|
||||
|
||||
;;;###autoload
|
||||
(defun profiler-start (mode)
|
||||
"Start/restart profilers. MODE can be one of `cpu', `mem',
|
||||
and `cpu+mem'. If MODE is `cpu' or `cpu+mem', sample profiler
|
||||
will be started. Also, if MODE is `mem' or `cpu+mem', then
|
||||
memory profiler will be started."
|
||||
"Start/restart profilers.
|
||||
MODE can be one of `cpu', `mem', or `cpu+mem'.
|
||||
If MODE is `cpu' or `cpu+mem', time-based profiler will be started.
|
||||
Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started."
|
||||
(interactive
|
||||
(list (intern (completing-read "Mode: " '("cpu" "mem" "cpu+mem")
|
||||
(list (intern (completing-read "Mode (default cpu): "
|
||||
'("cpu" "mem" "cpu+mem")
|
||||
nil t nil nil "cpu"))))
|
||||
(cl-ecase mode
|
||||
(cpu
|
||||
|
|
@ -679,25 +609,29 @@ memory profiler will be started."
|
|||
(defun profiler-reset ()
|
||||
"Reset profiler log."
|
||||
(interactive)
|
||||
(sample-profiler-reset)
|
||||
(memory-profiler-reset)
|
||||
(ignore (sample-profiler-log))
|
||||
(ignore (memory-profiler-log))
|
||||
t)
|
||||
|
||||
(defun sample-profiler-report ()
|
||||
(let ((sample-log (sample-profiler-log)))
|
||||
(when sample-log
|
||||
(profiler-report-log sample-log))))
|
||||
(defun profiler--report-cpu ()
|
||||
(let ((log (sample-profiler-log)))
|
||||
(when log
|
||||
(puthash 'type 'cpu log)
|
||||
(puthash 'timestamp (current-time) log)
|
||||
(profiler-report-log log))))
|
||||
|
||||
(defun memory-profiler-report ()
|
||||
(let ((memory-log (memory-profiler-log)))
|
||||
(when memory-log
|
||||
(profiler-report-log memory-log))))
|
||||
(defun profiler--report-memory ()
|
||||
(let ((log (memory-profiler-log)))
|
||||
(when log
|
||||
(puthash 'type 'memory log)
|
||||
(puthash 'timestamp (current-time) log)
|
||||
(profiler-report-log log))))
|
||||
|
||||
(defun profiler-report ()
|
||||
"Report profiling results."
|
||||
(interactive)
|
||||
(sample-profiler-report)
|
||||
(memory-profiler-report))
|
||||
(profiler--report-cpu)
|
||||
(profiler--report-memory))
|
||||
|
||||
;;;###autoload
|
||||
(defun profiler-find-log (filename)
|
||||
|
|
@ -709,25 +643,23 @@ memory profiler will be started."
|
|||
|
||||
;;; Profiling helpers
|
||||
|
||||
(cl-defmacro with-sample-profiling ((&key (interval profiler-sample-interval)) &rest body)
|
||||
`(progn
|
||||
(sample-profiler-start ,interval)
|
||||
(sample-profiler-reset)
|
||||
(unwind-protect
|
||||
(progn ,@body)
|
||||
(sample-profiler-stop)
|
||||
(sample-profiler-report)
|
||||
(sample-profiler-reset))))
|
||||
(cl-defmacro with-sample-profiling ((&key interval) &rest body)
|
||||
`(unwind-protect
|
||||
(progn
|
||||
(ignore (sample-profiler-log))
|
||||
(sample-profiler-start ,interval)
|
||||
,@body)
|
||||
(sample-profiler-stop)
|
||||
(profiler--report-cpu)))
|
||||
|
||||
(cl-defmacro with-memory-profiling (() &rest body)
|
||||
`(progn
|
||||
(memory-profiler-start)
|
||||
(memory-profiler-reset)
|
||||
(unwind-protect
|
||||
(progn ,@body)
|
||||
(memory-profiler-stop)
|
||||
(memory-profiler-report)
|
||||
(memory-profiler-reset))))
|
||||
(defmacro with-memory-profiling (&rest body)
|
||||
`(unwind-protect
|
||||
(progn
|
||||
(ignore (memory-profiler-log))
|
||||
(memory-profiler-start)
|
||||
,@body)
|
||||
(memory-profiler-stop)
|
||||
(profiler--report-memory)))
|
||||
|
||||
(provide 'profiler)
|
||||
;;; profiler.el ends here
|
||||
|
|
|
|||
|
|
@ -1,3 +1,31 @@
|
|||
2012-09-24 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* xdisp.c (Qautomatic_redisplay): New constant.
|
||||
(redisplay_internal): Record itself in backtrace_list.
|
||||
(syms_of_xdisp): Define Qautomatic_redisplay.
|
||||
|
||||
* profiler.c: Remove filtering functionality.
|
||||
(is_in_trace, Qgc): Remove vars.
|
||||
(make_log, record_backtrace, Fsample_profiler_log):
|
||||
Rewrite, using Elisp hash-tables.
|
||||
(approximate_median, evict_lower_half): New functions.
|
||||
(cpu_log): Rename from sample_log.
|
||||
(cpu_gc_count): New var.
|
||||
(Fsample_profiler_reset, Fmemory_profiler_reset): Remove.
|
||||
(sigprof_handler): Add count to cpu_gc_count during GC, detected via
|
||||
backtrace_list.
|
||||
(block_sigprof, unblock_sigprof): Remove.
|
||||
(gc_probe, mark_profiler): Remove functions.
|
||||
(syms_of_profiler): Staticpro cpu_log and memory_log.
|
||||
|
||||
* lisp.h (SXHASH_COMBINE): Move back to...
|
||||
* fns.c (SXHASH_COMBINE): ...here.
|
||||
|
||||
* alloc.c (Fgarbage_collect): Record itself in backtrace_list.
|
||||
Don't set is_in_trace any more. Don't call mark_profiler.
|
||||
Only call gc_probe for the memory profiler.
|
||||
(syms_of_alloc): Define Qautomatic_gc.
|
||||
|
||||
2012-09-15 Tomohiro Matsuyama <tomo@cx4a.org>
|
||||
|
||||
* alloc.c (emacs_blocked_malloc): Remove redundant MALLOC_PROBE.
|
||||
|
|
|
|||
26
src/alloc.c
26
src/alloc.c
|
|
@ -264,6 +264,7 @@ static Lisp_Object Qintervals;
|
|||
static Lisp_Object Qbuffers;
|
||||
static Lisp_Object Qstring_bytes, Qvector_slots, Qheap;
|
||||
static Lisp_Object Qgc_cons_threshold;
|
||||
Lisp_Object Qautomatic_gc;
|
||||
Lisp_Object Qchar_table_extra_slots;
|
||||
|
||||
/* Hook run after GC has finished. */
|
||||
|
|
@ -5421,6 +5422,7 @@ See Info node `(elisp)Garbage Collection'. */)
|
|||
EMACS_TIME start;
|
||||
Lisp_Object retval = Qnil;
|
||||
size_t tot_before = 0;
|
||||
struct backtrace backtrace;
|
||||
|
||||
if (abort_on_gc)
|
||||
abort ();
|
||||
|
|
@ -5430,6 +5432,14 @@ See Info node `(elisp)Garbage Collection'. */)
|
|||
if (pure_bytes_used_before_overflow)
|
||||
return Qnil;
|
||||
|
||||
/* Record this function, so it appears on the profiler's backtraces. */
|
||||
backtrace.next = backtrace_list;
|
||||
backtrace.function = &Qautomatic_gc;
|
||||
backtrace.args = &Qautomatic_gc;
|
||||
backtrace.nargs = 0;
|
||||
backtrace.debug_on_exit = 0;
|
||||
backtrace_list = &backtrace;
|
||||
|
||||
check_cons_list ();
|
||||
|
||||
/* Don't keep undo information around forever.
|
||||
|
|
@ -5486,7 +5496,6 @@ See Info node `(elisp)Garbage Collection'. */)
|
|||
shrink_regexp_cache ();
|
||||
|
||||
gc_in_progress = 1;
|
||||
is_in_trace = 1;
|
||||
|
||||
/* Mark all the special slots that serve as the roots of accessibility. */
|
||||
|
||||
|
|
@ -5538,8 +5547,6 @@ See Info node `(elisp)Garbage Collection'. */)
|
|||
mark_backtrace ();
|
||||
#endif
|
||||
|
||||
mark_profiler ();
|
||||
|
||||
#ifdef HAVE_WINDOW_SYSTEM
|
||||
mark_fringe_data ();
|
||||
#endif
|
||||
|
|
@ -5607,7 +5614,6 @@ See Info node `(elisp)Garbage Collection'. */)
|
|||
check_cons_list ();
|
||||
|
||||
gc_in_progress = 0;
|
||||
is_in_trace = 0;
|
||||
|
||||
consing_since_gc = 0;
|
||||
if (gc_cons_threshold < GC_DEFAULT_THRESHOLD / 10)
|
||||
|
|
@ -5720,24 +5726,19 @@ See Info node `(elisp)Garbage Collection'. */)
|
|||
gcs_done++;
|
||||
|
||||
/* Collect profiling data. */
|
||||
if (sample_profiler_running || memory_profiler_running)
|
||||
if (memory_profiler_running)
|
||||
{
|
||||
size_t swept = 0;
|
||||
size_t elapsed = 0;
|
||||
if (memory_profiler_running)
|
||||
{
|
||||
size_t tot_after = total_bytes_of_live_objects ();
|
||||
if (tot_before > tot_after)
|
||||
swept = tot_before - tot_after;
|
||||
}
|
||||
if (sample_profiler_running)
|
||||
{
|
||||
EMACS_TIME since_start = sub_emacs_time (current_emacs_time (), start);
|
||||
elapsed = EMACS_TIME_TO_DOUBLE (since_start) * 1000;
|
||||
}
|
||||
gc_probe (swept, elapsed);
|
||||
malloc_probe (swept);
|
||||
}
|
||||
|
||||
backtrace_list = backtrace.next;
|
||||
return retval;
|
||||
}
|
||||
|
||||
|
|
@ -6867,6 +6868,7 @@ do hash-consing of the objects allocated to pure space. */);
|
|||
DEFSYM (Qstring_bytes, "string-bytes");
|
||||
DEFSYM (Qvector_slots, "vector-slots");
|
||||
DEFSYM (Qheap, "heap");
|
||||
DEFSYM (Qautomatic_gc, "Automatic GC");
|
||||
|
||||
DEFSYM (Qgc_cons_threshold, "gc-cons-threshold");
|
||||
DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots");
|
||||
|
|
|
|||
|
|
@ -4096,6 +4096,13 @@ sweep_weak_hash_tables (void)
|
|||
|
||||
#define SXHASH_MAX_LEN 7
|
||||
|
||||
/* Combine two integers X and Y for hashing. The result might not fit
|
||||
into a Lisp integer. */
|
||||
|
||||
#define SXHASH_COMBINE(X, Y) \
|
||||
((((EMACS_UINT) (X) << 4) + ((EMACS_UINT) (X) >> (BITS_PER_EMACS_INT - 4))) \
|
||||
+ (EMACS_UINT) (Y))
|
||||
|
||||
/* Hash X, returning a value that fits into a Lisp integer. */
|
||||
#define SXHASH_REDUCE(X) \
|
||||
((((X) ^ (X) >> (BITS_PER_EMACS_INT - FIXNUM_BITS))) & INTMASK)
|
||||
|
|
|
|||
11
src/lisp.h
11
src/lisp.h
|
|
@ -2679,11 +2679,6 @@ extern void init_syntax_once (void);
|
|||
extern void syms_of_syntax (void);
|
||||
|
||||
/* Defined in fns.c */
|
||||
/* Combine two integers X and Y for hashing. The result might not fit
|
||||
into a Lisp integer. */
|
||||
#define SXHASH_COMBINE(X, Y) \
|
||||
((((EMACS_UINT) (X) << 4) + ((EMACS_UINT) (X) >> (BITS_PER_EMACS_INT - 4))) \
|
||||
+ (EMACS_UINT) (Y))
|
||||
extern Lisp_Object QCrehash_size, QCrehash_threshold;
|
||||
enum { NEXT_ALMOST_PRIME_LIMIT = 11 };
|
||||
EXFUN (Fidentity, 1) ATTRIBUTE_CONST;
|
||||
|
|
@ -2921,6 +2916,7 @@ build_string (const char *str)
|
|||
|
||||
extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
|
||||
extern void make_byte_code (struct Lisp_Vector *);
|
||||
extern Lisp_Object Qautomatic_gc;
|
||||
extern Lisp_Object Qchar_table_extra_slots;
|
||||
extern struct Lisp_Vector *allocate_vector (EMACS_INT);
|
||||
extern struct Lisp_Vector *allocate_pseudovector (int memlen, int lisplen, int tag);
|
||||
|
|
@ -3532,19 +3528,14 @@ void syms_of_dbusbind (void);
|
|||
/* Defined in profiler.c */
|
||||
extern bool sample_profiler_running;
|
||||
extern bool memory_profiler_running;
|
||||
extern bool is_in_trace;
|
||||
extern Lisp_Object Qgc;
|
||||
extern void malloc_probe (size_t);
|
||||
extern void gc_probe (size_t, size_t);
|
||||
#define ENTER_TRACE (is_in_trace = 1)
|
||||
#define LEAVE_TRACE (is_in_trace = 0)
|
||||
#define MALLOC_PROBE(size) \
|
||||
do { \
|
||||
if (memory_profiler_running) \
|
||||
malloc_probe (size); \
|
||||
} while (0)
|
||||
|
||||
extern void mark_profiler (void);
|
||||
extern void syms_of_profiler (void);
|
||||
|
||||
#ifdef DOS_NT
|
||||
|
|
|
|||
1046
src/profiler.c
1046
src/profiler.c
File diff suppressed because it is too large
Load diff
18
src/xdisp.c
18
src/xdisp.c
|
|
@ -333,10 +333,10 @@ static Lisp_Object Qinhibit_eval_during_redisplay;
|
|||
static Lisp_Object Qbuffer_position, Qposition, Qobject;
|
||||
static Lisp_Object Qright_to_left, Qleft_to_right;
|
||||
|
||||
/* Cursor shapes */
|
||||
/* Cursor shapes. */
|
||||
Lisp_Object Qbar, Qhbar, Qbox, Qhollow;
|
||||
|
||||
/* Pointer shapes */
|
||||
/* Pointer shapes. */
|
||||
static Lisp_Object Qarrow, Qhand;
|
||||
Lisp_Object Qtext;
|
||||
|
||||
|
|
@ -347,6 +347,7 @@ static Lisp_Object Qfontification_functions;
|
|||
|
||||
static Lisp_Object Qwrap_prefix;
|
||||
static Lisp_Object Qline_prefix;
|
||||
static Lisp_Object Qautomatic_redisplay;
|
||||
|
||||
/* Non-nil means don't actually do any redisplay. */
|
||||
|
||||
|
|
@ -12931,12 +12932,13 @@ redisplay_internal (void)
|
|||
struct frame *sf;
|
||||
int polling_stopped_here = 0;
|
||||
Lisp_Object old_frame = selected_frame;
|
||||
struct backtrace backtrace;
|
||||
|
||||
/* Non-zero means redisplay has to consider all windows on all
|
||||
frames. Zero means, only selected_window is considered. */
|
||||
int consider_all_windows_p;
|
||||
|
||||
/* Non-zero means redisplay has to redisplay the miniwindow */
|
||||
/* Non-zero means redisplay has to redisplay the miniwindow. */
|
||||
int update_miniwindow_p = 0;
|
||||
|
||||
TRACE ((stderr, "redisplay_internal %d\n", redisplaying_p));
|
||||
|
|
@ -12974,6 +12976,14 @@ redisplay_internal (void)
|
|||
++redisplaying_p;
|
||||
specbind (Qinhibit_free_realized_faces, Qnil);
|
||||
|
||||
/* Record this function, so it appears on the profiler's backtraces. */
|
||||
backtrace.next = backtrace_list;
|
||||
backtrace.function = &Qautomatic_redisplay;
|
||||
backtrace.args = &Qautomatic_redisplay;
|
||||
backtrace.nargs = 0;
|
||||
backtrace.debug_on_exit = 0;
|
||||
backtrace_list = &backtrace;
|
||||
|
||||
{
|
||||
Lisp_Object tail, frame;
|
||||
|
||||
|
|
@ -13671,6 +13681,7 @@ redisplay_internal (void)
|
|||
#endif /* HAVE_WINDOW_SYSTEM */
|
||||
|
||||
end_of_redisplay:
|
||||
backtrace_list = backtrace.next;
|
||||
unbind_to (count, Qnil);
|
||||
RESUME_POLLING;
|
||||
}
|
||||
|
|
@ -28696,6 +28707,7 @@ syms_of_xdisp (void)
|
|||
staticpro (&Vmessage_stack);
|
||||
|
||||
DEFSYM (Qinhibit_redisplay, "inhibit-redisplay");
|
||||
DEFSYM (Qautomatic_redisplay, "Automatic Redisplay");
|
||||
|
||||
message_dolog_marker1 = Fmake_marker ();
|
||||
staticpro (&message_dolog_marker1);
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue