X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug.lisp;h=d7b9a62ac7e22745feb89754ed643960a211ef22;hb=4ba392170e98744f0ef0b8e08a5d42b988f1d0c9;hp=98594c327f4a9dec5c0d564b995959d0cf583762;hpb=810b20fa136a21e53d7f1b45286cfc25058c584e;p=sbcl.git

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index 98594c3..d7b9a62 100644
--- a/src/code/debug.lisp
+++ b/src/code/debug.lisp
@@ -152,6 +152,11 @@ Other commands:
     useful when the debugger was invoked to handle an error in
     deeply nested input syntax, and now the reader is confused.)")
 
+(defmacro with-debug-io-syntax (() &body body)
+  (let ((thunk (gensym "THUNK")))
+    `(dx-flet ((,thunk ()
+                       ,@body))
+       (funcall-with-debug-io-syntax #',thunk))))
 
 ;;; If LOC is an unknown location, then try to find the block start
 ;;; location. Used by source printing to some information instead of
@@ -264,7 +269,7 @@ is :DEBUGGER-FRAME.
 
   :INTERRUPTED-FRAME
     specifies the first interrupted frame on the stack \(typically the frame
-    where the error occured, as opposed to error handling frames) if any,
+    where the error occurred, as opposed to error handling frames) if any,
     otherwise behaving as :CURRENT-FRAME.
 
   :DEBUGGER-FRAME
@@ -328,15 +333,16 @@ METHOD-FRAME-STYLE (defaulting to *METHOD-FRAME-STYLE*), determines how frames
 corresponding to method functions are printed. Possible values
 are :MINIMAL, :NORMAL, and :FULL. See *METHOD-FRAME-STYLE* for more
 information."
-  (fresh-line stream)
-  (when print-thread
-    (format stream "Backtrace for: ~S~%" sb!thread:*current-thread*))
-  (let ((*suppress-print-errors* (if (subtypep 'serious-condition *suppress-print-errors*)
-                                     *suppress-print-errors*
-                                     'serious-condition))
-        (*print-circle* t)
-        (n start))
-    (handler-bind ((print-not-readable #'print-unreadably))
+  (with-debug-io-syntax ()
+    (fresh-line stream)
+    (when print-thread
+      (format stream "Backtrace for: ~S~%" sb!thread:*current-thread*))
+    (let ((*suppress-print-errors* (if (subtypep 'serious-condition *suppress-print-errors*)
+                                       *suppress-print-errors*
+                                       'serious-condition))
+          (*print-circle* t)
+          (n start))
+      (handler-bind ((print-not-readable #'print-unreadably))
         (map-backtrace (lambda (frame)
                          (print-frame-call frame stream
                                            :number n
@@ -346,8 +352,8 @@ information."
                        :from (backtrace-start-frame from)
                        :start start
                        :count count)))
-  (fresh-line stream)
-  (values))
+    (fresh-line stream)
+    (values)))
 
 (defun list-backtrace (&key
                        (count *backtrace-frame-count*)
@@ -829,8 +835,8 @@ the current thread are replaced with dummy objects which can safely escape."
                  (package-name *package*))
       (setf *package* (find-package :cl-user))
       (format *error-output*
-              "The value of ~S was not an undeleted PACKAGE. It has been
-reset to ~S."
+              "The value of ~S was not an undeleted PACKAGE. It has been ~
+               reset to ~S."
               '*package* *package*))
 
     ;; Before we start our own output, finish any pending output.
@@ -1169,8 +1175,8 @@ and LDB (the low-level debugger).  See also ENABLE-DEBUGGER."
 (defvar *auto-eval-in-frame* t
   #!+sb-doc
   "When set (the default), evaluations in the debugger's command loop occur
-   relative to the current frame's environment without the need of debugger
-   forms that explicitly control this kind of evaluation.")
+relative to the current frame's environment without the need of debugger
+forms that explicitly control this kind of evaluation.")
 
 (defun debug-eval (expr)
   (cond ((not (and (fboundp 'compile) *auto-eval-in-frame*))
@@ -1613,12 +1619,6 @@ and LDB (the low-level debugger).  See also ENABLE-DEBUGGER."
 
 ;;;; source location printing
 
-;;; Stuff to clean up before saving a core
-(defun debug-deinit ()
-  ;; Nothing to do right now. Once there was, maybe once there
-  ;; will be again.
-  )
-
 (defun code-location-source-form (location context &optional (errorp t))
   (let* ((start-location (maybe-block-start-location location))
          (form-num (sb!di:code-location-form-number start-location)))
@@ -1840,11 +1840,6 @@ and LDB (the low-level debugger).  See also ENABLE-DEBUGGER."
   (sb!di:debug-var-info-available
    (sb!di:code-location-debug-fun
     (sb!di:frame-code-location frame))))
-
-;; Hack: ensure that *U-T-F-F* has a tls index.
-#!+unwind-to-frame-and-call-vop
-(let ((sb!vm::*unwind-to-frame-function* (lambda ()))))
-
 
 ;;;; debug loop command utilities