fix busyloop bug in agent
This commit is contained in:
parent
d41d8ee246
commit
0a9902d83e
|
@ -292,7 +292,7 @@
|
|||
(for/list ([i (in-naturals)] [wr (in-list pattern-ranges)])
|
||||
(define b (box #f))
|
||||
(cons (thread (lambda () (execute-cpu-wrap wr b))) b))))
|
||||
(let loop ()
|
||||
(let loop ([children children])
|
||||
(with-handlers ([exn? (lambda (ex)
|
||||
(log-agent-error "stopping assignment ~a due to error" aid)
|
||||
;; break all children
|
||||
|
@ -304,12 +304,12 @@
|
|||
;; reraise
|
||||
(raise ex))])
|
||||
(apply sync/enable-break (map car children))
|
||||
(define threads-running? (ormap (compose thread-running? car) children))
|
||||
(define any-exn (ormap (compose unbox cdr) children))
|
||||
(when any-exn
|
||||
(raise any-exn))
|
||||
(when threads-running?
|
||||
(loop))))
|
||||
(define-values [pending completed] (partition (compose thread-running? car) children))
|
||||
(for ([k (in-list completed)])
|
||||
(let ([maybe-exn (unbox (cdr k))])
|
||||
(when maybe-exn (raise maybe-exn))))
|
||||
(unless (empty? pending)
|
||||
(loop pending))))
|
||||
(break-enabled #t))
|
||||
|
||||
(cleanup)
|
||||
|
|
Loading…
Reference in New Issue