← 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_block.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_block.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_block.erl,v 1.1 2008/12/17 09:53:41 mikpe Exp $
 
17
%%
 
18
%% Purpose : Partitions assembly instructions into basic blocks and
 
19
%% optimizes them.
 
20
 
 
21
-module(beam_block).
 
22
 
 
23
-export([module/2]).
 
24
-export([live_at_entry/1]).                     %Used by beam_type, beam_bool.
 
25
-export([is_killed/2]).                         %Used by beam_dead, beam_type, beam_bool.
 
26
-export([is_not_used/2]).                       %Used by beam_bool.
 
27
-export([merge_blocks/2]).                      %Used by beam_jump.
 
28
-import(lists, [map/2,mapfoldr/3,reverse/1,reverse/2,foldl/3,
 
29
                member/2,sort/1,all/2]).
 
30
-define(MAXREG, 1024).
 
31
 
 
32
module({Mod,Exp,Attr,Fs,Lc}, _Opt) ->
 
33
    {ok,{Mod,Exp,Attr,map(fun function/1, Fs),Lc}}.
 
34
 
 
35
function({function,Name,Arity,CLabel,Is0}) ->
 
36
    %% Collect basic blocks and optimize them.
 
37
    Is = blockify(Is0),
 
38
 
 
39
    %% Done.
 
40
    {function,Name,Arity,CLabel,Is}.
 
41
 
 
42
%% blockify(Instructions0) -> Instructions
 
43
%%  Collect sequences of instructions to basic blocks and
 
44
%%  optimize the contents of the blocks. Also do some simple
 
45
%%  optimations on instructions outside the blocks.
 
46
 
 
47
blockify(Is) ->
 
48
    blockify(Is, []).
 
49
 
 
50
blockify([{loop_rec,{f,Fail},{x,0}},{loop_rec_end,_Lbl},{label,Fail}|Is], Acc) ->
 
51
    %% Useless instruction sequence.
 
52
    blockify(Is, Acc);
 
53
blockify([{test,bs_test_tail,F,[Bits]}|Is],
 
54
         [{test,bs_skip_bits,F,[{integer,I},Unit,_Flags]}|Acc]) ->
 
55
    blockify(Is, [{test,bs_test_tail,F,[Bits+I*Unit]}|Acc]);
 
56
blockify([{test,bs_skip_bits,F,[{integer,I1},Unit1,_]}|Is],
 
57
         [{test,bs_skip_bits,F,[{integer,I2},Unit2,Flags]}|Acc]) ->
 
58
    blockify(Is, [{test,bs_skip_bits,F,
 
59
                   [{integer,I1*Unit1+I2*Unit2},1,Flags]}|Acc]);
 
60
blockify([{test,is_atom,{f,Fail},[Reg]}=I|
 
61
          [{select_val,Reg,{f,Fail},
 
62
            {list,[{atom,false},{f,_}=BrFalse,
 
63
                   {atom,true}=AtomTrue,{f,_}=BrTrue]}}|Is]=Is0],
 
64
         [{block,Bl}|_]=Acc) ->
 
65
    case is_last_bool(Bl, Reg) of
 
66
        false ->
 
67
            blockify(Is0, [I|Acc]);
 
68
        true ->
 
69
            blockify(Is, [{jump,BrTrue},
 
70
                          {test,is_eq_exact,BrFalse,[Reg,AtomTrue]}|Acc])
 
71
    end;
 
72
blockify([{test,is_atom,{f,Fail},[Reg]}=I|
 
73
          [{select_val,Reg,{f,Fail},
 
74
            {list,[{atom,true}=AtomTrue,{f,_}=BrTrue,
 
75
                   {atom,false},{f,_}=BrFalse]}}|Is]=Is0],
 
76
         [{block,Bl}|_]=Acc) ->
 
77
    case is_last_bool(Bl, Reg) of
 
78
        false ->
 
79
            blockify(Is0, [I|Acc]);
 
80
        true ->
 
81
            blockify(Is, [{jump,BrTrue},
 
82
                          {test,is_eq_exact,BrFalse,[Reg,AtomTrue]}|Acc])
 
83
    end;
 
84
blockify([I|Is0]=IsAll, Acc) ->
 
85
    case is_bs_put(I) of
 
86
        true ->
 
87
            {BsPuts0,Is} = collect_bs_puts(IsAll),
 
88
            BsPuts = opt_bs_puts(BsPuts0),
 
89
            blockify(Is, reverse(BsPuts, Acc));
 
90
        false ->
 
91
            case collect(I) of
 
92
                error -> blockify(Is0, [I|Acc]);
 
93
                Instr when is_tuple(Instr) ->
 
94
                    {Block0,Is} = collect_block(IsAll),
 
95
                    Block = opt_block(Block0),
 
96
                    blockify(Is, [{block,Block}|Acc])
 
97
            end
 
98
    end;
 
99
blockify([], Acc) -> reverse(Acc).
 
100
 
 
101
is_last_bool([I,{'%live',_}], Reg) ->
 
102
    is_last_bool([I], Reg);
 
103
is_last_bool([{set,[Reg],As,{bif,N,_}}], Reg) ->
 
104
    Ar = length(As),
 
105
    erl_internal:new_type_test(N, Ar) orelse erl_internal:comp_op(N, Ar)
 
106
        orelse erl_internal:bool_op(N, Ar);
 
107
is_last_bool([_|Is], Reg) -> is_last_bool(Is, Reg);
 
108
is_last_bool([], _) -> false.
 
109
 
 
110
collect_block(Is) ->
 
111
    collect_block(Is, []).
 
112
 
 
113
collect_block([{allocate_zero,Ns,R},{test_heap,Nh,R}|Is], Acc) ->
 
114
    collect_block(Is, [{allocate,R,{no_opt,Ns,Nh,[]}}|Acc]);
 
115
collect_block([I|Is]=Is0, Acc) ->
 
116
    case collect(I) of
 
117
        error -> {reverse(Acc),Is0};
 
118
        Instr -> collect_block(Is, [Instr|Acc])
 
119
    end;
 
120
collect_block([], Acc) -> {reverse(Acc),[]}.
 
121
 
 
122
collect({allocate_zero,N,R}) -> {allocate,R,{zero,N,0,[]}};
 
123
collect({test_heap,N,R})     -> {allocate,R,{nozero,nostack,N,[]}};
 
124
collect({bif,N,nofail,As,D}) -> {set,[D],As,{bif,N}};
 
125
collect({bif,N,F,As,D})      -> {set,[D],As,{bif,N,F}};
 
126
collect({move,S,D})          -> {set,[D],[S],move};
 
127
collect({put_list,S1,S2,D})  -> {set,[D],[S1,S2],put_list};
 
128
collect({put_tuple,A,D})     -> {set,[D],[],{put_tuple,A}};
 
129
collect({put,S})             -> {set,[],[S],put};
 
130
collect({put_string,L,S,D})  -> {set,[D],[],{put_string,L,S}};
 
131
collect({get_tuple_element,S,I,D}) -> {set,[D],[S],{get_tuple_element,I}};
 
132
collect({set_tuple_element,S,D,I}) -> {set,[],[S,D],{set_tuple_element,I}};
 
133
collect({get_list,S,D1,D2})  -> {set,[D1,D2],[S],get_list};
 
134
collect(remove_message)      -> {set,[],[],remove_message};
 
135
collect({'catch',R,L})       -> {set,[R],[],{'catch',L}};
 
136
collect({'%live',_}=Live)    -> Live;
 
137
collect(_)                   -> error.
 
138
 
 
139
opt_block(Is0) ->
 
140
    %% We explicitly move any allocate instruction upwards before optimising
 
141
    %% moves, to avoid any potential problems with the calculation of live
 
142
    %% registers.
 
143
    Is1 = find_fixpoint(fun move_allocates/1, Is0),
 
144
    Is2 = find_fixpoint(fun opt/1, Is1),
 
145
    Is = opt_alloc(Is2),
 
146
    share_floats(Is).
 
147
 
 
148
find_fixpoint(OptFun, Is0) ->
 
149
    case OptFun(Is0) of
 
150
        Is0 -> Is0;
 
151
        Is1 -> find_fixpoint(OptFun, Is1)
 
152
    end.
 
153
 
 
154
move_allocates([{set,_Ds,_Ss,{set_tuple_element,_}}|_]=Is) -> Is;
 
155
move_allocates([{set,Ds,Ss,_Op}=Set,{allocate,R,Alloc}|Is]) when is_integer(R) ->
 
156
    [{allocate,live_regs(Ds, Ss, R),Alloc},Set|Is];
 
157
move_allocates([{allocate,R1,Alloc1},{allocate,R2,Alloc2}|Is]) ->
 
158
    R1 = R2,                                    % Assertion.
 
159
    move_allocates([{allocate,R1,combine_alloc(Alloc1, Alloc2)}|Is]);
 
160
move_allocates([I|Is]) ->
 
161
    [I|move_allocates(Is)];
 
162
move_allocates([]) -> [].
 
163
 
 
164
combine_alloc({_,Ns,Nh1,Init}, {_,nostack,Nh2,[]}) ->
 
165
    {zero,Ns,Nh1+Nh2,Init}.
 
166
 
 
167
merge_blocks([{allocate,R,{Attr,Ns,Nh1,Init}}|B1],
 
168
             [{allocate,_,{_,nostack,Nh2,[]}}|B2]) ->
 
169
    Alloc = {allocate,R,{Attr,Ns,Nh1+Nh2,Init}},
 
170
    [Alloc|merge_blocks(B1, B2)];
 
171
merge_blocks(B1, B2) -> merge_blocks_1(B1++[{set,[],[],stop_here}|B2]).
 
172
 
 
173
merge_blocks_1([{set,[],_,stop_here}|Is]) -> Is;
 
174
merge_blocks_1([{set,[D],_,move}=I|Is]) ->
 
175
    case is_killed(D, Is) of
 
176
        true -> merge_blocks_1(Is);
 
177
        false -> [I|merge_blocks_1(Is)]
 
178
    end;
 
179
merge_blocks_1([I|Is]) -> [I|merge_blocks_1(Is)].
 
180
 
 
181
opt([{set,[Dst],As,{bif,Bif,Fail}}=I1,
 
182
     {set,[Dst],[Dst],{bif,'not',Fail}}=I2|Is]) ->
 
183
    %% Get rid of the 'not' if the operation can be inverted.
 
184
    case inverse_comp_op(Bif) of
 
185
        none -> [I1,I2|opt(Is)];
 
186
        RevBif -> [{set,[Dst],As,{bif,RevBif,Fail}}|opt(Is)]
 
187
    end;
 
188
opt([{set,[X],[X],move}|Is]) -> opt(Is);
 
189
opt([{set,[D1],[{integer,Idx1},Reg],{bif,element,{f,0}}}=I1,
 
190
     {set,[D2],[{integer,Idx2},Reg],{bif,element,{f,0}}}=I2|Is])
 
191
  when Idx1 < Idx2, D1 =/= D2, D1 =/= Reg, D2 =/= Reg ->
 
192
    opt([I2,I1|Is]);
 
193
opt([{set,Ds0,Ss,Op}|Is0]) ->   
 
194
    {Ds,Is} =  opt_moves(Ds0, Is0),
 
195
    [{set,Ds,Ss,Op}|opt(Is)];
 
196
opt([I|Is]) -> [I|opt(Is)];
 
197
opt([]) -> [].
 
198
 
 
199
opt_moves([], Is0) -> {[],Is0};
 
200
opt_moves([D0], Is0) ->
 
201
    {D1,Is1} = opt_move(D0, Is0),
 
202
    {[D1],Is1};
 
203
opt_moves([X0,Y0]=Ds, Is0) ->
 
204
    {X1,Is1} = opt_move(X0, Is0),
 
205
    case opt_move(Y0, Is1) of
 
206
        {Y1,Is2} when X1 =/= Y1 -> {[X1,Y1],Is2};
 
207
        _Other when X1 =/= Y0 -> {[X1,Y0],Is1};
 
208
        _Other -> {Ds,Is0}
 
209
    end.
 
210
 
 
211
opt_move(R, [{set,[D],[R],move}|Is]=Is0) ->
 
212
    case is_killed(R, Is) of
 
213
        true -> {D,Is};
 
214
        false -> {R,Is0}
 
215
    end;
 
216
opt_move(R, [I|Is0]) ->
 
217
    case is_transparent(R, I) of
 
218
        true ->
 
219
            {D,Is1} = opt_move(R, Is0),
 
220
            case is_transparent(D, I) of
 
221
                true ->  {D,[I|Is1]};
 
222
                false -> {R,[I|Is0]}
 
223
            end;
 
224
        false -> {R,[I|Is0]}
 
225
    end;
 
226
opt_move(R, []) -> {R,[]}.
 
227
 
 
228
is_transparent(R, {set,Ds,Ss,_Op}) ->
 
229
    case member(R, Ds) of
 
230
        true -> false;
 
231
        false -> not member(R, Ss)
 
232
    end;
 
233
is_transparent(_, _) -> false.
 
234
 
 
235
%% is_killed(Register, [Instruction]) -> true|false
 
236
%%  Determine whether a register is killed by the instruction sequence.
 
237
%%  If true is returned, it means that the register will not be
 
238
%%  referenced in ANY way (not even indirectly by an allocate instruction);
 
239
%%  i.e. it is OK to enter the instruction sequence with Register
 
240
%%  containing garbage.
 
241
 
 
242
is_killed({x,N}=R, [{block,Blk}|Is]) ->
 
243
    case is_killed(R, Blk) of
 
244
        true -> true;
 
245
        false ->
 
246
            %% Before looking beyond the block, we must be
 
247
            %% sure that the register is not referenced by
 
248
            %% any allocate instruction in the block.
 
249
            case all(fun({allocate,Live,_}) when N < Live -> false;
 
250
                        (_) -> true
 
251
                     end, Blk) of
 
252
                true -> is_killed(R, Is);
 
253
                false -> false
 
254
            end
 
255
    end;
 
256
is_killed(R, [{block,Blk}|Is]) ->
 
257
    case is_killed(R, Blk) of
 
258
        true -> true;
 
259
        false -> is_killed(R, Is)
 
260
    end;
 
261
is_killed(R, [{set,Ds,Ss,_Op}|Is]) ->
 
262
    case member(R, Ss) of
 
263
        true -> false;
 
264
        false ->
 
265
            case member(R, Ds) of
 
266
                true -> true;
 
267
                false -> is_killed(R, Is)
 
268
            end
 
269
    end;
 
270
is_killed(R, [{case_end,Used}|_]) -> R =/= Used;
 
271
is_killed(R, [{badmatch,Used}|_]) -> R =/= Used;
 
272
is_killed(_, [if_end|_]) -> true;
 
273
is_killed(R, [{func_info,_,_,Ar}|_]) ->
 
274
    case R of
 
275
        {x,X} when X < Ar -> false;
 
276
        _ -> true
 
277
    end;
 
278
is_killed(R, [{kill,R}|_]) -> true;
 
279
is_killed(R, [{kill,_}|Is]) -> is_killed(R, Is);
 
280
is_killed(R, [{bs_init2,_,_,_,_,_,Dst}|Is]) ->
 
281
    if
 
282
        R =:= Dst -> true;
 
283
        true -> is_killed(R, Is)
 
284
    end;
 
285
is_killed(R, [{bs_put_string,_,_}|Is]) -> is_killed(R, Is);
 
286
is_killed({x,R}, [{'%live',Live}|_]) when R >= Live -> true;
 
287
is_killed({x,R}, [{'%live',_}|Is]) -> is_killed(R, Is);
 
288
is_killed({x,R}, [{allocate,Live,_}|_]) ->
 
289
    %% Note: To be safe here, we must return either true or false,
 
290
    %% not looking further at the instructions beyond the allocate
 
291
    %% instruction.
 
292
    R >= Live;
 
293
is_killed({x,R}, [{call,Live,_}|_]) when R >= Live -> true;
 
294
is_killed({x,R}, [{call_last,Live,_,_}|_]) when R >= Live -> true;
 
295
is_killed({x,R}, [{call_only,Live,_}|_]) when R >= Live -> true;
 
296
is_killed({x,R}, [{call_ext,Live,_}|_]) when R >= Live -> true;
 
297
is_killed({x,R}, [{call_ext_last,Live,_,_}|_]) when R >= Live -> true;
 
298
is_killed({x,R}, [{call_ext_only,Live,_}|_]) when R >= Live -> true;
 
299
is_killed({x,R}, [return|_]) when R > 0 -> true;
 
300
is_killed(_, _) -> false.
 
301
 
 
302
%% is_not_used(Register, [Instruction]) -> true|false
 
303
%%  Determine whether a register is used by the instruction sequence.
 
304
%%  If true is returned, it means that the register will not be
 
305
%%  referenced directly, but it may be referenced by an allocate
 
306
%%  instruction (meaning that it is NOT allowed to contain garbage).
 
307
 
 
308
is_not_used(R, [{block,Blk}|Is]) ->
 
309
    case is_not_used(R, Blk) of
 
310
        true -> true;
 
311
        false -> is_not_used(R, Is)
 
312
    end;
 
313
is_not_used({x,R}=Reg, [{allocate,Live,_}|Is]) ->
 
314
    if
 
315
        R >= Live -> true;
 
316
        true -> is_not_used(Reg, Is)
 
317
    end;
 
318
is_not_used(R, [{set,Ds,Ss,_Op}|Is]) ->
 
319
    case member(R, Ss) of
 
320
        true -> false;
 
321
        false ->
 
322
            case member(R, Ds) of
 
323
                true -> true;
 
324
                false -> is_not_used(R, Is)
 
325
            end
 
326
    end;
 
327
is_not_used(R, Is) -> is_killed(R, Is).
 
328
 
 
329
%% opt_alloc(Instructions) -> Instructions'
 
330
%%  Optimises all allocate instructions.
 
331
 
 
332
opt_alloc([{allocate,R,{_,Ns,Nh,[]}}|Is]) ->
 
333
    [opt_alloc(Is, Ns, Nh, R)|opt(Is)];
 
334
opt_alloc([I|Is]) -> [I|opt_alloc(Is)];
 
335
opt_alloc([]) -> [].
 
336
        
 
337
%% opt_alloc(Instructions, FrameSize, HeapNeed, LivingRegs) -> [Instr]
 
338
%%  Generates the optimal sequence of instructions for
 
339
%%  allocating and initalizing the stack frame and needed heap.
 
340
 
 
341
opt_alloc(_Is, nostack, Nh, LivingRegs) ->
 
342
    {allocate,LivingRegs,{nozero,nostack,Nh,[]}};
 
343
opt_alloc(Is, Ns, Nh, LivingRegs) ->
 
344
    InitRegs = init_yreg(Is, 0),
 
345
    case count_ones(InitRegs) of
 
346
        N when N*2 > Ns ->
 
347
            {allocate,LivingRegs,{nozero,Ns,Nh,gen_init(Ns, InitRegs)}};
 
348
        _ ->
 
349
            {allocate,LivingRegs,{zero,Ns,Nh,[]}}
 
350
    end.
 
351
 
 
352
gen_init(Fs, Regs) -> gen_init(Fs, Regs, 0, []).
 
353
 
 
354
gen_init(SameFs, _Regs, SameFs, Acc) -> reverse(Acc);
 
355
gen_init(Fs, Regs, Y, Acc) when Regs band 1 == 0 ->
 
356
    gen_init(Fs, Regs bsr 1, Y+1, [{init, {y,Y}}|Acc]);
 
357
gen_init(Fs, Regs, Y, Acc) ->
 
358
    gen_init(Fs, Regs bsr 1, Y+1, Acc).
 
359
 
 
360
%% init_yreg(Instructions, RegSet) -> RegSetInitialized
 
361
%%  Calculate the set of initialized y registers.
 
362
 
 
363
init_yreg([{set,_,_,{bif,_,_}}|_], Reg) -> Reg;
 
364
init_yreg([{set,Ds,_,_}|Is], Reg) -> init_yreg(Is, add_yregs(Ds, Reg));
 
365
init_yreg(_Is, Reg) -> Reg.
 
366
 
 
367
add_yregs(Ys, Reg) -> foldl(fun(Y, R0) -> add_yreg(Y, R0) end, Reg, Ys).
 
368
    
 
369
add_yreg({y,Y}, Reg) -> Reg bor (1 bsl Y);
 
370
add_yreg(_, Reg)     -> Reg.
 
371
 
 
372
count_ones(Bits) -> count_ones(Bits, 0).
 
373
count_ones(0, Acc) -> Acc;
 
374
count_ones(Bits, Acc) ->
 
375
    count_ones(Bits bsr 1, Acc + (Bits band 1)).
 
376
 
 
377
%% live_at_entry(Is) -> NumberOfRegisters
 
378
%%  Calculate the number of register live at the entry to the code
 
379
%%  sequence.
 
380
 
 
381
live_at_entry([{block,[{allocate,R,_}|_]}|_]) ->
 
382
    R;
 
383
live_at_entry([{label,_}|Is]) ->
 
384
    live_at_entry(Is);
 
385
live_at_entry([{block,Bl}|_]) ->
 
386
    live_at_entry(Bl);
 
387
live_at_entry([{func_info,_,_,Ar}|_]) ->
 
388
    Ar;
 
389
live_at_entry(Is0) ->
 
390
    case reverse(Is0) of
 
391
        [{'%live',Regs}|Is] -> live_at_entry_1(Is, (1 bsl Regs)-1);
 
392
        _ -> unknown
 
393
    end.
 
394
 
 
395
live_at_entry_1([{set,Ds,Ss,_}|Is], Rset0) ->
 
396
    Rset = x_live(Ss, x_dead(Ds, Rset0)),
 
397
    live_at_entry_1(Is, Rset);
 
398
live_at_entry_1([{allocate,_,_}|Is], Rset) ->
 
399
    live_at_entry_1(Is, Rset);
 
400
live_at_entry_1([], Rset) -> live_regs_1(0, Rset).
 
401
 
 
402
%% Calculate the new number of live registers when we move an allocate
 
403
%% instruction upwards, passing a 'set' instruction.
 
404
 
 
405
live_regs(Ds, Ss, Regs0) ->
 
406
    Rset = x_live(Ss, x_dead(Ds, (1 bsl Regs0)-1)),
 
407
    live_regs_1(0, Rset).
 
408
 
 
409
live_regs_1(N, 0) -> N;
 
410
live_regs_1(N, Regs) -> live_regs_1(N+1, Regs bsr 1).
 
411
 
 
412
x_dead([{x,N}|Rs], Regs) -> x_dead(Rs, Regs band (bnot (1 bsl N)));
 
413
x_dead([_|Rs], Regs) -> x_dead(Rs, Regs);
 
414
x_dead([], Regs) -> Regs.
 
415
 
 
416
x_live([{x,N}|Rs], Regs) -> x_live(Rs, Regs bor (1 bsl N));
 
417
x_live([_|Rs], Regs) -> x_live(Rs, Regs);
 
418
x_live([], Regs) -> Regs.
 
419
 
 
420
%%
 
421
%% If a floating point literal occurs more than once, move it into
 
422
%% a free register and re-use it.
 
423
%%
 
424
 
 
425
share_floats([{allocate,_,_}=Alloc|Is]) ->
 
426
    [Alloc|share_floats(Is)];
 
427
share_floats(Is0) ->
 
428
    All = get_floats(Is0, []),
 
429
    MoreThanOnce0 =  more_than_once(sort(All), gb_sets:empty()),
 
430
    case gb_sets:is_empty(MoreThanOnce0) of
 
431
        true -> Is0;
 
432
        false ->
 
433
            MoreThanOnce = gb_sets:to_list(MoreThanOnce0),
 
434
            FreeX = highest_used(Is0, -1) + 1,
 
435
            Regs0 = make_reg_map(MoreThanOnce, FreeX, []),
 
436
            Regs = gb_trees:from_orddict(Regs0),
 
437
            Is = map(fun({set,Ds,[{float,F}],Op}=I) ->
 
438
                             case gb_trees:lookup(F, Regs) of
 
439
                                 none -> I;
 
440
                                 {value,R} -> {set,Ds,[R],Op}
 
441
                             end;
 
442
                        (I) -> I
 
443
                     end, Is0),
 
444
            [{set,[R],[{float,F}],move} || {F,R} <- Regs0] ++ Is
 
445
    end.
 
446
 
 
447
get_floats([{set,_,[{float,F}],_}|Is], Acc) ->
 
448
    get_floats(Is, [F|Acc]);
 
449
get_floats([_|Is], Acc) ->
 
450
    get_floats(Is, Acc);
 
451
get_floats([], Acc) -> Acc.
 
452
 
 
453
more_than_once([F,F|Fs], Set) ->
 
454
    more_than_once(Fs, gb_sets:add(F, Set));
 
455
more_than_once([_|Fs], Set) ->
 
456
    more_than_once(Fs, Set);
 
457
more_than_once([], Set) -> Set.
 
458
 
 
459
highest_used([{set,Ds,Ss,_}|Is], High) ->
 
460
    highest_used(Is, highest(Ds, highest(Ss, High)));
 
461
highest_used([{'%live',Live}|Is], High) when Live > High ->
 
462
    highest_used(Is, Live);
 
463
highest_used([_|Is], High) ->
 
464
    highest_used(Is, High);
 
465
highest_used([], High) -> High.
 
466
 
 
467
highest([{x,R}|Rs], High) when R > High ->
 
468
    highest(Rs, R);
 
469
highest([_|Rs], High) ->
 
470
    highest(Rs, High);
 
471
highest([], High) -> High.
 
472
 
 
473
make_reg_map([F|Fs], R, Acc) when R < ?MAXREG ->
 
474
    make_reg_map(Fs, R+1, [{F,{x,R}}|Acc]);
 
475
make_reg_map(_, _, Acc) -> sort(Acc).
 
476
 
 
477
%% inverse_comp_op(Op) -> none|RevOp
 
478
 
 
479
inverse_comp_op('=:=') -> '=/=';
 
480
inverse_comp_op('=/=') -> '=:=';
 
481
inverse_comp_op('==') -> '/=';
 
482
inverse_comp_op('/=') -> '==';
 
483
inverse_comp_op('>') -> '=<';
 
484
inverse_comp_op('<') -> '>=';
 
485
inverse_comp_op('>=') -> '<';
 
486
inverse_comp_op('=<') -> '>';
 
487
inverse_comp_op(_) -> none.
 
488
 
 
489
%%%
 
490
%%% Evaluation of constant bit fields.
 
491
%%%
 
492
 
 
493
is_bs_put({bs_put_integer,_,_,_,_,_}) -> true;
 
494
is_bs_put({bs_put_float,_,_,_,_,_}) -> true;
 
495
is_bs_put(_) -> false.
 
496
 
 
497
collect_bs_puts(Is) ->
 
498
    collect_bs_puts_1(Is, []).
 
499
    
 
500
collect_bs_puts_1([I|Is]=Is0, Acc) ->
 
501
    case is_bs_put(I) of
 
502
        false -> {reverse(Acc),Is0};
 
503
        true -> collect_bs_puts_1(Is, [I|Acc])
 
504
    end;
 
505
collect_bs_puts_1([], Acc) -> {reverse(Acc),[]}.
 
506
    
 
507
opt_bs_puts(Is) ->
 
508
    opt_bs_1(Is, []).
 
509
 
 
510
opt_bs_1([{bs_put_float,Fail,{integer,Sz},1,Flags0,Src}=I0|Is], Acc) ->
 
511
    case catch eval_put_float(Src, Sz, Flags0) of
 
512
        {'EXIT',_} ->
 
513
            opt_bs_1(Is, [I0|Acc]);
 
514
        <<Int:Sz>> ->
 
515
            Flags = force_big(Flags0),
 
516
            I = {bs_put_integer,Fail,{integer,Sz},1,Flags,{integer,Int}},
 
517
            opt_bs_1([I|Is], Acc)
 
518
    end;
 
519
opt_bs_1([{bs_put_integer,_,{integer,8},1,_,{integer,_}}|_]=IsAll, Acc0) ->
 
520
    {Is,Acc} = bs_collect_string(IsAll, Acc0),
 
521
    opt_bs_1(Is, Acc);
 
522
opt_bs_1([{bs_put_integer,Fail,{integer,Sz},1,F,{integer,N}}=I|Is0], Acc) when Sz > 8 ->
 
523
    case field_endian(F) of
 
524
        big ->
 
525
            case bs_split_int(N, Sz, Fail, Is0) of
 
526
                no_split -> opt_bs_1(Is0, [I|Acc]);
 
527
                Is -> opt_bs_1(Is, Acc)
 
528
            end;
 
529
        little ->
 
530
            case catch <<N:Sz/little>> of
 
531
                {'EXIT',_} ->
 
532
                    opt_bs_1(Is0, [I|Acc]);
 
533
                <<Int:Sz>> ->
 
534
                    Flags = force_big(F),
 
535
                    Is = [{bs_put_integer,Fail,{integer,Sz},1,
 
536
                           Flags,{integer,Int}}|Is0],
 
537
                    opt_bs_1(Is, Acc)
 
538
            end;
 
539
        native -> opt_bs_1(Is0, [I|Acc])
 
540
    end;
 
541
opt_bs_1([{Op,Fail,{integer,Sz},U,F,Src}|Is], Acc) when U > 1 ->
 
542
    opt_bs_1([{Op,Fail,{integer,U*Sz},1,F,Src}|Is], Acc);
 
543
opt_bs_1([I|Is], Acc) ->
 
544
    opt_bs_1(Is, [I|Acc]);
 
545
opt_bs_1([], Acc) -> reverse(Acc).
 
546
 
 
547
eval_put_float(Src, Sz, Flags) ->
 
548
    Val = value(Src),
 
549
    case field_endian(Flags) of
 
550
        little -> <<Val:Sz/little-float-unit:1>>;
 
551
        big -> <<Val:Sz/big-float-unit:1>>
 
552
        %% native intentionally not handled here - we can't optimize it.
 
553
    end.
 
554
 
 
555
value({integer,I}) -> I;
 
556
value({float,F}) -> F;
 
557
value({atom,A}) -> A.
 
558
 
 
559
bs_collect_string(Is, [{bs_put_string,Len,{string,Str}}|Acc]) ->
 
560
    bs_coll_str_1(Is, Len, reverse(Str), Acc);
 
561
bs_collect_string(Is, Acc) ->
 
562
    bs_coll_str_1(Is, 0, [], Acc).
 
563
    
 
564
bs_coll_str_1([{bs_put_integer,_,{integer,Sz},U,_,{integer,V}}|Is],
 
565
              Len, StrAcc, IsAcc) when U*Sz =:= 8 ->
 
566
    Byte = V band 16#FF,
 
567
    bs_coll_str_1(Is, Len+1, [Byte|StrAcc], IsAcc);
 
568
bs_coll_str_1(Is, Len, StrAcc, IsAcc) ->
 
569
    {Is,[{bs_put_string,Len,{string,reverse(StrAcc)}}|IsAcc]}.
 
570
 
 
571
field_endian({field_flags,F}) -> field_endian_1(F).
 
572
 
 
573
field_endian_1([big=E|_]) -> E;
 
574
field_endian_1([little=E|_]) -> E;
 
575
field_endian_1([native=E|_]) -> E;
 
576
field_endian_1([_|Fs]) -> field_endian_1(Fs).
 
577
 
 
578
force_big({field_flags,F}) ->
 
579
    {field_flags,force_big_1(F)}.
 
580
 
 
581
force_big_1([big|_]=Fs) -> Fs;
 
582
force_big_1([little|Fs]) -> [big|Fs];
 
583
force_big_1([F|Fs]) -> [F|force_big_1(Fs)].
 
584
 
 
585
bs_split_int(0, Sz, _, _) when Sz > 64 ->
 
586
    %% We don't want to split in this case because the
 
587
    %% string will consist of only zeroes.
 
588
    no_split;
 
589
bs_split_int(N, Sz, Fail, Acc) ->
 
590
    FirstByteSz = case Sz rem 8 of
 
591
                      0 -> 8;
 
592
                      Rem -> Rem
 
593
                  end,
 
594
    bs_split_int_1(N, FirstByteSz, Sz, Fail, Acc).
 
595
 
 
596
bs_split_int_1(N, ByteSz, Sz, Fail, Acc) when Sz > 0 ->
 
597
    Mask = (1 bsl ByteSz) - 1,
 
598
    I = {bs_put_integer,Fail,{integer,ByteSz},1,
 
599
         {field_flags,[big]},{integer,N band Mask}},
 
600
    bs_split_int_1(N bsr ByteSz, 8, Sz-ByteSz, Fail, [I|Acc]);
 
601
bs_split_int_1(_, _, _, _, Acc) -> Acc.