Add some code

c_src/tiw_port_timer.c

@@ -0,0 +1,65 @@
+#include <stdio.h>
+#include <erl_driver.h>
+
+#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);
+}

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

rebar.config

@@ -0,0 +1,3 @@
+{port_specs,
+ [{".*", "priv/tiw_port_timer.so", ["c_src/tiw_port_timer.c"], []}]
+}.

src/tiw.app.src

@@ -0,0 +1,14 @@
+{application, tiw,
+ [
+  {description, "timer wheel helper"},
+  {vsn, "1"},
+  {modules, [
+             tiw
+            ]},
+  {registered, []},
+  {applications, [
+                  kernel,
+                  stdlib
+                 ]},
+  {env, []}
+ ]}.

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) ->
+    << <<C>> || <<C>> <= Binary, C =/= $\r, C =/= $\n >>.

src/tiw.hrl

@@ -0,0 +1 @@
+-record(timer, {expires_in = 0, callback, info}).

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, <<Timeout:32>>),
+            receive
+                {Port, {data, <<"timeout">>}} ->
+                    ok
+            end
+    end.