0.7.9.1:
[sbcl.git] / src / code / toplevel.lisp
index 1348ad7..9cc5f67 100644 (file)
@@ -65,7 +65,8 @@
      (/show0 "back from INFINITE-ERROR-PROTECTOR")
      (let ((*current-error-depth* (1+ *current-error-depth*)))
        (/show0 "in INFINITE-ERROR-PROTECT, incremented error depth")
-       #+sb-show (sb-debug:backtrace)
+       ;; arbitrary truncation
+       #!+sb-show (sb!debug:backtrace 8)
        ,@forms)))
 
 ;;; a helper function for INFINITE-ERROR-PROTECT
                    (type (unsigned-byte 20) count)
                    (values (unsigned-byte 20)))
           (let ((loc (int-sap (- (sap-int ptr) (+ offset sb!vm:n-word-bytes)))))
-            (cond ((<= (sap-int loc) end-of-stack) 0)
+            (cond ((< (sap-int loc) end-of-stack) 0)
                   ((= offset bytes-per-scrub-unit)
                    (look (int-sap (- (sap-int ptr) bytes-per-scrub-unit))
                          0 count))
                    (type (unsigned-byte 20) count)
                    (values (unsigned-byte 20)))
           (let ((loc (int-sap (- (sap-int ptr) offset))))
-            (cond ((<= (sap-int loc) end-of-stack) 0)
+            (cond ((< (sap-int loc) end-of-stack) 0)
                   ((= offset bytes-per-scrub-unit)
                    count)
                   ((zerop (sb!kernel::get-lisp-obj-address (stack-ref loc 0)))
        ;; get you out to here.
        (with-simple-restart
           (abort
-           "Reduce debugger level (leaving debugger, returning to toplevel).")
+           "~@<Reduce debugger level (leaving debugger, returning to toplevel).~@:>")
         (catch 'toplevel-catcher
           #!-sunos (sb!unix:unix-sigsetmask 0) ; FIXME: What is this for?
           ;; in the event of a control-stack-exhausted-error, we should