X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fcold-error.lisp;h=e4e094c95bf9d21bb4a1e160d8585017b1c47a2f;hb=9c3a9502bc872f024c365412d991ef43fd866e4c;hp=966d1893b91c91b01c505cb374b9cf55f44ccb39;hpb=6e60dc9f79037ab84f5bfd8568979c24291c9922;p=sbcl.git

diff --git a/src/code/cold-error.lisp b/src/code/cold-error.lisp
index 966d189..e4e094c 100644
--- a/src/code/cold-error.lisp
+++ b/src/code/cold-error.lisp
@@ -16,18 +16,8 @@
   "When (TYPEP condition *BREAK-ON-SIGNALS*) is true, then calls to SIGNAL will
    enter the debugger prior to signalling that condition.")
 
-(defun signal (datum &rest arguments)
-  #!+sb-doc
-  "Invokes the signal facility on a condition formed from DATUM and
-   ARGUMENTS. If the condition is not handled, NIL is returned. If
-   (TYPEP condition *BREAK-ON-SIGNALS*) is true, the debugger is invoked
-   before any signalling is done."
-  (let ((condition (coerce-to-condition datum
-                                        arguments
-                                        'simple-condition
-                                        'signal))
-        (*handler-clusters* *handler-clusters*)
-        (old-bos *break-on-signals*)
+(defun maybe-break-on-signal (condition)
+  (let ((old-bos *break-on-signals*)
         (bos-actually-breaking nil))
     (restart-case
         (let ((break-on-signals *break-on-signals*)
@@ -54,30 +44,45 @@
         (lambda (stream)
           (format stream
                   (if bos-actually-breaking
-                    "Return from BREAK and assign a new value to ~
-                     *BREAK-ON-SIGNALS*."
-                    "Assign a new value to *BREAK-ON-SIGNALS* and ~
-                     continue with signal handling.")))
+                      "Return from BREAK and assign a new value to ~
+                       *BREAK-ON-SIGNALS*."
+                      "Assign a new value to *BREAK-ON-SIGNALS* and ~
+                       continue with signal handling.")))
         :interactive
         (lambda ()
           (let (new-value)
             (loop
-             (format *query-io*
-                     "Enter new value for *BREAK-ON-SIGNALS*. ~
-                      Current value is ~S.~%~
-                      > "
-                     old-bos)
-             (force-output *query-io*)
-             (let ((*break-on-signals* nil))
-               (setf new-value (eval (read *query-io*)))
-               (if (typep new-value 'type-specifier)
-                   (return)
-                   (format *query-io*
-                           "~S is not a valid value for *BREAK-ON-SIGNALS* ~
-                            (must be a type-specifier).~%"
-                           new-value))))
+              (format *query-io*
+                      "Enter new value for *BREAK-ON-SIGNALS*. ~
+                       Current value is ~S.~%~
+                       > "
+                      old-bos)
+              (force-output *query-io*)
+              (let ((*break-on-signals* nil))
+                (setf new-value (eval (read *query-io*)))
+                (if (typep new-value 'type-specifier)
+                    (return)
+                    (format *query-io*
+                            "~S is not a valid value for *BREAK-ON-SIGNALS* ~
+                             (must be a type-specifier).~%"
+                            new-value))))
             (list new-value)))
-        (setf *break-on-signals* new-value)))
+        (setf *break-on-signals* new-value)))))
+
+(defun signal (datum &rest arguments)
+  #!+sb-doc
+  "Invokes the signal facility on a condition formed from DATUM and
+   ARGUMENTS. If the condition is not handled, NIL is returned. If
+   (TYPEP condition *BREAK-ON-SIGNALS*) is true, the debugger is invoked
+   before any signalling is done."
+  (let ((condition (coerce-to-condition datum
+                                        arguments
+                                        'simple-condition
+                                        'signal))
+        (*handler-clusters* *handler-clusters*)
+        (sb!debug:*stack-top-hint* (or sb!debug:*stack-top-hint* 'signal)))
+    (when *break-on-signals*
+      (maybe-break-on-signal condition))
     (loop
       (unless *handler-clusters*
         (return))
@@ -140,7 +145,6 @@
   #!+sb-doc
   "Print a message and invoke the debugger without allowing any possibility
 of condition handling occurring."
-  (declare (optimize (sb!c::rest-conversion 0)))
   (let ((*debugger-hook* nil) ; as specifically required by ANSI
         (sb!debug:*stack-top-hint* (or sb!debug:*stack-top-hint* 'break)))
     (apply #'%break 'break datum arguments)))