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

Handle %stacks not being a pair

Browse source 
Not sure when this would happen, but guard against it.
This commit is contained in:
Christopher Baines 2025-05-15 09:25:30 +01:00
parent 8c63ed7b4e
commit 7ba77010ae
4 changed files with 53 additions and 38 deletions
Download patch file Download diff file Expand all files Collapse all files

13
knots.scm
View file

@ -67,11 +67,14 @@
(define* (print-backtrace-and-exception/knots (define* (print-backtrace-and-exception/knots
exn exn
#:key (port (current-error-port))) #:key (port (current-error-port)))
(let* ((stack (match (fluid-ref %stacks) (let* ((stack
((stack-tag . prompt-tag) (match (fluid-ref %stacks)
(make-stack #t ((stack-tag . prompt-tag)
0 prompt-tag (make-stack #t
0 (and prompt-tag 1))))) 0 prompt-tag
0 (and prompt-tag 1)))
(_
(make-stack #t))))
(error-string (error-string
(call-with-output-string (call-with-output-string
(lambda (port) (lambda (port)

42
knots/parallelism.scm
View file

@ -52,15 +52,18 @@
(lambda () (lambda ()
(with-exception-handler (with-exception-handler
(lambda (exn) (lambda (exn)
(match (fluid-ref %stacks) (let ((stack
((stack-tag . prompt-tag) (match (fluid-ref %stacks)
(let ((stack (make-stack #t ((stack-tag . prompt-tag)
0 prompt-tag (make-stack #t
0 (and prompt-tag 1)))) 0 prompt-tag
(raise-exception 0 (and prompt-tag 1)))
(make-exception (_
exn (make-stack #t)))))
(make-knots-exception stack))))))) (raise-exception
(make-exception
exn
(make-knots-exception stack)))))
(lambda () (lambda ()
(call-with-values (call-with-values
(lambda () (lambda ()
@ -255,15 +258,18 @@
(lambda () (lambda ()
(with-exception-handler (with-exception-handler
(lambda (exn) (lambda (exn)
(match (fluid-ref %stacks) (let ((stack
((stack-tag . prompt-tag) (match (fluid-ref %stacks)
(let ((stack (make-stack #t ((stack-tag . prompt-tag)
0 prompt-tag (make-stack #t
0 (and prompt-tag 1)))) 0 prompt-tag
(raise-exception 0 (and prompt-tag 1)))
(make-exception (_
exn (make-stack #t)))))
(make-knots-exception stack))))))) (raise-exception
(make-exception
exn
(make-knots-exception stack)))))
(lambda () (lambda ()
(call-with-values (call-with-values
(lambda () (lambda ()

15
knots/resource-pool.scm
View file

@ -923,15 +923,18 @@ available. Return the resource once PROC has returned."
(lambda () (lambda ()
(with-exception-handler (with-exception-handler
(lambda (exn) (lambda (exn)
(match (fluid-ref %stacks) (let ((stack
((stack-tag . prompt-tag) (match (fluid-ref %stacks)
(let ((stack (make-stack #t ((stack-tag . prompt-tag)
0 prompt-tag (make-stack #t
0 (and prompt-tag 1)))) 0 prompt-tag
0 (and prompt-tag 1)))
(_
(make-stack #t)))))
(raise-exception (raise-exception
(make-exception (make-exception
exn exn
(make-knots-exception stack))))))) (make-knots-exception stack)))))
(lambda () (lambda ()
(proc resource)))) (proc resource))))
#:unwind? #t)) #:unwind? #t))

21
knots/thread-pool.scm
View file

@ -251,15 +251,18 @@ arguments of the thread pool procedure."
proc) proc)
(with-exception-handler (with-exception-handler
(lambda (exn) (lambda (exn)
(match (fluid-ref %stacks) (let ((stack
((stack-tag . prompt-tag) (match (fluid-ref %stacks)
(let ((stack (make-stack #t ((stack-tag . prompt-tag)
0 prompt-tag (make-stack #t
0 (and prompt-tag 1)))) 0 prompt-tag
(raise-exception 0 (and prompt-tag 1)))
(make-exception (_
exn (make-stack #t)))))
(make-knots-exception stack))))))) (raise-exception
(make-exception
exn
(make-knots-exception stack)))))
(lambda () (lambda ()
(call-with-values (call-with-values
(lambda () (lambda ()