Include location information for line instructions in BEAM files

4 files changed, 109 insertions, 22 deletions

diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl
index d56aeae524..6e63c4d0f2 100644
--- a/lib/compiler/src/beam_asm.erl
+++ b/lib/compiler/src/beam_asm.erl
@@ -31,10 +31,11 @@ module(Code, Abst, SourceFile, Opts) ->
 
 assemble({Mod,Exp,Attr0,Asm0,NumLabels}, Abst, SourceFile, Opts) ->
     {1,Dict0} = beam_dict:atom(Mod, beam_dict:new()),
+    {0,Dict1} = beam_dict:fname(atom_to_list(Mod) ++ ".erl", Dict0),
     NumFuncs = length(Asm0),
     {Asm,Attr} = on_load(Asm0, Attr0),
-    {Code,Dict1} = assemble_1(Asm, Exp, Dict0, []),
-    build_file(Code, Attr, Dict1, NumLabels, NumFuncs, Abst, SourceFile, Opts).
+    {Code,Dict2} = assemble_1(Asm, Exp, Dict1, []),
+    build_file(Code, Attr, Dict2, NumLabels, NumFuncs, Abst, SourceFile, Opts).
 
 on_load(Fs0, Attr0) ->
     case proplists:get_value(on_load, Attr0) of
@@ -136,7 +137,10 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) ->
 			   LitTab = iolist_to_binary(zlib:compress(LitTab2)),
 			   chunk(<<"LitT">>, <<(byte_size(LitTab2)):32>>, LitTab)
 		   end,
+
+    %% Create the line chunk.
     
+    LineChunk = chunk(<<"Line">>, build_line_table(Dict)),
 
     %% Create the attributes and compile info chunks.
 
@@ -154,8 +158,11 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) ->
     %% Create IFF chunk.
 
     Chunks = case member(slim, Opts) of
-		 true -> [Essentials,AttrChunk,AbstChunk];
-		 false -> [Essentials,LocChunk,AttrChunk,CompileChunk,AbstChunk]
+		 true ->
+		     [Essentials,AttrChunk,AbstChunk];
+		 false ->
+		     [Essentials,LocChunk,AttrChunk,
+		      CompileChunk,AbstChunk,LineChunk]
 	     end,
     build_form(<<"BEAM">>, Chunks).
 
@@ -205,6 +212,31 @@ build_attributes(Opts, SourceFile, Attr, Essentials) ->
     Compile = [{options,Opts},{version,?COMPILER_VSN}|Misc],
     {term_to_binary(calc_vsn(Attr, Essentials)),term_to_binary(Compile)}.
 
+build_line_table(Dict) ->
+    {NumLineInstrs,NumFnames0,Fnames0,NumLines,Lines0} =
+	beam_dict:line_table(Dict),
+    NumFnames = NumFnames0 - 1,
+    [_|Fnames1] = Fnames0,
+    Fnames2 = [unicode:characters_to_binary(F) || F <- Fnames1],
+    Fnames = << <<(byte_size(F)):16,F/binary>> || F <- Fnames2 >>,
+    Lines1 = encode_line_items(Lines0, 0),
+    Lines = iolist_to_binary(Lines1),
+    Ver = 0,
+    Bits = 0,
+    <<Ver:32,Bits:32,NumLineInstrs:32,NumLines:32,NumFnames:32,
+     Lines/binary,Fnames/binary>>.
+
+%% encode_line_items([{FnameIndex,Line}], PrevFnameIndex)
+%%  Encode the line items compactly. Tag the FnameIndex with
+%%  an 'a' tag (atom) and only include it when it has changed.
+%%  Tag the line numbers with an 'i' (integer) tag.
+
+encode_line_items([{F,L}|T], F) ->
+    [encode(?tag_i, L)|encode_line_items(T, F)];
+encode_line_items([{F,L}|T], _) ->
+    [encode(?tag_a, F),encode(?tag_i, L)|encode_line_items(T, F)];
+encode_line_items([], _) -> [].
+
 %%
 %% If the attributes contains no 'vsn' attribute, we'll insert one
 %% with an MD5 "checksum" calculated on the code as its value.
@@ -247,8 +279,9 @@ bif_type(_, 2)      -> bif2.
 
 make_op({'%',_}, Dict) ->
     {[],Dict};
-make_op({line,_}, Dict) ->
-    encode_op(line, [0], Dict);
+make_op({line,Location}, Dict0) ->
+    {Index,Dict} = beam_dict:line(Location, Dict0),
+    encode_op(line, [Index], Dict);
 make_op({bif, Bif, {f,_}, [], Dest}, Dict) ->
     %% BIFs without arguments cannot fail.
     encode_op(bif0, [{extfunc, erlang, Bif, 0}, Dest], Dict);
diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl
index c50ed28aa9..ee76623976 100644
--- a/lib/compiler/src/beam_dict.erl
+++ b/lib/compiler/src/beam_dict.erl
@@ -22,9 +22,10 @@
 
 -export([new/0,opcode/2,highest_opcode/1,
 	 atom/2,local/4,export/4,import/4,
-	 string/2,lambda/5,literal/2,
+	 string/2,lambda/5,literal/2,line/2,fname/2,
 	 atom_table/1,local_table/1,export_table/1,import_table/1,
-	 string_table/1,lambda_table/1,literal_table/1]).
+	 string_table/1,lambda_table/1,literal_table/1,
+	 line_table/1]).
 
 -type label() :: non_neg_integer().
 
@@ -36,6 +37,9 @@
 	 strings = <<>>		    :: binary(),	%String pool
 	 lambdas = [],				%[{...}]
 	 literals = dict:new()	    :: dict(),	%Format: {Literal,Number}
+	 fnames = gb_trees:empty()  :: gb_tree(),       %{Name,Index}
+	 lines = gb_trees:empty()   :: gb_tree(),	%{{Fname,Line},Index}
+	 num_lines = 0		    :: non_neg_integer(), %Number of line instructions
 	 next_import = 0	    :: non_neg_integer(),
 	 string_offset = 0	    :: non_neg_integer(),
 	 next_literal = 0	    :: non_neg_integer(),
@@ -152,6 +156,36 @@ literal(Lit, #asm{literals=Tab0,next_literal=NextIndex}=Dict) ->
 	    {NextIndex,Dict#asm{literals=Tab,next_literal=NextIndex+1}}
     end.
 
+%% Returns the index for a line instruction (adding information
+%% to the location information table).
+-spec line(list(), bdict()) -> {non_neg_integer(), bdict()}.
+
+line([], #asm{num_lines=N}=Dict) ->
+    %% No location available. Return the special pre-defined
+    %% index 0.
+    {0,Dict#asm{num_lines=N+1}};
+line([{location,Name,Line}], #asm{lines=Lines0,num_lines=N}=Dict0) ->
+    {FnameIndex,Dict1} = fname(Name, Dict0),
+    case gb_trees:lookup({FnameIndex,Line}, Lines0) of
+	{value,Index} ->
+	    {Index,Dict1#asm{num_lines=N+1}};
+	none ->
+	    Index = gb_trees:size(Lines0) + 1,
+	    Lines = gb_trees:insert({FnameIndex,Line}, Index, Lines0),
+	    Dict = Dict1#asm{lines=Lines,num_lines=N+1},
+	    {Index,Dict}
+    end.
+
+fname(Name, #asm{fnames=Fnames0}=Dict) ->
+    case gb_trees:lookup(Name, Fnames0) of
+	{value,Index} ->
+	    {Index,Dict};
+	none ->
+	    Index = gb_trees:size(Fnames0),
+	    Fnames = gb_trees:insert(Name, Index, Fnames0),
+	    {Index,Dict#asm{fnames=Fnames}}
+    end.
+
 %% Returns the atom table.
 %%    atom_table(Dict) -> {LastIndex,[Length,AtomString...]}
 -spec atom_table(bdict()) -> {non_neg_integer(), [[non_neg_integer(),...]]}.
@@ -219,6 +253,21 @@ literal_table(#asm{literals=Tab,next_literal=NumLiterals}) ->
 my_term_to_binary(Term) ->
     term_to_binary(Term, [{minor_version,1}]).
 
+%% Return the line table.
+-spec line_table(bdict()) ->
+    {non_neg_integer(),				%Number of line instructions.
+     non_neg_integer(),[string()],
+     non_neg_integer(),[{non_neg_integer(),non_neg_integer()}]}.
+
+line_table(#asm{fnames=Fnames0,lines=Lines0,num_lines=NumLineInstrs}) ->
+    NumFnames = gb_trees:size(Fnames0),
+    Fnames1 = lists:keysort(2, gb_trees:to_list(Fnames0)),
+    Fnames = [Name || {Name,_} <- Fnames1],
+    NumLines = gb_trees:size(Lines0),
+    Lines1 = lists:keysort(2, gb_trees:to_list(Lines0)),
+    Lines = [L || {L,_} <- Lines1],
+    {NumLineInstrs,NumFnames,Fnames,NumLines,Lines}.
+
 %% Search for binary string Str in the binary string pool Pool.
 %%    old_string(Str, Pool) -> none | Index
 -spec old_string(binary(), binary()) -> 'none' | pos_integer().
diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl
index fc1800d8be..410233a0f7 100644
--- a/lib/compiler/src/beam_disasm.erl
+++ b/lib/compiler/src/beam_disasm.erl
@@ -296,6 +296,8 @@ get_function_chunks(Code) ->
 labels_r([], R) -> {R, []};
 labels_r([{label,_}=I|Is], R) ->
     labels_r(Is, [I|R]);
+labels_r([{line,_}=I|Is], R) ->
+    labels_r(Is, [I|R]);
 labels_r(Is, R) -> {R, Is}.
 
 get_funs({[],[]}) -> [];
@@ -335,20 +337,17 @@ local_labels(Funs) ->
 				   local_labels_1(function__code(F), R)
 			   end, [], Funs)).
 
-%% The first clause below attempts to provide some (limited form of)
-%% backwards compatibility; it is not needed for .beam files generated
-%% by the R8 compiler.  The clause should one fine day be taken out.
-local_labels_1([{label,_}|[{label,_}|_]=Code], R) ->
-    local_labels_1(Code, R);
-local_labels_1([{label,_},{func_info,{atom,M},{atom,F},A}|Code], R)
-  when is_atom(M), is_atom(F) ->
-    local_labels_2(Code, R, M, F, A);
-local_labels_1(Code, _) ->
-    ?exit({'local_labels: no label in code',Code}).
-
-local_labels_2([{label,[{u,L}]}|Code], R, M, F, A) ->
-    local_labels_2(Code, [{L,{M,F,A}}|R], M, F, A);
-local_labels_2(_, R, _, _, _) -> R.
+local_labels_1(Code0, R) ->
+    Code1 = lists:dropwhile(fun({label,_}) -> true;
+			       ({line,_}) -> true;
+			       ({func_info,_,_,_}) -> false
+			    end, Code0),
+    [{func_info,{atom,M},{atom,F},A}|Code] = Code1,
+    local_labels_2(Code, R, {M,F,A}).
+
+local_labels_2([{label,[{u,L}]}|Code], R, MFA) ->
+    local_labels_2(Code, [{L,MFA}|R], MFA);
+local_labels_2(_, R, _) -> R.
 
 %%-----------------------------------------------------------------------
 %% Disassembles a single BEAM instruction; most instructions are handled
diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl
index 8254d71965..f557d3419e 100644
--- a/lib/hipe/icode/hipe_beam_to_icode.erl
+++ b/lib/hipe/icode/hipe_beam_to_icode.erl
@@ -281,10 +281,14 @@ needs_redtest(Leafness) ->
 %%-----------------------------------------------------------------------
 
 %%--- label & func_info combo ---
+trans_fun([{label,_}=F,{func_info,_,_,_}=FI|Instructions], Env) ->
+  %% Handle old code without a line instruction.
+  trans_fun([F,{line,[]},FI|Instructions], Env);
 trans_fun([{label,B},{label,_},
 	   {func_info,M,F,A},{label,L}|Instructions], Env) ->
   trans_fun([{label,B},{func_info,M,F,A},{label,L}|Instructions], Env);
 trans_fun([{label,B},
+	   {line,_},
 	   {func_info,{atom,_M},{atom,_F},_A},
 	   {label,L}|Instructions], Env) ->
   %% Emit code to handle function_clause errors.  The BEAM test instructions
@@ -1874,6 +1878,8 @@ patch_make_funs([], FunIndex, Acc) ->
 
 find_mfa([{label,_}|Code]) ->
   find_mfa(Code);
+find_mfa([{line,_}|Code]) ->
+  find_mfa(Code);
 find_mfa([{func_info,{atom,M},{atom,F},A}|_]) 
   when is_atom(M), is_atom(F), is_integer(A), 0 =< A, A =< 255 ->
   {M, F, A}.