Move thread bindings to (ice-9 threads)

* 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.

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
 

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 ()

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
+@xref{Threads}, for information on how get the number of processors
-@deffnx {C Function} scm_total_processor_count ()
+available on a system.
-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 Signals

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 */

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.  */
 

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);

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.
 ;;;

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
+  (begin
-    (lambda (x)
+    (define-syntax var
-      (issue-deprecation-warning msg)
+      (lambda (x)
-      (syntax-case x ()
+        (issue-deprecation-warning msg)
-        (id (identifier? #'id) #'exp)))))
+        (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)

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 <ludo@gnu.org>

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

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?

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?

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!

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)

module/srfi/srfi-18.scm

@@ -31,66 +31,63 @@
 ;;; Code:
 
 (define-module (srfi srfi-18)
-  :use-module (srfi srfi-34)
+  #:use-module ((ice-9 threads) #:prefix threads:)
-  :export (
+  #: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
+            ;; Mutexes
- ;; current-thread			<= in the core
+            make-mutex
- ;; thread?				<= in the core
+            mutex-name
- make-thread
+            mutex-specific
- thread-name
+            mutex-specific-set!
- thread-specific
+            mutex-state
- thread-specific-set!
+            mutex-lock!
- thread-start!
+            mutex-unlock!
- thread-yield!
- thread-sleep!
- thread-terminate!
- thread-join!
 
-;;; Mutexes
+            ;; Condition variables
- ;; mutex?				<= in the core
+            make-condition-variable
- make-mutex
+            condition-variable-name
- mutex-name
+            condition-variable-specific
- mutex-specific
+            condition-variable-specific-set!
- mutex-specific-set!
+            condition-variable-signal!
- mutex-state
+            condition-variable-broadcast!
- mutex-lock!
+            condition-variable-wait!
- mutex-unlock!
 
-;;; Condition variables
+            ;; Time
- ;; condition-variable?			<= in the core
+            current-time
- make-condition-variable
+            time?
- condition-variable-name
+            time->seconds
- condition-variable-specific
+            seconds->time
- condition-variable-specific-set!
- condition-variable-signal!
- condition-variable-broadcast!
- condition-variable-wait!
-
-;;; Time
- current-time
- time?
- time->seconds
- seconds->time
  
- current-exception-handler
+            current-exception-handler
- with-exception-handler
+            with-exception-handler
- raise
+            raise
- join-timeout-exception?
+            join-timeout-exception?
- abandoned-mutex-exception?
+            abandoned-mutex-exception?
- terminated-thread-exception?
+            terminated-thread-exception?
- uncaught-exception?
+            uncaught-exception?
- uncaught-exception-reason
+            uncaught-exception-reason)
- )
+  #:re-export ((threads:condition-variable? . condition-variable?)
-  :re-export (current-thread thread? mutex? condition-variable?)
+               (threads:current-thread . current-thread)
-  :replace (current-time 
+               (threads:thread? . thread?)
-	    make-thread 
+               (threads:mutex? . mutex?))
-	    make-mutex 
+  #:replace (current-time
-	    make-condition-variable
+             make-thread
-	    raise))
+             make-mutex
+             make-condition-variable
+             raise))
 
-(if (not (provided? 'threads))
+(unless (provided? 'threads)
-    (error "SRFI-18 requires Guile with threads support"))
+  (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)
+			       (threads:lock-mutex lmutex)
-			       (signal-condition-variable lcond)
+			       (threads:signal-condition-variable lcond)
-			       (lock-mutex smutex)
+			       (threads:lock-mutex smutex)
-			       (unlock-mutex lmutex)
+			       (threads:unlock-mutex lmutex)
-			       (wait-condition-variable scond smutex)
+			       (threads:wait-condition-variable scond smutex)
-			       (unlock-mutex 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)
+	(threads:lock-mutex lm)
-	(let ((t (call-with-new-thread (make-cond-wrapper thunk lc lm sc sm)
+	(let ((t (threads:call-with-new-thread
-				       srfi-18-exception-handler)))
+                  (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)
+	  (threads:wait-condition-variable lc lm)
-	  (unlock-mutex 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)
+	     (threads:lock-mutex smutex)
-	     (signal-condition-variable scond)
+	     (threads:signal-condition-variable scond)
-	     (unlock-mutex smutex)))
+	     (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!
-			       (lambda ()
+           thread 
-				 (with-exception-handler initial-handler
+           (lambda ()
-							 current-handler) 
+             (with-exception-handler initial-handler
-				 (srfi-18-exception-preserver
+               current-handler) 
-				  terminated-thread-exception)))
+             (srfi-18-exception-preserver
-	  (set-thread-cleanup! thread
+              terminated-thread-exception)))
-			       (lambda () (srfi-18-exception-preserver
+	  (threads:set-thread-cleanup!
-					   terminated-thread-exception))))
+           thread
-      (cancel-thread 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) 
+	  (m (threads:make-mutex 'unchecked-unlock 
-	      'unchecked-unlock 
+                                 'allow-external-unlock 
-	      'allow-external-unlock 
+                                 'recursive)))
-	      '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 (threads:thread-exited? owner) 'abandoned owner)
-	(if (> (mutex-level mutex) 0) 'not-owned 'not-abandoned))))
+	(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

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))

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 (ice-9 threads)
-  :use-module (system base compile))
+  #:use-module (test-suite lib)
+  #:use-module (system base compile))
 
 
 (define exception:syntax-error

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)