54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
+
+
-
-
+
+
|
;; (old-exit code)))
(define (stop-the-train)
(thread-start! (make-thread (lambda ()
(let loop ()
(if (and *toppath*
(file-exists? (conc *toppath*"/stop-the-train")))
(let* ((msg (conc "ERROR: found file "*toppath*"/stop-the-train, exiting immediately")))
;; yes, print to current-output-port AND *default-log-port*, annoying but necessary I think
(begin
(debug:print 0 *default-log-port* "ERROR: found file "*toppath*"/stop-the-train, exiting immediately")
(print msg)
(debug:print 0 *default-log-port* msg)
(exit 1)))
(thread-sleep! 5)
(loop))))))
;; execute thunk, return value. If exception thrown, trap exception, return #f, and emit nonfatal condition note to *default-log-port* .
;; arguments - thunk, message
(define (common:fail-safe thunk warning-message-on-exception)
|