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%%
17%%     $Id: beam_asm.erl,v 1.1 2008/12/17 09:53:40 mikpe Exp $
18%% Purpose : Assembler for threaded Beam.
19
20-module(beam_asm).
21
22-export([module/4,format_error/1]).
23-export([encode/2]).
24
25-import(lists, [map/2,member/2,keymember/3,duplicate/2]).
26-include("beam_opcodes.hrl").
27
28-define(bs_aligned, 1).
29
30module(Code, Abst, SourceFile, Opts) ->
31    case assemble(Code, Abst, SourceFile, Opts) of
32	{error, Error} ->
33	    {error, [{none, ?MODULE, Error}]};
34	Bin when binary(Bin) ->
35	    {ok, Bin}
36    end.
37
38format_error({crashed, Why}) ->
39    io_lib:format("beam_asm_int: EXIT: ~p", [Why]).
40
41assemble({Mod,Exp,Attr,Asm,NumLabels}, Abst, SourceFile, Opts) ->
42    {1,Dict0} = beam_dict:atom(Mod, beam_dict:new()),
43    NumFuncs = length(Asm),
44    {Code,Dict1} = assemble_1(Asm, Exp, Dict0, []),
45    build_file(Code, Attr, Dict1, NumLabels, NumFuncs, Abst, SourceFile, Opts).
46
47assemble_1([{function,Name,Arity,Entry,Asm}|T], Exp, Dict0, Acc) ->
48    Dict1 = case member({Name,Arity}, Exp) of
49		true ->
50		    beam_dict:export(Name, Arity, Entry, Dict0);
51		false ->
52		    beam_dict:local(Name, Arity, Entry, Dict0)
53	    end,
54    {Code, Dict2} = assemble_function(Asm, Acc, Dict1),
55    assemble_1(T, Exp, Dict2, Code);
56assemble_1([], _Exp, Dict0, Acc) ->
57    {IntCodeEnd,Dict1} = make_op(int_code_end, Dict0),
58    {list_to_binary(lists:reverse(Acc, [IntCodeEnd])),Dict1}.
59
60assemble_function([H|T], Acc, Dict0) ->
61    {Code, Dict} = make_op(H, Dict0),
62    assemble_function(T, [Code| Acc], Dict);
63assemble_function([], Code, Dict) ->
64    {Code, Dict}.
65
66build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) ->
67    %% Create the code chunk.
68
69    CodeChunk = chunk(<<"Code">>,
70		      <<16:32,
71		       (beam_opcodes:format_number()):32,
72		       (beam_dict:highest_opcode(Dict)):32,
73		       NumLabels:32,
74		       NumFuncs:32>>,
75		      Code),
76
77    %% Create the atom table chunk.
78
79    {NumAtoms, AtomTab} = beam_dict:atom_table(Dict),
80    AtomChunk = chunk(<<"Atom">>, <<NumAtoms:32>>, AtomTab),
81
82    %% Create the import table chunk.
83
84    {NumImps, ImpTab0} = beam_dict:import_table(Dict),
85    Imp = flatten_imports(ImpTab0),
86    ImportChunk = chunk(<<"ImpT">>, <<NumImps:32>>, Imp),
87
88    %% Create the export table chunk.
89
90    {NumExps, ExpTab0} = beam_dict:export_table(Dict),
91    Exp = flatten_exports(ExpTab0),
92    ExpChunk = chunk(<<"ExpT">>, <<NumExps:32>>, Exp),
93
94    %% Create the local function table chunk.
95
96    {NumLocals, Locals} = beam_dict:local_table(Dict),
97    Loc = flatten_exports(Locals),
98    LocChunk = chunk(<<"LocT">>, <<NumLocals:32>>, Loc),
99
100    %% Create the string table chunk.
101
102    {_,StringTab} = beam_dict:string_table(Dict),
103    StringChunk = chunk(<<"StrT">>, StringTab),
104
105    %% Create the fun table chunk. It is important not to build an empty chunk,
106    %% as that would change the MD5.
107
108    LambdaChunk = case beam_dict:lambda_table(Dict) of
109		      {0,[]} -> [];
110		      {NumLambdas,LambdaTab} ->
111			  chunk(<<"FunT">>, <<NumLambdas:32>>, LambdaTab)
112		  end,
113
114    %% Create the attributes and compile info chunks.
115
116    Essentials = [AtomChunk,CodeChunk,StringChunk,ImportChunk,ExpChunk,LambdaChunk],
117    {Attributes,Compile} = build_attributes(Opts, SourceFile, Attr, Essentials),
118    AttrChunk = chunk(<<"Attr">>, Attributes),
119    CompileChunk = chunk(<<"CInf">>, Compile),
120
121    %% Create the abstract code chunk.
122
123    AbstChunk = chunk(<<"Abst">>, Abst),
124
125    %% Create IFF chunk.
126
127    Chunks = case member(slim, Opts) of
128		 true -> [Essentials,AttrChunk,CompileChunk,AbstChunk];
129		 false -> [Essentials,LocChunk,AttrChunk,CompileChunk,AbstChunk]
130	     end,
131    build_form(<<"BEAM">>, Chunks).
132
133%% Build an IFF form.
134
135build_form(Id, Chunks0) when size(Id) == 4, list(Chunks0) ->
136    Chunks = list_to_binary(Chunks0),
137    Size = size(Chunks),
138    0 = Size rem 4,				% Assertion: correct padding?
139    <<"FOR1",(Size+4):32,Id/binary,Chunks/binary>>.
140
141%% Build a correctly padded chunk (with no sub-header).
142
143chunk(Id, Contents) when size(Id) == 4, binary(Contents) ->
144    Size = size(Contents),
145    [<<Id/binary,Size:32>>,Contents|pad(Size)];
146chunk(Id, Contents) when list(Contents) ->
147    chunk(Id, list_to_binary(Contents)).
148
149%% Build a correctly padded chunk (with a sub-header).
150
151chunk(Id, Head, Contents) when size(Id) == 4, is_binary(Head), is_binary(Contents) ->
152    Size = size(Head)+size(Contents),
153    [<<Id/binary,Size:32,Head/binary>>,Contents|pad(Size)];
154chunk(Id, Head, Contents) when list(Contents) ->
155    chunk(Id, Head, list_to_binary(Contents)).
156
157pad(Size) ->
158    case Size rem 4 of
159	0 -> [];
160	Rem -> duplicate(4 - Rem, 0)
161    end.
162
163flatten_exports(Exps) ->
164    list_to_binary(map(fun({F,A,L}) -> <<F:32,A:32,L:32>> end, Exps)).
165
166flatten_imports(Imps) ->
167    list_to_binary(map(fun({M,F,A}) -> <<M:32,F:32,A:32>> end, Imps)).
168
169build_attributes(Opts, SourceFile, Attr, Essentials) ->
170    Misc = case member(slim, Opts) of
171	       false ->
172		   {{Y,Mo,D},{H,Mi,S}} = erlang:universaltime(),
173		   [{time,{Y,Mo,D,H,Mi,S}},{source,SourceFile}];
174	       true -> []
175	   end,
176    Compile = [{options,Opts},{version,?COMPILER_VSN}|Misc],
177    {term_to_binary(calc_vsn(Attr, Essentials)),term_to_binary(Compile)}.
178
179%%
180%% If the attributes contains no 'vsn' attribute, we'll insert one
181%% with an MD5 "checksum" calculated on the code as its value.
182%% We'll not change an existing 'vsn' attribute.
183%%
184
185calc_vsn(Attr, Essentials) ->
186    case keymember(vsn, 1, Attr) of
187	true -> Attr;
188	false ->
189	    <<Number:128>> = erlang:md5(Essentials),
190	    [{vsn,[Number]}|Attr]
191    end.
192
193bif_type('-', 1)    -> negate;
194bif_type('+', 2)    -> {op, m_plus};
195bif_type('-', 2)    -> {op, m_minus};
196bif_type('*', 2)    -> {op, m_times};
197bif_type('/', 2)    -> {op, m_div};
198bif_type('div', 2)  -> {op, int_div};
199bif_type('rem', 2)  -> {op, int_rem};
200bif_type('band', 2) -> {op, int_band};
201bif_type('bor', 2)  -> {op, int_bor};
202bif_type('bxor', 2) -> {op, int_bxor};
203bif_type('bsl', 2)  -> {op, int_bsl};
204bif_type('bsr', 2)  -> {op, int_bsr};
205bif_type('bnot', 1) -> {op, int_bnot};
206bif_type(fnegate, 1)   -> {op, fnegate};
207bif_type(fadd, 2)   -> {op, fadd};
208bif_type(fsub, 2)   -> {op, fsub};
209bif_type(fmul, 2)   -> {op, fmul};
210bif_type(fdiv, 2)   -> {op, fdiv};
211bif_type(_, _)      -> bif.
212
213make_op(Comment, Dict) when element(1, Comment) == '%' ->
214    {[],Dict};
215make_op({'%live',_R}, Dict) ->
216    {[],Dict};
217make_op({bif, Bif, nofail, [], Dest}, Dict) ->
218    encode_op(bif0, [{extfunc, erlang, Bif, 0}, Dest], Dict);
219make_op({bif, raise, _Fail, [A1,A2], _Dest}, Dict) ->
220    encode_op(raise, [A1,A2], Dict);
221make_op({bif, Bif, Fail, Args, Dest}, Dict) ->
222    Arity = length(Args),
223    case bif_type(Bif, Arity) of
224	{op, Op} ->
225	    make_op(list_to_tuple([Op, Fail|Args++[Dest]]), Dict);
226	negate ->
227	    %% Fake negation operator.
228	    make_op({m_minus, Fail, {integer,0}, hd(Args), Dest}, Dict);
229	bif ->
230	    BifOp = list_to_atom(lists:concat([bif, Arity])),
231	    encode_op(BifOp, [Fail, {extfunc, erlang, Bif, Arity}|Args++[Dest]],
232		      Dict)
233    end;
234make_op({bs_add=Op,Fail,[Src1,Src2,Unit],Dest}, Dict) ->
235    encode_op(Op, [Fail,Src1,Src2,Unit,Dest], Dict);
236make_op({test,Cond,Fail,Ops}, Dict) when list(Ops) ->
237    encode_op(Cond, [Fail|Ops], Dict);
238make_op({make_fun2,{f,Lbl},Index,OldUniq,NumFree}, Dict0) ->
239    {Fun,Dict} = beam_dict:lambda(Lbl, Index, OldUniq, NumFree, Dict0),
240    make_op({make_fun2,Fun}, Dict);
241make_op(Op, Dict) when atom(Op) ->
242    encode_op(Op, [], Dict);
243make_op({kill,Y}, Dict) ->
244    make_op({init,Y}, Dict);
245make_op({Name,Arg1}, Dict) ->
246    encode_op(Name, [Arg1], Dict);
247make_op({Name,Arg1,Arg2}, Dict) ->
248    encode_op(Name, [Arg1,Arg2], Dict);
249make_op({Name,Arg1,Arg2,Arg3}, Dict) ->
250    encode_op(Name, [Arg1,Arg2,Arg3], Dict);
251make_op({Name,Arg1,Arg2,Arg3,Arg4}, Dict) ->
252    encode_op(Name, [Arg1,Arg2,Arg3,Arg4], Dict);
253make_op({Name,Arg1,Arg2,Arg3,Arg4,Arg5}, Dict) ->
254    encode_op(Name, [Arg1,Arg2,Arg3,Arg4,Arg5], Dict);
255make_op({Name,Arg1,Arg2,Arg3,Arg4,Arg5,Arg6}, Dict) ->
256    encode_op(Name, [Arg1,Arg2,Arg3,Arg4,Arg5,Arg6], Dict).
257
258encode_op(Name, Args, Dict0) when atom(Name) ->
259    {EncArgs,Dict1} = encode_args(Args, Dict0),
260    Op = beam_opcodes:opcode(Name, length(Args)),
261    Dict2 = beam_dict:opcode(Op, Dict1),
262    {list_to_binary([Op|EncArgs]),Dict2}.
263
264encode_args([Arg| T], Dict0) ->
265    {EncArg, Dict1} = encode_arg(Arg, Dict0),
266    {EncTail, Dict2} = encode_args(T, Dict1),
267    {[EncArg| EncTail], Dict2};
268encode_args([], Dict) ->
269    {[], Dict}.
270
271encode_arg({x, X}, Dict) when X >= 0 ->
272    {encode(?tag_x, X), Dict};
273encode_arg({y, Y}, Dict) when Y >= 0 ->
274    {encode(?tag_y, Y), Dict};
275encode_arg({atom, Atom}, Dict0) when atom(Atom) ->
276    {Index, Dict} = beam_dict:atom(Atom, Dict0),
277    {encode(?tag_a, Index), Dict};
278encode_arg({integer, N}, Dict) ->
279    {encode(?tag_i, N), Dict};
280encode_arg(nil, Dict) ->
281    {encode(?tag_a, 0), Dict};
282encode_arg({f, W}, Dict) ->
283    {encode(?tag_f, W), Dict};
284encode_arg({'char', C}, Dict) ->
285    {encode(?tag_h, C), Dict};
286encode_arg({string, String}, Dict0) ->
287    {Offset, Dict} = beam_dict:string(String, Dict0),
288    {encode(?tag_u, Offset), Dict};
289encode_arg({extfunc, M, F, A}, Dict0) ->
290    {Index, Dict} = beam_dict:import(M, F, A, Dict0),
291    {encode(?tag_u, Index), Dict};
292encode_arg({list, List}, Dict0) ->
293    {L, Dict} = encode_list(List, Dict0, []),
294    {[encode(?tag_z, 1), encode(?tag_u, length(List))|L], Dict};
295encode_arg({float, Float}, Dict) when float(Float) ->
296    {[encode(?tag_z, 0)|<<Float:64/float>>], Dict};
297encode_arg({fr,Fr}, Dict) ->
298    {[encode(?tag_z, 2),encode(?tag_u,Fr)], Dict};
299encode_arg({field_flags,Flags0}, Dict) ->
300    Flags = lists:foldl(fun (F, S) -> S bor flag_to_bit(F) end, 0, Flags0),
301    {encode(?tag_u, Flags), Dict};
302encode_arg({alloc,List}, Dict) ->
303    {encode_alloc_list(List),Dict};
304encode_arg(Int, Dict) when is_integer(Int) ->
305    {encode(?tag_u, Int),Dict}.
306
307flag_to_bit(aligned) -> 16#01;
308flag_to_bit(little)  -> 16#02;
309flag_to_bit(big)     -> 16#00;
310flag_to_bit(signed)  -> 16#04;
311flag_to_bit(unsigned)-> 16#00;
312flag_to_bit(exact)   -> 16#08;
313flag_to_bit(native) ->  16#10.
314
315encode_list([H|T], _Dict, _Acc) when is_list(H) ->
316    exit({illegal_nested_list,encode_arg,[H|T]});
317encode_list([H|T], Dict0, Acc) ->
318    {Enc,Dict} = encode_arg(H, Dict0),
319    encode_list(T, Dict, [Enc|Acc]);
320encode_list([], Dict, Acc) ->
321    {lists:reverse(Acc), Dict}.
322
323encode_alloc_list(L0) ->
324    L = encode_alloc_list_1(L0),
325    [encode(?tag_z, 3),encode(?tag_u, length(L0))|L].
326
327encode_alloc_list_1([{words,Words}|T]) ->
328    [encode(?tag_u, 0),encode(?tag_u, Words)|encode_alloc_list_1(T)];
329encode_alloc_list_1([{floats,Floats}|T]) ->
330    [encode(?tag_u, 1),encode(?tag_u, Floats)|encode_alloc_list_1(T)];
331encode_alloc_list_1([]) -> [].
332
333encode(Tag, N) when N < 0 ->
334    encode1(Tag, negative_to_bytes(N, []));
335encode(Tag, N) when N < 16 ->
336    (N bsl 4) bor Tag;
337encode(Tag, N) when N < 16#800  ->
338    [((N bsr 3) band 2#11100000) bor Tag bor 2#00001000, N band 16#ff];
339encode(Tag, N) ->
340    encode1(Tag, to_bytes(N, [])).
341
342encode1(Tag, Bytes) ->
343    case length(Bytes) of
344	Num when 2 =< Num, Num =< 8 ->
345	    [((Num-2) bsl 5) bor 2#00011000 bor Tag| Bytes];
346	Num when 8 < Num ->
347	    [2#11111000 bor Tag, encode(?tag_u, Num-9)| Bytes]
348    end.
349
350to_bytes(0, [B|Acc]) when B < 128 ->
351    [B|Acc];
352to_bytes(N, Acc) ->
353    to_bytes(N bsr 8, [N band 16#ff| Acc]).
354
355negative_to_bytes(-1, [B1, B2|T]) when B1 > 127 ->
356    [B1, B2|T];
357negative_to_bytes(N, Acc) ->
358    negative_to_bytes(N bsr 8, [N band 16#ff|Acc]).
359