diff options
Diffstat (limited to 'benchmarks')
| -rw-r--r-- | benchmarks/Makefile | 6 | ||||
| -rw-r--r-- | benchmarks/local-ping-pong.scm | 39 |
2 files changed, 44 insertions, 1 deletions
diff --git a/benchmarks/Makefile b/benchmarks/Makefile index bb6065f..cc1c7fb 100644 --- a/benchmarks/Makefile +++ b/benchmarks/Makefile @@ -1,10 +1,11 @@ chain_csv:=chain-0.csv chain-10.csv chain-100.csv ping_pong_csv:=ping-pong-10.csv ping-pong-100.csv +local_ping_pong_csv:=local-ping-pong-10.csv local-ping-pong-100.csv fan_out_csv:=fan-out-10.csv fan-out-100.csv diagonal_csv:=diagonal-10.csv diagonal-100.csv sieve_csv:=sieve-2000.csv -csv:=$(chain_csv) $(ping_pong_csv) $(fan_out_csv) $(diagonal_csv) $(sieve_csv) +csv:=$(chain_csv) $(ping_pong_csv) $(local_ping_pong_csv) $(fan_out_csv) $(diagonal_csv) $(sieve_csv) all: $(csv) @@ -14,6 +15,9 @@ chain-%.csv: ping-pong-%.csv: ../env guile ./scale-bench guile ping-pong.scm $* '#e1e4' | tee $@ +local-ping-pong-%.csv: + ../env guile ./scale-bench guile local-ping-pong.scm $* '#e1e4' | tee $@ + fan-out-%.csv: ../env guile ./scale-bench guile fan-out.scm $* '#e1e5' | tee $@ diff --git a/benchmarks/local-ping-pong.scm b/benchmarks/local-ping-pong.scm new file mode 100644 index 0000000..400421b --- /dev/null +++ b/benchmarks/local-ping-pong.scm @@ -0,0 +1,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))) |