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

Diff of /slime/swank-ccl.lisp

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

revision 1.17 by heller, Fri Mar 5 17:45:26 2010 UTC revision 1.18 by heller, Fri Mar 5 17:45:34 2010 UTC
# Line 300  Line 300 
300    
301  ;;; Debugging  ;;; Debugging
302    
 (defun openmcl-set-debug-switches ()  
   (setq ccl:*fasl-save-definitions* nil)  
   (setq ccl:*fasl-save-doc-strings* t)  
   (setq ccl:*fasl-save-local-symbols* t)  
   (setq ccl:*save-arglist-info* t)  
   (setq ccl:*save-definitions* nil)  
   (setq ccl:*save-doc-strings* t)  
   (setq ccl:*save-local-symbols* t)  
   (ccl:start-xref))  
   
303  (defimplementation call-with-debugging-environment (debugger-loop-fn)  (defimplementation call-with-debugging-environment (debugger-loop-fn)
304    (let* (;;(*debugger-hook* nil)    (let* (;;(*debugger-hook* nil)
305           ;; don't let error while printing error take us down           ;; don't let error while printing error take us down
# Line 320  Line 310 
310  ;; thread not selected by the user, so don't use thread-local vars  ;; thread not selected by the user, so don't use thread-local vars
311  ;; such as *emacs-connection*.  ;; such as *emacs-connection*.
312  (defun find-repl-thread ()  (defun find-repl-thread ()
313    (let* ((conn (funcall (swank-sym default-connection))))    (let* ((*break-on-signals* nil)
314             (conn (funcall (swank-sym default-connection))))
315      (and conn      (and conn
316           (let ((*break-on-signals* nil))           (ignore-errors ;; this errors if no repl-thread
317             (ignore-errors ;; this errors if no repl-thread             (funcall (swank-sym repl-thread) conn)))))
318               (funcall (swank-sym repl-thread) conn))))))  
   
319  (defimplementation call-with-debugger-hook (hook fun)  (defimplementation call-with-debugger-hook (hook fun)
320    (let ((*debugger-hook* hook)    (let ((*debugger-hook* hook)
321          (ccl:*break-hook* hook)          (ccl:*break-hook* hook)
# Line 347  Line 337 
337      (ccl:map-call-frames function      (ccl:map-call-frames function
338                           :origin ccl:*top-error-frame*                           :origin ccl:*top-error-frame*
339                           :start-frame-number start-frame-number                           :start-frame-number start-frame-number
340                           :count (- end-frame-number start-frame-number)                           :count (- end-frame-number start-frame-number))))
                          :test (and (not t) ;(not (symbol-value (swank-sym *sldb-show-internal-frames*)))  
                                     'interesting-frame-p))))  
   
 ;; Exceptions  
 (defvar *interesting-internal-frames* ())  
   
 (defun interesting-frame-p (p context)  
   ;; A frame is interesting if it has at least one external symbol in its name.  
   (labels ((internal (obj)  
              ;; For a symbol, return true if the symbol is internal, i.e. not  
              ;; declared to be external.  For a cons or list, everything  
              ;; must be internal.  For a method, the name must be internal.  
              ;; Nothing else is internal.  
              (typecase obj  
                (cons (and (internal (car obj)) (internal (cdr obj))))  
                (symbol (and (eq (symbol-package obj) (find-package :ccl))  
                             (eq :internal (nth-value 1 (find-symbol (symbol-name obj) :ccl)))  
                             (not (member obj *interesting-internal-frames*))))  
                (method (internal (ccl:method-name obj)))  
                (t nil))))  
     (let* ((lfun (ccl:frame-function p context))  
            (internal-frame-p (internal (ccl:function-name lfun))))  
       #+debug (format t "~S is ~@[not ~]internal~%"  
                       (ccl:function-name lfun)  
                       (not internal-frame-p))  
       (not internal-frame-p))))  
   
341    
342  (defimplementation compute-backtrace (start-frame-number end-frame-number)  (defimplementation compute-backtrace (start-frame-number end-frame-number)
343    (let (result)    (let (result)

Legend:
Removed from v.1.17  
changed lines
  Added in v.1.18

  ViewVC Help
Powered by ViewVC 1.1.5