haskal
/
crossfire
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fix busyloop bug in agent

This commit is contained in:
xenia 2021-01-14 02:30:43 -05:00
parent d41d8ee246
commit 0a9902d83e
1 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
crossfire/agent.rkt
View File

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