diff --git a/c_src/tiw_port_timer.c b/c_src/tiw_port_timer.c new file mode 100644 index 0000000..73260f4 --- /dev/null +++ b/c_src/tiw_port_timer.c @@ -0,0 +1,65 @@ +#include +#include + +#define get_int32(s) ((((unsigned char*) (s))[0] << 24) | \ + (((unsigned char*) (s))[1] << 16) | \ + (((unsigned char*) (s))[2] << 8) | \ + (((unsigned char*) (s))[3])) + +static ErlDrvData timer_start(ErlDrvPort, char*); +static void timer_stop(ErlDrvData); +static void timer_read(ErlDrvData, char*, ErlDrvSizeT); +static void timer(ErlDrvData); + +static ErlDrvEntry timer_driver_entry = +{ + NULL, + timer_start, + timer_stop, + timer_read, + NULL, + NULL, + "tiw_port_timer", + NULL, + NULL, + NULL, + timer, + NULL, + NULL, + NULL, + NULL, + NULL, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, + NULL, + NULL, + NULL +}; + +DRIVER_INIT(tiw_port_timer) +{ + return &timer_driver_entry; +} + +static ErlDrvData timer_start(ErlDrvPort port, char *buf) +{ + return (ErlDrvData)port; +} + +static void timer_read(ErlDrvData p, char *buf, ErlDrvSizeT len) +{ + ErlDrvPort port = (ErlDrvPort) p; + driver_set_timer(port, get_int32(buf)); +} + +static void timer_stop(ErlDrvData port) +{ +} + +static void timer(ErlDrvData port) +{ + char* reply = "timeout"; + driver_output((ErlDrvPort)port, reply, 7); +} diff --git a/priv/tiw.in b/priv/tiw.in new file mode 100644 index 0000000..5314e39 --- /dev/null +++ b/priv/tiw.in @@ -0,0 +1,98 @@ +define tiw-slot + set $p = tiw[$arg0] + while ($p != 0 && $arg0 == $p->slot) + printf "%d\n%d\n", $p->slot, $p->count + if (etp_smp_compiled) + tiw-timeout-symbol-smp + else + tiw-timeout-symbol-nosmp + end + printf "\n" + set $p = $p->next + end +end + +define tiw-timeout-symbol-nosmp + if $p->timeout == &timeout_proc + tiw-timeout-proc + else + if $p->timeout == &schedule_port_timeout + tiw-timeout-port + else + if $p->timeout == &bif_timer_timeout + tiw-timeout-bif_timer + else + if $p->timeout == &aux_work_timeout + tiw-timeout-aux_work + end + end + end + end +end + +define tiw-timeout-symbol-smp + if $p->timeout == &ptimer_timeout + tiw-timeout-ptimer + else + if $p->timeout == &bif_timer_timeout + tiw-timeout-bif_timer + else + if $p->timeout == &aux_work_timeout + tiw-timeout-aux_work + end + end + end +end + +## auxiliary work +define tiw-timeout-aux_work + printf "aux_work_timeout\nNULL\n" +end + +## timers initiated by erlang:send_after/3 and erlang:start_timer/3 bifs +define tiw-timeout-bif_timer + printf "bif_timer_timeout\n" + etp-pid-1 ((ErtsBifTimer*)($p->arg))->receiver.proc->ess->common.id + printf " ! " + etp ((ErtsBifTimer*)($p->arg))->message +end + +## process timeout ('receive ... after' block, so also timer:sleep/1) for smp +define tiw-timeout-ptimer + printf "ptimer_timeout\n" + etp-pid-1 ((ErtsSmpPTimer*)($p->arg))->timer->id + printf " | " + etp-port-1 ((ErtsSmpPTimer*)($p->arg))->timer->id + printf "\n" +end + +## process timeout but without smp +define tiw-timeout-proc + printf "timeout_proc\n" + etp-pid-1 ((Process*)($p->arg))->common.id + printf "\n" +end + +## port timeout +define tiw-timeout-port + printf "schedule_port_timeout\n" + etp-port-1 ((Port*)($p->arg))->common.id + printf "\n" +end + +define tiw + printf "=== tiw start\n" + printf "%d\n", tiw_pos + + set $TIW_SIZE = 65536 + set $i = tiw_pos + tiw-slot $i + set $i = ($i+1) % $TIW_SIZE + while ($i != tiw_pos) + tiw-slot $i + set $i = ($i+1) % $TIW_SIZE + end + printf "=== tiw end\n" +end + +# vi: ft=gdb diff --git a/rebar b/rebar new file mode 100755 index 0000000..182f5d1 Binary files /dev/null and b/rebar differ diff --git a/rebar.config b/rebar.config new file mode 100644 index 0000000..efd7c09 --- /dev/null +++ b/rebar.config @@ -0,0 +1,3 @@ +{port_specs, + [{".*", "priv/tiw_port_timer.so", ["c_src/tiw_port_timer.c"], []}] +}. diff --git a/src/tiw.app.src b/src/tiw.app.src new file mode 100644 index 0000000..a9c83eb --- /dev/null +++ b/src/tiw.app.src @@ -0,0 +1,14 @@ +{application, tiw, + [ + {description, "timer wheel helper"}, + {vsn, "1"}, + {modules, [ + tiw + ]}, + {registered, []}, + {applications, [ + kernel, + stdlib + ]}, + {env, []} + ]}. diff --git a/src/tiw.erl b/src/tiw.erl new file mode 100644 index 0000000..a3ae09d --- /dev/null +++ b/src/tiw.erl @@ -0,0 +1,79 @@ +-module(tiw). + +-compile(export_all). + +-include("tiw.hrl"). + +-define(TIW_SIZE, 65536). + +load(TiwFile) -> + [Pos|Lines] = read_lines(TiwFile), + parse_timers(Lines, i(Pos), []). + +buckets(Timers, Interval) -> + Ranges = ranges(Timers, Interval), + [ {Range, length(Results)} || {Range, Results} <- Ranges, + Results =/= [] ]. + +ranges(Timers, Interval) -> + Last = lists:last(Timers), + ranges(Timers, Interval, Last#timer.expires_in+Interval, Interval, []). + +ranges(_, Current, Max, _, Acc) when Current > Max -> + lists:reverse(Acc); +ranges(Timers, Current, Max, Interval, Acc0) -> + Pred = fun(#timer{expires_in = Exp}) when Exp < Current -> + true; + (#timer{}) -> + false + end, + {Cool, Uncool} = lists:splitwith(Pred, Timers), + Acc1 = [{{Current-Interval, Current-1}, Cool} | Acc0], + ranges(Uncool, Current+Interval, Max, Interval, Acc1). + +read_lines(TiwFile) -> + {ok, File} = file:open(TiwFile, [read, binary]), + Result = do_read_lines(line(File), File), + ok = file:close(File), + Result. + +parse_timers([], _, Acc) -> + lists:keysort(#timer.expires_in, Acc); +parse_timers([_, _, _, <<>> | Rest], Pos, Acc) -> + %% ignore incompatible format + parse_timers(Rest, Pos, Acc); +parse_timers([Slot, Count, Callback, Info, <<>> | Rest], Pos, Acc) -> + Timer = #timer{expires_in = expiration(Pos, i(Slot), i(Count)), + callback = binary_to_atom(Callback, utf8), + info = Info}, + parse_timers(Rest, Pos, [Timer | Acc]). + +expiration(Pos, Slot, Count) when Slot > Pos -> + Slot - Pos + (Count * ?TIW_SIZE); +expiration(Pos, Slot, Count) -> + ((?TIW_SIZE - Pos) + Slot) + (Count * ?TIW_SIZE). + +%% discard prefix +do_read_lines(eof, _File) -> + erlang:error(tiw_block_not_found); +do_read_lines({ok, <<"=== tiw start\n">>}, File) -> + do_read_lines(line(File), File, []); +do_read_lines(_, File) -> + do_read_lines(line(File), File). + +%% actual data +do_read_lines(eof, _, Acc) -> + lists:reverse(Acc); +do_read_lines({ok, <<"=== tiw end\n">>}, _, Acc) -> + lists:reverse(Acc); +do_read_lines({ok, Line}, File, Acc) -> + do_read_lines(line(File), File, [strip(Line)|Acc]). + +i(Binary) -> + binary_to_integer(Binary). + +line(File) -> + file:read_line(File). + +strip(Binary) -> + << <> || <> <= Binary, C =/= $\r, C =/= $\n >>. diff --git a/src/tiw.hrl b/src/tiw.hrl new file mode 100644 index 0000000..856e098 --- /dev/null +++ b/src/tiw.hrl @@ -0,0 +1 @@ +-record(timer, {expires_in = 0, callback, info}). diff --git a/src/tiw_example.erl b/src/tiw_example.erl new file mode 100644 index 0000000..91be2a3 --- /dev/null +++ b/src/tiw_example.erl @@ -0,0 +1,35 @@ +-module(tiw_example). + +-compile(export_all). + +process_timers(N, Ms) -> + [ spawn_link(fun() -> + receive + after I*Ms -> + ok + end + end) || I <- lists:seq(1, N) ]. + +bif_timers(N, Ms) -> + [ begin + Pid = spawn_link(fun() -> + receive + _ -> ok + end + end), + erlang:send_after(I*Ms, Pid, {msg, I}) + end || I <- lists:seq(1, N) ]. + +port_timers(N, Ms) -> + ok = erl_ddll:load_driver("priv", "tiw_port_timer"), + [ spawn_link(port_timer_fun(I*Ms)) || I <- lists:seq(1, N) ]. + +port_timer_fun(Timeout) -> + fun() -> + Port = erlang:open_port({spawn, tiw_port_timer}, [binary]), + true = erlang:port_command(Port, <>), + receive + {Port, {data, <<"timeout">>}} -> + ok + end + end.