1%% 2%% %CopyrightBegin% 3%% 4%% Copyright Ericsson AB 2011-2020. All Rights Reserved. 5%% 6%% Licensed under the Apache License, Version 2.0 (the "License"); 7%% you may not use this file except in compliance with the License. 8%% You may obtain a copy of the License at 9%% 10%% http://www.apache.org/licenses/LICENSE-2.0 11%% 12%% Unless required by applicable law or agreed to in writing, software 13%% distributed under the License is distributed on an "AS IS" BASIS, 14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15%% See the License for the specific language governing permissions and 16%% limitations under the License. 17%% 18%% %CopyrightEnd% 19%% 20 21-module(beam_except). 22-export([module/2]). 23 24%%% Rewrite certain calls to erlang:error/{1,2} to specialized 25%%% instructions: 26%%% 27%%% erlang:error({badmatch,Value}) => badmatch Value 28%%% erlang:error({case_clause,Value}) => case_end Value 29%%% erlang:error({try_clause,Value}) => try_case_end Value 30%%% erlang:error(if_clause) => if_end 31%%% erlang:error(function_clause, Args) => jump FuncInfoLabel 32%%% 33 34-import(lists, [reverse/1,reverse/2,seq/2,splitwith/2]). 35 36-spec module(beam_utils:module_code(), [compile:option()]) -> 37 {'ok',beam_utils:module_code()}. 38 39module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> 40 Fs = [function(F) || F <- Fs0], 41 {ok,{Mod,Exp,Attr,Fs,Lc}}. 42 43function({function,Name,Arity,CLabel,Is0}) -> 44 try 45 Is = function_1(Is0), 46 {function,Name,Arity,CLabel,Is} 47 catch 48 Class:Error:Stack -> 49 io:fwrite("Function: ~w/~w\n", [Name,Arity]), 50 erlang:raise(Class, Error, Stack) 51 end. 52 53-record(st, 54 {lbl :: beam_asm:label(), %func_info label 55 loc :: [_], %location for func_info 56 arity :: arity() %arity for function 57 }). 58 59function_1(Is0) -> 60 case Is0 of 61 [{label,Lbl},{line,Loc},{func_info,_,_,Arity}|_] -> 62 St = #st{lbl=Lbl,loc=Loc,arity=Arity}, 63 translate(Is0, St, []); 64 [{label,_}|_] -> 65 %% No line numbers. The source must be a .S file. 66 %% There is no need to do anything. 67 Is0 68 end. 69 70translate([{call_ext,Ar,{extfunc,erlang,error,Ar}}=I|Is], St, Acc) -> 71 translate_1(Ar, I, Is, St, Acc); 72translate([I|Is], St, Acc) -> 73 translate(Is, St, [I|Acc]); 74translate([], _, Acc) -> 75 reverse(Acc). 76 77translate_1(Ar, I, Is, #st{arity=Arity}=St, [{line,_}=Line|Acc1]=Acc0) -> 78 case dig_out(Ar, Arity, Acc1) of 79 no -> 80 translate(Is, St, [I|Acc0]); 81 {yes,function_clause,Acc2} -> 82 case {Is,Line,St} of 83 {[return|_],{line,Loc},#st{lbl=Fi,loc=Loc}} -> 84 Instr = {jump,{f,Fi}}, 85 translate(Is, St, [Instr|Acc2]); 86 {_,_,_} -> 87 %% Not a call_only instruction, or not the same 88 %% location information as in in the line instruction 89 %% before the func_info instruction. Not safe 90 %% to translate to a jump. 91 translate(Is, St, [I|Acc0]) 92 end; 93 {yes,Instr,Acc2} -> 94 translate(Is, St, [Instr,Line|Acc2]) 95 end. 96 97dig_out(1, _Arity, Is) -> 98 dig_out(Is); 99dig_out(2, Arity, Is) -> 100 dig_out_fc(Arity, Is); 101dig_out(_, _, _) -> no. 102 103dig_out([{block,Bl0}|Is]) -> 104 case dig_out_block(reverse(Bl0)) of 105 no -> no; 106 {yes,What,[]} -> 107 {yes,What,Is}; 108 {yes,What,Bl} -> 109 {yes,What,[{block,Bl}|Is]} 110 end; 111dig_out(_) -> no. 112 113dig_out_block([{set,[{x,0}],[{atom,if_clause}],move}]) -> 114 {yes,if_end,[]}; 115dig_out_block([{set,[{x,0}],[{literal,{Exc,Value}}],move}|Is]) -> 116 translate_exception(Exc, {literal,Value}, Is, 0); 117dig_out_block([{set,[{x,0}],[{atom,Exc},Value],put_tuple2}|Is]) -> 118 translate_exception(Exc, Value, Is, 3); 119dig_out_block(_) -> no. 120 121translate_exception(badmatch, Val, Is, Words) -> 122 {yes,{badmatch,Val},fix_block(Is, Words)}; 123translate_exception(case_clause, Val, Is, Words) -> 124 {yes,{case_end,Val},fix_block(Is, Words)}; 125translate_exception(try_clause, Val, Is, Words) -> 126 {yes,{try_case_end,Val},fix_block(Is, Words)}; 127translate_exception(_, _, _, _) -> no. 128 129fix_block(Is, 0) -> 130 reverse(Is); 131fix_block(Is, Words) -> 132 reverse(fix_block_1(Is, Words)). 133 134fix_block_1([{set,[],[],{alloc,Live,{F1,F2,Needed0,F3}}}|Is], Words) 135 when is_integer(Needed0) -> 136 case Needed0 - Words of 137 0 -> 138 Is; 139 Needed -> 140 true = Needed >= 0, %Assertion. 141 [{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is] 142 end; 143fix_block_1([I|Is], Words) -> 144 [I|fix_block_1(Is, Words)]; 145fix_block_1([], _Words) -> 146 %% Rare. The heap allocation was probably done by a binary 147 %% construction instruction. 148 []. 149 150dig_out_fc(Arity, Is0) -> 151 Regs0 = maps:from_list([{{x,X},{arg,X}} || X <- seq(0, Arity-1)]), 152 {Is,Acc0} = splitwith(fun({label,_}) -> false; 153 ({test,_,_,_}) -> false; 154 (_) -> true 155 end, Is0), 156 {Regs,Acc} = dig_out_fc_1(reverse(Is), Arity, Regs0, Acc0), 157 case Regs of 158 #{{x,0}:={atom,function_clause},{x,1}:=Args} -> 159 case moves_from_stack(Args, 0, []) of 160 {Moves,Arity} -> 161 {yes,function_clause,reverse(Moves, Acc)}; 162 {_,_} -> 163 no 164 end; 165 #{} -> 166 no 167 end. 168 169dig_out_fc_1([{block,Bl}|Is], Arity, Regs0, Acc) -> 170 Regs = dig_out_fc_block(Bl, Regs0), 171 dig_out_fc_1(Is, Arity, Regs, Acc); 172dig_out_fc_1([{bs_set_position,_,_}=I|Is], Arity, Regs, Acc) -> 173 dig_out_fc_1(Is, Arity, Regs, [I|Acc]); 174dig_out_fc_1([{bs_get_tail,Src,Dst,Live0}|Is], Arity, Regs0, Acc) -> 175 case Src of 176 {x,X} when X < Arity -> 177 %% The heuristic for determining the number of live 178 %% registers is likely to give an incorrect result. 179 %% Give up. 180 {#{},[]}; 181 _ -> 182 Regs = prune_xregs(Live0, Regs0), 183 Live = dig_out_stack_live(Regs, Live0), 184 I = {bs_get_tail,Src,Dst,Live}, 185 dig_out_fc_1(Is, Arity, Regs, [I|Acc]) 186 end; 187dig_out_fc_1([_|_], _Arity, _Regs, _Acc) -> 188 {#{},[]}; 189dig_out_fc_1([], _Arity, Regs, Acc) -> 190 {Regs,Acc}. 191 192dig_out_fc_block([{set,[],[],{alloc,Live,_}}|Is], Regs0) -> 193 Regs = prune_xregs(Live, Regs0), 194 dig_out_fc_block(Is, Regs); 195dig_out_fc_block([{set,[Dst],[Hd,Tl],put_list}|Is], Regs0) -> 196 Regs = Regs0#{Dst=>{cons,get_reg(Hd, Regs0),get_reg(Tl, Regs0)}}, 197 dig_out_fc_block(Is, Regs); 198dig_out_fc_block([{set,[Dst],[Src],move}|Is], Regs0) -> 199 Regs = Regs0#{Dst=>get_reg(Src, Regs0)}, 200 dig_out_fc_block(Is, Regs); 201dig_out_fc_block([{set,_,_,_}|_], _Regs) -> 202 %% Unknown instruction. Fail. 203 #{}; 204dig_out_fc_block([], Regs) -> Regs. 205 206dig_out_stack_live(Regs, Default) -> 207 Reg = {x,2}, 208 case Regs of 209 #{Reg:=List} -> 210 dig_out_stack_live_1(List, Default); 211 #{} -> 212 Default 213 end. 214 215dig_out_stack_live_1({cons,{arg,N},T}, Live) -> 216 dig_out_stack_live_1(T, max(N + 1, Live)); 217dig_out_stack_live_1({cons,_,T}, Live) -> 218 dig_out_stack_live_1(T, Live); 219dig_out_stack_live_1(nil, Live) -> 220 Live; 221dig_out_stack_live_1(_, Live) -> Live. 222 223prune_xregs(Live, Regs) -> 224 maps:filter(fun({x,X}, _) -> X < Live end, Regs). 225 226moves_from_stack({cons,{arg,N},_}, I, _Acc) when N =/= I -> 227 %% Wrong argument. Give up. 228 {[],-1}; 229moves_from_stack({cons,H,T}, I, Acc) -> 230 case H of 231 {arg,I} -> 232 moves_from_stack(T, I+1, Acc); 233 _ -> 234 moves_from_stack(T, I+1, [{move,H,{x,I}}|Acc]) 235 end; 236moves_from_stack(nil, I, Acc) -> 237 {reverse(Acc),I}; 238moves_from_stack({literal,[H|T]}, I, Acc) -> 239 Cons = {cons,tag_literal(H),tag_literal(T)}, 240 moves_from_stack(Cons, I, Acc); 241moves_from_stack(_, _, _) -> 242 %% Not understood. Give up. 243 {[],-1}. 244 245 246get_reg(R, Regs) -> 247 case Regs of 248 #{R:=Val} -> Val; 249 #{} -> R 250 end. 251 252tag_literal([]) -> nil; 253tag_literal(T) when is_atom(T) -> {atom,T}; 254tag_literal(T) when is_float(T) -> {float,T}; 255tag_literal(T) when is_integer(T) -> {integer,T}; 256tag_literal(T) -> {literal,T}. 257