mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Trim srfi-18 thread startup machinery

Browse source 
* module/srfi/srfi-18.scm (make-thread): Use just one cond/mutex pair
  for signalling in both directions: waiting for launch and waiting for
  start.
This commit is contained in:
Andy Wingo 2016-10-31 21:42:47 +01:00
parent 59fdf9cdcd
commit 6bf9c65419
1 changed files with 6 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

16
module/srfi/srfi-18.scm
View file

@ -147,17 +147,13 @@
;; exceptions wrapped in an uncaught-exception wrapper.
(define* (make-thread thunk #:optional name)
(let ((lm (make-mutex 'launch-mutex))
(lc (make-condition-variable 'launch-condition-variable))
(sm (make-mutex 'start-mutex))
(let ((sm (make-mutex 'start-mutex))
(sc (make-condition-variable 'start-condition-variable)))
(threads:lock-mutex lm)
(threads:lock-mutex sm)
(let ((t (threads:call-with-new-thread
(lambda ()
(threads:lock-mutex lm)
(threads:signal-condition-variable lc)
(threads:lock-mutex sm)
(threads:unlock-mutex lm)
(threads:signal-condition-variable sc)
(threads:wait-condition-variable sc sm)
(threads:unlock-mutex sm)
(thunk))
@ -168,10 +164,10 @@
(match (cons key args)
(('srfi-34 obj) obj)
(obj obj))))))))))
(hashq-set! thread-start-conds t (cons sm sc))
(when name (hashq-set! object-names t name))
(threads:wait-condition-variable lc lm)
(threads:unlock-mutex lm)
(threads:wait-condition-variable sc sm)
(hashq-set! thread-start-conds t (cons sm sc))
(threads:unlock-mutex sm)
t)))
(define (thread-name thread)