Merge branch 'legoscia/dialyzer/cache-hipe-binaries/OTP-12779'

* legoscia/dialyzer/cache-hipe-binaries/OTP-12779:
  Dialyzer to cache results of HiPE compilation
  Change hipe_bifs:system_crc/1 to hipe_bifs:system_crc/0

7 files changed, 80 insertions, 20 deletions

diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c
index 099f4f90de..a4311d22e2 100644
--- a/erts/emulator/hipe/hipe_bif0.c
+++ b/erts/emulator/hipe/hipe_bif0.c
@@ -1745,13 +1745,11 @@ BIF_RETTYPE hipe_bifs_check_crc_1(BIF_ALIST_1)
     BIF_RET(am_false);
 }
 
-BIF_RETTYPE hipe_bifs_system_crc_1(BIF_ALIST_1)
+BIF_RETTYPE hipe_bifs_system_crc_0(BIF_ALIST_0)
 {
     Uint crc;
 
-    if (!term_to_Uint(BIF_ARG_1, &crc))
-	BIF_ERROR(BIF_P, BADARG);
-    crc ^= (HIPE_SYSTEM_CRC ^ HIPE_LITERALS_CRC);
+    crc = HIPE_SYSTEM_CRC;
     BIF_RET(Uint_to_term(crc, BIF_P));
 }
 
diff --git a/erts/emulator/hipe/hipe_bif0.tab b/erts/emulator/hipe/hipe_bif0.tab
index a3e04802df..4271a78de3 100644
--- a/erts/emulator/hipe/hipe_bif0.tab
+++ b/erts/emulator/hipe/hipe_bif0.tab
@@ -74,7 +74,7 @@ bif hipe_bifs:set_native_address_in_fe/2
 bif hipe_bifs:find_na_or_make_stub/2
 
 bif hipe_bifs:check_crc/1
-bif hipe_bifs:system_crc/1
+bif hipe_bifs:system_crc/0
 bif hipe_bifs:get_rts_param/1
 
 #bif hipe_bifs:tuple_to_float/1
diff --git a/erts/emulator/hipe/hipe_mkliterals.c b/erts/emulator/hipe/hipe_mkliterals.c
index ed355ce264..49e8d39360 100644
--- a/erts/emulator/hipe/hipe_mkliterals.c
+++ b/erts/emulator/hipe/hipe_mkliterals.c
@@ -648,8 +648,7 @@ static int do_e(FILE *fp, const char* this_exe)
 	fprintf(fp, "-define(HIPE_SYSTEM_CRC, %u).\n", system_crc);
     }
     else {
-	fprintf(fp, "-define(HIPE_SYSTEM_CRC, hipe_bifs:system_crc(%u)).\n",
-		literals_crc);
+	fprintf(fp, "-define(HIPE_SYSTEM_CRC, hipe_bifs:system_crc()).\n");
     }
     return 0;
 }
diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml
index 5f52906625..fc076c24a6 100644
--- a/lib/dialyzer/doc/src/dialyzer.xml
+++ b/lib/dialyzer/doc/src/dialyzer.xml
@@ -70,7 +70,7 @@
 		[--build_plt] [--add_to_plt] [--remove_from_plt]
 		[--check_plt] [--no_check_plt] [--plt_info] [--get_warnings]
                 [--dump_callgraph file] [--no_native] [--fullpath]
-                [--statistics]</code>
+                [--statistics] [--no_native_cache]</code>
     <p>Options:</p>
     <taglist>
       <tag><c><![CDATA[files_or_dirs]]></c> (for backwards compatibility also
@@ -198,6 +198,11 @@
          heuristically performs when dialyzing many files; this avoids the
          compilation time but it may result in (much) longer analysis
          time.</item>
+       <tag><c><![CDATA[--no_native_cache]]></c></tag>
+       <item>By default, Dialyzer caches the results of native compilation in the
+         <c>$XDG_CACHE_HOME/erlang/dialyzer_hipe_cache</c> directory.
+         <c>XDG_CACHE_HOME</c> defaults to <c>$HOME/.cache</c>.
+         Use this option to disable caching.</item>
        <tag><c><![CDATA[--fullpath]]></c></tag>
        <item>Display the full path names of files for which warnings are emitted.</item>
        <tag><c><![CDATA[--gui]]></c></tag>
diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl
index 4386a8d52a..55fcd15641 100644
--- a/lib/dialyzer/src/dialyzer_cl.erl
+++ b/lib/dialyzer/src/dialyzer_cl.erl
@@ -512,32 +512,82 @@ hipe_compile(Files, #options{erlang_mode = ErlangMode} = Options) ->
 		  dialyzer_worker],
 	  report_native_comp(Options),
 	  {T1, _} = statistics(wall_clock),
-	  native_compile(Mods),
+	  Cache = (get(dialyzer_options_native_cache) =/= false),
+	  native_compile(Mods, Cache),
 	  {T2, _} = statistics(wall_clock),
 	  report_elapsed_time(T1, T2, Options)
       end
   end.
 
-native_compile(Mods) ->
+native_compile(Mods, Cache) ->
   case dialyzer_utils:parallelism() > ?MIN_PARALLELISM of
     true ->
       Parent = self(),
-      Pids = [spawn(fun () -> Parent ! {self(), hc(M)} end) || M <- Mods],
+      Pids = [spawn(fun () -> Parent ! {self(), hc(M, Cache)} end) || M <- Mods],
       lists:foreach(fun (Pid) -> receive {Pid, Res} -> Res end end, Pids);
     false ->
-      lists:foreach(fun (Mod) -> hc(Mod) end, Mods)
+      lists:foreach(fun (Mod) -> hc(Mod, Cache) end, Mods)
   end.
 
-hc(Mod) ->
+hc(Mod, Cache) ->
   {module, Mod} = code:ensure_loaded(Mod),
   case code:is_module_native(Mod) of
     true -> ok;
     false ->
       %% io:format(" ~w", [Mod]),
-      {ok, Mod} = hipe:c(Mod),
-      ok
+      case Cache of
+	false ->
+	  {ok, Mod} = hipe:c(Mod),
+	  ok;
+	true ->
+	  hc_cache(Mod)
+      end
   end.
 
+hc_cache(Mod) ->
+  CacheBase = cache_base_dir(),
+  %% Use HiPE architecture and version in directory name, to avoid
+  %% clashes between incompatible binaries.
+  HipeArchVersion =
+    lists:concat(
+      [erlang:system_info(hipe_architecture), "-",
+       hipe:version(), "-",
+       hipe_bifs:system_crc()]),
+  CacheDir = filename:join(CacheBase, HipeArchVersion),
+  OrigBeamFile = code:which(Mod),
+  {ok, {Mod, <<Checksum:128>>}} = beam_lib:md5(OrigBeamFile),
+  CachedBeamFile = filename:join(CacheDir, lists:concat([Mod, "-", Checksum, ".beam"])),
+  ok = filelib:ensure_dir(CachedBeamFile),
+  ModBin =
+    case filelib:is_file(CachedBeamFile) of
+      true ->
+	{ok, BinFromFile} = file:read_file(CachedBeamFile),
+	BinFromFile;
+      false ->
+	{ok, Mod, CompiledBin} = compile:file(OrigBeamFile, [from_beam, native, binary]),
+	ok = file:write_file(CachedBeamFile, CompiledBin),
+	CompiledBin
+    end,
+  code:unstick_dir(filename:dirname(OrigBeamFile)),
+  {module, Mod} = code:load_binary(Mod, CachedBeamFile, ModBin),
+  true = code:is_module_native(Mod),
+  ok.
+
+cache_base_dir() ->
+  %% http://standards.freedesktop.org/basedir-spec/basedir-spec-0.7.html
+  %% If XDG_CACHE_HOME is set to an absolute path, use it as base.
+  XdgCacheHome = os:getenv("XDG_CACHE_HOME"),
+  CacheHome =
+    case is_list(XdgCacheHome) andalso filename:pathtype(XdgCacheHome) =:= absolute of
+      true ->
+	XdgCacheHome;
+      false ->
+	%% Otherwise, the default is $HOME/.cache.
+	{ok, [[Home]]} = init:get_argument(home),
+	filename:join(Home, ".cache")
+    end,
+  filename:join([CacheHome, "dialyzer_hipe_cache"]).
+
 new_state() ->
   #cl_state{}.
 
diff --git a/lib/dialyzer/src/dialyzer_cl_parse.erl b/lib/dialyzer/src/dialyzer_cl_parse.erl
index 21fc424a1b..fae88ed6e8 100644
--- a/lib/dialyzer/src/dialyzer_cl_parse.erl
+++ b/lib/dialyzer/src/dialyzer_cl_parse.erl
@@ -75,6 +75,9 @@ cl(["-nn"|T]) ->
 cl(["--no_native"|T]) ->
   put(dialyzer_options_native, false),
   cl(T);
+cl(["--no_native_cache"|T]) ->
+  put(dialyzer_options_native_cache, false),
+  cl(T);
 cl(["--plt_info"|T]) ->
   put(dialyzer_options_analysis_type, plt_info),
   cl(T);
@@ -363,7 +366,7 @@ help_message() ->
 		[--build_plt] [--add_to_plt] [--remove_from_plt]
 		[--check_plt] [--no_check_plt] [--plt_info] [--get_warnings]
                 [--dump_callgraph file] [--no_native] [--fullpath]
-                [--statistics]
+                [--statistics] [--no_native_cache]
 Options:
   files_or_dirs (for backwards compatibility also as: -c files_or_dirs)
       Use Dialyzer from the command line to detect defects in the
@@ -468,6 +471,11 @@ Options:
       Bypass the native code compilation of some key files that Dialyzer
       heuristically performs when dialyzing many files; this avoids the
       compilation time but it may result in (much) longer analysis time.
+  --no_native_cache
+      By default, Dialyzer caches the results of native compilation in the
+      $XDG_CACHE_HOME/erlang/dialyzer_hipe_cache directory.
+      XDG_CACHE_HOME defaults to $HOME/.cache.  Use this option to disable
+      caching.
   --fullpath
       Display the full path names of files for which warnings are emitted.
   --gui
diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl
index 5b1401b34a..ee77d65932 100644
--- a/lib/hipe/cerl/erl_bif_types.erl
+++ b/lib/hipe/cerl/erl_bif_types.erl
@@ -1113,8 +1113,8 @@ type(hipe_bifs, set_native_address, 3, Xs, Opaques) ->
 type(hipe_bifs, set_native_address_in_fe, 2, Xs, Opaques) ->
   strict(hipe_bifs, set_native_address_in_fe, 2, Xs,
 	 fun (_) -> t_atom('true') end, Opaques);
-type(hipe_bifs, system_crc, 1, Xs, Opaques) ->
-  strict(hipe_bifs, system_crc, 1, Xs, fun (_) -> t_crc32() end, Opaques);
+type(hipe_bifs, system_crc, 0, _, _Opaques) ->
+  t_crc32();
 type(hipe_bifs, term_to_word, 1, Xs, Opaques) ->
   strict(hipe_bifs, term_to_word, 1, Xs,
 	 fun (_) -> t_integer() end, Opaques);
@@ -2490,8 +2490,8 @@ arg_types(hipe_bifs, set_native_address, 3) ->
   [t_mfa(), t_integer(), t_boolean()];
 arg_types(hipe_bifs, set_native_address_in_fe, 2) ->
   [t_integer(), t_integer()];
-arg_types(hipe_bifs, system_crc, 1) ->
-  [t_crc32()];
+arg_types(hipe_bifs, system_crc, 0) ->
+  [];
 arg_types(hipe_bifs, term_to_word, 1) ->
   [t_any()];
 arg_types(hipe_bifs, update_code_size, 3) ->