/[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.15 by mdj, Wed Dec 18 11:00:56 2002 UTC revision 1.16 by mdj, Thu Jan 23 16:04:06 2003 UTC
# Line 1  Line 1 
1  ;;;;    Copyright (C) 1996, 1998, 2001, 2002 Free Software Foundation, Inc.  ;;;;    Copyright (C) 1996, 1998, 2001, 2002, 2003 Free Software Foundation, Inc.
2  ;;;;  ;;;;
3  ;;;; This program is free software; you can redistribute it and/or modify  ;;;; This program is free software; you can redistribute it and/or modify
4  ;;;; 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
# Line 73  Line 73 
73    
74    
75  (define ((par-mapper mapper)  proc . arglists)  (define ((par-mapper mapper)  proc . arglists)
76    (mapper join-thread    (mapper future-ref
77            (apply map            (apply map
78                   (lambda args                   (lambda args
79                     (call-with-new-thread (lambda ()                     (future (apply proc args)))
                                            (apply proc args))  
                                          %thread-handler))  
80                   arglists)))                   arglists)))
81    
82  (define par-map (par-mapper map))  (define par-map (par-mapper map))
# Line 86  Line 84 
84    
85  (define (n-par-map n proc . arglists)  (define (n-par-map n proc . arglists)
86    (let* ((m (make-mutex))    (let* ((m (make-mutex))
87           (threads '())           (futures '())
88           (results (make-list (length (car arglists))))           (results (make-list (length (car arglists))))
89           (result results))           (result results))
90      (do ((i 0 (+ 1 i)))      (do ((i 0 (+ 1 i)))
91          ((= i n)          ((= i n)
92           (for-each join-thread threads)           (for-each future-ref futures)
93           results)           results)
94        (set! threads        (set! futures
95              (cons (call-with-new-thread              (cons (future
96                     (lambda ()                     (let loop ()
97                       (let loop ()                       (lock-mutex m)
98                         (lock-mutex m)                       (if (null? result)
99                         (if (null? result)                           (unlock-mutex m)
100                             (let ((args (map car arglists))
101                                   (my-result result))
102                               (set! arglists (map cdr arglists))
103                               (set! result (cdr result))
104                             (unlock-mutex m)                             (unlock-mutex m)
105                             (let ((args (map car arglists))                             (set-car! my-result (apply proc args))
106                                   (my-result result))                             (loop)))))
107                               (set! arglists (map cdr arglists))                    futures)))))
                              (set! result (cdr result))  
                              (unlock-mutex m)  
                              (set-car! my-result (apply proc args))  
                              (loop)))))  
                    %thread-handler)  
                   threads)))))  
108    
109  (define (n-par-for-each n proc . arglists)  (define (n-par-for-each n proc . arglists)
110    (let ((m (make-mutex))    (let ((m (make-mutex))
111          (threads '()))          (futures '()))
112      (do ((i 0 (+ 1 i)))      (do ((i 0 (+ 1 i)))
113          ((= i n)          ((= i n)
114           (for-each join-thread threads))           (for-each future-ref futures))
115        (set! threads        (set! futures
116              (cons (call-with-new-thread              (cons (future
117                     (lambda ()                     (let loop ()
118                       (let loop ()                       (lock-mutex m)
119                         (lock-mutex m)                       (if (null? (car arglists))
120                         (if (null? (car arglists))                           (unlock-mutex m)
121                             (let ((args (map car arglists)))
122                               (set! arglists (map cdr arglists))
123                             (unlock-mutex m)                             (unlock-mutex m)
124                             (let ((args (map car arglists)))                             (apply proc args)
125                               (set! arglists (map cdr arglists))                             (loop)))))
126                               (unlock-mutex m)                    futures)))))
                              (apply proc args)  
                              (loop)))))  
                    %thread-handler)  
                   threads)))))  
127    
128  (define (thread-handler tag . args)  (define (thread-handler tag . args)
129    (fluid-set! the-last-stack #f)    (fluid-set! the-last-stack #f)

Legend:
Removed from v.1.15  
changed lines
  Added in v.1.16

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