:datum object
:expected-type '(unsigned-byte 32)))
+(deferr tls-exhausted-error ()
+ ;; There is nothing we can do about it. A number of entries in the
+ ;; tls could be reserved and made available for recovery but since
+ ;; tls indices are never reused it would be kind of silly and
+ ;; without it signalling an error is more than likely to end in a
+ ;; recursive error.
+ (%primitive print "Thread local storage exhausted.")
+ (sb!impl::%halt))
+
(macrolet
((define-simple-array-internal-errors ()
`(progn
nil)))))
\f
-;;; Special variable to store away the signal context passed to
-;;; internal error. internal-error stores the context for use by
-;;; sb-di:top-frame to figure out what the frame pointer and pc were
-;;; when the error was signalled. This is done since on some platforms
-;;; we have problems tracing through signal handler frames.
-(defparameter *internal-error-context* nil)
-
;;;; INTERNAL-ERROR signal handler
(defun internal-error (context continuable)
(declare (type system-area-pointer context))
(declare (ignore continuable))
- (let ((*internal-error-context* context))
- (/show0 "entering INTERNAL-ERROR, CONTEXT=..")
- (/hexstr context)
- (infinite-error-protect
- (/show0 "about to bind ALIEN-CONTEXT")
- (let ((alien-context (locally
- (declare (optimize (inhibit-warnings 3)))
- (sb!alien:sap-alien context (* os-context-t)))))
- (/show0 "about to bind ERROR-NUMBER and ARGUMENTS")
- (multiple-value-bind (error-number arguments)
- (sb!vm:internal-error-args alien-context)
-
- ;; There's a limit to how much error reporting we can usefully
- ;; do before initialization is complete, but try to be a little
- ;; bit helpful before we die.
- (/show0 "back from INTERNAL-ERROR-ARGS, ERROR-NUMBER=..")
- (/hexstr error-number)
- (/show0 "cold/low ARGUMENTS=..")
- (/hexstr arguments)
- (unless *cold-init-complete-p*
- (%primitive print "can't recover from error in cold init, halting")
- (%primitive sb!c:halt))
-
+ (/show0 "entering INTERNAL-ERROR, CONTEXT=..")
+ (/hexstr context)
+ (infinite-error-protect
+ (/show0 "about to bind ALIEN-CONTEXT")
+ (let ((alien-context (locally
+ (declare (optimize (inhibit-warnings 3)))
+ (sb!alien:sap-alien context (* os-context-t)))))
+ (/show0 "about to bind ERROR-NUMBER and ARGUMENTS")
+ (multiple-value-bind (error-number arguments)
+ (sb!vm:internal-error-args alien-context)
+
+ ;; There's a limit to how much error reporting we can usefully
+ ;; do before initialization is complete, but try to be a little
+ ;; bit helpful before we die.
+ (/show0 "back from INTERNAL-ERROR-ARGS, ERROR-NUMBER=..")
+ (/hexstr error-number)
+ (/show0 "cold/low ARGUMENTS=..")
+ (/hexstr arguments)
+ (unless *cold-init-complete-p*
+ (%primitive print "can't recover from error in cold init, halting")
+ (%primitive sb!c:halt))
+
+ (with-interrupt-bindings
(multiple-value-bind (name sb!debug:*stack-top-hint*)
(find-interrupted-name-and-frame)
(/show0 "back from FIND-INTERRUPTED-NAME")
+ ;; Unblock trap signal here, we unwound the stack and can't return.
+ ;; FIXME: Should we not reset the _entire_ mask, but just
+ ;; restore it to the state before we got the condition?
+ ;; FIXME 2: Signals are currently unblocked in
+ ;; interrupt.c:internal_error before we do stack unwinding, can this
+ ;; introduce a race condition?
+ #!+(and linux mips)
+ (sb!unix::reset-signal-mask)
(let ((fp (int-sap (sb!vm:context-register alien-context
sb!vm::cfp-offset)))
(handler (and (< -1 error-number (length *internal-errors*))
(error 'control-stack-exhausted))))
;;; KLUDGE: we keep a single HEAP-EXHAUSTED-ERROR object around, so
-;;; that we don't need to allocate it when running out of memory. Similarly
-;;; we pass the amounts in special variables as there may be multiple threads
-;;; running into trouble at the same time. The condition is created by GC-REINIT.
+;;; that we don't need to allocate it when running out of
+;;; memory. Similarly we pass the amounts in special variables as
+;;; there may be multiple threads running into trouble at the same
+;;; time. The condition is created by GC-REINIT.
(defvar *heap-exhausted-error-condition*)
(defvar *heap-exhausted-error-available-bytes*)
(defvar *heap-exhausted-error-requested-bytes*)
;;; This is SIGTRAP / EXCEPTION_BREAKPOINT that runtime could not deal
;;; with. Prior to Windows we just had a Lisp side handler for
-;;; SIGTRAP, but now we need to deal this portably.
+;;; SIGTRAP, but now we need to deal with this portably.
(defun unhandled-trap-error (context-sap)
(declare (type system-area-pointer context-sap))
(infinite-error-protect
(let ((context (sap-alien context-sap (* os-context-t))))
- (error "Unhandled breakpoint/trap at #x~X."
- (sap-int (sb!vm:context-pc context))))))
+ (error 'breakpoint-error
+ :context context
+ :address (sap-int (sb!vm:context-pc context))))))
projects / sbcl.git / blobdiff