cbaines/guile-knots
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Improve exception reporting in the resource pool

Browse source
This commit is contained in:
Christopher Baines 2025-02-03 10:30:16 +01:00
parent 823cd95628
commit dc98ef9dcc
1 changed files with 266 additions and 242 deletions
Download patch file Download diff file Expand all files Collapse all files

52
knots/resource-pool.scm
View file

@ -200,17 +200,7 @@
channel
(list 'return-failed-checkout resource)))))))
(spawn-fiber
(lambda ()
(when idle-seconds
(spawn-fiber
(lambda ()
(while #t
(sleep idle-seconds)
(put-message channel '(check-for-idle-resources))))))
(with-throw-handler #t
(lambda ()
(define (main-loop)
(let loop ((resources '())
(available '())
(waiters '())
@ -449,9 +439,43 @@
available
waiters
resources-last-used)))))
(lambda (key . args)
(simple-format (current-error-port)
"exception in the ~A pool fiber\n" name))))
(spawn-fiber
(lambda ()
(when idle-seconds
(spawn-fiber
(lambda ()
(while #t
(sleep idle-seconds)
(put-message channel '(check-for-idle-resources))))))
(with-exception-handler
(lambda (exn)
#f)
(lambda ()
(with-exception-handler
(lambda (exn)
(let* ((stack (make-stack #t))
(error-string
(call-with-output-string
(lambda (port)
(simple-format
port
"exception in the ~A pool fiber, " name)
(print-exception
port
(stack-ref stack 3)
'%exception
(list exn))
(display-backtrace stack port 3)))))
(display error-string
(current-error-port)))
(raise-exception exn))
(lambda ()
(start-stack
#t
(main-loop)))))
#:unwind? #t))
(or scheduler
(current-scheduler)))