/[guile]/guile/guile-core/ice-9/threads.scm
ViewVC logotype

Diff of /guile/guile-core/ice-9/threads.scm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.11 by mvo, Sun Oct 27 17:27:25 2002 UTC revision 1.12 by mdj, Wed Dec 4 22:06:15 2002 UTC
# Line 57  Line 57 
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))
# Line 103  Line 152 
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))

Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26