mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-31 09:20:23 +02:00
Code Activity

* threads.scm (par-mapper, n-par-map, n-par-for-each): Use

Browse source 
futures.
This commit is contained in:
Mikael Djurfeldt 2003-01-23 16:04:06 +00:00
parent 77f9ca697e
commit f4719f3191
2 changed files with 36 additions and 37 deletions
Download patch file Download diff file Expand all files Collapse all files

5
ice-9/ChangeLog
View file

@ -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> 2003-01-20 Mikael Djurfeldt <djurfeldt@nada.kth.se>
* occam-channel.scm (alt): New syntax. * occam-channel.scm (alt): New syntax.

68
ice-9/threads.scm
View file

@ -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 ;;;; 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 ;;;; it under the terms of the GNU General Public License as published by
@ -73,12 +73,10 @@
(define ((par-mapper mapper) proc . arglists) (define ((par-mapper mapper) proc . arglists)
(mapper join-thread (mapper future-ref
(apply map (apply map
(lambda args (lambda args
(call-with-new-thread (lambda () (future (apply proc args)))
(apply proc args))
%thread-handler))
arglists))) arglists)))
(define par-map (par-mapper map)) (define par-map (par-mapper map))
@ -86,50 +84,46 @@
(define (n-par-map n proc . arglists) (define (n-par-map n proc . arglists)
(let* ((m (make-mutex)) (let* ((m (make-mutex))
(threads '()) (futures '())
(results (make-list (length (car arglists)))) (results (make-list (length (car arglists))))
(result results)) (result results))
(do ((i 0 (+ 1 i))) (do ((i 0 (+ 1 i)))
((= i n) ((= i n)
(for-each join-thread threads) (for-each future-ref futures)
results) results)
(set! threads (set! futures
(cons (call-with-new-thread (cons (future
(lambda () (let loop ()
(let loop () (lock-mutex m)
(lock-mutex m) (if (null? result)
(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) (unlock-mutex m)
(let ((args (map car arglists)) (set-car! my-result (apply proc args))
(my-result result)) (loop)))))
(set! arglists (map cdr arglists)) futures)))))
(set! result (cdr result))
(unlock-mutex m)
(set-car! my-result (apply proc args))
(loop)))))
%thread-handler)
threads)))))
(define (n-par-for-each n proc . arglists) (define (n-par-for-each n proc . arglists)
(let ((m (make-mutex)) (let ((m (make-mutex))
(threads '())) (futures '()))
(do ((i 0 (+ 1 i))) (do ((i 0 (+ 1 i)))
((= i n) ((= i n)
(for-each join-thread threads)) (for-each future-ref futures))
(set! threads (set! futures
(cons (call-with-new-thread (cons (future
(lambda () (let loop ()
(let loop () (lock-mutex m)
(lock-mutex m) (if (null? (car arglists))
(if (null? (car arglists)) (unlock-mutex m)
(let ((args (map car arglists)))
(set! arglists (map cdr arglists))
(unlock-mutex m) (unlock-mutex m)
(let ((args (map car arglists))) (apply proc args)
(set! arglists (map cdr arglists)) (loop)))))
(unlock-mutex m) futures)))))
(apply proc args)
(loop)))))
%thread-handler)
threads)))))
(define (thread-handler tag . args) (define (thread-handler tag . args)
(fluid-set! the-last-stack #f) (fluid-set! the-last-stack #f)