Merge pull request #1341 from josevalim/jv-compile-extra-chunks

Add extra_chunks option to compile

OTP-14221

4 files changed, 43 insertions, 20 deletions

diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml
index bd488a39a5..e6470b938f 100644
--- a/lib/compiler/doc/src/compile.xml
+++ b/lib/compiler/doc/src/compile.xml
@@ -418,7 +418,7 @@ module.beam: module.erl \
 	  without module prefix to local or imported functions before
 	  trying with auto-imported BIFs. If the BIF is to be
 	  called, use the <c>erlang</c> module prefix in the call, not
-	  <c>{ no_auto_import,[{F,A}, ...]}</c>.</p>
+	  <c>{no_auto_import,[{F,A}, ...]}</c>.</p>
 	  </note>
 	  <p>If this option is written in the source code, as a 
 	  <c>-compile</c> directive, the syntax <c>F/A</c> can be used instead 
@@ -439,6 +439,15 @@ module.beam: module.erl \
 	    </p>
           </item>
 
+          <tag><c>{extra_chunks, [{binary(), binary()}]}</c></tag>
+          <item>
+            <p>Pass extra chunks to be stored in the <c>.beam</c> file.
+              The extra chunks must be a list of tuples with a four byte
+              binary as chunk name followed by a binary with the chunk contents.
+              See <seealso marker="stdlib:beam_lib">beam_lib</seealso> for
+              more information.
+	    </p>
+          </item>
         </taglist>
 
         <p>If warnings are turned on (option <c>report_warnings</c>
diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl
index 2fc2850591..1bda185acd 100644
--- a/lib/compiler/src/beam_asm.erl
+++ b/lib/compiler/src/beam_asm.erl
@@ -49,28 +49,26 @@
 
 -type function_name() :: atom().
 
--type exports() :: [{function_name(),arity()}].
-
 -type asm_function() ::
         {'function',function_name(),arity(),label(),[asm_instruction()]}.
 
 -type module_code() ::
         {module(),[_],[_],[asm_function()],pos_integer()}.
 
--spec module(module_code(), exports(), [_], [compile:option()], [compile:option()]) ->
+-spec module(module_code(), [{binary(), binary()}], [_], [compile:option()], [compile:option()]) ->
                     {'ok',binary()}.
 
-module(Code, Abst, SourceFile, Opts, CompilerOpts) ->
-    {ok,assemble(Code, Abst, SourceFile, Opts, CompilerOpts)}.
+module(Code, ExtraChunks, SourceFile, Opts, CompilerOpts) ->
+    {ok,assemble(Code, ExtraChunks, SourceFile, Opts, CompilerOpts)}.
 
-assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, Abst, SourceFile, Opts, CompilerOpts) ->
+assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, ExtraChunks, SourceFile, Opts, CompilerOpts) ->
     {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),
     Exp = cerl_sets:from_list(Exp0),
     {Code,Dict2} = assemble_1(Asm, Exp, Dict1, []),
-    build_file(Code, Attr, Dict2, NumLabels, NumFuncs, Abst, SourceFile, Opts, CompilerOpts).
+    build_file(Code, Attr, Dict2, NumLabels, NumFuncs, ExtraChunks, SourceFile, Opts, CompilerOpts).
 
 on_load(Fs0, Attr0) ->
     case proplists:get_value(on_load, Attr0) of
@@ -113,7 +111,7 @@ assemble_function([H|T], Acc, Dict0) ->
 assemble_function([], Code, Dict) ->
     {Code, Dict}.
 
-build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts, CompilerOpts) ->
+build_file(Code, Attr, Dict, NumLabels, NumFuncs, ExtraChunks, SourceFile, Opts, CompilerOpts) ->
     %% Create the code chunk.
 
     CodeChunk = chunk(<<"Code">>,
@@ -188,18 +186,18 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts, Compil
     AttrChunk = chunk(<<"Attr">>, Attributes),
     CompileChunk = chunk(<<"CInf">>, Compile),
 
-    %% Create the abstract code chunk.
+    %% Compile all extra chunks.
 
-    AbstChunk = chunk(<<"Abst">>, Abst),
+    CheckedChunks = [chunk(Key, Value) || {Key, Value} <- ExtraChunks],
 
     %% Create IFF chunk.
 
     Chunks = case member(slim, Opts) of
 		 true ->
-		     [Essentials,AttrChunk,AbstChunk];
+		     [Essentials,AttrChunk,CheckedChunks];
 		 false ->
 		     [Essentials,LocChunk,AttrChunk,
-		      CompileChunk,AbstChunk,LineChunk]
+		      CompileChunk,CheckedChunks,LineChunk]
 	     end,
     build_form(<<"BEAM">>, Chunks).
 
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index dcd962df66..c849306c0d 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -315,19 +315,25 @@ format_error_reason(Reason) ->
 		  mod_options=[]  :: [option()], %Options for module_info
                   encoding=none :: none | epp:source_encoding(),
 		  errors=[]     :: [err_warn_info()],
-		  warnings=[]   :: [err_warn_info()]}).
+		  warnings=[]   :: [err_warn_info()],
+		  extra_chunks=[] :: [{binary(), binary()}]}).
 
 internal({forms,Forms}, Opts0) ->
     {_,Ps} = passes(forms, Opts0),
     Source = proplists:get_value(source, Opts0, ""),
     Opts1 = proplists:delete(source, Opts0),
-    Compile = #compile{options=Opts1,mod_options=Opts1},
+    Compile = build_compile(Opts1),
     internal_comp(Ps, Forms, Source, "", Compile);
 internal({file,File}, Opts) ->
     {Ext,Ps} = passes(file, Opts),
-    Compile = #compile{options=Opts,mod_options=Opts},
+    Compile = build_compile(Opts),
     internal_comp(Ps, none, File, Ext, Compile).
 
+build_compile(Opts0) ->
+    ExtraChunks = proplists:get_value(extra_chunks, Opts0, []),
+    Opts1 = proplists:delete(extra_chunks, Opts0),
+    #compile{options=Opts1,mod_options=Opts1,extra_chunks=ExtraChunks}.
+
 internal_comp(Passes, Code0, File, Suffix, St0) ->
     Dir = filename:dirname(File),
     Base = filename:basename(File, Suffix),
@@ -1386,14 +1392,15 @@ encrypt({des3_cbc=Type,Key,IVec,BlockSize}, Bin0) ->
 save_core_code(Code, St) ->
     {ok,Code,St#compile{core_code=cerl:from_records(Code)}}.
 
-beam_asm(Code0, #compile{ifile=File,abstract_code=Abst,
+beam_asm(Code0, #compile{ifile=File,abstract_code=Abst,extra_chunks=ExtraChunks,
 			 options=CompilerOpts,mod_options=Opts0}=St) ->
     Source = paranoid_absname(File),
     Opts1 = lists:map(fun({debug_info_key,_}) -> {debug_info_key,'********'};
 			 (Other) -> Other
 		      end, Opts0),
     Opts2 = [O || O <- Opts1, effects_code_generation(O)],
-    case beam_asm:module(Code0, Abst, Source, Opts2, CompilerOpts) of
+    Chunks = [{<<"Abst">>, Abst} | ExtraChunks],
+    case beam_asm:module(Code0, Chunks, Source, Opts2, CompilerOpts) of
 	{ok,Code} -> {ok,Code,St#compile{abstract_code=[]}}
     end.
 
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index 8d7facd727..10740ac2b0 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -30,7 +30,7 @@
 	 file_1/1, forms_2/1, module_mismatch/1, big_file/1, outdir/1,
 	 binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1,
 	 other_output/1, kernel_listing/1, encrypted_abstr/1,
-	 strict_record/1, utf8_atoms/1,
+	 strict_record/1, utf8_atoms/1, extra_chunks/1,
 	 cover/1, env/1, core/1,
 	 core_roundtrip/1, asm/1, optimized_guards/1,
 	 sys_pre_attributes/1, dialyzer/1,
@@ -48,7 +48,7 @@ all() ->
     [app_test, appup_test, file_1, forms_2, module_mismatch, big_file, outdir,
      binary, makedep, cond_and_ifdef, listings, listings_big,
      other_output, kernel_listing, encrypted_abstr,
-     strict_record, utf8_atoms,
+     strict_record, utf8_atoms, extra_chunks,
      cover, env, core, core_roundtrip, asm, optimized_guards,
      sys_pre_attributes, dialyzer, warnings, pre_load_check,
      env_compiler_options].
@@ -699,6 +699,15 @@ utf8_atoms(Config) when is_list(Config) ->
     NoUtf8AtomForms = [{attribute,Anno,module,no_utf8_atom}|Forms],
     error = compile:forms(NoUtf8AtomForms, [binary, r19]).
 
+extra_chunks(Config) when is_list(Config) ->
+    Anno = erl_anno:new(1),
+    Forms = [{attribute,Anno,module,extra_chunks}],
+
+    {ok,extra_chunks,ExtraChunksBinary} =
+	compile:forms(Forms, [binary, {extra_chunks, [{<<"ExCh">>, <<"Contents">>}]}]),
+    {ok,{extra_chunks,[{"ExCh",<<"Contents">>}]}} =
+	beam_lib:chunks(ExtraChunksBinary, ["ExCh"]).
+
 env(Config) when is_list(Config) ->
     {Simple,Target} = get_files(Config, simple, env),
     {ok,Cwd} = file:get_cwd(),