1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1998-2018. 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(beam_SUITE).
22
23-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
24	 init_per_group/2,end_per_group/2,
25	 packed_registers/1, apply_last/1, apply_last_bif/1,
26	 buildo_mucho/1, heap_sizes/1, big_lists/1, fconv/1,
27	 select_val/1, swap_temp_apply/1]).
28
29-export([applied/2,swap_temp_applied/1]).
30
31-include_lib("common_test/include/ct.hrl").
32-include_lib("syntax_tools/include/merl.hrl").
33
34suite() -> [{ct_hooks,[ts_install_cth]}].
35
36all() ->
37    [packed_registers, apply_last, apply_last_bif,
38     buildo_mucho, heap_sizes, big_lists, select_val,
39     swap_temp_apply].
40
41groups() ->
42    [].
43
44init_per_suite(Config) ->
45    Config.
46
47end_per_suite(_Config) ->
48    ok.
49
50init_per_group(_GroupName, Config) ->
51    Config.
52
53end_per_group(_GroupName, Config) ->
54    Config.
55
56
57
58%% Verify that apply(M, F, A) is really tail recursive.
59apply_last(Config) when is_list(Config) ->
60    Pid  = spawn(?MODULE, applied, [self(), 10000]),
61    Size =
62	receive
63	    {Pid, finished} ->
64		stack_size(Pid)
65	after 30000 ->
66		ct:fail("applied/2 timed out.")
67	end,
68    Pid ! die,
69    io:format("Size: ~p~n", [Size]),
70    if
71	Size < 700 ->
72	    ok;
73	true ->
74	    ct:fail("10000 apply() grew stack too much.")
75    end,
76    ok.
77
78stack_size(Pid) ->
79    {heap_size, HS}=process_info(Pid, heap_size),
80    {stack_size,SS}=process_info(Pid, stack_size),
81    HS+SS.
82
83applied(Starter, 0) ->
84    Starter ! {self(), finished},
85    receive
86	die ->
87	    ok
88    end,
89    ok;
90applied(Starter, N) ->
91    apply(?MODULE, applied, [Starter, N-1]).
92
93%% Verify that tail-recursive use of apply(M,F,A) on a Bif works."
94apply_last_bif(Config) when is_list(Config) ->
95    apply(erlang, abs, [1]).
96
97%% Test whether packing works properly.
98packed_registers(Config) when is_list(Config) ->
99    Mod = ?FUNCTION_NAME,
100
101    %% Generate scrambled sequence.
102    Seq0 = [{erlang:phash2(I),I} || I <- lists:seq(0, 260)],
103    Seq = [I || {_,I} <- lists:sort(Seq0)],
104
105    %% Generate a test modules that uses get_list/3 instructions
106    %% with high register numbers.
107    S0 = [begin
108	      VarName = list_to_atom("V"++integer_to_list(V)),
109	      {merl:var(VarName),V}
110	  end || V <- Seq],
111    Vars = [V || {V,_} <- S0],
112    NewVars = [begin
113		   VarName = list_to_atom("M"++integer_to_list(V)),
114		   merl:var(VarName)
115	       end || V <- Seq],
116    MoreNewVars = [begin
117                       VarName = list_to_atom("MM"++integer_to_list(V)),
118                       merl:var(VarName)
119                   end || V <- Seq],
120    TupleEls = [?Q("id(_@Value@)") || {_,Value} <- S0],
121    S = [?Q("_@Var = id(_@Value@)") || {Var,Value} <- S0],
122    Code = ?Q(["-module('@Mod@').\n"
123	       "-export([f/0]).\n"
124	       "f() ->\n"
125               "Tuple = id({_@TupleEls}),\n"
126               "{_@MoreNewVars} = Tuple,\n"
127	       "_@S,\n"
128	       "_ = id(0),\n"
129	       "L = [_@Vars],\n"
130	       "_ = id(1),\n"
131	       "[_@NewVars] = L,\n"		%Test get_list/3.
132	       "_ = id(2),\n"
133	       "id([_@Vars,_@NewVars,_@MoreNewVars]).\n"
134	       "id(I) -> I.\n"]),
135    merl:compile_and_load(Code),
136
137    %% Optionally print the generated code.
138    PrintCode = false,                          %Change to true to print code.
139
140    case PrintCode of
141        false ->
142            ok;
143        true ->
144            merl:print(Code),
145            erts_debug:df(Mod),
146            {ok,Dis} = file:read_file(atom_to_list(Mod)++".dis"),
147            io:put_chars(Dis)
148    end,
149
150    CombinedSeq = Seq ++ Seq ++ Seq,
151    CombinedSeq = Mod:f(),
152
153    %% Clean up.
154    true = code:delete(Mod),
155    false = code:purge(Mod),
156    ok.
157
158buildo_mucho(Config) when is_list(Config) ->
159    buildo_mucho_1(),
160    ok.
161
162buildo_mucho_1() ->
163    %% Thanks to Per Gustafsson, HiPE.
164    [{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
165     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
166     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
167     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
168     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
169     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
170     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
171     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
172     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
173     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
174     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
175     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
176     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
177     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
178     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
179     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
180     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
181     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
182     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
183     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
184     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
185     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
186     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
187     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
188     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
189     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
190     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
191     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
192     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
193     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
194     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
195     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
196     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
197     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
198     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
199     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
200     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
201     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
202     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
203     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
204     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
205     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
206     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
207     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
208     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
209     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
210     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
211     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
212     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
213     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
214     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
215     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
216     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
217     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
218     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
219     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
220     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
221     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
222     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
223     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
224     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
225     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
226     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},
227     {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}].
228
229heap_sizes(Config) when is_list(Config) ->
230    Sizes = erlang:system_info(heap_sizes),
231    io:format("~p heap sizes\n", [length(Sizes)]),
232    io:format("~p\n", [Sizes]),
233
234    %% Verify that heap sizes increase monotonically.
235    Largest = lists:foldl(fun(E, P) when is_integer(P), E > P -> E;
236				   (E, []) -> E
237				end, [], Sizes),
238
239    %% Verify that the largest heap size consists of
240    %%  - 31 bits of bytes on 32 bits arch
241    %%  - atleast 52 bits of bytes (48 is the maximum virtual address)
242    %%    and at the most 63 bits on 64 bit archs
243    %% heap sizes are in words
244    case erlang:system_info(wordsize) of
245	8 ->
246	    0    = (Largest*8) bsr 63,
247	    true = (Largest*8) > (1 bsl 52);
248	4 ->
249	    1 = (Largest*4) bsr 31
250    end,
251    ok.
252
253%% Thanks to Igor Goryachev.
254
255big_lists(Config) when is_list(Config) ->
256    b(),
257    ok.
258
259a() ->
260    {selected,
261     ["uid",
262      "nickname",
263      "n_family",
264      "n_given",
265      "email_pref",
266      "tel_home_number",
267      "tel_cellular_number",
268      "adr_home_country",
269      "adr_home_locality",
270      "adr_home_region",
271      "url",
272      "gender",
273      "bday",
274      "constitution",
275      "height",
276      "weight",
277      "hair",
278      "routine",
279      "smoke",
280      "maritalstatus",
281      "children",
282      "independence",
283      "school_number",
284      "school_locality",
285      "school_title",
286      "school_period",
287      "org_orgname",
288      "title",
289      "adr_work_locality",
290      "photo_type",
291      "photo_binval"],
292     [{"test"}]}.
293
294b() ->
295    case a() of
296        {selected,
297         ["uid",
298          "nickname",
299          "n_family",
300          "n_given",
301          "email_pref",
302          "tel_home_number",
303          "tel_cellular_number",
304          "adr_home_country",
305          "adr_home_locality",
306          "adr_home_region",
307          "url",
308          "gender",
309          "bday",
310          "constitution",
311          "height",
312          "weight",
313          "hair",
314          "routine",
315          "smoke",
316          "maritalstatus",
317          "children",
318          "independence",
319          "school_number",
320          "school_locality",
321          "school_title",
322          "school_period",
323          "org_orgname",
324          "title",
325          "adr_work_locality",
326          "photo_type",
327          "photo_binval"],
328         _} ->
329	    ok
330    end.
331
332fconv(Config) when is_list(Config) ->
333    do_fconv(atom),
334    do_fconv(nil),
335    do_fconv(tuple_literal),
336    3.0 = do_fconv(1.0, 2.0),
337    ok.
338
339do_fconv(Type) ->
340    try
341	do_fconv(Type, 1.0),
342	ct:fail(no_badarith)
343    catch
344	error:badarith ->
345	    ok
346    end.
347
348do_fconv(atom, Float) when is_float(Float) ->
349    Float + a;
350do_fconv(nil, Float) when is_float(Float) ->
351    Float + [];
352do_fconv(tuple_literal, Float) when is_float(Float) ->
353    Float + {a,b}.
354
355select_val(Config) when is_list(Config) ->
356    zero = do_select_val(0),
357    big = do_select_val(1 bsl 64),
358    integer = do_select_val(42),
359    ok.
360
361do_select_val(X) ->
362    case X of
363	0 ->
364	    zero;
365	1 bsl 64 ->
366	    big;
367	Int when is_integer(Int) ->
368	    integer
369    end.
370
371swap_temp_apply(_Config) ->
372    {swap_temp_applied,42} = do_swap_temp_apply(41),
373    not_an_integer = do_swap_temp_apply(not_an_integer),
374    ok.
375
376do_swap_temp_apply(Msg) ->
377    case swap_temp_apply_function(Msg) of
378	undefined -> Msg;
379	Type ->
380	    %% The following sequence:
381	    %%   move {x,0} {x,2}
382	    %%   move {y,0} {x,0}
383	    %%   move {x,2} {y,0}
384	    %%   apply 1
385	    %%
386	    %% Would be incorrectly transformed to:
387	    %%   swap {x,0} {y,0}
388	    %%   apply 1
389	    %%
390	    %% ({x,1} is the module, {x,2} the function to be applied).
391	    %%
392	    %% If the instructions are to be transformed, the correct
393	    %% transformation is:
394	    %%
395	    %%   swap_temp {x,0} {y,0} {x,2}
396	    %%   apply 1
397	    Fields = ?MODULE:Type(Msg),
398	    {Type,Fields}
399    end.
400
401swap_temp_apply_function(Int) when is_integer(Int) ->
402    swap_temp_applied;
403swap_temp_apply_function(_) ->
404    undefined.
405
406swap_temp_applied(Int) ->
407    Int+1.
408