cvs server: Diffing . Index: slime.el =================================================================== RCS file: /project/slime/cvsroot/slime/slime.el,v retrieving revision 1.197 diff -u -r1.197 slime.el --- slime.el 23 Jan 2004 14:17:57 -0000 1.197 +++ slime.el 28 Jan 2004 21:03:39 -0000 @@ -422,6 +423,12 @@ ;; NB: XEmacs dosn't like \C-g. Use \C-b as "break" key. ("\C-b" slime-interrupt :prefixed t :inferior t :sldb t) ("\M-g" slime-quit :prefixed t :inferior t :sldb t) + ;; Profiling + ("pt" slime-toggle-profile-fdefinition :prefixed t :inferior t :sldb t) + ("pu" slime-unprofile-all :prefixed t :inferior t :sldb t) + ("pf" slime-profiled-functions :prefixed t :inferior t :sldb t) + ("pr" slime-profile-report :prefixed t :inferior t :sldb t) + ("pc" slime-profile-reset :prefixed t :inferior t :sldb t) ;; Documentation (" " slime-space :inferior t) ("\C-d" slime-describe-symbol :prefixed t :inferior t :sldb t) @@ -508,6 +516,13 @@ [ "Toggle Trace..." slime-toggle-trace-fdefinition ,C ] [ "Disassemble..." slime-disassemble-symbol ,C ] [ "Inspect..." slime-inspect ,C ]) + ("Profiling" + [ "Toggle Profiling..." slime-toggle-profile-fdefinition ,C ] + [ "Unprofile All" slime-unprofile-all ,C ] + [ "Show Profiled" slime-profiled-functions ,C ] + "--" + [ "Report" slime-profile-report ,C ] + [ "Reset Counters" slime-profile-reset ,C ]) ("Compilation" [ "Compile Defun" slime-compile-defun ,C ] [ "Compile/Load File" slime-compile-and-load-file ,C ] @@ -3615,6 +3631,37 @@ (slime-eval-with-transcript `(swank:load-file ,lisp-filename) nil))) +;;;; Profiling + +(defun slime-toggle-profile-fdefinition (fname-string) + "Toggle profiling for FNAME-STRING." + (interactive (list (slime-read-from-minibuffer + "(Un)Profile: " (slime-symbol-name-at-point)))) + (message "%s" (slime-eval `(swank:toggle-profile-fdefinition ,fname-string) + (slime-buffer-package t)))) + +(defun slime-unprofile-all () + "Unprofile all functions." + (interactive) + (message "%s" (slime-eval `(swank:unprofile-all) (slime-buffer-package t)))) + +(defun slime-profile-report () + "Print profile report." + (interactive) + (slime-eval `(swank:profile-report))) + +(defun slime-profile-reset () + "Reset profile counters." + (interactive) + (message "%s" (slime-eval `(swank:profile-reset)))) + +(defun slime-profiled-functions () + "Return list of names of currently profiled functions." + (interactive) + (message "%s" (slime-eval `(swank:profiled-functions)))) + + + ;;; Documentation (defun slime-hyperspec-lookup (symbol-name) Index: swank-backend.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank-backend.lisp,v retrieving revision 1.22 diff -u -r1.22 swank-backend.lisp --- swank-backend.lisp 22 Jan 2004 00:35:17 -0000 1.22 +++ swank-backend.lisp 28 Jan 2004 21:03:40 -0000 @@ -77,6 +77,12 @@ #:throw-to-toplevel #:toggle-trace-fdefinition #:untrace-all + #:profile + #:unprofile + #:unprofile-all + #:profiled-functions + #:profile-report + #:profile-reset #:wait-goahead #:warn-unimplemented-interfaces #:who-binds @@ -390,6 +396,31 @@ (definterface restart-frame (frame-number) "Restart execution of the frame FRAME-NUMBER with the same arguments as it was called originally.") + + +;;;; Profiling + +;;; The following functions define a minimal profiling interface. + +(definterface profile (fname) + "Marks symbol FNAME for profiling.") + +(definterface profiled-functions () + "Returns a list of profiled functions.") + +(definterface unprofile (fname) + "Marks symbol FNAME as not profiled.") + +(definterface unprofile-all () + "Marks all currently profiled functions as not profiled." + (dolist (f (profiled-functions)) + (unprofile f))) + +(definterface profile-report () + "Prints profile report.") + +(definterface profile-reset () + "Resets profile counters.") ;;;; Queries Index: swank-cmucl.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank-cmucl.lisp,v retrieving revision 1.57 diff -u -r1.57 swank-cmucl.lisp --- swank-cmucl.lisp 22 Jan 2004 00:38:48 -0000 1.57 +++ swank-cmucl.lisp 28 Jan 2004 21:03:43 -0000 @@ -1162,6 +1162,29 @@ ("Function" . ,(kernel:fdefn-function o))))) +;;;; Profiling +(defimplementation profile (fname) + (when fname (eval `(sb-profile:profile ,fname)))) + +(defimplementation unprofile (fname) + (when fname (eval `(sb-profile:unprofile ,fname)))) + +(defimplementation unprofile-all () + (sb-profile:unprofile) + "All functions unprofiled.") + +(defimplementation profile-report () + (sb-profile:report-time)) + +(defimplementation profile-reset () + (sb-profile:reset-time) + "Reset profiling counters.") + +(defimplementation profiled-functions () + profile:*timed-functions*) + + + ;;;; Multiprocessing #+MP Index: swank-sbcl.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank-sbcl.lisp,v retrieving revision 1.56 diff -u -r1.56 swank-sbcl.lisp --- swank-sbcl.lisp 23 Jan 2004 21:03:11 -0000 1.56 +++ swank-sbcl.lisp 28 Jan 2004 21:03:44 -0000 @@ -536,6 +536,29 @@ (cond (probe (throw (car probe) (eval-in-frame form index))) (t (format nil "Cannot return from frame: ~S" frame))))) + +;;;; Profiling +(defimplementation profile (fname) + (when fname (eval `(sb-profile:profile ,fname)))) + +(defimplementation unprofile (fname) + (when fname (eval `(sb-profile:unprofile ,fname)))) + +(defimplementation unprofile-all () + (sb-profile:unprofile) + "All functions unprofiled.") + +(defimplementation profile-report () + (sb-profile:report)) + +(defimplementation profile-reset () + (sb-profile:reset) + "Reset profiling counters.") + +(defimplementation profiled-functions () + (sb-profile:profile)) + + ;;;; Multiprocessing #+SB-THREAD Index: swank.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank.lisp,v retrieving revision 1.109 diff -u -r1.109 swank.lisp --- swank.lisp 23 Jan 2004 00:20:39 -0000 1.109 +++ swank.lisp 28 Jan 2004 21:03:51 -0000 @@ -1136,6 +1136,21 @@ (throw 'slime-toplevel nil)) +;;;; Profiling + +(defun profiledp (fspec) + (member fspec (profiled-functions))) + +(defslimefun toggle-profile-fdefinition (fname-string) + (let ((fname (from-string fname-string))) + (cond ((profiledp fname) + (unprofile fname) + (format nil "~S is now unprofiled." fname)) + (t + (profile fname) + (format nil "~S is now profiled." fname))))) + + ;;;; Source Locations (defstruct (:location (:type list) :named