From 0a9902d83ed855c9c858c2273c125bc224a68afc Mon Sep 17 00:00:00 2001 From: haskal Date: Thu, 14 Jan 2021 02:30:43 -0500 Subject: [PATCH] fix busyloop bug in agent --- crossfire/agent.rkt | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/crossfire/agent.rkt b/crossfire/agent.rkt index 3f7b9ed..af52f59 100644 --- a/crossfire/agent.rkt +++ b/crossfire/agent.rkt @@ -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)