/[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.256 by sboukarev, Wed Dec 2 17:34:37 2009 UTC revision 1.257 by trittweiler, Thu Dec 10 20:51:33 2009 UTC
# Line 911  Return a list of the form (NAME LOCATION Line 911  Return a list of the form (NAME LOCATION
911    
912  ;;; Debugging  ;;; Debugging
913    
914  (defvar *sldb-stack-top*)  ;;; Notice that SB-EXT:*INVOKE-DEBUGGER-HOOK* is slightly stronger
915    ;;; than just a hook into BREAK. In particular, it'll make
916    ;;; (LET ((*DEBUGGER-HOOK* NIL)) ..error..) drop into SLDB rather
917    ;;; than the native debugger. That should probably be considered a
918    ;;; feature.
919    
920  (defun make-invoke-debugger-hook (hook)  (defun make-invoke-debugger-hook (hook)
921    #'(lambda (condition old-hook)    #'(sb-int:named-lambda swank-invoke-debugger-hook
922        ;; Notice that *INVOKE-DEBUGGER-HOOK* is tried before          (condition old-hook)
       ;; *DEBUGGER-HOOK*, so we have to make sure that the latter gets  
       ;; run when it was established locally by a user (i.e. changed meanwhile.)  
923        (if *debugger-hook*        (if *debugger-hook*
924            (funcall *debugger-hook* condition old-hook)            nil           ; decline, *DEBUGGER-HOOK* will be tried next.
925            (funcall hook condition old-hook))))            (funcall hook condition old-hook))))
926    
927    (defun set-break-hook (hook)
928      (setq sb-ext:*invoke-debugger-hook* (make-invoke-debugger-hook hook)))
929    
930    (defun call-with-break-hook (hook continuation)
931      (let ((sb-ext:*invoke-debugger-hook* (make-invoke-debugger-hook hook)))
932        (funcall continuation)))
933    
934  (defimplementation install-debugger-globally (function)  (defimplementation install-debugger-globally (function)
935    (setq *debugger-hook* function)    (setq *debugger-hook* function)
936    (setq sb-ext:*invoke-debugger-hook* (make-invoke-debugger-hook function)))    (set-break-hook function))
937    
938  (defimplementation condition-extras (condition)  (defimplementation condition-extras (condition)
939    (cond #+#.(swank-backend::sbcl-with-new-stepper-p)    (cond #+#.(swank-backend::sbcl-with-new-stepper-p)
# Line 946  Return a list of the form (NAME LOCATION Line 955  Return a list of the form (NAME LOCATION
955              ref)              ref)
956             (t (symbol-name ref))))))             (t (symbol-name ref))))))
957    
958    (defvar *sldb-stack-top*)
959    
960  (defimplementation call-with-debugging-environment (debugger-loop-fn)  (defimplementation call-with-debugging-environment (debugger-loop-fn)
961    (declare (type function debugger-loop-fn))    (declare (type function debugger-loop-fn))
962    (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 972  Return a list of the form (NAME LOCATION Line 983  Return a list of the form (NAME LOCATION
983      (invoke-restart 'sb-ext:step-out)))      (invoke-restart 'sb-ext:step-out)))
984    
985  (defimplementation call-with-debugger-hook (hook fun)  (defimplementation call-with-debugger-hook (hook fun)
986    (let ((*debugger-hook* hook)    (let (#+#.(swank-backend::sbcl-with-new-stepper-p)
         (sb-ext:*invoke-debugger-hook* (and hook (make-invoke-debugger-hook hook)))  
         #+#.(swank-backend::sbcl-with-new-stepper-p)  
987          (sb-ext:*stepper-hook*          (sb-ext:*stepper-hook*
988           (lambda (condition)           (lambda (condition)
989             (typecase condition             (typecase condition
# Line 983  Return a list of the form (NAME LOCATION Line 992  Return a list of the form (NAME LOCATION
992                  (sb-impl::invoke-debugger condition)))))))                  (sb-impl::invoke-debugger condition)))))))
993      (handler-bind (#+#.(swank-backend::sbcl-with-new-stepper-p)      (handler-bind (#+#.(swank-backend::sbcl-with-new-stepper-p)
994                     (sb-ext:step-condition #'sb-impl::invoke-stepper))                     (sb-ext:step-condition #'sb-impl::invoke-stepper))
995        (funcall fun))))        (call-with-break-hook hook fun))))
996    
997  (defun nth-frame (index)  (defun nth-frame (index)
998    (do ((frame *sldb-stack-top* (sb-di:frame-down frame))    (do ((frame *sldb-stack-top* (sb-di:frame-down frame))

Legend:
Removed from v.1.256  
changed lines
  Added in v.1.257

  ViewVC Help
Powered by ViewVC 1.1.5