Noddy pingpong tests of erlang and plain racket thread IPC

This commit is contained in:
Tony Garnock-Jones 2014-05-14 17:13:02 -04:00
parent e424476a05
commit 9484ecbfbc
2 changed files with 65 additions and 0 deletions

41
pingpong.erl Normal file
View File

@ -0,0 +1,41 @@
-module(pingpong).
-export([oneway/0, consumer/0, pingpong/0]).
oneway() ->
N = 10000000,
Pid = spawn(?MODULE, consumer, []),
Start = erlang:now(),
dotimes(N - 1, fun () -> Pid ! message end),
Pid ! {done, self()},
receive ok -> ok end,
Stop = erlang:now(),
N / time_diff(Start, Stop).
pingpong() ->
N = 10000000,
Pid = spawn(?MODULE, consumer, []),
Start = erlang:now(),
Message = {ping, self()},
dotimes(N, fun () ->
Pid ! Message,
receive pong -> ok end
end),
Stop = erlang:now(),
N / time_diff(Start, Stop).
consumer() ->
receive
message -> consumer();
{done, Pid} -> Pid ! ok;
{ping, Pid} ->
Pid ! pong,
consumer()
end.
dotimes(0, _) -> done;
dotimes(N, F) ->
F(),
dotimes(N - 1, F).
time_diff({A1,A2,A3}, {B1,B2,B3}) ->
(B1 - A1) * 1000000 + (B2 - A2) + (B3 - A3) / 1000000.0 .

24
pingpong.rkt Normal file
View File

@ -0,0 +1,24 @@
#lang racket
(define echoer
(thread
(lambda ()
(let loop ()
(define source (thread-receive))
(thread-send source #t)
(loop)))))
(define LIMIT 10000000)
(define start-time (current-inexact-milliseconds))
(let loop ((n 0))
(when (< n LIMIT)
(thread-send echoer (current-thread))
(thread-receive)
(loop (+ n 1))))
(define stop-time (current-inexact-milliseconds))
(define deltasec (/ (- stop-time start-time) 1000.0))
(define roundtrip-hz (/ LIMIT deltasec))
(printf "~v roundtrips/sec, i.e. ~v messages/sec\n"
roundtrip-hz
(* 2 roundtrip-hz))
(printf "That's a per-message latency of ~v\n" (/ (* 2 roundtrip-hz)))