← Back to branch summary

~ubuntu-branches/ubuntu/trusty/erlang/trusty

« back to all changes in this revision

Viewing changes to lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_bool.erl

  • Committer: Bazaar Package Importer
  • Author(s): Clint Byrum
  • Date: 2011-05-05 15:48:43 UTC
  • mfrom: (3.5.13 sid)
  • Revision ID: james.westby@ubuntu.com-20110505154843-0om6ekzg6m7ugj27
Tags: 1:14.b.2-dfsg-3ubuntu1
* Merge from debian unstable.  Remaining changes:
  - Drop libwxgtk2.8-dev build dependency. Wx isn't in main, and not
    supposed to.
  - Drop erlang-wx binary.
  - Drop erlang-wx dependency from -megaco, -common-test, and -reltool, they
    do not really need wx. Also drop it from -debugger; the GUI needs wx,
    but it apparently has CLI bits as well, and is also needed by -megaco,
    so let's keep the package for now.
  - debian/patches/series: Do what I meant, and enable build-options.patch
    instead.
* Additional changes:
  - Drop erlang-wx from -et
* Dropped Changes:
  - patches/pcre-crash.patch: CVE-2008-2371: outer level option with
    alternatives caused crash. (Applied Upstream)
  - fix for ssl certificate verification in newSSL: 
    ssl_cacertfile_fix.patch (Applied Upstream)
  - debian/patches/series: Enable native.patch again, to get stripped beam
    files and reduce the package size again. (build-options is what
    actually accomplished this)
  - Remove build-options.patch on advice from upstream and because it caused
    odd build failures.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_bool.erl
 
1
%% ``The contents of this file are subject to the Erlang Public License,
 
2
%% Version 1.1, (the "License"); you may not use this file except in
 
3
%% compliance with the License. You should have received a copy of the
 
4
%% Erlang Public License along with this software. If not, it can be
 
5
%% retrieved via the world wide web at http://www.erlang.org/.
 
6
%% 
 
7
%% Software distributed under the License is distributed on an "AS IS"
 
8
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
 
9
%% the License for the specific language governing rights and limitations
 
10
%% under the License.
 
11
%% 
 
12
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
 
13
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
 
14
%% AB. All Rights Reserved.''
 
15
%% 
 
16
%%     $Id: beam_bool.erl,v 1.1 2008/12/17 09:53:41 mikpe Exp $
 
17
%%
 
18
%% Purpose: Optimizes booleans in guards.
 
19
 
 
20
-module(beam_bool).
 
21
 
 
22
-export([module/2]).
 
23
 
 
24
-import(lists, [reverse/1,foldl/3,mapfoldl/3,sort/1,member/2]).
 
25
-define(MAXREG, 1024).
 
26
 
 
27
-record(st,
 
28
        {next,                                  %Next label number.
 
29
         ll                                     %Live regs at labels.
 
30
        }).
 
31
         
 
32
module({Mod,Exp,Attr,Fs0,Lc}, _Opts) ->
 
33
    %%io:format("~p:\n", [Mod]),
 
34
    {Fs,_} = mapfoldl(fun(Fn, Lbl) -> function(Fn, Lbl) end, 100000000, Fs0),
 
35
    {ok,{Mod,Exp,Attr,Fs,Lc}}.
 
36
 
 
37
function({function,Name,Arity,CLabel,Is0}, Lbl0) ->
 
38
    %%io:format("~p/~p:\n", [Name,Arity]),
 
39
    {Is,#st{next=Lbl}} = bool_opt(Is0, Lbl0),
 
40
    {{function,Name,Arity,CLabel,Is},Lbl}.
 
41
 
 
42
%%
 
43
%% Optimize boolean expressions that use guard bifs. Rewrite to
 
44
%% use test instructions if possible.
 
45
%%
 
46
 
 
47
bool_opt(Asm, Lbl) ->
 
48
    LiveInfo = index_instructions(Asm),
 
49
    bopt(Asm, [], #st{next=Lbl,ll=LiveInfo}).
 
50
 
 
51
bopt([{block,Bl0}=Block|
 
52
      [{jump,{f,Succ}},
 
53
       {label,Fail},
 
54
       {block,[{set,[Dst],[{atom,false}],move},{'%live',Live}]},
 
55
       {label,Succ}|Is]=Is0], Acc0, St) ->
 
56
    case split_block(Bl0, Dst, Fail) of
 
57
        failed ->
 
58
            bopt(Is0, [Block|Acc0], St);
 
59
        {Bl,PreBlock} ->
 
60
            Acc1 = case PreBlock of
 
61
                       [] -> Acc0;
 
62
                       _ -> [{block,PreBlock}|Acc0]
 
63
                   end,
 
64
            Acc = [{protected,[Dst],Bl,{Fail,Succ,Live}}|Acc1],
 
65
            bopt(Is, Acc, St)
 
66
    end;
 
67
bopt([{test,is_eq_exact,{f,Fail},[Reg,{atom,true}]}=I|Is], [{block,_}|_]=Acc0, St0) ->
 
68
    case bopt_block(Reg, Fail, Is, Acc0, St0) of
 
69
        failed -> bopt(Is, [I|Acc0], St0);
 
70
        {Acc,St} -> bopt(Is, Acc, St)
 
71
    end;
 
72
bopt([I|Is], Acc, St) ->
 
73
    bopt(Is, [I|Acc], St);
 
74
bopt([], Acc, St) ->
 
75
    {bopt_reverse(Acc, []),St}.
 
76
 
 
77
bopt_reverse([{protected,[Dst],Block,{Fail,Succ,Live}}|Is], Acc0) ->
 
78
    Acc = [{block,Block},{jump,{f,Succ}},
 
79
           {label,Fail},
 
80
           {block,[{set,[Dst],[{atom,false}],move},{'%live',Live}]},
 
81
           {label,Succ}|Acc0],
 
82
    bopt_reverse(Is, Acc);
 
83
bopt_reverse([I|Is], Acc) ->
 
84
    bopt_reverse(Is, [I|Acc]);
 
85
bopt_reverse([], Acc) -> Acc.
 
86
 
 
87
%% bopt_block(Reg, Fail, OldIs, Accumulator, St) -> failed | {NewAcc,St}
 
88
%%  Attempt to optimized a block of guard BIFs followed by a test
 
89
%%  instruction.
 
90
bopt_block(Reg, Fail, OldIs, [{block,Bl0}|Acc0], St0) ->
 
91
    case split_block(Bl0, Reg, Fail) of
 
92
        failed ->
 
93
            %% Reason for failure: The block either contained no
 
94
            %% guard BIFs with the failure label Fail, or the final
 
95
            %% instruction in the block did not assign the Reg register.
 
96
 
 
97
            %%io:format("split ~p: ~P\n", [Reg,Bl0,20]),
 
98
            failed;
 
99
        {Bl1,BlPre} ->
 
100
            %% The block has been splitted. Bl1 is a non-empty list
 
101
            %% of guard BIF instructions having the failure label Fail.
 
102
            %% BlPre is a (possibly empty list) of instructions preceeding
 
103
            %% Bl1.
 
104
            Acc1 = make_block(BlPre, Acc0),
 
105
            {Bl,Acc} = extend_block(Bl1, Fail, Acc1),
 
106
            case catch bopt_block_1(Bl, Fail, St0) of
 
107
                {'EXIT',_Reason} ->
 
108
                    %% Optimization failed for one of the following reasons:
 
109
                    %%
 
110
                    %% 1. Not possible to rewrite because a boolean value is
 
111
                    %%    passed to another guard bif, e.g. 'abs(A > B)'
 
112
                    %%    (in this case, obviously nonsense code). Rare in
 
113
                    %%    practice.
 
114
                    %%
 
115
                    %% 2. Not possible to rewrite because we have not seen
 
116
                    %%    the complete boolan expression (it is spread out
 
117
                    %%    over several blocks with jumps and labels).
 
118
                    %%    The 'or' and 'and' instructions need to that fully
 
119
                    %%    known operands in order to be eliminated.
 
120
                    %%
 
121
                    %% 3. Other bug or limitation.
 
122
 
 
123
                    %%io:format("~P\n", [_Reason,20]),
 
124
                    failed;
 
125
                {NewCode,St} ->
 
126
                    case is_opt_safe(Bl, NewCode, OldIs, St) of
 
127
                        false ->
 
128
                            %% The optimization is not safe. (A register
 
129
                            %% used by the instructions following the
 
130
                            %% optimized code is either not assigned a
 
131
                            %% value at all or assigned a different value.)
 
132
 
 
133
                            %%io:format("\nNot safe:\n"),
 
134
                            %%io:format("~p\n", [Bl]),
 
135
                            %%io:format("~p\n", [reverse(NewCode)]),
 
136
                            failed;
 
137
                        true -> {NewCode++Acc,St}
 
138
                    end
 
139
            end
 
140
    end.
 
141
 
 
142
bopt_block_1(Block, Fail, St) ->
 
143
    {Pre0,[{_,Tree}]} = bopt_tree(Block),
 
144
    Pre = update_fail_label(Pre0, Fail, []),
 
145
    bopt_cg(Tree, Fail, make_block(Pre, []), St).
 
146
 
 
147
%% is_opt_safe(OriginalCode, OptCode, FollowingCode, State) -> true|false
 
148
%%  Comparing the original code to the optimized code, determine
 
149
%%  whether the optimized code is guaranteed to work in the same
 
150
%%  way as the original code.
 
151
 
 
152
is_opt_safe(Bl, NewCode, OldIs, St) ->
 
153
    %% Here are the conditions that must be true for the
 
154
    %% optimization to be safe.
 
155
    %%
 
156
    %% 1. Any register that was assigned a value in the original
 
157
    %%    code, but is not in the optimized code, must be guaranteed
 
158
    %%    to be KILLED in the following code. (NotSet below.)
 
159
    %% 
 
160
    %% 2. Any register that is assigned a value in the optimized
 
161
    %%    code must be UNUSED in the following code. (NewDst, Set.)
 
162
    %%    (Possible future improvement: Registers that are known
 
163
    %%    to be assigned the SAME value in the original and optimized
 
164
    %%    code don't need to be unused in the following code.)
 
165
 
 
166
    PrevDst = dst_regs(Bl),
 
167
    NewDst = dst_regs(NewCode),
 
168
    NotSet = ordsets:subtract(PrevDst, NewDst),
 
169
 
 
170
    %% Note: The following line is an optimization. We don't need
 
171
    %% to test whether variables in NotSet for being unused, because
 
172
    %% they will all be tested for being killed (a stronger condition
 
173
    %% than being unused).
 
174
    
 
175
    Set = ordsets:subtract(NewDst, NotSet),
 
176
 
 
177
    all_killed(NotSet, OldIs, St) andalso
 
178
        none_used(Set, OldIs, St).
 
179
 
 
180
% update_fail_label([{set,_,_,{bif,_,{f,0}}}=I|Is], Fail, Acc) ->
 
181
%     update_fail_label(Is, Fail, [I|Acc]);
 
182
update_fail_label([{set,Ds,As,{bif,N,{f,_}}}|Is], Fail, Acc) ->
 
183
    update_fail_label(Is, Fail, [{set,Ds,As,{bif,N,{f,Fail}}}|Acc]);
 
184
update_fail_label([], _, Acc) -> Acc.
 
185
    
 
186
make_block([], Acc) -> Acc;
 
187
make_block(Bl, Acc) -> [{block,Bl}|Acc].
 
188
 
 
189
extend_block(BlAcc, Fail, [{protected,_,_,_}=Prot|OldAcc]) ->
 
190
    extend_block([Prot|BlAcc], Fail, OldAcc);
 
191
extend_block(BlAcc0, Fail, [{block,Is0}|OldAcc]=OldAcc0) ->
 
192
    case extend_block_1(reverse(Is0), Fail, BlAcc0) of
 
193
        {[],_} -> {BlAcc0,OldAcc0};
 
194
        {BlAcc,[]} -> extend_block(BlAcc, Fail, OldAcc);
 
195
        {BlAcc,Is} -> {BlAcc,[{block,Is}|OldAcc]}
 
196
    end;
 
197
extend_block(BlAcc, _, OldAcc) -> {BlAcc,OldAcc}.
 
198
 
 
199
extend_block_1([{set,[_],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) ->
 
200
    extend_block_1(Is, Fail, [I|Acc]);
 
201
extend_block_1([{set,[_],As,{bif,Bif,_}}=I|Is]=Is0, Fail, Acc) ->
 
202
    case safe_bool_op(Bif, length(As)) of
 
203
        false -> {Acc,reverse(Is0)};
 
204
        true -> extend_block_1(Is, Fail, [I|Acc])
 
205
    end;
 
206
extend_block_1([_|_]=Is, _, Acc) -> {Acc,reverse(Is)};
 
207
extend_block_1([], _, Acc) -> {Acc,[]}.
 
208
 
 
209
split_block(Is0, Dst, Fail) ->
 
210
    case reverse(Is0) of
 
211
        [{'%live',_}|[{set,[Dst],_,_}|_]=Is] ->
 
212
            split_block_1(Is, Fail);
 
213
        [{set,[Dst],_,_}|_]=Is ->
 
214
            split_block_1(Is, Fail);
 
215
        _ -> failed
 
216
    end.
 
217
 
 
218
split_block_1(Is, Fail) ->
 
219
    case split_block_2(Is, Fail, []) of
 
220
        {[],_} -> failed;
 
221
        {_,_}=Res -> Res
 
222
    end.
 
223
 
 
224
% split_block_2([{set,[_],_,{bif,_,{f,0}}}=I|Is], Fail, Acc) ->
 
225
%     split_block_2(Is, Fail, [I|Acc]);
 
226
split_block_2([{set,[_],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) ->
 
227
    split_block_2(Is, Fail, [I|Acc]);
 
228
split_block_2([{'%live',_}|Is], Fail, Acc) ->
 
229
    split_block_2(Is, Fail, Acc);
 
230
split_block_2(Is, _, Acc) -> {Acc,reverse(Is)}.
 
231
 
 
232
dst_regs(Is) ->
 
233
    dst_regs(Is, []).
 
234
 
 
235
dst_regs([{block,Bl}|Is], Acc) ->
 
236
    dst_regs(Bl, dst_regs(Is, Acc));
 
237
dst_regs([{set,[D],_,{bif,_,{f,_}}}|Is], Acc) ->
 
238
    dst_regs(Is, [D|Acc]);
 
239
dst_regs([_|Is], Acc) ->
 
240
    dst_regs(Is, Acc);
 
241
dst_regs([], Acc) -> ordsets:from_list(Acc).
 
242
 
 
243
all_killed([R|Rs], OldIs, St) ->
 
244
    case is_killed(R, OldIs, St) of
 
245
        false -> false;
 
246
        true -> all_killed(Rs, OldIs, St)
 
247
    end;
 
248
all_killed([], _, _) -> true.
 
249
 
 
250
none_used([R|Rs], OldIs, St) ->
 
251
    case is_not_used(R, OldIs, St) of
 
252
        false -> false;
 
253
        true -> none_used(Rs, OldIs, St)
 
254
    end;
 
255
none_used([], _, _) -> true.
 
256
 
 
257
bopt_tree(Block0) ->
 
258
    Block = ssa_block(Block0),
 
259
    Reg = free_variables(Block),
 
260
    %%io:format("~p\n", [Block]),
 
261
    %%io:format("~p\n", [Reg]),
 
262
    Res = bopt_tree_1(Block, Reg, []),
 
263
    %%io:format("~p\n", [Res]),
 
264
    Res.
 
265
 
 
266
bopt_tree_1([{set,[Dst],As0,{bif,'not',_}}|Is], Forest0, Pre) ->
 
267
    {[Arg],Forest1} = bopt_bool_args(As0, Forest0),
 
268
    Forest = gb_trees:enter(Dst, {'not',Arg}, Forest1),
 
269
    bopt_tree_1(Is, Forest, Pre);
 
270
bopt_tree_1([{set,[Dst],As0,{bif,'and',_}}|Is], Forest0, Pre) ->
 
271
    {As,Forest1} = bopt_bool_args(As0, Forest0),
 
272
    AndList = make_and_list(As),
 
273
    Forest = gb_trees:enter(Dst, {'and',AndList}, Forest1),
 
274
    bopt_tree_1(Is, Forest, Pre);
 
275
bopt_tree_1([{set,[Dst],[L0,R0],{bif,'or',_}}|Is], Forest0, Pre) ->
 
276
    L = gb_trees:get(L0, Forest0),
 
277
    R = gb_trees:get(R0, Forest0),
 
278
    Forest1 = gb_trees:delete(L0, gb_trees:delete(R0, Forest0)),
 
279
    OrList = make_or_list([L,R]),
 
280
    Forest = gb_trees:enter(Dst, {'or',OrList}, Forest1),
 
281
    bopt_tree_1(Is, Forest, Pre);
 
282
bopt_tree_1([{protected,[Dst],_,_}=Prot|Is], Forest0, Pre) ->
 
283
    Forest = gb_trees:enter(Dst, Prot, Forest0),
 
284
    bopt_tree_1(Is, Forest, Pre);    
 
285
bopt_tree_1([{set,[Dst],As,{bif,N,_}}=Bif|Is], Forest0, Pre) ->
 
286
    Ar = length(As),
 
287
    case safe_bool_op(N, Ar) of
 
288
        false ->
 
289
            bopt_good_args(As, Forest0),
 
290
            Forest = gb_trees:enter(Dst, any, Forest0),
 
291
            bopt_tree_1(Is, Forest, [Bif|Pre]);
 
292
        true ->
 
293
            bopt_good_args(As, Forest0),
 
294
            Test = bif_to_test(Dst, N, As),
 
295
            Forest = gb_trees:enter(Dst, Test, Forest0),
 
296
            bopt_tree_1(Is, Forest, Pre)
 
297
    end;
 
298
bopt_tree_1([], Forest, Pre) ->
 
299
    {Pre,[R || {_,V}=R <- gb_trees:to_list(Forest), V =/= any]}.
 
300
 
 
301
safe_bool_op(internal_is_record, 3) -> true;
 
302
safe_bool_op(N, Ar) ->
 
303
    erl_internal:new_type_test(N, Ar) orelse erl_internal:comp_op(N, Ar).
 
304
 
 
305
bopt_bool_args(As, Forest) ->
 
306
    mapfoldl(fun bopt_bool_arg/2, Forest, As).
 
307
 
 
308
bopt_bool_arg({T,_}=R, Forest) when T == x; T == y ->
 
309
    {gb_trees:get(R, Forest),gb_trees:delete(R, Forest)};
 
310
bopt_bool_arg(Term, Forest) ->
 
311
    {Term,Forest}.
 
312
 
 
313
bopt_good_args([A|As], Regs) ->
 
314
    bopt_good_arg(A, Regs),
 
315
    bopt_good_args(As, Regs);
 
316
bopt_good_args([], _) -> ok.
 
317
 
 
318
bopt_good_arg({x,_}=X, Regs) ->
 
319
    case gb_trees:get(X, Regs) of
 
320
        any -> ok;
 
321
        _Other ->
 
322
            %%io:format("not any: ~p: ~p\n", [X,_Other]),
 
323
            exit(bad_contents)
 
324
    end;
 
325
bopt_good_arg(_, _) -> ok.
 
326
 
 
327
bif_to_test(_, N, As) ->
 
328
    bif_to_test(N, As).
 
329
 
 
330
bif_to_test(internal_is_record, [_,_,_]=As) ->
 
331
    {test,internal_is_record,fail,As};
 
332
bif_to_test('=:=', As) -> {test,is_eq_exact,fail,As};
 
333
bif_to_test('=/=', As) -> {test,is_ne_exact,fail,As};
 
334
bif_to_test('==', As) -> {test,is_eq,fail,As};
 
335
bif_to_test('/=', As) -> {test,is_ne,fail,As};
 
336
bif_to_test('=<', [L,R]) -> {test,is_ge,fail,[R,L]};
 
337
bif_to_test('>=', As) -> {test,is_ge,fail,As};
 
338
bif_to_test('>', [L,R]) -> {test,is_lt,fail,[R,L]};
 
339
bif_to_test('<', As) -> {test,is_lt,fail,As};
 
340
bif_to_test(Name, [_]=As) ->
 
341
    case erl_internal:new_type_test(Name, 1) of
 
342
        false -> exit({bif_to_test,Name,As,failed});
 
343
        true -> {test,Name,fail,As}
 
344
    end.
 
345
 
 
346
make_and_list([{'and',As}|Is]) ->
 
347
    make_and_list(As++Is);
 
348
make_and_list([I|Is]) ->
 
349
    [I|make_and_list(Is)];
 
350
make_and_list([]) -> [].
 
351
 
 
352
make_or_list([{'or',As}|Is]) ->
 
353
    make_or_list(As++Is);
 
354
make_or_list([I|Is]) ->
 
355
    [I|make_or_list(Is)];
 
356
make_or_list([]) -> [].
 
357
 
 
358
%% Code generation for a boolean tree.
 
359
 
 
360
bopt_cg({'not',Arg}, Fail, Acc, St) ->
 
361
    I = bopt_cg_not(Arg),
 
362
    bopt_cg(I, Fail, Acc, St);
 
363
bopt_cg({'and',As}, Fail, Acc, St) ->
 
364
    bopt_cg_and(As, Fail, Acc, St);
 
365
bopt_cg({'or',As}, Fail, Acc, St0) ->
 
366
    {Succ,St} = new_label(St0),
 
367
    bopt_cg_or(As, Succ, Fail, Acc, St);
 
368
bopt_cg({test,is_tuple_element,fail,[Tmp,Tuple,RecordTag]}, Fail, Acc, St) ->
 
369
    {[{test,is_eq_exact,{f,Fail},[Tmp,RecordTag]},
 
370
      {get_tuple_element,Tuple,0,Tmp}|Acc],St};
 
371
bopt_cg({inverted_test,is_tuple_element,fail,[Tmp,Tuple,RecordTag]}, Fail, Acc, St) ->
 
372
    {[{test,is_ne_exact,{f,Fail},[Tmp,RecordTag]},
 
373
      {get_tuple_element,Tuple,0,Tmp}|Acc],St};
 
374
bopt_cg({test,N,fail,As}, Fail, Acc, St) ->
 
375
    Test = {test,N,{f,Fail},As},
 
376
    {[Test|Acc],St};
 
377
bopt_cg({inverted_test,N,fail,As}, Fail, Acc, St0) ->
 
378
    {Lbl,St} = new_label(St0),
 
379
    {[{label,Lbl},{jump,{f,Fail}},{test,N,{f,Lbl},As}|Acc],St};
 
380
bopt_cg({protected,_,Bl0,{_,_,_}}, Fail, Acc, St0) ->
 
381
    {Bl,St} = bopt_block_1(Bl0, Fail, St0),
 
382
    {Bl++Acc,St};
 
383
bopt_cg([_|_]=And, Fail, Acc, St) ->
 
384
    bopt_cg_and(And, Fail, Acc, St).
 
385
 
 
386
bopt_cg_not({'and',As0}) ->
 
387
    As = [bopt_cg_not(A) || A <- As0],
 
388
    {'or',As};
 
389
bopt_cg_not({'or',As0}) ->
 
390
    As = [bopt_cg_not(A) || A <- As0],
 
391
    {'and',As};
 
392
bopt_cg_not({test,Test,Fail,As}) ->
 
393
    {inverted_test,Test,Fail,As}.
 
394
 
 
395
bopt_cg_and([{atom,false}|_], Fail, _, St) ->
 
396
    {[{jump,{f,Fail}}],St};
 
397
bopt_cg_and([{atom,true}|Is], Fail, Acc, St) ->
 
398
    bopt_cg_and(Is, Fail, Acc, St);
 
399
bopt_cg_and([I|Is], Fail, Acc0, St0) ->
 
400
    {Acc,St} = bopt_cg(I, Fail, Acc0, St0),
 
401
    bopt_cg_and(Is, Fail, Acc, St);
 
402
bopt_cg_and([], _, Acc, St) -> {Acc,St}.
 
403
 
 
404
bopt_cg_or([I], Succ, Fail, Acc0, St0) ->
 
405
    {Acc,St} = bopt_cg(I, Fail, Acc0, St0),
 
406
    {[{label,Succ}|Acc],St};
 
407
bopt_cg_or([I|Is], Succ, Fail, Acc0, St0) ->
 
408
    {Lbl,St1} = new_label(St0),
 
409
    {Acc,St} = bopt_cg(I, Lbl, Acc0, St1),
 
410
    bopt_cg_or(Is, Succ, Fail, [{label,Lbl},{jump,{f,Succ}}|Acc], St).
 
411
    
 
412
new_label(#st{next=LabelNum}=St) when is_integer(LabelNum) ->
 
413
    {LabelNum,St#st{next=LabelNum+1}}.
 
414
 
 
415
free_variables(Is) ->
 
416
    E = gb_sets:empty(),
 
417
    free_vars_1(Is, E, E).
 
418
 
 
419
free_vars_1([{set,[Dst],As,{bif,_,_}}|Is], F0, N0) ->
 
420
    F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)),
 
421
    N = gb_sets:union(N0, var_list([Dst])),
 
422
    free_vars_1(Is, F, N);
 
423
free_vars_1([{protected,_,Pa,_}|Is], F, N) ->
 
424
    free_vars_1(Pa++Is, F, N);
 
425
free_vars_1([], F, _) ->
 
426
    gb_trees:from_orddict([{K,any} || K <- gb_sets:to_list(F)]).
 
427
 
 
428
var_list(Is) ->
 
429
    var_list_1(Is, gb_sets:empty()).
 
430
 
 
431
var_list_1([{x,_}=X|Is], D) ->
 
432
    var_list_1(Is, gb_sets:add(X, D));
 
433
var_list_1([_|Is], D) ->
 
434
    var_list_1(Is, D);
 
435
var_list_1([], D) -> D.
 
436
 
 
437
%%%
 
438
%%% Convert a block to Static Single Assignment (SSA) form.
 
439
%%%
 
440
 
 
441
-record(ssa,
 
442
        {live,
 
443
         sub}).
 
444
         
 
445
ssa_block(Is0) ->
 
446
    Next = ssa_first_free(Is0, 0),
 
447
    {Is,_} = ssa_block_1(Is0, #ssa{live=Next,sub=gb_trees:empty()}, []),
 
448
    Is.
 
449
 
 
450
ssa_block_1([{protected,[_],Pa0,Pb}|Is], Sub0, Acc) ->
 
451
    {Pa,Sub} = ssa_block_1(Pa0, Sub0, []),
 
452
    Dst = ssa_last_target(Pa),
 
453
    ssa_block_1(Is, Sub, [{protected,[Dst],Pa,Pb}|Acc]);
 
454
ssa_block_1([{set,[Dst],As,Bif}|Is], Sub0, Acc0) ->
 
455
    Sub1 = ssa_in_use_list(As, Sub0),
 
456
    Sub = ssa_assign(Dst, Sub1),
 
457
    Acc = [{set,[ssa_sub(Dst, Sub)],ssa_sub_list(As, Sub0),Bif}|Acc0],
 
458
    ssa_block_1(Is, Sub, Acc);
 
459
ssa_block_1([], Sub, Acc) -> {reverse(Acc),Sub}.
 
460
 
 
461
ssa_in_use_list(As, Sub) ->
 
462
    foldl(fun ssa_in_use/2, Sub, As).
 
463
 
 
464
ssa_in_use({x,_}=R, #ssa{sub=Sub0}=Ssa) ->
 
465
    case gb_trees:is_defined(R, Sub0) of
 
466
        true -> Ssa;
 
467
        false ->
 
468
            Sub = gb_trees:insert(R, R, Sub0),
 
469
            Ssa#ssa{sub=Sub}
 
470
    end;
 
471
ssa_in_use(_, Ssa) -> Ssa.
 
472
 
 
473
ssa_assign({x,_}=R, #ssa{sub=Sub0}=Ssa0) ->
 
474
    case gb_trees:is_defined(R, Sub0) of
 
475
        false ->
 
476
            Sub = gb_trees:insert(R, R, Sub0),
 
477
            Ssa0#ssa{sub=Sub};
 
478
        true ->
 
479
            {NewReg,Ssa} = ssa_new_reg(Ssa0),
 
480
            Sub1 = gb_trees:update(R, NewReg, Sub0),
 
481
            Sub = gb_trees:insert(NewReg, NewReg, Sub1),
 
482
            Ssa#ssa{sub=Sub}
 
483
    end;
 
484
ssa_assign(_, Ssa) -> Ssa.
 
485
 
 
486
ssa_sub_list(List, Sub) ->
 
487
    [ssa_sub(E, Sub) || E <- List].
 
488
 
 
489
ssa_sub(R0, #ssa{sub=Sub}) ->
 
490
    case gb_trees:lookup(R0, Sub) of
 
491
        none -> R0;
 
492
        {value,R} -> R
 
493
    end.
 
494
 
 
495
ssa_new_reg(#ssa{live=Reg}=Ssa) ->
 
496
    {{x,Reg},Ssa#ssa{live=Reg+1}}.
 
497
 
 
498
ssa_first_free([{protected,Ds,_,_}|Is], Next0) ->
 
499
    Next = ssa_first_free_list(Ds, Next0),
 
500
    ssa_first_free(Is, Next);
 
501
ssa_first_free([{set,[Dst],As,_}|Is], Next0) ->
 
502
    Next = ssa_first_free_list([Dst|As], Next0),
 
503
    ssa_first_free(Is, Next);
 
504
ssa_first_free([], Next) -> Next.
 
505
 
 
506
ssa_first_free_list(Regs, Next) ->
 
507
    foldl(fun({x,R}, N) when R >= N -> R+1;
 
508
             (_, N) -> N end, Next, Regs).
 
509
 
 
510
ssa_last_target([{set,[Dst],_,_},{'%live',_}]) -> Dst;
 
511
ssa_last_target([{set,[Dst],_,_}]) -> Dst;
 
512
ssa_last_target([_|Is]) -> ssa_last_target(Is).
 
513
    
 
514
%% index_instructions(FunctionIs) -> GbTree([{Label,Is}])
 
515
%%  Index the instruction sequence so that we can quickly
 
516
%%  look up the instruction following a specific label.
 
517
 
 
518
index_instructions(Is) ->
 
519
    ii_1(Is, []).
 
520
 
 
521
ii_1([{label,Lbl}|Is0], Acc) ->
 
522
    Is = lists:dropwhile(fun({label,_}) -> true;
 
523
                            (_) -> false end, Is0),
 
524
    ii_1(Is0, [{Lbl,Is}|Acc]);
 
525
ii_1([_|Is], Acc) ->
 
526
    ii_1(Is, Acc);
 
527
ii_1([], Acc) -> gb_trees:from_orddict(sort(Acc)).
 
528
 
 
529
%% is_killed(Register, [Instruction], State) -> true|false
 
530
%%  Determine whether a register is killed in the instruction sequence.
 
531
%%  The state is used to allow us to determine the kill state
 
532
%%  across branches.
 
533
 
 
534
is_killed(R, Is, St) ->
 
535
    case is_killed_1(R, Is, St) of
 
536
        false ->
 
537
            %%io:format("nk ~p: ~P\n", [R,Is,15]),
 
538
            false;
 
539
        true -> true
 
540
    end.
 
541
 
 
542
is_killed_1(R, [{block,Blk}|Is], St) ->
 
543
    case is_killed_1(R, Blk, St) of
 
544
        true -> true;
 
545
        false -> is_killed_1(R, Is, St)
 
546
    end;
 
547
is_killed_1(R, [{test,_,{f,Fail},As}|Is], St) ->
 
548
    case not member(R, As) andalso is_reg_killed_at(R, Fail, St) of
 
549
        false -> false;
 
550
        true -> is_killed_1(R, Is, St)
 
551
    end;
 
552
is_killed_1(R, [{select_val,R,_,_}|_], _) -> false;
 
553
is_killed_1(R, [{select_val,_,Fail,{list,Branches}}|_], St) ->
 
554
    is_killed_at_all(R, [Fail|Branches], St);
 
555
is_killed_1(R, [{jump,{f,F}}|_], St) ->
 
556
    is_reg_killed_at(R, F, St);
 
557
is_killed_1(Reg, Is, _) ->
 
558
    beam_block:is_killed(Reg, Is).
 
559
 
 
560
is_reg_killed_at(R, Lbl, #st{ll=Ll}=St) ->
 
561
    Is = gb_trees:get(Lbl, Ll),
 
562
    is_killed_1(R, Is, St).
 
563
 
 
564
is_killed_at_all(R, [{f,Lbl}|T], St) ->
 
565
    case is_reg_killed_at(R, Lbl, St) of
 
566
        false -> false;
 
567
        true -> is_killed_at_all(R, T, St)
 
568
    end;
 
569
is_killed_at_all(R, [_|T], St) ->
 
570
    is_killed_at_all(R, T, St);
 
571
is_killed_at_all(_, [], _) -> true.
 
572
 
 
573
%% is_not_used(Register, [Instruction], State) -> true|false
 
574
%%  Determine whether a register is never used in the instruction sequence
 
575
%%  (it could still referenced by an allocate instruction, meaning that
 
576
%%  it MUST be initialized).
 
577
%%    The state is used to allow us to determine the usage state
 
578
%%  across branches.
 
579
 
 
580
is_not_used(R, Is, St) ->
 
581
    case is_not_used_1(R, Is, St) of
 
582
        false ->
 
583
            %%io:format("used ~p: ~P\n", [R,Is,15]),
 
584
            false;
 
585
        true -> true
 
586
    end.
 
587
 
 
588
is_not_used_1(R, [{block,Blk}|Is], St) ->
 
589
    case is_not_used_1(R, Blk, St) of
 
590
        true -> true;
 
591
        false -> is_not_used_1(R, Is, St)
 
592
    end;
 
593
is_not_used_1(R, [{test,_,{f,Fail},As}|Is], St) ->
 
594
    case not member(R, As) andalso is_reg_not_used_at(R, Fail, St) of
 
595
        false -> false;
 
596
        true -> is_not_used_1(R, Is, St)
 
597
    end;
 
598
is_not_used_1(R, [{select_val,R,_,_}|_], _) -> false;
 
599
is_not_used_1(R, [{select_val,_,Fail,{list,Branches}}|_], St) ->
 
600
    is_used_at_none(R, [Fail|Branches], St);
 
601
is_not_used_1(R, [{jump,{f,F}}|_], St) ->
 
602
    is_reg_not_used_at(R, F, St);
 
603
is_not_used_1(Reg, Is, _) ->
 
604
    beam_block:is_not_used(Reg, Is).
 
605
 
 
606
is_reg_not_used_at(R, Lbl, #st{ll=Ll}=St) ->
 
607
    Is = gb_trees:get(Lbl, Ll),
 
608
    is_not_used_1(R, Is, St).
 
609
 
 
610
is_used_at_none(R, [{f,Lbl}|T], St) ->
 
611
    case is_reg_not_used_at(R, Lbl, St) of
 
612
        false -> false;
 
613
        true -> is_used_at_none(R, T, St)
 
614
    end;
 
615
is_used_at_none(R, [_|T], St) ->
 
616
    is_used_at_none(R, T, St);
 
617
is_used_at_none(_, [], _) -> true.