57 |
;;; Code: |
;;; Code: |
58 |
|
|
59 |
(define-module (ice-9 threads) |
(define-module (ice-9 threads) |
60 |
|
:export (par-map |
61 |
|
par-for-each |
62 |
|
%thread-handler) |
63 |
:export-syntax (make-thread |
:export-syntax (make-thread |
64 |
begin-thread |
begin-thread |
65 |
|
parallel |
66 |
with-mutex |
with-mutex |
67 |
monitor) |
monitor)) |
|
:export (%thread-handler)) |
|
68 |
|
|
69 |
|
|
70 |
|
|
71 |
|
(define (par-map proc . arglists) |
72 |
|
(let* ((m (make-mutex)) |
73 |
|
(c (make-condition-variable)) |
74 |
|
(n (length (car arglists))) |
75 |
|
(counter (- n 1)) |
76 |
|
(res (make-list n)) |
77 |
|
(ls res)) |
78 |
|
(lock-mutex m) |
79 |
|
(apply for-each |
80 |
|
(lambda args |
81 |
|
(let ((res ls)) |
82 |
|
(set! ls (cdr ls)) |
83 |
|
(call-with-new-thread |
84 |
|
(lambda () |
85 |
|
(set-car! res (apply proc args)) |
86 |
|
;; synchronize |
87 |
|
(lock-mutex m) |
88 |
|
(if (zero? counter) |
89 |
|
(signal-condition-variable c) |
90 |
|
(set! counter (- counter 1))) |
91 |
|
(unlock-mutex m)) |
92 |
|
%thread-handler))) |
93 |
|
arglists) |
94 |
|
(wait-condition-variable c m) |
95 |
|
res)) |
96 |
|
|
97 |
|
(define (par-for-each proc . arglists) |
98 |
|
(let* ((m (make-mutex)) |
99 |
|
(c (make-condition-variable)) |
100 |
|
(counter (- (length (car arglists)) 1))) |
101 |
|
(lock-mutex m) |
102 |
|
(apply for-each |
103 |
|
(lambda args |
104 |
|
(call-with-new-thread |
105 |
|
(lambda () |
106 |
|
(apply proc args) |
107 |
|
;; synchronize |
108 |
|
(lock-mutex m) |
109 |
|
(if (zero? counter) |
110 |
|
(signal-condition-variable c) |
111 |
|
(set! counter (- counter 1))) |
112 |
|
(unlock-mutex m)) |
113 |
|
%thread-handler)) |
114 |
|
arglists) |
115 |
|
(wait-condition-variable c m))) |
116 |
|
|
117 |
(define (%thread-handler tag . args) |
(define (%thread-handler tag . args) |
118 |
(fluid-set! the-last-stack #f) |
(fluid-set! the-last-stack #f) |
119 |
(let ((n (length args)) |
(let ((n (length args)) |
152 |
,first ,@rest)) |
,first ,@rest)) |
153 |
%thread-handler)) |
%thread-handler)) |
154 |
|
|
155 |
|
(defmacro parallel forms |
156 |
|
(cond ((null? forms) '(begin)) |
157 |
|
((null? (cdr forms)) (car forms)) |
158 |
|
(else |
159 |
|
(let* ((m (make-symbol "m")) |
160 |
|
(c (make-symbol "c")) |
161 |
|
(counter (make-symbol "counter")) |
162 |
|
(sync (make-symbol "sync")) |
163 |
|
(n-forms (length forms)) |
164 |
|
(vars (map (lambda (i) |
165 |
|
(make-symbol (string-append "res" |
166 |
|
(number->string i)))) |
167 |
|
(iota n-forms)))) |
168 |
|
`(let* ((,m (make-mutex)) |
169 |
|
(,c (make-condition-variable)) |
170 |
|
(,counter ,(- n-forms 1)) |
171 |
|
(,sync (lambda () |
172 |
|
(lock-mutex ,m) |
173 |
|
(if (zero? ,counter) |
174 |
|
(signal-condition-variable ,c) |
175 |
|
(set! ,counter (- ,counter 1))) |
176 |
|
(unlock-mutex ,m))) |
177 |
|
,@(map (lambda (var) |
178 |
|
`(,var #f)) |
179 |
|
vars)) |
180 |
|
(lock-mutex ,m) |
181 |
|
,@(map (lambda (var form) |
182 |
|
`(call-with-new-thread (lambda () |
183 |
|
(set! ,var ,form) |
184 |
|
(,sync)) |
185 |
|
%thread-handler)) |
186 |
|
vars |
187 |
|
forms) |
188 |
|
(wait-condition-variable ,c ,m) |
189 |
|
(values ,@vars)))))) |
190 |
|
|
191 |
(defmacro with-mutex (m . body) |
(defmacro with-mutex (m . body) |
192 |
`(dynamic-wind |
`(dynamic-wind |
193 |
(lambda () (lock-mutex ,m)) |
(lambda () (lock-mutex ,m)) |