- (with-unique-names (caught)
- `(let ((,caught (catch '%end-of-the-world
- (/show0 "inside CATCH '%END-OF-THE-WORLD")
- (unwind-protect
- (progn ,@body)
- (call-hooks "exit" *exit-hooks*)))))
- (/show0 "back from CATCH '%END-OF-THE-WORLD, flushing output")
- (flush-standard-output-streams)
- (sb!thread::terminate-session)
- (/show0 "calling UNIX-EXIT")
- (sb!unix:unix-exit ,caught))))
+ `(without-interrupts
+ (catch '%end-of-the-world
+ (unwind-protect
+ (with-local-interrupts
+ (unwind-protect
+ (progn ,@body)
+ (call-exit-hooks)))
+ (%exit)))))
+
+(defvar *exit-lock*)
+(defvar *exit-in-process* nil)
+(declaim (type (or null real) *exit-timeout*))
+(defvar *exit-timeout* 60
+ "Default amount of seconds, if any, EXIT should wait for other
+threads to finish after terminating them. Default value is 60. NIL
+means to wait indefinitely.")
+
+(defun os-exit-handler (condition)
+ (declare (ignore condition))
+ (os-exit *exit-in-process* :abort t))
+
+(defvar *exit-error-handler* #'os-exit-handler)
+
+(defun call-exit-hooks ()
+ (unless *exit-in-process*
+ (setf *exit-in-process* 0))
+ (handler-bind ((serious-condition *exit-error-handler*))
+ (call-hooks "exit" *exit-hooks* :on-error :warn)))
+
+(defun %exit ()
+ ;; If anything goes wrong, we will exit immediately and forcibly.
+ (handler-bind ((serious-condition *exit-error-handler*))
+ (let ((ok nil)
+ (code *exit-in-process*))
+ (if (consp code)
+ ;; Another thread called EXIT, and passed the buck to us -- only
+ ;; final call left to do.
+ (os-exit (car code) :abort nil)
+ (unwind-protect
+ (progn
+ (flush-standard-output-streams)
+ (sb!thread::%exit-other-threads)
+ (setf ok t))
+ (os-exit code :abort (not ok)))))))