1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2015-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-module(beam_block_SUITE).
21
22-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1,
23	 init_per_group/2,end_per_group/2,
24	 get_map_elements/1,otp_7345/1,move_opt_across_gc_bif/1,
25	 erl_202/1,repro/1,local_cse/1,second_block_pass/1,
26         coverage/1]).
27
28%% The only test for the following functions is that
29%% the code compiles and is accepted by beam_validator.
30-export([encode_wildcards3/4,find_operands/4]).
31
32suite() -> [{ct_hooks,[ts_install_cth]}].
33
34all() ->
35    [{group,p}].
36
37groups() ->
38    [{p,[parallel],
39      [get_map_elements,
40       otp_7345,
41       move_opt_across_gc_bif,
42       erl_202,
43       repro,
44       local_cse,
45       second_block_pass,
46       coverage
47      ]}].
48
49init_per_suite(Config) ->
50    test_lib:recompile(?MODULE),
51    Config.
52
53end_per_suite(_Config) ->
54    ok.
55
56init_per_group(_GroupName, Config) ->
57    Config.
58
59end_per_group(_GroupName, Config) ->
60    Config.
61
62get_map_elements(_Config) ->
63    [{pred,var}] = get_map_elements([{pred,var}], #{}, []),
64    [{pred,var}] = get_map_elements([{pred,var}], #{pred=>[]}, []),
65    acc = get_map_elements([], #{pred=>[]}, acc),
66    ok.
67
68get_map_elements([{Pred,Var}|Left], Map, Acc) ->
69    case Map of
70        #{Var := List} ->
71            case lists:keyfind(Pred, 1, List) of
72                false ->
73                    get_map_elements(Left, Map, [{Pred,Var}|Acc])
74            end;
75        #{} ->
76            get_map_elements(Left, Map, [{Pred,Var}|Acc])
77    end;
78get_map_elements([], _Map, Acc) ->
79    Acc.
80
81%% The following code
82%%
83%%    {get_list,{x,2},{x,0},{x,1}}.
84%%    {gc_bif,length,{f,0},1,[{x,0}],{x,0}}.
85%%    {move,{x,0},{x,1}}.
86%%
87%% was incorrectly optimized to
88%%
89%%    {get_list,{x,2},{x,0},{y,0}}.
90%%    {gc_bif,length,{f,0},3,[{x,0}],{x,1}}.
91%%
92%% because beam_block:is_transparent({x,1},
93%%                                  {gc_bif,length,{f,0},3,[{x,0}],{x,1}}
94%% incorrectly returned true.
95
96-record(contextId,{cid,device_type,contextRef}).
97-record(dpRef,{cid,tlli,ms_device_context_id}).
98-record(qosProfileBssgp,{peak_bit_rate_msb,
99                              peak_bit_rate_lsb,
100                              t_a_precedence}).
101-record(llUnitdataReq,{sapi,
102                            l3_pdu_length,
103                            pdu_life}).
104-record(ptmsi,{value}).
105
106otp_7345(_Config) ->
107    #llUnitdataReq{l3_pdu_length=3,pdu_life=4} =
108	otp_7345(#contextId{}, 0, [[1,2,3],4,5]).
109
110
111otp_7345(ObjRef, _RdEnv, Args) ->
112    Cid = ObjRef#contextId.cid,
113    _ =	#dpRef{cid = Cid,
114		     ms_device_context_id = cid_id,
115		     tlli = #ptmsi{value = 0}},
116    _ =	#qosProfileBssgp{peak_bit_rate_msb = 0,
117			 peak_bit_rate_lsb = 80,
118			 t_a_precedence = 49},
119    [Cpdu|_] = Args,
120    LlUnitdataReq =
121	#llUnitdataReq{sapi = 7,
122		       l3_pdu_length = length(Cpdu),
123		       pdu_life =
124		       id(42)
125		       div
126		       10},
127    id(LlUnitdataReq).
128
129
130%% Doing move optimizations across GC bifs are in general not safe.
131move_opt_across_gc_bif(_Config) ->
132    [0,true,1] = positive(speaking),
133    ok.
134
135positive(speaking) ->
136    try
137	Positive = 0,
138	[+Positive, case Positive of _ -> true end, paris([], Positive)]
139    after
140	mailing
141    end.
142
143paris([], P) -> P + 1.
144
145
146%% See https://bugs.erlang.org/browse/ERL-202.
147%% Test that move_allocates/1 in beam_block doesn't move allocate
148%% when it would not be safe.
149
150-record(erl_202_r1, {y}).
151-record(erl_202_r2, {x}).
152
153erl_202(_Config) ->
154    Ref = make_ref(),
155    Ref = erl_202({{1,2},Ref}, 42),
156
157    {Ref} = erl_202({7,8}, #erl_202_r1{y=#erl_202_r2{x=Ref}}),
158
159    ok.
160
161erl_202({{_, _},X}, _) ->
162    X;
163erl_202({_, _}, #erl_202_r1{y=R2}) ->
164    {R2#erl_202_r2.x}.
165
166%% See https://bugs.erlang.org/browse/ERL-266.
167%% Instructions with failure labels are not safe to include
168%% in a block. Including get_map_elements in a block would
169%% lead to unsafe code.
170
171repro(_Config) ->
172    [] = maps:to_list(repro([], #{}, #{})),
173    [{tmp1,n}] = maps:to_list(repro([{tmp1,0}], #{}, #{})),
174    [{tmp1,name}] = maps:to_list(repro([{tmp1,0}], #{}, #{0=>name})),
175    ok.
176
177repro([], TempNames, _Slots) ->
178    TempNames;
179repro([{Temp, Slot}|Xs], TempNames, Slots0) ->
180    {Name, Slots} =
181	case Slots0 of
182	    #{Slot := Name0} -> {Name0, Slots0};
183	    #{} ->              {n,     Slots0#{Slot => n}}
184	end,
185    repro(Xs, TempNames#{Temp => Name}, Slots).
186
187%%%
188%%% The only test of the following code is that it compiles.
189%%%
190
191%% Slightly simplifed from megaco_binary_term_id_gen.
192%%  beam_block failed to note that the {gc_bif,'-'...} instruction could
193%%  fail, and that therefore {y,0} need to be initialized.
194%%    {allocate,8,6}.
195%%                     %% {init,{y,0}} needed here.
196%%    {get_list,{x,1},{x,6},{x,7}}.
197%%    {'catch',{y,7},{f,3}}.
198%%    {move,{x,4},{y,1}}.
199%%    {move,{x,3},{y,2}}.
200%%    {move,{x,2},{y,3}}.
201%%    {move,{x,5},{y,4}}.
202%%    {move,{x,7},{y,5}}.
203%%    {move,{x,6},{y,6}}.
204%%    {gc_bif,'-',{f,0},8,[{x,3},{x,6}],{x,0}}.
205%%    {move,{x,0},{y,0}}.
206
207encode_wildcards3([],[],_,_) -> [];
208encode_wildcards3([Level|Levels],[BitsInLevel|BitsRest],LevelNo,TotSize) ->
209    case (catch ?MODULE:encode_wildcard(Level,BitsInLevel,TotSize-BitsInLevel,
210					length(Levels))) of
211	{'EXIT',{Reason,Info}} ->
212	    exit({Reason,{LevelNo,Info}});
213
214	no_wildcard ->
215	    encode_wildcards3(Levels,BitsRest,LevelNo+1,TotSize-BitsInLevel);
216
217	{level,Wl} ->
218	    [Wl|
219	     encode_wildcards3(Levels,BitsRest,LevelNo+1,TotSize-BitsInLevel)];
220
221	{recursive,Wr} ->
222	    [Wr]
223    end.
224
225%% Slightly simplified code from hipe_rtl_ssapre.
226%%  beam_block used to do the following incorrect optimization:
227%%
228%%    {gc_bif,length,{f,0},1,[{x,0}],{x,3}}.
229%%                                   ^^^^^ Was {x,0} - changing to {x,3} is not safe.
230%%    {gc_bif,'+',{f,0},0,[{y,2},{integer,1}],{x,0}}.
231%%                     ^^^ Only one register live
232%%     . . .
233%%    {call_last,4,{f,2},4}.   %% beam_validator noted that {x,3} wasn't live.
234
235find_operands(Cfg,XsiGraph,[],_Count) ->
236    {Cfg,XsiGraph};
237find_operands(Cfg,XsiGraph,ActiveList,Count) ->
238    {NewCfg,TempActiveList}=?MODULE:find_operands_for_active_list(Cfg,XsiGraph,
239								  ActiveList,[]),
240    NewActiveList=lists:reverse(TempActiveList),
241    [Count+1, length(NewActiveList), length(digraph:vertices(XsiGraph))],
242    find_operands(NewCfg,XsiGraph,NewActiveList,Count+1).
243
244%% Some tests of local common subexpression elimination (CSE).
245
246local_cse(_Config) ->
247    {Self,{ok,Self}} = local_cse_1(),
248
249    local_cse_2([]),
250    local_cse_2(lists:seq(1, 512)),
251    local_cse_2(?MODULE:module_info()),
252
253    {[b],[a,b]} = local_cse_3(a, b),
254
255    {2000,Self,{Self,write_cache}} = local_cse_4(),
256
257    ok.
258
259local_cse_1() ->
260    %% Cover handling of unsafe tuple construction in
261    %% eliminate_use_of_from_reg/4. It became necessary to handle
262    %% unsafe tuples when local CSE was introduced.
263
264    {self(),{ok,self()}}.
265
266local_cse_2(Term) ->
267    case cse_make_binary(Term) of
268        <<Size:8,BinTerm:Size/binary>> ->
269            Term = binary_to_term(BinTerm);
270        <<Size:8,SizeTerm:Size/binary,BinTerm/binary>> ->
271            {'$size',TermSize} = binary_to_term(SizeTerm),
272            TermSize = byte_size(BinTerm),
273            Term = binary_to_term(BinTerm)
274    end.
275
276%% Copy of observer_backend:ttb_make_binary/1. During development of
277%% the local CSE optimization this function was incorrectly optimized.
278
279cse_make_binary(Term) ->
280    B = term_to_binary(Term),
281    SizeB = byte_size(B),
282    if SizeB > 255 ->
283            SB = term_to_binary({'$size',SizeB}),
284            <<(byte_size(SB)):8, SB/binary, B/binary>>;
285       true ->
286            <<SizeB:8, B/binary>>
287    end.
288
289local_cse_3(X, Y) ->
290    %% The following expression was incorrectly transformed to {[X,Y],[X,Y]}
291    %% during development of the local CSE optimization.
292
293    {[Y],[X,Y]}.
294
295local_cse_4() ->
296    do_local_cse_4(2000, self(), {self(), write_cache}).
297
298do_local_cse_4(X, Y, Z) ->
299    {X,Y,Z}.
300
301%% Tests previously found bugs when running beam_block the second time.
302
303second_block_pass(_Config) ->
304    [#{dts:=5.0}] = second_1([#{dts => 10.0}], 2.0),
305    ok.
306
307second_1(Fs, TS) ->
308    [F#{dts=>DTS / TS} || #{dts:=DTS} = F <- Fs].
309
310coverage(_Config) ->
311    [] = coverage_1(),
312    ok.
313
314coverage_1() ->
315    [(bnot head):bar(hdr, case kind of
316                              [] -> whatever
317                          end) || 7 <- []].
318
319%%%
320%%% Common functions.
321%%%
322
323id(I) -> I.
324