Changeset 4752 for trunk/j/src/org/armedbear

Timestamp:

11/14/03 17:55:35 (19 years ago)

Author:

piso

Message:

Work in progress.

Location:

trunk/j/src/org/armedbear/lisp

Files:

• Profiler.java (modified) (6 diffs)
• profiler.lisp (modified) (3 diffs)

trunk/j/src/org/armedbear/lisp/Profiler.java

@@ -3 +3 @@
  *
  * Copyright (C) 2003 Peter Graves
- * $Id: Profiler.java,v 1.1 2003-11-12 21:28:11 piso Exp $
+ * $Id: Profiler.java,v 1.2 2003-11-14 17:55:17 piso Exp $
  *
  * This program is free software; you can redistribute it and/or
@@ -24 +24 @@
 public class Profiler extends Lisp
 {
+    private static int sleep = 1;
+
     public static final void sample(LispThread thread)
     {
@@ -33 +35 @@
         public void run()
         {
-            try {
-                int sleep = Fixnum.getValue(_GRANULARITY_.getSymbolValue());
-                while (profiling) {
-                    sampleNow = true;
-                    try {
-                        Thread.sleep(sleep);
-                    }
-                    catch (InterruptedException e) {
-                        Debug.trace(e);
-                    }
+            while (profiling) {
+                sampleNow = true;
+                try {
+                    Thread.sleep(sleep);
                 }
-            }
-            catch (ConditionThrowable t) {
-                Debug.trace(t);
+                catch (InterruptedException e) {
+                    Debug.trace(e);
+                }
             }
         }
     };
 
-    // ### start-profiler
-    public static final Primitive0 START_PROFILER =
-        new Primitive0("start-profiler", PACKAGE_PROF, true)
+    // ### %start-profiler
+    // %start-profiler type granularity
+    public static final Primitive2 _START_PROFILER =
+        new Primitive2("%start-profiler", PACKAGE_PROF, false)
     {
-        public LispObject execute() throws ConditionThrowable
+        public LispObject execute(LispObject first, LispObject second)
+            throws ConditionThrowable
         {
             CharacterOutputStream out = getStandardOutput();
             out.freshLine();
             if (profiling) {
-                out.writeLine("; Profiling already enabled.");
+                out.writeLine("; Profiler already started.");
             } else {
+                if (first == Keyword.TIME)
+                    sampling = true;
+                else if (first == Keyword.COUNT_ONLY)
+                    sampling = false;
+                else
+                    throw new ConditionThrowable(new LispError(
+                        "%START-PROFILER: argument must be either :TIME or :COUNT-ONLY"));
                 Package[] packages = Packages.getAllPackages();
                 for (int i = 0; i < packages.length; i++) {
@@ -73 +78 @@
                     }
                 }
-                sampling = true; // FIXME
                 if (sampling) {
+                    sleep = Fixnum.getValue(second);
                     if (!debug) {
                         debug = true;
@@ -86 +91 @@
                     new Thread(profilerRunnable).start();
                 }
-                out.writeLine("; Profiling started.");
+                out.writeLine("; Profiler started.");
                 profiling = true;
             }
@@ -103 +108 @@
             if (profiling) {
                 profiling = false;
-                out.writeLine("; Profiling stopped.");
+                out.writeLine("; Profiler stopped.");
             } else
-                out.writeLine("; Profiling not enabled.");
+                out.writeLine("; Profiler was not started.");
             out.flushOutput();
             return LispThread.currentThread().nothing();

trunk/j/src/org/armedbear/lisp/profiler.lisp

@@ -2 +2 @@
 ;;;
 ;;; Copyright (C) 2003 Peter Graves
-;;; $Id: profiler.lisp,v 1.7 2003-11-12 21:26:59 piso Exp $
+;;; $Id: profiler.lisp,v 1.8 2003-11-14 17:55:35 piso Exp $
 ;;;
 ;;; This program is free software; you can redistribute it and/or
@@ -20 +20 @@
 (in-package "PROFILER")
 
-;; SHOW-CALL-COUNTS and PROFILE are exported in Lisp.java.
+(defparameter *type* nil)
+
+(defparameter *granularity* 1 "Sampling interval (in milliseconds).")
 
 ;; Returns list of all symbols with non-zero call counts.
@@ -45 +47 @@
     (setf syms (sort syms #'<
                      :key #'(lambda (x) (sys::%call-count (fdefinition x)))))
-    (let* ((last-sym (car (last syms)))
-           (max-count (if last-sym
-                          (sys::%call-count (fdefinition last-sym))
-                          nil)))
-      (when (zerop max-count)
-        (setf max-count nil))
+    (let ((max-count nil))
+      (when (eq *type* :time)
+        (let* ((last-sym (car (last syms))))
+          (setf max-count (if last-sym
+                              (sys::%call-count (fdefinition last-sym))
+                              nil))
+          (when (eql max-count 0)
+            (setf max-count nil))))
       (dolist (sym syms)
         (show-call-count-for-symbol sym max-count))))
   (values))
 
-(defmacro profile (&rest forms)
-  `(progn (start-profiler) ,@forms (stop-profiler)))
+(defun start-profiler (&key type)
+  "Starts the profiler.
+  :TYPE may be either :TIME (statistical sampling) or :COUNT-ONLY (exact call
+  counts)."
+  (format t "start-profiler type = ~S~%" type)
+  (unless type
+    (setf type :time))
+  (unless (memq type '(:time :count-only))
+    (error ":TYPE must be :TIME or :COUNT-ONLY"))
+  (setf *type* type)
+  (%start-profiler type *granularity*))
+
+(defmacro with-profiling ((&key type) &body body)
+  `(unwind-protect (progn (start-profiler :type ,type) ,@body)
+                   (stop-profiler)))