1 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; This software is derived from the CMU CL system, which was
5 ;;;; written at Carnegie Mellon University and released into the
6 ;;;; public domain. The software is in the public domain and is
7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
8 ;;;; files for more information.
10 (in-package "SB!IMPL")
15 ;;; These specials are used by ERROR-ERROR to track the success of recovery
17 (defvar *error-error-depth* 0)
18 (defvar *error-throw-up-count* 0)
20 ;;; ERROR-ERROR can be called when the error system is in trouble and needs to
21 ;;; punt fast. It prints a message without using FORMAT. If we get into this
22 ;;; recursively, then we halt.
23 (defun error-error (&rest messages)
24 (let ((*error-error-depth* (1+ *error-error-depth*)))
25 (when (> *error-throw-up-count* 50)
26 (%primitive sb!c:halt)
27 (throw 'sb!impl::top-level-catcher nil))
28 (case *error-error-depth*
31 (stream-cold-init-or-reset))
33 (incf *error-throw-up-count*)
34 (throw 'sb!impl::top-level-catcher nil))
36 (%primitive sb!c:halt)
37 (throw 'sb!impl::top-level-catcher nil)))
39 (with-standard-io-syntax
40 (let ((*print-readably* nil))
41 (dolist (item messages)
42 (princ item *terminal-io*))
43 (sb!debug:internal-debug)))))