← 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_validator.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_validator.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_validator.erl,v 1.1 2008/12/17 09:53:41 mikpe Exp $
 
17
 
 
18
-module(beam_validator).
 
19
 
 
20
-export([file/1,files/1]).
 
21
 
 
22
%% Interface for compiler.
 
23
-export([module/2,format_error/1]).
 
24
 
 
25
-import(lists, [reverse/1,foldl/3]).
 
26
 
 
27
-define(MAXREG, 1024).
 
28
 
 
29
-define(DEBUG, 1).
 
30
-undef(DEBUG).
 
31
-ifdef(DEBUG).
 
32
-define(DBG_FORMAT(F, D), (io:format((F), (D)))).
 
33
-else.
 
34
-define(DBG_FORMAT(F, D), ok).
 
35
-endif.
 
36
 
 
37
%%%
 
38
%%% API functions.
 
39
%%%
 
40
 
 
41
files([F|Fs]) ->
 
42
    ?DBG_FORMAT("# Verifying: ~p~n", [F]),
 
43
    case file(F) of
 
44
        ok -> ok;
 
45
        {error,Es} ->
 
46
            io:format("~p:~n~s~n", [F,format_error(Es)])
 
47
    end,
 
48
    files(Fs);
 
49
files([]) -> ok.
 
50
 
 
51
file(Name) when is_list(Name) ->
 
52
    case case filename:extension(Name) of
 
53
             ".S" -> s_file(Name);
 
54
             ".beam" -> beam_file(Name)
 
55
         end of
 
56
        [] -> ok;
 
57
        Es -> {error,Es}
 
58
    end.
 
59
 
 
60
%% To be called by the compiler.
 
61
module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts)
 
62
  when is_atom(Mod), is_list(Exp), is_list(Attr), is_integer(Lc) ->
 
63
    case validate(Fs) of
 
64
        [] -> {ok,Code};
 
65
        Es0 ->
 
66
            Es = [{?MODULE,E} || E <- Es0],
 
67
            {error,[{atom_to_list(Mod),Es}]}
 
68
    end.
 
69
 
 
70
format_error([]) -> [];
 
71
format_error([{{M,F,A},{I,Off,Desc}}|Es]) ->
 
72
    [io_lib:format("  ~p:~p/~p+~p:~n    ~p - ~p~n",
 
73
                   [M,F,A,Off,I,Desc])|format_error(Es)];
 
74
format_error({{_M,F,A},{I,Off,Desc}}) ->
 
75
    io_lib:format(
 
76
      "function ~p/~p+~p:~n"
 
77
      "  Internal consistency check failed - please report this bug.~n"
 
78
      "  Instruction: ~p~n"
 
79
      "  Error:       ~p:~n", [F,A,Off,I,Desc]).
 
80
 
 
81
%%%
 
82
%%% Local functions follow.
 
83
%%%
 
84
 
 
85
s_file(Name) ->
 
86
    {ok,Is} = file:consult(Name),
 
87
    Fs = find_functions(Is),
 
88
    validate(Fs).
 
89
 
 
90
find_functions(Fs) ->
 
91
    find_functions_1(Fs, none, [], []).
 
92
 
 
93
find_functions_1([{function,Name,Arity,Entry}|Is], Func, FuncAcc, Acc0) ->
 
94
    Acc = add_func(Func, FuncAcc, Acc0),
 
95
    find_functions_1(Is, {Name,Arity,Entry}, [], Acc);
 
96
find_functions_1([I|Is], Func, FuncAcc, Acc) ->
 
97
    find_functions_1(Is, Func, [I|FuncAcc], Acc);
 
98
find_functions_1([], Func, FuncAcc, Acc) ->
 
99
    reverse(add_func(Func, FuncAcc, Acc)).
 
100
 
 
101
add_func(none, _, Acc) -> Acc;
 
102
add_func({Name,Arity,Entry}, Is, Acc) ->
 
103
    [{function,Name,Arity,Entry,reverse(Is)}|Acc].
 
104
 
 
105
beam_file(Name) ->
 
106
    try beam_disasm:file(Name) of
 
107
        {error,beam_lib,Reason} -> [{beam_lib,Reason}];
 
108
        {beam_file,L} ->
 
109
            {value,{code,Code0}} = lists:keysearch(code, 1, L),
 
110
            Code = beam_file_1(Code0, []),
 
111
            validate(Code)
 
112
    catch _:_ -> [disassembly_failed]
 
113
    end.
 
114
 
 
115
beam_file_1([F0|Fs], Acc) ->
 
116
    F = conv_func(F0),
 
117
    beam_file_1(Fs, [F|Acc]);
 
118
beam_file_1([], Acc) -> reverse(Acc).
 
119
 
 
120
%% Convert from the disassembly format to the internal format
 
121
%% used by the compiler (as passed to the assembler).
 
122
 
 
123
conv_func(Is) ->
 
124
    conv_func_1(labels(Is)).
 
125
 
 
126
conv_func_1({Ls,[{func_info,[{atom,M},{atom,F},Ar]},
 
127
                 {label,Entry}=Le|Is]}) ->
 
128
    %% The entry label gets maybe not correct here
 
129
    {function,F,Ar,Entry,
 
130
     [{label,L}||L<-Ls]++[{func_info,{atom,M},{atom,F},Ar},Le|Is]}.
 
131
 
 
132
%%%
 
133
%%% The validator follows.
 
134
%%%
 
135
%%% The purpose of the validator is find errors in the generated code
 
136
%%% that may cause the emulator to crash or behave strangely.
 
137
%%% We don't care about type errors in the user's code that will
 
138
%%% cause a proper exception at run-time.
 
139
%%%
 
140
 
 
141
%%% Things currently not checked. XXX
 
142
%%%
 
143
%%% - That floating point registers are initialized before used.
 
144
%%% - That fclearerror and fcheckerror are used properly.
 
145
%%% - Heap allocation for floating point numbers.
 
146
%%% - Heap allocation for binaries.
 
147
%%% - That a catchtag or trytag is not overwritten by the wrong
 
148
%%%   type of instruction (such as move/2).
 
149
%%% - Make sure that all catchtags and trytags have been removed
 
150
%%%   from the stack at return/tail call.
 
151
%%% - Verify get_list instructions.
 
152
%%%
 
153
 
 
154
%% validate([Function]) -> [] | [Error]
 
155
%%  A list of functions with their code. The code is in the same
 
156
%%  format as used in the compiler and in .S files.
 
157
validate([]) -> [];
 
158
validate([{function,Name,Ar,Entry,Code}|Fs]) ->
 
159
    try validate_1(Code, Name, Ar, Entry) of
 
160
        _ -> validate(Fs)
 
161
    catch
 
162
        Error ->
 
163
            [Error|validate(Fs)];
 
164
          error:Error ->
 
165
            [validate_error(Error, Name, Ar)|validate(Fs)]
 
166
    end.
 
167
 
 
168
-ifdef(DEBUG).
 
169
validate_error(Error, Name, Ar) ->
 
170
    exit(validate_error_1(Error, Name, Ar)).
 
171
-else.
 
172
validate_error(Error, Name, Ar) ->
 
173
    validate_error_1(Error, Name, Ar).
 
174
-endif.
 
175
validate_error_1(Error, Name, Ar) ->
 
176
    {{'_',Name,Ar},
 
177
     {internal_error,'_',{Error,erlang:get_stacktrace()}}}.
 
178
 
 
179
-record(st,                             %Emulation state
 
180
        {x=init_regs(0, term),          %x register info.
 
181
         y=init_regs(0, initialized),   %y register info.
 
182
         numy=none,                     %Number of y registers.
 
183
         h=0,                           %Available heap size.
 
184
         ct=[]                          %List of hot catch/try labels
 
185
        }).
 
186
 
 
187
-record(vst,                            %Validator state
 
188
        {current=none,                  %Current state
 
189
         branched=gb_trees:empty()      %States at jumps
 
190
        }).
 
191
 
 
192
-ifdef(DEBUG).
 
193
print_st(#st{x=Xs,y=Ys,numy=NumY,h=H,ct=Ct}) ->
 
194
    io:format("  #st{x=~p~n"
 
195
              "      y=~p~n"
 
196
              "      numy=~p,h=~p,ct=~w~n",
 
197
              [gb_trees:to_list(Xs),gb_trees:to_list(Ys),NumY,H,Ct]).
 
198
-endif.
 
199
 
 
200
validate_1(Is, Name, Arity, Entry) ->
 
201
    validate_2(labels(Is), Name, Arity, Entry).
 
202
 
 
203
validate_2({Ls1,[{func_info,{atom,Mod},{atom,Name},Arity}=_F|Is]},
 
204
           Name, Arity, Entry) ->
 
205
    lists:foreach(fun (_L) -> ?DBG_FORMAT("  ~p.~n", [_L]) end, Ls1),
 
206
    ?DBG_FORMAT("  ~p.~n", [_F]),
 
207
    validate_3(labels(Is), Name, Arity, Entry, Mod, Ls1);
 
208
validate_2({Ls1,Is}, Name, Arity, _Entry) ->
 
209
    error({{'_',Name,Arity},{first(Is),length(Ls1),illegal_instruction}}).
 
210
 
 
211
validate_3({Ls2,Is}, Name, Arity, Entry, Mod, Ls1) ->
 
212
    lists:foreach(fun (_L) -> ?DBG_FORMAT("  ~p.~n", [_L]) end, Ls2),
 
213
    Offset = 1 + length(Ls2),
 
214
    case lists:member(Entry, Ls2) of
 
215
        true ->
 
216
            St = init_state(Arity),
 
217
            Vst = #vst{current=St,
 
218
                       branched=gb_trees_from_list([{L,St} || L <- Ls1])},
 
219
            valfun(Is, {Mod,Name,Arity}, Offset, Vst);
 
220
        false ->
 
221
            error({{Mod,Name,Arity},{first(Is),Offset,no_entry_label}})
 
222
    end.
 
223
 
 
224
first([X|_]) -> X;
 
225
first([]) -> [].
 
226
 
 
227
labels(Is) ->
 
228
    labels_1(Is, []).
 
229
 
 
230
labels_1([{label,L}|Is], R) ->
 
231
    labels_1(Is, [L|R]);
 
232
labels_1(Is, R) ->
 
233
    {lists:reverse(R),Is}.
 
234
 
 
235
init_state(Arity) ->
 
236
    Xs = init_regs(Arity, term),
 
237
    Ys = init_regs(0, initialized),
 
238
    #st{x=Xs,y=Ys,numy=none,h=0,ct=[]}.
 
239
 
 
240
init_regs(0, _) ->
 
241
    gb_trees:empty();
 
242
init_regs(N, Type) ->
 
243
    gb_trees_from_list([{R,Type} || R <- lists:seq(0, N-1)]).
 
244
 
 
245
valfun([], _MFA, _Offset, Vst) -> Vst;
 
246
valfun([I|Is], MFA, Offset, Vst) ->
 
247
    ?DBG_FORMAT("    ~p.\n", [I]),
 
248
    valfun(Is, MFA, Offset+1,
 
249
           try valfun_1(I, Vst)
 
250
           catch Error ->
 
251
                   error({MFA,{I,Offset,Error}})
 
252
           end).
 
253
 
 
254
%% Instructions that are allowed in dead code or when failing,
 
255
%% that is while the state is undecided in some way.
 
256
valfun_1({label,Lbl}, #vst{current=St0,branched=B}=Vst) ->
 
257
    St = merge_states(Lbl, St0, B),
 
258
    Vst#vst{current=St,branched=gb_trees:enter(Lbl, St, B)};
 
259
valfun_1(_I, #vst{current=none}=Vst) ->
 
260
    %% Ignore instructions after erlang:error/1,2, which
 
261
    %% the original R10B compiler thought would return.
 
262
    ?DBG_FORMAT("Ignoring ~p\n", [_I]),
 
263
    Vst;
 
264
valfun_1({badmatch,Src}, Vst) ->
 
265
    assert_term(Src, Vst),
 
266
    kill_state(Vst);
 
267
valfun_1({case_end,Src}, Vst) ->
 
268
    assert_term(Src, Vst),
 
269
    kill_state(Vst);
 
270
valfun_1(if_end, Vst) ->
 
271
    kill_state(Vst);
 
272
valfun_1({try_case_end,Src}, Vst) ->
 
273
    assert_term(Src, Vst),
 
274
    kill_state(Vst);
 
275
%% Instructions that can not cause exceptions
 
276
valfun_1({move,Src,Dst}, Vst) ->
 
277
    Type = get_term_type(Src, Vst),
 
278
    set_type_reg(Type, Dst, Vst);
 
279
valfun_1({fmove,Src,{fr,_}}, Vst) ->
 
280
    assert_type(float, Src, Vst);
 
281
valfun_1({fmove,{fr,_},Dst}, Vst) ->
 
282
    set_type_reg({float,[]}, Dst, Vst);
 
283
valfun_1({kill,{y,_}=Reg}, Vst) ->
 
284
    set_type_y(initialized, Reg, Vst);
 
285
valfun_1({test_heap,Heap,Live}, Vst) ->
 
286
    test_heap(Heap, Live, Vst);
 
287
valfun_1({bif,_Op,nofail,Src,Dst}, Vst) ->
 
288
    validate_src(Src, Vst),
 
289
    set_type_reg(term, Dst, Vst);
 
290
%% Put instructions.
 
291
valfun_1({put_list,A,B,Dst}, Vst0) ->
 
292
    assert_term(A, Vst0),
 
293
    assert_term(B, Vst0),
 
294
    Vst = eat_heap(2, Vst0),
 
295
    set_type_reg(cons, Dst, Vst);
 
296
valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) ->
 
297
    Vst = eat_heap(1, Vst0),
 
298
    set_type_reg({tuple,Sz}, Dst, Vst);
 
299
valfun_1({put,Src}, Vst) ->
 
300
    assert_term(Src, Vst),
 
301
    eat_heap(1, Vst);
 
302
valfun_1({put_string,Sz,_,Dst}, Vst0) when is_integer(Sz) ->
 
303
    Vst = eat_heap(2*Sz, Vst0),
 
304
    set_type_reg(cons, Dst, Vst);
 
305
%% Allocate and deallocate, et.al
 
306
valfun_1({allocate,Stk,Live}, Vst) ->
 
307
    allocate(false, Stk, 0, Live, Vst);
 
308
valfun_1({allocate_heap,Stk,Heap,Live}, Vst) ->
 
309
    allocate(false, Stk, Heap, Live, Vst);
 
310
valfun_1({allocate_zero,Stk,Live}, Vst) ->
 
311
    allocate(true, Stk, 0, Live, Vst);
 
312
valfun_1({allocate_heap_zero,Stk,Heap,Live}, Vst) ->
 
313
    allocate(true, Stk, Heap, Live, Vst);
 
314
valfun_1({init,{y,_}=Reg}, Vst) ->
 
315
    set_type_y(initialized, Reg, Vst);
 
316
valfun_1({deallocate,StkSize}, #vst{current=#st{numy=StkSize,ct=[]}}=Vst) ->
 
317
    deallocate(Vst);
 
318
valfun_1({deallocate,_}, #vst{current=#st{numy=NumY,ct=[]}}) ->
 
319
    error({allocated,NumY});
 
320
valfun_1({deallocate,_}, #vst{current=#st{ct=Fails}}) ->
 
321
    error({catch_try_stack,Fails});
 
322
%% Catch & try.
 
323
valfun_1({'catch',Dst,{f,Fail}}, Vst0) when Fail /= none ->
 
324
    Vst = #vst{current=#st{ct=Fails}=St} =
 
325
        set_type_y({catchtag,Fail}, Dst, Vst0),
 
326
    Vst#vst{current=St#st{ct=[Fail|Fails]}};
 
327
valfun_1({'try',Dst,{f,Fail}}, Vst0) ->
 
328
    Vst = #vst{current=#st{ct=Fails}=St} =
 
329
        set_type_y({trytag,Fail}, Dst, Vst0),
 
330
    Vst#vst{current=St#st{ct=[Fail|Fails]}};
 
331
%% Do a postponed state branch if necessary and try next set of instructions
 
332
valfun_1(I, #vst{current=#st{ct=[]}}=Vst) ->
 
333
    valfun_2(I, Vst);
 
334
valfun_1(I, #vst{current=#st{ct=Fails}}=Vst0) ->
 
335
    %% Perform a postponed state branch
 
336
    Vst = #vst{current=St} = lists:foldl(fun branch_state/2, Vst0, Fails),
 
337
    valfun_2(I, Vst#vst{current=St#st{ct=[]}}).
 
338
 
 
339
%% Instructions that can cause exceptions.
 
340
valfun_2({apply,Live}, Vst) ->
 
341
    call(Live+2, Vst);
 
342
valfun_2({apply_last,Live,_}, Vst) ->
 
343
    tail_call(Live+2, Vst);
 
344
valfun_2({call_fun,Live}, Vst) ->
 
345
    call(Live, Vst);
 
346
valfun_2({call,Live,_}, Vst) ->
 
347
    call(Live, Vst);
 
348
valfun_2({call_ext,Live,Func}, Vst) ->
 
349
    call(Func, Live, Vst);
 
350
valfun_2({call_only,Live,_}, Vst) ->
 
351
    tail_call(Live, Vst);
 
352
valfun_2({call_ext_only,Live,_}, Vst) ->
 
353
    tail_call(Live, Vst);
 
354
valfun_2({call_last,Live,_,_}, Vst) ->
 
355
    tail_call(Live, Vst);
 
356
valfun_2({call_ext_last,Live,_,_}, Vst) ->
 
357
    tail_call(Live, Vst);
 
358
valfun_2({make_fun,_,_,Live}, Vst) ->
 
359
    call(Live, Vst);
 
360
valfun_2({make_fun2,_,_,_,Live}, Vst) ->
 
361
    call(Live, Vst);
 
362
%% Floating point.
 
363
valfun_2({fconv,Src,{fr,_}}, Vst) ->
 
364
    assert_term(Src, Vst);
 
365
valfun_2({bif,fadd,_,[{fr,_},{fr,_}],{fr,_}}, Vst) ->
 
366
    Vst;
 
367
valfun_2({bif,fdiv,_,[{fr,_},{fr,_}],{fr,_}}, Vst) ->
 
368
    Vst;
 
369
valfun_2({bif,fmul,_,[{fr,_},{fr,_}],{fr,_}}, Vst) ->
 
370
    Vst;
 
371
valfun_2({bif,fnegate,_,[{fr,_}],{fr,_}}, Vst) ->
 
372
    Vst;
 
373
valfun_2({bif,fsub,_,[{fr,_},{fr,_}],{fr,_}}, Vst) ->
 
374
    Vst;
 
375
valfun_2(fclearerror, Vst) ->
 
376
    Vst;
 
377
valfun_2({fcheckerror,_}, Vst) ->
 
378
    Vst;
 
379
%% Other BIFs
 
380
valfun_2({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) ->
 
381
    TupleType0 = get_term_type(Tuple, Vst0),
 
382
    PosType = get_term_type(Pos, Vst0),
 
383
    Vst1 = branch_state(Fail, Vst0),
 
384
    TupleType = upgrade_type({tuple,[get_tuple_size(PosType)]}, TupleType0),
 
385
    Vst = set_type(TupleType, Tuple, Vst1),
 
386
    set_type_reg(term, Dst, Vst);
 
387
valfun_2({bif,Op,{f,Fail},Src,Dst}, Vst0) ->
 
388
    validate_src(Src, Vst0),
 
389
    Vst = branch_state(Fail, Vst0),
 
390
    Type = bif_type(Op, Src, Vst),
 
391
    set_type_reg(Type, Dst, Vst);
 
392
valfun_2(return, #vst{current=#st{numy=none}}=Vst) ->
 
393
    kill_state(Vst);
 
394
valfun_2(return, #vst{current=#st{numy=NumY}}) ->
 
395
    error({stack_frame,NumY});
 
396
valfun_2({jump,{f,_}}, #vst{current=none}=Vst) ->
 
397
    %% Must be an unreachable jump which was not optimized away.
 
398
    %% Do nothing.
 
399
    Vst;
 
400
valfun_2({jump,{f,Lbl}}, Vst) ->
 
401
    kill_state(branch_state(Lbl, Vst));
 
402
valfun_2({loop_rec,{f,Fail},Dst}, Vst0) ->
 
403
    Vst = branch_state(Fail, Vst0),
 
404
    set_type_reg(term, Dst, Vst);
 
405
valfun_2(remove_message, Vst) ->
 
406
    Vst;
 
407
valfun_2({wait,_}, Vst) ->
 
408
    kill_state(Vst);
 
409
valfun_2({wait_timeout,_,Src}, Vst) ->
 
410
    assert_term(Src, Vst);
 
411
valfun_2({loop_rec_end,_}, Vst) ->
 
412
    kill_state(Vst);
 
413
valfun_2(timeout, #vst{current=St}=Vst) ->
 
414
    Vst#vst{current=St#st{x=init_regs(0, term)}};
 
415
valfun_2(send, Vst) ->
 
416
    call(2, Vst);
 
417
%% Catch & try.
 
418
valfun_2({catch_end,Reg}, Vst0) ->
 
419
    case get_type(Reg, Vst0) of
 
420
        {catchtag,_} ->
 
421
            Vst = #vst{current=St} = set_type_reg(initialized, Reg, Vst0),
 
422
            Xs = gb_trees_from_list([{0,term}]),
 
423
            Vst#vst{current=St#st{x=Xs}};
 
424
        Type ->
 
425
            error({bad_type,Type})
 
426
    end;
 
427
valfun_2({try_end,Reg}, Vst) ->
 
428
    case get_type(Reg, Vst) of
 
429
        {trytag,_} ->
 
430
            set_type_reg(initialized, Reg, Vst);
 
431
        Type ->
 
432
            error({bad_type,Type})
 
433
    end;
 
434
valfun_2({try_case,Reg}, Vst0) ->
 
435
    case get_type(Reg, Vst0) of
 
436
        {trytag,_} ->
 
437
            Vst = #vst{current=St} = set_type_reg(initialized, Reg, Vst0),
 
438
            Xs = gb_trees_from_list([{0,{atom,[]}},{1,term},{2,term}]),
 
439
            Vst#vst{current=St#st{x=Xs}};
 
440
        Type ->
 
441
            error({bad_type,Type})
 
442
    end;
 
443
valfun_2({set_tuple_element,Src,Tuple,I}, Vst) ->
 
444
    assert_term(Src, Vst),
 
445
    assert_type({tuple_element,I+1}, Tuple, Vst);
 
446
%% Match instructions.
 
447
valfun_2({select_val,Src,{f,Fail},{list,Choices}}, Vst) ->
 
448
    assert_term(Src, Vst),
 
449
    Lbls = [L || {f,L} <- Choices]++[Fail],
 
450
    kill_state(foldl(fun(L, S) -> branch_state(L, S) end, Vst, Lbls));
 
451
valfun_2({select_tuple_arity,Tuple,{f,Fail},{list,Choices}}, Vst) ->
 
452
    assert_type(tuple, Tuple, Vst),
 
453
    kill_state(branch_arities(Choices, Tuple, branch_state(Fail, Vst)));
 
454
valfun_2({get_list,Src,D1,D2}, Vst0) ->
 
455
    assert_term(Src, Vst0),
 
456
    Vst = set_type_reg(term, D1, Vst0),
 
457
    set_type_reg(term, D2, Vst);
 
458
valfun_2({get_tuple_element,Src,I,Dst}, Vst) ->
 
459
    assert_type({tuple_element,I+1}, Src, Vst),
 
460
    set_type_reg(term, Dst, Vst);
 
461
valfun_2({bs_restore,_}, Vst) ->
 
462
    Vst;
 
463
valfun_2({bs_save,_}, Vst) ->
 
464
    Vst;
 
465
valfun_2({bs_start_match,{f,Fail},Src}, Vst) ->
 
466
    assert_term(Src, Vst),
 
467
    branch_state(Fail, Vst);
 
468
valfun_2({test,bs_skip_bits,{f,Fail},[Src,_,_]}, Vst) ->
 
469
    assert_term(Src, Vst),
 
470
    branch_state(Fail, Vst);
 
471
valfun_2({test,_,{f,Fail},[_,_,_,Dst]}, Vst0) ->
 
472
    Vst = branch_state(Fail, Vst0),
 
473
    set_type_reg({integer,[]}, Dst, Vst);
 
474
valfun_2({test,bs_test_tail,{f,Fail},_}, Vst) ->
 
475
    branch_state(Fail, Vst);
 
476
%% Other test instructions.
 
477
valfun_2({test,is_float,{f,Lbl},[Float]}, Vst0) ->
 
478
    assert_term(Float, Vst0),
 
479
    Vst = branch_state(Lbl, Vst0),
 
480
    set_type({float,[]}, Float, Vst);
 
481
valfun_2({test,is_tuple,{f,Lbl},[Tuple]}, Vst0) ->
 
482
    assert_term(Tuple, Vst0),
 
483
    Vst = branch_state(Lbl, Vst0),
 
484
    set_type({tuple,[0]}, Tuple, Vst);
 
485
valfun_2({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst0) when is_integer(Sz) ->
 
486
    assert_type(tuple, Tuple, Vst0),
 
487
    Vst = branch_state(Lbl, Vst0),
 
488
    set_type_reg({tuple,Sz}, Tuple, Vst);
 
489
valfun_2({test,_Op,{f,Lbl},Src}, Vst) ->
 
490
    validate_src(Src, Vst),
 
491
    branch_state(Lbl, Vst);
 
492
valfun_2({bs_add,{f,Fail},[A,B,_],Dst}, Vst0) ->
 
493
    assert_term(A, Vst0),
 
494
    assert_term(B, Vst0),
 
495
    Vst = branch_state(Fail, Vst0),
 
496
    set_type_reg({integer,[]}, Dst, Vst);
 
497
valfun_2({bs_bits_to_bytes,{f,Fail},Src,Dst}, Vst0) ->
 
498
    assert_term(Src, Vst0),
 
499
    Vst = branch_state(Fail, Vst0),
 
500
    set_type_reg({integer,[]}, Dst, Vst);
 
501
valfun_2({bs_init2,{f,Fail},_,Heap,_,_,Dst}, Vst0) ->
 
502
    Vst1 = heap_alloc(Heap, Vst0),
 
503
    Vst = branch_state(Fail, Vst1),
 
504
    set_type_reg(binary, Dst, Vst);
 
505
valfun_2({bs_put_string,Sz,_}, Vst) when is_integer(Sz) ->
 
506
    Vst;
 
507
valfun_2({bs_put_binary,{f,Fail},_,_,_,Src}, Vst0) ->
 
508
    assert_term(Src, Vst0),
 
509
    branch_state(Fail, Vst0);
 
510
valfun_2({bs_put_float,{f,Fail},_,_,_,Src}, Vst0) ->
 
511
    assert_term(Src, Vst0),
 
512
    branch_state(Fail, Vst0);
 
513
valfun_2({bs_put_integer,{f,Fail},_,_,_,Src}, Vst0) ->
 
514
    assert_term(Src, Vst0),
 
515
    branch_state(Fail, Vst0);
 
516
%% Old bit syntax construction (before R10B).
 
517
valfun_2({bs_init,_,_}, Vst) -> Vst;
 
518
valfun_2({bs_need_buf,_}, Vst) -> Vst;
 
519
valfun_2({bs_final,{f,Fail},Dst}, Vst0) ->
 
520
    Vst = branch_state(Fail, Vst0),
 
521
    set_type_reg(binary, Dst, Vst);
 
522
%% Misc.
 
523
valfun_2({'%live',Live}, Vst) ->
 
524
    verify_live(Live, Vst),
 
525
    Vst;
 
526
valfun_2(_, _) ->
 
527
    error(unknown_instruction).
 
528
 
 
529
kill_state(#vst{current=#st{ct=[]}}=Vst) ->
 
530
    Vst#vst{current=none};
 
531
kill_state(#vst{current=#st{ct=Fails}}=Vst0) ->
 
532
    Vst = lists:foldl(fun branch_state/2, Vst0, Fails),
 
533
    Vst#vst{current=none}.
 
534
 
 
535
%% A "plain" call.
 
536
%%  The stackframe must have a known size and be initialized.
 
537
%%  The instruction will return to the instruction following the call.
 
538
call(Live, #vst{current=St}=Vst) ->
 
539
    verify_live(Live, Vst),
 
540
    verify_y_init(Vst),
 
541
    Xs = gb_trees_from_list([{0,term}]),
 
542
    Vst#vst{current=St#st{x=Xs}}.
 
543
 
 
544
%% A "plain" call.
 
545
%%  The stackframe must have a known size and be initialized.
 
546
%%  The instruction will return to the instruction following the call.
 
547
call(Name, Live, #vst{current=St}=Vst) ->
 
548
    verify_live(Live, Vst),
 
549
    case return_type(Name, Vst) of
 
550
        exception ->
 
551
            kill_state(Vst);
 
552
        Type ->
 
553
            verify_y_init(Vst),
 
554
            Xs = gb_trees_from_list([{0,Type}]),
 
555
            Vst#vst{current=St#st{x=Xs}}
 
556
    end.
 
557
 
 
558
%% Tail call.
 
559
%%  The stackframe must have a known size and be initialized.
 
560
%%  Does not return to the instruction following the call.
 
561
tail_call(Live, Vst) ->
 
562
    kill_state(call(Live, Vst)).
 
563
 
 
564
allocate(Zero, Stk, Heap, Live, #vst{current=#st{numy=none}=St}=Vst) ->
 
565
    verify_live(Live, Vst),
 
566
    Ys = init_regs(case Zero of
 
567
                       true -> Stk;
 
568
                       false -> 0
 
569
                   end, initialized),
 
570
    Vst#vst{current=St#st{y=Ys,numy=Stk,h=heap_alloc_1(Heap)}};
 
571
allocate(_, _, _, _, #vst{current=#st{numy=Numy}}) ->
 
572
    error({existing_stack_frame,{size,Numy}}).
 
573
 
 
574
deallocate(#vst{current=St}=Vst) ->
 
575
    Vst#vst{current=St#st{y=init_regs(0, initialized),numy=none}}.
 
576
 
 
577
test_heap(Heap, Live, Vst) ->
 
578
    verify_live(Live, Vst),
 
579
    heap_alloc(Heap, Vst).
 
580
 
 
581
heap_alloc(Heap, #vst{current=St}=Vst) ->
 
582
    Vst#vst{current=St#st{h=heap_alloc_1(Heap)}}.
 
583
 
 
584
heap_alloc_1({alloc,Alloc}) ->
 
585
    {value,{_,Heap}} = lists:keysearch(words, 1, Alloc),
 
586
    Heap;
 
587
heap_alloc_1(Heap) when is_integer(Heap) -> Heap.
 
588
 
 
589
 
 
590
set_type(Type, {x,_}=Reg, Vst) -> set_type_reg(Type, Reg, Vst);
 
591
set_type(Type, {y,_}=Reg, Vst) -> set_type_y(Type, Reg, Vst);
 
592
set_type(_, _, #vst{}=Vst) -> Vst.
 
593
 
 
594
set_type_reg(Type, {x,X}, #vst{current=#st{x=Xs}=St}=Vst)
 
595
  when 0 =< X, X < ?MAXREG ->
 
596
    Vst#vst{current=St#st{x=gb_trees:enter(X, Type, Xs)}};
 
597
set_type_reg(Type, Reg, Vst) ->
 
598
    set_type_y(Type, Reg, Vst).
 
599
 
 
600
set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys,numy=NumY}=St}=Vst)
 
601
  when is_integer(Y), 0 =< Y, Y < ?MAXREG ->
 
602
    case {Y,NumY} of
 
603
        {_,none} ->
 
604
            error({no_stack_frame,Reg});
 
605
        {_,_} when Y > NumY ->
 
606
            error({y_reg_out_of_range,Reg,NumY});
 
607
        {_,_} ->
 
608
            Vst#vst{current=St#st{y=gb_trees:enter(Y, Type, Ys)}}
 
609
    end;
 
610
set_type_y(Type, Reg, #vst{}) -> error({invalid_store,Reg,Type}).
 
611
 
 
612
assert_term(Src, Vst) ->
 
613
    get_term_type(Src, Vst),
 
614
    Vst.
 
615
 
 
616
%% The possible types.
 
617
%%
 
618
%% First non-term types:
 
619
%%
 
620
%% initialized          Only for Y registers. Means that the Y register
 
621
%%                      has been initialized with some valid term so that
 
622
%%                      it is safe to pass to the garbage collector.
 
623
%%                      NOT safe to use in any other way (will not crash the
 
624
%%                      emulator, but clearly points to a bug in the compiler).
 
625
%%
 
626
%% {catchtag,Lbl}       A special term used within a catch. Must only be used
 
627
%%                      by the catch instructions; NOT safe to use in other
 
628
%%                      instructions.
 
629
%%
 
630
%% {trytag,Lbl}         A special term used within a try block. Must only be
 
631
%%                      used by the catch instructions; NOT safe to use in other
 
632
%%                      instructions.
 
633
%%
 
634
%% exception            Can only be used as a type returned by return_type/2
 
635
%%                      (which gives the type of the value returned by a BIF).
 
636
%%                      Thus 'exception' is never stored as type descriptor
 
637
%%                      for a register.
 
638
%%
 
639
%% Normal terms:
 
640
%%
 
641
%% term                 Any valid Erlang (but not of the special types above).
 
642
%%
 
643
%% bool                 The atom 'true' or the atom 'false'.
 
644
%%
 
645
%% cons                 Cons cell: [_|_]
 
646
%%
 
647
%% nil                  Empty list: []
 
648
%%
 
649
%% {tuple,[Sz]}         Tuple. An element has been accessed using
 
650
%%                      element/2 or setelement/3 so that it is known that
 
651
%%                      the type is a tuple of size at least Sz.
 
652
%%
 
653
%% {tuple,Sz}           Tuple. A test_arity instruction has been seen
 
654
%%                      so that it is known that the size is exactly Sz.
 
655
%%
 
656
%% {atom,[]}            Atom.
 
657
%% {atom,Atom}
 
658
%%
 
659
%% {integer,[]}         Integer.
 
660
%% {integer,Integer}
 
661
%%
 
662
%% {float,[]}           Float.
 
663
%% {float,Float}
 
664
%%
 
665
%% number               Integer or Float of unknown value
 
666
%%
 
667
 
 
668
assert_type(WantedType, Term, Vst) ->
 
669
    assert_type(WantedType, get_type(Term, Vst)),
 
670
    Vst.
 
671
 
 
672
assert_type(float, {float,_}) -> ok;
 
673
assert_type(tuple, {tuple,_}) -> ok;
 
674
assert_type({tuple_element,I}, {tuple,[Sz]})
 
675
  when 1 =< I, I =< Sz ->
 
676
    ok;
 
677
assert_type({tuple_element,I}, {tuple,Sz})
 
678
  when is_integer(Sz), 1 =< I, I =< Sz ->
 
679
    ok;
 
680
assert_type(Needed, Actual) ->
 
681
    error({bad_type,{needed,Needed},{actual,Actual}}).
 
682
 
 
683
%% upgrade_type/2 is used when linear code finds out more and
 
684
%% more information about a type, so the type gets "narrower"
 
685
%% or perhaps inconsistent. In the case of inconsistency
 
686
%% we mostly widen the type to 'term' to make subsequent
 
687
%% code fail if it assumes anything about the type.
 
688
 
 
689
upgrade_type(Same, Same) -> Same;
 
690
upgrade_type(term, OldT) -> OldT;
 
691
upgrade_type(NewT, term) -> NewT;
 
692
upgrade_type({Type,New}=NewT, {Type,Old}=OldT)
 
693
  when Type == atom; Type == integer; Type == float ->
 
694
    if New =:= Old -> OldT;
 
695
       New =:= [] -> OldT;
 
696
       Old =:= [] -> NewT;
 
697
       true -> term
 
698
    end;
 
699
upgrade_type({Type,_}=NewT, number)
 
700
  when Type == integer; Type == float ->
 
701
    NewT;
 
702
upgrade_type(number, {Type,_}=OldT)
 
703
  when Type == integer; Type == float ->
 
704
    OldT;
 
705
upgrade_type(bool, {atom,A}) ->
 
706
    upgrade_bool(A);
 
707
upgrade_type({atom,A}, bool) ->
 
708
    upgrade_bool(A);
 
709
upgrade_type({tuple,[Sz]}, {tuple,[OldSz]})
 
710
  when is_integer(Sz) ->
 
711
    {tuple,[max(Sz, OldSz)]};
 
712
upgrade_type({tuple,Sz}=T, {tuple,[_]})
 
713
  when is_integer(Sz) ->
 
714
    %% This also takes care of the user error when a tuple element
 
715
    %% is accesed outside the known exact tuple size; there is
 
716
    %% no more type information, just a runtime error which is not
 
717
    %% our problem.
 
718
    T;
 
719
upgrade_type({tuple,[Sz]}, {tuple,_}=T)
 
720
  when is_integer(Sz) ->
 
721
    %% Same as the previous clause but mirrored.
 
722
    T;
 
723
upgrade_type(_A, _B) ->
 
724
    %%io:format("upgrade_type: ~p ~p\n", [_A,_B]),
 
725
    term.
 
726
 
 
727
upgrade_bool([]) -> bool;
 
728
upgrade_bool(true) -> {atom,true};
 
729
upgrade_bool(false) -> {atom,false};
 
730
upgrade_bool(_) -> term.
 
731
 
 
732
get_tuple_size({integer,[]}) -> 0;
 
733
get_tuple_size({integer,Sz}) -> Sz;
 
734
get_tuple_size(_) -> 0.
 
735
 
 
736
validate_src(Ss, Vst) when is_list(Ss) ->
 
737
    foldl(fun(S, _) -> get_type(S, Vst) end, ok, Ss).
 
738
 
 
739
get_term_type(Src, Vst) ->
 
740
    case get_type(Src, Vst) of
 
741
        initialized -> error({not_assigned,Src});
 
742
        exception -> error({exception,Src});
 
743
        {catchtag,_} -> error({catchtag,Src});
 
744
        {trytag,_} -> error({trytag,Src});
 
745
        Type -> Type
 
746
    end.
 
747
 
 
748
get_type(nil=T, _) -> T;
 
749
get_type({atom,A}=T, _) when is_atom(A) -> T;
 
750
get_type({float,F}=T, _) when is_float(F) -> T;
 
751
get_type({integer,I}=T, _) when is_integer(I) -> T;
 
752
get_type({x,X}=Reg, #vst{current=#st{x=Xs}}) when is_integer(X) ->
 
753
    case gb_trees:lookup(X, Xs) of
 
754
        {value,Type} -> Type;
 
755
        none -> error({uninitialized_reg,Reg})
 
756
    end;
 
757
get_type({y,Y}=Reg, #vst{current=#st{y=Ys}}) when is_integer(Y) ->
 
758
    case gb_trees:lookup(Y, Ys) of
 
759
        {value,initialized} -> error({unassigned_reg,Reg});
 
760
        {value,Type} -> Type;
 
761
        none -> error({uninitialized_reg,Reg})
 
762
    end;
 
763
get_type(Src, _) -> error({bad_source,Src}).
 
764
 
 
765
branch_arities([], _, #vst{}=Vst) -> Vst;
 
766
branch_arities([Sz,{f,L}|T], Tuple, #vst{current=St}=Vst0)
 
767
  when is_integer(Sz) ->
 
768
    Vst1 = set_type_reg({tuple,Sz}, Tuple, Vst0),
 
769
    Vst = branch_state(L, Vst1),
 
770
    branch_arities(T, Tuple, Vst#vst{current=St}).
 
771
 
 
772
branch_state(0, #vst{}=Vst) -> Vst;
 
773
branch_state(L, #vst{current=St,branched=B}=Vst) ->
 
774
    Vst#vst{
 
775
      branched=case gb_trees:is_defined(L, B) of
 
776
                   false ->
 
777
                       gb_trees:insert(L, St#st{ct=[]}, B);
 
778
                   true ->
 
779
                       MergedSt = merge_states(L, St, B),
 
780
                       gb_trees:update(L, MergedSt#st{ct=[]}, B)
 
781
               end}.
 
782
 
 
783
%% merge_states/3 is used when there are more than one way to arrive
 
784
%% at this point, and the type states for the different paths has
 
785
%% to be merged. The type states are downgraded to the least common
 
786
%% subset for the subsequent code.
 
787
 
 
788
merge_states(0, St, _Branched) -> St;
 
789
merge_states(L, St, Branched) ->
 
790
    case gb_trees:lookup(L, Branched) of
 
791
        none -> St;
 
792
        {value,OtherSt} when St == none -> OtherSt;
 
793
        {value,OtherSt} ->
 
794
            merge_states_1(St, OtherSt)
 
795
    end.
 
796
 
 
797
merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0}=St,
 
798
               #st{x=Xs1,y=Ys1,numy=NumY1,h=H1}) ->
 
799
    NumY = merge_stk(NumY0, NumY1),
 
800
    Xs = merge_regs(Xs0, Xs1),
 
801
    Ys = merge_regs(Ys0, Ys1),
 
802
    St#st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1)}.
 
803
 
 
804
merge_stk(S, S) -> S;
 
805
merge_stk(_, _) -> undecided.
 
806
 
 
807
merge_regs(Rs0, Rs1) ->
 
808
    Rs = merge_regs_1(gb_trees:to_list(Rs0), gb_trees:to_list(Rs1)),
 
809
    gb_trees_from_list(Rs).
 
810
 
 
811
merge_regs_1([Same|Rs1], [Same|Rs2]) ->
 
812
    [Same|merge_regs_1(Rs1, Rs2)];
 
813
merge_regs_1([{R1,_}|Rs1], [{R2,_}|_]=Rs2) when R1 < R2 ->
 
814
    merge_regs_1(Rs1, Rs2);
 
815
merge_regs_1([{R1,_}|_]=Rs1, [{R2,_}|Rs2]) when R1 > R2 ->
 
816
    merge_regs_1(Rs1, Rs2);
 
817
merge_regs_1([{R,Type1}|Rs1], [{R,Type2}|Rs2]) ->
 
818
    [{R,merge_types(Type1, Type2)}|merge_regs_1(Rs1, Rs2)];
 
819
merge_regs_1([], []) -> [];
 
820
merge_regs_1([], [_|_]) -> [];
 
821
merge_regs_1([_|_], []) -> [].
 
822
 
 
823
merge_types(T, T) -> T;
 
824
merge_types(initialized=I, _) -> I;
 
825
merge_types(_, initialized=I) -> I;
 
826
merge_types({tuple,Same}=T, {tuple,Same}) -> T;
 
827
merge_types({tuple,A}, {tuple,B}) ->
 
828
    {tuple,[min(tuple_sz(A), tuple_sz(B))]};
 
829
merge_types({Type,A}, {Type,B})
 
830
  when Type == atom; Type == integer; Type == float ->
 
831
    if A =:= B -> {Type,A};
 
832
       true -> {Type,[]}
 
833
    end;
 
834
merge_types({Type,_}, number)
 
835
  when Type == integer; Type == float ->
 
836
    number;
 
837
merge_types(number, {Type,_})
 
838
  when Type == integer; Type == float ->
 
839
    number;
 
840
merge_types(bool, {atom,A}) ->
 
841
    merge_bool(A);
 
842
merge_types({atom,A}, bool) ->
 
843
    merge_bool(A);
 
844
merge_types(_, _) -> term.
 
845
 
 
846
tuple_sz([Sz]) -> Sz;
 
847
tuple_sz(Sz) -> Sz.
 
848
 
 
849
merge_bool([]) -> {atom,[]};
 
850
merge_bool(true) -> bool;
 
851
merge_bool(false) -> bool;
 
852
merge_bool(_) -> {atom,[]}.
 
853
 
 
854
verify_y_init(#vst{current=#st{numy=none}}) -> ok;
 
855
verify_y_init(#vst{current=#st{numy=undecided}}) ->
 
856
    error(unknown_size_of_stackframe);
 
857
verify_y_init(#vst{current=#st{y=Ys,numy=NumY}}) ->
 
858
    verify_y_init_1(NumY, Ys).
 
859
 
 
860
verify_y_init_1(0, _) -> ok;
 
861
verify_y_init_1(N, Ys) ->
 
862
    Y = N-1,
 
863
    case gb_trees:is_defined(Y, Ys) of
 
864
        false -> error({{y,Y},not_initialized});
 
865
        true -> verify_y_init_1(Y, Ys)
 
866
    end.
 
867
 
 
868
verify_live(0, #vst{}) -> ok;
 
869
verify_live(N, #vst{current=#st{x=Xs}}) ->
 
870
    verify_live_1(N, Xs).
 
871
 
 
872
verify_live_1(0, _) -> ok;
 
873
verify_live_1(N, Xs) ->
 
874
    X = N-1,
 
875
    case gb_trees:is_defined(X, Xs) of
 
876
        false -> error({{x,X},not_live});
 
877
        true -> verify_live_1(X, Xs)
 
878
    end.
 
879
 
 
880
eat_heap(N, #vst{current=#st{h=Heap0}=St}=Vst) ->
 
881
    case Heap0-N of
 
882
        Neg when Neg < 0 ->
 
883
            error({heap_overflow,{left,Heap0},{wanted,N}});
 
884
        Heap ->
 
885
            Vst#vst{current=St#st{h=Heap}}
 
886
    end.
 
887
 
 
888
bif_type('-', Src, Vst) ->
 
889
    arith_type(Src, Vst);
 
890
bif_type('+', Src, Vst) ->
 
891
    arith_type(Src, Vst);
 
892
bif_type('*', Src, Vst) ->
 
893
    arith_type(Src, Vst);
 
894
bif_type(abs, [Num], Vst) ->
 
895
    case get_type(Num, Vst) of
 
896
        {float,_}=T -> T;
 
897
        {integer,_}=T -> T;
 
898
        _ -> number
 
899
    end;
 
900
bif_type(float, _, _) -> {float,[]};
 
901
bif_type('/', _, _) -> {float,[]};
 
902
%% Integer operations.
 
903
bif_type('div', [_,_], _) -> {integer,[]};
 
904
bif_type('rem', [_,_], _) -> {integer,[]};
 
905
bif_type(length, [_], _) -> {integer,[]};
 
906
bif_type(size, [_], _) -> {integer,[]};
 
907
bif_type(trunc, [_], _) -> {integer,[]};
 
908
bif_type(round, [_], _) -> {integer,[]};
 
909
bif_type('band', [_,_], _) -> {integer,[]};
 
910
bif_type('bor', [_,_], _) -> {integer,[]};
 
911
bif_type('bxor', [_,_], _) -> {integer,[]};
 
912
bif_type('bnot', [_], _) -> {integer,[]};
 
913
bif_type('bsl', [_,_], _) -> {integer,[]};
 
914
bif_type('bsr', [_,_], _) -> {integer,[]};
 
915
%% Booleans.
 
916
bif_type('==', [_,_], _) -> bool;
 
917
bif_type('/=', [_,_], _) -> bool;
 
918
bif_type('=<', [_,_], _) -> bool;
 
919
bif_type('<', [_,_], _) -> bool;
 
920
bif_type('>=', [_,_], _) -> bool;
 
921
bif_type('>', [_,_], _) -> bool;
 
922
bif_type('=:=', [_,_], _) -> bool;
 
923
bif_type('=/=', [_,_], _) -> bool;
 
924
bif_type('not', [_], _) -> bool;
 
925
bif_type('and', [_,_], _) -> bool;
 
926
bif_type('or', [_,_], _) -> bool;
 
927
bif_type('xor', [_,_], _) -> bool;
 
928
bif_type(is_atom, [_], _) -> bool;
 
929
bif_type(is_boolean, [_], _) -> bool;
 
930
bif_type(is_binary, [_], _) -> bool;
 
931
bif_type(is_constant, [_], _) -> bool;
 
932
bif_type(is_float, [_], _) -> bool;
 
933
bif_type(is_function, [_], _) -> bool;
 
934
bif_type(is_integer, [_], _) -> bool;
 
935
bif_type(is_list, [_], _) -> bool;
 
936
bif_type(is_number, [_], _) -> bool;
 
937
bif_type(is_pid, [_], _) -> bool;
 
938
bif_type(is_port, [_], _) -> bool;
 
939
bif_type(is_reference, [_], _) -> bool;
 
940
bif_type(is_tuple, [_], _) -> bool;
 
941
%% Misc.
 
942
bif_type(node, [], _) -> {atom,[]};
 
943
bif_type(node, [_], _) -> {atom,[]};
 
944
bif_type(hd, [_], _) -> term;
 
945
bif_type(tl, [_], _) -> term;
 
946
bif_type(get, [_], _) -> term;
 
947
bif_type(raise, [_,_], _) -> exception;
 
948
bif_type(_, _, _) -> term.
 
949
 
 
950
arith_type([A,B], Vst) ->
 
951
    case {get_type(A, Vst),get_type(B, Vst)} of
 
952
        {{float,_},_} -> {float,[]};
 
953
        {_,{float,_}} -> {float,[]};
 
954
        {_,_} -> number
 
955
    end;
 
956
arith_type(_, _) -> number.
 
957
 
 
958
return_type({extfunc,M,F,A}, Vst) ->
 
959
    return_type_1(M, F, A, Vst).
 
960
 
 
961
return_type_1(erlang, setelement, 3, Vst) ->
 
962
    Tuple = {x,1},
 
963
    TupleType =
 
964
        case get_type(Tuple, Vst) of
 
965
            {tuple,_}=TT -> TT;
 
966
            _ -> {tuple,[0]}
 
967
        end,
 
968
    case get_type({x,0}, Vst) of
 
969
        {integer,[]} -> TupleType;
 
970
        {integer,I} -> upgrade_type({tuple,[I]}, TupleType);
 
971
        _ -> TupleType
 
972
    end;
 
973
return_type_1(erlang, F, A, _) ->
 
974
    return_type_erl(F, A);
 
975
return_type_1(math, F, A, _) ->
 
976
    return_type_math(F, A);
 
977
return_type_1(_, _, _, _) -> term.
 
978
 
 
979
return_type_erl(exit, 1) -> exception;
 
980
return_type_erl(throw, 1) -> exception;
 
981
return_type_erl(fault, 1) -> exception;
 
982
return_type_erl(fault, 2) -> exception;
 
983
return_type_erl(error, 1) -> exception;
 
984
return_type_erl(error, 2) -> exception;
 
985
return_type_erl(_, _) -> term.
 
986
 
 
987
return_type_math(cos, 1) -> {float,[]};
 
988
return_type_math(cosh, 1) -> {float,[]};
 
989
return_type_math(sin, 1) -> {float,[]};
 
990
return_type_math(sinh, 1) -> {float,[]};
 
991
return_type_math(tan, 1) -> {float,[]};
 
992
return_type_math(tanh, 1) -> {float,[]};
 
993
return_type_math(acos, 1) -> {float,[]};
 
994
return_type_math(acosh, 1) -> {float,[]};
 
995
return_type_math(asin, 1) -> {float,[]};
 
996
return_type_math(asinh, 1) -> {float,[]};
 
997
return_type_math(atan, 1) -> {float,[]};
 
998
return_type_math(atanh, 1) -> {float,[]};
 
999
return_type_math(erf, 1) -> {float,[]};
 
1000
return_type_math(erfc, 1) -> {float,[]};
 
1001
return_type_math(exp, 1) -> {float,[]};
 
1002
return_type_math(log, 1) -> {float,[]};
 
1003
return_type_math(log10, 1) -> {float,[]};
 
1004
return_type_math(sqrt, 1) -> {float,[]};
 
1005
return_type_math(atan2, 2) -> {float,[]};
 
1006
return_type_math(pow, 2) -> {float,[]};
 
1007
return_type_math(pi, 0) -> {float,[]};
 
1008
return_type_math(_, _) -> term.
 
1009
 
 
1010
min(A, B) when is_integer(A), is_integer(B), A < B -> A;
 
1011
min(A, B) when is_integer(A), is_integer(B) -> B.
 
1012
 
 
1013
max(A, B) when is_integer(A), is_integer(B), A > B -> A;
 
1014
max(A, B) when is_integer(A), is_integer(B) -> B.
 
1015
 
 
1016
gb_trees_from_list(L) -> gb_trees:from_orddict(orddict:from_list(L)).
 
1017
 
 
1018
-ifdef(DEBUG).
 
1019
error(Error) -> exit(Error).
 
1020
-else.
 
1021
error(Error) -> throw(Error).
 
1022
-endif.