summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ice-9/ChangeLog5
-rw-r--r--ice-9/threads.scm68
2 files changed, 36 insertions, 37 deletions
diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog
index c220254b7..f25b13aad 100644
--- a/ice-9/ChangeLog
+++ b/ice-9/ChangeLog
@@ -1,3 +1,8 @@
+2003-01-23 Mikael Djurfeldt <djurfeldt@nada.kth.se>
+
+ * threads.scm (par-mapper, n-par-map, n-par-for-each): Use
+ futures.
+
2003-01-20 Mikael Djurfeldt <djurfeldt@nada.kth.se>
* occam-channel.scm (alt): New syntax.
diff --git a/ice-9/threads.scm b/ice-9/threads.scm
index 57e431ae9..f36aaea21 100644
--- a/ice-9/threads.scm
+++ b/ice-9/threads.scm
@@ -1,4 +1,4 @@
-;;;; Copyright (C) 1996, 1998, 2001, 2002 Free Software Foundation, Inc.
+;;;; Copyright (C) 1996, 1998, 2001, 2002, 2003 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
@@ -73,12 +73,10 @@
(define ((par-mapper mapper) proc . arglists)
- (mapper join-thread
+ (mapper future-ref
(apply map
(lambda args
- (call-with-new-thread (lambda ()
- (apply proc args))
- %thread-handler))
+ (future (apply proc args)))
arglists)))
(define par-map (par-mapper map))
@@ -86,50 +84,46 @@
(define (n-par-map n proc . arglists)
(let* ((m (make-mutex))
- (threads '())
+ (futures '())
(results (make-list (length (car arglists))))
(result results))
(do ((i 0 (+ 1 i)))
((= i n)
- (for-each join-thread threads)
+ (for-each future-ref futures)
results)
- (set! threads
- (cons (call-with-new-thread
- (lambda ()
- (let loop ()
- (lock-mutex m)
- (if (null? result)
+ (set! futures
+ (cons (future
+ (let loop ()
+ (lock-mutex m)
+ (if (null? result)
+ (unlock-mutex m)
+ (let ((args (map car arglists))
+ (my-result result))
+ (set! arglists (map cdr arglists))
+ (set! result (cdr result))
(unlock-mutex m)
- (let ((args (map car arglists))
- (my-result result))
- (set! arglists (map cdr arglists))
- (set! result (cdr result))
- (unlock-mutex m)
- (set-car! my-result (apply proc args))
- (loop)))))
- %thread-handler)
- threads)))))
+ (set-car! my-result (apply proc args))
+ (loop)))))
+ futures)))))
(define (n-par-for-each n proc . arglists)
(let ((m (make-mutex))
- (threads '()))
+ (futures '()))
(do ((i 0 (+ 1 i)))
((= i n)
- (for-each join-thread threads))
- (set! threads
- (cons (call-with-new-thread
- (lambda ()
- (let loop ()
- (lock-mutex m)
- (if (null? (car arglists))
+ (for-each future-ref futures))
+ (set! futures
+ (cons (future
+ (let loop ()
+ (lock-mutex m)
+ (if (null? (car arglists))
+ (unlock-mutex m)
+ (let ((args (map car arglists)))
+ (set! arglists (map cdr arglists))
(unlock-mutex m)
- (let ((args (map car arglists)))
- (set! arglists (map cdr arglists))
- (unlock-mutex m)
- (apply proc args)
- (loop)))))
- %thread-handler)
- threads)))))
+ (apply proc args)
+ (loop)))))
+ futures)))))
(define (thread-handler tag . args)
(fluid-set! the-last-stack #f)