Switch to guile-fibers@1.1

I think the main change required is just to stop accessing the now missing
current-fiber parameter.
This commit is contained in:
Christopher Baines 2022-02-09 17:20:54 +00:00
parent 8ed53099ba
commit 4a1088c216
2 changed files with 33 additions and 34 deletions

View File

@ -54,39 +54,38 @@
(define* (make-thread-pool-channel #:key (threads 8)) (define* (make-thread-pool-channel #:key (threads 8))
(parameterize (((@@ (fibers internal) current-fiber) #f)) (let ((channel (make-channel)))
(let ((channel (make-channel))) (for-each
(for-each (lambda _
(lambda _ (call-with-new-thread
(call-with-new-thread (lambda ()
(lambda () (let loop ()
(let loop () (match (get-message channel)
(match (get-message channel) (((? channel? reply) . (? procedure? proc))
(((? channel? reply) . (? procedure? proc)) (put-message
(put-message reply
reply (with-exception-handler
(with-exception-handler (lambda (exn)
(lambda (exn) (cons 'worker-thread-error exn))
(cons 'worker-thread-error exn)) (lambda ()
(lambda () (with-exception-handler
(with-exception-handler (lambda (exn)
(lambda (exn) (simple-format
(simple-format (current-error-port)
(current-error-port) "worker thread: exception: ~A\n"
"worker thread: exception: ~A\n" exn)
exn) (backtrace)
(backtrace) (raise-exception exn))
(raise-exception exn)) (lambda ()
(lambda () (call-with-values
(call-with-values proc
proc (lambda vals
(lambda vals vals)))))
vals))))) #:unwind? #t))
#:unwind? #t)) (loop))
(loop)) (_ #f))))))
(_ #f)))))) (iota threads))
(iota threads)) channel))
channel)))
(define %thread-pool-mutex (make-mutex)) (define %thread-pool-mutex (make-mutex))
(define %thread-pool-channel #f) (define %thread-pool-channel #f)

View File

@ -51,7 +51,7 @@
("guile-email" ,guile-email) ("guile-email" ,guile-email)
("guile-json" ,guile-json-4) ("guile-json" ,guile-json-4)
("guile-squee" ,guile-squee) ("guile-squee" ,guile-squee)
("guile-fibers" ,guile-fibers) ("guile-fibers" ,guile-fibers-1.1)
("guile-gcrypt" ,guile-gcrypt) ("guile-gcrypt" ,guile-gcrypt)
("guile-lzlib" ,guile-lzlib) ("guile-lzlib" ,guile-lzlib)
("guile-readline" ,guile-readline) ("guile-readline" ,guile-readline)