~ubuntu-branches/debian/squeeze/erlang/squeeze

« back to all changes in this revision

Viewing changes to lib/compiler/src/beam_validator.erl

  • Committer: Bazaar Package Importer
  • Author(s): Erlang Packagers, Sergei Golovan
  • Date: 2006-12-03 17:07:44 UTC
  • mfrom: (2.1.11 feisty)
  • Revision ID: james.westby@ubuntu.com-20061203170744-rghjwupacqlzs6kv
Tags: 1:11.b.2-4
[ Sergei Golovan ]
Fixed erlang-base and erlang-base-hipe prerm scripts.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
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$
 
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,foreach/2,member/2]).
 
26
 
 
27
-define(MAXREG, 1024).
 
28
 
 
29
%%-define(DEBUG, 1).
 
30
-ifdef(DEBUG).
 
31
-define(DBG_FORMAT(F, D), (io:format((F), (D)))).
 
32
-else.
 
33
-define(DBG_FORMAT(F, D), ok).
 
34
-endif.
 
35
 
 
36
%%%
 
37
%%% API functions.
 
38
%%%
 
39
 
 
40
files([F|Fs]) ->
 
41
    ?DBG_FORMAT("# Verifying: ~p~n", [F]),
 
42
    case file(F) of
 
43
        ok -> ok;
 
44
        {error,Es} -> 
 
45
            io:format("~p:~n~s~n", [F,format_error(Es)])
 
46
    end,
 
47
    files(Fs);
 
48
files([]) -> ok.
 
49
 
 
50
file(Name) when is_list(Name) ->
 
51
    case case filename:extension(Name) of
 
52
             ".S" -> s_file(Name);
 
53
             ".beam" -> beam_file(Name)
 
54
         end of
 
55
        [] -> ok;
 
56
        Es -> {error,Es}
 
57
    end.
 
58
 
 
59
%% To be called by the compiler.
 
60
module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts)
 
61
  when is_atom(Mod), is_list(Exp), is_list(Attr), is_integer(Lc) ->
 
62
    case validate(Mod, Fs) of
 
63
        [] -> {ok,Code};
 
64
        Es0 ->
 
65
            Es = [{?MODULE,E} || E <- Es0],
 
66
            {error,[{atom_to_list(Mod),Es}]}
 
67
    end.
 
68
 
 
69
format_error([]) -> [];
 
70
format_error([{{M,F,A},{I,Off,Desc}}|Es]) ->
 
71
    [io_lib:format("  ~p:~p/~p+~p:~n    ~p - ~p~n", 
 
72
                   [M,F,A,Off,I,Desc])|format_error(Es)];
 
73
format_error([Error|Es]) ->
 
74
    [format_error(Error)|format_error(Es)];
 
75
format_error({{_M,F,A},{I,Off,limit}}) ->
 
76
    io_lib:format(
 
77
      "function ~p/~p+~p:~n"
 
78
      "  An implementation limit was reached.~n"
 
79
      "  Try reducing the complexity of this function.~n~n"
 
80
      "  Instruction: ~p~n", [F,A,Off,I]);
 
81
format_error({{_M,F,A},{undef_labels,Lbls}}) ->
 
82
    io_lib:format(
 
83
      "function ~p/~p:~n"
 
84
      "  Internal consistency check failed - please report this bug.~n"
 
85
      "  The following label(s) were referenced but not defined:~n", [F,A]) ++
 
86
        "  " ++ [[integer_to_list(L)," "] || L <- Lbls] ++ "\n";
 
87
format_error({{_M,F,A},{I,Off,Desc}}) ->
 
88
    io_lib:format(
 
89
      "function ~p/~p+~p:~n"
 
90
      "  Internal consistency check failed - please report this bug.~n"
 
91
      "  Instruction: ~p~n"
 
92
      "  Error:       ~p:~n", [F,A,Off,I,Desc]);
 
93
format_error({Module,Error}) ->
 
94
    [Module:format_error(Error)];
 
95
format_error(Error) ->
 
96
    io_lib:format("~p~n", [Error]).
 
97
 
 
98
%%%
 
99
%%% Local functions follow.
 
100
%%% 
 
101
 
 
102
s_file(Name) ->
 
103
    {ok,Is} = file:consult(Name),
 
104
    {value,{module,Module}} = lists:keysearch(module, 1, Is),
 
105
    Fs = find_functions(Is),
 
106
    validate(Module, Fs).
 
107
 
 
108
find_functions(Fs) ->
 
109
    find_functions_1(Fs, none, [], []).
 
110
 
 
111
find_functions_1([{function,Name,Arity,Entry}|Is], Func, FuncAcc, Acc0) ->
 
112
    Acc = add_func(Func, FuncAcc, Acc0),
 
113
    find_functions_1(Is, {Name,Arity,Entry}, [], Acc);
 
114
find_functions_1([I|Is], Func, FuncAcc, Acc) ->
 
115
    find_functions_1(Is, Func, [I|FuncAcc], Acc);
 
116
find_functions_1([], Func, FuncAcc, Acc) ->
 
117
    reverse(add_func(Func, FuncAcc, Acc)).
 
118
 
 
119
add_func(none, _, Acc) -> Acc;
 
120
add_func({Name,Arity,Entry}, Is, Acc) ->
 
121
    [{function,Name,Arity,Entry,reverse(Is)}|Acc].
 
122
 
 
123
beam_file(Name) ->
 
124
    try beam_disasm:file(Name) of
 
125
        {error,beam_lib,Reason} -> [{beam_lib,Reason}];
 
126
        {beam_file,L} ->
 
127
            {value,{module,Module}} = lists:keysearch(module, 1, L),
 
128
            {value,{code,Code}} = lists:keysearch(code, 1, L),
 
129
            validate(Module, Code)
 
130
    catch _:_ -> [disassembly_failed]
 
131
    end.
 
132
 
 
133
%%%
 
134
%%% The validator follows.
 
135
%%%
 
136
%%% The purpose of the validator is find errors in the generated code
 
137
%%% that may cause the emulator to crash or behave strangely.
 
138
%%% We don't care about type errors in the user's code that will
 
139
%%% cause a proper exception at run-time.
 
140
%%%
 
141
 
 
142
%%% Things currently not checked. XXX
 
143
%%%
 
144
%%% - Heap allocation for binaries.
 
145
%%% - That put_tuple is followed by the correct number of
 
146
%%%   put instructions.
 
147
%%%
 
148
 
 
149
%% validate([Function]) -> [] | [Error]
 
150
%%  A list of functions with their code. The code is in the same
 
151
%%  format as used in the compiler and in .S files.
 
152
validate(_Module, []) -> [];
 
153
validate(Module, [{function,Name,Ar,Entry,Code}|Fs]) ->
 
154
    try validate_1(Code, Name, Ar, Entry) of
 
155
        _ -> validate(Module, Fs)
 
156
    catch
 
157
        Error ->
 
158
            [Error|validate(Module, Fs)];
 
159
          error:Error ->
 
160
            [validate_error(Error, Module, Name, Ar)|validate(Module, Fs)]
 
161
    end.
 
162
 
 
163
-ifdef(DEBUG).
 
164
validate_error(Error, Module, Name, Ar) ->
 
165
    exit(validate_error_1(Error, Module, Name, Ar)).
 
166
-else.
 
167
validate_error(Error, Module, Name, Ar) ->
 
168
    validate_error_1(Error, Module, Name, Ar).
 
169
-endif.
 
170
validate_error_1(Error, Module, Name, Ar) ->
 
171
    {{Module,Name,Ar},
 
172
     {internal_error,'_',{Error,erlang:get_stacktrace()}}}.
 
173
 
 
174
-record(st,                             %Emulation state
 
175
        {x=init_regs(0, term),          %x register info.
 
176
         y=init_regs(0, initialized),   %y register info.
 
177
         f=init_fregs(),                %
 
178
         numy=none,                     %Number of y registers.
 
179
         h=0,                           %Available heap size.
 
180
         hf=0,                          %Available heap size for floats.
 
181
         fls=undefined,                 %Floating point state.
 
182
         ct=[],                         %List of hot catch/try labels
 
183
         bsm=undefined,                 %Bit syntax matching state.
 
184
         bits=undefined,                %Number of bits in bit syntax binary.
 
185
         setelem=false                  %Previous instruction was setelement/3.
 
186
        }).
 
187
 
 
188
-record(vst,                            %Validator state
 
189
        {current=none,                  %Current state
 
190
         branched=gb_trees:empty(),     %States at jumps
 
191
         labels=gb_sets:empty()
 
192
        }).
 
193
 
 
194
-ifdef(DEBUG).
 
195
print_st(#st{x=Xs,y=Ys,numy=NumY,h=H,ct=Ct}) ->
 
196
    io:format("  #st{x=~p~n"
 
197
              "      y=~p~n"
 
198
              "      numy=~p,h=~p,ct=~w~n",
 
199
              [gb_trees:to_list(Xs),gb_trees:to_list(Ys),NumY,H,Ct]).
 
200
-endif.
 
201
 
 
202
validate_1(Is, Name, Arity, Entry) ->
 
203
    validate_2(labels(Is), Name, Arity, Entry).
 
204
 
 
205
validate_2({Ls1,[{func_info,{atom,Mod},{atom,Name},Arity}=_F|Is]},
 
206
           Name, Arity, Entry) ->
 
207
    lists:foreach(fun (_L) -> ?DBG_FORMAT("  ~p.~n", [{label,_L}]) end, Ls1),
 
208
    ?DBG_FORMAT("  ~p.~n", [_F]),
 
209
    validate_3(labels(Is), Name, Arity, Entry, Mod, Ls1);
 
210
validate_2({Ls1,Is}, Name, Arity, _Entry) ->
 
211
    error({{'_',Name,Arity},{first(Is),length(Ls1),illegal_instruction}}).
 
212
 
 
213
validate_3({Ls2,Is}, Name, Arity, Entry, Mod, Ls1) ->
 
214
    lists:foreach(fun (_L) -> ?DBG_FORMAT("  ~p.~n", [{label,_L}]) end, Ls2),
 
215
    Offset = 1 + length(Ls1) + 1 + length(Ls2),
 
216
    EntryOK = (Entry == undefined) orelse lists:member(Entry, Ls2),
 
217
    if  EntryOK ->
 
218
            St = init_state(Arity),
 
219
            Vst = #vst{current=St,
 
220
                       branched=gb_trees_from_list([{L,St} || L <- Ls1]),
 
221
                       labels=gb_sets:from_list(Ls1++Ls2)},
 
222
            valfun(Is, {Mod,Name,Arity}, Offset, Vst);
 
223
        true ->
 
224
            error({{Mod,Name,Arity},{first(Is),Offset,no_entry_label}})
 
225
    end.
 
226
 
 
227
first([X|_]) -> X;
 
228
first([]) -> [].
 
229
 
 
230
labels(Is) ->
 
231
    labels_1(Is, []).
 
232
 
 
233
labels_1([{label,L}|Is], R) ->
 
234
    labels_1(Is, [L|R]);
 
235
labels_1(Is, R) ->
 
236
    {lists:reverse(R),Is}.
 
237
 
 
238
init_state(Arity) ->
 
239
    Xs = init_regs(Arity, term),
 
240
    Ys = init_regs(0, initialized),
 
241
    #st{x=Xs,y=Ys,numy=none,h=0,hf=0,ct=[]}.
 
242
 
 
243
init_regs(0, _) ->
 
244
    gb_trees:empty();
 
245
init_regs(N, Type) ->
 
246
    gb_trees_from_list([{R,Type} || R <- lists:seq(0, N-1)]).
 
247
 
 
248
valfun([], MFA, _Offset, #vst{branched=Targets0,labels=Labels0}=Vst) ->
 
249
    Targets = gb_trees:keys(Targets0),
 
250
    Labels = gb_sets:to_list(Labels0),
 
251
    case Targets -- Labels of
 
252
        [] -> Vst;
 
253
        Undef ->
 
254
            Error = {undef_labels,Undef},
 
255
            error({MFA,Error})
 
256
    end;
 
257
valfun([I|Is], MFA, Offset, Vst0) ->
 
258
    ?DBG_FORMAT("    ~p.\n", [I]),
 
259
    valfun(Is, MFA, Offset+1,
 
260
           try
 
261
               Vst = val_dsetel(I, Vst0),
 
262
               valfun_1(I, Vst)
 
263
           catch Error ->
 
264
                   error({MFA,{I,Offset,Error}})
 
265
           end).
 
266
 
 
267
%% Instructions that are allowed in dead code or when failing,
 
268
%% that is while the state is undecided in some way.
 
269
valfun_1({label,Lbl}, #vst{current=St0,branched=B,labels=Lbls}=Vst) ->
 
270
    St = merge_states(Lbl, St0, B),
 
271
    Vst#vst{current=St,branched=gb_trees:enter(Lbl, St, B),
 
272
            labels=gb_sets:add(Lbl, Lbls)};
 
273
valfun_1(_I, #vst{current=none}=Vst) ->
 
274
    %% Ignore instructions after erlang:error/1,2, which
 
275
    %% the original R10B compiler thought would return.
 
276
    ?DBG_FORMAT("Ignoring ~p\n", [_I]),
 
277
    Vst;
 
278
valfun_1({badmatch,Src}, Vst) ->
 
279
    assert_term(Src, Vst),
 
280
    kill_state(Vst);
 
281
valfun_1({case_end,Src}, Vst) ->
 
282
    assert_term(Src, Vst),
 
283
    kill_state(Vst);
 
284
valfun_1(if_end, Vst) ->
 
285
    kill_state(Vst);
 
286
valfun_1({try_case_end,Src}, Vst) ->
 
287
    assert_term(Src, Vst),
 
288
    kill_state(Vst);
 
289
%% Instructions that can not cause exceptions
 
290
valfun_1({move,Src,Dst}, Vst) ->
 
291
    Type = get_term_type(Src, Vst),
 
292
    set_type_reg(Type, Dst, Vst);
 
293
valfun_1({fmove,Src,{fr,_}=Dst}, Vst) ->
 
294
    assert_type(float, Src, Vst),
 
295
    set_freg(Dst, Vst);
 
296
valfun_1({fmove,{fr,_}=Src,Dst}, Vst0) ->
 
297
    assert_freg_set(Src, Vst0),
 
298
    assert_fls(checked, Vst0),
 
299
    Vst = eat_heap_float(Vst0),
 
300
    set_type_reg({float,[]}, Dst, Vst);
 
301
valfun_1({kill,{y,_}=Reg}, Vst) ->
 
302
    set_type_y(initialized, Reg, Vst);
 
303
valfun_1({init,{y,_}=Reg}, Vst) ->
 
304
    set_type_y(initialized, Reg, Vst);
 
305
valfun_1({test_heap,Heap,Live}, Vst) ->
 
306
    test_heap(Heap, Live, Vst);
 
307
valfun_1({bif,_Op,nofail,Src,Dst}, Vst) ->
 
308
    validate_src(Src, Vst),
 
309
    set_type_reg(term, Dst, Vst);
 
310
%% Put instructions.
 
311
valfun_1({put_list,A,B,Dst}, Vst0) ->
 
312
    assert_term(A, Vst0),
 
313
    assert_term(B, Vst0),
 
314
    Vst = eat_heap(2, Vst0),
 
315
    set_type_reg(cons, Dst, Vst);
 
316
valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) ->
 
317
    Vst = eat_heap(1, Vst0),
 
318
    set_type_reg({tuple,Sz}, Dst, Vst);
 
319
valfun_1({put,Src}, Vst) ->
 
320
    assert_term(Src, Vst),
 
321
    eat_heap(1, Vst);
 
322
valfun_1({put_string,Sz,_,Dst}, Vst0) when is_integer(Sz) ->
 
323
    Vst = eat_heap(2*Sz, Vst0),
 
324
    set_type_reg(cons, Dst, Vst);
 
325
%% Misc.
 
326
valfun_1({'%live',Live}, Vst) ->
 
327
    verify_live(Live, Vst),
 
328
    Vst;
 
329
%% Exception generating calls
 
330
valfun_1({call_ext,Live,Func}=I, Vst) ->
 
331
    case return_type(Func, Vst) of
 
332
        exception ->
 
333
            verify_live(Live, Vst),
 
334
            kill_state(Vst);
 
335
        _ ->
 
336
            valfun_2(I, Vst)
 
337
    end;
 
338
valfun_1(_I, #vst{current=#st{ct=undecided}}) ->
 
339
    error(unknown_catch_try_state);
 
340
%%
 
341
%% Allocate and deallocate, et.al
 
342
valfun_1({allocate,Stk,Live}, Vst) ->
 
343
    allocate(false, Stk, 0, Live, Vst);
 
344
valfun_1({allocate_heap,Stk,Heap,Live}, Vst) ->
 
345
    allocate(false, Stk, Heap, Live, Vst);
 
346
valfun_1({allocate_zero,Stk,Live}, Vst) ->
 
347
    allocate(true, Stk, 0, Live, Vst);
 
348
valfun_1({allocate_heap_zero,Stk,Heap,Live}, Vst) ->
 
349
    allocate(true, Stk, Heap, Live, Vst);
 
350
valfun_1({deallocate,StkSize}, #vst{current=#st{numy=StkSize}}=Vst) ->
 
351
    verify_no_ct(Vst),
 
352
    deallocate(Vst);
 
353
valfun_1({deallocate,_}, #vst{current=#st{numy=NumY}}) ->
 
354
    error({allocated,NumY});
 
355
%% Catch & try.
 
356
valfun_1({'catch',Dst,{f,Fail}}, Vst0) when Fail /= none ->
 
357
    Vst = #vst{current=#st{ct=Fails}=St} = 
 
358
        set_type_y({catchtag,[Fail]}, Dst, Vst0),
 
359
    Vst#vst{current=St#st{ct=[[Fail]|Fails]}};
 
360
valfun_1({'try',Dst,{f,Fail}}, Vst0) ->
 
361
    Vst = #vst{current=#st{ct=Fails}=St} = 
 
362
        set_type_y({trytag,[Fail]}, Dst, Vst0),
 
363
    Vst#vst{current=St#st{ct=[[Fail]|Fails]}};
 
364
valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St0}=Vst0) ->
 
365
    case get_special_y_type(Reg, Vst0) of
 
366
        {catchtag,Fail} ->
 
367
            Vst = #vst{current=St} = 
 
368
                set_type_y(initialized_ct, Reg, 
 
369
                           Vst0#vst{current=St0#st{ct=Fails}}),
 
370
            Xs = gb_trees_from_list([{0,term}]),
 
371
            Vst#vst{current=St#st{x=Xs,fls=undefined}};
 
372
        Type ->
 
373
            error({bad_type,Type})
 
374
    end;
 
375
valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St}=Vst0) ->
 
376
    case get_special_y_type(Reg, Vst0) of
 
377
        {trytag,Fail} ->
 
378
            Vst = case Fail of
 
379
                      [FailLabel] -> branch_state(FailLabel, Vst0);
 
380
                      _ -> Vst0
 
381
                  end,
 
382
            set_type_reg(initialized_ct, Reg, 
 
383
                         Vst#vst{current=St#st{ct=Fails,fls=undefined}});
 
384
        Type ->
 
385
            error({bad_type,Type})
 
386
    end;
 
387
valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St0}=Vst0) ->
 
388
    case get_special_y_type(Reg, Vst0) of
 
389
        {trytag,Fail} ->
 
390
            Vst = #vst{current=St} = 
 
391
                set_type_y(initialized_ct, Reg, 
 
392
                           Vst0#vst{current=St0#st{ct=Fails}}),
 
393
            Xs = gb_trees_from_list([{0,{atom,[]}},{1,term},{2,term}]), %XXX
 
394
            Vst#vst{current=St#st{x=Xs,fls=undefined}};
 
395
        Type ->
 
396
            error({bad_type,Type})
 
397
    end;
 
398
valfun_1(I, Vst) ->
 
399
    valfun_2(I, Vst).
 
400
 
 
401
%% Update branched state if necessary and try next set of instructions.
 
402
valfun_2(I, #vst{current=#st{ct=[]}}=Vst) ->
 
403
    valfun_3(I, Vst);
 
404
valfun_2(I, #vst{current=#st{ct=[[Fail]|_]}}=Vst) when is_integer(Fail) ->
 
405
    %% Update branched state
 
406
    valfun_3(I, branch_state(Fail, Vst));
 
407
valfun_2(_, _) ->
 
408
    error(ambigous_catch_try_state).
 
409
 
 
410
%% Handle the remaining floating point instructions here.
 
411
%% Floating point.
 
412
valfun_3({arithfbif,Op,F,Src,Dst}, Vst) ->
 
413
    valfun_3({bif,Op,F,Src,Dst}, Vst);
 
414
valfun_3({fconv,Src,{fr,_}=Dst}, Vst) ->
 
415
    assert_term(Src, Vst),
 
416
    set_freg(Dst, Vst);
 
417
valfun_3({bif,fadd,_,[_,_]=Src,Dst}, Vst) ->
 
418
    float_op(Src, Dst, Vst);
 
419
valfun_3({bif,fdiv,_,[_,_]=Src,Dst}, Vst) ->
 
420
    float_op(Src, Dst, Vst);
 
421
valfun_3({bif,fmul,_,[_,_]=Src,Dst}, Vst) ->
 
422
    float_op(Src, Dst, Vst);
 
423
valfun_3({bif,fnegate,_,[_]=Src,Dst}, Vst) ->
 
424
    float_op(Src, Dst, Vst);
 
425
valfun_3({bif,fsub,_,[_,_]=Src,Dst}, Vst) ->
 
426
    float_op(Src, Dst, Vst);
 
427
valfun_3(fclearerror, Vst) ->
 
428
    case get_fls(Vst) of
 
429
        undefined -> ok;
 
430
        checked -> ok;
 
431
        Fls -> error({bad_floating_point_state,Fls})
 
432
    end,
 
433
    set_fls(cleared, Vst);
 
434
valfun_3({fcheckerror,_}, Vst) ->
 
435
    assert_fls(cleared, Vst),
 
436
    set_fls(checked, Vst);
 
437
valfun_3(I, Vst) ->
 
438
    %% The instruction is not a float instruction.
 
439
    case get_fls(Vst) of
 
440
        undefined ->
 
441
            valfun_4(I, Vst);
 
442
        checked ->
 
443
            valfun_4(I, Vst);
 
444
        Fls ->
 
445
            error({unsafe_instruction,{float_error_state,Fls}})
 
446
    end.
 
447
 
 
448
%% Instructions that can cause exceptions.
 
449
valfun_4({apply,Live}, Vst) ->
 
450
    call(Live+2, Vst);
 
451
valfun_4({apply_last,Live,_}, Vst) ->
 
452
    tail_call(Live+2, Vst);
 
453
valfun_4({call_fun,Live}, Vst) ->
 
454
    call(Live, Vst);
 
455
valfun_4({call,Live,_}, Vst) ->
 
456
    call(Live, Vst);
 
457
valfun_4({call_ext,Live,Func}, Vst) ->
 
458
    %% Exception BIFs has alread been taken care of above.
 
459
    call(Func, Live, Vst);
 
460
valfun_4({call_only,Live,_}, Vst) ->
 
461
    tail_call(Live, Vst);
 
462
valfun_4({call_ext_only,Live,_}, Vst) ->
 
463
    tail_call(Live, Vst);
 
464
valfun_4({call_last,Live,_,StkSize}, #vst{current=#st{numy=StkSize}}=Vst) ->
 
465
    tail_call(Live, Vst);
 
466
valfun_4({call_last,_,_,_}, #vst{current=#st{numy=NumY}}) ->
 
467
    error({allocated,NumY});
 
468
valfun_4({call_ext_last,Live,_,StkSize}, 
 
469
         #vst{current=#st{numy=StkSize}}=Vst) ->
 
470
    tail_call(Live, Vst);
 
471
valfun_4({call_ext_last,_,_,_}, #vst{current=#st{numy=NumY}}) ->
 
472
    error({allocated,NumY});
 
473
valfun_4({make_fun,_,_,Live}, Vst) ->
 
474
    call(Live, Vst);
 
475
valfun_4({make_fun2,_,_,_,Live}, Vst) ->
 
476
    call(Live, Vst);
 
477
%% Other BIFs
 
478
valfun_4({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) ->
 
479
    TupleType0 = get_term_type(Tuple, Vst0),
 
480
    PosType = get_term_type(Pos, Vst0),
 
481
    Vst1 = branch_state(Fail, Vst0),
 
482
    TupleType = upgrade_tuple_type({tuple,[get_tuple_size(PosType)]}, TupleType0),
 
483
    Vst = set_type(TupleType, Tuple, Vst1),
 
484
    set_type_reg(term, Dst, Vst);
 
485
valfun_4({arithbif,Op,F,Src,Dst}, Vst) ->
 
486
    valfun_4({bif,Op,F,Src,Dst}, Vst);
 
487
valfun_4({raise,{f,_}=Fail,Src,Dst}, Vst) ->
 
488
    valfun_4({bif,raise,Fail,Src,Dst}, Vst);
 
489
valfun_4({bif,Op,{f,Fail},Src,Dst}, Vst0) ->
 
490
    validate_src(Src, Vst0),
 
491
    Vst = branch_state(Fail, Vst0),
 
492
    Type = bif_type(Op, Src, Vst),
 
493
    set_type_reg(Type, Dst, Vst);
 
494
valfun_4({gc_bif,Op,{f,Fail},Live,Src,Dst}, #vst{current=St0}=Vst0) ->
 
495
    St = St0#st{h=0,hf=0},
 
496
    Vst1 = Vst0#vst{current=St},
 
497
    verify_live(Live, Vst1),
 
498
    Vst2 = prune_x_regs(Live, Vst1),
 
499
    validate_src(Src, Vst2),
 
500
    Vst = branch_state(Fail, Vst2),
 
501
    Type = bif_type(Op, Src, Vst),
 
502
    set_type_reg(Type, Dst, Vst);
 
503
valfun_4(return, #vst{current=#st{numy=none}}=Vst) ->
 
504
    kill_state(Vst);
 
505
valfun_4(return, #vst{current=#st{numy=NumY}}) ->
 
506
    error({stack_frame,NumY});
 
507
valfun_4({jump,{f,_}}, #vst{current=none}=Vst) ->
 
508
    %% Must be an unreachable jump which was not optimized away.
 
509
    %% Do nothing.
 
510
    Vst;
 
511
valfun_4({jump,{f,Lbl}}, Vst) ->
 
512
    kill_state(branch_state(Lbl, Vst));
 
513
valfun_4({loop_rec,{f,Fail},Dst}, Vst0) ->
 
514
    Vst = branch_state(Fail, Vst0),
 
515
    set_type_reg(term, Dst, Vst);
 
516
valfun_4(remove_message, Vst) ->
 
517
    Vst;
 
518
valfun_4({wait,_}, Vst) ->
 
519
    kill_state(Vst);
 
520
valfun_4({wait_timeout,_,Src}, Vst) ->
 
521
    assert_term(Src, Vst);
 
522
valfun_4({loop_rec_end,_}, Vst) ->
 
523
    kill_state(Vst);
 
524
valfun_4(timeout, #vst{current=St}=Vst) ->
 
525
    Vst#vst{current=St#st{x=init_regs(0, term)}};
 
526
valfun_4(send, Vst) ->
 
527
    call(2, Vst);
 
528
valfun_4({set_tuple_element,Src,Tuple,I}, Vst) ->
 
529
    assert_term(Src, Vst),
 
530
    assert_type({tuple_element,I+1}, Tuple, Vst);
 
531
%% Match instructions.
 
532
valfun_4({select_val,Src,{f,Fail},{list,Choices}}, Vst) ->
 
533
    assert_term(Src, Vst),
 
534
    Lbls = [L || {f,L} <- Choices]++[Fail],
 
535
    kill_state(foldl(fun(L, S) -> branch_state(L, S) end, Vst, Lbls));
 
536
valfun_4({select_tuple_arity,Tuple,{f,Fail},{list,Choices}}, Vst) ->
 
537
    assert_type(tuple, Tuple, Vst),
 
538
    kill_state(branch_arities(Choices, Tuple, branch_state(Fail, Vst)));
 
539
valfun_4({get_list,Src,D1,D2}, Vst0) ->
 
540
    assert_type(cons, Src, Vst0),
 
541
    Vst = set_type_reg(term, D1, Vst0),
 
542
    set_type_reg(term, D2, Vst);
 
543
valfun_4({get_tuple_element,Src,I,Dst}, Vst) ->
 
544
    assert_type({tuple_element,I+1}, Src, Vst),
 
545
    set_type_reg(term, Dst, Vst);
 
546
 
 
547
%% New bit syntax matching instructions.
 
548
valfun_4({test,bs_start_match2,{f,Fail},[Src,Live,Slots,Dst]}, Vst0) ->
 
549
    assert_term(Src, Vst0),
 
550
    verify_live(Live, Vst0),
 
551
    Vst1 = prune_x_regs(Live, Vst0),
 
552
    Vst = branch_state(Fail, Vst1),
 
553
    set_type_reg(bsm_match_state(Slots), Dst, Vst);
 
554
valfun_4({test,_Test,{f,Fail},[Ctx,Live,_,_,_,Dst]}, Vst0) ->
 
555
    bsm_validate_context(Ctx, Vst0),
 
556
    verify_live(Live, Vst0),
 
557
    Vst1 = prune_x_regs(Live, Vst0),
 
558
    Vst = branch_state(Fail, Vst1),
 
559
    set_type_reg(term, Dst, Vst);
 
560
valfun_4({test,bs_skip_bits2,{f,Fail},[Ctx,Src,_,_]}, Vst) ->
 
561
    bsm_validate_context(Ctx, Vst),
 
562
    assert_term(Src, Vst),
 
563
    branch_state(Fail, Vst);
 
564
valfun_4({test,bs_test_tail2,{f,Fail},[Ctx,_]}, Vst) ->
 
565
    bsm_validate_context(Ctx, Vst),
 
566
    branch_state(Fail, Vst);
 
567
valfun_4({bs_save2,Ctx,SavePoint}, Vst) ->
 
568
    bsm_save(Ctx, SavePoint, Vst);
 
569
valfun_4({bs_restore2,Ctx,SavePoint}, Vst) ->
 
570
    bsm_restore(Ctx, SavePoint, Vst);
 
571
 
 
572
%% Bit syntax instructions.
 
573
valfun_4({bs_start_match,{f,Fail},Src}, Vst) ->
 
574
    valfun_4({test,bs_start_match,{f,Fail},[Src]}, Vst);
 
575
valfun_4({test,bs_start_match,{f,Fail},[Src]}, Vst) ->
 
576
    assert_term(Src, Vst),
 
577
    bs_start_match(branch_state(Fail, Vst));
 
578
 
 
579
valfun_4({bs_save,SavePoint}, Vst) ->
 
580
    bs_assert_state(Vst),
 
581
    bs_save(SavePoint, Vst);
 
582
valfun_4({bs_restore,SavePoint}, Vst) ->
 
583
    bs_assert_state(Vst),
 
584
    bs_assert_savepoint(SavePoint, Vst),
 
585
    Vst;
 
586
valfun_4({test,bs_skip_bits,{f,Fail},[Src,_,_]}, Vst) ->
 
587
    bs_assert_state(Vst),
 
588
    assert_term(Src, Vst),
 
589
    branch_state(Fail, Vst);
 
590
valfun_4({test,bs_test_tail,{f,Fail},_}, Vst) ->
 
591
    bs_assert_state(Vst),
 
592
    branch_state(Fail, Vst);
 
593
valfun_4({test,_,{f,Fail},[_,_,_,Dst]}, Vst0) ->
 
594
    bs_assert_state(Vst0),
 
595
    Vst = branch_state(Fail, Vst0),
 
596
    set_type_reg({integer,[]}, Dst, Vst);
 
597
 
 
598
%% Other test instructions.
 
599
valfun_4({test,is_float,{f,Lbl},[Float]}, Vst) ->
 
600
    assert_term(Float, Vst),
 
601
    set_type({float,[]}, Float, branch_state(Lbl, Vst));
 
602
valfun_4({test,is_tuple,{f,Lbl},[Tuple]}, Vst) ->
 
603
    Type0 = get_term_type(Tuple, Vst),
 
604
    Type = upgrade_tuple_type({tuple,[0]}, Type0),
 
605
    set_type(Type, Tuple, branch_state(Lbl, Vst));
 
606
valfun_4({test,is_nonempty_list,{f,Lbl},[Cons]}, Vst) ->
 
607
    assert_term(Cons, Vst),
 
608
    set_type(cons, Cons, branch_state(Lbl, Vst));
 
609
valfun_4({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) ->
 
610
    assert_type(tuple, Tuple, Vst),
 
611
    set_type_reg({tuple,Sz}, Tuple, branch_state(Lbl, Vst));
 
612
valfun_4({test,_Op,{f,Lbl},Src}, Vst) ->
 
613
    validate_src(Src, Vst),
 
614
    branch_state(Lbl, Vst);
 
615
valfun_4({bs_add,{f,Fail},[A,B,_],Dst}, Vst) ->
 
616
    assert_term(A, Vst),
 
617
    assert_term(B, Vst),
 
618
    set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst));
 
619
valfun_4({bs_bits_to_bytes,{f,Fail},Src,Dst}, Vst) ->
 
620
    assert_term(Src, Vst),
 
621
    set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst));
 
622
valfun_4({bs_init2,{f,Fail},_,Heap,Live,_,Dst}, Vst0) ->
 
623
    verify_live(Live, Vst0),
 
624
    Vst1 = heap_alloc(Heap, Vst0),
 
625
    Vst2 = branch_state(Fail, Vst1),
 
626
    Vst3 = prune_x_regs(Live, Vst2),
 
627
    Vst = bs_zero_bits(Vst3),
 
628
    set_type_reg(binary, Dst, Vst);
 
629
valfun_4({bs_put_string,Sz,_}, Vst) when is_integer(Sz) ->
 
630
    Vst;
 
631
valfun_4({bs_put_binary,{f,Fail},_,_,_,Src}=I, Vst0) ->
 
632
    assert_term(Src, Vst0),
 
633
    Vst = bs_align_check(I, Vst0),
 
634
    branch_state(Fail, Vst);
 
635
valfun_4({bs_put_float,{f,Fail},_,_,_,Src}=I, Vst0) ->
 
636
    assert_term(Src, Vst0),
 
637
    Vst = bs_align_check(I, Vst0),
 
638
    branch_state(Fail, Vst);
 
639
valfun_4({bs_put_integer,{f,Fail},_,_,_,Src}=I, Vst0) ->
 
640
    assert_term(Src, Vst0),
 
641
    Vst = bs_align_check(I, Vst0),
 
642
    branch_state(Fail, Vst);
 
643
%% Old bit syntax construction (before R10B).
 
644
valfun_4({bs_init,_,_}, Vst) ->
 
645
    bs_zero_bits(Vst);
 
646
valfun_4({bs_need_buf,_}, Vst) -> Vst;
 
647
valfun_4({bs_final,{f,Fail},Dst}, Vst0) ->
 
648
    Vst = branch_state(Fail, Vst0),
 
649
    set_type_reg(binary, Dst, Vst);
 
650
valfun_4(_, _) ->
 
651
    error(unknown_instruction).
 
652
 
 
653
%%
 
654
%% Special state handling for setelement/3 and the set_tuple_element/3 instruction.
 
655
%% A possibility for garbage collection must not occur between setelement/3 and
 
656
%% set_tuple_element/3.
 
657
%%
 
658
val_dsetel({move,_,_}, Vst) ->
 
659
    Vst;
 
660
val_dsetel({put_string,0,{string,""},_}, Vst) ->
 
661
    %% An empty string is OK since it doesn't build anything.
 
662
    Vst;
 
663
val_dsetel({call_ext,3,{extfunc,erlang,setelement,3}}, #vst{current=St}=Vst) ->
 
664
    Vst#vst{current=St#st{setelem=true}};
 
665
val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=false}}) ->
 
666
    error(illegal_context_for_set_tuple_element);
 
667
val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=true}}=Vst) ->
 
668
    Vst;
 
669
val_dsetel(_, #vst{current=#st{setelem=true}=St}=Vst) ->
 
670
    Vst#vst{current=St#st{setelem=false}};
 
671
val_dsetel(_, Vst) -> Vst.
 
672
 
 
673
kill_state(#vst{current=#st{ct=[[Fail]|_]}}=Vst) when is_integer(Fail) ->
 
674
    %% There is an active catch. Make sure that we merge the state into
 
675
    %% the catch label before clearing it, so that that we can be sure
 
676
    %% that the label gets a state.
 
677
    kill_state_1(branch_state(Fail, Vst));
 
678
kill_state(Vst) ->
 
679
    kill_state_1(Vst).
 
680
 
 
681
kill_state_1(Vst) ->
 
682
    Vst#vst{current=none}.
 
683
 
 
684
%% A "plain" call.
 
685
%%  The stackframe must be initialized.
 
686
%%  The instruction will return to the instruction following the call.
 
687
call(Live, #vst{current=St}=Vst) ->
 
688
    verify_live(Live, Vst),
 
689
    verify_y_init(Vst),
 
690
    Xs = gb_trees_from_list([{0,term}]),
 
691
    Vst#vst{current=St#st{x=Xs,f=init_fregs(),bsm=undefined}}.
 
692
 
 
693
%% A "plain" call.
 
694
%%  The stackframe must be initialized.
 
695
%%  The instruction will return to the instruction following the call.
 
696
call(Name, Live, #vst{current=St}=Vst) ->
 
697
    verify_live(Live, Vst),
 
698
    verify_y_init(Vst),
 
699
    case return_type(Name, Vst) of
 
700
        Type when Type =/= exception ->
 
701
            %% Type is never 'exception' because it has been handled earlier.
 
702
            Xs = gb_trees_from_list([{0,Type}]),
 
703
            Vst#vst{current=St#st{x=Xs,f=init_fregs(),bsm=undefined}}
 
704
    end.
 
705
 
 
706
%% Tail call.
 
707
%%  The stackframe must have a known size and be initialized.
 
708
%%  Does not return to the instruction following the call.
 
709
tail_call(Live, Vst) ->
 
710
    verify_live(Live, Vst),
 
711
    verify_y_init(Vst),
 
712
    verify_no_ct(Vst),
 
713
    kill_state(Vst).
 
714
 
 
715
allocate(Zero, Stk, Heap, Live, #vst{current=#st{numy=none}=St}=Vst0) ->
 
716
    verify_live(Live, Vst0),
 
717
    Vst = prune_x_regs(Live, Vst0),
 
718
    Ys = init_regs(Stk, case Zero of 
 
719
                            true -> initialized;
 
720
                            false -> uninitialized
 
721
                        end),
 
722
    heap_alloc(Heap, Vst#vst{current=St#st{y=Ys,numy=Stk}});
 
723
allocate(_, _, _, _, #vst{current=#st{numy=Numy}}) ->
 
724
    error({existing_stack_frame,{size,Numy}}).
 
725
 
 
726
deallocate(#vst{current=St}=Vst) ->
 
727
    Vst#vst{current=St#st{y=init_regs(0, initialized),numy=none,bsm=undefined}}.
 
728
 
 
729
test_heap(Heap, Live, Vst0) ->
 
730
    verify_live(Live, Vst0),
 
731
    Vst = prune_x_regs(Live, Vst0),
 
732
    heap_alloc(Heap, Vst).
 
733
 
 
734
heap_alloc(Heap, #vst{current=St}=Vst) ->
 
735
    Words = heap_alloc_1(Heap),
 
736
    Floats = heap_float_alloc(Heap),
 
737
    Vst#vst{current=St#st{h=Words,hf=Floats,bsm=undefined}}.
 
738
    
 
739
heap_alloc_1({alloc,Alloc}) ->
 
740
    {value,{_,Heap}} = lists:keysearch(words, 1, Alloc),
 
741
    Heap;
 
742
heap_alloc_1(Heap) when is_integer(Heap) -> Heap.
 
743
 
 
744
heap_float_alloc({alloc,Alloc}) ->
 
745
    case lists:keysearch(floats, 1, Alloc) of
 
746
        false -> 0;
 
747
        {value,{_,Floats}} -> Floats
 
748
    end;
 
749
heap_float_alloc(Words) when is_integer(Words) -> 0.
 
750
 
 
751
prune_x_regs(Live, #vst{current=#st{x=Xs0}=St0}=Vst) when is_integer(Live) ->
 
752
    Xs1 = gb_trees:to_list(Xs0),
 
753
    Xs = [P || {R,_}=P <- Xs1, R < Live],
 
754
    St = St0#st{x=gb_trees:from_orddict(Xs)},
 
755
    Vst#vst{current=St}.
 
756
 
 
757
%%%
 
758
%%% Floating point checking.
 
759
%%%
 
760
%%% Possible values for the fls field (=floating point error state).
 
761
%%%
 
762
%%% undefined   - Undefined (initial state). No float operations allowed.
 
763
%%%
 
764
%%% cleared     - fclearerror/0 has been executed. Float operations
 
765
%%%               are allowed (such as fadd).
 
766
%%%
 
767
%%% checked     - fcheckerror/1 has been executed. It is allowed to
 
768
%%%               move values out of floating point registers.
 
769
%%%
 
770
%%% The following instructions may be executed in any state:
 
771
%%%
 
772
%%%   fconv Src {fr,_}             
 
773
%%%   fmove Src {fr,_}          %% Move INTO floating point register.
 
774
%%%
 
775
 
 
776
float_op(Src, Dst, Vst0) ->
 
777
    foreach (fun(S) -> assert_freg_set(S, Vst0) end, Src),
 
778
    assert_fls(cleared, Vst0),
 
779
    Vst = set_fls(cleared, Vst0),
 
780
    set_freg(Dst, Vst).
 
781
 
 
782
assert_fls(Fls, Vst) ->
 
783
    case get_fls(Vst) of
 
784
        Fls -> Vst;
 
785
        OtherFls -> error({bad_floating_point_state,OtherFls})
 
786
    end.
 
787
 
 
788
set_fls(Fls, #vst{current=#st{}=St}=Vst) when is_atom(Fls) ->
 
789
    Vst#vst{current=St#st{fls=Fls}}.
 
790
 
 
791
get_fls(#vst{current=#st{fls=Fls}}) when is_atom(Fls) -> Fls.
 
792
 
 
793
init_fregs() -> 0.
 
794
 
 
795
set_freg({fr,Fr}, #vst{current=#st{f=Fregs0}=St}=Vst)
 
796
  when is_integer(Fr), 0 =< Fr ->
 
797
    limit_check(Fr),
 
798
    Bit = 1 bsl Fr,
 
799
    if
 
800
        Fregs0 band Bit =:= 0 ->
 
801
            Fregs = Fregs0 bor Bit,
 
802
            Vst#vst{current=St#st{f=Fregs}};
 
803
        true -> Vst
 
804
    end;
 
805
set_freg(Fr, _) -> error({bad_target,Fr}).
 
806
 
 
807
assert_freg_set({fr,Fr}=Freg, #vst{current=#st{f=Fregs}})
 
808
  when is_integer(Fr), 0 =< Fr ->
 
809
    if
 
810
        Fregs band (1 bsl Fr) =/= 0 ->
 
811
            limit_check(Fr);
 
812
        true -> error({uninitialized_reg,Freg})
 
813
    end;
 
814
assert_freg_set(Fr, _) -> error({bad_source,Fr}).
 
815
 
 
816
%%%
 
817
%%% Binary matching.
 
818
%%%
 
819
%%% Possible values for the bsm field (=bit syntax matching state).
 
820
%%%
 
821
%%% undefined   - Undefined (initial state). No matching instructions allowed.
 
822
%%%              
 
823
%%% (gb set)    - The gb set contains the defined save points.
 
824
%%%
 
825
%%% The bsm field is reset to 'undefined' by instructions that may cause a
 
826
%%% a garbage collection (might move the binary) and/or context switch
 
827
%%% (may invalidate the save points).
 
828
 
 
829
bs_start_match(#vst{current=#st{bsm=undefined}=St}=Vst) ->
 
830
    Vst#vst{current=St#st{bsm=gb_sets:empty()}};
 
831
bs_start_match(Vst) ->
 
832
    %% Must retain save points here - it is possible to restore back
 
833
    %% to a previous binary.
 
834
    Vst.
 
835
 
 
836
bs_save(Reg, #vst{current=#st{bsm=Saved}=St}=Vst) ->
 
837
    Vst#vst{current=St#st{bsm=gb_sets:add(Reg, Saved)}}.
 
838
 
 
839
bs_assert_savepoint(Reg, #vst{current=#st{bsm=Saved}}) ->
 
840
    case gb_sets:is_member(Reg, Saved) of
 
841
        false -> error({no_save_point,Reg});
 
842
        true -> ok
 
843
    end.
 
844
 
 
845
bs_assert_state(#vst{current=#st{bsm=undefined}}) ->
 
846
    error(no_bs_match_state);
 
847
bs_assert_state(_) -> ok.
 
848
 
 
849
 
 
850
%%%
 
851
%%% New binary matching instructions.
 
852
%%%
 
853
 
 
854
bsm_match_state(Slots) ->
 
855
    {match_context,0,Slots}.
 
856
 
 
857
bsm_validate_context(Reg, Vst) ->
 
858
    bsm_get_context(Reg, Vst),
 
859
    ok.
 
860
 
 
861
bsm_get_context({x,X}=Reg, #vst{current=#st{x=Xs}}=_Vst) when is_integer(X) ->
 
862
    case gb_trees:lookup(X, Xs) of
 
863
        {value,{match_context,_,_}=Ctx} -> Ctx;
 
864
        _ -> error({no_bsm_context,Reg})
 
865
    end;
 
866
bsm_get_context(Reg, _) -> error({bad_source,Reg}).
 
867
    
 
868
bsm_save(Reg, SavePoint, Vst) ->
 
869
    case bsm_get_context(Reg, Vst) of
 
870
        {match_context,Bits,Slots} when SavePoint < Slots ->
 
871
            Ctx = {match_context,Bits bor (1 bsl SavePoint),Slots},
 
872
            set_type_reg(Ctx, Reg, Vst);
 
873
        _ -> error({illegal_save,SavePoint})
 
874
    end.
 
875
 
 
876
bsm_restore(Reg, SavePoint, Vst) ->
 
877
    case bsm_get_context(Reg, Vst) of
 
878
        {match_context,Bits,Slots} when SavePoint < Slots ->
 
879
            case Bits band (1 bsl SavePoint) of
 
880
                0 -> error({illegal_restore,SavePoint,not_set});
 
881
                _ -> Vst
 
882
            end;
 
883
        _ -> error({illegal_restore,SavePoint,range})
 
884
    end.
 
885
    
 
886
 
 
887
%%%
 
888
%%% Validation of alignment in the bit syntax. (Currently, construction only.)
 
889
%%%
 
890
%%% We make sure that the aligned flag is only set when we can be sure of the
 
891
%%% aligment.
 
892
%%%
 
893
 
 
894
bs_zero_bits(#vst{current=St}=Vst) ->
 
895
    Vst#vst{current=St#st{bits=0}}.
 
896
 
 
897
bs_align_check({_,_,Sz,U,Flags,_}, #vst{current=#st{bits=Bits}=St}=Vst) ->
 
898
    bs_verify_flags(Flags, St),
 
899
    bs_update_bits(Bits, Sz, U, St, Vst).
 
900
 
 
901
bs_update_bits(undefined, _, _, _, Vst) -> Vst;
 
902
bs_update_bits(Bits0, {integer,Sz}, U, St, Vst) ->
 
903
    Bits = Bits0 + U*Sz,
 
904
    Vst#vst{current=St#st{bits=Bits}};
 
905
bs_update_bits(_, {atom,all}, _, _, Vst) ->
 
906
    %% A binary will not change the alignment.
 
907
    Vst;
 
908
bs_update_bits(_, _, U, _, Vst) when U rem 8 =:= 0 ->
 
909
    %% Units of 8, 16, and so on will not change the aligment.
 
910
    Vst;
 
911
bs_update_bits(_, _, _, St, Vst) ->
 
912
    %% We can no longer be sure about aligment.
 
913
    Vst#vst{current=St#st{bits=undefined}}.
 
914
 
 
915
bs_verify_flags({field_flags,Fl}, #st{bits=Bits}) ->
 
916
    case bs_is_aligned(Fl) of
 
917
        false -> ok;
 
918
        true when is_integer(Bits), Bits rem 8 =:= 0 -> ok;
 
919
        true -> error({aligned_flag_set,{bits,Bits}})
 
920
    end.
 
921
 
 
922
bs_is_aligned(Fl) when is_integer(Fl) -> Fl band 1 =:= 1;
 
923
bs_is_aligned(Fl) when is_list(Fl) -> member(aligned, Fl).
 
924
    
 
925
%%%
 
926
%%% Keeping track of types.
 
927
%%%
 
928
 
 
929
set_type(Type, {x,_}=Reg, Vst) -> set_type_reg(Type, Reg, Vst);
 
930
set_type(Type, {y,_}=Reg, Vst) -> set_type_y(Type, Reg, Vst);
 
931
set_type(_, _, #vst{}=Vst) -> Vst.
 
932
 
 
933
set_type_reg(Type, {x,X}, #vst{current=#st{x=Xs}=St}=Vst) 
 
934
  when is_integer(X), 0 =< X ->
 
935
    limit_check(X),
 
936
    Vst#vst{current=St#st{x=gb_trees:enter(X, Type, Xs)}};
 
937
set_type_reg(Type, Reg, Vst) ->
 
938
    set_type_y(Type, Reg, Vst).
 
939
 
 
940
set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys0,numy=NumY}=St}=Vst) 
 
941
  when is_integer(Y), 0 =< Y ->
 
942
    limit_check(Y),
 
943
    case {Y,NumY} of
 
944
        {_,none} ->
 
945
            error({no_stack_frame,Reg});
 
946
        {_,_} when Y > NumY ->
 
947
            error({y_reg_out_of_range,Reg,NumY});
 
948
        {_,_} ->
 
949
            Ys = if  Type == initialized_ct ->
 
950
                         gb_trees:enter(Y, initialized, Ys0);
 
951
                     true ->
 
952
                         case gb_trees:lookup(Y, Ys0) of
 
953
                             none -> 
 
954
                                 gb_trees:insert(Y, Type, Ys0);
 
955
                             {value,uinitialized} ->
 
956
                                 gb_trees:insert(Y, Type, Ys0);
 
957
                             {value,{catchtag,_}=Tag} ->
 
958
                                 error(Tag);
 
959
                             {value,{trytag,_}=Tag} ->
 
960
                                 error(Tag);
 
961
                             {value,_} ->
 
962
                                 gb_trees:update(Y, Type, Ys0)
 
963
                         end
 
964
                 end,
 
965
            Vst#vst{current=St#st{y=Ys}}
 
966
    end;
 
967
set_type_y(Type, Reg, #vst{}) -> error({invalid_store,Reg,Type}).
 
968
 
 
969
assert_term(Src, Vst) ->
 
970
    get_term_type(Src, Vst),
 
971
    Vst.
 
972
 
 
973
%% The possible types.
 
974
%%
 
975
%% First non-term types:
 
976
%%
 
977
%% initialized          Only for Y registers. Means that the Y register
 
978
%%                      has been initialized with some valid term so that
 
979
%%                      it is safe to pass to the garbage collector.
 
980
%%                      NOT safe to use in any other way (will not crash the
 
981
%%                      emulator, but clearly points to a bug in the compiler).
 
982
%%
 
983
%% {catchtag,[Lbl]}     A special term used within a catch. Must only be used
 
984
%%                      by the catch instructions; NOT safe to use in other
 
985
%%                      instructions.
 
986
%%
 
987
%% {trytag,[Lbl]}       A special term used within a try block. Must only be
 
988
%%                      used by the catch instructions; NOT safe to use in other
 
989
%%                      instructions.
 
990
%%
 
991
%% exception            Can only be used as a type returned by return_type/2
 
992
%%                      (which gives the type of the value returned by a BIF).
 
993
%%                      Thus 'exception' is never stored as type descriptor
 
994
%%                      for a register.
 
995
%%
 
996
%% match_context        Only for X registers. A matching context for bit syntax
 
997
%%                      matching; must only be used by bit syntax instructions.
 
998
%%
 
999
%%
 
1000
%% Normal terms:
 
1001
%%
 
1002
%% term                 Any valid Erlang (but not of the special types above).
 
1003
%%
 
1004
%% bool                 The atom 'true' or the atom 'false'.
 
1005
%%
 
1006
%% cons                 Cons cell: [_|_]
 
1007
%%
 
1008
%% nil                  Empty list: []
 
1009
%%
 
1010
%% {tuple,[Sz]}         Tuple. An element has been accessed using
 
1011
%%                      element/2 or setelement/3 so that it is known that
 
1012
%%                      the type is a tuple of size at least Sz.
 
1013
%%
 
1014
%% {tuple,Sz}           Tuple. A test_arity instruction has been seen
 
1015
%%                      so that it is known that the size is exactly Sz.
 
1016
%%
 
1017
%% {atom,[]}            Atom.
 
1018
%% {atom,Atom}
 
1019
%%
 
1020
%% {integer,[]}         Integer.
 
1021
%% {integer,Integer}
 
1022
%%
 
1023
%% {float,[]}           Float.
 
1024
%% {float,Float}
 
1025
%%
 
1026
%% number               Integer or Float of unknown value
 
1027
%%
 
1028
 
 
1029
assert_type(WantedType, Term, Vst) ->
 
1030
    assert_type(WantedType, get_term_type(Term, Vst)),
 
1031
    Vst.
 
1032
 
 
1033
assert_type(Correct, Correct) -> ok;
 
1034
assert_type(float, {float,_}) -> ok;
 
1035
assert_type(tuple, {tuple,_}) -> ok;
 
1036
assert_type({tuple_element,I}, {tuple,[Sz]})
 
1037
  when 1 =< I, I =< Sz ->
 
1038
    ok;
 
1039
assert_type({tuple_element,I}, {tuple,Sz})
 
1040
  when is_integer(Sz), 1 =< I, I =< Sz ->
 
1041
    ok;
 
1042
assert_type(Needed, Actual) ->
 
1043
    error({bad_type,{needed,Needed},{actual,Actual}}).
 
1044
 
 
1045
 
 
1046
%% upgrade_tuple_type(NewTupleType, OldType) -> TupleType.
 
1047
%%  upgrade_tuple_type/2 is used when linear code finds out more and
 
1048
%%  more information about a tuple type, so that the type gets more
 
1049
%%  specialized. If OldType is not a tuple type, the type information
 
1050
%%  is inconsistent, and we know that some instructions will never
 
1051
%%  be executed at run-time.
 
1052
 
 
1053
upgrade_tuple_type({tuple,[Sz]}, {tuple,[OldSz]}=T) when Sz < OldSz ->
 
1054
    %% The old type has a higher value for the least tuple size.
 
1055
    T;
 
1056
upgrade_tuple_type({tuple,[Sz]}, {tuple,OldSz}=T) 
 
1057
  when is_integer(Sz), is_integer(OldSz), Sz =< OldSz ->
 
1058
    %% The old size is exact, and the new size is smaller than the old size.
 
1059
    T;
 
1060
upgrade_tuple_type({tuple,_}=T, _) ->
 
1061
    %% The new type information is exact or has a higher value for
 
1062
    %% the least tuple size.
 
1063
    %%     Note that inconsistencies are also handled in this
 
1064
    %% clause, e.g. if the old type was an integer or a tuple accessed
 
1065
    %% outside its size; inconsistences will generally cause an exception
 
1066
    %% at run-time but are safe from our point of view.
 
1067
    T.
 
1068
 
 
1069
get_tuple_size({integer,[]}) -> 0;
 
1070
get_tuple_size({integer,Sz}) -> Sz;
 
1071
get_tuple_size(_) -> 0.
 
1072
 
 
1073
validate_src(Ss, Vst) when is_list(Ss) ->
 
1074
    foreach(fun(S) -> get_term_type(S, Vst) end, Ss).
 
1075
 
 
1076
%% get_term_type(Src, ValidatorState) -> Type
 
1077
%%  Get the type of the source Src. The returned type Type will be
 
1078
%%  a standard Erlang type (no catch/try tags).
 
1079
 
 
1080
get_term_type(Src, Vst) ->
 
1081
    case get_term_type_1(Src, Vst) of
 
1082
        initialized -> error({unassigned,Src});
 
1083
        {catchtag,_} -> error({catchtag,Src});
 
1084
        {trytag,_} -> error({trytag,Src});
 
1085
        Type -> Type
 
1086
    end.
 
1087
 
 
1088
%% get_special_y_type(Src, ValidatorState) -> Type
 
1089
%%  Return the type for the Y register without doing any validity checks.
 
1090
 
 
1091
get_special_y_type({y,_}=Reg, Vst) -> get_term_type_1(Reg, Vst);
 
1092
get_special_y_type(Src, _) -> error({source_not_y_reg,Src}).
 
1093
 
 
1094
get_term_type_1(nil=T, _) -> T;
 
1095
get_term_type_1({atom,A}=T, _) when is_atom(A) -> T;
 
1096
get_term_type_1({float,F}=T, _) when is_float(F) -> T;
 
1097
get_term_type_1({integer,I}=T, _) when is_integer(I) -> T;
 
1098
get_term_type_1({x,X}=Reg, #vst{current=#st{x=Xs}}) when is_integer(X) ->
 
1099
    case gb_trees:lookup(X, Xs) of
 
1100
        {value,Type} -> Type;
 
1101
        none -> error({uninitialized_reg,Reg})
 
1102
    end;
 
1103
get_term_type_1({y,Y}=Reg, #vst{current=#st{y=Ys}}) when is_integer(Y) ->
 
1104
    case gb_trees:lookup(Y, Ys) of
 
1105
        none -> error({uninitialized_reg,Reg});
 
1106
        {value,uninitialized} -> error({uninitialized_reg,Reg});
 
1107
        {value,Type} -> Type
 
1108
    end;
 
1109
get_term_type_1(Src, _) -> error({bad_source,Src}).
 
1110
 
 
1111
 
 
1112
branch_arities([], _, #vst{}=Vst) -> Vst;
 
1113
branch_arities([Sz,{f,L}|T], Tuple, #vst{current=St}=Vst0) 
 
1114
  when is_integer(Sz) ->
 
1115
    Vst1 = set_type_reg({tuple,Sz}, Tuple, Vst0),
 
1116
    Vst = branch_state(L, Vst1),
 
1117
    branch_arities(T, Tuple, Vst#vst{current=St}).
 
1118
 
 
1119
branch_state(0, #vst{}=Vst) -> Vst;
 
1120
branch_state(L, #vst{current=St,branched=B}=Vst) ->
 
1121
    Vst#vst{
 
1122
      branched=case gb_trees:is_defined(L, B) of
 
1123
                   false ->
 
1124
                       gb_trees:insert(L, St, B);
 
1125
                   true ->
 
1126
                       MergedSt = merge_states(L, St, B),
 
1127
                       gb_trees:update(L, MergedSt, B)
 
1128
               end}.
 
1129
 
 
1130
%% merge_states/3 is used when there are more than one way to arrive
 
1131
%% at this point, and the type states for the different paths has
 
1132
%% to be merged. The type states are downgraded to the least common
 
1133
%% subset for the subsequent code.
 
1134
 
 
1135
merge_states(L, St, Branched) when L =/= 0 ->
 
1136
    case gb_trees:lookup(L, Branched) of
 
1137
        none -> St;
 
1138
        {value,OtherSt} when St == none -> OtherSt;
 
1139
        {value,OtherSt} -> merge_states_1(St, OtherSt)
 
1140
    end.
 
1141
 
 
1142
merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0,ct=Ct0,bsm=Bsm0}=St,
 
1143
               #st{x=Xs1,y=Ys1,numy=NumY1,h=H1,ct=Ct1,bsm=Bsm1}) ->
 
1144
    NumY = merge_stk(NumY0, NumY1),
 
1145
    Xs = merge_regs(Xs0, Xs1),
 
1146
    Ys = merge_y_regs(Ys0, Ys1),
 
1147
    Ct = merge_ct(Ct0, Ct1),
 
1148
    Bsm = merge_bsm(Bsm0, Bsm1),
 
1149
    St#st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1),ct=Ct,bsm=Bsm}.
 
1150
 
 
1151
merge_stk(S, S) -> S;
 
1152
merge_stk(_, _) -> undecided.
 
1153
 
 
1154
merge_ct(S, S) -> S;
 
1155
merge_ct(Ct0, Ct1) -> merge_ct_1(Ct0, Ct1).
 
1156
 
 
1157
merge_ct_1([C0|Ct0], [C1|Ct1]) ->
 
1158
    [ordsets:from_list(C0++C1)|merge_ct_1(Ct0, Ct1)];
 
1159
merge_ct_1([], []) -> [];
 
1160
merge_ct_1(_, _) -> undecided.
 
1161
 
 
1162
merge_regs(Rs0, Rs1) ->
 
1163
    Rs = merge_regs_1(gb_trees:to_list(Rs0), gb_trees:to_list(Rs1)),
 
1164
    gb_trees_from_list(Rs).
 
1165
 
 
1166
merge_regs_1([Same|Rs1], [Same|Rs2]) ->
 
1167
    [Same|merge_regs_1(Rs1, Rs2)];
 
1168
merge_regs_1([{R1,_}|Rs1], [{R2,_}|_]=Rs2) when R1 < R2 ->
 
1169
    merge_regs_1(Rs1, Rs2);
 
1170
merge_regs_1([{R1,_}|_]=Rs1, [{R2,_}|Rs2]) when R1 > R2 ->
 
1171
    merge_regs_1(Rs1, Rs2);
 
1172
merge_regs_1([{R,Type1}|Rs1], [{R,Type2}|Rs2]) ->
 
1173
    [{R,merge_types(Type1, Type2)}|merge_regs_1(Rs1, Rs2)];
 
1174
merge_regs_1([], []) -> [];
 
1175
merge_regs_1([], [_|_]) -> [];
 
1176
merge_regs_1([_|_], []) -> [].
 
1177
 
 
1178
merge_y_regs(Rs0, Rs1) ->
 
1179
    Rs = merge_y_regs_1(gb_trees:to_list(Rs0), gb_trees:to_list(Rs1)),
 
1180
    gb_trees_from_list(Rs).
 
1181
 
 
1182
merge_y_regs_1([Same|Rs1], [Same|Rs2]) ->
 
1183
    [Same|merge_y_regs_1(Rs1, Rs2)];
 
1184
merge_y_regs_1([{R1,_}|Rs1], [{R2,_}|_]=Rs2) when R1 < R2 ->
 
1185
    [{R1,uninitialized}|merge_y_regs_1(Rs1, Rs2)];
 
1186
merge_y_regs_1([{R1,_}|_]=Rs1, [{R2,_}|Rs2]) when R1 > R2 ->
 
1187
    [{R2,uninitialized}|merge_y_regs_1(Rs1, Rs2)];
 
1188
merge_y_regs_1([{R,Type1}|Rs1], [{R,Type2}|Rs2]) ->
 
1189
    [{R,merge_types(Type1, Type2)}|merge_y_regs_1(Rs1, Rs2)];
 
1190
merge_y_regs_1([], []) -> [];
 
1191
merge_y_regs_1([], [_|_]=Rs) -> Rs;
 
1192
merge_y_regs_1([_|_]=Rs, []) -> Rs.
 
1193
 
 
1194
%% merge_types(Type1, Type2) -> Type
 
1195
%%  Return the most specific type possible.
 
1196
%%  Note: Type1 must NOT be the same as Type2.
 
1197
merge_types(uninitialized=I, _) -> I;
 
1198
merge_types(_, uninitialized=I) -> I;
 
1199
merge_types(initialized=I, _) -> I;
 
1200
merge_types(_, initialized=I) -> I;
 
1201
merge_types({catchtag,T0},{catchtag,T1}) ->
 
1202
    {catchtag,ordsets:from_list(T0++T1)};
 
1203
merge_types({trytag,T0},{trytag,T1}) ->
 
1204
    {trytag,ordsets:from_list(T0++T1)};
 
1205
merge_types({tuple,A}, {tuple,B}) ->
 
1206
    {tuple,[min(tuple_sz(A), tuple_sz(B))]};
 
1207
merge_types({Type,A}, {Type,B}) 
 
1208
  when Type == atom; Type == integer; Type == float ->
 
1209
    if A =:= B -> {Type,A};
 
1210
       true -> {Type,[]}
 
1211
    end;
 
1212
merge_types({Type,_}, number) 
 
1213
  when Type == integer; Type == float ->
 
1214
    number;
 
1215
merge_types(number, {Type,_}) 
 
1216
  when Type == integer; Type == float ->
 
1217
    number;
 
1218
merge_types(bool, {atom,A}) ->
 
1219
    merge_bool(A);
 
1220
merge_types({atom,A}, bool) ->
 
1221
    merge_bool(A);
 
1222
merge_types({match_context,B0,Slots},{match_context,B1,Slots}) ->
 
1223
    {match_context,B0 bor B1,Slots};
 
1224
merge_types(T1, T2) when T1 =/= T2 ->
 
1225
    %% Too different. All we know is that the type is a 'term'.
 
1226
    term.
 
1227
 
 
1228
merge_bsm(undefined, _) -> undefined;
 
1229
merge_bsm(_, undefined) -> undefined;
 
1230
merge_bsm(Bsm0, Bsm1) -> gb_sets:intersection(Bsm0, Bsm1).
 
1231
 
 
1232
tuple_sz([Sz]) -> Sz;
 
1233
tuple_sz(Sz) -> Sz.
 
1234
 
 
1235
merge_bool([]) -> {atom,[]};
 
1236
merge_bool(true) -> bool;
 
1237
merge_bool(false) -> bool;
 
1238
merge_bool(_) -> {atom,[]}.
 
1239
    
 
1240
verify_y_init(#vst{current=#st{y=Ys}}) ->
 
1241
    verify_y_init_1(gb_trees:to_list(Ys)).
 
1242
 
 
1243
verify_y_init_1([]) -> ok;
 
1244
verify_y_init_1([{Y,uninitialized}|_]) ->
 
1245
    error({uninitialized_reg,{y,Y}});
 
1246
verify_y_init_1([{_,_}|Ys]) ->
 
1247
    verify_y_init_1(Ys).
 
1248
 
 
1249
verify_live(0, #vst{}) -> ok;
 
1250
verify_live(N, #vst{current=#st{x=Xs}}) ->
 
1251
    verify_live_1(N, Xs).
 
1252
 
 
1253
verify_live_1(0, _) -> ok;
 
1254
verify_live_1(N, Xs) when is_integer(N) ->
 
1255
    X = N-1,
 
1256
    case gb_trees:is_defined(X, Xs) of
 
1257
        false -> error({{x,X},not_live});
 
1258
        true -> verify_live_1(X, Xs)
 
1259
    end;
 
1260
verify_live_1(N, _) -> error({bad_number_of_live_regs,N}).
 
1261
 
 
1262
verify_no_ct(#vst{current=#st{numy=none}}) -> ok;
 
1263
verify_no_ct(#vst{current=#st{numy=undecided}}) ->
 
1264
    error(unknown_size_of_stackframe);
 
1265
verify_no_ct(#vst{current=#st{y=Ys}}) ->
 
1266
    case lists:filter(fun ({_,{catchtag,_}}) -> true;
 
1267
                          ({_,{trytag,_}}) -> true;
 
1268
                          ({_,_}) -> false
 
1269
                      end, gb_trees:to_list(Ys)) of
 
1270
        [] -> ok;
 
1271
        CT -> error({unfinished_catch_try,CT})
 
1272
    end.
 
1273
 
 
1274
eat_heap(N, #vst{current=#st{h=Heap0}=St}=Vst) ->
 
1275
    case Heap0-N of
 
1276
        Neg when Neg < 0 ->
 
1277
            error({heap_overflow,{left,Heap0},{wanted,N}});
 
1278
        Heap ->
 
1279
            Vst#vst{current=St#st{h=Heap}}
 
1280
    end.
 
1281
 
 
1282
eat_heap_float(#vst{current=#st{hf=HeapFloats0}=St}=Vst) ->
 
1283
    case HeapFloats0-1 of
 
1284
        Neg when Neg < 0 ->
 
1285
            error({heap_overflow,{left,{HeapFloats0,floats}},{wanted,{1,floats}}});
 
1286
        HeapFloats ->
 
1287
            Vst#vst{current=St#st{hf=HeapFloats}}
 
1288
    end.
 
1289
 
 
1290
bif_type('-', Src, Vst) ->
 
1291
    arith_type(Src, Vst);
 
1292
bif_type('+', Src, Vst) ->
 
1293
    arith_type(Src, Vst);
 
1294
bif_type('*', Src, Vst) ->
 
1295
    arith_type(Src, Vst);
 
1296
bif_type(abs, [Num], Vst) ->
 
1297
    case get_term_type(Num, Vst) of
 
1298
        {float,_}=T -> T;
 
1299
        {integer,_}=T -> T;
 
1300
        _ -> number
 
1301
    end;
 
1302
bif_type(float, _, _) -> {float,[]};
 
1303
bif_type('/', _, _) -> {float,[]};
 
1304
%% Integer operations.
 
1305
bif_type('div', [_,_], _) -> {integer,[]};
 
1306
bif_type('rem', [_,_], _) -> {integer,[]};
 
1307
bif_type(length, [_], _) -> {integer,[]};
 
1308
bif_type(size, [_], _) -> {integer,[]};
 
1309
bif_type(trunc, [_], _) -> {integer,[]};
 
1310
bif_type(round, [_], _) -> {integer,[]};
 
1311
bif_type('band', [_,_], _) -> {integer,[]};
 
1312
bif_type('bor', [_,_], _) -> {integer,[]};
 
1313
bif_type('bxor', [_,_], _) -> {integer,[]};
 
1314
bif_type('bnot', [_], _) -> {integer,[]};
 
1315
bif_type('bsl', [_,_], _) -> {integer,[]};
 
1316
bif_type('bsr', [_,_], _) -> {integer,[]};
 
1317
%% Booleans.
 
1318
bif_type('==', [_,_], _) -> bool;
 
1319
bif_type('/=', [_,_], _) -> bool;
 
1320
bif_type('=<', [_,_], _) -> bool;
 
1321
bif_type('<', [_,_], _) -> bool;
 
1322
bif_type('>=', [_,_], _) -> bool;
 
1323
bif_type('>', [_,_], _) -> bool;
 
1324
bif_type('=:=', [_,_], _) -> bool;
 
1325
bif_type('=/=', [_,_], _) -> bool;
 
1326
bif_type('not', [_], _) -> bool;
 
1327
bif_type('and', [_,_], _) -> bool;
 
1328
bif_type('or', [_,_], _) -> bool;
 
1329
bif_type('xor', [_,_], _) -> bool;
 
1330
bif_type(is_atom, [_], _) -> bool;
 
1331
bif_type(is_boolean, [_], _) -> bool;
 
1332
bif_type(is_binary, [_], _) -> bool;
 
1333
bif_type(is_constant, [_], _) -> bool;
 
1334
bif_type(is_float, [_], _) -> bool;
 
1335
bif_type(is_function, [_], _) -> bool;
 
1336
bif_type(is_integer, [_], _) -> bool;
 
1337
bif_type(is_list, [_], _) -> bool;
 
1338
bif_type(is_number, [_], _) -> bool;
 
1339
bif_type(is_pid, [_], _) -> bool;
 
1340
bif_type(is_port, [_], _) -> bool;
 
1341
bif_type(is_reference, [_], _) -> bool;
 
1342
bif_type(is_tuple, [_], _) -> bool;
 
1343
%% Misc.
 
1344
bif_type(node, [], _) -> {atom,[]};
 
1345
bif_type(node, [_], _) -> {atom,[]};
 
1346
bif_type(hd, [_], _) -> term;
 
1347
bif_type(tl, [_], _) -> term;
 
1348
bif_type(get, [_], _) -> term;
 
1349
bif_type(raise, [_,_], _) -> exception;
 
1350
bif_type(Bif, _, _) when is_atom(Bif) -> term.
 
1351
 
 
1352
arith_type([A,B], Vst) ->
 
1353
    case {get_term_type(A, Vst),get_term_type(B, Vst)} of
 
1354
        {{float,_},_} -> {float,[]};
 
1355
        {_,{float,_}} -> {float,[]};
 
1356
        {_,_} -> number
 
1357
    end;
 
1358
arith_type(_, _) -> number.
 
1359
 
 
1360
return_type({extfunc,M,F,A}, Vst) ->
 
1361
    return_type_1(M, F, A, Vst).
 
1362
 
 
1363
return_type_1(erlang, setelement, 3, Vst) ->
 
1364
    Tuple = {x,1},
 
1365
    TupleType =
 
1366
        case get_term_type(Tuple, Vst) of
 
1367
            {tuple,_}=TT -> TT;
 
1368
            _ -> {tuple,[0]}
 
1369
        end,
 
1370
    case get_term_type({x,0}, Vst) of
 
1371
        {integer,[]} -> TupleType;
 
1372
        {integer,I} -> upgrade_tuple_type({tuple,[I]}, TupleType);
 
1373
        _ -> TupleType
 
1374
    end;
 
1375
return_type_1(erlang, F, A, _) ->
 
1376
    return_type_erl(F, A);
 
1377
return_type_1(math, F, A, _) ->
 
1378
    return_type_math(F, A);
 
1379
return_type_1(M, F, A, _) when is_atom(M), is_atom(F), is_integer(A), A >= 0 ->
 
1380
    term.
 
1381
 
 
1382
return_type_erl(exit, 1) -> exception;
 
1383
return_type_erl(throw, 1) -> exception;
 
1384
return_type_erl(fault, 1) -> exception;
 
1385
return_type_erl(fault, 2) -> exception;
 
1386
return_type_erl(error, 1) -> exception;
 
1387
return_type_erl(error, 2) -> exception;
 
1388
return_type_erl(F, A) when is_atom(F), is_integer(A), A >= 0 -> term.
 
1389
 
 
1390
return_type_math(cos, 1) -> {float,[]};
 
1391
return_type_math(cosh, 1) -> {float,[]};
 
1392
return_type_math(sin, 1) -> {float,[]};
 
1393
return_type_math(sinh, 1) -> {float,[]};
 
1394
return_type_math(tan, 1) -> {float,[]};
 
1395
return_type_math(tanh, 1) -> {float,[]};
 
1396
return_type_math(acos, 1) -> {float,[]};
 
1397
return_type_math(acosh, 1) -> {float,[]};
 
1398
return_type_math(asin, 1) -> {float,[]};
 
1399
return_type_math(asinh, 1) -> {float,[]};
 
1400
return_type_math(atan, 1) -> {float,[]};
 
1401
return_type_math(atanh, 1) -> {float,[]};
 
1402
return_type_math(erf, 1) -> {float,[]};
 
1403
return_type_math(erfc, 1) -> {float,[]};
 
1404
return_type_math(exp, 1) -> {float,[]};
 
1405
return_type_math(log, 1) -> {float,[]};
 
1406
return_type_math(log10, 1) -> {float,[]};
 
1407
return_type_math(sqrt, 1) -> {float,[]};
 
1408
return_type_math(atan2, 2) -> {float,[]};
 
1409
return_type_math(pow, 2) -> {float,[]};
 
1410
return_type_math(pi, 0) -> {float,[]};
 
1411
return_type_math(F, A) when is_atom(F), is_integer(A), A >= 0 -> term.
 
1412
 
 
1413
limit_check(Num) when is_integer(Num), Num >= ?MAXREG ->
 
1414
    error(limit);
 
1415
limit_check(_) -> ok.
 
1416
 
 
1417
min(A, B) when is_integer(A), is_integer(B), A < B -> A;
 
1418
min(A, B) when is_integer(A), is_integer(B) -> B.
 
1419
 
 
1420
gb_trees_from_list(L) -> gb_trees:from_orddict(orddict:from_list(L)).
 
1421
 
 
1422
-ifdef(DEBUG).
 
1423
error(Error) -> exit(Error).
 
1424
-else.
 
1425
error(Error) -> throw(Error).
 
1426
-endif.