source: trunk/j/src/org/armedbear/lisp/profiler.lisp @ 4707

Last change on this file since 4707 was 4707, checked in by piso, 18 years ago

Time profiling.

File size: 2.1 KB
Line 
1;;; profiler.lisp
2;;;
3;;; Copyright (C) 2003 Peter Graves
4;;; $Id: profiler.lisp,v 1.7 2003-11-12 21:26:59 piso Exp $
5;;;
6;;; This program is free software; you can redistribute it and/or
7;;; modify it under the terms of the GNU General Public License
8;;; as published by the Free Software Foundation; either version 2
9;;; of the License, or (at your option) any later version.
10;;;
11;;; This program is distributed in the hope that it will be useful,
12;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with this program; if not, write to the Free Software
18;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
19
20(in-package "PROFILER")
21
22;; SHOW-CALL-COUNTS and PROFILE are exported in Lisp.java.
23
24;; Returns list of all symbols with non-zero call counts.
25(defun list-calls ()
26  (let ((result nil))
27    (dolist (pkg (list-all-packages))
28      (dolist (sym (sys::package-symbols pkg))
29        (when (fboundp sym)
30          (let* ((f (fdefinition sym))
31                 (n (sys::%call-count f)))
32            (unless (zerop n)
33              (setq result (cons sym result)))))))
34    result))
35
36(defun show-call-count-for-symbol (sym max-count)
37  (let ((count (sys::%call-count (fdefinition sym))))
38    (if max-count
39        (format t "~A ~A (~A%)~%" sym count
40                (/ (round (/ (* count 10000.0) max-count)) 100.0))
41        (format t "~A ~A~%" sym count))))
42
43(defun show-call-counts ()
44  (let ((syms (list-calls)))
45    (setf syms (sort syms #'<
46                     :key #'(lambda (x) (sys::%call-count (fdefinition x)))))
47    (let* ((last-sym (car (last syms)))
48           (max-count (if last-sym
49                          (sys::%call-count (fdefinition last-sym))
50                          nil)))
51      (when (zerop max-count)
52        (setf max-count nil))
53      (dolist (sym syms)
54        (show-call-count-for-symbol sym max-count))))
55  (values))
56
57(defmacro profile (&rest forms)
58  `(progn (start-profiler) ,@forms (stop-profiler)))
Note: See TracBrowser for help on using the repository browser.