1. xemacs
  2. xemacs-devel

Source

xemacs-devel / profile.el

Diff from to

File profile.el

  • Ignore whitespace
 ;;; profile.el --- basic profiling commands for XEmacs
 
-;; Copyright (C) 1996, 2002 Ben Wing.
+;; Copyright (C) 1996, 2002, 2003 Ben Wing.
 ;; Copyright (C) 1997 Free Software Foundation.
 
+;; Author: Ben Wing <ben@xemacs.org>
 ;; Maintainer: XEmacs Development Team
 ;; Keywords: internal
 
 ;;; Code:
 
 ;;;###autoload
-(defun profile-results (&optional info stream sort-by-call-count)
+(defun profile-results (&optional info stream sort-by)
   "Print profiling info INFO to STREAM in a pretty format.
 If INFO is omitted, the current profiling info is retrieved using
  `get-profiling-info'.
  using `with-output-to-temp-buffer'; otherwise, they will simply be
  printed into STREAM.  Use `standard-output' explicitly if you
  want standard output.
-If SORT-BY-CALL-COUNT is non-nil (interactively, the prefix arg),
- display items sorted by call count rather than timing."
-  (interactive (list nil nil current-prefix-arg))
-  (if sort-by-call-count (beep))
+If SORT-BY is `call-count' (interactively, the prefix arg), display items
+ sorted by call count rather than timing.  If `gc-usage' (interactively,
+ use C-u C-u), sort by GC usage."
+  (interactive (list nil nil (cond ((equal current-prefix-arg '(16))
+				    'gc-usage)
+				   (current-prefix-arg 'call-count))))
   (or info (setq info (get-profiling-info)))
   (if (not stream)
       (if (fboundp 'with-displaying-temp-buffer)
 	  (with-displaying-temp-buffer "*Profiling Results*"
-	      (profile-results info standard-output sort-by-call-count))
+	      (profile-results info standard-output sort-by))
 	(pop-to-buffer (get-buffer-create "*Profiling Results*"))
 	(erase-buffer)
 	(profile-results info (current-buffer))
 		     (loop for x being the hash-key in (getf info 'timing)
 		       using (hash-value y)
 		       collect (cons x y))))
+	   (total-timing (if (boundp 'call-count-profile-table)
+			       (make-hash-table)
+			     (getf info 'total-timing)))
 	   (call-count (if (boundp 'call-count-profile-table)
 			   call-count-profile-table
 			 (getf info 'call-count)))
+	   (gc-usage (if (boundp 'call-count-profile-table)
+			 (make-hash-table)
+		       (getf info 'gc-usage)))
+	   (total-gc-usage (if (boundp 'call-count-profile-table)
+			       (make-hash-table)
+			     (getf info 'total-gc-usage)))
+	   (spaces-for-data 41)
+	   (spaces-for-fun (- 79 spaces-for-data))
 	   maxfunlen)
-      ;; Add entries for any functions with call counts but no ticks
-      (loop for x being the hash-key in call-count using (hash-value y) do
-	(if (not (assoc x timing))
-	    (push (cons x 0) timing)))
+      (loop for table in (list total-timing call-count gc-usage total-gc-usage)
+	do
+	;; Add entries for any functions in other tables but no ticks
+	(loop for x being the hash-key in table using (hash-value y) do
+	  (if (not (assoc x timing))
+	      (push (cons x 0) timing))))
       ;; Calculate the longest function
       (setq maxfunlen
 	    (apply #'max
 		   (length "Function Name")
 		   (mapcar
 		    (lambda (el)
-		      ;; Functions longer than 50 characters (usually
-		      ;; anonymous functions) don't qualify
 		      (let ((l (length (format "%s" (car el)))))
-			(if (< l 50)
+			(if (<= l spaces-for-fun)
 			    l 0)))
 		    timing)))
-      (princ (format "%-*s    Ticks    %%/Total   Call Count\n"
+      (princ (format "%-*sTicks/Total %%Usage Calls GC-Usage/  Total\n"
 		     maxfunlen "Function Name"))
       (princ (make-string maxfunlen ?=))
-      (princ "    =====    =======   ==========\n")
-      (let ((sum (float (apply #'+ (mapcar #'cdr timing)))))
+      (princ "=====/===== ====== ===== ========/=======\n")
+      (let ((timing-sum (float (apply #'+ (mapcar #'cdr timing))))
+	    (calls-sum 0)
+	    (gc-sum 0))
 	(dolist (entry
 		 (nreverse
 		  (sort timing
-			(if sort-by-call-count
-			    #'(lambda (a b)
-				(< (or (gethash (car a) call-count) 0)
-				   (or (gethash (car b) call-count) 0)))
-			  #'cdr-less-than-cdr))))
-	  (princ (format "%-*s %8d    %7.3f    %s\n"
-			 maxfunlen (car entry) (cdr entry)
-			 (* 100 (/ (cdr entry) sum))
+			(cond ((eq sort-by 'call-count)
+			       #'(lambda (a b)
+				   (< (or (gethash (car a) call-count) 0)
+				      (or (gethash (car b) call-count) 0))))
+			      ((eq sort-by 'gc-usage)
+			       #'(lambda (a b)
+				   (< (or (gethash (car a) gc-usage) 0)
+				      (or (gethash (car b) gc-usage) 0))))
+			      (t #'cdr-less-than-cdr)))))
+	  (princ (format "%-*s%5d/%5d %6.3f %s %s\n"
+			 maxfunlen
+			 ;; if function too long (often lambdas or compiled
+			 ;; funs), put in a newline to keep the alignment
+			 (let ((str (format "%s" (car entry))))
+			   (if (<= (length str) maxfunlen) str
+			     (concat str "\n" (make-string maxfunlen ? ))))
+			 (cdr entry)
+			 (or (gethash (car entry) total-timing) 0)
+			 (* 100 (/ (cdr entry) timing-sum))
 			 (let ((count (gethash (car entry) call-count)))
-			   (if count (format "%9d" count) "")))))
-	(princ (make-string maxfunlen ?-))
-	(princ "---------------------------------\n")
-	(princ (format "%-*s    %5d    %7.3f\n" maxfunlen "Total" sum 100.0))
-	(princ (format "\n\nOne tick = %g ms\n"
+			   (if count (format "%5d" count) "     "))
+			 (let ((gcval (or (gethash (car entry) gc-usage) 0))
+			       (total-gcval
+				(or (gethash (car entry) total-gc-usage) 0)))
+			   (if (or (/= gcval 0) (/= total-gcval 0))
+			       (format "%8d/%7d" gcval total-gcval)
+			     "                "))
+			 ))
+	  (incf calls-sum (or (gethash (car entry) call-count 0)))
+	  (incf gc-sum (or (gethash (car entry) gc-usage 0)))
+	  )
+	(princ (make-string (+ maxfunlen spaces-for-data) ?-))
+	(princ (format "\n%-*s%7d      %7.3f %5d %8d\n"
+		       (- maxfunlen 2) "Total" timing-sum 100.0 calls-sum
+		       gc-sum))
+	(princ (format "\n
+Ticks/Total     = Ticks this function/this function and descendants
+Calls           = Number of calls to this function
+GC-Usage/Total  = Lisp allocation this function/this function and descendants
+One tick        = %g ms\n"
 		       (/ default-profiling-interval 1000.0)))
 	(and (boundp 'internal-error-checking)
 	     (delq 'quick-build internal-error-checking)
 	(loop for x being the hash-key in hash using (hash-value y)
 	  collect (cons x y)))
     (let ((ninfo (list 'timing (make-hash-table :test 'equal)
-		       'call-count (make-hash-table :test 'equal))))
+		       'total-timing (make-hash-table :test 'equal)
+		       'call-count (make-hash-table :test 'equal)
+		       'gc-usage (make-hash-table :test 'equal)
+		       'total-gc-usage (make-hash-table :test 'equal)
+		       )))
       (loop
 	for i in info do
 	(loop for (key hash) on i by #'cddr