%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2002-2013. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%% http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
%% %CopyrightEnd%
-module(estone_SUITE).
%% Test functions
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,estone/1,estone_bench/1]).
-export([init_per_testcase/2, end_per_testcase/2]).
%% Internal exports for EStone tests
-export([lists/1,
msgp/1,
msgp_medium/1,
msgp_huge/1,
pattern/1,
trav/1,
port_io/1,
large_dataset_work/1,
large_local_dataset_work/1,mk_big_procs/1,big_proc/0, very_big/1,
alloc/1,
bif_dispatch/1,
binary_h/1,echo/1,
ets/1,
generic/1,req/2,gserv/4,handle_call/3,
int_arith/1,
float_arith/1,
fcalls/1,remote0/1,remote1/1,app0/1,app1/1,
timer/1,
links/1,lproc/1,
run_micro/3,p1/1,ppp/3,macro/2,micros/0]).
-include_lib("common_test/include/ct.hrl").
-include_lib("common_test/include/ct_event.hrl").
%% Test suite defines
-define(default_timeout, ?t:minutes(10)).
%% EStone defines
-define(TOTAL, (3000 * 1000 * 100)). %% 300 secs
-define(BIGPROCS, 2).
-define(BIGPROC_SIZE, 50).
-define(STONEFACTOR, 31000000). %% Factor to make the reference
%% implementation to make 1000 TS_ESTONES.
-record(micro,
{function, %% The name of the function implementing the micro
weight, %% How important is this in typical applications ??
loops = 100,%% initial data
tt1, %% time to do one round
str}). %% Header string
init_per_testcase(_Case, Config) ->
?line Dog=test_server:timetrap(?default_timeout),
[{watchdog, Dog}|Config].
end_per_testcase(_Case, Config) ->
Dog=?config(watchdog, Config),
?t:timetrap_cancel(Dog),
ok.
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[estone].
groups() ->
[{estone_bench, [{repeat,50}],[estone_bench]}].
init_per_suite(Config) ->
Config.
end_per_suite(_Config) ->
ok.
init_per_group(_GroupName, Config) ->
Config.
end_per_group(_GroupName, Config) ->
Config.
estone(suite) ->
[];
estone(doc) ->
["EStone Test"];
estone(Config) when is_list(Config) ->
?line DataDir = ?config(data_dir,Config),
?line Mhz=get_cpu_speed(os:type(),DataDir),
?line L = ?MODULE:macro(?MODULE:micros(),DataDir),
?line {Total, Stones} = sum_micros(L, 0, 0),
?line pp(Mhz,Total,Stones,L),
?line {comment,Mhz ++ " MHz, " ++
integer_to_list(Stones) ++ " ESTONES"}.
estone_bench(Config) ->
DataDir = ?config(data_dir,Config),
L = ?MODULE:macro(?MODULE:micros(),DataDir),
[ct_event:notify(
#event{name = benchmark_data,
data = [{name,proplists:get_value(title,Mark)},
{value,proplists:get_value(estones,Mark)}]})
|| Mark <- L],
L.
%%
%% Calculate CPU speed
%%
%% get_cpu_speed() now returns a string. For multiprocessor
%% machines (at least on Solaris) the format is: <F1>+<F2>[+...]
%%
get_cpu_speed({win32, _},_DataDir) ->
RegH =
case catch win32reg:open([read]) of
{ok, Handle} ->
Handle;
_ ->
io:format("Error.~nCannot determine CPU clock"
"frequency.~n"
"Please set the environment variable"
"\"CPU_SPEED\"~n"),
exit(self(), {error, no_cpu_speed})
end,
case win32reg:change_key(RegH,"\\hkey_local_machine\\hardware\\"
"description\\system\\centralprocessor"
"\\0") of
ok ->
ok;
_ ->
io:format("Error.~nRegistry seems to be damaged or"
"unavailable.~n"
"Please set the environment variable"
"\"CPU_SPEED\",~nor correct your registry"
"if possible.~n"),
win32reg:close(RegH),
exit(self(), {error, no_cpu_speed})
end,
case win32reg:value(RegH, "~MHZ") of
{ok, Speed} ->
win32reg:close(RegH),
integer_to_list(Speed);
_ ->
io:format("Error.~nRegistry seems to be damaged or "
"unavailable.~n"),
io:format("Please set the environment variable"
"\"CPU_SPEED\"~n"),
win32reg:close(RegH),
exit(self(), {error, no_cpu_speed})
end;
get_cpu_speed({unix, sunos},DataDir) ->
os:cmd(filename:join(DataDir,"sunspeed.sh")) -- "\n";
get_cpu_speed(_Other,_DataDir) ->
%% Cannot determine CPU speed
"UNKNOWN".
%%
%% Pretty Print EStone Result
%%
pp(Mhz,Total,Stones,Ms) ->
io:format("EStone test completed~n",[]),
io:format("**** CPU speed ~s MHz ****~n",[Mhz]),
io:format("**** Total time ~w seconds ****~n", [Total / 1000000]),
io:format("**** ESTONES = ~w ****~n~n", [Stones]),
io:format("~-31s ~-12s ~-10s % ~-10s ~n~n",
[" Title", "Millis", "Estone", "Loops"]),
erlang:display({'ESTONES', Stones}),
pp2(Ms).
sum_micros([], Tot, Stones) -> {Tot, Stones};
sum_micros([H|T], Tot, Sto) ->
sum_micros(T, ks(microsecs, H) + Tot, ks(estones, H) + Sto).
pp2([]) -> ok;
pp2([R|Tail]) ->
io:format("~-35s ~-12w ~-10w ~-2w ~-10w ~n",
[ks(title,R),
round(ks(microsecs, R) / 1000),
ks(estones, R),
ks(weight_percentage, R),
ks(loops, R)]),
pp2(Tail).
ks(K, L) ->
{value, {_, V}} = lists:keysearch(K, 1, L),
V.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% EStone test
micro(lists) ->
#micro{function = lists,
weight = 7,
loops = 6400,
str = "list manipulation"};
micro(msgp) ->
#micro{function = msgp,
weight = 10,
loops = 1515,
str = "small messages"};
micro(msgp_medium) ->
#micro{function = msgp_medium,
weight = 14,
loops = 1527,
str = "medium messages"};
micro(msgp_huge) ->
#micro{function = msgp_huge,
weight = 4,
loops = 52,
str = "huge messages"};
micro(pattern) ->
#micro{function = pattern,
weight = 5,
loops = 1046,
str = "pattern matching"};
micro(trav) ->
#micro{function = trav,
weight = 4,
loops = 2834,
str = "traverse"};
micro(port_io) ->
#micro{function = port_io,
weight = 12,
loops = 4800,
str = "Port i/o"};
micro(large_dataset_work) ->
#micro{function = large_dataset_work,
weight = 3,
loops = 1193,
str = "Work with large dataset"};
micro(large_local_dataset_work) ->
#micro{function = large_local_dataset_work,
weight = 3,
loops = 1174,
str = "Work with large local dataset"};
micro(alloc) ->
#micro{function = alloc,
weight = 2,
loops = 3710,
str = "Alloc and dealloc"};
micro(bif_dispatch) ->
#micro{function = bif_dispatch,
weight = 5,
loops = 1623,
str = "Bif dispatch"};
micro(binary_h) ->
#micro{function = binary_h,
weight = 4,
loops = 581,
str = "Binary handling"};
micro(ets) ->
#micro{function = ets,
weight = 6,
loops = 342,
str = "ets datadictionary"};
micro(generic) ->
#micro{function = generic,
weight = 9,
loops = 7977,
str = "Generic server (with timeout)"};
micro(int_arith) ->
#micro{function = int_arith,
weight = 3,
loops = 4157,
str = "Small Integer arithmetics"};
micro(float_arith) ->
#micro{function = float_arith,
weight = 1,
loops = 5526,
str = "Float arithmetics"};
micro(fcalls) ->
#micro{function = fcalls,
weight = 5,
loops = 882,
str = "Function calls"};
micro(timer) ->
#micro{function = timer,
weight = 2,
loops = 2312,
str = "Timers"};
micro(links) ->
#micro{function = links,
weight = 1,
loops = 30,
str = "Links"}.
%% Return a list of micro's
micros() ->
[
micro(lists),
micro(msgp),
micro(msgp_medium),
micro(msgp_huge),
micro(pattern),
micro(trav),
micro(port_io),
micro(large_dataset_work),
micro(large_local_dataset_work),
micro(alloc),
micro(bif_dispatch),
micro(binary_h),
micro(ets),
micro(generic),
micro(int_arith),
micro(float_arith),
micro(fcalls),
micro(timer),
micro(links)
].
macro(Ms,DataDir) ->
statistics(reductions),
statistics(runtime),
lists(500), %% fixup cache on first round
run_micros(Ms,DataDir).
run_micros([],_) ->
io:nl(),
[];
run_micros([H|T],DataDir) ->
R = run_micro(H,DataDir),
[R| run_micros(T,DataDir)].
run_micro(M,DataDir) ->
Pid = spawn(?MODULE, run_micro, [self(),M,DataDir]),
Res = receive {Pid, Reply} -> Reply end,
{value,{title,Title}} = lists:keysearch(title,1,Reply),
{value,{estones,Estones}} = lists:keysearch(estones,1,Reply),
erlang:display({Title,Estones}),
Res.
run_micro(Top, M, DataDir) ->
EstoneCat = filename:join(DataDir,"estone_cat"),
put(estone_cat,EstoneCat),
Top ! {self(), apply_micro(M)}.
apply_micro(M) ->
{GC0, Words0, _} = statistics(garbage_collection),
statistics(reductions),
Before = monotonic_time(),
Compensate = apply_micro(M#micro.function, M#micro.loops),
After = monotonic_time(),
{GC1, Words1, _} = statistics(garbage_collection),
{_, Reds} = statistics(reductions),
Elapsed = subtr(Before, After),
MicroSecs = Elapsed - Compensate,
[{title, M#micro.str},
{tt1, M#micro.tt1},
{function, M#micro.function},
{weight_percentage, M#micro.weight},
{loops, M#micro.loops},
{microsecs,MicroSecs},
{estones, (M#micro.weight * M#micro.weight * ?STONEFACTOR) div max(1,MicroSecs)},
{gcs, GC1 - GC0},
{kilo_word_reclaimed, (Words1 - Words0) div 1000},
{kilo_reductions, Reds div 1000},
{gc_intensity, gci(max(1,Elapsed), GC1 - GC0, Words1 - Words0)}].
monotonic_time() ->
try erlang:monotonic_time() catch error:undef -> erlang:now() end.
subtr(Before, After) when is_integer(Before), is_integer(After) ->
erlang:convert_time_unit(After-Before, native, micro_seconds);
subtr({_,_,_}=Before, {_,_,_}=After) ->
timer:now_diff(After, Before).
gci(Micros, Words, Gcs) ->
((256 * Gcs) / Micros) + (Words / Micros).
apply_micro(Name, Loops) ->
io:format("~w(~w)~n", [Name, Loops]),
apply(?MODULE, Name, [Loops]).
%%%%%%%%%%%% micro bench manipulating lists. %%%%%%%%%%%%%%%%%%%%%%%%%
lists(I) ->
L1 = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx",
L2 = "aaaaaaaaaa",
lists(I, L1, L2).
lists(0, _,_) ->
0;
lists(I, L1, L2) ->
revt(10, L1),
appt(10, L1, L2),
lists(I-1, L1, L2).
revt(0, _) ->
done;
revt(I, L) ->
reverse(L),
revt(I-1, L).
reverse(L) ->
reverse(L, []).
reverse([H|T], Ack) -> reverse(T, [H|Ack]);
reverse([], Ack) -> Ack.
append([H|T], L) ->
[H | append(T, L)];
append([], L) ->
L.
appt(0, _L1, _L2) -> ok;
appt(I, L1, L2) ->
append(L1, L2),
appt(I-1, L1, L2).
%%%%%%%%%%%%%%% small message passing and ctxt switching %%%%%%%
msgp(I) ->
msgp(I, small()).
msgp(0, _) ->
0;
msgp(I, Msg) ->
P1 = spawn(?MODULE, p1, [self()]),
P2 = spawn(?MODULE, p1, [P1]),
P3 = spawn(?MODULE, p1, [P2]),
P4 = spawn(?MODULE, p1, [P3]),
msgp_loop(100, P4, Msg),
msgp(I-1, Msg).
p1(To) ->
receive
{_From, {message, X}} ->
To ! {self(), {message, X}},
p1(To);
stop ->
To ! stop,
exit(normal)
end.
msgp_loop(0, P, _) ->
P ! stop,
receive
stop -> ok
end;
msgp_loop(I, P, Msg) ->
P ! {self(), {message, Msg}},
receive
{_From, {message, _}} ->
msgp_loop(I-1, P, Msg)
end.
%%%%%%%%%%%% large massage passing and ctxt switching %%%%%%%
msgp_medium(I) ->
msgp_medium(I, big()).
msgp_medium(0, _) ->
0;
msgp_medium(I, Msg) ->
P1 = spawn(?MODULE , p1, [self()]),
P2 = spawn(?MODULE, p1, [P1]),
P3 = spawn(?MODULE, p1, [P2]),
P4 = spawn(?MODULE, p1, [P3]),
msgp_loop(100, P4, Msg),
msgp_medium(I-1, Msg).
%%%%%%%%%%%% huge massage passing and ctxt switching %%%%%%%
msgp_huge(I) ->
msgp_huge(I, very_big(15)).
msgp_huge(0, _) ->
0;
msgp_huge(I, Msg) ->
P1 = spawn(?MODULE , p1, [self()]),
P4 = spawn(?MODULE, p1, [P1]),
msgp_loop(100, P4, Msg),
msgp_huge(I-1, Msg).
%%%%%% typical protocol pattern matching %%%%%%%
pattern(0) ->
0;
pattern(I) ->
Tail = "aaabbaaababba",
P1 = [0, 1,2,3,4,5|Tail],
pat_loop1(100, P1),
pat_loop2(100, P1),
pat_loop3(100, P1),
pat_loop4(100, P1),
pat_loop5(100, P1),
pattern(I-1).
pat_loop1(0, _) ->
ok;
pat_loop1(_I, [_, _X, _Y, 0 |_T]) ->
ok;
pat_loop1(_I, [_, _X, _Y, 1| _T]) ->
ok;
pat_loop1(_I, [_, _X, _Y, 2 | _T]) ->
ok;
pat_loop1(I, [_, X, Y, 3 | T]) ->
pat_loop1(I-1, [0, X,Y,3|T]).
pat_loop2(0, _) ->
ok;
pat_loop2(_I, [_X, Y | _Tail]) when Y bsl 1 == 0 ->
ok;
pat_loop2(_I, [_X, Y | _Tail]) when Y bsl 2 == 0 ->
ok;
pat_loop2(I, [X, Y | Tail]) when Y bsl 2 == 4 ->
pat_loop2(I-1, [X, Y |Tail]).
pat_loop3(0, _) ->
ok;
pat_loop3(_I, [{c, h} | _Tail]) ->
ok;
pat_loop3(_I, [1, 0 |_T]) ->
ok;
pat_loop3(_I, [X, _Y |_Tail]) when is_binary(X), size(X) == 1 ->
ok;
pat_loop3(_I, [no, _Y|_Tail]) ->
ok;
pat_loop3(_I, []) ->
ok;
pat_loop3(_I, [X,_Y|_T]) when X /= 0 ->
ok;
pat_loop3(_I, [2,3|_T]) ->
ok;
pat_loop3(_I, [1, 2]) ->
ok;
pat_loop3(I, [0, 1 |T]) ->
pat_loop3(I-1, [0,1|T]).
pat_loop4(0, _) -> ok;
pat_loop4(_I, [20|_T]) -> ok;
pat_loop4(_I, [219|_T]) -> ok;
pat_loop4(_I, [18|_T]) -> ok;
pat_loop4(_I, [17|_T]) -> ok;
pat_loop4(_I, [16|_T]) -> ok;
pat_loop4(_I, [15|_T]) -> ok;
pat_loop4(_I, [14|_T]) -> ok;
pat_loop4(_I, [13|_T]) -> ok;
pat_loop4(_I, [12|_T]) -> ok;
pat_loop4(_I, [11|_T]) -> ok;
pat_loop4(_I, [10|_T]) -> ok;
pat_loop4(_I, [9|_T]) -> ok;
pat_loop4(_I, [8|_T]) -> ok;
pat_loop4(_I, [7|_T]) -> ok;
pat_loop4(_I, [6|_T]) -> ok;
pat_loop4(_I, [5|_T]) -> ok;
pat_loop4(_I, [4|_T]) -> ok;
pat_loop4(_I, [3|_T]) -> ok;
pat_loop4(_I, [1|_T]) -> ok;
pat_loop4(_I, [21|_T]) -> ok;
pat_loop4(_I, [22|_T]) -> ok;
pat_loop4(_I, [23|_T]) -> ok;
pat_loop4(_I, [24|_T]) -> ok;
pat_loop4(_I, [25|_T]) -> ok;
pat_loop4(_I, [26|_T]) -> ok;
pat_loop4(_I, [27|_T]) -> ok;
pat_loop4(I, [0|T]) ->
pat_loop4(I-1, [0|T]).
pat_loop5(0, _) -> ok;
pat_loop5(_I, [0, 20|_T]) -> ok;
pat_loop5(_I, [0, 19|_T]) -> ok;
pat_loop5(_I, [0, 18|_T]) -> ok;
pat_loop5(_I, [0, 17|_T]) -> ok;
pat_loop5(_I, [0, 16|_T]) -> ok;
pat_loop5(_I, [0, 15|_T]) -> ok;
pat_loop5(_I, [0, 14|_T]) -> ok;
pat_loop5(_I, [0, 13|_T]) -> ok;
pat_loop5(_I, [0, 12|_T]) -> ok;
pat_loop5(_I, [0, 11|_T]) -> ok;
pat_loop5(_I, [0, 10|_T]) -> ok;
pat_loop5(_I, [0, 9|_T]) -> ok;
pat_loop5(_I, [0, 8|_T]) -> ok;
pat_loop5(_I, [0, 7|_T]) -> ok;
pat_loop5(_I, [0, 6|_T]) -> ok;
pat_loop5(I, [0, 1|T]) ->
pat_loop5(I-1, [0,1|T]).
%%%%%%%%%% term traversal representing simple pattern matchhing %%%
%%%%%%%%% + some arith
trav(I) ->
X = very_big(10),
trav(I, X).
trav(0, _) -> 0;
trav(I, T) ->
do_trav(T),
trav(I-1, T).
do_trav(T) when is_tuple(T) ->
tup_trav(T, 1, 1 + size(T));
do_trav([H|T]) ->
do_trav(H) + do_trav(T);
do_trav(X) when is_integer(X) -> 1;
do_trav(_X) -> 0.
tup_trav(_T, P, P) -> 0;
tup_trav(T, P, End) ->
do_trav(element(P, T)) + tup_trav(T, P+1, End).
%% Port I/O
port_io(I) ->
EstoneCat = get(estone_cat),
Before = monotonic_time(),
Pps = make_port_pids(5, I, EstoneCat), %% 5 ports
send_procs(Pps, go),
After = monotonic_time(),
wait_for_pids(Pps),
subtr(Before, After).
make_port_pids(0, _, _) ->
[];
make_port_pids(NoPorts, J, EstoneCat) ->
[spawn(?MODULE, ppp, [self(),J,EstoneCat]) | make_port_pids(NoPorts-1, J, EstoneCat)].
ppp(Top, I, EstoneCat) ->
P = open_port({spawn, EstoneCat}, []),%% cat sits at the other end
Str = lists:duplicate(200, 88), %% 200 X'es
Cmd = {self(), {command, Str}},
receive
go -> ok
end,
ppp_loop(P, I, Cmd),
Cmd2 = {self(), {command, "abcde"}},
Res = ppp_loop(P, I, Cmd2),
P ! {self(), close},
receive
{P, closed} ->
closed
end,
Top ! {self(), Res}.
ppp_loop(_P, 0, _) ->
ok;
ppp_loop(P, I, Cmd) ->
P ! Cmd,
receive
{P, _} -> %% no match
ppp_loop(P, I-1, Cmd)
end.
%% Working with a very large non-working data set
%% where the passive data resides in remote processes
large_dataset_work(I) ->
{Minus, Ps} = timer:tc(?MODULE, mk_big_procs, [?BIGPROCS]),
trav(I),
lists(I),
send_procs(Ps, stop),
Minus. %% Don't count time to create the big procs.
mk_big_procs(0) -> [];
mk_big_procs(I) ->
[ mk_big_proc()| mk_big_procs(I-1)].
mk_big_proc() ->
P = spawn(?MODULE, big_proc, []),
P ! {self(), running},
receive
{P, yes} -> P
end.
big_proc() ->
X = very_big(?BIGPROC_SIZE), %% creates a big heap
Y = very_big(?BIGPROC_SIZE),
Z = very_big(?BIGPROC_SIZE),
receive
{From, running} ->
From ! {self(), yes}
end,
receive
stop ->
{X, Y, Z} %% Can't be garbed away now by very (not super)
%% smart compiler
end.
%% Working with a large non-working data set
%% where the data resides in the local process.
large_local_dataset_work(I) ->
{Minus, _Data} = timer:tc(?MODULE, very_big, [?BIGPROC_SIZE]),
trav(I),
lists(I),
Minus.
%% Fast allocation and also deallocation that is gc test
%% Important to not let variable linger on the stack un-necessarily
alloc(0) -> 0;
alloc(I) ->
_X11 = very_big(),
_X12 = very_big(),
_X13 = very_big(),
_Z = [_X14 = very_big(),
_X15 = very_big(),
_X16 = very_big()],
_X17 = very_big(),
_X18 = very_big(),
_X19 = very_big(),
_X20 = very_big(),
_X21 = very_big(),
_X22 = very_big(),
_X23 = very_big(),
_X24 = very_big(),
alloc(I-1).
%% Time to call bif's
%% Lot's of element stuff which reflects the record code which
%% is becomming more and more common
bif_dispatch(0) ->
0;
bif_dispatch(I) ->
disp(), disp(), disp(), disp(), disp(), disp(),
disp(), disp(), disp(), disp(), disp(), disp(),
bif_dispatch(I-1).
disp() ->
Tup = {a},
L = [x],
self(),self(),self(),self(),self(),self(),self(),self(),self(),
make_ref(),
atom_to_list(''),
_X = list_to_atom([]),
tuple_to_list({}),
_X2 = list_to_tuple([]),
element(1, Tup),
element(1, Tup),
_Elem = element(1, Tup),element(1, Tup),element(1, Tup),element(1, Tup),
element(1, Tup),element(1, Tup),element(1, Tup),element(1, Tup),
element(1, Tup),element(1, Tup),element(1, Tup),element(1, Tup),
element(1, Tup),element(1, Tup),element(1, Tup),element(1, Tup),
setelement(1, Tup,k),
setelement(1, Tup,k),
setelement(1, Tup,k),setelement(1, Tup,k),setelement(1, Tup,k),
setelement(1, Tup,k),setelement(1, Tup,k),setelement(1, Tup,k),
setelement(1, Tup,k),
setelement(1, Tup,k),
setelement(1, Tup,k),
setelement(1, Tup,k),
_Y = setelement(1, Tup,k),
_Date = date(), time(),
put(a, 1),
get(a),
erase(a),
hd(L),
tl(L),
_Len = length(L),length(L),length(L),length(L),
node(),node(),node(),node(),node(),node(),node(),node(),
S=self(),
node(S),node(S),node(S),
size(Tup),
_W = whereis(code_server),whereis(code_server),
whereis(code_server),whereis(code_server),
whereis(code_server),whereis(code_server),
_W2 = whereis(code_server).
%% Generic server like behaviour
generic(I) ->
register(funky, spawn(?MODULE, gserv, [funky, ?MODULE, [], []])),
g_loop(I).
g_loop(0) ->
exit(whereis(funky), kill),
0;
g_loop(I) ->
?MODULE:req(funky, {call, [abc]}),
?MODULE:req(funky, {call, [abc]}),
?MODULE:req(funky, {call, [abc]}),
?MODULE:req(funky, {call, [abc]}),
?MODULE:req(funky, {call, [xyz]}),
?MODULE:req(funky, {call, [abc]}),
?MODULE:req(funky, {call, [abc]}),
?MODULE:req(funky, {call, [abc]}),
?MODULE:req(funky, {call, [abc]}),
?MODULE:req(funky, {call, [abc]}),
?MODULE:req(funky, {call, [abc]}),
?MODULE:req(funky, {call, [abc]}),
?MODULE:req(funky, {call, [abc]}),
?MODULE:req(funky, {call, [abc]}),
?MODULE:req(funky, {call, [abc]}),
?MODULE:req(funky, {call, [xyz]}),
?MODULE:req(funky, {call, [abc]}),
?MODULE:req(funky, {call, [abc]}),
?MODULE:req(funky, {call, [abc]}),
?MODULE:req(funky, {call, [abc]}),
?MODULE:req(funky, {call, [abc]}),
?MODULE:req(funky, {call, [abc]}),
g_loop(I-1).
req(Name, Req) ->
R = make_ref(),
Name ! {self(), R, Req},
receive
{Name, R, Reply} -> Reply
after 2000 ->
exit(timeout)
end.
gserv(Name, Mod, State, Debug) ->
receive
{From, Ref, {call, Req}} when Debug == [] ->
case catch apply(Mod, handle_call, [From, State, Req]) of
{reply, Reply, State2} ->
From ! {Name, Ref, Reply},
gserv(Name, Mod, State2, Debug);
{noreply, State2} ->
gserv(Name, Mod, State2, Debug);
{'EXIT', Reason} ->
exit(Reason)
end;
{_From, _Ref, _Req} when Debug /= [] ->
exit(nodebug)
end.
handle_call(_From, _State, [xyz]) ->
R = atom_to_list(xyz),
{reply, R, []};
handle_call(_From, State, [abc]) ->
R = 1 + 3,
{reply, R, [R | State]}.
%% Binary handling, creating, manipulating and sending binaries
binary_h(I) ->
Before = monotonic_time(),
P = spawn(?MODULE, echo, [self()]),
B = list_to_binary(lists:duplicate(2000, 5)),
After = monotonic_time(),
Compensate = subtr(Before, After),
binary_h_2(I, P, B),
Compensate.
binary_h_2(0, P, _B) ->
exit(P, kill);
binary_h_2(I, P, B) ->
echo_loop(P, 20, B),
split_loop(B, {abc,1,2222,self(),"ancnd"}, 100),
binary_h_2(I-1, P, B).
split_loop(_B, _, 0) ->
ok;
split_loop(B, Term, I) ->
{X, Y} = split_binary(B, I),
size(X),
binary_to_list(Y, 1, 2),
binary_to_term(term_to_binary(Term)),
split_loop(B, Term, I-1).
echo_loop(_P, 0, _B) ->
k;
echo_loop(P, I, B) ->
P ! B,
P ! B,
P ! B,
P ! B,
P ! B,
P ! B,
P ! B,
P ! B,
P ! B,
P ! B,
receive _ -> ok end,
receive _ -> ok end,
receive _ -> ok end,
receive _ -> ok end,
receive _ -> ok end,
receive _ -> ok end,
receive _ -> ok end,
receive _ -> ok end,
receive _ -> ok end,
receive _ -> ok end,
echo_loop(P, I-1, B).
ets(0) ->
0;
ets(I) ->
T1 = ets:new(a, [set]),
T2 = ets:new(c, [bag, private]),
L = [T1, T2],
run_tabs(L, L, 1),
ets:delete(T1),
ets:delete(T2),
ets(I-1).
run_tabs(_, _, 0) ->
ok;
run_tabs([], L, I) ->
run_tabs(L, L, I-1);
run_tabs([Tab|Tail], L, I) ->
Begin = I * 20,
End = (I+1) * 20,
run_tab(Tab, Begin, End, I),
run_tabs(Tail, L, I).
run_tab(_Tab, X, X, _) ->
ok;
run_tab(Tab, Beg, End, J) ->
ets:insert(Tab, {Beg, J}),
ets:insert(Tab, {J, Beg}),
ets:insert(Tab, {{foo,Beg}, J}),
ets:insert(Tab, {{foo, J}, Beg}),
ets:delete(Tab, haha),
ets:match_delete(Tab, {k, j}),
ets:match(Tab, {Beg, '$1'}),
ets:match(Tab, {'$1', J}),
ets:delete(Tab, Beg),
K = ets:first(Tab),
_K2 = ets:next(Tab, K),
run_tab(Tab, Beg+1, End, J).
%%%% Integer arith %%%%%
int_arith(0) ->
0;
int_arith(I) ->
do_arith(I) +
do_arith(I) +
do_arith(I) +
do_arith(I) +
do_arith(I) +
do_arith(I) +
do_arith(I) +
do_arith(I) +
do_arith(I) +
66,
int_arith(I-1).
do_arith(I) ->
do_arith2(I) -
do_arith2(I) -
do_arith2(I) -
do_arith2(I) -
do_arith2(I) -
do_arith2(I) -
do_arith2(I) -
99.
do_arith2(I) ->
X = 23,
_Y = 789 + I,
Z = I + 1,
U = (X bsl 1 bsr I) * X div 2 bsr 4,
U1 = Z + Z + Z + Z + X bsl 4 * 2 bsl 2,
Z - U + U1 div 2.
%%%% Float arith %%%%%
float_arith(0) ->
0;
float_arith(I) ->
f_do_arith(I) +
f_do_arith(I) +
f_do_arith(I) +
f_do_arith(I) +
f_do_arith(I) +
f_do_arith(I) +
f_do_arith(I) +
f_do_arith(I) +
f_do_arith(I) +
66,
float_arith(I-1).
f_do_arith(I) ->
X = 23.4,
_Y = 789.99 + I,
Z = I + 1.88,
U = (X * 1 / I) * X / 2 * 4,
U1 = Z + Z + Z + Z + X * 4 * 2 / 2,
Z - U + U1 / 2.
%%%% time to do various function calls
fcalls(0) ->
0;
fcalls(I) ->
local0(400),
remote0(400),
app0(400),
local1(400),
remote1(400),
app1(400),
fcalls(I-1).
local0(0) -> 0;
local0(N) ->
local0(N-1).
local1(0) -> 0;
local1(N) ->
1+local1(N-1).
remote0(0) -> 0;
remote0(N) ->
?MODULE:remote0(N-1).
remote1(0) -> 0;
remote1(N) ->
1+?MODULE:remote1(N-1).
app0(0) -> 0;
app0(N) ->
apply(?MODULE, app0, [N-1]).
app1(0) -> 0;
app1(N) ->
1 + apply(?MODULE, app1, [N-1]).
%%%%%% jog the time queue implementation
timer(I) ->
L = [50, 50, 50, 100, 1000, 3000, 8000, 50000, 100000],
timer(I, L).
timer(0, _) -> 0;
timer(N, L) ->
send_self(100),
recv(100,L, L),
timer(N-1).
recv(0, _, _) ->
ok;
recv(N, [], L) ->
recv(N, L, L);
recv(N, [Timeout|Tail], L) ->
receive
hi_dude ->
recv(N-1, Tail, L)
after Timeout ->
io:format("XXXXX this wasn't supposed to happen???~n", []),
ok
end.
send_self(0) ->
ok;
send_self(N) ->
self() ! hi_dude,
send_self(N-1).
%%%%%%%%%%%% managing many links %%%%%
links(I) ->
L = mk_link_procs(100),
send_procs(L, {procs, L, I}),
wait_for_pids(L),
0.
mk_link_procs(0) ->
[];
mk_link_procs(I) ->
[spawn_link(?MODULE, lproc, [self()]) | mk_link_procs(I-1)].
lproc(Top) ->
process_flag(trap_exit,true),
receive
{procs, Procs, I} ->
Top ! {self(), lproc(Procs, Procs, link, I)}
end.
lproc(_, _, _, 0) ->
done;
lproc([], Procs, link, I) ->
lproc(Procs, Procs, unlink, I-1);
lproc([], Procs, unlink, I) ->
lproc(Procs, Procs, link, I-1);
lproc([Pid|Tail], Procs, unlink, I) ->
unlink(Pid),
lproc(Tail, Procs, unlink, I);
lproc([Pid|Tail], Procs, link, I) ->
link(Pid),
lproc(Tail, Procs, unlink, I).
%%%%%%%%%%% various utility functions %%%%%%%
echo(Pid) ->
receive
X -> Pid ! X,
echo(Pid)
end.
very_big() ->
very_big(2).
very_big(0) -> [];
very_big(I) ->
{1,2,3,a,v,f,r,t,y,u,self(), self(), self(),
"22222222222222222", {{"234", self()}},
[[very_big(I-1)]]}.
big() ->
{self(), funky_stuff, baby, {1, [123, true,[]], "abcdef"}}.
small() -> {self(), true}.
%% Wait for a list of children to respond
wait_for_pids([]) ->
ok;
wait_for_pids([P|Tail]) ->
receive
{P, _Res} -> wait_for_pids(Tail)
end.
send_procs([P|Tail], Msg) -> P ! Msg, send_procs(Tail, Msg);
send_procs([], _) -> ok.
