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