File 4672-Add-erl_compiler_server.patch of Package erlang
From 2f4d62ffc60fbff4a7d4c35e4292349263b4f266 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Tue, 14 May 2019 06:53:45 +0200
Subject: [PATCH 2/6] Add erl_compiler_server
---
lib/kernel/src/Makefile | 1 +
lib/kernel/src/erl_compile_server.erl | 253 ++++++++++++++++++++++++++++++++++
lib/kernel/src/kernel.app.src | 1 +
lib/kernel/src/kernel.erl | 17 ++-
4 files changed, 271 insertions(+), 1 deletion(-)
create mode 100644 lib/kernel/src/erl_compile_server.erl
diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile
index 88752431eb..2d2b84c206 100644
--- a/lib/kernel/src/Makefile
+++ b/lib/kernel/src/Makefile
@@ -67,6 +67,7 @@ MODULES = \
dist_ac \
dist_util \
erl_boot_server \
+ erl_compile_server \
erl_ddll \
erl_distribution \
erl_epmd \
diff --git a/lib/kernel/src/erl_compile_server.erl b/lib/kernel/src/erl_compile_server.erl
new file mode 100644
index 0000000000..f4b719068e
--- /dev/null
+++ b/lib/kernel/src/erl_compile_server.erl
@@ -0,0 +1,253 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2019. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(erl_compile_server).
+-behaviour(gen_server).
+-export([start_link/0, compile/1]).
+
+%% Internal exports
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2]).
+
+-define(COMPILE_SERVER, erl_compile_server).
+-define(IDLE_TIMEOUT, (10*1000)).
+-define(WRONG_TIMEOUT, 1).
+
+-type client() :: {pid(), term()}.
+-type job_map() :: #{{pid(),reference()} := client()}.
+
+-record(st, {
+ cwd=[] :: file:filename(),
+ config :: term(),
+ timeout=?IDLE_TIMEOUT :: non_neg_integer(),
+ jobs=#{} :: job_map()
+ }).
+
+-type state() :: #st{}.
+
+-spec start_link() -> {'ok', pid()} | {'error', term()}.
+
+start_link() ->
+ gen_server:start_link({local, ?COMPILE_SERVER}, ?MODULE, [], []).
+
+-spec init(Arg :: []) -> {'ok', any(), timeout()}.
+
+init([]) ->
+ %% We don't want the current directory in the code path.
+ %% Remove it.
+ Path = [D || D <- code:get_path(), D =/= "."],
+ true = code:set_path(Path),
+ Config = init_config(),
+ {ok, #st{config=Config}, ?IDLE_TIMEOUT}.
+
+-spec compile(term()) -> term().
+
+compile(Parameters) ->
+ gen_server:call(?COMPILE_SERVER, {compile, Parameters}, infinity).
+
+-spec handle_call(any(), _, state()) -> {'noreply', state()}.
+
+handle_call({compile, Parameters}, From, #st{jobs=Jobs}=St0) ->
+ {ErlcArgs, PathArgs} = parse_command_line(Parameters),
+ case verify_context(PathArgs, Parameters, St0) of
+ {ok, St1} ->
+ #{cwd := Cwd, encoding := Enc} = Parameters,
+ PidRef = spawn_monitor(fun() -> exit(do_compile(ErlcArgs, Cwd, Enc)) end),
+ St = St1#st{jobs=Jobs#{PidRef => From}},
+ {noreply, St#st{timeout=?IDLE_TIMEOUT}};
+ wrong_config ->
+ case map_size(Jobs) of
+ 0 ->
+ %% Wrong configuration and no outstanding jobs.
+ %% Terminate immediately.
+ halt();
+ _ ->
+ {reply, wrong_config, St0#st{timeout=?WRONG_TIMEOUT}, ?WRONG_TIMEOUT}
+ end
+ end.
+
+-spec handle_cast(term(), state()) -> {'noreply', state()}.
+
+handle_cast(_, St) ->
+ {noreply, St}.
+
+-spec handle_info(term(), state()) -> {'noreply', state(), timeout()}.
+
+handle_info({'DOWN',Ref,process,Pid,Reason}, #st{jobs=Jobs0}=St0) ->
+ Key = {Pid, Ref},
+ Client = map_get(Key, Jobs0),
+ Jobs = maps:remove(Key, Jobs0),
+ St = St0#st{jobs=Jobs},
+ gen_server:reply(Client, Reason),
+ case map_size(Jobs) =:= 0 of
+ true ->
+ {noreply, St, St#st.timeout};
+ false ->
+ {noreply, St}
+ end;
+handle_info(timeout, #st{jobs=Jobs}) when map_size(Jobs) =:= 0 ->
+ halt();
+handle_info(_, #st{timeout=Timeout}=St) ->
+ %% There are still outstanding jobs.
+ {noreply, St, Timeout}.
+
+%%%
+%%% Local functions.
+%%%
+
+verify_context(PathArgs, #{env := Env}=Parameters, St0) ->
+ case ensure_cwd(Parameters, St0) of
+ {ok, #st{config=Config}=St} ->
+ case make_config(PathArgs, Env) of
+ Config ->
+ {ok, St};
+ _ ->
+ wrong_config
+ end;
+ wrong_config ->
+ wrong_config
+ end.
+
+ensure_cwd(#{cwd := Cwd}, #st{cwd=Cwd}=St) ->
+ {ok, St};
+ensure_cwd(#{cwd := NewCwd}, #st{jobs=Jobs}=St) when map_size(Jobs) =:= 0 ->
+ ok = file:set_cwd(NewCwd),
+ {ok, St#st{cwd=NewCwd}};
+ensure_cwd(#{}, #st{}) ->
+ wrong_config.
+
+do_compile(ErlcArgs, Cwd, Enc) ->
+ GL = create_gl(),
+ group_leader(GL, self()),
+ Result = erl_compile:compile(ErlcArgs, Cwd),
+ StdOutput = ensure_enc(gl_get_output(GL), Enc),
+ case Result of
+ ok ->
+ {ok, StdOutput};
+ {error, StdErrorOutput0} ->
+ StdErrorOutput = ensure_enc(StdErrorOutput0, Enc),
+ {error, StdOutput, StdErrorOutput}
+ end.
+
+parse_command_line(#{command_line := CmdLine, cwd := Cwd}) ->
+ parse_command_line_1(CmdLine, Cwd, [], []).
+
+parse_command_line_1(["-pa", Pa|T], Cwd, PaAcc, PzAcc) ->
+ parse_command_line_1(T, Cwd, [Pa|PaAcc], PzAcc);
+parse_command_line_1(["-pz", Pz|T], Cwd, PaAcc, PzAcc) ->
+ parse_command_line_1(T, Cwd, PaAcc, [Pz|PzAcc]);
+parse_command_line_1(["-extra"|ErlcArgs], Cwd, PaAcc, PzAcc) ->
+ PaArgs = clean_path_args(lists:reverse(PaAcc), Cwd),
+ PzArgs = clean_path_args(lists:reverse(PzAcc), Cwd),
+ {ErlcArgs, [{pa, PaArgs}, {pz, PzArgs}]};
+parse_command_line_1([_|T], Cwd, PaAcc, PzAcc) ->
+ parse_command_line_1(T, Cwd, PaAcc, PzAcc).
+
+ensure_enc(Chars, latin1) ->
+ L = unicode:characters_to_list(Chars, unicode),
+ unicode:characters_to_binary(
+ [ case X of
+ High when High > 255 ->
+ ["\\x{", erlang:integer_to_list(X, 16), $}];
+ Low ->
+ Low
+ end || X <- L ], unicode, latin1);
+ensure_enc(Chars, _Enc) -> Chars.
+
+init_config() ->
+ EnvVars = ["ERL_AFLAGS", "ERL_FLAGS", "ERL_ZFLAGS",
+ "ERL_COMPILER_OPTIONS",
+ "ERL_LIBS",
+ "ERLC_CONFIGURATION"],
+ Env0 = [{Name, os:getenv(Name)} || Name <- EnvVars],
+ Env = [P || {_, Val}=P <- Env0, Val =/= false],
+ {ok, Cwd} = file:get_cwd(),
+ make_config([get_path_arg(pa, Cwd), get_path_arg(pz, Cwd)], Env).
+
+get_path_arg(PathArg, Cwd) ->
+ case init:get_argument(PathArg) of
+ error ->
+ {PathArg, []};
+ {ok, Paths0} ->
+ Paths1 = lists:append(Paths0),
+ Paths = clean_path_args(Paths1, Cwd),
+ {PathArg, Paths}
+ end.
+
+clean_path_args(PathArgs, Cwd) ->
+ [filename:absname(P, Cwd) || P <- PathArgs].
+
+make_config(PathArgs, Env0) ->
+ Env = lists:sort(Env0),
+ PathArgs ++ [iolist_to_binary([[Name,$=,Val,$\n] || {Name,Val} <- Env])].
+
+%%%
+%%% A group leader that will capture all output to the group leader.
+%%%
+
+create_gl() ->
+ spawn_link(fun() -> gl_loop([]) end).
+
+gl_get_output(GL) ->
+ GL ! {self(), get_output},
+ receive
+ {GL, Output} -> Output
+ end.
+
+gl_loop(State0) ->
+ receive
+ {io_request, From, ReplyAs, Request} ->
+ {_Tag, Reply, State} = gl_request(Request, State0),
+ gl_reply(From, ReplyAs, Reply),
+ gl_loop(State);
+ {From, get_output} ->
+ Output = iolist_to_binary(State0),
+ From ! {self(), Output},
+ gl_loop(State0);
+ _Unknown ->
+ gl_loop(State0)
+ end.
+
+gl_reply(From, ReplyAs, Reply) ->
+ From ! {io_reply, ReplyAs, Reply},
+ ok.
+
+gl_request({put_chars, Encoding, Chars}, State) ->
+ gl_put_chars(unicode:characters_to_binary(Chars, Encoding), State);
+gl_request({put_chars, Encoding, Module, Function, Args}, State) ->
+ try
+ gl_request({put_chars, Encoding, apply(Module, Function, Args)}, State)
+ catch
+ _:_ ->
+ {{error,Function}, State}
+ end;
+gl_request({requests, Reqs}, State) ->
+ gl_multi_request(Reqs, {ok, State});
+gl_request(_Other, State) ->
+ {error, {error, request}, State}.
+
+gl_multi_request([R|Rs], {ok, State}) ->
+ gl_multi_request(Rs, gl_request(R, State));
+gl_multi_request([_|_], Error) ->
+ Error;
+gl_multi_request([], Result) ->
+ Result.
+
+gl_put_chars(Chars, Output) ->
+ {ok, ok, [Output,Chars]}.
diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src
index c2ff6b63e9..4f5e6d782f 100644
--- a/lib/kernel/src/kernel.app.src
+++ b/lib/kernel/src/kernel.app.src
@@ -32,6 +32,7 @@
code_server,
dist_util,
erl_boot_server,
+ erl_compile_server,
erl_distribution,
erl_reply,
erl_signal_handler,
diff --git a/lib/kernel/src/kernel.erl b/lib/kernel/src/kernel.erl
index c8c631ab23..8877ceea8e 100644
--- a/lib/kernel/src/kernel.erl
+++ b/lib/kernel/src/kernel.erl
@@ -166,10 +166,12 @@ init([]) ->
modules => dynamic},
Timer = start_timer(),
+ CompileServer = start_compile_server(),
{ok, {SupFlags,
[Code, InetDb | DistChildren] ++
- [File, SigSrv, StdError, User, Config, RefC, SafeSup, LoggerSup] ++ Timer}}
+ [File, SigSrv, StdError, User, Config, RefC, SafeSup, LoggerSup] ++
+ Timer ++ CompileServer}}
end;
init(safe) ->
SupFlags = #{strategy => one_for_one,
@@ -303,6 +305,19 @@ start_timer() ->
[]
end.
+start_compile_server() ->
+ case application:get_env(kernel, start_compile_server) of
+ {ok, true} ->
+ [#{id => erl_compile_server,
+ start => {erl_compile_server, start_link, []},
+ restart => permanent,
+ shutdown => 2000,
+ type => worker,
+ modules => [erl_compile_server]}];
+ _ ->
+ []
+ end.
+
%%-----------------------------------------------------------------
%% The change of the distributed parameter is taken care of here
%%-----------------------------------------------------------------
--
2.16.4
