mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-09 13:30:26 +02:00
Enable interrupts only when running thread body
* libguile/threads.c (really_launch): Start threads with asyncs blocked. * module/ice-9/threads.scm (call-with-new-thread): Unblock asyncs once we have the bookkeeping sorted out. Don't use with-continuation-barrier; it's not needed. Print nice thread backtraces.
This commit is contained in:
parent
78239acff6
commit
a000e5c38d
2 changed files with 29 additions and 12 deletions
|
@ -732,6 +732,9 @@ typedef struct {
|
||||||
static void *
|
static void *
|
||||||
really_launch (void *d)
|
really_launch (void *d)
|
||||||
{
|
{
|
||||||
|
scm_i_thread *t = SCM_I_CURRENT_THREAD;
|
||||||
|
/* The thread starts with asyncs blocked. */
|
||||||
|
t->block_asyncs++;
|
||||||
SCM_I_CURRENT_THREAD->result = scm_call_0 (((launch_data *)d)->thunk);
|
SCM_I_CURRENT_THREAD->result = scm_call_0 (((launch_data *)d)->thunk);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
|
@ -128,23 +128,37 @@ Once @var{thunk} or @var{handler} returns, the return value is made the
|
||||||
(lambda () (catch #t thunk handler))
|
(lambda () (catch #t thunk handler))
|
||||||
thunk))
|
thunk))
|
||||||
(thread #f))
|
(thread #f))
|
||||||
|
(define (call-with-backtrace thunk)
|
||||||
|
(let ((err (current-error-port)))
|
||||||
|
(catch #t
|
||||||
|
(lambda () (%start-stack 'thread thunk))
|
||||||
|
(lambda _ (values))
|
||||||
|
(lambda (key . args)
|
||||||
|
;; Narrow by three: the dispatch-exception,
|
||||||
|
;; this thunk, and make-stack.
|
||||||
|
(let ((stack (make-stack #t 3)))
|
||||||
|
(false-if-exception
|
||||||
|
(begin
|
||||||
|
(when stack
|
||||||
|
(display-backtrace stack err))
|
||||||
|
(let ((frame (and stack (stack-ref stack 0))))
|
||||||
|
(print-exception err frame key args)))))))))
|
||||||
(with-mutex mutex
|
(with-mutex mutex
|
||||||
(%call-with-new-thread
|
(%call-with-new-thread
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(call-with-values
|
(call-with-values
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(with-continuation-barrier
|
(call-with-prompt cancel-tag
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(call-with-prompt cancel-tag
|
(lock-mutex mutex)
|
||||||
(lambda ()
|
(set! thread (current-thread))
|
||||||
(lock-mutex mutex)
|
(set! (thread-join-data thread) (cons cv mutex))
|
||||||
(set! thread (current-thread))
|
(signal-condition-variable cv)
|
||||||
(set! (thread-join-data thread) (cons cv mutex))
|
(unlock-mutex mutex)
|
||||||
(signal-condition-variable cv)
|
(call-with-unblocked-asyncs
|
||||||
(unlock-mutex mutex)
|
(lambda () (call-with-backtrace thunk))))
|
||||||
(thunk))
|
(lambda (k . args)
|
||||||
(lambda (k . args)
|
(apply values args))))
|
||||||
(apply values args))))))
|
|
||||||
(lambda vals
|
(lambda vals
|
||||||
(lock-mutex mutex)
|
(lock-mutex mutex)
|
||||||
;; Probably now you're wondering why we are going to use
|
;; Probably now you're wondering why we are going to use
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue