diff --git a/NEWS b/NEWS index 7402cadf4..0702eb294 100644 --- a/NEWS +++ b/NEWS @@ -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 diff --git a/doc/ref/api-scheduling.texi b/doc/ref/api-scheduling.texi index a13208a65..551b3fb38 100644 --- a/doc/ref/api-scheduling.texi +++ b/doc/ref/api-scheduling.texi @@ -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 () diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index 1c2c1f365..bcb16bd1a 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -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 diff --git a/libguile/init.c b/libguile/init.c index 31363c69b..4b95f3612 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -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 */ diff --git a/libguile/threads.c b/libguile/threads.c index b6099309f..9f11ac7e8 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -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. */ diff --git a/libguile/threads.h b/libguile/threads.h index 6b85baf52..a8bb21a4a 100644 --- a/libguile/threads.h +++ b/libguile/threads.h @@ -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); diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 48ea61d77..7f620979d 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -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. ;;; diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm index 375846ff3..de917df52 100644 --- a/module/ice-9/deprecated.scm +++ b/module/ice-9/deprecated.scm @@ -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) - (define-syntax var - (lambda (x) - (issue-deprecation-warning msg) - (syntax-case x () - (id (identifier? #'id) #'exp))))) + (begin + (define-syntax var + (lambda (x) + (issue-deprecation-warning msg) + (syntax-case x () + ((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) diff --git a/module/ice-9/futures.scm b/module/ice-9/futures.scm index 90bbe53ff..cc57e5c61 100644 --- a/module/ice-9/futures.scm +++ b/module/ice-9/futures.scm @@ -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 diff --git a/module/ice-9/threads.scm b/module/ice-9/threads.scm index 14da11339..49d070b99 100644 --- a/module/ice-9/threads.scm +++ b/module/ice-9/threads.scm @@ -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 diff --git a/module/language/cps/intmap.scm b/module/language/cps/intmap.scm index c29fa9ef4..3a4f51776 100644 --- a/module/language/cps/intmap.scm +++ b/module/language/cps/intmap.scm @@ -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? diff --git a/module/language/cps/intset.scm b/module/language/cps/intset.scm index cdf1fbe82..09af0eaa3 100644 --- a/module/language/cps/intset.scm +++ b/module/language/cps/intset.scm @@ -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? diff --git a/module/language/cps/reify-primitives.scm b/module/language/cps/reify-primitives.scm index df4dd248c..60be330b2 100644 --- a/module/language/cps/reify-primitives.scm +++ b/module/language/cps/reify-primitives.scm @@ -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! diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm index 71db1a635..be613c714 100644 --- a/module/language/tree-il/primitives.scm +++ b/module/language/tree-il/primitives.scm @@ -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) diff --git a/module/srfi/srfi-18.scm b/module/srfi/srfi-18.scm index 832b43606..e2d904770 100644 --- a/module/srfi/srfi-18.scm +++ b/module/srfi/srfi-18.scm @@ -31,66 +31,63 @@ ;;; Code: (define-module (srfi srfi-18) - :use-module (srfi srfi-34) - :export ( + #:use-module ((ice-9 threads) #:prefix threads:) + #:use-module (srfi srfi-34) + #:export (;; Threads + make-thread + thread-name + thread-specific + thread-specific-set! + thread-start! + thread-yield! + thread-sleep! + thread-terminate! + thread-join! -;;; Threads - ;; current-thread <= in the core - ;; thread? <= in the core - make-thread - thread-name - thread-specific - thread-specific-set! - thread-start! - thread-yield! - thread-sleep! - thread-terminate! - thread-join! + ;; Mutexes + make-mutex + mutex-name + mutex-specific + mutex-specific-set! + mutex-state + mutex-lock! + mutex-unlock! -;;; Mutexes - ;; mutex? <= in the core - make-mutex - mutex-name - mutex-specific - mutex-specific-set! - mutex-state - mutex-lock! - mutex-unlock! + ;; Condition variables + make-condition-variable + condition-variable-name + condition-variable-specific + condition-variable-specific-set! + condition-variable-signal! + condition-variable-broadcast! + condition-variable-wait! -;;; Condition variables - ;; condition-variable? <= in the core - make-condition-variable - condition-variable-name - condition-variable-specific - condition-variable-specific-set! - condition-variable-signal! - condition-variable-broadcast! - condition-variable-wait! - -;;; Time - current-time - time? - time->seconds - seconds->time + ;; Time + current-time + time? + time->seconds + seconds->time - current-exception-handler - with-exception-handler - raise - join-timeout-exception? - abandoned-mutex-exception? - terminated-thread-exception? - uncaught-exception? - uncaught-exception-reason - ) - :re-export (current-thread thread? mutex? condition-variable?) - :replace (current-time - make-thread - make-mutex - make-condition-variable - raise)) + current-exception-handler + with-exception-handler + raise + join-timeout-exception? + abandoned-mutex-exception? + terminated-thread-exception? + uncaught-exception? + 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)) - (error "SRFI-18 requires Guile with threads support")) +(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) - srfi-18-exception-handler))) + (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 - (lambda () - (with-exception-handler initial-handler - current-handler) - (srfi-18-exception-preserver - terminated-thread-exception))) - (set-thread-cleanup! thread - (lambda () (srfi-18-exception-preserver - terminated-thread-exception)))) - (cancel-thread thread) + (threads:set-thread-cleanup! + thread + (lambda () + (with-exception-handler initial-handler + current-handler) + (srfi-18-exception-preserver + terminated-thread-exception))) + (threads:set-thread-cleanup! + thread + (lambda () (srfi-18-exception-preserver + terminated-thread-exception)))) + (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 - 'allow-external-unlock - 'recursive))) + (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 diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test index 253c32ac5..fceb182be 100644 --- a/test-suite/tests/filesys.test +++ b/test-suite/tests/filesys.test @@ -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)) diff --git a/test-suite/tests/fluids.test b/test-suite/tests/fluids.test index 9ad9e81f8..ce7e62578 100644 --- a/test-suite/tests/fluids.test +++ b/test-suite/tests/fluids.test @@ -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 diff --git a/test-suite/tests/srfi-18.test b/test-suite/tests/srfi-18.test index ab055132e..5fba80ef7 100644 --- a/test-suite/tests/srfi-18.test +++ b/test-suite/tests/srfi-18.test @@ -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)