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_dict.erl,v 1.1 2008/12/17 09:53:41 mikpe Exp $
18%%
19%% Purpose : Maintain atom, import, and export tables for assembler.
20
21-module(beam_dict).
22
23-export([new/0, opcode/2, highest_opcode/1,
24	 atom/2, local/4, export/4, import/4, string/2, lambda/5,
25	 atom_table/1, local_table/1, export_table/1, import_table/1,
26	 string_table/1,lambda_table/1]).
27
28-record(asm_dict,
29	{atoms = [],				% [{Index, Atom}]
30	 exports = [],				% [{F, A, Label}]
31	 locals = [],				% [{F, A, Label}]
32	 imports = [],				% [{Index, {M, F, A}]
33	 strings = [],				% Deep list of characters
34	 lambdas = [],				% [{...}]
35	 next_atom = 1,
36	 next_import = 0,
37	 string_offset = 0,
38	 highest_opcode = 0
39	}).
40
41new() ->
42    #asm_dict{}.
43
44%% Remembers highest opcode.
45
46opcode(Op, Dict) when Dict#asm_dict.highest_opcode > Op -> Dict;
47opcode(Op, Dict) -> Dict#asm_dict{highest_opcode=Op}.
48
49%% Returns the highest opcode encountered.
50
51highest_opcode(#asm_dict{highest_opcode=Op}) -> Op.
52
53%% Returns the index for an atom (adding it to the atom table if necessary).
54%%    atom(Atom, Dict) -> {Index, Dict'}
55
56atom(Atom, Dict) when atom(Atom) ->
57    NextIndex = Dict#asm_dict.next_atom,
58    case lookup_store(Atom, Dict#asm_dict.atoms, NextIndex) of
59	{Index, _, NextIndex} ->
60	    {Index, Dict};
61	{Index, Atoms, NewIndex} ->
62	    {Index, Dict#asm_dict{atoms=Atoms, next_atom=NewIndex}}
63    end.
64
65%% Remembers an exported function.
66%%    export(Func, Arity, Label, Dict) -> Dict'
67
68export(Func, Arity, Label, Dict0) when atom(Func), integer(Arity), integer(Label) ->
69    {Index, Dict1} = atom(Func, Dict0),
70    Dict1#asm_dict{exports = [{Index, Arity, Label}| Dict1#asm_dict.exports]}.
71
72%% Remembers a local function.
73%%    local(Func, Arity, Label, Dict) -> Dict'
74
75local(Func, Arity, Label, Dict0) when atom(Func), integer(Arity), integer(Label) ->
76    {Index,Dict1} = atom(Func, Dict0),
77    Dict1#asm_dict{locals = [{Index,Arity,Label}| Dict1#asm_dict.locals]}.
78
79%% Returns the index for an import entry (adding it to the import table if necessary).
80%%    import(Mod, Func, Arity, Dict) -> {Index, Dict'}
81
82import(Mod, Func, Arity, Dict) when atom(Mod), atom(Func), integer(Arity) ->
83    NextIndex = Dict#asm_dict.next_import,
84    case lookup_store({Mod, Func, Arity}, Dict#asm_dict.imports, NextIndex) of
85	{Index, _, NextIndex} ->
86	    {Index, Dict};
87	{Index, Imports, NewIndex} ->
88	    {_, D1} = atom(Mod, Dict#asm_dict{imports=Imports, next_import=NewIndex}),
89	    {_, D2} = atom(Func, D1),
90	    {Index, D2}
91    end.
92
93%% Returns the index for a string in the string table (adding the string to the
94%% table if necessary).
95%%    string(String, Dict) -> {Offset, Dict'}
96
97string(Str, Dict) when list(Str) ->
98    #asm_dict{strings = Strings, string_offset = NextOffset} = Dict,
99    case old_string(Str, Strings) of
100	{true, Offset} ->
101	    {Offset, Dict};
102	false ->
103	    NewDict = Dict#asm_dict{strings = Strings++Str,
104				    string_offset = NextOffset+length(Str)},
105	    {NextOffset, NewDict}
106    end.
107
108%% Returns the index for a funentry (adding it to the table if necessary).
109%%    lambda(Dict, Lbl, Index, Uniq, NumFree) -> {Index,Dict'}
110
111lambda(Lbl, Index, OldUniq, NumFree, #asm_dict{lambdas=Lambdas0}=Dict) ->
112    OldIndex = length(Lambdas0),
113    Lambdas = [{Lbl,{OldIndex,Lbl,Index,NumFree,OldUniq}}|Lambdas0],
114    {OldIndex,Dict#asm_dict{lambdas=Lambdas}}.
115
116%% Returns the atom table.
117%%    atom_table(Dict) -> [Length,AtomString...]
118
119atom_table(#asm_dict{atoms=Atoms, next_atom=NumAtoms}) ->
120    Sorted = lists:sort(Atoms),
121    Fun = fun({_, A}) ->
122		  L = atom_to_list(A),
123		  [length(L)|L]
124	  end,
125    {NumAtoms-1, lists:map(Fun, Sorted)}.
126
127%% Returns the table of local functions.
128%%    local_table(Dict) -> {NumLocals, [{Function, Arity, Label}...]}
129
130local_table(#asm_dict{locals = Locals}) ->
131    {length(Locals),Locals}.
132
133%% Returns the export table.
134%%    export_table(Dict) -> {NumExports, [{Function, Arity, Label}...]}
135
136export_table(#asm_dict{exports = Exports}) ->
137    {length(Exports), Exports}.
138
139%% Returns the import table.
140%%    import_table(Dict) -> {NumImports, [{Module, Function, Arity}...]}
141
142import_table(Dict) ->
143    #asm_dict{imports = Imports, next_import = NumImports} = Dict,
144    Sorted = lists:sort(Imports),
145    Fun = fun({_, {Mod, Func, Arity}}) ->
146		  {Atom0, _} = atom(Mod, Dict),
147		  {Atom1, _} = atom(Func, Dict),
148		  {Atom0, Atom1, Arity}
149	  end,
150    {NumImports, lists:map(Fun, Sorted)}.
151
152string_table(#asm_dict{strings = Strings, string_offset = Size}) ->
153    {Size, Strings}.
154
155lambda_table(#asm_dict{locals=Loc0,lambdas=Lambdas0}) ->
156    Lambdas1 = sofs:relation(Lambdas0),
157    Loc = sofs:relation([{Lbl,{F,A}} || {F,A,Lbl} <- Loc0]),
158    Lambdas2 = sofs:relative_product1(Lambdas1, Loc),
159    Lambdas = [<<F:32,A:32,Lbl:32,Index:32,NumFree:32,OldUniq:32>> ||
160		  {{_,Lbl,Index,NumFree,OldUniq},{F,A}} <- sofs:to_external(Lambdas2)],
161    {length(Lambdas),Lambdas}.
162
163%%% Local helper functions.
164
165lookup_store(Key, Dict, NextIndex) ->
166    case catch lookup_store1(Key, Dict, NextIndex) of
167	Index when integer(Index) ->
168	    {Index, Dict, NextIndex};
169	{Index, NewDict} ->
170	    {Index, NewDict, NextIndex+1}
171    end.
172
173lookup_store1(Key, [Pair|Dict], NextIndex) when Key > element(2, Pair) ->
174    {Index, NewDict} = lookup_store1(Key, Dict, NextIndex),
175    {Index, [Pair|NewDict]};
176lookup_store1(Key, [{Index, Key}|_Dict], _NextIndex) ->
177    throw(Index);
178lookup_store1(Key, Dict, NextIndex) ->
179    {NextIndex, [{NextIndex, Key}|Dict]}.
180
181%% Search for string Str in the string pool Pool.
182%%   old_string(Str, Pool) -> false | {true, Offset}
183
184old_string(Str, Pool) ->
185    old_string(Str, Pool, 0).
186
187old_string([C|Str], [C|Pool], Index) ->
188    case lists:prefix(Str, Pool) of
189	true ->
190	    {true, Index};
191	false ->
192	    old_string([C|Str], Pool, Index+1)
193    end;
194old_string(Str, [_|Pool], Index) ->
195    old_string(Str, Pool, Index+1);
196old_string(_Str, [], _Index) ->
197    false.
198