diff options
Diffstat (limited to 'lib/compiler/src')
-rw-r--r-- | lib/compiler/src/beam_asm.erl | 2 | ||||
-rw-r--r-- | lib/compiler/src/beam_disasm.erl | 7 | ||||
-rw-r--r-- | lib/compiler/src/beam_except.erl | 22 | ||||
-rw-r--r-- | lib/compiler/src/beam_receive.erl | 2 | ||||
-rw-r--r-- | lib/compiler/src/beam_type.erl | 23 | ||||
-rw-r--r-- | lib/compiler/src/beam_validator.erl | 14 | ||||
-rw-r--r-- | lib/compiler/src/compile.erl | 6 | ||||
-rw-r--r-- | lib/compiler/src/core_lint.erl | 2 | ||||
-rw-r--r-- | lib/compiler/src/erl_bifs.erl | 4 | ||||
-rw-r--r-- | lib/compiler/src/sys_core_fold.erl | 9 |
10 files changed, 64 insertions, 27 deletions
diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index a7c8508321..98967e651f 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -387,7 +387,7 @@ encode_arg({list, List}, Dict0) -> {L, Dict} = encode_list(List, Dict0, []), {[encode(?tag_z, 1), encode(?tag_u, length(List))|L], Dict}; encode_arg({float, Float}, Dict) when is_float(Float) -> - {[encode(?tag_z, 0),<<Float:64/float>>], Dict}; + encode_arg({literal,Float}, Dict); encode_arg({fr,Fr}, Dict) -> {[encode(?tag_z, 2),encode(?tag_u, Fr)], Dict}; encode_arg({field_flags,Flags0}, Dict) -> diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index 62bdc74cc8..67d756c45c 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -512,7 +512,12 @@ decode_z_tagged(Tag,B,Bs,Literals) when (B band 16#08) =:= 0 -> decode_alloc_list(Bs, Literals); 4 -> % literal {{u,LitIndex},RestBs} = decode_arg(Bs), - {{literal,gb_trees:get(LitIndex, Literals)},RestBs}; + case gb_trees:get(LitIndex, Literals) of + Float when is_float(Float) -> + {{float,Float},RestBs}; + Literal -> + {{literal,Literal},RestBs} + end; _ -> ?exit({decode_z_tagged,{invalid_extended_tag,N}}) end; diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl index eddb41a358..e5ec1bd904 100644 --- a/lib/compiler/src/beam_except.erl +++ b/lib/compiler/src/beam_except.erl @@ -49,13 +49,14 @@ function({function,Name,Arity,CLabel,Is0}) -> -record(st, {lbl, %func_info label - loc %location for func_info + loc, %location for func_info + arity %arity for function }). function_1(Is0) -> case Is0 of - [{label,Lbl},{line,Loc}|_] -> - St = #st{lbl=Lbl,loc=Loc}, + [{label,Lbl},{line,Loc},{func_info,_,_,Arity}|_] -> + St = #st{lbl=Lbl,loc=Loc,arity=Arity}, translate(Is0, St, []); [{label,_}|_] -> %% No line numbers. The source must be a .S file. @@ -74,14 +75,14 @@ translate_1(Ar, I, Is, St, [{line,_}=Line|Acc1]=Acc0) -> case dig_out(Ar, Acc1) of no -> translate(Is, St, [I|Acc0]); - {yes,function_clause,Acc2} -> + {yes,{function_clause,Arity},Acc2} -> case {Line,St} of - {{line,Loc},#st{lbl=Fi,loc=Loc}} -> + {{line,Loc},#st{lbl=Fi,loc=Loc,arity=Arity}} -> Instr = {jump,{f,Fi}}, translate(Is, St, [Instr|Acc2]); {_,_} -> %% This must be "error(function_clause, Args)" in - %% the Erlang source code. Don't translate. + %% the Erlang source code or a fun. Don't translate. translate(Is, St, [I|Acc0]) end; {yes,Instr,Acc2} -> @@ -135,11 +136,16 @@ fix_block(Is0, Words) -> [{set,[],[],{alloc,Live,{F1,F2,Needed-Words,F3}}}|Is]. dig_out_block_fc([{set,[],[],{alloc,Live,_}}|Bl]) -> - dig_out_fc(Bl, Live-1, nil); + case dig_out_fc(Bl, Live-1, nil) of + no -> + no; + yes -> + {yes,{function_clause,Live}} + end; dig_out_block_fc(_) -> no. dig_out_fc([{set,[Dst],[{x,Reg},Dst0],put_list}|Is], Reg, Dst0) -> dig_out_fc(Is, Reg-1, Dst); dig_out_fc([{set,[{x,0}],[{atom,function_clause}],move}], -1, {x,1}) -> - {yes,function_clause}; + yes; dig_out_fc(_, _, _) -> no. diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl index 0bb527aeb9..3dd5ed182e 100644 --- a/lib/compiler/src/beam_receive.erl +++ b/lib/compiler/src/beam_receive.erl @@ -249,7 +249,7 @@ opt_ref_used(Is, RefReg, Fail, D) -> Done = gb_sets:singleton(Fail), Regs = regs_init_x0(), try - opt_ref_used_1(Is, RefReg, D, Done, Regs), + _ = opt_ref_used_1(Is, RefReg, D, Done, Regs), true catch throw:not_used -> diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 7392f99fb6..372923a5cf 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -142,9 +142,11 @@ simplify_float(Is0, Ts0) -> throw:not_possible -> not_possible end. -simplify_float_1([{set,[D0],[A],{alloc,_,{gc_bif,'-',{f,0}}}}=I|Is]=Is0, Ts0, Rs0, Acc0) -> - case tdb_find(A, Ts0) of +simplify_float_1([{set,[D0],[A0],{alloc,_,{gc_bif,'-',{f,0}}}}=I|Is]=Is0, + Ts0, Rs0, Acc0) -> + case tdb_find(A0, Ts0) of float -> + A = coerce_to_float(A0), {Rs1,Acc1} = load_reg(A, Ts0, Rs0, Acc0), {D,Rs} = find_dest(D0, Rs1), Areg = fetch_reg(A, Rs), @@ -156,13 +158,16 @@ simplify_float_1([{set,[D0],[A],{alloc,_,{gc_bif,'-',{f,0}}}}=I|Is]=Is0, Ts0, Rs {Rs,Acc} = flush(Rs0, Is0, Acc0), simplify_float_1(Is, Ts, Rs, [I|checkerror(Acc)]) end; -simplify_float_1([{set,[D0],[A,B],{alloc,_,{gc_bif,Op0,{f,0}}}}=I|Is]=Is0, Ts0, Rs0, Acc0) -> - case float_op(Op0, A, B, Ts0) of +simplify_float_1([{set,[D0],[A0,B0],{alloc,_,{gc_bif,Op0,{f,0}}}}=I|Is]=Is0, + Ts0, Rs0, Acc0) -> + case float_op(Op0, A0, B0, Ts0) of no -> Ts = update(I, Ts0), {Rs,Acc} = flush(Rs0, Is0, Acc0), simplify_float_1(Is, Ts, Rs, [I|checkerror(Acc)]); {yes,Op} -> + A = coerce_to_float(A0), + B = coerce_to_float(B0), {Rs1,Acc1} = load_reg(A, Ts0, Rs0, Acc0), {Rs2,Acc2} = load_reg(B, Ts0, Rs1, Acc1), {D,Rs} = find_dest(D0, Rs2), @@ -187,6 +192,16 @@ simplify_float_1([], Ts, Rs, Acc0) -> Is = opt_fmoves(Is0, []), {Is,Ts}. +coerce_to_float({integer,I}=Int) -> + try float(I) of + F -> + {float,F} + catch _:_ -> + %% Let the overflow happen at run-time. + Int + end; +coerce_to_float(Other) -> Other. + opt_fmoves([{set,[{x,_}=R],[{fr,_}]=Src,fmove}=I1, {set,[_]=Dst,[{x,_}=R],move}=I2|Is], Acc) -> case beam_utils:is_killed_block(R, Is) of diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 58aba0b9cc..eb72290306 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -649,7 +649,8 @@ valfun_4(send, Vst) -> call(send, 2, Vst); valfun_4({set_tuple_element,Src,Tuple,I}, Vst) -> assert_term(Src, Vst), - assert_type({tuple_element,I+1}, Tuple, Vst); + assert_type({tuple_element,I+1}, Tuple, Vst), + Vst; %% Match instructions. valfun_4({select_val,Src,{f,Fail},{list,Choices}}, Vst) -> assert_term(Src, Vst), @@ -1044,7 +1045,7 @@ float_op(Src, Dst, Vst0) -> assert_fls(Fls, Vst) -> case get_fls(Vst) of - Fls -> Vst; + Fls -> ok; OtherFls -> error({bad_floating_point_state,OtherFls}) end. @@ -1120,7 +1121,7 @@ bsm_match_state(Slots) -> {match_context,0,Slots}. bsm_validate_context(Reg, Vst) -> - bsm_get_context(Reg, Vst), + _ = bsm_get_context(Reg, Vst), ok. bsm_get_context({x,X}=Reg, #vst{current=#st{x=Xs}}=_Vst) when is_integer(X) -> @@ -1133,7 +1134,7 @@ bsm_get_context(Reg, _) -> error({bad_source,Reg}). bsm_save(Reg, {atom,start}, Vst) -> %% Save point refering to where the match started. %% It is always valid. But don't forget to validate the context register. - bsm_get_context(Reg, Vst), + bsm_validate_context(Reg, Vst), Vst; bsm_save(Reg, SavePoint, Vst) -> case bsm_get_context(Reg, Vst) of @@ -1146,7 +1147,7 @@ bsm_save(Reg, SavePoint, Vst) -> bsm_restore(Reg, {atom,start}, Vst) -> %% (Mostly) automatic save point refering to where the match started. %% It is always valid. But don't forget to validate the context register. - bsm_get_context(Reg, Vst), + bsm_validate_context(Reg, Vst), Vst; bsm_restore(Reg, SavePoint, Vst) -> case bsm_get_context(Reg, Vst) of @@ -1312,8 +1313,7 @@ assert_term(Src, Vst) -> %% assert_type(WantedType, Term, Vst) -> - assert_type(WantedType, get_term_type(Term, Vst)), - Vst. + assert_type(WantedType, get_term_type(Term, Vst)). assert_type(Correct, Correct) -> ok; assert_type(float, {float,_}) -> ok; diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index d2baf51edd..497af2b52c 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -683,7 +683,7 @@ binary_passes() -> %% Remove the target file so we don't have an old one if the compilation fail. remove_file(St) -> - file:delete(St#compile.ofile), + _ = file:delete(St#compile.ofile), {ok,St}. -record(asm_module, {module, @@ -1092,7 +1092,7 @@ makedep_output(#compile{code=Code,options=Opts,ofile=Ofile}=St) -> io:fwrite(Output1, "~ts", [Code]), %% Close the file if relevant. if - CloseOutput -> file:close(Output1); + CloseOutput -> ok = file:close(Output1); true -> ok end, {ok,St} @@ -1231,7 +1231,7 @@ encrypt(des3_cbc=Mode, {K1,K2,K3, IVec}, Bin0) -> random_bytes(N) -> {A,B,C} = now(), - random:seed(A, B, C), + _ = random:seed(A, B, C), random_bytes_1(N, []). random_bytes_1(0, Acc) -> Acc; diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl index 8b688df830..1e8983f594 100644 --- a/lib/compiler/src/core_lint.erl +++ b/lib/compiler/src/core_lint.erl @@ -309,7 +309,7 @@ expr(#c_fun{vars=Vs,body=B}, Def, Rt, St0) -> {Vvs,St1} = variable_list(Vs, St0), return_match(Rt, 1, body(B, union(Vvs, Def), any, St1)); expr(#c_seq{arg=Arg,body=B}, Def, Rt, St0) -> - St1 = expr(Arg, Def, any, St0), %Ignore values + St1 = expr(Arg, Def, 1, St0), body(B, Def, Rt, St1); expr(#c_let{vars=Vs,arg=Arg,body=B}, Def, Rt, St0) -> St1 = body(Arg, Def, let_varcount(Vs), St0), %This is a body diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index 9ad2378d00..cc07f0b9bc 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -68,6 +68,8 @@ is_pure(erlang, atom_to_list, 1) -> true; is_pure(erlang, binary_part, 2) -> true; is_pure(erlang, binary_part, 3) -> true; is_pure(erlang, binary_to_atom, 2) -> true; +is_pure(erlang, binary_to_float, 1) -> true; +is_pure(erlang, binary_to_integer, 1) -> true; is_pure(erlang, binary_to_list, 1) -> true; is_pure(erlang, binary_to_list, 3) -> true; is_pure(erlang, bit_size, 1) -> true; @@ -75,8 +77,10 @@ is_pure(erlang, byte_size, 1) -> true; is_pure(erlang, element, 2) -> true; is_pure(erlang, float, 1) -> true; is_pure(erlang, float_to_list, 1) -> true; +is_pure(erlang, float_to_binary, 1) -> true; is_pure(erlang, hash, 2) -> false; is_pure(erlang, hd, 1) -> true; +is_pure(erlang, integer_to_binary, 1) -> true; is_pure(erlang, integer_to_list, 1) -> true; is_pure(erlang, is_atom, 1) -> true; is_pure(erlang, is_boolean, 1) -> true; diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index d5fec0c869..cda3f7d81e 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -132,7 +132,12 @@ body(Body, Sub) -> body(#c_values{anno=A,es=Es0}, Ctxt, Sub) -> Es1 = expr_list(Es0, Ctxt, Sub), - #c_values{anno=A,es=Es1}; + case Ctxt of + value -> + #c_values{anno=A,es=Es1}; + effect -> + make_effect_seq(Es1, Sub) + end; body(E, Ctxt, Sub) -> ?ASSERT(verify_scope(E, Sub)), expr(E, Ctxt, Sub). @@ -1272,6 +1277,8 @@ eval_element(Call, #c_literal{val=Pos}, #c_var{name=V}, Types) true -> eval_failure(Call, badarg) end; + {ok,_} -> + eval_failure(Call, badarg); error -> Call end; |