syndicate-lang
/
racket-matrix-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

More conservative process-reaper: don't reap if actions for the process are queued

This commit is contained in:
Tony Garnock-Jones 2012-03-24 21:17:52 -04:00
parent 1143bde46c
commit ad8a31f703
1 changed files with 10 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
os2.rkt
View File

@ -221,7 +221,7 @@
(state (struct-copy vm state [pending-actions '()]))
(outbound-actions '()))
(match remaining-actions
['() (transition state (reverse outbound-actions))]
['() (transition (collect-dead-processes state) (reverse outbound-actions))]
[(cons (cons pid action) rest)
(match action
[(at-meta-level preaction)
@ -230,6 +230,14 @@
[preaction
(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)
(with-handlers ([exn:fail? failure-proc])
(apply f args)))
@ -293,9 +301,7 @@
[endpoints (set-remove (process-endpoints old-process) eid)]))
(let ((state (struct-copy vm state
[endpoints (hash-remove (vm-endpoints state) eid)]
[processes (if (set-empty? (process-endpoints new-process))
(hash-remove (vm-processes state) pid)
(hash-set (vm-processes state) pid new-process))])))
[processes (hash-set (vm-processes state) pid new-process)])))
(for*/fold ([state state])
([(matching-pid p) (in-hash (vm-processes state))]
[matching-eid (in-set (process-endpoints p))]