Mercurial > emacs
view lisp/cedet/semantic/elp.el @ 104488:7042156f9f43
lisp/cedet/semantic/scope.el (semantic-analyze-show): Fix require.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Fri, 11 Sep 2009 01:17:46 +0000 |
parents | 872396c919ad |
children |
line wrap: on
line source
;;; semantic/elp.el --- Bind ELP to measure Semantic ;;; Copyright (C) 2008, 2009 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <eric@siege-engine.com> ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: ;; ;; Provide fast ways to profile various (often slow) Semantic processes. (require 'elp) (require 'data-debug) (require 'semantic/adebug) (require 'semantic/tag-ls) (require 'semantic/tag-file) (require 'semantic/db) (require 'semantic/db-find) (require 'semantic/db-typecache) (require 'semantic/scope) (require 'semantic/analyze/fcn) (require 'semantic/analyze) (require 'semantic/analyze/complete) (declare-function semantic-idle-scheduler-work-parse-neighboring-files "semantic/idle") ;;; Code: (defvar semantic-elp-emacs-core-list '( append copy-sequence expand-file-name file-exists-p file-name-directory file-name-nondirectory file-attributes file-truename find-buffer-visiting length locate-file nconc nreverse sort string< string= ) "List of Emacs functions for profiling.") (defvar semantic-elp-eieio-core-list '( eieio-generic-call eieio-generic-call-primary-only eieiomt-method-list eieio-generic-form eieio-oref eieio-oset obj-of-class-p ) "List of EIEIO functions for profiling.") (defvar semantic-elp-ede-core-list '( ede-current-project ede-directory-get-open-project ede-expand-filename ede-expand-filename-impl ede-locate-file-in-project ede-locate-file-in-project-impl ede-system-include-path ede-toplevel ede-toplevel-project ede-directory-project-p ) "List of EDE functions to watch out for.") (defvar semantic-elp-semantic-core-list '( semantic-ctxt-current-argument semantic-ctxt-current-assignment semantic-ctxt-current-class-list semantic-ctxt-current-function semantic-ctxt-current-symbol-and-bounds semantic-current-tag semantic-dependency-tag-file semantic-equivalent-tag-p semantic-fetch-tags semantic-fetch-tags-fast semantic-find-tag-by-overlay semantic-sort-tags-by-name-decreasing semantic-sort-tags-by-name-increasing semantic-sort-tags-by-name-then-type-increasing semantic-sort-tags-by-type-decreasing semantic-sort-tags-by-type-increasing semantic-tag-clone semantic-tag-components semantic-tag-copy semantic-tag-external-member-children semantic-tag-file-name semantic-tag-function-arguments semantic-tag-function-parent semantic-tag-get-attribute semantic-tag-in-buffer-p semantic-tag-include-filename ;;semantic-tag-lessp-name-then-type semantic-tag-name semantic-tag-new-type semantic-tag-of-class-p semantic-tag-of-type-p semantic-tag-of-type-p semantic-tag-p semantic-tag-prototype-p semantic-tag-set-faux semantic-tag-type semantic-tag-type-members semantic-tag-type-superclasses semantic-tag-with-position-p ) "List of core Semantic functions for profiling.") (defvar semantic-elp-semantic-find-core-list '( semantic-find-tags-by-class semantic-find-tags-by-name semantic-find-tags-by-name-regexp semantic-find-tags-by-scope-protection semantic-find-tags-by-type semantic-find-tags-for-completion semantic-find-tags-included semantic-find-tags-of-compound-type ) "List of semantic-find routines for profiling.") (defvar semantic-elp-semanticdb-core-list '( semanticdb-cache-get semanticdb-current-database-list semanticdb-file-table semanticdb-file-table-object semanticdb-full-filename semanticdb-get-buffer semanticdb-get-table-index semanticdb-refresh-references semanticdb-refresh-table semanticdb-needs-refresh-p semanticdb-directory-loaded-p semanticdb-full-filename semanticdb-create-table-for-file ) "List of core Semanticdb functions for profiling.") (defvar semantic-elp-include-path-list '( semanticdb-find-incomplete-cache-entries-p semanticdb-find-load-unloaded semanticdb-find-table-for-include semanticdb-find-throttle-active-p semanticdb-find-translate-path-default semanticdb-find-translate-path-brutish-default semanticdb-find-translate-path-includes--internal semanticdb-find-translate-path-includes-default ) "List of include path calculation functions for profiling.") (defvar semantic-elp-semanticdb-find-list '( semanticdb-fast-strip-find-results semanticdb-find-results-p semanticdb-find-tags-by-class semanticdb-find-tags-by-name semanticdb-find-tags-by-name-regexp semanticdb-find-tags-collector semanticdb-find-tags-external-children-of-type semanticdb-find-tags-for-completion semanticdb-strip-find-results ) "List of semanticdb find functions to profile. You may also need `semantic-elp-include-path-list'.") (defun semantic-elp-core-enable () "Do an ELP reset, and enable profiling of the core system." (elp-reset-all) (elp-instrument-list semantic-elp-emacs-core-list) (elp-instrument-list semantic-elp-eieio-core-list) (elp-instrument-list semantic-elp-ede-core-list) (elp-instrument-list semantic-elp-semantic-core-list) (elp-instrument-list semantic-elp-semanticdb-core-list) (elp-instrument-list semantic-elp-semanticdb-find-list) (elp-instrument-list semantic-elp-include-path-list) ) (defun semantic-elp-include-path-enable () "Enable profiling for `semanticdb-find-translate-path'." (semantic-elp-core-enable) (elp-set-master 'semanticdb-find-translate-path-default) ) (defvar semantic-elp-typecache-list '( semantic-analyze-split-name semanticdb-get-typecache semanticdb-typecache-merge-streams semanticdb-typecache-safe-tag-members semanticdb-typecache-apply-filename semanticdb-typecache-file-tags semanticdb-typecache-include-tags ) "List of typecaching functions for profiling.") (defun semantic-elp-profile-typecache (tab) "Profile the typecache. Start with table TAB." (let ((tc (semanticdb-get-typecache tab))) (semanticdb-typecache-file-tags tab) (semanticdb-typecache-include-tags tab) tc)) (defun semantic-elp-typecache-enable () "Enable profiling for `semanticdb-get-typecache'." (semantic-elp-include-path-enable) (elp-instrument-list semantic-elp-typecache-list) (elp-set-master 'semantic-elp-profile-typecache) ) (defvar semantic-elp-scope-list '( semantic-analyze-find-tag semantic-analyze-scope-nested-tags semantic-analyze-scoped-types semantic-analyze-scoped-types semantic-analyze-tag-prototype-p semantic-analyze-scoped-type-parts semantic-calculate-scope semantic-ctxt-scoped-types semantic-get-all-local-variables semantic-scope-find semanticdb-typecache-find semanticdb-typecache-merge-streams ) "List of scope calculation functions for profiling.") (defun semantic-elp-scope-enable () "Enable profiling for `semanticdb-calculate-scope'." (semantic-elp-core-enable) (elp-instrument-list semantic-elp-typecache-list) (elp-instrument-list semantic-elp-scope-list) (elp-set-master 'semantic-calculate-scope) ) (defvar semantic-elp-analyze-list '( semantic-analyze-current-symbol semantic-analyze-current-context semantic-analyze-dereference-metatype semantic-analyze-find-tag-sequence semantic-analyze-interesting-tag semantic-analyze-pop-to-context semantic-analyze-select-best-tag semantic-analyze-tag-type semantic-analyze-type-to-name semantic-analyze-type-constraint semantic-analyze-scoped-type-parts semantic-cache-data-to-buffer ) "List of analyzer calculation functions for profiling.") (defun semantic-elp-analyze-enable () "Enable profiling for `semanticdb-analyze-current-context'." (semantic-elp-scope-enable) (elp-instrument-list semantic-elp-analyze-list) (elp-set-master 'semantic-analyze-current-context) ) (defvar semantic-elp-symref-list '( semantic-symref-hits-in-region semantic-symref-test-count-hits-in-tag ) "List of symref functions for profiling.") (defun semantic-elp-analyze-symref-hits () "Enable profiling for `semanticdb-analyze-current-context'." (semantic-elp-analyze-enable) (elp-instrument-list semantic-elp-symref-list) (elp-set-master 'semantic-symref-test-count-hits-in-tag) ) (defvar semantic-elp-complete-list '( semantic-analyze-possible-completions semantic-analyze-possible-completions-default semantic-analyze-tags-of-class-list semantic-analyze-type-constants semantic-unique-tag-table-by-name ) "List of smart completion functions for profiling.") (defun semantic-elp-complete-enable () "Enable profiling for `semanticdb-analyze-current-context'." (semantic-elp-analyze-enable) (elp-instrument-list semantic-elp-complete-list) (elp-set-master 'semantic-analyze-possible-completions) ) ;;; Storage Classes ;; ;; (defclass semantic-elp-data () ((raw :initarg :raw :type list :documentation "The raw ELP data.") (sort :initform time :documentation "Which column do we sort our data by during various dumps.") (sorted :initform nil :documentation "The sorted and filtered version of this data.") (total :initarg :total :initform nil :documentation "The total time spent in the operation. Recorded outside of ELP.") ) "Class for managing ELP data.") (defmethod semantic-elp-change-sort ((data semantic-elp-data) &optional newsort) "Change the sort in DATA object to NEWSORT." (cond ((eq newsort 'rotate) (let* ((arot '((time . avg) (avg . calls) (calls . name) (name . time))) (next (cdr (assoc (oref data sort) arot))) ) (oset data sort next))) ((null newsort) nil) (t (oset data sort newsort))) (let ((r (copy-sequence (oref data raw))) (s (oref data sort))) (cond ((eq s 'time) (oset data sorted (sort r (lambda (a b) (> (aref a 1) (aref b 1)) ))) ) ((eq s 'avg) (oset data sorted (sort r (lambda (a b) (> (aref a 2) (aref b 2)) ))) ) ((eq s 'calls) (oset data sorted (sort r (lambda (a b) (> (aref a 0) (aref b 0)) ))) ) ((eq s 'name) (oset data sorted (sort r (lambda (a b) (string< (aref a 3) (aref b 3)) ))) ) (t (message "Don't know how to resort with %s" s) )))) (defun semantic-elp-goto-function (point) "Goto the function from the ELP data. Argument POINT is where to get the data from." (let* ((data (get-text-property point 'ddebug)) ) (find-function (intern-soft (aref data 3))) )) (defmethod semantic-elp-dump-table ((data semantic-elp-data) prefix) "dump out the current DATA table using PREFIX before each line." (let* ((elpd (oref data sorted)) (spaces (make-string (- (length prefix) 2) ? )) ) (data-debug-insert-simple-thing "Calls\t Total Time\t Avg Time/Call\tName" spaces " " 'underline) (dolist (d elpd) (when (> (aref d 0) 0) ;; We had some calls (let ((start (point)) (end nil)) (data-debug-insert-simple-thing (format " % 4d\t% 2.7f\t% 2.7f\t%s" (aref d 0) (aref d 1) (aref d 2) (aref d 3)) spaces " " nil) (setq end (1- (point))) (put-text-property start end 'ddebug d) (put-text-property start end 'ddebug-noexpand t) (put-text-property start end 'ddebug-function 'semantic-elp-goto-function) ) )) ) ) (defmethod data-debug/eieio-insert-slots ((data semantic-elp-data) prefix) "Show the fields of ELP data in an adebug buffer. Ignore the usual, and format a nice table." (data-debug-insert-thing (object-name-string data) prefix "Name: ") (let* ((cl (object-class data)) (cv (class-v cl))) (data-debug-insert-thing (class-constructor cl) prefix "Class: ") ) (data-debug-insert-thing (oref data :total) prefix "Total Time Spent: ") (let ((s (oref data sort)) ) ;; Show how it's sorted: (let ((start (point)) (end nil) ) (insert prefix "Sort Method: " (symbol-name s)) (setq end (point)) ;; (data-debug-insert-thing s prefix "Sort Method: ") (put-text-property start end 'ddebug data) (put-text-property start end 'ddebug-noexpand t) (put-text-property start end 'ddebug-indent(length prefix)) (put-text-property start end 'ddebug-prefix prefix) (put-text-property start end 'ddebug-function 'semantic-elp-change-sort-adebug) (put-text-property start end 'help-echo "Change the Sort by selecting twice.") (insert "\n")) ;; How to sort the raw data (semantic-elp-change-sort data) ) ;; Display (semantic-elp-dump-table data prefix) ) (defun semantic-elp-change-sort-adebug (point) "Change the sort function here. Redisplay. Argument POINT is where the text is." (let* ((data (get-text-property point 'ddebug)) (prefix (get-text-property point 'ddebug-prefix)) ) ;; Get rid of the old table. (data-debug-contract-current-line) ;; Change it (semantic-elp-change-sort data 'rotate) (end-of-line) (forward-word -1) (delete-region (point) (point-at-eol)) (insert (symbol-name (oref data sort))) ;; Redraw it. (save-excursion (end-of-line) (forward-char 1) (semantic-elp-dump-table data prefix)) )) (defclass semantic-elp-object-base (eieio-persistent) ((file-header-line :initform ";; SEMANTIC ELP Profiling Save File") (total :initarg :total :type number :documentation "Amount of time spent during the entire collection.") ) "Base elp object.") (defclass semantic-elp-object (semantic-elp-object-base) ((time :initarg :time :type semantic-elp-data :documentation "Times for calculating something.") (answer :initarg :answer :documentation "Any answer that might be useful.")) "Simple elp object for remembering one analysis run.") (defclass semantic-elp-object-analyze (semantic-elp-object-base) ((pathtime :initarg :pathtime :type semantic-elp-data :documentation "Times for calculating the include path.") (typecachetime :initarg :typecachetime :type semantic-elp-data :documentation "Times for calculating the typecache.") (scopetime :initarg :scopetime :type semantic-elp-data :documentation "Times for calculating the typecache") (ctxttime :initarg :ctxttime :type semantic-elp-data :documentation "Times for calculating the context.") (completiontime :initarg :completiontime :type semantic-elp-data :documentation "Times for calculating the completions.") ) "Results from a profile run.") ;;; ELP hackery. ;; (defvar semantic-elp-last-results nil "Save the last results from an ELP run for more post processing.") (defun semantic-elp-results (name) "Fetch results from the last run, and display. Copied out of elp.el and modified only slightly. Argument NAME is the name to give the ELP data object." (let ((resvec (mapcar (function (lambda (funsym) (let* ((info (get funsym elp-timer-info-property)) (symname (format "%s" funsym)) (cc (aref info 0)) (tt (aref info 1))) (if (not info) (insert "No profiling information found for: " symname) ;;(setq longest (max longest (length symname))) (vector cc tt (if (zerop cc) 0.0 ;avoid arithmetic div-by-zero errors (/ (float tt) (float cc))) symname))))) elp-all-instrumented-list)) ) ; end let (setq semantic-elp-last-results (semantic-elp-data name :raw resvec)) (elp-reset-all)) ) ;;; The big analyze and timer function! ;; ;; (defvar semantic-elp-last-run nil "The results from the last elp run.") (defun semantic-elp-analyze () "Run the analyzer, using ELP to measure performance." (interactive) (let ((elp-recycle-buffers-p nil) (totalstart (current-time)) (totalstop nil) start stop path pathtime typecache typecachetime scope scopetime ctxt ctxttime completion completiontime) ;; Force tag table to be up to date. (semantic-clear-toplevel-cache) (semantic-fetch-tags) ;; Path translation (semantic-elp-include-path-enable) (progn (setq start (current-time)) (setq path (semanticdb-find-translate-path nil nil)) (setq stop (current-time))) (semantic-elp-results "translate-path") (setq pathtime semantic-elp-last-results) (oset pathtime :total (semantic-elapsed-time start stop)) ;; typecache (let* ((tab semanticdb-current-table) (idx (semanticdb-get-table-index tab)) (tc nil) ) (semantic-elp-typecache-enable) (progn (setq start (current-time)) (setq tc (semantic-elp-profile-typecache tab)) (setq stop (current-time))) (setq typecache tc)) (semantic-elp-results "typecache") (setq typecachetime semantic-elp-last-results) (oset typecachetime :total (semantic-elapsed-time start stop)) ;; Scope (semantic-elp-scope-enable) (progn (setq start (current-time)) (setq scope (semantic-calculate-scope)) (setq stop (current-time))) (semantic-elp-results "scope") (setq scopetime semantic-elp-last-results) (oset scopetime :total (semantic-elapsed-time start stop)) ;; Analyze! (semantic-elp-analyze-enable) (progn (setq start (current-time)) (setq ctxt (semantic-analyze-current-context)) ; skip caching (setq stop (current-time))) (semantic-elp-results "analyze") (setq ctxttime semantic-elp-last-results) (oset ctxttime :total (semantic-elapsed-time start stop)) ;; Complete! (semantic-elp-complete-enable) (progn (setq start (current-time)) (setq completion (semantic-analyze-possible-completions ctxt)) (setq stop (current-time))) (semantic-elp-results "complete") (setq completiontime semantic-elp-last-results) (oset completiontime :total (semantic-elapsed-time start stop)) ;; Finish it (setq totalstop (current-time)) ;; build it (let ((elpobj (semantic-elp-object-analyze "ELP" :total (semantic-elapsed-time totalstart totalstop) :pathtime pathtime :typecachetime typecachetime :scopetime scopetime :ctxttime ctxttime :completiontime completiontime ))) (data-debug-show elpobj) (setq semantic-elp-last-run elpobj) (let ((saveas (read-file-name "Save Profile to: " (expand-file-name "~/") "semantic.elp" nil "semantic.elp"))) (oset elpobj :file saveas) (eieio-persistent-save elpobj) ) ))) (defun semantic-elp-idle-work () "Run the idle work scheduler, using ELP to measure performance." (interactive) (require 'semantic/idle) (let ((elp-recycle-buffers-p nil) (totalstart nil) (totalstop nil) ans time ) ;; Path translation (semantic-elp-core-enable) (setq totalstart (current-time)) (semantic-idle-scheduler-work-parse-neighboring-files) (setq totalstop (current-time)) (semantic-elp-results "") (setq time semantic-elp-last-results) (oset time :total (semantic-elapsed-time totalstart totalstop)) ;; build it (let ((elpobj (semantic-elp-object "ELP" :total (semantic-elapsed-time totalstart totalstop) :time time))) (data-debug-show elpobj) (setq semantic-elp-last-run elpobj) (let ((saveas (read-file-name "Save Profile to: " (expand-file-name "~/") "semantic.elp" nil "semantic.elp"))) (oset elpobj :file saveas) (eieio-persistent-save elpobj) ) ))) (defun semantic-elp-searchdb () "Run a semanticdb search routine with the profiler. The expectation is that you will edit this fcn with different `semanticdb-find-' routines." (interactive) (let ((elp-recycle-buffers-p nil) (totalstart nil) (totalstop nil) ans time ) ;; reset (semantic-clear-toplevel-cache) (semantic-fetch-tags) ;; Path translation (semantic-elp-include-path-enable) (setq totalstart (current-time)) (setq ans (semanticdb-find-tags-by-name-regexp "task" nil)) (setq totalstop (current-time)) (semantic-elp-results "") (setq time semantic-elp-last-results) (oset time :total (semantic-elapsed-time totalstart totalstop)) ;; build it (let ((elpobj (semantic-elp-object "ELP" :total (semantic-elapsed-time totalstart totalstop) :time time :answer ans))) (data-debug-show elpobj) (setq semantic-elp-last-run elpobj) (let ((saveas (read-file-name "Save Profile to: " (expand-file-name "~/") "semantic.elp" nil "semantic.elp"))) (oset elpobj :file saveas) (eieio-persistent-save elpobj) ) ))) (defun semantic-elp-symref-hit-count () "Run a `semantic-symref-test-count-hits-in-tag' with elp on." (interactive) (let ((elp-recycle-buffers-p nil) (totalstart nil) (totalstop nil) ans time ) ;; reset (semantic-clear-toplevel-cache) (semantic-fetch-tags) ;; Build up caches so we get user use timings. (semantic-analyze-current-context) ;; Enable everything for analysis. (semantic-elp-analyze-symref-hits) ;; Do the analysis (setq totalstart (current-time)) (setq ans (semantic-symref-test-count-hits-in-tag)) (setq totalstop (current-time)) (semantic-elp-results "") (setq time semantic-elp-last-results) (oset time :total (semantic-elapsed-time totalstart totalstop)) ;; build it (let ((elpobj (semantic-elp-object "ELP" :total (semantic-elapsed-time totalstart totalstop) :time time :answer ans))) (data-debug-show elpobj) (setq semantic-elp-last-run elpobj) ;;(let ((saveas (read-file-name "Save Profile to: " (expand-file-name "~/") ;; "semantic.elp" nil "semantic.elp"))) ;; (oset elpobj :file saveas) ;; (eieio-persistent-save elpobj) ;; ) ))) (defun semantic-elp-show-last-run () "Show the last elp run." (interactive) (when (not semantic-elp-last-run) (error "No last run to show")) (data-debug-show semantic-elp-last-run)) (defun semantic-elp-load-old-run (file) "Load an old run from FILE, and show it." (interactive "fLast Run File: ") (setq semantic-elp-last-run (eieio-persistent-read file)) (data-debug-show semantic-elp-last-run)) (provide 'semantic/elp) ;;; semantic/elp.el ends here