From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Christian Ohler Newsgroups: gmane.emacs.devel Subject: Patch: Add call graph to elp.el Date: Sat, 09 Feb 2008 09:27:20 +0100 Message-ID: <47AD63E8.8080308@fastmail.net> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------080502010200090902000301" X-Trace: ger.gmane.org 1202545682 22873 80.91.229.12 (9 Feb 2008 08:28:02 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sat, 9 Feb 2008 08:28:02 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sat Feb 09 09:28:19 2008 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1JNl4L-0007OL-T1 for ged-emacs-devel@m.gmane.org; Sat, 09 Feb 2008 09:28:18 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1JNl3r-00077O-2y for ged-emacs-devel@m.gmane.org; Sat, 09 Feb 2008 03:27:47 -0500 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1JNl3c-000767-7Q for emacs-devel@gnu.org; Sat, 09 Feb 2008 03:27:32 -0500 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1JNl3X-00073z-QV for emacs-devel@gnu.org; Sat, 09 Feb 2008 03:27:31 -0500 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1JNl3X-00073m-8i for emacs-devel@gnu.org; Sat, 09 Feb 2008 03:27:27 -0500 Original-Received: from mx20.gnu.org ([199.232.41.8]) by monty-python.gnu.org with esmtps (TLS-1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.60) (envelope-from ) id 1JNl3W-0008Bz-LS for emacs-devel@gnu.org; Sat, 09 Feb 2008 03:27:26 -0500 Original-Received: from out4.smtp.messagingengine.com ([66.111.4.28]) by mx20.gnu.org with esmtp (Exim 4.60) (envelope-from ) id 1JNl3U-0004EC-F0 for emacs-devel@gnu.org; Sat, 09 Feb 2008 03:27:24 -0500 Original-Received: from compute2.internal (compute2.internal [10.202.2.42]) by out1.messagingengine.com (Postfix) with ESMTP id DF6418FB60; Sat, 9 Feb 2008 03:27:22 -0500 (EST) Original-Received: from heartbeat2.messagingengine.com ([10.202.2.161]) by compute2.internal (MEProxy); Sat, 09 Feb 2008 03:27:22 -0500 X-Sasl-enc: ItENgALGXXyxzOnG3ZxzyU7KjA5yGLRimHhjveLL+OKW 1202545641 Original-Received: from kraut.local (e176234054.adsl.alicedsl.de [85.176.234.54]) by mail.messagingengine.com (Postfix) with ESMTP id B144E290F9; Sat, 9 Feb 2008 03:27:21 -0500 (EST) X-detected-kernel: by mx20.gnu.org: Genre and OS details not recognized. X-detected-kernel: by monty-python.gnu.org: Linux 2.6, seldom 2.4 (older, 4) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:88575 Archived-At: This is a multi-part message in MIME format. --------------080502010200090902000301 Content-Type: text/plain; charset=ISO-8859-1; format=flowed Content-Transfer-Encoding: 7bit The attached patch makes elp.el record and display call graph information. This makes the profiler much more useful. Christian. --------------080502010200090902000301 Content-Type: text/plain; x-mac-type="0"; x-mac-creator="0"; name="elp.patch" Content-Transfer-Encoding: quoted-printable Content-Disposition: inline; filename="elp.patch" --- elp.el 28 Jan 2008 22:48:53 +0100 1.43 +++ elp.el 08 Feb 2008 21:58:18 +0100=09 @@ -126,6 +126,8 @@ =20 ;;; Code: =20 +(require 'cl) + =0C ;; start of user configuration variables ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv @@ -205,14 +207,29 @@ (defvar elp-master nil "Master function symbol.") =20 +(defun elp-compute-not-profilable () + (loop for prev =3D nil then funsyms + for funsyms =3D '(elp-wrapper called-interactively-p) + then (remove-duplicates + (append funsyms + (loop for funsym in funsyms + for fn =3D (symbol-function funsym) + unless (subrp fn) + append (remove-if-not + (lambda (x) + (and (symbolp x) (fboundp x))) + (coerce (aref fn 2) 'list)))) + :from-end t) + until (equal prev funsyms) + finally (return funsyms))) + (defvar elp-not-profilable - ;; First, the functions used inside each instrumented function: - '(elp-wrapper called-interactively-p - ;; Then the functions used by the above functions. I used - ;; (delq nil (mapcar (lambda (x) (and (symbolp x) (fboundp x) x)) - ;; (aref (symbol-function 'elp-wrapper) 2))) - ;; to help me find this list. - error call-interactively apply current-time) + '( + ;; To recompute this list, hit C-x C-e at the end of + ;; this line: (print (elp-compute-not-profilable) (current-buffer)) + (elp-wrapper called-interactively-p error call-interactively apply + current-time assoc vector signal format) + ) "List of functions that cannot be profiled. Those functions are used internally by the profiling code and profiling them would thus lead to infinite recursion.") @@ -245,7 +262,7 @@ ;; definition. (elp-restore-function funsym) (let* ((funguts (symbol-function funsym)) - (infovec (vector 0 0 funguts)) + (infovec (vector 0 0 funguts (list) (list))) (newguts '(lambda (&rest args)))) ;; we cannot profile macros (and (eq (car-safe funguts) 'macro) @@ -386,6 +403,8 @@ (aset info 0 0) ;reset call counter (aset info 1 0.0) ;reset total time ;; don't muck with aref 2 as that is the old symbol definition + (aset info 3 (list)) ;reset children + (aset info 4 (list)) ;reset parents )) =20 (defun elp-reset-list (&optional list) @@ -424,49 +443,80 @@ (- (car (cdr end)) (car (cdr start))) (/ (- (car (cdr (cdr end))) (car (cdr (cdr start)))) 1000000.0))) =20 -(defun elp-wrapper (funsym interactive-p args) - "This function has been instrumented for profiling by the ELP. +(defvar elp-parent-info nil) +(defvar elp-parent-name nil) + +(defstruct (elp-entry (:constructor elp-make-entry)) + (total-time 0) + (call-count 0)) + +(defun elp-wrapper (elp--funsym elp--interactive-p elp--args) + "This function has been instrumented for profiling by ELP. ELP is the Emacs Lisp Profiler. To restore the function to its original definition, use \\[elp-restore-function] or \\[elp-restore-all]= =2E" - ;; turn on recording if this is the master function - (if (and elp-master - (eq funsym elp-master)) - (setq elp-record-p t)) - ;; get info vector and original function symbol - (let* ((info (get funsym elp-timer-info-property)) - (func (aref info 2)) - result) - (or func - (error "%s is not instrumented for profiling" funsym)) - (if (not elp-record-p) - ;; when not recording, just call the original function symbol - ;; and return the results. - (setq result - (if interactive-p - (call-interactively func) - (apply func args))) - ;; we are recording times - (let (enter-time exit-time) - ;; increment the call-counter - (aset info 0 (1+ (aref info 0))) - ;; now call the old symbol function, checking to see if it - ;; should be called interactively. make sure we return the - ;; correct value - (if interactive-p - (setq enter-time (current-time) - result (call-interactively func) - exit-time (current-time)) - (setq enter-time (current-time) - result (apply func args) - exit-time (current-time))) - ;; calculate total time in function - (aset info 1 (+ (aref info 1) (elp-elapsed-time enter-time exit-time)))= - )) - ;; turn off recording if this is the master function + (lexical-let ((funsym elp--funsym) + (interactive-p elp--interactive-p) + (args elp--args)) + ;; turn on recording if this is the master function (if (and elp-master - (eq funsym elp-master)) - (setq elp-record-p nil)) - result)) + (eq funsym elp-master)) + (setq elp-record-p t)) + ;; get info vector and original function symbol + (lexical-let* ((info (get funsym elp-timer-info-property)) + (func (aref info 2)) + result) + (or func + (error "%s is not instrumented for profiling" funsym)) + (if (not elp-record-p) + ;; when not recording, just call the original function symbol + ;; and return the results. + (setq result + (let ((elp-parent-info info) + (elp-parent-name funsym)) + (if interactive-p + (call-interactively func) + (apply func args)))) + ;; we are recording times + (let (enter-time exit-time) + ;; increment the call-counter + (aset info 0 (1+ (aref info 0))) + ;; now call the old symbol function, checking to see if it + ;; should be called interactively. make sure we return the + ;; correct value + (let ((elp-parent-info info) + (elp-parent-name funsym)) + (if interactive-p + (setq enter-time (current-time) + result (call-interactively func) + exit-time (current-time)) + (setq enter-time (current-time) + result (apply func args) + exit-time (current-time)))) + (let ((elapsed-time (elp-elapsed-time enter-time exit-time))) + (aset info 1 (+ (aref info 1) elapsed-time)) + (unless (null elp-parent-info) + (let ((entry-in-parent (cdr + (assoc funsym (aref elp-parent-inf= o 3))))) + (unless entry-in-parent + (push (cons funsym + (setq entry-in-parent (elp-make-entry))) + (aref elp-parent-info 3))) + (incf (elp-entry-total-time entry-in-parent) elapsed-tim= e) + (incf (elp-entry-call-count entry-in-parent))) + (let ((parent-name elp-parent-name)) + (let ((entry-in-self (cdr (assoc parent-name (aref info = 4))))) + (unless entry-in-self + (push (cons parent-name + (setq entry-in-self (elp-make-entry))) + (aref info 4))) + (incf (elp-entry-total-time entry-in-self) elapsed-tim= e) + (incf (elp-entry-call-count entry-in-self)))))) + )) + ;; turn off recording if this is the master function + (if (and elp-master + (eq funsym elp-master)) + (setq elp-record-p nil)) + result))) =20 =0C ;; shut the byte-compiler up @@ -502,35 +552,79 @@ (match-string 2 number)) (substring number 0 width)))) =20 +(defun elp-output-result-entries (prefix entries) + (loop for vec in=20 + (if (null elp-sort-by-function) + entries + (sort (copy-list entries) elp-sort-by-function)) + for (fn-or-self-marker cc tt at tp ap) =3D (coerce vec 'list) + do + (insert prefix) + (let ((inserted-length + (elp-output-insert-symbol fn-or-self-marker))) + (insert-char 32 (+ elp-field-len + (- (+ inserted-length 1)) + 2))) + (let ((ccstr (number-to-string cc)) + (ttstr (number-to-string tt)) + (tpstr (number-to-string tp)) + (atstr (number-to-string at)) + (apstr (number-to-string ap))) + (insert ccstr) + (insert-char 32 (+ elp-cc-len (- (length ccstr)) 2)) + (let ((ttstr (elp-pack-number ttstr elp-et-len)) + (atstr (elp-pack-number atstr elp-at-len))) + (insert ttstr) + (insert-char 32 (+ elp-et-len (- (length ttstr)) 2)) + (insert atstr))) + (insert "\n"))) + +(defun elp-safe-/ (a b) + (if (zerop b) 0.0 (/ a b))) + (defun elp-output-result (resultvec) ;; output the RESULTVEC into the results buffer. RESULTVEC is a 4 or ;; more element vector where aref 0 is the call count, aref 1 is the ;; total time spent in the function, aref 2 is the average time ;; spent in the function, and aref 3 is the symbol's string - ;; name. All other elements in the vector are ignored. - (let* ((cc (aref resultvec 0)) - (tt (aref resultvec 1)) - (at (aref resultvec 2)) - (symname (aref resultvec 3)) - callcnt totaltime avetime) - (setq callcnt (number-to-string cc) - totaltime (number-to-string tt) - avetime (number-to-string at)) + ;; name. All other elements in the vector are ignored. aref 4 is + ;; list of children. aref 5 is list of parents. + (let* ((symname (aref resultvec 0)) + (cc (aref resultvec 1)) + (tt (aref resultvec 2)) + (at (aref resultvec 3)) + (children (aref resultvec 4)) + (parents (aref resultvec 5))) ;; possibly prune the results (if (and elp-report-limit (numberp elp-report-limit) (< cc elp-report-limit)) nil - (elp-output-insert-symname symname) - (insert-char 32 (+ elp-field-len (- (length symname)) 2)) - ;; print stuff out, formatting it nicely - (insert callcnt) - (insert-char 32 (+ elp-cc-len (- (length callcnt)) 2)) - (let ((ttstr (elp-pack-number totaltime elp-et-len)) - (atstr (elp-pack-number avetime elp-at-len))) - (insert ttstr) - (insert-char 32 (+ elp-et-len (- (length ttstr)) 2)) - (insert atstr)) + (elp-output-result-entries + " " + (loop for (parent . entry) in parents + collect (let* ((cc (elp-entry-call-count entry)) + (tt (elp-entry-total-time entry)) + (at (elp-safe-/ tt cc))) + (vector parent cc tt at 0 0)))) + (elp-output-result-entries + "" + (list (vector symname cc tt at 0 0))) + (elp-output-result-entries + " " + (append + (loop for (child . entry) in children + collect (let* ((cc (elp-entry-call-count entry)) + (tt (elp-entry-total-time entry)) + (at (elp-safe-/ tt cc))) + (vector child cc tt at 0 0))) + (list (let* ((cc cc) + (tt (- tt + (reduce #'+ (mapcar #'cdr children) + :key #'elp-entry-total-time))) + (at (elp-safe-/ tt cc)) + (self-marker '(self))) + (vector self-marker cc tt at 0 0))))) (insert "\n")))) =20 (defvar elp-results-symname-map @@ -546,13 +640,18 @@ (if event (posn-set-point (event-end event))) (find-function (get-text-property (point) 'elp-symname))) =20 -(defun elp-output-insert-symname (symname) - ;; Insert SYMNAME with text properties. - (insert (propertize symname - 'elp-symname (intern symname) - 'keymap elp-results-symname-map - 'mouse-face 'highlight - 'help-echo "mouse-2 or RET jumps to definition"))) +(defun elp-output-insert-symbol (symbol-or-self-marker) + (cond ((equal symbol-or-self-marker '(self)) + (let ((text "")) + (insert text) + (length text))) + (t + (insert (propertize (symbol-name symbol-or-self-marker) + 'elp-symname symbol-or-self-marker + 'keymap elp-results-symname-map + 'mouse-face 'highlight + 'help-echo "mouse-2 or RET jumps to definit= ion")) + (length (symbol-name symbol-or-self-marker))))) =20 ;;;###autoload (defun elp-results () @@ -585,15 +684,17 @@ (let* ((info (get funsym elp-timer-info-property)) (symname (format "%s" funsym)) (cc (aref info 0)) - (tt (aref info 1))) + (tt (aref info 1)) + (at (elp-safe-/ tt cc)) + (children (aref info 3)) + (parents (aref info 4))) (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))))) + (vector funsym + cc tt at + children parents))))) elp-all-instrumented-list)) ) ; end let* ;; If printing to stdout, insert the header so it will print. --------------080502010200090902000301--