chicken-users
[Top][All Lists]

 From: Dale Jordan Subject: [Chicken-users] thread-flow benchmark Date: Sun, 13 Mar 2005 17:59:46 -0800 User-agent: Mozilla Thunderbird 0.7.3 (X11/20040904)

Since I didn't have anything better to do on a Sunday afternoon I thought I'd learn how chicken threads worked. Attached is my contribution to your benchmark challenge.
```
Dale Jordan
```
```;;;; thread-flow benchmark

;     * create a chain of 3000 threads such that:
;                 + can receive an integer message
;                 + can store the received message
;                 + knows the next thread in the chain
;                 + can send the integer message + 1 to the next thread
;           o the last thread in the chain is different, it:
;                 + can receive an integer message
;                 + can store the sum of received messages
;                 + there is no next thread
;     * N times: send the integer message 0 to the first thread
;     * print the sum of messages received by the last thread

; Correct output N = 200 is:

; 600000

(require-extension srfi-18)

(define (make-channel)                  ; => channel
(let ((write-mutex (make-mutex))
(val #f))
(let ((t val))
(mutex-unlock! write-mutex)
t))
(define (write new-val)
(mutex-lock! write-mutex #f #f)
(set! val new-val)
(lambda (which)
(case which
((write) write)))))

;;; make thread chain connected by channels

(define (build-chain n chan0)           ; => channel-n
(lambda ()
(write (out 'write)))
(let loop ()
(loop)))))))
(let loop ((i n) (in chan0) (out (make-channel)))
(if (zero? i)
in
(begin
(loop (- i 1) out (make-channel))))))

;;; the last thread which accumulates the sum

(lambda ()
(write (out 'write)))
(let loop ((i 1) (n 0) (j (read)))
(let ((n- (+ n j)))
(if (= i iterations)
(write n-)
(loop (+ 1 i) n- (read))))))))))

;;; driver

(let* ((chan-0 (make-channel))
(chan-n (make-channel)))
(let ((write (chan-0 'write))
(let loop ((i 0))
(if (= i iterations)
(begin
(display "Sum is ") (display (read))
(newline))
(begin
(write 0)
(loop (+ 1 i))))))))

(define (main args)
(case (length args)
((0) (doit 3000 200))
((1) (doit 3000 (string->number (car args))))
((2) (doit (string->number (cadr args)) (string->number (car args))))
(else