0.9.2.37:

[sbcl.git] / src / code / debug.lisp

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index b20dc7e..f7acf9a 100644 (file)
--- a/src/code/debug.lisp
+++ b/src/code/debug.lisp
@@ -270,29 +270,44 @@ is how many frames to show."
 (legal-fun-name-p '(lambda ()))
 (defvar *show-entry-point-details* nil)
 
+(defun clean-xep (name args)
+  (values (second name)
+         (if (consp args)
+             (let ((count (first args))
+                   (real-args (rest args)))
+               (if (fixnump count)
+                   (subseq real-args 0 
+                           (min count (length real-args)))
+                   real-args))
+             args)))
+
+(defun clean-&more-processor (name args)
+  (values (second name)
+         (if (consp args)
+             (let* ((more (last args 2))
+                    (context (first more))
+                    (count (second more)))             
+               (append
+                (butlast args 2)
+                (if (fixnump count)
+                    (multiple-value-list 
+                     (sb!c:%more-arg-values context 0 count))
+                    (list
+                     (make-unprintable-object "more unavailable arguments")))))
+             args)))
+
 (defun frame-call (frame)
   (labels ((clean-name-and-args (name args)
              (if (and (consp name) (not *show-entry-point-details*))
+                ;; FIXME: do we need to deal with
+                ;; HAIRY-FUNCTION-ENTRY here? I can't make it or
+                ;; &AUX-BINDINGS appear in backtraces, so they are
+                ;; left alone for now. --NS 2005-02-28
                  (case (first name)
                    ((sb!c::xep sb!c::tl-xep)
-                    (clean-name-and-args 
-                     (second name)
-                     (let ((count (first args))
-                           (real-args (rest args)))
-                       (subseq real-args 0 (min count (length real-args))))))
+                   (clean-xep name args))
                    ((sb!c::&more-processor)
-                    (clean-name-and-args
-                     (second name)
-                     (let* ((more (last args 2))
-                            (context (first more))
-                            (count (second more)))
-                       (append (butlast args 2)
-                               (multiple-value-list 
-                                (sb!c:%more-arg-values context 0 count))))))
-                   ;; FIXME: do we need to deal with
-                   ;; HAIRY-FUNCTION-ENTRY here? I can't make it or
-                   ;; &AUX-BINDINGS appear in backtraces, so they are
-                   ;; left alone for now. --NS 2005-02-28
+                   (clean-&more-processor name args))
                    ((sb!c::hairy-arg-processor 
                      sb!c::varargs-entry sb!c::&optional-processor)
                     (clean-name-and-args (second name) args))
@@ -363,7 +378,7 @@ is how many frames to show."
        (sb!di:debug-condition (ignore) 
           ignore)
        (error (c) 
-          (format stream "error finding source: ~A" c))))))
+          (format stream "~&error finding source: ~A" c))))))
 \f
 ;;;; INVOKE-DEBUGGER
 
@@ -512,10 +527,11 @@ reset to ~S."
        ;; expect to see error messages logged there, regardless of what
        ;; the debugger does afterwards.)
        (format *error-output*
-               "~2&~@<debugger invoked on a ~S in thread ~A: ~
+               "~2&~@<debugger invoked on a ~S~@[ in thread ~A~]: ~
                     ~2I~_~A~:>~%"
                (type-of *debug-condition*)
-               (sb!thread:current-thread-id)
+                #!+sb-thread sb!thread:*current-thread*
+                #!-sb-thread nil
                *debug-condition*)
       (error (condition)
        (setf *nested-debug-condition* condition)
@@ -589,9 +605,10 @@ reset to ~S."
     (handler-case
        (progn
          (format *error-output*
-                 "~&~@<unhandled ~S in thread ~S: ~2I~_~A~:>~2%"
+                 "~&~@<unhandled ~S~@[ in thread ~S~]: ~2I~_~A~:>~2%"
                  (type-of condition)
-                 (sb!thread:current-thread-id)
+                  #!+sb-thread sb!thread:*current-thread*
+                  #!-sb-thread nil
                  condition)
          ;; Flush *ERROR-OUTPUT* even before the BACKTRACE, so that
          ;; even if we hit an error within BACKTRACE (e.g. a bug in
@@ -638,7 +655,8 @@ reset to ~S."
 
 (defun enable-debugger ()
   (when (eql *invoke-debugger-hook* 'debugger-disabled-hook)
-    (setf *invoke-debugger-hook* nil)))
+    (setf *debug-io* *query-io*
+          *invoke-debugger-hook* nil)))
 
 (setf *debug-io* *query-io*)