Ignore:
Timestamp:
11/14/03 17:55:35 (18 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/profiler.lisp

    r4707 r4752  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: profiler.lisp,v 1.7 2003-11-12 21:26:59 piso Exp $
     4;;; $Id: profiler.lisp,v 1.8 2003-11-14 17:55:35 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    2020(in-package "PROFILER")
    2121
    22 ;; SHOW-CALL-COUNTS and PROFILE are exported in Lisp.java.
     22(defparameter *type* nil)
     23
     24(defparameter *granularity* 1 "Sampling interval (in milliseconds).")
    2325
    2426;; Returns list of all symbols with non-zero call counts.
     
    4547    (setf syms (sort syms #'<
    4648                     :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))
     49    (let ((max-count nil))
     50      (when (eq *type* :time)
     51        (let* ((last-sym (car (last syms))))
     52          (setf max-count (if last-sym
     53                              (sys::%call-count (fdefinition last-sym))
     54                              nil))
     55          (when (eql max-count 0)
     56            (setf max-count nil))))
    5357      (dolist (sym syms)
    5458        (show-call-count-for-symbol sym max-count))))
    5559  (values))
    5660
    57 (defmacro profile (&rest forms)
    58   `(progn (start-profiler) ,@forms (stop-profiler)))
     61(defun start-profiler (&key type)
     62  "Starts the profiler.
     63  :TYPE may be either :TIME (statistical sampling) or :COUNT-ONLY (exact call
     64  counts)."
     65  (format t "start-profiler type = ~S~%" type)
     66  (unless type
     67    (setf type :time))
     68  (unless (memq type '(:time :count-only))
     69    (error ":TYPE must be :TIME or :COUNT-ONLY"))
     70  (setf *type* type)
     71  (%start-profiler type *granularity*))
     72
     73(defmacro with-profiling ((&key type) &body body)
     74  `(unwind-protect (progn (start-profiler :type ,type) ,@body)
     75                   (stop-profiler)))
Note: See TracChangeset for help on using the changeset viewer.