Check once for unix-signal support, rather than every (!) time (!)
This commit is contained in:
parent
acd9dde2b8
commit
e90c0e580e
|
@ -210,6 +210,7 @@
|
|||
(define receiver (make-log-receiver logger 'info))
|
||||
(define process-names (make-hash))
|
||||
(name-process! process-names '() 'ground) ;; by convention
|
||||
(define next-signal-evt (check-for-unix-signals-support!))
|
||||
(parameterize ((pretty-print-columns 100))
|
||||
(let loop ()
|
||||
(sync (handle-evt receiver
|
||||
|
@ -217,7 +218,6 @@
|
|||
(match-define (vector level message-string data event-name) v)
|
||||
(display-notification data process-names)
|
||||
(loop)))
|
||||
(let ((next-signal-evt (check-for-unix-signals-support!)))
|
||||
(if next-signal-evt
|
||||
(handle-evt next-signal-evt
|
||||
(lambda (_signum)
|
||||
|
@ -226,7 +226,7 @@
|
|||
(for [((pid name) (in-hash process-names))]
|
||||
(output "\t~v\t--> ~v\n" pid name)))
|
||||
(loop)))
|
||||
never-evt))))))
|
||||
never-evt)))))
|
||||
|
||||
(void (when (not (set-empty? flags))
|
||||
(thread (display-trace (install-trace-procedure!)))))
|
||||
|
|
Loading…
Reference in New Issue