diff options
-rw-r--r-- | ice-9/ChangeLog | 5 | ||||
-rw-r--r-- | ice-9/threads.scm | 68 |
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) |