diff options
Diffstat (limited to 'erts')
112 files changed, 4965 insertions, 1505 deletions
diff --git a/erts/configure.in b/erts/configure.in index 508e99a415..2f6043ee85 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -595,6 +595,8 @@ AS_HELP_STRING([--enable-pgo], esac ],enable_pgo=default) +LM_CHECK_ENABLE_CFLAG([-fprofile-use -fprofile-correction -Werror],[PROFILE_CORRECTION]) + USE_PGO=false AC_MSG_CHECKING([whether to do PGO of erts]) if test $enable_pgo = no; then @@ -607,22 +609,16 @@ elif test $CROSS_COMPILING = yes; then fi elif test "X$host" = "Xwin32"; then AC_MSG_RESULT([no, not supported in windows]) -elif test "X$PROFILE_GENERATE" = "Xtrue" -a "X$PROFILE_USE" = "Xtrue"; then +elif test "X$PROFILE_GENERATE" = "Xtrue" -a "X$PROFILE_USE" = "Xtrue" -a "X$PROFILE_CORRECTION" = "Xtrue"; then + ## We need -fprofile-generate and -fprofile-correction support to use PGO with + ## gcc as multiple threads run within the executed object files USE_PGO=true - AC_MSG_RESULT([yes, using -fprofile-generate]) PROFILE_COMPILER=gcc -# check if $CC accepts -fprofile-correction, if so we can use PGO on multi-threaded files. - LM_CHECK_ENABLE_CFLAG([-fprofile-use -fprofile-correction -Werror],[PROFILE_CORRECTION]) - if test "X$PROFILE_CORRECTION" = "Xtrue"; then - PROFILE_CORRECTION="-fprofile-correction" - else - PROFILE_CORRECTION="" - fi - AC_SUBST(PROFILE_CORRECTION) + AC_MSG_RESULT([yes, using -fprofile-generate -fprofile-correction]) elif test "X$PROFILE_INSTR_GENERATE" = "Xtrue" -a "X$PROFILE_INSTR_USE" = "Xtrue"; then USE_PGO=true - AC_MSG_RESULT([yes, using -fprofile-instr-generate]) PROFILE_COMPILER=clang + AC_MSG_RESULT([yes, using -fprofile-instr-generate]) else if $enable_pgo = yes; then AC_MSG_ERROR(cannot use PGO with this compiler) diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index 6f6eca2a0b..bd824b3405 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -1641,9 +1641,7 @@ <tag>The <c>.erlang</c> startup file</tag> <item> <p>When Erlang/OTP is started, the system searches for a file named - <c>.erlang</c> in the directory where Erlang/OTP is started. If not - found, the user's home directory is searched for an <c>.erlang</c> - file.</p> + <c>.erlang</c> in the user's home directory.</p> <p>If an <c>.erlang</c> file is found, it is assumed to contain valid Erlang expressions. These expressions are evaluated as if they were input to the shell.</p> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index b40aae5d28..3b7b9d6a50 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -557,9 +557,7 @@ hello <name name="binary_to_term" arity="2"/> <fsummary>Decode an Erlang external term format binary.</fsummary> <desc> - <p>As <c>binary_to_term/1</c>, but takes options that affect decoding - of the binary.</p> - <p>Option:</p> + <p>As <c>binary_to_term/1</c>, but takes these options:</p> <taglist> <tag><c>safe</c></tag> <item> @@ -575,18 +573,31 @@ hello creation of new external function references. None of those resources are garbage collected, so unchecked creation of them can exhaust available memory.</p> - </item> - </taglist> - <p>Failure: <c>badarg</c> if <c>safe</c> is specified and unsafe - data is decoded.</p> <pre> -> <input>binary_to_term(<<131,100,0,5,104,101,108,108,111>>, [safe]).</input> +> <input>binary_to_term(<<131,100,0,5,"hello">>, [safe]).</input> ** exception error: bad argument > <input>hello.</input> hello -> <input>binary_to_term(<<131,100,0,5,104,101,108,108,111>>, [safe]).</input> +> <input>binary_to_term(<<131,100,0,5,"hello">>, [safe]).</input> hello </pre> + </item> + <tag><c>used</c></tag> + <item> + <p>Changes the return value to <c>{Term, Used}</c> where <c>Used</c> + is the number of bytes actually read from <c>Binary</c>.</p> + <pre> +> <input>Input = <<131,100,0,5,"hello","world">>.</input> +<<131,100,0,5,104,101,108,108,111,119,111,114,108,100>> +> <input>{Term, Used} = binary_to_term(Input, [used]).</input> +{hello, 9} +> <input>split_binary(Input, Used).</input> +{<<131,100,0,5,104,101,108,108,111>>, <<"world">>} +</pre> + </item> + </taglist> + <p>Failure: <c>badarg</c> if <c>safe</c> is specified and unsafe + data is decoded.</p> <p>See also <seealso marker="#term_to_binary/1"><c>term_to_binary/1</c></seealso>, <seealso marker="#binary_to_term/1"> @@ -2029,6 +2040,18 @@ helper() -> where the exception occurred or the function was called. </item> </taglist> + <warning><p>Developers should rely on stacktrace entries only for + debugging purposes.</p> + <p>The VM performs tail call optimization, which + does not add new entries to the stacktrace, and also limits stacktraces + to a certain depth. Furthermore, compiler options, optimizations and + future changes may add or remove stacktrace entries, causing any code + that expects the stacktrace to be in a certain order or contain specific + items to fail.</p> + <p>The only exception to this rule is <c>error:undef</c> which + guarantees to include the <anno>Module</anno>, <anno>Function</anno> and <anno>Arity</anno> + of the attempted function as the first stacktrace entry.</p> + </warning> <p>See also <seealso marker="#error/1"><c>error/1</c></seealso> and <seealso marker="#error/2"><c>error/2</c></seealso>.</p> @@ -4718,11 +4741,11 @@ RealSystem = system + MissedSystem</code> </func> <func> - <name name="process_flag" arity="2" clause_i="3"/> + <name name="process_flag" arity="2" clause_i="3" + anchor="process_flag_min_heap_size"/> <fsummary>Set process flag min_heap_size for the calling process. </fsummary> <desc> - <marker id="process_flag_min_heap_size"/> <p>Changes the minimum heap size for the calling process.</p> <p>Returns the old value of the flag.</p> </desc> @@ -4740,12 +4763,12 @@ RealSystem = system + MissedSystem</code> </func> <func> - <name name="process_flag" arity="2" clause_i="5"/> + <name name="process_flag" arity="2" clause_i="5" + anchor="process_flag_max_heap_size"/> <fsummary>Set process flag max_heap_size for the calling process. </fsummary> <type name="max_heap_size"/> <desc> - <marker id="process_flag_max_heap_size"/> <p>This flag sets the maximum heap size for the calling process. If <c><anno>MaxHeapSize</anno></c> is an integer, the system default values for <c>kill</c> and <c>error_logger</c> are used. @@ -4814,12 +4837,12 @@ RealSystem = system + MissedSystem</code> </func> <func> - <name name="process_flag" arity="2" clause_i="6"/> + <name name="process_flag" arity="2" clause_i="6" + anchor="process_flag_message_queue_data"/> <fsummary>Set process flag message_queue_data for the calling process. </fsummary> <type name="message_queue_data"/> <desc> - <marker id="process_flag_message_queue_data"/> <p>This flag determines how messages in the message queue are stored, as follows:</p> <taglist> @@ -4856,11 +4879,12 @@ RealSystem = system + MissedSystem</code> </func> <func> - <name name="process_flag" arity="2" clause_i="7"/> + <name name="process_flag" arity="2" clause_i="7" + anchor="process_flag_priority"/> <fsummary>Set process flag priority for the calling process.</fsummary> <type name="priority_level"/> <desc> - <p><marker id="process_flag_priority"></marker> + <p> Sets the process priority. <c><anno>Level</anno></c> is an atom. Four priority levels exist: <c>low</c>, <c>normal</c>, <c>high</c>, and <c>max</c>. Default @@ -6335,10 +6359,10 @@ true</pre> </func> <func> - <name name="statistics" arity="1" clause_i="1"/> + <name name="statistics" arity="1" clause_i="1" + anchor="statistics_active_tasks"/> <fsummary>Information about active processes and ports.</fsummary> <desc> - <marker id="statistics_active_tasks"></marker> <p>Returns the same as <seealso marker="#statistics_active_tasks_all"> <c>statistics(active_tasks_all)</c></seealso> @@ -6350,10 +6374,10 @@ true</pre> </func> <func> - <name name="statistics" arity="1" clause_i="2"/> + <name name="statistics" arity="1" clause_i="2" + anchor="statistics_active_tasks_all"/> <fsummary>Information about active processes and ports.</fsummary> <desc> - <marker id="statistics_active_tasks_all"></marker> <p>Returns a list where each element represents the amount of active processes and ports on each run queue and its associated schedulers. That is, the number of processes and @@ -6401,10 +6425,10 @@ true</pre> </func> <func> - <name name="statistics" arity="1" clause_i="4"/> + <name name="statistics" arity="1" clause_i="4" + anchor="statistics_exact_reductions"/> <fsummary>Information about exact reductions.</fsummary> <desc> - <marker id="statistics_exact_reductions"></marker> <p>Returns the number of exact reductions.</p> <note> <p><c>statistics(exact_reductions)</c> is @@ -6439,10 +6463,10 @@ true</pre> </func> <func> - <name name="statistics" arity="1" clause_i="7"/> + <name name="statistics" arity="1" clause_i="7" + anchor="statistics_microstate_accounting"/> <fsummary>Information about microstate accounting.</fsummary> <desc> - <marker id="statistics_microstate_accounting"></marker> <p>Microstate accounting can be used to measure how much time the Erlang runtime system spends doing various tasks. It is designed to be as lightweight as possible, but some overhead exists when this @@ -6582,10 +6606,10 @@ lists:map( </func> <func> - <name name="statistics" arity="1" clause_i="8"/> + <name name="statistics" arity="1" clause_i="8" + anchor="statistics_reductions"/> <fsummary>Information about reductions.</fsummary> <desc> - <marker id="statistics_reductions"></marker> <p>Returns information about reductions, for example:</p> <pre> > <input>statistics(reductions).</input> @@ -6601,9 +6625,10 @@ lists:map( </func> <func> - <name name="statistics" arity="1" clause_i="9"/> + <name name="statistics" arity="1" clause_i="9" + anchor="statistics_run_queue"/> <fsummary>Information about the run-queues.</fsummary> - <desc><marker id="statistics_run_queue"></marker> + <desc> <p>Returns the total length of all normal run-queues. That is, the number of processes and ports that are ready to run on all available normal run-queues. Dirty run queues are not part of the @@ -6617,9 +6642,10 @@ lists:map( </func> <func> - <name name="statistics" arity="1" clause_i="10"/> + <name name="statistics" arity="1" clause_i="10" + anchor="statistics_run_queue_lengths"/> <fsummary>Information about the run-queue lengths.</fsummary> - <desc><marker id="statistics_run_queue_lengths"></marker> + <desc> <p>Returns the same as <seealso marker="#statistics_run_queue_lengths_all"> <c>statistics(run_queue_lengths_all)</c></seealso> @@ -6631,9 +6657,10 @@ lists:map( </func> <func> - <name name="statistics" arity="1" clause_i="11"/> + <name name="statistics" arity="1" clause_i="11" + anchor="statistics_run_queue_lengths_all"/> <fsummary>Information about the run-queue lengths.</fsummary> - <desc><marker id="statistics_run_queue_lengths_all"></marker> + <desc> <p>Returns a list where each element represents the amount of processes and ports ready to run for each run queue. Values for normal run queues are located first in the @@ -6691,10 +6718,10 @@ lists:map( </func> <func> - <name name="statistics" arity="1" clause_i="13"/> + <name name="statistics" arity="1" clause_i="13" + anchor="statistics_scheduler_wall_time"/> <fsummary>Information about each schedulers work time.</fsummary> <desc> - <marker id="statistics_scheduler_wall_time"></marker> <p>Returns a list of tuples with <c>{<anno>SchedulerId</anno>, <anno>ActiveTime</anno>, <anno>TotalTime</anno>}</c>, where @@ -6812,10 +6839,10 @@ ok </func> <func> - <name name="statistics" arity="1" clause_i="14"/> + <name name="statistics" arity="1" clause_i="14" + anchor="statistics_scheduler_wall_time_all"/> <fsummary>Information about each schedulers work time.</fsummary> <desc> - <marker id="statistics_scheduler_wall_time_all"></marker> <p>The same as <seealso marker="#statistics_scheduler_wall_time"><c>statistics(scheduler_wall_time)</c></seealso>, except that it also include information about all dirty I/O @@ -6837,9 +6864,10 @@ ok </desc> </func> <func> - <name name="statistics" arity="1" clause_i="15"/> + <name name="statistics" arity="1" clause_i="15" + anchor="statistics_total_active_tasks"/> <fsummary>Information about active processes and ports.</fsummary> - <desc><marker id="statistics_total_active_tasks"></marker> + <desc> <p>The same as calling <c>lists:sum(</c><seealso marker="#statistics_active_tasks"><c>statistics(active_tasks)</c></seealso><c>)</c>, but more efficient.</p> @@ -6847,9 +6875,10 @@ ok </func> <func> - <name name="statistics" arity="1" clause_i="16"/> + <name name="statistics" arity="1" clause_i="16" + anchor="statistics_total_active_tasks_all"/> <fsummary>Information about active processes and ports.</fsummary> - <desc><marker id="statistics_total_active_tasks_all"></marker> + <desc> <p>The same as calling <c>lists:sum(</c><seealso marker="#statistics_active_tasks_all"><c>statistics(active_tasks_all)</c></seealso><c>)</c>, but more efficient.</p> @@ -6857,9 +6886,10 @@ ok </func> <func> - <name name="statistics" arity="1" clause_i="17"/> + <name name="statistics" arity="1" clause_i="17" + anchor="statistics_total_run_queue_lengths"/> <fsummary>Information about the run-queue lengths.</fsummary> - <desc><marker id="statistics_total_run_queue_lengths"></marker> + <desc> <p>The same as calling <c>lists:sum(</c><seealso marker="#statistics_run_queue_lengths"><c>statistics(run_queue_lengths)</c></seealso><c>)</c>, but more efficient.</p> @@ -6867,9 +6897,10 @@ ok </func> <func> - <name name="statistics" arity="1" clause_i="18"/> + <name name="statistics" arity="1" clause_i="18" + anchor="statistics_total_run_queue_lengths_all"/> <fsummary>Information about the run-queue lengths.</fsummary> - <desc><marker id="statistics_total_run_queue_lengths_all"></marker> + <desc> <p>The same as calling <c>lists:sum(</c><seealso marker="#statistics_run_queue_lengths_all"><c>statistics(run_queue_lengths_all)</c></seealso><c>)</c>, but more efficient.</p> @@ -7017,7 +7048,8 @@ ok </func> <func> - <name name="system_flag" arity="2" clause_i="2"/> + <name name="system_flag" arity="2" clause_i="2" + anchor="system_flag_cpu_topology"/> <fsummary>Set system flag <c>cpu_topology</c>.</fsummary> <type name="cpu_topology"/> <type name="level_entry"/> @@ -7026,7 +7058,7 @@ ok <type name="info_list"/> <desc> <warning> - <p><marker id="system_flag_cpu_topology"></marker> + <p> <em>This argument is deprecated.</em> Instead of using this argument, use command-line argument <seealso marker="erts:erl#+sct"><c>+sct</c></seealso> in @@ -7064,10 +7096,11 @@ ok </func> <func> - <name name="system_flag" arity="2" clause_i="3"/> + <name name="system_flag" arity="2" clause_i="3" + anchor="system_flag_dirty_cpu_schedulers_online"/> <fsummary>Set system_flag_dirty_cpu_schedulers_online.</fsummary> <desc> - <p><marker id="system_flag_dirty_cpu_schedulers_online"></marker> + <p> Sets the number of dirty CPU schedulers online. Range is <c><![CDATA[1 <= DirtyCPUSchedulersOnline <= N]]></c>, where <c>N</c> is the smallest of the return values of @@ -7111,10 +7144,11 @@ ok </func> <func> - <name name="system_flag" arity="2" clause_i="5"/> + <name name="system_flag" arity="2" clause_i="5" + anchor="system_flag_microstate_accounting"/> <fsummary>Set system flag microstate_accounting.</fsummary> <desc> - <p><marker id="system_flag_microstate_accounting"></marker> + <p> Turns on/off microstate accounting measurements. When passing reset, all counters are reset to 0.</p> <p>For more information see @@ -7156,28 +7190,29 @@ ok </func> <func> - <name name="system_flag" arity="2" clause_i="8"/> + <name name="system_flag" arity="2" clause_i="8" + anchor="system_flag_max_heap_size"/> <fsummary>Set system flag max_heap_size.</fsummary> <type name="max_heap_size"/> <desc> - <marker id="system_flag_max_heap_size"></marker> <p> Sets the default maximum heap size settings for processes. The size is specified in words. The new <c>max_heap_size</c> effects only processes spawned efter the change has been made. <c>max_heap_size</c> can be set for individual processes using <seealso marker="#spawn_opt/4"><c>spawn_opt/2,3,4</c></seealso> or - <seealso marker="#process_flag_message_queue_data"> + <seealso marker="#process_flag_max_heap_size"> <c>process_flag/2</c></seealso>.</p> <p>Returns the old value of the flag.</p> </desc> </func> <func> - <name name="system_flag" arity="2" clause_i="9"/> + <name name="system_flag" arity="2" clause_i="9" + anchor="system_flag_multi_scheduling"/> <fsummary>Set system flag multi_scheduling.</fsummary> <desc> - <p><marker id="system_flag_multi_scheduling"></marker> + <p> If multi-scheduling is enabled, more than one scheduler thread is used by the emulator. Multi-scheduling can be blocked in two different ways. Either all schedulers but @@ -7229,12 +7264,13 @@ ok </func> <func> - <name name="system_flag" arity="2" clause_i="10"/> + <name name="system_flag" arity="2" clause_i="10" + anchor="system_flag_scheduler_bind_type"/> <fsummary>Set system flag scheduler_bind_type.</fsummary> <type name="scheduler_bind_type"/> <desc> <warning> - <p><marker id="system_flag_scheduler_bind_type"></marker> + <p> <em>This argument is deprecated.</em> Instead of using this argument, use command-line argument <seealso marker="erts:erl#+sbt"><c>+sbt</c></seealso> in @@ -7355,10 +7391,11 @@ ok </func> <func> - <name name="system_flag" arity="2" clause_i="11"/> + <name name="system_flag" arity="2" clause_i="11" + anchor="system_flag_scheduler_wall_time"/> <fsummary>Set system flag scheduler_wall_time.</fsummary> <desc> - <p><marker id="system_flag_scheduler_wall_time"></marker> + <p> Turns on or off scheduler wall time measurements.</p> <p>For more information, see <seealso marker="#statistics_scheduler_wall_time"> @@ -7367,10 +7404,11 @@ ok </func> <func> - <name name="system_flag" arity="2" clause_i="12"/> + <name name="system_flag" arity="2" clause_i="12" + anchor="system_flag_schedulers_online"/> <fsummary>Set system flag schedulers_online.</fsummary> <desc> - <p><marker id="system_flag_schedulers_online"></marker> + <p> Sets the number of schedulers online. Range is <c><![CDATA[1 <= SchedulersOnline <= erlang:system_info(schedulers)]]></c>.</p> @@ -7409,10 +7447,11 @@ ok </func> <func> - <name name="system_flag" arity="2" clause_i="14"/> + <name name="system_flag" arity="2" clause_i="14" + anchor="system_flag_time_offset"/> <fsummary>Finalize the time offset.</fsummary> <desc> - <p><marker id="system_flag_time_offset"></marker> + <p> Finalizes the <seealso marker="#time_offset/0">time offset</seealso> when <seealso marker="time_correction#Single_Time_Warp_Mode">single time warp mode</seealso> is used. If another time warp mode @@ -7585,7 +7624,8 @@ ok </func> <func> - <name name="system_info" arity="1" clause_i="12"/> + <name name="system_info" arity="1" clause_i="12" + anchor="system_info_cpu_topology"/> <name name="system_info" arity="1" clause_i="13"/> <fsummary>Information about the CPU topology of the system.</fsummary> <type name="cpu_topology"/> @@ -7613,7 +7653,6 @@ ok </type_desc> <desc> <marker id="system_info_cpu_topology_tags"></marker> - <marker id="system_info_cpu_topology"></marker> <p>Returns various information about the CPU topology of the current system (emulator) as specified by <c><anno>Item</anno></c>:</p> diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index ff3c798179..fca892dda1 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -31,6 +31,72 @@ </header> <p>This document describes the changes made to the ERTS application.</p> +<section><title>Erts 9.1.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Microstate accounting sometimes produced incorrect + results for dirty schedulers.</p> + <p> + Own Id: OTP-14707</p> + </item> + <item> + <p>Fixed a regression in <c>zlib:gunzip/1</c> that + prevented it from working when the decompressed size was + a perfect multiple of 16384. This regression was + introduced in 20.1.1</p> + <p> + Own Id: OTP-14730 Aux Id: ERL-507 </p> + </item> + <item> + <p>Fixed a memory corruption bug in + <c>enif_inspect_iovec</c>; writable binaries stayed + writable after entering the iovec.</p> + <p> + Own Id: OTP-14745</p> + </item> + <item> + <p>Fixed a crash in <c>enif_inspect_iovec</c> on + encountering empty binaries.</p> + <p> + Own Id: OTP-14750</p> + </item> + <item> + <p><c>zlib:deflateParams/3</c> will no longer return + <c>buf_error</c> when called after <c>zlib:deflate/2</c> + with zlib <c>1.2.11</c>.</p> + <p> + Own Id: OTP-14751</p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 9.1.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Added zlib:set_controlling_process/2 to move a + zstream() between processes.</p> + <p> + Own Id: OTP-14672 Aux Id: ERL-494 </p> + </item> + <item> + <p> + Fix so that schedulers are bound correctly when the first + available cpu is not the first detected cpu. e.g. when + using "taskset -c X..Y" when X is not equal to 0.</p> + <p> + Own Id: OTP-14694</p> + </item> + </list> + </section> + +</section> + <section><title>Erts 9.1.2</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -2827,6 +2893,58 @@ </section> +<section><title>Erts 7.3.1.4</title> + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix performance bug in pre-allocators that could cause + them to permanently fall back on normal more expensive + memory allocation. Pre-allocators are used for quick + allocation of short lived meta data used by messages and + other scheduled tasks. Bug exists since OTP_R15B02.</p> + <p> + Own Id: OTP-14491</p> + </item> + <item> + <p> + Fixed bug in operator <c>bxor</c> causing erroneuos + result when one operand is a big <em>negative</em> + integer with the lowest <c>N*W</c> bits as zero and the + other operand not larger than <c>N*W</c> bits. <c>N</c> + is an integer of 1 or larger and <c>W</c> is 32 or 64 + depending on word size.</p> + <p> + Own Id: OTP-14514</p> + </item> + <item> + <p> + A timer internal bit-field used for storing scheduler id + was too small. As a result, VM internal timer data + structures could become inconsistent when using 1024 + schedulers on the system. Note that systems with less + than 1024 schedulers are not effected by this bug.</p> + <p> + This bug was introduced in ERTS version 7.0 (OTP 18.0).</p> + <p> + Own Id: OTP-14548 Aux Id: OTP-11997, ERL-468 </p> + </item> + <item> + <p> + Fixed bug in <c>binary_to_term</c> and + <c>binary_to_atom</c> that could cause VM crash. + Typically happens when the last character of an UTF8 + string is in the range 128 to 255, but truncated to only + one byte. Bug exists in <c>binary_to_term</c> since ERTS + version 5.10.2 (OTP_R16B01) and <c>binary_to_atom</c> + since ERTS version 9.0 (OTP-20.0).</p> + <p> + Own Id: OTP-14590 Aux Id: ERL-474 </p> + </item> + </list> + </section> +</section> + <section><title>Erts 7.3.1.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/erts/doc/src/zlib.xml b/erts/doc/src/zlib.xml index f5cc1b1e64..6f4c42da27 100644 --- a/erts/doc/src/zlib.xml +++ b/erts/doc/src/zlib.xml @@ -71,6 +71,11 @@ list_to_binary([Compressed|Last])</pre> called prior to a call to <seealso marker="#inflate/2"><c>inflate/2</c></seealso>. </item> + <tag><c>not_on_controlling_process</c></tag> + <item>The stream was used by a process that doesn't control it. Use + <seealso marker="#set_controlling_process/2"> + <c>set_controlling_process/2</c></seealso> if you need to transfer + a stream to a different process.</item> <tag><c>data_error</c></tag> <item>The data contains errors. </item> @@ -740,6 +745,15 @@ loop(Z, Handler, {finished, Output}) -> </func> <func> + <name name="set_controlling_process" arity="2"/> + <fsummary>Transfers ownership of a zlib stream.</fsummary> + <desc> + <p>Changes the controlling process of <c><anno>Z</anno></c> to + <c><anno>Pid</anno></c>, which must be a local process.</p> + </desc> + </func> + + <func> <name name="uncompress" arity="1"/> <fsummary>Uncompress data with standard zlib functionality.</fsummary> <desc> diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 3117b24bcc..fdaf253fe5 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -74,9 +74,8 @@ endif endif ifeq ($(PROFILE_COMPILER), gcc) -PROFILE_CORRECTION=@PROFILE_CORRECTION@ PROFILE_GENERATE=-fprofile-generate -PROFILE_USE=-fprofile-use $(PROFILE_CORRECTION) +PROFILE_USE=-fprofile-use -fprofile-correction PROFILE_USE_DEPS=$(OBJDIR)/%_pu.gcda endif ifeq ($(PROFILE_COMPILER), clang) @@ -816,14 +815,7 @@ $(ERL_TOP)/lib/%.beam: INIT_OBJS = $(OBJDIR)/erl_main.o $(PRELOAD_OBJ) -# -fprofile-correction is needed in order to use PGO on erl_process -# as multiple threads execute in that file. -ifeq ($(PROFILE_CORRECTION),) -PROFILE_OBJS = $(OBJDIR)/beam_emu.o -RUN_OBJS = $(OBJDIR)/erl_process.o -else PROFILE_OBJS = $(OBJDIR)/beam_emu.o $(OBJDIR)/erl_process.o -endif EMU_OBJS = \ $(OBJDIR)/beam_opcodes.o \ diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 42a6991c6e..cef633bd93 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -108,6 +108,7 @@ atom asynchronous atom atom atom atom_used atom attributes +atom auto_connect atom await_microstate_accounting_modifications atom await_port_send_result atom await_proc_exit @@ -198,9 +199,7 @@ atom debug_flags atom decimals atom default atom delay_trap -atom dexit atom depth -atom dgroup_leader atom dictionary atom dirty_bif_exception atom dirty_bif_result @@ -221,7 +220,6 @@ atom dist_ctrl_put_data atom dist_data atom Div='/' atom div -atom dlink atom dmonitor_node atom dmonitor_p atom DollarDollar='$$' @@ -230,9 +228,7 @@ atom dollar_endonly atom dotall atom driver atom driver_options -atom dsend atom dsend_continue_trap -atom dunlink atom duplicate_bag atom duplicated atom dupnames diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 00822d1415..87367b44ab 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -768,36 +768,45 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) ErtsCodeIndex code_ix; Module* modp; + if (BIF_ARG_2 != am_false && BIF_ARG_2 != am_true) { + BIF_ERROR(BIF_P, BADARG); + } + if (!erts_try_seize_code_write_permission(BIF_P)) { ERTS_BIF_YIELD2(bif_export[BIF_finish_after_on_load_2], BIF_P, BIF_ARG_1, BIF_ARG_2); } - /* ToDo: Use code_ix staging instead of thread blocking */ - - erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_thr_progress_block(); - code_ix = erts_active_code_ix(); modp = erts_get_module(BIF_ARG_1, code_ix); - if (!modp || !modp->on_load || !modp->on_load->code_hdr) { - error: - erts_thr_progress_unblock(); - erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + if (!modp || !modp->on_load || !modp->on_load->code_hdr + || !modp->on_load->code_hdr->on_load_function_ptr) { + erts_release_code_write_permission(); BIF_ERROR(BIF_P, BADARG); } - if (modp->on_load->code_hdr->on_load_function_ptr == NULL) { - goto error; - } - if (BIF_ARG_2 != am_false && BIF_ARG_2 != am_true) { - goto error; - } if (BIF_ARG_2 == am_true) { + struct m mods[1]; + int is_blocking = 0; int i, num_exps; + erts_start_staging_code_ix(0); + code_ix = erts_staging_code_ix(); + modp = erts_get_module(BIF_ARG_1, code_ix); + + ASSERT(modp && modp->on_load && modp->on_load->code_hdr + && modp->on_load->code_hdr->on_load_function_ptr); + + if (erts_is_default_trace_enabled() + || IF_HIPE(hipe_need_blocking(modp))) { + + erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erts_thr_progress_block(); + is_blocking = 1; + } + /* * Make the code with the on_load function current. */ @@ -831,11 +840,13 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) } } modp->curr.code_hdr->on_load_function_ptr = NULL; - set_default_trace_pattern(BIF_ARG_1); - #ifdef HIPE - hipe_redirect_to_module(modp); - #endif - } else if (BIF_ARG_2 == am_false) { + + mods[0].modp = modp; + mods[0].module = BIF_ARG_1; + mods[0].exception = THE_NON_VALUE; + return staging_epilogue(BIF_P, 1, am_true, is_blocking, mods, 1, 0); + } + else if (BIF_ARG_2 == am_false) { int i, num_exps; /* @@ -855,8 +866,6 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) ep->beam[1] = 0; } } - erts_thr_progress_unblock(); - erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); erts_release_code_write_permission(); BIF_RET(am_true); } diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index fe1e15701b..0832b3f374 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -998,7 +998,9 @@ do_call_trace(Process* c_p, ErtsCodeInfo* info, Eterm* reg, fixup_cp_before_trace(c_p, &return_to_trace); + ERTS_UNREQ_PROC_MAIN_LOCK(c_p); flags = erts_call_trace(c_p, info, ms, reg, local, &tracer); + ERTS_REQ_PROC_MAIN_LOCK(c_p); /* restore cp after potential fixup */ c_p->cp = cp_save; diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index 70078c8c59..509aa2a84f 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -408,7 +408,10 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) addr++; ap = addr; } else { - BeamInstr instr_word = addr++[0]; +#if defined(ARCH_64) && defined(CODE_MODEL_SMALL) + BeamInstr instr_word = addr[0]; +#endif + addr++; /* * Copy all arguments to a local buffer for the unpacking. diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index aa94fbf536..ef9abcde08 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -400,12 +400,13 @@ static BeamInstr* apply_fun(Process* p, Eterm fun, Eterm args, Eterm* reg) NOINLINE; static Eterm new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free) NOINLINE; -static Eterm new_map(Process* p, Eterm* reg, Uint live, Uint n, BeamInstr* ptr) NOINLINE; -static Eterm new_small_map_lit(Process* p, Eterm* reg, Eterm keys_literal, +static Eterm erts_gc_new_map(Process* p, Eterm* reg, Uint live, + Uint n, BeamInstr* ptr) NOINLINE; +static Eterm erts_gc_new_small_map_lit(Process* p, Eterm* reg, Eterm keys_literal, Uint live, BeamInstr* ptr) NOINLINE; -static Eterm update_map_assoc(Process* p, Eterm* reg, Uint live, +static Eterm erts_gc_update_map_assoc(Process* p, Eterm* reg, Uint live, Uint n, BeamInstr* new_p) NOINLINE; -static Eterm update_map_exact(Process* p, Eterm* reg, Uint live, +static Eterm erts_gc_update_map_exact(Process* p, Eterm* reg, Uint live, Uint n, Eterm* new_p) NOINLINE; static Eterm get_map_element(Eterm map, Eterm key); static Eterm get_map_element_hash(Eterm map, Eterm key, Uint32 hx); @@ -1453,6 +1454,7 @@ handle_error(Process* c_p, BeamInstr* pc, Eterm* reg, ErtsCodeMFA *bif_mfa) reg[3] = c_p->ftrace; if ((new_pc = next_catch(c_p, reg))) { c_p->cp = 0; /* To avoid keeping stale references. */ + c_p->msg.saved_last = 0; /* No longer safe to use this position */ return new_pc; } if (c_p->catches > 0) erts_exit(ERTS_ERROR_EXIT, "Catch not found"); @@ -2755,7 +2757,7 @@ do { \ static Eterm -new_map(Process* p, Eterm* reg, Uint live, Uint n, BeamInstr* ptr) +erts_gc_new_map(Process* p, Eterm* reg, Uint live, Uint n, BeamInstr* ptr) { Uint i; Uint need = n + 1 /* hdr */ + 1 /*size*/ + 1 /* ptr */ + 1 /* arity */; @@ -2812,7 +2814,8 @@ new_map(Process* p, Eterm* reg, Uint live, Uint n, BeamInstr* ptr) } static Eterm -new_small_map_lit(Process* p, Eterm* reg, Eterm keys_literal, Uint live, BeamInstr* ptr) +erts_gc_new_small_map_lit(Process* p, Eterm* reg, Eterm keys_literal, + Uint live, BeamInstr* ptr) { Eterm* keys = tuple_val(keys_literal); Uint n = arityval(*keys); @@ -2846,7 +2849,8 @@ new_small_map_lit(Process* p, Eterm* reg, Eterm keys_literal, Uint live, BeamIns } static Eterm -update_map_assoc(Process* p, Eterm* reg, Uint live, Uint n, BeamInstr* new_p) +erts_gc_update_map_assoc(Process* p, Eterm* reg, Uint live, + Uint n, BeamInstr* new_p) { Uint num_old; Uint num_updates; @@ -2892,7 +2896,7 @@ update_map_assoc(Process* p, Eterm* reg, Uint live, Uint n, BeamInstr* new_p) */ if (num_old == 0) { - return new_map(p, reg, live, n, new_p); + return erts_gc_new_map(p, reg, live, n, new_p); } /* @@ -3048,7 +3052,7 @@ update_map_assoc(Process* p, Eterm* reg, Uint live, Uint n, BeamInstr* new_p) */ static Eterm -update_map_exact(Process* p, Eterm* reg, Uint live, Uint n, Eterm* new_p) +erts_gc_update_map_exact(Process* p, Eterm* reg, Uint live, Uint n, Eterm* new_p) { Uint i; Uint num_old; @@ -3199,13 +3203,16 @@ erts_is_builtin(Eterm Mod, Eterm Name, int arity) Export e; Export* ep; - if (Mod == am_erlang && Name == am_apply && arity == 3) { - /* - * Special case. apply/3 is built-in (implemented in C), - * but implemented in a different way than all other - * BIFs. - */ - return 1; + if (Mod == am_erlang) { + /* + * Special case for built-in functions that are implemented + * as instructions as opposed to SNIFs. + */ + if (Name == am_apply && (arity == 2 || arity == 3)) { + return 1; + } else if (Name == am_yield && arity == 0) { + return 1; + } } e.info.mfa.module = Mod; diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 00dd28b26c..4fcfea527c 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -806,11 +806,6 @@ erts_finish_loading(Binary* magic, Process* c_p, struct erl_module_instance* inst_p; Uint size; - /* - * No other process may run since we will update the export - * table which is not protected by any locks. - */ - ERTS_LC_ASSERT(erts_initialized == 0 || erts_has_code_write_permission() || erts_thr_progress_is_blocking()); /* @@ -2389,8 +2384,18 @@ load_code(LoaderState* stp) code[ci++] = NIL; break; case TAG_q: - new_literal_patch(stp, ci); - code[ci++] = tmp_op->a[arg].val; + { + BeamInstr val = tmp_op->a[arg].val; + Eterm term = stp->literals[val].term; + new_literal_patch(stp, ci); + code[ci++] = val; + switch (loader_tag(term)) { + case LOADER_X_REG: + case LOADER_Y_REG: + LoadError1(stp, "the term '%T' would be confused " + "with a register", term); + } + } break; default: LoadError1(stp, "bad tag %d for general source", @@ -5027,7 +5032,7 @@ freeze_code(LoaderState* stp) */ codev[pos] = (BeamInstr) (codev + value); } else { -#ifdef DEBUG +#if defined(DEBUG) && defined(BEAM_WIDE_MASK) Uint w; #endif Sint32 rel = lp->offset + value; diff --git a/erts/emulator/beam/beam_ranges.c b/erts/emulator/beam/beam_ranges.c index 6e373a3480..01bda7f3c1 100644 --- a/erts/emulator/beam/beam_ranges.c +++ b/erts/emulator/beam/beam_ranges.c @@ -32,6 +32,15 @@ typedef struct { erts_atomic_t end; /* (BeamInstr*) Points one word beyond last function in module. */ } Range; +/* + * Used for crash dumping of literals. The size of erts_dump_lit_areas is + * always twice the number of active ranges (to allow for literals in both + * current and old code). + */ + +ErtsLiteralArea** erts_dump_lit_areas; +Uint erts_dump_num_lit_areas; + /* Range 'end' needs to be atomic as we purge module by setting end=start in active code_ix */ #define RANGE_END(R) ((BeamInstr*)erts_atomic_read_nob(&(R)->end)) @@ -97,6 +106,11 @@ erts_init_ranges(void) r[i].allocated = 0; erts_atomic_init_nob(&r[i].mid, 0); } + + erts_dump_num_lit_areas = 8; + erts_dump_lit_areas = (ErtsLiteralArea **) + erts_alloc(ERTS_ALC_T_CRASH_DUMP, + erts_dump_num_lit_areas * sizeof(ErtsLiteralArea*)); } void @@ -164,6 +178,14 @@ erts_end_staging_ranges(int commit) erts_atomic_set_nob(&r[dst].mid, (erts_aint_t) (r[dst].modules + r[dst].n / 2)); + + if (r[dst].allocated * 2 > erts_dump_num_lit_areas) { + erts_dump_num_lit_areas *= 2; + erts_dump_lit_areas = (ErtsLiteralArea **) + erts_realloc(ERTS_ALC_T_CRASH_DUMP, + (void *) erts_dump_lit_areas, + erts_dump_num_lit_areas * sizeof(ErtsLiteralArea*)); + } } } diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index ad555bb195..50699eac31 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -227,17 +227,40 @@ BIF_RETTYPE link_1(BIF_ALIST_1) goto res_no_proc; } - code = erts_dsig_prepare(&dsd, dep, BIF_P, ERTS_DSP_RLOCK, 0); + code = erts_dsig_prepare(&dsd, dep, BIF_P, + (ERTS_PROC_LOCK_MAIN | ERTS_PROC_LOCK_LINK), + ERTS_DSP_RLOCK, 0, 1); switch (code) { case ERTS_DSIG_PREP_NOT_ALIVE: - /* Let the dlink trap handle it */ - case ERTS_DSIG_PREP_NOT_CONNECTED: - erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK); - BIF_TRAP1(dlink_trap, BIF_P, BIF_ARG_1); - + case ERTS_DSIG_PREP_NOT_CONNECTED: { + ErtsProcLocks locks = ERTS_PROC_LOCK_MAIN | ERTS_PROC_LOCK_LINK; + erts_aint32_t state; + erts_proc_lock(BIF_P, (ERTS_PROC_LOCKS_ALL & ~locks)); + locks = ERTS_PROC_LOCKS_ALL; + erts_send_exit_signal(BIF_P, BIF_ARG_1, BIF_P, &locks, + am_noconnection, NIL, NULL, 0); + erts_proc_unlock(BIF_P, locks & ERTS_PROC_LOCKS_ALL_MINOR); + + /* + * Copy-paste from old dist_exit_3, not sure if we really + * need erts_handle_pending_exit when exit_2 does not. + */ + state = erts_atomic32_read_acqb(&BIF_P->state); + if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT)) { +#ifdef ERTS_SMP + if (state & ERTS_PSFLG_PENDING_EXIT) + erts_handle_pending_exit(BIF_P, ERTS_PROC_LOCK_MAIN); +#endif + ERTS_BIF_EXITED(BIF_P); + } + BIF_RET(am_true); + } + case ERTS_DSIG_PREP_PENDING: case ERTS_DSIG_PREP_CONNECTED: - /* We are connected. Setup link and send link signal */ - + /* + * We have (pending) connection. + * Setup link and enqueue link signal. + */ erts_de_links_lock(dep); erts_add_link(&ERTS_P_LINKS(BIF_P), LINK_PID, BIF_ARG_1); @@ -256,8 +279,7 @@ BIF_RETTYPE link_1(BIF_ALIST_1) ERTS_BIF_YIELD_RETURN(BIF_P, am_true); BIF_RET(am_true); default: - ASSERT(! "Invalid dsig prepare result"); - BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); + ERTS_ASSERT(! "Invalid dsig prepare result"); } } } @@ -292,7 +314,8 @@ remote_demonitor(Process *c_p, DistEntry *dep, Eterm ref, Eterm to) ERTS_LC_ASSERT((ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK) == erts_proc_lc_my_proc_locks(c_p)); - code = erts_dsig_prepare(&dsd, dep, c_p, ERTS_DSP_RLOCK, 0); + code = erts_dsig_prepare(&dsd, dep, c_p, ERTS_PROC_LOCK_MAIN, + ERTS_DSP_RLOCK, 0, 0); switch (code) { case ERTS_DSIG_PREP_NOT_ALIVE: case ERTS_DSIG_PREP_NOT_CONNECTED: @@ -313,6 +336,7 @@ remote_demonitor(Process *c_p, DistEntry *dep, Eterm ref, Eterm to) res = am_true; break; + case ERTS_DSIG_PREP_PENDING: case ERTS_DSIG_PREP_CONNECTED: erts_de_links_lock(dep); @@ -347,8 +371,7 @@ remote_demonitor(Process *c_p, DistEntry *dep, Eterm ref, Eterm to) } break; default: - ASSERT(! "Invalid dsig prepare result"); - return am_internal_error; + ERTS_ASSERT(! "Invalid dsig prepare result"); } @@ -767,23 +790,20 @@ remote_monitor(Process *p, Eterm bifarg1, Eterm bifarg2, BIF_RETTYPE ret; int code; + ASSERT(dep); erts_proc_lock(p, ERTS_PROC_LOCK_LINK); - code = erts_dsig_prepare(&dsd, dep, p, ERTS_DSP_RLOCK, 0); + code = erts_dsig_prepare(&dsd, dep, + p, (ERTS_PROC_LOCK_MAIN | ERTS_PROC_LOCK_LINK), + ERTS_DSP_RLOCK, 0, 1); switch (code) { case ERTS_DSIG_PREP_NOT_ALIVE: - /* Let the dmonitor_p trap handle it */ case ERTS_DSIG_PREP_NOT_CONNECTED: erts_proc_unlock(p, ERTS_PROC_LOCK_LINK); ERTS_BIF_PREP_TRAP2(ret, dmonitor_p_trap, p, bifarg1, bifarg2); break; + case ERTS_DSIG_PREP_PENDING: case ERTS_DSIG_PREP_CONNECTED: - if (!(dep->flags & DFLAG_DIST_MONITOR) - || (byname && !(dep->flags & DFLAG_DIST_MONITOR_NAME))) { - erts_de_runlock(dep); - erts_proc_unlock(p, ERTS_PROC_LOCK_LINK); - ERTS_BIF_PREP_ERROR(ret, p, BADARG); - } - else { + { Eterm p_trgt, p_name, d_name, mon_ref; mon_ref = erts_make_ref(p); @@ -818,9 +838,7 @@ remote_monitor(Process *p, Eterm bifarg1, Eterm bifarg2, } break; default: - ASSERT(! "Invalid dsig prepare result"); - ERTS_BIF_PREP_ERROR(ret, p, EXC_INTERNAL_ERROR); - break; + ERTS_ASSERT(! "Invalid dsig prepare result"); } BIF_RET(ret); @@ -888,17 +906,17 @@ local_port: if (!erts_is_alive && remote_node != am_Noname) { goto badarg; /* Remote monitor from (this) undistributed node */ } - dep = erts_sysname_to_connected_dist_entry(remote_node); + dep = erts_find_or_insert_dist_entry(remote_node); if (dep == erts_this_dist_entry) { ret = local_name_monitor(BIF_P, BIF_ARG_1, name); } else { ret = remote_monitor(BIF_P, BIF_ARG_1, BIF_ARG_2, dep, name, 1); } + erts_deref_dist_entry(dep); } else { badarg: ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); } - return ret; } @@ -1158,21 +1176,14 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1) BIF_RET(am_true); } - code = erts_dsig_prepare(&dsd, dep, BIF_P, ERTS_DSP_NO_LOCK, 0); + code = erts_dsig_prepare(&dsd, dep, BIF_P, ERTS_PROC_LOCK_MAIN, + ERTS_DSP_NO_LOCK, 0, 0); switch (code) { case ERTS_DSIG_PREP_NOT_ALIVE: case ERTS_DSIG_PREP_NOT_CONNECTED: -#if 1 BIF_RET(am_true); -#else - /* - * This is how we used to do it, but the link is obviously not - * active, so I see no point in setting up a connection. - * /Rickard - */ - BIF_TRAP1(dunlink_trap, BIF_P, BIF_ARG_1); -#endif + case ERTS_DSIG_PREP_PENDING: case ERTS_DSIG_PREP_CONNECTED: erts_remove_dist_link(&dld, BIF_P->common.id, BIF_ARG_1, dep); code = erts_dsig_send_unlink(&dsd, BIF_P->common.id, BIF_ARG_1); @@ -1545,22 +1556,24 @@ BIF_RETTYPE exit_2(BIF_ALIST_2) DistEntry *dep; dep = external_pid_dist_entry(BIF_ARG_1); + ERTS_ASSERT(dep); if(dep == erts_this_dist_entry) BIF_RET(am_true); - code = erts_dsig_prepare(&dsd, dep, BIF_P, ERTS_DSP_NO_LOCK, 0); + code = erts_dsig_prepare(&dsd, dep, BIF_P, ERTS_PROC_LOCK_MAIN, + ERTS_DSP_NO_LOCK, 0, 1); switch (code) { case ERTS_DSIG_PREP_NOT_ALIVE: case ERTS_DSIG_PREP_NOT_CONNECTED: - BIF_TRAP2(dexit_trap, BIF_P, BIF_ARG_1, BIF_ARG_2); + BIF_RET(am_true); + case ERTS_DSIG_PREP_PENDING: case ERTS_DSIG_PREP_CONNECTED: code = erts_dsig_send_exit2(&dsd, BIF_P->common.id, BIF_ARG_1, BIF_ARG_2); if (code == ERTS_DSIG_SEND_YIELD) ERTS_BIF_YIELD_RETURN(BIF_P, am_true); BIF_RET(am_true); default: - ASSERT(! "Invalid dsig prepare result"); - BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); + ERTS_ASSERT(! "Invalid dsig prepare result"); } } else if (is_not_internal_pid(BIF_ARG_1)) { @@ -1964,7 +1977,7 @@ ebif_bang_2(BIF_ALIST_2) * Send a message to Process, Port or Registered Process. * Returns non-negative reduction bump or negative result code. */ -#define SEND_TRAP (-1) +#define SEND_NOCONNECT (-1) #define SEND_YIELD (-2) #define SEND_YIELD_RETURN (-3) #define SEND_BADARG (-4) @@ -1980,20 +1993,22 @@ static Sint remote_send(Process *p, DistEntry *dep, { Sint res; int code; - ASSERT(is_atom(to) || is_external_pid(to)); ctx->dep = dep; - code = erts_dsig_prepare(&ctx->dsd, dep, p, ERTS_DSP_NO_LOCK, !ctx->suspend); + code = erts_dsig_prepare(&ctx->dsd, dep, p, ERTS_PROC_LOCK_MAIN, + ERTS_DSP_NO_LOCK, + !ctx->suspend, ctx->connect); switch (code) { case ERTS_DSIG_PREP_NOT_ALIVE: case ERTS_DSIG_PREP_NOT_CONNECTED: - res = SEND_TRAP; + res = SEND_NOCONNECT; break; case ERTS_DSIG_PREP_WOULD_SUSPEND: ASSERT(!ctx->suspend); res = SEND_YIELD; break; + case ERTS_DSIG_PREP_PENDING: case ERTS_DSIG_PREP_CONNECTED: { if (is_atom(to)) @@ -2170,6 +2185,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx) } return ret_val; } else if (is_tuple(to)) { /* Remote send */ + int deref_dep = 0; int ret; tp = tuple_val(to); if (*tp != make_arityval(2)) @@ -2177,11 +2193,10 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx) if (is_not_atom(tp[1]) || is_not_atom(tp[2])) return SEND_BADARG; - /* sysname_to_connected_dist_entry will return NULL if there - is no dist_entry or the dist_entry has no port, + /* erts_find_dist_entry will return NULL if there is no dist_entry but remote_send() will handle that. */ - dep = erts_sysname_to_connected_dist_entry(tp[2]); + dep = erts_find_dist_entry(tp[2]); if (dep == erts_this_dist_entry) { Eterm id; @@ -2205,13 +2220,20 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx) } return 0; } + if (dep == NULL) { + dep = erts_find_or_insert_dist_entry(tp[2]); + ASSERT(dep != erts_this_dist_entry); + deref_dep = 1; + } + ctx->dsd.node = tp[2]; ret = remote_send(p, dep, tp[1], to, msg, ctx); if (ret == SEND_YIELD_CONTINUE) { - if (dep) - erts_ref_dist_entry(dep); - ctx->dep_to_deref = dep; + erts_ref_dist_entry(ctx->dep); + ctx->deref_dep = 1; } + if (deref_dep) + erts_deref_dist_entry(dep); return ret; } else { if (IS_TRACED_FL(p, F_TRACE_SEND)) @@ -2251,7 +2273,6 @@ BIF_RETTYPE send_3(BIF_ALIST_3) Eterm msg = BIF_ARG_2; Eterm opts = BIF_ARG_3; - int connect = !0; Eterm l = opts; Sint result; @@ -2262,14 +2283,15 @@ BIF_RETTYPE send_3(BIF_ALIST_3) UseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), BIF_P); ctx->suspend = !0; - ctx->dep_to_deref = NULL; + ctx->connect = !0; + ctx->deref_dep = 0; ctx->return_term = am_ok; ctx->dss.reds = (Sint) (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_LOOP_FACTOR); ctx->dss.phase = ERTS_DSIG_SEND_PHASE_INIT; while (is_list(l)) { if (CAR(list_val(l)) == am_noconnect) { - connect = 0; + ctx->connect = 0; } else if (CAR(list_val(l)) == am_nosuspend) { ctx->suspend = 0; } else { @@ -2306,9 +2328,9 @@ BIF_RETTYPE send_3(BIF_ALIST_3) goto yield_return; ERTS_BIF_PREP_RET(retval, am_ok); break; - case SEND_TRAP: - if (connect) { - ERTS_BIF_PREP_TRAP3(retval, dsend3_trap, p, to, msg, opts); + case SEND_NOCONNECT: + if (ctx->connect) { + ERTS_BIF_PREP_RET(retval, am_ok); } else { ERTS_BIF_PREP_RET(retval, am_noconnect); } @@ -2412,7 +2434,8 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) ref = NIL; #endif ctx->suspend = !0; - ctx->dep_to_deref = NULL; + ctx->connect = !0; + ctx->deref_dep = 0; ctx->return_term = msg; ctx->dss.reds = (Sint) (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_LOOP_FACTOR); ctx->dss.phase = ERTS_DSIG_SEND_PHASE_INIT; @@ -2436,8 +2459,8 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) goto yield_return; ERTS_BIF_PREP_RET(retval, msg); break; - case SEND_TRAP: - ERTS_BIF_PREP_TRAP2(retval, dsend2_trap, p, to, msg); + case SEND_NOCONNECT: + ERTS_BIF_PREP_RET(retval, msg); break; case SEND_YIELD: ERTS_BIF_PREP_YIELD2(retval, bif_export[BIF_send_2], p, to, msg); @@ -4200,7 +4223,7 @@ BIF_RETTYPE list_to_port_1(BIF_ALIST_1) cp += 6; /* strlen("#Port<") */ - if (sscanf(cp, "%u.%u>", &n, &p) < 2) + if (sscanf(cp, "%u.%u>", (unsigned int*)&n, (unsigned int*)&p) < 2) goto bad; if (p > ERTS_MAX_PORT_NUMBER) @@ -4384,23 +4407,24 @@ BIF_RETTYPE group_leader_2(BIF_ALIST_2) int code; ErtsDSigData dsd; dep = external_pid_dist_entry(BIF_ARG_2); + ERTS_ASSERT(dep); if(dep == erts_this_dist_entry) BIF_ERROR(BIF_P, BADARG); - code = erts_dsig_prepare(&dsd, dep, BIF_P, ERTS_DSP_NO_LOCK, 0); + code = erts_dsig_prepare(&dsd, dep, BIF_P, ERTS_PROC_LOCK_MAIN, + ERTS_DSP_NO_LOCK, 0, 1); switch (code) { case ERTS_DSIG_PREP_NOT_ALIVE: - BIF_RET(am_true); case ERTS_DSIG_PREP_NOT_CONNECTED: - BIF_TRAP2(dgroup_leader_trap, BIF_P, BIF_ARG_1, BIF_ARG_2); + BIF_RET(am_true); + case ERTS_DSIG_PREP_PENDING: case ERTS_DSIG_PREP_CONNECTED: code = erts_dsig_send_group_leader(&dsd, BIF_ARG_1, BIF_ARG_2); if (code == ERTS_DSIG_SEND_YIELD) ERTS_BIF_YIELD_RETURN(BIF_P, am_true); BIF_RET(am_true); default: - ASSERT(! "Invalid dsig prepare result"); - BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); + ERTS_ASSERT(! "Invalid dsig prepare result"); } } else if (is_internal_pid(BIF_ARG_2)) { diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 5d5ea3cdc4..1bd4acbf95 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -153,14 +153,12 @@ bif erlang:whereis/1 bif erlang:spawn_opt/1 bif erlang:setnode/2 bif erlang:setnode/3 -bif erlang:dist_exit/3 bif erlang:dist_get_stat/1 bif erlang:dist_ctrl_input_handler/2 bif erlang:dist_ctrl_put_data/2 bif erlang:dist_ctrl_get_data/1 bif erlang:dist_ctrl_get_data_notification/1 - # Static native functions in erts_internal bif erts_internal:port_info/1 bif erts_internal:port_info/2 @@ -693,4 +691,6 @@ bif erlang:iolist_to_iovec/1 # New in 21.0 # +bif erts_internal:new_connection/1 +bif erts_internal:abort_connection/2 bif erts_internal:map_next/3 diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 35b2365655..d9ee940662 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -58,6 +58,8 @@ static void dump_attributes(fmtfn_t to, void *to_arg, byte* ptr, int size); extern char* erts_system_version[]; +#define WRITE_BUFFER_SIZE (64*1024) + static void port_info(fmtfn_t to, void *to_arg) { @@ -673,18 +675,28 @@ bin_check(void) static Sint64 crash_dump_limit = ERTS_SINT64_MAX; static Sint64 crash_dump_written = 0; -static int crash_dump_limited_writer(void* vfdp, char* buf, size_t len) +typedef struct LimitedWriterInfo_ { + fmtfn_t to; + void* to_arg; +} LimitedWriterInfo; + +static int +crash_dump_limited_writer(void* vfdp, char* buf, size_t len) { const char stop_msg[] = "\n=abort:CRASH DUMP SIZE LIMIT REACHED\n"; + LimitedWriterInfo* lwi = (LimitedWriterInfo *) vfdp; crash_dump_written += len; if (crash_dump_written <= crash_dump_limit) { - return erts_write_fd(vfdp, buf, len); + return lwi->to(lwi->to_arg, buf, len); } len -= (crash_dump_written - crash_dump_limit); - erts_write_fd(vfdp, buf, len); - erts_write_fd(vfdp, (char*)stop_msg, sizeof(stop_msg)-1); + lwi->to(lwi->to_arg, buf, len); + lwi->to(lwi->to_arg, (char*)stop_msg, sizeof(stop_msg)-1); + if (lwi->to == &erts_write_fp) { + fclose((FILE *) lwi->to_arg); + } /* We assume that crash dump was called from erts_exit_vv() */ erts_exit_epilogue(); @@ -707,6 +719,9 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) int i; fmtfn_t to = &erts_write_fd; void* to_arg; + FILE* fp = 0; + LimitedWriterInfo lwi; + static char* write_buffer; /* 'static' to avoid a leak warning in valgrind */ if (ERTS_SOMEONE_IS_CRASH_DUMPING) return; @@ -810,9 +825,30 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) fd = open(dumpname,O_WRONLY | O_CREAT | O_TRUNC,0640); if (fd < 0) return; /* Can't create the crash dump, skip it */ - to_arg = (void*)&fd; + + /* + * Wrap into a FILE* so that we can use buffered output. Set an + * explicit buffer to make sure the first write does not fail because + * of a failure to allocate a buffer. + */ + write_buffer = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP, WRITE_BUFFER_SIZE); + if (write_buffer && (fp = fdopen(fd, "w")) != NULL) { + setvbuf(fp, write_buffer, _IOFBF, WRITE_BUFFER_SIZE); + lwi.to = &erts_write_fp; + lwi.to_arg = (void*)fp; + } else { + lwi.to = &erts_write_fd; + lwi.to_arg = (void*)&fd; + } + if (to == &crash_dump_limited_writer) { + to_arg = (void *) &lwi; + } else { + to = lwi.to; + to_arg = lwi.to_arg; + } + time(&now); - erts_cbprintf(to, to_arg, "=erl_crash_dump:0.3\n%s", ctime(&now)); + erts_cbprintf(to, to_arg, "=erl_crash_dump:0.4\n%s", ctime(&now)); if (file != NULL) erts_cbprintf(to, to_arg, "The error occurred in file %s, line %d\n", file, line); @@ -916,6 +952,9 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) } erts_cbprintf(to, to_arg, "=end\n"); + if (fp) { + fclose(fp); + } close(fd); erts_fprintf(stderr,"done\n"); } diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index bc168fc58d..8593ad867a 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -103,21 +103,12 @@ dist_msg_dbg(ErtsDistExternal *edep, char *what, byte *buf, int sz) -#define PASS_THROUGH 'p' /* This code should go */ - int erts_is_alive; /* System must be blocked on change */ int erts_dist_buf_busy_limit; /* distribution trap functions */ -Export* dsend2_trap = NULL; -Export* dsend3_trap = NULL; -/*Export* dsend_nosuspend_trap = NULL;*/ -Export* dlink_trap = NULL; -Export* dunlink_trap = NULL; Export* dmonitor_node_trap = NULL; -Export* dgroup_leader_trap = NULL; -Export* dexit_trap = NULL; Export* dmonitor_p_trap = NULL; /* local variables */ @@ -129,6 +120,7 @@ static void clear_dist_entry(DistEntry*); static int dsig_send_ctl(ErtsDSigData* dsdp, Eterm ctl, int force_busy); static void send_nodes_mon_msgs(Process *, Eterm, Eterm, Eterm, Eterm); static void init_nodes_monitors(void); +static Sint abort_connection(DistEntry* dep, Uint32 conn_id); static erts_atomic_t no_caches; static erts_atomic_t no_nodes; @@ -383,22 +375,24 @@ static void doit_node_link_net_exits(ErtsLink *lnk, void *vnecp) if (!rp) goto done; erts_proc_lock(rp, rp_locks); - rlnk = erts_remove_link(&ERTS_P_LINKS(rp), name); - if (rlnk != NULL) { - ASSERT(is_atom(rlnk->pid) && (rlnk->type == LINK_NODE)); - erts_destroy_link(rlnk); - } - n = ERTS_LINK_REFC(lnk); - for (i = 0; i < n; ++i) { - Eterm tup; - Eterm *hp; - ErtsMessage *msgp; - - msgp = erts_alloc_message_heap(rp, &rp_locks, - 3, &hp, &ohp); - tup = TUPLE2(hp, am_nodedown, name); - erts_queue_message(rp, rp_locks, msgp, tup, am_system); - } + if (!ERTS_PROC_IS_EXITING(rp)) { + rlnk = erts_remove_link(&ERTS_P_LINKS(rp), name); + if (rlnk != NULL) { + ASSERT(is_atom(rlnk->pid) && (rlnk->type == LINK_NODE)); + erts_destroy_link(rlnk); + } + n = ERTS_LINK_REFC(lnk); + for (i = 0; i < n; ++i) { + Eterm tup; + Eterm *hp; + ErtsMessage *msgp; + + msgp = erts_alloc_message_heap(rp, &rp_locks, + 3, &hp, &ohp); + tup = TUPLE2(hp, am_nodedown, name); + erts_queue_message(rp, rp_locks, msgp, tup, am_system); + } + } erts_proc_unlock(rp, rp_locks); } done: @@ -484,41 +478,55 @@ int erts_do_net_exits(DistEntry *dep, Eterm reason) if (dep == erts_this_dist_entry) { /* Net kernel has died (clean up!!) */ DistEntry *tdep; - int no_dist_ctrl = 0; + int no_dist_ctrl; + int no_pending; Eterm nd_reason = (reason == am_no_network ? am_no_network : am_net_kernel_terminated); + int i = 0; + Eterm *dist_ctrl; + DistEntry** pending; + + ERTS_UNDEF(dist_ctrl, NULL); + ERTS_UNDEF(pending, NULL); + erts_rwmtx_rlock(&erts_dist_table_rwmtx); - for (tdep = erts_hidden_dist_entries; tdep; tdep = tdep->next) - no_dist_ctrl++; - for (tdep = erts_visible_dist_entries; tdep; tdep = tdep->next) - no_dist_ctrl++; + no_dist_ctrl = (erts_no_of_hidden_dist_entries + + erts_no_of_visible_dist_entries); + no_pending = erts_no_of_pending_dist_entries; /* KILL all port controllers */ - if (no_dist_ctrl == 0) - erts_rwmtx_runlock(&erts_dist_table_rwmtx); - else { - Eterm def_buf[128]; - int i = 0; - Eterm *dist_ctrl; - - if (no_dist_ctrl <= sizeof(def_buf)/sizeof(def_buf[0])) - dist_ctrl = &def_buf[0]; - else - dist_ctrl = erts_alloc(ERTS_ALC_T_TMP, - sizeof(Eterm)*no_dist_ctrl); + if (no_dist_ctrl) { + dist_ctrl = erts_alloc(ERTS_ALC_T_TMP, + sizeof(Eterm)*no_dist_ctrl); for (tdep = erts_hidden_dist_entries; tdep; tdep = tdep->next) { ASSERT(is_internal_port(tdep->cid) || is_internal_pid(tdep->cid)); + ASSERT(i < no_dist_ctrl); dist_ctrl[i++] = tdep->cid; } for (tdep = erts_visible_dist_entries; tdep; tdep = tdep->next) { ASSERT(is_internal_port(tdep->cid) || is_internal_pid(tdep->cid)); + ASSERT(i < no_dist_ctrl); dist_ctrl[i++] = tdep->cid; } - erts_rwmtx_runlock(&erts_dist_table_rwmtx); + ASSERT(i == no_dist_ctrl); + } + if (no_pending) { + pending = erts_alloc(ERTS_ALC_T_TMP, sizeof(DistEntry*)*no_pending); + i = 0; + for (tdep = erts_pending_dist_entries; tdep; tdep = tdep->next) { + ASSERT(is_nil(tdep->cid)); + ASSERT(i < no_pending); + pending[i++] = tdep; + erts_ref_dist_entry(tdep); + } + ASSERT(i == no_pending); + } + erts_rwmtx_runlock(&erts_dist_table_rwmtx); - for (i = 0; i < no_dist_ctrl; i++) { + if (no_dist_ctrl) { + for (i = 0; i < no_dist_ctrl; i++) { if (is_internal_pid(dist_ctrl[i])) schedule_kill_dist_ctrl_proc(dist_ctrl[i]); else { @@ -532,11 +540,18 @@ int erts_do_net_exits(DistEntry *dep, Eterm reason) prt, dist_ctrl[i], nd_reason, NULL); } } - } + } + erts_free(ERTS_ALC_T_TMP, dist_ctrl); + } + + if (no_pending) { + for (i = 0; i < no_pending; i++) { + abort_connection(pending[i], pending[i]->connection_id); + erts_deref_dist_entry(pending[i]); + } + erts_free(ERTS_ALC_T_TMP, pending); + } - if (dist_ctrl != &def_buf[0]) - erts_free(ERTS_ALC_T_TMP, dist_ctrl); - } /* * When last dist ctrl exits, node will be taken @@ -613,7 +628,6 @@ int erts_do_net_exits(DistEntry *dep, Eterm reason) reason == am_normal ? am_connection_closed : reason); clear_dist_entry(dep); - } dec_no_nodes(); @@ -638,14 +652,7 @@ void init_dist(void) erts_atomic_init_nob(&no_caches, 0); /* Lookup/Install all references to trap functions */ - dsend2_trap = trap_function(am_dsend,2); - dsend3_trap = trap_function(am_dsend,3); - /* dsend_nosuspend_trap = trap_function(am_dsend_nosuspend,2);*/ - dlink_trap = trap_function(am_dlink,1); - dunlink_trap = trap_function(am_dunlink,1); dmonitor_node_trap = trap_function(am_dmonitor_node,3); - dgroup_leader_trap = trap_function(am_dgroup_leader,2); - dexit_trap = trap_function(am_dexit, 2); dmonitor_p_trap = trap_function(am_dmonitor_p, 2); dist_ctrl_put_data_trap = erts_export_put(am_erts_internal, am_dist_ctrl_put_data, @@ -664,6 +671,7 @@ alloc_dist_obuf(Uint size) obuf = (ErtsDistOutputBuf *) &bin->orig_bytes[0]; #ifdef DEBUG obuf->dbg_pattern = ERTS_DIST_OUTPUT_BUF_DBG_PATTERN; + obuf->alloc_endp = obuf->data + size; ASSERT(bin == ErtsDistOutputBuf2Binary(obuf)); #endif return obuf; @@ -684,31 +692,11 @@ size_obuf(ErtsDistOutputBuf *obuf) return bin->orig_size; } -static void clear_dist_entry(DistEntry *dep) +static ErtsDistOutputBuf* clear_de_out_queues(DistEntry* dep) { - Sint obufsize = 0; - ErtsAtomCache *cache; - ErtsProcList *suspendees; ErtsDistOutputBuf *obuf; - erts_de_rwlock(dep); - erts_atomic_set_nob(&dep->input_handler, - (erts_aint_t) NIL); - cache = dep->cache; - dep->cache = NULL; - -#ifdef DEBUG - erts_de_links_lock(dep); - ASSERT(!dep->nlinks); - ASSERT(!dep->node_links); - ASSERT(!dep->monitors); - erts_de_links_unlock(dep); -#endif - - erts_mtx_lock(&dep->qlock); - - erts_atomic64_set_nob(&dep->in, 0); - erts_atomic64_set_nob(&dep->out, 0); + ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&dep->qlock)); if (!dep->out_queue.last) obuf = dep->finalized_out_queue.first; @@ -728,17 +716,13 @@ static void clear_dist_entry(DistEntry *dep) dep->tmp_out_queue.last = NULL; dep->finalized_out_queue.first = NULL; dep->finalized_out_queue.last = NULL; - dep->status = 0; - suspendees = get_suspended_on_de(dep, ERTS_DE_QFLGS_ALL); - erts_mtx_unlock(&dep->qlock); - erts_atomic_set_nob(&dep->dist_cmd_scheduled, 0); - dep->send = NULL; - erts_de_rwunlock(dep); - - erts_resume_processes(suspendees); + return obuf; +} - delete_cache(cache); +static void free_de_out_queues(DistEntry* dep, ErtsDistOutputBuf *obuf) +{ + Sint obufsize = 0; while (obuf) { ErtsDistOutputBuf *fobuf; @@ -750,13 +734,56 @@ static void clear_dist_entry(DistEntry *dep) if (obufsize) { erts_mtx_lock(&dep->qlock); - ASSERT(erts_atomic_read_nob(&dep->qsize) >= obufsize); + ASSERT(erts_atomic_read_nob(&dep->qsize) >= obufsize); erts_atomic_add_nob(&dep->qsize, (erts_aint_t) -obufsize); erts_mtx_unlock(&dep->qlock); } } +static void clear_dist_entry(DistEntry *dep) +{ + ErtsAtomCache *cache; + ErtsProcList *suspendees; + ErtsDistOutputBuf *obuf; + + erts_de_rwlock(dep); + erts_atomic_set_nob(&dep->input_handler, + (erts_aint_t) NIL); + cache = dep->cache; + dep->cache = NULL; + +#ifdef DEBUG + erts_de_links_lock(dep); + ASSERT(!dep->nlinks); + ASSERT(!dep->node_links); + ASSERT(!dep->monitors); + erts_de_links_unlock(dep); +#endif + + erts_mtx_lock(&dep->qlock); + + erts_atomic64_set_nob(&dep->in, 0); + erts_atomic64_set_nob(&dep->out, 0); + + obuf = clear_de_out_queues(dep); + dep->status = 0; + suspendees = get_suspended_on_de(dep, ERTS_DE_QFLGS_ALL); + + erts_mtx_unlock(&dep->qlock); + erts_atomic_set_nob(&dep->dist_cmd_scheduled, 0); + dep->send = NULL; + erts_de_rwunlock(dep); + + erts_resume_processes(suspendees); + + delete_cache(cache); + + free_de_out_queues(dep, obuf); + if (dep->transcode_ctx) + transcode_free_ctx(dep); +} + int erts_dsend_context_dtor(Binary* ctx_bin) { ErtsSendContext* ctx = ERTS_MAGIC_BIN_DATA(ctx_bin); @@ -772,8 +799,8 @@ int erts_dsend_context_dtor(Binary* ctx_bin) if (ctx->dss.phase >= ERTS_DSIG_SEND_PHASE_ALLOC && ctx->dss.obuf) { free_dist_obuf(ctx->dss.obuf); } - if (ctx->dep_to_deref) - erts_deref_dist_entry(ctx->dep_to_deref); + if (ctx->deref_dep) + erts_deref_dist_entry(ctx->dep); return 1; } @@ -1324,7 +1351,7 @@ int erts_net_message(Port *prt, /* This is tricky (we MUST force a distributed send) */ ErtsDSigData dsd; int code; - code = erts_dsig_prepare(&dsd, dep, NULL, ERTS_DSP_NO_LOCK, 0); + code = erts_dsig_prepare(&dsd, dep, NULL, 0, ERTS_DSP_NO_LOCK, 0, 0); if (code == ERTS_DSIG_PREP_CONNECTED) { code = erts_dsig_send_exit(&dsd, to, from, am_noproc); ASSERT(code == ERTS_DSIG_SEND_OK); @@ -1416,7 +1443,7 @@ int erts_net_message(Port *prt, if (!rp) { ErtsDSigData dsd; int code; - code = erts_dsig_prepare(&dsd, dep, NULL, ERTS_DSP_NO_LOCK, 0); + code = erts_dsig_prepare(&dsd, dep, NULL, 0, ERTS_DSP_NO_LOCK, 0, 0); if (code == ERTS_DSIG_PREP_CONNECTED) { code = erts_dsig_send_m_exit(&dsd, watcher, watched, ref, am_noproc); @@ -1879,33 +1906,32 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx) if (ctx->flags & DFLAG_DIST_HDR_ATOM_CACHE) { ctx->acmp = erts_get_atom_cache_map(ctx->c_p); - ctx->pass_through_size = 0; + ctx->max_finalize_prepend = 0; } else { ctx->acmp = NULL; - ctx->pass_through_size = 1; + ctx->max_finalize_prepend = 3; } #ifdef ERTS_DIST_MSG_DBG - erts_fprintf(stderr, ">>%s CTL: %T\n", ctx->pass_through_size ? "P" : " ", ctx->ctl); - if (is_value(ctx->msg)) - erts_fprintf(stderr, " MSG: %T\n", ctx->msg); + erts_fprintf(stderr, ">> CTL: %T\n", ctx->ctl); + if (is_value(ctx->msg)) + erts_fprintf(stderr, " MSG: %T\n", ctx->msg); #endif - ctx->data_size = ctx->pass_through_size; + ctx->data_size = ctx->max_finalize_prepend; erts_reset_atom_cache_map(ctx->acmp); erts_encode_dist_ext_size(ctx->ctl, ctx->flags, ctx->acmp, &ctx->data_size); - if (is_value(ctx->msg)) { - ctx->u.sc.wstack.wstart = NULL; - ctx->u.sc.flags = ctx->flags; - ctx->u.sc.level = 0; - ctx->phase = ERTS_DSIG_SEND_PHASE_MSG_SIZE; - } else { - ctx->phase = ERTS_DSIG_SEND_PHASE_ALLOC; - } - break; + if (is_non_value(ctx->msg)) { + ctx->phase = ERTS_DSIG_SEND_PHASE_ALLOC; + break; + } + ctx->u.sc.wstack.wstart = NULL; + ctx->u.sc.flags = ctx->flags; + ctx->u.sc.level = 0; + ctx->phase = ERTS_DSIG_SEND_PHASE_MSG_SIZE; case ERTS_DSIG_SEND_PHASE_MSG_SIZE: if (erts_encode_dist_ext_size_int(ctx->msg, ctx, &ctx->data_size)) { retval = ERTS_DSIG_SEND_CONTINUE; @@ -1920,23 +1946,24 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx) ctx->data_size += ctx->dhdr_ext_size; ctx->obuf = alloc_dist_obuf(ctx->data_size); - ctx->obuf->ext_endp = &ctx->obuf->data[0] + ctx->pass_through_size + ctx->dhdr_ext_size; + ctx->obuf->ext_endp = &ctx->obuf->data[0] + ctx->max_finalize_prepend + ctx->dhdr_ext_size; /* Encode internal version of dist header */ ctx->obuf->extp = erts_encode_ext_dist_header_setup(ctx->obuf->ext_endp, ctx->acmp); /* Encode control message */ erts_encode_dist_ext(ctx->ctl, &ctx->obuf->ext_endp, ctx->flags, ctx->acmp, NULL, NULL); - if (is_value(ctx->msg)) { - ctx->u.ec.flags = ctx->flags; - ctx->u.ec.level = 0; - ctx->u.ec.wstack.wstart = NULL; - ctx->phase = ERTS_DSIG_SEND_PHASE_MSG_ENCODE; - } else { - ctx->phase = ERTS_DSIG_SEND_PHASE_FIN; - } - break; + if (is_non_value(ctx->msg)) { + ctx->obuf->msg_start = NULL; + ctx->phase = ERTS_DSIG_SEND_PHASE_FIN; + break; + } + ctx->u.ec.flags = ctx->flags; + ctx->u.ec.level = 0; + ctx->u.ec.wstack.wstart = NULL; + ctx->obuf->msg_start = ctx->obuf->ext_endp; - case ERTS_DSIG_SEND_PHASE_MSG_ENCODE: + ctx->phase = ERTS_DSIG_SEND_PHASE_MSG_ENCODE; + case ERTS_DSIG_SEND_PHASE_MSG_ENCODE: if (erts_encode_dist_ext(ctx->msg, &ctx->obuf->ext_endp, ctx->flags, ctx->acmp, &ctx->u.ec, &ctx->reds)) { retval = ERTS_DSIG_SEND_CONTINUE; goto done; @@ -1949,7 +1976,7 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx) int resume = 0; ASSERT(ctx->obuf->extp < ctx->obuf->ext_endp); - ASSERT(&ctx->obuf->data[0] <= ctx->obuf->extp - ctx->pass_through_size); + ASSERT(&ctx->obuf->data[0] <= ctx->obuf->extp - ctx->max_finalize_prepend); ASSERT(ctx->obuf->ext_endp <= &ctx->obuf->data[0] + ctx->data_size); ctx->data_size = ctx->obuf->ext_endp - ctx->obuf->extp; @@ -1961,9 +1988,9 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx) ctx->obuf->next = NULL; erts_de_rlock(dep); cid = dep->cid; - if (cid != dsdp->cid - || dep->connection_id != dsdp->connection_id - || dep->status & ERTS_DE_SFLG_EXITING) { + if (!(dep->status & (ERTS_DE_SFLG_PENDING | ERTS_DE_SFLG_CONNECTED)) + || dep->status & ERTS_DE_SFLG_EXITING + || dep->connection_id != dsdp->connection_id) { /* Not the same connection as when we started; drop message... */ erts_de_runlock(dep); free_dist_obuf(ctx->obuf); @@ -2037,8 +2064,13 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx) } erts_mtx_unlock(&dep->qlock); - if (is_internal_port(dep->cid)) - erts_schedule_dist_command(NULL, dep); + if (!(dep->status & ERTS_DE_SFLG_PENDING)) { + if (is_internal_port(dep->cid)) + erts_schedule_dist_command(NULL, dep); + } + else { + notify_proc = NIL; + } erts_de_runlock(dep); if (is_internal_pid(notify_proc)) notify_dist_data(ctx->c_p, notify_proc); @@ -2203,7 +2235,6 @@ dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf) #endif #define ERTS_PORT_REDS_DIST_CMD_START 5 -#define ERTS_PORT_REDS_DIST_CMD_FINALIZE 3 #define ERTS_PORT_REDS_DIST_CMD_EXIT 200 #define ERTS_PORT_REDS_DIST_CMD_RESUMED 5 #define ERTS_PORT_REDS_DIST_CMD_DATA(SZ) \ @@ -2212,9 +2243,9 @@ dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf) : ((((Sint) (SZ)) >> 10) & ((Sint) ERTS_PORT_REDS_MASK__))) int -erts_dist_command(Port *prt, int reds_limit) +erts_dist_command(Port *prt, int initial_reds) { - Sint reds = ERTS_PORT_REDS_DIST_CMD_START; + Sint reds = initial_reds - ERTS_PORT_REDS_DIST_CMD_START; Uint32 status; Uint32 flags; Sint qsize, obufsize = 0; @@ -2236,9 +2267,12 @@ erts_dist_command(Port *prt, int reds_limit) if (status & ERTS_DE_SFLG_EXITING) { erts_deliver_port_exit(prt, prt->common.id, am_killed, 0, 1); - return reds + ERTS_PORT_REDS_DIST_CMD_EXIT; + reds -= ERTS_PORT_REDS_DIST_CMD_EXIT; + return initial_reds - reds; } + ASSERT(!(status & ERTS_DE_SFLG_PENDING)); + ASSERT(send); /* @@ -2263,7 +2297,7 @@ erts_dist_command(Port *prt, int reds_limit) sched_flags = erts_atomic32_read_nob(&prt->sched.flags); - if (reds > reds_limit) + if (reds < 0) goto preempted; if (!(sched_flags & ERTS_PTS_FLG_BUSY_PORT) && foq.first) { @@ -2278,13 +2312,13 @@ erts_dist_command(Port *prt, int reds_limit) erts_fprintf(stderr, ">> "); bw(foq.first->extp, size); #endif - reds += ERTS_PORT_REDS_DIST_CMD_DATA(size); - fob = foq.first; - obufsize += size_obuf(fob); - foq.first = foq.first->next; - free_dist_obuf(fob); + reds -= ERTS_PORT_REDS_DIST_CMD_DATA(size); + fob = foq.first; + obufsize += size_obuf(fob); + foq.first = foq.first->next; + free_dist_obuf(fob); sched_flags = erts_atomic32_read_nob(&prt->sched.flags); - preempt = reds > reds_limit || (sched_flags & ERTS_PTS_FLG_EXIT); + preempt = reds < 0 || (sched_flags & ERTS_PTS_FLG_EXIT); if (sched_flags & ERTS_PTS_FLG_BUSY_PORT) break; } while (foq.first && !preempt); @@ -2297,81 +2331,71 @@ erts_dist_command(Port *prt, int reds_limit) if (sched_flags & ERTS_PTS_FLG_BUSY_PORT) { if (oq.first) { ErtsDistOutputBuf *ob; - int preempt; + ErtsDistOutputBuf *last_finalized = NULL; finalize_only: - preempt = 0; ob = oq.first; ASSERT(ob); do { - ob->extp = erts_encode_ext_dist_header_finalize(ob->extp, - dep->cache, - flags); - if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) - *--ob->extp = PASS_THROUGH; /* Old node; 'pass through' - needed */ - ASSERT(&ob->data[0] <= ob->extp && ob->extp < ob->ext_endp); - reds += ERTS_PORT_REDS_DIST_CMD_FINALIZE; - preempt = reds > reds_limit; - if (preempt) - break; - ob = ob->next; + reds = erts_encode_ext_dist_header_finalize(ob, dep, flags, reds); + if (reds >= 0) { + last_finalized = ob; + ob = ob->next; + } } while (ob); - /* - * At least one buffer was finalized; if we got preempted, - * ob points to the last buffer that we finalized. - */ - if (foq.last) - foq.last->next = oq.first; - else - foq.first = oq.first; - if (!preempt) { - /* All buffers finalized */ - foq.last = oq.last; - oq.first = oq.last = NULL; - } - else { - /* Not all buffers finalized; split oq. */ - foq.last = ob; - oq.first = ob->next; - if (oq.first) - ob->next = NULL; - else - oq.last = NULL; - } - if (preempt) - goto preempted; + if (last_finalized) { + /* + * At least one buffer was finalized; if we got preempted, + * ob points to the next buffer to continue finalize. + */ + if (foq.last) + foq.last->next = oq.first; + else + foq.first = oq.first; + foq.last = last_finalized; + if (!ob) { + /* All buffers finalized */ + ASSERT(foq.last == oq.last); + ASSERT(foq.last->next == NULL); + oq.first = oq.last = NULL; + } + else { + /* Not all buffers finalized; split oq. */ + ASSERT(foq.last->next == ob); + foq.last->next = NULL; + oq.first = ob; + } + } + if (reds <= 0) + goto preempted; } } else { int de_busy; int preempt = 0; while (oq.first && !preempt) { - ErtsDistOutputBuf *fob; - Uint size; - oq.first->extp - = erts_encode_ext_dist_header_finalize(oq.first->extp, - dep->cache, - flags); - reds += ERTS_PORT_REDS_DIST_CMD_FINALIZE; - if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) - *--oq.first->extp = PASS_THROUGH; /* Old node; 'pass through' - needed */ - ASSERT(&oq.first->data[0] <= oq.first->extp - && oq.first->extp < oq.first->ext_endp); - size = (*send)(prt, oq.first); + ErtsDistOutputBuf *fob; + Uint size; + reds = erts_encode_ext_dist_header_finalize(oq.first, dep, flags, reds); + if (reds < 0) { + preempt = 1; + break; + } + ASSERT(&oq.first->data[0] <= oq.first->extp + && oq.first->extp < oq.first->ext_endp); + size = (*send)(prt, oq.first); erts_atomic64_inc_nob(&dep->out); - esdp->io.out += (Uint64) size; + esdp->io.out += (Uint64) size; #ifdef ERTS_RAW_DIST_MSG_DBG erts_fprintf(stderr, ">> "); bw(oq.first->extp, size); #endif - reds += ERTS_PORT_REDS_DIST_CMD_DATA(size); - fob = oq.first; - obufsize += size_obuf(fob); - oq.first = oq.first->next; - free_dist_obuf(fob); + reds -= ERTS_PORT_REDS_DIST_CMD_DATA(size); + fob = oq.first; + obufsize += size_obuf(fob); + oq.first = oq.first->next; + free_dist_obuf(fob); sched_flags = erts_atomic32_read_nob(&prt->sched.flags); - preempt = reds > reds_limit || (sched_flags & ERTS_PTS_FLG_EXIT); + preempt = reds <= 0 || (sched_flags & ERTS_PTS_FLG_EXIT); if ((sched_flags & ERTS_PTS_FLG_BUSY_PORT) && oq.first && !preempt) goto finalize_only; } @@ -2411,7 +2435,7 @@ erts_dist_command(Port *prt, int reds_limit) erts_mtx_unlock(&dep->qlock); resumed = erts_resume_processes(suspendees); - reds += resumed*ERTS_PORT_REDS_DIST_CMD_RESUMED; + reds -= resumed*ERTS_PORT_REDS_DIST_CMD_RESUMED; } else erts_mtx_unlock(&dep->qlock); @@ -2434,8 +2458,7 @@ erts_dist_command(Port *prt, int reds_limit) erts_mtx_unlock(&dep->qlock); } - ASSERT(foq.first || !foq.last); - ASSERT(!foq.first || foq.last); + ASSERT(!!foq.first == !!foq.last); ASSERT(!dep->finalized_out_queue.first); ASSERT(!dep->finalized_out_queue.last); @@ -2445,10 +2468,10 @@ erts_dist_command(Port *prt, int reds_limit) } /* Avoid wrapping reduction counter... */ - if (reds > INT_MAX/2) - reds = INT_MAX/2; + if (reds < INT_MIN/2) + reds = INT_MIN/2; - return reds; + return initial_reds - reds; preempted: /* @@ -2456,8 +2479,7 @@ erts_dist_command(Port *prt, int reds_limit) * since last call to driver. */ - ASSERT(oq.first || !oq.last); - ASSERT(!oq.first || oq.last); + ASSERT(!!oq.first == !!oq.last); if (sched_flags & ERTS_PTS_FLG_EXIT) { /* @@ -2481,12 +2503,6 @@ erts_dist_command(Port *prt, int reds_limit) foq.first = NULL; foq.last = NULL; - -#ifdef DEBUG - erts_mtx_lock(&dep->qlock); - ASSERT(erts_atomic_read_nob(&dep->qsize) == obufsize); - erts_mtx_unlock(&dep->qlock); -#endif } else { if (oq.first) { @@ -2776,7 +2792,8 @@ BIF_RETTYPE dist_ctrl_get_data_1(BIF_ALIST_1) { DistEntry *dep = ERTS_PROC_GET_DIST_ENTRY(BIF_P); - int reds = 1; + const Sint initial_reds = ERTS_BIF_REDS_LEFT(BIF_P); + Sint reds = initial_reds; ErtsDistOutputBuf *obuf; Eterm *hp; ProcBin *pb; @@ -2807,6 +2824,7 @@ dist_ctrl_get_data_1(BIF_ALIST_1) { if (!dep->tmp_out_queue.first) { ASSERT(!dep->tmp_out_queue.last); + ASSERT(!dep->transcode_ctx); qsize = erts_atomic_read_acqb(&dep->qsize); if (qsize > 0) { erts_mtx_lock(&dep->qlock); @@ -2824,21 +2842,18 @@ dist_ctrl_get_data_1(BIF_ALIST_1) erts_de_runlock(dep); BIF_RET(am_none); } - else { - obuf = dep->tmp_out_queue.first; - dep->tmp_out_queue.first = obuf->next; - if (!obuf->next) - dep->tmp_out_queue.last = NULL; + + obuf = dep->tmp_out_queue.first; + reds = erts_encode_ext_dist_header_finalize(obuf, dep, dep->flags, reds); + if (reds < 0) { + erts_de_runlock(dep); + ERTS_BIF_YIELD1(bif_export[BIF_dist_ctrl_get_data_1], + BIF_P, BIF_ARG_1); } - obuf->extp = erts_encode_ext_dist_header_finalize(obuf->extp, - dep->cache, - dep->flags); - reds += ERTS_PORT_REDS_DIST_CMD_FINALIZE; - if (!(dep->flags & DFLAG_DIST_HDR_ATOM_CACHE)) - *--obuf->extp = PASS_THROUGH; /* 'pass through' needed */ - ASSERT(&obuf->data[0] <= obuf->extp - && obuf->extp < obuf->ext_endp); + dep->tmp_out_queue.first = obuf->next; + if (!obuf->next) + dep->tmp_out_queue.last = NULL; } erts_atomic64_inc_nob(&dep->out); @@ -2866,11 +2881,11 @@ dist_ctrl_get_data_1(BIF_ALIST_1) erts_mtx_unlock(&dep->qlock); if (resume_procs) { int resumed = erts_resume_processes(resume_procs); - reds += resumed*ERTS_PORT_REDS_DIST_CMD_RESUMED; + reds -= resumed*ERTS_PORT_REDS_DIST_CMD_RESUMED; } } - BIF_RET2(make_binary(pb), reds); + BIF_RET2(make_binary(pb), (initial_reds - reds)); } void @@ -2892,24 +2907,31 @@ erts_dist_port_not_busy(Port *prt) erts_schedule_dist_command(prt, NULL); } +static void kill_connection(DistEntry *dep) +{ + ERTS_LC_ASSERT(erts_lc_is_de_rwlocked(dep)); + ASSERT(dep->status == ERTS_DE_SFLG_CONNECTED); + + dep->status |= ERTS_DE_SFLG_EXITING; + erts_mtx_lock(&dep->qlock); + ASSERT(!(erts_atomic32_read_nob(&dep->qflgs) & ERTS_DE_QFLG_EXIT)); + erts_atomic32_read_bor_nob(&dep->qflgs, ERTS_DE_QFLG_EXIT); + erts_mtx_unlock(&dep->qlock); + + if (is_internal_port(dep->cid)) + erts_schedule_dist_command(NULL, dep); + else if (is_internal_pid(dep->cid)) + schedule_kill_dist_ctrl_proc(dep->cid); +} + void erts_kill_dist_connection(DistEntry *dep, Uint32 connection_id) { erts_de_rwlock(dep); if (connection_id == dep->connection_id - && !(dep->status & ERTS_DE_SFLG_EXITING)) { - - dep->status |= ERTS_DE_SFLG_EXITING; - - erts_mtx_lock(&dep->qlock); - ASSERT(!(erts_atomic32_read_nob(&dep->qflgs) & ERTS_DE_QFLG_EXIT)); - erts_atomic32_read_bor_nob(&dep->qflgs, ERTS_DE_QFLG_EXIT); - erts_mtx_unlock(&dep->qlock); + && dep->status == ERTS_DE_SFLG_CONNECTED) { - if (is_internal_port(dep->cid)) - erts_schedule_dist_command(NULL, dep); - else if (is_internal_pid(dep->cid)) - schedule_kill_dist_ctrl_proc(dep->cid); + kill_connection(dep); } erts_de_rwunlock(dep); } @@ -3069,6 +3091,10 @@ int distribution_info(fmtfn_t to, void *arg) /* Called by break handler */ info_dist_entry(to, arg, dep, 0, 1); } + for (dep = erts_pending_dist_entries; dep; dep = dep->next) { + info_dist_entry(to, arg, dep, 0, 0); + } + for (dep = erts_not_connected_dist_entries; dep; dep = dep->next) { if (dep != erts_this_dist_entry) { info_dist_entry(to, arg, dep, 0, 0); @@ -3091,7 +3117,6 @@ int distribution_info(fmtfn_t to, void *arg) /* Called by break handler */ monitor_node -- turn on/off node monitoring node controller only: - dist_exit/3 -- send exit signals from remote to local process dist_link/2 -- link a remote process to a local dist_unlink/2 -- unlink a remote from a local ****************************************************************************/ @@ -3101,15 +3126,6 @@ int distribution_info(fmtfn_t to, void *arg) /* Called by break handler */ /********************************************************************** ** Set the node name of current node fail if node already is set. ** setnode(name@host, Creation) - ** loads functions pointer to trap_functions from module erlang. - ** erlang:dsend/2 - ** erlang:dlink/1 - ** erlang:dunlink/1 - ** erlang:dmonitor_node/3 - ** erlang:dgroup_leader/2 - ** erlang:dexit/2 - ** -- are these needed ? - ** dexit/1 ***********************************************************************/ BIF_RETTYPE setnode_2(BIF_ALIST_2) @@ -3133,15 +3149,8 @@ BIF_RETTYPE setnode_2(BIF_ALIST_2) goto error; /* Check that all trap functions are defined !! */ - if (dsend2_trap->addressv[0] == NULL || - dsend3_trap->addressv[0] == NULL || - /* dsend_nosuspend_trap->address == NULL ||*/ - dlink_trap->addressv[0] == NULL || - dunlink_trap->addressv[0] == NULL || - dmonitor_node_trap->addressv[0] == NULL || - dgroup_leader_trap->addressv[0] == NULL || - dmonitor_p_trap->addressv[0] == NULL || - dexit_trap->addressv[0] == NULL) { + if (dmonitor_node_trap->addressv[0] == NULL || + dmonitor_p_trap->addressv[0] == NULL) { goto error; } @@ -3218,6 +3227,8 @@ BIF_RETTYPE setnode_3(BIF_ALIST_3) ErtsProcLocks proc_unlock = 0; Process *proc; Port *pp = NULL; + Eterm notify_proc; + erts_aint32_t qflgs; /* * Check and pick out arguments @@ -3245,21 +3256,25 @@ BIF_RETTYPE setnode_3(BIF_ALIST_3) if (!is_atom(ic) || !is_atom(oc)) goto badarg; - /* DFLAG_EXTENDED_REFERENCES is compulsory from R9 and forward */ - if (!(DFLAG_EXTENDED_REFERENCES & flags)) { + if (~flags & DFLAG_DIST_MANDATORY) { erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); erts_dsprintf(dsbufp, "%T", BIF_P->common.id); if (BIF_P->common.u.alive.reg) erts_dsprintf(dsbufp, " (%T)", BIF_P->common.u.alive.reg->name); erts_dsprintf(dsbufp, " attempted to enable connection to node %T " - "which is not able to handle extended references.\n", + "which does not support all mandatory capabilities.\n", BIF_ARG_1); erts_send_error_to_logger(BIF_P->group_leader, dsbufp); goto badarg; } /* + * ToDo: Should we not pass connection_id as well + * to make sure it's the right connection we commit. + */ + + /* * Arguments seem to be in order. */ @@ -3302,6 +3317,23 @@ BIF_RETTYPE setnode_3(BIF_ALIST_3) goto badarg; } + if (dep->status & ERTS_DE_SFLG_EXITING) { + /* Suspend on dist entry waiting for the exit to finish */ + ErtsProcList *plp = erts_proclist_create(BIF_P); + plp->next = NULL; + erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL); + erts_mtx_lock(&dep->qlock); + erts_proclist_store_last(&dep->suspended, plp); + erts_mtx_unlock(&dep->qlock); + goto yield; + } + if (dep->status != ERTS_DE_SFLG_PENDING) { + if (dep->status == 0) + erts_set_dist_entry_pending(dep); + else + goto badarg; + } + if (is_not_nil(dep->cid)) goto badarg; @@ -3344,8 +3376,12 @@ BIF_RETTYPE setnode_3(BIF_ALIST_3) erts_mtx_unlock(&dep->qlock); goto yield; } - - ASSERT(!(dep->status & ERTS_DE_SFLG_EXITING)); + if (dep->status != ERTS_DE_SFLG_PENDING) { + if (dep->status == 0) + erts_set_dist_entry_pending(dep); + else + goto badarg; + } if (pp->dist_entry || is_not_nil(dep->cid)) goto badarg; @@ -3376,7 +3412,8 @@ BIF_RETTYPE setnode_3(BIF_ALIST_3) dep->creation = 0; #ifdef DEBUG - ASSERT(erts_atomic_read_nob(&dep->qsize) == 0); + ASSERT(erts_atomic_read_nob(&dep->qsize) == 0 + || (dep->status & ERTS_DE_SFLG_PENDING)); #endif if (flags & DFLAG_DIST_HDR_ATOM_CACHE) @@ -3384,7 +3421,26 @@ BIF_RETTYPE setnode_3(BIF_ALIST_3) erts_set_dist_entry_connected(dep, BIF_ARG_2, flags); + notify_proc = NIL; + if (erts_atomic_read_nob(&dep->qsize)) { + if (is_internal_port(dep->cid)) { + erts_schedule_dist_command(NULL, dep); + } + else { + qflgs = erts_atomic32_read_nob(&dep->qflgs); + if (qflgs & ERTS_DE_QFLG_REQ_INFO) { + qflgs = erts_atomic32_read_band_mb(&dep->qflgs, + ~ERTS_DE_QFLG_REQ_INFO); + if (qflgs & ERTS_DE_QFLG_REQ_INFO) { + notify_proc = dep->cid; + ASSERT(is_internal_pid(notify_proc)); + } + } + } + } erts_de_rwunlock(dep); + if (is_internal_pid(notify_proc)) + notify_dist_data(BIF_P, notify_proc); ERTS_BIF_PREP_RET(ret, erts_make_dhandle(BIF_P, dep)); @@ -3426,79 +3482,168 @@ BIF_RETTYPE setnode_3(BIF_ALIST_3) goto done; } +BIF_RETTYPE erts_internal_new_connection_1(BIF_ALIST_1) +{ + DistEntry* dep; + Uint32 conn_id; + Eterm* hp; + Eterm dhandle; + + if (is_not_atom(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + dep = erts_find_or_insert_dist_entry(BIF_ARG_1); -/**********************************************************************/ -/* dist_exit(Local, Term, Remote) -> Bool */ + if (dep == erts_this_dist_entry) { + erts_deref_dist_entry(dep); + BIF_ERROR(BIF_P, BADARG); + } -BIF_RETTYPE dist_exit_3(BIF_ALIST_3) + erts_de_rwlock(dep); + + if (ERTS_DE_IS_CONNECTED(dep) || dep->status & ERTS_DE_SFLG_PENDING) + conn_id = dep->connection_id; + else if (dep->status == 0) { + erts_set_dist_entry_pending(dep); + conn_id = dep->connection_id; + } + else { + ASSERT(dep->status & ERTS_DE_SFLG_EXITING); + conn_id = (dep->connection_id + 1) & ERTS_DIST_CON_ID_MASK; + } + erts_de_rwunlock(dep); + hp = HAlloc(BIF_P, 3 + ERTS_MAGIC_REF_THING_SIZE); + dhandle = erts_build_dhandle(&hp, &BIF_P->off_heap, dep); + erts_deref_dist_entry(dep); + BIF_RET(TUPLE2(hp, make_small(conn_id), dhandle)); +} + +static Sint abort_connection(DistEntry* dep, Uint32 conn_id) { - Eterm local; - Eterm remote; - DistEntry *rdep; + erts_de_rwlock(dep); - local = BIF_ARG_1; - remote = BIF_ARG_3; + if (dep->connection_id != conn_id) + ; + else if (dep->status == ERTS_DE_SFLG_CONNECTED) { + kill_connection(dep); + } + else if (dep->status == ERTS_DE_SFLG_PENDING) { + NetExitsContext nec = {dep}; + ErtsLink *nlinks; + ErtsLink *node_links; + ErtsMonitor *monitors; + ErtsAtomCache *cache; + ErtsDistOutputBuf *obuf; + ErtsProcList *resume_procs; + Sint reds = 0; + + ASSERT(is_nil(dep->cid)); - /* Check that remote is a remote process */ - if (is_not_external_pid(remote)) - goto error; + erts_de_links_lock(dep); + monitors = dep->monitors; + nlinks = dep->nlinks; + node_links = dep->node_links; + dep->monitors = NULL; + dep->nlinks = NULL; + dep->node_links = NULL; + erts_de_links_unlock(dep); - rdep = external_dist_entry(remote); - - if(rdep == erts_this_dist_entry) - goto error; + cache = dep->cache; + dep->cache = NULL; + erts_mtx_lock(&dep->qlock); + obuf = dep->out_queue.first; + dep->out_queue.first = NULL; + dep->out_queue.last = NULL; + ASSERT(!dep->tmp_out_queue.first); + ASSERT(!dep->finalized_out_queue.first); + resume_procs = get_suspended_on_de(dep, ERTS_DE_QFLGS_ALL); + erts_mtx_unlock(&dep->qlock); + erts_atomic_set_nob(&dep->dist_cmd_scheduled, 0); + dep->send = NULL; - /* Check that local is local */ - if (is_internal_pid(local)) { - Process *lp; - ErtsProcLocks lp_locks; - if (BIF_P->common.id == local) { - lp_locks = ERTS_PROC_LOCKS_ALL; - lp = BIF_P; - erts_proc_lock(BIF_P, ERTS_PROC_LOCKS_ALL_MINOR); - } - else { - lp_locks = ERTS_PROC_LOCKS_XSIG_SEND; - lp = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN, - local, lp_locks); - if (!lp) { - BIF_RET(am_true); /* ignore */ - } - } - - (void) erts_send_exit_signal(BIF_P, - remote, - lp, - &lp_locks, - BIF_ARG_2, - NIL, - NULL, - 0); - if (lp == BIF_P) - lp_locks &= ~ERTS_PROC_LOCK_MAIN; - erts_proc_unlock(lp, lp_locks); - if (lp == BIF_P) { - erts_aint32_t state = erts_atomic32_read_acqb(&BIF_P->state); - /* - * We may have exited current process and may have to take action. - */ - if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT)) { - if (state & ERTS_PSFLG_PENDING_EXIT) - erts_handle_pending_exit(BIF_P, ERTS_PROC_LOCK_MAIN); - ERTS_BIF_EXITED(BIF_P); - } - } + erts_set_dist_entry_not_connected(dep); + + erts_de_rwunlock(dep); + + erts_sweep_monitors(monitors, &doit_monitor_net_exits, &nec); + erts_sweep_links(nlinks, &doit_link_net_exits, &nec); + erts_sweep_links(node_links, &doit_node_link_net_exits, &nec); + + if (resume_procs) { + int resumed = erts_resume_processes(resume_procs); + reds += resumed*ERTS_PORT_REDS_DIST_CMD_RESUMED; + } + + delete_cache(cache); + free_de_out_queues(dep, obuf); + return reds; } - else if (is_external_pid(local) - && external_dist_entry(local) == erts_this_dist_entry) { - BIF_RET(am_true); /* ignore */ + erts_de_rwunlock(dep); + return 0; +} + +BIF_RETTYPE erts_internal_abort_connection_2(BIF_ALIST_2) +{ + DistEntry* dep; + Eterm* tp; + + if (is_not_atom(BIF_ARG_1) || is_not_tuple_arity(BIF_ARG_2, 2)) { + BIF_ERROR(BIF_P, BADARG); + } + tp = tuple_val(BIF_ARG_2); + dep = erts_dhandle_to_dist_entry(tp[2]); + if (is_not_small(tp[1]) || dep != erts_find_dist_entry(BIF_ARG_1) + || dep == erts_this_dist_entry) { + BIF_ERROR(BIF_P, BADARG); + } + + if (dep) { + Sint reds = abort_connection(dep, unsigned_val(tp[1])); + BUMP_REDS(BIF_P, reds); } - else - goto error; BIF_RET(am_true); +} - error: - BIF_ERROR(BIF_P, BADARG); +int erts_auto_connect(DistEntry* dep, Process *proc, ErtsProcLocks proc_locks) +{ + erts_de_rwlock(dep); + if (dep->status != 0) { + erts_de_rwunlock(dep); + } + else { + Process* net_kernel; + ErtsProcLocks nk_locks = ERTS_PROC_LOCK_MSGQ; + Eterm *hp; + ErlOffHeap *ohp; + ErtsMessage *mp; + Eterm msg, dhandle; + Uint32 conn_id; + + erts_set_dist_entry_pending(dep); + conn_id = dep->connection_id; + erts_de_rwunlock(dep); + + net_kernel = erts_whereis_process(proc, proc_locks, + am_net_kernel, nk_locks, 0); + if (!net_kernel) { + abort_connection(dep, conn_id); + return 0; + } + + /* + * Send {auto_connect, Node, ConnId, DHandle} to net_kernel + */ + mp = erts_alloc_message_heap(net_kernel, &nk_locks, + 5 + ERTS_MAGIC_REF_THING_SIZE, + &hp, &ohp); + dhandle = erts_build_dhandle(&hp, ohp, dep); + msg = TUPLE4(hp, am_auto_connect, dep->sysname, make_small(conn_id), + dhandle); + erts_queue_message(net_kernel, nk_locks, mp, msg, proc->common.id); + erts_proc_unlock(net_kernel, nk_locks); + } + + return 1; } /**********************************************************************/ @@ -3574,9 +3719,11 @@ BIF_RETTYPE nodes_1(BIF_ALIST_1) ASSERT(erts_no_of_not_connected_dist_entries > 0); ASSERT(erts_no_of_hidden_dist_entries >= 0); + ASSERT(erts_no_of_pending_dist_entries >= 0); ASSERT(erts_no_of_visible_dist_entries >= 0); if(not_connected) - length += (erts_no_of_not_connected_dist_entries - 1); + length += ((erts_no_of_not_connected_dist_entries - 1) + + erts_no_of_pending_dist_entries); if(hidden) length += erts_no_of_hidden_dist_entries; if(visible) @@ -3596,13 +3743,18 @@ BIF_RETTYPE nodes_1(BIF_ALIST_1) #ifdef DEBUG endp = hp + length*2; #endif - if(not_connected) + if(not_connected) { for(dep = erts_not_connected_dist_entries; dep; dep = dep->next) { if (dep != erts_this_dist_entry) { result = CONS(hp, dep->sysname, result); hp += 2; } + } + for(dep = erts_pending_dist_entries; dep; dep = dep->next) { + result = CONS(hp, dep->sysname, result); + hp += 2; } + } if(hidden) for(dep = erts_hidden_dist_entries; dep; dep = dep->next) { result = CONS(hp, dep->sysname, result); @@ -3647,11 +3799,17 @@ monitor_node(Process* p, Eterm Node, Eterm Bool, Eterm Options) DistEntry *dep; ErtsLink *lnk; Eterm l; + int async_connect = 1; for (l = Options; l != NIL && is_list(l); l = CDR(list_val(l))) { Eterm t = CAR(list_val(l)); - /* allow_passive_connect the only available option right now */ - if (t != am_allow_passive_connect) { + if (t == am_allow_passive_connect) { + /* + * Handle this horrible feature by falling back on old synchronous + * auto-connect (if needed) + */ + async_connect = 0; + } else { BIF_ERROR(p, BADARG); } } @@ -3665,50 +3823,90 @@ monitor_node(Process* p, Eterm Node, Eterm Bool, Eterm Options) && (Node != erts_this_node->sysname))) { BIF_ERROR(p, BADARG); } - dep = erts_sysname_to_connected_dist_entry(Node); - if (!dep) { - do_trap: - BIF_TRAP3(dmonitor_node_trap, p, Node, Bool, Options); - } - if (dep == erts_this_dist_entry) - goto done; - - erts_proc_lock(p, ERTS_PROC_LOCK_LINK); - erts_de_rlock(dep); - if (ERTS_DE_IS_NOT_CONNECTED(dep)) { - erts_proc_unlock(p, ERTS_PROC_LOCK_LINK); - erts_de_runlock(dep); - goto do_trap; - } - erts_de_links_lock(dep); - erts_de_runlock(dep); if (Bool == am_true) { - ASSERT(dep->cid != NIL); - lnk = erts_add_or_lookup_link(&(dep->node_links), LINK_NODE, - p->common.id); - ++ERTS_LINK_REFC(lnk); - lnk = erts_add_or_lookup_link(&ERTS_P_LINKS(p), LINK_NODE, Node); - ++ERTS_LINK_REFC(lnk); - } - else { - lnk = erts_lookup_link(dep->node_links, p->common.id); - if (lnk != NULL) { - if ((--ERTS_LINK_REFC(lnk)) == 0) { - erts_destroy_link(erts_remove_link(&(dep->node_links), - p->common.id)); - } - } - lnk = erts_lookup_link(ERTS_P_LINKS(p), Node); - if (lnk != NULL) { - if ((--ERTS_LINK_REFC(lnk)) == 0) { - erts_destroy_link(erts_remove_link(&ERTS_P_LINKS(p), - Node)); + ErtsDSigData dsd; + dsd.node = Node; + dep = erts_find_or_insert_dist_entry(Node); + if (dep == erts_this_dist_entry) + goto done; + + erts_proc_lock(p, ERTS_PROC_LOCK_LINK); + + switch (erts_dsig_prepare(&dsd, dep, p, + (ERTS_PROC_LOCK_MAIN | ERTS_PROC_LOCK_LINK), + ERTS_DSP_RLOCK, 0, async_connect)) { + case ERTS_DSIG_PREP_NOT_ALIVE: + case ERTS_DSIG_PREP_NOT_CONNECTED: + /* Trap to either send 'nodedown' or do passive connection attempt */ + trap: + erts_proc_unlock(p, ERTS_PROC_LOCK_LINK); + erts_deref_dist_entry(dep); + BIF_TRAP3(dmonitor_node_trap, p, Node, Bool, Options); + case ERTS_DSIG_PREP_PENDING: + if (!async_connect) { + /* + * Pending connection may fail, so we must trap + * to ensure passive connection attempt + */ + erts_de_runlock(dep); + goto trap; } - } + /*fall through*/ + case ERTS_DSIG_PREP_CONNECTED: + erts_de_links_lock(dep); + erts_de_runlock(dep); + lnk = erts_add_or_lookup_link(&(dep->node_links), LINK_NODE, + p->common.id); + ++ERTS_LINK_REFC(lnk); + lnk = erts_add_or_lookup_link(&ERTS_P_LINKS(p), LINK_NODE, Node); + ++ERTS_LINK_REFC(lnk); + erts_de_links_unlock(dep); + break; + default: + ERTS_ASSERT(! "Invalid dsig prepare result"); + } + erts_deref_dist_entry(dep); + } + else { /* Bool == false */ + dep = erts_sysname_to_connected_dist_entry(Node); + if (!dep) { + /* + * Before OTP-21 this case triggered auto-connect + * and a 'nodedown' message if that failed. + * Now it's a simple no-op which feels more reasonable. + */ + BIF_RET(am_true); + } + if (dep == erts_this_dist_entry) + goto done; + + erts_proc_lock(p, ERTS_PROC_LOCK_LINK); + erts_de_rlock(dep); + if (!(dep->status & (ERTS_DE_SFLG_PENDING | ERTS_DE_SFLG_CONNECTED))) { + erts_proc_unlock(p, ERTS_PROC_LOCK_LINK); + erts_de_runlock(dep); + goto done; + } + erts_de_links_lock(dep); + erts_de_runlock(dep); + lnk = erts_lookup_link(dep->node_links, p->common.id); + if (lnk != NULL) { + if ((--ERTS_LINK_REFC(lnk)) == 0) { + erts_destroy_link(erts_remove_link(&(dep->node_links), + p->common.id)); + } + } + lnk = erts_lookup_link(ERTS_P_LINKS(p), Node); + if (lnk != NULL) { + if ((--ERTS_LINK_REFC(lnk)) == 0) { + erts_destroy_link(erts_remove_link(&ERTS_P_LINKS(p), + Node)); + } + } + erts_de_links_unlock(dep); } - erts_de_links_unlock(dep); erts_proc_unlock(p, ERTS_PROC_LOCK_LINK); done: diff --git a/erts/emulator/beam/dist.h b/erts/emulator/beam/dist.h index d4765c50b8..a96e39be89 100644 --- a/erts/emulator/beam/dist.h +++ b/erts/emulator/beam/dist.h @@ -45,6 +45,18 @@ #define DFLAG_MAP_TAG 0x20000 #define DFLAG_BIG_CREATION 0x40000 #define DFLAG_SEND_SENDER 0x80000 +#define DFLAG_NO_MAGIC 0x100000 + +/* Mandatory flags for distribution (sync with dist_util.erl) */ +#define DFLAG_DIST_MANDATORY (DFLAG_EXTENDED_REFERENCES \ + | DFLAG_EXTENDED_PIDS_PORTS \ + | DFLAG_UTF8_ATOMS \ + | DFLAG_NEW_FUN_TAGS) + +/* Additional optimistic flags when encoding toward pending connection */ +#define DFLAG_DIST_HOPEFULLY (DFLAG_NO_MAGIC \ + | DFLAG_EXPORT_PTR_TAG \ + | DFLAG_BIT_BINARIES) /* All flags that should be enabled when term_to_binary/1 is used. */ #define TERM_TO_BINARY_DFLAGS (DFLAG_EXTENDED_REFERENCES \ @@ -79,25 +91,19 @@ #define DOP_SEND_SENDER_TT 23 /* distribution trap functions */ -extern Export* dsend2_trap; -extern Export* dsend3_trap; -extern Export* dlink_trap; -extern Export* dunlink_trap; extern Export* dmonitor_node_trap; -extern Export* dgroup_leader_trap; -extern Export* dexit_trap; extern Export* dmonitor_p_trap; typedef enum { ERTS_DSP_NO_LOCK, - ERTS_DSP_RLOCK, - ERTS_DSP_RWLOCK + ERTS_DSP_RLOCK } ErtsDSigPrepLock; typedef struct { Process *proc; DistEntry *dep; + Eterm node; /* used if dep == NULL */ Eterm cid; Eterm connection_id; int no_suspend; @@ -117,14 +123,10 @@ extern int erts_is_alive; /* * erts_dsig_prepare() prepares a send of a distributed signal. - * One of the values defined below are returned. If the returned - * value is another than ERTS_DSIG_PREP_CONNECTED, the - * distributed signal cannot be sent before appropriate actions - * have been taken. Appropriate actions would typically be setting - * up the connection. + * One of the values defined below are returned. */ -/* Connected; signal can be sent. */ +/* Connected; signals can be enqueued and sent. */ #define ERTS_DSIG_PREP_CONNECTED 0 /* Not connected; connection needs to be set up. */ #define ERTS_DSIG_PREP_NOT_CONNECTED 1 @@ -132,43 +134,80 @@ extern int erts_is_alive; #define ERTS_DSIG_PREP_WOULD_SUSPEND 2 /* System not alive (distributed) */ #define ERTS_DSIG_PREP_NOT_ALIVE 3 +/* Pending connection; signals can be enqueued */ +#define ERTS_DSIG_PREP_PENDING 4 ERTS_GLB_INLINE int erts_dsig_prepare(ErtsDSigData *, - DistEntry *, + DistEntry*, Process *, + ErtsProcLocks, ErtsDSigPrepLock, + int, int); ERTS_GLB_INLINE void erts_schedule_dist_command(Port *, DistEntry *); +int erts_auto_connect(DistEntry* dep, Process *proc, ErtsProcLocks proc_locks); + #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE int erts_dsig_prepare(ErtsDSigData *dsdp, DistEntry *dep, Process *proc, + ErtsProcLocks proc_locks, ErtsDSigPrepLock dspl, - int no_suspend) + int no_suspend, + int connect) { - int failure; + int res; + if (!erts_is_alive) return ERTS_DSIG_PREP_NOT_ALIVE; - if (!dep) - return ERTS_DSIG_PREP_NOT_CONNECTED; - if (dspl == ERTS_DSP_RWLOCK) - erts_de_rwlock(dep); - else - erts_de_rlock(dep); - if (ERTS_DE_IS_NOT_CONNECTED(dep)) { - failure = ERTS_DSIG_PREP_NOT_CONNECTED; + if (!dep) { + ASSERT(!connect); + return ERTS_DSIG_PREP_NOT_CONNECTED; + } + +#ifdef ERTS_ENABLE_LOCK_CHECK + if (connect) { + erts_proc_lc_might_unlock(proc, proc_locks); + } +#endif + +retry: + erts_de_rlock(dep); + + if (ERTS_DE_IS_CONNECTED(dep)) { + res = ERTS_DSIG_PREP_CONNECTED; + } + else if (dep->status & ERTS_DE_SFLG_PENDING) { + res = ERTS_DSIG_PREP_PENDING; + } + else if (dep->status & ERTS_DE_SFLG_EXITING) { + res = ERTS_DSIG_PREP_NOT_CONNECTED; + goto fail; + } + else if (connect) { + ASSERT(dep->status == 0); + erts_de_runlock(dep); + if (!erts_auto_connect(dep, proc, proc_locks)) { + return ERTS_DSIG_PREP_NOT_ALIVE; + } + goto retry; + } + else { + ASSERT(dep->status == 0); + res = ERTS_DSIG_PREP_NOT_CONNECTED; goto fail; } + if (no_suspend) { - if (erts_atomic32_read_acqb(&dep->qflgs) & ERTS_DE_QFLG_BUSY) { - failure = ERTS_DSIG_PREP_WOULD_SUSPEND; + if (erts_atomic32_read_acqb(&dep->qflgs) & ERTS_DE_QFLG_BUSY) { + res = ERTS_DSIG_PREP_WOULD_SUSPEND; goto fail; - } + } } dsdp->proc = proc; dsdp->dep = dep; @@ -177,15 +216,11 @@ erts_dsig_prepare(ErtsDSigData *dsdp, dsdp->no_suspend = no_suspend; if (dspl == ERTS_DSP_NO_LOCK) erts_de_runlock(dep); - return ERTS_DSIG_PREP_CONNECTED; + return res; fail: - if (dspl == ERTS_DSP_RWLOCK) - erts_de_rwunlock(dep); - else - erts_de_runlock(dep); - return failure; - + erts_de_runlock(dep); + return res; } ERTS_GLB_INLINE @@ -332,7 +367,7 @@ struct erts_dsig_send_context { Eterm ctl; Eterm msg; int force_busy; - Uint32 pass_through_size; + Uint32 max_finalize_prepend; Uint data_size, dhdr_ext_size; ErtsAtomCacheMap *acmp; ErtsDistOutputBuf *obuf; @@ -346,11 +381,12 @@ struct erts_dsig_send_context { typedef struct { int suspend; + int connect; Eterm ctl_heap[6]; ErtsDSigData dsd; - DistEntry* dep_to_deref; DistEntry *dep; + int deref_dep; struct erts_dsig_send_context dss; Eterm return_term; diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 878b971b07..c6cc5c78b3 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -260,6 +260,8 @@ type MREF_TAB LONG_LIVED SYSTEM magic_ref_table type MINDIRECTION FIXED_SIZE SYSTEM magic_indirection type BINARY_FIND SHORT_LIVED PROCESSES binary_find type OPEN_PORT_ENV TEMPORARY SYSTEM open_port_env +type CRASH_DUMP STANDARD SYSTEM crash_dump +type DIST_TRANSCODE SHORT_LIVED SYSTEM dist_transcode_context type THR_Q_EL STANDARD SYSTEM thr_q_element type THR_Q_EL_SL FIXED_SIZE SYSTEM sl_thr_q_element diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 27bbf70c0b..9d05680723 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -3830,10 +3830,10 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) BIF_RET(res); } } - else if (ERTS_IS_ATOM_STR("term_to_binary_no_funs", tp[1])) { - Uint dflags = (DFLAG_EXTENDED_REFERENCES | - DFLAG_EXTENDED_PIDS_PORTS | - DFLAG_BIT_BINARIES); + else if (ERTS_IS_ATOM_STR("term_to_binary_tuple_fallbacks", tp[1])) { + Uint dflags = (TERM_TO_BINARY_DFLAGS + & ~DFLAG_EXPORT_PTR_TAG + & ~DFLAG_BIT_BINARIES); BIF_RET(erts_term_to_binary(BIF_P, tp[2], 0, dflags)); } else if (ERTS_IS_ATOM_STR("dist_ctrl", tp[1])) { diff --git a/erts/emulator/beam/erl_cpu_topology.c b/erts/emulator/beam/erl_cpu_topology.c index 49f9beb19f..6f8d2f8c35 100644 --- a/erts/emulator/beam/erl_cpu_topology.c +++ b/erts/emulator/beam/erl_cpu_topology.c @@ -602,7 +602,7 @@ write_schedulers_bind_change(erts_cpu_topology_t *cpudata, int size) cpu_bind_order_sort(cpudata, size, cpu_bind_order, 1); - for (cpu_ix = 0; cpu_ix < size && cpu_ix < erts_no_schedulers; cpu_ix++) + for (cpu_ix = 0; cpu_ix < size && s_ix <= erts_no_schedulers; cpu_ix++) if (erts_is_cpu_available(cpuinfo, cpudata[cpu_ix].logical)) scheduler2cpu_map[s_ix++].bind_id = cpudata[cpu_ix].logical; } diff --git a/erts/emulator/beam/erl_io_queue.c b/erts/emulator/beam/erl_io_queue.c index 190ba6bbb9..40d69ea6b0 100644 --- a/erts/emulator/beam/erl_io_queue.c +++ b/erts/emulator/beam/erl_io_queue.c @@ -658,7 +658,7 @@ io_list_vec_count(Eterm obj, Uint *v_size, int erts_ioq_iolist_vec_len(Eterm obj, int* vsize, Uint* csize, Uint* pvsize, Uint* pcsize, - Uint* total_size, Uint blimit) + size_t* total_size, Uint blimit) { DECLARE_ESTACK(s); Eterm* objp; @@ -669,7 +669,7 @@ erts_ioq_iolist_vec_len(Eterm obj, int* vsize, Uint* csize, Uint p_v_size = 0; Uint p_c_size = 0; Uint p_in_clist = 0; - Uint total; + size_t total; goto L_jump_start; /* avoid a push */ diff --git a/erts/emulator/beam/erl_io_queue.h b/erts/emulator/beam/erl_io_queue.h index 51abe99510..7d0fe6751c 100644 --- a/erts/emulator/beam/erl_io_queue.h +++ b/erts/emulator/beam/erl_io_queue.h @@ -103,7 +103,7 @@ Uint erts_ioq_sizeq(ErtsIOQueue *q); int erts_ioq_iolist_vec_len(Eterm obj, int* vsize, Uint* csize, Uint* pvsize, Uint* pcsize, - Uint* total_size, Uint blimit); + size_t* total_size, Uint blimit); int erts_ioq_iolist_to_vec(Eterm obj, SysIOVec* iov, ErtsIOQBinary** binv, ErtsIOQBinary* cbin, Uint bin_limit, int driver_binary); @@ -111,7 +111,7 @@ int erts_ioq_iolist_to_vec(Eterm obj, SysIOVec* iov, ERTS_GLB_INLINE int erts_ioq_iodata_vec_len(Eterm obj, int* vsize, Uint* csize, Uint* pvsize, Uint* pcsize, - Uint* total_size, Uint blimit); + size_t* total_size, Uint blimit); ERTS_GLB_INLINE int erts_ioq_iodata_to_vec(Eterm obj, SysIOVec* iov, ErtsIOQBinary** binv, ErtsIOQBinary* cbin, @@ -123,7 +123,7 @@ int erts_ioq_iodata_to_vec(Eterm obj, SysIOVec* iov, ERTS_GLB_INLINE int erts_ioq_iodata_vec_len(Eterm obj, int* vsize, Uint* csize, Uint* pvsize, Uint* pcsize, - Uint* total_size, Uint blimit) { + size_t* total_size, Uint blimit) { if (is_binary(obj)) { /* We optimize for when we get a procbin without a bit-offset * that fits in one iov slot diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h index 9c8cf84e43..a14f4f51d8 100644 --- a/erts/emulator/beam/erl_message.h +++ b/erts/emulator/beam/erl_message.h @@ -167,10 +167,9 @@ typedef struct { Sint len; /* queue length */ /* - * The following two fields are used by the recv_mark/1 and + * The following field is used by the recv_mark/1 and * recv_set/1 instructions. */ - BeamInstr* mark; /* address to rec_loop/2 instruction */ ErtsMessage** saved_last; /* saved last pointer */ } ErlMessageQueue; @@ -236,12 +235,17 @@ typedef struct erl_trace_message_queue__ { (p)->msg.len--; \ if (__mp == NULL) \ (p)->msg.last = (p)->msg.save; \ - (p)->msg.mark = 0; \ } while(0) -/* Reset message save point (after receive match) */ -#define JOIN_MESSAGE(p) \ - (p)->msg.save = &(p)->msg.first +/* + * Reset message save point (after receive match). + * Also invalidate the saved position since it may no + * longer be safe to use. + */ +#define JOIN_MESSAGE(p) do { \ + (p)->msg.save = &(p)->msg.first; \ + (p)->msg.saved_last = 0; \ +} while(0) /* Save current message */ #define SAVE_MESSAGE(p) \ diff --git a/erts/emulator/beam/erl_msacc.h b/erts/emulator/beam/erl_msacc.h index 2d4637f800..2588dec903 100644 --- a/erts/emulator/beam/erl_msacc.h +++ b/erts/emulator/beam/erl_msacc.h @@ -270,18 +270,32 @@ void erts_msacc_init_thread(char *type, int id, int liberty); #define ERTS_MSACC_PUSH_STATE_M() \ ERTS_MSACC_DECLARE_CACHE(); \ ERTS_MSACC_PUSH_STATE_CACHED_M() -#define ERTS_MSACC_PUSH_STATE_CACHED_M() \ - __erts_msacc_state = ERTS_MSACC_IS_ENABLED_CACHED() ? \ - erts_msacc_get_state_m__(__erts_msacc_cache) : ERTS_MSACC_STATE_OTHER +#define ERTS_MSACC_PUSH_STATE_CACHED_M() \ + do { \ + if (ERTS_MSACC_IS_ENABLED_CACHED()) { \ + ASSERT(!__erts_msacc_cache->unmanaged); \ + __erts_msacc_state = erts_msacc_get_state_m__(__erts_msacc_cache); \ + } else { \ + __erts_msacc_state = ERTS_MSACC_STATE_OTHER; \ + } \ + } while(0) #define ERTS_MSACC_SET_STATE_M(state) \ ERTS_MSACC_DECLARE_CACHE(); \ ERTS_MSACC_SET_STATE_CACHED_M(state) -#define ERTS_MSACC_SET_STATE_CACHED_M(state) \ - if (ERTS_MSACC_IS_ENABLED_CACHED()) \ - erts_msacc_set_state_m__(__erts_msacc_cache, state, 1) -#define ERTS_MSACC_POP_STATE_M() \ - if (ERTS_MSACC_IS_ENABLED_CACHED()) \ - erts_msacc_set_state_m__(__erts_msacc_cache, __erts_msacc_state, 0) +#define ERTS_MSACC_SET_STATE_CACHED_M(state) \ + do { \ + if (ERTS_MSACC_IS_ENABLED_CACHED()) { \ + ASSERT(!__erts_msacc_cache->unmanaged); \ + erts_msacc_set_state_m__(__erts_msacc_cache, state, 1); \ + } \ + } while(0) +#define ERTS_MSACC_POP_STATE_M() \ + do { \ + if (ERTS_MSACC_IS_ENABLED_CACHED()) { \ + ASSERT(!__erts_msacc_cache->unmanaged); \ + erts_msacc_set_state_m__(__erts_msacc_cache, __erts_msacc_state, 0); \ + } \ + } while(0) #define ERTS_MSACC_PUSH_AND_SET_STATE_M(state) \ ERTS_MSACC_PUSH_STATE_M(); ERTS_MSACC_SET_STATE_CACHED_M(state) diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index f7f12efe28..d1018bab26 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -1201,11 +1201,12 @@ size_t enif_binary_to_term(ErlNifEnv *dst_env, Sint size; ErtsHeapFactory factory; byte *bp = (byte*) data; + Uint32 flags = 0; - ERTS_CT_ASSERT(ERL_NIF_BIN2TERM_SAFE == ERTS_DIST_EXT_BTT_SAFE); - - if (opts & ~ERL_NIF_BIN2TERM_SAFE) { - return 0; + switch ((Uint32)opts) { + case 0: break; + case ERL_NIF_BIN2TERM_SAFE: flags = ERTS_DIST_EXT_BTT_SAFE; break; + default: return 0; } if ((size = erts_decode_ext_size(bp, data_sz)) < 0) return 0; @@ -1217,7 +1218,7 @@ size_t enif_binary_to_term(ErlNifEnv *dst_env, erts_factory_dummy_init(&factory); } - *term = erts_decode_ext(&factory, &bp, (Uint32)opts); + *term = erts_decode_ext(&factory, &bp, flags); if (is_non_value(*term)) { return 0; @@ -3323,36 +3324,38 @@ static int examine_iovec_term(Eterm list, UWord max_length, iovec_slice_t *resul size = binary_size(binary); binary_header = binary_val(binary); - /* If we're a sub-binary we'll need to check our underlying binary to - * determine whether we're on-heap or not. */ - if(thing_subtag(*binary_header) == SUB_BINARY_SUBTAG) { - ErlSubBin *sb = (ErlSubBin*)binary_header; + if (size > 0) { + /* If we're a sub-binary we'll need to check our underlying binary + * to determine whether we're on-heap or not. */ + if (thing_subtag(*binary_header) == SUB_BINARY_SUBTAG) { + ErlSubBin *sb = (ErlSubBin*)binary_header; - /* Reject bitstrings */ - if((sb->bitoffs + sb->bitsize) > 0) { - return 0; - } + /* Reject bitstrings */ + if((sb->bitoffs + sb->bitsize) > 0) { + return 0; + } - ASSERT(size <= binary_size(sb->orig)); - binary_header = binary_val(sb->orig); - } + ASSERT(size <= binary_size(sb->orig)); + binary_header = binary_val(sb->orig); + } - if(thing_subtag(*binary_header) == HEAP_BINARY_SUBTAG) { - ASSERT(size <= ERL_ONHEAP_BIN_LIMIT); + if (thing_subtag(*binary_header) == HEAP_BINARY_SUBTAG) { + ASSERT(size <= ERL_ONHEAP_BIN_LIMIT); - result->iovec_len += 1; - result->onheap_size += size; - } else { - ASSERT(thing_subtag(*binary_header) == REFC_BINARY_SUBTAG); + result->iovec_len += 1; + result->onheap_size += size; + } else { + ASSERT(thing_subtag(*binary_header) == REFC_BINARY_SUBTAG); - result->iovec_len += 1 + size / MAX_SYSIOVEC_IOVLEN; - result->offheap_size += size; + result->iovec_len += 1 + size / MAX_SYSIOVEC_IOVLEN; + result->offheap_size += size; + } } result->sublist_length += 1; lookahead = CDR(cell); - if(result->sublist_length >= max_length) { + if (result->sublist_length >= max_length) { break; } } @@ -3385,6 +3388,10 @@ static void inspect_raw_binary_data(Eterm binary, ErlNifBinary *result) { if (thing_subtag(*parent_header) == REFC_BINARY_SUBTAG) { ProcBin *pb = (ProcBin*)parent_header; + if (pb->flags & (PB_IS_WRITABLE | PB_ACTIVE_WRITER)) { + erts_emasculate_writable_binary(pb); + } + ASSERT(pb->val != NULL); ASSERT(byte_offset < pb->size); ASSERT(&pb->bytes[byte_offset] >= (byte*)(pb->val)->orig_bytes); @@ -3428,7 +3435,7 @@ static int fill_iovec_with_slice(ErlNifEnv *env, /* If this isn't a refc binary, copy its contents to the onheap buffer * and reference that instead. */ - if (raw_data.ref_bin == NULL) { + if (raw_data.size > 0 && raw_data.ref_bin == NULL) { ASSERT(onheap_offset < onheap_data.size); ASSERT(slice->onheap_size > 0); @@ -3439,12 +3446,11 @@ static int fill_iovec_with_slice(ErlNifEnv *env, raw_data.ref_bin = onheap_data.ref_bin; } - ASSERT(raw_data.ref_bin != NULL); - while (raw_data.size > 0) { UWord chunk_len = MIN(raw_data.size, MAX_SYSIOVEC_IOVLEN); ASSERT(iovec_idx < iovec->iovcnt); + ASSERT(raw_data.ref_bin != NULL); iovec->iov[iovec_idx].iov_base = raw_data.data; iovec->iov[iovec_idx].iov_len = chunk_len; diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c index 0f3dfa797c..eaf133f5c0 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -39,9 +39,11 @@ erts_rwmtx_t erts_node_table_rwmtx; DistEntry *erts_hidden_dist_entries; DistEntry *erts_visible_dist_entries; +DistEntry *erts_pending_dist_entries; DistEntry *erts_not_connected_dist_entries; /* including erts_this_dist_entry */ Sint erts_no_of_hidden_dist_entries; Sint erts_no_of_visible_dist_entries; +Sint erts_no_of_pending_dist_entries; Sint erts_no_of_not_connected_dist_entries; /* including erts_this_dist_entry */ DistEntry *erts_this_dist_entry; @@ -101,7 +103,9 @@ void erts_ref_dist_entry(DistEntry *dep) { ASSERT(dep); - de_refc_inc(dep, 1); + if (de_refc_inc_read(dep, 1) == 1) { + de_refc_inc(dep, 2); /* Pending delete */ + } } void @@ -139,9 +143,7 @@ dist_table_cmp(void *dep1, void *dep2) static void* dist_table_alloc(void *dep_tmpl) { -#ifdef DEBUG erts_aint_t refc; -#endif Eterm sysname; Binary *bin; DistEntry *dep; @@ -158,13 +160,8 @@ dist_table_alloc(void *dep_tmpl) dist_entries++; -#ifdef DEBUG - refc = -#else - (void) -#endif - de_refc_dec_read(dep, -1); - ASSERT(refc == -1); + refc = de_refc_dec_read(dep, -1); + ASSERT(refc == -1); (void)refc; dep->prev = NULL; erts_rwmtx_init_opt(&dep->rwmtx, &rwmtx_opt, "dist_entry", sysname, @@ -202,6 +199,7 @@ dist_table_alloc(void *dep_tmpl) erts_port_task_handle_init(&dep->dist_cmd); dep->send = NULL; dep->cache = NULL; + dep->transcode_ctx = NULL; /* Link in */ @@ -224,6 +222,8 @@ dist_table_free(void *vdep) { DistEntry *dep = (DistEntry *) vdep; + ASSERT(de_refc_read(dep, -1) == -1); + ASSERT(dep->status == 0); ASSERT(is_nil(dep->cid)); ASSERT(dep->nlinks == NULL); ASSERT(dep->node_links == NULL); @@ -384,56 +384,92 @@ erts_dhandle_to_dist_entry(Eterm dhandle) } Eterm -erts_make_dhandle(Process *c_p, DistEntry *dep) +erts_build_dhandle(Eterm **hpp, ErlOffHeap* ohp, DistEntry *dep) { - Binary *bin; - Eterm *hp; - - bin = ErtsDistEntry2Bin(dep); + Binary *bin = ErtsDistEntry2Bin(dep); ASSERT(bin); ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == erts_dist_entry_destructor); - hp = HAlloc(c_p, ERTS_MAGIC_REF_THING_SIZE); - return erts_mk_magic_ref(&hp, &c_p->off_heap, bin); + return erts_mk_magic_ref(hpp, ohp, bin); +} + +Eterm +erts_make_dhandle(Process *c_p, DistEntry *dep) +{ + Eterm *hp = HAlloc(c_p, ERTS_MAGIC_REF_THING_SIZE); + return erts_build_dhandle(&hp, &c_p->off_heap, dep); } -static void try_delete_dist_entry(void *vbin); +static void start_timer_delete_dist_entry(void *vdep); +static void prepare_try_delete_dist_entry(void *vdep); +static void try_delete_dist_entry(DistEntry*); + +static void schedule_delete_dist_entry(DistEntry* dep) +{ + /* + * Here we need thread progress to wait for other threads, that may have + * done lookup without refc++, to do either refc++ or drop their refs. + * + * Note that timeouts do not guarantee thread progress. + */ + erts_schedule_thr_prgr_later_op(start_timer_delete_dist_entry, + dep, &dep->later_op); +} static void -prepare_try_delete_dist_entry(void *vbin) +start_timer_delete_dist_entry(void *vdep) { - Binary *bin = (Binary *) vbin; - DistEntry *dep = ErtsBin2DistEntry(bin); - Uint size; + if (node_tab_delete_delay == 0) { + prepare_try_delete_dist_entry(vdep); + } + else { + ASSERT(node_tab_delete_delay > 0); + erts_start_timer_callback(node_tab_delete_delay, + prepare_try_delete_dist_entry, + vdep); + } +} + +static void +prepare_try_delete_dist_entry(void *vdep) +{ + DistEntry *dep = vdep; erts_aint_t refc; + /* + * Time has passed since we decremented refc to zero and DistEntry may + * have been revived. Do a fast check without table lock first. + */ refc = de_refc_read(dep, 0); - if (refc > 0) - return; - - size = ERTS_MAGIC_BIN_SIZE(sizeof(DistEntry)); - erts_schedule_thr_prgr_later_cleanup_op(try_delete_dist_entry, - vbin, &dep->later_op, size); + if (refc == 0) { + try_delete_dist_entry(dep); + } + else { + /* + * Someone has done lookup and done refc++ for us. + */ + refc = de_refc_dec_read(dep, 0); + if (refc == 0) + schedule_delete_dist_entry(dep); + } } -static void try_delete_dist_entry(void *vbin) +static void try_delete_dist_entry(DistEntry* dep) { - Binary *bin = (Binary *) vbin; - DistEntry *dep = ErtsBin2DistEntry(bin); erts_aint_t refc; erts_rwmtx_rwlock(&erts_dist_table_rwmtx); /* * Another thread might have looked up this dist entry after * we decided to delete it (refc became zero). If so, the other - * thread incremented refc twice. Once for the new reference - * and once for this thread. + * thread incremented refc one extra step for this thread. * - * If refc reach -1, no one has used the entry since we - * set up the timer. Delete the entry. + * If refc reach -1, no one has done lookup and no one can do lookup + * as we have table lock. Delete the entry. * - * If refc reach 0, the entry is currently not in use - * but has been used since we set up the timer. Set up a - * new timer. + * If refc reach 0, someone raced us and either + * (1) did lookup with own refc++ and already released it again + * (2) did lookup without own refc++ + * Schedule new delete operation. * * If refc > 0, the entry is in use. Keep the entry. */ @@ -443,12 +479,7 @@ static void try_delete_dist_entry(void *vbin) erts_rwmtx_rwunlock(&erts_dist_table_rwmtx); if (refc == 0) { - if (node_tab_delete_delay == 0) - prepare_try_delete_dist_entry(vbin); - else if (node_tab_delete_delay > 0) - erts_start_timer_callback(node_tab_delete_delay, - prepare_try_delete_dist_entry, - vbin); + schedule_delete_dist_entry(dep); } } @@ -462,12 +493,7 @@ int erts_dist_entry_destructor(Binary *bin) if (refc == -1) return 1; /* Allow deallocation of structure... */ - if (node_tab_delete_delay == 0) - prepare_try_delete_dist_entry((void *) bin); - else if (node_tab_delete_delay > 0) - erts_start_timer_callback(node_tab_delete_delay, - prepare_try_delete_dist_entry, - (void *) bin); + schedule_delete_dist_entry(dep); return 0; } @@ -498,12 +524,17 @@ erts_dist_table_size(void) i++; ASSERT(i == erts_no_of_hidden_dist_entries); i = 0; + for(dep = erts_pending_dist_entries; dep; dep = dep->next) + i++; + ASSERT(i == erts_no_of_pending_dist_entries); + i = 0; for(dep = erts_not_connected_dist_entries; dep; dep = dep->next) i++; ASSERT(i == erts_no_of_not_connected_dist_entries); ASSERT(dist_entries == (erts_no_of_visible_dist_entries + erts_no_of_hidden_dist_entries + + erts_no_of_pending_dist_entries + erts_no_of_not_connected_dist_entries)); #endif @@ -518,43 +549,46 @@ erts_dist_table_size(void) void erts_set_dist_entry_not_connected(DistEntry *dep) { + DistEntry** head; + ERTS_LC_ASSERT(erts_lc_is_de_rwlocked(dep)); erts_rwmtx_rwlock(&erts_dist_table_rwmtx); ASSERT(dep != erts_this_dist_entry); - ASSERT(is_internal_port(dep->cid) || is_internal_pid(dep->cid)); - - if(dep->flags & DFLAG_PUBLISHED) { - if(dep->prev) { - ASSERT(is_in_de_list(dep, erts_visible_dist_entries)); - dep->prev->next = dep->next; - } - else { - ASSERT(erts_visible_dist_entries == dep); - erts_visible_dist_entries = dep->next; - } - ASSERT(erts_no_of_visible_dist_entries > 0); - erts_no_of_visible_dist_entries--; + if (dep->status & ERTS_DE_SFLG_PENDING) { + ASSERT(is_nil(dep->cid)); + ASSERT(erts_no_of_pending_dist_entries > 0); + erts_no_of_pending_dist_entries--; + head = &erts_pending_dist_entries; } else { - if(dep->prev) { - ASSERT(is_in_de_list(dep, erts_hidden_dist_entries)); - dep->prev->next = dep->next; - } - else { - ASSERT(erts_hidden_dist_entries == dep); - erts_hidden_dist_entries = dep->next; - } - - ASSERT(erts_no_of_hidden_dist_entries > 0); - erts_no_of_hidden_dist_entries--; + ASSERT(dep->status != 0); + ASSERT(is_internal_port(dep->cid) || is_internal_pid(dep->cid)); + if (dep->flags & DFLAG_PUBLISHED) { + ASSERT(erts_no_of_visible_dist_entries > 0); + erts_no_of_visible_dist_entries--; + head = &erts_visible_dist_entries; + } + else { + ASSERT(erts_no_of_hidden_dist_entries > 0); + erts_no_of_hidden_dist_entries--; + head = &erts_hidden_dist_entries; + } } + if(dep->prev) { + ASSERT(is_in_de_list(dep, *head)); + dep->prev->next = dep->next; + } + else { + ASSERT(*head == dep); + *head = dep->next; + } if(dep->next) dep->next->prev = dep->prev; - dep->status &= ~ERTS_DE_SFLG_CONNECTED; + dep->status &= ~(ERTS_DE_SFLG_PENDING | ERTS_DE_SFLG_CONNECTED); dep->flags = 0; dep->prev = NULL; dep->cid = NIL; @@ -570,46 +604,87 @@ erts_set_dist_entry_not_connected(DistEntry *dep) } void +erts_set_dist_entry_pending(DistEntry *dep) +{ + ERTS_LC_ASSERT(erts_lc_is_de_rwlocked(dep)); + erts_rwmtx_rwlock(&erts_dist_table_rwmtx); + + ASSERT(dep != erts_this_dist_entry); + ASSERT(dep->status == 0); + ASSERT(is_nil(dep->cid)); + + if(dep->prev) { + ASSERT(is_in_de_list(dep, erts_not_connected_dist_entries)); + dep->prev->next = dep->next; + } + else { + ASSERT(dep == erts_not_connected_dist_entries); + erts_not_connected_dist_entries = dep->next; + } + + if(dep->next) + dep->next->prev = dep->prev; + + erts_no_of_not_connected_dist_entries--; + + dep->status = ERTS_DE_SFLG_PENDING; + dep->flags = (DFLAG_DIST_MANDATORY | DFLAG_DIST_HOPEFULLY); + dep->connection_id = (dep->connection_id + 1) & ERTS_DIST_CON_ID_MASK; + + dep->prev = NULL; + dep->next = erts_pending_dist_entries; + if(erts_pending_dist_entries) { + ASSERT(erts_pending_dist_entries->prev == NULL); + erts_pending_dist_entries->prev = dep; + } + erts_pending_dist_entries = dep; + erts_no_of_pending_dist_entries++; + erts_rwmtx_rwunlock(&erts_dist_table_rwmtx); +} + +void erts_set_dist_entry_connected(DistEntry *dep, Eterm cid, Uint flags) { + erts_aint32_t set_qflgs; + ERTS_LC_ASSERT(erts_lc_is_de_rwlocked(dep)); erts_rwmtx_rwlock(&erts_dist_table_rwmtx); ASSERT(dep != erts_this_dist_entry); ASSERT(is_nil(dep->cid)); + ASSERT(dep->status & ERTS_DE_SFLG_PENDING); ASSERT(is_internal_port(cid) || is_internal_pid(cid)); if(dep->prev) { - ASSERT(is_in_de_list(dep, erts_not_connected_dist_entries)); + ASSERT(is_in_de_list(dep, erts_pending_dist_entries)); dep->prev->next = dep->next; } else { - ASSERT(erts_not_connected_dist_entries == dep); - erts_not_connected_dist_entries = dep->next; + ASSERT(erts_pending_dist_entries == dep); + erts_pending_dist_entries = dep->next; } if(dep->next) dep->next->prev = dep->prev; - ASSERT(erts_no_of_not_connected_dist_entries > 0); - erts_no_of_not_connected_dist_entries--; + ASSERT(erts_no_of_pending_dist_entries > 0); + erts_no_of_pending_dist_entries--; + dep->status &= ~ERTS_DE_SFLG_PENDING; dep->status |= ERTS_DE_SFLG_CONNECTED; - dep->flags = flags; + dep->flags = flags & ~DFLAG_NO_MAGIC; dep->cid = cid; erts_atomic_set_nob(&dep->input_handler, (erts_aint_t) cid); - dep->connection_id++; - dep->connection_id &= ERTS_DIST_EXT_CON_ID_MASK; dep->prev = NULL; erts_atomic64_set_nob(&dep->in, 0); erts_atomic64_set_nob(&dep->out, 0); - erts_atomic32_set_nob(&dep->qflgs, - (is_internal_port(cid) - ? ERTS_DE_QFLG_PORT_CTRL - : ERTS_DE_QFLG_PROC_CTRL)); + set_qflgs = (is_internal_port(cid) ? + ERTS_DE_QFLG_PORT_CTRL : ERTS_DE_QFLG_PROC_CTRL); + erts_atomic32_read_bor_nob(&dep->qflgs, set_qflgs); + if(flags & DFLAG_PUBLISHED) { dep->next = erts_visible_dist_entries; if(erts_visible_dist_entries) { @@ -929,9 +1004,11 @@ void erts_init_node_tables(int dd_sec) erts_hidden_dist_entries = NULL; erts_visible_dist_entries = NULL; + erts_pending_dist_entries = NULL; erts_not_connected_dist_entries = NULL; erts_no_of_hidden_dist_entries = 0; erts_no_of_visible_dist_entries = 0; + erts_no_of_pending_dist_entries = 0; erts_no_of_not_connected_dist_entries = 0; node_tmpl.sysname = am_Noname; @@ -1057,6 +1134,7 @@ typedef struct { typedef struct dist_referrer_ { struct dist_referrer_ *next; int heap_ref; + int ets_ref; int node_ref; int ctrl_ref; int system_ref; @@ -1175,10 +1253,11 @@ insert_dist_referrer(ReferredDist *referred_dist, else { Uint *hp = &drp->id_heap[0]; ASSERT(is_tuple(id)); - drp->id = copy_struct(id, size_object(id), &hp, NULL); + drp->id = copy_struct(id, size_object(id), &hp, NULL); } drp->creation = creation; drp->heap_ref = 0; + drp->ets_ref = 0; drp->node_ref = 0; drp->ctrl_ref = 0; drp->system_ref = 0; @@ -1188,6 +1267,7 @@ insert_dist_referrer(ReferredDist *referred_dist, case NODE_REF: drp->node_ref++; break; case CTRL_REF: drp->ctrl_ref++; break; case HEAP_REF: drp->heap_ref++; break; + case ETS_REF: drp->ets_ref++; break; case SYSTEM_REF: drp->system_ref++; break; default: ASSERT(0); } @@ -1300,6 +1380,11 @@ insert_offheap2(ErlOffHeap *oh, void *arg) (((Bin)->intern.flags & BIN_FLAG_MAGIC) \ && ERTS_MAGIC_BIN_DESTRUCTOR((Bin)) == erts_dist_entry_destructor) +#define IsSendCtxBinary(Bin) \ + (((Bin)->intern.flags & BIN_FLAG_MAGIC) \ + && ERTS_MAGIC_BIN_DESTRUCTOR((Bin)) == erts_dsend_context_dtor) + + static void insert_offheap(ErlOffHeap *oh, int type, Eterm id) { @@ -1336,7 +1421,12 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id) inserted_bins = nib; UnUseTmpHeapNoproc(BIG_UINT_HEAP_SIZE); } - } + } + else if (IsSendCtxBinary(u.mref->mb)) { + ErtsSendContext* ctx = ERTS_MAGIC_BIN_DATA(u.mref->mb); + if (ctx->deref_dep) + insert_dist_entry(ctx->dep, type, id, 0); + } break; case REFC_BINARY_SUBTAG: case FUN_SUBTAG: @@ -1463,9 +1553,9 @@ insert_delayed_delete_node(void *state, } static void -insert_thr_prgr_delete_dist_entry(void *arg, ErtsThrPrgrVal thr_prgr, void *vbin) +insert_thr_prgr_delete_dist_entry(void *arg, ErtsThrPrgrVal thr_prgr, void *vdep) { - DistEntry *dep = ErtsBin2DistEntry(vbin); + DistEntry *dep = vdep; Eterm heap[3]; insert_dist_entry(dep, SYSTEM_REF, @@ -1476,9 +1566,9 @@ insert_thr_prgr_delete_dist_entry(void *arg, ErtsThrPrgrVal thr_prgr, void *vbin static void insert_delayed_delete_dist_entry(void *state, ErtsMonotonicTime timeout_pos, - void *vbin) + void *vdep) { - DistEntry *dep = ErtsBin2DistEntry(vbin); + DistEntry *dep = vdep; Eterm heap[3]; insert_dist_entry(dep, SYSTEM_REF, @@ -1520,7 +1610,7 @@ setup_reference_table(void) erts_debug_callback_timer_foreach(prepare_try_delete_dist_entry, insert_delayed_delete_dist_entry, NULL); - erts_debug_later_op_foreach(try_delete_dist_entry, + erts_debug_later_op_foreach(start_timer_delete_dist_entry, insert_thr_prgr_delete_dist_entry, NULL); @@ -1686,6 +1776,15 @@ setup_reference_table(void) insert_monitors(dep->monitors, dep->sysname); } + for(dep = erts_pending_dist_entries; dep; dep = dep->next) { + if(dep->nlinks) + insert_links2(dep->nlinks, dep->sysname); + if(dep->node_links) + insert_links(dep->node_links, dep->sysname); + if(dep->monitors) + insert_monitors(dep->monitors, dep->sysname); + } + /* Not connected dist entries should not have any links, but inspect them anyway */ for(dep = erts_not_connected_dist_entries; dep; dep = dep->next) { @@ -1855,6 +1954,10 @@ reference_table_term(Uint **hpp, ErlOffHeap *ohp, Uint *szp) tup = MK_2TUP(AM_heap, MK_UINT(drp->heap_ref)); drl = MK_CONS(tup, drl); } + if(drp->ets_ref) { + tup = MK_2TUP(AM_ets, MK_UINT(drp->ets_ref)); + drl = MK_CONS(tup, drl); + } if(drp->system_ref) { tup = MK_2TUP(AM_system, MK_UINT(drp->system_ref)); drl = MK_CONS(tup, drl); @@ -1871,12 +1974,17 @@ reference_table_term(Uint **hpp, ErlOffHeap *ohp, Uint *szp) else if (is_tuple(drp->id)) { Eterm *t; ASSERT(drp->system_ref && !drp->node_ref - && !drp->ctrl_ref && !drp->heap_ref); + && !drp->ctrl_ref && !drp->heap_ref && !drp->ets_ref); t = tuple_val(drp->id); ASSERT(2 == arityval(t[0])); tup = MK_2TUP(t[1], t[2]); } - else { + else if (drp->ets_ref) { + ASSERT(!drp->heap_ref && !drp->node_ref && + !drp->ctrl_ref && !drp->system_ref); + tup = MK_2TUP(AM_ets, drp->id); + } + else { ASSERT(!drp->ctrl_ref && drp->node_ref); ASSERT(is_atom(drp->id)); tup = MK_2TUP(drp->id, MK_UINT(drp->creation)); diff --git a/erts/emulator/beam/erl_node_tables.h b/erts/emulator/beam/erl_node_tables.h index 3bba673435..8d29c83e15 100644 --- a/erts/emulator/beam/erl_node_tables.h +++ b/erts/emulator/beam/erl_node_tables.h @@ -57,11 +57,9 @@ #define ERST_INTERNAL_CHANNEL_NO 0 -#define ERTS_DE_SFLG_CONNECTED (((Uint32) 1) << 0) -#define ERTS_DE_SFLG_EXITING (((Uint32) 1) << 1) - -#define ERTS_DE_SFLGS_ALL (ERTS_DE_SFLG_CONNECTED \ - | ERTS_DE_SFLG_EXITING) +#define ERTS_DE_SFLG_PENDING (((Uint32) 1) << 0) +#define ERTS_DE_SFLG_CONNECTED (((Uint32) 1) << 1) +#define ERTS_DE_SFLG_EXITING (((Uint32) 1) << 2) #define ERTS_DE_QFLG_BUSY (((erts_aint32_t) 1) << 0) #define ERTS_DE_QFLG_EXIT (((erts_aint32_t) 1) << 1) @@ -85,10 +83,12 @@ typedef struct ErtsDistOutputBuf_ ErtsDistOutputBuf; struct ErtsDistOutputBuf_ { #ifdef DEBUG Uint dbg_pattern; + byte *alloc_endp; #endif ErtsDistOutputBuf *next; byte *extp; byte *ext_endp; + byte *msg_start; byte data[1]; }; @@ -109,8 +109,6 @@ struct ErtsProcList_; * unlock mutexes with higher numbers before mutexes with higher numbers. */ -struct erl_link; - typedef struct dist_entry_ { HashBucket hash_bucket; /* Hash bucket */ struct dist_entry_ *next; /* Next entry in dist_table (not sorted) */ @@ -159,6 +157,8 @@ typedef struct dist_entry_ { struct cache* cache; /* The atom cache */ ErtsThrPrgrLaterOp later_op; + + struct transcode_context* transcode_ctx; } DistEntry; typedef struct erl_node_ { @@ -177,9 +177,11 @@ extern erts_rwmtx_t erts_node_table_rwmtx; extern DistEntry *erts_hidden_dist_entries; extern DistEntry *erts_visible_dist_entries; +extern DistEntry *erts_pending_dist_entries; extern DistEntry *erts_not_connected_dist_entries; extern Sint erts_no_of_hidden_dist_entries; extern Sint erts_no_of_visible_dist_entries; +extern Sint erts_no_of_pending_dist_entries; extern Sint erts_no_of_not_connected_dist_entries; extern DistEntry *erts_this_dist_entry; @@ -195,6 +197,7 @@ void erts_schedule_delete_dist_entry(DistEntry *); Uint erts_dist_table_size(void); void erts_dist_table_info(fmtfn_t, void *); void erts_set_dist_entry_not_connected(DistEntry *); +void erts_set_dist_entry_pending(DistEntry *); void erts_set_dist_entry_connected(DistEntry *, Eterm, Uint); ErlNode *erts_find_or_insert_node(Eterm, Uint32); void erts_schedule_delete_node(ErlNode *); @@ -210,6 +213,7 @@ int erts_lc_is_de_rlocked(DistEntry *); #endif int erts_dist_entry_destructor(Binary *bin); DistEntry *erts_dhandle_to_dist_entry(Eterm dhandle); +Eterm erts_build_dhandle(Eterm **hpp, ErlOffHeap*, DistEntry*); Eterm erts_make_dhandle(Process *c_p, DistEntry *dep); void erts_ref_dist_entry(DistEntry *dep); void erts_deref_dist_entry(DistEntry *dep); @@ -271,5 +275,6 @@ erts_de_links_unlock(DistEntry *dep) #endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ void erts_debug_test_node_tab_delayed_delete(Sint64 millisecs); +void erts_lcnt_update_distribution_locks(int enable); #endif diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 3d12b3bc21..a807d60ec7 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -3276,7 +3276,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) erts_aint32_t aux_work = 0; int thr_prgr_active = 1; erts_aint32_t flgs; - ERTS_MSACC_PUSH_STATE_M(); + ERTS_MSACC_PUSH_STATE(); ERTS_LC_ASSERT(erts_lc_runq_is_locked(rq)); @@ -3385,9 +3385,9 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) - 1) + 1; } else timeout = -1; - ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); + ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_SLEEP); res = erts_tse_twait(ssi->event, timeout); - ERTS_MSACC_POP_STATE_M(); + ERTS_MSACC_POP_STATE(); current_time = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0 : erts_get_monotonic_time(esdp); } while (res == EINTR); @@ -9701,7 +9701,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) | ERTS_PROC_LOCK_STATUS | ERTS_PROC_LOCK_TRACE)); - ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER); + ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_OTHER); if (state & ERTS_PSFLG_FREE) { if (!is_normal_sched) { @@ -9916,7 +9916,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) case 0: /* No process at all */ default: ASSERT(qmask == 0); - ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER); + ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_OTHER); goto check_activities_to_run; } @@ -10034,7 +10034,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) } - ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_EMULATOR); + ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_EMULATOR); if (flags & ERTS_RUNQ_FLG_PROTECTED) @@ -10824,7 +10824,7 @@ request_system_task(Process *c_p, Eterm requester, Eterm target, goto badarg; req_type = tp[1]; req_id = tp[2]; - req_id_sz = is_immed(req_id) ? req_id : size_object(req_id); + req_id_sz = is_immed(req_id) ? 0 : size_object(req_id); tot_sz = req_id_sz; for (i = 0; i < ERTS_MAX_PROC_SYS_TASK_ARGS; i++) { int tix = 3 + i; @@ -12659,9 +12659,11 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext) erts_de_links_unlock(dep); if (rmon) { ErtsDSigData dsd; - int code = erts_dsig_prepare(&dsd, dep, NULL, - ERTS_DSP_NO_LOCK, 0); - if (code == ERTS_DSIG_PREP_CONNECTED) { + int code = erts_dsig_prepare(&dsd, dep, NULL, 0, + ERTS_DSP_NO_LOCK, 0, 0); + if (code == ERTS_DSIG_PREP_CONNECTED || + code == ERTS_DSIG_PREP_PENDING) { + code = erts_dsig_send_demonitor(&dsd, rmon->u.pid, mon->name, @@ -12705,9 +12707,11 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext) erts_de_links_unlock(dep); if (rmon) { ErtsDSigData dsd; - int code = erts_dsig_prepare(&dsd, dep, NULL, - ERTS_DSP_NO_LOCK, 0); - if (code == ERTS_DSIG_PREP_CONNECTED) { + int code = erts_dsig_prepare(&dsd, dep, NULL, 0, + ERTS_DSP_NO_LOCK, 0, 0); + if (code == ERTS_DSIG_PREP_CONNECTED || + code == ERTS_DSIG_PREP_PENDING) { + code = erts_dsig_send_demonitor(&dsd, rmon->u.pid, mon->u.pid, @@ -12764,8 +12768,8 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext) erts_de_links_unlock(dep); if (rmon) { ErtsDSigData dsd; - int code = erts_dsig_prepare(&dsd, dep, NULL, - ERTS_DSP_NO_LOCK, 0); + int code = erts_dsig_prepare(&dsd, dep, NULL, 0, + ERTS_DSP_NO_LOCK, 0, 0); if (code == ERTS_DSIG_PREP_CONNECTED) { code = erts_dsig_send_m_exit(&dsd, mon->u.pid, @@ -12887,14 +12891,18 @@ static void doit_exit_link(ErtsLink *lnk, void *vpcontext) int code; ErtsDistLinkData dld; erts_remove_dist_link(&dld, p->common.id, item, dep); - erts_proc_lock(p, ERTS_PROC_LOCK_MAIN); - code = erts_dsig_prepare(&dsd, dep, p, ERTS_DSP_NO_LOCK, 0); - if (code == ERTS_DSIG_PREP_CONNECTED) { - code = erts_dsig_send_exit_tt(&dsd, p->common.id, item, - reason, SEQ_TRACE_TOKEN(p)); - ASSERT(code == ERTS_DSIG_SEND_OK); - } - erts_proc_unlock(p, ERTS_PROC_LOCK_MAIN); + if (dld.d_lnk) { + erts_proc_lock(p, ERTS_PROC_LOCK_MAIN); + code = erts_dsig_prepare(&dsd, dep, p, 0, ERTS_DSP_NO_LOCK, 0, 0); + if (code == ERTS_DSIG_PREP_CONNECTED || + code == ERTS_DSIG_PREP_PENDING) { + + code = erts_dsig_send_exit_tt(&dsd, p->common.id, item, + reason, SEQ_TRACE_TOKEN(p)); + ASSERT(code == ERTS_DSIG_SEND_OK); + } + erts_proc_unlock(p, ERTS_PROC_LOCK_MAIN); + } erts_destroy_dist_link(&dld); } } diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c index 5a2c262ff1..0b7f361622 100644 --- a/erts/emulator/beam/erl_process_dump.c +++ b/erts/emulator/beam/erl_process_dump.c @@ -32,6 +32,7 @@ #include "dist.h" #include "beam_catches.h" #include "erl_binary.h" +#include "erl_map.h" #define ERTS_WANT_EXTERNAL_TAGS #include "external.h" @@ -51,6 +52,11 @@ static void print_function_from_pc(fmtfn_t to, void *to_arg, BeamInstr* x); static void heap_dump(fmtfn_t to, void *to_arg, Eterm x); static void dump_binaries(fmtfn_t to, void *to_arg, Binary* root); static void dump_externally(fmtfn_t to, void *to_arg, Eterm term); +static void mark_literal(Eterm* ptr); +static void init_literal_areas(void); +static void dump_literals(fmtfn_t to, void *to_arg); +static void dump_module_literals(fmtfn_t to, void *to_arg, + ErtsLiteralArea* lit_area); static Binary* all_binaries; @@ -58,14 +64,14 @@ extern BeamInstr beam_apply[]; extern BeamInstr beam_exit[]; extern BeamInstr beam_continue_exit[]; - void erts_deep_process_dump(fmtfn_t to, void *to_arg) { int i, max = erts_ptab_max(&erts_proc); all_binaries = NULL; - + init_literal_areas(); + for (i = 0; i < max; i++) { Process *p = erts_pix2proc(i); if (p && p->i != ENULL) { @@ -75,6 +81,7 @@ erts_deep_process_dump(fmtfn_t to, void *to_arg) } } + dump_literals(to, to_arg); dump_binaries(to, to_arg, all_binaries); } @@ -373,7 +380,9 @@ heap_dump(fmtfn_t to, void *to_arg, Eterm x) next = (Eterm *) x; } else if (is_list(x)) { ptr = list_val(x); - if (ptr[0] != OUR_NIL) { + if (erts_is_literal(x, ptr)) { + mark_literal(ptr); + } else if (ptr[0] != OUR_NIL) { erts_print(to, to_arg, PTR_FMT ":l", ptr); dump_element(to, to_arg, ptr[0]); erts_putc(to, to_arg, '|'); @@ -392,7 +401,9 @@ heap_dump(fmtfn_t to, void *to_arg, Eterm x) ptr = boxed_val(x); hdr = *ptr; - if (hdr != OUR_NIL) { /* If not visited */ + if (erts_is_literal(x, ptr)) { + mark_literal(ptr); + } else if (hdr != OUR_NIL) { erts_print(to, to_arg, PTR_FMT ":", ptr); if (is_arity_value(hdr)) { Uint i; @@ -498,11 +509,77 @@ heap_dump(fmtfn_t to, void *to_arg, Eterm x) erts_print(to, to_arg, "p<%beu.%beu>\n", port_channel_no(x), port_number(x)); *ptr = OUR_NIL; + } else if (is_map_header(hdr)) { + if (is_flatmap_header(hdr)) { + flatmap_t* fmp = (flatmap_t *) flatmap_val(x); + Eterm* values = ptr + sizeof(flatmap_t) / sizeof(Eterm); + Uint map_size = fmp->size; + int i; + + erts_print(to, to_arg, "Mf" ETERM_FMT ":", map_size); + dump_element(to, to_arg, fmp->keys); + erts_putc(to, to_arg, ':'); + for (i = 0; i < map_size; i++) { + dump_element(to, to_arg, values[i]); + if (is_immed(values[i])) { + values[i] = make_small(0); + } + if (i < map_size-1) { + erts_putc(to, to_arg, ','); + } + } + erts_putc(to, to_arg, '\n'); + *ptr = OUR_NIL; + x = fmp->keys; + if (map_size) { + fmp->keys = (Eterm) next; + next = &values[map_size-1]; + } + continue; + } else { + Uint i; + Uint sz = 0; + Eterm* nodes = ptr + 1; + + switch (MAP_HEADER_TYPE(hdr)) { + case MAP_HEADER_TAG_HAMT_HEAD_ARRAY: + nodes++; + sz = 16; + erts_print(to, to_arg, "Mh" ETERM_FMT ":" ETERM_FMT ":", + hashmap_size(x), sz); + break; + case MAP_HEADER_TAG_HAMT_HEAD_BITMAP: + nodes++; + sz = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + erts_print(to, to_arg, "Mh" ETERM_FMT ":" ETERM_FMT ":", + hashmap_size(x), sz); + break; + case MAP_HEADER_TAG_HAMT_NODE_BITMAP: + sz = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + erts_print(to, to_arg, "Mn" ETERM_FMT ":", sz); + break; + } + *ptr = OUR_NIL; + for (i = 0; i < sz; i++) { + dump_element(to, to_arg, nodes[i]); + if (is_immed(nodes[i])) { + nodes[i] = make_small(0); + } + if (i < sz-1) { + erts_putc(to, to_arg, ','); + } + } + erts_putc(to, to_arg, '\n'); + x = nodes[0]; + nodes[0] = (Eterm) next; + next = &nodes[sz-1]; + continue; + } } else { /* * All other we dump in the external term format. */ - dump_externally(to, to_arg, x); + dump_externally(to, to_arg, x); erts_putc(to, to_arg, '\n'); *ptr = OUR_NIL; } @@ -564,11 +641,6 @@ dump_externally(fmtfn_t to, void *to_arg, Eterm term) } } - /* Do not handle maps */ - if (is_map(term)) { - term = am_undefined; - } - s = p = sbuf; erts_encode_ext(term, &p); erts_print(to, to_arg, "E%X:", p-s); @@ -577,6 +649,284 @@ dump_externally(fmtfn_t to, void *to_arg, Eterm term) } } +/* + * Handle dumping of literal areas. + */ + +static ErtsLiteralArea** lit_areas; +static Uint num_lit_areas; + +static int compare_areas(const void * a, const void * b) +{ + ErtsLiteralArea** a_p = (ErtsLiteralArea **) a; + ErtsLiteralArea** b_p = (ErtsLiteralArea **) b; + + if (*a_p < *b_p) { + return -1; + } else if (*b_p < *a_p) { + return 1; + } else { + return 0; + } +} + + +static void +init_literal_areas(void) +{ + int i; + Module* modp; + ErtsCodeIndex code_ix; + ErtsLiteralArea** area_p; + + code_ix = erts_active_code_ix(); + erts_rlock_old_code(code_ix); + + lit_areas = area_p = erts_dump_lit_areas; + num_lit_areas = 0; + for (i = 0; i < module_code_size(code_ix); i++) { + modp = module_code(i, code_ix); + if (modp == NULL) { + continue; + } + if (modp->curr.code_length > 0 && + modp->curr.code_hdr->literal_area) { + *area_p++ = modp->curr.code_hdr->literal_area; + } + if (modp->old.code_length > 0 && modp->old.code_hdr->literal_area) { + *area_p++ = modp->old.code_hdr->literal_area; + } + } + + num_lit_areas = area_p - lit_areas; + ASSERT(num_lit_areas <= erts_dump_num_lit_areas); + for (i = 0; i < num_lit_areas; i++) { + lit_areas[i]->off_heap = 0; + } + + qsort(lit_areas, num_lit_areas, sizeof(ErtsLiteralArea *), + compare_areas); + + erts_runlock_old_code(code_ix); +} + +static int search_areas(const void * a, const void * b) { + Eterm* key = (Eterm *) a; + ErtsLiteralArea** b_p = (ErtsLiteralArea **) b; + if (key < b_p[0]->start) { + return -1; + } else if (b_p[0]->end <= key) { + return 1; + } else { + return 0; + } +} + +static void mark_literal(Eterm* ptr) +{ + ErtsLiteralArea** ap; + + ap = bsearch(ptr, lit_areas, num_lit_areas, sizeof(ErtsLiteralArea*), + search_areas); + + /* + * If the literal was created by native code, this search will not + * find it and ap will be NULL. + */ + + if (ap) { + ap[0]->off_heap = (struct erl_off_heap_header *) 1; + } +} + + +static void +dump_literals(fmtfn_t to, void *to_arg) +{ + ErtsCodeIndex code_ix; + int i; + + code_ix = erts_active_code_ix(); + erts_rlock_old_code(code_ix); + + erts_print(to, to_arg, "=literals\n"); + for (i = 0; i < num_lit_areas; i++) { + if (lit_areas[i]->off_heap) { + dump_module_literals(to, to_arg, lit_areas[i]); + } + } + + erts_runlock_old_code(code_ix); +} + +static void +dump_module_literals(fmtfn_t to, void *to_arg, ErtsLiteralArea* lit_area) +{ + Eterm* htop; + Eterm* hend; + + htop = lit_area->start; + hend = lit_area->end; + while (htop < hend) { + Eterm w = *htop; + Eterm term; + Uint size; + + switch (primary_tag(w)) { + case TAG_PRIMARY_HEADER: + term = make_boxed(htop); + erts_print(to, to_arg, PTR_FMT ":", htop); + if (is_arity_value(w)) { + Uint i; + Uint arity = arityval(w); + + erts_print(to, to_arg, "t" ETERM_FMT ":", arity); + for (i = 1; i <= arity; i++) { + dump_element(to, to_arg, htop[i]); + if (i < arity) { + erts_putc(to, to_arg, ','); + } + } + erts_putc(to, to_arg, '\n'); + } else if (w == HEADER_FLONUM) { + FloatDef f; + char sbuf[31]; + int i; + + GET_DOUBLE_DATA((htop+1), f); + i = sys_double_to_chars(f.fd, sbuf, sizeof(sbuf)); + sys_memset(sbuf+i, 0, 31-i); + erts_print(to, to_arg, "F%X:%s\n", i, sbuf); + } else if (_is_bignum_header(w)) { + erts_print(to, to_arg, "B%T\n", term); + } else if (is_binary_header(w)) { + Uint tag = thing_subtag(w); + Uint size = binary_size(term); + Uint i; + + if (tag == HEAP_BINARY_SUBTAG) { + byte* p; + + erts_print(to, to_arg, "Yh%X:", size); + p = binary_bytes(term); + for (i = 0; i < size; i++) { + erts_print(to, to_arg, "%02X", p[i]); + } + } else if (tag == REFC_BINARY_SUBTAG) { + ProcBin* pb = (ProcBin *) binary_val(term); + Binary* val = pb->val; + + if (erts_atomic_xchg_nob(&val->intern.refc, 0) != 0) { + val->intern.flags = (UWord) all_binaries; + all_binaries = val; + } + erts_print(to, to_arg, + "Yc" PTR_FMT ":" PTR_FMT ":" PTR_FMT, + val, + pb->bytes - (byte *)val->orig_bytes, + size); + } else if (tag == SUB_BINARY_SUBTAG) { + ErlSubBin* Sb = (ErlSubBin *) binary_val(term); + Eterm* real_bin; + void* val; + + real_bin = boxed_val(Sb->orig); + if (thing_subtag(*real_bin) == REFC_BINARY_SUBTAG) { + /* + * Unvisited REFC_BINARY: Point directly to + * the binary. + */ + ProcBin* pb = (ProcBin *) real_bin; + val = pb->val; + } else { + /* + * Heap binary or visited REFC binary: Point + * to heap binary or ProcBin on the heap. + */ + val = real_bin; + } + erts_print(to, to_arg, + "Ys" PTR_FMT ":" PTR_FMT ":" PTR_FMT, + val, Sb->offs, size); + } + erts_putc(to, to_arg, '\n'); + } else if (is_map_header(w)) { + if (is_flatmap_header(w)) { + flatmap_t* fmp = (flatmap_t *) flatmap_val(term); + Eterm* values = htop + sizeof(flatmap_t) / sizeof(Eterm); + Uint map_size = fmp->size; + int i; + + erts_print(to, to_arg, "Mf" ETERM_FMT ":", map_size); + dump_element(to, to_arg, fmp->keys); + erts_putc(to, to_arg, ':'); + for (i = 0; i < map_size; i++) { + dump_element(to, to_arg, values[i]); + if (i < map_size-1) { + erts_putc(to, to_arg, ','); + } + } + erts_putc(to, to_arg, '\n'); + } else { + Uint i; + Uint sz = 0; + Eterm* nodes = htop + 1; + + switch (MAP_HEADER_TYPE(w)) { + case MAP_HEADER_TAG_HAMT_HEAD_ARRAY: + nodes++; + sz = 16; + erts_print(to, to_arg, "Mh" ETERM_FMT ":" ETERM_FMT ":", + hashmap_size(term), sz); + break; + case MAP_HEADER_TAG_HAMT_HEAD_BITMAP: + nodes++; + sz = hashmap_bitcount(MAP_HEADER_VAL(w)); + erts_print(to, to_arg, "Mh" ETERM_FMT ":" ETERM_FMT ":", + hashmap_size(term), sz); + break; + case MAP_HEADER_TAG_HAMT_NODE_BITMAP: + sz = hashmap_bitcount(MAP_HEADER_VAL(w)); + erts_print(to, to_arg, "Mn" ETERM_FMT ":", sz); + break; + } + for (i = 0; i < sz; i++) { + dump_element(to, to_arg, nodes[i]); + if (i < sz-1) { + erts_putc(to, to_arg, ','); + } + } + erts_putc(to, to_arg, '\n'); + } + } + size = 1 + header_arity(w); + switch (w & _HEADER_SUBTAG_MASK) { + case MAP_SUBTAG: + if (is_flatmap_header(w)) { + size += 1 + flatmap_get_size(htop); + } else { + size += hashmap_bitcount(MAP_HEADER_VAL(w)); + } + break; + case SUB_BINARY_SUBTAG: + size += 1; + break; + } + break; + default: + ASSERT(!is_header(htop[1])); + erts_print(to, to_arg, PTR_FMT ":l", htop); + dump_element(to, to_arg, htop[0]); + erts_putc(to, to_arg, '|'); + dump_element(to, to_arg, htop[1]); + erts_putc(to, to_arg, '\n'); + size = 2; + break; + } + htop += size; + } +} + void erts_dump_process_state(fmtfn_t to, void *to_arg, erts_aint32_t psflg) { char *s; diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index 6daf043117..7d42d1b396 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -55,9 +55,6 @@ struct erl_node_; /* Declared in erl_node_tables.h */ #if defined(ARCH_64) # define TAG_PTR_MASK__ 0x7 # if !defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION) -# ifdef HIPE -# error Hipe on 64-bit needs a real mmap as it does not support the literal tag -# endif # define TAG_LITERAL_PTR 0x4 # else # undef TAG_LITERAL_PTR @@ -862,7 +859,7 @@ do { \ ((ErtsMRefThing *) (Hp))->mb = (Binp); \ ((ErtsMRefThing *) (Hp))->next = (Ohp)->first; \ (Ohp)->first = (struct erl_off_heap_header*) (Hp); \ - ASSERT(erts_is_ref_numbers_magic(&(Binp)->refn)); \ + ASSERT(erts_is_ref_numbers_magic((Binp)->refn)); \ } while (0) #endif /* ARCH_32 */ diff --git a/erts/emulator/beam/erl_thr_progress.h b/erts/emulator/beam/erl_thr_progress.h index fa936b5707..8c029bcf99 100644 --- a/erts/emulator/beam/erl_thr_progress.h +++ b/erts/emulator/beam/erl_thr_progress.h @@ -28,7 +28,7 @@ * Author: Rickard Green */ -#if !defined(ERL_THR_PROGRESS_H__TSD_TYPE__) +#ifndef ERL_THR_PROGRESS_H__TSD_TYPE__ #define ERL_THR_PROGRESS_H__TSD_TYPE__ #include "sys.h" diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 970158933f..f2e6399ad7 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -122,8 +122,9 @@ static int encode_size_struct_int(struct TTBSizeContext_*, ErtsAtomCacheMap *acm static Export binary_to_term_trap_export; static BIF_RETTYPE binary_to_term_trap_1(BIF_ALIST_1); -static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* context_b, - Export *bif, Eterm arg0, Eterm arg1); +static Sint transcode_dist_obuf(ErtsDistOutputBuf*, DistEntry*, Uint32 dflags, Sint reds); + + void erts_init_external(void) { erts_init_trap_export(&term_to_binary_trap_export, @@ -222,23 +223,10 @@ erts_destroy_atom_cache_map(ErtsAtomCacheMap *acmp) static ERTS_INLINE void insert_acache_map(ErtsAtomCacheMap *acmp, Eterm atom, Uint32 dflags) { - /* - * If the receiver do not understand utf8 atoms - * and this atom cannot be represented in latin1, - * we are not allowed to cache it. - * - * In this case all atoms are assumed to have - * latin1 encoding in the cache. By refusing it - * in the cache we will instead encode it using - * ATOM_UTF8_EXT/SMALL_ATOM_UTF8_EXT which the - * receiver do not recognize and tear down the - * connection. - */ - if (acmp && acmp->sz < ERTS_MAX_INTERNAL_ATOM_CACHE_ENTRIES - && ((dflags & DFLAG_UTF8_ATOMS) - || atom_tab(atom_val(atom))->latin1_chars >= 0)) { + if (acmp && acmp->sz < ERTS_MAX_INTERNAL_ATOM_CACHE_ENTRIES) { int ix; ASSERT(acmp->hdr_sz < 0); + ASSERT(dflags & DFLAG_UTF8_ATOMS); ix = atom2cix(atom); if (acmp->cache[ix].iix < 0) { acmp->cache[ix].iix = acmp->sz; @@ -258,9 +246,7 @@ get_iix_acache_map(ErtsAtomCacheMap *acmp, Eterm atom, Uint32 dflags) ASSERT(is_atom(atom)); ix = atom2cix(atom); if (acmp->cache[ix].iix < 0) { - ASSERT(acmp->sz == ERTS_MAX_INTERNAL_ATOM_CACHE_ENTRIES - || (!(dflags & DFLAG_UTF8_ATOMS) - && atom_tab(atom_val(atom))->latin1_chars < 0)); + ASSERT(acmp->sz == ERTS_MAX_INTERNAL_ATOM_CACHE_ENTRIES); return -1; } else { @@ -274,7 +260,6 @@ void erts_finalize_atom_cache_map(ErtsAtomCacheMap *acmp, Uint32 dflags) { if (acmp) { - int utf8_atoms = (int) (dflags & DFLAG_UTF8_ATOMS); int long_atoms = 0; /* !0 if one or more atoms are longer than 255. */ int i; int sz; @@ -285,6 +270,7 @@ erts_finalize_atom_cache_map(ErtsAtomCacheMap *acmp, Uint32 dflags) + 1 /* number of internal cache entries */ ; int min_sz; + ASSERT(dflags & DFLAG_UTF8_ATOMS); ASSERT(acmp->hdr_sz < 0); /* Make sure cache update instructions fit */ min_sz = fix_sz+(2+4)*acmp->sz; @@ -296,7 +282,7 @@ erts_finalize_atom_cache_map(ErtsAtomCacheMap *acmp, Uint32 dflags) atom = acmp->cache[acmp->cix[i]].atom; ASSERT(is_atom(atom)); a = atom_tab(atom_val(atom)); - len = (int) (utf8_atoms ? a->len : a->latin1_chars); + len = (int) a->len; ASSERT(len >= 0); if (!long_atoms && len > 255) long_atoms = 1; @@ -366,18 +352,62 @@ byte *erts_encode_ext_dist_header_setup(byte *ctl_ext, ErtsAtomCacheMap *acmp) } } -byte *erts_encode_ext_dist_header_finalize(byte *ext, ErtsAtomCache *cache, Uint32 dflags) + +#define PASS_THROUGH 'p' + +Sint erts_encode_ext_dist_header_finalize(ErtsDistOutputBuf* ob, + DistEntry* dep, + Uint32 dflags, + Sint reds) { byte *ip; byte instr_buf[(2+4)*ERTS_ATOM_CACHE_SIZE]; int ci, sz; byte dist_hdr_flags; int long_atoms; - int utf8_atoms = (int) (dflags & DFLAG_UTF8_ATOMS); - register byte *ep = ext; - ASSERT(ep[0] == VERSION_MAGIC); - if (ep[1] != DIST_HEADER) - return ext; + register byte *ep = ob->extp; + ASSERT(dflags & DFLAG_UTF8_ATOMS); + + /* + * The buffer can have different layouts at this point depending on + * what was known when encoded: + * + * Pending connection: CtrlTerm [, MsgTerm] + * With atom cache : VERSION_MAGIC, DIST_HEADER, ..., CtrlTerm [, MsgTerm] + * No atom cache : VERSION_MAGIC, CtrlTerm [, VERSION_MAGIC, MsgTerm] + */ + + if (ep[0] != VERSION_MAGIC || dep->transcode_ctx) { + /* + * Was encoded without atom cache toward pending connection. + */ + ASSERT(ep[0] == SMALL_TUPLE_EXT || ep[0] == LARGE_TUPLE_EXT); + + if (~dflags & (DFLAG_BIT_BINARIES | DFLAG_EXPORT_PTR_TAG + | DFLAG_DIST_HDR_ATOM_CACHE)) { + reds = transcode_dist_obuf(ob, dep, dflags, reds); + if (reds < 0) + return reds; + ep = ob->extp; + } + if (dflags & DFLAG_DIST_HDR_ATOM_CACHE) { + /* + * Encoding was done without atom caching but receiver expects + * a dist header, so we prepend an empty one. + */ + *--ep = 0; /* NumberOfAtomCacheRefs */ + *--ep = DIST_HEADER; + *--ep = VERSION_MAGIC; + } + goto done; + } + else if (ep[1] != DIST_HEADER) { + ASSERT(ep[1] == SMALL_TUPLE_EXT || ep[1] == LARGE_TUPLE_EXT); + ASSERT(!(dflags & DFLAG_DIST_HDR_ATOM_CACHE)); + /* Node without atom cache, 'pass through' needed */ + *--ep = PASS_THROUGH; + goto done; + } dist_hdr_flags = ep[2]; long_atoms = ERTS_DIST_HDR_LONG_ATOMS_FLG & ((int) dist_hdr_flags); @@ -405,6 +435,7 @@ byte *erts_encode_ext_dist_header_finalize(byte *ext, ErtsAtomCache *cache, Uint / sizeof(Uint32))+1]; register Uint32 flgs; int iix, flgs_bytes, flgs_buf_ix, used_half_bytes; + ErtsAtomCache* cache = dep->cache; #ifdef DEBUG int tot_used_half_bytes; #endif @@ -447,17 +478,9 @@ byte *erts_encode_ext_dist_header_finalize(byte *ext, ErtsAtomCache *cache, Uint Atom *a; cache->out_arr[cix] = atom; a = atom_tab(atom_val(atom)); - if (utf8_atoms) { - sz = a->len; - ep -= sz; - sys_memcpy((void *) ep, (void *) a->name, sz); - } - else { - ASSERT(0 <= a->latin1_chars && a->latin1_chars <= MAX_ATOM_CHARACTERS); - ep -= a->latin1_chars; - sz = erts_utf8_to_latin1(ep, a->name, a->len); - ASSERT(a->latin1_chars == sz); - } + sz = a->len; + ep -= sz; + sys_memcpy((void *) ep, (void *) a->name, sz); if (long_atoms) { ep -= 2; put_int16(sz, ep); @@ -504,12 +527,16 @@ byte *erts_encode_ext_dist_header_finalize(byte *ext, ErtsAtomCache *cache, Uint break; } } + reds -= 3; /*was ERTS_PORT_REDS_DIST_CMD_FINALIZE*/ } --ep; put_int8(ci, ep); *--ep = DIST_HEADER; *--ep = VERSION_MAGIC; - return ep; +done: + ob->extp = ep; + ASSERT(&ob->data[0] <= ob->extp && ob->extp < ob->ext_endp); + return reds < 0 ? 0 : reds; } int erts_encode_dist_ext_size(Eterm term, Uint32 flags, ErtsAtomCacheMap *acmp, @@ -520,7 +547,7 @@ int erts_encode_dist_ext_size(Eterm term, Uint32 flags, ErtsAtomCacheMap *acmp, return -1; } else { #ifndef ERTS_DEBUG_USE_DIST_SEP - if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) + if (!(flags & (DFLAG_DIST_HDR_ATOM_CACHE | DFLAG_NO_MAGIC))) #endif sz++ /* VERSION_MAGIC */; @@ -536,7 +563,7 @@ int erts_encode_dist_ext_size_int(Eterm term, struct erts_dsig_send_context* ctx return -1; } else { #ifndef ERTS_DEBUG_USE_DIST_SEP - if (!(ctx->flags & DFLAG_DIST_HDR_ATOM_CACHE)) + if (!(ctx->flags & (DFLAG_DIST_HDR_ATOM_CACHE | DFLAG_NO_MAGIC))) #endif sz++ /* VERSION_MAGIC */; @@ -568,7 +595,7 @@ int erts_encode_dist_ext(Eterm term, byte **ext, Uint32 flags, ErtsAtomCacheMap { if (!ctx || !ctx->wstack.wstart) { #ifndef ERTS_DEBUG_USE_DIST_SEP - if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) + if (!(flags & (DFLAG_DIST_HDR_ATOM_CACHE | DFLAG_NO_MAGIC))) #endif *(*ext)++ = VERSION_MAGIC; } @@ -643,7 +670,7 @@ erts_prepare_dist_ext(ErtsDistExternal *edep, #endif register byte *ep = ext; - int utf8_atoms = (int) (dep->flags & DFLAG_UTF8_ATOMS); + ASSERT(dep->flags & DFLAG_UTF8_ATOMS); edep->heap_size = -1; edep->ext_endp = ext+size; @@ -669,17 +696,16 @@ erts_prepare_dist_ext(ErtsDistExternal *edep, erts_de_rlock(dep); - if ((dep->status & (ERTS_DE_SFLG_EXITING|ERTS_DE_SFLG_CONNECTED)) - != ERTS_DE_SFLG_CONNECTED) { + if (dep->status != ERTS_DE_SFLG_CONNECTED && + dep->status != ERTS_DE_SFLG_PENDING) { erts_de_runlock(dep); return ERTS_PREP_DIST_EXT_CLOSED; } - if (dep->flags & DFLAG_DIST_HDR_ATOM_CACHE) edep->flags |= ERTS_DIST_EXT_DFLAG_HDR; *connection_id = dep->connection_id; - edep->flags |= (dep->connection_id & ERTS_DIST_EXT_CON_ID_MASK); + edep->connection_id = dep->connection_id; if (ep[1] != DIST_HEADER) { if (edep->flags & ERTS_DIST_EXT_DFLAG_HDR) @@ -806,9 +832,7 @@ erts_prepare_dist_ext(ErtsDistExternal *edep, CHKSIZE(len); atom = erts_atom_put((byte *) ep, len, - (utf8_atoms - ? ERTS_ATOM_ENC_UTF8 - : ERTS_ATOM_ENC_LATIN1), + ERTS_ATOM_ENC_UTF8, 0); if (is_non_value(atom)) ERTS_EXT_HDR_FAIL; @@ -895,7 +919,7 @@ bad_dist_ext(ErtsDistExternal *edep) erts_dsprintf(dsbufp, ", %d=%T", i, edep->attab.atom[i]); } erts_send_warning_to_logger_nogl(dsbufp); - erts_kill_dist_connection(dep, ERTS_DIST_EXT_CON_ID(edep)); + erts_kill_dist_connection(dep, edep->connection_id); } } @@ -1220,7 +1244,8 @@ typedef struct B2TContext_t { ErtsBinary2TermState b2ts; Uint32 flags; SWord reds; - Eterm trap_bin; + Uint used_bytes; /* In: boolean, Out: bytes */ + Eterm trap_bin; /* THE_NON_VALUE if not exported */ Export *bif; Eterm arg[2]; enum B2TState state; @@ -1314,6 +1339,11 @@ binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size, ctx->u.uc.dbytes = state->extp; ctx->u.uc.dleft = dest_len; + if (ctx->used_bytes) { + ASSERT(ctx->used_bytes == 1); + /* to be subtracted by stream.avail_in when done */ + ctx->used_bytes = data_size; + } ctx->state = B2TUncompressChunk; *ctxp = ctx; } @@ -1416,13 +1446,15 @@ static int b2t_context_destructor(Binary *context_bin) return 1; } +static BIF_RETTYPE binary_to_term_int(Process*, Eterm bin, B2TContext*); + + static BIF_RETTYPE binary_to_term_trap_1(BIF_ALIST_1) { Binary *context_bin = erts_magic_ref2bin(BIF_ARG_1); ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(context_bin) == b2t_context_destructor); - return binary_to_term_int(BIF_P, 0, THE_NON_VALUE, context_bin, NULL, - THE_NON_VALUE, THE_NON_VALUE); + return binary_to_term_int(BIF_P, THE_NON_VALUE, ERTS_MAGIC_BIN_DATA(context_bin)); } @@ -1448,6 +1480,8 @@ static B2TContext* b2t_export_context(Process* p, B2TContext* src) b2t_context_destructor); B2TContext* ctx = ERTS_MAGIC_BIN_DATA(context_b); Eterm* hp; + + ASSERT(is_non_value(src->trap_bin)); sys_memcpy(ctx, src, sizeof(B2TContext)); if (ctx->state >= B2TDecode && ctx->u.dc.next == &src->u.dc.res) { ctx->u.dc.next = &ctx->u.dc.res; @@ -1457,8 +1491,7 @@ static B2TContext* b2t_export_context(Process* p, B2TContext* src) return ctx; } -static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* context_b, - Export *bif_init, Eterm arg0, Eterm arg1) +static BIF_RETTYPE binary_to_term_int(Process* p, Eterm bin, B2TContext *ctx) { BIF_RETTYPE ret_val; #ifdef EXTREME_B2T_TRAPPING @@ -1466,25 +1499,17 @@ static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binar #else SWord initial_reds = (Uint)(ERTS_BIF_REDS_LEFT(p) * B2T_BYTES_PER_REDUCTION); #endif - B2TContext c_buff; - B2TContext *ctx; int is_first_call; - if (context_b == NULL) { + if (is_value(bin)) { /* Setup enough to get started */ is_first_call = 1; - ctx = &c_buff; ctx->state = B2TPrepare; ctx->aligned_alloc = NULL; - ctx->flags = flags; - ctx->bif = bif_init; - ctx->arg[0] = arg0; - ctx->arg[1] = arg1; - IF_DEBUG(ctx->trap_bin = THE_NON_VALUE;) } else { - is_first_call = 0; - ctx = ERTS_MAGIC_BIN_DATA(context_b); + ASSERT(is_value(ctx->trap_bin)); ASSERT(ctx->state != B2TPrepare); + is_first_call = 0; } ctx->reds = initial_reds; @@ -1528,6 +1553,10 @@ static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binar && zret == Z_STREAM_END && ctx->u.uc.dleft == 0) { ctx->reds -= chunk; + if (ctx->used_bytes) { + ASSERT(ctx->used_bytes > 5 + ctx->u.uc.stream.avail_in); + ctx->used_bytes -= ctx->u.uc.stream.avail_in; + } ctx->state = B2TSizeInit; } else { @@ -1546,11 +1575,11 @@ static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binar break; case B2TDecodeInit: - if (ctx == &c_buff && ctx->b2ts.extsize > ctx->reds) { + if (is_non_value(ctx->trap_bin) && ctx->b2ts.extsize > ctx->reds) { /* dec_term will maybe trap, allocate space for magic bin before result term to make it easy to trim with HRelease. */ - ctx = b2t_export_context(p, &c_buff); + ctx = b2t_export_context(p, ctx); } ctx->u.dc.ep = ctx->b2ts.extp; ctx->u.dc.res = (Eterm) (UWord) NULL; @@ -1593,6 +1622,25 @@ static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binar return ret_val; case B2TDone: + if (ctx->used_bytes) { + Eterm *hp; + Eterm used; + if (!ctx->b2ts.exttmp) { + ASSERT(ctx->used_bytes == 1); + ctx->used_bytes = (ctx->u.dc.ep - ctx->b2ts.extp + +1); /* VERSION_MAGIC */ + } + if (IS_USMALL(0, ctx->used_bytes)) { + hp = erts_produce_heap(&ctx->u.dc.factory, 3, 0); + used = make_small(ctx->used_bytes); + } + else { + hp = erts_produce_heap(&ctx->u.dc.factory, 3+BIG_UINT_HEAP_SIZE, 0); + used = uint_to_big(ctx->used_bytes, hp); + hp += BIG_UINT_HEAP_SIZE; + } + ctx->u.dc.res = TUPLE2(hp, ctx->u.dc.res, used); + } b2t_destroy_context(ctx); if (ctx->u.dc.factory.hp > ctx->u.dc.factory.hp_end) { @@ -1613,11 +1661,10 @@ static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binar } }while (ctx->reds > 0 || ctx->state >= B2TDone); - if (ctx == &c_buff) { - ASSERT(ctx->trap_bin == THE_NON_VALUE); - ctx = b2t_export_context(p, &c_buff); + if (is_non_value(ctx->trap_bin)) { + ctx = b2t_export_context(p, ctx); + ASSERT(is_value(ctx->trap_bin)); } - ASSERT(ctx->trap_bin != THE_NON_VALUE); if (is_first_call) { erts_set_gc_state(p, 0); @@ -1634,23 +1681,35 @@ HIPE_WRAPPER_BIF_DISABLE_GC(binary_to_term, 1) BIF_RETTYPE binary_to_term_1(BIF_ALIST_1) { - return binary_to_term_int(BIF_P, 0, BIF_ARG_1, NULL, bif_export[BIF_binary_to_term_1], - BIF_ARG_1, THE_NON_VALUE); + B2TContext ctx; + + ctx.flags = 0; + ctx.used_bytes = 0; + ctx.trap_bin = THE_NON_VALUE; + ctx.bif = bif_export[BIF_binary_to_term_1]; + ctx.arg[0] = BIF_ARG_1; + ctx.arg[1] = THE_NON_VALUE; + return binary_to_term_int(BIF_P, BIF_ARG_1, &ctx); } HIPE_WRAPPER_BIF_DISABLE_GC(binary_to_term, 2) BIF_RETTYPE binary_to_term_2(BIF_ALIST_2) { + B2TContext ctx; Eterm opts; Eterm opt; - Uint32 flags = 0; + ctx.flags = 0; + ctx.used_bytes = 0; opts = BIF_ARG_2; while (is_list(opts)) { opt = CAR(list_val(opts)); if (opt == am_safe) { - flags |= ERTS_DIST_EXT_BTT_SAFE; + ctx.flags |= ERTS_DIST_EXT_BTT_SAFE; + } + else if (opt == am_used) { + ctx.used_bytes = 1; } else { goto error; @@ -1661,8 +1720,11 @@ BIF_RETTYPE binary_to_term_2(BIF_ALIST_2) if (is_not_nil(opts)) goto error; - return binary_to_term_int(BIF_P, flags, BIF_ARG_1, NULL, bif_export[BIF_binary_to_term_2], - BIF_ARG_1, BIF_ARG_2); + ctx.trap_bin = THE_NON_VALUE; + ctx.bif = bif_export[BIF_binary_to_term_2]; + ctx.arg[0] = BIF_ARG_1; + ctx.arg[1] = BIF_ARG_2; + return binary_to_term_int(BIF_P, BIF_ARG_1, &ctx); error: BIF_ERROR(BIF_P, BADARG); @@ -2099,7 +2161,7 @@ enc_atom(ErtsAtomCacheMap *acmp, Eterm atom, byte *ep, Uint32 dflags) { int iix; int len; - int utf8_atoms = (int) (dflags & DFLAG_UTF8_ATOMS); + const int utf8_atoms = (int) (dflags & DFLAG_UTF8_ATOMS); ASSERT(is_atom(atom)); @@ -2494,8 +2556,6 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, break; } - L_jump_start: - if (ctx && --r <= 0) { *reds = 0; ctx->obj = obj; @@ -2503,6 +2563,8 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, WSTACK_SAVE(s, &ctx->wstack); return -1; } + + L_jump_start: switch(tag_val_def(obj)) { case NIL_DEF: *ep++ = NIL_EXT; @@ -2867,62 +2929,27 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, ErlFunThing* funp = (ErlFunThing *) fun_val(obj); int ei; - if ((dflags & DFLAG_NEW_FUN_TAGS) != 0) { - *ep++ = NEW_FUN_EXT; - WSTACK_PUSH2(s, ENC_PATCH_FUN_SIZE, - (UWord) ep); /* Position for patching in size */ - ep += 4; - *ep = funp->arity; - ep += 1; - sys_memcpy(ep, funp->fe->uniq, 16); - ep += 16; - put_int32(funp->fe->index, ep); - ep += 4; - put_int32(funp->num_free, ep); - ep += 4; - ep = enc_atom(acmp, funp->fe->module, ep, dflags); - ep = enc_term(acmp, make_small(funp->fe->old_index), ep, dflags, off_heap); - ep = enc_term(acmp, make_small(funp->fe->old_uniq), ep, dflags, off_heap); - ep = enc_pid(acmp, funp->creator, ep, dflags); - } else { - /* - * Communicating with an obsolete erl_interface or - * jinterface node. Convert the fun to a tuple to - * avoid crasching. - */ - - /* Tag, arity */ - *ep++ = SMALL_TUPLE_EXT; - put_int8(5, ep); - ep += 1; - - /* 'fun' */ - ep = enc_atom(acmp, am_fun, ep, dflags); - - /* Module name */ - ep = enc_atom(acmp, funp->fe->module, ep, dflags); - - /* Index, Uniq */ - *ep++ = INTEGER_EXT; - put_int32(funp->fe->old_index, ep); - ep += 4; - *ep++ = INTEGER_EXT; - put_int32(funp->fe->old_uniq, ep); - ep += 4; - - /* Environment sub-tuple arity */ - ASSERT(funp->num_free < MAX_ARG); - *ep++ = SMALL_TUPLE_EXT; - put_int8(funp->num_free, ep); - ep += 1; - } - for (ei = funp->num_free-1; ei > 0; ei--) { + ASSERT(dflags & DFLAG_NEW_FUN_TAGS); + *ep++ = NEW_FUN_EXT; + WSTACK_PUSH2(s, ENC_PATCH_FUN_SIZE, + (UWord) ep); /* Position for patching in size */ + ep += 4; + *ep = funp->arity; + ep += 1; + sys_memcpy(ep, funp->fe->uniq, 16); + ep += 16; + put_int32(funp->fe->index, ep); + ep += 4; + put_int32(funp->num_free, ep); + ep += 4; + ep = enc_atom(acmp, funp->fe->module, ep, dflags); + ep = enc_term(acmp, make_small(funp->fe->old_index), ep, dflags, off_heap); + ep = enc_term(acmp, make_small(funp->fe->old_uniq), ep, dflags, off_heap); + ep = enc_pid(acmp, funp->creator, ep, dflags); + + for (ei = funp->num_free-1; ei >= 0; ei--) { WSTACK_PUSH2(s, ENC_TERM, (UWord) funp->env[ei]); } - if (funp->num_free != 0) { - obj = funp->env[0]; - goto L_jump_start; - } } break; } @@ -3260,6 +3287,7 @@ dec_term_atom_common: n--; if (ctx) { if (reds < n) { + ASSERT(reds > 0); ctx->state = B2TDecodeList; ctx->u.dc.remaining_n = n - reds; n = reds; @@ -4000,6 +4028,7 @@ dec_term_atom_common: if (ctx) { ctx->state = B2TDone; ctx->reds = reds; + ctx->u.dc.ep = ep; } return ep; @@ -4269,24 +4298,12 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, { ErlFunThing* funp = (ErlFunThing *) fun_val(obj); - if ((dflags & DFLAG_NEW_FUN_TAGS) != 0) { - result += 20+1+1+4; /* New ID + Tag */ - result += 4; /* Length field (number of free variables */ - result += encode_size_struct2(acmp, funp->creator, dflags); - result += encode_size_struct2(acmp, funp->fe->module, dflags); - result += 2 * (1+4); /* Index, Uniq */ - } else { - /* - * Size when fun is mapped to a tuple. - */ - result += 1 + 1; /* Tuple tag, arity */ - result += 1 + 1 + 2 + - atom_tab(atom_val(am_fun))->len; /* 'fun' */ - result += 1 + 1 + 2 + - atom_tab(atom_val(funp->fe->module))->len; /* Module name */ - result += 2 * (1 + 4); /* Index + Uniq */ - result += 1 + (funp->num_free < 0x100 ? 1 : 4); - } + ASSERT(dflags & DFLAG_NEW_FUN_TAGS); + result += 20+1+1+4; /* New ID + Tag */ + result += 4; /* Length field (number of free variables */ + result += encode_size_struct2(acmp, funp->creator, dflags); + result += encode_size_struct2(acmp, funp->fe->module, dflags); + result += 2 * (1+4); /* Index, Uniq */ if (funp->num_free > 1) { WSTACK_PUSH2(s, (UWord) (funp->env + 1), (UWord) TERM_ARRAY_OP(funp->num_free-1)); @@ -4374,7 +4391,7 @@ decoded_size(byte *ep, byte* endp, int internal_tags, B2TContext* ctx) } } else - reds = 0; /* not used but compiler warns anyway */ + ERTS_UNDEF(reds, 0); heap_size = 0; terms = 1; @@ -4684,3 +4701,177 @@ error: #undef SKIP2 #undef CHKSIZE } + + +struct transcode_context { + enum { + TRANSCODE_DEC_MSG_SIZE, + TRANSCODE_DEC_MSG, + TRANSCODE_ENC_CTL, + TRANSCODE_ENC_MSG + }state; + Eterm ctl_term; + Eterm* ctl_heap; + ErtsHeapFactory ctl_factory; + Eterm* msg_heap; + B2TContext b2t; + TTBEncodeContext ttb; +#ifdef DEBUG + ErtsDistOutputBuf* dbg_ob; +#endif +}; + +void transcode_free_ctx(DistEntry* dep) +{ + struct transcode_context* ctx = dep->transcode_ctx; + + erts_factory_close(&ctx->ctl_factory); + erts_free(ERTS_ALC_T_DIST_TRANSCODE, ctx->ctl_heap); + + if (ctx->msg_heap) { + erts_factory_close(&ctx->b2t.u.dc.factory); + erts_free(ERTS_ALC_T_DIST_TRANSCODE, ctx->msg_heap); + } + erts_free(ERTS_ALC_T_DIST_TRANSCODE, ctx); + dep->transcode_ctx = NULL; +} + +Sint transcode_dist_obuf(ErtsDistOutputBuf* ob, + DistEntry* dep, + Uint32 dflags, + Sint reds) +{ + Sint hsz; + byte* decp; + const int have_msg = !!ob->msg_start; + int i; + struct transcode_context* ctx = dep->transcode_ctx; + + if (!ctx) { /* first call for 'ob' */ + + if (~dflags & (DFLAG_BIT_BINARIES | DFLAG_EXPORT_PTR_TAG)) { + /* + * Receiver does not support bitstrings and/or export funs. + * We need to transcode control and message terms to use tuple fallbacks. + */ + ctx = erts_alloc(ERTS_ALC_T_DIST_TRANSCODE, sizeof(struct transcode_context)); + dep->transcode_ctx = ctx; + #ifdef DEBUG + ctx->dbg_ob = ob; + #endif + + hsz = decoded_size(ob->extp, ob->ext_endp, 0, NULL); + ctx->ctl_heap = erts_alloc(ERTS_ALC_T_DIST_TRANSCODE, hsz*sizeof(Eterm)); + erts_factory_tmp_init(&ctx->ctl_factory, ctx->ctl_heap, hsz, ERTS_ALC_T_DIST_TRANSCODE); + ctx->msg_heap = NULL; + + decp = dec_term(NULL, &ctx->ctl_factory, ob->extp, &ctx->ctl_term, NULL); + if (have_msg) { + ASSERT(decp == ob->msg_start); (void)decp; + ctx->b2t.u.sc.ep = NULL; + ctx->b2t.state = B2TSize; + ctx->b2t.aligned_alloc = NULL; + ctx->b2t.b2ts.exttmp = 0; + ctx->state = TRANSCODE_DEC_MSG_SIZE; + } + else { + ASSERT(decp == ob->ext_endp); + ctx->state = TRANSCODE_ENC_CTL; + } + } + else { + /* + * No need for full transcoding, but primitive receiver (erl_/jinterface) + * expects VERSION_MAGIC before both control and message terms. + */ + if (ob->msg_start) { + Sint ctl_bytes = ob->msg_start - ob->extp; + ASSERT(ob->extp < ob->msg_start && ob->msg_start < ob->ext_endp); + /* Move control term back 1 byte to make room */ + sys_memmove(ob->extp-1, ob->extp, ctl_bytes); + *--(ob->msg_start) = VERSION_MAGIC; + --(ob->extp); + reds -= ctl_bytes / (B2T_BYTES_PER_REDUCTION * B2T_MEMCPY_FACTOR); + } + *--(ob->extp) = VERSION_MAGIC; + goto done; + } + } + else { + ASSERT(ctx->dbg_ob == ob); + } + ctx->b2t.reds = reds * B2T_BYTES_PER_REDUCTION; + + switch (ctx->state) { + case TRANSCODE_DEC_MSG_SIZE: + hsz = decoded_size(ob->msg_start, ob->ext_endp, 0, &ctx->b2t); + if (ctx->b2t.state == B2TSize) { + return -1; + } + ASSERT(ctx->b2t.state == B2TDecodeInit); + ctx->msg_heap = erts_alloc(ERTS_ALC_T_DIST_TRANSCODE, hsz*sizeof(Eterm)); + ctx->b2t.u.dc.ep = ob->msg_start; + ctx->b2t.u.dc.res = (Eterm) NULL; + ctx->b2t.u.dc.next = &ctx->b2t.u.dc.res; + erts_factory_tmp_init(&ctx->b2t.u.dc.factory, + ctx->msg_heap, hsz, ERTS_ALC_T_DIST_TRANSCODE); + ctx->b2t.u.dc.flat_maps.wstart = NULL; + ctx->b2t.u.dc.hamt_array.pstart = NULL; + ctx->b2t.state = B2TDecode; + + ctx->state = TRANSCODE_DEC_MSG; + case TRANSCODE_DEC_MSG: + if (ctx->b2t.reds <= 0) + ctx->b2t.reds = 1; + decp = dec_term(NULL, NULL, NULL, NULL, &ctx->b2t); + if (ctx->b2t.state < B2TDone) { + return -1; + } + ASSERT(ctx->b2t.state == B2TDone); + ASSERT(decp && decp <= ob->ext_endp); + reds = ctx->b2t.reds / B2T_BYTES_PER_REDUCTION; + b2t_destroy_context(&ctx->b2t); + + ctx->state = TRANSCODE_ENC_CTL; + case TRANSCODE_ENC_CTL: + if (!(dflags & DFLAG_DIST_HDR_ATOM_CACHE)) { + ASSERT(!(dflags & DFLAG_NO_MAGIC)); + ob->extp -= 2; /* VERSION_MAGIC x 2 */ + } + ob->ext_endp = ob->extp; + i = erts_encode_dist_ext(ctx->ctl_term, &ob->ext_endp, dflags, + NULL, NULL, NULL); + ASSERT(i == 0); (void)i; + ASSERT(ob->ext_endp <= ob->alloc_endp); + + if (!have_msg) { + break; + } + ob->msg_start = ob->ext_endp; + ctx->ttb.wstack.wstart = NULL; + ctx->ttb.flags = dflags; + ctx->ttb.level = 0; + + ctx->state = TRANSCODE_ENC_MSG; + case TRANSCODE_ENC_MSG: + reds *= TERM_TO_BINARY_LOOP_FACTOR; + if (erts_encode_dist_ext(ctx->b2t.u.dc.res, &ob->ext_endp, dflags, NULL, + &ctx->ttb, &reds)) { + return -1; + } + reds /= TERM_TO_BINARY_LOOP_FACTOR; + + ASSERT(ob->ext_endp <= ob->alloc_endp); + + } + transcode_free_ctx(dep); + +done: + if (!(dflags & DFLAG_DIST_HDR_ATOM_CACHE)) + *--(ob->extp) = PASS_THROUGH; + + if (reds < 0) + reds = 0; + + return reds; +} diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h index 3c61d013da..f9f8abcc27 100644 --- a/erts/emulator/beam/external.h +++ b/erts/emulator/beam/external.h @@ -109,35 +109,26 @@ typedef struct { } ErtsAtomTranslationTable; /* - * These flags are tagged onto the high bits of a connection ID and stored in - * the ErtsDistExternal structure's flags field. They are used to indicate - * various bits of state necessary to decode binaries in a variety of - * scenarios. The mask ERTS_DIST_EXT_CON_ID_MASK is used later to separate the - * connection ID from the flags. Be careful to ensure that the mask does not - * overlap any of the bits used for flags, or ERTS will leak flags bits into - * connection IDs and leak connection ID bits into the flags. + * These flags are stored in the ErtsDistExternal structure's flags field. + * They are used to indicate various bits of state necessary to decode binaries + * in a variety of scenarios. */ -#define ERTS_DIST_EXT_DFLAG_HDR ((Uint32) 0x80000000) -#define ERTS_DIST_EXT_ATOM_TRANS_TAB ((Uint32) 0x40000000) -#define ERTS_DIST_EXT_BTT_SAFE ((Uint32) 0x20000000) -#define ERTS_DIST_EXT_CON_ID_MASK ((Uint32) 0x1fffffff) +#define ERTS_DIST_EXT_DFLAG_HDR ((Uint32) 0x1) +#define ERTS_DIST_EXT_ATOM_TRANS_TAB ((Uint32) 0x2) +#define ERTS_DIST_EXT_BTT_SAFE ((Uint32) 0x4) + +#define ERTS_DIST_CON_ID_MASK ((Uint32) 0x00ffffff) /* also in net_kernel.erl */ -#define ERTS_DIST_EXT_CON_ID(DIST_EXTP) \ - ((DIST_EXTP)->flags & ERTS_DIST_EXT_CON_ID_MASK) typedef struct { DistEntry *dep; byte *extp; byte *ext_endp; Sint heap_size; + Uint32 connection_id; Uint32 flags; ErtsAtomTranslationTable attab; } ErtsDistExternal; -typedef struct { - int have_header; - int cache_entries; -} ErtsDistHeaderPeek; - #define ERTS_DIST_EXT_SIZE(EDEP) \ (sizeof(ErtsDistExternal) \ - (((EDEP)->flags & ERTS_DIST_EXT_ATOM_TRANS_TAB) \ @@ -163,7 +154,7 @@ void erts_finalize_atom_cache_map(ErtsAtomCacheMap *, Uint32); Uint erts_encode_ext_dist_header_size(ErtsAtomCacheMap *); byte *erts_encode_ext_dist_header_setup(byte *, ErtsAtomCacheMap *); -byte *erts_encode_ext_dist_header_finalize(byte *, ErtsAtomCache *, Uint32); +Sint erts_encode_ext_dist_header_finalize(ErtsDistOutputBuf*, DistEntry *, Uint32 dflags, Sint reds); struct erts_dsig_send_context; int erts_encode_dist_ext_size(Eterm, Uint32, ErtsAtomCacheMap*, Uint* szp); int erts_encode_dist_ext_size_int(Eterm term, struct erts_dsig_send_context* ctx, Uint* szp); @@ -177,9 +168,6 @@ Uint erts_encode_ext_size_ets(Eterm); void erts_encode_ext(Eterm, byte **); byte* erts_encode_ext_ets(Eterm, byte *, struct erl_off_heap_header** ext_off_heap); -#ifdef ERTS_WANT_EXTERNAL_TAGS -ERTS_GLB_INLINE void erts_peek_dist_header(ErtsDistHeaderPeek *, byte *, Uint); -#endif ERTS_GLB_INLINE void erts_free_dist_ext_copy(ErtsDistExternal *); ERTS_GLB_INLINE void *erts_dist_ext_trailer(ErtsDistExternal *); ErtsDistExternal *erts_make_dist_ext_copy(ErtsDistExternal *, Uint); @@ -207,23 +195,9 @@ void erts_binary2term_abort(ErtsBinary2TermState *); Eterm erts_binary2term_create(ErtsBinary2TermState *, ErtsHeapFactory*); int erts_debug_max_atom_out_cache_index(void); int erts_debug_atom_to_out_cache_index(Eterm); - +void transcode_free_ctx(DistEntry* dep); #if ERTS_GLB_INLINE_INCL_FUNC_DEF -#ifdef ERTS_WANT_EXTERNAL_TAGS -ERTS_GLB_INLINE void -erts_peek_dist_header(ErtsDistHeaderPeek *dhpp, byte *ext, Uint sz) -{ - if (ext[0] == VERSION_MAGIC - || ext[1] != DIST_HEADER - || sz < (1+1+1)) - dhpp->have_header = 0; - else { - dhpp->have_header = 1; - dhpp->cache_entries = (int) get_int8(&ext[2]); - } -} -#endif ERTS_GLB_INLINE void erts_free_dist_ext_copy(ErtsDistExternal *edep) diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 09aeba00fa..3dd3a60939 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -947,6 +947,8 @@ void erts_update_ranges(BeamInstr* code, Uint size); void erts_remove_from_ranges(BeamInstr* code); UWord erts_ranges_sz(void); void erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info); +ErtsLiteralArea** erts_dump_lit_areas; +Uint erts_dump_num_lit_areas; /* break.c */ void init_break_handler(void); diff --git a/erts/emulator/beam/instrs.tab b/erts/emulator/beam/instrs.tab index 20d356a81d..c17d1a8f69 100644 --- a/erts/emulator/beam/instrs.tab +++ b/erts/emulator/beam/instrs.tab @@ -788,7 +788,8 @@ is_eq_exact(Fail, X, Y) { } i_is_eq_exact_literal(Fail, Src, Literal) { - if (!eq($Src, $Literal)) { + Eterm src = $Src; + if (is_immed(src) || !eq(src, $Literal)) { $FAIL($Fail); } } @@ -800,7 +801,8 @@ is_ne_exact(Fail, X, Y) { } i_is_ne_exact_literal(Fail, Src, Literal) { - if (eq($Src, $Literal)) { + Eterm src = $Src; + if (!is_immed(src) && eq(src, $Literal)) { $FAIL($Fail); } } diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 85013af3ad..9933c8dda4 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -3829,11 +3829,12 @@ static void sweep_one_link(ErtsLink *lnk, void *vpsc) ErtsDistLinkData dld; ErtsDSigData dsd; int code; - code = erts_dsig_prepare(&dsd, dep, NULL, ERTS_DSP_NO_LOCK, 0); + code = erts_dsig_prepare(&dsd, dep, NULL, 0, ERTS_DSP_NO_LOCK, 0, 0); switch (code) { case ERTS_DSIG_PREP_NOT_ALIVE: case ERTS_DSIG_PREP_NOT_CONNECTED: break; + case ERTS_DSIG_PREP_PENDING: case ERTS_DSIG_PREP_CONNECTED: erts_remove_dist_link(&dld, port_id, lnk->pid, dep); erts_destroy_dist_link(&dld); diff --git a/erts/emulator/beam/macros.tab b/erts/emulator/beam/macros.tab index e0b5f56b53..494fe8961e 100644 --- a/erts/emulator/beam/macros.tab +++ b/erts/emulator/beam/macros.tab @@ -20,13 +20,12 @@ // // -// Use if there is a garbage collection before storing to a -// general destination (either X or Y register). +// Define a regular expression that will match instructions that +// perform GC. That will allow beam_makeops to check for instructions +// that don't use $REFRESH_GEN_DEST() when they should. // -REFRESH_GEN_DEST() { - dst_ptr = REG_TARGET_PTR(dst); -} +GC_REGEXP=erts_garbage_collect|erts_gc|GcBifFunction; // $Offset is relative to the start of the instruction (not to the // location of the failure label reference). Since combined diff --git a/erts/emulator/beam/map_instrs.tab b/erts/emulator/beam/map_instrs.tab index bbb2f49b66..c594a87298 100644 --- a/erts/emulator/beam/map_instrs.tab +++ b/erts/emulator/beam/map_instrs.tab @@ -31,7 +31,7 @@ new_map(Dst, Live, N) { Eterm res; HEAVY_SWAPOUT; - res = new_map(c_p, reg, $Live, $N, $NEXT_INSTRUCTION); + res = erts_gc_new_map(c_p, reg, $Live, $N, $NEXT_INSTRUCTION); HEAVY_SWAPIN; $REFRESH_GEN_DEST(); $Dst = res; @@ -44,7 +44,7 @@ i_new_small_map_lit(Dst, Live, Keys) { Eterm keys = $Keys; HEAVY_SWAPOUT; - res = new_small_map_lit(c_p, reg, keys, $Live, $NEXT_INSTRUCTION); + res = erts_gc_new_small_map_lit(c_p, reg, keys, $Live, $NEXT_INSTRUCTION); HEAVY_SWAPIN; $REFRESH_GEN_DEST(); $Dst = res; @@ -133,7 +133,7 @@ update_map_assoc(Src, Dst, Live, N) { reg[live] = $Src; HEAVY_SWAPOUT; - res = update_map_assoc(c_p, reg, live, $N, $NEXT_INSTRUCTION); + res = erts_gc_update_map_assoc(c_p, reg, live, $N, $NEXT_INSTRUCTION); HEAVY_SWAPIN; ASSERT(is_value(res)); $REFRESH_GEN_DEST(); @@ -147,7 +147,7 @@ update_map_exact(Fail, Src, Dst, Live, N) { reg[live] = $Src; HEAVY_SWAPOUT; - res = update_map_exact(c_p, reg, live, $N, $NEXT_INSTRUCTION); + res = erts_gc_update_map_exact(c_p, reg, live, $N, $NEXT_INSTRUCTION); HEAVY_SWAPIN; if (is_value(res)) { $REFRESH_GEN_DEST(); diff --git a/erts/emulator/beam/module.c b/erts/emulator/beam/module.c index baeec115ea..1712dc803c 100644 --- a/erts/emulator/beam/module.c +++ b/erts/emulator/beam/module.c @@ -254,4 +254,3 @@ void module_end_staging(int commit) IF_DEBUG(dbg_load_code_ix = -1); } - diff --git a/erts/emulator/beam/module.h b/erts/emulator/beam/module.h index 9a81e6035b..a3f1ce1705 100644 --- a/erts/emulator/beam/module.h +++ b/erts/emulator/beam/module.h @@ -45,7 +45,7 @@ typedef struct erl_module { int seen; /* Used by finish_loading() */ struct erl_module_instance curr; - struct erl_module_instance old; /* protected by "old_code" rwlock */ + struct erl_module_instance old; /* active protected by "old_code" rwlock */ struct erl_module_instance* on_load; } Module; diff --git a/erts/emulator/beam/msg_instrs.tab b/erts/emulator/beam/msg_instrs.tab index 8055a8616f..d6d4d2fb49 100644 --- a/erts/emulator/beam/msg_instrs.tab +++ b/erts/emulator/beam/msg_instrs.tab @@ -43,27 +43,23 @@ // * // */ -recv_mark(Dest) { +i_recv_mark() { /* - * Save the current position in message buffer and the - * the label for the loop_rec/2 instruction for the - * the receive statement. + * Save the current position in message buffer. */ - $SET_REL_I(c_p->msg.mark, $Dest); c_p->msg.saved_last = c_p->msg.last; } i_recv_set() { /* - * If the mark is valid (points to the loop_rec/2 - * instruction that follows), we know that the saved - * position points to the first message that could - * possibly be matched out. + * If c_p->msg.saved_last is non-zero, it points to the first + * message that could possibly be matched out. * - * If the mark is invalid, we do nothing, meaning that - * we will look through all messages in the message queue. + * If c_p->msg.saved_last is zero, it means that it was invalidated + * because another receive was executed before this i_recv_set() + * instruction was reached. */ - if (c_p->msg.mark == (BeamInstr *) ($NEXT_INSTRUCTION)) { + if (c_p->msg.saved_last) { c_p->msg.save = c_p->msg.saved_last; } SET_I($NEXT_INSTRUCTION); @@ -131,6 +127,7 @@ i_loop_rec(Dest) { ASSERT(HTOP == c_p->htop && E == c_p->stop); /* TODO: Add DTrace probe for this bad message situation? */ UNLINK_MESSAGE(c_p, msgp); + c_p->msg.saved_last = 0; /* Better safe than sorry. */ msgp->next = NULL; erts_cleanup_messages(msgp); goto loop_rec__; diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 7a2c39b3a8..3df91056cb 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -511,8 +511,6 @@ put_list y x x put_list y y x put_list x y x -put_list y x x - # put_list SrcReg Constant Dst put_list x c x @@ -1567,7 +1565,12 @@ on_load # # R14A. # -recv_mark f +# Modified in OTP 21 because it turns out that we don't need the +# label after all. +# + +recv_mark f => i_recv_mark +i_recv_mark recv_set Fail | label Lbl | loop_rec Lf Reg => \ i_recv_set | label Lbl | loop_rec Lf Reg diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 7b1f4a0e9c..95d61fcc5d 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -1136,7 +1136,6 @@ static int packet_inet_init(void); static void packet_inet_stop(ErlDrvData); static void packet_inet_command(ErlDrvData, char*, ErlDrvSizeT); static void packet_inet_drv_input(ErlDrvData data, ErlDrvEvent event); -static void packet_inet_drv_output(ErlDrvData data, ErlDrvEvent event); static ErlDrvData udp_inet_start(ErlDrvPort, char* command); #ifdef HAVE_SCTP static ErlDrvData sctp_inet_start(ErlDrvPort, char* command); @@ -1161,7 +1160,7 @@ static struct erl_drv_entry udp_inet_driver_entry = NULL, #else packet_inet_drv_input, - packet_inet_drv_output, + NULL, #endif "udp_inet", NULL, @@ -1196,7 +1195,7 @@ static struct erl_drv_entry sctp_inet_driver_entry = NULL, #else packet_inet_drv_input, - packet_inet_drv_output, + NULL, #endif "sctp_inet", NULL, @@ -1262,7 +1261,6 @@ typedef struct { static int packet_inet_input(udp_descriptor* udesc, HANDLE event); -static int packet_inet_output(udp_descriptor* udesc, HANDLE event); #endif /* convert descriptor pointer to inet_descriptor pointer */ @@ -2199,13 +2197,16 @@ static int inet_reply_ok(inet_descriptor* desc) ErlDrvTermData caller = desc->caller; int i = 0; + desc->caller = 0; + if (is_not_internal_pid(caller)) + return 0; + i = LOAD_ATOM(spec, i, am_inet_reply); i = LOAD_PORT(spec, i, desc->dport); i = LOAD_ATOM(spec, i, am_ok); i = LOAD_TUPLE(spec, i, 3); ASSERT(i == sizeof(spec)/sizeof(*spec)); - desc->caller = 0; return erl_drv_send_term(desc->dport, caller, spec, i); } @@ -11297,24 +11298,20 @@ static ErlDrvSSizeT packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, (desc->sfamily, &remote, &buf, &len)) != NULL) return ctl_xerror(xerror, rbuf, rsize); - sock_select(desc, FD_CONNECT, 1); code = sock_connect(desc->s, &remote.sa, len); if (IS_SOCKET_ERROR(code) && (sock_errno() == EINPROGRESS)) { /* XXX: Unix only -- WinSock would have a different cond! */ - desc->state = INET_STATE_CONNECTING; if (timeout != INET_INFINITY) driver_set_timer(desc->port, timeout); enq_async(desc, tbuf, INET_REQ_CONNECT); + async_ok(desc); } else if (code == 0) { /* OK we are connected */ - sock_select(desc, FD_CONNECT, 0); - desc->state = INET_STATE_CONNECTED; enq_async(desc, tbuf, INET_REQ_CONNECT); async_ok(desc); } else { - sock_select(desc, FD_CONNECT, 0); return ctl_error(sock_errno(), rbuf, rsize); } return ctl_reply(INET_REP_OK, tbuf, 2, rbuf, rsize); @@ -11829,77 +11826,6 @@ static int packet_inet_input(udp_descriptor* udesc, HANDLE event) return count; } -static void packet_inet_drv_output(ErlDrvData e, ErlDrvEvent event) -{ - (void) packet_inet_output((udp_descriptor*)e, (HANDLE)event); -} - -/* UDP/SCTP socket ready for output: -** This is a Back-End for Non-Block SCTP Connect (INET_STATE_CONNECTING) -*/ -static int packet_inet_output(udp_descriptor* udesc, HANDLE event) -{ - inet_descriptor* desc = INETP(udesc); - int ret = 0; - ErlDrvPort ix = desc->port; - - DEBUGF(("packet_inet_output(%ld) {s=%d\r\n", - (long)desc->port, desc->s)); - - if (desc->state == INET_STATE_CONNECTING) { - sock_select(desc, FD_CONNECT, 0); - - driver_cancel_timer(ix); /* posssibly cancel a timer */ -#ifndef __WIN32__ - /* - * XXX This is strange. This *should* work on Windows NT too, - * but doesn't. An bug in Winsock 2.0 for Windows NT? - * - * See "Unix Netwok Programming", W.R.Stevens, p 412 for a - * discussion about Unix portability and non blocking connect. - */ - -#ifndef SO_ERROR - { - int sz = sizeof(desc->remote); - int code = sock_peer(desc->s, - (struct sockaddr*) &desc->remote, &sz); - - if (IS_SOCKET_ERROR(code)) { - desc->state = INET_STATE_OPEN; /* restore state */ - ret = async_error(desc, sock_errno()); - goto done; - } - } -#else - { - int error = 0; /* Has to be initiated, we check it */ - unsigned int sz = sizeof(error); /* even if we get -1 */ - int code = sock_getopt(desc->s, SOL_SOCKET, SO_ERROR, - (void *)&error, &sz); - - if ((code < 0) || error) { - desc->state = INET_STATE_OPEN; /* restore state */ - ret = async_error(desc, error); - goto done; - } - } -#endif /* SO_ERROR */ -#endif /* !__WIN32__ */ - - desc->state = INET_STATE_CONNECTED; - async_ok(desc); - } - else { - sock_select(desc,FD_CONNECT,0); - - DEBUGF(("packet_inet_output(%ld): bad state: %04x\r\n", - (long)desc->port, desc->state)); - } - done: - DEBUGF(("packet_inet_output(%ld) }\r\n", (long)desc->port)); - return ret; -} #endif /*---------------------------------------------------------------------------*/ diff --git a/erts/emulator/hipe/hipe_amd64_bifs.m4 b/erts/emulator/hipe/hipe_amd64_bifs.m4 index b3c9a460bb..cf4c59c9af 100644 --- a/erts/emulator/hipe/hipe_amd64_bifs.m4 +++ b/erts/emulator/hipe/hipe_amd64_bifs.m4 @@ -462,6 +462,7 @@ ASYM($1): TYPE_FUNCTION(ASYM($1)) #endif') + /* * noproc_primop_interface_0(nbif_name, cbif_name) * noproc_primop_interface_1(nbif_name, cbif_name) diff --git a/erts/emulator/hipe/hipe_bif0.tab b/erts/emulator/hipe/hipe_bif0.tab index 4038ca7ef8..0380e8c795 100644 --- a/erts/emulator/hipe/hipe_bif0.tab +++ b/erts/emulator/hipe/hipe_bif0.tab @@ -135,8 +135,8 @@ atom bs_utf16_size atom bs_put_utf16be atom bs_put_utf16le atom bs_get_utf16 -atom bs_validate_unicode atom bs_validate_unicode_retract atom emulate_fpe atom emasculate_binary atom is_divisible +atom is_unicode
\ No newline at end of file diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4 index bebe20a18e..625d8486fd 100644 --- a/erts/emulator/hipe/hipe_bif_list.m4 +++ b/erts/emulator/hipe/hipe_bif_list.m4 @@ -222,7 +222,8 @@ standard_bif_interface_2(nbif_rethrow, hipe_rethrow) standard_bif_interface_3(nbif_find_na_or_make_stub, hipe_find_na_or_make_stub) standard_bif_interface_2(nbif_nonclosure_address, hipe_nonclosure_address) nocons_nofail_primop_interface_0(nbif_fclearerror_error, hipe_fclearerror_error) -standard_bif_interface_2(nbif_is_divisible, hipe_is_divisible) +noproc_primop_interface_2(nbif_is_divisible, hipe_is_divisible) +noproc_primop_interface_1(nbif_is_unicode, hipe_is_unicode) /* * Mbox primops with implicit P parameter. @@ -247,7 +248,6 @@ nofail_primop_interface_3(nbif_bs_get_float_2, erts_bs_get_float_2) standard_bif_interface_3(nbif_bs_put_utf8, hipe_bs_put_utf8) standard_bif_interface_3(nbif_bs_put_utf16be, hipe_bs_put_utf16be) standard_bif_interface_3(nbif_bs_put_utf16le, hipe_bs_put_utf16le) -standard_bif_interface_1(nbif_bs_validate_unicode, hipe_bs_validate_unicode) /* * Bit-syntax primops without any P parameter. diff --git a/erts/emulator/hipe/hipe_debug.c b/erts/emulator/hipe/hipe_debug.c index 222a11db3d..cfe60b379e 100644 --- a/erts/emulator/hipe/hipe_debug.c +++ b/erts/emulator/hipe/hipe_debug.c @@ -135,7 +135,9 @@ static void print_heap(Eterm *pos, Eterm *end) printf("From: 0x%0*lx to 0x%0*lx\n\r", 2*(int)sizeof(long), (unsigned long)pos, 2*(int)sizeof(long), (unsigned long)end); - printf(" | H E A P |\r\n"); + printf(" | %*s H E A P %*s |\r\n", + 2*(int)sizeof(long)-1, "", + 2*(int)sizeof(long)-1, ""); printf(" | %*s | %*s |\r\n", 2+2*(int)sizeof(long), "Address", 2+2*(int)sizeof(long), "Contents"); @@ -158,8 +160,10 @@ static void print_heap(Eterm *pos, Eterm *end) ++pos; --ari; } - } else + } else { + fflush(stdout); erts_printf("%.30T", val); + } printf("\r\n"); } printf(" |%s|%s|\r\n", dashes, dashes); diff --git a/erts/emulator/hipe/hipe_mkliterals.c b/erts/emulator/hipe/hipe_mkliterals.c index 6ea120c65c..de00994d64 100644 --- a/erts/emulator/hipe/hipe_mkliterals.c +++ b/erts/emulator/hipe/hipe_mkliterals.c @@ -462,6 +462,15 @@ static const struct rts_param rts_params[] = { 0 #endif }, + /* This flag is always defined, but its value is configuration-dependent. */ + { 17, "ERTS_USE_LITERAL_TAG", + 1, +#if defined(TAG_LITERAL_PTR) + 1 +#else + 0 +#endif + }, /* This parameter is always defined, but its value depends on ERTS_SMP. */ { 19, "MSG_MESSAGE", 1, offsetof(struct erl_mesg, m[0]) diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index 23f64a6991..99c34532b9 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -482,15 +482,12 @@ static int validate_unicode(Eterm arg) return 1; } -BIF_RETTYPE nbif_impl_hipe_bs_validate_unicode(NBIF_ALIST_1) +Uint hipe_is_unicode(Eterm arg) { - Process *p = BIF_P; - Eterm arg = BIF_ARG_1; - if (!validate_unicode(arg)) - BIF_ERROR(p, BADARG); - return NIL; + return (Uint) validate_unicode(arg); } + int hipe_bs_validate_unicode_retract(ErlBinMatchBuffer* mb, Eterm arg) { if (!validate_unicode(arg)) { @@ -500,16 +497,12 @@ int hipe_bs_validate_unicode_retract(ErlBinMatchBuffer* mb, Eterm arg) return 1; } -/* Called via standard_bif_interface_2 */ -BIF_RETTYPE nbif_impl_hipe_is_divisible(NBIF_ALIST_2) +Uint hipe_is_divisible(Uint dividend, Uint divisor) { - /* Arguments are Eterm-sized unsigned integers */ - Uint dividend = BIF_ARG_1; - Uint divisor = BIF_ARG_2; if (dividend % divisor) { - BIF_ERROR(BIF_P, BADARG); + return 0; } else { - return NIL; + return 1; } } diff --git a/erts/emulator/hipe/hipe_native_bif.h b/erts/emulator/hipe/hipe_native_bif.h index cbc7ab8dc6..d5081b8438 100644 --- a/erts/emulator/hipe/hipe_native_bif.h +++ b/erts/emulator/hipe/hipe_native_bif.h @@ -66,9 +66,9 @@ AEXTERN(Eterm,nbif_bs_utf16_size,(Eterm)); AEXTERN(Eterm,nbif_bs_put_utf16be,(Process*,Eterm,byte*,unsigned int)); AEXTERN(Eterm,nbif_bs_put_utf16le,(Process*,Eterm,byte*,unsigned int)); AEXTERN(Eterm,nbif_bs_get_utf16,(void)); -AEXTERN(Eterm,nbif_bs_validate_unicode,(Process*,Eterm)); +AEXTERN(Uint,nbif_is_unicode,(Eterm)); AEXTERN(Eterm,nbif_bs_validate_unicode_retract,(void)); -AEXTERN(void,nbif_is_divisible,(Process*,Uint,Uint)); +AEXTERN(Uint,nbif_is_divisible,(Uint,Uint)); AEXTERN(void,nbif_select_msg,(Process*)); AEXTERN(Eterm,nbif_cmp_2,(void)); @@ -91,10 +91,10 @@ BIF_RETTYPE nbif_impl_hipe_bs_put_utf8(NBIF_ALIST_3); Eterm hipe_bs_utf16_size(Eterm); BIF_RETTYPE nbif_impl_hipe_bs_put_utf16be(NBIF_ALIST_3); BIF_RETTYPE nbif_impl_hipe_bs_put_utf16le(NBIF_ALIST_3); -BIF_RETTYPE nbif_impl_hipe_bs_validate_unicode(NBIF_ALIST_1); +Uint hipe_is_unicode(Eterm); struct erl_bin_match_buffer; int hipe_bs_validate_unicode_retract(struct erl_bin_match_buffer*, Eterm); -BIF_RETTYPE nbif_impl_hipe_is_divisible(NBIF_ALIST_2); +Uint hipe_is_divisible(Uint, Uint); #ifdef NO_FPE_SIGNALS AEXTERN(void,nbif_emulate_fpe,(Process*)); diff --git a/erts/emulator/hipe/hipe_primops.h b/erts/emulator/hipe/hipe_primops.h index 6aac5e6205..a6abd3e011 100644 --- a/erts/emulator/hipe/hipe_primops.h +++ b/erts/emulator/hipe/hipe_primops.h @@ -63,7 +63,7 @@ PRIMOP_LIST(am_bs_utf16_size, &nbif_bs_utf16_size) PRIMOP_LIST(am_bs_put_utf16be, &nbif_bs_put_utf16be) PRIMOP_LIST(am_bs_put_utf16le, &nbif_bs_put_utf16le) PRIMOP_LIST(am_bs_get_utf16, &nbif_bs_get_utf16) -PRIMOP_LIST(am_bs_validate_unicode, &nbif_bs_validate_unicode) +PRIMOP_LIST(am_is_unicode, &nbif_is_unicode) PRIMOP_LIST(am_bs_validate_unicode_retract, &nbif_bs_validate_unicode_retract) PRIMOP_LIST(am_is_divisible, &nbif_is_divisible) diff --git a/erts/emulator/internal_doc/GarbageCollection.md b/erts/emulator/internal_doc/GarbageCollection.md new file mode 100644 index 0000000000..1d9e3f4160 --- /dev/null +++ b/erts/emulator/internal_doc/GarbageCollection.md @@ -0,0 +1,187 @@ +# Erlang Garbage Collector + +Erlang manages dynamic memory with a [tracing garbage collector](https://en.wikipedia.org/wiki/Tracing_garbage_collection). More precisely a per process generational semi-space copying collector using [Cheney's](#cheney) copy collection algorithm together with a global large object space. + +## Overview + +Each Erlang process has its own stack and heap which are allocated in the same memory block and grow towards each other. When the stack and the heap [meet](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/beam_emu.c#L387), the garbage collector is triggered and memory is reclaimed. If not enough memory was reclaimed, the heap will grow. + +### Creating Data + +Terms are created on the heap by evaluating expressions. There are two major types of terms: [immediate terms](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_term.h#L88-L97) which require no heap space (small integers, atoms, pids, port ids etc) and cons or [boxed terms](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_term.h#L106-L120) (tuple, big num, binaries etc) that do require heap space. Immediate terms do not need any heap space because they are embedded into the containing structure. + +Let's look at an example that returns a tuple with the newly created data. + +```erlang +data(Foo) -> + Cons = [42|Foo], + Literal = {text, "hello world!"}, + {tag, Cons, Literal}. +``` + +In this example we first create a new cons cell with an integer and a tuple with some text. Then a tuple of size three wrapping the other values with an atom tag is created and returned. + +On the heap tuples require a word size for each of its elements as well as for the header. Cons cells always require two words. Adding these things together, we get seven words for the tuples and 26 words for the cons cells. The string `"hello world!"` is a list of cons cells and thus requires 24 words. The atom `tag` and the integer `42` do not require any additional heap memory since it is an *immediate*. Adding all the terms together, the heap space required in this example should be 33 words. + +Compiling this code to beam assembly (`erlc -S`) shows exactly what is happening. + +```erlang + ... + {test_heap,6,1}. + {put_list,{integer,42},{x,0},{x,1}}. + {put_tuple,3,{x,0}}. + {put,{atom,tag}}. + {put,{x,1}}. + {put,{literal,{text,"hello world!"}}}. + return. +``` + +Looking at the assembler code we can see three things; The heap requirement in this function turns out to be only six words, as seen by the `{test_heap,6,1}` instruction. All the allocations are combined to a single instruction. The bulk of the data `{text, "hello world!"}` is a *literal*. Literals, sometimes referred to as constants, are not allocated in the function since they are a part of the module and allocated at load time. + +If there is not enough space available on the heap to satisfy the `test_heap` instructions request for memory, then a garbage collection is initiated. It may happen immediately in the `test_heap` instruction, or it can be delayed until a later time depending on what state the process is in. If the garbage collection is delayed, any memory needed will be allocated in heap fragments. Heap fragments are extra memory blocks that are a part of the young heap, but are not allocated in the contigious area where terms normally reside. See [The young heap](#the-young-heap) for more details. + +### The collector + +Erlang has a copying semi-space garbage collector. This means that when doing a garbage collection, the terms are copied from one distinct area, called the *from space*, to a new clean area, called the *to space*. The collector starts by [scanning the root-set](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L1980) (stack, registers, etc). + + + +It follows all the pointers from the root-set to the heap and copies each term word by word to the *to space*. + +After the header word has been copied a [*move marker*](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.h#L45-L46) is destructively placed in it pointing to the term in the *to space*. Any other term that points to the already moved term will [see this move marker](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L1125) and copy the referring pointer instead. For example, if the have the following Erlang code: + +```erlang +foo(Arg) -> + T = {test, Arg}, + {wrapper, T, T, T}. +``` + +Only one copy of T exists on the heap and during the garbage collection only the first time T is encountered will it be copied. + + + +After [all terms](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L1089) referenced by the root-set have been copied, the collector scans the *to space* and copies all terms that these terms reference. When scanning, the collector steps through each term on the *to space* and any term still referencing the *from space* is copied over to the *to space*. Some terms contain non-term data (the payload of a on heap binary for instance). When encountered by the collector, these values are simply skipped. + + + +Every term object we can reach is copied to the *to space* and stored on top off the *scan stop* line, and then the scan stop is moved to the end of the last object. + + + +When *scan stop* marker [catches up](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L1103) to the *scan start* marker, the garbage collection is done. At this point we can [deallocate](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L1206) the entire *from space* and therefore reclaim the entire young heap. + +## Generational Garbage Collection + +In addition to the collection algorithm described above, the Erlang garbage collector also provides generational garbage collection. An additional heap, called the old heap, is used where the long lived data is stored. The original heap is called the young heap, or sometimes the allocation heap. + +With this in mind we can look at the Erlang's garbage collection again. During the copy stage anything that should be copied to the young *to space* is instead copied to the old *to space* *if* it is [below the *high-watermark*](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L1127). + + + +The [*high-watermark*](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_process.h#L1021) is placed where the previous garbage collection (described in [Overview](#overview)) ended and we have introduced a new area called the old heap. When doing the normal garbage collection pass, any term that is located below the high-watermark is copied to the old *to space* instead of the young. + + + +In the next garbage collection, any pointers to the old heap will be ignored and not scanned. This way the garbage collector does not have to scan the long-lived terms. + +Generational garbage collection aims to increase performance at the expense of memory. This is achieved because only the young, smaller, heap is considered in most garbage collections. + +The generational [hypothesis](#ungar) predicts that most terms tend to die young, and for an immutable language such as Erlang, young terms die even faster than in other languages. So for most usage patterns the data in the new heap will die very soon after it is allocated. This is good because it limits the amount of data copied to the old heap and also because the garbage collection algorithm used is proportional to the amount of live data on the heap. + +One critical issue to note here is that any term on the young heap can reference terms on the old heap but *no* term on the old heap may refer to a term on the young heap. This is due to the nature of the copy algorithm. Anything referenced by an old heap term is not included in the reference tree, root-set and its followers, and hence is not copied. If it was, the data would be lost, fire and brimstone would rise to cover the earth. Fortunately, this comes naturally for Erlang because the terms are immutable and thus there can be no pointers modified on the old heap to point to the young heap. + +To reclaim data from the old heap, both young and old heaps are included during the collection and copied to a common *to space*. Both the *from space* of the young and old heap are then deallocated and the procedure will start over from the beginning. This type of garbage collection is called a full sweep and is triggered when the size of the area under the high-watermark is larger than the size of the free area of the old heap. It can also be triggered by doing a manual call to [erlang:garbage_collect()](http://erlang.org/doc/man/erlang.html#garbage_collect-0), or by running into the young garbage collection limit set by [spawn_opt(fun(),[{fullsweep_after, N}])](http://erlang.org/doc/man/erlang.html#spawn_opt-4) where N is the number of young garbage collections to do before forcing a garbage collection of both young and old heap. + +## The young heap + +The young heap, or the allocation heap, consists of the stack and heap as described in the Overview. However, it also includes any heap fragments that are attached to the heap. All of the heap fragments are considered to be above the high-watermark and part of the young generation. Heap fragments contain terms that either did not fit on the heap, or were created by another process and then attached to the heap. For instance if the bif binary_to_term created a term which does not fit on the current heap without doing a garbage collection, it will create a heap-fragment for the term and then schedule a garbage collection for later. Also if a message is sent to the process, the payload may be placed in a heap-fragment and that fragment is added to young heap when the message is matched in a receive clause. + +This procedure differs from how it worked prior to Erlang/OTP 19.0. Before 19.0, only a contiguous memory block where the young heap and stack resided was considered to be part of the young heap. Heap fragments and messages were immediately copied into the young heap before they could be inspected by the Erlang program. The behaviour introduced in 19.0 is superior in many ways - most significantly it reduces the number of necessary copy operations and the root set for garbage collection. + +## Sizing the heap + +As mentioned in the Overview the size of the heap [grows](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L247) to accommodate more data. Heaps grow in two stages, first a [variation of the Fibonacci sequence](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L199-L208) is used starting at 233 words. Then at about 1 mega words the heap only [grows in 20% increments](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L215-L227). + +There are two occasions when the young heap grows: + +* if the total size of the heap + message and heap fragments exceeds the current heap size. +* if after a fullsweep, the total amount of live objects is greater than 75%. + +There are two occasions when the young heap is shrunk: + +* if after a young collection, the total amount of live objects is less than 25% of the heap and the young heap is "big" +* if after a fullsweep, the total amount of live objects is less than 25% of the heap. + +The old heap is always one step ahead in the heap growth stages than the young heap. + +## Literals + +When garbage collecting a heap (young or old) all literals are left in place and not copied. To figure out if a term should be copied or not when doing a garbage collection the following pseudo code is used: + +```c +if (erts_is_literal(ptr) || (on_old_heap(ptr) && !fullsweep)) { + /* literal or non fullsweep - do not copy */ +} else { + copy(ptr); +} +``` + +The [`erts_is_literal`](https://github.com/erlang/otp/blob/OTP-19.0/erts/emulator/beam/global.h#L1452-L1465) check works differently on different architectures and operating systems. + +On 64 bit systems that allow mapping of unreserved virtual memory areas (most operating systems except Windows), an area of size 1 GB (by default) is mapped and then all literals are placed within that area. Then all that has to be done to determine if something is a literal or not is [two quick pointer checks](https://github.com/erlang/otp/blob/OTP-19.0/erts/emulator/beam/erl_alloc.h#L322-L324). This system relies on the fact that a memory page that has not been touched yet does not take any actual space. So even if 1 GB of virtual memory is mapped, only the memory which is actually needed for literals is allocated in ram. The size of the literal area is configurable through the +MIscs erts_alloc option. + +On 32 bit systems, there is not enough virtual memory space to allocate 1 GB for just literals, so instead small 256 KB sized literal regions are created on demand and a card mark bit-array of the entire 32 bit memory space is then used to determine if a term is a literal or not. Since the total memory space is only 32 bits, the card mark bit-array is only 256 words large. On a 64 bit system the same bit-array would have to be 1 tera words large, so this technique is only viable on 32 bit systems. Doing [lookups in the array](https://github.com/erlang/otp/blob/OTP-19.0/erts/emulator/beam/erl_alloc.h#L316-L319) is a little more expensive then just doing the pointer checks that can be done in 64 bit systems, but not extremely so. + +On 64 bit windows, on which erts_alloc cannot do unreserved virtual memory mappings, a [special tag](https://github.com/erlang/otp/blob/OTP-19.0/erts/emulator/beam/erl_term.h#L59) within the Erlang term object is used to determine if something [is a literal or not](https://github.com/erlang/otp/blob/OTP-19.0/erts/emulator/beam/erl_term.h#L248-L252). This is very cheap, however, the tag is only available on 64 bit machines, and it is possible to do a great deal of other nice optimizations with this tag in the future (like for instance a more compact list implementation) so it is not used on operating systems where it is not needed. + +This behaviour is different from how it worked prior to Erlang/OTP 19.0. Before 19.0 the literal check was done by checking if the pointer pointed to the young or old heap block. If it did not, then it was considered a literal. This lead to considerable overhead and strange memory usage scenarios, so it was removed in 19.0. + +## Binary heap + +The binary heap works as a large object space for binary terms that are greater than 64 bytes (from now on called off-heap binaries). The binary heap is [reference counted](https://en.wikipedia.org/wiki/Reference_counting) and a pointer to the off-heap binary is stored on the process heap. To keep track of when to decrement the reference counter of the off-heap binary, a linked list (the MSO - mark and sweep object list) containing funs and externals as well as off-heap binaries is woven through the heap. After a garbage collection is done, the [MSO list is swept](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L2299) and any off-heap binary that does not have a [move marker](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L2325) written into the header words has its reference [decremented and is potentially freed](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L2344-L2367). + +All items in the MSO list are ordered by the time they were added to the process heap, so when doing a minor garbage collection, the MSO sweeper only has to sweep until it [encounters an off-heap binary that is on the old heap](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L2369). + +### Virtual Binary heap + +Each process has a virtual binary heap associated with it that has the size of all the current off-heap binaries that the process has references to. The virtual binary heap also has a limit and grows and shrinks depending on how off-heap binaries are used by the process. The same growth and shrink mechanisms are used for the binary heap and for the term heap, so first a Fibonacci like series and then 20% growth. + +The virtual binary heap exists in order to [trigger](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/beam_emu.c#L364) garbage collections earlier when potentially there is a very large amount of off-heap binary data that could be reclaimed. This approach does not catch all problems with binary memory not being released soon enough, but it does catch a lot of them. + +## Messages + +Messages can become a part of the process heap at different times. This depends on how the process is configured. +We can configure the behaviour of each process using `process_flag(message_queue_data, off_heap | on_heap)` or we can set a default for all processes at start using the option `+hmqd`. + +What do these different configurations do and when should we use them? +Let's start by going through what happens when one Erlang process sends a message to another. +The sending process needs to do a couple of things: + +1. calculate [how large](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_message.c#L1031) the message to be sent is +2. [allocate enough space](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_message.c#L1033) to fit the entire message +3. [copy](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_message.c#L1040) the message payload +4. allocate a message container with some meta data +5. [insert](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_message.c#L502) the message container in the receiver process' [message queue](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_process.h#L1042) + +The process flag `message_queue_data`, of the receiver process, controls the message allocating strategy of the sender process in step 2 and also how the message data is treated by the garbage collector. + +The procedure above is different from how it worked prior to 19.0. Before 19.0 there was no configuration option, the behaviour was always very similar to how the `on_heap` option is in 19.0. + +### Message allocating strategies + +If set to `on_heap`, the sending process will first attempt to allocate the space for the message directly on the young heap block of the receiving process. +This is not always possible as it requires taking the *main lock* of the receiving process. The main lock is also held when the process is executing. The possibility for a lock conflict is thus likely in an intensely collaborating system. +If the sending process cannot acquire the main lock, a heap fragment is instead created for the message and the message payload is copied onto that. +With the `off_heap` option the sender process always creates heap fragments for messages sent to that process. + +There are a bunch of different tradeoffs that come into play when trying to figure out which of the strategies you want to use. + +Using `off_heap` may seem like a nice way to get a more scalable system as you get very little contention on the main locks, however, allocating a heap fragment is more expensive than allocating on the heap of the receiving process. So if it is very unlikely that contention will occur, it is more efficient to try to allocate the message directly on the receiving process' heap. + +Using `on_heap` will force all messages to be part of on the young heap which will increase the amount of data that the garbage collector has to move. So if a garbage collection is triggered while processing a large amount of messages, they will be copied to the young heap. This in turn will lead to that the messages will quickly be promoted to the old heap and thus increase its size. This may be good or bad depending on exactly what the process does. A large old heap means that the young heap will also be larger, which in turn means that less garbage collections will be triggered while processing the message queue. This will temporarly increase the throughput of the process at the cost of more memory usage. However, if after all the messages have been consumed the process enters a state where a lot less messages are being received. Then it may be a long time before the next fullsweep garbage collection happens and the messages that are on the old heap will be there until that happens. So while `on_heap` is potentially faster than the other modes, it uses more memory for a longer time. This mode is the legacy mode which is almost how the message queue was handled before Erlang/OTP 19.0. + +Which one of these strategies is best depends a lot on what the process is doing and how it interacts with other processes. So, as always, profile the application and see how it behaves with the different options. + + <a name="cheney">[1]</a>: C. J. Cheney. A nonrecursive list compacting algorithm. Commun. ACM, 13(11):677–678, Nov. 1970. + + <a name="ungar">[2]</a>: D. Ungar. Generation scavenging: A non-disruptive high performance storage reclamation algorithm. SIGSOFT Softw. Eng. Notes, 9(3):157–167, Apr. 1984. diff --git a/erts/emulator/internal_doc/beam_makeops.md b/erts/emulator/internal_doc/beam_makeops.md new file mode 100644 index 0000000000..1da8d2ab05 --- /dev/null +++ b/erts/emulator/internal_doc/beam_makeops.md @@ -0,0 +1,1846 @@ +The beam\_makeops script +======================= + +This document describes the **beam\_makeops** script. + +Introduction +------------ + +The **beam\_makeops** Perl script is used at build-time by both the +compiler and runtime system. Given a number of input files (all with +the extension `.tab`), it will generate source files used by the +Erlang compiler and by the runtime system to load and execute BEAM +instructions. + +Essentially those `.tab` files define: + +* External generic BEAM instructions. They are the instructions that +are known to both the compiler and the runtime system. Generic +instructions are stable between releases. New generic instructions +with high numbers than previous instructions can be added in major +releases. The OTP 20 release has 159 external generic instructions. + +* Internal generic instructions. They are known only to the runtime +system and can be changed at any time without compatibility issues. +They are created by transformation rules (described next). + +* Rules for transforming one or more generic instructions to other +generic instructions. The transformation rules allow combining, +splitting, and removal of instructions, as well as shuffling operands. +Because of the transformation rules, the runtime can have many +internal generic instructions that are only known to runtime system. + +* Specific BEAM instructions. The specific instructions are the +instructions that are actually executed by the runtime system. They +can be changed at any time without causing compatibility issues. +The loader translates generic instructions to specific instructions. +In general, for each generic instruction, there exists a family of +specific instructions. The OTP 20 release has 389 specific +instructions. + +* The implementation of specific instructions. + +Generic instructions have typed operands. Here are a few examples of +operands for `move/2`: + + {move,{atom,id},{x,5}}. + {move,{x,3},{x,0}}. + {move,{x,2},{y,1}}. + +When those instructions are loaded, the loader rewrites them +to specific instructions: + + move_cx id 5 + move_xx 3 0 + move_xy 2 1 + +Corresponding to each generic instruction, there is a family of +specific instructions. The types that an instance of a specific +instruction can handle are encoded in the instruction names. For +example, `move_xy` takes an X register number as the first operand and +a Y register number as the second operand. `move_cx` takes a tagged +Erlang term as the first operand and an X register number as the +second operand. + +An example: the move instruction +-------------------------------- + +Using the `move` instruction as an example, we will give a quick +tour to show the main features of **beam\_makeops**. + +In the `compiler` application, in the file `genop.tab`, there is the +following line: + + 64: move/2 + +This is a definition of an external generic BEAM instruction. Most +importantly it specifices that the opcode is 64. It also defines that +it has two operands. The BEAM assembler will use the opcode when +creating `.beam` files. The compiler does not really need the arity, +but it will use it as an internal sanity check when assembling the +BEAM code. + +Let's have a look at `ops.tab` in `erts/emulator/beam`, where the +specific `move` instructions are defined. Here are a few of them: + + move x x + move x y + move c x + +Each specific instructions is defined by following the name of the +instruction with the types for each operand. An operand type is a +single letter. For example, `x` means an X register, `y` +means a Y register, and `c` is a "constant" (a tagged term such as +an integer, an atom, or a literal). + +Now let's look at the implementation of the `move` instruction. There +are multiple files containing implementations of instructions in the +`erts/emulator/beam` directory. The `move` instruction is defined in +`instrs.tab`. It looks like this: + + move(Src, Dst) { + $Dst = $Src; + } + +The implementation for an instruction largely follows the C syntax, +except that the variables in the function head don't have any types. +The `$` before an identifier denotes a macro expansion. Thus, +`$Src` will expand to the code to pick up the source operand for +the instruction and `$Dst` to the code for the destination register. + +We will look at the code for each specific instruction in turn. To +make the code easier to understand, let's first look at the memory +layout for the instruction `{move,{atom,id},{x,5}}`: + + +--------------------+--------------------+ + I -> | 40 | &&lb_move_cx | + +--------------------+--------------------+ + | Tagged atom 'id' | + +--------------------+--------------------+ + +This example and all other examples in the document assumes a 64-bit +archictecture, and furthermore that pointers to C code fit in 32 bits. + +`I` in the BEAM virtual machine is the instruction pointer. When BEAM +executes an instruction, `I` points to the first word of the +instruction. + +`&&lb_move_cx` is the address to C code that implements `move_cx`. It +is stored in the lower 32 bits of the word. In the upper 32 bits is +the byte offset to the X register; the register number 5 has been +multiplied by the word size size 8. + +In the next word the tagged atom `id` is stored. + +With that background, we can look at the generated code for `move_cx` +in `beam_hot.h`: + + OpCase(move_cx): + { + BeamInstr next_pf = BeamCodeAddr(I[2]); + xb(BeamExtraData(I[0])) = I[1]; + I += 2; + ASSERT(VALID_INSTR(next_pf)); + GotoPF(next_pf); + } + +We will go through each line in turn. + +* `OpCase(move_cx):` defines a label for the instruction. The +`OpCase()` macro is defined in `beam_emu.c`. It will expand this line +to `lb_move_cx:`. + +* `BeamInstr next_pf = BeamCodeAddr(I[2]);` fetches the pointer to +code for the next instruction to be executed. The `BeamCodeAddr()` +macro extracts the pointer from the lower 32 bits of the instruction +word. + +* `xb(BeamExtraData(I[0])) = I[1];` is the expansion of `$Dst = $Src`. +`BeamExtraData()` is a macro that will extract the upper 32 bits from +the instruction word. In this example, it will return 40 which is the +byte offset for X register 5. The `xb()` macro will cast a byte +pointer to an `Eterm` pointer and dereference it. The `I[1]` on +the right side of the `=` fetches an Erlang term (the atom `id` in +this case). + +* `I += 2` advances the instruction pointer to the next +instruction. + +* In a debug-compiled emulator, `ASSERT(VALID_INSTR(next_pf));` makes +sure that `next_pf` is a valid instruction (that is, that it points +within the `process_main()` function in `beam_emu.c`). + +* `GotoPF(next_pf);` transfers control to the next instruction. + +Now let's look at the implementation of `move_xx`: + + OpCase(move_xx): + { + Eterm tmp_packed1 = BeamExtraData(I[0]); + BeamInstr next_pf = BeamCodeAddr(I[1]); + xb((tmp_packed1>>BEAM_TIGHT_SHIFT)) = xb(tmp_packed1&BEAM_TIGHT_MASK); + I += 1; + ASSERT(VALID_INSTR(next_pf)); + GotoPF(next_pf); + } + +We will go through the lines that are new or have changed compared to +`move_cx`. + +* `Eterm tmp_packed1 = BeamExtraData(I[0]);` picks up both X register +numbers packed into the upper 32 bits of the instruction word. + +* `BeamInstr next_pf = BeamCodeAddr(I[1]);` pre-fetches the address of +the next instruction. Note that because both X registers operands fits +into the instruction word, the next instruction is in the very next +word. + +* `xb((tmp_packed1>>BEAM_TIGHT_SHIFT)) = xb(tmp_packed1&BEAM_TIGHT_MASK);` +copies the source to the destination. (For a 64-bit architecture, +`BEAM_TIGHT_SHIFT` is 16 and `BEAM_TIGHT_MASK` is `0xFFFF`.) + +* `I += 1;` advances the instruction pointer to the next instruction. + +`move_xy` is almost identical to `move_xx`. The only difference is +the use of the `yb()` macro instead of `xb()` to reference the +destination register: + + OpCase(move_xy): + { + Eterm tmp_packed1 = BeamExtraData(I[0]); + BeamInstr next_pf = BeamCodeAddr(I[1]); + yb((tmp_packed1>>BEAM_TIGHT_SHIFT)) = xb(tmp_packed1&BEAM_TIGHT_MASK); + I += 1; + ASSERT(VALID_INSTR(next_pf)); + GotoPF(next_pf); + } + +### Transformation rules ### + +Next let's look at how we can do some optimizations using transformation +rules. For simple instructions such as `move/2`, the instruction dispatch +overhead can be substantial. A simple optimization is to combine common +instructions sequences to a single instruction. One such common sequence +is multiple `move` instructions moving X registers to Y registers. + +Using the following rule we can combine two `move` instructions +to a `move2` instruction: + + move X1=x Y1=y | move X2=x Y2=y => move2 X1 Y1 X2 Y2 + +The left side of the arrow (`=>`) is a pattern. If the pattern +matches, the matching instructions will be replaced by the +instructions on the right side. Variables in a pattern must start +with an uppercase letter just as in Erlang. A pattern variable may be +followed `=` and one or more type letters to constrain the match to +one of those types. The variables that are bound on the left side can +be used on the right side. + +We will also need to define a specific instruction and an implementation: + + # In ops.tab + move2 x y x y + + // In instrs.tab + move2(S1, D1, S2, D2) { + Eterm V1, V2; + V1 = $S1; + V2 = $S2; + $D1 = V1; + $D2 = V2; + } + +When the loader has found a match and replaced the matched instructions, +it will match the new instructions against the transformation rules. +Because of that, we can define the rule for a `move3/6` instruction +as follows: + + move2 X1=x Y1=y X2=x Y2=y | move X3=x Y3=y => \ + move3 X1 Y1 X2 Y2 X3 Y3 + +(A `\` before a newline can be used to break a long line for readability.) + +It would also be possible to define it like this: + + move X1=x Y1=y | move X2=x Y2=y | move X3=x Y3=y => \ + move3 X1 Y1 X2 Y2 X3 Y3 + +but in that case it must be defined before the rule for `move2/4` +because the first matching rule will be applied. + +One must be careful not to create infinite loops. For example, if we +for some reason would want to reverse the operand order for the `move` +instruction, we must not do like this: + + move Src Dst => move Dst Src + +The loader would swap the operands forever. To avoid the loop, we must +rename the instruction. For example: + + move Src Dst => assign Dst Src + +This concludes the quick tour of the features of **beam\_makeops**. + +Short overview of instruction loading +------------------------------------- + +To give some background to the rest of this document, here follows a +quick overview of how instructions are loaded. + +* The loader reads and decodes one instruction at a time from the BEAM +code and creates a generic instruction. Many transformation rules +must look at multiple instructions, so the loader will +keep multiple generic instructions in a linked list. + +* The loader tries to apply transformation rules against the +generic instructions in the linked list. If a rule matches, the +matched instructions will be removed and replaced with new +generic instructions constructed from the right side of the +transformation. + +* If a transformation rule matched, the loader applies the +transformation rules again. + +* If no transformation rule match, the loader will begin rewriting +the first of generic instructions to a specific instruction. + +* First the loader will search for a specific operation where the +types for all operands match the type for the generic instruction. +The first matching instruction will be selected. **beam\_makeops** +has ordered the specific instructions so that instructions with more +specific operands comes before instructions with less specific +operands. For example, `move_nx` is more specific than `move_cx`. If +the first operand is `[]` (NIL), `move_nx` will be selected. + +* Given the opcode for the selected specific instruction, the loader +looks up the pointer to the C code for the instruction and stores +in the code area for the module being loaded. + +* The loader translates each operand to a machine word and stores it +in the code area. The operand type for the selected specific +instruction guides the translation. For example, if the type is `e`, +the value of the operand is an index into an arry of external +functions and will be translated to a pointer to the export entry for +the function to call. If the type is `x`, the number of the X +register will be multiplied by the word size to produce a byte offset. + +* The loader runs the packing engine to pack multiple operands into a +single word. The packing engine is controlled by a small program, +which is a string where each character is an instruction. For +example, the code to pack the operands for `move_xy` is `"22#"` (on a +64-bit machine). That program will pack the byte offsets for both +registers into the same word as the pointer to C code. + +Running beam_makeops +-------------------- + +**beam\_makeops** is found in `$ERL_TOP/erts/emulator/utils`. Options +start with a hyphen (`-`). The options are followed by the name of +the input files. By convention, all input files have the extension +`.tab`, but is not enforced by **beam\_makeops**. + +### The -outdir option ### + +The option `-outdir Directory` specifies the output directory for +the generated files. Default is the current working directory. + +### Running beam_makeops for the compiler ### + +Give the option `-compiler` to produce output files for the compiler. +The following files will be written to the output directory: + +* `beam_opcodes.erl` - Used primarily by `beam_asm` and `beam_diasm`. + +* `beam_opcode.hrl` - Used by `beam_asm`. It contains tag definitions +used for encoding instruction operands. + +The input file should only contain the definition of BEAM_FORMAT_NUMBER +and external generic instructions. (Everything else would be ignored.) + +### Running beam_makeops for the emulator ### + +Give the option `-emulator` to produce output files for the emulator. +The following output files will be generated in the output directory. + +* `beam_hot.h`, `beam_warm.h`, `beam_cold.`h - Implementation of +instructions. Included inside the `process_main()` function in +`beam_emu.c`. + +* `beam_opcodes.c` - Defines static data used by the loader +(`beam_load.c`). Data about generic instructions, specific +instructions (including how to pack their operands), and +transformation rules are all part of this file. + +* `beam_opcodes.h` - Miscellanous preprocessor definitions, mainly +used by `beam_load.c` but also by `beam_{hot,warm,cold}.h`. + +* `beam_pred_funcs.h` - Included by `beam_load.c`. Contains defines +needed to call guard constraints in transformation rules. + +* `beam_tr_funcs.h` - Included by `beam_load.c`. Contains defines +needed to call a C function to the right of a transformation rule. + +The following options can be given: + +* `wordsize 32|64` - Defines the word size. Default is 32. + +* `code-model Model` - The code model as given to `-mcmodel` option +for GCC. Default is `unknown`. If the code model is `small` (and +the word size is 64 bits), **beam\_makeops** will pack operands +into the upper 32 bits of the instruction word. + +* `DSymbol=0|1` - Defines the value for a symbol. The symbol can be +used in `%if` and `%unless` directives. + +Syntax of .tab files +-------------------- + +### Comments ### + +Any line starting with `#` is a comment and is ignored. + +A line with `//` is also a comment. It is recommended to only +use this style of comments in files that define implementations of +instructions. + +A long line can be broken into shorter lines by a placing a`\` before +the newline. + +### Variable definitions ### + +A variable definition binds a variable to a Perl variable. It is only +meaningful to add a new definition if **beam\_makeops** is updated +at the same time to use the variable. A variable definition looks this: + +*name*=*value*[;] + +where *name* is the name of a Perl variable in **beam\_makeops**, +and *value* is the value to be given to the variable. The line +can optionally end with a `;` (to avoid messing up the +C indentation mode in Emacs). + +Here follows a description of the variables that are defined. + +#### BEAM\_FORMAT\_NUMBER #### + +`genop.tab` has the following definition: + + BEAM_FORMAT_NUMBER=0 + +It defines the version of the instruction set (which will be +included in the code header in the BEAM code). Theoretically, +the version could be bumped, and all instructions changed. +In practice, we would have two support two instruction sets +in the runtime system for at least two releases, so it will +probably never happen in practice. + +#### GC\_REGEXP #### + +In `macros.tab`, there is a definition of `GC_REGEXP`. +It will be described in [a later section](#the-gc_regexp-definition). + +### Directives ### + +There are directives to classify specific instructions depending +on how frequently used they are: + +* `%hot` - Implementation will be placed in `beam_hot.h`. Frequently +executed instructions. + +* `%warm` - Implementation will be placed in `beam_warm.h`. Binary +syntax instructions. + +* `%cold` - Implementation will be placed in `beam_cold.h`. Trace +instructions and infrequently used instructions. + +Default is `%hot`. The directives will be applied to declarations +of the specific instruction that follow. Here is an example: + + %cold + is_number f? xy + %hot + +#### Conditional compilation directives #### + +The `%if` directive includes a range of lines if a condition is +true. For example: + + %if ARCH_64 + i_bs_get_integer_32 x f? x + %endif + +The specific instruction `i_bs_get_integer_32` will only be defined +on a 64-bit machine. + +The condition can be inverted by using `%unless` instead of `%if`: + + %unless NO_FPE_SIGNALS + fcheckerror p => i_fcheckerror + i_fcheckerror + fclearerror + %endif + +It is also possible to add an `%else` clause: + + %if ARCH_64 + BS_SAFE_MUL(A, B, Fail, Dst) { + Uint64 res = ($A) * ($B); + if (res / $B != $A) { + $Fail; + } + $Dst = res; + } + %else + BS_SAFE_MUL(A, B, Fail, Dst) { + Uint64 res = (Uint64)($A) * (Uint64)($B); + if ((res >> (8*sizeof(Uint))) != 0) { + $Fail; + } + $Dst = res; + } + %endif + +#### Symbols that are defined in directives #### + +The following symbols are always defined. + +* `ARCH_64` - is 1 for a 64-bit machine, and 0 otherwise. +* `ARCH_32` - is 1 for 32-bit machine, and 1 otherwise. + +The `Makefile` for building the emulator currently defines the +following symbols by using the `-D` option on the command line for +**beam\_makeops**. + +* `NO_FPE_SIGNALS` - 1 if FPE signals are not enable in runtime system, +0 otherwise. +* `USE_VM_PROBES` - 1 if the runtime system is compiled to use VM probes (support for dtrace or systemtap), 0 otherwise. + +### Defining external generic instructions ### + +External generic BEAM instructions are known to both the compiler and +the runtime system. They remain stable between releases. A new major +release may add more external generic instructions, but must not change +the semantics for a previously defined instruction. + +The syntax for an external generic instruction is as follows: + +*opcode*: [-]*name*/*arity* + +*opcode* is an integer greater than or equal to 1. + +*name* is an identifier starting with a lowercase letter. *arity* is +an integer denoting the number of operands. + +*name* can optionally be preceded by `-` to indicate that it has been +obsoleted. The compiler is not allowed to generate BEAM files that +use obsolete instructions and the loader will refuse to load BEAM +files that use obsolete instructions. + +It only makes sense to define external generic instructions in the +file `genop.tab` in `lib/compiler/src`, because the compiler must +know about them in order to use them. + +New instructions must be added at the end of the file, with higher +numbers than the previous instructions. + +### Defining internal generic instructions ### + +Internal generic instructions are known only to the runtime +system and can be changed at any time without compatibility issues. + +There are two ways to define internal generic instructions: + +* Implicitly when a specific instruction is defined. This is by far +the most common way. Whenever a specific instruction is created, +**beam\_makeops** automatically creates an internal generic instruction +if it does not previously exist. + +* Explicitly. This is necessary only when a generic instruction does +not have any corresponding specific instruction. + +The syntax for an internal generic instruction is as follows: + +*name*/*arity* + +*name* is an identifier starting with a lowercase letter. *arity* is +an integer denoting the number of operands. + +### About generic instructions in general ### + +Each generic instruction has an opcode. The opcode is an integer, +greater than or equal to 1. For an external generic instruction, it +must be explicitly given `genop.tab`, while internal generic +instructions are automatically numbered by **beam\_makeops**. + +The identity of a generic instruction is its name combined with its +arity. That means that it is allowed to define two distinct generic +instructions having the same name but with different arities. For +example: + + move_window/5 + move_window/6 + +Each operand of a generic instruction is tagged with its type. A generic +instruction can have one of the following types: + +* `x` - X register. + +* `y` - Y register. + +* `l` - Floating point register number. + +* `i` - Tagged literal integer. + +* `a` - Tagged literal atom. + +* `n` - NIL (`[]`, the empty list). + +* `q` - Literal that don't fit in a word, that is an object stored on +the heap such as a list or tuple. Any heap object type is supported, +even types that don't have real literals such as external references. + +* `f` - Non-zero failure label. + +* `p` - Zero failure label. + +* `u` - Untagged integer that fits in a machine word. It is used for many +different purposes, such as the number of live registers in `test_heap/2`, +as a reference to the export for `call_ext/2`, and as the flags operand for +binary syntax instructions. When the generic instruction is translated to a +specific instruction, the type for the operand in the specific operation will +tell the loader how to treat the operand. + +* `o` - Overflow. If the value for an `u` operand does not fit in a machine +word, the type of the operand will be changed to `o` (with no associated +value). Currently only used internally in the loader in the guard constraint +function `binary_too_big()`. + +* `v` - Arity value. Only used internally in the loader. + + +### Defining specific instructions ### + +The specific instructions are known only to the runtime system and +are the instructions that are actually executed. They can be changed +at any time without causing compatibility issues. + +A specific instruction can have at most 6 operands. + +A specific instruction is defined by first giving its name followed by +the types for each operand. For example: + + move x y + +Internally, for example in the generated code and in the output from +the BEAM disassembler, the instruction `move x y` will be called `move_xy`. + +The name for a specific instruction is an identifier starting with a +lowercase letter. A type is an lowercase or uppercase letter. + +All specific instructions with a given name must have the same number +of operands. That is, the following is **not** allowed: + + move x x + move x y x y + +Here follows the type letters that more or less directly corresponds +to the types for generic instructions. + +* `x` - X register. Will be loaded as a byte offset to the X register +relative to the base of X register array. (Can be packed with other +operands.) + +* `y` - Y register. Will be loaded as a byte offset to the Y register +relative to the stack frame. (Can be packed with other operands.) + +* `r` - X register 0. An implicit operand that will not be stored in +the loaded code. + +* `l` - Floating point register number. (Can be packed with other +operands.) + +* `i` - Tagged literal integer (a SMALL that will fit in one word). + +* `a` - Tagged atom. + +* `n` - NIL or the empty list. (Will not be stored in the loaded code.) + +* `q` - Tagged CONS or BOXED pointer. That is, a term such as a list +or tuple. Any heap object type is supported, even types that don't +have real literals such as external references. + +* `f` - Failure label (non-zero). The target for a branch +or call instruction. + +* `p` - The 0 failure label, meaning that an exception should be raised +if the instruction fails. (Will not be stored in the loaded code.) + +* `c` - Any literal term; that is, immediate literals such as SMALL, +and CONS or BOXED pointers to literals. (Can be used where the +operand in the generic instruction has one of the types `i`, `a`, `n`, +or `q`.) + +The types that follow do a type test of the operand at runtime; thus, +they are generally more expensive in terms of runtime than the types +described earlier. However, those operand types are needed to avoid a +combinatorial explosion in the number of specific instructions and +overall code size of `process_main()`. + +* `s` - Tagged source: X register, Y register, or a literal term. The +tag will be tested at runtime to retrieve the value from an X +register, a Y register, or simply use the value as a tagged Erlang +term. (Implementation note: An X register is tagged as a pid, and a Y +register as a port. Therefore the literal term must not contain a +port or pid.) + +* `S` - Tagged source register (X or Y). The tag will be tested at +runtime to retrieve the value from an X register or a Y register. Slighly +cheaper than `s`. + +* `d` - Tagged destination register (X or Y). The tag will be tested +at runtime to set up a pointer to the destination register. If the +instrution performs a garbarge collection, it must use the +`$REFRESH_GEN_DEST()` macro to refresh the pointer before storing to +it (there are more details about that in a later section). + +* `j` - A failure label (combination of `f` and `p`). If the branch target 0, +an exception will be raised if instruction fails, otherwise control will be +transfered to the target address. + +The types that follows are all applied to an operand that has the `u` +type. + +* `t` - An untagged integer that will fit in 12 bits (0-4096). It can be +packed with other operands in a word. Most often used as the number +of live registers in instructions such as `test_heap`. + +* `I` - An untagged integer that will fit in 32 bits. It can be +packed with other operands in a word on a 64-bit system. + +* `W` - Untagged integer or pointer. Not possible to pack with other +operands. + +* `e` - Pointer to an export entry. Use by call instructions that call +other modules, such as `call_ext`. + +* `L` - A label. Only used by the `label/1` instruction. + +* `b` - Pointer to BIF. Used by instructions that BIFs, such as +`call_bif`. + +* `A` - A tagged arityvalue. Used in instructions that test the arity +of a tuple. + +* `P` - A byte offset into a tuple. + +* `Q` - A byte offset into the stack. Used for updating the frame +pointer register. Can be packed with other operands. + +When the loader translates a generic instruction a specific +instruction, it will choose the most specific instruction that will +fit the types. Consider the following two instructions: + + move c x + move n x + +The `c` operand can encode any literal value, including NIL. The +`n` operand only works for NIL. If we have the generic instruction +`{move,nil,{x,1}}`, the loader will translate it to `move_nx 1` +because `move n x` is more specific. `move_nx` could be slightly +faster or smaller (depending on the architecture), because the `[]` +is not stored explicitly as an operand. + +#### Syntactic sugar for specific instructions #### + +It is possible to specify more than one type letter for each operand. +Here is an example: + + move cxy xy + +This is syntactic sugar for: + + move c x + move c y + move x x + move x y + move y x + move y y + +Note the difference between `move c xy` and `move c d`. Note that `move c xy` +is equivalent to the following two definitions: + + move c x + move c y + +On the other hand, `move c d` is a single instruction. At runtime, +the `d` operand will be tested to see whether it refers to an X +register or a Y register, and a pointer to the register will be set +up. + +#### The '?' type modifier #### + +The character `?` can be added to the end of an operand to indicate +that the operand will not be used every time the instruction is executed. +For example: + + allocate_heap t I t? + is_eq_exact f? x xy + +In `allocate_heap`, the last operand is the number of live registers. +It will only be used if there is not enough heap space and a garbage +collection must be performed. + +In `is_eq_exact`, the failure address (the first operand) will only be +used if the two register operands are not equal. + +Knowing that an operand is not always used can improve how packing +is done for some instructions. + +For the `allocate_heap` instruction, without the `?` the packing would +be done like this: + + +--------------------+--------------------+ + I -> | Stack needed | &&lb_allocate_heap + + +--------------------+--------------------+ + | Heap needed | Live registers + + +--------------------+--------------------+ + +"Stack needed" and "Heap needed" are always used, but they are in +different words. Thus, at runtime the `allocate_heap` instruction +must read both words from memory even though it will not always use +"Live registers". + +With the `?`, the operands will be packed like this: + + +--------------------+--------------------+ + I -> | Live registers | &&lb_allocate_heap + + +--------------------+--------------------+ + | Heap needed | Stack needed + + +--------------------+--------------------+ + +Now "Stack needed" and "Heap needed" are in the same word. + +### Defining transformation rules ### + +Transformation rules are used to rewrite generic instructions to other +generic instructions. The transformations rules are applied +repeatedly until no rule match. At that point, the first instruction +in the resulting instruction sequence will be converted to a specific +instruction and added to the code for the module being loaded. Then +the transformation rules for the remaining instructions are run in the +same way. + +A rule is recognized by its right-pointer arrow: `=>`. To the left of +the arrow is one or more instruction patterns, separated by `|`. To +the right of the arrow is zero or more instructions, separated by `|`. +If the instructions from the BEAM code matches the instruction +patterns on the left side, they will be replaced with instructions on +the right side (or removed if there are no instructions on the right). + +#### Defining instruction patterns #### + +We will start looking at the patterns on the left side of the arrow. + +A pattern for an instruction consists of its name, followed by a pattern +for each of its operands. The operand patterns are separated by spaces. + +The simplest possible pattern is a variable. Just like in Erlang, +a variable must begin with an uppercase letter. If the same variable is +used in multiple operands, the pattern will only match if the operands +are equal. For example: + + move Same Same => + +This pattern will match if the operands for `move` are the same. If +the pattern match, the instruction will be removed. (That used to be an +actual rule a long time ago when the compiler would occasionally produce +instructions such as `{move,{x,2},{x,2}}`.) + +Variables that have been bound on the left side can be used on the +right side. For example, this rule will rewrite all `move` instructions +to `assign` instructions with the operands swapped: + + move Src Dst => assign Dst Src + +If we only want to match operands of a certain type, we can +use a type constraint. A type constraint consists of one or more +lowercase letters, each specifying a type. For example: + + is_integer Fail an => jump Fail + +The second operand pattern, `an`, will match if the second operand is +either an atom or NIL (the empty list). In case of a match, the +`is_integer/2` instruction will be replaced with a `jump/1` +instruction. + +An operand pattern can bind a variable and constrain the type at the +same time by following the variable with a `=` and the constraint. +For example: + + is_eq_exact Fail=f R=xy C=q => i_is_eq_exact_literal Fail R C + +Here the `is_eq_exact` instruction is replaced with a specialized instruction +that only compares literals, but only if the first operand is a register and +the second operand is a literal. + +#### Further constraining patterns #### + +In addition to specifying a type letter, the actual value for the type can +be specified. For example: + + move C=c x==1 => move_x1 C + +Here the second operand of `move` is constrained to be X register 1. + +When specifying an atom constraint, the atom is written as it would be +in the C source code. That is, it needs an `am_` prefix, and it must +be listed in `atom.names`. For example: + + is_boolean Fail=f a==am_true => + is_boolean Fail=f a==am_false => + +There are several constraints available for testing whether a call is to a BIF +or a function. + +The constraint `u$is_bif` will test whether the given operand refers to a BIF. +For example: + + call_ext u Bif=u$is_bif => call_bif Bif + call_ext u Func => i_call_ext Func + +The `call_ext` instruction can be used to call functions written in +Erlang as well as BIFs (or more properly called SNIFs). The +`u$is_bif` constraint will match if the operand refers to a BIF (that +is, if it is listed in the file `bif.tab`). Note that `u$is_bif` +should only be applied to operands that are known to contain an index +to the import table chunk in the BEAM file (such operands have the +type `b` or `e` in the corresponding specific instruction). If +applied to other `u` operands, it will at best return a nonsense +result. + +The `u$is_not_bif` constraint matches if the operand does not refer to +a BIF (not listed in `bif.tab`). For example: + + move S X0=x==0 | line Loc | call_ext_last Ar Func=u$is_not_bif D => \ + move S X0 | call_ext_last Ar Func D + +The `u$bif:Module:Name/Arity` constraint tests whether the given +operand refers to a specific BIF. Note that `Module:Name/Arity` +**must** be an existing BIF defined in `bif.tab`, or there will +be a compilation error. It is useful when a call to a specific BIF +should be replaced with an instruction as in this example: + + gc_bif2 Fail Live u$bif:erlang:splus/2 S1 S2 Dst => \ + gen_plus Fail Live S1 S2 Dst + +Here the call to the GC BIF `'+'/2` will be replaced with the instruction +`gen_plus/5`. Note that the same name as used in the C source code must be +used for the BIF, which in this case is `splus`. It is defined like this +in `bit.tab`: + + ubif erlang:'+'/2 splus_2 + +The `u$func:Module:Name/Arity` will test whether the given operand is a +a specific function. Here is an example: + + bif1 Fail u$func:erlang:is_constant/1 Src Dst => too_old_compiler + +`is_constant/1` used to be a BIF a long time ago. The transformation +replaces the call with the `too_old_compiler` instruction which will produce +a nicer error message than the default error would be for a missing guard BIF. + +#### Type constraints allowed in patterns #### + +Here are all type letters that are allowed on the left side of a transformation +rule. + +* `u` - An untagged integer that fits in a machine word. + +* `x` - X register. + +* `y` - Y register. + +* `l` - Floating point register number. + +* `i` - Tagged literal integer. + +* `a` - Tagged literal atom. + +* `n` - NIL (`[]`, the empty list). + +* `q` - Literals that don't fit in a word, such as list or tuples. + +* `f` - Non-zero failure label. + +* `p` - The zero failure label. + +* `j` - Any label. Equivalent to `fp`. + +* `c` - Any literal term. Equivalent to `ainq`. + +* `s` - X register, Y register, or any literal term. Equivalent to `xyc`. + +* `d` - X or Y register. Equivalent to `xy`. (In a pattern `d` will +match both source and destination registers. As an operand in a specific +instruction, it must only be used for a destination register.) + +* `o` - Overflow. An untagged integer that does not fit in a machine word. + +#### Guard constraints #### + +If the constraints described so far is not enough, additional +constraints can be written in C in `beam_load.c` and be called as a +guard function on the left side of the transformation. If the guard +function returns a non-zero value, the matching of the rule will +continue, otherwise the match will fail. For example: + + ensure_map Lit=q | literal_is_map(Lit) => + +The guard test `literal_is_map/1` tests whether the given literal is a map. +If the literal is a map, the instruction is unnecessary and can be removed. + +It is outside the scope for this document to describe in detail how such +guard functions are written, but for the curious here is the implementation +of `literal_is_map()`: + + static int + literal_is_map(LoaderState* stp, GenOpArg Lit) + { + Eterm term; + + ASSERT(Lit.type == TAG_q); + term = stp->literals[Lit.val].term; + return is_map(term); + } + +#### Handling instruction with variable number of operands #### + +Some instructions, such as `select_val/3`, essentially has a variable +number of operands. Such instructions have a `{list,[...]}` operand +as their last operand in the BEAM assembly code. For example: + + {select_val,{x,0}, + {f,1}, + {list,[{atom,b},{f,4},{atom,a},{f,5}]}}. + +The loader will convert a `{list,[...]}` operand to an `u` operand whose +value is the number of elements in the list, followed by each element in +the list. The instruction above would be translated to the following +generic instruction: + + {select_val,{x,0},{f,1},{u,4},{atom,b},{f,4},{atom,a},{f,5}} + +To match a variable number of arguments we need to use the special +operand type `*` like this: + + select_val Src=aiq Fail=f Size=u List=* => \ + i_const_select_val Src Fail Size List + +This transformation renames a `select_val/3` instruction +with a constant source operand to `i_const_select_val/3`. + +#### Constructing new instructions on the right side #### + +The most common operand on the right side is a variable that was bound while +matching the left side. For example: + + trim N Remaining => i_trim N + +An operand can also be a type letter to construct an operand of that type. +Each type has a default value. For example, the type `x` has the default +value 1023, which is the highest X register. That makes `x` on the right +side a convenient shortcut for a temporary X register. For example: + + is_number Fail Literal=q => move Literal x | is_number Fail x + +If the second operand for `is_number/2` is a literal, it will be moved to +X register 1023. Then `is_number/2` will test whether the value stored in +X register 1023 is a number. + +This kind of transformation is useful when it is rare that an operand can +be anything else but a register. In the case of `is_number/2`, the second +operand is always a register unless the compiler optimizations have been +disabled. + +If the default value is not suitable, the type letter can be followed +by `=` and a value. Most types take an integer value. The value for +an atom is written the same way as in the C source code. For example, +the atom `false` is written as `am_false`. The atom must be listed in +`atom.names`. + +Here is an example showing how values can be specified: + + bs_put_utf32 Fail=j Flags=u Src=s => \ + i_bs_validate_unicode Fail Src | \ + bs_put_integer Fail i=32 u=1 Flags Src + +#### Type letters on the right side #### + +Here follows all types that are allowed to be used in operands for +instructions being constructed on the right side of a transformation +rule. + +* `u` - Construct an untagged integer. The default value is 0. + +* `x` - X register. The default value is 1023. That makes `x` convenient to +use as a temporary X register. + +* `y` - Y register. The default value is 0. + +* `l` - Foating point register number. The default value is 0. + +* `i` - Tagged literal integer. The default value is 0. + +* `a` - Tagged atom. The default value is the empty atom (`am_Empty`). + +* `n` - NIL (`[]`, the empty list). + +#### Function call on the right side #### + +Transformations that are not possible to describe with the rule +language as described here can be written as a C function in +`beam_load.c` and called from the right side of a transformation. The +left side of the transformation will perform the match and bind +operands to variables. The variables can then be passed to a +generator function on the right side. For example: + + bif2 Fail=j u$bif:erlang:element/2 Index=s Tuple=xy Dst=d => \ + gen_element(Jump, Index, Tuple, Dst) + +This transformation rule matches a call to the BIF `element/2`. +The operands will be captured and the function `gen_element()` will +be called. + +`gen_element()` will produce one of two instructions depending +on `Index`. If `Index` is an integer in the range from 1 up to +the maximum tuple size, the instruction `i_fast_element/2` will +be produced, otherwise the instruction `i_element/4` will be +produced. The corresponding specific instructions are: + + i_fast_element xy j? I d + i_element xy j? s d + +The `i_fast_element/2` instruction is faster because the tuple is +already an untagged integer. It also knows that the index is at least +1, so it does not have to test for that. The `i_element/4` +instruction will have to fetch the index from a register, test that it +is an integer, and untag the integer. + +It is outside the scope of this document to describe in detail how +generator functions are written, but for the curious, here is the +implementation of `gen_element()`: + + static GenOp* + gen_element(LoaderState* stp, GenOpArg Fail, + GenOpArg Index, GenOpArg Tuple, GenOpArg Dst) + { + GenOp* op; + + NEW_GENOP(stp, op); + op->arity = 4; + op->next = NULL; + + if (Index.type == TAG_i && Index.val > 0 && + Index.val <= ERTS_MAX_TUPLE_SIZE && + (Tuple.type == TAG_x || Tuple.type == TAG_y)) { + op->op = genop_i_fast_element_4; + op->a[0] = Tuple; + op->a[1] = Fail; + op->a[2].type = TAG_u; + op->a[2].val = Index.val; + op->a[3] = Dst; + } else { + op->op = genop_i_element_4; + op->a[0] = Tuple; + op->a[1] = Fail; + op->a[2] = Index; + op->a[3] = Dst; + } + + return op; + } +} + +### Defining the implementation ### + +The actual implementation of instructions are also defined in `.tab` +files processed by **beam\_makeops**. For practical reasons, +instruction definitions are stored in several files, at the time of +writing in the following files: + + bif_instrs.tab + arith_instrs.tab + bs_instrs.tab + float_instrs.tab + instrs.tab + map_instrs.tab + msg_instrs.tab + select_instrs.tab + trace_instrs.tab + +There is also a file that only contains macro definitions: + + macros.tab + +The syntax of each file is similar to C code. In fact, most of +the contents *is* C code, interspersed with macro invocations. + +To allow Emacs to auto-indent the code, each file starts with the +following line: + + // -*- c -*- + +To avoid messing up the indentation, all comments are written +as C++ style comments (`//`) instead of `#`. Note that a comment +must start at the beginning of a line. + +The meat of an instruction definition file are macro definitions. +We have seen this macro definition before: + + move(Src, Dst) { + $Dst = $Src; + } + +A macro definitions must start at the beginning of the line (no spaces +allowed), the opening curly bracket must be on the same line, and the +finishing curly bracket must be at the beginning of a line. It is +recommended that the macro body is properly indented. + +As a convention, the macro arguments in the head all start with an +uppercase letter. In the body, the macro arguments can be expanded +by preceding them with `$`. + +A macro definition whose name and arity matches a family of +specific instructions is assumed to be the implementation of that +instruction. + +A macro can also be invoked from within another macro. For example, +`move_deallocate_return/2` avoids repeating code by invoking +`$deallocate_return()` as a macro: + + move_deallocate_return(Src, Deallocate) { + x(0) = $Src; + $deallocate_return($Deallocate); + } + +Here is the definition of `deallocate_return/1`: + + deallocate_return(Deallocate) { + //| -no_next + int words_to_pop = $Deallocate; + SET_I((BeamInstr *) cp_val(*E)); + E = ADD_BYTE_OFFSET(E, words_to_pop); + CHECK_TERM(x(0)); + DispatchReturn; + } + +The expanded code for `move_deallocate_return` will look this: + + OpCase(move_deallocate_return_cQ): + { + x(0) = I[1]; + do { + int words_to_pop = Qb(BeamExtraData(I[0])); + SET_I((BeamInstr *) cp_val(*E)); + E = ADD_BYTE_OFFSET(E, words_to_pop); + CHECK_TERM(x(0)); + DispatchReturn; + } while (0); + } + +When expanding macros, **beam\_makeops** wraps the expansion in a +`do`/`while` wrapper unless **beam\_makeops** can clearly see that no +wrapper is needed. In this case, the wrapper is needed. + +Note that arguments for macros cannot be complex expressions, because +the arguments are split on `,`. For example, the following would +not work because **beam\_makeops** would split the expression into +two arguments: + + $deallocate_return(get_deallocation(y, $Deallocate)); + +#### Code generation directives #### + +Within macro definitions, `//` comments are in general not treated +specially. They will be copied to the file with the generated code +along with the rest of code in the body. + +However, there is an exception. Within a macro definition, a line that +starts with whitespace followed by `//|` is treated specially. The +rest of the line is assumed to contain directives to control code +generation. + +Currently, two code generation directives are recognized: + +* `-no_prefetch` +* `-no_next` + +##### The -no_prefetch directive ##### + +To see what `-no_prefetch` does, let's first look at the default code +generation. Here is the code generated for `move_cx`: + + OpCase(move_cx): + { + BeamInstr next_pf = BeamCodeAddr(I[2]); + xb(BeamExtraData(I[0])) = I[1]; + I += 2; + ASSERT(VALID_INSTR(next_pf)); + GotoPF(next_pf); + } + +Note that the very first thing done is to fetch the address to the +next instruction. The reason is that it usually improves performance. + +Just as a demonstration, we can add a `-no_prefetch` directive to +the `move/2` instruction: + + move(Src, Dst) { + //| -no_prefetch + $Dst = $Src; + } + +We can see that the prefetch is no longer done: + + OpCase(move_cx): + { + xb(BeamExtraData(I[0])) = I[1]; + I += 2; + ASSERT(VALID_INSTR(*I)); + Goto(*I); + } + +When would we want to turn off the prefetch in practice? + +In instructions that will not always execute the next instruction. +For example: + + is_atom(Fail, Src) { + if (is_not_atom($Src)) { + $FAIL($Fail); + } + } + + // From macros.tab + FAIL(Fail) { + //| -no_prefetch + $SET_I_REL($Fail); + Goto(*I); + } + +`is_atom/2` may either execute the next instruction (if the second +operand is an atom) or branch to the failure label. + +The generated code looks like this: + + OpCase(is_atom_fx): + { + if (is_not_atom(xb(I[1]))) { + ASSERT(VALID_INSTR(*(I + (fb(BeamExtraData(I[0]))) + 0))); + I += fb(BeamExtraData(I[0])) + 0;; + Goto(*I);; + } + I += 2; + ASSERT(VALID_INSTR(*I)); + Goto(*I); + } + +##### The -no_next directive ##### + +Next we will look at when the `-no_next` directive can be used. Here +is the `jump/1` instruction: + + jump(Fail) { + $JUMP($Fail); + } + + // From macros.tab + JUMP(Fail) { + //| -no_next + $SET_I_REL($Fail); + Goto(*I); + } + +The generated code looks like this: + + OpCase(jump_f): + { + ASSERT(VALID_INSTR(*(I + (fb(BeamExtraData(I[0]))) + 0))); + I += fb(BeamExtraData(I[0])) + 0;; + Goto(*I);; + } + +If we remove the `-no_next` directive, the code would look like this: + + OpCase(jump_f): + { + BeamInstr next_pf = BeamCodeAddr(I[1]); + ASSERT(VALID_INSTR(*(I + (fb(BeamExtraData(I[0]))) + 0))); + I += fb(BeamExtraData(I[0])) + 0;; + Goto(*I);; + I += 1; + ASSERT(VALID_INSTR(next_pf)); + GotoPF(next_pf); + } + +In the end, the C compiler will probably optimize this code to the +same native code as the first version, but the first version is certainly +much easier to read for human readers. + +#### Macros in the macros.tab file #### + +The file `macros.tab` contains many useful macros. When implementing +new instructions it is good practice to look through `macros.tab` to +see if any of existing macros can be used rather than re-inventing +the wheel. + +We will describe a few of the most useful macros here. + +##### The GC_REGEXP definition ##### + +The following line defines a regular expression that will recognize +a call to a function that does a garbage collection: + + GC_REGEXP=erts_garbage_collect|erts_gc|GcBifFunction; + +The purpose is that **beam\_makeops** can verify that an instruction +that does a garbage collection and has an `d` operand uses the +`$REFRESH_GEN_DEST()` macro. + +If you need to define a new function that does garbage collection, +you should give it the prefix `erts_gc_`. If that is not possible +you should update the regular expression so that it will match your +new function. + +##### FAIL(Fail) ##### + +Branch to `$Fail`. Will suppress prefetch (`-no_prefetch`). Typical use: + + is_nonempty_list(Fail, Src) { + if (is_not_list($Src)) { + $FAIL($Fail); + } + } + +##### JUMP(Fail) ##### + +Branch to `$Fail`. Suppresses generation of dispatch of the next +instruction (`-no_next`). Typical use: + + jump(Fail) { + $JUMP($Fail); + } + +##### GC_TEST(NeedStack, NeedHeap, Live) ##### + +`$GC_TEST(NeedStack, NeedHeap, Live)` tests that given amount of +stack space and heap space is available. If not it will do a +garbage collection. Typical use: + + test_heap(Nh, Live) { + $GC_TEST(0, $Nh, $Live); + } + +##### AH(NeedStack, NeedHeap, Live) ##### + +`AH(NeedStack, NeedHeap, Live)` allocates a stack frame and +optionally additional heap space. + +#### Pre-defined macros and variables #### + +**beam\_makeops** defines several built-in macros and pre-bound variables. + +##### The NEXT_INSTRUCTION pre-bound variable ##### + +The NEXT_INSTRUCTION is a pre-bound variable that is available in +all instructions. It expands to the address of the next instruction. + +Here is an example: + + i_call(CallDest) { + SET_CP(c_p, $NEXT_INSTRUCTION); + $DISPATCH_REL($CallDest); + } + +When calling a function, the return address is first stored in `c_p->cp` +(using the `SET_CP()` macro defined in `beam_emu.c`), and then control is +transferred to the callee. Here is the generated code: + + OpCase(i_call_f): + { + SET_CP(c_p, I+1); + ASSERT(VALID_INSTR(*(I + (fb(BeamExtraData(I[0]))) + 0))); + I += fb(BeamExtraData(I[0])) + 0;; + DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I)); + Dispatch();; + } + +We can see that that `$NEXT_INSTRUCTION` has been expanded to `I+1`. +That makes sense since the size of the `i_call_f/1` instruction is +one word. + +##### The IP_ADJUSTMENT pre-bound variable ##### + +`$IP_ADJUSTMENT` is usually 0. In a few combined instructions +(described below) it can be non-zero. It is used like this +in `macros.tab`: + + SET_I_REL(Offset) { + ASSERT(VALID_INSTR(*(I + ($Offset) + $IP_ADJUSTMENT))); + I += $Offset + $IP_ADJUSTMENT; + } + +Avoid using `IP_ADJUSTMENT` directly. Use `SET_I_REL()` or +one of the macros that invoke such as `FAIL()` or `JUMP()` +defined in `macros.tab`. + +#### Pre-defined macro functions #### + +##### The IF() macro ##### + +`$IF(Expr, IfTrue, IfFalse)` evaluates `Expr`, which must be a valid +Perl expression (which for simple numeric expressions have the same +syntax as C). If `Expr` evaluates to 0, the entire `IF()` expression will be +replaced with `IfFalse`, otherwise it will be replaced with `IfTrue`. + +See the description of `OPERAND_POSITION()` for an example. + +##### The OPERAND\_POSITION() macro ##### + +`$OPERAND_POSITION(Expr)` returns the position for `Expr`, if +`Expr` is an operand that is not packed. The first operand is +at position 1. + +Returns 0 otherwise. + +This macro could be used like this in order to share code: + + FAIL(Fail) { + //| -no_prefetch + $IF($OPERAND_POSITION($Fail) == 1 && $IP_ADJUSTMENT == 0, + goto common_jump, + $DO_JUMP($Fail)); + } + + DO_JUMP(Fail) { + $SET_I_REL($Fail); + Goto(*I)); + } + + // In beam_emu.c: + common_jump: + I += I[1]; + Goto(*I)); + + +#### The $REFRESH\_GEN\_DEST() macro #### + +When a specific instruction has a `d` operand, early during execution +of the instruction, a pointer will be initialized to point to the X or +Y register in question. + +If there is a garbage collection before the result is stored, +the stack will move and if the `d` operand refered to a Y +register, the pointer will no longer be valid. (Y registers are +stored on the stack.) + +In those circumstances, `$REFRESH_GEN_DEST()` must be invoked +to set up the pointer again. **beam\_makeops** will notice +if there is a call to a function that does a garbage collection and +`$REFRESH_GEN_DEST()` is not called. + +Here is a complete example. The `new_map` instruction is defined +like this: + + new_map d t I + +It is implemented like this: + + new_map(Dst, Live, N) { + Eterm res; + + HEAVY_SWAPOUT; + res = erts_gc_new_map(c_p, reg, $Live, $N, $NEXT_INSTRUCTION); + HEAVY_SWAPIN; + $REFRESH_GEN_DEST(); + $Dst = res; + $NEXT($NEXT_INSTRUCTION+$N); + } + +If we have forgotten the `$REFRESH_GEN_DEST()` there would be a message +similar to this: + + pointer to destination register is invalid after GC -- use $REFRESH_GEN_DEST() + ... from the body of new_map at beam/map_instrs.tab(30) + +#### Combined instructions #### + +**Problem**: For frequently executed instructions we want to use +"fast" operands types such as `x` and `y`, as opposed to `s` or `S`. +To avoid an explosion in code size, we want to share most of the +implementation between the instructions. Here are the specific +instructions for `i_increment/5`: + + i_increment r W t d + i_increment x W t d + i_increment y W t d + +The `i_increment` instruction is implemented like this: + + i_increment(Source, IncrementVal, Live, Dst) { + Eterm increment_reg_source = $Source; + Eterm increment_val = $IncrementVal; + Uint live; + Eterm result; + + if (ERTS_LIKELY(is_small(increment_reg_val))) { + Sint i = signed_val(increment_reg_val) + increment_val; + if (ERTS_LIKELY(IS_SSMALL(i))) { + $Dst = make_small(i); + $NEXT0(); + } + } + live = $Live; + HEAVY_SWAPOUT; + reg[live] = increment_reg_val; + reg[live+1] = make_small(increment_val); + result = erts_gc_mixed_plus(c_p, reg, live); + HEAVY_SWAPIN; + ERTS_HOLE_CHECK(c_p); + if (ERTS_LIKELY(is_value(result))) { + $REFRESH_GEN_DEST(); + $Dst = result; + $NEXT0(); + } + ASSERT(c_p->freason != BADMATCH || is_value(c_p->fvalue)); + goto find_func_info; + } + +There will be three almost identical copies of the code. Given the +size of the code, that could be too high cost to pay. + +To avoid the three copies of the code, we could use only one specific +instruction: + + i_increment S W t d + +(The same implementation as above will work.) + +That reduces the code size, but is slower because `S` means that +there will be extra code to test whether the operand refers to an X +register or a Y register. + +**Solution**: We can use "combined instructions". Combined +instructions are combined from instruction fragments. The +bulk of the code can be shared. + +Here we will show how `i_increment` can be implemented as a combined +instruction. We will show each individual fragment first, and then +show how to connect them together. First we will need a variable that +we can store the value fetched from the register in: + + increment.head() { + Eterm increment_reg_val; + } + +The name `increment` is the name of the group that the fragment +belongs to. Note that it does not need to have the same +name as the instruction. The group name is followed by `.` and +the name of the fragment. The name `head` is pre-defined. +The code in it will be placed at the beginning of a block, so +that all fragments in the group can access it. + +Next we define the fragment that will pick up the value from the +register from the first operand: + + increment.fetch(Src) { + increment_reg_val = $Src; + } + +We call this fragment `fetch`. This fragment will be duplicated three +times, one for each value of the first operand (`r`, `x`, and `y`). + +Next we define the main part of the code that do the actual incrementing. + + increment.execute(IncrementVal, Live, Dst) { + Eterm increment_val = $IncrementVal; + Uint live; + Eterm result; + + if (ERTS_LIKELY(is_small(increment_reg_val))) { + Sint i = signed_val(increment_reg_val) + increment_val; + if (ERTS_LIKELY(IS_SSMALL(i))) { + $Dst = make_small(i); + $NEXT0(); + } + } + live = $Live; + HEAVY_SWAPOUT; + reg[live] = increment_reg_val; + reg[live+1] = make_small(increment_val); + result = erts_gc_mixed_plus(c_p, reg, live); + HEAVY_SWAPIN; + ERTS_HOLE_CHECK(c_p); + if (ERTS_LIKELY(is_value(result))) { + $REFRESH_GEN_DEST(); + $Dst = result; + $NEXT0(); + } + ASSERT(c_p->freason != BADMATCH || is_value(c_p->fvalue)); + goto find_func_info; + } + +We call this fragment `execute`. It will handle the three remaining +operands (`W t d`). There will only be one copy of this fragment. + +Now that we have defined the fragments, we need to inform +**beam\_makeops** how they should be connected: + + i_increment := increment.fetch.execute; + +To the left of the `:=` is the name of the specific instruction that +should be implemented by the fragments, in this case `i_increment`. +To the right of `:=` is the name of the group with the fragments, +followed by a `.`. Then the name of the fragments in the group are +listed in the order they should be executed. Note that the `head` +fragment is not listed. + +The line ends in `;` (to avoid messing up the indentation in Emacs). + +(Note that in practice the `:=` line is usually placed before the +fragments.) + +The generated code looks like this: + + { + Eterm increment_reg_val; + OpCase(i_increment_rWtd): + { + increment_reg_val = r(0); + } + goto increment__execute; + + OpCase(i_increment_xWtd): + { + increment_reg_val = xb(BeamExtraData(I[0])); + } + goto increment__execute; + + OpCase(i_increment_yWtd): + { + increment_reg_val = yb(BeamExtraData(I[0])); + } + goto increment__execute; + + increment__execute: + { + // Here follows the code from increment.execute() + . + . + . + } + +##### Some notes about combined instructions ##### + +The operands that are different must be at +the beginning of the instruction. All operands in the last +fragment must have the same operands in all variants of +the specific instruction. + +As an example, the following specific instructions cannot be +implemented as a combined instruction: + + i_times j? t x x d + i_times j? t x y d + i_times j? t s s d + +We would have to change the order of the operands so that the +two operands that are different are placed first: + + i_times x x j? t d + i_times x y j? t d + i_times s s j? t d + +We can then define: + + i_times := times.fetch.execute; + + times.head { + Eterm op1, op2; + } + + times.fetch(Src1, Src2) { + op1 = $Src1; + op2 = $Src2; + } + + times.execute(Fail, Live, Dst) { + // Multiply op1 and op2. + . + . + . + } + +Several instructions can share a group. As an example, the following +instructions have different names, but in the end they all create a +binary. The last two operands are common for all of them: + + i_bs_init_fail xy j? t? x + i_bs_init_fail_heap s I j? t? x + i_bs_init W t? x + i_bs_init_heap W I t? x + +The instructions are defined like this (formatted with extra +spaces for clarity): + + i_bs_init_fail_heap := bs_init . fail_heap . verify . execute; + i_bs_init_fail := bs_init . fail . verify . execute; + i_bs_init := bs_init . . plain . execute; + i_bs_init_heap := bs_init . heap . execute; + +Note that the first two instruction have three fragments, while the +other two only have two fragments. Here are the fragments: + + bs_init_bits.head() { + Eterm num_bits_term; + Uint num_bits; + Uint alloc; + } + + bs_init_bits.plain(NumBits) { + num_bits = $NumBits; + alloc = 0; + } + + bs_init_bits.heap(NumBits, Alloc) { + num_bits = $NumBits; + alloc = $Alloc; + } + + bs_init_bits.fail(NumBitsTerm) { + num_bits_term = $NumBitsTerm; + alloc = 0; + } + + bs_init_bits.fail_heap(NumBitsTerm, Alloc) { + num_bits_term = $NumBitsTerm; + alloc = $Alloc; + } + + bs_init_bits.verify(Fail) { + // Verify the num_bits_term, fail using $FAIL + // if there is a problem. + . + . + . + } + + bs_init_bits.execute(Live, Dst) { + // Long complicated code to a create a binary. + . + . + . + } + +The full definitions of those instructions can be found in `bs_instrs.tab`. +The generated code can be found in `beam_warm.h`. diff --git a/erts/emulator/internal_doc/figures/.gitignore b/erts/emulator/internal_doc/figures/.gitignore new file mode 100644 index 0000000000..c2813ac866 --- /dev/null +++ b/erts/emulator/internal_doc/figures/.gitignore @@ -0,0 +1 @@ +*.eps
\ No newline at end of file diff --git a/erts/emulator/internal_doc/figures/Makefile b/erts/emulator/internal_doc/figures/Makefile new file mode 100644 index 0000000000..111cb393fb --- /dev/null +++ b/erts/emulator/internal_doc/figures/Makefile @@ -0,0 +1,20 @@ +# In order to update the figures you have to have both dia +# and imagemagick installed. + +DIAGRAMS=$(wildcard *.dia) +EPS_DIAGRAMS=$(patsubst %.dia,%.eps,$(DIAGRAMS)) +PNG_DIAGRAMS=$(patsubst %.dia,%.png,$(DIAGRAMS)) + +diagrams: $(EPS_DIAGRAMS) + +png: $(PNG_DIAGRAMS) + +update_png: png + git add $(PNG_DIAGRAMS) + git commit -m "Update internal docs figures" + +%.eps: %.dia + dia --export=$@ $< + +%.png: %.eps + convert $< -resize 65% $@ diff --git a/erts/emulator/internal_doc/figures/gc-heap-scan1.dia b/erts/emulator/internal_doc/figures/gc-heap-scan1.dia Binary files differnew file mode 100644 index 0000000000..b8a32dc092 --- /dev/null +++ b/erts/emulator/internal_doc/figures/gc-heap-scan1.dia diff --git a/erts/emulator/internal_doc/figures/gc-heap-scan1.png b/erts/emulator/internal_doc/figures/gc-heap-scan1.png Binary files differnew file mode 100644 index 0000000000..9724fc8698 --- /dev/null +++ b/erts/emulator/internal_doc/figures/gc-heap-scan1.png diff --git a/erts/emulator/internal_doc/figures/gc-heap-stop.dia b/erts/emulator/internal_doc/figures/gc-heap-stop.dia Binary files differnew file mode 100644 index 0000000000..af219958c6 --- /dev/null +++ b/erts/emulator/internal_doc/figures/gc-heap-stop.dia diff --git a/erts/emulator/internal_doc/figures/gc-heap-stop.png b/erts/emulator/internal_doc/figures/gc-heap-stop.png Binary files differnew file mode 100644 index 0000000000..ec79790d36 --- /dev/null +++ b/erts/emulator/internal_doc/figures/gc-heap-stop.png diff --git a/erts/emulator/internal_doc/figures/gc-rootset-scan.dia b/erts/emulator/internal_doc/figures/gc-rootset-scan.dia Binary files differnew file mode 100644 index 0000000000..d6147740e5 --- /dev/null +++ b/erts/emulator/internal_doc/figures/gc-rootset-scan.dia diff --git a/erts/emulator/internal_doc/figures/gc-rootset-scan.png b/erts/emulator/internal_doc/figures/gc-rootset-scan.png Binary files differnew file mode 100644 index 0000000000..06509f83c3 --- /dev/null +++ b/erts/emulator/internal_doc/figures/gc-rootset-scan.png diff --git a/erts/emulator/internal_doc/figures/gc-start.dia b/erts/emulator/internal_doc/figures/gc-start.dia Binary files differnew file mode 100644 index 0000000000..41832d29b0 --- /dev/null +++ b/erts/emulator/internal_doc/figures/gc-start.dia diff --git a/erts/emulator/internal_doc/figures/gc-start.png b/erts/emulator/internal_doc/figures/gc-start.png Binary files differnew file mode 100644 index 0000000000..6c29e9adb0 --- /dev/null +++ b/erts/emulator/internal_doc/figures/gc-start.png diff --git a/erts/emulator/internal_doc/figures/gc-watermark-2.dia b/erts/emulator/internal_doc/figures/gc-watermark-2.dia Binary files differnew file mode 100644 index 0000000000..2ea3be3fb2 --- /dev/null +++ b/erts/emulator/internal_doc/figures/gc-watermark-2.dia diff --git a/erts/emulator/internal_doc/figures/gc-watermark-2.png b/erts/emulator/internal_doc/figures/gc-watermark-2.png Binary files differnew file mode 100644 index 0000000000..bca110282d --- /dev/null +++ b/erts/emulator/internal_doc/figures/gc-watermark-2.png diff --git a/erts/emulator/internal_doc/figures/gc-watermark.dia b/erts/emulator/internal_doc/figures/gc-watermark.dia Binary files differnew file mode 100644 index 0000000000..a5de7565dc --- /dev/null +++ b/erts/emulator/internal_doc/figures/gc-watermark.dia diff --git a/erts/emulator/internal_doc/figures/gc-watermark.png b/erts/emulator/internal_doc/figures/gc-watermark.png Binary files differnew file mode 100644 index 0000000000..b835c7694e --- /dev/null +++ b/erts/emulator/internal_doc/figures/gc-watermark.png diff --git a/erts/emulator/nifs/common/zlib_nif.c b/erts/emulator/nifs/common/zlib_nif.c index a9c5b05e47..b709ed5a6f 100644 --- a/erts/emulator/nifs/common/zlib_nif.c +++ b/erts/emulator/nifs/common/zlib_nif.c @@ -106,6 +106,7 @@ typedef struct { int inflateChunk_buffer_size; ErlNifPid controlling_process; + ErlNifMutex *controller_lock; ErlNifIOQueue *input_queue; @@ -117,6 +118,8 @@ typedef struct { static ERL_NIF_TERM zlib_open(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM zlib_close(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM zlib_set_controller(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); + static ERL_NIF_TERM zlib_deflateInit(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM zlib_deflateSetDictionary(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM zlib_deflateReset(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); @@ -143,6 +146,11 @@ static ERL_NIF_TERM zlib_setBufSize(ErlNifEnv *env, int argc, const ERL_NIF_TERM static ERL_NIF_TERM zlib_enqueue_input(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); static ErlNifFunc nif_funcs[] = { + {"close_nif", 1, zlib_close}, + {"open_nif", 0, zlib_open}, + + {"set_controller_nif", 2, zlib_set_controller}, + /* deflate */ {"deflateInit_nif", 6, zlib_deflateInit}, {"deflateSetDictionary_nif", 2, zlib_deflateSetDictionary}, @@ -162,10 +170,6 @@ static ErlNifFunc nif_funcs[] = { /* running checksum */ {"crc32_nif", 1, zlib_crc32}, - /* open & close */ - {"close_nif", 1, zlib_close}, - {"open_nif", 0, zlib_open}, - /* The stash keeps a single term alive across calls, and is used in * exception_on_need_dict/1 to retain the old error behavior, and for * saving data flushed through deflateParams/3. */ @@ -281,9 +285,7 @@ static ERL_NIF_TERM zlib_return(ErlNifEnv *env, int code) { return reason; } -static void gc_zlib(ErlNifEnv *env, void* data) { - zlib_data_t *d = (zlib_data_t*)data; - +static void zlib_internal_close(zlib_data_t *d) { if(d->state == ST_DEFLATE) { deflateEnd(&d->s); } else if(d->state == ST_INFLATE) { @@ -291,8 +293,6 @@ static void gc_zlib(ErlNifEnv *env, void* data) { } if(d->state != ST_CLOSED) { - enif_ioq_destroy(d->input_queue); - if(d->stash_env != NULL) { enif_free_env(d->stash_env); } @@ -301,17 +301,36 @@ static void gc_zlib(ErlNifEnv *env, void* data) { } } +static void gc_zlib(ErlNifEnv *env, void* data) { + zlib_data_t *d = (zlib_data_t*)data; + + enif_mutex_destroy(d->controller_lock); + enif_ioq_destroy(d->input_queue); + + zlib_internal_close(d); + + (void)env; +} + static int get_zlib_data(ErlNifEnv *env, ERL_NIF_TERM opaque, zlib_data_t **d) { return enif_get_resource(env, opaque, rtype_zlib, (void **)d); } static int zlib_process_check(ErlNifEnv *env, zlib_data_t *d) { + int is_controlling_process; ErlNifPid current_process; enif_self(env, ¤t_process); - return enif_is_identical(enif_make_pid(env, ¤t_process), + enif_mutex_lock(d->controller_lock); + + is_controlling_process = enif_is_identical( + enif_make_pid(env, ¤t_process), enif_make_pid(env, &d->controlling_process)); + + enif_mutex_unlock(d->controller_lock); + + return is_controlling_process; } static void zlib_reset_input(zlib_data_t *d) { @@ -516,6 +535,8 @@ static ERL_NIF_TERM zlib_open(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[ d->input_queue = enif_ioq_create(ERL_NIF_IOQ_NORMAL); + d->controller_lock = enif_mutex_create("zlib_controller_lock"); + d->s.zalloc = zlib_alloc; d->s.zfree = zlib_free; d->s.opaque = d; @@ -556,7 +577,28 @@ static ERL_NIF_TERM zlib_close(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv return enif_raise_exception(env, am_not_initialized); } - gc_zlib(env, d); + zlib_internal_close(d); + + return am_ok; +} + +static ERL_NIF_TERM zlib_set_controller(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + + ErlNifPid new_owner; + + if(argc != 2 || !get_zlib_data(env, argv[0], &d) + || !enif_get_local_pid(env, argv[1], &new_owner)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } + + enif_mutex_lock(d->controller_lock); + + d->controlling_process = new_owner; + + enif_mutex_unlock(d->controller_lock); return am_ok; } @@ -675,7 +717,9 @@ static ERL_NIF_TERM zlib_deflateEnd(ErlNifEnv *env, int argc, const ERL_NIF_TERM static ERL_NIF_TERM zlib_deflateParams(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { zlib_data_t *d; + int res, level, strategy; + Bytef dummy_buffer; if(argc != 3 || !get_zlib_data(env, argv[0], &d) || !enif_get_int(env, argv[1], &level) @@ -687,12 +731,27 @@ static ERL_NIF_TERM zlib_deflateParams(ErlNifEnv *env, int argc, const ERL_NIF_T return enif_raise_exception(env, am_not_initialized); } - /* deflateParams will flush everything currently in the stream, corrupting - * the heap unless it's empty. We therefore pretend to have a full output - * buffer, forcing a Z_BUF_ERROR if there's anything left to be flushed. */ - d->s.avail_out = 0; + /* This is a bit of a hack; deflateParams flushes with Z_BLOCK which won't + * stop at a byte boundary, so we can't split this operation up, and we + * can't allocate a buffer large enough to fit it in one go since we have + * to support zlib versions that lack deflatePending. + * + * We therefore flush everything prior to this call to ensure that we are + * stopped on a byte boundary and have no pending data. We then hand it a + * dummy buffer to detect when this assumption doesn't hold (Hopefully + * never), and to smooth over an issue with zlib 1.2.11 which always + * returns Z_BUF_ERROR when d->s.avail_out is 0, regardless of whether + * there's any pending data or not. */ + + d->s.next_out = &dummy_buffer; + d->s.avail_out = 1; + res = deflateParams(&d->s, level, strategy); + if(d->s.avail_out == 0) { + return zlib_return(env, Z_STREAM_ERROR); + } + return zlib_return(env, res); } @@ -887,7 +946,7 @@ static ERL_NIF_TERM zlib_inflate(ErlNifEnv *env, int argc, const ERL_NIF_TERM ar return enif_raise_exception(env, am_not_initialized); } - if(d->eos_seen) { + if(d->eos_seen && enif_ioq_size(d->input_queue) > 0) { int res; switch(d->eos_behavior) { @@ -901,11 +960,10 @@ static ERL_NIF_TERM zlib_inflate(ErlNifEnv *env, int argc, const ERL_NIF_TERM ar } d->eos_seen = 0; + break; case EOS_BEHAVIOR_CUT: zlib_reset_input(d); - - return enif_make_tuple2(env, am_finished, enif_make_list(env, 0)); } } diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c index 30a595c17a..7aa53e8f36 100644 --- a/erts/emulator/sys/common/erl_poll.c +++ b/erts/emulator/sys/common/erl_poll.c @@ -2059,7 +2059,8 @@ uint32_t epoll_events(int kp_fd, int fd) int ev_fd; uint32_t events; uint64_t data; - if (fscanf(f,"tfd:%d events:%x data:%lx\n", &ev_fd, &events, &data) != 3) { + if (fscanf(f,"tfd:%d events:%x data:%llx\n", &ev_fd, &events, + (unsigned long long*)&data) != 3) { fprintf(stderr,"failed to parse file %s on line %d, errno = %d\n", fname, line, errno); @@ -2125,7 +2126,8 @@ ERTS_POLL_EXPORT(erts_poll_get_selected_events)(ErtsPollSet *ps, int fd; uint32_t events; uint64_t data; - if (fscanf(f,"tfd:%d events:%x data:%lx\n", &fd, &events, &data) != 3) { + if (fscanf(f,"tfd:%d events:%x data:%llx\n", &fd, &events, + (unsigned long long*)&data) != 3) { fprintf(stderr,"failed to parse file %s on line %d, errno = %d\n", fname, line, errno); ASSERT(0); diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl index f0871ead7d..5e5cd6f578 100644 --- a/erts/emulator/test/alloc_SUITE.erl +++ b/erts/emulator/test/alloc_SUITE.erl @@ -89,10 +89,11 @@ mmsc_flags() -> mmsc_flags(Env) -> case os:getenv(Env) of false -> false; - V -> case string:str(V, "+MMsc") of - 0 -> false; - P -> Env ++ "=" ++ string:substr(V, P) - end + V -> + case string:find(V, "+MMsc") of + nomatch -> false; + SubStr -> Env ++ "=" ++ SubStr + end end. erts_mmap_do(Config, SCO, SCRPM, SCRFSD) -> diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl index 04b7f2de15..e1b42e5d85 100644 --- a/erts/emulator/test/bif_SUITE.erl +++ b/erts/emulator/test/bif_SUITE.erl @@ -731,10 +731,12 @@ erlang_halt(Config) when is_list(Config) -> [broken_halt, "Validate correct crash dump"]), {ok,_} = wait_until_stable_size(CrashDump,-1), {ok, Bin} = file:read_file(CrashDump), - case {string:str(binary_to_list(Bin),"\n=end\n"), - string:str(binary_to_list(Bin),"\r\n=end\r\n")} of - {0,0} -> ct:fail("Could not find end marker in crash dump"); - _ -> ok + case {string:find(Bin, <<"\n=end\n">>), + string:find(Bin, <<"\r\n=end\r\n">>)} of + {nomatch,nomatch} -> + ct:fail("Could not find end marker in crash dump"); + {_,_} -> + ok end. wait_until_stable_size(_File,-10) -> @@ -779,14 +781,20 @@ is_builtin(_Config) -> {F,A} <- M:module_info(exports)], Exp = ordsets:from_list(Exp0), - %% erlang:apply/3 is considered to be built-in, but is not - %% implemented as other BIFs. + %% Built-ins implemented as special instructions. + Instructions = [{erlang,apply,2},{erlang,apply,3},{erlang,yield,0}], - Builtins0 = [{erlang,apply,3}|erlang:system_info(snifs)], + Builtins0 = Instructions ++ erlang:system_info(snifs), Builtins = ordsets:from_list(Builtins0), - NotBuiltin = ordsets:subtract(Exp, Builtins), - _ = [true = erlang:is_builtin(M, F, A) || {M,F,A} <- Builtins], - _ = [false = erlang:is_builtin(M, F, A) || {M,F,A} <- NotBuiltin], + + Fakes = [{M,F,42} || {M,F,_} <- Instructions], + All = ordsets:from_list(Fakes ++ Exp), + NotBuiltin = ordsets:subtract(All, Builtins), + + _ = [{true,_} = {erlang:is_builtin(M, F, A),MFA} || + {M,F,A}=MFA <- Builtins], + _ = [{false,_} = {erlang:is_builtin(M, F, A),MFA} || + {M,F,A}=MFA <- NotBuiltin], ok. diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index 61536bacd7..b59c22f125 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -48,6 +48,7 @@ bad_list_to_binary/1, bad_binary_to_list/1, t_split_binary/1, bad_split/1, terms/1, terms_float/1, float_middle_endian/1, + b2t_used_big/1, external_size/1, t_iolist_size/1, t_hash/1, bad_size/1, @@ -57,7 +58,9 @@ otp_5484/1,otp_5933/1, ordering/1,unaligned_order/1,gc_test/1, bit_sized_binary_sizes/1, - otp_6817/1,deep/1,obsolete_funs/1,robustness/1,otp_8117/1, + otp_6817/1,deep/1, + term2bin_tuple_fallbacks/1, + robustness/1,otp_8117/1, otp_8180/1, trapping/1, large/1, error_after_yield/1, cmp_old_impl/1]). @@ -72,12 +75,14 @@ all() -> t_split_binary, bad_split, bad_list_to_binary, bad_binary_to_list, terms, terms_float, float_middle_endian, external_size, t_iolist_size, + b2t_used_big, bad_binary_to_term_2, safe_binary_to_term2, bad_binary_to_term, bad_terms, t_hash, bad_size, bad_term_to_binary, more_bad_terms, otp_5484, otp_5933, ordering, unaligned_order, gc_test, bit_sized_binary_sizes, otp_6817, otp_8117, deep, - obsolete_funs, robustness, otp_8180, trapping, large, + term2bin_tuple_fallbacks, + robustness, otp_8180, trapping, large, error_after_yield, cmp_old_impl]. groups() -> @@ -425,40 +430,77 @@ bad_term_to_binary(Config) when is_list(Config) -> terms(Config) when is_list(Config) -> TestFun = fun(Term) -> - try - S = io_lib:format("~p", [Term]), - io:put_chars(S) - catch - error:badarg -> - io:put_chars("bit sized binary") - end, + S = io_lib:format("~p", [Term]), + io:put_chars(S), Bin = term_to_binary(Term), case erlang:external_size(Bin) of Sz when is_integer(Sz), size(Bin) =< Sz -> ok end, - Bin1 = term_to_binary(Term, [{minor_version, 1}]), - case erlang:external_size(Bin1, [{minor_version, 1}]) of - Sz1 when is_integer(Sz1), size(Bin1) =< Sz1 -> - ok - end, + Bin1 = term_to_binary(Term, [{minor_version, 1}]), + case erlang:external_size(Bin1, [{minor_version, 1}]) of + Sz1 when is_integer(Sz1), size(Bin1) =< Sz1 -> + ok + end, Term = binary_to_term_stress(Bin), Term = binary_to_term_stress(Bin, [safe]), - Unaligned = make_unaligned_sub_binary(Bin), - Term = binary_to_term_stress(Unaligned), - Term = binary_to_term_stress(Unaligned, []), - Term = binary_to_term_stress(Bin, [safe]), + Bin_sz = byte_size(Bin), + {Term,Bin_sz} = binary_to_term_stress(Bin, [used]), + + BinE = <<Bin/binary, 1, 2, 3>>, + {Term,Bin_sz} = binary_to_term_stress(BinE, [used]), + + BinU = make_unaligned_sub_binary(Bin), + Term = binary_to_term_stress(BinU), + Term = binary_to_term_stress(BinU, []), + Term = binary_to_term_stress(BinU, [safe]), + {Term,Bin_sz} = binary_to_term_stress(BinU, [used]), + + BinUE = make_unaligned_sub_binary(BinE), + {Term,Bin_sz} = binary_to_term_stress(BinUE, [used]), + BinC = erlang:term_to_binary(Term, [compressed]), + BinC_sz = byte_size(BinC), + true = BinC_sz =< size(Bin), Term = binary_to_term_stress(BinC), - true = size(BinC) =< size(Bin), + {Term, BinC_sz} = binary_to_term_stress(BinC, [used]), + Bin = term_to_binary(Term, [{compressed,0}]), terms_compression_levels(Term, size(Bin), 1), - UnalignedC = make_unaligned_sub_binary(BinC), - Term = binary_to_term_stress(UnalignedC) + + BinUC = make_unaligned_sub_binary(BinC), + Term = binary_to_term_stress(BinUC), + {Term,BinC_sz} = binary_to_term_stress(BinUC, [used]), + + BinCE = <<BinC/binary, 1, 2, 3>>, + {Term,BinC_sz} = binary_to_term_stress(BinCE, [used]), + + BinUCE = make_unaligned_sub_binary(BinCE), + Term = binary_to_term_stress(BinUCE), + {Term,BinC_sz} = binary_to_term_stress(BinUCE, [used]) end, test_terms(TestFun), ok. +%% Test binary_to_term(_, [used]) returning a big Used integer. +b2t_used_big(_Config) -> + case erlang:system_info(wordsize) of + 8 -> + {skipped, "This is not a 32-bit machine"}; + 4 -> + %% Use a long utf8 atom for large external format but compact on heap. + BigAtom = binary_to_atom(<< <<16#F0908D88:32>> || _ <- lists:seq(1,255) >>, + utf8), + Atoms = (1 bsl 17) + (1 bsl 9), + BigAtomList = lists:duplicate(Atoms, BigAtom), + BigBin = term_to_binary(BigAtomList), + {BigAtomList, Used} = binary_to_term(BigBin, [used]), + 2 = erts_debug:size(Used), + Used = byte_size(BigBin), + Used = 1 + 1 + 4 + Atoms*(1+2+4*255) + 1, + ok + end. + terms_compression_levels(Term, UncompressedSz, Level) when Level < 10 -> BinC = erlang:term_to_binary(Term, [{compressed,Level}]), Term = binary_to_term_stress(BinC), @@ -1261,40 +1303,28 @@ deep_roundtrip(T) -> B = term_to_binary(T), T = binary_to_term(B). -obsolete_funs(Config) when is_list(Config) -> +term2bin_tuple_fallbacks(Config) when is_list(Config) -> erts_debug:set_internal_state(available_internal_state, true), - X = id({1,2,3}), - Y = id([a,b,c,d]), - Z = id({x,y,z}), - obsolete_fun(fun() -> ok end), - obsolete_fun(fun() -> X end), - obsolete_fun(fun(A) -> {A,X} end), - obsolete_fun(fun() -> {X,Y} end), - obsolete_fun(fun() -> {X,Y,Z} end), - - obsolete_fun(fun ?MODULE:all/1), + term2bin_tf(fun ?MODULE:all/1), + term2bin_tf(<<1:1>>), + term2bin_tf(<<90,80:7>>), erts_debug:set_internal_state(available_internal_state, false), ok. -obsolete_fun(Fun) -> - Tuple = case erlang:fun_info(Fun, type) of - {type,external} -> - {module,M} = erlang:fun_info(Fun, module), - {name,F} = erlang:fun_info(Fun, name), - {M,F}; - {type,local} -> - {module,M} = erlang:fun_info(Fun, module), - {index,I} = erlang:fun_info(Fun, index), - {uniq,U} = erlang:fun_info(Fun, uniq), - {env,E} = erlang:fun_info(Fun, env), - {'fun',M,I,U,list_to_tuple(E)} - end, - Tuple = no_fun_roundtrip(Fun). - -no_fun_roundtrip(Term) -> - binary_to_term_stress(erts_debug:get_internal_state({term_to_binary_no_funs,Term})). +term2bin_tf(Term) -> + Tuple = case Term of + Fun when is_function(Fun) -> + {type, external} = erlang:fun_info(Fun, type), + {module,M} = erlang:fun_info(Fun, module), + {name,F} = erlang:fun_info(Fun, name), + {M,F}; + BS when bit_size(BS) rem 8 =/= 0 -> + Bits = bit_size(BS) rem 8, + {<<BS/bitstring, 0:(8-Bits)>>, Bits} + end, + Tuple = binary_to_term_stress(erts_debug:get_internal_state({term_to_binary_tuple_fallbacks,Term})). %% Test non-standard encodings never generated by term_to_binary/1 %% but recognized by binary_to_term/1. diff --git a/erts/emulator/test/decode_packet_SUITE.erl b/erts/emulator/test/decode_packet_SUITE.erl index 54ee4d5567..0ccdbd7ee8 100644 --- a/erts/emulator/test/decode_packet_SUITE.erl +++ b/erts/emulator/test/decode_packet_SUITE.erl @@ -239,7 +239,7 @@ packet_size(Config) when is_list(Config) -> %% Test OTP-9389, long HTTP header lines. Opts = [{packet_size, 128}], Pkt = list_to_binary(["GET / HTTP/1.1\r\nHost: localhost\r\nLink: /", - string:chars($Y, 64), "\r\n\r\n"]), + lists:duplicate(64, $Y), "\r\n\r\n"]), <<Pkt1:50/binary, Pkt2/binary>> = Pkt, {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest1} = erlang:decode_packet(http, Pkt1, Opts), @@ -250,7 +250,7 @@ packet_size(Config) when is_list(Config) -> erlang:decode_packet(httph, list_to_binary([Rest2, Pkt2]), Opts), Pkt3 = list_to_binary(["GET / HTTP/1.1\r\nHost: localhost\r\nLink: /", - string:chars($Y, 129), "\r\n\r\n"]), + lists:duplicate(129, $Y), "\r\n\r\n"]), {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest3} = erlang:decode_packet(http, Pkt3, Opts), {ok, {http_header,_,'Host',_,"localhost"}, Rest4} = @@ -509,9 +509,9 @@ decode_line(Bin,MaxLen) -> end. find_in_binary(Byte, Bin) -> - case string:chr(binary_to_list(Bin),Byte) of - 0 -> notfound; - P -> P + case string:find(Bin, [Byte]) of + nomatch -> notfound; + Suffix -> byte_size(Bin) - byte_size(Suffix) + 1 end. ssl(Config) when is_list(Config) -> @@ -562,7 +562,7 @@ decode_pkt(Type,Bin,Opts) -> otp_9389(Config) when is_list(Config) -> Opts = [{packet_size, 16384}, {line_length, 3000}], Pkt = list_to_binary(["GET / HTTP/1.1\r\nHost: localhost\r\nLink: /", - string:chars($X, 8192), + lists:duplicate(8192, $X), "\r\nContent-Length: 0\r\n\r\n"]), <<Pkt1:5000/binary, Pkt2/binary>> = Pkt, {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest1} = diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl index 17cd1d1a3b..f1831b7c45 100644 --- a/erts/emulator/test/distribution_SUITE.erl +++ b/erts/emulator/test/distribution_SUITE.erl @@ -35,13 +35,18 @@ -include_lib("common_test/include/ct.hrl"). +%-define(Line, erlang:display({line,?LINE}),). +-define(Line,). + -export([all/0, suite/0, groups/0, ping/1, bulk_send_small/1, + group_leader/1, + optimistic_dflags/1, bulk_send_big/1, bulk_send_bigbig/1, local_send_small/1, local_send_big/1, local_send_legal/1, link_to_busy/1, exit_to_busy/1, lost_exit/1, link_to_dead/1, link_to_dead_new_node/1, - applied_monitor_node/1, ref_port_roundtrip/1, nil_roundtrip/1, + ref_port_roundtrip/1, nil_roundtrip/1, trap_bif_1/1, trap_bif_2/1, trap_bif_3/1, stop_dist/1, dist_auto_connect_never/1, dist_auto_connect_once/1, @@ -61,6 +66,8 @@ %% Internal exports. -export([sender/3, receiver2/2, dummy_waiter/0, dead_process/0, + group_leader_1/1, + optimistic_dflags_echo/0, optimistic_dflags_sender/1, roundtrip/1, bounce/1, do_dist_auto_connect/1, inet_rpc_server/1, dist_parallel_sender/3, dist_parallel_receiver/0, dist_evil_parallel_receiver/0]). @@ -74,8 +81,10 @@ suite() -> all() -> [ping, {group, bulk_send}, {group, local_send}, + group_leader, + optimistic_dflags, link_to_busy, exit_to_busy, lost_exit, link_to_dead, - link_to_dead_new_node, applied_monitor_node, + link_to_dead_new_node, ref_port_roundtrip, nil_roundtrip, stop_dist, {group, trap_bif}, {group, dist_auto_connect}, dist_parallel_send, atom_roundtrip, unicode_atom_roundtrip, @@ -124,6 +133,96 @@ ping(Config) when is_list(Config) -> ok. +%% Test erlang:group_leader(_, ExternalPid), i.e. DOP_GROUP_LEADER +group_leader(Config) when is_list(Config) -> + ?Line Sock = start_relay_node(group_leader_1, []), + ?Line Sock2 = start_relay_node(group_leader_2, []), + try + ?Line Node2 = inet_rpc_nodename(Sock2), + ?Line {ok, ok} = do_inet_rpc(Sock, ?MODULE, group_leader_1, [Node2]) + after + ?Line stop_relay_node(Sock), + ?Line stop_relay_node(Sock2) + end, + ok. + +group_leader_1(Node2) -> + ?Line ExtPid = spawn(Node2, fun F() -> + receive {From, group_leader} -> + From ! {self(), group_leader, group_leader()} + end, + F() + end), + ?Line GL1 = self(), + ?Line group_leader(GL1, ExtPid), + ?Line ExtPid ! {self(), group_leader}, + ?Line {ExtPid, group_leader, GL1} = receive_one(), + + %% Kill connection and repeat test when group_leader/2 triggers auto-connect + ?Line net_kernel:monitor_nodes(true), + ?Line net_kernel:disconnect(Node2), + ?Line {nodedown, Node2} = receive_one(), + ?Line GL2 = spawn(fun() -> dummy end), + ?Line group_leader(GL2, ExtPid), + ?Line {nodeup, Node2} = receive_one(), + ?Line ExtPid ! {self(), group_leader}, + ?Line {ExtPid, group_leader, GL2} = receive_one(), + ok. + +%% Test optimistic distribution flags toward pending connections (DFLAG_DIST_HOPEFULLY) +optimistic_dflags(Config) when is_list(Config) -> + ?Line Sender = start_relay_node(optimistic_dflags_sender, []), + ?Line Echo = start_relay_node(optimistic_dflags_echo, []), + try + ?Line {ok, ok} = do_inet_rpc(Echo, ?MODULE, optimistic_dflags_echo, []), + + ?Line EchoNode = inet_rpc_nodename(Echo), + ?Line {ok, ok} = do_inet_rpc(Sender, ?MODULE, optimistic_dflags_sender, [EchoNode]) + after + ?Line stop_relay_node(Sender), + ?Line stop_relay_node(Echo) + end, + ok. + +optimistic_dflags_echo() -> + P = spawn(fun F() -> + receive {From, Term} -> + From ! {self(), Term} + end, + F() + end), + register(optimistic_dflags_echo, P), + optimistic_dflags_echo ! {self(), hello}, + {P, hello} = receive_one(), + ok. + +optimistic_dflags_sender(EchoNode) -> + ?Line net_kernel:monitor_nodes(true), + + optimistic_dflags_do(EchoNode, <<1:1>>), + optimistic_dflags_do(EchoNode, fun lists:map/2), + ok. + +optimistic_dflags_do(EchoNode, Term) -> + ?Line {optimistic_dflags_echo, EchoNode} ! {self(), Term}, + ?Line {nodeup, EchoNode} = receive_one(), + ?Line {EchoPid, Term} = receive_one(), + %% repeat with pid destination + ?Line net_kernel:disconnect(EchoNode), + ?Line {nodedown, EchoNode} = receive_one(), + ?Line EchoPid ! {self(), Term}, + ?Line {nodeup, EchoNode} = receive_one(), + ?Line {EchoPid, Term} = receive_one(), + + ?Line net_kernel:disconnect(EchoNode), + ?Line {nodedown, EchoNode} = receive_one(), + ok. + + +receive_one() -> + receive M -> M after 1000 -> timeout end. + + bulk_send_small(Config) when is_list(Config) -> bulk_send(64, 32). @@ -639,26 +738,6 @@ link_to_dead_new_node(Config) when is_list(Config) -> end, ok. -%% Test that monitor_node/2 works when applied. -applied_monitor_node(Config) when is_list(Config) -> - NonExisting = list_to_atom("__non_existing__@" ++ hostname()), - - %% Tail-recursive call to apply (since the node is non-existing, - %% there will be a trap). - - true = tail_apply(erlang, monitor_node, [NonExisting, true]), - [{nodedown, NonExisting}] = test_server:messages_get(), - - %% Ordinary call (with trap). - - true = apply(erlang, monitor_node, [NonExisting, true]), - [{nodedown, NonExisting}] = test_server:messages_get(), - - ok. - -tail_apply(M, F, A) -> - apply(M, F, A). - %% Test that sending a port or reference to another node and back again %% doesn't correct them in any way. ref_port_roundtrip(Config) when is_list(Config) -> @@ -786,8 +865,8 @@ dist_auto_connect_once(Config) when is_list(Config) -> {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]), {ok,[NN2]} = do_inet_rpc(Sock,erlang,nodes,[]), {ok,[NN]} = do_inet_rpc(Sock2,erlang,nodes,[]), - [_,HostPartPeer] = string:tokens(atom_to_list(NN),"@"), - [_,MyHostPart] = string:tokens(atom_to_list(node()),"@"), + [_,HostPartPeer] = string:lexemes(atom_to_list(NN),"@"), + [_,MyHostPart] = string:lexemes(atom_to_list(node()),"@"), % Give net_kernel a chance to change the state of the node to up to. receive after 1000 -> ok end, case HostPartPeer of @@ -1158,8 +1237,6 @@ contended_atom_cache_entry_test(Config, Type) -> spawn_link( SNode, fun () -> - erts_debug:set_internal_state(available_internal_state, - true), Master = self(), CIX = get_cix(), TestAtoms = case Type of @@ -1244,7 +1321,7 @@ get_cix(CIX) when is_integer(CIX), CIX < 0 -> get_cix(CIX) when is_integer(CIX) -> get_cix(CIX, unwanted_cixs(), - erts_debug:get_internal_state(max_atom_out_cache_index)). + get_internal_state(max_atom_out_cache_index)). get_cix(CIX, Unwanted, MaxCIX) when CIX > MaxCIX -> get_cix(0, Unwanted, MaxCIX); @@ -1256,8 +1333,8 @@ get_cix(CIX, Unwanted, MaxCIX) -> unwanted_cixs() -> lists:map(fun (Node) -> - erts_debug:get_internal_state({atom_out_cache_index, - Node}) + get_internal_state({atom_out_cache_index, + Node}) end, nodes()). @@ -1266,7 +1343,7 @@ get_conflicting_atoms(_CIX, 0) -> []; get_conflicting_atoms(CIX, N) -> Atom = list_to_atom("atom" ++ integer_to_list(erlang:unique_integer([positive]))), - case erts_debug:get_internal_state({atom_out_cache_index, Atom}) of + case get_internal_state({atom_out_cache_index, Atom}) of CIX -> [Atom|get_conflicting_atoms(CIX, N-1)]; _ -> @@ -1277,7 +1354,7 @@ get_conflicting_unicode_atoms(_CIX, 0) -> []; get_conflicting_unicode_atoms(CIX, N) -> Atom = string_to_atom([16#1f608] ++ "atom" ++ integer_to_list(erlang:unique_integer([positive]))), - case erts_debug:get_internal_state({atom_out_cache_index, Atom}) of + case get_internal_state({atom_out_cache_index, Atom}) of CIX -> [Atom|get_conflicting_unicode_atoms(CIX, N-1)]; _ -> @@ -1365,81 +1442,59 @@ bad_dist_structure(Config) when is_list(Config) -> start_monitor(Offender,P), P ! one, send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal},2), - pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_monitor(Offender,P), send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal,normal},2), - pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_link(Offender,P), send_bad_structure(Offender, P,{?DOP_LINK},0), - pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_link(Offender,P), send_bad_structure(Offender, P,{?DOP_UNLINK,'replace'},2), - pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_link(Offender,P), send_bad_structure(Offender, P,{?DOP_UNLINK,'replace',make_ref()},2), - pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_link(Offender,P), send_bad_structure(Offender, P,{?DOP_UNLINK,make_ref(),P},0), - pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_link(Offender,P), send_bad_structure(Offender, P,{?DOP_UNLINK,normal,normal},0), - pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_monitor(Offender,P), send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P},2), - pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_monitor(Offender,P), send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P,normal},2), - pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_monitor(Offender,P), send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P},2), - pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_monitor(Offender,P), send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P,normal},2), - pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_EXIT,'replace',P},2), - pong = rpc:call(Victim, net_adm, ping, [Offender]), send_bad_structure(Offender, P,{?DOP_EXIT,make_ref(),normal,normal},0), - pong = rpc:call(Victim, net_adm, ping, [Offender]), send_bad_structure(Offender, P,{?DOP_EXIT_TT,'replace',token,P},2), - pong = rpc:call(Victim, net_adm, ping, [Offender]), send_bad_structure(Offender, P,{?DOP_EXIT_TT,make_ref(),token,normal,normal},0), - pong = rpc:call(Victim, net_adm, ping, [Offender]), send_bad_structure(Offender, P,{?DOP_EXIT2,'replace',P},2), - pong = rpc:call(Victim, net_adm, ping, [Offender]), send_bad_structure(Offender, P,{?DOP_EXIT2,make_ref(),normal,normal},0), - pong = rpc:call(Victim, net_adm, ping, [Offender]), send_bad_structure(Offender, P,{?DOP_EXIT2_TT,'replace',token,P},2), - pong = rpc:call(Victim, net_adm, ping, [Offender]), send_bad_structure(Offender, P,{?DOP_EXIT2_TT,make_ref(),token,normal,normal},0), - pong = rpc:call(Victim, net_adm, ping, [Offender]), send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace'},2), - pong = rpc:call(Victim, net_adm, ping, [Offender]), send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace','atomic'},2), - pong = rpc:call(Victim, net_adm, ping, [Offender]), send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace',P},0), - pong = rpc:call(Victim, net_adm, ping, [Offender]), send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name},2,{message}), - pong = rpc:call(Victim, net_adm, ping, [Offender]), send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name,token},0,{message}), - pong = rpc:call(Victim, net_adm, ping, [Offender]), send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace',''},2,{message}), - pong = rpc:call(Victim, net_adm, ping, [Offender]), send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',P},0,{message}), - pong = rpc:call(Victim, net_adm, ping, [Offender]), send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name},0,{message}), - pong = rpc:call(Victim, net_adm, ping, [Offender]), send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name,{token}},2,{message}), - pong = rpc:call(Victim, net_adm, ping, [Offender]), send_bad_structure(Offender, P,{?DOP_SEND_TT,'',P},0,{message}), - pong = rpc:call(Victim, net_adm, ping, [Offender]), send_bad_structure(Offender, P,{?DOP_SEND_TT,'',name,token},0,{message}), - pong = rpc:call(Victim, net_adm, ping, [Offender]), send_bad_structure(Offender, P,{?DOP_SEND,''},0,{message}), - pong = rpc:call(Victim, net_adm, ping, [Offender]), send_bad_structure(Offender, P,{?DOP_SEND,'',name},0,{message}), - pong = rpc:call(Victim, net_adm, ping, [Offender]), send_bad_structure(Offender, P,{?DOP_SEND,'',P,{token}},0,{message}), - pong = rpc:call(Victim, net_adm, ping, [Offender]), P ! two, P ! check_msgs, receive @@ -1685,13 +1740,16 @@ bad_dist_ext_size(Config) when is_list(Config) -> start_node_monitors([Offender,Victim]), Parent = self(), - P = spawn_link(Victim, + P = spawn_opt(Victim, fun () -> Parent ! {self(), started}, receive check_msgs -> ok end, %% DID CRASH HERE bad_dist_ext_check_msgs([one]), Parent ! {self(), messages_checked} - end), + end, + [link, + %% on_heap to force total_heap_size to inspect msg queue + {message_queue_data, on_heap}]), receive {P, started} -> ok end, P ! one, @@ -1714,6 +1772,7 @@ bad_dist_ext_size(Config) when is_list(Config) -> verify_still_up(Offender, Victim), + %% Let process_info(P, total_heap_size) find bad msg and disconnect rpc:call(Victim, erlang, process_info, [P, total_heap_size]), verify_down(Offender, connection_closed, Victim, killed), @@ -1795,10 +1854,11 @@ send_bad_structure(Offender,Victim,Bad,WhereToPutSelf) -> send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,PayLoad) -> Parent = self(), Done = make_ref(), - spawn(Offender, + spawn_link(Offender, fun () -> Node = node(Victim), pong = net_adm:ping(Node), + erlang:monitor_node(Node, true), DCtrl = dctrl(Node), Bad1 = case WhereToPutSelf of 0 -> @@ -1812,7 +1872,16 @@ send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,PayLoad) -> [] -> []; _Other -> [dmsg_ext(PayLoad)] end, + + receive {nodedown, Node} -> exit("premature nodedown") + after 10 -> ok + end, + dctrl_send(DCtrl, DData), + + receive {nodedown, Node} -> ok + after 5000 -> exit("missing nodedown") + end, Parent ! {DData,Done} end), receive @@ -1893,11 +1962,26 @@ send_bad_dhdr(BadNode, ToNode) when is_atom(BadNode), is_atom(ToNode) -> receive Done -> ok end. dctrl(Node) when is_atom(Node) -> - case catch erts_debug:get_internal_state(available_internal_state) of - true -> true; - _ -> erts_debug:set_internal_state(available_internal_state, true) - end, - erts_debug:get_internal_state({dist_ctrl, Node}). + get_internal_state({dist_ctrl, Node}). + +get_internal_state(Op) -> + try erts_debug:get_internal_state(Op) of + R -> R + catch + error:undef -> + erts_debug:set_internal_state(available_internal_state, true), + erts_debug:get_internal_state(Op) + end. + +set_internal_state(Op, Val) -> + try erts_debug:set_internal_state(Op, Val) of + R -> R + catch + error:undef -> + erts_debug:set_internal_state(available_internal_state, true), + erts_debug:set_internal_state(Op, Val) + end. + dmsg_hdr() -> [131, % Version Magic @@ -2040,11 +2124,9 @@ freeze_node(Node, MS) -> Freezer = self(), spawn_link(Node, fun () -> - erts_debug:set_internal_state(available_internal_state, - true), dctrl_dop_send(Freezer, DoingIt), receive after Own -> ok end, - erts_debug:set_internal_state(block, MS+Own) + set_internal_state(block, MS+Own) end), receive DoingIt -> ok end, receive after Own -> ok end. @@ -2094,7 +2176,7 @@ start_relay_node(Node, Args) -> [{args, Args ++ " -setcookie "++Cookie++" -pa "++Pa++" "++ RunArg}]), - [N,H] = string:tokens(atom_to_list(NN),"@"), + [N,H] = string:lexemes(atom_to_list(NN),"@"), {ok, Sock} = gen_tcp:accept(LSock), pang = net_adm:ping(NN), {N,H,Sock}. @@ -2248,8 +2330,7 @@ forever(Fun) -> forever(Fun). abort(Why) -> - erts_debug:set_internal_state(available_internal_state, true), - erts_debug:set_internal_state(abort, Why). + set_internal_state(abort, Why). start_busy_dist_port_tracer() -> diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index 33d0b708cf..475e03087a 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -1192,9 +1192,9 @@ check_driver_system_info_result(Result) -> io:format("All names: ~p~n", [?EXPECTED_SYSTEM_INFO_NAMES]), io:format("Result: ~p~n", [Result]), {[], Ns, DDVSN} = chk_sis(lists:map(fun (Str) -> - string:tokens(Str, "=") + string:lexemes(Str, "=") end, - string:tokens(Result, " ")), + string:lexemes(Result, " ")), ?EXPECTED_SYSTEM_INFO_NAMES), case {DDVSN, drv_vsn_str2tup(erlang:system_info(driver_version))} of @@ -2438,7 +2438,7 @@ wait_until(Fun) -> end. drv_vsn_str2tup(Str) -> - [Major, Minor] = string:tokens(Str, "."), + [Major, Minor] = string:lexemes(Str, "."), {list_to_integer(Major), list_to_integer(Minor)}. %% Build port data from a template. diff --git a/erts/emulator/test/erl_link_SUITE.erl b/erts/emulator/test/erl_link_SUITE.erl index d8c5b663e3..a66ca7a57d 100644 --- a/erts/emulator/test/erl_link_SUITE.erl +++ b/erts/emulator/test/erl_link_SUITE.erl @@ -200,13 +200,16 @@ monitor_nodes(Config) when is_list(Config) -> monitor_node(A, true), check_monitor_node(self(), A, 1), check_monitor_node(self(), B, 3), + ok = receive {nodedown, C} -> ok after 1000 -> timeout end, + %%OTP-21: monitor_node(_,false) does not trigger auto-connect anymore + %% and therefore no nodedown if it fails. + %%ok = receive {nodedown, C} -> ok after 1000 -> timeout end, + ok = receive {nodedown, C} -> ok after 1000 -> timeout end, + ok = receive {nodedown, D} -> ok after 1000 -> timeout end, + ok = receive {nodedown, D} -> ok after 1000 -> timeout end, check_monitor_node(self(), C, 0), check_monitor_node(self(), D, 0), - receive {nodedown, C} -> ok end, - receive {nodedown, C} -> ok end, - receive {nodedown, C} -> ok end, - receive {nodedown, D} -> ok end, - receive {nodedown, D} -> ok end, + stop_node(A), receive {nodedown, A} -> ok end, check_monitor_node(self(), A, 0), diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl index be90f929df..7df001fec5 100644 --- a/erts/emulator/test/node_container_SUITE.erl +++ b/erts/emulator/test/node_container_SUITE.erl @@ -966,6 +966,8 @@ check_refc(ThisNodeName,ThisCreation,Table,EntryList) when is_list(EntryList) -> {case Referrer of {system,delayed_delete_timer} -> true; + {system,thread_progress_delete_timer} -> + true; _ -> DDT end, diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index 1c76eb8019..17555d63c6 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -145,7 +145,7 @@ t_float_to_string(Config) when is_list(Config) -> 123456789012345678.0, [{decimals, 237}])), {'EXIT', {badarg, _}} = (catch float_to_binary( 123456789012345678.0, [{decimals, 237}])), - test_fts("1." ++ string:copies("0", 249) ++ "e+00", + test_fts("1." ++ lists:duplicate(249, $0) ++ "e+00", 1.0, [{scientific, 249}, compact]), X1 = float_to_list(1.0), diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index 730a17d7e8..e46665a881 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -1035,6 +1035,9 @@ huge_env(Config) when is_list(Config) -> try erlang:open_port({spawn,Cmd},[exit_status, {env, Env}]) of P -> receive + {P, {exit_status,N}} = M when N > 127-> + %% If exit status is > 127 something went very wrong + ct:fail("Open port failed got ~p",[M]); {P, {exit_status,N}} = M -> %% We test that the exit status is an integer, this means %% that the child program has started. If we get an atom @@ -1662,13 +1665,7 @@ spawn_executable(Config) when is_list(Config) -> [ExactFile2,"hello world","dlrow olleh"] = run_echo_args_2(unicode:characters_to_binary("\""++ExactFile2++"\" "++"\"hello world\" \"dlrow olleh\"")), - ExeExt = - case string:to_lower(lists:last(string:tokens(ExactFile2,"."))) of - "exe" -> - ".exe"; - _ -> - "" - end, + ExeExt = filename:extension(ExactFile2), Executable2 = "spoky name"++ExeExt, file:copy(ExactFile1,filename:join([SpaceDir,Executable2])), ExactFile3 = filename:nativename(filename:join([SpaceDir,Executable2])), @@ -1836,7 +1833,7 @@ collect_data(Port) -> end. parse_echo_args_output(Data) -> - [lists:last(string:tokens(S,"|")) || S <- string:tokens(Data,"\r\n")]. + [lists:last(string:lexemes(S,"|")) || S <- string:lexemes(Data,["\r\n",$\n])]. %% Test that the emulator does not mix up ports when the port table wraps mix_up_ports(Config) when is_list(Config) -> @@ -1962,7 +1959,7 @@ max_ports() -> erlang:system_info(port_limit). port_ix(Port) when is_port(Port) -> - ["#Port",_,PortIxStr] = string:tokens(erlang:port_to_list(Port), + ["#Port",_,PortIxStr] = string:lexemes(erlang:port_to_list(Port), "<.>"), list_to_integer(PortIxStr). diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index a9f20f9928..a8bcfac84d 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -2532,8 +2532,13 @@ system_task_on_suspended(Config) when is_list(Config) -> end. gc_request_when_gc_disabled(Config) when is_list(Config) -> - Master = self(), AIS = erts_debug:set_internal_state(available_internal_state, true), + gc_request_when_gc_disabled_do(ref), + gc_request_when_gc_disabled_do(immed), + erts_debug:set_internal_state(available_internal_state, AIS). + +gc_request_when_gc_disabled_do(ReqIdType) -> + Master = self(), {P, M} = spawn_opt(fun () -> true = erts_debug:set_internal_state(gc_state, false), @@ -2545,7 +2550,10 @@ gc_request_when_gc_disabled(Config) when is_list(Config) -> receive after 100 -> ok end end, [monitor, link]), receive {P, gc_state, false} -> ok end, - ReqId = make_ref(), + ReqId = case ReqIdType of + ref -> make_ref(); + immed -> immed + end, async = garbage_collect(P, [{async, ReqId}]), receive {garbage_collect, ReqId, Result} -> @@ -2554,7 +2562,6 @@ gc_request_when_gc_disabled(Config) when is_list(Config) -> ok end, receive {garbage_collect, ReqId, true} -> ok end, - erts_debug:set_internal_state(available_internal_state, AIS), receive {'DOWN', M, process, P, _Reason} -> ok end, ok. diff --git a/erts/emulator/test/receive_SUITE.erl b/erts/emulator/test/receive_SUITE.erl index a12019ec83..1fe11428b4 100644 --- a/erts/emulator/test/receive_SUITE.erl +++ b/erts/emulator/test/receive_SUITE.erl @@ -25,14 +25,16 @@ -include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0, - call_with_huge_message_queue/1,receive_in_between/1]). + call_with_huge_message_queue/1,receive_in_between/1, + receive_opt_exception/1,receive_opt_recursion/1]). suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap, {minutes, 3}}]. -all() -> - [call_with_huge_message_queue, receive_in_between]. +all() -> + [call_with_huge_message_queue, receive_in_between, + receive_opt_exception, receive_opt_recursion]. call_with_huge_message_queue(Config) when is_list(Config) -> Pid = spawn_link(fun echo_loop/0), @@ -113,6 +115,60 @@ receive_one() -> dummy -> ok end. +receive_opt_exception(_Config) -> + Recurse = fun() -> + %% Overwrite with the same mark, + %% and never consume it. + ThrowFun = fun() -> throw(aborted) end, + aborted = (catch do_receive_opt_exception(ThrowFun)), + ok + end, + do_receive_opt_exception(Recurse), + + %% Eat the second message. + receive + Ref when is_reference(Ref) -> ok + end. + +do_receive_opt_exception(Disturber) -> + %% Create a receive mark. + Ref = make_ref(), + self() ! Ref, + Disturber(), + receive + Ref -> + ok + after 0 -> + error(the_expected_message_was_not_there) + end. + +receive_opt_recursion(_Config) -> + Recurse = fun() -> + %% Overwrite with the same mark, + %% and never consume it. + NoOp = fun() -> ok end, + BlackHole = spawn(NoOp), + expected = do_receive_opt_recursion(BlackHole, NoOp, true), + ok + end, + do_receive_opt_recursion(self(), Recurse, false), + ok. + +do_receive_opt_recursion(Recipient, Disturber, IsInner) -> + Ref = make_ref(), + Recipient ! Ref, + Disturber(), + receive + Ref -> ok + after 0 -> + case IsInner of + true -> + expected; + false -> + error(the_expected_message_was_not_there) + end + end. + %%% %%% Common helpers. %%% diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index 7afb82a1b8..7eebbe8b19 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -894,11 +894,9 @@ adjust_schedulers_online() -> read_affinity(Data) -> Exp = "pid " ++ os:getpid() ++ "'s current affinity mask", - case string:tokens(Data, ":") of + case string:lexemes(Data, ":") of [Exp, DirtyAffinityStr] -> - AffinityStr = string:strip(string:strip(DirtyAffinityStr, - both, $ ), - both, $\n), + AffinityStr = string:trim(DirtyAffinityStr), case catch erlang:list_to_integer(AffinityStr, 16) of Affinity when is_integer(Affinity) -> Affinity; diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl index 56522039da..fdf4aab24d 100644 --- a/erts/emulator/test/system_info_SUITE.erl +++ b/erts/emulator/test/system_info_SUITE.erl @@ -308,9 +308,9 @@ memory_test(_Config) -> mem_workers_call(MWs, fun () -> - list_to_atom("an ugly atom "++integer_to_list(erlang:system_info(scheduler_id))), - list_to_atom("another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))), - list_to_atom("yet another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))) + _ = list_to_atom("an ugly atom "++integer_to_list(erlang:system_info(scheduler_id))), + _ = list_to_atom("another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))), + _ = list_to_atom("yet another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))) end, []), cmp_memory(MWs, "new atoms"), diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index d7791d23fa..da994fae3e 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -19,7 +19,7 @@ # %CopyrightEnd% # use strict; -use vars qw($BEAM_FORMAT_NUMBER); +use vars qw($BEAM_FORMAT_NUMBER $GC_REGEXP); use constant COLD => 0; use constant WARM => 1; use constant HOT => 2; @@ -36,6 +36,7 @@ use constant PACK_CMD_LOOSE => '3'; use constant PACK_CMD_WIDE => '4'; $BEAM_FORMAT_NUMBER = undef; +$GC_REGEXP = undef; my $target = \&emulator_output; my $outdir = "."; # Directory for output files. @@ -77,6 +78,10 @@ my %num_specific; my %gen_to_spec; my %specific_op; +# The following hashes are used for error checking. +my %print_name; +my %specific_op_arity; + # Information about each specific operator. Key is the print name (e.g. get_list_xxy). # Value is a hash. my %spec_op_info; @@ -131,7 +136,10 @@ my $loader_types = "nprvlqo"; my $genop_types = $compiler_types . $loader_types; # -# Defines the argument types and their loaded size assuming no packing. +# Define the operand types and their loaded size assuming no packing. +# +# Those are the types that can be used in the definition of a specific +# instruction. # my %arg_size = ('r' => 0, # x(0) - x register zero 'x' => 1, # x(N), N > 0 - x register @@ -154,12 +162,35 @@ my %arg_size = ('r' => 0, # x(0) - x register zero 'A' => 1, # arity value 'P' => 1, # byte offset into tuple or stack 'Q' => 1, # like 'P', but packable - 'h' => 1, # character + 'h' => 1, # character (not used) 'l' => 1, # float reg 'q' => 1, # literal term ); # +# Define the types that may be used in a transformation rule. +# +# %pattern_type defines the types that may be used in a pattern +# on the left side. +# +# %construction_type defines the types that may be used when +# constructing a new instruction on the right side (a subset of +# the pattern types that are possible to construct). +# +my $pattern_types = "acdfjilnopqsuxy"; +my %pattern_type; +@pattern_type{split("", $pattern_types)} = (1) x length($pattern_types); + +my %construction_type; +foreach my $type (keys %pattern_type) { + $construction_type{$type} = 1 + if index($genop_types, $type) >= 0; +} +foreach my $makes_no_sense ('f', 'j', 'o', 'p', 'q') { + delete $construction_type{$makes_no_sense}; +} + +# # Generate bits. # my %type_bit; @@ -194,7 +225,8 @@ sub define_type_bit { define_type_bit('S', $type_bit{'d'}); define_type_bit('j', $type_bit{'f'} | $type_bit{'p'}); - # Aliases (for matching purposes). + # Aliases of 'u'. Those specify how to load the operand and + # what kind of packing can be done. define_type_bit('t', $type_bit{'u'}); define_type_bit('I', $type_bit{'u'}); define_type_bit('W', $type_bit{'u'}); @@ -279,9 +311,15 @@ if ($wordsize == 64) { # Add placeholders for built-in macros. # -$c_code{'IS_PACKED'} = ['$Expr',"built-in macro",('Expr')]; -$c_code{'ARG_POSITION'} = ['$Expr',"built-in macro",('Expr')]; -foreach my $name (keys %c_code) { +my %predef_macros = + (OPERAND_POSITION => ['Expr'], + IF => ['Expr','IfTrue','IfFalse'], + REFRESH_GEN_DEST => [], + ); +foreach my $name (keys %predef_macros) { + my @args = @{$predef_macros{$name}}; + my $body = join(':', map { '$' . $_ } @args); + $c_code{$name} = [$body,"built-in macro",@args], $c_code_used{$name} = 1; } @@ -359,8 +397,10 @@ while (<>) { # if (/^([\w_][\w\d_]+)=(.*)/) { no strict 'refs'; - my($name) = $1; - $$name = $2; + my $name = $1; + my $value = $2; + $value =~ s/;\s*$//; + $$name = $value; next; } @@ -1019,6 +1059,22 @@ sub parse_specific_op { my $key = "$name/$arity"; foreach my $args_ref (@res) { @args = @$args_ref; + my $arity = @args; + my $loc = "$ARGV($.)"; + if (defined $specific_op_arity{$name}) { + my($prev_arity,$loc) = @{$specific_op_arity{$name}}; + if ($arity != $prev_arity) { + error("$name defined with arity $arity, " . + "but previously defined with arity $prev_arity at $loc"); + } + } + $specific_op_arity{$name} = [$arity,$loc]; + my $print_name = print_name($name, @args); + if (defined $print_name{$print_name}) { + error("$name @args: already defined at " . + $print_name{$print_name}); + } + $print_name{$print_name} = $loc; push @{$specific_op{$key}}, [$name,$hotness,@args]; } @@ -1333,7 +1389,9 @@ sub cg_basic { # sub cg_combined_size { - my %params = (@_, pack_options => \@basic_pack_options); + my %params = (@_, + pack_options => \@basic_pack_options, + size_only => 1); $params{pack_options} = \@extended_pack_options if $params{first}; my($size) = code_gen(%params); @@ -1361,6 +1419,7 @@ sub code_gen { my %params = (extra_comments => '', offset => 0, inc => 0, + size_only => 0, @_); my $name = $params{name}; my $extra_comments = $params{extra_comments}; @@ -1393,6 +1452,7 @@ sub code_gen { my $need_block = 0; my $arg_offset = $offset; + my $has_gen_dest = 0; @args = map { s/[?]$//g; $_ } @args; foreach (@args) { my($this_size) = $arg_size{$_}; @@ -1403,6 +1463,7 @@ sub code_gen { "Eterm* dst_ptr = REG_TARGET_PTR(dst);\n"; push(@f, "*dst_ptr"); $this_size = $1; + $has_gen_dest = 1; last SWITCH; }; /^packed:[a-zA-z]:(\d):(.*)/ and do { @@ -1435,6 +1496,7 @@ sub code_gen { $var_decls .= "Eterm dst = " . arg_offset($arg_offset) . ";\n" . "Eterm* dst_ptr = REG_TARGET_PTR(dst);\n"; push(@f, "*dst_ptr"); + $has_gen_dest = 1; last SWITCH; }; defined $arg_size{$_} and do { @@ -1449,10 +1511,10 @@ sub code_gen { } # - # If the implementation is in beam_emu.c, there is nothing - # more to do. + # If the implementation is in beam_emu.c or if + # the caller only wants the size, we are done. # - unless (defined $c_code_ref) { + if (not defined $c_code_ref or $params{size_only}) { return ($size+1, undef, ''); } @@ -1517,9 +1579,36 @@ sub code_gen { "{", "$var_decls$body", "}", ""); + + # Make sure that $REFRESH_GEN_DEST() is used when a + # general destination ('d') may have been clobbered by + # a GC. + my $gc_error = verify_gc_code($code, $has_gen_dest); + if (defined $gc_error) { + warn $gc_error; + error("... from the body of $name at $where"); + } + + # Done. ($size+1, $code, $pack_spec); } +sub verify_gc_code { + my $code = shift; + my $has_gen_dest = shift; + + return unless $has_gen_dest; + + if ($code =~ /$GC_REGEXP/o) { + my $code_after_gc = substr($code, $+[0]); + unless ($code_after_gc =~ /dst_ptr = REG_TARGET_PTR/) { + return "pointer to destination register is invalid after GC -- " . + "use \$REFRESH_GEN_DEST()\n"; + } + } + return undef; +} + sub arg_offset { my $offset = shift; "I[" . ($offset+1) . "]"; @@ -1619,17 +1708,26 @@ sub expand_macro { } # Handle built-in macros. - if ($name eq 'ARG_POSITION') { + if ($name eq 'OPERAND_POSITION') { if ($body =~ /^I\[(\d+)\]$/) { $body = $1; } else { $body = 0; } - } elsif ($name eq 'IS_PACKED') { - $body = ($body =~ /^I\[\d+\]$/) ? 0 : 1; + } elsif ($name eq 'IF') { + my $expr = $new_bindings{Expr}; + my $bool = eval $expr; + if ($@ ne '') { + &error("bad expression '$expr' in \$IF()"); + } + my $part = $bool ? 'IfTrue' : 'IfFalse'; + $body = $new_bindings{$part}; + } elsif ($name eq 'REFRESH_GEN_DEST') { + $body = "dst_ptr = REG_TARGET_PTR(dst)"; } - # Wrap body if needed and return resul.t + + # Wrap body if needed and return result. $body = "do {\n$body\n} while (0)" if needs_do_wrapper($body); ($body,$rest); @@ -2156,12 +2254,19 @@ sub tr_parse_op { if (/^([a-z*]+)(.*)/) { $type = $1; $_ = $2; + error("$type: only a single type is allowed on right side of transformations") + if not $src and length($type) > 1; foreach (split('', $type)) { - error("bad type in $op") - unless defined $type_bit{$_} or $type eq '*'; - $_ eq 'r' and - error("$op: 'r' is not allowed in transformations") - } + next if $src and $type eq '*'; + error("$op: not a type") + unless defined $type_bit{$_}; + error("$op: the type '$_' is not allowed in transformations") + unless defined $pattern_type{$_}; + if (not $src) { + error("$op: type '$_' is not allowed on the right side of transformations") + unless defined $construction_type{$_}; + } + } } # Get an optional condition. (In source.) @@ -2194,10 +2299,18 @@ sub tr_parse_op { } # Get an optional value. (In destination.) - $type_val = $type eq 'x' ? 1023 : 0; + if ($type eq 'x') { + $type_val = 1023; + } elsif ($type eq 'a') { + $type_val = 'am_Empty'; + } else { + $type_val = 0; + } if (/^=(.*)/) { - error("value not allowed in source: $op") + error("$op: value not allowed in source") if $src; + error("$op: the type 'n' must not be given a value") + if $type eq 'n'; $type_val = $1; $_ = ''; } @@ -2207,13 +2320,16 @@ sub tr_parse_op { error("garbage '$_' after operand: $op") unless /^\s*$/; - # Test that destination has no conditions. + # Check the conditions. - unless ($src) { - error("condition not allowed in destination: $op") + if ($src) { + error("$op: the type '$type' is not allowed to be compared with a literal value") + if $cond and not $construction_type{$type}; + } else { + error("$op: condition not allowed in destination") if $cond; - error("variable name and type cannot be combined in destination: $op") - if $var && $type; + error("$op: variable name and type cannot be combined in destination") + if $var and $type; } ($var,$type,$type_val,$cond,$cond_val); diff --git a/erts/etc/common/dialyzer.c b/erts/etc/common/dialyzer.c index 0e74eb065b..b45d5c7ca7 100644 --- a/erts/etc/common/dialyzer.c +++ b/erts/etc/common/dialyzer.c @@ -255,7 +255,7 @@ int main(int argc, char** argv) } PUSH("+B"); - PUSH2("-boot", "start_clean"); + PUSH2("-boot", "no_dot_erlang"); PUSH3("-run", "dialyzer", "plain_cl"); PUSH("-extra"); diff --git a/erts/etc/common/erlc.c b/erts/etc/common/erlc.c index 8cfd98bcc4..aa99c69100 100644 --- a/erts/etc/common/erlc.c +++ b/erts/etc/common/erlc.c @@ -234,7 +234,7 @@ int main(int argc, char** argv) PUSH("+A0"); PUSH("-noinput"); PUSH2("-mode", "minimal"); - PUSH2("-boot", "start_clean"); + PUSH2("-boot", "no_dot_erlang"); PUSH3("-s", "erl_compile", "compile_cmdline"); PUSH("-extra"); diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index d61a3cbf95..08e326b33b 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -31,6 +31,7 @@ #ifdef __WIN32__ # include "erl_version.h" # include "init_file.h" +# include <Shlobj.h> #endif #define NO 0 @@ -1531,17 +1532,16 @@ static void get_parameters(int argc, char** argv) static void get_home(void) { - int len; - char tmpstr[MAX_PATH+1]; + wchar_t *profile; char* homedrive; char* homepath; homedrive = get_env("HOMEDRIVE"); homepath = get_env("HOMEPATH"); if (!homedrive || !homepath) { - if (len = GetWindowsDirectory(tmpstr,MAX_PATH)) { - home = emalloc(len+1); - strcpy(home,tmpstr); + if (SHGetKnownFolderPath(&FOLDERID_Profile, 0, NULL, &profile) == S_OK) { + home = utf16_to_utf8(profile); + /* CoTaskMemFree(profile); */ } else error("HOMEDRIVE or HOMEPATH is not set and GetWindowsDir failed"); } else { diff --git a/erts/etc/common/escript.c b/erts/etc/common/escript.c index 8241675200..d739d21f12 100644 --- a/erts/etc/common/escript.c +++ b/erts/etc/common/escript.c @@ -521,7 +521,7 @@ main(int argc, char** argv) free_env_val(env); PUSH("+B"); - PUSH2("-boot", "start_clean"); + PUSH2("-boot", "no_dot_erlang"); PUSH("-noshell"); /* diff --git a/erts/etc/common/typer.c b/erts/etc/common/typer.c index b64cbb4a92..f13135d883 100644 --- a/erts/etc/common/typer.c +++ b/erts/etc/common/typer.c @@ -177,7 +177,7 @@ main(int argc, char** argv) } PUSH("+B"); - PUSH2("-boot", "start_clean"); + PUSH2("-boot", "no_dot_erlang"); PUSH3("-run", "typer", "start"); PUSH("-extra"); diff --git a/erts/etc/unix/cerl.src b/erts/etc/unix/cerl.src index 8d5882cf32..9dd8d85abe 100644 --- a/erts/etc/unix/cerl.src +++ b/erts/etc/unix/cerl.src @@ -45,6 +45,8 @@ # -valgrind Run emulator compiled for valgrind # -lcnt Run emulator compiled for lock counting # -icount Run emulator compiled for instruction counting +# -rr Run emulator under "rr record" +# Can be combined with compile targets (like -debug) except valgrind. # -nox Unset the DISPLAY variable to disable us of X Windows # # FIXME For GDB you can also set the break point using "-break FUNCTION". @@ -84,6 +86,8 @@ GDBARGS= TYPE= debug= run_valgrind=no +run_rr=no +skip_erlexec=no # Default rootdir ROOTDIR=%SRC_ROOTDIR% @@ -225,6 +229,13 @@ while [ $# -gt 0 ]; do cargs="$cargs -valgrind" TYPE=.valgrind run_valgrind=yes + skip_erlexec=yes + ;; + "-rr") + shift + cargs="$cargs -rr" + run_rr=yes + skip_erlexec=yes ;; *) break @@ -246,7 +257,19 @@ PROGNAME="$PROGNAME$cargs" EMU="$EMU$TYPE" EMU_NAME=`$EXEC -emu_name_exit $eeargs` -if [ $run_valgrind != yes ]; then +if [ $skip_erlexec = yes ]; then + emu_xargs=`echo $xargs | sed "s|+|-|g"` + beam_args=`$EXEC -emu_args_exit ${1+"$@"}` + + # Prepare for some argument passing voodoo: + # $beam_args is a list of command line arguments separated by newlines. + # Make "$@" represent those arguments verbatim (including spaces and quotes). + SAVE_IFS="$IFS" + IFS=' +' + set -- $beam_args + IFS="$SAVE_IFS" +else xargs="$xargs -pz $PRELOADED --" fi if [ "x$GDB" = "x" ]; then @@ -254,7 +277,6 @@ if [ "x$GDB" = "x" ]; then valversion=`valgrind --version` valmajor=`echo $valversion | sed 's,[a-z]*\-\([0-9]*\).*,\1,'` valminor=`echo $valversion | sed 's,[a-z]*\-[0-9]*.\([0-9]*\).*,\1,'` - emu_xargs=`echo $xargs | sed "s|+|-|g"` if [ "x$VALGRIND_LOG_XML" = "x" ]; then valgrind_xml= log_file_prefix="--log-file=" @@ -294,17 +316,10 @@ if [ "x$GDB" = "x" ]; then sched_arg= fi - beam_args=`$EXEC -emu_args_exit ${1+"$@"}` - - # Time for some argument passing voodoo: - # $beam_args is a list of command line arguments separated by newlines. - # Make "$@" represent those arguments verbatim (including spaces and quotes). - SAVE_IFS="$IFS" - IFS=' -' - set -- $beam_args - IFS="$SAVE_IFS" exec $taskset1 valgrind $valgrind_xml $valgrind_log $valgrind_misc_flags $BINDIR/$EMU_NAME $sched_arg $emu_xargs "$@" -pz $PRELOADED + + elif [ $run_rr = yes ]; then + exec rr record --ignore-nested $BINDIR/$EMU_NAME $emu_xargs "$@" -pz $PRELOADED else exec $EXEC $eeargs $xargs ${1+"$@"} fi diff --git a/erts/include/internal/erl_printf.h b/erts/include/internal/erl_printf.h index f180a53f18..7e9807f6a8 100644 --- a/erts/include/internal/erl_printf.h +++ b/erts/include/internal/erl_printf.h @@ -44,6 +44,7 @@ struct erts_dsprintf_buf_t_ { typedef int (*fmtfn_t)(void*, char*, size_t); int erts_write_fd(void *vfdp, char* buf, size_t len); +int erts_write_fp(void *vfdp, char* buf, size_t len); int erts_write_ds(void *vdsbufp, char* buf, size_t len); int erts_printf(const char *, ...); diff --git a/erts/lib_src/common/erl_printf.c b/erts/lib_src/common/erl_printf.c index 9031a4c5b7..1de0f81e84 100644 --- a/erts/lib_src/common/erl_printf.c +++ b/erts/lib_src/common/erl_printf.c @@ -143,8 +143,8 @@ write_f_add_cr(void *vfp, char* buf, size_t len) return len; } -static int -write_f(void *vfp, char* buf, size_t len) +int +erts_write_fp(void *vfp, char* buf, size_t len) { ASSERT(vfp); #ifdef PUTC_ON_SMALL_WRITES @@ -253,7 +253,7 @@ erts_printf(const char *format, ...) FLOCKFILE(stdout); res = erts_printf_format(erts_printf_add_cr_to_stdout ? write_f_add_cr - : write_f, + : erts_write_fp, (void *) stdout, (char *) format, arglist); @@ -281,7 +281,7 @@ erts_fprintf(FILE *filep, const char *format, ...) else if (erts_printf_add_cr_to_stderr && filep == stderr) fmt_f = write_f_add_cr; else - fmt_f = write_f; + fmt_f = erts_write_fp; FLOCKFILE(filep); res = erts_printf_format(fmt_f,(void *)filep,(char *)format,arglist); FUNLOCKFILE(filep); @@ -386,7 +386,7 @@ erts_vprintf(const char *format, va_list arglist) errno = 0; res = erts_printf_format(erts_printf_add_cr_to_stdout ? write_f_add_cr - : write_f, + : erts_write_fp, (void *) stdout, (char *) format, arglist); @@ -410,7 +410,7 @@ erts_vfprintf(FILE *filep, const char *format, va_list arglist) else if (erts_printf_add_cr_to_stderr && filep == stderr) fmt_f = write_f_add_cr; else - fmt_f = write_f; + fmt_f = erts_write_fp; res = erts_printf_format(fmt_f,(void *)filep,(char *)format,arglist); } return res; diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex 5ffcaa9280..198032c18d 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erl_tracer.beam b/erts/preloaded/ebin/erl_tracer.beam Binary files differindex 9f07eb209b..7754d64a6b 100644 --- a/erts/preloaded/ebin/erl_tracer.beam +++ b/erts/preloaded/ebin/erl_tracer.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex e6657e24b3..7ee47ee023 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam Binary files differindex 7278d71084..655e1d2e06 100644 --- a/erts/preloaded/ebin/erts_code_purger.beam +++ b/erts/preloaded/ebin/erts_code_purger.beam diff --git a/erts/preloaded/ebin/erts_dirty_process_code_checker.beam b/erts/preloaded/ebin/erts_dirty_process_code_checker.beam Binary files differindex b92c03d6d7..2a4cb53d3e 100644 --- a/erts/preloaded/ebin/erts_dirty_process_code_checker.beam +++ b/erts/preloaded/ebin/erts_dirty_process_code_checker.beam diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex 1dad5841fc..f8871c63eb 100644 --- a/erts/preloaded/ebin/erts_internal.beam +++ b/erts/preloaded/ebin/erts_internal.beam diff --git a/erts/preloaded/ebin/erts_literal_area_collector.beam b/erts/preloaded/ebin/erts_literal_area_collector.beam Binary files differindex 187ea3cc28..bb2676a9e8 100644 --- a/erts/preloaded/ebin/erts_literal_area_collector.beam +++ b/erts/preloaded/ebin/erts_literal_area_collector.beam diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam Binary files differindex 9c329e2ca4..fb4fc67148 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam Binary files differindex a2df162521..6a03451ad5 100644 --- a/erts/preloaded/ebin/otp_ring0.beam +++ b/erts/preloaded/ebin/otp_ring0.beam diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam Binary files differindex 235e0d71f1..17c59708e7 100644 --- a/erts/preloaded/ebin/prim_eval.beam +++ b/erts/preloaded/ebin/prim_eval.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex d08e11ab2f..eb326ac4b6 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam Binary files differindex 988ef61413..32b104ae95 100644 --- a/erts/preloaded/ebin/prim_inet.beam +++ b/erts/preloaded/ebin/prim_inet.beam diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam Binary files differindex f0d41ed6bf..1ec6870178 100644 --- a/erts/preloaded/ebin/prim_zip.beam +++ b/erts/preloaded/ebin/prim_zip.beam diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam Binary files differindex e96d0dca5c..7a5f4d7527 100644 --- a/erts/preloaded/ebin/zlib.beam +++ b/erts/preloaded/ebin/zlib.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index f743b7d26b..2be053575b 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -31,8 +31,7 @@ -export([localtime_to_universaltime/1]). -export([suspend_process/1]). -export([min/2, max/2]). --export([dlink/1, dunlink/1, dsend/2, dsend/3, dgroup_leader/2, - dexit/2, dmonitor_node/3, dmonitor_p/2]). +-export([dmonitor_node/3, dmonitor_p/2]). -export([delay_trap/2]). -export([set_cookie/2, get_cookie/0]). -export([nodes/0]). @@ -124,7 +123,7 @@ -export([crc32/2, crc32_combine/3, date/0, decode_packet/3]). -export([delete_element/2]). -export([delete_module/1, demonitor/1, demonitor/2, display/1]). --export([display_nl/0, display_string/1, dist_exit/3, erase/0, erase/1]). +-export([display_nl/0, display_string/1, erase/0, erase/1]). -export([error/1, error/2, exit/1, exit/2, external_size/1]). -export([external_size/2, finish_after_on_load/2, finish_loading/1, float/1]). -export([float_to_binary/1, float_to_binary/2, @@ -427,9 +426,11 @@ binary_to_term(_Binary) -> erlang:nif_error(undefined). %% binary_to_term/2 --spec binary_to_term(Binary, Opts) -> term() when +-spec binary_to_term(Binary, Opts) -> term() | {term(), Used} when Binary :: ext_binary(), - Opts :: [safe]. + Opt :: safe | used, + Opts :: [Opt], + Used :: pos_integer(). binary_to_term(_Binary, _Opts) -> erlang:nif_error(undefined). @@ -702,14 +703,6 @@ display_nl() -> display_string(_P1) -> erlang:nif_error(undefined). -%% dist_exit/3 --spec erlang:dist_exit(P1, P2, P3) -> true when - P1 :: pid(), - P2 :: kill | noconnection | normal, - P3 :: pid() | port(). -dist_exit(_P1, _P2, _P3) -> - erlang:nif_error(undefined). - %% dt_append_vm_tag_data/1 -spec erlang:dt_append_vm_tag_data(IoData) -> IoDataRet when IoData :: iodata(), @@ -3265,34 +3258,11 @@ dist_ctrl_get_data_notification(_DHandle) -> dist_get_stat(_DHandle) -> erlang:nif_error(undefined). -%% -%% If the emulator wants to perform a distributed command and -%% a connection is not established to the actual node the following -%% functions are called in order to set up the connection and then -%% reactivate the command. -%% - --spec erlang:dlink(pid() | port()) -> 'true'. -dlink(Pid) -> - case net_kernel:connect(erlang:node(Pid)) of - true -> erlang:link(Pid); - false -> erlang:dist_exit(erlang:self(), noconnection, Pid), true - end. - -%% Can this ever happen? --spec erlang:dunlink(identifier()) -> 'true'. -dunlink(Pid) -> - case net_kernel:connect(erlang:node(Pid)) of - true -> erlang:unlink(Pid); - false -> true - end. - -dmonitor_node(Node, Flag, []) -> - case net_kernel:connect(Node) of - true -> erlang:monitor_node(Node, Flag, []); - false -> erlang:self() ! {nodedown, Node}, true - end; +dmonitor_node(Node, _Flag, []) -> + %% Only called when auto-connect attempt failed early in VM + erlang:self() ! {nodedown, Node}, + true; dmonitor_node(Node, Flag, Opts) -> case lists:member(allow_passive_connect, Opts) of true -> @@ -3304,71 +3274,12 @@ dmonitor_node(Node, Flag, Opts) -> dmonitor_node(Node,Flag,[]) end. -dgroup_leader(Leader, Pid) -> - case net_kernel:connect(erlang:node(Pid)) of - true -> erlang:group_leader(Leader, Pid); - false -> true %% bad arg ? - end. - -dexit(Pid, Reason) -> - case net_kernel:connect(erlang:node(Pid)) of - true -> erlang:exit(Pid, Reason); - false -> true - end. - -dsend(Pid, Msg) when erlang:is_pid(Pid) -> - case net_kernel:connect(erlang:node(Pid)) of - true -> erlang:send(Pid, Msg); - false -> Msg - end; -dsend(Port, Msg) when erlang:is_port(Port) -> - case net_kernel:connect(erlang:node(Port)) of - true -> erlang:send(Port, Msg); - false -> Msg - end; -dsend({Name, Node}, Msg) -> - case net_kernel:connect(Node) of - true -> erlang:send({Name,Node}, Msg); - false -> Msg; - ignored -> Msg % Not distributed. - end. - -dsend(Pid, Msg, Opts) when erlang:is_pid(Pid) -> - case net_kernel:connect(erlang:node(Pid)) of - true -> erlang:send(Pid, Msg, Opts); - false -> ok - end; -dsend(Port, Msg, Opts) when erlang:is_port(Port) -> - case net_kernel:connect(erlang:node(Port)) of - true -> erlang:send(Port, Msg, Opts); - false -> ok - end; -dsend({Name, Node}, Msg, Opts) -> - case net_kernel:connect(Node) of - true -> erlang:send({Name,Node}, Msg, Opts); - false -> ok; - ignored -> ok % Not distributed. - end. - -spec erlang:dmonitor_p('process', pid() | {atom(),atom()}) -> reference(). dmonitor_p(process, ProcSpec) -> - %% ProcSpec = pid() | {atom(),atom()} - %% ProcSpec CANNOT be an atom because a locally registered process - %% is never handled here. - Node = case ProcSpec of - {S,N} when erlang:is_atom(S), - erlang:is_atom(N), - N =/= erlang:node() -> N; - _ when erlang:is_pid(ProcSpec) -> erlang:node(ProcSpec) - end, - case net_kernel:connect(Node) of - true -> - erlang:monitor(process, ProcSpec); - false -> - Ref = erlang:make_ref(), - erlang:self() ! {'DOWN', Ref, process, ProcSpec, noconnection}, - Ref - end. + %% Only called when auto-connect attempt failed early in VM + Ref = erlang:make_ref(), + erlang:self() ! {'DOWN', Ref, process, ProcSpec, noconnection}, + Ref. %% %% Trap function used when modified timing has been enabled. diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index 83439f0279..ffa9217c4d 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -63,6 +63,9 @@ -export([dist_ctrl_put_data/2]). +-export([new_connection/1]). +-export([abort_connection/2]). + %% Auto import name clash -export([check_process_code/1]). @@ -501,3 +504,16 @@ dist_ctrl_put_data(DHandle, IoList) -> | RootST], erlang:raise(Class, Reason, StackTrace) end. + + +-spec erts_internal:new_connection(Node) -> ConnId when + Node :: atom(), + ConnId :: {integer(), erlang:dist_handle()}. +new_connection(_Node) -> + erlang:nif_error(undefined). + +-spec erts_internal:abort_connection(Node, ConnId) -> boolean() when + Node :: atom(), + ConnId :: {integer(), erlang:dist_handle()}. +abort_connection(_Node, _ConnId) -> + erlang:nif_error(undefined). diff --git a/erts/preloaded/src/zlib.erl b/erts/preloaded/src/zlib.erl index 3170ab6351..a4ef42204d 100644 --- a/erts/preloaded/src/zlib.erl +++ b/erts/preloaded/src/zlib.erl @@ -20,7 +20,8 @@ -module(zlib). --export([open/0,close/1,deflateInit/1,deflateInit/2,deflateInit/6, +-export([open/0,close/1,set_controlling_process/2, + deflateInit/1,deflateInit/2,deflateInit/6, deflateSetDictionary/2,deflateReset/1,deflateParams/3, deflate/2,deflate/3,deflateEnd/1, inflateInit/1,inflateInit/2,inflateInit/3, @@ -128,6 +129,14 @@ close(Z) -> close_nif(_Z) -> erlang:nif_error(undef). +-spec set_controlling_process(Z, Pid) -> 'ok' when + Z :: zstream(), + Pid :: pid(). +set_controlling_process(Z, Pid) -> + set_controller_nif(Z, Pid). +set_controller_nif(_Z, _Pid) -> + erlang:nif_error(undef). + -spec deflateInit(Z) -> 'ok' when Z :: zstream(). deflateInit(Z) -> @@ -179,14 +188,13 @@ deflateReset_nif(_Z) -> deflateParams(Z, Level0, Strategy0) -> Level = arg_level(Level0), Strategy = arg_strategy(Strategy0), + Progress = deflate(Z, <<>>, sync), case deflateParams_nif(Z, Level, Strategy) of - buf_error -> - %% We had data left in the pipe; flush everything and stash it away - %% for the next deflate call before trying again. - Output = deflate(Z, <<>>, full), - save_progress(Z, deflate, Output), - deflateParams_nif(Z, Level, Strategy); - Any -> Any + ok -> + save_progress(Z, deflate, Progress), + ok; + Other -> + Other end. deflateParams_nif(_Z, _Level, _Strategy) -> erlang:nif_error(undef). diff --git a/erts/start_scripts/Makefile b/erts/start_scripts/Makefile index 20fea99016..5a47ad9616 100644 --- a/erts/start_scripts/Makefile +++ b/erts/start_scripts/Makefile @@ -171,8 +171,7 @@ $(ERL_TOP)/bin/no_dot_erlang.script: $(ERLC) $(SCRIPT_PATH) +no_warn_sasl +otp_build +no_dot_erlang -o $@ $(SS_ROOT)/no_dot_erlang.rel ) ## Special target used from system/build/Makefile for source code release bootstrap. -## Add no_dot_erlang after next release -bootstrap_scripts: $(SS_ROOT)/start_clean.rel +bootstrap_scripts: $(SS_ROOT)/start_clean.rel $(SS_ROOT)/no_dot_erlang.rel $(V_at)$(INSTALL_DIR) $(TESTROOT)/bin $(V_at)$(INSTALL_DIR) $(SS_TMP) $(V_at)( cd $(SS_TMP) && \ @@ -181,6 +180,10 @@ bootstrap_scripts: $(SS_ROOT)/start_clean.rel $(V_at)( cd $(SS_TMP) && \ $(ERLC) $(BOOTSTRAP_SCRIPT_PATH) +otp_build +no_module_tests \ -o $(TESTROOT)/bin/start_clean.script $(SS_ROOT)/start_clean.rel ) + $(V_at)( cd $(SS_TMP) && \ + $(ERLC) $(BOOTSTRAP_SCRIPT_PATH) +otp_build +no_module_tests \ + -o $(TESTROOT)/bin/no_dot_erlang.script $(SS_ROOT)/no_dot_erlang.rel ) + clean: $(V_at)$(RM) $(REL_SCRIPTS) $(INSTALL_SCRIPTS) diff --git a/erts/vsn.mk b/erts/vsn.mk index 3d7ff2db66..220c3b5f6c 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% # -VSN = 9.1.2 +VSN = 9.1.4 # Port number 4365 in 4.2 # Port number 4366 in 4.3 |
