aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--erts/emulator/beam/erl_proc_sig_queue.c18
-rw-r--r--erts/emulator/beam/erl_process.c1
-rw-r--r--lib/inets/doc/src/httpc.xml3
-rw-r--r--lib/inets/src/http_client/httpc_handler.erl65
-rw-r--r--lib/inets/src/http_client/httpc_response.erl1
-rw-r--r--lib/inets/test/httpc_SUITE.erl97
-rw-r--r--lib/kernel/doc/src/heart.xml5
-rwxr-xr-xscripts/diffable620
8 files changed, 756 insertions, 54 deletions
diff --git a/erts/emulator/beam/erl_proc_sig_queue.c b/erts/emulator/beam/erl_proc_sig_queue.c
index 1ba0b789ec..b32ba1b2e6 100644
--- a/erts/emulator/beam/erl_proc_sig_queue.c
+++ b/erts/emulator/beam/erl_proc_sig_queue.c
@@ -723,7 +723,7 @@ erts_proc_sig_fetch(Process *proc)
ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(proc);
}
-void do_seq_trace_output(Eterm to, Eterm token, Eterm msg);
+static void do_seq_trace_output(Eterm to, Eterm token, Eterm msg);
static void
send_gen_exit_signal(Process *c_p, Eterm from_tag,
@@ -869,7 +869,7 @@ send_gen_exit_signal(Process *c_p, Eterm from_tag,
}
}
-void
+static void
do_seq_trace_output(Eterm to, Eterm token, Eterm msg)
{
/*
@@ -887,15 +887,17 @@ do_seq_trace_output(Eterm to, Eterm token, Eterm msg)
else
rp = erts_proc_lookup_raw_inc_refc(to);
- erts_proc_lock(rp, ERTS_PROC_LOCK_MSGQ);
+ if (rp) {
+ erts_proc_lock(rp, ERTS_PROC_LOCK_MSGQ);
- if (!ERTS_PROC_IS_EXITING(rp))
- seq_trace_output(token, msg, SEQ_TRACE_SEND, to, rp);
+ if (!ERTS_PROC_IS_EXITING(rp))
+ seq_trace_output(token, msg, SEQ_TRACE_SEND, to, rp);
- erts_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ);
+ erts_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ);
- if (!is_normal_sched)
- erts_proc_dec_refc(rp);
+ if (!is_normal_sched)
+ erts_proc_dec_refc(rp);
+ }
}
void
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index be1306cd79..ba0a9fbc79 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -10785,7 +10785,6 @@ exit_permanent_prio_elevation(Process *c_p, erts_aint32_t state)
while (1) {
erts_aint32_t aprio, uprio, n, e;
ASSERT(a & ERTS_PSFLG_EXITING);
- ASSERT(!(a & ERTS_PSFLG_FREE));
aprio = ERTS_PSFLGS_GET_ACT_PRIO(a);
uprio = ERTS_PSFLGS_GET_USR_PRIO(a);
if (aprio >= uprio)
diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml
index 14662f257c..ffc6fec518 100644
--- a/lib/inets/doc/src/httpc.xml
+++ b/lib/inets/doc/src/httpc.xml
@@ -312,8 +312,7 @@
<v>Body = string() | binary()</v>
<v>Profile = profile() | pid()</v>
<d>When started <c>stand_alone</c> only the pid can be used.</d>
- <v>Reason = {connect_failed, term()} |
- {send_failed, term()} | term()</v>
+ <v>Reason = term()</v>
</type>
<desc>
diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl
index 9b09832eb8..eeb08ce0ee 100644
--- a/lib/inets/src/http_client/httpc_handler.erl
+++ b/lib/inets/src/http_client/httpc_handler.erl
@@ -48,19 +48,17 @@
queue_timer :: reference() | 'undefined'
}).
--type session_failed() :: {'connect_failed',term()} | {'send_failed',term()}.
-
-record(state,
{
request :: request() | 'undefined',
- session :: session() | session_failed() | 'undefined',
+ session :: session() | 'undefined',
status_line, % {Version, StatusCode, ReasonPharse}
headers :: http_response_h() | 'undefined',
body :: binary() | 'undefined',
mfa, % {Module, Function, Args}
pipeline = queue:new() :: queue:queue(),
keep_alive = queue:new() :: queue:queue(),
- status, % undefined | new | pipeline | keep_alive | close | {ssl_tunnel, Request}
+ status :: undefined | new | pipeline | keep_alive | close | {ssl_tunnel, request()},
canceled = [], % [RequestId]
max_header_size = nolimit :: nolimit | integer(),
max_body_size = nolimit :: nolimit | integer(),
@@ -255,8 +253,8 @@ handle_call(Request, From, State) ->
Result ->
Result
catch
- _:Reason ->
- {stop, {shutdown, Reason} , State}
+ Class:Reason:ST ->
+ {stop, {shutdown, {{Class, Reason}, ST}}, State}
end.
@@ -271,8 +269,8 @@ handle_cast(Msg, State) ->
Result ->
Result
catch
- _:Reason ->
- {stop, {shutdown, Reason} , State}
+ Class:Reason:ST ->
+ {stop, {shutdown, {{Class, Reason}, ST}}, State}
end.
%%--------------------------------------------------------------------
@@ -286,8 +284,8 @@ handle_info(Info, State) ->
Result ->
Result
catch
- _:Reason ->
- {stop, {shutdown, Reason} , State}
+ Class:Reason:ST ->
+ {stop, {shutdown, {{Class, Reason}, ST}}, State}
end.
%%--------------------------------------------------------------------
@@ -295,23 +293,6 @@ handle_info(Info, State) ->
%% Description: Shutdown the httpc_handler
%%--------------------------------------------------------------------
-%% Init error there is no socket to be closed.
-terminate(normal,
- #state{request = Request,
- session = {send_failed, _} = Reason} = State) ->
- maybe_send_answer(Request,
- httpc_response:error(Request, Reason),
- State),
- ok;
-
-terminate(normal,
- #state{request = Request,
- session = {connect_failed, _} = Reason} = State) ->
- maybe_send_answer(Request,
- httpc_response:error(Request, Reason),
- State),
- ok;
-
terminate(normal, #state{session = undefined}) ->
ok;
@@ -588,11 +569,11 @@ do_handle_info({Proto, _Socket, Data},
activate_once(Session),
{noreply, State#state{mfa = NewMFA}}
catch
- _:Reason ->
+ Class:Reason:ST ->
ClientReason = {could_not_parse_as_http, Data},
ClientErrMsg = httpc_response:error(Request, ClientReason),
NewState = answer_request(Request, ClientErrMsg, State),
- {stop, {shutdown, Reason}, NewState}
+ {stop, {shutdown, {{Class, Reason}, ST}}, NewState}
end;
do_handle_info({Proto, Socket, Data},
@@ -1058,15 +1039,15 @@ handle_response(#state{status = new} = State) ->
?hcrd("handle response - status = new", []),
handle_response(try_to_enable_pipeline_or_keep_alive(State));
-handle_response(#state{request = Request,
- status = Status,
- session = Session,
- status_line = StatusLine,
- headers = Headers,
- body = Body,
- options = Options,
- profile_name = ProfileName} = State)
- when Status =/= new ->
+handle_response(#state{status = Status0} = State0) when Status0 =/= new ->
+ State = handle_server_closing(State0),
+ #state{request = Request,
+ session = Session,
+ status_line = StatusLine,
+ headers = Headers,
+ body = Body,
+ options = Options,
+ profile_name = ProfileName} = State,
handle_cookies(Headers, Request, Options, ProfileName),
case httpc_response:result({StatusLine, Headers, Body}, Request) of
%% 100-continue
@@ -1330,6 +1311,14 @@ try_to_enable_pipeline_or_keep_alive(
State#state{status = close}
end.
+handle_server_closing(State = #state{status = close}) -> State;
+handle_server_closing(State = #state{headers = undefined}) -> State;
+handle_server_closing(State = #state{headers = Headers}) ->
+ case httpc_response:is_server_closing(Headers) of
+ true -> State#state{status = close};
+ false -> State
+ end.
+
answer_request(#request{id = RequestId, from = From} = Request, Msg,
#state{session = Session,
timers = Timers,
diff --git a/lib/inets/src/http_client/httpc_response.erl b/lib/inets/src/http_client/httpc_response.erl
index 58ab9144df..92dc9b0e02 100644
--- a/lib/inets/src/http_client/httpc_response.erl
+++ b/lib/inets/src/http_client/httpc_response.erl
@@ -83,7 +83,6 @@ whole_body(Body, Length) ->
%% result(Response, Request) ->
%% Response - {StatusLine, Headers, Body}
%% Request - #request{}
-%% Session - #tcp_session{}
%%
%% Description: Checks the status code ...
%%-------------------------------------------------------------------------
diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl
index 38705372c9..1116fdb1b6 100644
--- a/lib/inets/test/httpc_SUITE.erl
+++ b/lib/inets/test/httpc_SUITE.erl
@@ -67,7 +67,7 @@ groups() ->
%% process_leak_on_keepalive is depending on stream_fun_server_close
%% and it shall be the last test case in the suite otherwise cookie
%% will fail.
- {sim_http, [], only_simulated() ++ [process_leak_on_keepalive]},
+ {sim_http, [], only_simulated() ++ server_closing_connection() ++ [process_leak_on_keepalive]},
{http_internal, [], real_requests_esi()},
{http_unix_socket, [], simulated_unix_socket()},
{https, [], real_requests()},
@@ -154,6 +154,12 @@ only_simulated() ->
stream_fun_server_close
].
+server_closing_connection() ->
+ [
+ server_closing_connection_on_first_response,
+ server_closing_connection_on_second_response
+ ].
+
misc() ->
[
server_does_not_exist,
@@ -233,7 +239,7 @@ init_per_testcase(pipeline, Config) ->
init_per_testcase(persistent_connection, Config) ->
inets:start(httpc, [{profile, persistent}]),
httpc:set_options([{keep_alive_timeout, 50000},
- {max_keep_alive_length, 3}], persistent_connection),
+ {max_keep_alive_length, 3}], persistent),
Config;
init_per_testcase(wait_for_whole_response, Config) ->
@@ -252,6 +258,24 @@ end_per_testcase(pipeline, _Config) ->
inets:stop(httpc, pipeline);
end_per_testcase(persistent_connection, _Config) ->
inets:stop(httpc, persistent);
+end_per_testcase(Case, Config)
+ when Case == server_closing_connection_on_first_response;
+ Case == server_closing_connection_on_second_response ->
+ %% Test case uses at most one session. Ensure no leftover
+ %% sessions left behind.
+ {_, Status} = proplists:lookup(tc_status, Config),
+ ShallCleanup = case Status of
+ ok -> true;
+ {failed, _} -> true;
+ {skipped, _} -> false
+ end,
+ if ShallCleanup =:= true ->
+ httpc:request(url(group_name(Config), "/just_close.html", Config)),
+ ok;
+ true ->
+ ct:pal("Not cleaning up because test case status was ~p", [Status]),
+ ok
+ end;
end_per_testcase(_Case, _Config) ->
ok.
@@ -1275,6 +1299,53 @@ stream_fun_server_close(Config) when is_list(Config) ->
end.
%%--------------------------------------------------------------------
+server_closing_connection_on_first_response() ->
+ [{doc, "Client receives \"Connection: close\" on first response."
+ "A client that receives a \"close\" connection option MUST cease sending"
+ "requests on that connection and close the connection after reading"
+ "the response message containing the \"close\""}].
+server_closing_connection_on_first_response(Config) when is_list(Config) ->
+ ReqSrvSendOctFun =
+ fun(V, U, S) ->
+ {ok, {{V, S, _}, Headers0, []}} =
+ httpc:request(get, {U, []}, [{version, V}], []),
+ {_, SendOctStr} =
+ proplists:lookup("x-socket-stat-send-oct", Headers0),
+ list_to_integer(SendOctStr)
+ end,
+ V = "HTTP/1.1",
+ Url0 = url(group_name(Config), "/http_1_1_send_oct.html", Config),
+ Url1 = url(group_name(Config), "/http_1_1_send_oct_and_connection_close.html", Config),
+ %% Test case assumes at most one reusable past session.
+ _ = ReqSrvSendOctFun(V, Url1, 204),
+ 0 = ReqSrvSendOctFun(V, Url0, 204),
+ ok.
+
+%%--------------------------------------------------------------------
+server_closing_connection_on_second_response() ->
+ [{doc, "Client receives \"Connection: close\" on second response."
+ "A client that receives a \"close\" connection option MUST cease sending"
+ "requests on that connection and close the connection after reading"
+ "the response message containing the \"close\""}].
+server_closing_connection_on_second_response(Config) when is_list(Config) ->
+ ReqSrvSendOctFun =
+ fun(V, U, S) ->
+ {ok, {{V, S, _}, Headers0, []}} =
+ httpc:request(get, {U, []}, [{version, V}], []),
+ {_, SendOctStr} =
+ proplists:lookup("x-socket-stat-send-oct", Headers0),
+ list_to_integer(SendOctStr)
+ end,
+ V = "HTTP/1.1",
+ Url0 = url(group_name(Config), "/http_1_1_send_oct.html", Config),
+ Url1 = url(group_name(Config), "/http_1_1_send_oct_and_connection_close.html", Config),
+ %% Test case assumes no reusable past sessions.
+ SendOct0 = 0 = ReqSrvSendOctFun(V, Url0, 204),
+ case ReqSrvSendOctFun(V, Url1, 204) of SendOct1 when SendOct1 > SendOct0 -> ok end,
+ 0 = ReqSrvSendOctFun(V, Url0, 204),
+ ok.
+
+%%--------------------------------------------------------------------
slow_connection() ->
[{doc, "Test that a request on a slow keep-alive connection won't crash the httpc_manager"}].
slow_connection(Config) when is_list(Config) ->
@@ -2232,10 +2303,32 @@ handle_uri("GET","/v1/kv/foo",_,_,_,_) ->
"Content-Length: 24\r\n" ++
"Content-Type: application/json\r\n\r\n" ++
"[{\"Value\": \"aGVsbG8=\"}]\n";
+handle_uri(_,"/http_1_1_send_oct.html",_,_,Socket,_) ->
+ "HTTP/1.1 204 No Content\r\n" ++
+ "X-Socket-Stat-Send-Oct: " ++ integer_to_list(get_stat(Socket, send_oct)) ++ "\r\n" ++
+ "\r\n";
+handle_uri(_,"/http_1_1_send_oct_and_connection_close.html",_,_,Socket,_) ->
+ "HTTP/1.1 204 No Content\r\n" ++
+ "X-Socket-Stat-Send-Oct: " ++ integer_to_list(get_stat(Socket, send_oct)) ++ "\r\n" ++
+ "Connection: close\r\n" ++
+ "\r\n";
handle_uri(_,_,_,_,_,DefaultResponse) ->
DefaultResponse.
+get_stat(S, Opt) ->
+ case getstat(S, [Opt]) of
+ {ok, [{Opt, V}]} when is_integer(V) ->
+ V;
+ {error, _} = E ->
+ E
+ end.
+
+getstat(#sslsocket{} = S, Opts) ->
+ ssl:getstat(S, Opts);
+getstat(S, Opts) ->
+ inet:getstat(S, Opts).
+
url_start(#sslsocket{}) ->
{ok,Host} = inet:gethostname(),
?TLS_URL_START ++ Host ++ ":";
diff --git a/lib/kernel/doc/src/heart.xml b/lib/kernel/doc/src/heart.xml
index 5b5b71e521..46c7ce60b6 100644
--- a/lib/kernel/doc/src/heart.xml
+++ b/lib/kernel/doc/src/heart.xml
@@ -59,8 +59,9 @@
<pre>
% <input>erl -heart -env HEART_BEAT_TIMEOUT 30 ...</input></pre>
<p>The value (in seconds) must be in the range 10 &lt; X &lt;= 65535.</p>
- <p>Notice that if the system clock is adjusted with
- more than <c>HEART_BEAT_TIMEOUT</c> seconds, <c>heart</c>
+ <p>When running on OSs lacking support for monotonic time,
+ <c>heart</c> is susceptible to system clock adjustments of more than
+ <c>HEART_BEAT_TIMEOUT</c> seconds. When this happens, <c>heart</c>
times out and tries to reboot the system. This can occur, for
example, if the system clock is adjusted automatically by use of the
Network Time Protocol (NTP).</p>
diff --git a/scripts/diffable b/scripts/diffable
new file mode 100755
index 0000000000..f22194e99f
--- /dev/null
+++ b/scripts/diffable
@@ -0,0 +1,620 @@
+#!/usr/bin/env escript
+%% -*- erlang -*-
+-mode(compile).
+
+main(Args0) ->
+ {Args,Opts} = opts(Args0, #{format=>asm,no_compile=>false}),
+ case Args of
+ [OutDir] ->
+ do_compile(OutDir, Opts);
+ _ ->
+ usage(),
+ halt(1)
+ end.
+
+usage() ->
+ S = "usage: otp-diffable-asm [OPTION] DIRECTORY\n\n"
+ "Options:\n"
+ " --asm Output to .S files (default)\n"
+ " --dis Output to .dis files\n"
+ " --no-compile Disassemble from BEAM files (use with --dis)\n"
+ "\n"
+ "DESCRIPTION\n"
+ "\n"
+ "Compile some applications from OTP (more than 700 modules) to either\n"
+ ".S files or .dis files. The files are massaged to make them diff-friendly.\n"
+ "\n"
+ "EXAMPLES\n"
+ "\n"
+ "This example shows how the effectiveness of a compiler \n"
+ "optimization can be verified (alternatively, that pure code\n"
+ "refactoring has no effect on the generated code):\n"
+ "\n"
+ "$ scripts/diffable old\n"
+ "# Hack the compiler.\n"
+ "$ scripts/diffable new\n"
+ "$ diff -u old new\n"
+ "\n"
+ "This example shows how the effectiveness of loader hacks\n"
+ "can be verified:\n"
+ "\n"
+ "$ scripts/diffable --dis --no-compile old\n"
+ "# Hack ops.tab and/or one of the *instr.tab files.\n"
+ "$ scripts/diffable --dis --no-compile new\n"
+ "$ diff -u old new\n",
+ io:put_chars(S).
+
+opts(["--asm"|Args], Opts) ->
+ opts(Args, Opts#{format:=asm});
+opts(["--dis"|Args], Opts) ->
+ opts(Args, Opts#{format:=dis});
+opts(["--no-compile"|Args], Opts) ->
+ opts(Args, Opts#{format:=dis,no_compile:=true});
+opts(Args, Opts) ->
+ {Args,Opts}.
+
+do_compile(OutDir, Opts0) ->
+ Opts1 = Opts0#{outdir=>OutDir},
+ _ = filelib:ensure_dir(filename:join(OutDir, "dummy")),
+ Apps = ["preloaded",
+ "asn1",
+ "stdlib",
+ "kernel",
+ "reltool",
+ "runtime_tools",
+ "xmerl",
+ "common_test",
+ "compiler",
+ "diameter",
+ "mnesia",
+ "inets",
+ "syntax_tools",
+ "parsetools",
+ "dialyzer",
+ "ssl",
+ "wx"],
+ {Files,Opts} = get_files(Apps, Opts1),
+ CF = choose_format(Opts),
+ p_run(fun(File) ->
+ compile_file(CF, File)
+ end, Files).
+
+choose_format(#{format:=Format}=Opts) ->
+ case Format of
+ asm ->
+ compile_to_asm_fun(Opts);
+ dis ->
+ compile_to_dis_fun(Opts)
+ end.
+
+compile_file(CF, File) ->
+ try
+ CF(File)
+ catch
+ Class:Error:Stk ->
+ io:format("~s: ~p ~p\n~p\n",
+ [File,Class,Error,Stk]),
+ error
+ end.
+
+%%%
+%%% Get names of files (either .erl files or BEAM files).
+%%%
+
+get_files(Apps, #{format:=dis,no_compile:=true}=Opts) ->
+ Files = get_beams(Apps),
+ {Files,Opts};
+get_files(Apps, #{}=Opts) ->
+ Inc = make_includes(),
+ CompilerOpts = [{d,epmd_dist_high,42},
+ {d,epmd_dist_low,37},
+ {d,'VSN',1},
+ {d,'COMPILER_VSN',1},
+ {d,erlang_daemon_port,1337}|Inc],
+ Files0 = get_src(Apps),
+ Files = add_opts(Files0, CompilerOpts),
+ {Files,Opts}.
+
+add_opts([F|Fs], Opts0) ->
+ Opts = case filename:basename(F) of
+ "group_history.erl" ->
+ Opts0 -- [{d,'VSN',1}];
+ _ ->
+ Opts0
+ end,
+ [{F,Opts}|add_opts(Fs, Opts0)];
+add_opts([], _Opts) ->
+ [].
+
+get_src(["preloaded"|Apps]) ->
+ WC = filename:join(code:root_dir(), "erts/preloaded/src/*.erl"),
+ filelib:wildcard(WC) ++ get_src(Apps);
+get_src(["inets"|Apps]) ->
+ LibDir = code:lib_dir(inets),
+ WC = filename:join(LibDir, "src/*/*.erl"),
+ filelib:wildcard(WC) ++ get_src(Apps);
+get_src(["syntax_tools"|Apps]) ->
+ LibDir = code:lib_dir(syntax_tools),
+ WC = filename:join(LibDir, "src/*.erl"),
+ Files0 = filelib:wildcard(WC),
+ Files = [F || F <- Files0,
+ filename:basename(F) =/= "merl_tests.erl"],
+ Files ++ get_src(Apps);
+get_src(["wx"|Apps]) ->
+ LibDir = code:lib_dir(wx),
+ WC1 = filename:join(LibDir, "src/gen/*.erl"),
+ WC2 = filename:join(LibDir, "src/*.erl"),
+ filelib:wildcard(WC1) ++ filelib:wildcard(WC2) ++ get_src(Apps);
+get_src([App|Apps]) ->
+ WC = filename:join(code:lib_dir(App), "src/*.erl"),
+ filelib:wildcard(WC) ++ get_src(Apps);
+get_src([]) -> [].
+
+make_includes() ->
+ Is = [{common_test,"include"},
+ {inets,"include"},
+ {inets,"src/http_client"},
+ {inets,"src/http_lib"},
+ {inets,"src/http_server"},
+ {inets,"src/inets_app"},
+ {kernel,"include"},
+ {kernel,"src"},
+ {public_key,"include"},
+ {runtime_tools,"include"},
+ {ssh,"include"},
+ {snmp,"include"},
+ {stdlib,"include"},
+ {syntax_tools,"include"},
+ {wx,"src"},
+ {wx,"include"},
+ {xmerl,"include"}],
+ [{i,filename:join(code:lib_dir(App), Path)} || {App,Path} <- Is].
+
+get_beams(["preloaded"|Apps]) ->
+ WC = filename:join(code:root_dir(), "erts/preloaded/ebin/*.beam"),
+ filelib:wildcard(WC) ++ get_beams(Apps);
+get_beams([App|Apps]) ->
+ WC = filename:join(code:lib_dir(App), "ebin/*.beam"),
+ filelib:wildcard(WC) ++ get_beams(Apps);
+get_beams([]) -> [].
+
+
+%%%
+%%% Generate renumbered .S files.
+%%%
+
+compile_to_asm_fun(#{outdir:=OutDir}) ->
+ fun(File) ->
+ compile_to_asm(File, OutDir)
+ end.
+
+compile_to_asm({File,Opts}, OutDir) ->
+ case compile:file(File, [to_asm,binary,report_errors|Opts]) of
+ error ->
+ error;
+ {ok,Mod,Asm0} ->
+ {ok,Asm1} = beam_a:module(Asm0, []),
+ Asm2 = renumber_asm(Asm1),
+ {ok,Asm} = beam_z:module(Asm2, []),
+ print_asm(Mod, OutDir, Asm)
+ end.
+
+print_asm(Mod, OutDir, Asm) ->
+ S = atom_to_list(Mod) ++ ".S",
+ Name = filename:join(OutDir, S),
+ {ok,Fd} = file:open(Name, [write,raw,delayed_write]),
+ ok = beam_listing(Fd, Asm),
+ ok = file:close(Fd).
+
+renumber_asm({Mod,Exp,Attr,Fs0,NumLabels}) ->
+ EntryLabels = maps:from_list(entry_labels(Fs0)),
+ Fs = [fix_func(F, EntryLabels) || F <- Fs0],
+ {Mod,Exp,Attr,Fs,NumLabels}.
+
+entry_labels(Fs) ->
+ [{Entry,{Name,Arity}} || {function,Name,Arity,Entry,_} <- Fs].
+
+fix_func({function,Name,Arity,Entry0,Is0}, LabelMap0) ->
+ Entry = maps:get(Entry0, LabelMap0),
+ LabelMap = label_map(Is0, 1, LabelMap0),
+ Is = replace(Is0, [], LabelMap),
+ {function,Name,Arity,Entry,Is}.
+
+label_map([{label,Old}|Is], New, Map) ->
+ case maps:is_key(Old, Map) of
+ false ->
+ label_map(Is, New+1, Map#{Old=>New});
+ true ->
+ label_map(Is, New, Map)
+ end;
+label_map([_|Is], New, Map) ->
+ label_map(Is, New, Map);
+label_map([], _New, Map) ->
+ Map.
+
+replace([{label,Lbl}|Is], Acc, D) ->
+ replace(Is, [{label,label(Lbl, D)}|Acc], D);
+replace([{test,Test,{f,Lbl},Ops}|Is], Acc, D) ->
+ replace(Is, [{test,Test,{f,label(Lbl, D)},Ops}|Acc], D);
+replace([{test,Test,{f,Lbl},Live,Ops,Dst}|Is], Acc, D) ->
+ replace(Is, [{test,Test,{f,label(Lbl, D)},Live,Ops,Dst}|Acc], D);
+replace([{select,I,R,{f,Fail0},Vls0}|Is], Acc, D) ->
+ Vls = lists:map(fun ({f,L}) -> {f,label(L, D)};
+ (Other) -> Other
+ end, Vls0),
+ Fail = label(Fail0, D),
+ replace(Is, [{select,I,R,{f,Fail},Vls}|Acc], D);
+replace([{'try',R,{f,Lbl}}|Is], Acc, D) ->
+ replace(Is, [{'try',R,{f,label(Lbl, D)}}|Acc], D);
+replace([{'catch',R,{f,Lbl}}|Is], Acc, D) ->
+ replace(Is, [{'catch',R,{f,label(Lbl, D)}}|Acc], D);
+replace([{jump,{f,Lbl}}|Is], Acc, D) ->
+ replace(Is, [{jump,{f,label(Lbl, D)}}|Acc], D);
+replace([{loop_rec,{f,Lbl},R}|Is], Acc, D) ->
+ replace(Is, [{loop_rec,{f,label(Lbl, D)},R}|Acc], D);
+replace([{loop_rec_end,{f,Lbl}}|Is], Acc, D) ->
+ replace(Is, [{loop_rec_end,{f,label(Lbl, D)}}|Acc], D);
+replace([{wait,{f,Lbl}}|Is], Acc, D) ->
+ replace(Is, [{wait,{f,label(Lbl, D)}}|Acc], D);
+replace([{wait_timeout,{f,Lbl},To}|Is], Acc, D) ->
+ replace(Is, [{wait_timeout,{f,label(Lbl, D)},To}|Acc], D);
+replace([{bif,Name,{f,Lbl},As,R}|Is], Acc, D) when Lbl =/= 0 ->
+ replace(Is, [{bif,Name,{f,label(Lbl, D)},As,R}|Acc], D);
+replace([{gc_bif,Name,{f,Lbl},Live,As,R}|Is], Acc, D) when Lbl =/= 0 ->
+ replace(Is, [{gc_bif,Name,{f,label(Lbl, D)},Live,As,R}|Acc], D);
+replace([{call,Ar,{f,Lbl}}|Is], Acc, D) ->
+ replace(Is, [{call,Ar,{f,label(Lbl,D)}}|Acc], D);
+replace([{make_fun2,{f,Lbl},U1,U2,U3}|Is], Acc, D) ->
+ replace(Is, [{make_fun2,{f,label(Lbl, D)},U1,U2,U3}|Acc], D);
+replace([{bs_init,{f,Lbl},Info,Live,Ss,Dst}|Is], Acc, D) when Lbl =/= 0 ->
+ replace(Is, [{bs_init,{f,label(Lbl, D)},Info,Live,Ss,Dst}|Acc], D);
+replace([{bs_put,{f,Lbl},Info,Ss}|Is], Acc, D) when Lbl =/= 0 ->
+ replace(Is, [{bs_put,{f,label(Lbl, D)},Info,Ss}|Acc], D);
+replace([{put_map=I,{f,Lbl},Op,Src,Dst,Live,List}|Is], Acc, D)
+ when Lbl =/= 0 ->
+ replace(Is, [{I,{f,label(Lbl, D)},Op,Src,Dst,Live,List}|Acc], D);
+replace([{get_map_elements=I,{f,Lbl},Src,List}|Is], Acc, D) when Lbl =/= 0 ->
+ replace(Is, [{I,{f,label(Lbl, D)},Src,List}|Acc], D);
+replace([{recv_mark=I,{f,Lbl}}|Is], Acc, D) ->
+ replace(Is, [{I,{f,label(Lbl, D)}}|Acc], D);
+replace([{recv_set=I,{f,Lbl}}|Is], Acc, D) ->
+ replace(Is, [{I,{f,label(Lbl, D)}}|Acc], D);
+replace([I|Is], Acc, D) ->
+ replace(Is, [I|Acc], D);
+replace([], Acc, _) ->
+ lists:reverse(Acc).
+
+label(Old, D) when is_integer(Old) ->
+ maps:get(Old, D).
+
+%%%
+%%% Compile and disassemble the loaded code.
+%%%
+
+compile_to_dis_fun(#{outdir:=OutDir,no_compile:=false}) ->
+ fun(File) ->
+ compile_to_dis(File, OutDir)
+ end;
+compile_to_dis_fun(#{outdir:=OutDir,no_compile:=true}) ->
+ fun(File) ->
+ dis_only(File, OutDir)
+ end.
+
+compile_to_dis({File,Opts}, OutDir) ->
+ case compile:file(File, [to_asm,binary,report_errors|Opts]) of
+ error ->
+ error;
+ {ok,Mod,Asm0} ->
+ NewMod = list_to_atom("--"++atom_to_list(Mod)++"--"),
+ Asm = rename_mod_in_asm(Asm0, Mod, NewMod),
+ AsmOpts = [from_asm,report,no_postopt,binary],
+ {ok,NewMod,Beam} = compile:forms(Asm, AsmOpts),
+ Dis0 = disasm(NewMod, Beam),
+ Dis1 = renumber_disasm(Dis0, Mod, NewMod),
+ Dis = format_disasm(Dis1),
+ OutFile = filename:join(OutDir, atom_to_list(Mod)++".dis"),
+ ok = file:write_file(OutFile, Dis)
+ end.
+
+dis_only(File, OutDir) ->
+ Mod0 = filename:rootname(filename:basename(File)),
+ Mod = list_to_atom(Mod0),
+ Dis0 = disasm(Mod),
+ Dis1 = renumber_disasm(Dis0, Mod, Mod),
+ Dis = format_disasm(Dis1),
+ OutFile = filename:join(OutDir, atom_to_list(Mod)++".dis"),
+ ok = file:write_file(OutFile, Dis).
+
+%%% Loading system modules can cause any number of problems.
+%%% Therefore, we rename all modules to a dummy name before
+%%% loading and disassembling them.
+
+rename_mod_in_asm({OldMod,Exp,_Attr,Fs0,NumLabels}, OldMod, NewMod) ->
+ Fs = [fix_func_info(F, {atom,OldMod}, {atom,NewMod}) || F <- Fs0],
+ {NewMod,Exp,[],Fs,NumLabels}.
+
+fix_func_info({function,Name,Arity,Entry,Is0}, OldMod, NewMod) ->
+ Is1 = [begin
+ case I of
+ {func_info,_,F,A} ->
+ {func_info,NewMod,F,A};
+ _ ->
+ I
+ end
+ end || I <- Is0],
+ Is = case {Name,Arity} of
+ {module_info,0} -> fix_module_info(Is1, OldMod, NewMod);
+ {module_info,1} -> fix_module_info(Is1, OldMod, NewMod);
+ {_,_} -> Is1
+ end,
+ {function,Name,Arity,Entry,Is}.
+
+fix_module_info([{move,OldMod,Dst}|Is], OldMod, NewMod) ->
+ [{move,NewMod,Dst}|fix_module_info(Is, OldMod, NewMod)];
+fix_module_info([I|Is], OldMod, NewMod) ->
+ [I|fix_module_info(Is, OldMod, NewMod)];
+fix_module_info([], _, _) ->
+ [].
+
+
+%%% Disassemble the module.
+
+disasm(Mod, Beam) ->
+ {module,Mod} = code:load_binary(Mod, "", Beam),
+ disasm(Mod).
+
+disasm(Mod) ->
+ disasm_1(Mod:module_info(functions), Mod).
+
+disasm_1([{Name,Arity}|Fs], Mod) ->
+ MFA = {Mod,Name,Arity},
+ Dis = disasm_func({MFA,<<>>,MFA}, MFA),
+ [{Name,Arity,Dis}|disasm_1(Fs, Mod)];
+disasm_1([], _) ->
+ [].
+
+disasm_func({Next,_,MFA}, MFA) ->
+ case erts_debug:disassemble(Next) of
+ {_,Line,MFA}=Cont ->
+ [Line|disasm_func(Cont, MFA)];
+ {_,_,_} ->
+ [];
+ false ->
+ []
+ end.
+
+%%% Renumber the disassembled module to use labels instead of
+%%% absolute addresses. Also do other translations so that the
+%%% output will be the same each time (for the same BEAM file
+%%% runtime system).
+
+renumber_disasm(Fs0, OldMod, NewMod) ->
+ Fs1 = split_dis_lines(Fs0),
+ renumber_disasm_fs(Fs1, OldMod, NewMod).
+
+renumber_disasm_fs([{Name,Arity,Is0}|Fs], OldMod, NewMod) ->
+ Labels = find_labels(Is0, Name, Arity),
+ Is1 = rename_mod(Is0, OldMod, NewMod),
+ Is = renumber_disasm_func(Is1, Labels),
+ [{Name,Arity,Is}|renumber_disasm_fs(Fs, OldMod, NewMod)];
+renumber_disasm_fs([], _OldMod, _NewMod) ->
+ [].
+
+renumber_disasm_func([[A,OpCode|Ops0]|Is], Labels) ->
+ Spaces = " ",
+ Left = case maps:find(A, Labels) of
+ {ok,Lbl} ->
+ case byte_size(Lbl) of
+ LblSize when LblSize < length(Spaces) ->
+ [$\n,Lbl,":",lists:nth(LblSize, Spaces)];
+ _ ->
+ [Lbl,":\n"|Spaces]
+ end;
+ error ->
+ Spaces
+ end,
+ Ops1 = [replace_label(Op, Labels) || Op <- Ops0],
+ Ops = handle_special_instrs(OpCode, Ops1),
+ [[Left,OpCode|Ops]|renumber_disasm_func(Is, Labels)];
+renumber_disasm_func([], _) ->
+ [].
+
+handle_special_instrs(<<"i_get_hash_cId">>, [Key,_Hash,Dst]) ->
+ [Key,hash_value(),Dst];
+handle_special_instrs(<<"i_get_map_element_",_/binary>>,
+ [Fail,Src,Key,_Hash,Dst]) ->
+ [Fail,Src,Key,hash_value(),Dst];
+handle_special_instrs(<<"i_get_map_elements_",_/binary>>,
+ [Fail,Src,N,Space|List0]) ->
+ List1 = rejoin_atoms(List0),
+ List = fix_hash_value(List1),
+ [Fail,Src,N,Space|List];
+handle_special_instrs(<<"i_select_val_bins_",_/binary>>,
+ [Src,Fail,Num|List0]) ->
+ %% Atoms are sorted in atom-number order, which is
+ %% different every time the runtime system is restarted.
+ %% Resort the values in ASCII order.
+ List1 = rejoin_atoms(List0),
+ {Values0,Labels0} = lists:split(length(List1) div 2, List1),
+ Zipped0 = lists:zip(Values0, Labels0),
+ Zipped = lists:sort(Zipped0),
+ {Values,Labels} = lists:unzip(Zipped),
+ [Src,Fail,Num|Values++Labels];
+handle_special_instrs(<<"i_select_val_lins_",_/binary>>,
+ [Src,Fail,Num|List0]) ->
+ List1 = rejoin_atoms(List0),
+ {Values0,Labels0} = lists:split(length(List1) div 2, List1),
+ Values1 = lists:droplast(Values0),
+ Labels1 = lists:droplast(Labels0),
+ Vlast = lists:last(Values0),
+ Llast = lists:last(Labels0),
+ Zipped0 = lists:zip(Values1, Labels1),
+ Zipped = lists:sort(Zipped0),
+ {Values,Labels} = lists:unzip(Zipped),
+ [Src,Fail,Num|Values++[Vlast]++Labels++[Llast]];
+handle_special_instrs(_, Ops) ->
+ Ops.
+
+fix_hash_value([Val,Dst,_Hash|T]) ->
+ [Val,Dst,hash_value()|fix_hash_value(T)];
+fix_hash_value([]) ->
+ [].
+
+hash_value() ->
+ <<"--hash-value--">>.
+
+replace_label(<<"f(",T/binary>>, Labels) ->
+ replace_label_1("f(", T, Labels);
+replace_label(<<"j(",T/binary>>, Labels) ->
+ replace_label_1("j(", T, Labels);
+replace_label(Op, _Labels) ->
+ Op.
+
+replace_label_1(Prefix, Lbl0, Labels) ->
+ Sz = byte_size(Lbl0)-1,
+ Lbl = case Lbl0 of
+ <<"0)">> ->
+ Lbl0;
+ <<Lbl1:Sz/bytes,")">> ->
+ [maps:get(Lbl1, Labels),")"];
+ _ ->
+ Lbl0
+ end,
+ iolist_to_binary([Prefix,Lbl]).
+
+split_dis_lines(Fs) ->
+ {ok,RE} = re:compile(<<"\\s*\\n$">>),
+ Colon = binary:compile_pattern(<<": ">>),
+ Space = binary:compile_pattern(<<" ">>),
+ [split_dis_func(F, RE, Colon, Space) || F <- Fs].
+
+split_dis_func({Name,Arity,Lines0}, RE, Colon, Space) ->
+ Lines1 = [re:replace(L, RE, <<>>, [{return,binary}]) || L <- Lines0],
+ Lines2 = [begin
+ [A,I] = binary:split(L, Colon),
+ Ops = binary:split(I, Space, [global]),
+ [A|Ops]
+ end|| L <- Lines1],
+ {Name,Arity,Lines2}.
+
+rejoin_atoms([<<"'",Tail/binary>> = Bin0,Next|Ops]) ->
+ Sz = byte_size(Tail) - 1,
+ case Tail of
+ <<_:Sz/bytes,"'">> ->
+ [Bin0|rejoin_atoms([Next|Ops])];
+ <<>> ->
+ Bin = <<Bin0/binary,$\s,Next/binary>>,
+ rejoin_atoms([Bin|Ops]);
+ _ ->
+ Bin = <<Bin0/binary,$\s,Next/binary>>,
+ rejoin_atoms([Bin|Ops])
+ end;
+rejoin_atoms(Ops) ->
+ Ops.
+
+find_labels(Is, Name, Arity) ->
+ [_,[Entry|_]|_] = Is,
+ EntryLabel = iolist_to_binary(io_lib:format("~p/~p", [Name,Arity])),
+ {ok,RE} = re:compile(<<"^[fj]\\(([0-9A-F]{8,16})\\)$">>),
+ Ls0 = [find_labels_1(Ops, RE) || [_Addr,_OpCode|Ops] <- Is],
+ Ls1 = lists:flatten(Ls0),
+ Ls2 = lists:usort(Ls1),
+ Ls3 = number(Ls2, 1),
+ Ls = [{Entry,EntryLabel}|Ls3],
+ maps:from_list(Ls).
+
+find_labels_1([Op|Ops], RE) ->
+ case re:run(Op, RE, [{capture,all_but_first,binary}]) of
+ nomatch ->
+ find_labels_1(Ops, RE);
+ {match,[M]} ->
+ [M|find_labels_1(Ops, RE)]
+ end;
+find_labels_1([], _) ->
+ [].
+
+number([H|T], N) ->
+ S = iolist_to_binary(["L",integer_to_list(N)]),
+ [{H,S}|number(T, N+1)];
+number([], _) ->
+ [].
+
+format_disasm([{_,_,Is}|Fs]) ->
+ L = [lists:join(" ", I) || I <- Is],
+ [lists:join("\n", L),"\n\n"|format_disasm(Fs)];
+format_disasm([]) ->
+ [].
+
+rename_mod(Is, OldMod0, NewMod) ->
+ OldMod = atom_to_binary(OldMod0, utf8),
+ Pattern = <<"'",(atom_to_binary(NewMod, utf8))/binary,"'">>,
+ [rename_mod_1(I, Pattern, OldMod) || I <- Is].
+
+rename_mod_1([A,OpCode|Ops], Pat, Replacement) ->
+ [A,OpCode|[rename_mod_2(Op, Pat, Replacement) || Op <- Ops]].
+
+rename_mod_2(Subject, Pat, Replacement) ->
+ Sz = byte_size(Pat),
+ case Subject of
+ <<Pat:Sz/bytes,Tail/binary>> ->
+ <<Replacement/binary,Tail/binary>>;
+ _ ->
+ Subject
+ end.
+
+%%%
+%%% Run tasks in parallel.
+%%%
+
+p_run(Test, List) ->
+ N = erlang:system_info(schedulers) * 2,
+ p_run_loop(Test, List, N, [], 0).
+
+p_run_loop(_, [], _, [], Errors) ->
+ io:put_chars("\r \n"),
+ case Errors of
+ 0 ->
+ ok;
+ N ->
+ io:format("~p errors\n", [N]),
+ halt(1)
+ end;
+p_run_loop(Test, [H|T], N, Refs, Errors) when length(Refs) < N ->
+ {_,Ref} = erlang:spawn_monitor(fun() -> exit(Test(H)) end),
+ p_run_loop(Test, T, N, [Ref|Refs], Errors);
+p_run_loop(Test, List, N, Refs0, Errors0) ->
+ io:format("\r~p ", [length(List)+length(Refs0)]),
+ receive
+ {'DOWN',Ref,process,_,Res} ->
+ Errors = case Res of
+ ok -> Errors0;
+ error -> Errors0 + 1
+ end,
+ Refs = Refs0 -- [Ref],
+ p_run_loop(Test, List, N, Refs, Errors)
+ end.
+
+%%%
+%%% Borrowed from beam_listing and tweaked.
+%%%
+
+beam_listing(Stream, {Mod,Exp,Attr,Code,NumLabels}) ->
+ Head = ["%% -*- encoding:latin-1 -*-\n",
+ io_lib:format("{module, ~p}. %% version = ~w\n",
+ [Mod, beam_opcodes:format_number()]),
+ io_lib:format("\n{exports, ~p}.\n", [Exp]),
+ io_lib:format("\n{attributes, ~p}.\n", [Attr]),
+ io_lib:format("\n{labels, ~p}.\n", [NumLabels])],
+ ok = file:write(Stream, Head),
+ lists:foreach(
+ fun ({function,Name,Arity,Entry,Asm}) ->
+ S = [io_lib:format("\n\n{function, ~w, ~w, ~w}.\n",
+ [Name,Arity,Entry])|format_asm(Asm)],
+ ok = file:write(Stream, S)
+ end, Code).
+
+format_asm([{label,_}=I|Is]) ->
+ [io_lib:format(" ~p", [I]),".\n"|format_asm(Is)];
+format_asm([I|Is]) ->
+ [io_lib:format(" ~p", [I]),".\n"|format_asm(Is)];
+format_asm([]) -> [].
generated by cgit v1.2.3 (git 2.25.1) at 2025-01-19 03:02:57 +0000