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