1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1999-2016. 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
21-module(save_calls_SUITE).
22
23-include_lib("common_test/include/ct.hrl").
24
25-export([all/0, suite/0, init_per_testcase/2,end_per_testcase/2]).
26
27-export([save_calls_1/1,dont_break_reductions/1]).
28
29-export([do_bopp/1, do_bipp/0, do_bepp/0]).
30
31suite() -> [{ct_hooks,[ts_install_cth]}].
32
33all() ->
34    [save_calls_1, dont_break_reductions].
35
36init_per_testcase(dont_break_reductions,Config) ->
37    %% Skip on --enable-native-libs as hipe rescedules after each
38    %% function call.
39    case erlang:system_info(hipe_architecture) of
40        undefined ->
41            Config;
42        Architecture ->
43            {lists, ListsBinary, _ListsFilename} = code:get_object_code(lists),
44            ChunkName = hipe_unified_loader:chunk_name(Architecture),
45            NativeChunk = beam_lib:chunks(ListsBinary, [ChunkName]),
46            case NativeChunk of
47                {ok,{_,[{_,Bin}]}} when is_binary(Bin) ->
48                    {skip,"Does not work for --enable-native-libs"};
49                {error, beam_lib, _} -> Config
50            end
51    end;
52init_per_testcase(_,Config) ->
53    Config.
54
55end_per_testcase(_,_Config) ->
56    ok.
57
58%% Check that save_calls dont break reduction-based scheduling
59dont_break_reductions(Config) when is_list(Config) ->
60    RPS1 = reds_per_sched(0),
61    RPS2 = reds_per_sched(20),
62    Diff = abs(RPS1 - RPS2),
63    true = (Diff < (0.2 * RPS1)),
64    ok.
65
66
67reds_per_sched(SaveCalls) ->
68    Parent = self(),
69    HowMany = 10000,
70    Pid = spawn(fun() ->
71                        process_flag(save_calls,SaveCalls),
72                        receive
73                            go ->
74                                carmichaels_below(HowMany),
75                                Parent ! erlang:process_info(self(),reductions)
76                        end
77                end),
78    TH = spawn(fun() -> trace_handler(0,Parent,Pid) end),
79    erlang:trace(Pid, true,[running,procs,{tracer,TH}]),
80    Pid ! go,
81    {Sched,Reds} = receive
82                       {accumulated,X} ->
83                           receive {reductions,Y} ->
84                                       {X,Y}
85                           after 30000 ->
86                                     timeout
87                           end
88                   after 30000 ->
89                             timeout
90                   end,
91    Reds div Sched.
92
93
94
95trace_handler(Acc,Parent,Client) ->
96    receive
97        {trace,Client,out,_} ->
98            trace_handler(Acc+1,Parent,Client);
99        {trace,Client,exit,_} ->
100            Parent ! {accumulated, Acc};
101        _ ->
102            trace_handler(Acc,Parent,Client)
103    after 10000 ->
104              ok
105    end.
106
107%% Test call saving.
108save_calls_1(Config) when is_list(Config) ->
109    case test_server:is_native(?MODULE) of
110        true -> {skipped,"Native code"};
111        false -> save_calls_1()
112    end.
113
114save_calls_1() ->
115    erlang:process_flag(self(), save_calls, 0),
116    {last_calls, false} = process_info(self(), last_calls),
117
118    erlang:process_flag(self(), save_calls, 10),
119    {last_calls, _L1} = process_info(self(), last_calls),
120    ?MODULE:do_bipp(),
121    {last_calls, L2} = process_info(self(), last_calls),
122    L21 = lists:filter(fun is_local_function/1, L2),
123    case L21 of
124        [{?MODULE,do_bipp,0},
125         timeout,
126         'send',
127         {?MODULE,do_bopp,1},
128         'receive',
129         timeout,
130         {?MODULE,do_bepp,0}] ->
131            ok;
132        X ->
133            ct:fail({l21, X})
134    end,
135
136    erlang:process_flag(self(), save_calls, 10),
137    {last_calls, L3} = process_info(self(), last_calls),
138    true = (L3 /= false),
139    L31 = lists:filter(fun is_local_function/1, L3),
140    [] = L31,
141    erlang:process_flag(self(), save_calls, 0),
142
143    %% Also check that it works on another process ...
144    Pid = spawn(fun () -> receive after infinity -> ok end end),
145    erlang:process_flag(Pid, save_calls, 10),
146    {last_calls, L4} = process_info(Pid, last_calls),
147    true = (L4 /= false),
148    L41 = lists:filter(fun is_local_function/1, L4),
149    [] = L41,
150    exit(Pid,kill),
151    ok.
152
153do_bipp() ->
154    do_bopp(0),
155    do_bapp(),
156    ?MODULE:do_bopp(0),
157    do_bopp(3),
158    apply(?MODULE, do_bepp, []).
159
160do_bapp() ->
161    self() ! heffaklump.
162
163do_bopp(T) ->
164    receive
165        X -> X
166    after T -> ok
167    end.
168
169do_bepp() ->
170    ok.
171
172is_local_function({?MODULE, _, _}) ->
173    true;
174is_local_function({_, _, _}) ->
175    false;
176is_local_function(_) ->
177    true.
178
179
180% Number crunching for reds test.
181carmichaels_below(N) ->
182    rand:seed(exsplus, {3172,9814,20125}),
183    carmichaels_below(1,N).
184
185carmichaels_below(N,N2) when N >= N2 ->
186    0;
187carmichaels_below(N,N2) ->
188    X = case fast_prime(N,10) of
189            false -> 0;
190            true ->
191                case fast_prime2(N,10) of
192                    true ->
193                        %io:format("Prime: ~p~n",[N]),
194                        0;
195                    false ->
196                        io:format("Carmichael: ~p (dividable by ~p)~n",
197                                  [N,smallest_divisor(N)]),
198                        1
199                end
200        end,
201    X+carmichaels_below(N+2,N2).
202
203expmod(_,E,_) when E == 0 ->
204    1;
205expmod(Base,Exp,Mod) when (Exp rem 2) == 0 ->
206    X = expmod(Base,Exp div 2,Mod),
207    (X*X) rem Mod;
208expmod(Base,Exp,Mod) ->
209    (Base * expmod(Base,Exp - 1,Mod)) rem Mod.
210
211uniform(N) ->
212    rand:uniform(N-1).
213
214fermat(N) ->
215    R = uniform(N),
216    expmod(R,N,N) == R.
217
218do_fast_prime(1,_) ->
219    true;
220do_fast_prime(_N,0) ->
221    true;
222do_fast_prime(N,Times) ->
223    case fermat(N) of
224        true ->
225            do_fast_prime(N,Times-1);
226        false ->
227            false
228    end.
229
230fast_prime(N,T) ->
231    do_fast_prime(N,T).
232
233expmod2(_,E,_) when E == 0 ->
234    1;
235expmod2(Base,Exp,Mod) when (Exp rem 2) == 0 ->
236    %% Uncomment the code below to simulate scheduling bug!
237    %     case erlang:process_info(self(),last_calls) of
238    % 	{last_calls,false} -> ok;
239    % 	_ -> erlang:yield()
240    %     end,
241    X = expmod2(Base,Exp div 2,Mod),
242    Y=(X*X) rem Mod,
243    if
244        Y == 1, X =/= 1, X =/= (Mod - 1) ->
245            0;
246        true ->
247            Y rem Mod
248    end;
249expmod2(Base,Exp,Mod) ->
250    (Base * expmod2(Base,Exp - 1,Mod)) rem Mod.
251
252miller_rabbin(N) ->
253    R = uniform(N),
254    expmod2(R,N,N) == R.
255
256do_fast_prime2(1,_) ->
257    true;
258do_fast_prime2(_N,0) ->
259    true;
260do_fast_prime2(N,Times) ->
261    case miller_rabbin(N) of
262        true ->
263            do_fast_prime2(N,Times-1);
264        false ->
265            false
266    end.
267
268fast_prime2(N,T) ->
269    do_fast_prime2(N,T).
270
271smallest_divisor(N) ->
272    find_divisor(N,2).
273
274find_divisor(N,TD) ->
275    if
276        TD*TD > N ->
277            N;
278        true ->
279            case divides(TD,N) of
280                true ->
281                    TD;
282                false ->
283                    find_divisor(N,TD+1)
284            end
285    end.
286
287divides(A,B) ->
288    (B rem A) == 0.
289