[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