1%% ``Licensed under the Apache License, Version 2.0 (the "License"); 2%% you may not use this file except in compliance with the License. 3%% You may obtain a copy of the License at 4%% 5%% http://www.apache.org/licenses/LICENSE-2.0 6%% 7%% Unless required by applicable law or agreed to in writing, software 8%% distributed under the License is distributed on an "AS IS" BASIS, 9%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 10%% See the License for the specific language governing permissions and 11%% limitations under the License. 12%% 13%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. 14%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings 15%% AB. All Rights Reserved.'' 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 41files([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); 49files([]) -> ok. 50 51file(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. 61module({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 70format_error([]) -> []; 71format_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)]; 74format_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 85s_file(Name) -> 86 {ok,Is} = file:consult(Name), 87 Fs = find_functions(Is), 88 validate(Fs). 89 90find_functions(Fs) -> 91 find_functions_1(Fs, none, [], []). 92 93find_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); 96find_functions_1([I|Is], Func, FuncAcc, Acc) -> 97 find_functions_1(Is, Func, [I|FuncAcc], Acc); 98find_functions_1([], Func, FuncAcc, Acc) -> 99 reverse(add_func(Func, FuncAcc, Acc)). 100 101add_func(none, _, Acc) -> Acc; 102add_func({Name,Arity,Entry}, Is, Acc) -> 103 [{function,Name,Arity,Entry,reverse(Is)}|Acc]. 104 105beam_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 115beam_file_1([F0|Fs], Acc) -> 116 F = conv_func(F0), 117 beam_file_1(Fs, [F|Acc]); 118beam_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 123conv_func(Is) -> 124 conv_func_1(labels(Is)). 125 126conv_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. 157validate([]) -> []; 158validate([{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). 169validate_error(Error, Name, Ar) -> 170 exit(validate_error_1(Error, Name, Ar)). 171-else. 172validate_error(Error, Name, Ar) -> 173 validate_error_1(Error, Name, Ar). 174-endif. 175validate_error_1(Error, Name, Ar) -> 176 {{'_',Name,Ar}, 177 {internal_error,'_',{Error,[]}}}. 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). 193print_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 200validate_1(Is, Name, Arity, Entry) -> 201 validate_2(labels(Is), Name, Arity, Entry). 202 203validate_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); 208validate_2({Ls1,Is}, Name, Arity, _Entry) -> 209 error({{'_',Name,Arity},{first(Is),length(Ls1),illegal_instruction}}). 210 211validate_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 224first([X|_]) -> X; 225first([]) -> []. 226 227labels(Is) -> 228 labels_1(Is, []). 229 230labels_1([{label,L}|Is], R) -> 231 labels_1(Is, [L|R]); 232labels_1(Is, R) -> 233 {lists:reverse(R),Is}. 234 235init_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 240init_regs(0, _) -> 241 gb_trees:empty(); 242init_regs(N, Type) -> 243 gb_trees_from_list([{R,Type} || R <- lists:seq(0, N-1)]). 244 245valfun([], _MFA, _Offset, Vst) -> Vst; 246valfun([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. 256valfun_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)}; 259valfun_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; 264valfun_1({badmatch,Src}, Vst) -> 265 assert_term(Src, Vst), 266 kill_state(Vst); 267valfun_1({case_end,Src}, Vst) -> 268 assert_term(Src, Vst), 269 kill_state(Vst); 270valfun_1(if_end, Vst) -> 271 kill_state(Vst); 272valfun_1({try_case_end,Src}, Vst) -> 273 assert_term(Src, Vst), 274 kill_state(Vst); 275%% Instructions that cannot cause exceptions 276valfun_1({move,Src,Dst}, Vst) -> 277 Type = get_term_type(Src, Vst), 278 set_type_reg(Type, Dst, Vst); 279valfun_1({fmove,Src,{fr,_}}, Vst) -> 280 assert_type(float, Src, Vst); 281valfun_1({fmove,{fr,_},Dst}, Vst) -> 282 set_type_reg({float,[]}, Dst, Vst); 283valfun_1({kill,{y,_}=Reg}, Vst) -> 284 set_type_y(initialized, Reg, Vst); 285valfun_1({test_heap,Heap,Live}, Vst) -> 286 test_heap(Heap, Live, Vst); 287valfun_1({bif,_Op,nofail,Src,Dst}, Vst) -> 288 validate_src(Src, Vst), 289 set_type_reg(term, Dst, Vst); 290%% Put instructions. 291valfun_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); 296valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) -> 297 Vst = eat_heap(1, Vst0), 298 set_type_reg({tuple,Sz}, Dst, Vst); 299valfun_1({put,Src}, Vst) -> 300 assert_term(Src, Vst), 301 eat_heap(1, Vst); 302valfun_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 306valfun_1({allocate,Stk,Live}, Vst) -> 307 allocate(false, Stk, 0, Live, Vst); 308valfun_1({allocate_heap,Stk,Heap,Live}, Vst) -> 309 allocate(false, Stk, Heap, Live, Vst); 310valfun_1({allocate_zero,Stk,Live}, Vst) -> 311 allocate(true, Stk, 0, Live, Vst); 312valfun_1({allocate_heap_zero,Stk,Heap,Live}, Vst) -> 313 allocate(true, Stk, Heap, Live, Vst); 314valfun_1({init,{y,_}=Reg}, Vst) -> 315 set_type_y(initialized, Reg, Vst); 316valfun_1({deallocate,StkSize}, #vst{current=#st{numy=StkSize,ct=[]}}=Vst) -> 317 deallocate(Vst); 318valfun_1({deallocate,_}, #vst{current=#st{numy=NumY,ct=[]}}) -> 319 error({allocated,NumY}); 320valfun_1({deallocate,_}, #vst{current=#st{ct=Fails}}) -> 321 error({catch_try_stack,Fails}); 322%% Catch & try. 323valfun_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]}}; 327valfun_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 332valfun_1(I, #vst{current=#st{ct=[]}}=Vst) -> 333 valfun_2(I, Vst); 334valfun_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. 340valfun_2({apply,Live}, Vst) -> 341 call(Live+2, Vst); 342valfun_2({apply_last,Live,_}, Vst) -> 343 tail_call(Live+2, Vst); 344valfun_2({call_fun,Live}, Vst) -> 345 call(Live, Vst); 346valfun_2({call,Live,_}, Vst) -> 347 call(Live, Vst); 348valfun_2({call_ext,Live,Func}, Vst) -> 349 call(Func, Live, Vst); 350valfun_2({call_only,Live,_}, Vst) -> 351 tail_call(Live, Vst); 352valfun_2({call_ext_only,Live,_}, Vst) -> 353 tail_call(Live, Vst); 354valfun_2({call_last,Live,_,_}, Vst) -> 355 tail_call(Live, Vst); 356valfun_2({call_ext_last,Live,_,_}, Vst) -> 357 tail_call(Live, Vst); 358valfun_2({make_fun,_,_,Live}, Vst) -> 359 call(Live, Vst); 360valfun_2({make_fun2,_,_,_,Live}, Vst) -> 361 call(Live, Vst); 362%% Floating point. 363valfun_2({fconv,Src,{fr,_}}, Vst) -> 364 assert_term(Src, Vst); 365valfun_2({bif,fadd,_,[{fr,_},{fr,_}],{fr,_}}, Vst) -> 366 Vst; 367valfun_2({bif,fdiv,_,[{fr,_},{fr,_}],{fr,_}}, Vst) -> 368 Vst; 369valfun_2({bif,fmul,_,[{fr,_},{fr,_}],{fr,_}}, Vst) -> 370 Vst; 371valfun_2({bif,fnegate,_,[{fr,_}],{fr,_}}, Vst) -> 372 Vst; 373valfun_2({bif,fsub,_,[{fr,_},{fr,_}],{fr,_}}, Vst) -> 374 Vst; 375valfun_2(fclearerror, Vst) -> 376 Vst; 377valfun_2({fcheckerror,_}, Vst) -> 378 Vst; 379%% Other BIFs 380valfun_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); 387valfun_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); 392valfun_2(return, #vst{current=#st{numy=none}}=Vst) -> 393 kill_state(Vst); 394valfun_2(return, #vst{current=#st{numy=NumY}}) -> 395 error({stack_frame,NumY}); 396valfun_2({jump,{f,_}}, #vst{current=none}=Vst) -> 397 %% Must be an unreachable jump which was not optimized away. 398 %% Do nothing. 399 Vst; 400valfun_2({jump,{f,Lbl}}, Vst) -> 401 kill_state(branch_state(Lbl, Vst)); 402valfun_2({loop_rec,{f,Fail},Dst}, Vst0) -> 403 Vst = branch_state(Fail, Vst0), 404 set_type_reg(term, Dst, Vst); 405valfun_2(remove_message, Vst) -> 406 Vst; 407valfun_2({wait,_}, Vst) -> 408 kill_state(Vst); 409valfun_2({wait_timeout,_,Src}, Vst) -> 410 assert_term(Src, Vst); 411valfun_2({loop_rec_end,_}, Vst) -> 412 kill_state(Vst); 413valfun_2(timeout, #vst{current=St}=Vst) -> 414 Vst#vst{current=St#st{x=init_regs(0, term)}}; 415valfun_2(send, Vst) -> 416 call(2, Vst); 417%% Catch & try. 418valfun_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; 427valfun_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; 434valfun_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; 443valfun_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. 447valfun_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)); 451valfun_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))); 454valfun_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); 458valfun_2({get_tuple_element,Src,I,Dst}, Vst) -> 459 assert_type({tuple_element,I+1}, Src, Vst), 460 set_type_reg(term, Dst, Vst); 461valfun_2({bs_restore,_}, Vst) -> 462 Vst; 463valfun_2({bs_save,_}, Vst) -> 464 Vst; 465valfun_2({bs_start_match,{f,Fail},Src}, Vst) -> 466 assert_term(Src, Vst), 467 branch_state(Fail, Vst); 468valfun_2({test,bs_skip_bits,{f,Fail},[Src,_,_]}, Vst) -> 469 assert_term(Src, Vst), 470 branch_state(Fail, Vst); 471valfun_2({test,_,{f,Fail},[_,_,_,Dst]}, Vst0) -> 472 Vst = branch_state(Fail, Vst0), 473 set_type_reg({integer,[]}, Dst, Vst); 474valfun_2({test,bs_test_tail,{f,Fail},_}, Vst) -> 475 branch_state(Fail, Vst); 476%% Other test instructions. 477valfun_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); 481valfun_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); 485valfun_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); 489valfun_2({test,_Op,{f,Lbl},Src}, Vst) -> 490 validate_src(Src, Vst), 491 branch_state(Lbl, Vst); 492valfun_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); 497valfun_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); 501valfun_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); 505valfun_2({bs_put_string,Sz,_}, Vst) when is_integer(Sz) -> 506 Vst; 507valfun_2({bs_put_binary,{f,Fail},_,_,_,Src}, Vst0) -> 508 assert_term(Src, Vst0), 509 branch_state(Fail, Vst0); 510valfun_2({bs_put_float,{f,Fail},_,_,_,Src}, Vst0) -> 511 assert_term(Src, Vst0), 512 branch_state(Fail, Vst0); 513valfun_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). 517valfun_2({bs_init,_,_}, Vst) -> Vst; 518valfun_2({bs_need_buf,_}, Vst) -> Vst; 519valfun_2({bs_final,{f,Fail},Dst}, Vst0) -> 520 Vst = branch_state(Fail, Vst0), 521 set_type_reg(binary, Dst, Vst); 522%% Misc. 523valfun_2({'%live',Live}, Vst) -> 524 verify_live(Live, Vst), 525 Vst; 526valfun_2(_, _) -> 527 error(unknown_instruction). 528 529kill_state(#vst{current=#st{ct=[]}}=Vst) -> 530 Vst#vst{current=none}; 531kill_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. 538call(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. 547call(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. 561tail_call(Live, Vst) -> 562 kill_state(call(Live, Vst)). 563 564allocate(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)}}; 571allocate(_, _, _, _, #vst{current=#st{numy=Numy}}) -> 572 error({existing_stack_frame,{size,Numy}}). 573 574deallocate(#vst{current=St}=Vst) -> 575 Vst#vst{current=St#st{y=init_regs(0, initialized),numy=none}}. 576 577test_heap(Heap, Live, Vst) -> 578 verify_live(Live, Vst), 579 heap_alloc(Heap, Vst). 580 581heap_alloc(Heap, #vst{current=St}=Vst) -> 582 Vst#vst{current=St#st{h=heap_alloc_1(Heap)}}. 583 584heap_alloc_1({alloc,Alloc}) -> 585 {value,{_,Heap}} = lists:keysearch(words, 1, Alloc), 586 Heap; 587heap_alloc_1(Heap) when is_integer(Heap) -> Heap. 588 589 590set_type(Type, {x,_}=Reg, Vst) -> set_type_reg(Type, Reg, Vst); 591set_type(Type, {y,_}=Reg, Vst) -> set_type_y(Type, Reg, Vst); 592set_type(_, _, #vst{}=Vst) -> Vst. 593 594set_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)}}; 597set_type_reg(Type, Reg, Vst) -> 598 set_type_y(Type, Reg, Vst). 599 600set_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; 610set_type_y(Type, Reg, #vst{}) -> error({invalid_store,Reg,Type}). 611 612assert_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 668assert_type(WantedType, Term, Vst) -> 669 assert_type(WantedType, get_type(Term, Vst)), 670 Vst. 671 672assert_type(float, {float,_}) -> ok; 673assert_type(tuple, {tuple,_}) -> ok; 674assert_type({tuple_element,I}, {tuple,[Sz]}) 675 when 1 =< I, I =< Sz -> 676 ok; 677assert_type({tuple_element,I}, {tuple,Sz}) 678 when is_integer(Sz), 1 =< I, I =< Sz -> 679 ok; 680assert_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 689upgrade_type(Same, Same) -> Same; 690upgrade_type(term, OldT) -> OldT; 691upgrade_type(NewT, term) -> NewT; 692upgrade_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; 699upgrade_type({Type,_}=NewT, number) 700 when Type == integer; Type == float -> 701 NewT; 702upgrade_type(number, {Type,_}=OldT) 703 when Type == integer; Type == float -> 704 OldT; 705upgrade_type(bool, {atom,A}) -> 706 upgrade_bool(A); 707upgrade_type({atom,A}, bool) -> 708 upgrade_bool(A); 709upgrade_type({tuple,[Sz]}, {tuple,[OldSz]}) 710 when is_integer(Sz) -> 711 {tuple,[max(Sz, OldSz)]}; 712upgrade_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; 719upgrade_type({tuple,[Sz]}, {tuple,_}=T) 720 when is_integer(Sz) -> 721 %% Same as the previous clause but mirrored. 722 T; 723upgrade_type(_A, _B) -> 724 %%io:format("upgrade_type: ~p ~p\n", [_A,_B]), 725 term. 726 727upgrade_bool([]) -> bool; 728upgrade_bool(true) -> {atom,true}; 729upgrade_bool(false) -> {atom,false}; 730upgrade_bool(_) -> term. 731 732get_tuple_size({integer,[]}) -> 0; 733get_tuple_size({integer,Sz}) -> Sz; 734get_tuple_size(_) -> 0. 735 736validate_src(Ss, Vst) when is_list(Ss) -> 737 foldl(fun(S, _) -> get_type(S, Vst) end, ok, Ss). 738 739get_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 748get_type(nil=T, _) -> T; 749get_type({atom,A}=T, _) when is_atom(A) -> T; 750get_type({float,F}=T, _) when is_float(F) -> T; 751get_type({integer,I}=T, _) when is_integer(I) -> T; 752get_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; 757get_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; 763get_type(Src, _) -> error({bad_source,Src}). 764 765branch_arities([], _, #vst{}=Vst) -> Vst; 766branch_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 772branch_state(0, #vst{}=Vst) -> Vst; 773branch_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 788merge_states(0, St, _Branched) -> St; 789merge_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 797merge_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 804merge_stk(S, S) -> S; 805merge_stk(_, _) -> undecided. 806 807merge_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 811merge_regs_1([Same|Rs1], [Same|Rs2]) -> 812 [Same|merge_regs_1(Rs1, Rs2)]; 813merge_regs_1([{R1,_}|Rs1], [{R2,_}|_]=Rs2) when R1 < R2 -> 814 merge_regs_1(Rs1, Rs2); 815merge_regs_1([{R1,_}|_]=Rs1, [{R2,_}|Rs2]) when R1 > R2 -> 816 merge_regs_1(Rs1, Rs2); 817merge_regs_1([{R,Type1}|Rs1], [{R,Type2}|Rs2]) -> 818 [{R,merge_types(Type1, Type2)}|merge_regs_1(Rs1, Rs2)]; 819merge_regs_1([], []) -> []; 820merge_regs_1([], [_|_]) -> []; 821merge_regs_1([_|_], []) -> []. 822 823merge_types(T, T) -> T; 824merge_types(initialized=I, _) -> I; 825merge_types(_, initialized=I) -> I; 826merge_types({tuple,Same}=T, {tuple,Same}) -> T; 827merge_types({tuple,A}, {tuple,B}) -> 828 {tuple,[min(tuple_sz(A), tuple_sz(B))]}; 829merge_types({Type,A}, {Type,B}) 830 when Type == atom; Type == integer; Type == float -> 831 if A =:= B -> {Type,A}; 832 true -> {Type,[]} 833 end; 834merge_types({Type,_}, number) 835 when Type == integer; Type == float -> 836 number; 837merge_types(number, {Type,_}) 838 when Type == integer; Type == float -> 839 number; 840merge_types(bool, {atom,A}) -> 841 merge_bool(A); 842merge_types({atom,A}, bool) -> 843 merge_bool(A); 844merge_types(_, _) -> term. 845 846tuple_sz([Sz]) -> Sz; 847tuple_sz(Sz) -> Sz. 848 849merge_bool([]) -> {atom,[]}; 850merge_bool(true) -> bool; 851merge_bool(false) -> bool; 852merge_bool(_) -> {atom,[]}. 853 854verify_y_init(#vst{current=#st{numy=none}}) -> ok; 855verify_y_init(#vst{current=#st{numy=undecided}}) -> 856 error(unknown_size_of_stackframe); 857verify_y_init(#vst{current=#st{y=Ys,numy=NumY}}) -> 858 verify_y_init_1(NumY, Ys). 859 860verify_y_init_1(0, _) -> ok; 861verify_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 868verify_live(0, #vst{}) -> ok; 869verify_live(N, #vst{current=#st{x=Xs}}) -> 870 verify_live_1(N, Xs). 871 872verify_live_1(0, _) -> ok; 873verify_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 880eat_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 888bif_type('-', Src, Vst) -> 889 arith_type(Src, Vst); 890bif_type('+', Src, Vst) -> 891 arith_type(Src, Vst); 892bif_type('*', Src, Vst) -> 893 arith_type(Src, Vst); 894bif_type(abs, [Num], Vst) -> 895 case get_type(Num, Vst) of 896 {float,_}=T -> T; 897 {integer,_}=T -> T; 898 _ -> number 899 end; 900bif_type(float, _, _) -> {float,[]}; 901bif_type('/', _, _) -> {float,[]}; 902%% Integer operations. 903bif_type('div', [_,_], _) -> {integer,[]}; 904bif_type('rem', [_,_], _) -> {integer,[]}; 905bif_type(length, [_], _) -> {integer,[]}; 906bif_type(size, [_], _) -> {integer,[]}; 907bif_type(trunc, [_], _) -> {integer,[]}; 908bif_type(round, [_], _) -> {integer,[]}; 909bif_type('band', [_,_], _) -> {integer,[]}; 910bif_type('bor', [_,_], _) -> {integer,[]}; 911bif_type('bxor', [_,_], _) -> {integer,[]}; 912bif_type('bnot', [_], _) -> {integer,[]}; 913bif_type('bsl', [_,_], _) -> {integer,[]}; 914bif_type('bsr', [_,_], _) -> {integer,[]}; 915%% Booleans. 916bif_type('==', [_,_], _) -> bool; 917bif_type('/=', [_,_], _) -> bool; 918bif_type('=<', [_,_], _) -> bool; 919bif_type('<', [_,_], _) -> bool; 920bif_type('>=', [_,_], _) -> bool; 921bif_type('>', [_,_], _) -> bool; 922bif_type('=:=', [_,_], _) -> bool; 923bif_type('=/=', [_,_], _) -> bool; 924bif_type('not', [_], _) -> bool; 925bif_type('and', [_,_], _) -> bool; 926bif_type('or', [_,_], _) -> bool; 927bif_type('xor', [_,_], _) -> bool; 928bif_type(is_atom, [_], _) -> bool; 929bif_type(is_boolean, [_], _) -> bool; 930bif_type(is_binary, [_], _) -> bool; 931bif_type(is_constant, [_], _) -> bool; 932bif_type(is_float, [_], _) -> bool; 933bif_type(is_function, [_], _) -> bool; 934bif_type(is_integer, [_], _) -> bool; 935bif_type(is_list, [_], _) -> bool; 936bif_type(is_number, [_], _) -> bool; 937bif_type(is_pid, [_], _) -> bool; 938bif_type(is_port, [_], _) -> bool; 939bif_type(is_reference, [_], _) -> bool; 940bif_type(is_tuple, [_], _) -> bool; 941%% Misc. 942bif_type(node, [], _) -> {atom,[]}; 943bif_type(node, [_], _) -> {atom,[]}; 944bif_type(hd, [_], _) -> term; 945bif_type(tl, [_], _) -> term; 946bif_type(get, [_], _) -> term; 947bif_type(raise, [_,_], _) -> exception; 948bif_type(_, _, _) -> term. 949 950arith_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; 956arith_type(_, _) -> number. 957 958return_type({extfunc,M,F,A}, Vst) -> 959 return_type_1(M, F, A, Vst). 960 961return_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; 973return_type_1(erlang, F, A, _) -> 974 return_type_erl(F, A); 975return_type_1(math, F, A, _) -> 976 return_type_math(F, A); 977return_type_1(_, _, _, _) -> term. 978 979return_type_erl(exit, 1) -> exception; 980return_type_erl(throw, 1) -> exception; 981return_type_erl(fault, 1) -> exception; 982return_type_erl(fault, 2) -> exception; 983return_type_erl(error, 1) -> exception; 984return_type_erl(error, 2) -> exception; 985return_type_erl(_, _) -> term. 986 987return_type_math(cos, 1) -> {float,[]}; 988return_type_math(cosh, 1) -> {float,[]}; 989return_type_math(sin, 1) -> {float,[]}; 990return_type_math(sinh, 1) -> {float,[]}; 991return_type_math(tan, 1) -> {float,[]}; 992return_type_math(tanh, 1) -> {float,[]}; 993return_type_math(acos, 1) -> {float,[]}; 994return_type_math(acosh, 1) -> {float,[]}; 995return_type_math(asin, 1) -> {float,[]}; 996return_type_math(asinh, 1) -> {float,[]}; 997return_type_math(atan, 1) -> {float,[]}; 998return_type_math(atanh, 1) -> {float,[]}; 999return_type_math(erf, 1) -> {float,[]}; 1000return_type_math(erfc, 1) -> {float,[]}; 1001return_type_math(exp, 1) -> {float,[]}; 1002return_type_math(log, 1) -> {float,[]}; 1003return_type_math(log10, 1) -> {float,[]}; 1004return_type_math(sqrt, 1) -> {float,[]}; 1005return_type_math(atan2, 2) -> {float,[]}; 1006return_type_math(pow, 2) -> {float,[]}; 1007return_type_math(pi, 0) -> {float,[]}; 1008return_type_math(_, _) -> term. 1009 1010min(A, B) when is_integer(A), is_integer(B), A < B -> A; 1011min(A, B) when is_integer(A), is_integer(B) -> B. 1012 1013max(A, B) when is_integer(A), is_integer(B), A > B -> A; 1014max(A, B) when is_integer(A), is_integer(B) -> B. 1015 1016gb_trees_from_list(L) -> gb_trees:from_orddict(orddict:from_list(L)). 1017 1018-ifdef(DEBUG). 1019error(Error) -> exit(Error). 1020-else. 1021error(Error) -> throw(Error). 1022-endif. 1023