From a64d0589512480bc7016e7e7fd503c5596ba3050 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 29 Jan 2006 19:44:45 +0000 Subject: [PATCH] Replaced 'futures' with threads. --- ice-9/ChangeLog | 4 ++++ ice-9/threads.scm | 48 ++++++++++++++++++-------------------- test-suite/ChangeLog | 4 ++++ test-suite/tests/time.test | 8 +++---- 4 files changed, 35 insertions(+), 29 deletions(-) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 33c7935e3..8bf2938d9 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,7 @@ +2006-01-29 Marius Vollmer + + * threads.scm: Replaced 'futures' with threads. + 2006-01-13 Neil Jerram * boot-9.scm (repl-reader): Use value of current-reader fluid to diff --git a/ice-9/threads.scm b/ice-9/threads.scm index ba5c689df..551f7cf52 100644 --- a/ice-9/threads.scm +++ b/ice-9/threads.scm @@ -37,22 +37,20 @@ n-par-map n-par-for-each n-for-each-par-map) - :re-export (future-ref) :export-syntax (begin-thread parallel letpar make-thread with-mutex - monitor) - :re-export-syntax (future)) + monitor)) (define ((par-mapper mapper) proc . arglists) - (mapper future-ref + (mapper thread-join (apply map (lambda args - (future (apply proc args))) + (begin-thread (apply proc args))) arglists))) (define par-map (par-mapper map)) @@ -60,15 +58,15 @@ (define (n-par-map n proc . arglists) (let* ((m (make-mutex)) - (futures '()) + (threads '()) (results (make-list (length (car arglists)))) (result results)) (do ((i 0 (+ 1 i))) ((= i n) - (for-each future-ref futures) + (for-each thread-join threads) results) - (set! futures - (cons (future + (set! threads + (cons (begin-thread (let loop () (lock-mutex m) (if (null? result) @@ -80,16 +78,16 @@ (unlock-mutex m) (set-car! my-result (apply proc args)) (loop))))) - futures))))) + threads))))) (define (n-par-for-each n proc . arglists) (let ((m (make-mutex)) - (futures '())) + (threads '())) (do ((i 0 (+ 1 i))) ((= i n) - (for-each future-ref futures)) - (set! futures - (cons (future + (for-each thread-join futures)) + (set! threads + (cons (begin-thread (let loop () (lock-mutex m) (if (null? (car arglists)) @@ -99,7 +97,7 @@ (unlock-mutex m) (apply proc args) (loop))))) - futures))))) + threads))))) ;;; The following procedure is motivated by the common and important ;;; case where a lot of work should be done, (not too much) in parallel, @@ -110,15 +108,15 @@ "Using N parallel processes, apply S-PROC in serial order on the results of applying P-PROC on ARGLISTS." (let* ((m (make-mutex)) - (futures '()) + (threads '()) (no-result '(no-value)) (results (make-list (length (car arglists)) no-result)) (result results)) (do ((i 0 (+ 1 i))) ((= i n) - (for-each future-ref futures)) - (set! futures - (cons (future + (for-each thread-join futures)) + (set! threads + (cons (begin-thread (let loop () (lock-mutex m) (cond ((null? results) @@ -143,7 +141,7 @@ of applying P-PROC on ARGLISTS." (unlock-mutex m) (set-car! my-result (apply p-proc args)) (loop)))))) - futures))))) + threads))))) (define (thread-handler tag . args) (fluid-set! the-last-stack #f) @@ -169,7 +167,7 @@ of applying P-PROC on ARGLISTS." #f)) ;;; Set system thread handler -(set! %thread-handler thread-handler) +(define %thread-handler thread-handler) ; --- MACROS ------------------------------------------------------- @@ -189,8 +187,8 @@ of applying P-PROC on ARGLISTS." (make-symbol "f")) forms))) `((lambda ,vars - (values ,@(map (lambda (v) `(future-ref ,v)) vars))) - ,@(map (lambda (form) `(future ,form)) forms)))))) + (values ,@(map (lambda (v) `(thread-join ,v)) vars))) + ,@(map (lambda (form) `(begin-thread ,form)) forms)))))) (define-macro (letpar bindings . body) (cond ((or (null? bindings) (null? (cdr bindings))) @@ -199,8 +197,8 @@ of applying P-PROC on ARGLISTS." (let ((vars (map car bindings))) `((lambda ,vars ((lambda ,vars ,@body) - ,@(map (lambda (v) `(future-ref ,v)) vars))) - ,@(map (lambda (b) `(future ,(cadr b))) bindings)))))) + ,@(map (lambda (v) `(thread-join ,v)) vars))) + ,@(map (lambda (b) `(begin-thread ,(cadr b))) bindings)))))) (define-macro (make-thread proc . args) `(call-with-new-thread diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 041a905a6..bbee0dc9b 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,7 @@ +2006-01-29 Marius Vollmer + + * tests/time.test: Replaced 'futures' with threads. + 2005-11-30 Kevin Ryde * tests/srfi-13.test (string-append/shared): New tests. diff --git a/test-suite/tests/time.test b/test-suite/tests/time.test index f4bb51c2d..b872e1b99 100644 --- a/test-suite/tests/time.test +++ b/test-suite/tests/time.test @@ -40,9 +40,9 @@ (alarm 5) (false-if-exception (gmtime t)) - (future-ref (future (catch 'out-of-range - (lambda () (gmtime t)) - (lambda args #f)))) + (thread-join (begin-thread (catch 'out-of-range + (lambda () (gmtime t)) + (lambda args #f)))) (alarm 0) #t)) @@ -118,6 +118,6 @@ (alarm 5) (false-if-exception (strptime "%a" "nosuchday")) - (future-ref (future (strptime "%d" "1"))) + (thread-join (begin-thread (strptime "%d" "1"))) (alarm 0) #t)) -- 2.20.1