Include location information for line instructions in BEAM files

1 files changed, 51 insertions, 2 deletions

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().