More conservative process-reaper: don't reap if actions for the process are queued
This commit is contained in:
parent
1143bde46c
commit
ad8a31f703
14
os2.rkt
14
os2.rkt
|
@ -221,7 +221,7 @@
|
||||||
(state (struct-copy vm state [pending-actions '()]))
|
(state (struct-copy vm state [pending-actions '()]))
|
||||||
(outbound-actions '()))
|
(outbound-actions '()))
|
||||||
(match remaining-actions
|
(match remaining-actions
|
||||||
['() (transition state (reverse outbound-actions))]
|
['() (transition (collect-dead-processes state) (reverse outbound-actions))]
|
||||||
[(cons (cons pid action) rest)
|
[(cons (cons pid action) rest)
|
||||||
(match action
|
(match action
|
||||||
[(at-meta-level preaction)
|
[(at-meta-level preaction)
|
||||||
|
@ -230,6 +230,14 @@
|
||||||
[preaction
|
[preaction
|
||||||
(loop rest (perform-action pid preaction state) outbound-actions)])])))
|
(loop rest (perform-action pid preaction state) outbound-actions)])])))
|
||||||
|
|
||||||
|
(define (collect-dead-processes state)
|
||||||
|
(struct-copy vm state
|
||||||
|
[processes (for/hash ([(pid p) (in-hash (vm-processes state))]
|
||||||
|
#:when (or (not (set-empty? (process-endpoints p)))
|
||||||
|
(ormap (lambda (entry) (= (car entry) pid))
|
||||||
|
(vm-pending-actions state))))
|
||||||
|
(values pid p))]))
|
||||||
|
|
||||||
(define (send-to-user failure-proc f . args)
|
(define (send-to-user failure-proc f . args)
|
||||||
(with-handlers ([exn:fail? failure-proc])
|
(with-handlers ([exn:fail? failure-proc])
|
||||||
(apply f args)))
|
(apply f args)))
|
||||||
|
@ -293,9 +301,7 @@
|
||||||
[endpoints (set-remove (process-endpoints old-process) eid)]))
|
[endpoints (set-remove (process-endpoints old-process) eid)]))
|
||||||
(let ((state (struct-copy vm state
|
(let ((state (struct-copy vm state
|
||||||
[endpoints (hash-remove (vm-endpoints state) eid)]
|
[endpoints (hash-remove (vm-endpoints state) eid)]
|
||||||
[processes (if (set-empty? (process-endpoints new-process))
|
[processes (hash-set (vm-processes state) pid new-process)])))
|
||||||
(hash-remove (vm-processes state) pid)
|
|
||||||
(hash-set (vm-processes state) pid new-process))])))
|
|
||||||
(for*/fold ([state state])
|
(for*/fold ([state state])
|
||||||
([(matching-pid p) (in-hash (vm-processes state))]
|
([(matching-pid p) (in-hash (vm-processes state))]
|
||||||
[matching-eid (in-set (process-endpoints p))]
|
[matching-eid (in-set (process-endpoints p))]
|
||||||
|
|
Loading…
Reference in New Issue