[gambit-list] gcc stage timing
Lang Martin
lang-gb at coptix.com
Mon Oct 16 14:57:45 EDT 2006
quoth Christian:
> To proove my point, I've put together a parallel map implementation
> (see attachment; semaphore implementation based on example from the
> manual). I haven't tested it on Marc's code, since I don't have a
> multiprocessor machine.
I just made a parallel map myself the other day, but mine's pretty
different. So, for the sake of posterity, I've attached it.
0) it's actually a for-each here. Moreover, it's a poorly named
for-each that returns the number of iterations.
0.1) Several of these maps operate on streams, I defined those
myself, in terms of (fold-anything cons car cdr null? nil list).
1) it's still a bit incomplete. There's no parallel limit -- I'm going
to capture out of memory exceptions instead. I don't like the idea
of a limit -- I want to go until I run out of juice.
2) Some of the names are bit fanciful and/or incorrect -- it's a
weakness of mine. "Incorrect" is a result of being a new scheme
programmer, and new to formal computing terms in general;
"fanciful" is exhibited by the name "kermit", because it's
reporter, you see, and I was wearing a sesame street t-shirt at
coding time.
3) I have tested this, and it's performance was entirely satisfactory.
4) the reporting thread exits when it's received as many messages as
the count stored in it's specific field. the main loop joins the
reporting thread with a timeout, which is my el-cheapo method for
dropping pending operations on the floor, since they will errors
after some point in time for my purposes.
Criticism welcome.
Lang
-------------- next part --------------
#!/usr/local/bin/gsi-script
(include "~~/lang at coptix.com/corps.scm")
(define-macro (debug . stuff)
`(warning-message
"debug" #f , at stuff #\newline))
(define (with-threads fn catcher-thread)
(lambda (x)
(thread-start!
(make-thread
(lambda ()
(thread-send
catcher-thread
(fn x)))))))
(define (make-reporting-thread fn! . timeout)
(let* ((sleep-time (if (null? timeout) 1 (car timeout)))
(th (make-thread
(lambda ()
(thread-report
fn!
(lambda () (thread-sleep! sleep-time)))))))
(thread-specific-set! th -1)
(thread-start! th)))
(define (thread-report fn! pause!)
(let ((nada (gensym))
(total (lambda () (thread-specific (current-thread)))))
(let lp ((count 0) (debug '()))
(pause!)
(cond
((= count (total)) debug)
(else
(lp (fold-lazy
(lambda (x acc) (fn! x) (++ acc))
count
(make-lazy
(lambda (exit)
(let ((r (thread-receive 0 nada)))
(cond
((eqv? r nada) (exit))
(else r))))))
(cons (list count: count total: (total))
debug)))))))
(define (reporter-total! th total)
(thread-specific-set! th total))
;;;; Specifics
(define queue
(make-lazy
(lambda (exit)
(or (get-recips-sql)
(exit)))))
(define kermit
(make-reporting-thread
(lambda (x)
(sql-send-reports x))))
(define (main2)
(reporter-total!
kermit
(for-each-lazy
(with-threads
(lambda (r)
(send-message helo sender r message))
kermit)
queue))
(thread-join! kermit))
More information about the Gambit-list
mailing list