← Back to branch summary

~clint-fewbar/ubuntu/precise/erlang/merge-15b

« back to all changes in this revision

Viewing changes to lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_type.erl

  • Committer: Package Import Robot
  • Author(s): Sergei Golovan
  • Date: 2011-12-15 19:20:10 UTC
  • mfrom: (1.1.18) (3.5.15 sid)
  • mto: (3.5.16 sid)
  • mto: This revision was merged to the branch mainline in revision 33.
  • Revision ID: package-import@ubuntu.com-20111215192010-jnxcfe3tbrpp0big
Tags: 1:15.b-dfsg-1
* New upstream release.
* Upload to experimental because this release breaks external drivers
  API along with ABI, so several applications are to be fixed.
* Removed SSL patch because the old SSL implementation is removed from
  the upstream distribution.
* Removed never used patch which added native code to erlang beam files.
* Removed the erlang-docbuilder binary package because the docbuilder
  application was dropped by upstream.
* Documented dropping ${erlang-docbuilder:Depends} substvar in
  erlang-depends(1) manpage.
* Made erlang-base and erlang-base-hipe provide virtual package
  erlang-abi-15.b (the number means the first erlang version, which
  provides current ABI).

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_type.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_type.erl,v 1.1 2008/12/17 09:53:41 mikpe Exp $
 
17
%%
 
18
%% Purpose : Type-based optimisations.
 
19
 
 
20
-module(beam_type).
 
21
 
 
22
-export([module/2]).
 
23
 
 
24
-import(lists, [map/2,foldl/3,reverse/1,reverse/2,filter/2,member/2]).
 
25
 
 
26
module({Mod,Exp,Attr,Fs0,Lc}, Opt) ->
 
27
    AllowFloatOpts = not member(no_float_opt, Opt),
 
28
    Fs = map(fun(F) -> function(F, AllowFloatOpts) end, Fs0),
 
29
    {ok,{Mod,Exp,Attr,Fs,Lc}}.
 
30
 
 
31
function({function,Name,Arity,CLabel,Asm0}, AllowFloatOpts) ->
 
32
    Asm = opt(Asm0, AllowFloatOpts, [], tdb_new()),
 
33
    {function,Name,Arity,CLabel,Asm}.
 
34
 
 
35
%% opt([Instruction], AllowFloatOpts, Accumulator, TypeDb) -> {[Instruction'],TypeDb'}
 
36
%%  Keep track of type information; try to simplify.
 
37
 
 
38
opt([{block,Body1}|Is], AllowFloatOpts, [{block,Body0}|Acc], Ts0) ->
 
39
    {Body2,Ts} = simplify(Body1, Ts0, AllowFloatOpts),
 
40
    Body = beam_block:merge_blocks(Body0, Body2),
 
41
    opt(Is, AllowFloatOpts, [{block,Body}|Acc], Ts);
 
42
opt([{block,Body0}|Is], AllowFloatOpts, Acc, Ts0) ->
 
43
    {Body,Ts} = simplify(Body0, Ts0, AllowFloatOpts),
 
44
    opt(Is, AllowFloatOpts, [{block,Body}|Acc], Ts);
 
45
opt([I0|Is], AllowFloatOpts, Acc, Ts0) ->
 
46
    case simplify([I0], Ts0, AllowFloatOpts) of
 
47
        {[],Ts} -> opt(Is, AllowFloatOpts, Acc, Ts);
 
48
        {[I],Ts} -> opt(Is, AllowFloatOpts, [I|Acc], Ts)
 
49
    end;
 
50
opt([], _, Acc, _) -> reverse(Acc).
 
51
 
 
52
%% simplify(Instruction, TypeDb, AllowFloatOpts) -> NewInstruction
 
53
%%  Simplify an instruction using type information (this is
 
54
%%  technically a "strength reduction").
 
55
 
 
56
simplify(Is, TypeDb, false) ->
 
57
    simplify(Is, TypeDb, no_float_opt, []);
 
58
simplify(Is, TypeDb, true) ->
 
59
    case are_live_regs_determinable(Is) of
 
60
        false -> simplify(Is, TypeDb, no_float_opt, []);
 
61
        true -> simplify(Is, TypeDb, [], [])
 
62
    end.
 
63
 
 
64
simplify([{set,[D],[{integer,Index},Reg],{bif,element,_}}=I0|Is]=Is0, Ts0, Rs0, Acc0) ->
 
65
    I = case max_tuple_size(Reg, Ts0) of
 
66
            Sz when 0 < Index, Index =< Sz ->
 
67
                {set,[D],[Reg],{get_tuple_element,Index-1}};
 
68
            _Other -> I0
 
69
    end,
 
70
    Ts = update(I, Ts0),
 
71
    {Rs,Acc} = flush(Rs0, Is0, Acc0),
 
72
    simplify(Is, Ts, Rs, [I|checkerror(Acc)]);
 
73
simplify([{set,[D0],[A],{bif,'-',{f,0}}}=I|Is]=Is0, Ts0, Rs0, Acc0)
 
74
  when Rs0 =/= no_float_opt ->
 
75
    case tdb_find(A, Ts0) of
 
76
        float ->
 
77
            {Rs1,Acc1} = load_reg(A, Ts0, Rs0, Acc0),
 
78
            {D,Rs} = find_dest(D0, Rs1),
 
79
            Areg = fetch_reg(A, Rs),
 
80
            Acc = [{set,[D],[Areg],{bif,fnegate,{f,0}}}|clearerror(Acc1)],
 
81
            Ts = tdb_update([{D0,float}], Ts0),
 
82
            simplify(Is, Ts, Rs, Acc);
 
83
        _Other ->
 
84
            Ts = update(I, Ts0),
 
85
            {Rs,Acc} = flush(Rs0, Is0, Acc0),
 
86
            simplify(Is, Ts, Rs, [I|checkerror(Acc)])
 
87
    end;
 
88
simplify([{set,[_],[_],{bif,_,{f,0}}}=I|Is]=Is0, Ts0, Rs0, Acc0) ->
 
89
    Ts = update(I, Ts0),
 
90
    {Rs,Acc} = flush(Rs0, Is0, Acc0),
 
91
    simplify(Is, Ts, Rs, [I|checkerror(Acc)]);
 
92
simplify([{set,[D0],[A,B],{bif,Op0,{f,0}}}=I|Is]=Is0, Ts0, Rs0, Acc0)
 
93
  when Rs0 =/= no_float_opt ->
 
94
    case float_op(Op0, A, B, Ts0) of
 
95
        no ->
 
96
            Ts = update(I, Ts0),
 
97
            {Rs,Acc} = flush(Rs0, Is0, Acc0),
 
98
            simplify(Is, Ts, Rs, [I|checkerror(Acc)]);
 
99
        {yes,Op} ->
 
100
            {Rs1,Acc1} = load_reg(A, Ts0, Rs0, Acc0),
 
101
            {Rs2,Acc2} = load_reg(B, Ts0, Rs1, Acc1),
 
102
            {D,Rs} = find_dest(D0, Rs2),
 
103
            Areg = fetch_reg(A, Rs),
 
104
            Breg = fetch_reg(B, Rs),
 
105
            Acc = [{set,[D],[Areg,Breg],{bif,Op,{f,0}}}|clearerror(Acc2)],
 
106
            Ts = tdb_update([{D0,float}], Ts0),
 
107
            simplify(Is, Ts, Rs, Acc)
 
108
    end;
 
109
simplify([{set,[D],[TupleReg],{get_tuple_element,0}}=I|Is0], Ts0, Rs0, Acc0) ->
 
110
    case tdb_find(TupleReg, Ts0) of
 
111
        {tuple,_,[Contents]} ->
 
112
            Ts = tdb_update([{D,Contents}], Ts0),
 
113
            {Rs,Acc} = flush(Rs0, Is0, Acc0),
 
114
            simplify(Is0, Ts, Rs, [{set,[D],[Contents],move}|Acc]);
 
115
        _ ->
 
116
            Ts = update(I, Ts0),
 
117
            {Rs,Acc} = flush(Rs0, Is0, Acc0),
 
118
            simplify(Is0, Ts, Rs, [I|checkerror(Acc)])
 
119
    end;
 
120
simplify([{set,_,_,{'catch',_}}=I|Is]=Is0, _Ts, Rs0, Acc0) ->
 
121
    Acc = flush_all(Rs0, Is0, Acc0),
 
122
    simplify(Is, tdb_new(), Rs0, [I|Acc]);
 
123
simplify([{test,is_tuple,_,[R]}=I|Is], Ts, Rs, Acc) ->
 
124
    case tdb_find(R, Ts) of
 
125
        {tuple,_,_} -> simplify(Is, Ts, Rs, Acc);
 
126
        _ ->
 
127
            simplify(Is, Ts, Rs, [I|Acc])
 
128
    end;
 
129
simplify([{test,test_arity,_,[R,Arity]}=I|Is], Ts0, Rs, Acc) ->
 
130
    case tdb_find(R, Ts0) of
 
131
        {tuple,Arity,_} ->
 
132
            simplify(Is, Ts0, Rs, Acc);
 
133
        _Other ->
 
134
            Ts = update(I, Ts0),
 
135
            simplify(Is, Ts, Rs, [I|Acc])
 
136
    end;
 
137
simplify([{test,is_eq_exact,Fail,[R,{atom,_}=Atom]}=I|Is0], Ts0, Rs0, Acc0) ->
 
138
    Acc1 = case tdb_find(R, Ts0) of
 
139
               {atom,_}=Atom -> Acc0;
 
140
               {atom,_} -> [{jump,Fail}|Acc0];
 
141
               _ -> [I|Acc0]
 
142
           end,
 
143
    Ts = update(I, Ts0),
 
144
    {Rs,Acc} = flush(Rs0, Is0, Acc1),
 
145
    simplify(Is0, Ts, Rs, Acc);
 
146
simplify([I|Is]=Is0, Ts0, Rs0, Acc0) ->
 
147
    Ts = update(I, Ts0),
 
148
    {Rs,Acc} = flush(Rs0, Is0, Acc0),
 
149
    simplify(Is, Ts, Rs, [I|Acc]);
 
150
simplify([], Ts, Rs, Acc) ->
 
151
    Is0 = reverse(flush_all(Rs, [], Acc)),
 
152
    Is1 = opt_fmoves(Is0, []),
 
153
    Is = add_ftest_heap(Is1),
 
154
    {Is,Ts}.
 
155
 
 
156
opt_fmoves([{set,[{x,_}=R],[{fr,_}]=Src,fmove}=I1,
 
157
            {set,[{y,_}]=Dst,[{x,_}=R],move}=I2|Is], Acc) ->
 
158
    case beam_block:is_killed(R, Is) of
 
159
        false -> opt_fmoves(Is, [I2,I1|Acc]);
 
160
        true -> opt_fmoves(Is, [{set,Dst,Src,fmove}|Acc])
 
161
    end;
 
162
opt_fmoves([I|Is], Acc) ->
 
163
    opt_fmoves(Is, [I|Acc]);
 
164
opt_fmoves([], Acc) -> reverse(Acc).
 
165
 
 
166
clearerror(Is) ->
 
167
    clearerror(Is, Is).
 
168
 
 
169
clearerror([{set,[],[],fclearerror}|_], OrigIs) -> OrigIs;
 
170
clearerror([{set,[],[],fcheckerror}|_], OrigIs) -> [{set,[],[],fclearerror}|OrigIs];
 
171
clearerror([_|Is], OrigIs) -> clearerror(Is, OrigIs);
 
172
clearerror([], OrigIs) -> [{set,[],[],fclearerror}|OrigIs].
 
173
 
 
174
%% update(Instruction, TypeDb) -> NewTypeDb
 
175
%%  Update the type database to account for executing an instruction.
 
176
%%
 
177
%%  First the cases for instructions inside basic blocks.
 
178
update({set,[D],[S],move}, Ts0) ->
 
179
    Ops = case tdb_find(S, Ts0) of
 
180
              error -> [{D,kill}];
 
181
              Info -> [{D,Info}]
 
182
          end,
 
183
    tdb_update(Ops, Ts0);
 
184
update({set,[D],[{integer,I},Reg],{bif,element,_}}, Ts0) ->
 
185
    tdb_update([{Reg,{tuple,I,[]}},{D,kill}], Ts0);
 
186
update({set,[D],[_Index,Reg],{bif,element,_}}, Ts0) ->
 
187
    tdb_update([{Reg,{tuple,0,[]}},{D,kill}], Ts0);
 
188
update({set,[D],[S],{get_tuple_element,0}}, Ts) ->
 
189
    tdb_update([{D,{tuple_element,S,0}}], Ts);
 
190
update({set,[D],[S],{bif,float,{f,0}}}, Ts0) ->
 
191
    %% Make sure we reject non-numeric literal argument.
 
192
    case possibly_numeric(S) of
 
193
        true ->  tdb_update([{D,float}], Ts0);
 
194
        false -> Ts0
 
195
    end;
 
196
update({set,[D],[S1,S2],{bif,'/',{f,0}}}, Ts0) ->
 
197
    %% Make sure we reject non-numeric literals.
 
198
    case possibly_numeric(S1) andalso possibly_numeric(S2) of
 
199
        true ->  tdb_update([{D,float}], Ts0);
 
200
        false -> Ts0
 
201
    end;
 
202
update({set,[D],[S1,S2],{bif,Op,{f,0}}}, Ts0) ->
 
203
    case arith_op(Op) of
 
204
        no ->
 
205
            tdb_update([{D,kill}], Ts0);
 
206
        {yes,_} ->
 
207
            case {tdb_find(S1, Ts0),tdb_find(S2, Ts0)} of
 
208
                {float,_} -> tdb_update([{D,float}], Ts0);
 
209
                {_,float} -> tdb_update([{D,float}], Ts0);
 
210
                {_,_} -> tdb_update([{D,kill}], Ts0)
 
211
            end
 
212
    end;
 
213
update({set,[],_Src,_Op}, Ts0) -> Ts0;
 
214
update({set,[D],_Src,_Op}, Ts0) ->
 
215
    tdb_update([{D,kill}], Ts0);
 
216
update({set,[D1,D2],_Src,_Op}, Ts0) ->
 
217
    tdb_update([{D1,kill},{D2,kill}], Ts0);
 
218
update({allocate,_,_}, Ts) -> Ts;
 
219
update({init,D}, Ts) ->
 
220
    tdb_update([{D,kill}], Ts);
 
221
update({kill,D}, Ts) ->
 
222
    tdb_update([{D,kill}], Ts);
 
223
update({'%live',_}, Ts) -> Ts;
 
224
 
 
225
%% Instructions outside of blocks.
 
226
update({test,is_float,_Fail,[Src]}, Ts0) ->
 
227
    tdb_update([{Src,float}], Ts0);
 
228
update({test,test_arity,_Fail,[Src,Arity]}, Ts0) ->
 
229
    tdb_update([{Src,{tuple,Arity,[]}}], Ts0);
 
230
update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts) ->
 
231
    case tdb_find(Reg, Ts) of
 
232
        error ->
 
233
            Ts;
 
234
        {tuple_element,TupleReg,0} ->
 
235
            tdb_update([{TupleReg,{tuple,1,[Atom]}}], Ts);
 
236
        _ ->
 
237
            Ts
 
238
    end;
 
239
update({test,_Test,_Fail,_Other}, Ts) -> Ts;
 
240
update({call_ext,1,{extfunc,math,Math,1}}, Ts) ->
 
241
    case is_math_bif(Math, 1) of
 
242
        true -> tdb_update([{{x,0},float}], Ts);
 
243
        false -> tdb_kill_xregs(Ts)
 
244
    end;
 
245
update({call_ext,2,{extfunc,math,Math,2}}, Ts) ->
 
246
    case is_math_bif(Math, 2) of
 
247
        true -> tdb_update([{{x,0},float}], Ts);
 
248
        false -> tdb_kill_xregs(Ts)
 
249
    end;
 
250
update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) ->
 
251
    Op = case tdb_find({x,1}, Ts0) of
 
252
             error -> kill;
 
253
             Info -> Info
 
254
         end,
 
255
    Ts1 = tdb_kill_xregs(Ts0),
 
256
    tdb_update([{{x,0},Op}], Ts1);
 
257
update({call,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts);
 
258
update({call_ext,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts);
 
259
update({make_fun2,_,_,_,_}, Ts) -> tdb_kill_xregs(Ts);
 
260
 
 
261
%% The instruction is unknown.  Kill all information.
 
262
update(_I, _Ts) -> tdb_new().
 
263
 
 
264
is_math_bif(cos, 1) -> true;
 
265
is_math_bif(cosh, 1) -> true;
 
266
is_math_bif(sin, 1) -> true;
 
267
is_math_bif(sinh, 1) -> true;
 
268
is_math_bif(tan, 1) -> true;
 
269
is_math_bif(tanh, 1) -> true;
 
270
is_math_bif(acos, 1) -> true;
 
271
is_math_bif(acosh, 1) -> true;
 
272
is_math_bif(asin, 1) -> true;
 
273
is_math_bif(asinh, 1) -> true;
 
274
is_math_bif(atan, 1) -> true;
 
275
is_math_bif(atanh, 1) -> true;
 
276
is_math_bif(erf, 1) -> true;
 
277
is_math_bif(erfc, 1) -> true;
 
278
is_math_bif(exp, 1) -> true;
 
279
is_math_bif(log, 1) -> true;
 
280
is_math_bif(log10, 1) -> true;
 
281
is_math_bif(sqrt, 1) -> true;
 
282
is_math_bif(atan2, 2) -> true;
 
283
is_math_bif(pow, 2) -> true;
 
284
is_math_bif(pi, 0) -> true;
 
285
is_math_bif(_, _) -> false.
 
286
 
 
287
%% Reject non-numeric literals.
 
288
possibly_numeric({x,_}) -> true;
 
289
possibly_numeric({y,_}) -> true;
 
290
possibly_numeric({integer,_}) -> true;
 
291
possibly_numeric({float,_}) -> true;
 
292
possibly_numeric(_) -> false.
 
293
 
 
294
max_tuple_size(Reg, Ts) ->
 
295
    case tdb_find(Reg, Ts) of
 
296
        {tuple,Sz,_} -> Sz;
 
297
        _Other -> 0
 
298
    end.
 
299
 
 
300
float_op('/', A, B, _) ->
 
301
    case possibly_numeric(A) andalso possibly_numeric(B) of
 
302
        true -> {yes,fdiv};
 
303
        false -> no
 
304
    end;
 
305
float_op(Op, {float,_}, B, _) ->
 
306
    case possibly_numeric(B) of
 
307
        true -> arith_op(Op);
 
308
        false -> no
 
309
    end;
 
310
float_op(Op, A, {float,_}, _) ->
 
311
    case possibly_numeric(A) of
 
312
        true -> arith_op(Op);
 
313
        false -> no
 
314
    end;
 
315
float_op(Op, A, B, Ts) ->
 
316
    case {tdb_find(A, Ts),tdb_find(B, Ts)} of
 
317
        {float,_} -> arith_op(Op);
 
318
        {_,float} -> arith_op(Op);
 
319
        {_,_} -> no
 
320
    end.
 
321
 
 
322
find_dest(V, Rs0) ->
 
323
    case find_reg(V, Rs0) of
 
324
        {ok,FR} ->
 
325
            {FR,mark(V, Rs0, dirty)};
 
326
        error ->
 
327
            Rs = put_reg(V, Rs0, dirty),
 
328
            {ok,FR} = find_reg(V, Rs),
 
329
            {FR,Rs}
 
330
    end.
 
331
 
 
332
load_reg({float,_}=F, _, Rs0, Is0) ->
 
333
    Rs = put_reg(F, Rs0, clean),
 
334
    {ok,FR} = find_reg(F, Rs),
 
335
    Is = [{set,[FR],[F],fmove}|Is0],
 
336
    {Rs,Is};
 
337
load_reg(V, Ts, Rs0, Is0) ->
 
338
    case find_reg(V, Rs0) of
 
339
        {ok,_FR} -> {Rs0,Is0};
 
340
        error ->
 
341
            Rs = put_reg(V, Rs0, clean),
 
342
            {ok,FR} = find_reg(V, Rs),
 
343
            Op = case tdb_find(V, Ts) of
 
344
                     float -> fmove;
 
345
                     _ -> fconv
 
346
                 end,
 
347
            Is = [{set,[FR],[V],Op}|Is0],
 
348
            {Rs,Is}
 
349
    end.
 
350
 
 
351
arith_op('+') -> {yes,fadd};
 
352
arith_op('-') -> {yes,fsub};
 
353
arith_op('*') -> {yes,fmul};
 
354
arith_op('/') -> {yes,fdiv};
 
355
arith_op(_) -> no.
 
356
 
 
357
flush(no_float_opt, _, Acc) -> {no_float_opt,Acc};
 
358
flush(Rs, [{set,[_],[],{put_tuple,_}}|_]=Is0, Acc0) ->
 
359
    Acc = flush_all(Rs, Is0, Acc0),
 
360
    {[],Acc};
 
361
flush(Rs0, [{set,Ds,Ss,_Op}|_], Acc0) ->
 
362
    Save = gb_sets:from_list(Ss),
 
363
    Acc = save_regs(Rs0, Save, Acc0),
 
364
    Rs1 = foldl(fun(S, A) -> mark(S, A, clean) end, Rs0, Ss),
 
365
    Kill = gb_sets:from_list(Ds),
 
366
    Rs = kill_regs(Rs1, Kill),
 
367
    {Rs,Acc};
 
368
flush(Rs0, Is, Acc0) ->
 
369
    Acc = flush_all(Rs0, Is, Acc0),
 
370
    {[],Acc}.
 
371
 
 
372
flush_all(no_float_opt, _, Acc) -> Acc;
 
373
flush_all([{_,{float,_},_}|Rs], Is, Acc) ->
 
374
    flush_all(Rs, Is, Acc);
 
375
flush_all([{I,V,dirty}|Rs], Is, Acc0) ->
 
376
    Acc = checkerror(Acc0),
 
377
    case beam_block:is_killed(V, Is) of
 
378
        true  -> flush_all(Rs, Is, Acc);
 
379
        false -> flush_all(Rs, Is, [{set,[V],[{fr,I}],fmove}|Acc])
 
380
    end;
 
381
flush_all([{_,_,clean}|Rs], Is, Acc) -> flush_all(Rs, Is, Acc);
 
382
flush_all([free|Rs], Is, Acc) -> flush_all(Rs, Is, Acc);
 
383
flush_all([], _, Acc) -> Acc.
 
384
 
 
385
save_regs(Rs, Save, Acc) ->
 
386
    foldl(fun(R, A) -> save_reg(R, Save, A) end, Acc, Rs).
 
387
 
 
388
save_reg({I,V,dirty}, Save, Acc) ->
 
389
    case gb_sets:is_member(V, Save) of
 
390
        true -> [{set,[V],[{fr,I}],fmove}|checkerror(Acc)];
 
391
        false -> Acc
 
392
    end;
 
393
save_reg(_, _, Acc) -> Acc.
 
394
 
 
395
kill_regs(Rs, Kill) ->
 
396
    map(fun(R) -> kill_reg(R, Kill) end, Rs).
 
397
 
 
398
kill_reg({_,V,_}=R, Kill) ->
 
399
    case gb_sets:is_member(V, Kill) of
 
400
        true -> free;
 
401
        false -> R
 
402
    end;
 
403
kill_reg(R, _) -> R.
 
404
 
 
405
mark(V, [{I,V,_}|Rs], Mark) -> [{I,V,Mark}|Rs];
 
406
mark(V, [R|Rs], Mark) -> [R|mark(V, Rs, Mark)];
 
407
mark(_, [], _) -> [].
 
408
 
 
409
fetch_reg(V, [{I,V,_}|_]) -> {fr,I};
 
410
fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs).
 
411
 
 
412
find_reg(V, [{I,V,_}|_]) -> {ok,{fr,I}};
 
413
find_reg(V, [_|SRs]) -> find_reg(V, SRs);
 
414
find_reg(_, []) -> error.
 
415
 
 
416
put_reg(V, Rs, Dirty) -> put_reg_1(V, Rs, Dirty, 0).
 
417
 
 
418
put_reg_1(V, [free|Rs], Dirty, I) -> [{I,V,Dirty}|Rs];
 
419
put_reg_1(V, [R|Rs], Dirty, I) -> [R|put_reg_1(V, Rs, Dirty, I+1)];
 
420
put_reg_1(V, [], Dirty, I) -> [{I,V,Dirty}].
 
421
 
 
422
checkerror(Is) ->
 
423
    checkerror_1(Is, Is).
 
424
 
 
425
checkerror_1([{set,[],[],fcheckerror}|_], OrigIs) -> OrigIs;
 
426
checkerror_1([{set,[],[],fclearerror}|_], OrigIs) -> OrigIs;
 
427
checkerror_1([{set,_,_,{bif,fadd,_}}|_], OrigIs) -> checkerror_2(OrigIs);
 
428
checkerror_1([{set,_,_,{bif,fsub,_}}|_], OrigIs) -> checkerror_2(OrigIs);
 
429
checkerror_1([{set,_,_,{bif,fmul,_}}|_], OrigIs) -> checkerror_2(OrigIs);
 
430
checkerror_1([{set,_,_,{bif,fdiv,_}}|_], OrigIs) -> checkerror_2(OrigIs);
 
431
checkerror_1([{set,_,_,{bif,fnegate,_}}|_], OrigIs) -> checkerror_2(OrigIs);
 
432
checkerror_1([_|Is], OrigIs) -> checkerror_1(Is, OrigIs);
 
433
checkerror_1([], OrigIs) -> OrigIs.
 
434
 
 
435
checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs].
 
436
 
 
437
add_ftest_heap(Is) ->
 
438
    add_ftest_heap_1(reverse(Is), 0, []).
 
439
 
 
440
add_ftest_heap_1([{set,_,[{fr,_}],fmove}=I|Is], Floats, Acc) ->
 
441
    add_ftest_heap_1(Is, Floats+1, [I|Acc]);
 
442
add_ftest_heap_1([{allocate,_,_}=I|Is], 0, Acc) ->
 
443
    reverse(Is, [I|Acc]);
 
444
add_ftest_heap_1([{allocate,Regs,{Z,Stk,Heap,Inits}}|Is], Floats, Acc) ->
 
445
    reverse(Is, [{allocate,Regs,{Z,Stk,Heap,Floats,Inits}}|Acc]);
 
446
add_ftest_heap_1([I|Is], Floats, Acc) ->
 
447
    add_ftest_heap_1(Is, Floats, [I|Acc]);
 
448
add_ftest_heap_1([], 0, Acc) ->
 
449
    Acc;
 
450
add_ftest_heap_1([], Floats, Is) ->
 
451
    Regs = beam_block:live_at_entry(Is),
 
452
    [{allocate,Regs,{nozero,nostack,0,Floats,[]}}|Is].
 
453
 
 
454
are_live_regs_determinable([{allocate,_,_}|_]) -> true;
 
455
are_live_regs_determinable([{'%live',_}|_]) -> true;
 
456
are_live_regs_determinable([_|Is]) -> are_live_regs_determinable(Is);
 
457
are_live_regs_determinable([]) -> false.
 
458
 
 
459
 
 
460
%%% Routines for maintaining a type database.  The type database
 
461
%%% associates type information with registers.
 
462
%%%
 
463
%%% {tuple,Size,First} means that the corresponding register contains a
 
464
%%% tuple with *at least* Size elements.  An tuple with unknown
 
465
%%% size is represented as {tuple,0}. First is either [] (meaning that
 
466
%%% the tuple's first element is unknown) or [FirstElement] (the contents
 
467
%%% of the first element).
 
468
%%%
 
469
%%% 'float' means that the register contains a float.
 
470
 
 
471
%% tdb_new() -> EmptyDataBase
 
472
%%  Creates a new, empty type database.
 
473
 
 
474
tdb_new() -> [].
 
475
 
 
476
%% tdb_find(Register, Db) -> Information|error
 
477
%%  Returns type information or the atom error if there are no type
 
478
%%  information available for Register.
 
479
 
 
480
tdb_find(Key, [{K,_}|_]) when Key < K -> error;
 
481
tdb_find(Key, [{Key,Info}|_]) -> Info;
 
482
tdb_find(Key, [_|Db]) -> tdb_find(Key, Db);
 
483
tdb_find(_, []) -> error.
 
484
 
 
485
%% tdb_update([UpdateOp], Db) -> NewDb
 
486
%%        UpdateOp = {Register,kill}|{Register,NewInfo}
 
487
%%  Updates a type database.  If a 'kill' operation is given, the type
 
488
%%  information for that register will be removed from the database.
 
489
%%  A kill operation takes precende over other operations for the same
 
490
%%  register (i.e. [{{x,0},kill},{{x,0},{tuple,5}}] means that the
 
491
%%  the existing type information, if any, will be discarded, and the
 
492
%%  the '{tuple,5}' information ignored.
 
493
%%
 
494
%%  If NewInfo information is given and there exists information about
 
495
%%  the register, the old and new type information will be merged.
 
496
%%  For instance, {tuple,5} and {tuple,10} will be merged to produce
 
497
%%  {tuple,10}.
 
498
 
 
499
tdb_update(Uis0, Ts0) ->
 
500
    Uis1 = filter(fun ({{x,_},_Op}) -> true;
 
501
                      ({{y,_},_Op}) -> true;
 
502
                      (_) -> false
 
503
                  end, Uis0),
 
504
    tdb_update1(lists:sort(Uis1), Ts0).
 
505
 
 
506
tdb_update1([{Key,kill}|Ops], [{K,_Old}|_]=Db) when Key < K ->
 
507
    tdb_update1(remove_key(Key, Ops), Db);
 
508
tdb_update1([{Key,_New}=New|Ops], [{K,_Old}|_]=Db) when Key < K ->
 
509
    [New|tdb_update1(Ops, Db)];
 
510
tdb_update1([{Key,kill}|Ops], [{Key,_}|Db]) ->
 
511
    tdb_update1(remove_key(Key, Ops), Db);
 
512
tdb_update1([{Key,NewInfo}|Ops], [{Key,OldInfo}|Db]) ->
 
513
    [{Key,merge_type_info(NewInfo, OldInfo)}|tdb_update1(Ops, Db)];
 
514
tdb_update1([{_,_}|_]=Ops, [Old|Db]) ->
 
515
    [Old|tdb_update1(Ops, Db)];
 
516
tdb_update1([{Key,kill}|Ops], []) ->
 
517
    tdb_update1(remove_key(Key, Ops), []);
 
518
tdb_update1([{_,_}=New|Ops], []) ->
 
519
    [New|tdb_update1(Ops, [])];
 
520
tdb_update1([], Db) -> Db.
 
521
 
 
522
%% tdb_kill_xregs(Db) -> NewDb
 
523
%%  Kill all information about x registers. Also kill all tuple_element
 
524
%%  dependencies from y registers to x registers.
 
525
 
 
526
tdb_kill_xregs([{{x,_},_Type}|Db]) -> tdb_kill_xregs(Db);
 
527
tdb_kill_xregs([{{y,_},{tuple_element,{x,_},_}}|Db]) -> tdb_kill_xregs(Db);
 
528
tdb_kill_xregs([Any|Db]) -> [Any|tdb_kill_xregs(Db)];
 
529
tdb_kill_xregs([]) -> [].
 
530
 
 
531
remove_key(Key, [{Key,_Op}|Ops]) -> remove_key(Key, Ops);
 
532
remove_key(_, Ops) -> Ops.
 
533
 
 
534
merge_type_info(I, I) -> I;
 
535
merge_type_info({tuple,Sz1,Same}, {tuple,Sz2,Same}=Max) when Sz1 < Sz2 ->
 
536
    Max;
 
537
merge_type_info({tuple,Sz1,Same}=Max, {tuple,Sz2,Same}) when Sz1 > Sz2 ->
 
538
    Max;
 
539
merge_type_info({tuple,Sz1,[]}, {tuple,Sz2,First}) ->
 
540
    merge_type_info({tuple,Sz1,First}, {tuple,Sz2,First});
 
541
merge_type_info({tuple,Sz1,First}, {tuple,Sz2,_}) ->
 
542
    merge_type_info({tuple,Sz1,First}, {tuple,Sz2,First});
 
543
merge_type_info(NewType, _) ->
 
544
    verify_type(NewType),
 
545
    NewType.
 
546
 
 
547
verify_type({tuple,Sz,[]}) when is_integer(Sz) -> ok;
 
548
verify_type({tuple,Sz,[_]}) when is_integer(Sz) -> ok;
 
549
verify_type({tuple_element,_,_}) -> ok;
 
550
verify_type(float) -> ok;
 
551
verify_type({atom,_}) -> ok.