? advice.lisp
? dribble.sbcl
? local.patch
? nregex.ufsl
? presents.lisp
? ps-test.ps
? result.sbcl
? slime.core
? stepper.patch
? swank-clisp.fas
? swank-clisp.lib
? swank-coreloader.lisp
? swank-loader.ufsl
? test.el
? test.fas
? test.lib
? test.lisp
Index: slime.el
===================================================================
RCS file: /project/slime/cvsroot/slime/slime.el,v
retrieving revision 1.535
diff -C5 -d -r1.535 slime.el
*** slime.el	30 Aug 2005 23:57:26 -0000	1.535
--- slime.el	31 Aug 2005 18:48:40 -0000
***************
*** 629,638 ****
--- 629,639 ----
      ("\M-p" slime-repl-set-package :prefixed t :inferior t)
      ;; Cross reference
      ("<" slime-list-callers :prefixed t :inferior t :sldb t)
      (">" slime-list-callees :prefixed t :inferior t :sldb t)
      ;; "Other"
+     ("s" slime-toggle-stepping :prefixed t :inferior t :sldb t)
      ("\I"  slime-inspect :prefixed t :inferior t :sldb t)
      ("\C-]" slime-close-all-sexp :prefixed t :inferior t :sldb t)
      ("\C-xt" slime-list-threads :prefixed t :inferior t :sldb t)
      ("\C-xc" slime-list-connections :prefixed t :inferior t :sldb t)
      ;; Shadow unwanted bindings from inf-lisp
***************
*** 746,756 ****
        ("Debugging"
         [ "Macroexpand Once..."     slime-macroexpand-1 ,C ]
         [ "Macroexpand All..."      slime-macroexpand-all ,C ]
         [ "Toggle Trace..."         slime-toggle-trace-fdefinition ,C ]
         [ "Disassemble..."          slime-disassemble-symbol ,C ]
!        [ "Inspect..."              slime-inspect ,C ])
        ("Compilation"
         [ "Compile Defun"           slime-compile-defun ,C ]
         [ "Compile/Load File"       slime-compile-and-load-file ,C ]
         [ "Compile File"            slime-compile-file ,C ]
         [ "Compile Region"          slime-compile-region ,C ]
--- 747,758 ----
        ("Debugging"
         [ "Macroexpand Once..."     slime-macroexpand-1 ,C ]
         [ "Macroexpand All..."      slime-macroexpand-all ,C ]
         [ "Toggle Trace..."         slime-toggle-trace-fdefinition ,C ]
         [ "Disassemble..."          slime-disassemble-symbol ,C ]
!        [ "Inspect..."              slime-inspect ,C ]
!        [ "Toggle stepping..."      slime-toggle-stepping ,C ])
        ("Compilation"
         [ "Compile Defun"           slime-compile-defun ,C ]
         [ "Compile/Load File"       slime-compile-and-load-file ,C ]
         [ "Compile File"            slime-compile-file ,C ]
         [ "Compile Region"          slime-compile-region ,C ]
***************
*** 2311,2323 ****
                 (t
                  (error "Unexpected reply: %S %S" id value)))))
        ((:debug-activate thread level)
         (assert thread)
         (sldb-activate thread level))
!       ((:debug thread level condition restarts frames conts)
         (assert thread)
!        (sldb-setup thread level condition restarts frames conts))
        ((:debug-return thread level &optional stepping)
         (assert thread)
         (sldb-exit thread level stepping))
        ((:emacs-interrupt thread)
         (cond ((slime-use-sigint-for-interrupt) (slime-send-sigint))
--- 2313,2325 ----
                 (t
                  (error "Unexpected reply: %S %S" id value)))))
        ((:debug-activate thread level)
         (assert thread)
         (sldb-activate thread level))
!       ((:debug thread level condition restarts frames skip-frameno conts)
         (assert thread)
!        (sldb-setup thread level condition restarts frames skip-frameno conts))
        ((:debug-return thread level &optional stepping)
         (assert thread)
         (sldb-exit thread level stepping))
        ((:emacs-interrupt thread)
         (cond ((slime-use-sigint-for-interrupt) (slime-send-sigint))
***************
*** 6795,6804 ****
--- 6797,6817 ----
      (message "package: %s  default-directory: %s" (car package) directory)))
  	
  
  ;;;; Debugger (SLDB)
  
+ 
+ ;; TODO: This doesn't quite seem like the spot
+ (defun slime-toggle-stepping (symbol-name)
+   "Toggle stepping of a function"
+   (interactive (list (slime-read-symbol-name "Step function: ")))
+   (unless symbol-name
+     (error "No symbol given"))
+   (slime-eval-async `(swank:toggle-stepping ,symbol-name)
+                     'message))
+ 
+ 
  (defvar sldb-hook nil
    "Hook run on entry to the debugger.")
  
  (defun slime-add-face (face string)
    (add-text-properties 0 (length string) (list 'face face) string)
***************
*** 6866,6879 ****
     \\[sldb-down]   - down
     \\[sldb-up]   - up
     \\[sldb-details-down] - down, with details
     \\[sldb-details-up] - up, with details
  
  Miscellaneous commands:
     \\[sldb-restart-frame]   - restart frame
     \\[sldb-return-from-frame]   - return from frame
-    \\[sldb-step]   - step
     \\[sldb-break-with-default-debugger]   - switch to default debugger
     \\[slime-interactive-eval]   - eval
  
  Full list of commands:
  
--- 6879,6897 ----
     \\[sldb-down]   - down
     \\[sldb-up]   - up
     \\[sldb-details-down] - down, with details
     \\[sldb-details-up] - up, with details
  
+ Commands to control stepping:
+    \\[sldb-step]   - step (?)
+    \\[sldb-step-over]   - Step over the next expression
+    \\[sldb-step-out]   - Resume execution until the selected frame has been reached
+    \\[sldb-step-exit]   - Resume execution
+ 
  Miscellaneous commands:
     \\[sldb-restart-frame]   - restart frame
     \\[sldb-return-from-frame]   - return from frame
     \\[sldb-break-with-default-debugger]   - switch to default debugger
     \\[slime-interactive-eval]   - eval
  
  Full list of commands:
  
***************
*** 6930,6939 ****
--- 6948,6958 ----
    ("t"    'sldb-toggle-details)
    ("r"    'sldb-restart-frame)
    ("R"    'sldb-return-from-frame)
    ("c"    'sldb-continue)
    ("s"    'sldb-step)
+   ("x"    'sldb-step-exit)
    ("b"    'sldb-break-on-return)
    ("a"    'sldb-abort)
    ("q"    'sldb-quit)
    ("B"    'sldb-break-with-default-debugger)
    ("P"    'sldb-print-condition)
***************
*** 7007,7017 ****
        (with-current-buffer b
          (when (eq slime-buffer-connection connection)
            (setq accu (append sldb-continuations accu)))))
      accu))
  
! (defun sldb-setup (thread level condition restarts frames conts)
    "Setup a new SLDB buffer.
  CONDITION is a string describing the condition to debug.
  RESTARTS is a list of strings (NAME DESCRIPTION) for each available restart.
  FRAMES is a list (NUMBER DESCRIPTION) describing the initial
  portion of the backtrace. Frames are numbered from 0.
--- 7026,7036 ----
        (with-current-buffer b
          (when (eq slime-buffer-connection connection)
            (setq accu (append sldb-continuations accu)))))
      accu))
  
! (defun sldb-setup (thread level condition restarts frames skip-frameno conts)
    "Setup a new SLDB buffer.
  CONDITION is a string describing the condition to debug.
  RESTARTS is a list of strings (NAME DESCRIPTION) for each available restart.
  FRAMES is a list (NUMBER DESCRIPTION) describing the initial
  portion of the backtrace. Frames are numbered from 0.
***************
*** 7032,7044 ****
--- 7051,7068 ----
        (insert (in-sldb-face section "Restarts:") "\n")
        (sldb-insert-restarts restarts)
        (insert "\n" (in-sldb-face section "Backtrace:") "\n")
        (setq sldb-backtrace-start-marker (point-marker))
        (sldb-insert-frames (sldb-prune-initial-frames frames) nil)
+       (next-line skip-frameno)
        (run-hooks 'sldb-hook)
        (pop-to-buffer (current-buffer))
        (setq buffer-read-only t)
+       ;; TODO: Conditionalize this
+       (unless (zerop skip-frameno)
+         (split-window)
+         (sldb-show-source))
        (when (and slime-stack-eval-tags
                   ;; (y-or-n-p "Enter recursive edit? ")
                   )
          (message "Entering recursive edit..")
          (recursive-edit)))))
***************
*** 7575,7584 ****
--- 7599,7624 ----
  (defun sldb-step ()
    "Select the \"continue\" restart and set a new break point."
    (interactive)
    (let ((frame (sldb-frame-number-at-point)))
      (slime-eval-async `(swank:sldb-step ,frame))))
+ 
+ (defun sldb-step-over ()
+   "Select the \"step-over\" restart."
+   (interactive)
+   (slime-eval-async '(swank:step-over)))
+ 
+ (defun sldb-step-exit ()
+   "Select the \"step-exit\" restart."
+   (interactive)
+   (slime-eval-async '(swank:step-exit)))
+ 
+ (defun sldb-step-out ()
+   "Select the \"step-out\" restart and resume normal execution until we hit
+ the selected frame"
+   (interactive)
+   (slime-eval-async `(swank:step-out ,(sldb-frame-number-at-point))))
  
  (defun sldb-break-on-return ()
    "Set a breakpoint at the current frame. 
  The debugger is entered when the frame exits."
    (interactive)
Index: swank-backend.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-backend.lisp,v
retrieving revision 1.87
diff -C5 -d -r1.87 swank-backend.lisp
*** swank-backend.lisp	28 Aug 2005 14:47:11 -0000	1.87
--- swank-backend.lisp	31 Aug 2005 18:48:40 -0000
***************
*** 474,483 ****
--- 474,491 ----
  (definterface disassemble-frame (frame-number)
    "Disassemble the code for the FRAME-NUMBER.
  The output should be written to standard output.
  FRAME-NUMBER is a non-negative integer.")
  
+ (definterface frame-package (frame)
+   "Return the package that owns frame, or nil.
+ For example, a frame containing a call to cl:+ is owned by the common-lisp
+ package.
+ 
+ This is best-effort; implementations are allowed to have false negatives"
+   nil)
+ 
  (definterface eval-in-frame (form frame-number)
     "Evaluate a Lisp form in the lexical context of a stack frame
  in the debugger.  The results are undefined unless called in the
  dynamic contour of a function defined by DEFINE-DEBUGGER-HOOK.
  
***************
*** 520,538 ****
--- 528,595 ----
  The allowed elements are of the form:
    (:SHOW-FRAME-SOURCE frame-number)"
    (declare (ignore condition))
    '())
  
+ (definterface last-stepper-frame ()
+   "Returns the number of the last frame that's part of the stepper, or nil.
+ Add one to get the frame being stepped."
+   nil)
+ 
+ (definterface call-with-stepping (function)
+   "Attempt to step through a function.
+ The stepper will signal signal a subclass of step-condition to provide a UI;
+ at this point, the three restarts named below may be usable, along with a
+ 'continue' restart that attempts to step as closely as possible; this can be
+ \"step-in\", \"step-over\" or even \"step-exit\"; the text should mention which.")
+ 
+ ;; Restarts
+ (export '(step-over step-out step-exit))
+ 
  (definterface activate-stepping (frame-number)
    "Prepare the frame FRAME-NUMBER for stepping.")
  
+ 
+ (define-condition step-condition (condition)
+   ((form :initarg :form :reader form))
+   (:documentation "Common base class for stepping conditions.
+ form holds a representation of the form being stepped into"))
+ 
+ (export
+  (defun step-condition-p (condition)
+    (typep condition 'step-condition)))
+ 
+ (define-condition step-result-condition (step-condition)
+   ((results :initarg :results :reader results :initform nil))
+   (:documentation
+    "This condition is signalled when a form/variable has finished evaluating;
+ contains the values returned by the form as a list.")
+   (:report (lambda (c s)
+              (format s (if (= (length (results c)) 1)
+                            "~A returned ~{~A~}"
+                            "~A returned (values~{ ~A~})")
+                      (form c)
+                      (results c)))))
+ 
+ (define-condition step-eval-condition (step-condition)
+   ()
+   (:documentation "Condition signalled when the single-stepper is about to
+ evaluate a form.")
+   (:report (lambda (c s)
+              (format s "Stepping into ~A" (form c)))))
+ 
+ 
  (definterface sldb-break-on-return (frame-number)
    "Set a breakpoint in the frame FRAME-NUMBER.")
  
  (definterface sldb-break-at-start (symbol)
    "Set a breakpoint on the beginning of the function for SYMBOL.")
    
+ (definterface skippable-packages ()
+   "Returns a list of packages whose functions may be skipped when placing
+ point in an sldb frame list"
+   nil)
  
  
  ;;;; Definition finding
  
  (defstruct (:location (:type list) :named
Index: swank-clisp.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-clisp.lisp,v
retrieving revision 1.54
diff -C5 -d -r1.54 swank-clisp.lisp
*** swank-clisp.lisp	22 Aug 2005 04:30:30 -0000	1.54
--- swank-clisp.lisp	31 Aug 2005 18:48:40 -0000
***************
*** 501,510 ****
--- 501,561 ----
  	       ()))
  	   (with-condition-restarts condition (list (find-restart 'continue))
  				    (invoke-debugger condition)))))
     nil))
  
+ ;;; Stepping
+ ;; Mostly copied from reploop.lisp
+ 
+ 
+ ;; (defvar *step-level* 0 "current Step-depth")
+ ;; (defvar *step-quit* most-positive-fixnum "critical Step-depth")
+ ;; ;; the stepper wakes up, as soon as *step-level* <= *step-quit*
+ 
+ ;; (defvar *step-watch* nil)               ; terminating condition
+ 
+ (defun step-values (form values)
+   (with-simple-restart
+       (continue "Keep stepping")
+     (error (make-condition 'step-result-condition :form form :results values)))
+   (values-list values))
+ 
+ ;; TODO: There is great potential for step-out.
+ (defun step-hook-fn (form &optional (env system::*toplevel-environment*))
+   (let ((system::*step-level* (1+ system::*step-level*)))
+     (when (>= system::*step-level* system::*step-quit*)	; while *step-level* >= *step-quit*
+       (if (and system::*step-watch* (funcall system::*step-watch*)) ; and no Breakpoint,
+ 	  (setq system::*step-quit* most-positive-fixnum)
+ 	  (return-from step-hook-fn	; the Stepper remains passive
+ 	    (system::evalhook form nil nil env)))) ; (e.g. it simply evaluates the Form)
+ 
+     (restart-case
+ 	(error (make-condition 'step-eval-condition :form form))
+       (continue ()
+ 	(return-from step-hook-fn
+ 	  (step-values
+ 	   form
+ 	   (multiple-value-list (system::evalhook form #'step-hook-fn nil env)))))
+       (step-over ()
+ 	(return-from step-hook-fn
+ 	  (step-values
+ 	   form
+ 	   (multiple-value-list (system::evalhook form nil nil env)))))
+       (step-exit ()
+ 	(setq system::*step-quit* 0)
+ 	(return-from step-hook-fn
+ 	  (step-values
+ 	   form
+ 	   (multiple-value-list (system::evalhook form nil nil env))))))))
+ 
+ (defimplementation call-with-stepping (function)
+   (let* ((system::*step-level* 0)
+ 	 (system::*step-quit* most-positive-fixnum)
+ 	 (system::*step-watch* nil)
+ 	 (system::*evalhook* #'step-hook-fn))
+     (funcall function)))
+ 
  ;;; Inspecting
  
  (defclass clisp-inspector (inspector)
    ())
  
Index: swank-loader.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-loader.lisp,v
retrieving revision 1.51
diff -C5 -d -r1.51 swank-loader.lisp
*** swank-loader.lisp	3 Aug 2005 09:40:20 -0000	1.51
--- swank-loader.lisp	31 Aug 2005 18:48:40 -0000
***************
*** 33,42 ****
--- 33,43 ----
             #+allegro '("swank-allegro" "swank-gray")
             #+clisp '("xref" "metering" "swank-clisp" "swank-gray")
             #+armedbear '("swank-abcl")
             #+cormanlisp '("swank-corman" "swank-gray")
             #+ecl '("swank-ecl" "swank-gray")
+            '("advice")
             )))
  
  (defparameter *implementation-features*
    '(:allegro :lispworks :sbcl :openmcl :cmu :clisp :ccl :corman :cormanlisp :armedbear :gcl :ecl))
  
Index: swank-sbcl.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-sbcl.lisp,v
retrieving revision 1.143
diff -C5 -d -r1.143 swank-sbcl.lisp
*** swank-sbcl.lisp	29 Aug 2005 11:23:55 -0000	1.143
--- swank-sbcl.lisp	31 Aug 2005 18:48:41 -0000
***************
*** 15,25 ****
    (require 'sb-bsd-sockets)
    (require 'sb-introspect)
    (require 'sb-posix))
  
  (in-package :swank-backend)
! (declaim (optimize (debug 2)))
  
  (import
   '(sb-gray:fundamental-character-output-stream
     sb-gray:stream-write-char
     sb-gray:stream-line-length
--- 15,28 ----
    (require 'sb-bsd-sockets)
    (require 'sb-introspect)
    (require 'sb-posix))
  
  (in-package :swank-backend)
! 
! ;; Stepping through the stepper is inadvisable.
! (declaim (optimize (debug 2)
!                    (sb-c::insert-step-conditions 0)))
  
  (import
   '(sb-gray:fundamental-character-output-stream
     sb-gray:stream-write-char
     sb-gray:stream-line-length
***************
*** 639,649 ****
                                 :original-condition condition)))))
        (funcall debugger-loop-fn))))
  
  (defimplementation call-with-debugger-hook (hook fun)
    (let ((sb-ext:*invoke-debugger-hook* hook))
!     (funcall fun)))
  
  (defun nth-frame (index)
    (do ((frame *sldb-stack-top* (sb-di:frame-down frame))
         (i index (1- i)))
        ((zerop i) frame)))
--- 642,653 ----
                                 :original-condition condition)))))
        (funcall debugger-loop-fn))))
  
  (defimplementation call-with-debugger-hook (hook fun)
    (let ((sb-ext:*invoke-debugger-hook* hook))
!     (handler-bind ((sb-impl::step-condition #'sb-impl::invoke-stepper))
!       (funcall fun))))
  
  (defun nth-frame (index)
    (do ((frame *sldb-stack-top* (sb-di:frame-down frame))
         (i index (1- i)))
        ((zerop i) frame)))
***************
*** 652,665 ****
    "Return a list of frames starting with frame number START and
  continuing to frame number END or, if END is nil, the last frame on the
  stack."
    (let ((end (or end most-positive-fixnum)))
      (loop for f = (nth-frame start) then (sb-di:frame-down f)
! 	  for i from start below end
! 	  while f
! 	  collect f)))
! 
  (defimplementation print-frame (frame stream)
    (sb-debug::print-frame-call frame stream))
  
  ;;;; Code-location -> source-location translation
  
--- 656,669 ----
    "Return a list of frames starting with frame number START and
  continuing to frame number END or, if END is nil, the last frame on the
  stack."
    (let ((end (or end most-positive-fixnum)))
      (loop for f = (nth-frame start) then (sb-di:frame-down f)
!                  for i from start below end
!                  while f
!                  collect f)))
!   
  (defimplementation print-frame (frame stream)
    (sb-debug::print-frame-call frame stream))
  
  ;;;; Code-location -> source-location translation
  
***************
*** 823,832 ****
--- 827,900 ----
  
  (defimplementation condition-references (condition)
    (if (typep condition 'sb-int:reference-condition)
        (sb-int:reference-condition-references condition)
        '()))
+ 
+ ;;;; Stepping
+ 
+ (defvar *step-exit-to* nil
+   "Bound to nil by call-with-stepping
+ If nil, stepping proceeds normally
+ If a frame number, stepping is skipped until that number is reached (TODO)
+   (counting from bottom)
+ If T, stepping is skipped")
+ 
+ (defvar *stepping* nil
+   "Bound to T while stepping")
+ 
+ ;; Could possibly be made more robust by looking for sb-c::step-*
+ (defimplementation last-stepper-frame ()
+   3)
+ 
+ (defimplementation call-with-stepping (function)
+   (let ((sb-impl::*stepper-hook* 'single-step)
+         (*step-exit-to* nil))
+     (if *stepping*
+         (funcall function)
+         (let ((*stepping* t))
+           (let ((sb-int:*stepping* t)
+                 (sb-int:*step* t))
+             (funcall function))))))
+ 
+ (defimplementation skippable-packages ()
+   (mapcar 'find-package
+           '(:common-lisp :sb-c :sb-impl :sb-pcl :sb-sys :sb-kernel :sb-int
+             :sb-fasl :sb-ext :sb-bignum :sb-assem :sb-alien
+             :sb-alien-internals :swank :swank-backend)))
+ 
+ (defgeneric single-step (condition)
+   (:method ((condition sb-kernel::step-condition))
+     (error "Unknown step condition signalled by SBCL - report a Slime bug"))
+   (:method ((condition sb-kernel::step-form-condition))
+     (when (eql *step-exit-to* t)
+       (invoke-restart 'sb-kernel::step-continue))
+     (restart-case
+         (error (make-condition 'step-eval-condition
+                                :form (sb-kernel::step-condition-form condition)))
+       (continue ()
+         :report "Step inside, if possible"
+         (invoke-restart 'sb-kernel::step-into))
+       (step-over ()
+         :report "Step over the next expression"
+         (invoke-restart 'sb-kernel::step-next))
+       (step-exit ()
+         :report "Resume normal execution"
+         (setf *step-exit-to* t)
+         (invoke-restart 'sb-kernel::step-continue))))
+   (:method ((condition sb-kernel::step-result-condition))
+     (declare (optimize (sb-c:insert-step-conditions 0)))
+     (with-simple-restart (continue "Keep stepping")
+       (error (make-condition 'step-result-condition
+                              :form (sb-kernel::step-condition-form condition)
+                              :results (list (sb-kernel::step-condition-result condition))))))
+   (:method ((condition sb-kernel::step-values-condition))
+     (declare (optimize (sb-c:insert-step-conditions 0)))
+     (with-simple-restart (continue "Keep stepping")
+       (error (make-condition 'step-result-condition
+                              :form (sb-kernel::step-condition-form condition)
+                              :results (sb-kernel::step-condition-result condition))))))
  
  
  ;;;; Profiling
  
  (defimplementation profile (fname)
Index: swank.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank.lisp,v
retrieving revision 1.329
diff -C5 -d -r1.329 swank.lisp
*** swank.lisp	31 Aug 2005 11:27:47 -0000	1.329
--- swank.lisp	31 Aug 2005 18:48:41 -0000
***************
*** 47,56 ****
--- 47,57 ----
             #:profile-report
             #:profile-reset
             #:unprofile-all
             #:profile-package
             #:default-directory
+            #:toggle-stepping
             #:set-default-directory
             #:quit-lisp))
  
  (in-package :swank)
  
***************
*** 1817,1826 ****
--- 1818,1828 ----
  
  (defslimefun interactive-eval (string)
    (let ((*can-print-presentation* t)) 
      (with-buffer-syntax ()
        (let ((values (multiple-value-list (eval (from-string string)))))
+         (advice:update-all)
          (fresh-line)
          (force-output)
          (format-values-for-echo-area values)))))
  
  (defslimefun eval-and-grab-output (string)
***************
*** 2057,2067 ****
  
  (defvar *sldb-restarts* nil
    "The list of currenlty active restarts.")
  
  (defvar *sldb-stepping-p* nil
!   "True when during execution of a stepp command.")
  
  (defun debug-in-emacs (condition)
    (let ((*swank-debugger-condition* condition)
          (*sldb-restarts* (compute-restarts condition))
          (*package* (or (and (boundp '*buffer-package*)
--- 2059,2069 ----
  
  (defvar *sldb-restarts* nil
    "The list of currenlty active restarts.")
  
  (defvar *sldb-stepping-p* nil
!   "True during execution of a step command.")
  
  (defun debug-in-emacs (condition)
    (let ((*swank-debugger-condition* condition)
          (*sldb-restarts* (compute-restarts condition))
          (*package* (or (and (boundp '*buffer-package*)
***************
*** 2147,2174 ****
      ;; higher likelyhood of lossage due to dynamic extent objects.
      (loop for frame in (compute-backtrace start end)
            for i from start
            collect (list i (frame-for-emacs i frame)))))
  
  (defslimefun debugger-info-for-emacs (start end)
    "Return debugger state, with stack frames from START to END.
  The result is a list:
!   (condition ({restart}*) ({stack-frame}*) (cont*))
  where
!   condition   ::= (description type [extra])
!   restart     ::= (name description)
!   stack-frame ::= (number description)
!   extra       ::= (:references and other random things)
!   cont        ::= continutation
  condition---a pair of strings: message, and type.  If show-source is
  not nil it is a frame number for which the source should be displayed.
  
  restart---a pair of strings: restart name, and description.
  
  stack-frame---a number from zero (the top), and a printed
  representation of the frame's call.
  
  continutation---the id of a pending Emacs continuation.
  
  Below is an example return value. In this case the condition was a
  division by zero (multi-line description), and only one frame is being
  fetched (start=0, end=1).
--- 2149,2197 ----
      ;; higher likelyhood of lossage due to dynamic extent objects.
      (loop for frame in (compute-backtrace start end)
            for i from start
            collect (list i (frame-for-emacs i frame)))))
  
+ 
+ 
+ ;; TODO: Should use skippable-packages and frame-package
+ (defun count-skippable-frames (start end)
+   (declare (ignore start end))
+   (if (and (step-condition-p *swank-debugger-condition*)
+            (last-stepper-frame))
+       (1+ (last-stepper-frame))
+       0))
+ 
+ ;; (if (not (member 'frame-package swank-backend::*unimplemented-interfaces*))
+ ;;                (loop for frame in (compute-backtrace start end)
+ ;;                      for i from start
+ ;;                      while (member (frame-package frame) (skippable-packages))
+ ;;                      finally (return i))
+ ;;                0)
+ 
  (defslimefun debugger-info-for-emacs (start end)
    "Return debugger state, with stack frames from START to END.
  The result is a list:
!   (condition ({restart}*) ({stack-frame}*) skip-frameno (cont*))
  where
!   condition    ::= (description type [extra])
!   restart      ::= (name description)
!   stack-frame  ::= (number description)
!   skip-frameno ::= number
!   extra        ::= (:references and other random things)
!   cont         ::= continutation
  condition---a pair of strings: message, and type.  If show-source is
  not nil it is a frame number for which the source should be displayed.
  
  restart---a pair of strings: restart name, and description.
  
  stack-frame---a number from zero (the top), and a printed
  representation of the frame's call.
  
+ skip-frameno---a number from zero (the top) telling Emacs which frame
+ to start at
+ 
  continutation---the id of a pending Emacs continuation.
  
  Below is an example return value. In this case the condition was a
  division by zero (multi-line description), and only one frame is being
  fetched (start=0, end=1).
***************
*** 2177,2190 ****
--- 2200,2215 ----
  Operation was KERNEL::DIVISION, operands (1 0).\"
     \"[Condition of type DIVISION-BY-ZERO]\")
    ((\"ABORT\" \"Return to Slime toplevel.\")
     (\"ABORT\" \"Return to Top-Level.\"))
    ((0 \"(KERNEL::INTEGER-/-INTEGER 1 0)\"))
+   0
    (4))"
    (list (debugger-condition-for-emacs)
  	(format-restarts-for-emacs)
  	(backtrace start end)
+         (count-skippable-frames start end)
          *pending-continuations*))
  
  (defun nth-restart (index)
    (nth index *sldb-restarts*))
  
***************
*** 2247,2264 ****
--- 2272,2319 ----
  
  (defslimefun sldb-break (name)
    (with-buffer-syntax ()
      (sldb-break-at-start (read-from-string name))))
  
+ ;;; Stepping calls
  (defslimefun sldb-step (frame)
    (cond ((find-restart 'continue)
           (activate-stepping frame)
           (setq *sldb-stepping-p* t)
           (continue))
          (t
           (error "No continue restart."))))
  
+ (defslimefun step-over (&rest args)
+   (apply 'invoke-restart 'step-over args))
+ 
+ (defslimefun step-exit (&rest args)
+   (apply 'invoke-restart 'step-exit args))
+ 
+ (defslimefun step-out (&rest args)
+   (apply 'invoke-restart 'step-out args))
+ 
+ (defslimefun toggle-stepping (symbol-name)
+   (let ((symbol (with-buffer-syntax ()
+                   (parse-symbol-or-lose symbol-name))))
+     (unless (fboundp symbol)
+       (error "Unknown function: ~A [in ~A]" symbol (symbol-package symbol)))
+     (symbol-macrolet ((stepped (get symbol 'stepped)))
+         (prog1
+             (cond ((not stepped)
+                    (advice:add-advice symbol 'invoke-stepper :around
+                                       (lambda (&rest args)
+                                         (let ((*sldb-stepping-p* t))
+                                           (call-with-stepping
+                                            (lambda ()
+                                              (apply 'advice:call-next-advice args))))))
+                    "Stepping on")
+                   (stepped
+                    (advice:delete-advice symbol 'invoke-stepper :around)
+                    "Stepping off"))
+           (setf stepped (not stepped))))))
+ 
  
  ;;;; Compilation Commands.
  
  (defvar *compiler-notes* '()
    "List of compiler notes for the last compilation unit.")
***************
*** 2302,2311 ****
--- 2357,2367 ----
      (clear-compiler-notes)
      (with-simple-restart (abort "Abort SLIME compilation.")
        (multiple-value-bind (result usecs)
            (handler-bind ((compiler-condition #'record-note-for-condition))
              (measure-time-interval function))
+         (advice:update-all)
          (list (to-string result)
                (format nil "~,2F" (/ usecs 1000000.0)))))))
  
  (defslimefun compile-file-for-emacs (filename load-p &optional external-format)
    "Compile FILENAME and, when LOAD-P, load the result.
***************
*** 2319,2329 ****
  (defslimefun compile-string-for-emacs (string buffer position directory)
    "Compile STRING (exerpted from BUFFER at POSITION).
  Record compiler notes signalled as `compiler-condition's."
    (with-buffer-syntax ()
      (swank-compiler
!      (lambda () 
         (let ((*compile-print* nil) (*compile-verbose* t))
           (swank-compile-string string :buffer buffer :position position 
                                 :directory directory))))))
  
  (defslimefun operate-on-system-for-emacs (system-name operation &rest keywords)
--- 2375,2385 ----
  (defslimefun compile-string-for-emacs (string buffer position directory)
    "Compile STRING (exerpted from BUFFER at POSITION).
  Record compiler notes signalled as `compiler-condition's."
    (with-buffer-syntax ()
      (swank-compiler
!      (lambda ()
         (let ((*compile-print* nil) (*compile-verbose* t))
           (swank-compile-string string :buffer buffer :position position 
                                 :directory directory))))))
  
  (defslimefun operate-on-system-for-emacs (system-name operation &rest keywords)
