Use log-info instead of printf to permit silencing os2.rkt

This commit is contained in:
Tony Garnock-Jones 2012-05-11 15:18:23 -04:00
parent f597cfe33d
commit e925a963ff
1 changed files with 22 additions and 21 deletions

43
os2.rkt
View File

@ -305,11 +305,13 @@
(struct-copy vm state (struct-copy vm state
[processes (for/hash ([(pid p) (in-hash (vm-processes state))] [processes (for/hash ([(pid p) (in-hash (vm-processes state))]
#:when (or (process-alive? pid p) #:when (or (process-alive? pid p)
(begin (printf "~a PID ~v (~a) garbage-collected~n" (begin
(vm-name state) (log-info
pid (format "~a PID ~v (~a) garbage-collected"
(process-name p)) (vm-name state)
#f))) pid
(process-name p)))
#f)))
(values pid p))])) (values pid p))]))
(define (send-to-user failure-proc f . args) (define (send-to-user failure-proc f . args)
@ -444,29 +446,28 @@
(struct-copy vm (enqueue-actions state new-pid initial-actions) (struct-copy vm (enqueue-actions state new-pid initial-actions)
[processes (hash-set (vm-processes state) new-pid initial-process)] [processes (hash-set (vm-processes state) new-pid initial-process)]
[next-process-id (+ new-pid 1)])) [next-process-id (+ new-pid 1)]))
(printf "~a PID ~v (~a) started~n" (vm-name state) new-pid new-name) (log-info (format "~a PID ~v (~a) started" (vm-name state) new-pid new-name))
(flush-output (current-output-port))
(run-trapk spawned-state spawning-pid k new-pid)) (run-trapk spawned-state spawning-pid k new-pid))
(define (print-kill vm-name pid-to-kill process-name reason) (define (print-kill vm-name pid-to-kill process-name reason)
(cond (cond
[(eq? reason #f) (printf "~a PID ~v (~a) exited normally~n" [(eq? reason #f) (log-info (format "~a PID ~v (~a) exited normally"
vm-name vm-name
pid-to-kill pid-to-kill
process-name)] process-name))]
[(exn? reason) ((error-display-handler) [(exn? reason) (begin ((error-display-handler)
(format "~a PID ~v (~a) exited with exception~n~a" (format "~a PID ~v (~a) exited with exception~n~a"
vm-name
pid-to-kill
process-name
(exn-message reason))
reason)
(flush-output (current-output-port)))]
[else (log-info (format "~a PID ~v (~a) exited with reason: ~a"
vm-name vm-name
pid-to-kill pid-to-kill
process-name process-name
(exn-message reason)) reason))]))
reason)]
[else (printf "~a PID ~v (~a) exited with reason: ~a~n"
vm-name
pid-to-kill
process-name
reason)])
(flush-output (current-output-port)))
(define (do-kill pid-to-kill reason state) (define (do-kill pid-to-kill reason state)
(cond (cond