1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2002-2017. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19
20-module(estone_SUITE).
21%% Test functions
22-export([all/0, suite/0, groups/0,
23	 estone/1, estone_bench/1, pgo/0]).
24
25%% Internal exports for EStone tests
26-export([lists/1,
27	 msgp/1,
28	 msgp_medium/1,
29	 msgp_huge/1,
30	 pattern/1,
31	 trav/1,
32	 port_io/1,
33	 large_dataset_work/1,
34	 large_local_dataset_work/1,mk_big_procs/1,big_proc/0, very_big/1,
35	 alloc/1,
36	 bif_dispatch/1,
37	 binary_h/1,echo/1,
38	 ets/1,
39	 generic/1,req/2,gserv/4,handle_call/3,
40	 int_arith/1,
41	 float_arith/1,
42	 fcalls/1,remote0/1,remote1/1,app0/1,app1/1,
43	 timer/1,
44	 links/1,lproc/1,
45	 run_micro/3,p1/1,ppp/3,macro/2,micros/0]).
46
47-ifndef(PGO).
48-include_lib("common_test/include/ct_event.hrl").
49-endif.
50
51%% EStone defines
52-define(TOTAL, (3000 * 1000 * 100)).   %% 300 secs
53-define(BIGPROCS, 2).
54-define(BIGPROC_SIZE, 50).
55-define(STONEFACTOR, 31000000).   %% Factor to make the reference
56                             %% implementation to make 1000 TS_ESTONES.
57-record(micro,
58	{function, %% The name of the function implementing the micro
59	 weight,   %% How important is this in typical applications ??
60	 loops = 100,%% initial data
61	 tt1,      %% time to do one round
62	 str}).    %% Header string
63
64
65suite() ->
66    [{ct_hooks,[ts_install_cth]},
67     {timetrap, {minutes, 4}}].
68
69all() ->
70    [estone].
71
72groups() ->
73    [{estone_bench, [{repeat,50}],[estone_bench]}].
74
75
76%% EStone Test
77estone(Config) when is_list(Config) ->
78    DataDir = proplists:get_value(data_dir,Config),
79    Mhz=get_cpu_speed(os:type(),DataDir),
80    L = ?MODULE:macro(?MODULE:micros(),DataDir),
81    {Total, Stones} = sum_micros(L, 0, 0),
82    pp(Mhz,Total,Stones,L),
83    {comment,Mhz ++ " MHz, " ++ integer_to_list(Stones) ++ " ESTONES"}.
84
85estone_bench(Config) ->
86    DataDir = proplists:get_value(data_dir,Config),
87    L = ?MODULE:macro(?MODULE:micros(),DataDir),
88    {Total, Stones} = sum_micros(L, 0, 0),
89    notify([[{title,"ESTONES"}, {estones, Stones}] | L]),
90    L.
91
92-ifndef(PGO).
93notify(Marks) ->
94    [ct_event:notify(
95       #event{name = benchmark_data,
96	      data = [{name,proplists:get_value(title, Mark)},
97		      {value,proplists:get_value(estones, Mark)}]})
98     || Mark <- Marks].
99-else.
100notify(_) ->
101    ok.
102-endif.
103
104%% The benchmarks to run in order to guide PGO (profile guided optimisation)
105pgo() ->
106    %% We run all benchmarks except the port_io as we don't want to
107    %% have to build a custom port.
108    Micros = ?MODULE:micros() -- [micro(port_io)],
109    ?MODULE:macro(Micros,[]).
110
111%%
112%% Calculate CPU speed
113%%
114%% get_cpu_speed() now returns a string. For multiprocessor
115%% machines (at least on Solaris) the format is: <F1>+<F2>[+...]
116%%
117get_cpu_speed({win32, _},_DataDir) ->
118    RegH =
119	case catch win32reg:open([read]) of
120	    {ok, Handle} ->
121		Handle;
122	    _ ->
123		io:format("Error.~nCannot determine CPU clock"
124			  "frequency.~n"
125			  "Please set the environment variable"
126			  "\"CPU_SPEED\"~n"),
127		exit(self(), {error, no_cpu_speed})
128	end,
129    case win32reg:change_key(RegH,"\\hkey_local_machine\\hardware\\"
130			     "description\\system\\centralprocessor"
131			     "\\0") of
132	ok ->
133	    ok;
134	_ ->
135	    io:format("Error.~nRegistry seems to be damaged or"
136		      "unavailable.~n"
137		      "Please set the environment variable"
138		      "\"CPU_SPEED\",~nor correct your registry"
139		      "if possible.~n"),
140	    win32reg:close(RegH),
141	    exit(self(), {error, no_cpu_speed})
142    end,
143    case win32reg:value(RegH, "~MHZ") of
144	{ok, Speed} ->
145	    win32reg:close(RegH),
146	    integer_to_list(Speed);
147	_ ->
148	    io:format("Error.~nRegistry seems to be damaged or "
149		      "unavailable.~n"),
150	    io:format("Please set the environment variable"
151		      "\"CPU_SPEED\"~n"),
152	    win32reg:close(RegH),
153	    exit(self(), {error, no_cpu_speed})
154    end;
155get_cpu_speed({unix, sunos},DataDir) ->
156    os:cmd(filename:join(DataDir,"sunspeed.sh")) -- "\n";
157get_cpu_speed(_Other,_DataDir) ->
158    %% Cannot determine CPU speed
159    "UNKNOWN".
160
161
162%%
163%% Pretty Print EStone Result
164%%
165pp(Mhz,Total,Stones,Ms) ->
166    io:format("EStone test completed~n",[]),
167    io:format("**** CPU speed ~s MHz ****~n",[Mhz]),
168    io:format("**** Total time ~w seconds ****~n", [Total / 1000000]),
169    io:format("**** ESTONES = ~w ****~n~n", [Stones]),
170    io:format("~-31s      ~-12s  ~-10s   %    ~-10s ~n~n",
171	      ["    Title", "Millis", "Estone", "Loops"]),
172    erlang:display({'ESTONES', Stones}),
173    pp2(Ms).
174
175sum_micros([], Tot, Stones) -> {Tot, Stones};
176sum_micros([H|T], Tot, Sto) ->
177    sum_micros(T, ks(microsecs, H) + Tot, ks(estones, H) + Sto).
178
179pp2([]) ->   ok;
180pp2([R|Tail]) ->
181    io:format("~-35s  ~-12w    ~-10w   ~-2w    ~-10w ~n",
182	      [ks(title,R),
183	       round(ks(microsecs, R) / 1000),
184	       ks(estones, R),
185	       ks(weight_percentage, R),
186	       ks(loops, R)]),
187    pp2(Tail).
188
189ks(K, L) ->
190    {value, {_, V}} = lists:keysearch(K, 1, L),
191    V.
192
193
194
195%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
196%%% EStone test
197micro(lists) ->
198     #micro{function = lists,
199	    weight = 7,
200	    loops = 6400,
201	    str = "list manipulation"};
202micro(msgp) ->
203    #micro{function = msgp,
204	    weight = 10,
205	    loops = 1515,
206	    str = "small messages"};
207micro(msgp_medium) ->
208    #micro{function = msgp_medium,
209	    weight = 14,
210	    loops = 1527,
211	    str = "medium messages"};
212micro(msgp_huge) ->
213    #micro{function = msgp_huge,
214	    weight = 4,
215	    loops = 52,
216	    str = "huge messages"};
217
218micro(pattern) ->
219    #micro{function = pattern,
220	    weight = 5,
221	    loops = 1046,
222	    str = "pattern matching"};
223
224micro(trav) ->
225    #micro{function = trav,
226	    weight = 4,
227	    loops = 2834,
228	    str = "traverse"};
229
230micro(port_io) ->
231    #micro{function = port_io,
232	   weight = 12,
233	   loops = 4800,
234	   str = "Port i/o"};
235
236micro(large_dataset_work) ->
237    #micro{function = large_dataset_work,
238	   weight = 3,
239	   loops = 1193,
240	   str = "Work with large dataset"};
241
242micro(large_local_dataset_work) ->
243    #micro{function = large_local_dataset_work,
244	   weight = 3,
245	   loops = 1174,
246	   str = "Work with large local dataset"};
247
248micro(alloc) ->
249    #micro{function = alloc,
250	   weight = 2,
251	   loops = 3710,
252	   str = "Alloc and dealloc"};
253
254micro(bif_dispatch) ->
255    #micro{function = bif_dispatch,
256	   weight = 5,
257	   loops = 1623,
258	   str = "Bif dispatch"};
259
260micro(binary_h) ->
261    #micro{function = binary_h,
262	   weight = 4,
263	   loops = 581,
264	   str = "Binary handling"};
265micro(ets) ->
266    #micro{function = ets,
267	   weight = 6,
268	   loops = 342,
269	   str = "ets datadictionary"};
270micro(generic) ->
271    #micro{function = generic,
272	   weight = 9,
273	   loops = 7977,
274	   str = "Generic server (with timeout)"};
275micro(int_arith) ->
276    #micro{function = int_arith,
277	   weight = 3,
278	   loops = 4157,
279	   str = "Small Integer arithmetics"};
280micro(float_arith) ->
281    #micro{function = float_arith,
282	   weight = 1,
283	   loops = 5526,
284	   str = "Float arithmetics"};
285micro(fcalls) ->
286    #micro{function = fcalls,
287	   weight = 5,
288	   loops = 882,
289	   str = "Function calls"};
290
291micro(timer) ->
292    #micro{function = timer,
293	   weight = 2,
294	   loops = 2312,
295	   str = "Timers"};
296
297micro(links) ->
298    #micro{function = links,
299	   weight = 1,
300	   loops = 30,
301	   str = "Links"}.
302
303
304
305%% Return a list of micro's
306micros() ->
307    [
308     micro(lists),
309     micro(msgp),
310     micro(msgp_medium),
311     micro(msgp_huge),
312     micro(pattern),
313     micro(trav),
314     micro(port_io),
315     micro(large_dataset_work),
316     micro(large_local_dataset_work),
317     micro(alloc),
318     micro(bif_dispatch),
319     micro(binary_h),
320     micro(ets),
321     micro(generic),
322     micro(int_arith),
323     micro(float_arith),
324     micro(fcalls),
325     micro(timer),
326     micro(links)
327    ].
328
329macro(Ms,DataDir) ->
330    statistics(reductions),
331    statistics(runtime),
332    lists(500),  %% fixup cache on first round
333    run_micros(Ms,DataDir).
334
335run_micros([],_) ->
336    io:nl(),
337    [];
338run_micros([H|T],DataDir) ->
339    R = run_micro(H,DataDir),
340    [R| run_micros(T,DataDir)].
341
342run_micro(M,DataDir) ->
343    Pid = spawn(?MODULE, run_micro, [self(),M,DataDir]),
344    Res = receive {Pid, Reply} -> Reply end,
345    {value,{title,Title}} = lists:keysearch(title,1,Reply),
346    {value,{estones,Estones}} = lists:keysearch(estones,1,Reply),
347    erlang:display({Title,Estones}),
348    Res.
349
350
351run_micro(Top, M, DataDir) ->
352    EstoneCat = filename:join(DataDir,"estone_cat"),
353    put(estone_cat,EstoneCat),
354    Top ! {self(),  apply_micro(M)}.
355
356apply_micro(M) ->
357    {GC0, Words0, _} = statistics(garbage_collection),
358    statistics(reductions),
359    Before = monotonic_time(),
360    Compensate = apply_micro(M#micro.function, M#micro.loops),
361    After = monotonic_time(),
362    {GC1, Words1, _} = statistics(garbage_collection),
363    {_, Reds} = statistics(reductions),
364    Elapsed = subtr(Before, After),
365    MicroSecs = Elapsed - Compensate,
366    [{title, M#micro.str},
367     {tt1, M#micro.tt1},
368     {function, M#micro.function},
369     {weight_percentage, M#micro.weight},
370     {loops, M#micro.loops},
371     {microsecs,MicroSecs},
372     {estones, (M#micro.weight * M#micro.weight * ?STONEFACTOR) div max(1,MicroSecs)},
373     {gcs, GC1 - GC0},
374     {kilo_word_reclaimed, (Words1 - Words0) div 1000},
375     {kilo_reductions, Reds div 1000},
376     {gc_intensity, gci(max(1,Elapsed), GC1 - GC0, Words1 - Words0)}].
377
378monotonic_time() ->
379    try erlang:monotonic_time() catch error:undef -> erlang:now() end.
380
381subtr(Before, After) when is_integer(Before), is_integer(After) ->
382    erlang:convert_time_unit(After-Before, native, 1000000);
383subtr({_,_,_}=Before, {_,_,_}=After) ->
384    timer:now_diff(After, Before).
385
386gci(Micros, Words, Gcs) ->
387    ((256 * Gcs) / Micros) + (Words / Micros).
388
389apply_micro(Name, Loops) ->
390    io:format("~w(~w)~n", [Name, Loops]),
391    apply(?MODULE, Name, [Loops]).
392
393%%%%%%%%%%%% micro bench manipulating lists. %%%%%%%%%%%%%%%%%%%%%%%%%
394lists(I) ->
395    L1 = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx",
396    L2 = "aaaaaaaaaa",
397    lists(I, L1, L2).
398
399lists(0, _,_) ->
400    0;
401lists(I, L1, L2) ->
402    revt(10, L1),
403    appt(10, L1, L2),
404    lists(I-1, L1, L2).
405
406revt(0, _) ->
407    done;
408revt(I, L) ->
409    reverse(L),
410    revt(I-1, L).
411
412reverse(L) ->
413    reverse(L, []).
414reverse([H|T], Ack) -> reverse(T, [H|Ack]);
415reverse([], Ack) -> Ack.
416
417append([H|T], L) ->
418    [H | append(T, L)];
419append([], L) ->
420    L.
421
422appt(0, _L1, _L2) -> ok;
423appt(I, L1, L2) ->
424    append(L1, L2),
425    appt(I-1, L1, L2).
426
427
428%%%%%%%%%%%%%%% small message passing and ctxt switching %%%%%%%
429msgp(I) ->
430    msgp(I, small()).
431
432msgp(0, _) ->
433    0;
434msgp(I, Msg) ->
435    P1 = spawn(?MODULE, p1, [self()]),
436    P2 = spawn(?MODULE, p1, [P1]),
437    P3 = spawn(?MODULE, p1, [P2]),
438    P4 = spawn(?MODULE, p1, [P3]),
439    msgp_loop(100, P4, Msg),
440    msgp(I-1, Msg).
441
442p1(To) ->
443    receive
444	{_From, {message, X}} ->
445	    To ! {self(), {message, X}},
446	    p1(To);
447	stop ->
448	    To ! stop,
449	    exit(normal)
450    end.
451
452msgp_loop(0, P, _) ->
453    P ! stop,
454    receive
455	stop -> ok
456    end;
457msgp_loop(I, P, Msg) ->
458    P ! {self(), {message, Msg}},
459    receive
460	{_From, {message, _}} ->
461	    msgp_loop(I-1, P, Msg)
462    end.
463
464%%%%%%%%%%%% large massage passing and ctxt switching %%%%%%%
465msgp_medium(I) ->
466        msgp_medium(I, big()).
467
468msgp_medium(0, _) ->
469    0;
470msgp_medium(I, Msg) ->
471    P1 = spawn(?MODULE , p1, [self()]),
472    P2 = spawn(?MODULE, p1, [P1]),
473    P3 = spawn(?MODULE, p1, [P2]),
474    P4 = spawn(?MODULE, p1, [P3]),
475    msgp_loop(100, P4, Msg),
476    msgp_medium(I-1, Msg).
477
478
479
480%%%%%%%%%%%% huge massage passing and ctxt switching %%%%%%%
481msgp_huge(I) ->
482        msgp_huge(I, very_big(15)).
483
484msgp_huge(0, _) ->
485    0;
486msgp_huge(I, Msg) ->
487    P1 = spawn(?MODULE , p1, [self()]),
488    P4 = spawn(?MODULE, p1, [P1]),
489    msgp_loop(100, P4, Msg),
490    msgp_huge(I-1, Msg).
491
492
493%%%%%% typical protocol pattern matching %%%%%%%
494pattern(0) ->
495    0;
496pattern(I) ->
497    Tail = "aaabbaaababba",
498    P1 = [0, 1,2,3,4,5|Tail],
499    pat_loop1(100, P1),
500    pat_loop2(100, P1),
501    pat_loop3(100, P1),
502    pat_loop4(100, P1),
503    pat_loop5(100, P1),
504    pattern(I-1).
505
506pat_loop1(0, _) ->
507    ok;
508pat_loop1(_I, [_, _X, _Y, 0 |_T])  ->
509    ok;
510pat_loop1(_I, [_, _X, _Y, 1| _T]) ->
511    ok;
512pat_loop1(_I, [_, _X, _Y, 2 | _T]) ->
513    ok;
514pat_loop1(I, [_, X, Y, 3 | T]) ->
515    pat_loop1(I-1, [0, X,Y,3|T]).
516
517pat_loop2(0, _) ->
518    ok;
519pat_loop2(_I, [_X, Y | _Tail]) when Y bsl 1 == 0 ->
520    ok;
521pat_loop2(_I, [_X, Y | _Tail]) when Y bsl 2 == 0 ->
522    ok;
523pat_loop2(I, [X, Y | Tail]) when Y bsl 2 == 4 ->
524    pat_loop2(I-1, [X, Y |Tail]).
525
526
527pat_loop3(0, _) ->
528    ok;
529pat_loop3(_I, [{c, h} | _Tail]) ->
530    ok;
531pat_loop3(_I, [1, 0 |_T]) ->
532    ok;
533pat_loop3(_I, [X, _Y |_Tail]) when is_binary(X), size(X) == 1 ->
534    ok;
535pat_loop3(_I, [no, _Y|_Tail]) ->
536    ok;
537pat_loop3(_I, []) ->
538    ok;
539pat_loop3(_I, [X,_Y|_T]) when X /= 0 ->
540    ok;
541pat_loop3(_I, [2,3|_T]) ->
542    ok;
543pat_loop3(_I, [1, 2]) ->
544    ok;
545pat_loop3(I, [0, 1 |T]) ->
546    pat_loop3(I-1, [0,1|T]).
547
548
549pat_loop4(0, _) ->  ok;
550pat_loop4(_I, [20|_T]) -> ok;
551pat_loop4(_I, [219|_T]) -> ok;
552pat_loop4(_I, [18|_T]) -> ok;
553pat_loop4(_I, [17|_T]) -> ok;
554pat_loop4(_I, [16|_T]) -> ok;
555pat_loop4(_I, [15|_T]) -> ok;
556pat_loop4(_I, [14|_T]) -> ok;
557pat_loop4(_I, [13|_T]) -> ok;
558pat_loop4(_I, [12|_T]) -> ok;
559pat_loop4(_I, [11|_T]) -> ok;
560pat_loop4(_I, [10|_T]) -> ok;
561pat_loop4(_I, [9|_T]) -> ok;
562pat_loop4(_I, [8|_T]) -> ok;
563pat_loop4(_I, [7|_T]) -> ok;
564pat_loop4(_I, [6|_T]) -> ok;
565pat_loop4(_I, [5|_T]) -> ok;
566pat_loop4(_I, [4|_T]) -> ok;
567pat_loop4(_I, [3|_T]) -> ok;
568pat_loop4(_I, [1|_T]) -> ok;
569pat_loop4(_I, [21|_T]) -> ok;
570pat_loop4(_I, [22|_T]) -> ok;
571pat_loop4(_I, [23|_T]) -> ok;
572pat_loop4(_I, [24|_T]) -> ok;
573pat_loop4(_I, [25|_T]) -> ok;
574pat_loop4(_I, [26|_T]) -> ok;
575pat_loop4(_I, [27|_T]) -> ok;
576pat_loop4(I, [0|T]) ->
577    pat_loop4(I-1, [0|T]).
578
579pat_loop5(0, _) -> ok;
580pat_loop5(_I, [0, 20|_T]) -> ok;
581pat_loop5(_I, [0, 19|_T]) -> ok;
582pat_loop5(_I, [0, 18|_T]) -> ok;
583pat_loop5(_I, [0, 17|_T]) -> ok;
584pat_loop5(_I, [0, 16|_T]) -> ok;
585pat_loop5(_I, [0, 15|_T]) -> ok;
586pat_loop5(_I, [0, 14|_T]) -> ok;
587pat_loop5(_I, [0, 13|_T]) -> ok;
588pat_loop5(_I, [0, 12|_T]) -> ok;
589pat_loop5(_I, [0, 11|_T]) -> ok;
590pat_loop5(_I, [0, 10|_T]) -> ok;
591pat_loop5(_I, [0, 9|_T]) -> ok;
592pat_loop5(_I, [0, 8|_T]) -> ok;
593pat_loop5(_I, [0, 7|_T]) -> ok;
594pat_loop5(_I, [0, 6|_T]) -> ok;
595pat_loop5(I, [0, 1|T]) ->
596    pat_loop5(I-1, [0,1|T]).
597
598%%%%%%%%%% term traversal representing simple pattern matchhing %%%
599%%%%%%%%%                              + some arith
600trav(I) ->
601    X = very_big(10),
602    trav(I, X).
603
604trav(0, _) -> 0;
605trav(I, T) ->
606    do_trav(T),
607    trav(I-1, T).
608
609do_trav(T) when is_tuple(T) ->
610    tup_trav(T, 1, 1 + size(T));
611do_trav([H|T]) ->
612    do_trav(H) + do_trav(T);
613do_trav(X) when is_integer(X) -> 1;
614do_trav(_X) -> 0.
615tup_trav(_T, P, P) -> 0;
616tup_trav(T, P, End) ->
617    do_trav(element(P, T)) + tup_trav(T, P+1, End).
618
619
620%% Port I/O
621port_io(I) ->
622    EstoneCat = get(estone_cat),
623    Before = monotonic_time(),
624    Pps = make_port_pids(5, I, EstoneCat),  %% 5 ports
625    send_procs(Pps, go),
626    After = monotonic_time(),
627    wait_for_pids(Pps),
628    subtr(Before, After).
629
630make_port_pids(0, _, _) ->
631    [];
632make_port_pids(NoPorts, J, EstoneCat) ->
633    [spawn(?MODULE, ppp, [self(),J,EstoneCat]) | make_port_pids(NoPorts-1, J, EstoneCat)].
634ppp(Top, I, EstoneCat) ->
635    P = open_port({spawn, EstoneCat}, []),%% cat sits at the other end
636    Str = lists:duplicate(200, 88), %% 200 X'es
637    Cmd = {self(), {command, Str}},
638    receive
639	go -> ok
640    end,
641    ppp_loop(P, I, Cmd),
642    Cmd2 = {self(), {command, "abcde"}},
643    Res = ppp_loop(P, I, Cmd2),
644    P ! {self(), close},
645    receive
646	{P, closed} ->
647	    closed
648    end,
649    Top ! {self(), Res}.
650
651ppp_loop(_P, 0, _) ->
652    ok;
653ppp_loop(P, I, Cmd) ->
654    P ! Cmd,
655    receive
656	{P, _} ->  %% no match
657	    ppp_loop(P, I-1, Cmd)
658    end.
659
660%% Working with a very large non-working data set
661%% where the passive data resides in remote processes
662large_dataset_work(I) ->
663    {Minus, Ps} = timer:tc(?MODULE, mk_big_procs, [?BIGPROCS]),
664    trav(I),
665    lists(I),
666    send_procs(Ps, stop),
667    Minus. %% Don't count time to create the big procs.
668
669mk_big_procs(0) -> [];
670mk_big_procs(I) ->
671    [ mk_big_proc()| mk_big_procs(I-1)].
672
673mk_big_proc() ->
674    P = spawn(?MODULE, big_proc, []),
675    P ! {self(), running},
676    receive
677	{P, yes} -> P
678    end.
679
680big_proc() ->
681    X = very_big(?BIGPROC_SIZE), %% creates a big heap
682    Y = very_big(?BIGPROC_SIZE),
683    Z = very_big(?BIGPROC_SIZE),
684
685    receive
686	{From, running} ->
687	    From ! {self(), yes}
688    end,
689    receive
690	stop ->
691	    {X, Y, Z}  %% Can't be garbed away now by very (not super)
692                       %% smart compiler
693    end.
694
695%% Working with a large non-working data set
696%% where the data resides in the local process.
697large_local_dataset_work(I) ->
698    {Minus, _Data} = timer:tc(?MODULE, very_big, [?BIGPROC_SIZE]),
699    trav(I),
700    lists(I),
701    Minus.
702
703
704%% Fast allocation and also deallocation that is gc test
705%% Important to not let variable linger on the stack un-necessarily
706alloc(0) -> 0;
707alloc(I) ->
708    _X11 = very_big(),
709    _X12 = very_big(),
710    _X13 = very_big(),
711    _Z = [_X14 = very_big(),
712	  _X15 = very_big(),
713	  _X16 = very_big()],
714    _X17 = very_big(),
715    _X18 = very_big(),
716    _X19 = very_big(),
717    _X20 = very_big(),
718    _X21 = very_big(),
719    _X22 = very_big(),
720    _X23 = very_big(),
721    _X24 = very_big(),
722    alloc(I-1).
723
724%% Time to call bif's
725%% Lot's of element stuff which reflects the record code which
726%% is becoming more and more common
727bif_dispatch(0) ->
728    0;
729bif_dispatch(I) ->
730    disp(),    disp(),    disp(),    disp(),    disp(),    disp(),
731    disp(),    disp(),    disp(),    disp(),    disp(),    disp(),
732    bif_dispatch(I-1).
733
734disp() ->
735    Tup = {a},
736    L = [x],
737    self(),self(),self(),self(),self(),self(),self(),self(),self(),
738    make_ref(),
739    atom_to_list(''),
740    _X = list_to_atom([]),
741    tuple_to_list({}),
742    _X2 = list_to_tuple([]),
743    element(1, Tup),
744    element(1, Tup),
745    _Elem = element(1, Tup),element(1, Tup),element(1, Tup),element(1, Tup),
746    element(1, Tup),element(1, Tup),element(1, Tup),element(1, Tup),
747    element(1, Tup),element(1, Tup),element(1, Tup),element(1, Tup),
748    element(1, Tup),element(1, Tup),element(1, Tup),element(1, Tup),
749    setelement(1, Tup,k),
750    setelement(1, Tup,k),
751    setelement(1, Tup,k),setelement(1, Tup,k),setelement(1, Tup,k),
752    setelement(1, Tup,k),setelement(1, Tup,k),setelement(1, Tup,k),
753    setelement(1, Tup,k),
754    setelement(1, Tup,k),
755    setelement(1, Tup,k),
756    setelement(1, Tup,k),
757    _Y = setelement(1, Tup,k),
758    _Date = date(), time(),
759    put(a, 1),
760    get(a),
761    erase(a),
762    hd(L),
763    tl(L),
764    _Len = length(L),length(L),length(L),length(L),
765    node(),node(),node(),node(),node(),node(),node(),node(),
766    S=self(),
767    node(S),node(S),node(S),
768    size(Tup),
769    _W = whereis(code_server),whereis(code_server),
770    whereis(code_server),whereis(code_server),
771    whereis(code_server),whereis(code_server),
772    _W2 = whereis(code_server).
773
774
775%% Generic server like behaviour
776generic(I) ->
777    register(funky, spawn(?MODULE, gserv, [funky, ?MODULE, [], []])),
778    g_loop(I).
779
780g_loop(0) ->
781    exit(whereis(funky), kill),
782    0;
783g_loop(I) ->
784    ?MODULE:req(funky, {call, [abc]}),
785    ?MODULE:req(funky, {call, [abc]}),
786    ?MODULE:req(funky, {call, [abc]}),
787    ?MODULE:req(funky, {call, [abc]}),
788    ?MODULE:req(funky, {call, [xyz]}),
789    ?MODULE:req(funky, {call, [abc]}),
790    ?MODULE:req(funky, {call, [abc]}),
791    ?MODULE:req(funky, {call, [abc]}),
792    ?MODULE:req(funky, {call, [abc]}),
793    ?MODULE:req(funky, {call, [abc]}),
794    ?MODULE:req(funky, {call, [abc]}),
795    ?MODULE:req(funky, {call, [abc]}),
796    ?MODULE:req(funky, {call, [abc]}),
797    ?MODULE:req(funky, {call, [abc]}),
798    ?MODULE:req(funky, {call, [abc]}),
799    ?MODULE:req(funky, {call, [xyz]}),
800    ?MODULE:req(funky, {call, [abc]}),
801    ?MODULE:req(funky, {call, [abc]}),
802    ?MODULE:req(funky, {call, [abc]}),
803    ?MODULE:req(funky, {call, [abc]}),
804    ?MODULE:req(funky, {call, [abc]}),
805    ?MODULE:req(funky, {call, [abc]}),
806    g_loop(I-1).
807
808req(Name, Req) ->
809    R = make_ref(),
810    Name ! {self(), R, Req},
811    receive
812	{Name, R, Reply} -> Reply
813    after 2000 ->
814	    exit(timeout)
815    end.
816
817gserv(Name, Mod, State, Debug) ->
818    receive
819	{From, Ref, {call, Req}} when Debug == [] ->
820	    case catch apply(Mod, handle_call, [From, State, Req]) of
821		{reply, Reply, State2} ->
822		    From ! {Name, Ref, Reply},
823		    gserv(Name, Mod, State2, Debug);
824		{noreply, State2} ->
825		    gserv(Name, Mod, State2, Debug);
826		{'EXIT', Reason} ->
827		    exit(Reason)
828	    end;
829	{_From, _Ref, _Req} when Debug /= [] ->
830	    exit(nodebug)
831    end.
832
833handle_call(_From, _State, [xyz]) ->
834    R = atom_to_list(xyz),
835    {reply, R, []};
836handle_call(_From, State, [abc]) ->
837    R = 1 + 3,
838    {reply, R, [R | State]}.
839
840
841
842%% Binary handling, creating, manipulating and sending binaries
843binary_h(I) ->
844    Before = monotonic_time(),
845    P = spawn(?MODULE, echo, [self()]),
846    B = list_to_binary(lists:duplicate(2000, 5)),
847    After = monotonic_time(),
848    Compensate = subtr(Before, After),
849    binary_h_2(I, P, B),
850    Compensate.
851
852binary_h_2(0, P, _B) ->
853    exit(P, kill);
854binary_h_2(I, P, B) ->
855    echo_loop(P, 20, B),
856    split_loop(B, {abc,1,2222,self(),"ancnd"}, 100),
857    binary_h_2(I-1, P, B).
858
859split_loop(_B, _, 0) ->
860    ok;
861split_loop(B, Term, I) ->
862    {X, Y} = split_binary(B, I),
863    size(X),
864    binary_to_list(Y, 1, 2),
865    binary_to_term(term_to_binary(Term)),
866    split_loop(B, Term, I-1).
867
868
869echo_loop(_P, 0, _B) ->
870    k;
871echo_loop(P, I, B) ->
872    P ! B,
873    P ! B,
874    P ! B,
875    P ! B,
876    P ! B,
877    P ! B,
878    P ! B,
879    P ! B,
880    P ! B,
881    P ! B,
882    receive _ -> ok end,
883    receive _ -> ok end,
884    receive _ -> ok end,
885    receive _ -> ok end,
886    receive _ -> ok end,
887    receive _ -> ok end,
888    receive _ -> ok end,
889    receive _ -> ok end,
890    receive _ -> ok end,
891    receive _ -> ok end,
892    echo_loop(P, I-1, B).
893
894
895ets(0) ->
896    0;
897ets(I) ->
898    T1 = ets:new(a, [set]),
899    T2 = ets:new(c, [bag, private]),
900    L = [T1, T2],
901    run_tabs(L, L, 1),
902    ets:delete(T1),
903    ets:delete(T2),
904    ets(I-1).
905
906run_tabs(_, _, 0) ->
907    ok;
908run_tabs([], L, I) ->
909    run_tabs(L, L, I-1);
910run_tabs([Tab|Tail], L, I) ->
911    Begin = I * 20,
912    End = (I+1) * 20,
913    run_tab(Tab, Begin, End, I),
914    run_tabs(Tail, L, I).
915
916run_tab(_Tab, X, X, _) ->
917    ok;
918run_tab(Tab, Beg, End, J) ->
919    ets:insert(Tab, {Beg, J}),
920    ets:insert(Tab, {J, Beg}),
921    ets:insert(Tab, {{foo,Beg}, J}),
922    ets:insert(Tab, {{foo, J}, Beg}),
923    ets:delete(Tab, haha),
924    ets:match_delete(Tab, {k, j}),
925    ets:match(Tab, {Beg, '$1'}),
926    ets:match(Tab, {'$1', J}),
927    ets:delete(Tab, Beg),
928    K = ets:first(Tab),
929    _K2 = ets:next(Tab, K),
930    run_tab(Tab, Beg+1, End, J).
931
932
933%%%% Integer arith %%%%%
934int_arith(0) ->
935    0;
936int_arith(I) ->
937    do_arith(I) +
938    do_arith(I) +
939    do_arith(I) +
940    do_arith(I) +
941    do_arith(I) +
942    do_arith(I) +
943    do_arith(I) +
944    do_arith(I) +
945    do_arith(I) +
946	66,
947    int_arith(I-1).
948
949do_arith(I) ->
950    do_arith2(I) -
951    do_arith2(I) -
952    do_arith2(I) -
953    do_arith2(I) -
954    do_arith2(I) -
955    do_arith2(I) -
956    do_arith2(I) -
957	99.
958
959do_arith2(I) ->
960    X = 23,
961    _Y = 789 + I,
962    Z = I + 1,
963    U = (X bsl 1 bsr I) * X div 2 bsr 4,
964    U1 = Z + Z + Z + Z + X bsl 4 * 2 bsl 2,
965    Z - U + U1 div 2.
966
967
968%%%% Float arith %%%%%
969float_arith(0) ->
970    0;
971float_arith(I) ->
972    f_do_arith(I) +
973    f_do_arith(I) +
974    f_do_arith(I) +
975    f_do_arith(I) +
976    f_do_arith(I) +
977    f_do_arith(I) +
978    f_do_arith(I) +
979    f_do_arith(I) +
980    f_do_arith(I) +
981	66,
982    float_arith(I-1).
983
984f_do_arith(I) ->
985    X = 23.4,
986    _Y = 789.99 + I,
987    Z = I + 1.88,
988    U = (X * 1 / I) * X / 2 * 4,
989    U1 = Z + Z + Z + Z + X * 4 * 2 / 2,
990    Z - U + U1 / 2.
991
992%%%% time to do various function calls
993fcalls(0) ->
994    0;
995fcalls(I) ->
996    local0(400),
997    remote0(400),
998    app0(400),
999    local1(400),
1000    remote1(400),
1001    app1(400),
1002    fcalls(I-1).
1003
1004
1005local0(0) -> 0;
1006local0(N) ->
1007    local0(N-1).
1008
1009local1(0) -> 0;
1010local1(N) ->
1011    1+local1(N-1).
1012
1013remote0(0) -> 0;
1014remote0(N) ->
1015    ?MODULE:remote0(N-1).
1016
1017remote1(0) -> 0;
1018remote1(N) ->
1019    1+?MODULE:remote1(N-1).
1020
1021app0(0) -> 0;
1022app0(N) ->
1023    apply(?MODULE, app0, [N-1]).
1024
1025app1(0) -> 0;
1026app1(N) ->
1027    1 + apply(?MODULE, app1, [N-1]).
1028
1029%%%%%% jog the time queue implementation
1030timer(I) ->
1031    L = [50, 50, 50, 100, 1000, 3000, 8000, 50000, 100000],
1032    timer(I, L).
1033
1034timer(0, _) -> 0;
1035timer(N, L) ->
1036    send_self(100),
1037    recv(100,L, L),
1038    timer(N-1).
1039
1040recv(0, _, _) ->
1041    ok;
1042recv(N, [], L) ->
1043    recv(N, L, L);
1044recv(N, [Timeout|Tail], L) ->
1045    receive
1046        hi_dude ->
1047            recv(N-1, Tail, L)
1048    after Timeout ->
1049            io:format("XXXXX this wasn't supposed to happen???~n", []),
1050            ok
1051    end.
1052
1053send_self(0) ->
1054    ok;
1055send_self(N) ->
1056    self() ! hi_dude,
1057    send_self(N-1).
1058
1059
1060%%%%%%%%%%%% managing many links %%%%%
1061links(I) ->
1062    L = mk_link_procs(100),
1063    send_procs(L, {procs, L, I}),
1064    wait_for_pids(L),
1065    0.
1066
1067mk_link_procs(0) ->
1068    [];
1069mk_link_procs(I) ->
1070    [spawn_link(?MODULE, lproc, [self()]) | mk_link_procs(I-1)].
1071
1072
1073lproc(Top) ->
1074    process_flag(trap_exit,true),
1075    receive
1076	{procs, Procs, I} ->
1077	    Top ! {self(), lproc(Procs, Procs, link, I)}
1078    end.
1079
1080lproc(_, _, _, 0) ->
1081    done;
1082lproc([], Procs, link, I) ->
1083    lproc(Procs, Procs, unlink, I-1);
1084lproc([], Procs, unlink, I) ->
1085    lproc(Procs, Procs, link, I-1);
1086lproc([Pid|Tail], Procs, unlink, I) ->
1087    unlink(Pid),
1088    lproc(Tail, Procs, unlink, I);
1089lproc([Pid|Tail], Procs, link, I) ->
1090    link(Pid),
1091    lproc(Tail, Procs, unlink, I).
1092
1093
1094
1095%%%%%%%%%%% various utility functions %%%%%%%
1096
1097echo(Pid) ->
1098    receive
1099	X -> Pid ! X,
1100	     echo(Pid)
1101    end.
1102
1103very_big() ->
1104    very_big(2).
1105very_big(0) -> [];
1106very_big(I) ->
1107    {1,2,3,a,v,f,r,t,y,u,self(), self(), self(),
1108     "22222222222222222", {{"234", self()}},
1109     [[very_big(I-1)]]}.
1110
1111big() ->
1112    {self(), funky_stuff, baby, {1, [123, true,[]], "abcdef"}}.
1113
1114small() -> {self(), true}.
1115
1116%% Wait for a list of children to respond
1117wait_for_pids([]) ->
1118    ok;
1119wait_for_pids([P|Tail]) ->
1120    receive
1121	{P, _Res} -> wait_for_pids(Tail)
1122    end.
1123
1124send_procs([P|Tail], Msg) -> P ! Msg, send_procs(Tail, Msg);
1125send_procs([], _) -> ok.
1126