=== modified file 'lisp/profiler.el' --- lisp/profiler.el 2012-09-26 15:19:10 +0000 +++ lisp/profiler.el 2012-09-30 16:17:12 +0000 @@ -24,19 +24,21 @@ ;;; Code: -(eval-when-compile - (require 'cl-lib)) +(require 'cl-lib) (defgroup profiler nil "Emacs profiler." :group 'lisp :prefix "profiler-") -(defcustom profiler-sample-interval 1 - "Default sample interval in millisecond." +(defconst profiler-version "24.3") + +(defcustom profiler-sampling-interval 10 + "Default sampling interval in millisecond." :type 'integer :group 'profiler) + ;;; Utilities (defun profiler-ensure-string (object) @@ -49,6 +51,23 @@ (t (format "%s" object)))) +(defun profiler-format-percent (number divisor) + (concat (number-to-string (/ (* number 100) divisor)) "%")) + +(defun profiler-format-number (number) + "Format NUMBER in humarn readable string." + (if (and (integerp number) (> number 0)) + (cl-loop with i = (% (1+ (floor (log10 number))) 3) + for c in (append (number-to-string number) nil) + if (= i 0) + collect ?, into s + and do (setq i 3) + collect c into s + do (cl-decf i) + finally return + (apply 'string (if (eq (car s) ?,) (cdr s) s))) + (profiler-ensure-string number))) + (defun profiler-format (fmt &rest args) (cl-loop for (width align subfmt) in fmt for arg in args @@ -74,27 +93,10 @@ into frags finally return (apply #'concat frags))) -(defun profiler-format-percent (number divisor) - (concat (number-to-string (/ (* number 100) divisor)) "%")) - -(defun profiler-format-nbytes (nbytes) - "Format NBYTES in humarn readable string." - (if (and (integerp nbytes) (> nbytes 0)) - (cl-loop with i = (% (1+ (floor (log10 nbytes))) 3) - for c in (append (number-to-string nbytes) nil) - if (= i 0) - collect ?, into s - and do (setq i 3) - collect c into s - do (cl-decf i) - finally return - (apply 'string (if (eq (car s) ?,) (cdr s) s))) - (profiler-ensure-string nbytes))) - ;;; Entries -(defun profiler-entry-format (entry) +(defun profiler-format-entry (entry) "Format ENTRY in human readable string. ENTRY would be a function name of a function itself." (cond ((memq (car-safe entry) '(closure lambda)) @@ -106,76 +108,117 @@ (t (format "#" (sxhash entry))))) -;;; Log data structure +(defun profiler-fixup-entry (entry) + (if (symbolp entry) + entry + (profiler-format-entry entry))) + + +;;; Backtraces + +(defun profiler-fixup-backtrace (backtrace) + (apply 'vector (mapcar 'profiler-fixup-entry backtrace))) + + +;;; Logs ;; 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 -be same type." - (unless (eq (profiler-log-type log1) - (profiler-log-type log2)) - (error "Can't compare different type of logs")) +;; sampling-interval or the memory being allocated). + +(defun profiler-compare-logs (log1 log2) + "Compare LOG1 with LOG2 and return diff." (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))) + (puthash backtrace (- (gethash backtrace log1 0) count) + newlog)) log2) newlog)) -(defun profiler-log-fixup-entry (entry) - (if (symbolp entry) - entry - (profiler-entry-format entry))) - -(defun profiler-log-fixup-backtrace (backtrace) - (mapcar 'profiler-log-fixup-entry backtrace)) - -(defun profiler-log-fixup (log) - "Fixup LOG so that the log could be serialized into file." +(defun profiler-fixup-log (log) (let ((newlog (make-hash-table :test 'equal))) (maphash (lambda (backtrace count) - (puthash (if (not (vectorp backtrace)) - backtrace - (profiler-log-fixup-backtrace backtrace)) + (puthash (profiler-fixup-backtrace backtrace) count newlog)) log) newlog)) -(defun profiler-log-write-file (log filename &optional confirm) - "Write LOG into FILENAME." + +;;; Profiles + +(cl-defstruct (profiler-profile (:type vector) + (:constructor profiler-make-profile)) + (tag 'profiler-profile) + (version profiler-version) + ;; - `type' has a value indicating the kind of profile (`memory' or `cpu'). + ;; - `log' indicates the profile log. + ;; - `timestamp' has a value giving the time when the profile was obtained. + ;; - `diff-p' indicates if this profile represents a diff between two profiles. + type log timestamp diff-p) + +(defun profiler-compare-profiles (profile1 profile2) + "Compare PROFILE1 with PROFILE2 and return diff." + (unless (eq (profiler-profile-type profile1) + (profiler-profile-type profile2)) + (error "Can't compare different type of profiles")) + (profiler-make-profile + :type (profiler-profile-type profile1) + :timestamp (current-time) + :diff-p t + :log (profiler-compare-logs + (profiler-profile-log profile1) + (profiler-profile-log profile2)))) + +(defun profiler-fixup-profile (profile) + "Fixup PROFILE so that the profile could be serialized into file." + (profiler-make-profile + :type (profiler-profile-type profile) + :timestamp (profiler-profile-timestamp profile) + :diff-p (profiler-profile-diff-p profile) + :log (profiler-fixup-log (profiler-profile-log profile)))) + +(defun profiler-write-profile (profile filename &optional confirm) + "Write PROFILE into file FILENAME." (with-temp-buffer (let (print-level print-length) - (print (profiler-log-fixup log) (current-buffer))) + (print (profiler-fixup-profile profile) + (current-buffer))) (write-file filename confirm))) -(defun profiler-log-read-file (filename) - "Read log from FILENAME." +(defun profiler-read-profile (filename) + "Read profile from file FILENAME." + ;; FIXME: tag and version check (with-temp-buffer (insert-file-contents filename) (goto-char (point-min)) (read (current-buffer)))) +(defun profiler-cpu-profile () + "Return CPU profile." + (when (and (fboundp 'profiler-cpu-running-p) + (fboundp 'profiler-cpu-log) + (profiler-cpu-running-p)) + (profiler-make-profile + :type 'cpu + :timestamp (current-time) + :log (profiler-cpu-log)))) + +(defun profiler-memory-profile () + "Return memory profile." + (when (profiler-memory-running-p) + (profiler-make-profile + :type 'memory + :timestamp (current-time) + :log (profiler-memory-log)))) + -;;; Calltree data structure +;;; Calltrees (cl-defstruct (profiler-calltree (:constructor profiler-make-calltree)) entry @@ -202,7 +245,6 @@ (defun profiler-calltree-find (tree entry) "Return a child tree of ENTRY under TREE." - ;; OPTIMIZED (let (result (children (profiler-calltree-children tree))) ;; FIXME: Use `assoc'. (while (and children (null result)) @@ -224,19 +266,18 @@ ;; get a meaningful call-tree. (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)))))))) + (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) @@ -281,18 +322,18 @@ :type 'string :group 'profiler) -(defvar profiler-report-sample-line-format +(defvar profiler-report-cpu-line-format '((60 left) (14 right ((9 right) (5 right))))) (defvar profiler-report-memory-line-format '((55 left) - (19 right ((14 right profiler-format-nbytes) + (19 right ((14 right profiler-format-number) (5 right))))) -(defvar-local profiler-report-log nil - "The current profiler log.") +(defvar-local profiler-report-profile nil + "The current profile.") (defvar-local profiler-report-reversed nil "True if calltree is rendered in bottom-up. Do not touch this @@ -313,7 +354,7 @@ 'mouse-face 'highlight 'help-echo "mouse-2 or RET jumps to definition")) (t - (profiler-entry-format entry))))) + (profiler-format-entry entry))))) (propertize string 'profiler-entry entry))) (defun profiler-report-make-name-part (tree) @@ -332,12 +373,12 @@ (concat " " escaped))) (defun profiler-report-line-format (tree) - (let ((diff-p (profiler-log-diff-p profiler-report-log)) + (let ((diff-p (profiler-profile-diff-p profiler-report-profile)) (name-part (profiler-report-make-name-part tree)) (count (profiler-calltree-count tree)) (count-percent (profiler-calltree-count-percent tree))) - (profiler-format (cl-ecase (profiler-log-type profiler-report-log) - (cpu profiler-report-sample-line-format) + (profiler-format (cl-ecase (profiler-profile-type profiler-report-profile) + (cpu profiler-report-cpu-line-format) (memory profiler-report-memory-line-format)) name-part (if diff-p @@ -378,27 +419,35 @@ (define-key map "B" 'profiler-report-render-reversed-calltree) (define-key map "A" 'profiler-report-ascending-sort) (define-key map "D" 'profiler-report-descending-sort) - (define-key map "=" 'profiler-report-compare-log) - (define-key map (kbd "C-x C-w") 'profiler-report-write-log) + (define-key map "=" 'profiler-report-compare-profile) + (define-key map (kbd "C-x C-w") 'profiler-report-write-profile) (define-key map "q" 'quit-window) map)) -(defun profiler-report-make-buffer-name (log) +(defun profiler-report-make-buffer-name (profile) (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)))) + (cl-ecase (profiler-profile-type profile) (cpu 'CPU) (memory 'Memory)) + (format-time-string "%Y-%m-%d %T" (profiler-profile-timestamp profile)))) -(defun profiler-report-setup-buffer (log) - "Make a buffer for LOG and return it." - (let* ((buf-name (profiler-report-make-buffer-name log)) +(defun profiler-report-setup-buffer-1 (profile) + "Make a buffer for PROFILE and return it." + (let* ((buf-name (profiler-report-make-buffer-name profile)) (buffer (get-buffer-create buf-name))) (with-current-buffer buffer (profiler-report-mode) - (setq profiler-report-log log + (setq profiler-report-profile profile profiler-report-reversed nil profiler-report-order 'descending)) buffer)) +(defun profiler-report-setup-buffer (profile) + "Make a buffer for PROFILE with rendering the profile and +return it." + (let ((buffer (profiler-report-setup-buffer-1 profile))) + (with-current-buffer buffer + (profiler-report-render-calltree)) + buffer)) + (define-derived-mode profiler-report-mode special-mode "Profiler-Report" "Profiler Report Mode." (setq buffer-read-only t @@ -408,12 +457,12 @@ ;;; Report commands -(defun profiler-report-calltree-at-point () - (get-text-property (point) 'calltree)) +(defun profiler-report-calltree-at-point (&optional point) + (get-text-property (or point (point)) 'calltree)) (defun profiler-report-move-to-entry () - (let ((point (next-single-property-change (line-beginning-position) - 'profiler-entry))) + (let ((point (next-single-property-change + (line-beginning-position) 'profiler-entry))) (if point (goto-char point) (back-to-indentation)))) @@ -493,14 +542,15 @@ (describe-function entry))))) (cl-defun profiler-report-render-calltree-1 - (log &key reverse (order 'descending)) - (let ((calltree (profiler-calltree-build profiler-report-log - :reverse reverse))) + (profile &key reverse (order 'descending)) + (let ((calltree (profiler-calltree-build + (profiler-profile-log profile) + :reverse reverse))) (setq header-line-format - (cl-ecase (profiler-log-type log) + (cl-ecase (profiler-profile-type profile) (cpu (profiler-report-header-line-format - profiler-report-sample-line-format + profiler-report-cpu-line-format "Function" (list "Time (ms)" "%"))) (memory (profiler-report-header-line-format @@ -517,7 +567,7 @@ (profiler-report-move-to-entry)))) (defun profiler-report-rerender-calltree () - (profiler-report-render-calltree-1 profiler-report-log + (profiler-report-render-calltree-1 profiler-report-profile :reverse profiler-report-reversed :order profiler-report-order)) @@ -545,28 +595,31 @@ (setq profiler-report-order 'descending) (profiler-report-rerender-calltree)) -(defun profiler-report-log (log) - (let ((buffer (profiler-report-setup-buffer log))) - (with-current-buffer buffer - (profiler-report-render-calltree)) - (pop-to-buffer buffer))) - -(defun profiler-report-compare-log (buffer) - "Compare the current profiler log with another." +(defun profiler-report-profile (profile) + (switch-to-buffer (profiler-report-setup-buffer profile))) + +(defun profiler-report-profile-other-window (profile) + (switch-to-buffer-other-window (profiler-report-setup-buffer profile))) + +(defun profiler-report-profile-other-frame (profile) + (switch-to-buffer-other-frame (profiler-report-setup-buffer profile))) + +(defun profiler-report-compare-profile (buffer) + "Compare the current profile with another." (interactive (list (read-buffer "Compare to: "))) - (let* ((log1 (with-current-buffer buffer profiler-report-log)) - (log2 profiler-report-log) - (diff-log (profiler-log-diff log1 log2))) - (profiler-report-log diff-log))) + (let* ((profile1 (with-current-buffer buffer profiler-report-profile)) + (profile2 profiler-report-profile) + (diff-profile (profiler-compare-profiles profile1 profile2))) + (profiler-report-profile diff-profile))) -(defun profiler-report-write-log (filename &optional confirm) - "Write the current profiler log into FILENAME." +(defun profiler-report-write-profile (filename &optional confirm) + "Write the current profile into file FILENAME." (interactive - (list (read-file-name "Write log: " default-directory) + (list (read-file-name "Write profile: " default-directory) (not current-prefix-arg))) - (profiler-log-write-file profiler-report-log - filename - confirm)) + (profiler-write-profile profiler-report-profile + filename + confirm)) ;;; Profiler commands @@ -584,13 +637,13 @@ nil t nil nil "cpu"))))) (cl-ecase mode (cpu - (profiler-cpu-start profiler-sample-interval) + (profiler-cpu-start profiler-sampling-interval) (message "CPU profiler started")) (mem (profiler-memory-start) (message "Memory profiler started")) (cpu+mem - (profiler-cpu-start profiler-sample-interval) + (profiler-cpu-start profiler-sampling-interval) (profiler-memory-start) (message "CPU and memory profiler started")))) @@ -606,48 +659,58 @@ (t "No"))))) (defun profiler-reset () - "Reset profiler log." + "Reset profiler logs." (interactive) (when (fboundp 'profiler-cpu-log) (ignore (profiler-cpu-log))) (ignore (profiler-memory-log)) t) -(defun profiler--report-cpu () - (let ((log (if (fboundp 'profiler-cpu-log) (profiler-cpu-log)))) - (when log - (puthash 'type 'cpu log) - (puthash 'timestamp (current-time) log) - (profiler-report-log log)))) +(defun profiler-report-cpu () + (let ((profile (profiler-cpu-profile))) + (when profile + (profiler-report-profile-other-window profile)))) -(defun profiler--report-memory () - (let ((log (profiler-memory-log))) - (when log - (puthash 'type 'memory log) - (puthash 'timestamp (current-time) log) - (profiler-report-log log)))) +(defun profiler-report-memory () + (let ((profile (profiler-memory-profile))) + (when profile + (profiler-report-profile-other-window profile)))) (defun profiler-report () "Report profiling results." (interactive) - (profiler--report-cpu) - (profiler--report-memory)) - -;;;###autoload -(defun profiler-find-log (filename) - "Read a profiler log from FILENAME and report it." - (interactive - (list (read-file-name "Find log: " default-directory))) - (profiler-report-log (profiler-log-read-file filename))) + (profiler-report-cpu) + (profiler-report-memory)) + +;;;###autoload +(defun profiler-find-profile (filename) + "Open profile FILENAME." + (interactive + (list (read-file-name "Find profile: " default-directory))) + (profiler-report-profile (profiler-read-profile filename))) + +;;;###autoload +(defun profiler-find-profile-other-window (filename) + "Open profile FILENAME." + (interactive + (list (read-file-name "Find profile: " default-directory))) + (profiler-report-profile-other-window (profiler-read-profile filename))) + +;;;###autoload +(defun profiler-find-profile-other-frame (filename) + "Open profile FILENAME." + (interactive + (list (read-file-name "Find profile: " default-directory))) + (profiler-report-profile-other-frame(profiler-read-profile filename))) ;;; Profiling helpers -;; (cl-defmacro with-sample-profiling ((&key interval) &rest body) +;; (cl-defmacro with-cpu-profiling ((&key sampling-interval) &rest body) ;; `(unwind-protect ;; (progn ;; (ignore (profiler-cpu-log)) -;; (profiler-cpu-start ,interval) +;; (profiler-cpu-start ,sampling-interval) ;; ,@body) ;; (profiler-cpu-stop) ;; (profiler--report-cpu))) === modified file 'src/profiler.c' --- src/profiler.c 2012-09-30 15:49:05 +0000 +++ src/profiler.c 2012-09-30 16:17:12 +0000 @@ -198,7 +198,7 @@ } } -/* Sample profiler. */ +/* Sampling profiler. */ #ifdef PROFILER_CPU_SUPPORT @@ -220,10 +220,10 @@ /* Separate counter for the time spent in the GC. */ static EMACS_INT cpu_gc_count; -/* The current sample interval in milliseconds. */ -static EMACS_INT current_sample_interval; +/* The current sampling interval in milliseconds. */ +static EMACS_INT current_sampling_interval; -/* Signal handler for sample profiler. */ +/* Signal handler for sampling profiler. */ static void handle_profiler_signal (int signal) @@ -235,11 +235,11 @@ not expect the ARRAY_MARK_FLAG to be set. We could try and harden the hash-table code, but it doesn't seem worth the effort. */ - cpu_gc_count = saturated_add (cpu_gc_count, current_sample_interval); + cpu_gc_count = saturated_add (cpu_gc_count, current_sampling_interval); else { eassert (HASH_TABLE_P (cpu_log)); - record_backtrace (XHASH_TABLE (cpu_log), current_sample_interval); + record_backtrace (XHASH_TABLE (cpu_log), current_sampling_interval); } } @@ -250,21 +250,21 @@ } static enum profiler_cpu_running -setup_cpu_timer (Lisp_Object sample_interval) +setup_cpu_timer (Lisp_Object sampling_interval) { struct sigaction action; struct itimerval timer; struct timespec interval; - if (! RANGED_INTEGERP (1, sample_interval, + if (! RANGED_INTEGERP (1, sampling_interval, (TYPE_MAXIMUM (time_t) < EMACS_INT_MAX / 1000 ? (EMACS_INT) TYPE_MAXIMUM (time_t) * 1000 + 999 : EMACS_INT_MAX))) return NOT_RUNNING; - current_sample_interval = XINT (sample_interval); - interval = make_emacs_time (current_sample_interval / 1000, - current_sample_interval % 1000 * 1000000); + current_sampling_interval = XINT (sampling_interval); + interval = make_emacs_time (current_sampling_interval / 1000, + current_sampling_interval % 1000 * 1000000); emacs_sigaction_init (&action, deliver_profiler_signal); sigaction (SIGPROF, &action, 0); @@ -315,12 +315,12 @@ DEFUN ("profiler-cpu-start", Fprofiler_cpu_start, Sprofiler_cpu_start, 1, 1, 0, doc: /* Start or restart the cpu profiler. -It takes call-stack samples each SAMPLE-INTERVAL milliseconds. +It takes call-stack samples each SAMPLING-INTERVAL milliseconds. See also `profiler-log-size' and `profiler-max-stack-depth'. */) - (Lisp_Object sample_interval) + (Lisp_Object sampling_interval) { if (profiler_cpu_running) - error ("Sample profiler is already running"); + error ("CPU profiler is already running"); if (NILP (cpu_log)) { @@ -329,9 +329,9 @@ profiler_max_stack_depth); } - profiler_cpu_running = setup_cpu_timer (sample_interval); + profiler_cpu_running = setup_cpu_timer (sampling_interval); if (! profiler_cpu_running) - error ("Invalid sample interval"); + error ("Invalid sampling interval"); return Qt; }