/[slime]/slime/swank-sbcl.lisp
ViewVC logotype

Diff of /slime/swank-sbcl.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.161 by nsiivola, Mon Sep 11 08:01:59 2006 UTC revision 1.162 by jsnellman, Mon Sep 18 21:56:13 2006 UTC
# Line 583  Return a list of the form (NAME LOCATION Line 583  Return a list of the form (NAME LOCATION
583    
584  ;;; Debugging  ;;; Debugging
585    
586    (eval-when (:compile-toplevel :load-toplevel :execute)
587      ;; Generate a form suitable for testing for stepper support (0.9.17)
588      ;; with #+.
589      (defun sbcl-with-new-stepper-p ()
590        (if (find-symbol "ENABLE-STEPPING" "SB-IMPL")
591            '(and)
592            '(or))))
593    
594  (defvar *sldb-stack-top*)  (defvar *sldb-stack-top*)
595    
596  (defimplementation install-debugger-globally (function)  (defimplementation install-debugger-globally (function)
597    (setq sb-ext:*invoke-debugger-hook* function))    (setq sb-ext:*invoke-debugger-hook* function))
598    
599    #+#.(swank-backend::sbcl-with-new-stepper-p)
600    (defimplementation condition-extras (condition)
601      (when (typep condition 'sb-impl::step-form-condition)
602        `((:short-frame-source 0))))
603    
604  (defimplementation call-with-debugging-environment (debugger-loop-fn)  (defimplementation call-with-debugging-environment (debugger-loop-fn)
605    (declare (type function debugger-loop-fn))    (declare (type function debugger-loop-fn))
606    (let* ((*sldb-stack-top* (or sb-debug:*stack-top-hint* (sb-di:top-frame)))    (let* ((*sldb-stack-top* (or sb-debug:*stack-top-hint* (sb-di:top-frame)))
# Line 599  Return a list of the form (NAME LOCATION Line 612  Return a list of the form (NAME LOCATION
612                                 :original-condition condition)))))                                 :original-condition condition)))))
613        (funcall debugger-loop-fn))))        (funcall debugger-loop-fn))))
614    
615    #+#.(swank-backend::sbcl-with-new-stepper-p)
616    (progn
617      (defimplementation activate-stepping (frame)
618        (declare (ignore frame))
619        (sb-impl::enable-stepping))
620      (defimplementation sldb-stepper-condition-p (condition)
621        (typep condition 'sb-ext:step-form-condition))
622      (defimplementation sldb-step-into ()
623        (invoke-restart 'sb-ext:step-into))
624      (defimplementation sldb-step-next ()
625        (invoke-restart 'sb-ext:step-next))
626      (defimplementation sldb-step-out ()
627        (invoke-restart 'sb-ext:step-out)))
628    
629  (defimplementation call-with-debugger-hook (hook fun)  (defimplementation call-with-debugger-hook (hook fun)
630    (let ((sb-ext:*invoke-debugger-hook* hook))    (let ((sb-ext:*invoke-debugger-hook* hook)
631            #+#.(swank-backend::sbcl-with-new-stepper-p)
632            (sb-ext:*stepper-hook*
633             (lambda (condition)
634               (when (typep condition 'sb-ext:step-form-condition)
635                 (let ((sb-debug:*stack-top-hint* (sb-di::find-stepped-frame)))
636                   (sb-impl::invoke-debugger condition))))))
637      (funcall fun)))      (funcall fun)))
638    
639  (defun nth-frame (index)  (defun nth-frame (index)

Legend:
Removed from v.1.161  
changed lines
  Added in v.1.162

  ViewVC Help
Powered by ViewVC 1.1.5