blob: 400421b2f6f8c190988c24ae45422bb3d5d09407 (
about) (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
|
#!/usr/bin/env guile
# -*- scheme -*-
!#
(use-modules (ice-9 match)
(fibers)
(fibers channels))
(define (run-ping-pong message-count)
(let ((ch (make-channel)))
(spawn-fiber (lambda ()
(let lp ()
(put-message ch (get-message ch))
(lp))))
(let lp ((n 0))
(when (< n message-count)
(put-message ch n)
(get-message ch)
(lp (1+ n))))))
(define (test pair-count message-count)
(let ((done (make-channel)))
(for-each (lambda (_)
(spawn-fiber (lambda ()
(run-ping-pong message-count)
(put-message done 'done))
#:parallel? #t))
(iota pair-count))
(for-each (lambda (_) (get-message done))
(iota pair-count))))
(define (main args)
(match args
((_ pair-count message-count)
(let ((pair-count (string->number pair-count))
(message-count (string->number message-count)))
(run-fibers (lambda () (test pair-count message-count)))))))
(when (batch-mode?) (main (program-arguments)))
|