mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00
Code Activity

Move thread bindings to (ice-9 threads)

Browse source 
* libguile/init.c (scm_i_init_guile): Don't call scm_init_thread_procs.
* libguile/threads.c (scm_init_ice_9_threads): Rename from
  scm_init_thread_procs, make static.
  (scm_init_threads): Register scm_init_thread_procs extension.
* libguile/threads.h (scm_init_thread_procs): Remove decl.
* module/ice-9/boot-9.scm: Load (ice-9 threads), so that related side
  effects occur early.
* module/ice-9/deprecated.scm (define-deprecated): Fix to allow
  deprecated bindings to appear in operator position.  Export deprecated
  bindings.
  (define-deprecated/threads, define-deprecated/threads*): Trampoline
  thread bindings to (ice-9 threads).
* module/ice-9/futures.scm: Use ice-9 threads.
* module/ice-9/threads.scm: Load scm_init_ice_9_threads extension.
  Reorder definitions and imports so that the module circularity
  with (ice-9 futures) continues to work.
* module/language/cps/intmap.scm:
* module/language/cps/intset.scm:
* module/language/tree-il/primitives.scm: Use (ice-9 threads).
* module/language/cps/reify-primitives.scm: Reify current-thread
  in (ice-9 threads) module.
* module/srfi/srfi-18.scm: Use ice-9 threads with a module prefix, and
  adapt all users.  Use proper keywords in module definition form.
* test-suite/tests/filesys.test (test-suite):
* test-suite/tests/fluids.test (test-suite):
* test-suite/tests/srfi-18.test: Use ice-9 threads.
* NEWS: Add entry.
* doc/ref/api-scheduling.texi (Threads): Update.
* doc/ref/posix.texi (Processes): Move current-processor-count and
  total-processor-count docs to Threads.
This commit is contained in:
Andy Wingo 2016-10-23 20:28:48 +02:00
parent 56b490a4dd
commit d74e0fed0d
18 changed files with 328 additions and 202 deletions
Download patch file Download diff file Expand all files Collapse all files

9
NEWS
View file

@ -12,6 +12,15 @@ Changes in 2.1.5 (changes since the 2.1.4 alpha release):
* New interfaces
* Performance improvements
* Incompatible changes
** Threading facilities moved to (ice-9 threads)
It used to be that call-with-new-thread and other threading primitives
were available in the default environment. This is no longer the case;
they have been moved to (ice-9 threads) instead. Existing code will not
break, however; we used the deprecation facility to signal a warning
message while also providing these bindings in the root environment for
the duration of the 2.2 series.
* New deprecations
** Arbiters deprecated

44
doc/ref/api-scheduling.texi
View file

@ -37,6 +37,12 @@ the system's POSIX threads. For application-level parallelism, using
higher-level constructs, such as futures, is recommended
(@pxref{Futures}).
To use these facilities, load the @code{(ice-9 threads)} module.
@example
(use-modules (ice-9 threads))
@end example
@deffn {Scheme Procedure} all-threads
@deffnx {C Function} scm_all_threads ()
Return a list of all threads.
@ -142,10 +148,6 @@ Return the cleanup handler currently installed for the thread
thread-cleanup returns @code{#f}.
@end deffn
Higher level thread procedures are available by loading the
@code{(ice-9 threads)} module. These provide standardized
thread creation.
@deffn macro make-thread proc arg @dots{}
Apply @var{proc} to @var{arg} @dots{} in a new thread formed by
@code{call-with-new-thread} using a default error handler that display
@ -159,6 +161,34 @@ Evaluate forms @var{expr1} @var{expr2} @dots{} in a new thread formed by
the error to the current error port.
@end deffn
One often wants to limit the number of threads running to be
proportional to the number of available processors. These interfaces
are therefore exported by (ice-9 threads) as well.
@deffn {Scheme Procedure} total-processor-count
@deffnx {C Function} scm_total_processor_count ()
Return the total number of processors of the machine, which
is guaranteed to be at least 1. A ``processor'' here is a
thread execution unit, which can be either:
@itemize
@item an execution core in a (possibly multi-core) chip, in a
(possibly multi- chip) module, in a single computer, or
@item a thread execution unit inside a core in the case of
@dfn{hyper-threaded} CPUs.
@end itemize
Which of the two definitions is used, is unspecified.
@end deffn
@deffn {Scheme Procedure} current-processor-count
@deffnx {C Function} scm_current_processor_count ()
Like @code{total-processor-count}, but return the number of
processors available to the current process. See
@code{setaffinity} and @code{getaffinity} for more
information.
@end deffn
@node Asyncs
@subsection Asynchronous Interrupts
@ -350,6 +380,12 @@ then an endless wait will occur (in the current implementation).
Acquiring requisite mutexes in a fixed order (like always A before B)
in all threads is one way to avoid such problems.
To use these facilities, load the @code{(ice-9 threads)} module.
@example
(use-modules (ice-9 threads))
@end example
@sp 1
@deffn {Scheme Procedure} make-mutex flag @dots{}
@deffnx {C Function} scm_make_mutex ()

25
doc/ref/posix.texi
View file

@ -1976,29 +1976,8 @@ Currently this procedure is only defined on GNU variants
GNU C Library Reference Manual}).
@end deffn
@deffn {Scheme Procedure} total-processor-count
@deffnx {C Function} scm_total_processor_count ()
Return the total number of processors of the machine, which
is guaranteed to be at least 1. A ``processor'' here is a
thread execution unit, which can be either:
@itemize
@item an execution core in a (possibly multi-core) chip, in a
(possibly multi- chip) module, in a single computer, or
@item a thread execution unit inside a core in the case of
@dfn{hyper-threaded} CPUs.
@end itemize
Which of the two definitions is used, is unspecified.
@end deffn
@deffn {Scheme Procedure} current-processor-count
@deffnx {C Function} scm_current_processor_count ()
Like @code{total-processor-count}, but return the number of
processors available to the current process. See
@code{setaffinity} and @code{getaffinity} for more
information.
@end deffn
@xref{Threads}, for information on how get the number of processors
available on a system.
@node Signals

1
libguile/init.c
View file

@ -415,7 +415,6 @@ scm_i_init_guile (void *base)
scm_init_root (); /* requires continuations */
scm_init_threads (); /* requires smob_prehistory */
scm_init_gsubr ();
scm_init_thread_procs (); /* requires gsubrs */
scm_init_procprop ();
scm_init_alist ();
scm_init_async (); /* requires smob_prehistory */

16
libguile/threads.c
View file

@ -2093,6 +2093,12 @@ scm_t_bits scm_tc16_thread;
scm_t_bits scm_tc16_mutex;
scm_t_bits scm_tc16_condvar;
static void
scm_init_ice_9_threads (void *unused)
{
#include "libguile/threads.x"
}
void
scm_init_threads ()
{
@ -2111,6 +2117,10 @@ scm_init_threads ()
threads_initialized_p = 1;
dynwind_critical_section_mutex = scm_make_recursive_mutex ();
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
"scm_init_ice_9_threads",
scm_init_ice_9_threads, NULL);
}
void
@ -2120,12 +2130,6 @@ scm_init_threads_default_dynamic_state ()
scm_i_default_dynamic_state = state;
}
void
scm_init_thread_procs ()
{
#include "libguile/threads.x"
}
/* IA64-specific things. */

1
libguile/threads.h
View file

@ -141,7 +141,6 @@ SCM_API void *scm_with_guile (void *(*func)(void *), void *data);
SCM_INTERNAL void scm_i_reset_fluid (size_t);
SCM_INTERNAL void scm_threads_prehistory (void *);
SCM_INTERNAL void scm_init_threads (void);
SCM_INTERNAL void scm_init_thread_procs (void);
SCM_INTERNAL void scm_init_threads_default_dynamic_state (void);
SCM_INTERNAL void scm_i_dynwind_pthread_mutex_lock_block_asyncs (scm_i_pthread_mutex_t *mutex);

8
module/ice-9/boot-9.scm
View file

@ -4067,6 +4067,14 @@ when none is available, reading FILE-NAME with READER."
;;; {Threads}
;;;
;; Load (ice-9 threads), initializing some internal data structures.
(resolve-interface '(ice-9 threads))
;;; SRFI-4 in the default environment. FIXME: we should figure out how
;;; to deprecate this.
;;;

50
module/ice-9/deprecated.scm
View file

@ -16,14 +16,17 @@
;;;;
(define-module (ice-9 deprecated)
#:export (_IONBF _IOLBF _IOFBF))
#:use-module ((ice-9 threads) #:prefix threads:))
(define-syntax-rule (define-deprecated var msg exp)
(begin
(define-syntax var
(lambda (x)
(issue-deprecation-warning msg)
(syntax-case x ()
(id (identifier? #'id) #'exp)))))
((id arg (... ...)) #'(let ((x id)) (x arg (... ...))))
(id (identifier? #'id) #'exp))))
(export var)))
(define-deprecated _IONBF
"`_IONBF' is deprecated. Use the symbol 'none instead."
@ -34,3 +37,46 @@
(define-deprecated _IOFBF
"`_IOFBF' is deprecated. Use the symbol 'block instead."
'block)
(define-syntax define-deprecated/threads
(lambda (stx)
(define (threads-name id)
(datum->syntax id (symbol-append 'threads: (syntax->datum id))))
(syntax-case stx ()
((_ name)
(with-syntax ((name* (threads-name #'name))
(warning (string-append
"Import (ice-9 threads) to have access to `"
(symbol->string (syntax->datum #'name)) "'.")))
#'(define-deprecated name warning name*))))))
(define-syntax-rule (define-deprecated/threads* name ...)
(begin (define-deprecated/threads name) ...))
(define-deprecated/threads*
call-with-new-thread
yield
cancel-thread
set-thread-cleanup!
thread-cleanup
join-thread
thread?
make-mutex
make-recursive-mutex
lock-mutex
try-mutex
unlock-mutex
mutex?
mutex-owner
mutex-level
mutex-locked?
make-condition-variable
wait-condition-variable
signal-condition-variable
broadcast-condition-variable
condition-variable?
current-thread
all-threads
thread-exited?
total-processor-count
current-processor-count)

1
module/ice-9/futures.scm
View file

@ -24,6 +24,7 @@
#:use-module (ice-9 q)
#:use-module (ice-9 match)
#:use-module (ice-9 control)
#:use-module (ice-9 threads)
#:export (future make-future future? touch))
;;; Author: Ludovic Courtès <ludo@gnu.org>

129
module/ice-9/threads.scm
View file

@ -26,22 +26,50 @@
;;; Commentary:
;; This module is documented in the Guile Reference Manual.
;; Briefly, one procedure is exported: `%thread-handler';
;; as well as four macros: `make-thread', `begin-thread',
;; `with-mutex' and `monitor'.
;;; Code:
(define-module (ice-9 threads)
#:use-module (ice-9 futures)
#:use-module (ice-9 match)
;; These bindings are marked as #:replace because when deprecated code
;; is enabled, (ice-9 deprecated) also exports these names.
;; (Referencing one of the deprecated names prints a warning directing
;; the user to these bindings.) Anyway once we can remove the
;; deprecated bindings, we should use #:export instead of #:replace
;; for these.
#:replace (call-with-new-thread
yield
cancel-thread
set-thread-cleanup!
thread-cleanup
join-thread
thread?
make-mutex
make-recursive-mutex
lock-mutex
try-mutex
unlock-mutex
mutex?
mutex-owner
mutex-level
mutex-locked?
make-condition-variable
wait-condition-variable
signal-condition-variable
broadcast-condition-variable
condition-variable?
current-thread
all-threads
thread-exited?
total-processor-count
current-processor-count)
#:export (begin-thread
parallel
letpar
make-thread
with-mutex
monitor
parallel
letpar
par-map
par-for-each
n-par-map
@ -49,6 +77,13 @@
n-for-each-par-map
%thread-handler))
;; Note that this extension also defines %make-transcoded-port, which is
;; not exported but is used by (rnrs io ports).
(eval-when (expand eval load)
(load-extension (string-append "libguile-" (effective-version))
"scm_init_ice_9_threads"))
;;; Macros first, so that the procedures expand correctly.
@ -58,21 +93,6 @@
(lambda () e0 e1 ...)
%thread-handler))
(define-syntax parallel
(lambda (x)
(syntax-case x ()
((_ e0 ...)
(with-syntax (((tmp0 ...) (generate-temporaries (syntax (e0 ...)))))
#'(let ((tmp0 (future e0))
...)
(values (touch tmp0) ...)))))))
(define-syntax-rule (letpar ((v e) ...) b0 b1 ...)
(call-with-values
(lambda () (parallel e ...))
(lambda (v ...)
b0 b1 ...)))
(define-syntax-rule (make-thread proc arg ...)
(call-with-new-thread
(lambda () (proc arg ...))
@ -104,6 +124,48 @@
#`(with-mutex (monitor-mutex-with-id '#,id)
body body* ...))))))
(define (thread-handler tag . args)
(let ((n (length args))
(p (current-error-port)))
(display "In thread:" p)
(newline p)
(if (>= n 3)
(display-error #f
p
(car args)
(cadr args)
(caddr args)
(if (= n 4)
(cadddr args)
'()))
(begin
(display "uncaught throw to " p)
(display tag p)
(display ": " p)
(display args p)
(newline p)))
#f))
;;; Set system thread handler
(define %thread-handler thread-handler)
(use-modules (ice-9 futures))
(define-syntax parallel
(lambda (x)
(syntax-case x ()
((_ e0 ...)
(with-syntax (((tmp0 ...) (generate-temporaries (syntax (e0 ...)))))
#'(let ((tmp0 (future e0))
...)
(values (touch tmp0) ...)))))))
(define-syntax-rule (letpar ((v e) ...) b0 b1 ...)
(call-with-values
(lambda () (parallel e ...))
(lambda (v ...)
b0 b1 ...)))
(define (par-mapper mapper cons)
(lambda (proc . lists)
(let loop ((lists lists))
@ -205,29 +267,4 @@ of applying P-PROC on ARGLISTS."
(loop))))))
threads)))))
(define (thread-handler tag . args)
(let ((n (length args))
(p (current-error-port)))
(display "In thread:" p)
(newline p)
(if (>= n 3)
(display-error #f
p
(car args)
(cadr args)
(caddr args)
(if (= n 4)
(cadddr args)
'()))
(begin
(display "uncaught throw to " p)
(display tag p)
(display ": " p)
(display args p)
(newline p)))
#f))
;;; Set system thread handler
(define %thread-handler thread-handler)
;;; threads.scm ends here

1
module/language/cps/intmap.scm
View file

@ -34,6 +34,7 @@
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
#:use-module (ice-9 match)
#:use-module ((ice-9 threads) #:select (current-thread))
#:export (empty-intmap
intmap?
transient-intmap?

1
module/language/cps/intset.scm
View file

@ -29,6 +29,7 @@
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
#:use-module (ice-9 match)
#:use-module ((ice-9 threads) #:select (current-thread))
#:export (empty-intset
intset?
transient-intset?

1
module/language/cps/reify-primitives.scm
View file

@ -79,6 +79,7 @@
make-atomic-box atomic-box-ref atomic-box-set!
atomic-box-swap! atomic-box-compare-and-swap!)
'(ice-9 atomic))
((current-thread) '(ice-9 threads))
((class-of) '(oop goops))
((u8vector-ref
u8vector-set! s8vector-ref s8vector-set!

1
module/language/tree-il/primitives.scm
View file

@ -21,6 +21,7 @@
(define-module (language tree-il primitives)
#:use-module (system base pmatch)
#:use-module (ice-9 match)
#:use-module (ice-9 threads)
#:use-module (rnrs bytevectors)
#:use-module (system base syntax)
#:use-module (language tree-il)

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

@ -31,12 +31,9 @@
;;; Code:
(define-module (srfi srfi-18)
:use-module (srfi srfi-34)
:export (
;;; Threads
;; current-thread <= in the core
;; thread? <= in the core
#:use-module ((ice-9 threads) #:prefix threads:)
#:use-module (srfi srfi-34)
#:export (;; Threads
make-thread
thread-name
thread-specific
@ -47,8 +44,7 @@
thread-terminate!
thread-join!
;;; Mutexes
;; mutex? <= in the core
;; Mutexes
make-mutex
mutex-name
mutex-specific
@ -57,8 +53,7 @@
mutex-lock!
mutex-unlock!
;;; Condition variables
;; condition-variable? <= in the core
;; Condition variables
make-condition-variable
condition-variable-name
condition-variable-specific
@ -67,7 +62,7 @@
condition-variable-broadcast!
condition-variable-wait!
;;; Time
;; Time
current-time
time?
time->seconds
@ -80,16 +75,18 @@
abandoned-mutex-exception?
terminated-thread-exception?
uncaught-exception?
uncaught-exception-reason
)
:re-export (current-thread thread? mutex? condition-variable?)
:replace (current-time
uncaught-exception-reason)
#:re-export ((threads:condition-variable? . condition-variable?)
(threads:current-thread . current-thread)
(threads:thread? . thread?)
(threads:mutex? . mutex?))
#:replace (current-time
make-thread
make-mutex
make-condition-variable
raise))
(if (not (provided? 'threads))
(unless (provided? 'threads)
(error "SRFI-18 requires Guile with threads support"))
(cond-expand-provide (current-module) '(srfi-18))
@ -121,7 +118,7 @@
(define (srfi-18-exception-preserver obj)
(if (or (terminated-thread-exception? obj)
(uncaught-exception? obj))
(set! (thread->exception (current-thread)) obj)))
(set! (thread->exception (threads:current-thread)) obj)))
(define (srfi-18-exception-handler key . args)
@ -135,12 +132,12 @@
(cons* uncaught-exception key args)))))
(define (current-handler-stack)
(let ((ct (current-thread)))
(let ((ct (threads:current-thread)))
(or (hashq-ref thread-exception-handlers ct)
(hashq-set! thread-exception-handlers ct (list initial-handler)))))
(define (with-exception-handler handler thunk)
(let ((ct (current-thread))
(let ((ct (threads:current-thread))
(hl (current-handler-stack)))
(check-arg-type procedure? handler "with-exception-handler")
(check-arg-type thunk? thunk "with-exception-handler")
@ -176,12 +173,12 @@
(define make-thread
(let ((make-cond-wrapper (lambda (thunk lcond lmutex scond smutex)
(lambda ()
(lock-mutex lmutex)
(signal-condition-variable lcond)
(lock-mutex smutex)
(unlock-mutex lmutex)
(wait-condition-variable scond smutex)
(unlock-mutex smutex)
(threads:lock-mutex lmutex)
(threads:signal-condition-variable lcond)
(threads:lock-mutex smutex)
(threads:unlock-mutex lmutex)
(threads:wait-condition-variable scond smutex)
(threads:unlock-mutex smutex)
(with-exception-handler initial-handler
thunk)))))
(lambda (thunk . name)
@ -192,40 +189,42 @@
(sm (make-mutex 'start-mutex))
(sc (make-condition-variable 'start-condition-variable)))
(lock-mutex lm)
(let ((t (call-with-new-thread (make-cond-wrapper thunk lc lm sc sm)
(threads:lock-mutex lm)
(let ((t (threads:call-with-new-thread
(make-cond-wrapper thunk lc lm sc sm)
srfi-18-exception-handler)))
(hashq-set! thread-start-conds t (cons sm sc))
(and n (hashq-set! object-names t n))
(wait-condition-variable lc lm)
(unlock-mutex lm)
(threads:wait-condition-variable lc lm)
(threads:unlock-mutex lm)
t)))))
(define (thread-name thread)
(hashq-ref object-names (check-arg-type thread? thread "thread-name")))
(hashq-ref object-names
(check-arg-type threads:thread? thread "thread-name")))
(define (thread-specific thread)
(hashq-ref object-specifics
(check-arg-type thread? thread "thread-specific")))
(check-arg-type threads:thread? thread "thread-specific")))
(define (thread-specific-set! thread obj)
(hashq-set! object-specifics
(check-arg-type thread? thread "thread-specific-set!")
(check-arg-type threads:thread? thread "thread-specific-set!")
obj)
*unspecified*)
(define (thread-start! thread)
(let ((x (hashq-ref thread-start-conds
(check-arg-type thread? thread "thread-start!"))))
(check-arg-type threads:thread? thread "thread-start!"))))
(and x (let ((smutex (car x))
(scond (cdr x)))
(hashq-remove! thread-start-conds thread)
(lock-mutex smutex)
(signal-condition-variable scond)
(unlock-mutex smutex)))
(threads:lock-mutex smutex)
(threads:signal-condition-variable scond)
(threads:unlock-mutex smutex)))
thread))
(define (thread-yield!) (yield) *unspecified*)
(define (thread-yield!) (threads:yield) *unspecified*)
(define (thread-sleep! timeout)
(let* ((ct (time->seconds (current-time)))
@ -259,25 +258,27 @@
(define (thread-terminate! thread)
(define (thread-terminate-inner!)
(let ((current-handler (thread-cleanup thread)))
(let ((current-handler (threads:thread-cleanup thread)))
(if (thunk? current-handler)
(set-thread-cleanup! thread
(threads:set-thread-cleanup!
thread
(lambda ()
(with-exception-handler initial-handler
current-handler)
(srfi-18-exception-preserver
terminated-thread-exception)))
(set-thread-cleanup! thread
(threads:set-thread-cleanup!
thread
(lambda () (srfi-18-exception-preserver
terminated-thread-exception))))
(cancel-thread thread)
(threads:cancel-thread thread)
*unspecified*))
(thread-terminate-inner!))
(define (thread-join! thread . args)
(define thread-join-inner!
(wrap (lambda ()
(let ((v (apply join-thread thread args))
(let ((v (apply threads:join-thread thread args))
(e (thread->exception thread)))
(if (and (= (length args) 1) (not v))
(raise join-timeout-exception))
@ -291,41 +292,40 @@
(define make-mutex
(lambda name
(let ((n (and (pair? name) (car name)))
(m ((@ (guile) make-mutex)
'unchecked-unlock
(m (threads:make-mutex 'unchecked-unlock
'allow-external-unlock
'recursive)))
(and n (hashq-set! object-names m n)) m)))
(define (mutex-name mutex)
(hashq-ref object-names (check-arg-type mutex? mutex "mutex-name")))
(hashq-ref object-names (check-arg-type threads:mutex? mutex "mutex-name")))
(define (mutex-specific mutex)
(hashq-ref object-specifics
(check-arg-type mutex? mutex "mutex-specific")))
(check-arg-type threads:mutex? mutex "mutex-specific")))
(define (mutex-specific-set! mutex obj)
(hashq-set! object-specifics
(check-arg-type mutex? mutex "mutex-specific-set!")
(check-arg-type threads:mutex? mutex "mutex-specific-set!")
obj)
*unspecified*)
(define (mutex-state mutex)
(let ((owner (mutex-owner mutex)))
(let ((owner (threads:mutex-owner mutex)))
(if owner
(if (thread-exited? owner) 'abandoned owner)
(if (> (mutex-level mutex) 0) 'not-owned 'not-abandoned))))
(if (threads:thread-exited? owner) 'abandoned owner)
(if (> (threads:mutex-level mutex) 0) 'not-owned 'not-abandoned))))
(define (mutex-lock! mutex . args)
(define mutex-lock-inner!
(wrap (lambda ()
(catch 'abandoned-mutex-error
(lambda () (apply lock-mutex mutex args))
(lambda () (apply threads:lock-mutex mutex args))
(lambda (key . args) (raise abandoned-mutex-exception))))))
(call/cc mutex-lock-inner!))
(define (mutex-unlock! mutex . args)
(apply unlock-mutex mutex args))
(apply threads:unlock-mutex mutex args))
;; CONDITION VARIABLES
;; These functions are all pass-thrus to the existing Guile implementations.
@ -333,33 +333,33 @@
(define make-condition-variable
(lambda name
(let ((n (and (pair? name) (car name)))
(m ((@ (guile) make-condition-variable))))
(m (threads:make-condition-variable)))
(and n (hashq-set! object-names m n)) m)))
(define (condition-variable-name condition-variable)
(hashq-ref object-names (check-arg-type condition-variable?
(hashq-ref object-names (check-arg-type threads:condition-variable?
condition-variable
"condition-variable-name")))
(define (condition-variable-specific condition-variable)
(hashq-ref object-specifics (check-arg-type condition-variable?
(hashq-ref object-specifics (check-arg-type threads:condition-variable?
condition-variable
"condition-variable-specific")))
(define (condition-variable-specific-set! condition-variable obj)
(hashq-set! object-specifics
(check-arg-type condition-variable?
(check-arg-type threads:condition-variable?
condition-variable
"condition-variable-specific-set!")
obj)
*unspecified*)
(define (condition-variable-signal! cond)
(signal-condition-variable cond)
(threads:signal-condition-variable cond)
*unspecified*)
(define (condition-variable-broadcast! cond)
(broadcast-condition-variable cond)
(threads:broadcast-condition-variable cond)
*unspecified*)
;; TIME

1
test-suite/tests/filesys.test
View file

@ -19,6 +19,7 @@
(define-module (test-suite test-filesys)
#:use-module (test-suite lib)
#:use-module (test-suite guile-test)
#:use-module (ice-9 threads)
#:use-module (ice-9 match)
#:use-module (rnrs io ports)
#:use-module (rnrs bytevectors))

5
test-suite/tests/fluids.test
View file

@ -18,8 +18,9 @@
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite test-fluids)
:use-module (test-suite lib)
:use-module (system base compile))
#:use-module (ice-9 threads)
#:use-module (test-suite lib)
#:use-module (system base compile))
(define exception:syntax-error

14
test-suite/tests/srfi-18.test
View file

@ -18,6 +18,7 @@
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite test-srfi-18)
#:use-module ((ice-9 threads) #:prefix threads:)
#:use-module (test-suite lib))
;; two expressions so that the srfi-18 import is in effect for expansion
@ -43,9 +44,9 @@
(with-test-prefix "make-thread"
(pass-if "make-thread creates new thread"
(let* ((n (length (all-threads)))
(let* ((n (length (threads:all-threads)))
(t (make-thread (lambda () 'foo) 'make-thread-1))
(r (> (length (all-threads)) n)))
(r (> (length (threads:all-threads)) n)))
(thread-terminate! t) r)))
(with-test-prefix "thread-name"
@ -110,7 +111,7 @@
(pass-if "termination destroys non-started thread"
(let ((t (make-thread (lambda () 'nothing) 'thread-terminate-1))
(num-threads (length (all-threads)))
(num-threads (length (threads:all-threads)))
(success #f))
(thread-terminate! t)
(with-exception-handler
@ -375,7 +376,8 @@
(mutex-unlock! m1)))
(dec-sem! (lambda ()
(mutex-lock! m1)
(while (eqv? sem 0) (wait-condition-variable c1 m1))
(while (eqv? sem 0)
(threads:wait-condition-variable c1 m1))
(set! sem (- sem 1))
(mutex-unlock! m1)))
(t1 (make-thread (lambda ()
@ -449,13 +451,13 @@
h2 (lambda ()
(mutex-lock! m)
(condition-variable-signal! c)
(wait-condition-variable c m)
(threads:wait-condition-variable c m)
(and (eq? (current-exception-handler) h2)
(mutex-unlock! m)))))
'current-exception-handler-4)))
(mutex-lock! m)
(thread-start! t)
(wait-condition-variable c m)
(threads:wait-condition-variable c m)
(and (eq? (current-exception-handler) h1)
(condition-variable-signal! c)
(mutex-unlock! m)