diff options
297 files changed, 9517 insertions, 4578 deletions
diff --git a/.dir-locals.el b/.dir-locals.el new file mode 100644 index 0000000000..2b8f690c8d --- /dev/null +++ b/.dir-locals.el @@ -0,0 +1,14 @@ +;; Project-wide Emacs settings +( + (erlang-mode (indent-tabs-mode . nil)) + (autoconf-mode (indent-tabs-mode . nil)) + (java-mode (indent-tabs-mode . nil)) + (perl-mode (indent-tabs-mode . nil)) + (xml-mode (indent-tabs-mode . nil)) + ;; In C code indentation is 4 spaces and in C++ 2 spaces + (c++-mode + (indent-tabs-mode . nil) + (c-basic-offset . 2)) + (c-mode + (indent-tabs-mode . nil) + (c-basic-offset . 4))) diff --git a/.travis.yml b/.travis.yml index e05c644bd1..42151a16d2 100644 --- a/.travis.yml +++ b/.travis.yml @@ -33,14 +33,8 @@ script: after_success: - $ERL_TOP/bin/dialyzer --build_plt --apps asn1 compiler crypto dialyzer edoc erts et hipe inets kernel mnesia observer public_key runtime_tools snmp ssh ssl stdlib syntax_tools wx xmerl --statistics - - $ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps compiler erts kernel stdlib --statistics - - $ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps asn1 crypto dialyzer --statistics - - $ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps hipe parsetools public_key --statistics - - $ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps runtime_tools sasl tools --statistics - - $ERL_TOP/bin/dialyzer -n --apps common_test debugger edoc --statistics - - $ERL_TOP/bin/dialyzer -n --apps inets mnesia observer --statistics - - $ERL_TOP/bin/dialyzer -n --apps ssh ssl syntax_tools --statistics - - $ERL_TOP/bin/dialyzer -n --apps tools wx xmerl --statistics + - $ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps compiler erts kernel stdlib asn1 crypto dialyzer hipe parsetools public_key runtime_tools sasl tools --statistics + - $ERL_TOP/bin/dialyzer -n --apps common_test debugger edoc inets mnesia observer ssh ssl syntax_tools tools wx xmerl --statistics - ./otp_build tests && make release_docs after_script: @@ -40,7 +40,7 @@ In short: * Go to the JIRA issue tracker at [bugs.erlang.org] [7] to see reported issues which you can contribute to. - Search for issues with the status *Contribution Needed*. + Search for issues with the status *Help Wanted*. Bug Reports diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex 68dc2a5f61..b7bcadace0 100644 --- a/bootstrap/bin/start.boot +++ b/bootstrap/bin/start.boot diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot Binary files differindex 68dc2a5f61..b7bcadace0 100644 --- a/bootstrap/bin/start_clean.boot +++ b/bootstrap/bin/start_clean.boot diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam Binary files differindex 588ab97968..8169505d78 100644 --- a/bootstrap/lib/compiler/ebin/beam_asm.beam +++ b/bootstrap/lib/compiler/ebin/beam_asm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_bsm.beam b/bootstrap/lib/compiler/ebin/beam_bsm.beam Binary files differindex cf5b3e2712..acba331476 100644 --- a/bootstrap/lib/compiler/ebin/beam_bsm.beam +++ b/bootstrap/lib/compiler/ebin/beam_bsm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_clean.beam b/bootstrap/lib/compiler/ebin/beam_clean.beam Binary files differindex ed0827953c..3d0d5112f8 100644 --- a/bootstrap/lib/compiler/ebin/beam_clean.beam +++ b/bootstrap/lib/compiler/ebin/beam_clean.beam diff --git a/bootstrap/lib/compiler/ebin/beam_dict.beam b/bootstrap/lib/compiler/ebin/beam_dict.beam Binary files differindex 0f85080a31..3428b2872e 100644 --- a/bootstrap/lib/compiler/ebin/beam_dict.beam +++ b/bootstrap/lib/compiler/ebin/beam_dict.beam diff --git a/bootstrap/lib/compiler/ebin/beam_listing.beam b/bootstrap/lib/compiler/ebin/beam_listing.beam Binary files differindex 645440c85e..b80561b4dd 100644 --- a/bootstrap/lib/compiler/ebin/beam_listing.beam +++ b/bootstrap/lib/compiler/ebin/beam_listing.beam diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam Binary files differindex f8eb5e8a7c..9837ed458b 100644 --- a/bootstrap/lib/compiler/ebin/compile.beam +++ b/bootstrap/lib/compiler/ebin/compile.beam diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app index 237993f080..e91be8e4ad 100644 --- a/bootstrap/lib/compiler/ebin/compiler.app +++ b/bootstrap/lib/compiler/ebin/compiler.app @@ -19,7 +19,7 @@ {application, compiler, [{description, "ERTS CXC 138 10"}, - {vsn, "7.0.2"}, + {vsn, "7.0.3"}, {modules, [ beam_a, beam_asm, diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam Binary files differindex a5545a1458..cd8fd5ac05 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_fold.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_fold.beam diff --git a/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam b/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam Binary files differindex 58dff1b796..eed59b6cfa 100644 --- a/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam +++ b/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam diff --git a/bootstrap/lib/compiler/ebin/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam Binary files differindex 6cbe3165d1..1db120e00e 100644 --- a/bootstrap/lib/compiler/ebin/v3_codegen.beam +++ b/bootstrap/lib/compiler/ebin/v3_codegen.beam diff --git a/bootstrap/lib/kernel/ebin/heart.beam b/bootstrap/lib/kernel/ebin/heart.beam Binary files differindex 5a1cd86854..b5bb0806c8 100644 --- a/bootstrap/lib/kernel/ebin/heart.beam +++ b/bootstrap/lib/kernel/ebin/heart.beam diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam Binary files differindex ac0f44b7c8..078a0ffc9e 100644 --- a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam +++ b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app index 60bb6e06ee..4af19d756e 100644 --- a/bootstrap/lib/kernel/ebin/kernel.app +++ b/bootstrap/lib/kernel/ebin/kernel.app @@ -22,7 +22,7 @@ {application, kernel, [ {description, "ERTS CXC 138 10"}, - {vsn, "5.1"}, + {vsn, "5.1.1"}, {modules, [application, application_controller, application_master, diff --git a/bootstrap/lib/stdlib/ebin/dict.beam b/bootstrap/lib/stdlib/ebin/dict.beam Binary files differindex 8beaf0022e..a4e8f674f0 100644 --- a/bootstrap/lib/stdlib/ebin/dict.beam +++ b/bootstrap/lib/stdlib/ebin/dict.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam Binary files differindex e633572309..eff463adc0 100644 --- a/bootstrap/lib/stdlib/ebin/erl_eval.beam +++ b/bootstrap/lib/stdlib/ebin/erl_eval.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam Binary files differindex c7262358ec..9f241899e0 100644 --- a/bootstrap/lib/stdlib/ebin/erl_parse.beam +++ b/bootstrap/lib/stdlib/ebin/erl_parse.beam diff --git a/bootstrap/lib/stdlib/ebin/escript.beam b/bootstrap/lib/stdlib/ebin/escript.beam Binary files differindex 096c28e969..2d04bab10c 100644 --- a/bootstrap/lib/stdlib/ebin/escript.beam +++ b/bootstrap/lib/stdlib/ebin/escript.beam diff --git a/bootstrap/lib/stdlib/ebin/gb_trees.beam b/bootstrap/lib/stdlib/ebin/gb_trees.beam Binary files differindex 334e3649ae..a2627402ae 100644 --- a/bootstrap/lib/stdlib/ebin/gb_trees.beam +++ b/bootstrap/lib/stdlib/ebin/gb_trees.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_event.beam b/bootstrap/lib/stdlib/ebin/gen_event.beam Binary files differindex 023366da29..80db66b438 100644 --- a/bootstrap/lib/stdlib/ebin/gen_event.beam +++ b/bootstrap/lib/stdlib/ebin/gen_event.beam diff --git a/bootstrap/lib/stdlib/ebin/orddict.beam b/bootstrap/lib/stdlib/ebin/orddict.beam Binary files differindex 7ab6e61f6d..4624d2139a 100644 --- a/bootstrap/lib/stdlib/ebin/orddict.beam +++ b/bootstrap/lib/stdlib/ebin/orddict.beam diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index 916b7a0483..371ba299f0 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -20,7 +20,7 @@ %% {application, stdlib, [{description, "ERTS CXC 138 10"}, - {vsn, "3.1"}, + {vsn, "3.2"}, {modules, [array, base64, beam_lib, diff --git a/erts/configure.in b/erts/configure.in index 2018e19b76..e1233cee59 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -139,6 +139,13 @@ AS_HELP_STRING([--enable-dirty-schedulers], [enable dirty scheduler support]), *) enable_dirty_schedulers=yes ;; esac ], enable_dirty_schedulers=default) +AC_ARG_ENABLE(dirty-schedulers-test, +AS_HELP_STRING([--enable-dirty-schedulers-test], [enable dirty scheduler test (for debugging purposes)]), +[ case "$enableval" in + yes) enable_dirty_schedulers_test=yes ;; + *) enable_dirty_schedulers_test=no ;; + esac ], enable_dirty_schedulers_test=no) + AC_ARG_ENABLE(smp-support, AS_HELP_STRING([--enable-smp-support], [enable smp support]) AS_HELP_STRING([--disable-smp-support], [disable smp support]), @@ -1050,6 +1057,22 @@ esac AC_MSG_RESULT($DIRTY_SCHEDULER_SUPPORT) AC_SUBST(DIRTY_SCHEDULER_SUPPORT) +DIRTY_SCHEDULER_TEST=$enable_dirty_schedulers_test +test $DIRTY_SCHEDULER_SUPPORT = yes || DIRTY_SCHEDULER_TEST=no +AC_SUBST(DIRTY_SCHEDULER_TEST) +test $DIRTY_SCHEDULER_TEST != yes || { + test -f "$ERL_TOP/erts/CONF_INFO" || echo "" > "$ERL_TOP/erts/CONF_INFO" + cat >> $ERL_TOP/erts/CONF_INFO <<EOF + + WARNING: + Dirty Scheduler Test has been enabled. This + feature is for debugging purposes only. + Poor performance as well as strange system + characteristics is expected! + +EOF +} + if test $ERTS_BUILD_SMP_EMU = yes; then if test $found_threads = no; then diff --git a/erts/doc/src/absform.xml b/erts/doc/src/absform.xml index ab00d47425..fe8e3b30e7 100644 --- a/erts/doc/src/absform.xml +++ b/erts/doc/src/absform.xml @@ -886,7 +886,7 @@ Rep(Fc) = <c>[Rep(C_1), ..., Rep(C_k)]</c>.</p> <list type="bulleted"> - <item>If C is a constraint <c>is_subtype(V, T)</c> or <c>V :: T</c>, + <item>If C is a constraint <c>V :: T</c>, where <c>V</c> is a type variable and <c>T</c> is a type, then Rep(C) = <c>{type,LINE,constraint,[{atom,LINE,is_subtype},[Rep(V),Rep(T)]]}</c>. diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index f2a55f6298..4e32118405 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -946,9 +946,7 @@ schedulers was allowed to be unlimited, dirty CPU bound jobs would potentially starve normal jobs.</p> <p>This option is ignored if the emulator does not have threading - support enabled. <em>This option is experimental</em> and - is supported only if the emulator was configured and built with - support for dirty schedulers enabled (it is disabled by default).</p> + support enabled.</p> </item> <tag><marker id="+SDPcpu"/><c><![CDATA[+SDPcpu DirtyCPUSchedulersPercentage:DirtyCPUSchedulersOnlinePercentage]]></c></tag> @@ -974,9 +972,7 @@ either order) results in 2 dirty CPU scheduler threads (50% of 4) and 1 dirty CPU scheduler thread online (25% of 4).</p> <p>This option is ignored if the emulator does not have threading - support enabled. <em>This option is experimental</em> and - is supported only if the emulator was configured and built with - support for dirty schedulers enabled (it is disabled by default).</p> + support enabled.</p> </item> <tag><marker id="+SDio"/><c><![CDATA[+SDio DirtyIOSchedulers]]></c></tag> <item> @@ -992,9 +988,7 @@ bound jobs on dirty I/O schedulers, these jobs might starve ordinary jobs executing on ordinary schedulers.</p> <p>This option is ignored if the emulator does not have threading - support enabled. <em>This option is experimental</em> and - is supported only if the emulator was configured and built with - support for dirty schedulers enabled (it is disabled by default).</p> + support enabled.</p> </item> <tag><c><![CDATA[+sFlag Value]]></c></tag> <item> @@ -1595,6 +1589,25 @@ </section> <section> + <marker id="signals"></marker> + <title>Signals</title> + <p>On Unix systems, the Erlang runtime will interpret two types of signals.</p> + <taglist> + <tag><c>SIGUSR1</c></tag> + <item> + <p>A <c>SIGUSR1</c> signal forces a crash dump.</p> + </item> + <tag><c>SIGTERM</c></tag> + <item> + <p>A <c>SIGTERM</c> will produce a <c>stop</c> message to the <c>init</c> process. + This is equivalent to a <c>init:stop/0</c> call.</p> + <p>Introduced in ERTS 8.3 (Erlang/OTP 19.3)</p> + </item> + </taglist> + <p>The signal <c>SIGUSR2</c> is reserved for internal usage. No other signals are handled.</p> + </section> + + <section> <marker id="configuration"></marker> <title>Configuration</title> <p>The standard Erlang/OTP system can be reconfigured to change the default diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 906c1be17b..51b095e6ef 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -123,7 +123,7 @@ ok "Hello world!"</code> <p>A better solution for a real module is to take advantage of the new - directive <c>on load</c> (see section + directive <c>on_load</c> (see section <seealso marker="doc/reference_manual:code_loading#on_load">Running a Function When a Module is Loaded</seealso> in the Erlang Reference Manual) to load the NIF library automatically when the module is @@ -135,27 +135,14 @@ ok away by the compiler, causing loading of the NIF library to fail.</p> </note> - <p>A loaded NIF library is tied to the Erlang module code version - that loaded it. If the module is upgraded with a new version, the - new Erlang code need to load its own NIF library (or maybe choose not - to). The new code version can, however, choose to load the - same NIF library as the old code if it wants to. Sharing the - dynamic library means that static data defined by the library - is shared as well. To avoid unintentionally shared static - data, each Erlang module code can keep its own private data. This - private data can be set when the NIF library is loaded and - then retrieved by calling <seealso marker="#enif_priv_data"> - <c>enif_priv_data</c></seealso>.</p> - - <p>A NIF library cannot be loaded explicitly. A library is - automatically unloaded when the module code that it belongs to is purged - by the code server.</p> + <p>Once loaded, a NIF library is persistent. It will not be unloaded + until the module code version that it belongs to is purged.</p> </description> <section> <title>Functionality</title> - <p>All functions that a NIF library needs to do with Erlang are - performed through the NIF API functions. Functions exist + <p>All interaction between NIF code and the Erlang runtime system is + performed by calling NIF API functions. Functions exist for the following functionality:</p> <taglist> @@ -286,6 +273,19 @@ return term;</code> library is postponed as long as there exist resource objects with a destructor function in the library.</p> </item> + <tag>Module upgrade and static data</tag> + <item> + <p>A loaded NIF library is tied to the Erlang module instance + that loaded it. If the module is upgraded, the new module instance + needs to load its own NIF library (or maybe choose not to). The new + module instance can, however, choose to load the exact same NIF library + as the old code if it wants to. Sharing the dynamic library means that + static data defined by the library is shared as well. To avoid + unintentionally shared static data between module instances, each Erlang + module version can keep its own private data. This private data can be + set when the NIF library is loaded and later retrieved by calling + <seealso marker="#enif_priv_data"><c>enif_priv_data</c></seealso>.</p> + </item> <tag>Threads and concurrency</tag> <item> <p>A NIF is thread-safe without any explicit synchronization as @@ -402,14 +402,14 @@ return term;</code> <tag><marker id="dirty_nifs"/>Dirty NIF</tag> <item> <note> - <p><em>The dirty NIF functionality described here - is experimental</em>. Dirty NIF support is available only when - the emulator is configured with dirty schedulers enabled. This - feature is disabled by default. The Erlang runtime - without SMP support does not support dirty schedulers even when - the dirty scheduler support is enabled. To check at runtime for - the presence of dirty scheduler threads, code can use the - <seealso marker="#enif_system_info"> + <p>Dirty NIF support is available only when the emulator is + configured with dirty scheduler support. As of ERTS version + 9.0, dirty scheduler support is enabled by default on the + runtime system with SMP support. The Erlang runtime without + SMP support does <em>not</em> support dirty schedulers even + when the dirty scheduler support is explicitly enabled. To + check at runtime for the presence of dirty scheduler threads, + code can use the <seealso marker="#enif_system_info"> <c>enif_system_info()</c></seealso> API function.</p> </note> <p>A NIF that cannot be split and cannot execute in a millisecond @@ -525,7 +525,7 @@ return term;</code> <p><c>load</c> is called when the NIF library is loaded and no previously loaded library exists for this module.</p> <p><c>*priv_data</c> can be set to point to some private data - that the library needs to keep a state between NIF + if the library needs to keep a state between NIF calls. <c>enif_priv_data</c> returns this pointer. <c>*priv_data</c> is initialized to <c>NULL</c> when <c>load</c> is called.</p> @@ -642,9 +642,6 @@ typedef struct { <p><c>flags</c> can be used to indicate that the NIF is a <seealso marker="#dirty_nifs">dirty NIF</seealso> that is to be executed on a dirty scheduler thread.</p> - <p><em>The dirty NIF functionality described here is - experimental.</em> You have to enable support for dirty - schedulers when building OTP to try out the functionality.</p> <p>If the dirty NIF is expected to be CPU-bound, its <c>flags</c> field is to be set to <c>ERL_NIF_DIRTY_JOB_CPU_BOUND</c> or <c>ERL_NIF_DIRTY_JOB_IO_BOUND</c>.</p> @@ -2450,9 +2447,6 @@ enif_map_iterator_destroy(env, &iter);</code> application to break up long-running work into multiple regular NIF calls or to schedule a <seealso marker="#dirty_nifs"> dirty NIF</seealso> to execute on a dirty scheduler thread.</p> - <p><em>The dirty NIF functionality described here is - experimental.</em> You have to enable support for dirty - schedulers when building OTP to try out the functionality.</p> <taglist> <tag><c>fun_name</c></tag> <item> @@ -2463,7 +2457,7 @@ enif_map_iterator_destroy(env, &iter);</code> <tag><c>flags</c></tag> <item> <p>Must be set to <c>0</c> for a regular NIF. If the emulator was - built with the experimental dirty scheduler support enabled, + built with dirty scheduler support enabled, <c>flags</c> can be set to either <c>ERL_NIF_DIRTY_JOB_CPU_BOUND</c> if the job is expected to be CPU-bound, or <c>ERL_NIF_DIRTY_JOB_IO_BOUND</c> for diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 3dad09365e..7815bfa510 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -4933,7 +4933,9 @@ RealSystem = system + MissedSystem</code> <p>Returns the current call stack back-trace (<em>stacktrace</em>) of the process. The stack has the same format as returned by <seealso marker="#get_stacktrace/0"> - <c>erlang:get_stacktrace/0</c></seealso>.</p> + <c>erlang:get_stacktrace/0</c></seealso>. The depth of the + stacktrace is truncated according to the <c>backtrace_depth</c> + system flag setting.</p> </item> <tag><c>{dictionary, <anno>Dictionary</anno>}</c></tag> <item> @@ -6413,12 +6415,17 @@ lists:map( <c><anno>TotalTime</anno></c> is the total time duration since <seealso marker="#system_flag_scheduler_wall_time"> <c>scheduler_wall_time</c></seealso> - activation. The time unit is undefined and can be subject - to change between releases, OSs, and system restarts. - <c>scheduler_wall_time</c> is only to be used to - calculate relative values for scheduler-utilization. - <c><anno>ActiveTime</anno></c> can never exceed - <c><anno>TotalTime</anno></c>.</p> + activation for the specific scheduler. Note that + activation time can differ significantly between + schedulers. Currently dirty schedulers are activated + at system start while normal schedulers are activated + some time after the <c>scheduler_wall_time</c> + functionality is enabled. The time unit is undefined + and can be subject to change between releases, OSs, + and system restarts. <c>scheduler_wall_time</c> is only + to be used to calculate relative values for scheduler + utilization. <c><anno>ActiveTime</anno></c> can never + exceed <c><anno>TotalTime</anno></c>.</p> <p>The definition of a busy scheduler is when it is not idle and is not scheduling (selecting) a process or port, that is:</p> @@ -6436,15 +6443,37 @@ lists:map( <c>scheduler_wall_time</c></seealso> is turned off.</p> <p>The list of scheduler information is unsorted and can appear in different order between calls.</p> + <p>As of ERTS version 9.0, also dirty CPU schedulers will + be included in the result. That is, all scheduler threads + that are expected to handle CPU bound work. If you also + want information about dirty I/O schedulers, use + <seealso marker="#statistics_scheduler_wall_time_all"><c>statistics(scheduler_wall_time_all)</c></seealso> + instead.</p> + + <p>Normal schedulers will have scheduler identifiers in + the range <c>1 =< <anno>SchedulerId</anno> =< + </c><seealso marker="#system_info_schedulers"><c>erlang:system_info(schedulers)</c></seealso>. + Dirty CPU schedulers will have scheduler identifiers in + the range <c>erlang:system_info(schedulers) < + <anno>SchedulerId</anno> =< erlang:system_info(schedulers) + + + </c><seealso marker="#system_info_dirty_cpu_schedulers"><c>erlang:system_info(dirty_cpu_schedulers)</c></seealso>. + </p> + <note><p>The different types of schedulers handle + specific types of jobs. Every job is assigned to a specific + scheduler type. Jobs can migrate between different schedulers + of the same type, but never between schedulers of different + types. This fact has to be taken under consideration when + evaluating the result returned.</p></note> <p>Using <c>scheduler_wall_time</c> to calculate - scheduler-utilization:</p> + scheduler utilization:</p> <pre> > <input>erlang:system_flag(scheduler_wall_time, true).</input> false > <input>Ts0 = lists:sort(erlang:statistics(scheduler_wall_time)), ok.</input> ok</pre> <p>Some time later the user takes another snapshot and calculates - scheduler-utilization per scheduler, for example:</p> + scheduler utilization per scheduler, for example:</p> <pre> > <input>Ts1 = lists:sort(erlang:statistics(scheduler_wall_time)), ok.</input> ok @@ -6459,11 +6488,32 @@ ok {7,0.973237033077876}, {8,0.9741297293248656}]</pre> <p>Using the same snapshots to calculate a total - scheduler-utilization:</p> + scheduler utilization:</p> <pre> > <input>{A, T} = lists:foldl(fun({{_, A0, T0}, {_, A1, T1}}, {Ai,Ti}) -> - {Ai + (A1 - A0), Ti + (T1 - T0)} end, {0, 0}, lists:zip(Ts0,Ts1)), A/T.</input> + {Ai + (A1 - A0), Ti + (T1 - T0)} end, {0, 0}, lists:zip(Ts0,Ts1)), + TotalSchedulerUtilization = A/T.</input> +0.9769136803764825</pre> + <p>Total scheduler utilization will equal <c>1.0</c> when + all schedulers have been active all the time between the + two measurements.</p> + <p>Another (probably more) useful value is to calculate + total scheduler utilization weighted against maximum amount + of available CPU time:</p> + <pre> +> <input>WeightedSchedulerUtilization = (TotalSchedulerUtilization + * (erlang:system_info(schedulers) + + erlang:system_info(dirty_cpu_schedulers))) + / erlang:system_info(logical_processors_available).</input> 0.9769136803764825</pre> + <p>This weighted scheduler utilization will reach <c>1.0</c> + when schedulers are active the same amount of time as + maximum available CPU time. If more schedulers exist + than available logical processors, this value may + be greater than <c>1.0</c>.</p> + <p>As of ERTS version 9.0, the Erlang runtime system + with SMP support will as default have more schedulers + than logical processors. This due to the dirty schedulers.</p> <note> <p><c>scheduler_wall_time</c> is by default disabled. To enable it, use @@ -6474,6 +6524,31 @@ ok <func> <name name="statistics" arity="1" clause_i="12"/> + <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 + schedulers.</p> + <p>Dirty IO schedulers will have scheduler identifiers in + the range + <seealso marker="#system_info_schedulers"><c>erlang:system_info(schedulers)</c></seealso><c> + + + </c><seealso marker="#system_info_dirty_cpu_schedulers"><c>erlang:system_info(dirty_cpu_schedulers)</c></seealso><c> < + <anno>SchedulerId</anno> =< erlang:system_info(schedulers) + + erlang:system_info(dirty_cpu_schedulers) + + + </c><seealso marker="#system_info_dirty_io_schedulers"><c>erlang:system_info(dirty_io_schedulers)</c></seealso>.</p> + <note><p>Note that work executing on dirty I/O schedulers + are expected to mainly wait for I/O. That is, when you + get high scheduler utilization on dirty I/O schedulers, + CPU utilization is <em>not</em> expected to be high due to + this work.</p></note> + </desc> + </func> + <func> + <name name="statistics" arity="1" clause_i="13"/> <fsummary>Information about active processes and ports.</fsummary> <desc><marker id="statistics_total_active_tasks"></marker> <p>Returns the total amount of active processes and ports in @@ -6493,7 +6568,7 @@ ok </func> <func> - <name name="statistics" arity="1" clause_i="13"/> + <name name="statistics" arity="1" clause_i="14"/> <fsummary>Information about the run-queue lengths.</fsummary> <desc><marker id="statistics_total_run_queue_lengths"></marker> <p>Returns the total length of the run queues. That is, the number @@ -6513,7 +6588,7 @@ ok </func> <func> - <name name="statistics" arity="1" clause_i="14"/> + <name name="statistics" arity="1" clause_i="15"/> <fsummary>Information about wall clock.</fsummary> <desc> <p>Returns information about wall clock. <c>wall_clock</c> can @@ -6645,7 +6720,9 @@ ok <fsummary>Set system flag <c>backtrace_depth</c>.</fsummary> <desc> <p>Sets the maximum depth of call stack back-traces in the - exit reason element of <c>'EXIT'</c> tuples.</p> + exit reason element of <c>'EXIT'</c> tuples. The flag + also limits the stacktrace depth returned by <c>process_info</c> + item <c>current_stacktrace.</c></p> <p>Returns the old value of the flag.</p> </desc> </func> @@ -6717,11 +6794,6 @@ ok down to 3. Similarly, the number of dirty CPU schedulers online increases proportionally to increases in the number of schedulers online.</p> - <note> - <p>The dirty schedulers functionality is experimental. - Enable support for dirty schedulers when building OTP to - try out the functionality.</p> - </note> <p>For more information, see <seealso marker="#system_info_dirty_cpu_schedulers"> <c>erlang:system_info(dirty_cpu_schedulers)</c></seealso> and @@ -7224,8 +7296,8 @@ ok </func> <func> - <name name="system_info" arity="1" clause_i="11"/> <name name="system_info" arity="1" clause_i="12"/> + <name name="system_info" arity="1" clause_i="13"/> <fsummary>Information about the CPU topology of the system.</fsummary> <type name="cpu_topology"/> <type name="level_entry"/> @@ -7325,12 +7397,12 @@ ok </func> <func> - <name name="system_info" arity="1" clause_i="28"/> <name name="system_info" arity="1" clause_i="29"/> - <name name="system_info" arity="1" clause_i="37"/> + <name name="system_info" arity="1" clause_i="30"/> <name name="system_info" arity="1" clause_i="38"/> <name name="system_info" arity="1" clause_i="39"/> <name name="system_info" arity="1" clause_i="40"/> + <name name="system_info" arity="1" clause_i="41"/> <fsummary>Information about the default process heap settings.</fsummary> <type name="message_queue_data"/> <type name="max_heap_size"/> @@ -7408,7 +7480,7 @@ ok <name name="system_info" arity="1" clause_i="8"/> <name name="system_info" arity="1" clause_i="9"/> <name name="system_info" arity="1" clause_i="10"/> - <name name="system_info" arity="1" clause_i="13"/> + <name name="system_info" arity="1" clause_i="11"/> <name name="system_info" arity="1" clause_i="14"/> <name name="system_info" arity="1" clause_i="15"/> <name name="system_info" arity="1" clause_i="16"/> @@ -7423,14 +7495,14 @@ ok <name name="system_info" arity="1" clause_i="25"/> <name name="system_info" arity="1" clause_i="26"/> <name name="system_info" arity="1" clause_i="27"/> - <name name="system_info" arity="1" clause_i="30"/> + <name name="system_info" arity="1" clause_i="28"/> <name name="system_info" arity="1" clause_i="31"/> <name name="system_info" arity="1" clause_i="32"/> <name name="system_info" arity="1" clause_i="33"/> <name name="system_info" arity="1" clause_i="34"/> <name name="system_info" arity="1" clause_i="35"/> <name name="system_info" arity="1" clause_i="36"/> - <name name="system_info" arity="1" clause_i="41"/> + <name name="system_info" arity="1" clause_i="37"/> <name name="system_info" arity="1" clause_i="42"/> <name name="system_info" arity="1" clause_i="43"/> <name name="system_info" arity="1" clause_i="44"/> @@ -7460,11 +7532,18 @@ ok <name name="system_info" arity="1" clause_i="68"/> <name name="system_info" arity="1" clause_i="69"/> <name name="system_info" arity="1" clause_i="70"/> + <name name="system_info" arity="1" clause_i="71"/> <fsummary>Information about the system.</fsummary> <desc> <p>Returns various information about the current system (emulator) as specified by <c><anno>Item</anno></c>:</p> <taglist> + <tag><c>atom_count</c></tag> + <item> + <marker id="system_info_atom_count"></marker> + <p>Returns the number of atoms currently existing at the + local node. The value is given as an integer.</p> + </item> <tag><c>atom_limit</c></tag> <item> <marker id="system_info_atom_limit"></marker> @@ -7559,9 +7638,6 @@ ok <seealso marker="erts:erl#+SDcpu"><c>+SDcpu</c></seealso> or <seealso marker="erts:erl#+SDPcpu"><c>+SDPcpu</c></seealso> in <c>erl(1)</c>.</p> - <p>Notice that the dirty schedulers functionality is - experimental. Enable support for dirty schedulers when - building OTP to try out the functionality.</p> <p>See also <seealso marker="#system_flag_dirty_cpu_schedulers_online"> <c>erlang:system_flag(dirty_cpu_schedulers_online, @@ -7591,9 +7667,6 @@ ok startup by passing command-line flag <seealso marker="erts:erl#+SDcpu"><c>+SDcpu</c></seealso> in <c>erl(1)</c>.</p> - <p>Notice that the dirty schedulers functionality is - experimental. Enable support for dirty schedulers when - building OTP to try out the functionality.</p> <p>For more information, see <seealso marker="#system_info_dirty_cpu_schedulers"> <c>erlang:system_info(dirty_cpu_schedulers)</c></seealso>, @@ -7615,9 +7688,6 @@ ok <p>This value can be set at startup by passing command-line argument <seealso marker="erts:erl#+SDio"><c>+SDio</c></seealso> in <c>erl(1)</c>.</p> - <p>Notice that the dirty schedulers functionality is - experimental. Enable support for dirty schedulers when - building OTP to try out the functionality.</p> <p>For more information, see <seealso marker="#system_info_dirty_cpu_schedulers"> <c>erlang:system_info(dirty_cpu_schedulers)</c></seealso>, diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index da6190b685..812538729d 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -32,6 +32,26 @@ <p>This document describes the changes made to the ERTS application.</p> +<section><title>Erts 8.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix a quite rare bug causing VM crash during code loading + and the use of export funs (fun M:F/A) of not yet loaded + modules. Requires a very specfic timing of concurrent + scheduler threads. Has been seen on ARM but can probably + also occure on other architectures. Bug has existed since + OTP R16.</p> + <p> + Own Id: OTP-14144 Aux Id: seq13242 </p> + </item> + </list> + </section> + +</section> + <section><title>Erts 8.2</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -145,13 +165,6 @@ <p> Own Id: OTP-14051</p> </item> - <item> - <p> - Fixed a number of bugs that caused faulty stack-traces to - be created on exception when a process was traced.</p> - <p> - Own Id: OTP-14055</p> - </item> </list> </section> diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index ce50022683..18fd7f320b 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -52,6 +52,7 @@ OMIT_OMIT_FP=no TYPE_LIBS= DIRTY_SCHEDULER_SUPPORT=@DIRTY_SCHEDULER_SUPPORT@ +DIRTY_SCHEDULER_TEST=@DIRTY_SCHEDULER_TEST@ ifeq ($(TYPE),debug) PURIFY = @@ -181,9 +182,24 @@ ENABLE_ALLOC_TYPE_VARS += smp nofrag M4FLAGS += -DERTS_SMP=1 ifeq ($(DIRTY_SCHEDULER_SUPPORT),yes) THR_DEFS += -DERTS_DIRTY_SCHEDULERS -endif +DS_SUPPORT=yes -else +ifeq ($(DIRTY_SCHEDULER_TEST),yes) +DS_TEST=yes +THR_DEFS += -DERTS_DIRTY_SCHEDULERS_TEST +else # DIRTY_SCHEDULER_TEST +DS_TEST=no +endif # DIRTY_SCHEDULER_TEST + +else # DIRTY_SCHEDULER_SUPPORT +DS_SUPPORT=no +DS_TEST=no +endif # DIRTY_SCHEDULER_SUPPORT + +else # FLAVOR + +DS_SUPPORT=no +DS_TEST=no # If flavor isn't one of the above, it *is* plain flavor... override FLAVOR=plain @@ -548,8 +564,10 @@ GENERATE += $(TTF_DIR)/OPCODES-GENERATED # bif and atom table ATOMS= beam/atom.names +DIRTY_BIFS = beam/erl_dirty_bif.tab BIFS = beam/bif.tab ifdef HIPE_ENABLED +HIPE=yes HIPE_ARCH64_TAB=hipe/hipe_bif64.tab HIPE_x86_TAB=hipe/hipe_x86.tab HIPE_amd64_TAB=hipe/hipe_amd64.tab $(HIPE_ARCH64_TAB) @@ -559,20 +577,26 @@ HIPE_ppc64_TAB=hipe/hipe_ppc64.tab $(HIPE_ARCH64_TAB) HIPE_arm_TAB=hipe/hipe_arm.tab HIPE_ARCH_TAB=$(HIPE_$(ARCH)_TAB) BIFS += hipe/hipe_bif0.tab hipe/hipe_bif1.tab hipe/hipe_bif2.tab $(HIPE_ARCH_TAB) -endif - -$(TARGET)/erl_bif_table.c \ -$(TARGET)/erl_bif_table.h \ -$(TARGET)/erl_bif_wrap.c \ -$(TARGET)/erl_bif_list.h \ -$(TARGET)/erl_gc_bifs.c \ -$(TARGET)/erl_atom_table.c \ -$(TARGET)/erl_atom_table.h \ - : $(TARGET)/TABLES-GENERATED -$(TARGET)/TABLES-GENERATED: $(ATOMS) $(BIFS) utils/make_tables - $(gen_verbose)LANG=C $(PERL) utils/make_tables -src $(TARGET) -include $(TARGET)\ - $(ATOMS) $(BIFS) && echo $? >$(TARGET)/TABLES-GENERATED -GENERATE += $(TARGET)/TABLES-GENERATED +HIPE_NBIF_FILES=$(TTF_DIR)/hipe_nbif_impl.h $(TTF_DIR)/hipe_nbif_impl.c +else +HIPE=no +HIPE_NBIF_FILES= +endif + +$(TTF_DIR)/erl_bif_table.c \ +$(TTF_DIR)/erl_bif_table.h \ +$(TTF_DIR)/erl_bif_wrap.c \ +$(TTF_DIR)/erl_bif_list.h \ +$(TTF_DIR)/erl_atom_table.c \ +$(TTF_DIR)/erl_atom_table.h \ +$(TTF_DIR)/erl_guard_bifs.c \ +$(TTF_DIR)/erl_dirty_bif_wrap.c \ +$(HIPE_NBIF_FILES) \ + : $(TTF_DIR)/TABLES-GENERATED +$(TTF_DIR)/TABLES-GENERATED: $(ATOMS) $(DIRTY_BIFS) $(BIFS) utils/make_tables + $(gen_verbose)LANG=C $(PERL) utils/make_tables -src $(TTF_DIR) -include $(TTF_DIR)\ + -ds $(DS_SUPPORT) -dst $(DS_TEST) -hipe $(HIPE) $(ATOMS) $(DIRTY_BIFS) $(BIFS) && echo $? >$(TTF_DIR)/TABLES-GENERATED +GENERATE += $(TTF_DIR)/TABLES-GENERATED $(TTF_DIR)/erl_alloc_types.h: beam/erl_alloc.types utils/make_alloc_types $(gen_verbose)LANG=C $(PERL) utils/make_alloc_types -src $< -dst $@ $(ENABLE_ALLOC_TYPE_VARS) @@ -750,8 +774,8 @@ RUN_OBJS = \ $(OBJDIR)/erl_bif_info.o $(OBJDIR)/erl_bif_op.o \ $(OBJDIR)/erl_bif_os.o $(OBJDIR)/erl_bif_lists.o \ $(OBJDIR)/erl_bif_trace.o $(OBJDIR)/erl_bif_unique.o \ - $(OBJDIR)/erl_bif_wrap.o \ - $(OBJDIR)/erl_gc_bifs.o \ + $(OBJDIR)/erl_bif_wrap.o $(OBJDIR)/erl_nfunc_sched.o \ + $(OBJDIR)/erl_guard_bifs.o $(OBJDIR)/erl_dirty_bif_wrap.o \ $(OBJDIR)/erl_trace.o $(OBJDIR)/copy.o \ $(OBJDIR)/utils.o $(OBJDIR)/bif.o \ $(OBJDIR)/io.o $(OBJDIR)/erl_printf_term.o\ @@ -882,6 +906,7 @@ HIPE_noarch_OBJS= HIPE_ARCH_OBJS=$(HIPE_$(ARCH)_OBJS) HIPE_OBJS= \ + $(OBJDIR)/hipe_nbif_impl.o \ $(OBJDIR)/hipe_bif0.o \ $(OBJDIR)/hipe_bif1.o \ $(OBJDIR)/hipe_bif2.o \ @@ -917,7 +942,7 @@ $(OBJS): $(TTF_DIR)/GENERATED ######################################## # HiPE section -M4FLAGS += -DTARGET=$(TARGET) -DOPSYS=$(OPSYS) -DARCH=$(ARCH) +M4FLAGS += -DTARGET=$(TARGET) -DTTF_DIR=$(TTF_DIR) -DOPSYS=$(OPSYS) -DARCH=$(ARCH) $(TTF_DIR)/%.S: hipe/%.m4 $(m4_verbose)m4 $(M4FLAGS) $< > $@ @@ -938,7 +963,7 @@ $(BINDIR)/hipe_mkliterals$(TF_MARKER): $(OBJDIR)/hipe_mkliterals.o $(ld_verbose)$(CC) $(LDFLAGS) -o $@ $< $(TYPE_LIBS) $(OBJDIR)/hipe_mkliterals.o: $(HIPE_ASM) $(TTF_DIR)/erl_alloc_types.h $(DTRACE_HEADERS) \ - $(TTF_DIR)/OPCODES-GENERATED $(TARGET)/TABLES-GENERATED + $(TTF_DIR)/OPCODES-GENERATED $(TTF_DIR)/TABLES-GENERATED $(TTF_DIR)/hipe_literals.h: $(BINDIR)/hipe_mkliterals$(TF_MARKER) $(gen_verbose)$(BINDIR)/hipe_mkliterals$(TF_MARKER) -c > $@ @@ -947,7 +972,7 @@ $(OBJDIR)/hipe_x86_glue.o: hipe/hipe_x86_glue.S \ $(TTF_DIR)/hipe_x86_asm.h $(TTF_DIR)/hipe_literals.h \ hipe/hipe_mode_switch.h $(TTF_DIR)/hipe_x86_bifs.S: hipe/hipe_x86_bifs.m4 hipe/hipe_x86_asm.m4 \ - hipe/hipe_bif_list.m4 $(TARGET)/erl_bif_list.h hipe/hipe_gbif_list.h + hipe/hipe_bif_list.m4 $(TTF_DIR)/erl_bif_list.h hipe/hipe_gbif_list.h $(OBJDIR)/hipe_x86_bifs.o: $(TTF_DIR)/hipe_x86_bifs.S \ $(TTF_DIR)/hipe_literals.h @@ -955,7 +980,7 @@ $(OBJDIR)/hipe_amd64_glue.o: hipe/hipe_amd64_glue.S \ $(TTF_DIR)/hipe_amd64_asm.h $(TTF_DIR)/hipe_literals.h \ hipe/hipe_mode_switch.h $(TTF_DIR)/hipe_amd64_bifs.S: hipe/hipe_amd64_bifs.m4 hipe/hipe_amd64_asm.m4 \ - hipe/hipe_bif_list.m4 $(TARGET)/erl_bif_list.h hipe/hipe_gbif_list.h + hipe/hipe_bif_list.m4 $(TTF_DIR)/erl_bif_list.h hipe/hipe_gbif_list.h $(OBJDIR)/hipe_amd64_bifs.o: $(TTF_DIR)/hipe_amd64_bifs.S \ $(TTF_DIR)/hipe_literals.h @@ -963,21 +988,21 @@ $(OBJDIR)/hipe_sparc_glue.o: hipe/hipe_sparc_glue.S \ $(TTF_DIR)/hipe_sparc_asm.h hipe/hipe_mode_switch.h \ $(TTF_DIR)/hipe_literals.h $(TTF_DIR)/hipe_sparc_bifs.S: hipe/hipe_sparc_bifs.m4 hipe/hipe_sparc_asm.m4 \ - hipe/hipe_bif_list.m4 $(TARGET)/erl_bif_list.h hipe/hipe_gbif_list.h + hipe/hipe_bif_list.m4 $(TTF_DIR)/erl_bif_list.h hipe/hipe_gbif_list.h $(OBJDIR)/hipe_sparc_bifs.o: $(TTF_DIR)/hipe_sparc_bifs.S \ $(TTF_DIR)/hipe_literals.h $(OBJDIR)/hipe_ppc_glue.o: hipe/hipe_ppc_glue.S $(TTF_DIR)/hipe_ppc_asm.h \ hipe/hipe_mode_switch.h $(TTF_DIR)/hipe_literals.h $(TTF_DIR)/hipe_ppc_bifs.S: hipe/hipe_ppc_bifs.m4 hipe/hipe_ppc_asm.m4 \ - hipe/hipe_bif_list.m4 $(TARGET)/erl_bif_list.h hipe/hipe_gbif_list.h + hipe/hipe_bif_list.m4 $(TTF_DIR)/erl_bif_list.h hipe/hipe_gbif_list.h $(OBJDIR)/hipe_ppc_bifs.o: $(TTF_DIR)/hipe_ppc_bifs.S \ $(TTF_DIR)/hipe_literals.h $(OBJDIR)/hipe_arm_glue.o: hipe/hipe_arm_glue.S $(TTF_DIR)/hipe_arm_asm.h \ hipe/hipe_mode_switch.h $(TTF_DIR)/hipe_literals.h $(TTF_DIR)/hipe_arm_bifs.S: hipe/hipe_arm_bifs.m4 hipe/hipe_arm_asm.m4 \ - hipe/hipe_bif_list.m4 $(TARGET)/erl_bif_list.h hipe/hipe_gbif_list.h + hipe/hipe_bif_list.m4 $(TTF_DIR)/erl_bif_list.h hipe/hipe_gbif_list.h $(OBJDIR)/hipe_arm_bifs.o: $(TTF_DIR)/hipe_arm_bifs.S \ $(TTF_DIR)/hipe_literals.h diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index b1aeed7889..dd0a42b5ba 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -76,6 +76,7 @@ atom ac atom accessor atom active atom active_tasks +atom alive atom all atom all_but_first atom all_names @@ -199,10 +200,15 @@ atom dexit atom depth atom dgroup_leader atom dictionary +atom dirty_bif_exception +atom dirty_bif_result +atom dirty_bif_trap atom dirty_cpu atom dirty_cpu_schedulers_online atom dirty_execution atom dirty_io +atom dirty_nif_exception +atom dirty_nif_finalizer atom disable_trace atom disabled atom discard @@ -243,6 +249,7 @@ atom ERROR='ERROR' atom error_handler atom error_logger atom erts_code_purger +atom erts_debug atom erts_internal atom ets atom ETS_TRANSFER='ETS-TRANSFER' @@ -567,12 +574,15 @@ atom safe atom save_calls atom scheduler atom scheduler_id +atom scheduler_wall_time +atom scheduler_wall_time_all atom schedulers_online atom scheme atom scientific atom scope atom second atom seconds +atom send atom send_to_non_existing_process atom sensitive atom sequential_tracer @@ -665,11 +675,11 @@ atom value atom values atom version atom visible +atom wait atom waiting atom wall_clock atom warning atom warning_msg -atom scheduler_wall_time atom wordsize atom write_concurrency atom xor diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 5c3565f498..c8dde8caf8 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -36,6 +36,7 @@ #include "erl_nif.h" #include "erl_bits.h" #include "erl_thr_progress.h" +#include "erl_nfunc_sched.h" #ifdef HIPE # include "hipe_bif0.h" # define IF_HIPE(X) (X) @@ -670,7 +671,7 @@ BIF_RETTYPE delete_module_1(BIF_ALIST_1) } else if (modp->old.code_hdr) { erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - erts_dsprintf(dsbufp, "Module %T must be purged before loading\n", + erts_dsprintf(dsbufp, "Module %T must be purged before deleting\n", BIF_ARG_1); erts_send_error_to_logger(BIF_P->group_leader, dsbufp); ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG); @@ -806,7 +807,7 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) } if (BIF_ARG_2 == am_true) { - int i; + int i, num_exps; /* * Make the code with the on_load function current. @@ -822,7 +823,8 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) /* * The on_load function succeded. Fix up export entries. */ - for (i = 0; i < export_list_size(code_ix); i++) { + num_exps = export_list_size(code_ix); + for (i = 0; i < num_exps; i++) { Export *ep = export_list(i,code_ix); if (ep == NULL || ep->info.mfa.module != BIF_ARG_1) { continue; @@ -845,14 +847,15 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) hipe_redirect_to_module(modp); #endif } else if (BIF_ARG_2 == am_false) { - int i; + int i, num_exps; /* * The on_load function failed. Remove references to the * code that is about to be purged from the export entries. */ - for (i = 0; i < export_list_size(code_ix); i++) { + num_exps = export_list_size(code_ix); + for (i = 0; i < num_exps; i++) { Export *ep = export_list(i,code_ix); if (ep == NULL || ep->info.mfa.module != BIF_ARG_1) { continue; @@ -912,7 +915,7 @@ erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed la = ERTS_COPY_LITERAL_AREA(); if (!la) - return am_ok; + goto return_ok; oh = la->off_heap; literals = (char *) &la->start[0]; @@ -976,6 +979,11 @@ erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed * this is not completely certain). We go for * the GC directly instead of scanning everything * one more time... + * + * Also note that calling functions expect a + * major GC to be performed if gc_allowed is set + * to true. If you change this, you need to fix + * callers... */ goto literal_gc; } @@ -998,6 +1006,12 @@ erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed if (any_heap_refs(c_p->heap, c_p->htop, literals, lit_bsize)) goto literal_gc; *redsp += 1; + if (c_p->abandoned_heap) { + if (any_heap_refs(c_p->abandoned_heap, c_p->abandoned_heap + c_p->heap_sz, + literals, lit_bsize)) + goto literal_gc; + *redsp += 1; + } if (any_heap_refs(c_p->old_heap, c_p->old_htop, literals, lit_bsize)) goto literal_gc; @@ -1044,6 +1058,13 @@ erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed } } +return_ok: + +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(c_p))) + c_p->flags &= ~F_DIRTY_CLA; +#endif + return am_ok; literal_gc: @@ -1054,13 +1075,13 @@ literal_gc: if (c_p->flags & F_DISABLE_GC) return THE_NON_VALUE; - FLAGS(c_p) |= F_NEED_FULLSWEEP; - - *redsp += erts_garbage_collect_nobump(c_p, 0, c_p->arg_reg, c_p->arity, fcalls); - - erts_garbage_collect_literals(c_p, (Eterm *) literals, lit_bsize, oh); + *redsp += erts_garbage_collect_literals(c_p, (Eterm *) literals, lit_bsize, + oh, fcalls); - *redsp += lit_bsize / 64; /* Need, better value... */ +#ifdef ERTS_DIRTY_SCHEDULERS + if (c_p->flags & F_DIRTY_CLA) + return THE_NON_VALUE; +#endif return am_ok; } @@ -1099,6 +1120,11 @@ check_process_code(Process* rp, Module* modp, int *redsp, int fcalls) if (erts_check_nif_export_in_area(rp, mod_start, mod_size)) return am_true; + *redsp += 1; + + if (erts_check_nif_export_in_area(rp, mod_start, mod_size)) + return am_true; + *redsp += (STACK_START(rp) - rp->stop) / 32; /* @@ -1777,9 +1803,9 @@ delete_code(Module* modp) { ErtsCodeIndex code_ix = erts_staging_code_ix(); Eterm module = make_atom(modp->module); - int i; + int i, num_exps = export_list_size(code_ix); - for (i = 0; i < export_list_size(code_ix); i++) { + for (i = 0; i < num_exps; i++) { Export *ep = export_list(i, code_ix); if (ep != NULL && (ep->info.mfa.module == module)) { if (ep->addressv[code_ix] == ep->beam) { diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 73158205b3..27329a339e 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -32,6 +32,7 @@ #include "erl_binary.h" #include "beam_bp.h" #include "erl_term.h" +#include "erl_nfunc_sched.h" /* ************************************************************************* ** Macros @@ -74,6 +75,9 @@ extern BeamInstr beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */ erts_smp_atomic32_t erts_active_bp_index; erts_smp_atomic32_t erts_staging_bp_index; +#ifdef ERTS_DIRTY_SCHEDULERS +erts_smp_mtx_t erts_dirty_bp_ix_mtx; +#endif /* * Inlined helpers @@ -85,6 +89,31 @@ get_mtime(Process *c_p) return erts_get_monotonic_time(erts_proc_sched_data(c_p)); } +static ERTS_INLINE Uint32 +acquire_bp_sched_ix(Process *c_p) +{ + ErtsSchedulerData *esdp = erts_proc_sched_data(c_p); + ASSERT(esdp); +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) { + erts_smp_mtx_lock(&erts_dirty_bp_ix_mtx); + return (Uint32) erts_no_schedulers; + } +#endif + return (Uint32) esdp->no - 1; +} + +static ERTS_INLINE void +release_bp_sched_ix(Uint32 ix) +{ +#ifdef ERTS_DIRTY_SCHEDULERS + if (ix == (Uint32) erts_no_schedulers) + erts_smp_mtx_unlock(&erts_dirty_bp_ix_mtx); +#endif +} + + + /* ************************************************************************* ** Local prototypes */ @@ -135,6 +164,9 @@ void erts_bp_init(void) { erts_smp_atomic32_init_nob(&erts_active_bp_index, 0); erts_smp_atomic32_init_nob(&erts_staging_bp_index, 1); +#ifdef ERTS_DIRTY_SCHEDULERS + erts_smp_mtx_init(&erts_dirty_bp_ix_mtx, "dirty_break_point_index"); +#endif } @@ -774,6 +806,30 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) result = func(p, args, I); + if (erts_nif_export_check_save_trace(p, result, + applying, ep, + cp, flags, + flags_meta, I, + meta_tracer)) { + /* + * erts_bif_trace_epilogue() will be called + * later when appropriate via the NIF export + * scheduling functionality... + */ + return result; + } + + return erts_bif_trace_epilogue(p, result, applying, ep, cp, + flags, flags_meta, I, + meta_tracer); +} + +Eterm +erts_bif_trace_epilogue(Process *p, Eterm result, int applying, + Export* ep, BeamInstr *cp, Uint32 flags, + Uint32 flags_meta, BeamInstr* I, + ErtsTracer meta_tracer) +{ if (applying && (flags & MATCH_SET_RETURN_TO_TRACE)) { BeamInstr i_return_trace = beam_return_trace[0]; BeamInstr i_return_to_trace = beam_return_to_trace[0]; @@ -983,6 +1039,7 @@ erts_trace_time_call(Process* c_p, ErtsCodeInfo *info, BpDataTime* bdt) bp_data_time_item_t sitem, *item = NULL; bp_time_hash_t *h = NULL; BpDataTime *pbdt = NULL; + Uint32 six = acquire_bp_sched_ix(c_p); ASSERT(c_p); ASSERT(erts_smp_atomic32_read_acqb(&c_p->state) & (ERTS_PSFLG_RUNNING @@ -990,7 +1047,7 @@ erts_trace_time_call(Process* c_p, ErtsCodeInfo *info, BpDataTime* bdt) /* get previous timestamp and breakpoint * from the process psd */ - + pbt = ERTS_PROC_GET_CALL_TIME(c_p); time = get_mtime(c_p); @@ -1016,7 +1073,7 @@ erts_trace_time_call(Process* c_p, ErtsCodeInfo *info, BpDataTime* bdt) /* if null then the breakpoint was removed */ if (pbdt) { - h = &(pbdt->hash[bp_sched2ix_proc(c_p)]); + h = &(pbdt->hash[six]); ASSERT(h); ASSERT(h->item); @@ -1037,7 +1094,7 @@ erts_trace_time_call(Process* c_p, ErtsCodeInfo *info, BpDataTime* bdt) /* this breakpoint */ ASSERT(bdt); - h = &(bdt->hash[bp_sched2ix_proc(c_p)]); + h = &(bdt->hash[six]); ASSERT(h); ASSERT(h->item); @@ -1051,6 +1108,8 @@ erts_trace_time_call(Process* c_p, ErtsCodeInfo *info, BpDataTime* bdt) pbt->ci = info; pbt->time = time; + + release_bp_sched_ix(six); } void @@ -1061,6 +1120,7 @@ erts_trace_time_return(Process *p, ErtsCodeInfo *ci) bp_data_time_item_t sitem, *item = NULL; bp_time_hash_t *h = NULL; BpDataTime *pbdt = NULL; + Uint32 six = acquire_bp_sched_ix(p); ASSERT(p); ASSERT(erts_smp_atomic32_read_acqb(&p->state) & (ERTS_PSFLG_RUNNING @@ -1081,6 +1141,7 @@ erts_trace_time_return(Process *p, ErtsCodeInfo *ci) */ if (pbt) { + /* might have been removed due to * trace_pattern(false) */ @@ -1095,7 +1156,8 @@ erts_trace_time_return(Process *p, ErtsCodeInfo *ci) /* beware, the trace_pattern might have been removed */ if (pbdt) { - h = &(pbdt->hash[bp_sched2ix_proc(p)]); + + h = &(pbdt->hash[six]); ASSERT(h); ASSERT(h->item); @@ -1106,11 +1168,15 @@ erts_trace_time_return(Process *p, ErtsCodeInfo *ci) } else { BP_TIME_ADD(item, &sitem); } + } pbt->ci = ci; pbt->time = time; + } + + release_bp_sched_ix(six); } int @@ -1362,6 +1428,7 @@ void erts_schedule_time_break(Process *p, Uint schedule) { bp_data_time_item_t sitem, *item = NULL; bp_time_hash_t *h = NULL; BpDataTime *pbdt = NULL; + Uint32 six = acquire_bp_sched_ix(p); ASSERT(p); @@ -1384,7 +1451,7 @@ void erts_schedule_time_break(Process *p, Uint schedule) { sitem.pid = p->common.id; sitem.count = 0; - h = &(pbdt->hash[bp_sched2ix_proc(p)]); + h = &(pbdt->hash[six]); ASSERT(h); ASSERT(h->item); @@ -1410,6 +1477,8 @@ void erts_schedule_time_break(Process *p, Uint schedule) { break; } } /* pbt */ + + release_bp_sched_ix(six); } /* ************************************************************************* @@ -1526,7 +1595,11 @@ set_function_break(ErtsCodeInfo *ci, Binary *match_spec, Uint break_flags, ASSERT((bp->flags & ERTS_BPF_TIME_TRACE) == 0); bdt = Alloc(sizeof(BpDataTime)); erts_refc_init(&bdt->refc, 1); - bdt->n = erts_no_total_schedulers; +#ifdef ERTS_DIRTY_SCHEDULERS + bdt->n = erts_no_schedulers + 1; +#else + bdt->n = erts_no_schedulers; +#endif bdt->hash = Alloc(sizeof(bp_time_hash_t)*(bdt->n)); for (i = 0; i < bdt->n; i++) { bp_hash_init(&(bdt->hash[i]), 32); diff --git a/erts/emulator/beam/beam_bp.h b/erts/emulator/beam/beam_bp.h index 224b46407d..cccd395e0a 100644 --- a/erts/emulator/beam/beam_bp.h +++ b/erts/emulator/beam/beam_bp.h @@ -79,10 +79,8 @@ typedef struct generic_bp { #define ERTS_BP_CALL_TIME_SCHEDULE_OUT (1) #define ERTS_BP_CALL_TIME_SCHEDULE_EXITING (2) -#ifdef ERTS_SMP -#define bp_sched2ix_proc(p) (erts_proc_sched_data(p)->thr_id - 1) -#else -#define bp_sched2ix_proc(p) (0) +#ifdef ERTS_DIRTY_SCHEDULERS +extern erts_smp_mtx_t erts_dirty_bp_ix_mtx; #endif enum erts_break_op{ diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index e72d7f8de4..8326d348af 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -39,6 +39,7 @@ #include "beam_bp.h" #include "erl_binary.h" #include "erl_thr_progress.h" +#include "erl_nfunc_sched.h" #ifdef ARCH_64 # define HEXF "%016bpX" @@ -764,3 +765,356 @@ static void print_bif_name(fmtfn_t to, void* to_arg, BifFunction bif) erts_print(to, to_arg, "%T/%u", name, arity); } } + +/* + * Dirty BIF testing. + * + * The erts_debug:dirty_cpu/2, erts_debug:dirty_io/1, and + * erts_debug:dirty/3 BIFs are used by the dirty_bif_SUITE + * test suite. + */ + +#ifdef ERTS_DIRTY_SCHEDULERS +static int ms_wait(Process *c_p, Eterm etimeout, int busy); +static int dirty_send_message(Process *c_p, Eterm to, Eterm tag); +#endif +static BIF_RETTYPE dirty_test(Process *c_p, Eterm type, Eterm arg1, Eterm arg2, UWord *I); + +/* + * erts_debug:dirty_cpu/2 is statically determined to execute on + * a dirty CPU scheduler (see erts_dirty_bif.tab). + */ +BIF_RETTYPE +erts_debug_dirty_cpu_2(BIF_ALIST_2) +{ + return dirty_test(BIF_P, am_dirty_cpu, BIF_ARG_1, BIF_ARG_2, BIF_I); +} + +/* + * erts_debug:dirty_io/2 is statically determined to execute on + * a dirty I/O scheduler (see erts_dirty_bif.tab). + */ +BIF_RETTYPE +erts_debug_dirty_io_2(BIF_ALIST_2) +{ + return dirty_test(BIF_P, am_dirty_io, BIF_ARG_1, BIF_ARG_2, BIF_I); +} + +/* + * erts_debug:dirty/3 executes on a normal scheduler. + */ +BIF_RETTYPE +erts_debug_dirty_3(BIF_ALIST_3) +{ +#ifdef ERTS_DIRTY_SCHEDULERS + Eterm argv[2]; + switch (BIF_ARG_1) { + case am_normal: + return dirty_test(BIF_P, am_normal, BIF_ARG_2, BIF_ARG_3, BIF_I); + case am_dirty_cpu: + argv[0] = BIF_ARG_2; + argv[1] = BIF_ARG_3; + return erts_schedule_bif(BIF_P, + argv, + BIF_I, + erts_debug_dirty_cpu_2, + ERTS_SCHED_DIRTY_CPU, + am_erts_debug, + am_dirty_cpu, + 2); + case am_dirty_io: + argv[0] = BIF_ARG_2; + argv[1] = BIF_ARG_3; + return erts_schedule_bif(BIF_P, + argv, + BIF_I, + erts_debug_dirty_io_2, + ERTS_SCHED_DIRTY_IO, + am_erts_debug, + am_dirty_io, + 2); + default: + BIF_ERROR(BIF_P, EXC_BADARG); + } +#else + BIF_ERROR(BIF_P, EXC_UNDEF); +#endif +} + + +static BIF_RETTYPE +dirty_test(Process *c_p, Eterm type, Eterm arg1, Eterm arg2, UWord *I) +{ + BIF_RETTYPE ret; +#ifdef ERTS_DIRTY_SCHEDULERS + if (am_scheduler == arg1) { + ErtsSchedulerData *esdp; + if (arg2 != am_type) + goto badarg; + esdp = erts_proc_sched_data(c_p); + if (!esdp) + ERTS_BIF_PREP_RET(ret, am_error); + else if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) + ERTS_BIF_PREP_RET(ret, am_normal); + else if (ERTS_SCHEDULER_IS_DIRTY_CPU(esdp)) + ERTS_BIF_PREP_RET(ret, am_dirty_cpu); + else if (ERTS_SCHEDULER_IS_DIRTY_IO(esdp)) + ERTS_BIF_PREP_RET(ret, am_dirty_io); + else + ERTS_BIF_PREP_RET(ret, am_error); + } + else if (am_error == arg1) { + switch (arg2) { + case am_notsup: + ERTS_BIF_PREP_ERROR(ret, c_p, EXC_NOTSUP); + break; + case am_undef: + ERTS_BIF_PREP_ERROR(ret, c_p, EXC_UNDEF); + break; + case am_badarith: + ERTS_BIF_PREP_ERROR(ret, c_p, EXC_BADARITH); + break; + case am_noproc: + ERTS_BIF_PREP_ERROR(ret, c_p, EXC_NOPROC); + break; + case am_system_limit: + ERTS_BIF_PREP_ERROR(ret, c_p, SYSTEM_LIMIT); + break; + case am_badarg: + default: + goto badarg; + } + } + else if (am_copy == arg1) { + int i; + Eterm res; + + for (res = NIL, i = 0; i < 1000; i++) { + Eterm *hp, sz; + Eterm cpy; + /* We do not want this to be optimized, + but rather the oposite... */ + sz = size_object(arg2); + hp = HAlloc(c_p, sz); + cpy = copy_struct(arg2, sz, &hp, &c_p->off_heap); + hp = HAlloc(c_p, 2); + res = CONS(hp, cpy, res); + } + + ERTS_BIF_PREP_RET(ret, res); + } + else if (am_send == arg1) { + dirty_send_message(c_p, arg2, am_ok); + ERTS_BIF_PREP_RET(ret, am_ok); + } + else if (ERTS_IS_ATOM_STR("wait", arg1)) { + if (!ms_wait(c_p, arg2, type == am_dirty_cpu)) + goto badarg; + ERTS_BIF_PREP_RET(ret, am_ok); + } + else if (ERTS_IS_ATOM_STR("reschedule", arg1)) { + /* + * Reschedule operation after decrement of two until we reach + * zero. Switch between dirty scheduler types when 'n' is + * evenly divided by 4. If the initial value wasn't evenly + * dividable by 2, throw badarg exception. + */ + Eterm next_type; + Sint n; + if (!term_to_Sint(arg2, &n) || n < 0) + goto badarg; + if (n == 0) + ERTS_BIF_PREP_RET(ret, am_ok); + else { + Eterm argv[3]; + Eterm eint = erts_make_integer((Uint) (n - 2), c_p); + if (n % 4 != 0) + next_type = type; + else { + switch (type) { + case am_dirty_cpu: next_type = am_dirty_io; break; + case am_dirty_io: next_type = am_normal; break; + case am_normal: next_type = am_dirty_cpu; break; + default: goto badarg; + } + } + switch (next_type) { + case am_dirty_io: + argv[0] = arg1; + argv[1] = eint; + ret = erts_schedule_bif(c_p, + argv, + I, + erts_debug_dirty_io_2, + ERTS_SCHED_DIRTY_IO, + am_erts_debug, + am_dirty_io, + 2); + break; + case am_dirty_cpu: + argv[0] = arg1; + argv[1] = eint; + ret = erts_schedule_bif(c_p, + argv, + I, + erts_debug_dirty_cpu_2, + ERTS_SCHED_DIRTY_CPU, + am_erts_debug, + am_dirty_cpu, + 2); + break; + case am_normal: + argv[0] = am_normal; + argv[1] = arg1; + argv[2] = eint; + ret = erts_schedule_bif(c_p, + argv, + I, + erts_debug_dirty_3, + ERTS_SCHED_NORMAL, + am_erts_debug, + am_dirty, + 3); + break; + default: + goto badarg; + } + } + } + else if (ERTS_IS_ATOM_STR("ready_wait6_done", arg1)) { + ERTS_DECL_AM(ready); + ERTS_DECL_AM(done); + dirty_send_message(c_p, arg2, AM_ready); + ms_wait(c_p, make_small(6000), 0); + dirty_send_message(c_p, arg2, AM_done); + ERTS_BIF_PREP_RET(ret, am_ok); + } + else if (ERTS_IS_ATOM_STR("alive_waitexiting", arg1)) { + Process *real_c_p = erts_proc_shadow2real(c_p); + Eterm *hp, *hp2; + Uint sz; + int i; + ErtsSchedulerData *esdp = erts_proc_sched_data(c_p); + int dirty_io = esdp->type == ERTS_SCHED_DIRTY_IO; + + if (ERTS_PROC_IS_EXITING(real_c_p)) + goto badarg; + dirty_send_message(c_p, arg2, am_alive); + + /* Wait until dead */ + while (!ERTS_PROC_IS_EXITING(real_c_p)) { + if (dirty_io) + ms_wait(c_p, make_small(100), 0); + else + erts_thr_yield(); + } + + ms_wait(c_p, make_small(1000), 0); + + /* Should still be able to allocate memory */ + hp = HAlloc(c_p, 3); /* Likely on heap */ + sz = 10000; + hp2 = HAlloc(c_p, sz); /* Likely in heap fragment */ + *hp2 = make_pos_bignum_header(sz); + for (i = 1; i < sz; i++) + hp2[i] = (Eterm) 4711; + ERTS_BIF_PREP_RET(ret, TUPLE2(hp, am_ok, make_big(hp2))); + } + else { + badarg: + ERTS_BIF_PREP_ERROR(ret, c_p, BADARG); + } +#else + ERTS_BIF_PREP_ERROR(ret, c_p, EXC_UNDEF); +#endif + return ret; +} + +#ifdef ERTS_DIRTY_SCHEDULERS + +static int +dirty_send_message(Process *c_p, Eterm to, Eterm tag) +{ + ErtsProcLocks c_p_locks, rp_locks; + Process *rp, *real_c_p; + Eterm msg, *hp; + ErlOffHeap *ohp; + ErtsMessage *mp; + + ASSERT(is_immed(tag)); + + real_c_p = erts_proc_shadow2real(c_p); + if (real_c_p != c_p) + c_p_locks = 0; + else + c_p_locks = ERTS_PROC_LOCK_MAIN; + + ASSERT(real_c_p->common.id == c_p->common.id); + + rp = erts_pid2proc_opt(real_c_p, c_p_locks, + to, 0, + ERTS_P2P_FLG_INC_REFC); + + if (!rp) + return 0; + + rp_locks = 0; + mp = erts_alloc_message_heap(rp, &rp_locks, 3, &hp, &ohp); + + msg = TUPLE2(hp, tag, c_p->common.id); + erts_queue_message(rp, rp_locks, mp, msg, c_p->common.id); + + if (rp == real_c_p) + rp_locks &= ~c_p_locks; + if (rp_locks) + erts_smp_proc_unlock(rp, rp_locks); + + erts_proc_dec_refc(rp); + + return 1; +} + +static int +ms_wait(Process *c_p, Eterm etimeout, int busy) +{ + ErtsSchedulerData *esdp = erts_proc_sched_data(c_p); + ErtsMonotonicTime time, timeout_time; + Sint64 ms; + + if (!term_to_Sint64(etimeout, &ms)) + return 0; + + time = erts_get_monotonic_time(esdp); + + if (ms < 0) + timeout_time = time; + else + timeout_time = time + ERTS_MSEC_TO_MONOTONIC(ms); + + while (time < timeout_time) { + if (busy) + erts_thr_yield(); + else { + ErtsMonotonicTime timeout = timeout_time - time; + +#ifdef __WIN32__ + Sleep((DWORD) ERTS_MONOTONIC_TO_MSEC(timeout)); +#else + { + ErtsMonotonicTime to = ERTS_MONOTONIC_TO_USEC(timeout); + struct timeval tv; + + tv.tv_sec = (long) to / (1000*1000); + tv.tv_usec = (long) to % (1000*1000); + + select(0, NULL, NULL, NULL, &tv); + } +#endif + } + + time = erts_get_monotonic_time(esdp); + } + return 1; +} + +#endif /* ERTS_DIRTY_SCHEDULERS */ diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 613bd5c14e..85d92321b8 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -38,6 +38,7 @@ #include "beam_bp.h" #include "beam_catches.h" #include "erl_thr_progress.h" +#include "erl_nfunc_sched.h" #ifdef HIPE #include "hipe_mode_switch.h" #include "hipe_bif1.h" @@ -214,6 +215,7 @@ BeamInstr beam_continue_exit[1]; BeamInstr* em_call_error_handler; BeamInstr* em_apply_bif; BeamInstr* em_call_nif; +BeamInstr* em_call_bif_e; /* NOTE These should be the only variables containing trace instructions. @@ -633,21 +635,34 @@ void** beam_ops; y[4] = xt4; \ } while (0) +#define DispatchReturn \ +do { \ + if (FCALLS > 0 || FCALLS > neg_o_reds) { \ + FCALLS--; \ + Goto(*I); \ + } \ + else { \ + c_p->current = NULL; \ + c_p->arity = 1; \ + goto context_switch3; \ + } \ +} while (0) + #define MoveReturn(Src) \ x(0) = (Src); \ I = c_p->cp; \ ASSERT(VALID_INSTR(*c_p->cp)); \ c_p->cp = 0; \ CHECK_TERM(r(0)); \ - Goto(*I) + DispatchReturn #define DeallocateReturn(Deallocate) \ do { \ int words_to_pop = (Deallocate); \ - SET_I((BeamInstr *) cp_val(*E)); \ + SET_I((BeamInstr *) cp_val(*E)); \ E = ADD_BYTE_OFFSET(E, words_to_pop); \ CHECK_TERM(r(0)); \ - Goto(*I); \ + DispatchReturn; \ } while (0) #define MoveDeallocateReturn(Src, Deallocate) \ @@ -1042,14 +1057,17 @@ void** beam_ops; * The following functions are called directly by process_main(). * Don't inline them. */ -static BifFunction translate_gc_bif(void* gcf) NOINLINE; +static ErtsCodeMFA *ubif2mfa(void* uf) NOINLINE; +static ErtsCodeMFA *gcbif2mfa(void* gcf) NOINLINE; static BeamInstr* handle_error(Process* c_p, BeamInstr* pc, - Eterm* reg, BifFunction bf) NOINLINE; + Eterm* reg, ErtsCodeMFA* bif_mfa) NOINLINE; static BeamInstr* call_error_handler(Process* p, ErtsCodeMFA* mfa, Eterm* reg, Eterm func) NOINLINE; -static BeamInstr* fixed_apply(Process* p, Eterm* reg, Uint arity) NOINLINE; +static BeamInstr* fixed_apply(Process* p, Eterm* reg, Uint arity, + BeamInstr *I, Uint offs) NOINLINE; static BeamInstr* apply(Process* p, Eterm module, Eterm function, - Eterm args, Eterm* reg) NOINLINE; + Eterm args, Eterm* reg, + BeamInstr *I, Uint offs) NOINLINE; static BeamInstr* call_fun(Process* p, int arity, Eterm* reg, Eterm args) NOINLINE; static BeamInstr* apply_fun(Process* p, Eterm fun, @@ -1071,7 +1089,7 @@ static BeamInstr* next_catch(Process* c_p, Eterm *reg); static void terminate_proc(Process* c_p, Eterm Value); static Eterm add_stacktrace(Process* c_p, Eterm Value, Eterm exc); static void save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, - BifFunction bf, Eterm args); + ErtsCodeMFA *bif_mfa, Eterm args); static struct StackTrace * get_trace_from_exc(Eterm exc); static Eterm make_arglist(Process* c_p, Eterm* reg, int a); @@ -1679,7 +1697,7 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array) c_p->cp = 0; CHECK_TERM(r(0)); HEAP_SPACE_VERIFIED(0); - Goto(*I); + DispatchReturn; } /* @@ -2566,7 +2584,7 @@ do { \ OpCase(bif1_fbsd): { - Eterm (*bf)(Process*, Eterm*); + ErtsBifFunc bf; Eterm tmp_reg[1]; Eterm result; @@ -2577,7 +2595,7 @@ do { \ PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); ERTS_CHK_MBUF_SZ(c_p); - result = (*bf)(c_p, tmp_reg); + result = (*bf)(c_p, tmp_reg, I); ERTS_CHK_MBUF_SZ(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); @@ -2598,19 +2616,19 @@ do { \ OpCase(bif1_body_bsd): { - Eterm (*bf)(Process*, Eterm*); + ErtsBifFunc bf; Eterm tmp_reg[1]; Eterm result; GetArg1(1, tmp_reg[0]); - bf = (BifFunction) Arg(0); + bf = (ErtsBifFunc) Arg(0); ERTS_DBG_CHK_REDS(c_p, FCALLS); c_p->fcalls = FCALLS; PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); ERTS_CHK_MBUF_SZ(c_p); - result = (*bf)(c_p, tmp_reg); + result = (*bf)(c_p, tmp_reg, I); ERTS_CHK_MBUF_SZ(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); @@ -2623,7 +2641,7 @@ do { \ } reg[0] = tmp_reg[0]; SWAPOUT; - I = handle_error(c_p, I, reg, bf); + I = handle_error(c_p, I, reg, ubif2mfa((void *) bf)); goto post_error_handling; } @@ -2659,7 +2677,7 @@ do { \ Goto(*I); } x(0) = x(live); - I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf)); + I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf)); goto post_error_handling; } @@ -2704,7 +2722,7 @@ do { \ live--; x(0) = x(live); x(1) = x(live+1); - I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf)); + I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf)); goto post_error_handling; } @@ -2750,7 +2768,7 @@ do { \ x(0) = x(live); x(1) = x(live+1); x(2) = x(live+2); - I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf)); + I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf)); goto post_error_handling; } @@ -2760,17 +2778,17 @@ do { \ OpCase(i_bif2_fbssd): { Eterm tmp_reg[2]; - Eterm (*bf)(Process*, Eterm*); + ErtsBifFunc bf; Eterm result; GetArg2(2, tmp_reg[0], tmp_reg[1]); - bf = (BifFunction) Arg(1); + bf = (ErtsBifFunc) Arg(1); ERTS_DBG_CHK_REDS(c_p, FCALLS); c_p->fcalls = FCALLS; PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); ERTS_CHK_MBUF_SZ(c_p); - result = (*bf)(c_p, tmp_reg); + result = (*bf)(c_p, tmp_reg, I); ERTS_CHK_MBUF_SZ(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); @@ -2791,15 +2809,15 @@ do { \ OpCase(i_bif2_body_bssd): { Eterm tmp_reg[2]; - Eterm (*bf)(Process*, Eterm*); + ErtsBifFunc bf; Eterm result; GetArg2(1, tmp_reg[0], tmp_reg[1]); - bf = (BifFunction) Arg(0); + bf = (ErtsBifFunc) Arg(0); PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); ERTS_CHK_MBUF_SZ(c_p); - result = (*bf)(c_p, tmp_reg); + result = (*bf)(c_p, tmp_reg, I); ERTS_CHK_MBUF_SZ(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); @@ -2812,7 +2830,7 @@ do { \ reg[0] = tmp_reg[0]; reg[1] = tmp_reg[1]; SWAPOUT; - I = handle_error(c_p, I, reg, bf); + I = handle_error(c_p, I, reg, ubif2mfa((void *) bf)); goto post_error_handling; } @@ -2822,7 +2840,7 @@ do { \ */ OpCase(call_bif_e): { - Eterm (*bf)(Process*, Eterm*, BeamInstr*); + ErtsBifFunc bf; Eterm result; BeamInstr *next; ErlHeapFragment *live_hf_end; @@ -2889,7 +2907,7 @@ do { \ * Error handling. SWAPOUT is not needed because it was done above. */ ASSERT(c_p->stop == E); - I = handle_error(c_p, I, reg, bf); + I = handle_error(c_p, I, reg, &export->info.mfa); goto post_error_handling; } @@ -3186,21 +3204,21 @@ do { \ OpCase(i_apply): { BeamInstr *next; HEAVY_SWAPOUT; - next = apply(c_p, r(0), x(1), x(2), reg); + next = apply(c_p, r(0), x(1), x(2), reg, NULL, 0); HEAVY_SWAPIN; if (next != NULL) { SET_CP(c_p, I+1); SET_I(next); Dispatch(); } - I = handle_error(c_p, I, reg, apply_3); + I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); goto post_error_handling; } OpCase(i_apply_last_P): { BeamInstr *next; HEAVY_SWAPOUT; - next = apply(c_p, r(0), x(1), x(2), reg); + next = apply(c_p, r(0), x(1), x(2), reg, I, Arg(0)); HEAVY_SWAPIN; if (next != NULL) { SET_CP(c_p, (BeamInstr *) E[0]); @@ -3208,20 +3226,20 @@ do { \ SET_I(next); Dispatch(); } - I = handle_error(c_p, I, reg, apply_3); + I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); goto post_error_handling; } OpCase(i_apply_only): { BeamInstr *next; HEAVY_SWAPOUT; - next = apply(c_p, r(0), x(1), x(2), reg); + next = apply(c_p, r(0), x(1), x(2), reg, I, 0); HEAVY_SWAPIN; if (next != NULL) { SET_I(next); Dispatch(); } - I = handle_error(c_p, I, reg, apply_3); + I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); goto post_error_handling; } @@ -3229,14 +3247,14 @@ do { \ BeamInstr *next; HEAVY_SWAPOUT; - next = fixed_apply(c_p, reg, Arg(0)); + next = fixed_apply(c_p, reg, Arg(0), NULL, 0); HEAVY_SWAPIN; if (next != NULL) { SET_CP(c_p, I+2); SET_I(next); Dispatch(); } - I = handle_error(c_p, I, reg, apply_3); + I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); goto post_error_handling; } @@ -3244,7 +3262,7 @@ do { \ BeamInstr *next; HEAVY_SWAPOUT; - next = fixed_apply(c_p, reg, Arg(0)); + next = fixed_apply(c_p, reg, Arg(0), I, Arg(1)); HEAVY_SWAPIN; if (next != NULL) { SET_CP(c_p, (BeamInstr *) E[0]); @@ -3252,7 +3270,7 @@ do { \ SET_I(next); Dispatch(); } - I = handle_error(c_p, I, reg, apply_3); + I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); goto post_error_handling; } @@ -3547,12 +3565,6 @@ do { \ ErlHeapFragment *live_hf_end; ErtsCodeMFA *codemfa; - if (!((FCALLS - 1) > 0 || (FCALLS - 1) > neg_o_reds)) { - /* If we have run out of reductions, we do a context - switch before calling the nif */ - goto context_switch; - } - ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_NIF); codemfa = erts_code_to_codemfa(I); @@ -3561,8 +3573,8 @@ do { \ DTRACE_NIF_ENTRY(c_p, codemfa); - SWAPOUT; - c_p->fcalls = FCALLS - 1; + HEAVY_SWAPOUT; + PROCESS_MAIN_CHK_LOCKS(c_p); bif_nif_arity = codemfa->arity; ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); @@ -3635,7 +3647,7 @@ do { \ ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); { - Eterm (*bf)(Process*, Eterm*, BeamInstr*) = vbf; + ErtsBifFunc bf = vbf; ASSERT(!ERTS_PROC_IS_EXITING(c_p)); live_hf_end = c_p->mbuf; ERTS_CHK_MBUF_SZ(c_p); @@ -3679,7 +3691,7 @@ do { \ } Dispatch(); } - I = handle_error(c_p, c_p->cp, reg, vbf); + I = handle_error(c_p, c_p->cp, reg, c_p->current); goto post_error_handling; } } @@ -5034,7 +5046,7 @@ do { \ goto do_schedule; } else { HEAVY_SWAPIN; - I = handle_error(c_p, I, reg, hibernate_3); + I = handle_error(c_p, I, reg, &bif_export[BIF_hibernate_3]->info.mfa); goto post_error_handling; } } @@ -5128,6 +5140,7 @@ do { \ em_call_error_handler = OpCode(call_error_handler); em_apply_bif = OpCode(apply_bif); em_call_nif = OpCode(call_nif); + em_call_bif_e = OpCode(call_bif_e); beam_apply[0] = (BeamInstr) OpCode(i_apply); beam_apply[1] = (BeamInstr) OpCode(normal_exit); @@ -5314,10 +5327,25 @@ void erts_dirty_process_main(ErtsSchedulerData *esdp) ASSERT(!(c_p->flags & F_HIPE_MODE)); ERTS_MSACC_UPDATE_CACHE_X(); - reg = esdp->x_reg_array; - { + /* + * Set fcalls even though we ignore it, so we don't + * confuse code accessing it... + */ + if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) + c_p->fcalls = 0; + else + c_p->fcalls = CONTEXT_REDS; + + if (erts_smp_atomic32_read_nob(&c_p->state) & ERTS_PSFLG_DIRTY_RUNNING_SYS) { + erts_execute_dirty_system_task(c_p); + goto do_dirty_schedule; + } + else { + ErtsCodeMFA *codemfa; Eterm* argp; - int i; + int i, exiting; + + reg = esdp->x_reg_array; argp = c_p->arg_reg; for (i = c_p->arity - 1; i >= 0; i--) { @@ -5333,17 +5361,6 @@ void erts_dirty_process_main(ErtsSchedulerData *esdp) I = c_p->i; - ASSERT(em_call_nif == (BeamInstr *) *I); - - /* - * Set fcalls even though we ignore it, so we don't - * confuse code accessing it... - */ - if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) - c_p->fcalls = 0; - else - c_p->fcalls = CONTEXT_REDS; - SWAPIN; #ifdef USE_VM_PROBES @@ -5367,96 +5384,81 @@ void erts_dirty_process_main(ErtsSchedulerData *esdp) DTRACE2(process_scheduled, process_buf, fun_buf); } #endif - } - - { -#ifdef DEBUG - Eterm result; -#endif - Eterm arity; - { - /* - * call_nif is always first instruction in function: - * - * I[-3]: Module - * I[-2]: Function - * I[-1]: Arity - * I[0]: &&call_nif - * I[1]: Function pointer to NIF function - * I[2]: Pointer to erl_module_nif - * I[3]: Function pointer to dirty NIF - * - * This layout is determined by the NifExport struct - */ - BifFunction vbf; - ErtsCodeMFA *codemfa; - - ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_NIF); + /* + * call_nif is always first instruction in function: + * + * I[-3]: Module + * I[-2]: Function + * I[-1]: Arity + * I[0]: &&call_nif + * I[1]: Function pointer to NIF function + * I[2]: Pointer to erl_module_nif + * I[3]: Function pointer to dirty NIF + * + * This layout is determined by the NifExport struct + */ - codemfa = erts_code_to_codemfa(I); + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_NIF); - DTRACE_NIF_ENTRY(c_p, codemfa); - /* current and vbf set to please handle_error */ - c_p->current = codemfa; - SWAPOUT; - PROCESS_MAIN_CHK_LOCKS(c_p); - arity = codemfa->arity; - ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + codemfa = erts_code_to_codemfa(I); - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - { - typedef Eterm NifF(struct enif_environment_t*, int argc, Eterm argv[]); - NifF* fp = vbf = (NifF*) I[1]; - struct enif_environment_t env; - ASSERT(!c_p->scheduler_data); - - erts_pre_dirty_nif(esdp, &env, c_p, - (struct erl_module_nif*)I[2]); - -#ifdef DEBUG - result = -#else - (void) -#endif - (*fp)(&env, arity, reg); + DTRACE_NIF_ENTRY(c_p, codemfa); + c_p->current = codemfa; + SWAPOUT; + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); - erts_post_dirty_nif(&env); + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + if (em_apply_bif == (BeamInstr *) *I) { + exiting = erts_call_dirty_bif(esdp, c_p, I, reg); + } + else { + ASSERT(em_call_nif == (BeamInstr *) *I); + exiting = erts_call_dirty_nif(esdp, c_p, I, reg); + } - ASSERT(!is_value(result)); - ASSERT(c_p->freason == TRAP); - ASSERT(!(c_p->flags & F_HIBERNATE_SCHED)); + ASSERT(!(c_p->flags & F_HIBERNATE_SCHED)); - PROCESS_MAIN_CHK_LOCKS(c_p); - ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); - if (env.exiting) - goto do_dirty_schedule; - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - } + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); + if (exiting) + goto do_dirty_schedule; + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - DTRACE_NIF_RETURN(c_p, codemfa); - ERTS_HOLE_CHECK(c_p); - SWAPIN; - I = c_p->i; - goto context_switch; - } + DTRACE_NIF_RETURN(c_p, codemfa); + ERTS_HOLE_CHECK(c_p); + SWAPIN; + I = c_p->i; + goto context_switch; } #endif /* ERTS_DIRTY_SCHEDULERS */ } -static BifFunction -translate_gc_bif(void* gcf) +static ErtsCodeMFA * +gcbif2mfa(void* gcf) { - const ErtsGcBif* p; - - for (p = erts_gc_bifs; p->bif != 0; p++) { - if (p->gc_bif == gcf) { - return p->bif; - } + int i; + for (i = 0; erts_gc_bifs[i].bif; i++) { + if (erts_gc_bifs[i].gc_bif == gcf) + return &bif_export[erts_gc_bifs[i].exp_ix]->info.mfa; } erts_exit(ERTS_ERROR_EXIT, "bad gc bif"); + return NULL; +} + +static ErtsCodeMFA * +ubif2mfa(void* uf) +{ + int i; + for (i = 0; erts_u_bifs[i].bif; i++) { + if (erts_u_bifs[i].bif == uf) + return &bif_export[erts_u_bifs[i].exp_ix]->info.mfa; + } + erts_exit(ERTS_ERROR_EXIT, "bad u bif"); + return NULL; } /* @@ -5515,15 +5517,27 @@ Eterm error_atom[NUMBER_EXIT_CODES] = { */ static BeamInstr* -handle_error(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf) +handle_error(Process* c_p, BeamInstr* pc, Eterm* reg, ErtsCodeMFA *bif_mfa) { Eterm* hp; Eterm Value = c_p->fvalue; Eterm Args = am_true; - c_p->i = pc; /* In case we call erts_exit(). */ ASSERT(c_p->freason != TRAP); /* Should have been handled earlier. */ + if (c_p->freason & EXF_RESTORE_NIF) + erts_nif_export_restore_error(c_p, &pc, reg, &bif_mfa); + +#ifdef DEBUG + if (bif_mfa) { + /* Verify that bif_mfa does not point into our nif export */ + NifExport *nep = ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p); + ASSERT(!nep || !ErtsInArea(bif_mfa, (char *)nep, sizeof(NifExport))); + } +#endif + + c_p->i = pc; /* In case we call erts_exit(). */ + /* * Check if we have an arglist for the top level call. If so, this * is encoded in Value, so we have to dig out the real Value as well @@ -5546,7 +5560,7 @@ handle_error(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf) * more modular. */ if (c_p->freason & EXF_SAVETRACE) { - save_stacktrace(c_p, pc, reg, bf, Args); + save_stacktrace(c_p, pc, reg, bif_mfa, Args); } /* @@ -5821,11 +5835,12 @@ expand_error_value(Process* c_p, Uint freason, Eterm Value) { */ static void -save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf, - Eterm args) { +save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, + ErtsCodeMFA *bif_mfa, Eterm args) { struct StackTrace* s; int sz; int depth = erts_backtrace_depth; /* max depth (never negative) */ + if (depth > 0) { /* There will always be a current function */ depth --; @@ -5841,33 +5856,30 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf, s->depth = 0; /* - * If the failure was in a BIF other than 'error', 'exit' or - * 'throw', find the bif-table index and save the argument + * If the failure was in a BIF other than 'error/1', 'error/2', + * 'exit/1' or 'throw/1', save BIF-MFA and save the argument * registers by consing up an arglist. */ - if (bf != NULL && bf != error_1 && bf != error_2 && - bf != exit_1 && bf != throw_1) { - int i; - int a = 0; - for (i = 0; i < BIF_SIZE; i++) { - if (bf == bif_table[i].f || bf == bif_table[i].traced) { - Export *ep = bif_export[i]; - s->current = &ep->info.mfa; - a = bif_table[i].arity; + if (bif_mfa) { + if (bif_mfa->module == am_erlang) { + switch (bif_mfa->function) { + case am_error: + if (bif_mfa->arity == 1 || bif_mfa->arity == 2) + goto non_bif_stacktrace; + break; + case am_exit: + if (bif_mfa->arity == 1) + goto non_bif_stacktrace; + break; + case am_throw: + if (bif_mfa->arity == 1) + goto non_bif_stacktrace; + break; + default: break; } } - if (i >= BIF_SIZE) { - /* - * The Bif does not really exist (no BIF entry). It is a - * TRAP and traps are called through apply_bif, which also - * sets c_p->current (luckily). - * OR it is a NIF called by call_nif where current is also set. - */ - ASSERT(c_p->current); - s->current = c_p->current; - a = s->current->arity; - } + s->current = bif_mfa; /* Save first stack entry */ ASSERT(pc); if (depth > 0) { @@ -5880,8 +5892,11 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf, depth--; } s->pc = NULL; - args = make_arglist(c_p, reg, a); /* Overwrite CAR(c_p->ftrace) */ + args = make_arglist(c_p, reg, bif_mfa->arity); /* Overwrite CAR(c_p->ftrace) */ } else { + + non_bif_stacktrace: + s->current = c_p->current; /* * For a function_clause error, the arguments are in the beam @@ -5942,12 +5957,30 @@ erts_save_stacktrace(Process* p, struct StackTrace* s, int depth) p->cp) { /* Cannot follow cp here - code may be unloaded */ BeamInstr *cpp = p->cp; + int trace_cp; if (cpp == beam_exception_trace || cpp == beam_return_trace) { /* Skip return_trace parameters */ ptr += 2; + trace_cp = 1; } else if (cpp == beam_return_to_trace) { /* Skip return_to_trace parameters */ ptr += 1; + trace_cp = 1; + } + else { + trace_cp = 0; + } + if (trace_cp && s->pc == cpp) { + /* + * If process 'cp' points to a return/exception trace + * instruction and 'cp' has been saved as 'pc' in + * stacktrace, we need to update 'pc' in stacktrace + * with the actual 'cp' located on the top of the + * stack; otherwise, we will lose the top stackframe + * when building the stack trace. + */ + ASSERT(is_CP(p->stop[0])); + s->pc = cp_val(p->stop[0]); } } while (ptr < STACK_START(p) && depth > 0) { @@ -6067,12 +6100,15 @@ build_stacktrace(Process* c_p, Eterm exc) { erts_set_current_function(&fi, s->current); } + depth = s->depth; /* - * If fi.current is still NULL, default to the initial function + * If fi.current is still NULL, and we have no + * stack at all, default to the initial function * (e.g. spawn_link(erlang, abs, [1])). */ if (fi.mfa == NULL) { - erts_set_current_function(&fi, &c_p->u.initial); + if (depth <= 0) + erts_set_current_function(&fi, &c_p->u.initial); args = am_true; /* Just in case */ } else { args = get_args_from_exc(exc); @@ -6082,10 +6118,9 @@ build_stacktrace(Process* c_p, Eterm exc) { * Look up all saved continuation pointers and calculate * needed heap space. */ - depth = s->depth; stk = stkp = (FunctionInfo *) erts_alloc(ERTS_ALC_T_TMP, depth*sizeof(FunctionInfo)); - heap_size = fi.needed + 2; + heap_size = fi.mfa ? fi.needed + 2 : 0; for (i = 0; i < depth; i++) { erts_lookup_function_info(stkp, s->trace[i], 1); if (stkp->mfa) { @@ -6104,8 +6139,10 @@ build_stacktrace(Process* c_p, Eterm exc) { res = CONS(hp, mfa, res); hp += 2; } - hp = erts_build_mfa_item(&fi, hp, args, &mfa); - res = CONS(hp, mfa, res); + if (fi.mfa) { + hp = erts_build_mfa_item(&fi, hp, args, &mfa); + res = CONS(hp, mfa, res); + } erts_free(ERTS_ALC_T_TMP, (void *) stk); return res; @@ -6203,8 +6240,107 @@ apply_setup_error_handler(Process* p, Eterm module, Eterm function, Uint arity, return ep; } +static ERTS_INLINE void +apply_bif_error_adjustment(Process *p, Export *ep, + Eterm *reg, Uint arity, + BeamInstr *I, Uint stack_offset) +{ + /* + * I is only set when the apply is a tail call, i.e., + * from the instructions i_apply_only, i_apply_last_P, + * and apply_last_IP. + */ + if (I + && ep->beam[0] == (BeamInstr) em_apply_bif + && (ep == bif_export[BIF_error_1] + || ep == bif_export[BIF_error_2] + || ep == bif_export[BIF_exit_1] + || ep == bif_export[BIF_throw_1])) { + /* + * We are about to tail apply one of the BIFs + * erlang:error/1, erlang:error/2, erlang:exit/1, + * or erlang:throw/1. Error handling of these BIFs is + * special! + * + * We need 'p->cp' to point into the calling + * function when handling the error after the BIF has + * been applied. This in order to get the topmost + * stackframe correct. Without the following adjustment, + * 'p->cp' will point into the function that called + * current function when handling the error. We add a + * dummy stackframe in order to achive this. + * + * Note that these BIFs unconditionally will cause + * an exception to be raised. That is, our modifications + * of 'p->cp' as well as the stack will be corrected by + * the error handling code. + * + * If we find an exception/return-to trace continuation + * pointer as the topmost continuation pointer, we do not + * need to do anything since the information already will + * be available for generation of the stacktrace. + */ + int apply_only = stack_offset == 0; + BeamInstr *cpp; + + if (apply_only) { + ASSERT(p->cp != NULL); + cpp = p->cp; + } + else { + ASSERT(is_CP(p->stop[0])); + cpp = cp_val(p->stop[0]); + } + + if (cpp != beam_exception_trace + && cpp != beam_return_trace + && cpp != beam_return_to_trace) { + Uint need = stack_offset /* bytes */ / sizeof(Eterm); + if (need == 0) + need = 1; /* i_apply_only */ + if (p->stop - p->htop < need) + erts_garbage_collect(p, (int) need, reg, arity+1); + p->stop -= need; + + if (apply_only) { + /* + * Called from the i_apply_only instruction. + * + * 'p->cp' contains continuation pointer pointing + * into the function that called current function. + * We push that continuation pointer onto the stack, + * and set 'p->cp' to point into current function. + */ + + p->stop[0] = make_cp(p->cp); + p->cp = I; + } + else { + /* + * Called from an i_apply_last_p, or apply_last_IP, + * instruction. + * + * Calling instruction will after we return read + * a continuation pointer from the stack and write + * it to 'p->cp', and then remove the topmost + * stackframe of size 'stack_offset'. + * + * We have sized the dummy-stackframe so that it + * will be removed by the instruction we currently + * are executing, and leave the stackframe that + * normally would have been removed intact. + * + */ + p->stop[0] = make_cp(I); + } + } + } +} + static BeamInstr* -apply(Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg) +apply( +Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg, +BeamInstr *I, Uint stack_offset) { int arity; Export* ep; @@ -6229,21 +6365,54 @@ apply(Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg) return 0; } - /* The module argument may be either an atom or an abstract module - * (currently implemented using tuples, but this might change). - */ - this = THE_NON_VALUE; - if (is_not_atom(module)) { - Eterm* tp; + while (1) { + Eterm m, f, a; + /* The module argument may be either an atom or an abstract module + * (currently implemented using tuples, but this might change). + */ + this = THE_NON_VALUE; + if (is_not_atom(module)) { + Eterm* tp; + + if (is_not_tuple(module)) goto error; + tp = tuple_val(module); + if (arityval(tp[0]) < 1) goto error; + this = module; + module = tp[1]; + if (is_not_atom(module)) goto error; + } - if (is_not_tuple(module)) goto error; - tp = tuple_val(module); - if (arityval(tp[0]) < 1) goto error; - this = module; - module = tp[1]; - if (is_not_atom(module)) goto error; + if (module != am_erlang || function != am_apply) + break; + + /* Adjust for multiple apply of apply/3... */ + + a = args; + if (is_list(a)) { + Eterm *consp = list_val(a); + m = CAR(consp); + a = CDR(consp); + if (is_list(a)) { + consp = list_val(a); + f = CAR(consp); + a = CDR(consp); + if (is_list(a)) { + consp = list_val(a); + a = CAR(consp); + if (is_nil(CDR(consp))) { + /* erlang:apply/3 */ + module = m; + function = f; + args = a; + if (is_not_atom(f)) + goto error; + continue; + } + } + } + } + break; /* != erlang:apply/3 */ } - /* * Walk down the 3rd parameter of apply (the argument list) and copy * the parameters to the x registers (reg[]). If the module argument @@ -6281,12 +6450,14 @@ apply(Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg) } else if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) { save_calls(p, ep); } + apply_bif_error_adjustment(p, ep, reg, arity, I, stack_offset); DTRACE_GLOBAL_CALL_FROM_EXPORT(p, ep); return ep->addressv[erts_active_code_ix()]; } static BeamInstr* -fixed_apply(Process* p, Eterm* reg, Uint arity) +fixed_apply(Process* p, Eterm* reg, Uint arity, + BeamInstr *I, Uint stack_offset) { Export* ep; Eterm module; @@ -6316,6 +6487,10 @@ fixed_apply(Process* p, Eterm* reg, Uint arity) if (is_not_atom(module)) goto error; ++arity; } + + /* Handle apply of apply/3... */ + if (module == am_erlang && function == am_apply && arity == 3) + return apply(p, reg[0], reg[1], reg[2], reg, I, stack_offset); /* * Get the index into the export table, or failing that the export @@ -6330,6 +6505,7 @@ fixed_apply(Process* p, Eterm* reg, Uint arity) } else if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) { save_calls(p, ep); } + apply_bif_error_adjustment(p, ep, reg, arity, I, stack_offset); DTRACE_GLOBAL_CALL_FROM_EXPORT(p, ep); return ep->addressv[erts_active_code_ix()]; } diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 8f1faa6719..309465bcd3 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -800,14 +800,14 @@ erts_finish_loading(Binary* magic, Process* c_p, } else { ErtsCodeIndex code_ix = erts_staging_code_ix(); Eterm module = stp->module; - int i; + int i, num_exps; /* * There is an -on_load() function. We will keep the current * code, but we must turn off any tracing. */ - - for (i = 0; i < export_list_size(code_ix); i++) { + num_exps = export_list_size(code_ix); + for (i = 0; i < num_exps; i++) { Export *ep = export_list(i, code_ix); if (ep == NULL || ep->info.mfa.module != module) { continue; @@ -5724,12 +5724,13 @@ exported_from_module(Process* p, /* Process whose heap to use. */ ErtsCodeIndex code_ix, Eterm mod) /* Tagged atom for module. */ { - int i; + int i, num_exps; Eterm* hp = NULL; Eterm* hend = NULL; Eterm result = NIL; - for (i = 0; i < export_list_size(code_ix); i++) { + num_exps = export_list_size(code_ix); + for (i = 0; i < num_exps; i++) { Export* ep = export_list(i,code_ix); if (ep->info.mfa.module == mod) { diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index d886c2985e..65c370c55b 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -3865,13 +3865,6 @@ BIF_RETTYPE now_0(BIF_ALIST_0) /**********************************************************************/ -BIF_RETTYPE garbage_collect_0(BIF_ALIST_0) -{ - FLAGS(BIF_P) |= F_NEED_FULLSWEEP; - erts_garbage_collect(BIF_P, 0, NULL, 0); - return am_true; -} - /* * Pass atom 'minor' for relaxed generational GC run. This is only * recommendation, major run may still be chosen by VM. @@ -4324,7 +4317,7 @@ BIF_RETTYPE group_leader_2(BIF_ALIST_2) erts_smp_proc_unlock(new_member, ERTS_PROC_LOCK_STATUS); if (new_member == BIF_P || !(erts_smp_atomic32_read_nob(&new_member->state) - & (ERTS_PSFLG_DIRTY_RUNNING|ERTS_PSFLG_DIRTY_RUNNING_SYS))) { + & ERTS_PSFLG_DIRTY_RUNNING)) { new_member->group_leader = STORE_NC_IN_PROC(new_member, BIF_ARG_1); } @@ -4608,7 +4601,7 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) erts_aint32_t new = BIF_ARG_2 == am_true ? 1 : 0; erts_aint32_t old = erts_smp_atomic32_xchg_nob(&sched_wall_time, new); - Eterm ref = erts_sched_wall_time_request(BIF_P, 1, new); + Eterm ref = erts_sched_wall_time_request(BIF_P, 1, new, 0, 0); ASSERT(is_value(ref)); BIF_TRAP2(await_sched_wall_time_mod_trap, BIF_P, @@ -4958,7 +4951,7 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, Export bif_return_trap_export; void erts_init_trap_export(Export* ep, Eterm m, Eterm f, Uint a, - Eterm (*bif)(BIF_ALIST_0)) + Eterm (*bif)(BIF_ALIST)) { int i; sys_memset((void *) ep, 0, sizeof(Export)); @@ -5019,6 +5012,314 @@ void erts_init_bif(void) erts_smp_atomic32_init_nob(&msacc, ERTS_MSACC_IS_ENABLED()); } +/* + * Scheduling of BIFs via NifExport... + */ +#define ERTS_WANT_NFUNC_SCHED_INTERNALS__ +#include "erl_nfunc_sched.h" + +#define ERTS_SCHED_BIF_TRAP_MARKER ((void *) (UWord) 1) + +static ERTS_INLINE void +schedule(Process *c_p, Process *dirty_shadow_proc, + ErtsCodeMFA *mfa, BeamInstr *pc, + ErtsBifFunc dfunc, void *ifunc, + Eterm module, Eterm function, + int argc, Eterm *argv) +{ + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(c_p)); + (void) erts_nif_export_schedule(c_p, dirty_shadow_proc, + mfa, pc, (BeamInstr) em_apply_bif, + dfunc, ifunc, + module, function, + argc, argv); +} + +#ifdef ERTS_DIRTY_SCHEDULERS + +static BIF_RETTYPE dirty_bif_result(BIF_ALIST_1) +{ + NifExport *nep = (NifExport *) ERTS_PROC_GET_NIF_TRAP_EXPORT(BIF_P); + erts_nif_export_restore(BIF_P, nep, BIF_ARG_1); + BIF_RET(BIF_ARG_1); +} + +static BIF_RETTYPE dirty_bif_trap(BIF_ALIST) +{ + NifExport *nep = (NifExport *) ERTS_PROC_GET_NIF_TRAP_EXPORT(BIF_P); + + /* + * Arity and argument registers already set + * correct by call to dirty_bif_trap()... + */ + + ASSERT(BIF_P->arity == nep->exp.info.mfa.arity); + + erts_nif_export_restore(BIF_P, nep, THE_NON_VALUE); + + BIF_P->i = (BeamInstr *) nep->func; + BIF_P->freason = TRAP; + return THE_NON_VALUE; +} + +static BIF_RETTYPE dirty_bif_exception(BIF_ALIST_2) +{ + Eterm freason; + + ASSERT(is_small(BIF_ARG_1)); + + freason = signed_val(BIF_ARG_1); + + /* Restore orig info for error and clear nif export in handle_error() */ + freason |= EXF_RESTORE_NIF; + + BIF_P->fvalue = BIF_ARG_2; + + BIF_ERROR(BIF_P, freason); +} + +#endif /* ERTS_DIRTY_SCHEDULERS */ + +extern BeamInstr* em_call_bif_e; +static BIF_RETTYPE call_bif(Process *c_p, Eterm *reg, BeamInstr *I); + +BIF_RETTYPE +erts_schedule_bif(Process *proc, + Eterm *argv, + BeamInstr *i, + ErtsBifFunc bif, + ErtsSchedType sched_type, + Eterm mod, + Eterm func, + int argc) +{ + Process *c_p, *dirty_shadow_proc; + ErtsCodeMFA *mfa; + +#ifdef ERTS_DIRTY_SCHEDULERS + if (proc->static_flags & ERTS_STC_FLG_SHADOW_PROC) { + dirty_shadow_proc = proc; + c_p = proc->next; + ASSERT(c_p->common.id == dirty_shadow_proc->common.id); + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); + } + else +#endif + { + dirty_shadow_proc = NULL; + c_p = proc; + } + + if (!ERTS_PROC_IS_EXITING(c_p)) { + Export *exp; + BifFunction dbif, ibif; + BeamInstr *pc; + + /* + * dbif - direct bif + * ibif - indirect bif + */ + +#ifdef ERTS_DIRTY_SCHEDULERS + erts_aint32_t set, mask; + mask = (ERTS_PSFLG_DIRTY_CPU_PROC + | ERTS_PSFLG_DIRTY_IO_PROC); + switch (sched_type) { + case ERTS_SCHED_DIRTY_CPU: + set = ERTS_PSFLG_DIRTY_CPU_PROC; + dbif = bif; + ibif = NULL; + break; + case ERTS_SCHED_DIRTY_IO: + set = ERTS_PSFLG_DIRTY_IO_PROC; + dbif = bif; + ibif = NULL; + break; + case ERTS_SCHED_NORMAL: + default: + set = 0; + dbif = call_bif; + ibif = bif; + break; + } + + (void) erts_smp_atomic32_read_bset_nob(&c_p->state, mask, set); +#else + dbif = call_bif; + ibif = bif; +#endif + + if (i == NULL) { + ERTS_INTERNAL_ERROR("Missing instruction pointer"); + } +#ifdef HIPE + else if (proc->flags & F_HIPE_MODE) { + /* Pointer to bif export in i */ + exp = (Export *) i; + pc = c_p->cp; + mfa = &exp->info.mfa; + } +#endif + else if (em_call_bif_e == (BeamInstr *) *i) { + /* Pointer to bif export in i+1 */ + exp = (Export *) i[1]; + pc = i; + mfa = &exp->info.mfa; + } + else if (em_apply_bif == (BeamInstr *) *i) { + /* Pointer to bif in i+1, and mfa in i-3 */ + pc = c_p->cp; + mfa = erts_code_to_codemfa(i); + } + else { + ERTS_INTERNAL_ERROR("erts_schedule_bif() called " + "from unexpected instruction"); + } + ASSERT(bif); + + if (argc < 0) { /* reschedule original call */ + mod = mfa->module; + func = mfa->function; + argc = (int) mfa->arity; + } + + schedule(c_p, dirty_shadow_proc, mfa, pc, dbif, ibif, + mod, func, argc, argv); + } + + if (dirty_shadow_proc) + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); + + return THE_NON_VALUE; +} + +static BIF_RETTYPE +call_bif(Process *c_p, Eterm *reg, BeamInstr *I) +{ + NifExport *nep = ERTS_I_BEAM_OP_TO_NIF_EXPORT(I); + ErtsBifFunc bif = (ErtsBifFunc) nep->func; + BIF_RETTYPE ret; + + ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data())); + + nep->func = ERTS_SCHED_BIF_TRAP_MARKER; + + ASSERT(bif); + + ret = (*bif)(c_p, reg, I); + + if (is_value(ret)) + erts_nif_export_restore(c_p, nep, ret); + else if (c_p->freason != TRAP) + c_p->freason |= EXF_RESTORE_NIF; /* restore in handle_error() */ + else if (nep->func == ERTS_SCHED_BIF_TRAP_MARKER) { + /* BIF did an ordinary trap... */ + erts_nif_export_restore(c_p, nep, ret); + } + /* else: + * BIF rescheduled itself using erts_schedule_bif(). + */ + + return ret; +} + +#ifdef ERTS_DIRTY_SCHEDULERS + +int +erts_call_dirty_bif(ErtsSchedulerData *esdp, Process *c_p, BeamInstr *I, Eterm *reg) +{ + BIF_RETTYPE result; + int exiting; + Process *dirty_shadow_proc; + ErtsBifFunc bf; + NifExport *nep; +#ifdef DEBUG + Eterm *c_p_htop; + erts_aint32_t state; + + ASSERT(!c_p->scheduler_data); + state = erts_smp_atomic32_read_nob(&c_p->state); + ASSERT((state & ERTS_PSFLG_DIRTY_RUNNING) + && !(state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS))); + ASSERT(esdp); + +#endif + + nep = ERTS_I_BEAM_OP_TO_NIF_EXPORT(I); + ASSERT(nep == ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p)); + + nep->func = ERTS_SCHED_BIF_TRAP_MARKER; + + bf = (ErtsBifFunc) I[1]; + + erts_smp_atomic32_read_band_mb(&c_p->state, ~(ERTS_PSFLG_DIRTY_CPU_PROC + | ERTS_PSFLG_DIRTY_IO_PROC)); + + dirty_shadow_proc = erts_make_dirty_shadow_proc(esdp, c_p); + + dirty_shadow_proc->freason = c_p->freason; + dirty_shadow_proc->fvalue = c_p->fvalue; + dirty_shadow_proc->ftrace = c_p->ftrace; + dirty_shadow_proc->cp = c_p->cp; + dirty_shadow_proc->i = c_p->i; + +#ifdef DEBUG + c_p_htop = c_p->htop; +#endif + + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); + + result = (*bf)(dirty_shadow_proc, reg, I); + + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); + + ASSERT(c_p_htop == c_p->htop); + ASSERT(dirty_shadow_proc->static_flags & ERTS_STC_FLG_SHADOW_PROC); + ASSERT(dirty_shadow_proc->next == c_p); + + exiting = ERTS_PROC_IS_EXITING(c_p); + + if (!exiting) { + if (is_value(result)) + schedule(c_p, dirty_shadow_proc, NULL, NULL, dirty_bif_result, + NULL, am_erts_internal, am_dirty_bif_result, 1, &result); + else if (dirty_shadow_proc->freason != TRAP) { + Eterm argv[2]; + ASSERT(dirty_shadow_proc->freason <= MAX_SMALL); + argv[0] = make_small(dirty_shadow_proc->freason); + argv[1] = dirty_shadow_proc->fvalue; + schedule(c_p, dirty_shadow_proc, NULL, NULL, + dirty_bif_exception, NULL, am_erts_internal, + am_dirty_bif_exception, 2, argv); + } + else if (nep->func == ERTS_SCHED_BIF_TRAP_MARKER) { + /* Dirty BIF did an ordinary trap... */ + ASSERT(!(erts_smp_atomic32_read_nob(&c_p->state) + & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC))); + schedule(c_p, dirty_shadow_proc, NULL, NULL, + dirty_bif_trap, (void *) dirty_shadow_proc->i, + am_erts_internal, am_dirty_bif_trap, + dirty_shadow_proc->arity, reg); + } + /* else: + * BIF rescheduled itself using erts_schedule_bif(). + */ + c_p->freason = dirty_shadow_proc->freason; + c_p->fvalue = dirty_shadow_proc->fvalue; + c_p->ftrace = dirty_shadow_proc->ftrace; + c_p->cp = dirty_shadow_proc->cp; + c_p->i = dirty_shadow_proc->i; + c_p->arity = dirty_shadow_proc->arity; + } + + erts_flush_dirty_shadow_proc(dirty_shadow_proc); + + return exiting; +} + +#endif /* ERTS_DIRTY_SCHEDULERS */ + + #ifdef HARDDEBUG /* You'll need this line in bif.tab to be able to use this debug bif diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h index 0c85e19ef0..01cca90a7a 100644 --- a/erts/emulator/beam/bif.h +++ b/erts/emulator/beam/bif.h @@ -29,17 +29,35 @@ extern Export *erts_convert_time_unit_trap; #define BIF_P A__p -#define BIF_ALIST_0 Process* A__p, Eterm* BIF__ARGS -#define BIF_ALIST_1 Process* A__p, Eterm* BIF__ARGS -#define BIF_ALIST_2 Process* A__p, Eterm* BIF__ARGS -#define BIF_ALIST_3 Process* A__p, Eterm* BIF__ARGS -#define BIF_ALIST_4 Process* A__p, Eterm* BIF__ARGS +#define BIF_ALIST Process* A__p, Eterm* BIF__ARGS, BeamInstr *A__I +#define BIF_CALL_ARGS A__p, BIF__ARGS, A__I + +#define BIF_ALIST_0 BIF_ALIST +#define BIF_ALIST_1 BIF_ALIST +#define BIF_ALIST_2 BIF_ALIST +#define BIF_ALIST_3 BIF_ALIST +#define BIF_ALIST_4 BIF_ALIST #define BIF_ARG_1 (BIF__ARGS[0]) #define BIF_ARG_2 (BIF__ARGS[1]) #define BIF_ARG_3 (BIF__ARGS[2]) #define BIF_ARG_4 (BIF__ARGS[3]) +#define BIF_I A__I + +/* NBIF_* is for bif calls from native code... */ + +#define NBIF_ALIST Process* A__p, Eterm* BIF__ARGS +#define NBIF_CALL_ARGS A__p, BIF__ARGS + +#define NBIF_ALIST_0 NBIF_ALIST +#define NBIF_ALIST_1 NBIF_ALIST +#define NBIF_ALIST_2 NBIF_ALIST +#define NBIF_ALIST_3 NBIF_ALIST +#define NBIF_ALIST_4 NBIF_ALIST + +typedef BIF_RETTYPE (*ErtsBifFunc)(BIF_ALIST); + #define ERTS_IS_PROC_OUT_OF_REDS(p) \ ((p)->fcalls > 0 \ ? 0 \ @@ -480,6 +498,43 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, Eterm args[], int nargs); +#ifdef ERTS_DIRTY_SCHEDULERS +int erts_call_dirty_bif(ErtsSchedulerData *esdp, Process *c_p, + BeamInstr *I, Eterm *reg); +#endif + +BIF_RETTYPE +erts_schedule_bif(Process *proc, + Eterm *argv, + BeamInstr *i, + ErtsBifFunc dbf, + ErtsSchedType sched_type, + Eterm mod, + Eterm func, + int argc); + +ERTS_GLB_INLINE BIF_RETTYPE +erts_reschedule_bif(Process *proc, + Eterm *argv, + BeamInstr *i, + ErtsBifFunc dbf, + ErtsSchedType sched_type); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE BIF_RETTYPE +erts_reschedule_bif(Process *proc, + Eterm *argv, + BeamInstr *i, + ErtsBifFunc dbf, + ErtsSchedType sched_type) +{ + return erts_schedule_bif(proc, argv, i, dbf, sched_type, + THE_NON_VALUE, THE_NON_VALUE, -1); +} + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + #ifdef ERL_WANT_HIPE_BIF_WRAPPER__ #ifndef HIPE @@ -510,16 +565,16 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, #define HIPE_WRAPPER_BIF_DISABLE_GC(BIF_NAME, ARITY) \ -BIF_RETTYPE hipe_wrapper_ ## BIF_NAME ## _ ## ARITY (Process* c_p, \ - Eterm* args); \ -BIF_RETTYPE hipe_wrapper_ ## BIF_NAME ## _ ## ARITY (Process* c_p, \ - Eterm* args) \ +BIF_RETTYPE \ +nbif_impl_hipe_wrapper_ ## BIF_NAME ## _ ## ARITY (NBIF_ALIST); \ +BIF_RETTYPE \ +nbif_impl_hipe_wrapper_ ## BIF_NAME ## _ ## ARITY (NBIF_ALIST) \ { \ BIF_RETTYPE res; \ - hipe_reserve_beam_trap_frame(c_p, args, ARITY); \ - res = BIF_NAME ## _ ## ARITY (c_p, args); \ - if (is_value(res) || c_p->freason != TRAP) { \ - hipe_unreserve_beam_trap_frame(c_p); \ + hipe_reserve_beam_trap_frame(BIF_P, BIF__ARGS, ARITY); \ + res = nbif_impl_ ## BIF_NAME ## _ ## ARITY (NBIF_CALL_ARGS); \ + if (is_value(res) || BIF_P->freason != TRAP) { \ + hipe_unreserve_beam_trap_frame(BIF_P); \ } \ return res; \ } diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 32600f4338..47fdcfa7a4 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -68,7 +68,6 @@ gcbif erlang:float/1 bif erlang:float_to_list/1 bif erlang:float_to_list/2 bif erlang:fun_info/2 -bif erlang:garbage_collect/0 bif erts_internal:garbage_collect/1 bif erlang:get/0 bif erlang:get/1 @@ -420,6 +419,9 @@ bif erts_debug:set_internal_state/2 bif erts_debug:display/1 bif erts_debug:dist_ext_to_term/2 bif erts_debug:instructions/0 +bif erts_debug:dirty_cpu/2 +bif erts_debug:dirty_io/2 +bif erts_debug:dirty/3 # # Monitor testing bif's... diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 40a45c961f..4d990a9c56 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -44,6 +44,7 @@ #include "erl_hl_timer.h" #include "erl_cpu_topology.h" #include "erl_thr_queue.h" +#include "erl_nfunc_sched.h" #if defined(ERTS_ALC_T_DRV_SEL_D_STATE) || defined(ERTS_ALC_T_DRV_EV_D_STATE) #include "erl_check_io.h" #endif @@ -679,6 +680,8 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_ABIF_TIMER)] = erts_timer_type_size(ERTS_ALC_T_ABIF_TIMER); #endif + fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_NIF_EXP_TRACE)] + = sizeof(NifExportTrace); #ifdef HARD_DEBUG hdbg_init(); @@ -2437,6 +2440,10 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg) fi, ERTS_ALC_T_ABIF_TIMER); #endif + add_fix_values(&size.processes, + &size.processes_used, + fi, + ERTS_ALC_T_NIF_EXP_TRACE); } if (want.atom || want.atom_used) { diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 6e8710eb8a..70eca5b49c 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -376,7 +376,8 @@ type DB_MS_PSDO_PROC LONG_LIVED ETS db_match_pseudo_proc type SCHDLR_DATA LONG_LIVED SYSTEM scheduler_data type LL_TEMP_TERM LONG_LIVED SYSTEM ll_temp_term -type NIF_TRAP_EXPORT STANDARD CODE nif_trap_export_entry +type NIF_TRAP_EXPORT STANDARD PROCESSES nif_trap_export_entry +type NIF_EXP_TRACE FIXED_SIZE PROCESSES nif_export_trace type EXPORT LONG_LIVED CODE export_entry type MONITOR_SH FIXED_SIZE PROCESSES monitor_sh type NLINK_SH FIXED_SIZE PROCESSES nlink_sh diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 0e0842e139..5ee19aead8 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -94,6 +94,9 @@ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE #if defined(ERTS_DIRTY_SCHEDULERS) && defined(ERTS_SMP) " [ds:%beu:%beu:%beu]" #endif +#if defined(ERTS_DIRTY_SCHEDULERS_TEST) + " [dirty-schedulers-TEST]" +#endif " [async-threads:%d]" #endif #ifdef HIPE @@ -1673,11 +1676,11 @@ current_stacktrace(Process* p, Process* rp, Eterm** hpp) Eterm mfa; Eterm res = NIL; - depth = 8; + depth = erts_backtrace_depth; sz = offsetof(struct StackTrace, trace) + sizeof(BeamInstr *)*depth; s = (struct StackTrace *) erts_alloc(ERTS_ALC_T_TMP, sz); s->depth = 0; - if (rp->i) { + if (depth > 0 && rp->i) { s->trace[s->depth++] = rp->i; depth--; } @@ -2677,20 +2680,30 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) erts_schedulers_state(NULL, NULL, &active, NULL, NULL, NULL, NULL, NULL); BIF_RET(make_small(active)); #endif -#if defined(ERTS_SMP) && defined(ERTS_DIRTY_SCHEDULERS) } else if (ERTS_IS_ATOM_STR("dirty_cpu_schedulers", BIF_ARG_1)) { Uint dirty_cpu; +#ifdef ERTS_DIRTY_SCHEDULERS erts_schedulers_state(NULL, NULL, NULL, &dirty_cpu, NULL, NULL, NULL, NULL); +#else + dirty_cpu = 0; +#endif BIF_RET(make_small(dirty_cpu)); } else if (ERTS_IS_ATOM_STR("dirty_cpu_schedulers_online", BIF_ARG_1)) { Uint dirty_cpu_onln; +#ifdef ERTS_DIRTY_SCHEDULERS erts_schedulers_state(NULL, NULL, NULL, NULL, &dirty_cpu_onln, NULL, NULL, NULL); +#else + dirty_cpu_onln = 0; +#endif BIF_RET(make_small(dirty_cpu_onln)); } else if (ERTS_IS_ATOM_STR("dirty_io_schedulers", BIF_ARG_1)) { Uint dirty_io; +#ifdef ERTS_DIRTY_SCHEDULERS erts_schedulers_state(NULL, NULL, NULL, NULL, NULL, NULL, &dirty_io, NULL); - BIF_RET(make_small(dirty_io)); +#else + dirty_io = 0; #endif + BIF_RET(make_small(dirty_io)); } else if (ERTS_IS_ATOM_STR("run_queues", BIF_ARG_1)) { res = make_small(erts_no_run_queues); BIF_RET(res); @@ -2863,6 +2876,9 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) else if (ERTS_IS_ATOM_STR("atom_limit",BIF_ARG_1)) { BIF_RET(make_small(erts_get_atom_limit())); } + else if (ERTS_IS_ATOM_STR("atom_count",BIF_ARG_1)) { + BIF_RET(make_small(atom_table_size())); + } else if (ERTS_IS_ATOM_STR("tolerant_timeofday",BIF_ARG_1)) { if (erts_has_time_correction() && erts_time_offset_state() == ERTS_TIME_OFFSET_FINAL) { @@ -3369,7 +3385,12 @@ BIF_RETTYPE statistics_1(BIF_ALIST_1) Eterm* hp; if (BIF_ARG_1 == am_scheduler_wall_time) { - res = erts_sched_wall_time_request(BIF_P, 0, 0); + res = erts_sched_wall_time_request(BIF_P, 0, 0, 1, 0); + if (is_non_value(res)) + BIF_RET(am_undefined); + BIF_TRAP1(gather_sched_wall_time_res_trap, BIF_P, res); + } else if (BIF_ARG_1 == am_scheduler_wall_time_all) { + res = erts_sched_wall_time_request(BIF_P, 0, 0, 1, 1); if (is_non_value(res)) BIF_RET(am_undefined); BIF_TRAP1(gather_sched_wall_time_res_trap, BIF_P, res); diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index b1c2c427b0..a480754bdb 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -1061,9 +1061,16 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key) erts_smp_thr_progress_block(); } #endif +#ifdef ERTS_DIRTY_SCHEDULERS + erts_smp_mtx_lock(&erts_dirty_bp_ix_mtx); +#endif + r = function_is_traced(p, mfa, &ms, &ms_meta, &meta, &count, &call_time); +#ifdef ERTS_DIRTY_SCHEDULERS + erts_smp_mtx_unlock(&erts_dirty_bp_ix_mtx); +#endif #ifdef ERTS_SMP if ( (key == am_call_time) || (key == am_all)) { erts_smp_thr_progress_unblock(); diff --git a/erts/emulator/beam/erl_dirty_bif.tab b/erts/emulator/beam/erl_dirty_bif.tab new file mode 100644 index 0000000000..69421dcfcc --- /dev/null +++ b/erts/emulator/beam/erl_dirty_bif.tab @@ -0,0 +1,82 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2016. All Rights Reserved. +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# +# %CopyrightEnd% +# + +# +# Static declaration of BIFs that should execute on dirty schedulers. +# +# <dirty-bif-decl> ::= <type> <bif> +# <bif> ::= <module> ":" <name> "/" <arity> +# <type> ::= dirty-cpu | dirty-io | dirty-cpu-test | dirty-io-test +# +# When dirty scheduler support is available, a BIF declared with the +# 'dirty-cpu' type will unconditionally execute on a dirty CPU scheduler, +# and a BIF declared with the type 'dirty-io' will unconditionally execute +# on a dirty IO scheduler. When dirty scheduler support is not available +# all BIFs will of course execute on normal schedulers. +# +# When the emulator has been configured with the debug option +# '--enable-dirty-schedulers-test', BIFs with the types 'dirty-cpu-test', +# and 'dirty-io-test' will unconditionally execute on dirty schedulers. +# When this debug option has not been enabled, these BIFs will be executed +# on normal schedulers. +# +# BIFs marked as 'ubif' in ./bif.tab will be ignored, i.e., will always +# execute on normal schedulers. +# + +# --- Dirty BIFs --- + +dirty-cpu erts_debug:dirty_cpu/2 +dirty-io erts_debug:dirty_io/2 + +# --- TEST of Dirty BIF functionality --- +# Functions below will execute on dirty schedulers when emulator has +# been configured for testing dirty schedulers. This is used for test +# and debug purposes only. We really do *not* want to execute these +# on dirty schedulers on a real system. + +dirty-cpu-test erlang:'++'/2 +dirty-cpu-test erlang:append/2 +dirty-cpu-test erlang:'--'/2 +dirty-cpu-test erlang:subtract/2 +dirty-cpu-test erlang:iolist_size/1 +dirty-cpu-test erlang:make_tuple/2 +dirty-cpu-test erlang:make_tuple/3 +dirty-cpu-test erlang:append_element/2 +dirty-cpu-test erlang:insert_element/3 +dirty-cpu-test erlang:delete_element/2 +dirty-cpu-test erlang:atom_to_list/1 +dirty-cpu-test erlang:list_to_atom/1 +dirty-cpu-test erlang:list_to_existing_atom/1 +dirty-cpu-test erlang:integer_to_list/1 +dirty-cpu-test erlang:string_to_integer/1 +dirty-cpu-test erlang:list_to_integer/1 +dirty-cpu-test erlang:list_to_integer/2 +dirty-cpu-test erlang:float_to_list/1 +dirty-cpu-test erlang:float_to_list/2 +dirty-cpu-test erlang:float_to_binary/1 +dirty-cpu-test erlang:float_to_binary/2 +dirty-cpu-test erlang:string_to_float/1 +dirty-cpu-test erlang:list_to_float/1 +dirty-cpu-test erlang:binary_to_float/1 +dirty-cpu-test erlang:tuple_to_list/1 +dirty-cpu-test erlang:list_to_tuple/1 +dirty-cpu-test erlang:display/1 +dirty-cpu-test erlang:display_string/1 diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 28b2b02914..3a3ad820b5 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -42,6 +42,7 @@ #include "dtrace-wrapper.h" #include "erl_bif_unique.h" #include "dist.h" +#include "erl_nfunc_sched.h" #define ERTS_INACT_WR_PB_LEAVE_MUCH_LIMIT 1 #define ERTS_INACT_WR_PB_LEAVE_MUCH_PERCENTAGE 20 @@ -59,6 +60,10 @@ # define ERTS_GC_ASSERT(B) ((void) 1) #endif +#if defined(DEBUG) && 0 +# define HARDDEBUG 1 +#endif + /* * Returns number of elements in an array. */ @@ -110,18 +115,20 @@ typedef struct { static Uint setup_rootset(Process*, Eterm*, int, Rootset*); static void cleanup_rootset(Rootset *rootset); -static void remove_message_buffers(Process* p); static Eterm *full_sweep_heaps(Process *p, int hibernate, Eterm *n_heap, Eterm* n_htop, char *oh, Uint oh_size, Eterm *objv, int nobj); static int garbage_collect(Process* p, ErlHeapFragment *live_hf_end, - int need, Eterm* objv, int nobj, int fcalls); + int need, Eterm* objv, int nobj, int fcalls, + Uint max_young_gen_usage); static int major_collection(Process* p, ErlHeapFragment *live_hf_end, - int need, Eterm* objv, int nobj, Uint *recl); + int need, Eterm* objv, int nobj, + Uint ygen_usage, Uint *recl); static int minor_collection(Process* p, ErlHeapFragment *live_hf_end, - int need, Eterm* objv, int nobj, Uint *recl); + int need, Eterm* objv, int nobj, + Uint ygen_usage, Uint *recl); static void do_minor(Process *p, ErlHeapFragment *live_hf_end, char *mature, Uint mature_size, Uint new_sz, Eterm* objv, int nobj); @@ -153,7 +160,7 @@ static void init_gc_info(ErtsGCInfo *gcip); static Uint64 next_vheap_size(Process* p, Uint64 vheap, Uint64 vheap_sz); #ifdef HARDDEBUG -static void disallow_heap_frag_ref_in_heap(Process* p); +static void disallow_heap_frag_ref_in_heap(Process *p, Eterm *heap, Eterm *htop); static void disallow_heap_frag_ref_in_old_heap(Process* p); #endif @@ -176,6 +183,13 @@ typedef struct { erts_smp_atomic32_t refc; } ErtsGCInfoReq; +#ifdef ERTS_DIRTY_SCHEDULERS +static struct { + erts_mtx_t mtx; + ErtsGCInfo info; +} dirty_gc; +#endif + static ERTS_INLINE int gc_cost(Uint gc_moved_live_words, Uint resize_moved_words) { @@ -259,6 +273,11 @@ erts_init_gc(void) init_gc_info(&esdp->gc_info); } +#ifdef ERTS_DIRTY_SCHEDULERS + erts_smp_mtx_init(&dirty_gc.mtx, "dirty_gc_info"); + init_gc_info(&dirty_gc.info); +#endif + init_gcireq_alloc(); } @@ -400,15 +419,15 @@ erts_gc_after_bif_call_lhf(Process* p, ErlHeapFragment *live_hf_end, regs = erts_proc_sched_data(p)->x_reg_array; } #endif - cost = garbage_collect(p, live_hf_end, 0, regs, p->arity, p->fcalls); + cost = garbage_collect(p, live_hf_end, 0, regs, p->arity, p->fcalls, 0); } else { - cost = garbage_collect(p, live_hf_end, 0, regs, arity, p->fcalls); + cost = garbage_collect(p, live_hf_end, 0, regs, arity, p->fcalls, 0); } } else { Eterm val[1]; val[0] = result; - cost = garbage_collect(p, live_hf_end, 0, val, 1, p->fcalls); + cost = garbage_collect(p, live_hf_end, 0, val, 1, p->fcalls, 0); result = val[0]; } BUMP_REDS(p, cost); @@ -477,24 +496,26 @@ delay_garbage_collection(Process *p, ErlHeapFragment *live_hf_end, int need, int hsz = ssz + need + ERTS_DELAY_GC_EXTRA_FREE; hfrag = new_message_buffer(hsz); - hfrag->next = p->mbuf; - p->mbuf = hfrag; - p->mbuf_sz += hsz; p->heap = p->htop = &hfrag->mem[0]; p->hend = hend = &hfrag->mem[hsz]; p->stop = stop = hend - ssz; sys_memcpy((void *) stop, (void *) orig_stop, ssz * sizeof(Eterm)); if (p->abandoned_heap) { - /* Active heap already in a fragment; adjust it... */ - ErlHeapFragment *hfrag = ((ErlHeapFragment *) - (((char *) orig_heap) - - offsetof(ErlHeapFragment, mem))); - Uint unused = orig_hend - orig_htop; - ASSERT(hfrag->used_size == hfrag->alloc_size); - ASSERT(hfrag->used_size >= unused); - hfrag->used_size -= unused; - p->mbuf_sz -= unused; + /* + * Active heap already in a fragment; adjust it and + * save it into mbuf list... + */ + ErlHeapFragment *hfrag = ((ErlHeapFragment *) + (((char *) orig_heap) + - offsetof(ErlHeapFragment, mem))); + Uint used = orig_htop - orig_heap; + hfrag->used_size = used; + p->mbuf_sz += used; + ASSERT(hfrag->used_size <= hfrag->alloc_size); + ASSERT(!hfrag->off_heap.first && !hfrag->off_heap.overhead); + hfrag->next = p->mbuf; + p->mbuf = hfrag; } else { /* Do not leave a hole in the abandoned heap... */ @@ -556,17 +577,14 @@ young_gen_usage(Process *p) } } + hsz += p->htop - p->heap; aheap = p->abandoned_heap; - if (!aheap) - hsz += p->htop - p->heap; - else { + if (aheap) { /* used in orig heap */ if (p->flags & F_ABANDONED_HEAP_USE) hsz += aheap[p->heap_sz-1]; else hsz += p->heap_sz; - /* Remove unused part in latest fragment */ - hsz -= p->hend - p->htop; } return hsz; } @@ -587,6 +605,32 @@ young_gen_usage(Process *p) } \ } while (0) +#ifdef ERTS_DIRTY_SCHEDULERS + +static ERTS_INLINE void +check_for_possibly_long_gc(Process *p, Uint ygen_usage) +{ + int major; + Uint sz; + + major = (p->flags & F_NEED_FULLSWEEP) || GEN_GCS(p) >= MAX_GEN_GCS(p); + + sz = ygen_usage; + sz += p->hend - p->stop; + if (p->flags & F_ON_HEAP_MSGQ) + sz += p->msg.len; + if (major) + sz += p->old_htop - p->old_heap; + + if (sz >= ERTS_POTENTIALLY_LONG_GC_HSIZE) { + ASSERT(!(p->flags & (F_DISABLE_GC|F_DELAY_GC))); + p->flags |= major ? F_DIRTY_MAJOR_GC : F_DIRTY_MINOR_GC; + erts_schedule_dirty_sys_execution(p); + } +} + +#endif + /* * Garbage collect a process. * @@ -597,28 +641,44 @@ young_gen_usage(Process *p) */ static int garbage_collect(Process* p, ErlHeapFragment *live_hf_end, - int need, Eterm* objv, int nobj, int fcalls) + int need, Eterm* objv, int nobj, int fcalls, + Uint max_young_gen_usage) { Uint reclaimed_now = 0; + Uint ygen_usage; Eterm gc_trace_end_tag; int reds; - ErtsMonotonicTime start_time = 0; /* Shut up faulty warning... */ - ErtsSchedulerData *esdp; + ErtsMonotonicTime start_time; + ErtsSchedulerData *esdp = erts_proc_sched_data(p); erts_aint32_t state; ERTS_MSACC_PUSH_STATE_M(); #ifdef USE_VM_PROBES DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE); #endif + ERTS_UNDEF(start_time, 0); ERTS_CHK_MBUF_SZ(p); - ASSERT(CONTEXT_REDS - ERTS_REDS_LEFT(p, fcalls) - >= erts_proc_sched_data(p)->virtual_reds); + ASSERT(CONTEXT_REDS - ERTS_REDS_LEFT(p, fcalls) >= esdp->virtual_reds); state = erts_smp_atomic32_read_nob(&p->state); - if (p->flags & (F_DISABLE_GC|F_DELAY_GC) || state & ERTS_PSFLG_EXITING) + if ((p->flags & (F_DISABLE_GC|F_DELAY_GC)) || state & ERTS_PSFLG_EXITING) { +#ifdef ERTS_DIRTY_SCHEDULERS + delay_gc_before_start: +#endif return delay_garbage_collection(p, live_hf_end, need, fcalls); + } + + ygen_usage = max_young_gen_usage ? max_young_gen_usage : young_gen_usage(p); + +#ifdef ERTS_DIRTY_SCHEDULERS + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + check_for_possibly_long_gc(p, ygen_usage); + if (p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC)) + goto delay_gc_before_start; + } +#endif if (p->abandoned_heap) live_hf_end = ERTS_INVALID_HFRAG_PTR; @@ -627,8 +687,6 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_GC); - esdp = erts_get_scheduler_data(); - erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC); if (erts_system_monitor_long_gc != 0) start_time = erts_get_monotonic_time(esdp); @@ -655,14 +713,25 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, trace_gc(p, am_gc_minor_start, need, THE_NON_VALUE); } DTRACE2(gc_minor_start, pidbuf, need); - reds = minor_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); + reds = minor_collection(p, live_hf_end, need, objv, nobj, + ygen_usage, &reclaimed_now); DTRACE2(gc_minor_end, pidbuf, reclaimed_now); if (reds == -1) { if (IS_TRACED_FL(p, F_TRACE_GC)) { trace_gc(p, am_gc_minor_end, reclaimed_now, THE_NON_VALUE); } +#ifdef ERTS_DIRTY_SCHEDULERS + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + p->flags |= F_NEED_FULLSWEEP; + check_for_possibly_long_gc(p, ygen_usage); + if (p->flags & F_DIRTY_MAJOR_GC) + goto delay_gc_after_start; + } +#endif goto do_major_collection; } + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) + p->flags &= ~F_DIRTY_MINOR_GC; gc_trace_end_tag = am_gc_minor_end; } else { do_major_collection: @@ -671,7 +740,10 @@ do_major_collection: trace_gc(p, am_gc_major_start, need, THE_NON_VALUE); } DTRACE2(gc_major_start, pidbuf, need); - reds = major_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); + reds = major_collection(p, live_hf_end, need, objv, nobj, + ygen_usage, &reclaimed_now); + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) + p->flags &= ~(F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC); DTRACE2(gc_major_end, pidbuf, reclaimed_now); gc_trace_end_tag = am_gc_major_end; ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_GC); @@ -701,6 +773,9 @@ do_major_collection: am_kill, NIL, NULL, 0); erts_smp_proc_unlock(p, locks & ERTS_PROC_LOCKS_ALL_MINOR); +#ifdef ERTS_DIRTY_SCHEDULERS + delay_gc_after_start: +#endif /* erts_send_exit_signal looks for ERTS_PSFLG_GC, so we have to remove it after the signal is sent */ erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC); @@ -735,8 +810,19 @@ do_major_collection: monitor_large_heap(p); } - esdp->gc_info.garbage_cols++; - esdp->gc_info.reclaimed += reclaimed_now; +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) { + erts_mtx_lock(&dirty_gc.mtx); + dirty_gc.info.garbage_cols++; + dirty_gc.info.reclaimed += reclaimed_now; + erts_mtx_unlock(&dirty_gc.mtx); + } + else +#endif + { + esdp->gc_info.garbage_cols++; + esdp->gc_info.reclaimed += reclaimed_now; + } FLAGS(p) &= ~F_FORCE_GC; p->live_hf_end = ERTS_INVALID_HFRAG_PTR; @@ -765,6 +851,7 @@ do_major_collection: ASSERT(!p->mbuf); ASSERT(!ERTS_IS_GC_DESIRED(p)); + ASSERT(need <= HEAP_LIMIT(p) - HEAP_TOP(p)); return reds; } @@ -772,7 +859,7 @@ do_major_collection: int erts_garbage_collect_nobump(Process* p, int need, Eterm* objv, int nobj, int fcalls) { - int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, fcalls); + int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, fcalls, 0); int reds_left = ERTS_REDS_LEFT(p, fcalls); if (reds > reds_left) reds = reds_left; @@ -783,12 +870,13 @@ erts_garbage_collect_nobump(Process* p, int need, Eterm* objv, int nobj, int fca void erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) { - int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, p->fcalls); + int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, p->fcalls, 0); BUMP_REDS(p, reds); ASSERT(CONTEXT_REDS - ERTS_BIF_REDS_LEFT(p) >= erts_proc_sched_data(p)->virtual_reds); } + /* * Place all living data on a the new heap; deallocate any old heap. * Meant to be used by hibernate/3. @@ -808,6 +896,20 @@ erts_garbage_collect_hibernate(Process* p) if (p->flags & F_DISABLE_GC) ERTS_INTERNAL_ERROR("GC disabled"); +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(p))) + p->flags &= ~(F_DIRTY_GC_HIBERNATE|F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC); + else { + Uint flags = p->flags; + p->flags |= F_NEED_FULLSWEEP; + check_for_possibly_long_gc(p, (p->htop - p->heap) + p->mbuf_sz); + if (p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC)) { + p->flags = flags|F_DIRTY_GC_HIBERNATE; + return; + } + p->flags = flags; + } +#endif /* * Preliminaries. */ @@ -819,7 +921,6 @@ erts_garbage_collect_hibernate(Process* p) * Do it. */ - heap_size = p->heap_sz + (p->old_htop - p->old_heap) + p->mbuf_sz; heap = (Eterm*) ERTS_HEAP_ALLOC(ERTS_ALC_T_TMP_HEAP, @@ -835,11 +936,11 @@ erts_garbage_collect_hibernate(Process* p) p->arg_reg, p->arity); - ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, - (p->abandoned_heap - ? p->abandoned_heap - : p->heap), - p->heap_sz * sizeof(Eterm)); +#ifdef HARDDEBUG + disallow_heap_frag_ref_in_heap(p, heap, htop); +#endif + + erts_deallocate_young_generation(p); p->heap = heap; p->high_water = htop; @@ -874,8 +975,6 @@ erts_garbage_collect_hibernate(Process* p) sys_memcpy((void *) heap, (void *) p->heap, actual_size*sizeof(Eterm)); ERTS_HEAP_FREE(ERTS_ALC_T_TMP_HEAP, p->heap, p->heap_sz*sizeof(Eterm)); - remove_message_buffers(p); - p->stop = p->hend = heap + heap_size; offs = heap - p->heap; @@ -962,10 +1061,11 @@ static ERTS_INLINE void offset_nstack(Process* p, Sint offs, #endif /* HIPE */ -void +int erts_garbage_collect_literals(Process* p, Eterm* literals, Uint byte_lit_size, - struct erl_off_heap_header* oh) + struct erl_off_heap_header* oh, + int fcalls) { Uint lit_size = byte_lit_size / sizeof(Eterm); Uint old_heap_size; @@ -977,20 +1077,49 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, Uint area_size; Eterm* old_htop; Uint n; + Uint ygen_usage = 0; struct erl_off_heap_header** prev = NULL; + Sint64 reds; + + if (p->flags & (F_DISABLE_GC|F_DELAY_GC)) + ERTS_INTERNAL_ERROR("GC disabled"); + + /* + * First an ordinary major collection... + */ + + p->flags |= F_NEED_FULLSWEEP; + +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(p))) + p->flags &= ~F_DIRTY_CLA; + else { + ygen_usage = young_gen_usage(p); + check_for_possibly_long_gc(p, + (byte_lit_size/sizeof(Uint) + + 2*ygen_usage)); + if (p->flags & F_DIRTY_MAJOR_GC) { + p->flags |= F_DIRTY_CLA; + return 10; + } + } +#endif + + reds = (Sint64) garbage_collect(p, ERTS_INVALID_HFRAG_PTR, 0, + p->arg_reg, p->arity, fcalls, + ygen_usage); + + ASSERT(!(p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC))); - if (p->flags & F_DISABLE_GC) - return; /* * Set GC state. */ erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC); /* - * We assume that the caller has already done a major collection - * (which has discarded the old heap), so that we don't have to cope - * with pointer to literals on the old heap. We will now allocate - * an old heap to contain the literals. + * Just did a major collection (which has discarded the old heap), + * so that we don't have to cope with pointer to literals on the + * old heap. We will now allocate an old heap to contain the literals. */ ASSERT(p->old_heap == 0); /* Must NOT have an old heap yet. */ @@ -1133,15 +1262,21 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, * Restore status. */ erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC); + + reds += (Sint64) gc_cost((p->htop - p->heap) + byte_lit_size/sizeof(Uint), 0); + if (reds > INT_MAX) + return INT_MAX; + return (int) reds; } static int minor_collection(Process* p, ErlHeapFragment *live_hf_end, - int need, Eterm* objv, int nobj, Uint *recl) + int need, Eterm* objv, int nobj, + Uint ygen_usage, Uint *recl) { Eterm *mature = p->abandoned_heap ? p->abandoned_heap : p->heap; Uint mature_size = p->high_water - mature; - Uint size_before = young_gen_usage(p); + Uint size_before = ygen_usage; /* * Check if we have gone past the max heap size limit @@ -1494,22 +1629,16 @@ do_minor(Process *p, ErlHeapFragment *live_hf_end, } #endif - ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, - (p->abandoned_heap - ? p->abandoned_heap - : HEAP_START(p)), - HEAP_SIZE(p) * sizeof(Eterm)); - p->abandoned_heap = NULL; - p->flags &= ~F_ABANDONED_HEAP_USE; +#ifdef HARDDEBUG + disallow_heap_frag_ref_in_heap(p, n_heap, n_htop); +#endif + + erts_deallocate_young_generation(p); + HEAP_START(p) = n_heap; HEAP_TOP(p) = n_htop; HEAP_SIZE(p) = new_sz; HEAP_END(p) = n_heap + new_sz; - -#ifdef HARDDEBUG - disallow_heap_frag_ref_in_heap(p); -#endif - remove_message_buffers(p); } /* @@ -1518,7 +1647,8 @@ do_minor(Process *p, ErlHeapFragment *live_hf_end, static int major_collection(Process* p, ErlHeapFragment *live_hf_end, - int need, Eterm* objv, int nobj, Uint *recl) + int need, Eterm* objv, int nobj, + Uint ygen_usage, Uint *recl) { Uint size_before, size_after, stack_size; Eterm* n_heap; @@ -1536,7 +1666,7 @@ major_collection(Process* p, ErlHeapFragment *live_hf_end, * to receive all live data. */ - size_before = young_gen_usage(p); + size_before = ygen_usage; size_before += p->old_htop - p->old_heap; stack_size = p->hend - p->stop; @@ -1598,13 +1728,12 @@ major_collection(Process* p, ErlHeapFragment *live_hf_end, } #endif - ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, - (p->abandoned_heap - ? p->abandoned_heap - : HEAP_START(p)), - p->heap_sz * sizeof(Eterm)); - p->abandoned_heap = NULL; - p->flags &= ~F_ABANDONED_HEAP_USE; +#ifdef HARDDEBUG + disallow_heap_frag_ref_in_heap(p, n_heap, n_htop); +#endif + + erts_deallocate_young_generation(p); + HEAP_START(p) = n_heap; HEAP_TOP(p) = n_htop; HEAP_SIZE(p) = new_sz; @@ -1613,11 +1742,6 @@ major_collection(Process* p, ErlHeapFragment *live_hf_end, HIGH_WATER(p) = HEAP_TOP(p); -#ifdef HARDDEBUG - disallow_heap_frag_ref_in_heap(p); -#endif - remove_message_buffers(p); - if (p->flags & F_ON_HEAP_MSGQ) move_msgq_to_heap(p); @@ -1770,22 +1894,56 @@ adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj) return adjusted; } -/* - * Remove all message buffers. - */ -static void -remove_message_buffers(Process* p) +void +erts_deallocate_young_generation(Process *c_p) { - if (MBUF(p) != NULL) { - free_message_buffer(MBUF(p)); - MBUF(p) = NULL; + Eterm *orig_heap; + + if (!c_p->abandoned_heap) { + orig_heap = c_p->heap; + ASSERT(!(c_p->flags & F_ABANDONED_HEAP_USE)); + } + else { + ErlHeapFragment *hfrag; + + orig_heap = c_p->abandoned_heap; + c_p->abandoned_heap = NULL; + c_p->flags &= ~F_ABANDONED_HEAP_USE; + + /* + * Temporary heap located in heap fragment + * only referred to by 'c_p->heap'. Add it to + * 'c_p->mbuf' list and deallocate it as any + * other heap fragment... + */ + hfrag = ((ErlHeapFragment *) + (((char *) c_p->heap) + - offsetof(ErlHeapFragment, mem))); + + ASSERT(!hfrag->off_heap.first); + ASSERT(!hfrag->off_heap.overhead); + ASSERT(!hfrag->next); + ASSERT(c_p->htop - c_p->heap <= hfrag->alloc_size); + + hfrag->next = c_p->mbuf; + c_p->mbuf = hfrag; + } + + if (c_p->mbuf) { + free_message_buffer(c_p->mbuf); + c_p->mbuf = NULL; } - if (p->msg_frag) { - erts_cleanup_messages(p->msg_frag); - p->msg_frag = NULL; + if (c_p->msg_frag) { + erts_cleanup_messages(c_p->msg_frag); + c_p->msg_frag = NULL; } - MBUF_SIZE(p) = 0; + c_p->mbuf_sz = 0; + + ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, + orig_heap, + c_p->heap_sz * sizeof(Eterm)); } + #ifdef HARDDEBUG /* @@ -1797,19 +1955,15 @@ remove_message_buffers(Process* p) */ static void -disallow_heap_frag_ref_in_heap(Process* p) +disallow_heap_frag_ref_in_heap(Process *p, Eterm *heap, Eterm *htop) { Eterm* hp; - Eterm* htop; - Eterm* heap; Uint heap_size; if (p->mbuf == 0) { return; } - htop = p->htop; - heap = p->heap; heap_size = (htop - heap)*sizeof(Eterm); hp = heap; @@ -2384,17 +2538,10 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset) } /* - * If a NIF has saved arguments, they need to be added + * If a NIF or BIF has saved arguments, they need to be added */ - if (ERTS_PROC_GET_NIF_TRAP_EXPORT(p)) { - Eterm* argv; - int argc; - if (erts_setup_nif_gc(p, &argv, &argc)) { - roots[n].v = argv; - roots[n].sz = argc; - n++; - } - } + if (erts_setup_nif_export_rootset(p, &roots[n].v, &roots[n].sz)) + n++; ASSERT(n <= rootset->size); @@ -2946,6 +3093,8 @@ static void ERTS_INLINE offset_one_rootset(Process *p, Sint offs, char* area, Uint area_size, Eterm* objv, int nobj) { + Eterm *v; + Uint sz; if (p->dictionary) { offset_heap(ERTS_PD_START(p->dictionary), ERTS_PD_SIZE(p->dictionary), @@ -2966,12 +3115,8 @@ offset_one_rootset(Process *p, Sint offs, char* area, Uint area_size, offset_heap_ptr(objv, nobj, offs, area, area_size); } offset_off_heap(p, offs, area, area_size); - if (ERTS_PROC_GET_NIF_TRAP_EXPORT(p)) { - Eterm* argv; - int argc; - if (erts_setup_nif_gc(p, &argv, &argc)) - offset_heap_ptr(argv, argc, offs, area, area_size); - } + if (erts_setup_nif_export_rootset(p, &v, &sz)) + offset_heap_ptr(v, sz, offs, area, area_size); } static void @@ -3009,6 +3154,18 @@ reply_gc_info(void *vgcirp) reclaimed = esdp->gc_info.reclaimed; garbage_cols = esdp->gc_info.garbage_cols; +#ifdef ERTS_DIRTY_SCHEDULERS + /* + * Add dirty schedulers info on requesting + * schedulers info + */ + if (gcirp->req_sched == esdp->no) { + erts_mtx_lock(&dirty_gc.mtx); + reclaimed += dirty_gc.info.reclaimed; + garbage_cols += dirty_gc.info.garbage_cols; + erts_mtx_unlock(&dirty_gc.mtx); + } +#endif sz = 0; hpp = NULL; @@ -3282,20 +3439,22 @@ erts_max_heap_size(Eterm arg, Uint *max_heap_size, Uint *max_heap_flags) #if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG) -static int -within2(Eterm *ptr, Process *p, Eterm *real_htop) +int +erts_dbg_within_proc(Eterm *ptr, Process *p, Eterm *real_htop) { ErlHeapFragment* bp; ErtsMessage* mp; Eterm *htop, *heap; - if (p->abandoned_heap) + if (p->abandoned_heap) { ERTS_GET_ORIG_HEAP(p, heap, htop); - else { - heap = p->heap; - htop = real_htop ? real_htop : HEAP_TOP(p); + if (heap <= ptr && ptr < htop) + return 1; } + heap = p->heap; + htop = real_htop ? real_htop : HEAP_TOP(p); + if (OLD_HEAP(p) && (OLD_HEAP(p) <= ptr && ptr < OLD_HEND(p))) { return 1; } @@ -3327,12 +3486,6 @@ within2(Eterm *ptr, Process *p, Eterm *real_htop) return 0; } -int -within(Eterm *ptr, Process *p) -{ - return within2(ptr, p, NULL); -} - #endif #ifdef ERTS_OFFHEAP_DEBUG @@ -3387,7 +3540,7 @@ erts_check_off_heap2(Process *p, Eterm *htop) else if (oheap <= u.ep && u.ep < ohtop) old = 1; else { - ERTS_CHK_OFFHEAP_ASSERT(within2(u.ep, p, htop)); + ERTS_CHK_OFFHEAP_ASSERT(erts_dbg_within_proc(u.ep, p, htop)); } } diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h index 54ea9ca3c0..1cce426d21 100644 --- a/erts/emulator/beam/erl_gc.h +++ b/erts/emulator/beam/erl_gc.h @@ -25,11 +25,9 @@ /* GC declarations shared by beam/erl_gc.c and hipe/hipe_gc.c */ -#include "erl_map.h" +#define ERTS_POTENTIALLY_LONG_GC_HSIZE (128*1024) /* Words */ -#if defined(DEBUG) && !ERTS_GLB_INLINE_INCL_FUNC_DEF -# define HARDDEBUG 1 -#endif +#include "erl_map.h" #define IS_MOVED_BOXED(x) (!is_header((x))) #define IS_MOVED_CONS(x) (is_non_value((x))) @@ -69,10 +67,6 @@ do { \ while (nelts--) *HTOP++ = *PTR++; \ } while(0) -#if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG) -int within(Eterm *ptr, Process *p); -#endif - #define ErtsInYoungGen(TPtr, Ptr, OldHeap, OldHeapSz) \ (!erts_is_literal((TPtr), (Ptr)) \ & !ErtsInArea((Ptr), (OldHeap), (OldHeapSz))) @@ -145,9 +139,10 @@ void erts_garbage_collect_hibernate(struct process* p); Eterm erts_gc_after_bif_call_lhf(struct process* p, ErlHeapFragment *live_hf_end, Eterm result, Eterm* regs, Uint arity); Eterm erts_gc_after_bif_call(struct process* p, Eterm result, Eterm* regs, Uint arity); -void erts_garbage_collect_literals(struct process* p, Eterm* literals, - Uint lit_size, - struct erl_off_heap_header* oh); +int erts_garbage_collect_literals(struct process* p, Eterm* literals, + Uint lit_size, + struct erl_off_heap_header* oh, + int fcalls); Uint erts_next_heap_size(Uint, Uint); Eterm erts_heap_sizes(struct process* p); @@ -157,5 +152,9 @@ void erts_offset_heap(Eterm*, Uint, Sint, Eterm*, Eterm*); void erts_free_heap_frags(struct process* p); Eterm erts_max_heap_size_map(Sint, Uint, Eterm **, Uint *); int erts_max_heap_size(Eterm, Uint *, Uint *); +void erts_deallocate_young_generation(Process *c_p); +#if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG) +int erts_dbg_within_proc(Eterm *ptr, Process *p, Eterm* real_htop); +#endif #endif /* __ERL_GC_H__ */ diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c index d29d079fc5..647fa26811 100644 --- a/erts/emulator/beam/erl_hl_timer.c +++ b/erts/emulator/beam/erl_hl_timer.c @@ -2666,7 +2666,7 @@ erts_start_timer_callback(ErtsMonotonicTime tmo, tmo); twt = tmo < ERTS_TIMER_WHEEL_MSEC; - if (esdp) + if (esdp && !ERTS_SCHEDULER_IS_DIRTY(esdp)) start_callback_timer(esdp, twt, timeout_pos, @@ -2865,7 +2865,8 @@ btm_print(ErtsHLTimer *tmr, void *vbtmp) if (tmr->timeout <= btmp->now) left = 0; - left = ERTS_CLKTCKS_TO_MSEC(tmr->timeout - btmp->now); + else + left = ERTS_CLKTCKS_TO_MSEC(tmr->timeout - btmp->now); receiver = ((tmr->head.roflgs & ERTS_TMR_ROFLG_REG_NAME) ? tmr->receiver.name diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 356f5ca71e..08dcbed91c 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -127,6 +127,8 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "run_queue", "address" }, #ifdef ERTS_DIRTY_SCHEDULERS { "dirty_run_queue_sleep_list", "address" }, + { "dirty_gc_info", NULL }, + { "dirty_break_point_index", NULL }, #endif { "process_table", NULL }, { "cpu_info", NULL }, diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 118adc0c1b..547e9cac64 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -193,7 +193,7 @@ free_message_buffer(ErlHeapFragment* bp) erts_cleanup_offheap(&bp->off_heap); ERTS_HEAP_FREE(ERTS_ALC_T_HEAP_FRAG, (void *) bp, - ERTS_HEAP_FRAG_SIZE(bp->size)); + ERTS_HEAP_FRAG_SIZE(bp->alloc_size)); bp = next_bp; }while (bp != NULL); } @@ -285,9 +285,11 @@ erts_queue_dist_message(Process *rcvr, if (!(rcvr_locks & ERTS_PROC_LOCK_MSGQ)) { if (erts_smp_proc_trylock(rcvr, ERTS_PROC_LOCK_MSGQ) == EBUSY) { ErtsProcLocks need_locks = ERTS_PROC_LOCK_MSGQ; - if (rcvr_locks & ERTS_PROC_LOCK_STATUS) { - erts_smp_proc_unlock(rcvr, ERTS_PROC_LOCK_STATUS); - need_locks |= ERTS_PROC_LOCK_STATUS; + ErtsProcLocks unlocks = + rcvr_locks & ERTS_PROC_LOCKS_HIGHER_THAN(ERTS_PROC_LOCK_MSGQ); + if (unlocks) { + erts_smp_proc_unlock(rcvr, unlocks); + need_locks |= unlocks; } erts_smp_proc_lock(rcvr, need_locks); } @@ -406,7 +408,7 @@ queue_messages(Process* receiver, if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT)) goto exiting; - need_locks = receiver_locks & (ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); + need_locks = receiver_locks & ERTS_PROC_LOCKS_HIGHER_THAN(ERTS_PROC_LOCK_MSGQ); if (need_locks) { erts_smp_proc_unlock(receiver, need_locks); } diff --git a/erts/emulator/beam/erl_msacc.c b/erts/emulator/beam/erl_msacc.c index 7ddf49937f..66bb55e6c8 100644 --- a/erts/emulator/beam/erl_msacc.c +++ b/erts/emulator/beam/erl_msacc.c @@ -137,8 +137,8 @@ void erts_msacc_init_thread(char *type, int id, int managed) { void erts_msacc_set_bif_state(ErtsMsAcc *__erts_msacc_cache, Eterm mod, void *fn) { #ifdef ERTS_MSACC_EXTENDED_BIFS -#define BIF_LIST(Mod,Func,Arity,FuncAddr,Num) \ - if (fn == &FuncAddr) { \ +#define BIF_LIST(Mod,Func,Arity,BifFuncAddr,FuncAddr,Num) \ + if (fn == &BifFuncAddr) { \ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATIC_STATE_COUNT + Num); \ } else #include "erl_bif_list.h" diff --git a/erts/emulator/beam/erl_msacc.h b/erts/emulator/beam/erl_msacc.h index 9ef86a1293..d64ef8c8b9 100644 --- a/erts/emulator/beam/erl_msacc.h +++ b/erts/emulator/beam/erl_msacc.h @@ -122,7 +122,7 @@ static char *erts_msacc_states[] = { "sleep", "timers" #ifdef ERTS_MSACC_EXTENDED_BIFS -#define BIF_LIST(Mod,Func,Arity,FuncAddr,Num) \ +#define BIF_LIST(Mod,Func,Arity,BifFuncAddr,FuncAddr,Num) \ ,"bif_" #Mod "_" #Func "_" #Arity #include "erl_bif_list.h" #undef BIF_LIST diff --git a/erts/emulator/beam/erl_nfunc_sched.c b/erts/emulator/beam/erl_nfunc_sched.c new file mode 100644 index 0000000000..1bebc1eda4 --- /dev/null +++ b/erts/emulator/beam/erl_nfunc_sched.c @@ -0,0 +1,180 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2016. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#define ERTS_WANT_NFUNC_SCHED_INTERNALS__ + +#include "global.h" +#include "erl_process.h" +#include "bif.h" +#include "erl_nfunc_sched.h" +#include "erl_trace.h" + +NifExport * +erts_new_proc_nif_export(Process *c_p, int argc) +{ + size_t size; + int i; + NifExport *nep, *old_nep; + + size = sizeof(NifExport) + (argc-1)*sizeof(Eterm); + nep = erts_alloc(ERTS_ALC_T_NIF_TRAP_EXPORT, size); + + for (i = 0; i < ERTS_NUM_CODE_IX; i++) + nep->exp.addressv[i] = &nep->exp.beam[0]; + + nep->argc = -1; /* unused marker */ + nep->argv_size = argc; + nep->trace = NULL; + old_nep = ERTS_PROC_SET_NIF_TRAP_EXPORT(c_p, nep); + if (old_nep) { + ASSERT(!nep->trace); + erts_free(ERTS_ALC_T_NIF_TRAP_EXPORT, old_nep); + } + return nep; +} + +void +erts_destroy_nif_export(Process *p) +{ + NifExport *nep = ERTS_PROC_SET_NIF_TRAP_EXPORT(p, NULL); + if (nep) { + if (nep->m) + erts_nif_export_cleanup_nif_mod(nep); + erts_free(ERTS_ALC_T_NIF_TRAP_EXPORT, nep); + } +} + +void +erts_nif_export_save_trace(Process *c_p, NifExport *nep, int applying, + Export* ep, BeamInstr *cp, Uint32 flags, + Uint32 flags_meta, BeamInstr* I, + ErtsTracer meta_tracer) +{ + NifExportTrace *netp; + ASSERT(nep && nep->argc >= 0); + ASSERT(!nep->trace); + netp = erts_alloc(ERTS_ALC_T_NIF_EXP_TRACE, + sizeof(NifExportTrace)); + netp->applying = applying; + netp->ep = ep; + netp->cp = cp; + netp->flags = flags; + netp->flags_meta = flags_meta; + netp->I = I; + netp->meta_tracer = NIL; + erts_tracer_update(&netp->meta_tracer, meta_tracer); + nep->trace = netp; +} + +void +erts_nif_export_restore_trace(Process *c_p, Eterm result, NifExport *nep) +{ + NifExportTrace *netp = nep->trace; + nep->trace = NULL; + erts_bif_trace_epilogue(c_p, result, netp->applying, netp->ep, + netp->cp, netp->flags, netp->flags_meta, + netp->I, netp->meta_tracer); + erts_tracer_update(&netp->meta_tracer, NIL); + erts_free(ERTS_ALC_T_NIF_EXP_TRACE, netp); +} + +NifExport * +erts_nif_export_schedule(Process *c_p, Process *dirty_shadow_proc, + ErtsCodeMFA *mfa, BeamInstr *pc, + BeamInstr instr, + void *dfunc, void *ifunc, + Eterm mod, Eterm func, + int argc, const Eterm *argv) +{ + Process *used_proc; + ErtsSchedulerData *esdp; + Eterm* reg; + NifExport* nep; + int i; + + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) + & ERTS_PROC_LOCK_MAIN); + + if (dirty_shadow_proc) { + esdp = erts_get_scheduler_data(); + ASSERT(esdp && ERTS_SCHEDULER_IS_DIRTY(esdp)); + + used_proc = dirty_shadow_proc; + } + else { + esdp = erts_proc_sched_data(c_p); + ASSERT(esdp && !ERTS_SCHEDULER_IS_DIRTY(esdp)); + + used_proc = c_p; + ERTS_VBUMP_ALL_REDS(c_p); + } + + reg = esdp->x_reg_array; + + if (mfa) + nep = erts_get_proc_nif_export(c_p, (int) mfa->arity); + else { + /* If no mfa, this is not the first schedule... */ + nep = ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p); + ASSERT(nep && nep->argc >= 0); + } + + if (nep->argc < 0) { + /* + * First schedule; save things that might + * need to be restored... + */ + for (i = 0; i < (int) mfa->arity; i++) + nep->argv[i] = reg[i]; + nep->pc = pc; + nep->cp = c_p->cp; + nep->mfa = mfa; + nep->current = c_p->current; + ASSERT(argc >= 0); + nep->argc = (int) mfa->arity; + nep->m = NULL; + + ASSERT(!erts_check_nif_export_in_area(c_p, + (char *) nep, + (sizeof(NifExport) + + (sizeof(Eterm) + *(nep->argc-1))))); + } + /* Copy new arguments into register array if necessary... */ + if (reg != argv) { + for (i = 0; i < argc; i++) + reg[i] = argv[i]; + } + ASSERT(is_atom(mod) && is_atom(func)); + nep->exp.info.mfa.module = mod; + nep->exp.info.mfa.function = func; + nep->exp.info.mfa.arity = (Uint) argc; + nep->exp.beam[0] = (BeamInstr) instr; /* call_nif || apply_bif */ + nep->exp.beam[1] = (BeamInstr) dfunc; + nep->func = ifunc; + used_proc->arity = argc; + used_proc->freason = TRAP; + used_proc->i = (BeamInstr*) nep->exp.addressv[0]; + return nep; +} diff --git a/erts/emulator/beam/erl_nfunc_sched.h b/erts/emulator/beam/erl_nfunc_sched.h new file mode 100644 index 0000000000..55a3a6dbf6 --- /dev/null +++ b/erts/emulator/beam/erl_nfunc_sched.h @@ -0,0 +1,332 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2016. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#ifndef ERL_NFUNC_SCHED_H__ +#define ERL_NFUNC_SCHED_H__ + +#include "erl_process.h" +#include "bif.h" +#include "error.h" + +typedef struct { + int applying; + Export* ep; + BeamInstr *cp; + Uint32 flags; + Uint32 flags_meta; + BeamInstr* I; + ErtsTracer meta_tracer; +} NifExportTrace; + +/* + * NIF exports need a few more items than the Export struct provides, + * including the erl_module_nif* and a NIF function pointer, so the + * NifExport below adds those. The Export member must be first in the + * struct. A number of values are stored for error handling purposes + * only. + * + * 'argc' is >= 0 when NifExport is in use, and < 0 when not. + */ + +typedef struct { + Export exp; + struct erl_module_nif* m; /* NIF module, or NULL if BIF */ + void *func; /* Indirect NIF or BIF to execute (may be unused) */ + ErtsCodeMFA *current;/* Current as set when originally called */ + NifExportTrace *trace; + /* --- The following is only used on error --- */ + BeamInstr *pc; /* Program counter */ + BeamInstr *cp; /* Continuation pointer */ + ErtsCodeMFA *mfa; /* MFA of original call */ + int argc; /* Number of arguments in original call */ + int argv_size; /* Allocated size of argv */ + Eterm argv[1]; /* Saved arguments from the original call */ +} NifExport; + +NifExport *erts_new_proc_nif_export(Process *c_p, int argc); +void erts_nif_export_save_trace(Process *c_p, NifExport *nep, int applying, + Export* ep, BeamInstr *cp, Uint32 flags, + Uint32 flags_meta, BeamInstr* I, + ErtsTracer meta_tracer); +void erts_nif_export_restore_trace(Process *c_p, Eterm result, NifExport *nep); +void erts_destroy_nif_export(Process *p); +NifExport *erts_nif_export_schedule(Process *c_p, Process *dirty_shadow_proc, + ErtsCodeMFA *mfa, BeamInstr *pc, + BeamInstr instr, + void *dfunc, void *ifunc, + Eterm mod, Eterm func, + int argc, const Eterm *argv); +void erts_nif_export_cleanup_nif_mod(NifExport *ep); /* erl_nif.c */ +ERTS_GLB_INLINE NifExport *erts_get_proc_nif_export(Process *c_p, int extra); +ERTS_GLB_INLINE int erts_setup_nif_export_rootset(Process* proc, Eterm** objv, + Uint* nobj); +ERTS_GLB_INLINE int erts_check_nif_export_in_area(Process *p, + char *start, Uint size); +ERTS_GLB_INLINE void erts_nif_export_restore(Process *c_p, NifExport *ep, + Eterm result); +ERTS_GLB_INLINE void erts_nif_export_restore_error(Process* c_p, BeamInstr **pc, + Eterm *reg, ErtsCodeMFA **nif_mfa); +ERTS_GLB_INLINE int erts_nif_export_check_save_trace(Process *c_p, Eterm result, + int applying, Export* ep, + BeamInstr *cp, Uint32 flags, + Uint32 flags_meta, BeamInstr* I, + ErtsTracer meta_tracer); +ERTS_GLB_INLINE Process *erts_proc_shadow2real(Process *c_p); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE NifExport * +erts_get_proc_nif_export(Process *c_p, int argc) +{ + NifExport *nep = ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p); + if (!nep || (nep->argc < 0 && nep->argv_size < argc)) + return erts_new_proc_nif_export(c_p, argc); + return nep; +} + +/* + * If a process has saved arguments, they need to be part of the GC + * rootset. The function below is called from setup_rootset() in + * erl_gc.c. Any exception term saved in the NifExport is also made + * part of the GC rootset here; it always resides in rootset[0]. + */ +ERTS_GLB_INLINE int +erts_setup_nif_export_rootset(Process* proc, Eterm** objv, Uint* nobj) +{ + NifExport* ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + + if (!ep || ep->argc <= 0) + return 0; + + *objv = ep->argv; + *nobj = ep->argc; + return 1; +} + +/* + * Check if nif export points into code area... + */ +ERTS_GLB_INLINE int +erts_check_nif_export_in_area(Process *p, char *start, Uint size) +{ + NifExport *nep = ERTS_PROC_GET_NIF_TRAP_EXPORT(p); + if (!nep || nep->argc < 0) + return 0; + if (ErtsInArea(nep->pc, start, size)) + return 1; + if (ErtsInArea(nep->cp, start, size)) + return 1; + if (ErtsInArea(nep->mfa, start, size)) + return 1; + if (ErtsInArea(nep->current, start, size)) + return 1; + return 0; +} + +ERTS_GLB_INLINE void +erts_nif_export_restore(Process *c_p, NifExport *ep, Eterm result) +{ + ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data())); + ERTS_SMP_LC_ASSERT(!(c_p->static_flags + & ERTS_STC_FLG_SHADOW_PROC)); + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) + & ERTS_PROC_LOCK_MAIN); + + c_p->current = ep->current; + ep->argc = -1; /* Unused nif-export marker... */ + if (ep->trace) + erts_nif_export_restore_trace(c_p, result, ep); +} + +ERTS_GLB_INLINE void +erts_nif_export_restore_error(Process* c_p, BeamInstr **pc, + Eterm *reg, ErtsCodeMFA **nif_mfa) +{ + NifExport *nep = (NifExport *) ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p); + int ix; + + ASSERT(nep); + *pc = nep->pc; + c_p->cp = nep->cp; + *nif_mfa = nep->mfa; + for (ix = 0; ix < nep->argc; ix++) + reg[ix] = nep->argv[ix]; + erts_nif_export_restore(c_p, nep, THE_NON_VALUE); +} + +ERTS_GLB_INLINE int +erts_nif_export_check_save_trace(Process *c_p, Eterm result, + int applying, Export* ep, + BeamInstr *cp, Uint32 flags, + Uint32 flags_meta, BeamInstr* I, + ErtsTracer meta_tracer) +{ + if (is_non_value(result) && c_p->freason == TRAP) { + NifExport *nep = ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p); + if (nep && nep->argc >= 0) { + erts_nif_export_save_trace(c_p, nep, applying, ep, + cp, flags, flags_meta, + I, meta_tracer); + return 1; + } + } + return 0; +} + +ERTS_GLB_INLINE Process * +erts_proc_shadow2real(Process *c_p) +{ +#ifdef ERTS_DIRTY_SCHEDULERS + if (c_p->static_flags & ERTS_STC_FLG_SHADOW_PROC) { + Process *real_c_p = c_p->next; + ASSERT(ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data())); + ASSERT(real_c_p->common.id == c_p->common.id); + return real_c_p; + } + ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data())); +#endif + return c_p; +} + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#endif /* ERL_NFUNC_SCHED_H__ */ + +#if defined(ERTS_WANT_NFUNC_SCHED_INTERNALS__) && !defined(ERTS_NFUNC_SCHED_INTERNALS__) +#define ERTS_NFUNC_SCHED_INTERNALS__ + +#define ERTS_I_BEAM_OP_TO_NIF_EXPORT(I) \ + (ASSERT(BeamOp(op_apply_bif) == (BeamInstr *) (*(I)) \ + || BeamOp(op_call_nif) == (BeamInstr *) (*(I))), \ + ((NifExport *) (((char *) (I)) - offsetof(NifExport, exp.beam[0])))) + +#ifdef ERTS_DIRTY_SCHEDULERS + +#include "erl_message.h" +#include <stddef.h> + +ERTS_GLB_INLINE void erts_flush_dirty_shadow_proc(Process *sproc); +ERTS_GLB_INLINE void erts_cache_dirty_shadow_proc(Process *sproc); +ERTS_GLB_INLINE Process *erts_make_dirty_shadow_proc(ErtsSchedulerData *esdp, + Process *c_p); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_flush_dirty_shadow_proc(Process *sproc) +{ + Process *c_p = sproc->next; + + ASSERT(sproc->common.id == c_p->common.id); + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) + & ERTS_PROC_LOCK_MAIN); + + ASSERT(c_p->stop == sproc->stop); + ASSERT(c_p->hend == sproc->hend); + ASSERT(c_p->heap == sproc->heap); + ASSERT(c_p->abandoned_heap == sproc->abandoned_heap); + ASSERT(c_p->heap_sz == sproc->heap_sz); + ASSERT(c_p->high_water == sproc->high_water); + ASSERT(c_p->old_heap == sproc->old_heap); + ASSERT(c_p->old_htop == sproc->old_htop); + ASSERT(c_p->old_hend == sproc->old_hend); + + ASSERT(c_p->htop <= sproc->htop && sproc->htop <= c_p->stop); + + c_p->htop = sproc->htop; + + if (!c_p->mbuf) + c_p->mbuf = sproc->mbuf; + else if (sproc->mbuf) { + ErlHeapFragment *bp; + for (bp = sproc->mbuf; bp->next; bp = bp->next) + ASSERT(!bp->off_heap.first); + bp->next = c_p->mbuf; + c_p->mbuf = sproc->mbuf; + } + + c_p->mbuf_sz += sproc->mbuf_sz; + + if (!c_p->off_heap.first) + c_p->off_heap.first = sproc->off_heap.first; + else if (sproc->off_heap.first) { + struct erl_off_heap_header *ohhp; + for (ohhp = sproc->off_heap.first; ohhp->next; ohhp = ohhp->next) + ; + ohhp->next = c_p->off_heap.first; + c_p->off_heap.first = sproc->off_heap.first; + } + + c_p->off_heap.overhead += sproc->off_heap.overhead; +} + +ERTS_GLB_INLINE void +erts_cache_dirty_shadow_proc(Process *sproc) +{ + Process *c_p = sproc->next; + ASSERT(c_p); + ASSERT(sproc->common.id == c_p->common.id); + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) + & ERTS_PROC_LOCK_MAIN); + + sproc->htop = c_p->htop; + sproc->stop = c_p->stop; + sproc->hend = c_p->hend; + sproc->heap = c_p->heap; + sproc->abandoned_heap = c_p->abandoned_heap; + sproc->heap_sz = c_p->heap_sz; + sproc->high_water = c_p->high_water; + sproc->old_hend = c_p->old_hend; + sproc->old_htop = c_p->old_htop; + sproc->old_heap = c_p->old_heap; + sproc->mbuf = NULL; + sproc->mbuf_sz = 0; + ERTS_INIT_OFF_HEAP(&sproc->off_heap); +} + +ERTS_GLB_INLINE Process * +erts_make_dirty_shadow_proc(ErtsSchedulerData *esdp, Process *c_p) +{ + Process *sproc; + + ASSERT(ERTS_SCHEDULER_IS_DIRTY(esdp)); + + sproc = esdp->dirty_shadow_process; + ASSERT(sproc); + ASSERT(sproc->static_flags & ERTS_STC_FLG_SHADOW_PROC); + ASSERT(erts_smp_atomic32_read_nob(&sproc->state) + == (ERTS_PSFLG_ACTIVE + | ERTS_PSFLG_DIRTY_RUNNING + | ERTS_PSFLG_PROXY)); + + sproc->next = c_p; + sproc->common.id = c_p->common.id; + + erts_cache_dirty_shadow_proc(sproc); + + return sproc; +} + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#endif /* ERTS_DIRTY_SCHEDULERS */ + +#endif /* defined(ERTS_WANT_NFUNC_SCHED_INTERNALS__) && !defined(ERTS_NFUNC_SCHED_INTERNALS__) */ + diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 5499512dd1..47b5b23614 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -55,6 +55,9 @@ #include "dtrace-wrapper.h" #include "erl_process.h" #include "erl_bif_unique.h" +#undef ERTS_WANT_NFUNC_SCHED_INTERNALS__ +#define ERTS_WANT_NFUNC_SCHED_INTERNALS__ +#include "erl_nfunc_sched.h" #if defined(USE_DYNAMIC_TRACE) && (defined(USE_DTRACE) || defined(USE_SYSTEMTAP)) #define HAVE_USE_DTRACE 1 #endif @@ -79,8 +82,11 @@ struct erl_module_nif { ErlNifFunc _funcs_copy_[1]; /* only used for old libs */ }; +typedef ERL_NIF_TERM (*NativeFunPtr)(ErlNifEnv*, int, const ERL_NIF_TERM[]); + #ifdef DEBUG # define READONLY_CHECK +# define ERTS_DBG_NIF_NOT_SCHED_MARKER ((void *) (UWord) 1) #endif #ifdef READONLY_CHECK # define ADD_READONLY_CHECK(ENV,PTR,SIZE) add_readonly_check(ENV,PTR,SIZE) @@ -89,6 +95,14 @@ static void add_readonly_check(ErlNifEnv*, unsigned char* ptr, unsigned sz); # define ADD_READONLY_CHECK(ENV,PTR,SIZE) ((void)0) #endif +#ifdef ERTS_NIF_ASSERT_IN_ENV +# define ASSERT_IN_ENV(ENV, TERM, NR, TYPE) dbg_assert_in_env(ENV, TERM, NR, TYPE, __func__) +static void dbg_assert_in_env(ErlNifEnv*, Eterm term, int nr, const char* type, const char* func); +# include "erl_gc.h" +#else +# define ASSERT_IN_ENV(ENV, TERM, NR, TYPE) +#endif + #ifdef DEBUG static int is_offheap(const ErlOffHeap* off_heap); #endif @@ -196,6 +210,9 @@ void erts_pre_nif(ErlNifEnv* env, Process* p, struct erl_module_nif* mod_nif, ASSERT(p->common.id != ERTS_INVALID_PID); +#ifdef ERTS_NIF_ASSERT_IN_ENV + env->dbg_disable_assert_in_env = 0; +#endif #if defined(DEBUG) && defined(ERTS_DIRTY_SCHEDULERS) { ErtsSchedulerData *esdp = erts_get_scheduler_data(); @@ -219,38 +236,6 @@ static void cache_env(ErlNifEnv* env); static void full_flush_env(ErlNifEnv *env); static void flush_env(ErlNifEnv* env); -#ifdef ERTS_DIRTY_SCHEDULERS -void erts_pre_dirty_nif(ErtsSchedulerData *esdp, - ErlNifEnv* env, Process* p, - struct erl_module_nif* mod_nif) -{ - Process *sproc; -#ifdef DEBUG - erts_aint32_t state = erts_smp_atomic32_read_nob(&p->state); - - ASSERT(!p->scheduler_data); - ASSERT((state & ERTS_PSFLG_DIRTY_RUNNING) - && !(state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS))); - ASSERT(esdp); -#endif - - erts_pre_nif(env, p, mod_nif, NULL); - - sproc = esdp->dirty_shadow_process; - ASSERT(sproc); - ASSERT(sproc->static_flags & ERTS_STC_FLG_SHADOW_PROC); - ASSERT(erts_smp_atomic32_read_nob(&sproc->state) - == (ERTS_PSFLG_ACTIVE - | ERTS_PSFLG_DIRTY_RUNNING - | ERTS_PSFLG_PROXY)); - - sproc->next = p; - sproc->common.id = p->common.id; - env->proc = sproc; - full_cache_env(env); -} -#endif - /* Temporary object header, auto-deallocated when NIF returns * or when independent environment is cleared. */ @@ -278,115 +263,154 @@ void erts_post_nif(ErlNifEnv* env) env->exiting = ERTS_PROC_IS_EXITING(env->proc); } -#ifdef ERTS_DIRTY_SCHEDULERS -void erts_post_dirty_nif(ErlNifEnv* env) + +/* + * Initialize a NifExport struct. Create it if needed and store it in the + * proc. The direct_fp function is what will be invoked by op_call_nif, and + * the indirect_fp function, if not NULL, is what the direct_fp function + * will call. If the allocated NifExport isn't enough to hold all of argv, + * allocate a larger one. Save 'current' and registers if first time this + * call is scheduled. + */ + +static ERTS_INLINE ERL_NIF_TERM +schedule(ErlNifEnv* env, NativeFunPtr direct_fp, NativeFunPtr indirect_fp, + Eterm mod, Eterm func_name, int argc, const ERL_NIF_TERM argv[]) { - Process *c_p; - ASSERT(env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC); - ASSERT(env->proc->next); - erts_unblock_fpe(env->fpe_was_unmasked); - full_flush_env(env); - free_tmp_objs(env); - c_p = env->proc->next; - env->exiting = ERTS_PROC_IS_EXITING(c_p); - ERTS_VBUMP_ALL_REDS(c_p); + NifExport *ep; + Process *c_p, *dirty_shadow_proc; + + execution_state(env, &c_p, NULL); + if (c_p == env->proc) + dirty_shadow_proc = NULL; + else + dirty_shadow_proc = env->proc; + + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(c_p)); + + ep = erts_nif_export_schedule(c_p, dirty_shadow_proc, + c_p->current, + c_p->cp, + (BeamInstr) em_call_nif, + direct_fp, indirect_fp, + mod, func_name, + argc, (const Eterm *) argv); + if (!ep->m) { + /* First time this call is scheduled... */ + erts_refc_inc(&env->mod_nif->rt_dtor_cnt, 1); + ep->m = env->mod_nif; + } + return (ERL_NIF_TERM) THE_NON_VALUE; } -#endif -static void full_flush_env(ErlNifEnv* env) -{ #ifdef ERTS_DIRTY_SCHEDULERS - if (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC) { - /* Dirty nif call using shadow process struct */ - Process *c_p = env->proc->next; - - ASSERT(is_scheduler() < 0); - ASSERT(env->proc->common.id == c_p->common.id); - ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) - & ERTS_PROC_LOCK_MAIN); - - if (!env->heap_frag) { - ASSERT(env->hp_end == HEAP_LIMIT(c_p)); - ASSERT(env->hp >= HEAP_TOP(c_p)); - ASSERT(env->hp <= HEAP_LIMIT(c_p)); - HEAP_TOP(c_p) = env->hp; + +static ERL_NIF_TERM dirty_nif_finalizer(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM dirty_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + +int +erts_call_dirty_nif(ErtsSchedulerData *esdp, Process *c_p, BeamInstr *I, Eterm *reg) +{ + int exiting; + ERL_NIF_TERM *argv = (ERL_NIF_TERM *) reg; + NifExport *nep = ERTS_I_BEAM_OP_TO_NIF_EXPORT(I); + ErtsCodeMFA *codemfa = erts_code_to_codemfa(I); + NativeFunPtr dirty_nif = (NativeFunPtr) I[1]; + ErlNifEnv env; + ERL_NIF_TERM result; +#ifdef DEBUG + erts_aint32_t state = erts_smp_atomic32_read_nob(&c_p->state); + + ASSERT(nep == ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p)); + + ASSERT(!c_p->scheduler_data); + ASSERT((state & ERTS_PSFLG_DIRTY_RUNNING) + && !(state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS))); + ASSERT(esdp); + + nep->func = ERTS_DBG_NIF_NOT_SCHED_MARKER; +#endif + + erts_pre_nif(&env, c_p, nep->m, NULL); + + env.proc = erts_make_dirty_shadow_proc(esdp, c_p); + + env.proc->freason = EXC_NULL; + env.proc->fvalue = NIL; + env.proc->ftrace = NIL; + env.proc->i = c_p->i; + + ASSERT(ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(c_p))); + + erts_smp_atomic32_read_band_mb(&c_p->state, ~(ERTS_PSFLG_DIRTY_CPU_PROC + | ERTS_PSFLG_DIRTY_IO_PROC)); + + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); + + result = (*dirty_nif)(&env, codemfa->arity, argv); /* Call dirty NIF */ + + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); + + ASSERT(env.proc->static_flags & ERTS_STC_FLG_SHADOW_PROC); + ASSERT(env.proc->next == c_p); + + exiting = ERTS_PROC_IS_EXITING(c_p); + + if (!exiting) { + if (env.exception_thrown) { + schedule_exception: + schedule(&env, dirty_nif_exception, NULL, + am_erts_internal, am_dirty_nif_exception, + 1, &env.proc->fvalue); + } + else if (is_value(result)) { + schedule(&env, dirty_nif_finalizer, NULL, + am_erts_internal, am_dirty_nif_finalizer, + 1, &result); + } + else if (env.proc->freason != TRAP) { /* user returned garbage... */ + ERTS_DECL_AM(badreturn); + (void) enif_raise_exception(&env, AM_badreturn); + goto schedule_exception; } else { - Uint usz; - ASSERT(env->hp_end != HEAP_LIMIT(c_p)); - ASSERT(env->hp_end - env->hp <= env->heap_frag->alloc_size); - - HEAP_TOP(c_p) = HEAP_TOP(env->proc); - usz = env->hp - env->heap_frag->mem; - env->proc->mbuf_sz += usz - env->heap_frag->used_size; - env->heap_frag->used_size = usz; - - ASSERT(env->heap_frag->used_size <= env->heap_frag->alloc_size); - - if (c_p->mbuf) { - ErlHeapFragment *bp; - for (bp = env->proc->mbuf; bp->next; bp = bp->next) - ; - bp->next = c_p->mbuf; - } + /* Rescheduled by dirty NIF call... */ + ASSERT(nep->func != ERTS_DBG_NIF_NOT_SCHED_MARKER); + } + c_p->i = env.proc->i; + c_p->arity = env.proc->arity; + } - c_p->mbuf = env->proc->mbuf; - c_p->mbuf_sz += env->proc->mbuf_sz; +#ifdef DEBUG + if (nep->func == ERTS_DBG_NIF_NOT_SCHED_MARKER) + nep->func = NULL; +#endif - } + erts_unblock_fpe(env.fpe_was_unmasked); + full_flush_env(&env); + free_tmp_objs(&env); - if (!c_p->off_heap.first) - c_p->off_heap.first = env->proc->off_heap.first; - else if (env->proc->off_heap.first) { - struct erl_off_heap_header *ohhp; - for (ohhp = env->proc->off_heap.first; ohhp->next; ohhp = ohhp->next) - ; - ohhp->next = c_p->off_heap.first; - c_p->off_heap.first = env->proc->off_heap.first; - } - c_p->off_heap.overhead += env->proc->off_heap.overhead; + return exiting; +} - return; - } #endif +static void full_flush_env(ErlNifEnv* env) +{ flush_env(env); +#ifdef ERTS_DIRTY_SCHEDULERS + if (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC) + /* Dirty nif call using shadow process struct */ + erts_flush_dirty_shadow_proc(env->proc); +#endif } static void full_cache_env(ErlNifEnv* env) { #ifdef ERTS_DIRTY_SCHEDULERS - if (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC) { - /* Dirty nif call using shadow process struct */ - Process *sproc = env->proc; - Process *c_p = sproc->next; - ASSERT(c_p); - ASSERT(is_scheduler() < 0); - ASSERT(env->proc->common.id == c_p->common.id); - ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) - & ERTS_PROC_LOCK_MAIN); - - sproc->htop = c_p->htop; - sproc->stop = c_p->stop; - sproc->hend = c_p->hend; - sproc->heap = c_p->heap; - sproc->abandoned_heap = c_p->abandoned_heap; - sproc->heap_sz = c_p->heap_sz; - sproc->high_water = c_p->high_water; - sproc->old_hend = c_p->old_hend; - sproc->old_htop = c_p->old_htop; - sproc->old_heap = c_p->old_heap; - sproc->mbuf = NULL; - sproc->mbuf_sz = 0; - ERTS_INIT_OFF_HEAP(&sproc->off_heap); - - env->hp_end = HEAP_LIMIT(c_p); - env->hp = HEAP_TOP(c_p); - env->heap_frag = NULL; - return; - } + if (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC) + erts_cache_dirty_shadow_proc(env->proc); #endif - cache_env(env); } @@ -474,11 +498,15 @@ setup_nif_env(struct enif_msg_environment_t* msg_env, HEAP_END(&msg_env->phony_proc) = phony_heap; MBUF(&msg_env->phony_proc) = NULL; msg_env->phony_proc.common.id = ERTS_INVALID_PID; + msg_env->env.tracee = tracee; + #ifdef FORCE_HEAP_FRAGS msg_env->phony_proc.space_verified = 0; msg_env->phony_proc.space_verified_from = NULL; #endif - msg_env->env.tracee = tracee; +#ifdef ERTS_NIF_ASSERT_IN_ENV + msg_env->env.dbg_disable_assert_in_env = 0; +#endif } ErlNifEnv* enif_alloc_env(void) @@ -1303,22 +1331,15 @@ Eterm enif_make_badarg(ErlNifEnv* env) Eterm enif_raise_exception(ErlNifEnv* env, ERL_NIF_TERM reason) { - Process *c_p; - - execution_state(env, &c_p, NULL); - env->exception_thrown = 1; - c_p->fvalue = reason; - BIF_ERROR(c_p, EXC_ERROR); + env->proc->fvalue = reason; + BIF_ERROR(env->proc, EXC_ERROR); } int enif_has_pending_exception(ErlNifEnv* env, ERL_NIF_TERM* reason) { - if (env->exception_thrown && reason != NULL) { - Process *c_p; - execution_state(env, &c_p, NULL); - *reason = c_p->fvalue; - } + if (env->exception_thrown && reason != NULL) + *reason = env->proc->fvalue; return env->exception_thrown; } @@ -1586,6 +1607,9 @@ int enif_make_existing_atom_len(ErlNifEnv* env, const char* name, size_t len, ERL_NIF_TERM enif_make_tuple(ErlNifEnv* env, unsigned cnt, ...) { +#ifdef ERTS_NIF_ASSERT_IN_ENV + int nr = 0; +#endif Eterm* hp = alloc_heap(env,cnt+1); Eterm ret = make_tuple(hp); va_list ap; @@ -1593,7 +1617,9 @@ ERL_NIF_TERM enif_make_tuple(ErlNifEnv* env, unsigned cnt, ...) *hp++ = make_arityval(cnt); va_start(ap,cnt); while (cnt--) { - *hp++ = va_arg(ap,Eterm); + Eterm elem = va_arg(ap,Eterm); + ASSERT_IN_ENV(env, elem, ++nr, "tuple"); + *hp++ = elem; } va_end(ap); return ret; @@ -1601,12 +1627,16 @@ ERL_NIF_TERM enif_make_tuple(ErlNifEnv* env, unsigned cnt, ...) ERL_NIF_TERM enif_make_tuple_from_array(ErlNifEnv* env, const ERL_NIF_TERM arr[], unsigned cnt) { +#ifdef ERTS_NIF_ASSERT_IN_ENV + int nr = 0; +#endif Eterm* hp = alloc_heap(env,cnt+1); Eterm ret = make_tuple(hp); const Eterm* src = arr; *hp++ = make_arityval(cnt); while (cnt--) { + ASSERT_IN_ENV(env, *src, ++nr, "tuple"); *hp++ = *src++; } return ret; @@ -1617,6 +1647,8 @@ ERL_NIF_TERM enif_make_list_cell(ErlNifEnv* env, Eterm car, Eterm cdr) Eterm* hp = alloc_heap(env,2); Eterm ret = make_list(hp); + ASSERT_IN_ENV(env, car, 0, "head of list cell"); + ASSERT_IN_ENV(env, cdr, 0, "tail of list cell"); CAR(hp) = car; CDR(hp) = cdr; return ret; @@ -1628,6 +1660,9 @@ ERL_NIF_TERM enif_make_list(ErlNifEnv* env, unsigned cnt, ...) return NIL; } else { +#ifdef ERTS_NIF_ASSERT_IN_ENV + int nr = 0; +#endif Eterm* hp = alloc_heap(env,cnt*2); Eterm ret = make_list(hp); Eterm* last = &ret; @@ -1635,8 +1670,10 @@ ERL_NIF_TERM enif_make_list(ErlNifEnv* env, unsigned cnt, ...) va_start(ap,cnt); while (cnt--) { + Eterm term = va_arg(ap,Eterm); *last = make_list(hp); - *hp = va_arg(ap,Eterm); + ASSERT_IN_ENV(env, term, ++nr, "list"); + *hp = term; last = ++hp; ++hp; } @@ -1648,14 +1685,19 @@ ERL_NIF_TERM enif_make_list(ErlNifEnv* env, unsigned cnt, ...) ERL_NIF_TERM enif_make_list_from_array(ErlNifEnv* env, const ERL_NIF_TERM arr[], unsigned cnt) { +#ifdef ERTS_NIF_ASSERT_IN_ENV + int nr = 0; +#endif Eterm* hp = alloc_heap(env,cnt*2); Eterm ret = make_list(hp); Eterm* last = &ret; const Eterm* src = arr; while (cnt--) { + Eterm term = *src++; *last = make_list(hp); - *hp = *src++; + ASSERT_IN_ENV(env, term, ++nr, "list"); + *hp = term; last = ++hp; ++hp; } @@ -1688,13 +1730,9 @@ void enif_system_info(ErlNifSysInfo *sip, size_t si_size) driver_system_info(sip, si_size); } -int enif_make_reverse_list(ErlNifEnv* env, ERL_NIF_TERM term, ERL_NIF_TERM *list) { - Eterm *listptr, ret = NIL, *hp; - - if (is_nil(term)) { - *list = term; - return 1; - } +int enif_make_reverse_list(ErlNifEnv* env, ERL_NIF_TERM term, ERL_NIF_TERM *list) +{ + Eterm *listptr, ret, *hp; ret = NIL; @@ -2269,188 +2307,28 @@ int enif_consume_timeslice(ErlNifEnv* env, int percent) return ERTS_BIF_REDS_LEFT(proc) == 0; } -/* - * NIF exports need a few more items than the Export struct provides, - * including the erl_module_nif* and a NIF function pointer, so the - * NifExport below adds those. The Export member must be first in the - * struct. The saved_current, exception_thrown, saved_argc, rootset_extra, and - * rootset members are used to track the MFA, any pending exception, and - * arguments of the top NIF in case a chain of one or more - * enif_schedule_nif() calls results in an exception, since in that case - * the original MFA and registers have to be restored before returning to - * Erlang to ensure stacktrace information associated with the exception is - * correct. - */ -typedef ERL_NIF_TERM (*NativeFunPtr)(ErlNifEnv*, int, const ERL_NIF_TERM[]); - -typedef struct { - Export exp; - struct erl_module_nif* m; - NativeFunPtr fp; - ErtsCodeMFA *saved_current; - int exception_thrown; - int saved_argc; - int rootset_extra; - Eterm rootset[1]; -} NifExport; - -/* - * If a process has saved arguments, they need to be part of the GC - * rootset. The function below is called from setup_rootset() in - * erl_gc.c. This function is declared in erl_process.h. Any exception term - * saved in the NifExport is also made part of the GC rootset here; it - * always resides in rootset[0]. - */ -int -erts_setup_nif_gc(Process* proc, Eterm** objv, int* nobj) -{ - NifExport* ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); - int gc = ep && (ep->saved_argc > 0 || ep->rootset[0] != NIL); - - if (gc) { - *objv = ep->rootset; - *nobj = 1 + ep->saved_argc; - } - return gc; -} - -int -erts_check_nif_export_in_area(Process *p, char *start, Uint size) -{ - NifExport *nep = ERTS_PROC_GET_NIF_TRAP_EXPORT(p); - if (!nep || !nep->saved_current) - return 0; - if (ErtsInArea(nep->saved_current, start, size)) - return 1; - return 0; -} - -/* - * Allocate a NifExport and set it in proc specific data - */ -static NifExport* -allocate_nif_sched_data(Process* proc, int argc) -{ - NifExport* ep; - size_t total; - int i; - - total = sizeof(NifExport) + argc*sizeof(Eterm); - ep = erts_alloc(ERTS_ALC_T_NIF_TRAP_EXPORT, total); - sys_memset((void*) ep, 0, total); - ep->rootset_extra = argc; - ep->rootset[0] = NIL; - for (i=0; i<ERTS_NUM_CODE_IX; i++) { - ep->exp.addressv[i] = &ep->exp.beam[0]; - } - ep->exp.beam[0] = (BeamInstr) em_call_nif; - (void) ERTS_PROC_SET_NIF_TRAP_EXPORT(proc, ep); - return ep; -} - static ERTS_INLINE void -destroy_nif_export(NifExport *nif_export) +nif_export_cleanup_nif_mod(NifExport *ep) { - erts_free(ERTS_ALC_T_NIF_TRAP_EXPORT, (void *) nif_export); + if (erts_refc_dectest(&ep->m->rt_dtor_cnt, 0) == 0 && ep->m->mod == NULL) + close_lib(ep->m); + ep->m = NULL; } void -erts_destroy_nif_export(void *nif_export) +erts_nif_export_cleanup_nif_mod(NifExport *ep) { - destroy_nif_export((NifExport *) nif_export); + nif_export_cleanup_nif_mod(ep); } -/* - * Initialize a NifExport struct. Create it if needed and store it in the - * proc. The direct_fp function is what will be invoked by op_call_nif, and - * the indirect_fp function, if not NULL, is what the direct_fp function - * will call. If the allocated NifExport isn't enough to hold all of argv, - * allocate a larger one. Save MFA and registers only if the need_save - * parameter is true. - */ -static ERL_NIF_TERM -init_nif_sched_data(ErlNifEnv* env, NativeFunPtr direct_fp, NativeFunPtr indirect_fp, - int need_save, int argc, const ERL_NIF_TERM argv[]) +static ERTS_INLINE void +nif_export_restore(Process *c_p, NifExport *ep, Eterm res) { - Process* proc; - Eterm* reg; - NifExport* ep; - int i, scheduler; - int orig_argc; - - execution_state(env, &proc, &scheduler); - - ASSERT(scheduler); - - ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(proc) - & ERTS_PROC_LOCK_MAIN); - - reg = erts_proc_sched_data(proc)->x_reg_array; - - ASSERT(!need_save || proc->current); - orig_argc = need_save ? (int) proc->current->arity : 0; - - ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); - if (!ep) - ep = allocate_nif_sched_data(proc, orig_argc); - else if (need_save && ep->rootset_extra < orig_argc) { - NifExport* new_ep = allocate_nif_sched_data(proc, orig_argc); - destroy_nif_export(ep); - ep = new_ep; - } - if (env->exception_thrown) { - ep->exception_thrown = 1; - ep->rootset[0] = proc->fvalue; - } else { - ep->exception_thrown = 0; - ep->rootset[0] = NIL; - } - if (scheduler > 0) - ERTS_VBUMP_ALL_REDS(proc); - if (need_save) { - ep->saved_current = proc->current; - ep->saved_argc = orig_argc; - for (i = 0; i < orig_argc; i++) - ep->rootset[i+1] = reg[i]; - } - for (i = 0; i < argc; i++) - reg[i] = (Eterm) argv[i]; - proc->i = (BeamInstr*) ep->exp.addressv[0]; - ep->exp.info.mfa.module = proc->current->module; - ep->exp.info.mfa.function = proc->current->function; - ep->exp.info.mfa.arity = argc; - ep->exp.beam[1] = (BeamInstr) direct_fp; - ep->m = env->mod_nif; - ep->fp = indirect_fp; - proc->freason = TRAP; - proc->arity = argc; - return THE_NON_VALUE; + erts_nif_export_restore(c_p, ep, res); + ASSERT(ep->m); + nif_export_cleanup_nif_mod(ep); } -/* - * Restore saved MFA and registers. Registers are restored only when the - * exception flag is true. - */ -static void -restore_nif_mfa(Process* proc, NifExport* ep, int exception) -{ - int i; - - ERTS_SMP_LC_ASSERT(!(proc->static_flags - & ERTS_STC_FLG_SHADOW_PROC)); - ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(proc) - & ERTS_PROC_LOCK_MAIN); - - ASSERT(ep->saved_current != &ep->exp.info.mfa); - proc->current = ep->saved_current; - ep->saved_current = NULL; - if (exception) { - Eterm* reg = erts_proc_sched_data(proc)->x_reg_array; - for (i = 0; i < ep->saved_argc; i++) - reg[i] = ep->rootset[i+1]; - } - ep->saved_argc = 0; -} #ifdef ERTS_DIRTY_SCHEDULERS @@ -2459,7 +2337,7 @@ restore_nif_mfa(Process* proc, NifExport* ep, int exception) * switch the process off a dirty scheduler thread and back onto a regular * scheduler thread, and then return the result from the dirty NIF. It also * restores the original NIF MFA when necessary based on the value of - * ep->fp set by execute_dirty_nif via init_nif_sched_data -- non-NULL + * ep->func set by execute_dirty_nif via init_nif_sched_data -- non-NULL * means restore, NULL means do not restore. */ static ERL_NIF_TERM @@ -2474,9 +2352,7 @@ dirty_nif_finalizer(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(proc))); ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); ASSERT(ep); - ASSERT(!ep->exception_thrown); - if (ep->fp) - restore_nif_mfa(proc, ep, 0); + nif_export_restore(proc, ep, argv[0]); return argv[0]; } @@ -2486,148 +2362,100 @@ dirty_nif_finalizer(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) static ERL_NIF_TERM dirty_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { + ERL_NIF_TERM ret; Process* proc; NifExport* ep; + Eterm exception; execution_state(env, &proc, NULL); + ASSERT(argc == 1); ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(proc))); ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); ASSERT(ep); - ASSERT(ep->exception_thrown); - if (ep->fp) - restore_nif_mfa(proc, ep, 1); - return enif_raise_exception(env, ep->rootset[0]); + exception = argv[0]; /* argv overwritten by restore below... */ + nif_export_cleanup_nif_mod(ep); + ret = enif_raise_exception(env, exception); + + /* Restore orig info for error and clear nif export in handle_error() */ + proc->freason |= EXF_RESTORE_NIF; + return ret; } /* - * Dirty NIF execution wrapper function. Invoke an application's dirty NIF, - * then check the result and schedule the appropriate finalizer function - * where needed. Also restore the original NIF MFA when appropriate. + * Dirty NIF scheduling wrapper function. Schedule a dirty NIF to execute. + * The dirty scheduler thread type (CPU or I/O) is indicated in flags + * parameter. */ -static ERL_NIF_TERM -execute_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERTS_INLINE ERL_NIF_TERM +schedule_dirty_nif(ErlNifEnv* env, int flags, NativeFunPtr fp, + Eterm func_name, int argc, const ERL_NIF_TERM argv[]) { Process* proc; - NativeFunPtr fp; - NifExport* ep; - ERL_NIF_TERM result; - - execution_state(env, &proc, NULL); - ep = ErtsContainerStruct(proc->current, NifExport, exp.info.mfa); - fp = ep->fp; - - ASSERT(ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(proc))); - - /* - * Set ep->fp to NULL before the native call so we know later whether it scheduled another NIF for execution - */ - ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); - ASSERT(ep && fp); - - ep->fp = NULL; - erts_smp_atomic32_read_band_mb(&proc->state, ~(ERTS_PSFLG_DIRTY_CPU_PROC - | ERTS_PSFLG_DIRTY_IO_PROC)); + ASSERT(is_atom(func_name)); + ASSERT(fp); - erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN); + ASSERT(flags==ERL_NIF_DIRTY_JOB_IO_BOUND || flags==ERL_NIF_DIRTY_JOB_CPU_BOUND); - result = (*fp)(env, argc, argv); + execution_state(env, &proc, NULL); - erts_smp_proc_lock(proc, ERTS_PROC_LOCK_MAIN); + (void) erts_smp_atomic32_read_bset_nob(&proc->state, + (ERTS_PSFLG_DIRTY_CPU_PROC + | ERTS_PSFLG_DIRTY_IO_PROC), + (flags == ERL_NIF_DIRTY_JOB_CPU_BOUND + ? ERTS_PSFLG_DIRTY_CPU_PROC + : ERTS_PSFLG_DIRTY_IO_PROC)); - if (erts_refc_dectest(&env->mod_nif->rt_dtor_cnt, 0) == 0 && env->mod_nif->mod == NULL) - close_lib(env->mod_nif); - /* - * If no more NIFs were scheduled by the native call via - * enif_schedule_nif(), then ep->fp will still be NULL as set above, in - * which case we need to restore the original NIF calling - * context. Reuse fp essentially as a boolean for this, passing it to - * init_nif_sched_data below. Both dirty_nif_exception and - * dirty_nif_finalizer then check ep->fp to decide whether or not to - * restore the original calling context. - */ - ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); - ASSERT(ep); - if (ep->fp) - fp = NULL; - if (is_non_value(result) || env->exception_thrown) { - if (proc->freason != TRAP) { - return init_nif_sched_data(env, dirty_nif_exception, fp, 0, argc, argv); - } else { - if (ep->fp == NULL) - restore_nif_mfa(proc, ep, 1); - return THE_NON_VALUE; - } - } - else - return init_nif_sched_data(env, dirty_nif_finalizer, fp, 0, 1, &result); + return schedule(env, fp, NULL, proc->current->module, func_name, argc, argv); } -/* - * Dirty NIF scheduling wrapper function. Schedule a dirty NIF to execute - * via the execute_dirty_nif() wrapper function. The dirty scheduler thread - * type (CPU or I/O) is indicated in flags parameter. - */ static ERTS_INLINE ERL_NIF_TERM -schedule_dirty_nif(ErlNifEnv* env, int flags, int argc, const ERL_NIF_TERM argv[]) +static_schedule_dirty_nif(ErlNifEnv* env, erts_aint32_t dirty_psflg, + int argc, const ERL_NIF_TERM argv[]) { - ERL_NIF_TERM result; - erts_aint32_t act, dirty_flag; - Process* proc; + Process *proc; + NifExport *ep; + Eterm mod, func; NativeFunPtr fp; - NifExport* ep; - int need_save, scheduler; - execution_state(env, &proc, &scheduler); - if (scheduler <= 0) { - ASSERT(scheduler < 0); - erts_smp_proc_lock(proc, ERTS_PROC_LOCK_MAIN); - } + execution_state(env, &proc, NULL); + + /* + * Called in order to schedule statically determined + * dirty NIF calls... + * + * Note that 'current' does not point into a NifExport + * structure; only a structure with similar + * parts (located in code). + */ ep = ErtsContainerStruct(proc->current, NifExport, exp.info.mfa); - fp = ep->fp; + mod = proc->current->module; + func = proc->current->function; + fp = (NativeFunPtr) ep->func; + ASSERT(is_atom(mod) && is_atom(func)); ASSERT(fp); - ASSERT(flags==ERL_NIF_DIRTY_JOB_IO_BOUND || flags==ERL_NIF_DIRTY_JOB_CPU_BOUND); - - if (flags == ERL_NIF_DIRTY_JOB_CPU_BOUND) - dirty_flag = ERTS_PSFLG_DIRTY_CPU_PROC; - else - dirty_flag = ERTS_PSFLG_DIRTY_IO_PROC; + (void) erts_smp_atomic32_read_bset_nob(&proc->state, + (ERTS_PSFLG_DIRTY_CPU_PROC + | ERTS_PSFLG_DIRTY_IO_PROC), + dirty_psflg); - act = erts_smp_atomic32_read_bor_nob(&proc->state, dirty_flag); - if (!(act & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC))) - erts_refc_inc(&env->mod_nif->rt_dtor_cnt, 1); - else if ((act & (ERTS_PSFLG_DIRTY_CPU_PROC - | ERTS_PSFLG_DIRTY_IO_PROC)) & ~dirty_flag) { - /* clear other flag... */ - if (flags == ERL_NIF_DIRTY_JOB_CPU_BOUND) - dirty_flag = ERTS_PSFLG_DIRTY_IO_PROC; - else - dirty_flag = ERTS_PSFLG_DIRTY_CPU_PROC; - erts_smp_atomic32_read_band_nob(&proc->state, ~dirty_flag); - } - - ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); - need_save = (ep == NULL || !ep->saved_current); - result = init_nif_sched_data(env, execute_dirty_nif, fp, need_save, argc, argv); - if (scheduler <= 0) - erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN); - return result; + return schedule(env, fp, NULL, mod, func, argc, argv); } static ERL_NIF_TERM -schedule_dirty_io_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static_schedule_dirty_io_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - return schedule_dirty_nif(env, ERL_NIF_DIRTY_JOB_IO_BOUND, argc, argv); + return static_schedule_dirty_nif(env, ERTS_PSFLG_DIRTY_IO_PROC, argc, argv); } static ERL_NIF_TERM -schedule_dirty_cpu_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static_schedule_dirty_cpu_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - return schedule_dirty_nif(env, ERL_NIF_DIRTY_JOB_CPU_BOUND, argc, argv); + return static_schedule_dirty_nif(env, ERTS_PSFLG_DIRTY_CPU_PROC, argc, argv); } #endif /* ERTS_DIRTY_SCHEDULERS */ @@ -2646,23 +2474,42 @@ execute_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) ERL_NIF_TERM result; execution_state(env, &proc, NULL); - ep = ErtsContainerStruct(proc->current, NifExport, exp.info.mfa); - fp = ep->fp; - ASSERT(!env->exception_thrown); - ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + ep = ErtsContainerStruct(proc->current, NifExport, exp.info.mfa); + fp = ep->func; ASSERT(ep); - ep->fp = NULL; + ASSERT(!env->exception_thrown); + + fp = (NativeFunPtr) ep->func; + +#ifdef DEBUG + ep->func = ERTS_DBG_NIF_NOT_SCHED_MARKER; +#endif + result = (*fp)(env, argc, argv); - ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); - ASSERT(ep); - /* - * If no NIFs were scheduled by the native call via - * enif_schedule_nif(), then ep->fp will still be NULL as set above, in - * which case we need to restore the original NIF MFA. - */ - if (ep->fp == NULL) - restore_nif_mfa(proc, ep, env->exception_thrown); + + ASSERT(ep == ERTS_PROC_GET_NIF_TRAP_EXPORT(proc)); + + if (is_value(result) || proc->freason != TRAP) { + /* Done (not rescheduled)... */ + ASSERT(ep->func == ERTS_DBG_NIF_NOT_SCHED_MARKER); + if (!env->exception_thrown) + nif_export_restore(proc, ep, result); + else { + nif_export_cleanup_nif_mod(ep); + /* + * Restore orig info for error and clear nif + * export in handle_error() + */ + proc->freason |= EXF_RESTORE_NIF; + } + } + +#ifdef DEBUG + if (ep->func == ERTS_DBG_NIF_NOT_SCHED_MARKER) + ep->func = NULL; +#endif + return result; } @@ -2672,9 +2519,8 @@ enif_schedule_nif(ErlNifEnv* env, const char* fun_name, int flags, int argc, const ERL_NIF_TERM argv[]) { Process* proc; - NifExport* ep; ERL_NIF_TERM fun_name_atom, result; - int need_save, scheduler; + int scheduler; if (argc > MAX_ARG) return enif_make_badarg(env); @@ -2689,35 +2535,16 @@ enif_schedule_nif(ErlNifEnv* env, const char* fun_name, int flags, erts_smp_proc_lock(proc, ERTS_PROC_LOCK_MAIN); } - ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); - need_save = (ep == NULL || !ep->saved_current); - - if (flags) { + if (flags == 0) + result = schedule(env, execute_nif, fp, proc->current->module, + fun_name_atom, argc, argv); #ifdef ERTS_DIRTY_SCHEDULERS - NativeFunPtr sched_fun; - int chkflgs = (flags & (ERL_NIF_DIRTY_JOB_IO_BOUND|ERL_NIF_DIRTY_JOB_CPU_BOUND)); - if (chkflgs == ERL_NIF_DIRTY_JOB_IO_BOUND) - sched_fun = schedule_dirty_io_nif; - else if (chkflgs == ERL_NIF_DIRTY_JOB_CPU_BOUND) - sched_fun = schedule_dirty_cpu_nif; - else { - result = enif_make_badarg(env); - goto done; - } - result = init_nif_sched_data(env, sched_fun, fp, need_save, argc, argv); -#else - result = enif_make_badarg(env); + else if (!(flags & ~(ERL_NIF_DIRTY_JOB_IO_BOUND|ERL_NIF_DIRTY_JOB_CPU_BOUND))) + result = schedule_dirty_nif(env, flags, fp, fun_name_atom, argc, argv); #endif - goto done; - } else - result = init_nif_sched_data(env, execute_nif, fp, need_save, argc, argv); - - ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); - ASSERT(ep); - ep->exp.info.mfa.function = (BeamInstr) fun_name_atom; + result = enif_make_badarg(env); -done: if (scheduler < 0) erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN); @@ -2789,6 +2616,10 @@ int enif_make_map_put(ErlNifEnv* env, if (!is_map(map_in)) { return 0; } + ASSERT_IN_ENV(env, map_in, 0, "old map"); + ASSERT_IN_ENV(env, key, 0, "key"); + ASSERT_IN_ENV(env, value, 0, "value"); + flush_env(env); *map_out = erts_maps_put(env->proc, key, value, map_in); cache_env(env); @@ -2823,6 +2654,10 @@ int enif_make_map_update(ErlNifEnv* env, return 0; } + ASSERT_IN_ENV(env, map_in, 0, "old map"); + ASSERT_IN_ENV(env, key, 0, "key"); + ASSERT_IN_ENV(env, value, 0, "value"); + flush_env(env); res = erts_maps_update(env->proc, key, value, map_in, map_out); cache_env(env); @@ -3416,8 +3251,8 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) if (f->flags) { code_ptr[3] = (BeamInstr) f->fptr; code_ptr[1] = (f->flags == ERL_NIF_DIRTY_JOB_IO_BOUND) ? - (BeamInstr) schedule_dirty_io_nif : - (BeamInstr) schedule_dirty_cpu_nif; + (BeamInstr) static_schedule_dirty_io_nif : + (BeamInstr) static_schedule_dirty_cpu_nif; } else #endif @@ -3528,8 +3363,8 @@ Eterm erts_nif_call_function(Process *p, Process *tracee, #endif if (p) { /* This is almost a normal nif call like in beam_emu, - except that any heap fragment created in the nif will be - discarded without checking if anything in it is live. + except that any heap consumed by the nif will be + released without checking if anything in it is live. This is because we cannot do a GC here as we don't know the number of live registers that have to be preserved. This means that any heap part of the returned term may @@ -3543,6 +3378,9 @@ Eterm erts_nif_call_function(Process *p, Process *tracee, clear_offheap(&MSO(p)); erts_pre_nif(&env, p, mod, tracee); +#ifdef ERTS_NIF_ASSERT_IN_ENV + env.dbg_disable_assert_in_env = 1; +#endif nif_result = (*fun->fptr)(&env, argc, argv); if (env.exception_thrown) nif_result = THE_NON_VALUE; @@ -3565,6 +3403,9 @@ Eterm erts_nif_call_function(Process *p, Process *tracee, so we create a phony one. */ struct enif_msg_environment_t msg_env; pre_nif_noproc(&msg_env, mod, tracee); +#ifdef ERTS_NIF_ASSERT_IN_ENV + msg_env.env.dbg_disable_assert_in_env = 1; +#endif nif_result = (*fun->fptr)(&msg_env.env, argc, argv); if (msg_env.env.exception_thrown) nif_result = THE_NON_VALUE; @@ -3629,6 +3470,55 @@ static unsigned calc_checksum(unsigned char* ptr, unsigned size) #endif /* READONLY_CHECK */ +#ifdef ERTS_NIF_ASSERT_IN_ENV +static void dbg_assert_in_env(ErlNifEnv* env, Eterm term, + int nr, const char* type, const char* func) +{ + Uint saved_used_size; + Eterm* real_htop; + + if (is_immed(term) + || (is_non_value(term) && env->exception_thrown) + || erts_is_literal(term, ptr_val(term))) + return; + + if (env->dbg_disable_assert_in_env) { + /* + * Trace nifs may cheat as built terms are discarded after return. + * ToDo: Check if 'term' is part of argv[]. + */ + return; + } + + if (env->heap_frag) { + ASSERT(env->heap_frag == MBUF(env->proc)); + ASSERT(env->hp >= env->heap_frag->mem); + ASSERT(env->hp <= env->heap_frag->mem + env->heap_frag->alloc_size); + saved_used_size = env->heap_frag->used_size; + env->heap_frag->used_size = env->hp - env->heap_frag->mem; + real_htop = NULL; + } + else { + real_htop = env->hp; + } + if (!erts_dbg_within_proc(ptr_val(term), env->proc, real_htop)) { + fprintf(stderr, "\r\nFAILED ASSERTION in %s:\r\n", func); + if (nr) { + fprintf(stderr, "Term #%d of the %s is not from same ErlNifEnv.", + nr, type); + } + else { + fprintf(stderr, "The %s is not from the same ErlNifEnv.", type); + } + fprintf(stderr, "\r\nABORTING\r\n"); + abort(); + } + if (env->heap_frag) { + env->heap_frag->used_size = saved_used_size; + } +} +#endif + #ifdef HAVE_USE_DTRACE #define MESSAGE_BUFSIZ 1024 diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c index 3102e44c11..4836b9e2d3 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -936,7 +936,7 @@ enqueue_port(ErtsRunQueue *runq, Port *pp) erts_smp_inc_runq_len(runq, &runq->ports.info, ERTS_PORT_PRIO_LEVEL); #ifdef ERTS_SMP - if (runq->halt_in_progress) + if (ERTS_RUNQ_FLGS_GET_NOB(runq) & ERTS_RUNQ_FLG_HALTING) erts_non_empty_runq(runq); #endif } diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 4fb0f9e975..f80ebdf31b 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -48,6 +48,7 @@ #include "erl_bif_unique.h" #define ERTS_WANT_TIMER_WHEEL_API #include "erl_time.h" +#include "erl_nfunc_sched.h" #define ERTS_CHECK_TIME_REDS CONTEXT_REDS #define ERTS_DELAYED_WAKEUP_INFINITY (~(Uint64) 0) @@ -106,9 +107,31 @@ #define LOW_BIT (1 << PRIORITY_LOW) #define PORT_BIT (1 << ERTS_PORT_PRIO_LEVEL) -#define ERTS_EMPTY_RUNQ(RQ) \ - ((ERTS_RUNQ_FLGS_GET_NOB((RQ)) & ERTS_RUNQ_FLGS_QMASK) == 0 \ - && (RQ)->misc.start == NULL) +#define ERTS_IS_RUNQ_EMPTY_FLGS(FLGS) \ + (!((FLGS) & (ERTS_RUNQ_FLGS_QMASK|ERTS_RUNQ_FLG_MISC_OP))) + +#define ERTS_IS_RUNQ_EMPTY_PORTS_FLGS(FLGS) \ + (!((FLGS) & (PORT_BIT|ERTS_RUNQ_FLG_MISC_OP))) + +#define ERTS_EMPTY_RUNQ(RQ) \ + ERTS_IS_RUNQ_EMPTY_FLGS(ERTS_RUNQ_FLGS_GET_NOB((RQ))) + +#define ERTS_EMPTY_RUNQ_PORTS(RQ) \ + ERTS_IS_RUNQ_EMPTY_FLGS(ERTS_RUNQ_FLGS_GET_NOB((RQ))) + +static ERTS_INLINE int +runq_got_work_to_execute_flags(Uint32 flags) +{ + if (flags & ERTS_RUNQ_FLG_HALTING) + return !ERTS_IS_RUNQ_EMPTY_PORTS_FLGS(flags); + return !ERTS_IS_RUNQ_EMPTY_FLGS(flags); +} + +static ERTS_INLINE int +runq_got_work_to_execute(ErtsRunQueue *rq) +{ + return runq_got_work_to_execute_flags(ERTS_RUNQ_FLGS_GET_NOB(rq)); +} #undef RUNQ_READ_RQ #undef RUNQ_SET_RQ @@ -140,9 +163,6 @@ do { \ # define ERTS_DBG_VERIFY_VALID_RUNQP(RQP) #endif -#define ERTS_EMPTY_RUNQ_PORTS(RQ) \ - (RUNQ_READ_LEN(&(RQ)->ports.info.len) == 0 && (RQ)->misc.start == NULL) - const Process erts_invalid_process = {{ERTS_INVALID_PID}}; extern BeamInstr beam_apply[]; @@ -193,170 +213,145 @@ static ErtsAuxWorkData *aux_thread_aux_work_data; #define ERTS_SCHDLR_SSPND_CHNG_ONLN (((erts_aint32_t) 1) << 2) #define ERTS_SCHDLR_SSPND_CHNG_DCPU_ONLN (((erts_aint32_t) 1) << 3) -typedef enum { - ERTS_SCHED_NORMAL, - ERTS_SCHED_DIRTY_CPU, - ERTS_SCHED_DIRTY_IO -} ErtsSchedType; - typedef struct { int ongoing; ErtsProcList *blckrs; ErtsProcList *chngq; } ErtsMultiSchedulingBlock; +typedef struct { + Uint32 normal; +#ifdef ERTS_DIRTY_SCHEDULERS + Uint32 dirty_cpu; + Uint32 dirty_io; +#endif +} ErtsSchedTypeCounters; + static struct { erts_smp_mtx_t mtx; - Uint32 online; - Uint32 curr_online; - Uint32 active; + ErtsSchedTypeCounters online; + ErtsSchedTypeCounters curr_online; + ErtsSchedTypeCounters active; erts_smp_atomic32_t changing; ErtsProcList *chngq; Eterm changer; ErtsMultiSchedulingBlock nmsb; /* Normal multi Scheduling Block */ ErtsMultiSchedulingBlock msb; /* Multi Scheduling Block */ +#ifdef ERTS_DIRTY_SCHEDULERS + ErtsSchedType last_msb_dirty_type; +#endif } schdlr_sspnd; -#define ERTS_SCHDLR_SSPND_S_BITS 10 -#define ERTS_SCHDLR_SSPND_DCS_BITS 11 -#define ERTS_SCHDLR_SSPND_DIS_BITS 11 - -#define ERTS_SCHDLR_SSPND_S_MASK ((1 << ERTS_SCHDLR_SSPND_S_BITS)-1) -#define ERTS_SCHDLR_SSPND_DCS_MASK ((1 << ERTS_SCHDLR_SSPND_DCS_BITS)-1) -#define ERTS_SCHDLR_SSPND_DIS_MASK ((1 << ERTS_SCHDLR_SSPND_DIS_BITS)-1) - -#define ERTS_SCHDLR_SSPND_S_SHIFT 0 -#define ERTS_SCHDLR_SSPND_DCS_SHIFT (ERTS_SCHDLR_SSPND_S_SHIFT \ - + ERTS_SCHDLR_SSPND_S_BITS) -#define ERTS_SCHDLR_SSPND_DIS_SHIFT (ERTS_SCHDLR_SSPND_DCS_SHIFT \ - + ERTS_SCHDLR_SSPND_DCS_BITS) - -#if (ERTS_SCHDLR_SSPND_S_BITS \ - + ERTS_SCHDLR_SSPND_DCS_BITS \ - + ERTS_SCHDLR_SSPND_DIS_BITS) > 32 -# error Wont fit in Uint32 -#endif +static void init_scheduler_suspend(void); -#if (ERTS_MAX_NO_OF_SCHEDULERS-1) > ERTS_SCHDLR_SSPND_S_MASK -# error Max no schedulers wont fit in its bit-field -#endif -#if ERTS_MAX_NO_OF_DIRTY_CPU_SCHEDULERS > ERTS_SCHDLR_SSPND_DCS_MASK -# error Max no dirty cpu schedulers wont fit in its bit-field -#endif -#if ERTS_MAX_NO_OF_DIRTY_IO_SCHEDULERS > ERTS_SCHDLR_SSPND_DIS_MASK -# error Max no dirty io schedulers wont fit in its bit-field +static ERTS_INLINE Uint32 +schdlr_sspnd_eq_nscheds(ErtsSchedTypeCounters *val1p, ErtsSchedTypeCounters *val2p) +{ + int res = val1p->normal == val2p->normal; +#ifdef ERTS_DIRTY_SCHEDULERS + res &= val1p->dirty_cpu == val2p->dirty_cpu; + res &= val1p->dirty_io == val2p->dirty_io; #endif - -#define ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(S, DCS, DIS) \ - ((((Uint32) (((S) & ERTS_SCHDLR_SSPND_S_MASK))-1) \ - << ERTS_SCHDLR_SSPND_S_SHIFT) \ - | ((((Uint32) ((DCS) & ERTS_SCHDLR_SSPND_DCS_MASK)) \ - << ERTS_SCHDLR_SSPND_DCS_SHIFT)) \ - | ((((Uint32) ((DIS) & ERTS_SCHDLR_SSPND_DIS_MASK)) \ - << ERTS_SCHDLR_SSPND_DIS_SHIFT))) - -static void init_scheduler_suspend(void); + return res; +} static ERTS_INLINE Uint32 -schdlr_sspnd_get_nscheds(Uint32 *valp, ErtsSchedType type) +schdlr_sspnd_get_nscheds(ErtsSchedTypeCounters *valp, + ErtsSchedType type) { - Uint32 res = (Uint32) (*valp); switch (type) { case ERTS_SCHED_NORMAL: - res >>= ERTS_SCHDLR_SSPND_S_SHIFT; - res &= (Uint32) ERTS_SCHDLR_SSPND_S_MASK; - res++; - break; + return valp->normal; +#ifdef ERTS_DIRTY_SCHEDULERS case ERTS_SCHED_DIRTY_CPU: - res >>= ERTS_SCHDLR_SSPND_DCS_SHIFT; - res &= (Uint32) ERTS_SCHDLR_SSPND_DCS_MASK; - break; + return valp->dirty_cpu; case ERTS_SCHED_DIRTY_IO: - res >>= ERTS_SCHDLR_SSPND_DIS_SHIFT; - res &= (Uint32) ERTS_SCHDLR_SSPND_DIS_MASK; - break; + return valp->dirty_io; +#else + case ERTS_SCHED_DIRTY_CPU: + case ERTS_SCHED_DIRTY_IO: + return 0; +#endif default: ERTS_INTERNAL_ERROR("Invalid scheduler type"); return 0; } +} +static ERTS_INLINE Uint32 +schdlr_sspnd_get_nscheds_tot(ErtsSchedTypeCounters *valp) +{ + Uint32 res = valp->normal; +#ifdef ERTS_DIRTY_SCHEDULERS + res += valp->dirty_cpu; + res += valp->dirty_io; +#endif return res; } static ERTS_INLINE void -schdlr_sspnd_dec_nscheds(Uint32 *valp, ErtsSchedType type) +schdlr_sspnd_dec_nscheds(ErtsSchedTypeCounters *valp, + ErtsSchedType type) { ASSERT(schdlr_sspnd_get_nscheds(valp, type) > 0); switch (type) { case ERTS_SCHED_NORMAL: - *valp -= ((Uint32) 1) << ERTS_SCHDLR_SSPND_S_SHIFT; + valp->normal--; break; +#ifdef ERTS_DIRTY_SCHEDULERS case ERTS_SCHED_DIRTY_CPU: - *valp -= ((Uint32) 1) << ERTS_SCHDLR_SSPND_DCS_SHIFT; + valp->dirty_cpu--; break; case ERTS_SCHED_DIRTY_IO: - *valp -= ((Uint32) 1) << ERTS_SCHDLR_SSPND_DIS_SHIFT; + valp->dirty_io--; break; +#endif default: ERTS_INTERNAL_ERROR("Invalid scheduler type"); } } static ERTS_INLINE void -schdlr_sspnd_inc_nscheds(Uint32 *valp, ErtsSchedType type) +schdlr_sspnd_inc_nscheds(ErtsSchedTypeCounters *valp, + ErtsSchedType type) { switch (type) { case ERTS_SCHED_NORMAL: - ASSERT(schdlr_sspnd_get_nscheds(valp, type) - < ERTS_MAX_NO_OF_SCHEDULERS-1); - *valp += ((Uint32) 1) << ERTS_SCHDLR_SSPND_S_SHIFT; + valp->normal++; break; +#ifdef ERTS_DIRTY_SCHEDULERS case ERTS_SCHED_DIRTY_CPU: - ASSERT(schdlr_sspnd_get_nscheds(valp, type) - < ERTS_MAX_NO_OF_DIRTY_CPU_SCHEDULERS); - *valp += ((Uint32) 1) << ERTS_SCHDLR_SSPND_DCS_SHIFT; + valp->dirty_cpu++; break; case ERTS_SCHED_DIRTY_IO: - ASSERT(schdlr_sspnd_get_nscheds(valp, type) - < ERTS_MAX_NO_OF_DIRTY_IO_SCHEDULERS); - *valp += ((Uint32) 1) << ERTS_SCHDLR_SSPND_DIS_SHIFT; + valp->dirty_io++; break; +#endif default: ERTS_INTERNAL_ERROR("Invalid scheduler type"); } } static ERTS_INLINE void -schdlr_sspnd_set_nscheds(Uint32 *valp, ErtsSchedType type, Uint32 no) +schdlr_sspnd_set_nscheds(ErtsSchedTypeCounters *valp, + ErtsSchedType type, Uint32 no) { - Uint32 val = *valp; - switch (type) { case ERTS_SCHED_NORMAL: - ASSERT(no > 0); - val &= ~(((Uint32) ERTS_SCHDLR_SSPND_S_MASK) - << ERTS_SCHDLR_SSPND_S_SHIFT); - val |= (((no-1) & ((Uint32) ERTS_SCHDLR_SSPND_S_MASK)) - << ERTS_SCHDLR_SSPND_S_SHIFT); + valp->normal = no; break; +#ifdef ERTS_DIRTY_SCHEDULERS case ERTS_SCHED_DIRTY_CPU: - val &= ~(((Uint32) ERTS_SCHDLR_SSPND_DCS_MASK) - << ERTS_SCHDLR_SSPND_DCS_SHIFT); - val |= ((no & ((Uint32) ERTS_SCHDLR_SSPND_DCS_MASK)) - << ERTS_SCHDLR_SSPND_DCS_SHIFT); + valp->dirty_cpu = no; break; case ERTS_SCHED_DIRTY_IO: - val &= ~(((Uint32) ERTS_SCHDLR_SSPND_DIS_MASK) - << ERTS_SCHDLR_SSPND_DIS_SHIFT); - val |= ((no & ((Uint32) ERTS_SCHDLR_SSPND_DIS_MASK)) - << ERTS_SCHDLR_SSPND_DIS_SHIFT); + valp->dirty_io = no; break; +#endif default: ERTS_INTERNAL_ERROR("Invalid scheduler type"); } - - *valp = val; } static struct { @@ -809,15 +804,28 @@ erts_late_init_process(void) } +#define ERTS_SCHED_WTIME_IDLE ~((Uint64) 0) + static void -init_sched_wall_time(ErtsSchedWallTime *swtp) +init_sched_wall_time(ErtsSchedulerData *esdp, Uint64 time_stamp) { - swtp->need = erts_sched_balance_util; - swtp->enabled = 0; - swtp->start = 0; - swtp->working.total = 0; - swtp->working.start = 0; - swtp->working.currently = 0; +#ifdef ERTS_DIRTY_SCHEDULERS + if (esdp->type != ERTS_SCHED_NORMAL) { + erts_atomic32_init_nob(&esdp->sched_wall_time.u.mod, 0); + esdp->sched_wall_time.enabled = 1; + esdp->sched_wall_time.start = time_stamp; + esdp->sched_wall_time.working.total = 0; + esdp->sched_wall_time.working.start = ERTS_SCHED_WTIME_IDLE; + } + else +#endif + { + esdp->sched_wall_time.u.need = erts_sched_balance_util; + esdp->sched_wall_time.enabled = 0; + esdp->sched_wall_time.start = 0; + esdp->sched_wall_time.working.total = 0; + esdp->sched_wall_time.working.start = 0; + } } static ERTS_INLINE Uint64 @@ -1008,31 +1016,145 @@ init_runq_sched_util(ErtsRunQueueSchedUtil *rqsu, int enabled) #endif /* ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT */ -static ERTS_INLINE void +#ifdef ERTS_DIRTY_SCHEDULERS + +typedef struct { + Uint64 working; + Uint64 total; +} ErtsDirtySchedWallTime; + +static void +read_dirty_sched_wall_time(ErtsSchedulerData *esdp, ErtsDirtySchedWallTime *info) +{ + erts_aint32_t mod1; + Uint64 working, start, ts; + + mod1 = erts_atomic32_read_nob(&esdp->sched_wall_time.u.mod); + + while (1) { + erts_aint32_t mod2; + + /* Spin until values are not written... */ + while (1) { + if ((mod1 & 1) == 0) + break; + ERTS_SPIN_BODY; + mod1 = erts_atomic32_read_nob(&esdp->sched_wall_time.u.mod); + } + + ERTS_THR_READ_MEMORY_BARRIER; + + working = esdp->sched_wall_time.working.total; + start = esdp->sched_wall_time.working.start; + + ERTS_THR_READ_MEMORY_BARRIER; + + mod2 = erts_atomic32_read_nob(&esdp->sched_wall_time.u.mod); + if (mod1 == mod2) + break; + mod1 = mod2; + } + + ts = sched_wall_time_ts(); + ts -= esdp->sched_wall_time.start; + + info->total = ts; + + if (start == ERTS_SCHED_WTIME_IDLE || ts < start) + info->working = working; + else + info->working = working + (ts - start); + + if (info->working > info->total) + info->working = info->total; +} + +#endif + +#ifdef ERTS_SMP + +static void +dirty_sched_wall_time_change(ErtsSchedulerData *esdp, int working) +{ + erts_aint32_t mod; + Uint64 ts = sched_wall_time_ts(); + + ts -= esdp->sched_wall_time.start; + + /* + * This thread is the only thread writing in + * this sched_wall_time struct. We set 'mod' to + * an odd value while writing... + */ + mod = erts_atomic32_read_dirty(&esdp->sched_wall_time.u.mod); + ASSERT((mod & 1) == 0); + mod++; + + erts_atomic32_set_nob(&esdp->sched_wall_time.u.mod, mod); + ERTS_THR_WRITE_MEMORY_BARRIER; + + if (working) { + ASSERT(esdp->sched_wall_time.working.start + == ERTS_SCHED_WTIME_IDLE); + + esdp->sched_wall_time.working.start = ts; + + } + else { + Uint64 total; + + ASSERT(esdp->sched_wall_time.working.start + != ERTS_SCHED_WTIME_IDLE); + + total = esdp->sched_wall_time.working.total; + total += ts - esdp->sched_wall_time.working.start; + + esdp->sched_wall_time.working.total = total; + esdp->sched_wall_time.working.start = ERTS_SCHED_WTIME_IDLE; + + + } + + ERTS_THR_WRITE_MEMORY_BARRIER; + mod++; + erts_atomic32_set_nob(&esdp->sched_wall_time.u.mod, mod); + +#if 0 + if (!working) { + ERTS_MSACC_SET_STATE_M_X(ERTS_MSACC_STATE_BUSY_WAIT); + } else { + ERTS_MSACC_SET_STATE_M_X(ERTS_MSACC_STATE_OTHER); + } +#endif +} + +#endif /* ERTS_SMP */ + +static void sched_wall_time_change(ErtsSchedulerData *esdp, int working) { - if (esdp->sched_wall_time.need) { + if (esdp->sched_wall_time.u.need) { Uint64 ts = sched_wall_time_ts(); #if ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT - update_avg_sched_util(esdp, ts, working); + update_avg_sched_util(esdp, ts, working); #endif if (esdp->sched_wall_time.enabled) { if (working) { -#ifdef DEBUG - ASSERT(!esdp->sched_wall_time.working.currently); - esdp->sched_wall_time.working.currently = 1; -#endif + ASSERT(esdp->sched_wall_time.working.start + == ERTS_SCHED_WTIME_IDLE); ts -= esdp->sched_wall_time.start; esdp->sched_wall_time.working.start = ts; } else { -#ifdef DEBUG - ASSERT(esdp->sched_wall_time.working.currently); - esdp->sched_wall_time.working.currently = 0; -#endif + ASSERT(esdp->sched_wall_time.working.start + != ERTS_SCHED_WTIME_IDLE); ts -= esdp->sched_wall_time.start; ts -= esdp->sched_wall_time.working.start; esdp->sched_wall_time.working.total += ts; +#ifdef DEBUG + esdp->sched_wall_time.working.start + = ERTS_SCHED_WTIME_IDLE; +#endif } } } @@ -1052,6 +1174,10 @@ typedef struct { Eterm ref_heap[REF_THING_SIZE]; Uint req_sched; erts_smp_atomic32_t refc; +#ifdef ERTS_DIRTY_SCHEDULERS + int want_dirty_cpu; + int want_dirty_io; +#endif } ErtsSchedWallTimeReq; typedef struct { @@ -1073,6 +1199,7 @@ ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(screq, 5, ERTS_ALC_T_SYS_CHECK_REQ) + static void reply_sched_wall_time(void *vswtrp) { @@ -1096,23 +1223,23 @@ reply_sched_wall_time(void *vswtrp) #endif if (swtrp->set) { if (!swtrp->enable && esdp->sched_wall_time.enabled) { - esdp->sched_wall_time.need = erts_sched_balance_util; + esdp->sched_wall_time.u.need = erts_sched_balance_util; esdp->sched_wall_time.enabled = 0; } else if (swtrp->enable && !esdp->sched_wall_time.enabled) { Uint64 ts = sched_wall_time_ts(); - esdp->sched_wall_time.need = 1; + esdp->sched_wall_time.u.need = 1; esdp->sched_wall_time.enabled = 1; esdp->sched_wall_time.start = ts; esdp->sched_wall_time.working.total = 0; esdp->sched_wall_time.working.start = 0; - esdp->sched_wall_time.working.currently = 1; } } if (esdp->sched_wall_time.enabled) { Uint64 ts = sched_wall_time_ts(); - ASSERT(esdp->sched_wall_time.working.currently); + ASSERT(esdp->sched_wall_time.working.start + != ERTS_SCHED_WTIME_IDLE); ts -= esdp->sched_wall_time.start; total = ts; ts -= esdp->sched_wall_time.working.start; @@ -1123,30 +1250,117 @@ reply_sched_wall_time(void *vswtrp) hpp = NULL; szp = &sz; - while (1) { - if (hpp) - ref_copy = STORE_NC(hpp, ohp, swtrp->ref); - else - *szp += REF_THING_SIZE; +#ifdef ERTS_DIRTY_SCHEDULERS + if (esdp->sched_wall_time.enabled + && swtrp->req_sched == esdp->no + && (swtrp->want_dirty_cpu || swtrp->want_dirty_io)) { + /* Reply with info about this scheduler and all dirty schedulers... */ + ErtsDirtySchedWallTime *dswt; + int ix, no_dirty_scheds, want_dcpu, want_dio, soffset; + + want_dcpu = swtrp->want_dirty_cpu; + want_dio = swtrp->want_dirty_io; + + no_dirty_scheds = 0; + if (want_dcpu) + no_dirty_scheds += erts_no_dirty_cpu_schedulers; + if (want_dio) + no_dirty_scheds += erts_no_dirty_io_schedulers; + + ASSERT(no_dirty_scheds); + + dswt = erts_alloc(ERTS_ALC_T_TMP, + sizeof(ErtsDirtySchedWallTime) + * no_dirty_scheds); + + for (ix = 0; ix < no_dirty_scheds; ix++) { + ErtsSchedulerData *esdp; + if (want_dcpu && ix < erts_no_dirty_cpu_schedulers) + esdp = &erts_aligned_dirty_cpu_scheduler_data[ix].esd; + else { + int dio_ix = ix - erts_no_dirty_cpu_schedulers; + esdp = &erts_aligned_dirty_io_scheduler_data[dio_ix].esd; + } + read_dirty_sched_wall_time(esdp, &dswt[ix]); + } - if (swtrp->set) - msg = ref_copy; - else { - msg = (!esdp->sched_wall_time.enabled - ? am_notsup - : erts_bld_tuple(hpp, szp, 3, - make_small(esdp->no), - erts_bld_uint64(hpp, szp, working), - erts_bld_uint64(hpp, szp, total))); + soffset = erts_no_schedulers + 1; - msg = erts_bld_tuple(hpp, szp, 2, ref_copy, msg); - } - if (hpp) - break; + if (!want_dcpu) { + ASSERT(want_dio); + soffset += erts_no_dirty_cpu_schedulers; + } - mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp); - szp = NULL; - hpp = &hp; + while (1) { + if (hpp) + ref_copy = STORE_NC(hpp, ohp, swtrp->ref); + else + *szp += REF_THING_SIZE; + + ASSERT(!swtrp->set); + + /* info about dirty schedulers... */ + msg = NIL; + for (ix = no_dirty_scheds-1; ix >= 0; ix--) { + msg = erts_bld_cons(hpp, szp, + erts_bld_tuple(hpp, szp, 3, + make_small(ix+soffset), + erts_bld_uint64(hpp, szp, + dswt[ix].working), + erts_bld_uint64(hpp, szp, + dswt[ix].total)), + msg); + } + /* info about this scheduler... */ + msg = erts_bld_cons(hpp, szp, + erts_bld_tuple(hpp, szp, 3, + make_small(esdp->no), + erts_bld_uint64(hpp, szp, working), + erts_bld_uint64(hpp, szp, total)), + msg); + + msg = erts_bld_tuple(hpp, szp, 2, ref_copy, msg); + + if (hpp) + break; + + mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp); + szp = NULL; + hpp = &hp; + } + + erts_free(ERTS_ALC_T_TMP, dswt); + } + else +#endif + { + /* Reply with info about this scheduler only... */ + + while (1) { + if (hpp) + ref_copy = STORE_NC(hpp, ohp, swtrp->ref); + else + *szp += REF_THING_SIZE; + + if (swtrp->set) + msg = ref_copy; + else { + msg = (!esdp->sched_wall_time.enabled + ? am_undefined + : erts_bld_tuple(hpp, szp, 3, + make_small(esdp->no), + erts_bld_uint64(hpp, szp, working), + erts_bld_uint64(hpp, szp, total))); + + msg = erts_bld_tuple(hpp, szp, 2, ref_copy, msg); + } + if (hpp) + break; + + mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp); + szp = NULL; + hpp = &hp; + } } erts_queue_message(rp, rp_locks, mp, msg, am_system); @@ -1164,7 +1378,8 @@ reply_sched_wall_time(void *vswtrp) } Eterm -erts_sched_wall_time_request(Process *c_p, int set, int enable) +erts_sched_wall_time_request(Process *c_p, int set, int enable, + int want_dirty_cpu, int want_dirty_io) { ErtsSchedulerData *esdp = erts_proc_sched_data(c_p); Eterm ref; @@ -1186,6 +1401,10 @@ erts_sched_wall_time_request(Process *c_p, int set, int enable) swtrp->proc = c_p; swtrp->ref = STORE_NC(&hp, NULL, ref); swtrp->req_sched = esdp->no; +#ifdef ERTS_DIRTY_SCHEDULERS + swtrp->want_dirty_cpu = want_dirty_cpu; + swtrp->want_dirty_io = want_dirty_io; +#endif erts_smp_atomic32_init_nob(&swtrp->refc, (erts_aint32_t) erts_no_schedulers); @@ -2059,6 +2278,7 @@ handle_thr_prgr_later_op(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int wait #endif for (lops = 0; lops < ERTS_MAX_THR_PRGR_LATER_OPS; lops++) { ErtsThrPrgrLaterOp *lop = awdp->later_op.first; + if (!erts_thr_progress_has_reached_this(current, lop->later)) return aux_work & ~ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP; awdp->later_op.first = lop->next; @@ -2297,7 +2517,8 @@ static ERTS_INLINE erts_aint32_t handle_reap_ports(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting) { unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_REAP_PORTS); - awdp->esdp->run_queue->halt_in_progress = 1; + ERTS_RUNQ_FLGS_SET(awdp->esdp->run_queue, ERTS_RUNQ_FLG_HALTING); + if (erts_smp_atomic32_dec_read_acqb(&erts_halt_progress) == 0) { int i, max = erts_ptab_max(&erts_port); erts_smp_atomic32_set_nob(&erts_halt_progress, 1); @@ -2837,11 +3058,12 @@ static erts_aint32_t sched_prep_spin_wait(ErtsSchedulerSleepInfo *ssi) { erts_aint32_t oflgs; - erts_aint32_t nflgs = (ERTS_SSI_FLG_SLEEPING - | ERTS_SSI_FLG_WAITING); + erts_aint32_t nflgs; erts_aint32_t xflgs = 0; do { + nflgs = (xflgs & ERTS_SSI_FLG_MSB_EXEC); + nflgs |= ERTS_SSI_FLG_SLEEPING|ERTS_SSI_FLG_WAITING; oflgs = erts_smp_atomic32_cmpxchg_acqb(&ssi->flags, nflgs, xflgs); if (oflgs == xflgs) return nflgs; @@ -2863,7 +3085,7 @@ sched_prep_cont_spin_wait(ErtsSchedulerSleepInfo *ssi) if (oflgs == xflgs) return nflgs; xflgs = oflgs; - nflgs |= oflgs & ERTS_SSI_FLG_SUSPENDED; + nflgs |= oflgs & (ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC); } while (oflgs & ERTS_SSI_FLG_WAITING); return oflgs; } @@ -2913,7 +3135,7 @@ sched_set_sleeptype(ErtsSchedulerSleepInfo *ssi, erts_aint32_t sleep_type) return oflgs; } xflgs = oflgs; - nflgs |= oflgs & ERTS_SSI_FLG_SUSPENDED; + nflgs |= oflgs & (ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC); } } @@ -3048,6 +3270,8 @@ aux_thread(void *unused) return NULL; } +static void suspend_scheduler(ErtsSchedulerData *esdp); + #endif /* ERTS_SMP */ static void @@ -3106,8 +3330,10 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) tse_wait: - if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && thr_prgr_active != working) - sched_wall_time_change(esdp, thr_prgr_active); + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) + dirty_sched_wall_time_change(esdp, working = 0); + else if (thr_prgr_active != working) + sched_wall_time_change(esdp, working = thr_prgr_active); while (1) { ErtsMonotonicTime current_time = 0; @@ -3213,13 +3439,17 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) } - if (flgs & ~ERTS_SSI_FLG_SUSPENDED) - erts_smp_atomic32_read_band_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED); + if (flgs & ~(ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC)) + erts_smp_atomic32_read_band_nob(&ssi->flags, + (ERTS_SSI_FLG_SUSPENDED + | ERTS_SSI_FLG_MSB_EXEC)); - if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && !thr_prgr_active) { + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) + dirty_sched_wall_time_change(esdp, working = 1); + else if (!thr_prgr_active) { erts_thr_progress_active(esdp, thr_prgr_active = 1); sched_wall_time_change(esdp, 1); - } + } erts_smp_runq_lock(rq); sched_active(esdp->no, rq); @@ -3413,8 +3643,10 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) erts_smp_runq_lock(rq); } clear_sys_scheduling(); - if (flgs & ~ERTS_SSI_FLG_SUSPENDED) - erts_smp_atomic32_read_band_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED); + if (flgs & ~(ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC)) + erts_smp_atomic32_read_band_nob(&ssi->flags, + (ERTS_SSI_FLG_SUSPENDED + | ERTS_SSI_FLG_MSB_EXEC)); #endif if (!working) sched_wall_time_change(esdp, working = 1); @@ -3437,17 +3669,54 @@ ssi_flags_set_wake(ErtsSchedulerSleepInfo *ssi) oflgs = erts_smp_atomic32_cmpxchg_relb(&ssi->flags, nflgs, xflgs); if (oflgs == xflgs) return oflgs; - nflgs = oflgs & ERTS_SSI_FLG_SUSPENDED; + nflgs = oflgs & (ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC); xflgs = oflgs; } } +static ERTS_INLINE void +ssi_wake(ErtsSchedulerSleepInfo *ssi) +{ + erts_sched_finish_poke(ssi, ssi_flags_set_wake(ssi)); +} + +#ifdef ERTS_DIRTY_SCHEDULERS + static void -wake_scheduler(ErtsRunQueue *rq) +dcpu_sched_ix_suspend_wake(Uint ix) { - ErtsSchedulerSleepInfo *ssi; - erts_aint32_t flgs; + ErtsSchedulerSleepInfo* ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); + erts_smp_atomic32_read_bor_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED); + ssi_wake(ssi); +} + +static void +dio_sched_ix_suspend_wake(Uint ix) +{ + ErtsSchedulerSleepInfo* ssi = ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix); + erts_smp_atomic32_read_bor_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED); + ssi_wake(ssi); +} + +static void +dcpu_sched_ix_wake(Uint ix) +{ + ssi_wake(ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix)); +} +#if 0 +static void +dio_sched_ix_wake(Uint ix) +{ + ssi_wake(ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix)); +} +#endif + +#endif + +static void +wake_scheduler(ErtsRunQueue *rq) +{ /* * The unlocked run queue is not strictly necessary * from a thread safety or deadlock prevention @@ -3459,10 +3728,7 @@ wake_scheduler(ErtsRunQueue *rq) ERTS_SMP_LC_ASSERT(!erts_smp_lc_runq_is_locked(rq) || ERTS_RUNQ_IX_IS_DIRTY(rq->ix)); - ssi = rq->scheduler->ssi; - - flgs = ssi_flags_set_wake(ssi); - erts_sched_finish_poke(ssi, flgs); + ssi_wake(rq->scheduler->ssi); } #ifdef ERTS_DIRTY_SCHEDULERS @@ -3509,6 +3775,13 @@ wake_dirty_schedulers(ErtsRunQueue *rq, int one) } while (ssi); } } + +static void +wake_dirty_scheduler(ErtsRunQueue *rq) +{ + wake_dirty_schedulers(rq, 1); +} + #endif #define ERTS_NO_USED_RUNQS_SHIFT 16 @@ -3649,7 +3922,7 @@ smp_notify_inc_runq(ErtsRunQueue *runq) if (runq) { #ifdef ERTS_DIRTY_SCHEDULERS if (ERTS_RUNQ_IX_IS_DIRTY(runq->ix)) - wake_dirty_schedulers(runq, 1); + wake_dirty_scheduler(runq); else #endif wake_scheduler(runq); @@ -3953,8 +4226,7 @@ suspend_run_queue(ErtsRunQueue *rq) wake_scheduler(rq); } -static void scheduler_ix_resume_wake(Uint ix); -static void scheduler_ssi_resume_wake(ErtsSchedulerSleepInfo *ssi); +static void nrml_sched_ix_resume_wake(Uint ix); static ERTS_INLINE void resume_run_queue(ErtsRunQueue *rq) @@ -3962,16 +4234,19 @@ resume_run_queue(ErtsRunQueue *rq) int pix; Uint32 oflgs; + ASSERT(!ERTS_RUNQ_IX_IS_DIRTY(rq->ix)); + erts_smp_runq_lock(rq); oflgs = ERTS_RUNQ_FLGS_READ_BSET(rq, (ERTS_RUNQ_FLG_OUT_OF_WORK | ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK - | ERTS_RUNQ_FLG_SUSPENDED), + | ERTS_RUNQ_FLG_SUSPENDED + | ERTS_RUNQ_FLG_MSB_EXEC), (ERTS_RUNQ_FLG_OUT_OF_WORK | ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK)); - if (oflgs & ERTS_RUNQ_FLG_SUSPENDED) { + if (oflgs & (ERTS_RUNQ_FLG_SUSPENDED|ERTS_RUNQ_FLG_MSB_EXEC)) { erts_aint32_t len; rq->check_balance_reds = ERTS_RUNQ_CALL_CHECK_BALANCE_REDS; @@ -3990,10 +4265,7 @@ resume_run_queue(ErtsRunQueue *rq) erts_smp_runq_unlock(rq); -#ifdef ERTS_DIRTY_SCHEDULERS - if (!ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) -#endif - scheduler_ix_resume_wake(rq->ix); + nrml_sched_ix_resume_wake(rq->ix); } typedef struct { @@ -4051,28 +4323,22 @@ evacuate_run_queue(ErtsRunQueue *rq, int prio_q; ErtsRunQueue *to_rq; ErtsMigrationPaths *mps; - ErtsMigrationPath *mp = NULL; + ErtsMigrationPath *mp; ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); (void) ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_PROTECTED); -#ifdef ERTS_DIRTY_SCHEDULERS - if (!ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) -#endif - { - mps = erts_get_migration_paths_managed(); - mp = &mps->mpath[rq->ix]; - } + ASSERT(!ERTS_RUNQ_IX_IS_DIRTY(rq->ix)); + + mps = erts_get_migration_paths_managed(); + mp = &mps->mpath[rq->ix]; /* Evacuate scheduled misc ops */ if (rq->misc.start) { ErtsMiscOpList *start, *end; -#ifdef ERTS_DIRTY_SCHEDULERS - ASSERT(!ERTS_RUNQ_IX_IS_DIRTY(rq->ix)); -#endif to_rq = mp->misc_evac_runq; if (!to_rq) return; @@ -4081,6 +4347,7 @@ evacuate_run_queue(ErtsRunQueue *rq, end = rq->misc.end; rq->misc.start = NULL; rq->misc.end = NULL; + ERTS_RUNQ_FLGS_UNSET_NOB(rq, ERTS_RUNQ_FLG_MISC_OP); erts_smp_runq_unlock(rq); erts_smp_runq_lock(to_rq); @@ -4101,9 +4368,6 @@ evacuate_run_queue(ErtsRunQueue *rq, if (rq->ports.start) { Port *prt; -#ifdef ERTS_DIRTY_SCHEDULERS - ASSERT(!ERTS_RUNQ_IX_IS_DIRTY(rq->ix)); -#endif to_rq = mp->prio[ERTS_PORT_PRIO_LEVEL].runq; if (!to_rq) return; @@ -4141,15 +4405,10 @@ evacuate_run_queue(ErtsRunQueue *rq, int notify = 0; to_rq = NULL; -#ifdef ERTS_DIRTY_SCHEDULERS - if (!ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) -#endif - { - if (!mp->prio[prio_q].runq) - return; - if (prio_q == PRIORITY_NORMAL && !mp->prio[PRIORITY_LOW].runq) - return; - } + if (!mp->prio[prio_q].runq) + return; + if (prio_q == PRIORITY_NORMAL && !mp->prio[PRIORITY_LOW].runq) + return; proc = dequeue_process(rq, prio_q, &state); while (proc) { @@ -4205,11 +4464,6 @@ evacuate_run_queue(ErtsRunQueue *rq, goto handle_next_proc; } -#ifdef ERTS_DIRTY_SCHEDULERS - if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) - clear_proc_dirty_queue_bit(real_proc, rq, qbit); -#endif - if (ERTS_PSFLG_BOUND & real_state) { /* Bound processes get stuck here... */ proc->next = NULL; @@ -4223,16 +4477,7 @@ evacuate_run_queue(ErtsRunQueue *rq, int prio = (int) ERTS_PSFLGS_GET_PRQ_PRIO(state); erts_smp_runq_unlock(rq); -#ifdef ERTS_DIRTY_SCHEDULERS - if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) - /* - * dirty run queues evacuate only to run - * queue 0 during multi-scheduling blocking - */ - to_rq = ERTS_RUNQ_IX(0); - else -#endif - to_rq = mp->prio[prio].runq; + to_rq = mp->prio[prio].runq; RUNQ_SET_RQ(&proc->run_queue, to_rq); erts_smp_runq_lock(to_rq); @@ -4267,7 +4512,7 @@ try_steal_task_from_victim(ErtsRunQueue *rq, int *rq_lockedp, ErtsRunQueue *vrq, erts_smp_runq_lock(vrq); - if (rq->halt_in_progress) + if (ERTS_RUNQ_FLGS_GET_NOB(rq) & ERTS_RUNQ_FLG_HALTING) goto no_procs; /* @@ -4366,8 +4611,7 @@ check_possible_steal_victim(ErtsRunQueue *rq, int *rq_lockedp, int vix) { ErtsRunQueue *vrq = ERTS_RUNQ_IX(vix); Uint32 flags = ERTS_RUNQ_FLGS_GET(vrq); - if ((flags & (ERTS_RUNQ_FLG_NONEMPTY - | ERTS_RUNQ_FLG_PROTECTED)) == ERTS_RUNQ_FLG_NONEMPTY) + if (runq_got_work_to_execute_flags(flags) & (!(flags & ERTS_RUNQ_FLG_PROTECTED))) return try_steal_task_from_victim(rq, rq_lockedp, vrq, flags); else return 0; @@ -4435,11 +4679,9 @@ try_steal_task(ErtsRunQueue *rq) if (!rq_locked) erts_smp_runq_lock(rq); - if (!res) - res = rq->halt_in_progress ? - !ERTS_EMPTY_RUNQ_PORTS(rq) : !ERTS_EMPTY_RUNQ(rq); - - return res; + if (res) + return res; + return runq_got_work_to_execute(rq); } /* Run queue balancing */ @@ -5351,7 +5593,7 @@ wakeup_other_check(ErtsRunQueue *rq, Uint32 flags) #ifdef ERTS_DIRTY_SCHEDULERS if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) { if (rq->waiting) { - wake_dirty_schedulers(rq, 1); + wake_dirty_scheduler(rq); } } else #endif @@ -5698,7 +5940,8 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num, ErtsSchedulerSleepInfo* ssi, ErtsRunQueue* runq, char** daww_ptr, size_t daww_sz, - Process *shadow_proc) + Process *shadow_proc, + Uint64 time_stamp) { esdp->timer_wheel = NULL; #ifdef ERTS_SMP @@ -5714,13 +5957,29 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num, erts_alloc_permanent_cache_aligned(ERTS_ALC_T_BEAM_REGISTER, MAX_REG * sizeof(FloatDef)); #ifdef ERTS_DIRTY_SCHEDULERS + esdp->run_queue = runq; if (ERTS_RUNQ_IX_IS_DIRTY(runq->ix)) { esdp->no = 0; + if (runq == ERTS_DIRTY_CPU_RUNQ) + esdp->type = ERTS_SCHED_DIRTY_CPU; + else { + ASSERT(runq == ERTS_DIRTY_IO_RUNQ); + esdp->type = ERTS_SCHED_DIRTY_IO; + } ERTS_DIRTY_SCHEDULER_NO(esdp) = (Uint) num; + if (num == 1) { + /* + * Multi-scheduling block functionality depends + * on finding dirty scheduler number 1 here... + */ + runq->scheduler = esdp; + } } else { + esdp->type = ERTS_SCHED_NORMAL; esdp->no = (Uint) num; ERTS_DIRTY_SCHEDULER_NO(esdp) = 0; + runq->scheduler = esdp; } esdp->dirty_shadow_process = shadow_proc; if (shadow_proc) { @@ -5732,6 +5991,8 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num, shadow_proc->static_flags = ERTS_STC_FLG_SHADOW_PROC; } #else + runq->scheduler = esdp; + esdp->run_queue = runq; esdp->no = (Uint) num; #endif @@ -5744,9 +6005,6 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num, erts_init_atom_cache_map(&esdp->atom_cache_map); - esdp->run_queue = runq; - esdp->run_queue->scheduler = esdp; - esdp->last_monotonic_time = 0; esdp->check_time_reds = 0; @@ -5765,7 +6023,7 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num, esdp->reductions = 0; - init_sched_wall_time(&esdp->sched_wall_time); + init_sched_wall_time(esdp, time_stamp); erts_port_task_handle_init(&esdp->nosuspend_port_task_handle); } @@ -5862,7 +6120,6 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online erts_smp_atomic32_set_nob(&rq->len, 0); rq->wakeup_other = 0; rq->wakeup_other_reds = 0; - rq->halt_in_progress = 0; rq->procs.pending_exiters = NULL; rq->procs.context_switches = 0; @@ -5980,17 +6237,18 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online erts_aligned_scheduler_data = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_SCHDLR_DATA, - n*sizeof(ErtsAlignedSchedulerData)); + n*sizeof(ErtsAlignedSchedulerData)); for (ix = 0; ix < n; ix++) { ErtsSchedulerData *esdp = ERTS_SCHEDULER_IX(ix); init_scheduler_data(esdp, ix+1, ERTS_SCHED_SLEEP_INFO_IX(ix), ERTS_RUNQ_IX(ix), &daww_ptr, daww_sz, - NULL); + NULL, 0); } #ifdef ERTS_DIRTY_SCHEDULERS { + Uint64 ts = sched_wall_time_ts(); int dirty_scheds = no_dirty_cpu_schedulers + no_dirty_io_schedulers; int adspix = 0; ErtsAlignedDirtyShadowProcess *adsp = @@ -6010,13 +6268,13 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online ErtsSchedulerData *esdp = ERTS_DIRTY_CPU_SCHEDULER_IX(ix); init_scheduler_data(esdp, ix+1, ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix), ERTS_DIRTY_CPU_RUNQ, NULL, 0, - &adsp[adspix++].dsp); + &adsp[adspix++].dsp, ts); } for (ix = 0; ix < no_dirty_io_schedulers; ix++) { ErtsSchedulerData *esdp = ERTS_DIRTY_IO_SCHEDULER_IX(ix); init_scheduler_data(esdp, ix+1, ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix), ERTS_DIRTY_IO_RUNQ, NULL, 0, - &adsp[adspix++].dsp); + &adsp[adspix++].dsp, ts); } } #endif @@ -6233,6 +6491,12 @@ check_dirty_enqueue_in_prio_queue(Process *c_p, int queue; erts_aint32_t dact, max_qbit; + /* Do not enqueue free process... */ + if (actual & ERTS_PSFLG_FREE) { + *newp &= ~ERTS_PSFLGS_DIRTY_WORK; + return ERTS_ENQUEUE_NOT; + } + /* Termination should be done on an ordinary scheduler */ if ((*newp) & ERTS_PSFLG_EXITING) { *newp &= ~ERTS_PSFLGS_DIRTY_WORK; @@ -6425,6 +6689,9 @@ select_enqueue_run_queue(int enqueue, int enq_prio, Process *p, erts_aint32_t st /* * schedule_out_process() return with c_rq locked. + * + * Return non-zero value if caller should decrease + * reference count on the process when done with it... */ static ERTS_INLINE int schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, @@ -6434,10 +6701,30 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, int enqueue; /* < 0 -> use proxy */ ErtsRunQueue* runq; - if (is_normal_sched) - running_flgs = ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS; - else + if (!is_normal_sched) running_flgs = ERTS_PSFLG_DIRTY_RUNNING|ERTS_PSFLG_DIRTY_RUNNING_SYS; + else { + running_flgs = ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS; +#ifdef ERTS_DIRTY_SCHEDULERS + if (state & ERTS_PSFLG_DIRTY_ACTIVE_SYS + && (p->flags & (F_DELAY_GC|F_DISABLE_GC))) { + /* + * Delay dirty GC; will be enabled automatically + * again by next GC... + */ + + /* + * No normal execution until dirty CLA or hibernat has + * been handled... + */ + ASSERT(!(p->flags & (F_DIRTY_CLA | F_DIRTY_GC_HIBERNATE))); + + state = erts_smp_atomic32_read_band_nob(&p->state, + ~ERTS_PSFLG_DIRTY_ACTIVE_SYS); + state &= ~ERTS_PSFLG_DIRTY_ACTIVE_SYS; + } +#endif + } a = state; @@ -6479,12 +6766,18 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, erts_smp_runq_lock(c_rq); - return 0; - +#if !defined(ERTS_SMP) + /* Decrement refc if process struct is free... */ + return !!(n & ERTS_PSFLG_FREE); +#else + /* Decrement refc if scheduled out from dirty scheduler... */ + return !is_normal_sched; +#endif } else { Process* sched_p; + ASSERT(!(n & ERTS_PSFLG_FREE)); ASSERT(!(n & ERTS_PSFLG_SUSPENDED) || (n & (ERTS_PSFLG_ACTIVE_SYS | ERTS_PSFLG_DIRTY_ACTIVE_SYS))); @@ -6500,11 +6793,14 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, erts_smp_runq_lock(runq); + if (is_normal_sched && sched_p == p && ERTS_RUNQ_IX_IS_DIRTY(runq->ix)) + erts_proc_inc_refc(p); /* Needs to be done before enqueue_process() */ + /* Enqueue the process */ enqueue_process(runq, (int) enq_prio, sched_p); if (runq == c_rq) - return 1; + return 0; erts_smp_runq_unlock(runq); @@ -6512,9 +6808,15 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, erts_smp_runq_lock(c_rq); - return 1; + /* + * Decrement refc if process is scheduled out by a + * dirty scheduler, and we have not just scheduled + * the process using the ordinary process struct + * on a dirty run-queue again... + */ + return !is_normal_sched && (sched_p != p + || !ERTS_RUNQ_IX_IS_DIRTY(runq->ix)); } - } static ERTS_INLINE void @@ -6529,8 +6831,17 @@ add2runq(int enqueue, erts_aint32_t prio, if (runq) { Process *sched_p; - if (enqueue > 0) + if (enqueue > 0) { sched_p = proc; + /* + * Refc on process struct (i.e. true struct, + * not proxy-struct) increased while in a + * dirty run-queue or executing on a dirty + * scheduler. + */ + if (ERTS_RUNQ_IX_IS_DIRTY(runq->ix)) + erts_proc_inc_refc(proc); + } else { Process *pxy; @@ -6925,15 +7236,8 @@ resume_process(Process *p, ErtsProcLocks locks) #ifdef ERTS_SMP -static void -scheduler_ix_resume_wake(Uint ix) -{ - ErtsSchedulerSleepInfo *ssi = ERTS_SCHED_SLEEP_INFO_IX(ix); - scheduler_ssi_resume_wake(ssi); -} - -static void -scheduler_ssi_resume_wake(ErtsSchedulerSleepInfo *ssi) +static ERTS_INLINE void +sched_resume_wake__(ErtsSchedulerSleepInfo *ssi) { erts_aint32_t xflgs = (ERTS_SSI_FLG_SLEEPING | ERTS_SSI_FLG_TSE_SLEEPING @@ -6947,9 +7251,31 @@ scheduler_ssi_resume_wake(ErtsSchedulerSleepInfo *ssi) break; } xflgs = oflgs; - } while (oflgs & ERTS_SSI_FLG_SUSPENDED); + } while (oflgs & (ERTS_SSI_FLG_MSB_EXEC|ERTS_SSI_FLG_SUSPENDED)); } +static void +nrml_sched_ix_resume_wake(Uint ix) +{ + sched_resume_wake__(ERTS_SCHED_SLEEP_INFO_IX(ix)); +} + +#ifdef ERTS_DIRTY_SCHEDULERS + +static void +dcpu_sched_ix_resume_wake(Uint ix) +{ + sched_resume_wake__(ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix)); +} + +static void +dio_sched_ix_resume_wake(Uint ix) +{ + sched_resume_wake__(ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix)); +} + +#endif + static erts_aint32_t sched_prep_spin_suspended(ErtsSchedulerSleepInfo *ssi, erts_aint32_t xpct) { @@ -7029,9 +7355,18 @@ static void init_scheduler_suspend(void) { erts_smp_mtx_init(&schdlr_sspnd.mtx, "schdlr_sspnd"); - schdlr_sspnd.online = ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0); - schdlr_sspnd.curr_online = ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0); - schdlr_sspnd.active = ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0); + schdlr_sspnd.online.normal = 1; + schdlr_sspnd.curr_online.normal = 1; + schdlr_sspnd.active.normal = 1; +#ifdef ERTS_DIRTY_SCHEDULERS + schdlr_sspnd.online.dirty_cpu = 0; + schdlr_sspnd.curr_online.dirty_cpu = 0; + schdlr_sspnd.active.dirty_cpu = 0; + schdlr_sspnd.online.dirty_io = 0; + schdlr_sspnd.curr_online.dirty_io = 0; + schdlr_sspnd.active.dirty_io = 0; + schdlr_sspnd.last_msb_dirty_type = ERTS_SCHED_DIRTY_IO; +#endif erts_smp_atomic32_init_nob(&schdlr_sspnd.changing, 0); schdlr_sspnd.chngq = NULL; schdlr_sspnd.changer = am_false; @@ -7054,12 +7389,18 @@ typedef struct { } ErtsSchdlrSspndResume; static void -schdlr_sspnd_resume_proc(Eterm pid) +schdlr_sspnd_resume_proc(ErtsSchedType sched_type, Eterm pid) { - Process *p = erts_pid2proc(NULL, 0, pid, ERTS_PROC_LOCK_STATUS); + Process *p; + p = erts_pid2proc_opt(NULL, 0, pid, ERTS_PROC_LOCK_STATUS, + (sched_type != ERTS_SCHED_NORMAL + ? ERTS_P2P_FLG_INC_REFC + : 0)); if (p) { resume_process(p, ERTS_PROC_LOCK_STATUS); erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + if (sched_type != ERTS_SCHED_NORMAL) + erts_proc_dec_refc(p); } } @@ -7068,21 +7409,270 @@ schdlr_sspnd_resume_procs(ErtsSchedType sched_type, ErtsSchdlrSspndResume *resume) { if (is_internal_pid(resume->onln.chngr)) { - schdlr_sspnd_resume_proc(resume->onln.chngr); + schdlr_sspnd_resume_proc(sched_type, + resume->onln.chngr); resume->onln.chngr = NIL; } if (is_internal_pid(resume->onln.nxt)) { - schdlr_sspnd_resume_proc(resume->onln.nxt); + schdlr_sspnd_resume_proc(sched_type, + resume->onln.nxt); resume->onln.nxt = NIL; } while (resume->msb.chngrs) { ErtsProcList *plp = resume->msb.chngrs; resume->msb.chngrs = plp->next; - schdlr_sspnd_resume_proc(plp->pid); + schdlr_sspnd_resume_proc(sched_type, + plp->pid); proclist_destroy(plp); } } +#ifdef ERTS_DIRTY_SCHEDULERS + +static ERTS_INLINE int +have_dirty_work(void) +{ + return !(ERTS_EMPTY_RUNQ(ERTS_DIRTY_CPU_RUNQ) + | ERTS_EMPTY_RUNQ(ERTS_DIRTY_IO_RUNQ)); +} + +#define ERTS_MSB_NONE_PRIO_BIT PORT_BIT + +static ERTS_INLINE Uint32 +msb_runq_prio_bit(Uint32 flgs) +{ + int pbit; + + pbit = (int) (flgs & ERTS_RUNQ_FLGS_PROCS_QMASK); + if (flgs & PORT_BIT) { + /* rate ports as proc prio high */ + pbit |= HIGH_BIT; + } + if (flgs & ERTS_RUNQ_FLG_MISC_OP) { + /* rate misc ops as proc prio normal */ + pbit |= NORMAL_BIT; + } + if (flgs & LOW_BIT) { + /* rate low prio as normal (avoid starvation) */ + pbit |= NORMAL_BIT; + } + if (!pbit) + pbit = (int) ERTS_MSB_NONE_PRIO_BIT; + else + pbit &= -pbit; /* least significant bit set... */ + ASSERT(pbit); + + /* High prio low value; low prio high value... */ + return (Uint32) pbit; +} + +static ERTS_INLINE void +msb_runq_prio_bits(Uint32 *nrmlp, Uint32 *dcpup, Uint32 *diop) +{ + Uint32 flgs = ERTS_RUNQ_FLGS_GET(ERTS_RUNQ_IX(0)); + if (flgs & ERTS_RUNQ_FLG_HALTING) { + /* + * Emulator is halting; only execute port jobs + * on normal scheduler. Ensure that we switch + * to the normal scheduler. + */ + *nrmlp = HIGH_BIT; + *dcpup = ERTS_MSB_NONE_PRIO_BIT; + *diop = ERTS_MSB_NONE_PRIO_BIT; + } + else { + *nrmlp = msb_runq_prio_bit(flgs); + + flgs = ERTS_RUNQ_FLGS_GET(ERTS_DIRTY_CPU_RUNQ); + *dcpup = msb_runq_prio_bit(flgs); + + flgs = ERTS_RUNQ_FLGS_GET(ERTS_DIRTY_IO_RUNQ); + *diop = msb_runq_prio_bit(flgs); + } +} + +static int +msb_scheduler_type_switch(ErtsSchedType sched_type, + ErtsSchedulerData *esdp, + long no) +{ + Uint32 nrml_prio, dcpu_prio, dio_prio; + ErtsSchedType exec_type; + ErtsRunQueue *exec_rq; +#ifdef DEBUG + erts_aint32_t dbg_val; +#endif + + ASSERT(schdlr_sspnd.msb.ongoing); + + /* + * This function determines how to switch + * between scheduler types when multi-scheduling + * is blocked. + * + * If no dirty work exist, we always select + * execution of normal scheduler. If nothing + * executes, normal scheduler 1 should be waiting + * in sys_schedule(), otherwise we cannot react + * on I/O events. + * + * We unconditionally switch back to normal + * scheduler after executing dirty in order to + * make sure we check for I/O... + */ + + msb_runq_prio_bits(&nrml_prio, &dcpu_prio, &dio_prio); + + exec_type = ERTS_SCHED_NORMAL; + if (sched_type == ERTS_SCHED_NORMAL) { + + /* + * Check priorities of work in the + * different run-queues and determine + * run-queue with highest prio job... + */ + + if ((dcpu_prio == ERTS_MSB_NONE_PRIO_BIT) + & (dio_prio == ERTS_MSB_NONE_PRIO_BIT)) { + /* + * No dirty work exist; continue on normal + * scheduler... + */ + return 0; + } + + if (dcpu_prio < nrml_prio) { + exec_type = ERTS_SCHED_DIRTY_CPU; + if (dio_prio < dcpu_prio) + exec_type = ERTS_SCHED_DIRTY_IO; + } + else { + if (dio_prio < nrml_prio) + exec_type = ERTS_SCHED_DIRTY_IO; + } + + /* + * Make sure to alternate between dirty types + * inbetween normal execution if highest + * priorities are equal. + */ + + if (exec_type == ERTS_SCHED_NORMAL) { + if (dcpu_prio == nrml_prio) + exec_type = ERTS_SCHED_DIRTY_CPU; + else if (dio_prio == nrml_prio) + exec_type = ERTS_SCHED_DIRTY_IO; + else { + /* + * Normal work has higher prio than + * dirty work; continue on normal + * scheduler... + */ + return 0; + } + } + + ASSERT(exec_type != ERTS_SCHED_NORMAL); + if (dio_prio == dcpu_prio) { + /* Alter between dirty types... */ + if (schdlr_sspnd.last_msb_dirty_type == ERTS_SCHED_DIRTY_IO) + exec_type = ERTS_SCHED_DIRTY_CPU; + else + exec_type = ERTS_SCHED_DIRTY_IO; + } + } + + ASSERT(sched_type != exec_type); + + if (exec_type != ERTS_SCHED_NORMAL) + schdlr_sspnd.last_msb_dirty_type = exec_type; + else { + erts_aint32_t calls; + /* + * Going back to normal scheduler after + * dirty execution; make sure it will check + * for I/O... + */ + if (ERTS_USE_MODIFIED_TIMING()) + calls = ERTS_MODIFIED_TIMING_INPUT_REDS + 1; + else + calls = INPUT_REDUCTIONS + 1; + erts_smp_atomic32_set_nob(&function_calls, calls); + + if ((nrml_prio == ERTS_MSB_NONE_PRIO_BIT) + & ((dcpu_prio != ERTS_MSB_NONE_PRIO_BIT) + | (dio_prio != ERTS_MSB_NONE_PRIO_BIT))) { + /* + * We have dirty work, but an empty + * normal run-queue. + * + * Since the normal run-queue is + * empty, the normal scheduler will + * go to sleep when selected for + * execution. We have dirty work to + * do, so we only want it to check + * I/O, and then come back here and + * switch to dirty execution. + * + * To prevent the scheduler from going + * to sleep we trick it into believing + * it has work to do... + */ + ERTS_RUNQ_FLGS_SET_NOB(ERTS_RUNQ_IX(0), + ERTS_RUNQ_FLG_MISC_OP); + } + } + + /* + * Suspend this scheduler and wake up scheduler + * number one of another type... + */ +#ifdef DEBUG + dbg_val = +#else + (void) +#endif + erts_smp_atomic32_read_bset_mb(&esdp->ssi->flags, + (ERTS_SSI_FLG_SUSPENDED + | ERTS_SSI_FLG_MSB_EXEC), + ERTS_SSI_FLG_SUSPENDED); + ASSERT(dbg_val & ERTS_SSI_FLG_MSB_EXEC); + + switch (exec_type) { + case ERTS_SCHED_NORMAL: + exec_rq = ERTS_RUNQ_IX(0); + break; + case ERTS_SCHED_DIRTY_CPU: + exec_rq = ERTS_DIRTY_CPU_RUNQ; + break; + case ERTS_SCHED_DIRTY_IO: + exec_rq = ERTS_DIRTY_IO_RUNQ; + break; + default: + ERTS_INTERNAL_ERROR("Invalid scheduler type"); + exec_rq = NULL; + break; + } + +#ifdef DEBUG + dbg_val = +#else + (void) +#endif + erts_smp_atomic32_read_bset_mb(&exec_rq->scheduler->ssi->flags, + (ERTS_SSI_FLG_SUSPENDED + | ERTS_SSI_FLG_MSB_EXEC), + ERTS_SSI_FLG_MSB_EXEC); + ASSERT(dbg_val & ERTS_SSI_FLG_SUSPENDED); + + wake_scheduler(exec_rq); + + return 1; /* suspend this scheduler... */ + +} + +#endif + static void suspend_scheduler(ErtsSchedulerData *esdp) { @@ -7108,40 +7698,51 @@ suspend_scheduler(ErtsSchedulerData *esdp) * Regardless of why a scheduler is suspended, it ends up here. */ -#ifdef ERTS_DIRTY_SCHEDULERS - if (ERTS_SCHEDULER_IS_DIRTY(esdp)) { + +#if !defined(ERTS_DIRTY_SCHEDULERS) + + sched_type = ERTS_SCHED_NORMAL; + online_flag = ERTS_SCHDLR_SSPND_CHNG_ONLN; + no = esdp->no; + ASSERT(no != 1); + +#else + + sched_type = esdp->type; + switch (sched_type) { + case ERTS_SCHED_NORMAL: + online_flag = ERTS_SCHDLR_SSPND_CHNG_ONLN; + no = esdp->no; + break; + case ERTS_SCHED_DIRTY_CPU: + online_flag = ERTS_SCHDLR_SSPND_CHNG_DCPU_ONLN; + no = ERTS_DIRTY_SCHEDULER_NO(esdp); + break; + case ERTS_SCHED_DIRTY_IO: + online_flag = 0; no = ERTS_DIRTY_SCHEDULER_NO(esdp); - if (ERTS_RUNQ_IS_DIRTY_CPU_RUNQ(esdp->run_queue)) { - online_flag = ERTS_SCHDLR_SSPND_CHNG_DCPU_ONLN; - sched_type = ERTS_SCHED_DIRTY_CPU; - } - else { - online_flag = 0; - sched_type = ERTS_SCHED_DIRTY_IO; - } + break; + default: + ERTS_INTERNAL_ERROR("Invalid scheduler type"); + return; } - else -#endif - { - online_flag = ERTS_SCHDLR_SSPND_CHNG_ONLN; - no = esdp->no; - sched_type = ERTS_SCHED_NORMAL; + + if (erts_smp_atomic32_read_nob(&ssi->flags) & ERTS_SSI_FLG_MSB_EXEC) { + ASSERT(no == 1); + if (!msb_scheduler_type_switch(sched_type, esdp, no)) + return; + /* Suspend and let scheduler 1 of another type execute... */ } - ASSERT(sched_type != ERTS_SCHED_NORMAL || no != 1); +#endif if (sched_type != ERTS_SCHED_NORMAL) { - if (erts_smp_mtx_trylock(&schdlr_sspnd.mtx) == EBUSY) { - erts_smp_runq_unlock(esdp->run_queue); - erts_smp_mtx_lock(&schdlr_sspnd.mtx); - erts_smp_runq_lock(esdp->run_queue); - } - if (schdlr_sspnd.msb.ongoing) - evacuate_run_queue(esdp->run_queue, &sbp); erts_smp_runq_unlock(esdp->run_queue); + dirty_sched_wall_time_change(esdp, 0); } else { - evacuate_run_queue(esdp->run_queue, &sbp); + if (no != 1) + evacuate_run_queue(esdp->run_queue, &sbp); erts_smp_runq_unlock(esdp->run_queue); @@ -7149,20 +7750,15 @@ suspend_scheduler(ErtsSchedulerData *esdp) if (erts_system_profile_flags.scheduler) profile_scheduler(make_small(esdp->no), am_inactive); - - sched_wall_time_change(esdp, 0); - - erts_smp_mtx_lock(&schdlr_sspnd.mtx); } + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + flgs = sched_prep_spin_suspended(ssi, ERTS_SSI_FLG_SUSPENDED); if (flgs & ERTS_SSI_FLG_SUSPENDED) { schdlr_sspnd_dec_nscheds(&schdlr_sspnd.active, sched_type); - ASSERT(schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, - ERTS_SCHED_NORMAL) >= 1); - changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); while (1) { @@ -7184,9 +7780,13 @@ suspend_scheduler(ErtsSchedulerData *esdp) ERTS_SCHED_NORMAL) == 1) { clr_flg = ERTS_SCHDLR_SSPND_CHNG_NMSB; } - else if (schdlr_sspnd.active - == ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0)) { - clr_flg = ERTS_SCHDLR_SSPND_CHNG_MSB; + else if (schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_NORMAL) == 1 + && schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_DIRTY_CPU) == 0 + && schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_DIRTY_IO) == 0) { + clr_flg = ERTS_SCHDLR_SSPND_CHNG_MSB; } if (clr_flg) { @@ -7197,15 +7797,18 @@ suspend_scheduler(ErtsSchedulerData *esdp) (void) erts_proclist_fetch(&msb[i]->chngq, &end_plp); /* resume processes that initiated the multi scheduling block... */ plp = msb[i]->chngq; - while (plp) { - erts_proclist_store_last(&msb[i]->blckrs, - proclist_copy(plp)); - plp = plp->next; - } - if (end_plp) + if (plp) { + ASSERT(end_plp); + ASSERT(msb[i]->ongoing); + do { + erts_proclist_store_last(&msb[i]->blckrs, + proclist_copy(plp)); + plp = plp->next; + } while (plp); end_plp->next = resume.msb.chngrs; - resume.msb.chngrs = msb[i]->chngq; - msb[i]->chngq = NULL; + resume.msb.chngrs = msb[i]->chngq; + msb[i]->chngq = NULL; + } } } } @@ -7255,10 +7858,7 @@ suspend_scheduler(ErtsSchedulerData *esdp) } } - if (curr_online - && (sched_type == ERTS_SCHED_NORMAL - ? !(schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing) - : !schdlr_sspnd.msb.ongoing)) { + if (curr_online) { flgs = erts_smp_atomic32_read_acqb(&ssi->flags); if (!(flgs & ERTS_SSI_FLG_SUSPENDED)) break; @@ -7269,28 +7869,16 @@ suspend_scheduler(ErtsSchedulerData *esdp) while (1) { ErtsMonotonicTime current_time; - erts_aint32_t qmask; erts_aint32_t flgs; - qmask = (ERTS_RUNQ_FLGS_GET(esdp->run_queue) - & ERTS_RUNQ_FLGS_QMASK); - - if (sched_type != ERTS_SCHED_NORMAL) { - if (qmask) { - erts_smp_mtx_lock(&schdlr_sspnd.mtx); - erts_smp_runq_lock(esdp->run_queue); - if (schdlr_sspnd.msb.ongoing) - evacuate_run_queue(esdp->run_queue, &sbp); - erts_smp_runq_unlock(esdp->run_queue); - erts_smp_mtx_unlock(&schdlr_sspnd.mtx); - } + if (sched_type != ERTS_SCHED_NORMAL) aux_work = 0; - } else { + int evacuate = no == 1 ? 0 : !ERTS_EMPTY_RUNQ(esdp->run_queue); aux_work = erts_atomic32_read_acqb(&ssi->aux_work); - if (aux_work|qmask) { + if (aux_work|evacuate) { if (!thr_prgr_active) { erts_thr_progress_active(esdp, thr_prgr_active = 1); sched_wall_time_change(esdp, 1); @@ -7302,7 +7890,7 @@ suspend_scheduler(ErtsSchedulerData *esdp) if (aux_work && erts_thr_progress_update(esdp)) erts_thr_progress_leader_update(esdp); - if (qmask) { + if (evacuate) { erts_smp_runq_lock(esdp->run_queue); evacuate_run_queue(esdp->run_queue, &sbp); erts_smp_runq_unlock(esdp->run_queue); @@ -7414,37 +8002,46 @@ suspend_scheduler(ErtsSchedulerData *esdp) schdlr_sspnd_inc_nscheds(&schdlr_sspnd.active, sched_type); changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); - if ((changing & ERTS_SCHDLR_SSPND_CHNG_MSB) - && schdlr_sspnd.online == schdlr_sspnd.active) { - erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, - ~ERTS_SCHDLR_SSPND_CHNG_MSB); - } - + if (changing) { + if ((changing & ERTS_SCHDLR_SSPND_CHNG_MSB) + && !schdlr_sspnd.msb.ongoing + && schdlr_sspnd_eq_nscheds(&schdlr_sspnd.online, + &schdlr_sspnd.active)) { + erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, + ~ERTS_SCHDLR_SSPND_CHNG_MSB); + } + if ((changing & ERTS_SCHDLR_SSPND_CHNG_NMSB) + && !schdlr_sspnd.nmsb.ongoing + && (schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, + ERTS_SCHED_NORMAL) + == schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_NORMAL))) { + erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, + ~ERTS_SCHDLR_SSPND_CHNG_NMSB); + } + } ASSERT(no <= schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, sched_type)); - ASSERT((sched_type == ERTS_SCHED_NORMAL - ? !(schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing) - : !schdlr_sspnd.msb.ongoing)); } erts_smp_mtx_unlock(&schdlr_sspnd.mtx); - ASSERT(!resume.msb.chngrs); schdlr_sspnd_resume_procs(sched_type, &resume); ASSERT(curr_online); - if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { - if (erts_system_profile_flags.scheduler) - profile_scheduler(make_small(esdp->no), am_active); + if (sched_type != ERTS_SCHED_NORMAL) + dirty_sched_wall_time_change(esdp, 1); + else { + (void) erts_get_monotonic_time(esdp); + if (erts_system_profile_flags.scheduler) + profile_scheduler(make_small(esdp->no), am_active); - if (!thr_prgr_active) { - erts_thr_progress_active(esdp, thr_prgr_active = 1); - sched_wall_time_change(esdp, 1); - } + if (!thr_prgr_active) { + erts_thr_progress_active(esdp, thr_prgr_active = 1); + sched_wall_time_change(esdp, 1); + } } - if (sched_type == ERTS_SCHED_NORMAL) - (void) erts_get_monotonic_time(esdp); erts_smp_runq_lock(esdp->run_queue); non_empty_runq(esdp->run_queue); @@ -7552,7 +8149,7 @@ abort_sched_onln_chng_waitq(Process *p) erts_smp_mtx_unlock(&schdlr_sspnd.mtx); if (is_internal_pid(resume)) - schdlr_sspnd_resume_proc(resume); + schdlr_sspnd_resume_proc(ERTS_SCHED_NORMAL, resume); } ErtsSchedSuspendResult @@ -7714,10 +8311,8 @@ erts_set_schedulers_online(Process *p, erts_sched_poke(ssi); } } else { - for (ix = dirty_online; ix < dirty_no; ix++) { - ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); - scheduler_ssi_resume_wake(ssi); - } + for (ix = dirty_online; ix < dirty_no; ix++) + dcpu_sched_ix_resume_wake(ix); } } if (!dirty_only) @@ -7745,19 +8340,19 @@ erts_set_schedulers_online(Process *p, else /* if decrease */ { #ifdef ERTS_DIRTY_SCHEDULERS if (change_dirty) { - ErtsSchedulerSleepInfo* ssi; if (schdlr_sspnd.msb.ongoing) { - for (ix = dirty_no; ix < dirty_online; ix++) { - ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); - erts_sched_poke(ssi); - } - } else { - for (ix = dirty_no; ix < dirty_online; ix++) { - ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); - erts_smp_atomic32_read_bor_nob(&ssi->flags, - ERTS_SSI_FLG_SUSPENDED); - } - wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0); + for (ix = dirty_no; ix < dirty_online; ix++) + erts_sched_poke(ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix)); + } + else { + for (ix = dirty_no; ix < dirty_online; ix++) + dcpu_sched_ix_suspend_wake(ix); + /* + * Newly suspended scheduler may have just been + * about to handle a task. Make sure someone takes + * care of such a task... + */ + dcpu_sched_ix_wake(0); } } if (!dirty_only) @@ -7820,9 +8415,6 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal { int resume_proc, ix, res, have_unlocked_plocks = 0; ErtsProcList *plp; -#ifdef ERTS_DIRTY_SCHEDULERS - ErtsSchedulerSleepInfo* ssi; -#endif ErtsMultiSchedulingBlock *msbp; erts_aint32_t chng_flg; int have_blckd_flg; @@ -7869,8 +8461,9 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal erts_proclist_store_last(&msbp->blckrs, plp); p->flags |= have_blckd_flg; ASSERT(normal - ? 1 == schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, ERTS_SCHED_NORMAL) - : schdlr_sspnd.active == ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0)); + ? 1 == schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_NORMAL) + : schdlr_sspnd_get_nscheds_tot(&schdlr_sspnd.active) == 1); ASSERT(erts_proc_sched_data(p)->no == 1); if (schdlr_sspnd.msb.ongoing) res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED; @@ -7888,59 +8481,41 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal } ASSERT(!msbp->ongoing); msbp->ongoing = 1; - if (schdlr_sspnd.active == ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0) - || (normal && schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, - ERTS_SCHED_NORMAL) == 1)) { - ASSERT(erts_proc_sched_data(p)->no == 1); - plp = proclist_create(p); - erts_proclist_store_last(&msbp->blckrs, plp); - if (schdlr_sspnd.msb.ongoing) - res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED; - else - res = ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED; - } - else { - erts_smp_atomic32_read_bor_nob(&schdlr_sspnd.changing, - chng_flg); - change_no_used_runqs(1); - for (ix = 1; ix < erts_no_run_queues; ix++) - suspend_run_queue(ERTS_RUNQ_IX(ix)); - for (ix = 1; ix < online; ix++) { - ErtsRunQueue *rq = ERTS_RUNQ_IX(ix); - wake_scheduler(rq); - } + erts_smp_atomic32_read_bor_nob(&schdlr_sspnd.changing, + chng_flg); + change_no_used_runqs(1); + for (ix = 1; ix < erts_no_run_queues; ix++) + suspend_run_queue(ERTS_RUNQ_IX(ix)); -#ifdef ERTS_DIRTY_SCHEDULERS - if (!normal) { - for (ix = 0; ix < erts_no_dirty_cpu_schedulers; ix++) { - ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); - erts_smp_atomic32_read_bor_nob(&ssi->flags, - ERTS_SSI_FLG_SUSPENDED); - } - wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0); + for (ix = 1; ix < online; ix++) { + ErtsRunQueue *rq = ERTS_RUNQ_IX(ix); + wake_scheduler(rq); + } - for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) { - ssi = ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix); - erts_smp_atomic32_read_bor_nob(&ssi->flags, - ERTS_SSI_FLG_SUSPENDED); - } - wake_dirty_schedulers(ERTS_DIRTY_IO_RUNQ, 0); - } +#ifdef ERTS_DIRTY_SCHEDULERS + if (!normal) { + ERTS_RUNQ_FLGS_SET_NOB(ERTS_RUNQ_IX(0), ERTS_RUNQ_FLG_MSB_EXEC); + erts_smp_atomic32_read_bor_nob(&ERTS_RUNQ_IX(0)->scheduler->ssi->flags, + ERTS_SSI_FLG_MSB_EXEC); + for (ix = 0; ix < erts_no_dirty_cpu_schedulers; ix++) + dcpu_sched_ix_suspend_wake(ix); + for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) + dio_sched_ix_suspend_wake(ix); + } #endif - wait_until_msb: + wait_until_msb: - ASSERT(chng_flg & erts_smp_atomic32_read_nob(&schdlr_sspnd.changing)); + ASSERT(chng_flg & erts_smp_atomic32_read_nob(&schdlr_sspnd.changing)); - plp = proclist_create(p); - erts_proclist_store_last(&msbp->chngq, plp); - resume_proc = 0; - if (schdlr_sspnd.msb.ongoing) - res = ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED; - else - res = ERTS_SCHDLR_SSPND_YIELD_DONE_NMSCHED_BLOCKED; - } + plp = proclist_create(p); + erts_proclist_store_last(&msbp->chngq, plp); + resume_proc = 0; + if (schdlr_sspnd.msb.ongoing) + res = ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED; + else + res = ERTS_SCHDLR_SSPND_YIELD_DONE_NMSCHED_BLOCKED; ASSERT(erts_proc_sched_data(p)); } } @@ -7950,21 +8525,20 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal } else { /* ------ UNBLOCK ------ */ if (p->flags & have_blckd_flg) { - ErtsProcList *plps[2]; + ErtsProcList **plpps[3] = {0}; ErtsProcList *plp; - int limit = 0; - plps[limit++] = erts_proclist_peek_first(msbp->blckrs); - if (all) - plps[limit++] = erts_proclist_peek_first(msbp->chngq); + plpps[0] = &msbp->blckrs; + if (all) + plpps[1] = &msbp->chngq; - for (ix = 0; ix < limit; ix++) { - plp = plps[ix]; + for (ix = 0; plpps[ix]; ix++) { + plp = erts_proclist_peek_first(*plpps[ix]); while (plp) { ErtsProcList *tmp_plp = plp; - plp = erts_proclist_peek_next(msbp->blckrs, plp); + plp = erts_proclist_peek_next(*plpps[ix], plp); if (erts_proclist_same(tmp_plp, p)) { - erts_proclist_remove(&msbp->blckrs, tmp_plp); + erts_proclist_remove(plpps[ix], tmp_plp); proclist_destroy(tmp_plp); if (!all) break; @@ -7973,27 +8547,19 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal } } if (!msbp->blckrs && !msbp->chngq) { - int online = (int) schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, - ERTS_SCHED_NORMAL); + int online; erts_smp_atomic32_read_bor_nob(&schdlr_sspnd.changing, chng_flg); p->flags &= ~have_blckd_flg; msbp->ongoing = 0; - if (online == 1) { - /* No normal schedulers to resume */ - ASSERT(schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, - ERTS_SCHED_NORMAL) == 1); -#ifndef ERTS_DIRTY_SCHEDULERS - erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, - ~chng_flg); -#endif - } - else if (!(schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing)) { - if (plocks) { + if (!(schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing)) { + if (plocks) { have_unlocked_plocks = 1; erts_smp_proc_unlock(p, plocks); } + online = (int) schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, + ERTS_SCHED_NORMAL); change_no_used_runqs(online); /* Resume all online run queues */ @@ -8004,19 +8570,15 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal suspend_run_queue(ERTS_RUNQ_IX(ix)); } #ifdef ERTS_DIRTY_SCHEDULERS - if (!normal) { - ASSERT(!schdlr_sspnd.msb.ongoing); + if (!schdlr_sspnd.msb.ongoing) { + /* Get rid of msb-exec flag in run-queue of scheduler 1 */ + resume_run_queue(ERTS_RUNQ_IX(0)); online = (int) schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, ERTS_SCHED_DIRTY_CPU); - for (ix = 0; ix < online; ix++) { - ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); - scheduler_ssi_resume_wake(ssi); - } - - for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) { - ssi = ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix); - scheduler_ssi_resume_wake(ssi); - } + for (ix = 0; ix < online; ix++) + dcpu_sched_ix_resume_wake(ix); + for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) + dio_sched_ix_resume_wake(ix); } #endif } @@ -8190,6 +8752,8 @@ sched_dirty_cpu_thread_func(void *vesdp) callbacks.wait = NULL; callbacks.finalize_wait = NULL; + dirty_sched_wall_time_change(esdp, 1); + esdp->thr_id += erts_no_schedulers; erts_msacc_init_thread("dirty_cpu_scheduler", no, 0); @@ -8237,6 +8801,8 @@ sched_dirty_io_thread_func(void *vesdp) callbacks.wait = NULL; callbacks.finalize_wait = NULL; + dirty_sched_wall_time_change(esdp, 1); + esdp->thr_id += erts_no_schedulers + erts_no_dirty_cpu_schedulers; erts_msacc_init_thread("dirty_io_scheduler", no, 0); @@ -8604,8 +9170,14 @@ pid2proc_not_running(Process *c_p, ErtsProcLocks c_p_locks, * from being selected for normal execution regardless * of locks held or not held on it... */ - ASSERT(!((ERTS_PSFLG_RUNNING|ERTS_PSFLG_DIRTY_RUNNING_SYS) - & erts_smp_atomic32_read_nob(&rp->state))); +#ifdef DEBUG + { + erts_aint32_t state; + state = erts_smp_atomic32_read_nob(&rp->state); + ASSERT((state & ERTS_PSFLG_PENDING_EXIT) + || !(state & ERTS_PSFLG_RUNNING)); + } +#endif if (!suspend) resume_process(rp, pid_locks|ERTS_PROC_LOCK_STATUS); @@ -9587,40 +10159,45 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) esdp->reductions += reds; - /* schedule_out_process() returns with rq locked! */ - schedule_out_process(rq, state, p, proxy_p, is_normal_sched); - proxy_p = NULL; + { + int dec_refc; - ERTS_PROC_REDUCTIONS_EXECUTED(esdp, rq, - (int) ERTS_PSFLGS_GET_USR_PRIO(state), - reds, - actual_reds); + /* schedule_out_process() returns with rq locked! */ + dec_refc = schedule_out_process(rq, state, p, + proxy_p, is_normal_sched); + proxy_p = NULL; - esdp->current_process = NULL; + ERTS_PROC_REDUCTIONS_EXECUTED(esdp, rq, + (int) ERTS_PSFLGS_GET_USR_PRIO(state), + reds, + actual_reds); + + esdp->current_process = NULL; #ifdef ERTS_SMP - p->scheduler_data = NULL; + p->scheduler_data = NULL; #endif - erts_smp_proc_unlock(p, (ERTS_PROC_LOCK_MAIN - | ERTS_PROC_LOCK_STATUS - | ERTS_PROC_LOCK_TRACE)); + erts_smp_proc_unlock(p, (ERTS_PROC_LOCK_MAIN + | ERTS_PROC_LOCK_STATUS + | ERTS_PROC_LOCK_TRACE)); - ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER); - if (state & ERTS_PSFLG_FREE) { - if (!is_normal_sched) { - ASSERT(p->flags & F_DELAYED_DEL_PROC); - erts_proc_dec_refc(p); - } - else { #ifdef ERTS_SMP - ASSERT(esdp->free_process == p); - esdp->free_process = NULL; -#else - erts_proc_dec_refc(p); + if (state & ERTS_PSFLG_FREE) { + if (!is_normal_sched) { + ASSERT(p->flags & F_DELAYED_DEL_PROC); + } + else { + ASSERT(esdp->free_process == p); + esdp->free_process = NULL; + } + } #endif - } - } + + if (dec_refc) + erts_proc_dec_refc(p); + } #ifdef ERTS_SMP ASSERT(!esdp->free_process); @@ -9670,7 +10247,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) if (!is_normal_sched) { if (erts_smp_atomic32_read_acqb(&esdp->ssi->flags) - & ERTS_SSI_FLG_SUSPENDED) { + & (ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC)) { suspend_scheduler(esdp); } } @@ -9680,8 +10257,10 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) ASSERT(is_normal_sched); - if (flags & (ERTS_RUNQ_FLG_CHK_CPU_BIND|ERTS_RUNQ_FLG_SUSPENDED)) { - if (flags & ERTS_RUNQ_FLG_SUSPENDED) { + if (flags & (ERTS_RUNQ_FLG_CHK_CPU_BIND + | ERTS_RUNQ_FLG_SUSPENDED + | ERTS_RUNQ_FLG_MSB_EXEC)) { + if (flags & (ERTS_RUNQ_FLG_SUSPENDED|ERTS_RUNQ_FLG_MSB_EXEC)) { (void) ERTS_RUNQ_FLGS_UNSET_NOB(rq, ERTS_RUNQ_FLG_EXEC); suspend_scheduler(esdp); flags = ERTS_RUNQ_FLGS_SET_NOB(rq, ERTS_RUNQ_FLG_EXEC); @@ -9720,13 +10299,12 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) flags = ERTS_RUNQ_FLGS_GET_NOB(rq); - if (!is_normal_sched && rq->halt_in_progress) { + if (!is_normal_sched & !!(flags & ERTS_RUNQ_FLG_HALTING)) { /* Wait for emulator to terminate... */ while (1) erts_milli_sleep(1000*1000); } - else if ((!(flags & ERTS_RUNQ_FLGS_QMASK) && !rq->misc.start) - || (rq->halt_in_progress && ERTS_EMPTY_RUNQ_PORTS(rq))) { + else if (!runq_got_work_to_execute_flags(flags)) { /* Prepare for scheduler wait */ #ifdef ERTS_SMP ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); @@ -9740,21 +10318,44 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) if (flags & ERTS_RUNQ_FLG_INACTIVE) empty_runq(rq); else { - if (is_normal_sched && try_steal_task(rq)) - goto continue_check_activities_to_run; - - empty_runq(rq); - - /* - * Check for ERTS_RUNQ_FLG_SUSPENDED has to be done - * after trying to steal a task. - */ - flags = ERTS_RUNQ_FLGS_GET_NOB(rq); - if (flags & ERTS_RUNQ_FLG_SUSPENDED) { - non_empty_runq(rq); - flags |= ERTS_RUNQ_FLG_NONEMPTY; - goto continue_check_activities_to_run_known_flags; + ASSERT(!runq_got_work_to_execute(rq)); + if (!is_normal_sched) { + /* Dirty scheduler */ + if (erts_smp_atomic32_read_acqb(&esdp->ssi->flags) + & (ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC)) { + /* Go suspend... */ + goto continue_check_activities_to_run_known_flags; + } + } + else { + /* Normal scheduler */ + if (try_steal_task(rq)) + goto continue_check_activities_to_run; + /* + * Check for suspend has to be done after trying + * to steal a task... + */ + flags = ERTS_RUNQ_FLGS_GET_NOB(rq); + if ((flags & ERTS_RUNQ_FLG_SUSPENDED) +#ifdef ERTS_DIRTY_SCHEDULERS + /* If multi scheduling block and we have + * dirty work, suspend and let dirty + * scheduler handle work... */ + || ((((flags & (ERTS_RUNQ_FLG_HALTING + | ERTS_RUNQ_FLG_MSB_EXEC)) + == ERTS_RUNQ_FLG_MSB_EXEC)) + && have_dirty_work()) +#endif + ) { + non_empty_runq(rq); + flags |= ERTS_RUNQ_FLG_NONEMPTY; + /* + * Go suspend... + */ + goto continue_check_activities_to_run_known_flags; + } } + empty_runq(rq); } #endif @@ -9806,7 +10407,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) #endif } - if (rq->misc.start) + if (flags & ERTS_RUNQ_FLG_MISC_OP) exec_misc_ops(rq); #ifdef ERTS_SMP @@ -9817,13 +10418,15 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) * Find a new port to run. */ - if (RUNQ_READ_LEN(&rq->ports.info.len)) { + flags = ERTS_RUNQ_FLGS_GET_NOB(rq); + + if (flags & PORT_BIT) { int have_outstanding_io; have_outstanding_io = erts_port_task_execute(rq, &esdp->current_port); if ((!erts_eager_check_io && have_outstanding_io && fcalls > 2*input_reductions) - || rq->halt_in_progress) { + || (flags & ERTS_RUNQ_FLG_HALTING)) { /* * If we have performed more than 2*INPUT_REDUCTIONS since * last call to erl_sys_schedule() and we still haven't @@ -9896,8 +10499,12 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) if (!(state & ERTS_PSFLG_PROXY)) psflg_band_mask &= ~ERTS_PSFLG_IN_RUNQ; else { + Eterm pid = p->common.id; proxy_p = p; - p = erts_proc_lookup_raw(proxy_p->common.id); + p = (is_normal_sched + ? erts_proc_lookup_raw(pid) + : erts_pid2proc_opt(NULL, 0, pid, 0, + ERTS_P2P_FLG_INC_REFC)); if (!p) { free_proxy_proc(proxy_p); proxy_p = NULL; @@ -9929,8 +10536,10 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) | ERTS_PSFLG_FREE))) #ifdef ERTS_DIRTY_SCHEDULERS | (((state & (ERTS_PSFLG_RUNNING + | ERTS_PSFLG_FREE | ERTS_PSFLG_RUNNING_SYS + | ERTS_PSFLG_DIRTY_RUNNING_SYS | ERTS_PSFLG_EXITING)) == ERTS_PSFLG_EXITING) & (!!is_normal_sched)) @@ -9942,7 +10551,14 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) | ERTS_PSFLG_PENDING_EXIT | ERTS_PSFLG_ACTIVE_SYS | ERTS_PSFLG_DIRTY_ACTIVE_SYS)) - != ERTS_PSFLG_SUSPENDED)); + != ERTS_PSFLG_SUSPENDED) +#ifdef ERTS_DIRTY_SCHEDULERS + & (!(state & (ERTS_PSFLG_EXITING + | ERTS_PSFLG_PENDING_EXIT)) + | (!!is_normal_sched)) +#endif + ); + if (run_process) { if (state & (ERTS_PSFLG_ACTIVE_SYS | ERTS_PSFLG_DIRTY_ACTIVE_SYS)) @@ -9961,6 +10577,8 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) /* free and not queued by proxy */ erts_proc_dec_refc(p); } + if (!is_normal_sched) + erts_proc_dec_refc(p); goto pick_next_process; } state = new; @@ -10045,9 +10663,6 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) goto sunlock_sched_out_proc; } - ASSERT((state & ERTS_PSFLG_DIRTY_ACTIVE_SYS) - || *p->i == (BeamInstr) em_call_nif); - ASSERT(rq == ERTS_DIRTY_CPU_RUNQ ? (state & (ERTS_PSFLG_DIRTY_CPU_PROC | ERTS_PSFLG_DIRTY_ACTIVE_SYS)) @@ -10084,65 +10699,70 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) } } - if (state & (ERTS_PSFLG_RUNNING_SYS - | ERTS_PSFLG_DIRTY_RUNNING_SYS)) { - /* - * GC is normally never delayed when a process - * is scheduled out, but might be when executing - * hand written beam assembly in - * prim_eval:'receive'. If GC is delayed we are - * not allowed to execute system tasks. - */ - if (!(p->flags & F_DELAY_GC)) { - int cost = execute_sys_tasks(p, &state, reds); - calls += cost; - reds -= cost; - if (reds <= 0 + if (is_normal_sched) { + + if (state & ERTS_PSFLG_RUNNING_SYS) { + /* + * GC is normally never delayed when a process + * is scheduled out, but might be when executing + * hand written beam assembly in + * prim_eval:'receive'. If GC is delayed we are + * not allowed to execute system tasks. + */ + if (!(p->flags & F_DELAY_GC)) { + int cost = execute_sys_tasks(p, &state, reds); + calls += cost; + reds -= cost; + if (reds <= 0) + goto sched_out_proc; #ifdef ERTS_DIRTY_SCHEDULERS - || !is_normal_sched - || (state & ERTS_PSFLGS_DIRTY_WORK) + if (state & ERTS_PSFLGS_DIRTY_WORK) + goto sched_out_proc; #endif - ) { - goto sched_out_proc; - } - } + } - ASSERT(state & psflg_running_sys); - ASSERT(!(state & psflg_running)); + ASSERT(state & psflg_running_sys); + ASSERT(!(state & psflg_running)); - while (1) { - erts_aint32_t n, e; + while (1) { + erts_aint32_t n, e; - if (((state & (ERTS_PSFLG_SUSPENDED - | ERTS_PSFLG_ACTIVE)) != ERTS_PSFLG_ACTIVE) - && !(state & ERTS_PSFLG_EXITING)) { - goto sched_out_proc; - } + if (((state & (ERTS_PSFLG_SUSPENDED + | ERTS_PSFLG_ACTIVE)) != ERTS_PSFLG_ACTIVE) + && !(state & ERTS_PSFLG_EXITING)) { + goto sched_out_proc; + } - n = e = state; - n &= ~psflg_running_sys; - n |= psflg_running; + n = e = state; + n &= ~psflg_running_sys; + n |= psflg_running; - state = erts_smp_atomic32_cmpxchg_mb(&p->state, n, e); - if (state == e) { - state = n; - break; - } + state = erts_smp_atomic32_cmpxchg_mb(&p->state, n, e); + if (state == e) { + state = n; + break; + } - ASSERT(state & psflg_running_sys); - ASSERT(!(state & psflg_running)); - } - } + ASSERT(state & psflg_running_sys); + ASSERT(!(state & psflg_running)); + } + } - if (ERTS_IS_GC_DESIRED(p) && !ERTS_SCHEDULER_IS_DIRTY_IO(esdp)) { - if (!(state & ERTS_PSFLG_EXITING) && !(p->flags & (F_DELAY_GC|F_DISABLE_GC))) { - int cost = scheduler_gc_proc(p, reds); - calls += cost; - reds -= cost; - if (reds <= 0) - goto sched_out_proc; - } - } + if (ERTS_IS_GC_DESIRED(p)) { + if (!(state & ERTS_PSFLG_EXITING) + && !(p->flags & (F_DELAY_GC|F_DISABLE_GC))) { + int cost = scheduler_gc_proc(p, reds); + calls += cost; + reds -= cost; + if (reds <= 0) + goto sched_out_proc; +#ifdef ERTS_DIRTY_SCHEDULERS + if (p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC)) + goto sched_out_proc; +#endif + } + } + } if (proxy_p) { free_proxy_proc(proxy_p); @@ -10154,7 +10774,13 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); /* Never run a suspended process */ - ASSERT(!(ERTS_PSFLG_SUSPENDED & erts_smp_atomic32_read_nob(&p->state))); +#ifdef DEBUG + { + erts_aint32_t dstate = erts_smp_atomic32_read_nob(&p->state); + ASSERT(!(ERTS_PSFLG_SUSPENDED & dstate) + || (ERTS_PSFLG_DIRTY_RUNNING_SYS & dstate)); + } +#endif ASSERT(erts_proc_read_refc(p) > 0); @@ -10175,9 +10801,18 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) } static int -notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st, Eterm st_result) +notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st, + Eterm st_result, int normal_sched) { - Process *rp = erts_proc_lookup(st->requester); + Process *rp; +#ifdef ERTS_DIRTY_SCHEDULERS + if (!normal_sched) + rp = erts_pid2proc_opt(c_p, ERTS_PROC_LOCK_MAIN, + st->requester, 0, + ERTS_P2P_FLG_INC_REFC); + else +#endif + rp = erts_proc_lookup(st->requester); if (rp) { ErtsProcLocks rp_locks; ErlOffHeap *ohp; @@ -10225,6 +10860,11 @@ notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st, Eterm st_result) if (rp_locks) erts_smp_proc_unlock(rp, rp_locks); + +#ifdef ERTS_DIRTY_SCHEDULERS + if (!normal_sched) + erts_proc_dec_refc(rp); +#endif } erts_cleanup_offheap(&st->off_heap); @@ -10380,18 +11020,23 @@ done: } static void save_gc_task(Process *c_p, ErtsProcSysTask *st, int prio); +#ifdef ERTS_DIRTY_SCHEDULERS +static void save_dirty_task(Process *c_p, ErtsProcSysTask *st); +#endif static int execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) { - int garbage_collected = 0; + int minor_gc = 0, major_gc = 0; erts_aint32_t state = *statep; int reds = in_reds; int qmask = 0; + ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(c_p))); ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCK_MAIN); do { + ErtsProcSysTaskType type; ErtsProcSysTask *st; int st_prio; Eterm st_res; @@ -10409,7 +11054,9 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) if (!st) break; - switch (st->type) { + type = st->type; + + switch (type) { case ERTS_PSTT_GC_MAJOR: case ERTS_PSTT_GC_MINOR: if (c_p->flags & F_DISABLE_GC) { @@ -10418,12 +11065,23 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) reds--; } else { - if (!garbage_collected) { - if (st->type == ERTS_PSTT_GC_MAJOR) { + if (!minor_gc + || (!major_gc && type == ERTS_PSTT_GC_MAJOR)) { + if (type == ERTS_PSTT_GC_MAJOR) { FLAGS(c_p) |= F_NEED_FULLSWEEP; } reds -= scheduler_gc_proc(c_p, reds); - garbage_collected = 1; +#ifdef ERTS_DIRTY_SCHEDULERS + if (c_p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC)) { + save_dirty_task(c_p, st); + st = NULL; + break; + } +#endif + if (type == ERTS_PSTT_GC_MAJOR) + minor_gc = major_gc = 1; + else + minor_gc = 1; } st_res = am_true; } @@ -10450,20 +11108,31 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) case ERTS_PSTT_CLA: { int fcalls; int cla_reds = 0; + int do_gc; + if (!ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) fcalls = reds; else fcalls = reds - CONTEXT_REDS; - st_res = erts_proc_copy_literal_area(c_p, - &cla_reds, - fcalls, - st->arg[0] == am_true); + do_gc = st->arg[0] == am_true; + st_res = erts_proc_copy_literal_area(c_p, &cla_reds, + fcalls, do_gc); reds -= cla_reds; if (is_non_value(st_res)) { +#ifdef ERTS_DIRTY_SCHEDULERS + if (c_p->flags & F_DIRTY_CLA) { + save_dirty_task(c_p, st); + st = NULL; + break; + } +#endif /* Needed gc, but gc was disabled */ save_gc_task(c_p, st, st_prio); st = NULL; + break; } + if (do_gc) /* We did a major gc */ + minor_gc = major_gc = 1; break; } case ERTS_PSTT_COHMQ: @@ -10482,7 +11151,7 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) } if (st) - reds += notify_sys_task_executed(c_p, st, st_res); + reds += notify_sys_task_executed(c_p, st, st_res, 1); state = erts_smp_atomic32_read_acqb(&c_p->state); } while (qmask && reds > 0); @@ -10510,9 +11179,18 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds) Eterm st_res; int st_prio; - st = fetch_sys_task(c_p, state, &qmask, &st_prio); - if (!st) - break; +#ifdef ERTS_DIRTY_SCHEDULERS + if (c_p->dirty_sys_tasks) { + st = c_p->dirty_sys_tasks; + c_p->dirty_sys_tasks = st->next; + } + else +#endif + { + st = fetch_sys_task(c_p, state, &qmask, &st_prio); + if (!st) + break; + } switch (st->type) { case ERTS_PSTT_GC_MAJOR: @@ -10536,7 +11214,7 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds) break; } - reds += notify_sys_task_executed(c_p, st, st_res); + reds += notify_sys_task_executed(c_p, st, st_res, 1); state = erts_smp_atomic32_read_acqb(&c_p->state); } while (qmask && reds < max_reds); @@ -10546,6 +11224,92 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds) #ifdef ERTS_DIRTY_SCHEDULERS +void +erts_execute_dirty_system_task(Process *c_p) +{ + Eterm cla_res = THE_NON_VALUE; + ErtsProcSysTask *stasks; + + /* + * If multiple operations, perform them in the following + * order (in order to avoid unnecessary GC): + * 1. Copy Literal Area (implies major GC). + * 2. GC Hibernate (implies major GC if not woken). + * 3. Major GC (implies minor GC). + * 4. Minor GC. + * + * System task requests are handled after the actual + * operations have been performed... + */ + + ASSERT(!(c_p->flags & (F_DELAY_GC|F_DISABLE_GC))); + + if (c_p->flags & F_DIRTY_CLA) { + int cla_reds = 0; + cla_res = erts_proc_copy_literal_area(c_p, &cla_reds, c_p->fcalls, 1); + ASSERT(is_value(cla_res)); + } + + if (c_p->flags & F_DIRTY_GC_HIBERNATE) { + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS); + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); + if (c_p->msg.len) + c_p->flags &= ~F_DIRTY_GC_HIBERNATE; /* operation aborted... */ + else { + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS); + c_p->fvalue = NIL; + erts_garbage_collect_hibernate(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS); + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + } + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS); + } + + if (c_p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC)) { + if (c_p->flags & F_DIRTY_MAJOR_GC) + c_p->flags |= F_NEED_FULLSWEEP; + (void) erts_garbage_collect_nobump(c_p, 0, c_p->arg_reg, + c_p->arity, c_p->fcalls); + } + + ASSERT(!(c_p->flags & (F_DIRTY_CLA + | F_DIRTY_GC_HIBERNATE + | F_DIRTY_MAJOR_GC + | F_DIRTY_MINOR_GC))); + + stasks = c_p->dirty_sys_tasks; + c_p->dirty_sys_tasks = NULL; + + while (stasks) { + Eterm st_res; + ErtsProcSysTask *st = stasks; + stasks = st->next; + + switch (st->type) { + case ERTS_PSTT_CLA: + ASSERT(is_value(st_res)); + st_res = cla_res; + break; + case ERTS_PSTT_GC_MAJOR: + st_res = am_true; + break; + case ERTS_PSTT_GC_MINOR: + st_res = am_true; + break; + + default: + ERTS_INTERNAL_ERROR("Not supported dirty system task"); + break; + } + + (void) notify_sys_task_executed(c_p, st, st_res, 0); + + } + + erts_smp_atomic32_read_band_relb(&c_p->state, ~ERTS_PSFLG_DIRTY_ACTIVE_SYS); +} + static BIF_RETTYPE dispatch_system_task(Process *c_p, erts_aint_t fail_state, ErtsProcSysTask *st, Eterm target, @@ -10748,7 +11512,7 @@ request_system_task(Process *c_p, Eterm requester, Eterm target, ERTS_INTERNAL_ERROR("Unknown failure schedule_process_sys_task()"); failure = am_internal_error; } - notify_sys_task_executed(c_p, st, failure); + notify_sys_task_executed(c_p, st, failure, 1); } ERTS_BIF_PREP_RET(ret, am_ok); @@ -10963,6 +11727,15 @@ save_gc_task(Process *c_p, ErtsProcSysTask *st, int prio) } } +#ifdef ERTS_DIRTY_SCHEDULERS +static void +save_dirty_task(Process *c_p, ErtsProcSysTask *st) +{ + st->next = c_p->dirty_sys_tasks; + c_p->dirty_sys_tasks = st; +} +#endif + int erts_set_gc_state(Process *c_p, int enable) { @@ -11185,6 +11958,8 @@ erts_schedule_misc_op(void (*func)(void *), void *arg) non_empty_runq(rq); #endif + ERTS_RUNQ_FLGS_SET_NOB(rq, ERTS_RUNQ_FLG_MISC_OP); + erts_smp_runq_unlock(rq); smp_notify_inc_runq(rq); @@ -11215,6 +11990,9 @@ exec_misc_ops(ErtsRunQueue *rq) rq->misc.end = NULL; } + if (!rq->misc.start) + ERTS_RUNQ_FLGS_UNSET_NOB(rq, ERTS_RUNQ_FLG_MISC_OP); + erts_smp_runq_unlock(rq); while (molp) { @@ -11299,6 +12077,7 @@ static void early_init_process_struct(void *varg, Eterm data) proc->common.id = make_internal_pid(data); #ifdef ERTS_DIRTY_SCHEDULERS erts_smp_atomic32_init_nob(&proc->dirty_state, 0); + proc->dirty_sys_tasks = NULL; #endif erts_smp_atomic32_init_relb(&proc->state, arg->state); @@ -11807,6 +12586,7 @@ void erts_init_empty_process(Process *p) #ifdef ERTS_DIRTY_SCHEDULERS erts_smp_atomic32_init_nob(&p->dirty_state, 0); + p->dirty_sys_tasks = NULL; #endif erts_smp_atomic32_init_nob(&p->state, (erts_aint32_t) PRIORITY_NORMAL); @@ -11915,11 +12695,9 @@ erts_cleanup_empty_process(Process* p) static void delete_process(Process* p) { - Eterm *heap; ErtsPSD *psd; struct saved_calls *scb; process_breakpoint_time_t *pbt; - void *nif_export; VERBOSE(DEBUG_PROCESSES, ("Removing process: %T\n",p->common.id)); VERBOSE(DEBUG_SHCOPY, ("[pid=%T] delete process: %p %p %p %p\n", p->common.id, @@ -11936,9 +12714,7 @@ delete_process(Process* p) if (pbt) erts_free(ERTS_ALC_T_BPD, (void *) pbt); - nif_export = ERTS_PROC_SET_NIF_TRAP_EXPORT(p, NULL); - if (nif_export) - erts_destroy_nif_export(nif_export); + erts_destroy_nif_export(p); /* Cleanup psd */ @@ -11970,13 +12746,8 @@ delete_process(Process* p) hipe_delete_process(&p->hipe); #endif - heap = p->abandoned_heap ? p->abandoned_heap : p->heap; + erts_deallocate_young_generation(p); -#ifdef DEBUG - sys_memset(heap, DEBUG_BAD_BYTE, p->heap_sz*sizeof(Eterm)); -#endif - - ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, (void*) heap, p->heap_sz*sizeof(Eterm)); if (p->old_heap != NULL) { #ifdef DEBUG @@ -11988,16 +12759,6 @@ delete_process(Process* p) (p->old_hend-p->old_heap)*sizeof(Eterm)); } - /* - * Free all pending message buffers. - */ - if (p->mbuf != NULL) { - free_message_buffer(p->mbuf); - } - - if (p->msg_frag) - erts_cleanup_messages(p->msg_frag); - erts_erase_dicts(p); /* free all pending messages */ @@ -12397,7 +13158,9 @@ send_exit_signal(Process *c_p, /* current process if and only } set_proc_exiting(c_p, state, rsn, NULL); } - else if (!(state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS))) { + else if (!(state & (ERTS_PSFLG_RUNNING + | ERTS_PSFLG_RUNNING_SYS + | ERTS_PSFLG_DIRTY_RUNNING_SYS))) { /* Process not running ... */ ErtsProcLocks need_locks = ~(*rp_locks) & ERTS_PROC_LOCKS_ALL; ErlHeapFragment *bp = NULL; @@ -12424,8 +13187,7 @@ send_exit_signal(Process *c_p, /* current process if and only ErlOffHeap *ohp; Uint rsn_sz = size_object(rsn); #ifdef ERTS_DIRTY_SCHEDULERS - if (state & (ERTS_PSFLG_DIRTY_RUNNING - | ERTS_PSFLG_DIRTY_RUNNING_SYS)) { + if (state & ERTS_PSFLG_DIRTY_RUNNING) { bp = new_message_buffer(rsn_sz); ohp = &bp->off_heap; hp = &bp->mem[0]; @@ -12442,7 +13204,7 @@ send_exit_signal(Process *c_p, /* current process if and only set_proc_exiting(rp, state, rsn_cpy, bp); } else { /* Process running... */ - + /* * The pending exit will be discovered when the process * is scheduled out if not discovered earlier. @@ -12464,8 +13226,35 @@ send_exit_signal(Process *c_p, /* current process if and only &bp->off_heap); rp->pending_exit.bp = bp; } - erts_smp_atomic32_read_bor_relb(&rp->state, - ERTS_PSFLG_PENDING_EXIT); + + /* + * If no dirty work has been scheduled, pending exit will + * be discovered when the process is scheduled. If dirty work + * has been scheduled, we may need to add it to a normal run + * queue... + */ +#ifndef ERTS_DIRTY_SCHEDULERS + (void) erts_smp_atomic32_read_bor_relb(&rp->state, + ERTS_PSFLG_PENDING_EXIT); +#else + { + erts_aint32_t a = erts_smp_atomic32_read_nob(&rp->state); + while (1) { + erts_aint32_t n, e; + int dwork; + n = e = a; + n |= ERTS_PSFLG_PENDING_EXIT; + dwork = !!(n & ERTS_PSFLGS_DIRTY_WORK); + n &= ~ERTS_PSFLGS_DIRTY_WORK; + a = erts_smp_atomic32_cmpxchg_mb(&rp->state, n, e); + if (a == e) { + if (dwork) + erts_schedule_process(rp, n, *rp_locks); + break; + } + } + } +#endif } } /* else: @@ -13094,15 +13883,14 @@ erts_continue_exit_process(Process *p) } #ifdef ERTS_DIRTY_SCHEDULERS - if (a & (ERTS_PSFLG_DIRTY_RUNNING - | ERTS_PSFLG_DIRTY_RUNNING_SYS)) { + if (a & (ERTS_PSFLG_DIRTY_RUNNING + | ERTS_PSFLG_DIRTY_RUNNING_SYS)) { p->flags |= F_DELAYED_DEL_PROC; delay_del_proc = 1; /* - * The dirty scheduler will also decrease - * refc when done... + * The dirty scheduler decrease refc + * when done with the process... */ - erts_proc_inc_refc(p); } #endif @@ -13316,6 +14104,8 @@ erts_print_scheduler_info(fmtfn_t to, void *to_arg, ErtsSchedulerData *esdp) { erts_print(to, to_arg, "WAITING"); break; case ERTS_SSI_FLG_SUSPENDED: erts_print(to, to_arg, "SUSPENDED"); break; + case ERTS_SSI_FLG_MSB_EXEC: + erts_print(to, to_arg, "MSB_EXEC"); break; default: erts_print(to, to_arg, "UNKNOWN(%d)", flg); break; } @@ -13425,6 +14215,12 @@ erts_print_scheduler_info(fmtfn_t to, void *to_arg, ErtsSchedulerData *esdp) { erts_print(to, to_arg, "NONEMPTY"); break; case ERTS_RUNQ_FLG_PROTECTED: erts_print(to, to_arg, "PROTECTED"); break; + case ERTS_RUNQ_FLG_EXEC: + erts_print(to, to_arg, "EXEC"); break; + case ERTS_RUNQ_FLG_MSB_EXEC: + erts_print(to, to_arg, "MSB_EXEC"); break; + case ERTS_RUNQ_FLG_MISC_OP: + erts_print(to, to_arg, "MISC_OP"); break; default: erts_print(to, to_arg, "UNKNOWN(%d)", flg); break; } @@ -13474,11 +14270,11 @@ erts_print_scheduler_info(fmtfn_t to, void *to_arg, ErtsSchedulerData *esdp) { * A nice system halt closing all open port goes as follows: * 1) This function schedules the aux work ERTS_SSI_AUX_WORK_REAP_PORTS * on all schedulers, then schedules itself out. - * 2) All shedulers detect this and set the flag halt_in_progress + * 2) All shedulers detect this and set the flag ERTS_RUNQ_FLG_HALTING * on their run queue. The last scheduler sets all non-closed ports * ERTS_PORT_SFLG_HALT. Global atomic erts_halt_progress is used * as refcount to determine which is last. - * 3) While the run ques has flag halt_in_progress no processes + * 3) While the run queues has flag ERTS_RUNQ_FLG_HALTING no processes * will be scheduled, only ports. * 4) When the last port closes that scheduler calls erlang:halt/1. * The same global atomic is used as refcount. @@ -13493,8 +14289,8 @@ void erts_halt(int code) erts_no_schedulers, -1)) { #ifdef ERTS_DIRTY_SCHEDULERS - ERTS_DIRTY_CPU_RUNQ->halt_in_progress = 1; - ERTS_DIRTY_IO_RUNQ->halt_in_progress = 1; + ERTS_RUNQ_FLGS_SET(ERTS_DIRTY_CPU_RUNQ, ERTS_RUNQ_FLG_HALTING); + ERTS_RUNQ_FLGS_SET(ERTS_DIRTY_IO_RUNQ, ERTS_RUNQ_FLG_HALTING); #endif erts_halt_code = code; notify_reap_ports_relb(); @@ -13508,6 +14304,9 @@ erts_dbg_check_halloc_lock(Process *p) ErtsSchedulerData *esdp; if (ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p)) return 1; + if ((p->static_flags & ERTS_STC_FLG_SHADOW_PROC) + && ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data())) + return 1; if (p->common.id == ERTS_INVALID_PID) return 1; esdp = erts_proc_sched_data(p); diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 1c4b9f149d..ce0989883c 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -170,8 +170,14 @@ extern int erts_sched_thread_suggested_stack_size; (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 6)) #define ERTS_RUNQ_FLG_EXEC \ (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 7)) +#define ERTS_RUNQ_FLG_MSB_EXEC \ + (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 8)) +#define ERTS_RUNQ_FLG_MISC_OP \ + (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 9)) +#define ERTS_RUNQ_FLG_HALTING \ + (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 10)) -#define ERTS_RUNQ_FLG_MAX (ERTS_RUNQ_FLG_BASE2 + 8) +#define ERTS_RUNQ_FLG_MAX (ERTS_RUNQ_FLG_BASE2 + 11) #define ERTS_RUNQ_FLGS_MIGRATION_QMASKS \ (ERTS_RUNQ_FLGS_EMIGRATE_QMASK \ @@ -262,8 +268,9 @@ typedef enum { #define ERTS_SSI_FLG_TSE_SLEEPING (((erts_aint32_t) 1) << 2) #define ERTS_SSI_FLG_WAITING (((erts_aint32_t) 1) << 3) #define ERTS_SSI_FLG_SUSPENDED (((erts_aint32_t) 1) << 4) +#define ERTS_SSI_FLG_MSB_EXEC (((erts_aint32_t) 1) << 5) -#define ERTS_SSI_FLGS_MAX 5 +#define ERTS_SSI_FLGS_MAX 6 #define ERTS_SSI_FLGS_SLEEP_TYPE \ (ERTS_SSI_FLG_TSE_SLEEPING|ERTS_SSI_FLG_POLL_SLEEPING) @@ -274,7 +281,8 @@ typedef enum { #define ERTS_SSI_FLGS_ALL \ (ERTS_SSI_FLGS_SLEEP \ | ERTS_SSI_FLG_WAITING \ - | ERTS_SSI_FLG_SUSPENDED) + | ERTS_SSI_FLG_SUSPENDED \ + | ERTS_SSI_FLG_MSB_EXEC) /* * Keep ERTS_SSI_AUX_WORK flags ordered in expected frequency @@ -393,6 +401,12 @@ typedef struct { Process* last; } ErtsRunPrioQueue; +typedef enum { + ERTS_SCHED_NORMAL, + ERTS_SCHED_DIRTY_CPU, + ERTS_SCHED_DIRTY_IO +} ErtsSchedType; + typedef struct ErtsSchedulerData_ ErtsSchedulerData; typedef struct ErtsRunQueue_ ErtsRunQueue; @@ -478,7 +492,6 @@ struct ErtsRunQueue_ { erts_smp_atomic32_t len; int wakeup_other; int wakeup_other_reds; - int halt_in_progress; struct { ErtsProcList *pending_exiters; @@ -537,13 +550,15 @@ do { \ } while (0) typedef struct { - int need; /* "+sbu true" or scheduler_wall_time enabled */ + union { + erts_atomic32_t mod; /* on dirty schedulers */ + int need; /* "+sbu true" or scheduler_wall_time enabled */ + } u; int enabled; Uint64 start; struct { Uint64 total; Uint64 start; - int currently; } working; } ErtsSchedWallTime; @@ -642,6 +657,7 @@ struct ErtsSchedulerData_ { #endif ErtsSchedulerSleepInfo *ssi; Process *current_process; + ErtsSchedType type; Uint no; /* Scheduler number for normal schedulers */ #ifdef ERTS_DIRTY_SCHEDULERS ErtsDirtySchedId dirty_no; /* Scheduler number for dirty schedulers */ @@ -838,8 +854,8 @@ typedef struct { #define ERTS_PSD_DELAYED_GC_TASK_QS_GET_LOCKS ERTS_PROC_LOCK_MAIN #define ERTS_PSD_DELAYED_GC_TASK_QS_SET_LOCKS ERTS_PROC_LOCK_MAIN -#define ERTS_PSD_NIF_TRAP_EXPORT_GET_LOCKS ((ErtsProcLocks) 0) -#define ERTS_PSD_NIF_TRAP_EXPORT_SET_LOCKS ((ErtsProcLocks) 0) +#define ERTS_PSD_NIF_TRAP_EXPORT_GET_LOCKS ERTS_PROC_LOCK_MAIN +#define ERTS_PSD_NIF_TRAP_EXPORT_SET_LOCKS ERTS_PROC_LOCK_MAIN typedef struct { ErtsProcLocks get_locks; @@ -1060,6 +1076,9 @@ struct process { Uint64 bin_old_vheap; /* Virtual old heap size for binaries */ ErtsProcSysTaskQs *sys_task_qs; +#ifdef ERTS_DIRTY_SCHEDULERS + ErtsProcSysTask *dirty_sys_tasks; +#endif erts_smp_atomic32_t state; /* Process state flags (see ERTS_PSFLG_*) */ #ifdef ERTS_DIRTY_SCHEDULERS @@ -1384,14 +1403,18 @@ extern int erts_system_profile_ts_type; #define F_FORCE_GC (1 << 10) /* Force gc at process in-scheduling */ #define F_DISABLE_GC (1 << 11) /* Disable GC (see below) */ #define F_OFF_HEAP_MSGQ (1 << 12) /* Off heap msg queue */ -#define F_ON_HEAP_MSGQ (1 << 13) /* Off heap msg queue */ +#define F_ON_HEAP_MSGQ (1 << 13) /* On heap msg queue */ #define F_OFF_HEAP_MSGQ_CHNG (1 << 14) /* Off heap msg queue changing */ #define F_ABANDONED_HEAP_USE (1 << 15) /* Have usage of abandoned heap */ #define F_DELAY_GC (1 << 16) /* Similar to disable GC (see below) */ #define F_SCHDLR_ONLN_WAITQ (1 << 17) /* Process enqueued waiting to change schedulers online */ #define F_HAVE_BLCKD_NMSCHED (1 << 18) /* Process has blocked normal multi-scheduling */ -#define F_HIPE_MODE (1 << 19) +#define F_HIPE_MODE (1 << 19) /* Process is executing in HiPE mode */ #define F_DELAYED_DEL_PROC (1 << 20) /* Delay delete process (dirty proc exit case) */ +#define F_DIRTY_CLA (1 << 21) /* Dirty copy literal area scheduled */ +#define F_DIRTY_GC_HIBERNATE (1 << 22) /* Dirty GC hibernate scheduled */ +#define F_DIRTY_MAJOR_GC (1 << 23) /* Dirty major GC scheduled */ +#define F_DIRTY_MINOR_GC (1 << 24) /* Dirty minor GC scheduled */ /* * F_DISABLE_GC and F_DELAY_GC are similar. Both will prevent @@ -1573,19 +1596,18 @@ void erts_init_scheduling(int, int , int, int, int #endif ); - +#ifdef ERTS_DIRTY_SCHEDULERS +void erts_execute_dirty_system_task(Process *c_p); +#endif int erts_set_gc_state(Process *c_p, int enable); -Eterm erts_sched_wall_time_request(Process *c_p, int set, int enable); +Eterm erts_sched_wall_time_request(Process *c_p, int set, int enable, + int dirty_cpu, int want_dirty_io); Eterm erts_system_check_request(Process *c_p); Eterm erts_gc_info_request(Process *c_p); Uint64 erts_get_proc_interval(void); Uint64 erts_ensure_later_proc_interval(Uint64); Uint64 erts_step_proc_interval(void); -int erts_setup_nif_gc(Process* proc, Eterm** objv, int* nobj); /* see erl_nif.c */ -void erts_destroy_nif_export(void *); /* see erl_nif.c */ -int erts_check_nif_export_in_area(Process *p, char *start, Uint size); - ErtsProcList *erts_proclist_create(Process *); ErtsProcList *erts_proclist_copy(ErtsProcList *); void erts_proclist_destroy(ErtsProcList *); @@ -1681,7 +1703,7 @@ ERTS_GLB_INLINE ErtsProcList *erts_proclist_fetch_first(ErtsProcList **list) return NULL; else { ErtsProcList *res = *list; - if (res == *list) + if (res->next == *list) *list = NULL; else *list = res->next; @@ -1922,6 +1944,8 @@ ErtsSchedulerData *erts_get_scheduler_data(void) void erts_schedule_process(Process *, erts_aint32_t, ErtsProcLocks); ERTS_GLB_INLINE void erts_proc_notify_new_message(Process *p, ErtsProcLocks locks); +ERTS_GLB_INLINE void erts_schedule_dirty_sys_execution(Process *c_p); + #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE void erts_proc_notify_new_message(Process *p, ErtsProcLocks locks) @@ -1931,6 +1955,34 @@ erts_proc_notify_new_message(Process *p, ErtsProcLocks locks) if (!(state & ERTS_PSFLG_ACTIVE)) erts_schedule_process(p, state, locks); } + +ERTS_GLB_INLINE void +erts_schedule_dirty_sys_execution(Process *c_p) +{ + erts_aint32_t a, n, e; + + a = erts_smp_atomic32_read_nob(&c_p->state); + + /* + * Only a currently executing process schedules + * itself for dirty-sys execution... + */ + + ASSERT(a & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS)); + + /* Don't set dirty-active-sys if we are about to exit... */ + + while (!(a & (ERTS_PSFLG_DIRTY_ACTIVE_SYS + | ERTS_PSFLG_EXITING + | ERTS_PSFLG_PENDING_EXIT))) { + e = a; + n = a | ERTS_PSFLG_DIRTY_ACTIVE_SYS; + a = erts_smp_atomic32_cmpxchg_mb(&c_p->state, n, e); + if (a == e) + break; /* dirty-active-sys set */ + } +} + #endif #if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c index e534c33637..7c23b5c76a 100644 --- a/erts/emulator/beam/erl_process_dump.c +++ b/erts/emulator/beam/erl_process_dump.c @@ -90,9 +90,12 @@ Uint erts_process_memory(Process *p, int incl_msg_inq) { erts_doforall_links(ERTS_P_LINKS(p), &erts_one_link_size, &size); erts_doforall_monitors(ERTS_P_MONITORS(p), &erts_one_mon_size, &size); size += (p->heap_sz + p->mbuf_sz) * sizeof(Eterm); + if (p->abandoned_heap) + size += (p->hend - p->heap) * sizeof(Eterm); if (p->old_hend && p->old_heap) size += (p->old_hend - p->old_heap) * sizeof(Eterm); + size += p->msg.len * sizeof(ErtsMessage); for (mp = p->msg.first; mp; mp = mp->next) diff --git a/erts/emulator/beam/erl_process_lock.c b/erts/emulator/beam/erl_process_lock.c index 180df229eb..a93f1755c8 100644 --- a/erts/emulator/beam/erl_process_lock.c +++ b/erts/emulator/beam/erl_process_lock.c @@ -1006,6 +1006,41 @@ erts_pid2proc_opt(Process *c_p, return proc; } +static ERTS_INLINE +Process *proc_lookup_inc_refc(Eterm pid, int allow_exit) +{ + Process *proc; +#ifdef ERTS_SMP + ErtsThrPrgrDelayHandle dhndl; + + dhndl = erts_thr_progress_unmanaged_delay(); +#endif + + proc = erts_proc_lookup_raw(pid); + if (proc) { + if (!allow_exit && ERTS_PROC_IS_EXITING(proc)) + proc = NULL; + else + erts_proc_inc_refc(proc); + } + +#ifdef ERTS_SMP + erts_thr_progress_unmanaged_continue(dhndl); +#endif + + return proc; +} + +Process *erts_proc_lookup_inc_refc(Eterm pid) +{ + return proc_lookup_inc_refc(pid, 0); +} + +Process *erts_proc_lookup_raw_inc_refc(Eterm pid) +{ + return proc_lookup_inc_refc(pid, 1); +} + void erts_proc_lock_init(Process *p) { diff --git a/erts/emulator/beam/erl_process_lock.h b/erts/emulator/beam/erl_process_lock.h index 2cccf0697a..46a72fcb0c 100644 --- a/erts/emulator/beam/erl_process_lock.h +++ b/erts/emulator/beam/erl_process_lock.h @@ -219,6 +219,10 @@ typedef struct erts_proc_lock_t_ { #define ERTS_PROC_LOCKS_ALL_MINOR (ERTS_PROC_LOCKS_ALL \ & ~ERTS_PROC_LOCK_MAIN) +/* All locks we first must unlock to lock L */ +#define ERTS_PROC_LOCKS_HIGHER_THAN(L) \ + (ERTS_PROC_LOCKS_ALL & (~(L) & ~((L)-1))) + #define ERTS_PIX_LOCKS_BITS 10 #define ERTS_NO_OF_PIX_LOCKS (1 << ERTS_PIX_LOCKS_BITS) @@ -940,6 +944,8 @@ void erts_proc_safelock(Process *a_proc, #define erts_pid2proc(PROC, HL, PID, NL) \ erts_pid2proc_opt((PROC), (HL), (PID), (NL), 0) +Process *erts_proc_lookup_inc_refc(Eterm pid); +Process *erts_proc_lookup_raw_inc_refc(Eterm pid); ERTS_GLB_INLINE Process *erts_pix2proc(int ix); ERTS_GLB_INLINE Process *erts_proc_lookup_raw(Eterm pid); diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index 9be4741ec8..04f3160d42 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -1435,6 +1435,7 @@ void trace_gc(Process *p, Eterm what, Uint size, Eterm msg) { ErtsTracerNif *tnif = NULL; + Eterm* o_hp = NULL; Eterm* hp; Uint sz = 0; Eterm tup; @@ -1445,7 +1446,7 @@ trace_gc(Process *p, Eterm what, Uint size, Eterm msg) if (is_non_value(msg)) { (void) erts_process_gc_info(p, &sz, NULL, 0, 0); - hp = HAlloc(p, sz + 3 + 2); + o_hp = hp = erts_alloc(ERTS_ALC_T_TMP, (sz + 3 + 2) * sizeof(Eterm)); msg = erts_process_gc_info(p, NULL, &hp, 0, 0); tup = TUPLE2(hp, am_wordsize, make_small(size)); hp += 3; @@ -1454,6 +1455,8 @@ trace_gc(Process *p, Eterm what, Uint size, Eterm msg) send_to_tracer_nif(p, &p->common, p->common.id, tnif, TRACE_FUN_T_GC, what, msg, THE_NON_VALUE, am_true); + if (o_hp) + erts_free(ERTS_ALC_T_TMP, o_hp); } } diff --git a/erts/emulator/beam/erl_trace.h b/erts/emulator/beam/erl_trace.h index 378b6de49c..01fe1e5e23 100644 --- a/erts/emulator/beam/erl_trace.h +++ b/erts/emulator/beam/erl_trace.h @@ -143,6 +143,11 @@ Uint erts_trace_flag2bit(Eterm flag); int erts_trace_flags(Eterm List, Uint *pMask, ErtsTracer *pTracer, int *pCpuTimestamp); Eterm erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr *I); +Eterm +erts_bif_trace_epilogue(Process *p, Eterm result, int applying, + Export* ep, BeamInstr *cp, Uint32 flags, + Uint32 flags_meta, BeamInstr* I, + ErtsTracer meta_tracer); #ifdef ERTS_SMP void erts_send_pending_trace_msgs(ErtsSchedulerData *esdp); diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index 93cfe08105..d88cafc5bf 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -36,7 +36,7 @@ #define EMULATOR "BEAM" #define SEQ_TRACE 1 -#define CONTEXT_REDS 2000 /* Swap process out after this number */ +#define CONTEXT_REDS 4000 /* Swap process out after this number */ #define MAX_ARG 255 /* Max number of arguments allowed */ #define MAX_REG 1024 /* Max number of x(N) registers used */ diff --git a/erts/emulator/beam/error.h b/erts/emulator/beam/error.h index e431c3051b..64c08b1570 100644 --- a/erts/emulator/beam/error.h +++ b/erts/emulator/beam/error.h @@ -39,14 +39,11 @@ */ /* - * Bits 0-1 index the 'exception class tag' table. - */ -#define EXC_CLASSBITS 3 -#define GET_EXC_CLASS(x) ((x) & EXC_CLASSBITS) - -/* * Exception class tags (indices into the 'exception_tag' array) */ +#define EXTAG_OFFSET 0 +#define EXTAG_BITS 2 + #define EXTAG_ERROR 0 #define EXTAG_EXIT 1 #define EXTAG_THROWN 2 @@ -54,20 +51,31 @@ #define NUMBER_EXC_TAGS 3 /* The number of exception class tags */ /* - * Exit code flags (bits 2-7) + * Index to the 'exception class tag' table. + */ +#define EXC_CLASSBITS ((1<<EXTAG_BITS)-1) +#define GET_EXC_CLASS(x) ((x) & EXC_CLASSBITS) + +/* + * Exit code flags * * These flags make is easier and quicker to decide what to do with the * exception in the early stages, before a handler is found, and also * maintains some separation between the class tag and the actions. */ -#define EXF_PANIC (1<<2) /* ignore catches */ -#define EXF_THROWN (1<<3) /* nonlocal return */ -#define EXF_LOG (1<<4) /* write to logger on termination */ -#define EXF_NATIVE (1<<5) /* occurred in native code */ -#define EXF_SAVETRACE (1<<6) /* save stack trace in internal form */ -#define EXF_ARGLIST (1<<7) /* has arglist for top of trace */ +#define EXF_OFFSET EXTAG_BITS +#define EXF_BITS 7 -#define EXC_FLAGBITS 0x00fc +#define EXF_PANIC (1<<(0+EXF_OFFSET)) /* ignore catches */ +#define EXF_THROWN (1<<(1+EXF_OFFSET)) /* nonlocal return */ +#define EXF_LOG (1<<(2+EXF_OFFSET)) /* write to logger on termination */ +#define EXF_NATIVE (1<<(3+EXF_OFFSET)) /* occurred in native code */ +#define EXF_SAVETRACE (1<<(4+EXF_OFFSET)) /* save stack trace in internal form */ +#define EXF_ARGLIST (1<<(5+EXF_OFFSET)) /* has arglist for top of trace */ +#define EXF_RESTORE_NIF (1<<(6+EXF_OFFSET)) /* restore original bif/nif */ + +#define EXC_FLAGBITS (((1<<(EXF_BITS+EXF_OFFSET))-1) \ + & ~((1<<(EXF_OFFSET))-1)) /* * The primary fields of an exception code @@ -77,11 +85,16 @@ #define NATIVE_EXCEPTION(x) ((x) | EXF_NATIVE) /* - * Bits 8-12 of the error code are used for indexing into + * Error code used for indexing into * the short-hand error descriptor table. */ -#define EXC_INDEXBITS 0x1f00 -#define GET_EXC_INDEX(x) (((x) & EXC_INDEXBITS) >> 8) +#define EXC_OFFSET (EXF_OFFSET+EXF_BITS) +#define EXC_BITS 5 + +#define EXC_INDEXBITS (((1<<(EXC_BITS+EXC_OFFSET))-1) \ + & ~((1<<(EXC_OFFSET))-1)) + +#define GET_EXC_INDEX(x) (((x) & EXC_INDEXBITS) >> EXC_OFFSET) /* * Exit codes used for raising a fresh exception. The primary exceptions @@ -107,46 +120,46 @@ /* Error with given arglist term * (exit reason in p->fvalue) */ -#define EXC_NORMAL ((1 << 8) | EXC_EXIT) +#define EXC_NORMAL ((1 << EXC_OFFSET) | EXC_EXIT) /* Normal exit (reason 'normal') */ -#define EXC_INTERNAL_ERROR ((2 << 8) | EXC_ERROR | EXF_PANIC) +#define EXC_INTERNAL_ERROR ((2 << EXC_OFFSET) | EXC_ERROR | EXF_PANIC) /* Things that shouldn't happen */ -#define EXC_BADARG ((3 << 8) | EXC_ERROR) +#define EXC_BADARG ((3 << EXC_OFFSET) | EXC_ERROR) /* Bad argument to a BIF */ -#define EXC_BADARITH ((4 << 8) | EXC_ERROR) +#define EXC_BADARITH ((4 << EXC_OFFSET) | EXC_ERROR) /* Bad arithmetic */ -#define EXC_BADMATCH ((5 << 8) | EXC_ERROR) +#define EXC_BADMATCH ((5 << EXC_OFFSET) | EXC_ERROR) /* Bad match in function body */ -#define EXC_FUNCTION_CLAUSE ((6 << 8) | EXC_ERROR) +#define EXC_FUNCTION_CLAUSE ((6 << EXC_OFFSET) | EXC_ERROR) /* No matching function head */ -#define EXC_CASE_CLAUSE ((7 << 8) | EXC_ERROR) +#define EXC_CASE_CLAUSE ((7 << EXC_OFFSET) | EXC_ERROR) /* No matching case clause */ -#define EXC_IF_CLAUSE ((8 << 8) | EXC_ERROR) +#define EXC_IF_CLAUSE ((8 << EXC_OFFSET) | EXC_ERROR) /* No matching if clause */ -#define EXC_UNDEF ((9 << 8) | EXC_ERROR) +#define EXC_UNDEF ((9 << EXC_OFFSET) | EXC_ERROR) /* No farity that matches */ -#define EXC_BADFUN ((10 << 8) | EXC_ERROR) +#define EXC_BADFUN ((10 << EXC_OFFSET) | EXC_ERROR) /* Not an existing fun */ -#define EXC_BADARITY ((11 << 8) | EXC_ERROR) +#define EXC_BADARITY ((11 << EXC_OFFSET) | EXC_ERROR) /* Attempt to call fun with * wrong number of arguments. */ -#define EXC_TIMEOUT_VALUE ((12 << 8) | EXC_ERROR) +#define EXC_TIMEOUT_VALUE ((12 << EXC_OFFSET) | EXC_ERROR) /* Bad time out value */ -#define EXC_NOPROC ((13 << 8) | EXC_ERROR) +#define EXC_NOPROC ((13 << EXC_OFFSET) | EXC_ERROR) /* No process or port */ -#define EXC_NOTALIVE ((14 << 8) | EXC_ERROR) +#define EXC_NOTALIVE ((14 << EXC_OFFSET) | EXC_ERROR) /* Not distributed */ -#define EXC_SYSTEM_LIMIT ((15 << 8) | EXC_ERROR) +#define EXC_SYSTEM_LIMIT ((15 << EXC_OFFSET) | EXC_ERROR) /* Ran out of something */ -#define EXC_TRY_CLAUSE ((16 << 8) | EXC_ERROR) +#define EXC_TRY_CLAUSE ((16 << EXC_OFFSET) | EXC_ERROR) /* No matching try clause */ -#define EXC_NOTSUP ((17 << 8) | EXC_ERROR) +#define EXC_NOTSUP ((17 << EXC_OFFSET) | EXC_ERROR) /* Not supported */ -#define EXC_BADMAP ((18 << 8) | EXC_ERROR) +#define EXC_BADMAP ((18 << EXC_OFFSET) | EXC_ERROR) /* Bad map */ -#define EXC_BADKEY ((19 << 8) | EXC_ERROR) +#define EXC_BADKEY ((19 << EXC_OFFSET) | EXC_ERROR) /* Bad key in map */ #define NUMBER_EXIT_CODES 20 /* The number of exit code indices */ @@ -154,7 +167,7 @@ /* * Internal pseudo-error codes. */ -#define TRAP (1 << 8) /* BIF Trap to erlang code */ +#define TRAP (1 << EXC_OFFSET) /* BIF Trap to erlang code */ /* * Aliases for some common exit codes. diff --git a/erts/emulator/beam/export.c b/erts/emulator/beam/export.c index f397ab6b00..33ed6d7ec1 100644 --- a/erts/emulator/beam/export.c +++ b/erts/emulator/beam/export.c @@ -356,7 +356,7 @@ Export *export_list(int i, ErtsCodeIndex code_ix) int export_list_size(ErtsCodeIndex code_ix) { - return export_tables[code_ix].entries; + return erts_index_num_entries(&export_tables[code_ix]); } int export_table_sz(void) diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 2b2f3c5cdc..c39ac2f7ec 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -45,6 +45,9 @@ struct enif_func_t; +#ifdef DEBUG +# define ERTS_NIF_ASSERT_IN_ENV +#endif struct enif_environment_t /* ErlNifEnv */ { struct erl_module_nif* mod_nif; @@ -57,16 +60,14 @@ struct enif_environment_t /* ErlNifEnv */ int exception_thrown; /* boolean */ Process *tracee; int exiting; /* boolean (dirty nifs might return in exiting state) */ + +#ifdef ERTS_NIF_ASSERT_IN_ENV + int dbg_disable_assert_in_env; +#endif }; extern void erts_pre_nif(struct enif_environment_t*, Process*, struct erl_module_nif*, Process* tracee); extern void erts_post_nif(struct enif_environment_t* env); -#ifdef ERTS_DIRTY_SCHEDULERS -extern void erts_pre_dirty_nif(ErtsSchedulerData *, - struct enif_environment_t*, Process*, - struct erl_module_nif*); -extern void erts_post_dirty_nif(struct enif_environment_t* env); -#endif extern Eterm erts_nif_taints(Process* p); extern void erts_print_nif_taints(fmtfn_t to, void* to_arg); void erts_unload_nif(struct erl_module_nif* nif); @@ -78,6 +79,12 @@ extern Eterm erts_nif_call_function(Process *p, Process *tracee, struct enif_func_t *, int argc, Eterm *argv); +#ifdef ERTS_DIRTY_SCHEDULERS +int erts_call_dirty_nif(ErtsSchedulerData *esdp, Process *c_p, + BeamInstr *I, Eterm *reg); +#endif /* ERTS_DIRTY_SCHEDULERS */ + + /* Driver handle (wrapper for old plain handle) */ #define ERL_DE_OK 0 #define ERL_DE_UNLOAD 1 @@ -993,7 +1000,7 @@ void erts_queue_monitor_message(Process *, Eterm, Eterm); void erts_init_trap_export(Export* ep, Eterm m, Eterm f, Uint a, - Eterm (*bif)(Process*,Eterm*)); + Eterm (*bif)(Process*, Eterm*, BeamInstr*)); void erts_init_bif(void); Eterm erl_send(Process *p, Eterm to, Eterm msg); diff --git a/erts/emulator/beam/index.c b/erts/emulator/beam/index.c index c86a2122f6..cd834e2c12 100644 --- a/erts/emulator/beam/index.c +++ b/erts/emulator/beam/index.c @@ -91,9 +91,16 @@ index_put_entry(IndexTable* t, void* tmpl) t->seg_table[ix>>INDEX_PAGE_SHIFT] = erts_alloc(t->type, sz); t->size += INDEX_PAGE_SIZE; } - t->entries++; p->index = ix; t->seg_table[ix>>INDEX_PAGE_SHIFT][ix&INDEX_PAGE_MASK] = p; + + /* + * Do a write barrier here to allow readers to do lock free iteration. + * erts_index_num_entries() does matching read barrier. + */ + ERTS_SMP_WRITE_MEMORY_BARRIER; + t->entries++; + return p; } diff --git a/erts/emulator/beam/index.h b/erts/emulator/beam/index.h index b2e3c0eab5..10f5d1eb39 100644 --- a/erts/emulator/beam/index.h +++ b/erts/emulator/beam/index.h @@ -65,6 +65,7 @@ void index_erase_latest_from(IndexTable*, Uint ix); ERTS_GLB_INLINE int index_put(IndexTable*, void*); ERTS_GLB_INLINE IndexSlot* erts_index_lookup(IndexTable*, Uint); +ERTS_GLB_INLINE int erts_index_num_entries(IndexTable* t); #if ERTS_GLB_INLINE_INCL_FUNC_DEF @@ -78,6 +79,19 @@ erts_index_lookup(IndexTable* t, Uint ix) { return t->seg_table[ix>>INDEX_PAGE_SHIFT][ix&INDEX_PAGE_MASK]; } + +ERTS_GLB_INLINE int erts_index_num_entries(IndexTable* t) +{ + int ret = t->entries; + /* + * Do a read barrier here to allow lock free iteration + * on tables where entries are never erased. + * index_put_entry() does matching write barrier. + */ + ERTS_SMP_READ_MEMORY_BARRIER; + return ret; +} + #endif #endif diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 4ef04d020a..ec36b23059 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -802,15 +802,10 @@ call_ext_last u==1 Bif=u$bif:erts_internal:check_process_code/1 D => i_call_ext_ call_ext_only u==1 Bif=u$bif:erts_internal:check_process_code/1 => i_call_ext_only Bif # -# The BIFs erlang:garbage_collect/0 must be called like a function, +# The BIFs erts_internal:garbage_collect/1 must be called like a function, # to allow them to invoke the garbage collector. (The stack pointer must # be saved and p->arity must be zeroed, which is not done on ordinary BIF calls.) # - -call_ext u==0 Bif=u$bif:erlang:garbage_collect/0 => i_call_ext Bif -call_ext_last u==0 Bif=u$bif:erlang:garbage_collect/0 D => i_call_ext_last Bif D -call_ext_only u==0 Bif=u$bif:erlang:garbage_collect/0 => i_call_ext_only Bif - call_ext u==1 Bif=u$bif:erts_internal:garbage_collect/1 => i_call_ext Bif call_ext_last u==1 Bif=u$bif:erts_internal:garbage_collect/1 D => i_call_ext_last Bif D call_ext_only u==1 Bif=u$bif:erts_internal:garbage_collect/1 => i_call_ext_only Bif diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index ec502d5a78..3fa48da1ec 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -56,6 +56,8 @@ #ifdef HIPE # include "hipe_mode_switch.h" #endif +#define ERTS_WANT_NFUNC_SCHED_INTERNALS__ +#include "erl_nfunc_sched.h" #undef M_TRIM_THRESHOLD #undef M_TOP_PAD diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index 3adb8db661..d64f015a6a 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -1937,7 +1937,8 @@ static void free_sendfile(void *data) { MUTEX_LOCK(d->c.sendfile.q_mtx); driver_deq(d->c.sendfile.port,1); MUTEX_UNLOCK(d->c.sendfile.q_mtx); - driver_select(d->c.sendfile.port, (ErlDrvEvent)(long)d->c.sendfile.out_fd, ERL_DRV_USE_NO_CALLBACK|ERL_DRV_WRITE, 0); + driver_select(d->c.sendfile.port, (ErlDrvEvent)(long)d->c.sendfile.out_fd, + ERL_DRV_USE_NO_CALLBACK|ERL_DRV_WRITE, 0); } EF_FREE(data); } @@ -2555,7 +2556,7 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data) desc->sendfile_state = sending; desc->d = d; driver_select(desc->port, (ErlDrvEvent)(long)d->c.sendfile.out_fd, - ERL_DRV_USE_NO_CALLBACK|ERL_DRV_WRITE, 1); + ERL_DRV_USE|ERL_DRV_WRITE, 1); } break; #endif diff --git a/erts/emulator/drivers/common/zlib_drv.c b/erts/emulator/drivers/common/zlib_drv.c index 066cf87c9d..e8afddb01b 100644 --- a/erts/emulator/drivers/common/zlib_drv.c +++ b/erts/emulator/drivers/common/zlib_drv.c @@ -252,9 +252,9 @@ static int zlib_output(ZLibData* d) return zlib_output_init(d); } -#ifdef HAVE_ZLIB_INFLATEGETDICTIONARY static int zlib_inflate_get_dictionary(ZLibData* d) { +#ifdef HAVE_ZLIB_INFLATEGETDICTIONARY ErlDrvBinary* dbin = driver_alloc_binary(INFL_DICT_SZ); uInt dlen = 0; int res = inflateGetDictionary(&d->s, (unsigned char*)dbin->orig_bytes, &dlen); @@ -263,8 +263,11 @@ static int zlib_inflate_get_dictionary(ZLibData* d) } driver_free_binary(dbin); return res; -} +#else + abort(); /* never called, just to silence 'unresolved symbol' + for non-optimizing compiler */ #endif +} static int zlib_inflate(ZLibData* d, int flush) { @@ -448,10 +451,35 @@ static void zlib_free(void* data, void* addr) driver_free(addr); } +#if defined(__APPLE__) && defined(__MACH__) && defined(HAVE_ZLIB_INFLATEGETDICTIONARY) + +/* Work around broken build system with runtime version test */ +static int have_inflateGetDictionary; + +static int zlib_init() +{ + unsigned int v[4] = {0, 0, 0, 0}; + unsigned hexver; + + sscanf(zlibVersion(), "%u.%u.%u.%u", &v[0], &v[1], &v[2], &v[3]); + + hexver = (v[0] << (8*3)) | (v[1] << (8*2)) | (v[2] << (8)) | v[3]; + + have_inflateGetDictionary = (hexver >= 0x1020701); /* 1.2.7.1 */ + + return 0; +} +#else /* trust configure got it right */ +# ifdef HAVE_ZLIB_INFLATEGETDICTIONARY +# define have_inflateGetDictionary 1 +# else +# define have_inflateGetDictionary 0 +# endif static int zlib_init() { return 0; } +#endif static ErlDrvData zlib_start(ErlDrvPort port, char* buf) { @@ -605,14 +633,14 @@ static ErlDrvSSizeT zlib_ctl(ErlDrvData drv_data, unsigned int command, char *bu return zlib_return(res, rbuf, rlen); case INFLATE_GETDICT: -#ifdef HAVE_ZLIB_INFLATEGETDICTIONARY - if (d->state != ST_INFLATE) goto badarg; - res = zlib_inflate_get_dictionary(d); + if (have_inflateGetDictionary) { + if (d->state != ST_INFLATE) goto badarg; + res = zlib_inflate_get_dictionary(d); + } else { + errno = ENOTSUP; + res = Z_ERRNO; + } return zlib_return(res, rbuf, rlen); -#else - errno = ENOTSUP; - return zlib_return(Z_ERRNO, rbuf, rlen); -#endif case INFLATE_SYNC: if (d->state != ST_INFLATE) goto badarg; diff --git a/erts/emulator/hipe/hipe_amd64_bifs.m4 b/erts/emulator/hipe/hipe_amd64_bifs.m4 index 21739726bb..dca3887564 100644 --- a/erts/emulator/hipe/hipe_amd64_bifs.m4 +++ b/erts/emulator/hipe/hipe_amd64_bifs.m4 @@ -41,11 +41,11 @@ define(HANDLE_GOT_MBUF,` `#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) # define CALL_BIF(F) \ - movq CSYM(F)@GOTPCREL(%rip), %r11; \ + movq CSYM(nbif_impl_##F)@GOTPCREL(%rip), %r11; \ movq %r11, P_BIF_CALLEE(P); \ call CSYM(hipe_debug_bif_wrapper) #else -# define CALL_BIF(F) call CSYM(F) +# define CALL_BIF(F) call CSYM(nbif_impl_##F) #endif' /* @@ -595,13 +595,9 @@ noproc_primop_interface_0(nbif_handle_fp_exception, erts_restore_fpu) #endif /* NO_FPE_SIGNALS */ /* - * Implement gc_bif_interface_0 as nofail_primop_interface_0. - */ -define(gc_bif_interface_0,`nofail_primop_interface_0($1, $2)') - -/* - * Implement gc_bif_interface_N as standard_bif_interface_N (N=1,2,3). + * Implement gc_bif_interface_N as standard_bif_interface_N. */ +define(gc_bif_interface_0,`standard_bif_interface_0($1, $2)') define(gc_bif_interface_1,`standard_bif_interface_1($1, $2)') define(gc_bif_interface_2,`standard_bif_interface_2($1, $2)') define(gc_bif_interface_3,`standard_bif_interface_3($1, $2)') diff --git a/erts/emulator/hipe/hipe_arm_bifs.m4 b/erts/emulator/hipe/hipe_arm_bifs.m4 index d7a2fec04a..a9097dabde 100644 --- a/erts/emulator/hipe/hipe_arm_bifs.m4 +++ b/erts/emulator/hipe/hipe_arm_bifs.m4 @@ -30,9 +30,9 @@ include(`hipe/hipe_arm_asm.m4') .arm `#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) -# define CALL_BIF(F) ldr r14, =F; str r14, [r0, #P_BIF_CALLEE]; bl hipe_debug_bif_wrapper +# define CALL_BIF(F) ldr r14, =nbif_impl_##F; str r14, [r0, #P_BIF_CALLEE]; bl hipe_debug_bif_wrapper #else -# define CALL_BIF(F) bl F +# define CALL_BIF(F) bl nbif_impl_##F #endif' define(TEST_GOT_MBUF,`ldr r1, [P, #P_MBUF] /* `TEST_GOT_MBUF' */ diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c index 5c29473443..9c6ac4bd9c 100644 --- a/erts/emulator/hipe/hipe_bif0.c +++ b/erts/emulator/hipe/hipe_bif0.c @@ -732,7 +732,7 @@ struct nbif { }; static struct nbif nbifs[BIF_SIZE] = { -#define BIF_LIST(MOD,FUN,ARY,CFUN,IX) \ +#define BIF_LIST(MOD,FUN,ARY,BIF,CFUN,IX) \ { {0,0}, MOD, FUN, ARY, &nbif_##CFUN }, #include "erl_bif_list.h" #undef BIF_LIST @@ -905,7 +905,8 @@ BIF_RETTYPE hipe_bifs_term_to_word_1(BIF_ALIST_1) } /* XXX: this is really a primop, not a BIF */ -BIF_RETTYPE hipe_conv_big_to_float(BIF_ALIST_1) +/* Called via standard_bif_interface_1 */ +BIF_RETTYPE nbif_impl_hipe_conv_big_to_float(NBIF_ALIST_1) { Eterm res; Eterm *hp; @@ -1432,7 +1433,8 @@ void *hipe_get_remote_na(Eterm m, Eterm f, unsigned int a) } /* primop, but called like a BIF for error handling purposes */ -BIF_RETTYPE hipe_find_na_or_make_stub(BIF_ALIST_3) +/* Called via standard_bif_interface_3 */ +BIF_RETTYPE nbif_impl_hipe_find_na_or_make_stub(NBIF_ALIST_3) { Uint arity; void *address; @@ -1457,7 +1459,8 @@ BIF_RETTYPE hipe_bifs_find_na_or_make_stub_1(BIF_ALIST_1) } /* primop, but called like a BIF for error handling purposes */ -BIF_RETTYPE hipe_nonclosure_address(BIF_ALIST_2) +/* Called via standard_bif_interface_2 */ +BIF_RETTYPE nbif_impl_hipe_nonclosure_address(NBIF_ALIST_2) { Eterm hdr, m, f; void *address; diff --git a/erts/emulator/hipe/hipe_bif0.h b/erts/emulator/hipe/hipe_bif0.h index 4a59bacc6e..811c3801c1 100644 --- a/erts/emulator/hipe/hipe_bif0.h +++ b/erts/emulator/hipe/hipe_bif0.h @@ -30,7 +30,7 @@ extern Uint *hipe_bifs_find_pc_from_mfa(Eterm mfa); extern void hipe_mfa_info_table_init(void); extern void *hipe_get_remote_na(Eterm m, Eterm f, unsigned int a); -extern BIF_RETTYPE hipe_find_na_or_make_stub(BIF_ALIST_3); +extern BIF_RETTYPE nbif_impl_hipe_find_na_or_make_stub(NBIF_ALIST_3); extern int hipe_find_mfa_from_ra(const void *ra, Eterm *m, Eterm *f, unsigned int *a); /* needed in beam_load.c */ diff --git a/erts/emulator/hipe/hipe_bif2.c b/erts/emulator/hipe/hipe_bif2.c index dfd34e31d4..e04d3d32d1 100644 --- a/erts/emulator/hipe/hipe_bif2.c +++ b/erts/emulator/hipe/hipe_bif2.c @@ -155,7 +155,7 @@ BIF_RETTYPE hipe_bifs_modeswitch_debug_off_0(BIF_ALIST_0) #if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) -BIF_RETTYPE hipe_debug_bif_wrapper(BIF_ALIST_1); +BIF_RETTYPE hipe_debug_bif_wrapper(NBIF_ALIST_1); # define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) \ if ((P)) erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN,\ @@ -163,13 +163,13 @@ BIF_RETTYPE hipe_debug_bif_wrapper(BIF_ALIST_1); # define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) \ if ((P)) erts_proc_lc_unrequire_lock((P), ERTS_PROC_LOCK_MAIN) -BIF_RETTYPE hipe_debug_bif_wrapper(BIF_ALIST_1) +BIF_RETTYPE hipe_debug_bif_wrapper(NBIF_ALIST_1) { - typedef BIF_RETTYPE Bif(BIF_ALIST_1); - Bif* fp = (Bif*) (BIF_P->hipe.bif_callee); + typedef BIF_RETTYPE nBif(NBIF_ALIST_1); + nBif* fp = (nBif*) (BIF_P->hipe.bif_callee); BIF_RETTYPE res; ERTS_SMP_UNREQ_PROC_MAIN_LOCK(BIF_P); - res = (*fp)(BIF_P, BIF__ARGS); + res = (*fp)(NBIF_CALL_ARGS); ERTS_SMP_REQ_PROC_MAIN_LOCK(BIF_P); return res; } diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4 index bb328b5915..f034c4700c 100644 --- a/erts/emulator/hipe/hipe_bif_list.m4 +++ b/erts/emulator/hipe/hipe_bif_list.m4 @@ -71,6 +71,32 @@ ****************************************************************/ /* + * NOTE: + * Beam BIFs have the prototype: + * Eterm (*BIF)(Process *c_p, Eterm *regs, UWord *I) + * Native BIFs have the prototype: + * Eterm (*BIF)(Process *c_p, Eterm *regs) + * + * Beam BIFs expect 'I' to contain current instruction + * pointer when called from beam, and expect 'I' to + * contain a pointer to the export entry of the BIF + * when called from native code. In order to facilitate + * this, beam BIFs are called via wrapper functions + * when called from native code. These wrapper functions + * are auto-generated (by utils/make_tables) and have + * the function names nbif_impl_<BIF>. + * + * The standard_bif_interface_*() and + * gc_bif_interface_*() will add the prefix and + * thus call nbif_impl_<cbif_name>. That is, all + * functions (true BIFs as well as other c-functions) + * called via these interfaces have to be named + * nbif_impl_<FUNC>. + */ + +/* + * See NOTE above! + * * standard_bif_interface_0(nbif_name, cbif_name) * standard_bif_interface_1(nbif_name, cbif_name) * standard_bif_interface_2(nbif_name, cbif_name) @@ -93,6 +119,8 @@ */ /* + * See NOTE above! + * * gc_bif_interface_0(nbif_name, cbif_name) * gc_bif_interface_1(nbif_name, cbif_name) * gc_bif_interface_2(nbif_name, cbif_name) @@ -155,7 +183,7 @@ standard_bif_interface_0(nbif_ports_0, ports_0) */ gc_bif_interface_1(nbif_erts_internal_check_process_code_1, hipe_erts_internal_check_process_code_1) gc_bif_interface_1(nbif_erase_1, erase_1) -gc_bif_interface_0(nbif_garbage_collect_0, garbage_collect_0) +gc_bif_interface_1(nbif_erts_internal_garbage_collect_1, erts_internal_garbage_collect_1) gc_nofail_primop_interface_1(nbif_gc_1, hipe_gc) gc_bif_interface_2(nbif_put_2, put_2) @@ -247,7 +275,7 @@ nocons_nofail_primop_interface_5(nbif_bs_put_big_integer, hipe_bs_put_big_intege noproc_primop_interface_5(nbif_bs_put_big_integer, hipe_bs_put_big_integer) ')dnl -gc_bif_interface_0(nbif_check_get_msg, hipe_check_get_msg) +nofail_primop_interface_0(nbif_check_get_msg, hipe_check_get_msg) #`ifdef' NO_FPE_SIGNALS nocons_nofail_primop_interface_0(nbif_emulate_fpe, hipe_emulate_fpe) @@ -291,8 +319,8 @@ gc_bif_interface_2(nbif_maps_merge_2, hipe_wrapper_maps_merge_2) * BIF_LIST(ModuleAtom,FunctionAtom,Arity,CFun,Index) */ -define(BIF_LIST,`standard_bif_interface_$3(nbif_$4, $4)') -include(TARGET/`erl_bif_list.h') +define(BIF_LIST,`standard_bif_interface_$3(nbif_$5, $5)') +include(TTF_DIR/`erl_bif_list.h') /* * Guard BIFs. diff --git a/erts/emulator/hipe/hipe_gc.c b/erts/emulator/hipe/hipe_gc.c index e6ce7ce628..cf0435adc9 100644 --- a/erts/emulator/hipe/hipe_gc.c +++ b/erts/emulator/hipe/hipe_gc.c @@ -99,7 +99,7 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop) if (IS_MOVED_CONS(val)) { *nsp_i = ptr[1]; } else if (!erts_is_literal(gval, ptr)) { - ASSERT(within(ptr, p)); + ASSERT(erts_dbg_within_proc(ptr, p, NULL)); MOVE_CONS(ptr, val, n_htop, nsp_i); } } @@ -208,7 +208,7 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop) } else if (ErtsInArea(ptr, mature, mature_size)) { MOVE_BOXED(ptr, val, old_htop, nsp_i); } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) { - ASSERT(within(ptr, p)); + ASSERT(erts_dbg_within_proc(ptr, p, NULL)); MOVE_BOXED(ptr, val, n_htop, nsp_i); } } else if (is_list(gval)) { @@ -219,7 +219,7 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop) } else if (ErtsInArea(ptr, mature, mature_size)) { MOVE_CONS(ptr, val, old_htop, nsp_i); } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) { - ASSERT(within(ptr, p)); + ASSERT(erts_dbg_within_proc(ptr, p, NULL)); MOVE_CONS(ptr, val, n_htop, nsp_i); } } diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index 9439b823ab..9a9252e8b8 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -42,8 +42,8 @@ */ /* for -Wmissing-prototypes :-( */ -extern Eterm hipe_erts_internal_check_process_code_1(BIF_ALIST_1); -extern Eterm hipe_show_nstack_1(BIF_ALIST_1); +extern Eterm nbif_impl_hipe_erts_internal_check_process_code_1(NBIF_ALIST_1); +extern Eterm nbif_impl_hipe_show_nstack_1(NBIF_ALIST_1); /* Used when a BIF can trigger a stack walk. */ static __inline__ void hipe_set_narity(Process *p, unsigned int arity) @@ -51,22 +51,24 @@ static __inline__ void hipe_set_narity(Process *p, unsigned int arity) p->hipe.narity = arity; } -Eterm hipe_erts_internal_check_process_code_1(BIF_ALIST_1) +/* Called via standard_bif_interface_2 */ +Eterm nbif_impl_hipe_erts_internal_check_process_code_1(NBIF_ALIST_1) { Eterm ret; hipe_set_narity(BIF_P, 1); - ret = erts_internal_check_process_code_1(BIF_P, BIF__ARGS); + ret = nbif_impl_erts_internal_check_process_code_1(NBIF_CALL_ARGS); hipe_set_narity(BIF_P, 0); return ret; } -Eterm hipe_show_nstack_1(BIF_ALIST_1) +/* Called via standard_bif_interface_1 */ +Eterm nbif_impl_hipe_show_nstack_1(NBIF_ALIST_1) { Eterm ret; hipe_set_narity(BIF_P, 1); - ret = hipe_bifs_show_nstack_1(BIF_P, BIF__ARGS); + ret = nbif_impl_hipe_bifs_show_nstack_1(NBIF_CALL_ARGS); hipe_set_narity(BIF_P, 0); return ret; } @@ -89,7 +91,7 @@ void hipe_gc(Process *p, Eterm need) * has begun. * XXX: BUG: native code should check return status */ -BIF_RETTYPE hipe_set_timeout(BIF_ALIST_1) +BIF_RETTYPE nbif_impl_hipe_set_timeout(NBIF_ALIST_1) { Process* p = BIF_P; Eterm timeout_value = BIF_ARG_1; @@ -226,11 +228,6 @@ void hipe_handle_exception(Process *c_p) ASSERT(c_p->freason != TRAP); /* Should have been handled earlier. */ - if (c_p->mbuf) { - erts_printf("%s line %u: p==%p, p->mbuf==%p\n", __FUNCTION__, __LINE__, c_p, c_p->mbuf); - /* erts_garbage_collect(c_p, 0, NULL, 0); */ - } - /* * Check if we have an arglist for the top level call. If so, this * is encoded in Value, so we have to dig out the real Value as well @@ -259,11 +256,6 @@ void hipe_handle_exception(Process *c_p) /* Synthesized to avoid having to generate code for it. */ c_p->def_arg_reg[0] = exception_tag[GET_EXC_CLASS(c_p->freason)]; - if (c_p->mbuf) { - /* erts_printf("%s line %u: p==%p, p->mbuf==%p, p->lastbif==%p\n", __FUNCTION__, __LINE__, c_p, c_p->mbuf, c_p->hipe.lastbif); */ - erts_garbage_collect(c_p, 0, NULL, 0); - } - hipe_find_handler(c_p); } @@ -280,10 +272,10 @@ static struct StackTrace *get_trace_from_exc(Eterm exc) * This does what the (misnamed) Beam instruction 'raise_ss' does, * namely, a proper re-throw of an exception that was caught by 'try'. */ - -BIF_RETTYPE hipe_rethrow(BIF_ALIST_2) +/* Called via standard_bif_interface_2 */ +BIF_RETTYPE nbif_impl_hipe_rethrow(NBIF_ALIST_2) { - Process* c_p = BIF_P; + Process *c_p = BIF_P; Eterm exc = BIF_ARG_1; Eterm value = BIF_ARG_2; @@ -407,7 +399,7 @@ Eterm hipe_bs_utf8_size(Eterm arg) return make_small(4); } -BIF_RETTYPE hipe_bs_put_utf8(BIF_ALIST_3) +BIF_RETTYPE nbif_impl_hipe_bs_put_utf8(NBIF_ALIST_3) { Process* p = BIF_P; Eterm arg = BIF_ARG_1; @@ -468,7 +460,7 @@ Eterm hipe_bs_put_utf16(Process *p, Eterm arg, byte *base, unsigned int offset, return new_offset; } -BIF_RETTYPE hipe_bs_put_utf16be(BIF_ALIST_3) +BIF_RETTYPE nbif_impl_hipe_bs_put_utf16be(NBIF_ALIST_3) { Process *p = BIF_P; Eterm arg = BIF_ARG_1; @@ -477,7 +469,7 @@ BIF_RETTYPE hipe_bs_put_utf16be(BIF_ALIST_3) return hipe_bs_put_utf16(p, arg, base, offset, 0); } -BIF_RETTYPE hipe_bs_put_utf16le(BIF_ALIST_3) +BIF_RETTYPE nbif_impl_hipe_bs_put_utf16le(NBIF_ALIST_3) { Process *p = BIF_P; Eterm arg = BIF_ARG_1; @@ -495,7 +487,7 @@ static int validate_unicode(Eterm arg) return 1; } -BIF_RETTYPE hipe_bs_validate_unicode(BIF_ALIST_1) +BIF_RETTYPE nbif_impl_hipe_bs_validate_unicode(NBIF_ALIST_1) { Process *p = BIF_P; Eterm arg = BIF_ARG_1; @@ -513,7 +505,8 @@ int hipe_bs_validate_unicode_retract(ErlBinMatchBuffer* mb, Eterm arg) return 1; } -BIF_RETTYPE hipe_is_divisible(BIF_ALIST_2) +/* Called via standard_bif_interface_2 */ +BIF_RETTYPE nbif_impl_hipe_is_divisible(NBIF_ALIST_2) { /* Arguments are Eterm-sized unsigned integers */ Uint dividend = BIF_ARG_1; diff --git a/erts/emulator/hipe/hipe_native_bif.h b/erts/emulator/hipe/hipe_native_bif.h index a02d26087b..38f874888b 100644 --- a/erts/emulator/hipe/hipe_native_bif.h +++ b/erts/emulator/hipe/hipe_native_bif.h @@ -74,27 +74,27 @@ AEXTERN(void,nbif_select_msg,(Process*)); AEXTERN(Eterm,nbif_cmp_2,(void)); AEXTERN(Eterm,nbif_eq_2,(void)); -BIF_RETTYPE hipe_nonclosure_address(BIF_ALIST_2); -BIF_RETTYPE hipe_conv_big_to_float(BIF_ALIST_1); +BIF_RETTYPE nbif_impl_hipe_nonclosure_address(NBIF_ALIST_2); +BIF_RETTYPE nbif_impl_hipe_conv_big_to_float(NBIF_ALIST_1); void hipe_fclearerror_error(Process*); void hipe_select_msg(Process*); void hipe_gc(Process*, Eterm); -BIF_RETTYPE hipe_set_timeout(BIF_ALIST_1); +BIF_RETTYPE nbif_impl_hipe_set_timeout(NBIF_ALIST_1); void hipe_handle_exception(Process*); -BIF_RETTYPE hipe_rethrow(BIF_ALIST_2); +BIF_RETTYPE nbif_impl_hipe_rethrow(NBIF_ALIST_2); char *hipe_bs_allocate(int); Binary *hipe_bs_reallocate(Binary*, int); int hipe_bs_put_small_float(Process*, Eterm, Uint, byte*, unsigned, unsigned); void hipe_bs_put_bits(Eterm, Uint, byte*, unsigned, unsigned); Eterm hipe_bs_utf8_size(Eterm); -BIF_RETTYPE hipe_bs_put_utf8(BIF_ALIST_3); +BIF_RETTYPE nbif_impl_hipe_bs_put_utf8(NBIF_ALIST_3); Eterm hipe_bs_utf16_size(Eterm); -BIF_RETTYPE hipe_bs_put_utf16be(BIF_ALIST_3); -BIF_RETTYPE hipe_bs_put_utf16le(BIF_ALIST_3); -BIF_RETTYPE hipe_bs_validate_unicode(BIF_ALIST_1); +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); struct erl_bin_match_buffer; int hipe_bs_validate_unicode_retract(struct erl_bin_match_buffer*, Eterm); -BIF_RETTYPE hipe_is_divisible(BIF_ALIST_2); +BIF_RETTYPE nbif_impl_hipe_is_divisible(NBIF_ALIST_2); #ifdef NO_FPE_SIGNALS AEXTERN(void,nbif_emulate_fpe,(Process*)); @@ -129,7 +129,7 @@ void hipe_atomic_inc(int*); void hipe_clear_timeout(Process*); #endif -#define BIF_LIST(M,F,A,C,I) AEXTERN(Eterm,nbif_##C,(void)); +#define BIF_LIST(M,F,A,B,C,I) AEXTERN(Eterm,nbif_##C,(void)); #include "erl_bif_list.h" #undef BIF_LIST diff --git a/erts/emulator/hipe/hipe_ppc_bifs.m4 b/erts/emulator/hipe/hipe_ppc_bifs.m4 index b540562185..79a8bef77d 100644 --- a/erts/emulator/hipe/hipe_ppc_bifs.m4 +++ b/erts/emulator/hipe/hipe_ppc_bifs.m4 @@ -26,9 +26,9 @@ include(`hipe/hipe_ppc_asm.m4') #`include' "hipe_literals.h" `#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) -# define CALL_BIF(F) STORE_IA(CSYM(F), P_BIF_CALLEE(P), r29); bl CSYM(hipe_debug_bif_wrapper) +# define CALL_BIF(F) STORE_IA(CSYM(nbif_impl_##F), P_BIF_CALLEE(P), r29); bl CSYM(hipe_debug_bif_wrapper) #else -# define CALL_BIF(F) bl CSYM(F) +# define CALL_BIF(F) bl CSYM(nbif_impl_##F) #endif' .text diff --git a/erts/emulator/hipe/hipe_sparc_bifs.m4 b/erts/emulator/hipe/hipe_sparc_bifs.m4 index 1389beaa61..14330c2f1c 100644 --- a/erts/emulator/hipe/hipe_sparc_bifs.m4 +++ b/erts/emulator/hipe/hipe_sparc_bifs.m4 @@ -29,9 +29,9 @@ include(`hipe/hipe_sparc_asm.m4') .align 4 `#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) -# define CALL_BIF(F) set F, %o7; st %o7, [%o0+P_BIF_CALLEE]; call hipe_debug_bif_wrapper +# define CALL_BIF(F) set nbif_impl_##F, %o7; st %o7, [%o0+P_BIF_CALLEE]; call hipe_debug_bif_wrapper #else -# define CALL_BIF(F) call F +# define CALL_BIF(F) call nbif_impl_##F #endif' /* diff --git a/erts/emulator/hipe/hipe_x86_bifs.m4 b/erts/emulator/hipe/hipe_x86_bifs.m4 index c0c149733c..aecf67dc1b 100644 --- a/erts/emulator/hipe/hipe_x86_bifs.m4 +++ b/erts/emulator/hipe/hipe_x86_bifs.m4 @@ -32,9 +32,9 @@ include(`hipe/hipe_x86_asm.m4') #endif' `#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) -# define CALL_BIF(F) movl $CSYM(F), P_BIF_CALLEE(P); call CSYM(hipe_debug_bif_wrapper) +# define CALL_BIF(F) movl $CSYM(nbif_impl_##F), P_BIF_CALLEE(P); call CSYM(hipe_debug_bif_wrapper) #else -# define CALL_BIF(F) call CSYM(F) +# define CALL_BIF(F) call CSYM(nbif_impl_##F) #endif' define(TEST_GOT_MBUF,`movl P_MBUF(P), %edx /* `TEST_GOT_MBUF' */ @@ -666,13 +666,9 @@ noproc_primop_interface_0(nbif_handle_fp_exception, erts_restore_fpu) #endif /* NO_FPE_SIGNALS */ /* - * Implement gc_bif_interface_0 as nofail_primop_interface_0. - */ -define(gc_bif_interface_0,`nofail_primop_interface_0($1, $2)') - -/* - * Implement gc_bif_interface_N as standard_bif_interface_N (N=1,2,3). + * Implement gc_bif_interface_N as standard_bif_interface_N. */ +define(gc_bif_interface_0,`standard_bif_interface_0($1, $2)') define(gc_bif_interface_1,`standard_bif_interface_1($1, $2)') define(gc_bif_interface_2,`standard_bif_interface_2($1, $2)') define(gc_bif_interface_3,`standard_bif_interface_3($1, $2)') diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 4b2edace0a..2fc802a2c6 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -407,6 +407,7 @@ erts_sys_pre_init(void) #ifdef ERTS_THR_HAVE_SIG_FUNCS sigemptyset(&thr_create_sigmask); sigaddset(&thr_create_sigmask, SIGINT); /* block interrupt */ + sigaddset(&thr_create_sigmask, SIGTERM); /* block terminate signal */ sigaddset(&thr_create_sigmask, SIGUSR1); /* block user defined signal */ #endif @@ -655,6 +656,40 @@ static RETSIGTYPE request_break(int signum) #endif } +static void stop_requested(void) { + Process* p = NULL; + Eterm msg, *hp; + ErtsProcLocks locks = 0; + ErlOffHeap *ohp; + Eterm id = erts_whereis_name_to_id(NULL, am_init); + + if ((p = (erts_pid2proc_opt(NULL, 0, id, 0, ERTS_P2P_FLG_INC_REFC))) != NULL) { + ErtsMessage *msgp = erts_alloc_message_heap(p, &locks, 3, &hp, &ohp); + + /* init ! {stop,stop} */ + msg = TUPLE2(hp, am_stop, am_stop); + erts_queue_message(p, locks, msgp, msg, am_system); + + if (locks) + erts_smp_proc_unlock(p, locks); + erts_proc_dec_refc(p); + } +} + +#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL)) +static RETSIGTYPE request_stop(void) +#else +static RETSIGTYPE request_stop(int signum) +#endif +{ +#ifdef ERTS_SMP + smp_sig_notify('S'); +#else + stop_requested(); +#endif +} + + static ERTS_INLINE void sigusr1_exit(void) { @@ -751,6 +786,7 @@ static RETSIGTYPE do_quit(int signum) /* Disable break */ void erts_set_ignore_break(void) { sys_signal(SIGINT, SIG_IGN); + sys_signal(SIGTERM, SIG_IGN); sys_signal(SIGQUIT, SIG_IGN); sys_signal(SIGTSTP, SIG_IGN); } @@ -776,6 +812,7 @@ void erts_replace_intr(void) { void init_break_handler(void) { sys_signal(SIGINT, request_break); + sys_signal(SIGTERM, request_stop); #ifndef ETHR_UNUSABLE_SIGUSRX sys_signal(SIGUSR1, user_signal1); #endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */ @@ -1289,6 +1326,9 @@ signal_dispatcher_thread_func(void *unused) switch (buf[i]) { case 0: /* Emulator initialized */ break; + case 'S': /* SIGTERM */ + stop_requested(); + break; case 'I': /* SIGINT */ break_requested(); break; diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 2e48c475d5..7c9927c4f3 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -53,6 +53,7 @@ MODULES= \ crypto_SUITE \ ddll_SUITE \ decode_packet_SUITE \ + dirty_bif_SUITE \ dirty_nif_SUITE \ distribution_SUITE \ driver_SUITE \ diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl index b8d89126fe..f70fb0e501 100644 --- a/erts/emulator/test/bif_SUITE.erl +++ b/erts/emulator/test/bif_SUITE.erl @@ -32,7 +32,8 @@ binary_to_atom/1,binary_to_existing_atom/1, atom_to_binary/1,min_max/1, erlang_halt/1, erl_crash_dump_bytes/1, - is_builtin/1]). + is_builtin/1, error_stacktrace/1, + error_stacktrace_during_call_trace/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -44,8 +45,8 @@ all() -> t_list_to_existing_atom, os_env, otp_7526, display, atom_to_binary, binary_to_atom, binary_to_existing_atom, - erl_crash_dump_bytes, - min_max, erlang_halt, is_builtin]. + erl_crash_dump_bytes, min_max, erlang_halt, is_builtin, + error_stacktrace, error_stacktrace_during_call_trace]. %% Uses erlang:display to test that erts_printf does not do deep recursion display(Config) when is_list(Config) -> @@ -727,6 +728,172 @@ is_builtin(_Config) -> ok. +error_stacktrace(Config) when is_list(Config) -> + error_stacktrace_test(). + +error_stacktrace_during_call_trace(Config) when is_list(Config) -> + Tracer = spawn_link(fun () -> + receive after infinity -> ok end + end), + Mprog = [{'_',[],[{exception_trace}]}], + erlang:trace_pattern({?MODULE,'_','_'}, Mprog, [local]), + 1 = erlang:trace_pattern({erlang,error,2}, Mprog, [local]), + 1 = erlang:trace_pattern({erlang,error,1}, Mprog, [local]), + erlang:trace(all, true, [call,return_to,timestamp,{tracer, Tracer}]), + try + error_stacktrace_test() + after + erlang:trace(all, false, [call,return_to,timestamp,{tracer, Tracer}]), + erlang:trace_pattern({erlang,error,2}, false, [local]), + erlang:trace_pattern({erlang,error,1}, false, [local]), + erlang:trace_pattern({?MODULE,'_','_'}, false, [local]), + unlink(Tracer), + exit(Tracer, kill), + Mon = erlang:monitor(process, Tracer), + receive + {'DOWN', Mon, process, Tracer, _} -> ok + end + end, + ok. + + +error_stacktrace_test() -> + Types = [apply_const_last, apply_const, apply_last, + apply, double_apply_const_last, double_apply_const, + double_apply_last, double_apply, multi_apply_const_last, + multi_apply_const, multi_apply_last, multi_apply, + call_const_last, call_last, call_const, call], + lists:foreach(fun (Type) -> + {Pid, Mon} = spawn_monitor( + fun () -> + stk([a,b,c,d], Type, error_2) + end), + receive + {'DOWN', Mon, process, Pid, Reason} -> + {oops, Stack} = Reason, +%% io:format("Type: ~p Stack: ~p~n", +%% [Type, Stack]), + [{?MODULE, do_error_2, [Type], _}, + {?MODULE, stk, 3, _}, + {?MODULE, stk, 3, _}] = Stack + end + end, + Types), + lists:foreach(fun (Type) -> + {Pid, Mon} = spawn_monitor( + fun () -> + stk([a,b,c,d], Type, error_1) + end), + receive + {'DOWN', Mon, process, Pid, Reason} -> + {oops, Stack} = Reason, +%% io:format("Type: ~p Stack: ~p~n", +%% [Type, Stack]), + [{?MODULE, do_error_1, 1, _}, + {?MODULE, stk, 3, _}, + {?MODULE, stk, 3, _}] = Stack + end + end, + Types), + ok. + +stk([], Type, Func) -> + tail(Type, Func, jump), + ok; +stk([_|L], Type, Func) -> + stk(L, Type, Func), + ok. + +tail(Type, Func, jump) -> + tail(Type, Func, do); +tail(Type, error_1, do) -> + do_error_1(Type); +tail(Type, error_2, do) -> + do_error_2(Type). + +do_error_2(apply_const_last) -> + erlang:apply(erlang, error, [oops, [apply_const_last]]); +do_error_2(apply_const) -> + erlang:apply(erlang, error, [oops, [apply_const]]), + ok; +do_error_2(apply_last) -> + erlang:apply(id(erlang), id(error), id([oops, [apply_last]])); +do_error_2(apply) -> + erlang:apply(id(erlang), id(error), id([oops, [apply]])), + ok; +do_error_2(double_apply_const_last) -> + erlang:apply(erlang, apply, [erlang, error, [oops, [double_apply_const_last]]]); +do_error_2(double_apply_const) -> + erlang:apply(erlang, apply, [erlang, error, [oops, [double_apply_const]]]), + ok; +do_error_2(double_apply_last) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops, [double_apply_last]])]); +do_error_2(double_apply) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops, [double_apply]])]), + ok; +do_error_2(multi_apply_const_last) -> + erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops, [multi_apply_const_last]]]]]); +do_error_2(multi_apply_const) -> + erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops, [multi_apply_const]]]]]), + ok; +do_error_2(multi_apply_last) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops, [multi_apply_last]])]]]); +do_error_2(multi_apply) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops, [multi_apply]])]]]), + ok; +do_error_2(call_const_last) -> + erlang:error(oops, [call_const_last]); +do_error_2(call_last) -> + erlang:error(id(oops), id([call_last])); +do_error_2(call_const) -> + erlang:error(oops, [call_const]), + ok; +do_error_2(call) -> + erlang:error(id(oops), id([call])). + + +do_error_1(apply_const_last) -> + erlang:apply(erlang, error, [oops]); +do_error_1(apply_const) -> + erlang:apply(erlang, error, [oops]), + ok; +do_error_1(apply_last) -> + erlang:apply(id(erlang), id(error), id([oops])); +do_error_1(apply) -> + erlang:apply(id(erlang), id(error), id([oops])), + ok; +do_error_1(double_apply_const_last) -> + erlang:apply(erlang, apply, [erlang, error, [oops]]); +do_error_1(double_apply_const) -> + erlang:apply(erlang, apply, [erlang, error, [oops]]), + ok; +do_error_1(double_apply_last) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops])]); +do_error_1(double_apply) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops])]), + ok; +do_error_1(multi_apply_const_last) -> + erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops]]]]); +do_error_1(multi_apply_const) -> + erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops]]]]), + ok; +do_error_1(multi_apply_last) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops])]]]); +do_error_1(multi_apply) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops])]]]), + ok; +do_error_1(call_const_last) -> + erlang:error(oops); +do_error_1(call_last) -> + erlang:error(id(oops)); +do_error_1(call_const) -> + erlang:error(oops), + ok; +do_error_1(call) -> + erlang:error(id(oops)). + + + %% Helpers diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl index 6ba6301c7c..2e303ba9a8 100644 --- a/erts/emulator/test/call_trace_SUITE.erl +++ b/erts/emulator/test/call_trace_SUITE.erl @@ -45,7 +45,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap, {seconds, 30}}]. -all() -> +all() -> Common = [errors, on_load], NotHipe = [process_specs, basic, flags, pam, change_pam, upgrade, @@ -1090,8 +1090,7 @@ exception_nocatch() -> {trace,t2,exception_from,{erlang,throw,1}, {error,{nocatch,Q2}}}], exception_from, {error,{nocatch,Q2}}), - expect({trace,T2,exit,{{nocatch,Q2},[{erlang,throw,[Q2],[]}, - {?MODULE,deep_4,1, + expect({trace,T2,exit,{{nocatch,Q2},[{?MODULE,deep_4,1, Deep4LocThrow}]}}), Q3 = {dump,[dump,{dump}]}, T3 = @@ -1100,8 +1099,7 @@ exception_nocatch() -> {trace,t3,exception_from,{erlang,error,1}, {error,Q3}}], exception_from, {error,Q3}), - expect({trace,T3,exit,{Q3,[{erlang,error,[Q3],[]}, - {?MODULE,deep_4,1,Deep4LocError}]}}), + expect({trace,T3,exit,{Q3,[{?MODULE,deep_4,1,Deep4LocError}]}}), T4 = exception_nocatch(?LINE, '=', [17,4711], 5, [], exception_from, {error,{badmatch,4711}}), diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index 0742b77a52..b29520ab9f 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -65,9 +65,9 @@ versions(Config) when is_list(Config) -> 2 = versions:version(), %% Kill processes, unload code. - P1 ! P2 ! done, _ = monitor(process, P1), _ = monitor(process, P2), + P1 ! P2 ! done, receive {'DOWN',_,process,P1,normal} -> ok end, diff --git a/erts/emulator/test/dirty_bif_SUITE.erl b/erts/emulator/test/dirty_bif_SUITE.erl new file mode 100644 index 0000000000..308323594d --- /dev/null +++ b/erts/emulator/test/dirty_bif_SUITE.erl @@ -0,0 +1,583 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2014. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(dirty_bif_SUITE). + +%%-define(line_trace,true). +-define(CHECK(Exp,Got), check(Exp,Got,?LINE)). +%%-define(CHECK(Exp,Got), Exp = Got). + +-include_lib("common_test/include/ct.hrl"). + +-export([all/0, suite/0, + init_per_suite/1, end_per_suite/1, + init_per_testcase/2, end_per_testcase/2, + dirty_bif/1, dirty_bif_exception/1, + dirty_bif_multischedule/1, + dirty_bif_multischedule_exception/1, + dirty_scheduler_exit/1, + dirty_call_while_terminated/1, + dirty_heap_access/1, + dirty_process_info/1, + dirty_process_register/1, + dirty_process_trace/1, + code_purge/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +%% +%% All these tests utilize the debug BIFs: +%% - erts_debug:dirty_cpu/2 - Statically determined +%% to (begin to) execute on a dirty CPU scheduler. +%% - erts_debug:dirty_io/2 - Statically determined +%% to (begin to) execute on a dirty IO scheduler. +%% - erts_debug:dirty/3 +%% Their implementations are located in +%% $ERL_TOP/erts/emulator/beam/beam_debug.c +%% + +all() -> + [dirty_bif, + dirty_bif_multischedule, + dirty_bif_exception, + dirty_bif_multischedule_exception, + dirty_scheduler_exit, + dirty_call_while_terminated, + dirty_heap_access, + dirty_process_info, + dirty_process_register, + dirty_process_trace, + code_purge]. + +init_per_suite(Config) -> + case erlang:system_info(dirty_cpu_schedulers) of + N when N > 0 -> + Config; + _ -> + {skipped, "No dirty scheduler support"} + end. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(Case, Config) -> + [{testcase, Case} | Config]. + +end_per_testcase(_Case, _Config) -> + ok. + +dirty_bif(Config) when is_list(Config) -> + dirty_cpu = erts_debug:dirty_cpu(scheduler,type), + dirty_io = erts_debug:dirty_io(scheduler,type), + normal = erts_debug:dirty(normal,scheduler,type), + dirty_cpu = erts_debug:dirty(dirty_cpu,scheduler,type), + dirty_io = erts_debug:dirty(dirty_io,scheduler,type), + ok. + +dirty_bif_multischedule(Config) when is_list(Config) -> + ok = erts_debug:dirty_cpu(reschedule,1000), + ok = erts_debug:dirty_io(reschedule,1000), + ok = erts_debug:dirty(normal,reschedule,1000), + ok. + + +dirty_bif_exception(Config) when is_list(Config) -> + lists:foreach(fun (Error) -> + ErrorType = case Error of + _ when is_atom(Error) -> Error; + _ -> badarg + end, + try + erts_debug:dirty_cpu(error, Error), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty_cpu,[error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + apply(erts_debug,dirty_cpu,[error, Error]), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty_cpu,[error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + erts_debug:dirty_io(error, Error), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty_io,[error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + apply(erts_debug,dirty_io,[error, Error]), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty_io,[error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + erts_debug:dirty(normal, error, Error), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty,[normal, error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + apply(erts_debug,dirty,[normal, error, Error]), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty,[normal, error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + erts_debug:dirty(dirty_cpu, error, Error), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty,[dirty_cpu, error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + apply(erts_debug,dirty,[dirty_cpu, error, Error]), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty,[dirty_cpu, error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + erts_debug:dirty(dirty_io, error, Error), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty,[dirty_io, error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + apply(erts_debug,dirty,[dirty_io, error, Error]), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty,[dirty_io, error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end + end, + [badarg, undef, badarith, system_limit, noproc, + make_ref(), {another, "heap", term_to_binary("term")}]), + ok. + + +dirty_bif_multischedule_exception(Config) when is_list(Config) -> + try + erts_debug:dirty_cpu(reschedule,1001) + catch + error:badarg -> + [{erts_debug,dirty_cpu,[reschedule, 1001],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + erts_debug:dirty_io(reschedule,1001) + catch + error:badarg -> + [{erts_debug,dirty_io,[reschedule, 1001],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + erts_debug:dirty(normal,reschedule,1001) + catch + error:badarg -> + [{erts_debug,dirty,[normal,reschedule,1001],_}|_] + = erlang:get_stacktrace(), + ok + end. + +dirty_scheduler_exit(Config) when is_list(Config) -> + {ok, Node} = start_node(Config, "+SDio 1"), + [ok] = mcall(Node, + [fun() -> + Start = erlang:monotonic_time(millisecond), + ok = test_dirty_scheduler_exit(), + End = erlang:monotonic_time(millisecond), + io:format("Time=~p ms~n", [End-Start]), + ok + end]), + stop_node(Node), + ok. + +test_dirty_scheduler_exit() -> + process_flag(trap_exit,true), + test_dse(10,[]). +test_dse(0,Pids) -> + timer:sleep(100), + kill_dse(Pids,[]); +test_dse(N,Pids) -> + Pid = spawn_link(fun () -> erts_debug:dirty_io(wait, 5000) end), + test_dse(N-1,[Pid|Pids]). + +kill_dse([],Killed) -> + wait_dse(Killed); +kill_dse([Pid|Pids],AlreadyKilled) -> + exit(Pid,kill), + kill_dse(Pids,[Pid|AlreadyKilled]). + +wait_dse([]) -> + ok; +wait_dse([Pid|Pids]) -> + receive + {'EXIT',Pid,Reason} -> + killed = Reason + end, + wait_dse(Pids). + +dirty_call_while_terminated(Config) when is_list(Config) -> + Me = self(), + Bin = list_to_binary(lists:duplicate(4711, $r)), + {value, {BinAddr, 4711, 1}} = lists:keysearch(4711, 2, + element(2, + process_info(self(), + binary))), + {Dirty, DM} = spawn_opt(fun () -> + erts_debug:dirty_cpu(alive_waitexiting, Me), + blipp:blupp(Bin) + end, + [monitor,link]), + receive {alive, Dirty} -> ok end, + {value, {BinAddr, 4711, 2}} = lists:keysearch(4711, 2, + element(2, + process_info(self(), + binary))), + Reason = die_dirty_process, + OT = process_flag(trap_exit, true), + exit(Dirty, Reason), + receive + {'DOWN', DM, process, Dirty, R0} -> + R0 = Reason + end, + receive + {'EXIT', Dirty, R1} -> + R1 = Reason + end, + undefined = process_info(Dirty), + undefined = process_info(Dirty, status), + false = erlang:is_process_alive(Dirty), + false = lists:member(Dirty, processes()), + %% Binary still refered by Dirty process not yet cleaned up + %% since the dirty bif has not yet returned... + {value, {BinAddr, 4711, 2}} = lists:keysearch(4711, 2, + element(2, + process_info(self(), + binary))), + receive after 2000 -> ok end, + receive + Msg -> + ct:fail({unexpected_message, Msg}) + after + 0 -> + ok + end, + {value, {BinAddr, 4711, 1}} = lists:keysearch(4711, 2, + element(2, + process_info(self(), + binary))), + process_flag(trap_exit, OT), + try + blipp:blupp(Bin) + catch + _ : _ -> ok + end. + +dirty_heap_access(Config) when is_list(Config) -> + {ok, Node} = start_node(Config), + Me = self(), + RGL = rpc:call(Node,erlang,whereis,[init]), + Ref = rpc:call(Node,erlang,make_ref,[]), + Dirty = spawn_link(fun () -> + Res = erts_debug:dirty_cpu(copy, Ref), + garbage_collect(), + Me ! {self(), Res}, + receive after infinity -> ok end + end), + {N, R} = access_dirty_heap(Dirty, RGL, 0, 0), + receive + {_Pid, Res} -> + 1000 = length(Res), + lists:foreach(fun (X) -> Ref = X end, Res) + end, + unlink(Dirty), + exit(Dirty, kill), + stop_node(Node), + {comment, integer_to_list(N) ++ " GL change loops; " + ++ integer_to_list(R) ++ " while running dirty"}. + +access_dirty_heap(Dirty, RGL, N, R) -> + case process_info(Dirty, status) of + {status, waiting} -> + {N, R}; + {status, Status} -> + {group_leader, GL} = process_info(Dirty, group_leader), + true = group_leader(RGL, Dirty), + {group_leader, RGL} = process_info(Dirty, group_leader), + true = group_leader(GL, Dirty), + {group_leader, GL} = process_info(Dirty, group_leader), + access_dirty_heap(Dirty, RGL, N+1, case Status of + running -> + R+1; + _ -> + R + end) + end. + +%% These tests verify that processes that access a process executing a +%% dirty BIF where the main lock is needed for that access do not get +%% blocked. Each test passes its pid to dirty_sleeper, which sends an +%% 'alive' message when it's running on a dirty scheduler and just before +%% it starts a 6 second sleep. When it receives the message, it verifies +%% that access to the dirty process is as it expects. After the dirty +%% process finishes its 6 second sleep but before it returns from the dirty +%% scheduler, it sends a 'done' message. If the tester already received +%% that message, the test fails because it means attempting to access the +%% dirty process waited for that process to return to a regular scheduler, +%% so verify that we haven't received that message, and also verify that +%% the dirty process is still alive immediately after accessing it. +dirty_process_info(Config) when is_list(Config) -> + access_dirty_process( + Config, + fun() -> ok end, + fun(BifPid) -> + PI = process_info(BifPid), + {current_function,{erts_debug,dirty_io,2}} = + lists:keyfind(current_function, 1, PI), + ok + end, + fun(_) -> ok end). + +dirty_process_register(Config) when is_list(Config) -> + access_dirty_process( + Config, + fun() -> ok end, + fun(BifPid) -> + register(test_dirty_process_register, BifPid), + BifPid = whereis(test_dirty_process_register), + unregister(test_dirty_process_register), + false = lists:member(test_dirty_process_register, + registered()), + ok + end, + fun(_) -> ok end). + +dirty_process_trace(Config) when is_list(Config) -> + access_dirty_process( + Config, + fun() -> + erlang:trace_pattern({erts_debug,dirty_io,2}, + [{'_',[],[{return_trace}]}], + [local,meta]), + ok + end, + fun(BifPid) -> + erlang:trace(BifPid, true, [call,timestamp]), + ok + end, + fun(BifPid) -> + receive + {done, BifPid} -> + receive + {trace_ts,BifPid,call,{erts_debug,dirty_io,_},_} -> + ok + after + 0 -> + error(missing_trace_call_message) + end %%, + %% receive + %% {trace_ts,BifPid,return_from,{erts_debug,dirty_io,2}, + %% ok,_} -> + %% ok + %% after + %% 100 -> + %% error(missing_trace_return_message) + %% end + after + 6500 -> + error(missing_done_message) + end, + ok + end). + +dirty_code_test_code() -> + " +-module(dirty_code_test). + +-export([func/1]). + +func(Fun) -> + Fun(), + blipp:blapp(). + +". + +code_purge(Config) when is_list(Config) -> + Path = ?config(data_dir, Config), + File = filename:join(Path, "dirty_code_test.erl"), + ok = file:write_file(File, dirty_code_test_code()), + {ok, dirty_code_test, Bin} = compile:file(File, [binary]), + {module, dirty_code_test} = erlang:load_module(dirty_code_test, Bin), + Start = erlang:monotonic_time(), + {Pid1, Mon1} = spawn_monitor(fun () -> + dirty_code_test:func(fun () -> + %% Sleep for 6 seconds + %% in dirty bif... + erts_debug:dirty_io(wait,6000) + end) + end), + {module, dirty_code_test} = erlang:load_module(dirty_code_test, Bin), + {Pid2, Mon2} = spawn_monitor(fun () -> + dirty_code_test:func(fun () -> + %% Sleep for 6 seconds + %% in dirty bif... + erts_debug:dirty_io(wait,6000) + end) + end), + receive + {'DOWN', Mon1, process, Pid1, _} -> + ct:fail(premature_death) + after 100 -> + ok + end, + true = erlang:purge_module(dirty_code_test), + receive + {'DOWN', Mon1, process, Pid1, Reason1} -> + killed = Reason1 + end, + receive + {'DOWN', Mon2, process, Pid2, _} -> + ct:fail(premature_death) + after 100 -> + ok + end, + true = erlang:delete_module(dirty_code_test), + receive + {'DOWN', Mon2, process, Pid2, _} -> + ct:fail(premature_death) + after 100 -> + ok + end, + true = erlang:purge_module(dirty_code_test), + receive + {'DOWN', Mon2, process, Pid2, Reason2} -> + killed = Reason2 + end, + End = erlang:monotonic_time(), + Time = erlang:convert_time_unit(End-Start, native, milli_seconds), + io:format("Time=~p~n", [Time]), + true = Time =< 1000, + ok. + +%% +%% Internal... +%% + +access_dirty_process(Config, Start, Test, Finish) -> + {ok, Node} = start_node(Config, ""), + [ok] = mcall(Node, + [fun() -> + ok = test_dirty_process_access(Start, Test, Finish) + end]), + stop_node(Node), + ok. + +test_dirty_process_access(Start, Test, Finish) -> + ok = Start(), + Self = self(), + BifPid = spawn_link(fun() -> + ok = erts_debug:dirty_io(ready_wait6_done, Self) + end), + ok = receive + {ready, BifPid} -> + ok = Test(BifPid), + receive + {done, BifPid} -> + error(dirty_process_info_blocked) + after + 0 -> + true = erlang:is_process_alive(BifPid), + ok + end + after + 3000 -> + error(timeout) + end, + ok = Finish(BifPid). + +receive_any() -> + receive M -> M end. + +start_node(Config) -> + start_node(Config, ""). + +start_node(Config, Args) when is_list(Config) -> + Pa = filename:dirname(code:which(?MODULE)), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(second)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))), + test_server:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). + +stop_node(Node) -> + test_server:stop_node(Node). + +mcall(Node, Funs) -> + Parent = self(), + Refs = lists:map(fun (Fun) -> + Ref = make_ref(), + spawn_link(Node, + fun () -> + Res = Fun(), + unlink(Parent), + Parent ! {Ref, Res} + end), + Ref + end, Funs), + lists:map(fun (Ref) -> + receive + {Ref, Res} -> + Res + end + end, Refs). diff --git a/erts/emulator/test/dirty_bif_SUITE_data/.gitignore b/erts/emulator/test/dirty_bif_SUITE_data/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/erts/emulator/test/dirty_bif_SUITE_data/.gitignore diff --git a/erts/emulator/test/dirty_nif_SUITE.erl b/erts/emulator/test/dirty_nif_SUITE.erl index a61fd92a18..991ba0acc8 100644 --- a/erts/emulator/test/dirty_nif_SUITE.erl +++ b/erts/emulator/test/dirty_nif_SUITE.erl @@ -54,8 +54,8 @@ all() -> dirty_nif_send_traced]. init_per_suite(Config) -> - try erlang:system_info(dirty_cpu_schedulers) of - N when is_integer(N), N > 0 -> + case erlang:system_info(dirty_cpu_schedulers) of + N when N > 0 -> case lib_loaded() of false -> ok = erlang:load_nif( @@ -64,8 +64,8 @@ init_per_suite(Config) -> true -> ok end, - Config - catch _:_ -> + Config; + _ -> {skipped, "No dirty scheduler support"} end. diff --git a/erts/emulator/test/driver_SUITE_data/chkio_drv.c b/erts/emulator/test/driver_SUITE_data/chkio_drv.c index 614b68e865..8e5e81665c 100644 --- a/erts/emulator/test/driver_SUITE_data/chkio_drv.c +++ b/erts/emulator/test/driver_SUITE_data/chkio_drv.c @@ -1397,10 +1397,18 @@ static void assert_print(char* str, int line) static void assert_failed(ErlDrvPort port, char* str, int line) { char buf[30]; + size_t bufsz = sizeof(buf); + assert_print(str,line); - snprintf(buf,sizeof(buf),"failed_at_line_%d",line); - driver_failure_atom(port,buf); - /*abort();*/ + + if (erl_drv_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0 + && (strcmp("true", buf) == 0 || strcmp("yes", buf) == 0)) { + abort(); + } + else { + snprintf(buf,sizeof(buf),"failed_at_line_%d",line); + driver_failure_atom(port,buf); + } } #define my_driver_select(PORT,FD,MODE,ON) \ diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 0d3910b2e2..36d512e388 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -1689,7 +1689,7 @@ consume_timeslice(Config) when is_list(Config) -> consume_timeslice_test(Config) when is_list(Config) -> ensure_lib_loaded(Config), - CONTEXT_REDS = 2000, + CONTEXT_REDS = 4000, Me = self(), Go = make_ref(), RedDiff = make_ref(), diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 2c93891852..4decb7f418 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -116,7 +116,6 @@ static ERL_NIF_TERM make_pointer(ErlNifEnv* env, void* p) { void** bin_data; ERL_NIF_TERM res; - ADD_CALL("get_priv_data_ptr"); bin_data = (void**)enif_make_new_binary(env, sizeof(void*), &res); *bin_data = p; return res; @@ -389,8 +388,7 @@ static ERL_NIF_TERM type_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ ErlNifSInt64 sint64; ErlNifUInt64 uint64; double d; - ERL_NIF_TERM atom, ref1, ref2, term; - size_t len; + ERL_NIF_TERM atom, ref1, ref2; sint = INT_MIN; do { @@ -1024,6 +1022,7 @@ struct make_term_info { ErlNifEnv* caller_env; ErlNifEnv* dst_env; + int dst_env_valid; ERL_NIF_TERM reuse[MAKE_TERM_REUSE_LEN]; unsigned reuse_push; unsigned reuse_pull; @@ -1053,6 +1052,7 @@ static ERL_NIF_TERM pull_term(struct make_term_info* mti) mti->reuse_push < MAKE_TERM_REUSE_LEN) { mti->reuse_pull = 0; if (mti->reuse_push == 0) { + assert(mti->dst_env_valid); mti->reuse[0] = enif_make_list(mti->dst_env, 0); } } @@ -1241,6 +1241,7 @@ static unsigned num_of_make_funcs() static int make_term_n(struct make_term_info* mti, int n, ERL_NIF_TERM* res) { if (n < num_of_make_funcs()) { + assert(mti->dst_env_valid); *res = make_funcs[n](mti, n); push_term(mti, *res); return 1; @@ -1257,6 +1258,7 @@ static ERL_NIF_TERM make_blob(ErlNifEnv* caller_env, ErlNifEnv* dst_env, struct make_term_info mti; mti.caller_env = caller_env; mti.dst_env = dst_env; + mti.dst_env_valid = 1; mti.reuse_push = 0; mti.reuse_pull = 0; mti.resource_type = priv->rt_arr[0].t; @@ -1297,6 +1299,7 @@ static ERL_NIF_TERM alloc_msgenv(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar sizeof(*mti)); mti->caller_env = NULL; mti->dst_env = enif_alloc_env(); + mti->dst_env_valid = 1; mti->reuse_push = 0; mti->reuse_pull = 0; mti->resource_type = priv->rt_arr[0].t; @@ -1328,6 +1331,7 @@ static ERL_NIF_TERM clear_msgenv(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar return enif_make_badarg(env); } enif_clear_env(mti.p->dst_env); + mti.p->dst_env_valid = 1; mti.p->reuse_pull = 0; mti.p->reuse_push = 0; mti.p->blob = enif_make_list(mti.p->dst_env, 0); @@ -1362,6 +1366,8 @@ static ERL_NIF_TERM send_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ } copy = enif_make_copy(env, mti.p->blob); res = enif_send(env, &to, mti.p->dst_env, mti.p->blob); + if (res) + mti.p->dst_env_valid = 0; return enif_make_tuple3(env, atom_ok, enif_make_int(env,res), copy); } @@ -1369,7 +1375,6 @@ static ERL_NIF_TERM send3_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv { mti_t mti; ErlNifPid to; - ERL_NIF_TERM copy; int res; if (!enif_get_resource(env, argv[0], msgenv_resource_type, &mti.vp) || !enif_get_local_pid(env, argv[1], &to)) { @@ -1379,6 +1384,8 @@ static ERL_NIF_TERM send3_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv enif_make_copy(mti.p->dst_env, argv[2]), mti.p->blob); res = enif_send(env, &to, mti.p->dst_env, mti.p->blob); + if (res) + mti.p->dst_env_valid = 0; return enif_make_int(env,res); } @@ -1395,6 +1402,8 @@ void* threaded_sender(void *arg) mti.p->send_it = 0; enif_mutex_unlock(mti.p->mtx); mti.p->send_res = enif_send(NULL, &mti.p->to_pid, mti.p->dst_env, mti.p->blob); + if (mti.p->send_res) + mti.p->dst_env_valid = 0; return NULL; } diff --git a/erts/emulator/test/old_scheduler_SUITE.erl b/erts/emulator/test/old_scheduler_SUITE.erl index ffe7d40139..8515a87df8 100644 --- a/erts/emulator/test/old_scheduler_SUITE.erl +++ b/erts/emulator/test/old_scheduler_SUITE.erl @@ -64,11 +64,11 @@ all() -> init_per_testcase(_Case, Config) -> %% main test process needs max prio Prio = process_flag(priority, max), - MS = erlang:system_flag(multi_scheduling, block), + MS = erlang:system_flag(multi_scheduling, block_normal), [{prio,Prio},{multi_scheduling, MS}|Config]. end_per_testcase(_Case, Config) -> - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), Prio=proplists:get_value(prio, Config), process_flag(priority, Prio), ok. diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index d4e77d634a..2a13b2d2f4 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -2066,13 +2066,13 @@ exit_status_msb_test(Config, SleepSecs) when is_list(Config) -> StartedTime = (erlang:monotonic_time(microsecond) - Start)/1000000, io:format("StartedTime = ~p~n", [StartedTime]), true = StartedTime < SleepSecs, - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), lists:foreach(fun (P) -> receive {P, done} -> ok end end, Procs), DoneTime = (erlang:monotonic_time(microsecond) - Start)/1000000, io:format("DoneTime = ~p~n", [DoneTime]), true = DoneTime > SleepSecs, ok = verify_multi_scheduling_blocked(), - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), case {length(lists:usort(lists:flatten(SIds))), NoSchedsOnln} of {N, N} -> ok; @@ -2292,7 +2292,7 @@ maybe_to_list(List) -> List. format({Eol,List}) -> - io_lib:format("tuple<~w,~s>",[Eol, maybe_to_list(List)]); + io_lib:format("tuple<~w,~w>",[Eol, maybe_to_list(List)]); format(List) when is_list(List) -> case list_at_least(50, List) of true -> diff --git a/erts/emulator/test/port_SUITE_data/Makefile.src b/erts/emulator/test/port_SUITE_data/Makefile.src index fb7685c4b6..3a343e6d17 100644 --- a/erts/emulator/test/port_SUITE_data/Makefile.src +++ b/erts/emulator/test/port_SUITE_data/Makefile.src @@ -20,6 +20,12 @@ echo_args@exe@: echo_args@obj@ echo_args@obj@: echo_args.c $(CC) -c -o echo_args@obj@ $(CFLAGS) echo_args.c +dead_port@exe@: dead_port@obj@ + $(LD) $(CROSSLDFLAGS) -o dead_port dead_port@obj@ @LIBS@ + +dead_port@obj@: dead_port.c + $(CC) -c -o dead_port@obj@ $(CFLAGS) dead_port.c + port_test.@EMULATOR@: port_test.erl @erl_name@ -compile port_test diff --git a/erts/emulator/test/port_SUITE_data/port_test.c b/erts/emulator/test/port_SUITE_data/port_test.c index cc3ebdf0f8..e199a0fc13 100644 --- a/erts/emulator/test/port_SUITE_data/port_test.c +++ b/erts/emulator/test/port_SUITE_data/port_test.c @@ -10,6 +10,7 @@ #include <sys/types.h> #include <sys/stat.h> #include <fcntl.h> +#include <ctype.h> #ifndef __WIN32__ #include <unistd.h> @@ -33,7 +34,7 @@ exit(1); \ } -#define MAIN(argc, argv) main(argc, argv) +#define ASSERT(e) ((void) ((e) ? 1 : abort())) extern int errno; @@ -105,9 +106,7 @@ int err; #endif -MAIN(argc, argv) -int argc; -char *argv[]; +int main(int argc, char *argv[]) { int ret, fd_count; if((port_data = (PORT_TEST_DATA *) malloc(sizeof(PORT_TEST_DATA))) == NULL) { @@ -377,9 +376,11 @@ write_reply(buf, size) int size; /* Size of buffer to send. */ { int n; /* Temporary to hold size. */ + int rv; if (port_data->slow_writes <= 0) { /* Normal, "fast", write. */ - write(port_data->fd_to_erl, buf, size); + rv = write(port_data->fd_to_erl, buf, size); + ASSERT(rv == size); } else { /* * Write chunks with delays in between. @@ -387,7 +388,8 @@ write_reply(buf, size) while (size > 0) { n = size > port_data->slow_writes ? port_data->slow_writes : size; - write(port_data->fd_to_erl, buf, n); + rv = write(port_data->fd_to_erl, buf, n); + ASSERT(rv == n); size -= n; buf += n; if (size) @@ -558,7 +560,7 @@ char* spec; /* Specification for reply. */ buf = (char *) malloc(total_size); if (buf == NULL) { fprintf(stderr, "%s: insufficent memory for reply buffer of size %d\n", - port_data->progname, total_size); + port_data->progname, (int)total_size); exit(1); } diff --git a/erts/emulator/test/port_trace_SUITE_data/echo_drv.c b/erts/emulator/test/port_trace_SUITE_data/echo_drv.c index b545523192..20ec33a594 100644 --- a/erts/emulator/test/port_trace_SUITE_data/echo_drv.c +++ b/erts/emulator/test/port_trace_SUITE_data/echo_drv.c @@ -2,23 +2,30 @@ #include "erl_driver.h" #include <errno.h> #include <string.h> +#include <assert.h> /* ------------------------------------------------------------------------- ** Data types **/ +struct my_thread { + struct my_thread* next; + ErlDrvTid tid; +}; typedef struct _erl_drv_data { ErlDrvPort erlang_port; ErlDrvTermData caller; + struct my_thread* threads; } EchoDrvData; struct remote_send_term { - char *buf; - int len; + struct my_thread thread; ErlDrvTermData port; ErlDrvTermData caller; + int len; + char buf[1]; /* buf[len] */ }; #define ECHO_DRV_NOOP 0 @@ -86,7 +93,7 @@ static ErlDrvEntry echo_drv_entry = { NULL }; -static void send_term_thread(void *); +static void* send_term_thread(void *); /* ------------------------------------------------------------------------- ** Entry functions @@ -111,10 +118,22 @@ static EchoDrvData *echo_drv_start(ErlDrvPort port, char *command) EchoDrvData *echo_drv_data_p = driver_alloc(sizeof(EchoDrvData)); echo_drv_data_p->erlang_port = port; echo_drv_data_p->caller = driver_caller(port); + echo_drv_data_p->threads = NULL; return echo_drv_data_p; } -static void echo_drv_stop(EchoDrvData *data_p) { +static void echo_drv_stop(EchoDrvData *data_p) +{ + struct my_thread* thr = data_p->threads; + + while (thr) { + struct my_thread* next = thr->next; + void* exit_value; + int ret = erl_drv_thread_join(thr->tid, &exit_value); + assert(ret == 0 && exit_value == NULL); + driver_free(thr); + thr = next; + } driver_free(data_p); } @@ -212,14 +231,14 @@ static void echo_drv_output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) { } case ECHO_DRV_REMOTE_SEND_TERM: { - ErlDrvTid tid; - struct remote_send_term *t = malloc(sizeof(struct remote_send_term)); + struct remote_send_term *t = driver_alloc(sizeof(struct remote_send_term) + len); t->len = len-1; - t->buf = malloc(len-1); t->port = driver_mk_port(port); t->caller = data_p->caller; memcpy(t->buf, buf+1, t->len); - erl_drv_thread_create("tmp_thread", &tid, send_term_thread, t, NULL); + erl_drv_thread_create("tmp_thread", &t->thread.tid, send_term_thread, t, NULL); + t->thread.next = data_p->threads; + data_p->threads = &t->thread; break; } case ECHO_DRV_SAVE_CALLER: @@ -262,7 +281,7 @@ static ErlDrvSSizeT echo_drv_call(ErlDrvData drv_data, return len-command; } -static void send_term_thread(void *a) +static void* send_term_thread(void *a) { struct remote_send_term *t = (struct remote_send_term*)a; ErlDrvTermData term[] = { @@ -273,5 +292,5 @@ static void send_term_thread(void *a) ERL_DRV_TUPLE, 3}; erl_drv_send_term(t->port, t->caller, term, sizeof(term) / sizeof(ErlDrvTermData)); - return; + return NULL; } diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index e035fc64fe..e14185e881 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -437,11 +437,22 @@ t_process_info(Config) when is_list(Config) -> verify_loc(Line2, Res2), pi_stacktrace([{?MODULE,t_process_info,1,?LINE}]), + verify_stacktrace_depth(), + Gleader = group_leader(), {group_leader, Gleader} = process_info(self(), group_leader), {'EXIT',{badarg,_Info}} = (catch process_info('not_a_pid')), ok. +verify_stacktrace_depth() -> + CS = current_stacktrace, + OldDepth = erlang:system_flag(backtrace_depth, 0), + {CS,[]} = erlang:process_info(self(), CS), + _ = erlang:system_flag(backtrace_depth, 8), + {CS,[{?MODULE,verify_stacktrace_depth,0,_},_|_]} = + erlang:process_info(self(), CS), + _ = erlang:system_flag(backtrace_depth, OldDepth). + pi_stacktrace(Expected0) -> {Line,Res} = {?LINE,erlang:process_info(self(), current_stacktrace)}, {current_stacktrace,Stack} = Res, @@ -1017,9 +1028,9 @@ low_prio(Config) when is_list(Config) -> 1 -> ok = low_prio_test(Config); _ -> - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), ok = low_prio_test(Config), - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), {comment, "Test not written for SMP runtime system. " "Multi scheduling blocked during test."} @@ -1086,9 +1097,9 @@ yield(Config) when is_list(Config) -> ++ ") is enabled. Testcase gets messed up by modfied " "timing."}; _ -> - MS = erlang:system_flag(multi_scheduling, block), + MS = erlang:system_flag(multi_scheduling, block_normal), yield_test(), - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), case MS of blocked -> {comment, @@ -1611,6 +1622,7 @@ spawn_initial_hangarounds(_Cleaner, NP, Max, Len, HAs) when NP > Max -> {Len, HAs}; spawn_initial_hangarounds(Cleaner, NP, Max, Len, HAs) -> Skip = 30, + wait_for_proc_slots(Skip+3), HA1 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround], [{priority, low}]), HA2 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround], @@ -1620,6 +1632,15 @@ spawn_initial_hangarounds(Cleaner, NP, Max, Len, HAs) -> spawn_drop(Skip), spawn_initial_hangarounds(Cleaner, NP+Skip, Max, Len+3, [HA1,HA2,HA3|HAs]). +wait_for_proc_slots(MinFreeSlots) -> + case erlang:system_info(process_limit) - erlang:system_info(process_count) of + FreeSlots when FreeSlots < MinFreeSlots -> + receive after 10 -> ok end, + wait_for_proc_slots(MinFreeSlots); + _FreeSlots -> + ok + end. + spawn_drop(N) when N =< 0 -> ok; spawn_drop(N) -> @@ -1658,7 +1679,7 @@ processes_bif_test() -> true -> %% Do it again with a process suspended while %% in the processes/0 bif. - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), Suspendee = spawn_link(fun () -> Tester ! {suspend_me, self()}, Tester ! {self(), @@ -1671,7 +1692,7 @@ processes_bif_test() -> end), receive {suspend_me, Suspendee} -> ok end, erlang:suspend_process(Suspendee), - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), [{status,suspended},{current_function,{erlang,ptab_list_continue,2}}] = process_info(Suspendee, [status, current_function]), @@ -1711,10 +1732,10 @@ do_processes_bif_test(WantReds, DieTest, Processes) -> Splt = NoTestProcs div 10, {TP1, TP23} = lists:split(Splt, TestProcs), {TP2, TP3} = lists:split(Splt, TP23), - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), Tester ! DoIt, receive GetGoing -> ok end, - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), SpawnProcesses(high), lists:foreach( fun (P) -> SpawnHangAround(), @@ -1923,7 +1944,7 @@ processes_gc_trap(Config) when is_list(Config) -> processes() end, - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), Suspendee = spawn_link(fun () -> Tester ! {suspend_me, self()}, Tester ! {self(), @@ -1933,7 +1954,7 @@ processes_gc_trap(Config) when is_list(Config) -> end), receive {suspend_me, Suspendee} -> ok end, erlang:suspend_process(Suspendee), - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), [{status,suspended}, {current_function,{erlang,ptab_list_continue,2}}] = process_info(Suspendee, [status, current_function]), @@ -2140,7 +2161,7 @@ processes_term_proc_list_test(MustChk) -> end) end, SpawnSuspendProcessesProc = fun () -> - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), P = spawn_link(fun () -> Tester ! {suspend_me, self()}, Tester ! {self(), @@ -2150,7 +2171,7 @@ processes_term_proc_list_test(MustChk) -> end), receive {suspend_me, P} -> ok end, erlang:suspend_process(P), - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), [{status,suspended}, {current_function,{erlang,ptab_list_continue,2}}] = process_info(P, [status, current_function]), @@ -2211,7 +2232,7 @@ processes_term_proc_list_test(MustChk) -> S8 = SpawnSuspendProcessesProc(), ?CHK_TERM_PROC_LIST(MustChk, 7), - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), Exit(S8), ?CHK_TERM_PROC_LIST(MustChk, 7), Exit(S5), @@ -2220,7 +2241,7 @@ processes_term_proc_list_test(MustChk) -> ?CHK_TERM_PROC_LIST(MustChk, 6), Exit(S6), ?CHK_TERM_PROC_LIST(MustChk, 0), - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), as_expected. diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index 3aee15a8fc..b178dede5b 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -1095,16 +1095,13 @@ scheduler_threads(Config) when is_list(Config) -> end. dirty_scheduler_threads(Config) when is_list(Config) -> - SmpSupport = erlang:system_info(smp_support), - try - erlang:system_info(dirty_cpu_schedulers), - dirty_scheduler_threads_test(Config, SmpSupport) - catch - error:badarg -> - {skipped, "No dirty scheduler support"} + case erlang:system_info(dirty_cpu_schedulers) of + 0 -> {skipped, "No dirty scheduler support"}; + _ -> dirty_scheduler_threads_test(Config) end. -dirty_scheduler_threads_test(Config, SmpSupport) -> +dirty_scheduler_threads_test(Config) -> + SmpSupport = erlang:system_info(smp_support), {Sched, SchedOnln, _} = get_dsstate(Config, ""), {HalfSched, HalfSchedOnln} = case SmpSupport of false -> {1,1}; @@ -1374,12 +1371,9 @@ sst2_loop(N) -> sst2_loop(N-1). sst3_loop(S, N) -> - try erlang:system_info(dirty_cpu_schedulers) of - DS -> - sst3_loop_with_dirty_schedulers(S, DS, N) - catch - error:badarg -> - sst3_loop_normal_schedulers_only(S, N) + case erlang:system_info(dirty_cpu_schedulers) of + 0 -> sst3_loop_normal_schedulers_only(S, N); + DS -> sst3_loop_with_dirty_schedulers(S, DS, N) end. sst3_loop_normal_schedulers_only(_S, 0) -> diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl index a1f12ba93c..f51244485b 100644 --- a/erts/emulator/test/statistics_SUITE.erl +++ b/erts/emulator/test/statistics_SUITE.erl @@ -28,6 +28,8 @@ runtime_update/1, runtime_diff/1, run_queue_one/1, scheduler_wall_time/1, + scheduler_wall_time_all/1, + msb_scheduler_wall_time/1, reductions/1, reductions_big/1, garbage_collection/1, io/1, badarg/1, run_queues_lengths_active_tasks/1, msacc/1]). @@ -43,7 +45,9 @@ suite() -> all() -> [{group, wall_clock}, {group, runtime}, reductions, - reductions_big, {group, run_queue}, scheduler_wall_time, + reductions_big, {group, run_queue}, + scheduler_wall_time, scheduler_wall_time_all, + msb_scheduler_wall_time, garbage_collection, io, badarg, run_queues_lengths_active_tasks, msacc]. @@ -271,35 +275,64 @@ hog_iter(0, Mon) -> %% Tests that statistics(scheduler_wall_time) works as intended scheduler_wall_time(Config) when is_list(Config) -> + scheduler_wall_time_test(scheduler_wall_time). + +%% Tests that statistics(scheduler_wall_time_all) works as intended +scheduler_wall_time_all(Config) when is_list(Config) -> + scheduler_wall_time_test(scheduler_wall_time_all). + +scheduler_wall_time_test(Type) -> %% Should return undefined if system_flag is not turned on yet - undefined = statistics(scheduler_wall_time), + undefined = statistics(Type), %% Turn on statistics false = erlang:system_flag(scheduler_wall_time, true), try Schedulers = erlang:system_info(schedulers_online), + DirtyCPUSchedulers = erlang:system_info(dirty_cpu_schedulers_online), + DirtyIOSchedulers = erlang:system_info(dirty_io_schedulers), + TotLoadSchedulers = case Type of + scheduler_wall_time_all -> + Schedulers + DirtyCPUSchedulers + DirtyIOSchedulers; + scheduler_wall_time -> + Schedulers + DirtyCPUSchedulers + end, + %% Let testserver and everyone else finish their work timer:sleep(1500), %% Empty load - EmptyLoad = get_load(), + EmptyLoad = get_load(Type), {false, _} = {lists:any(fun(Load) -> Load > 50 end, EmptyLoad),EmptyLoad}, MeMySelfAndI = self(), StartHog = fun() -> - Pid = spawn(?MODULE, hog, [self()]), + Pid = spawn_link(?MODULE, hog, [self()]), receive hog_started -> MeMySelfAndI ! go end, Pid end, + StartDirtyHog = fun(Func) -> + F = fun () -> + erts_debug:Func(alive_waitexiting, + MeMySelfAndI) + end, + Pid = spawn_link(F), + receive {alive, Pid} -> ok end, + Pid + end, P1 = StartHog(), %% Max on one, the other schedulers empty (hopefully) %% Be generous the process can jump between schedulers %% which is ok and we don't want the test to fail for wrong reasons - _L1 = [S1Load|EmptyScheds1] = get_load(), + _L1 = [S1Load|EmptyScheds1] = get_load(Type), {true,_} = {S1Load > 50,S1Load}, {false,_} = {lists:any(fun(Load) -> Load > 50 end, EmptyScheds1),EmptyScheds1}, {true,_} = {lists:sum(EmptyScheds1) < 60,EmptyScheds1}, %% 50% load HalfHogs = [StartHog() || _ <- lists:seq(1, (Schedulers-1) div 2)], - HalfLoad = lists:sum(get_load()) div Schedulers, + HalfDirtyCPUHogs = [StartDirtyHog(dirty_cpu) + || _ <- lists:seq(1, DirtyCPUSchedulers div 2)], + HalfDirtyIOHogs = [StartDirtyHog(dirty_io) + || _ <- lists:seq(1, DirtyIOSchedulers div 2)], + HalfLoad = lists:sum(get_load(Type)) div TotLoadSchedulers, if Schedulers < 2, HalfLoad > 80 -> ok; %% Ok only one scheduler online and one hog %% We want roughly 50% load HalfLoad > 40, HalfLoad < 60 -> ok; @@ -308,23 +341,30 @@ scheduler_wall_time(Config) when is_list(Config) -> %% 100% load LastHogs = [StartHog() || _ <- lists:seq(1, Schedulers div 2)], - FullScheds = get_load(), + LastDirtyCPUHogs = [StartDirtyHog(dirty_cpu) + || _ <- lists:seq(1, DirtyCPUSchedulers div 2)], + LastDirtyIOHogs = [StartDirtyHog(dirty_io) + || _ <- lists:seq(1, DirtyIOSchedulers div 2)], + FullScheds = get_load(Type), {false,_} = {lists:any(fun(Load) -> Load < 80 end, FullScheds),FullScheds}, - FullLoad = lists:sum(FullScheds) div Schedulers, + FullLoad = lists:sum(FullScheds) div TotLoadSchedulers, if FullLoad > 90 -> ok; true -> exit({fullload, FullLoad}) end, KillHog = fun (HP) -> HPM = erlang:monitor(process, HP), + unlink(HP), exit(HP, kill), receive {'DOWN', HPM, process, HP, killed} -> ok end end, - [KillHog(Pid) || Pid <- [P1|HalfHogs++LastHogs]], - AfterLoad = get_load(), + [KillHog(Pid) || Pid <- [P1|HalfHogs++HalfDirtyCPUHogs++HalfDirtyIOHogs + ++LastHogs++LastDirtyCPUHogs++LastDirtyIOHogs]], + receive after 2000 -> ok end, %% Give dirty schedulers time to complete... + AfterLoad = get_load(Type), io:format("AfterLoad=~p~n", [AfterLoad]), {false,_} = {lists:any(fun(Load) -> Load > 25 end, AfterLoad),AfterLoad}, true = erlang:system_flag(scheduler_wall_time, false) @@ -332,16 +372,81 @@ scheduler_wall_time(Config) when is_list(Config) -> erlang:system_flag(scheduler_wall_time, false) end. -get_load() -> - Start = erlang:statistics(scheduler_wall_time), +get_load(Type) -> + Start = erlang:statistics(Type), timer:sleep(1500), - End = erlang:statistics(scheduler_wall_time), + End = erlang:statistics(Type), lists:reverse(lists:sort(load_percentage(lists:sort(Start),lists:sort(End)))). load_percentage([{Id, WN, TN}|Ss], [{Id, WP, TP}|Ps]) -> [100*(WN-WP) div (TN-TP)|load_percentage(Ss, Ps)]; load_percentage([], []) -> []. +count(0) -> + ok; +count(N) -> + count(N-1). + +msb_swt_hog(true) -> + count(1000000), + erts_debug:dirty_cpu(wait, 10), + erts_debug:dirty_io(wait, 10), + msb_swt_hog(true); +msb_swt_hog(false) -> + count(1000000), + msb_swt_hog(false). + +msb_scheduler_wall_time(Config) -> + erlang:system_flag(scheduler_wall_time, true), + Dirty = erlang:system_info(dirty_cpu_schedulers) /= 0, + Hogs = lists:map(fun (_) -> + spawn_opt(fun () -> + msb_swt_hog(Dirty) + end, [{priority,low}, link, monitor]) + end, lists:seq(1,10)), + erlang:system_flag(multi_scheduling, block), + try + SWT1 = lists:sort(statistics(scheduler_wall_time_all)), + %% io:format("SWT1 = ~p~n", [SWT1]), + receive after 4000 -> ok end, + SWT2 = lists:sort(statistics(scheduler_wall_time_all)), + %% io:format("SWT2 = ~p~n", [SWT2]), + SWT = lists:zip(SWT1, SWT2), + io:format("SU = ~p~n", [lists:map(fun({{I, A0, T0}, {I, A1, T1}}) -> + {I, (A1 - A0)/(T1 - T0)} end, + SWT)]), + {A, T} = lists:foldl(fun({{_, A0, T0}, {_, A1, T1}}, {Ai,Ti}) -> + {Ai + (A1 - A0), Ti + (T1 - T0)} + end, + {0, 0}, + SWT), + TSU = A/T, + WSU = ((TSU * (erlang:system_info(schedulers) + + erlang:system_info(dirty_cpu_schedulers) + + erlang:system_info(dirty_io_schedulers))) + / 1), + %% Weighted scheduler utilization should be + %% very close to 1.0, i.e., we execute the + %% same time as one thread executing all + %% the time... + io:format("WSU = ~p~n", [WSU]), + true = 0.9 < WSU andalso WSU < 1.1, + ok + after + erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(scheduler_wall_time, false), + lists:foreach(fun ({HP, _HM}) -> + unlink(HP), + exit(HP, kill) + end, Hogs), + lists:foreach(fun ({HP, HM}) -> + receive + {'DOWN', HM, process, HP, _} -> + ok + end + end, Hogs), + ok + end. %% Tests that statistics(garbage_collection) is callable. %% It is not clear how to test anything more. diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl index 3d9e74472b..6a772bf7c9 100644 --- a/erts/emulator/test/system_info_SUITE.erl +++ b/erts/emulator/test/system_info_SUITE.erl @@ -36,7 +36,8 @@ -export([all/0, suite/0]). -export([process_count/1, system_version/1, misc_smoke_tests/1, - heap_size/1, wordsize/1, memory/1, ets_limit/1, atom_limit/1]). + heap_size/1, wordsize/1, memory/1, ets_limit/1, atom_limit/1, + atom_count/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -44,7 +45,7 @@ suite() -> all() -> [process_count, system_version, misc_smoke_tests, - heap_size, wordsize, memory, ets_limit, atom_limit]. + heap_size, wordsize, memory, ets_limit, atom_limit, atom_count]. %%% %%% The test cases ------------------------------------------------------------- @@ -550,3 +551,13 @@ get_atom_limit(Config, AtomsMax) -> end, stop_node(Node), Res. + +%% Verify that system_info(atom_count) works. +atom_count(Config) when is_list(Config) -> + Limit = erlang:system_info(atom_limit), + Count1 = erlang:system_info(atom_count), + list_to_atom(integer_to_list(erlang:unique_integer())), + Count2 = erlang:system_info(atom_count), + true = Limit >= Count2, + true = Count2 > Count1, + ok. diff --git a/erts/emulator/test/z_SUITE.erl b/erts/emulator/test/z_SUITE.erl index ab56018373..d663cc548c 100644 --- a/erts/emulator/test/z_SUITE.erl +++ b/erts/emulator/test/z_SUITE.erl @@ -68,8 +68,8 @@ schedulers_alive(Config) when is_list(Config) -> enabled -> io:format("Testing blocking process exit~n"), BF = fun () -> - blocked = erlang:system_flag(multi_scheduling, - block), + blocked_normal = erlang:system_flag(multi_scheduling, + block_normal), Master ! {self(), blocking}, receive after infinity -> ok end end, @@ -77,21 +77,21 @@ schedulers_alive(Config) when is_list(Config) -> Mon = erlang:monitor(process, Blocker), receive {Blocker, blocking} -> ok end, [Blocker] - = erlang:system_info(multi_scheduling_blockers), + = erlang:system_info(normal_multi_scheduling_blockers), unlink(Blocker), exit(Blocker, kill), receive {'DOWN', Mon, _, _, _} -> ok end, enabled = erlang:system_info(multi_scheduling), - [] = erlang:system_info(multi_scheduling_blockers), + [] = erlang:system_info(normal_multi_scheduling_blockers), ok end, io:format("Testing blocked~n"), - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), case erlang:system_info(multi_scheduling) of enabled -> ct:fail(multi_scheduling_enabled); - blocked -> - [Master] = erlang:system_info(multi_scheduling_blockers); + blocked_normal -> + [Master] = erlang:system_info(normal_multi_scheduling_blockers); disabled -> ok end, Ps = lists:map( @@ -109,8 +109,8 @@ schedulers_alive(Config) when is_list(Config) -> unlink(P), exit(P, bang) end, Ps), - case erlang:system_flag(multi_scheduling, unblock) of - blocked -> ct:fail(multi_scheduling_blocked); + case erlang:system_flag(multi_scheduling, unblock_normal) of + blocked_normal -> ct:fail(multi_scheduling_blocked); disabled -> ok; enabled -> ok end, diff --git a/erts/emulator/utils/make_tables b/erts/emulator/utils/make_tables index 27f9dcc878..47e1528958 100755 --- a/erts/emulator/utils/make_tables +++ b/erts/emulator/utils/make_tables @@ -36,6 +36,10 @@ use File::Basename; # <-src>/erl_am.c # <-src>/erl_bif_table.c # <-src>/erl_bif_wrap.c +# <-src>/erl_dirty_bif_wrap.c +# <-src>/erl_guard_bifs.c +# <-src>/hipe_nbif_impl.c +# <-include>/hipe_nbif_impl.h # <-include>/erl_atom_table.h # <-include>/erl_bif_table.h # @@ -51,9 +55,13 @@ my %atom; my %atom_alias; my %aliases; my $auto_alias_num = 0; +my %dirty_bif_tab; my @bif; -my @bif_type; +my @bif_info; +my $dirty_schedulers = 'no'; +my $dirty_schedulers_test = 'no'; +my $hipe = 'no'; while (@ARGV && $ARGV[0] =~ /^-(\w+)/) { my $opt = shift; @@ -65,6 +73,18 @@ while (@ARGV && $ARGV[0] =~ /^-(\w+)/) { $include = shift; die "No directory for -include argument specified" unless defined $include; + } elsif($opt eq '-ds') { + $dirty_schedulers = shift; + die "No -ds argument specified" + unless defined $dirty_schedulers; + } elsif($opt eq '-dst') { + $dirty_schedulers_test = shift; + die "No -dst argument specified" + unless defined $dirty_schedulers_test; + } elsif($opt eq '-hipe') { + $hipe = shift; + die "No -hipe argument specified" + unless defined $hipe; } else { usage("bad option: $opt"); } @@ -84,12 +104,31 @@ while (<>) { my($bif,$alias) = (@args); $bif =~ m@^([a-z_.'0-9]+):(.*)/(\d)$@ or error("invalid BIF"); my($mod,$name,$arity) = ($1,$2,$3); + my $mfa = "$mod:$name/$arity"; save_atoms($mod, $name); unless (defined $alias) { $alias = ""; $alias = "${mod}_" unless $mod eq 'erlang'; $alias .= "${name}_$arity"; } + my $sched_type; + my $alias3 = $alias; + + $sched_type = $dirty_bif_tab{$mfa}; + + if (!$sched_type or ($type eq 'ubif')) { + $sched_type = 'normal'; + } + elsif ($sched_type eq 'dirty_cpu') { + $alias3 = "schedule_dirty_cpu_$alias" + } + elsif ($sched_type eq 'dirty_io') { + $alias3 = "schedule_dirty_io_$alias" + } + else { + error("invalid sched_type: $sched_type"); + } + my $wrapper; if ($type eq 'bif') { $wrapper = "wrap_$alias"; @@ -97,8 +136,25 @@ while (<>) { $wrapper = $alias; } push(@bif, ["am_$atom_alias{$mod}","am_$atom_alias{$name}",$arity, - $alias,$wrapper]); - push(@bif_type, $type); + $alias3,$wrapper,$alias]); + push(@bif_info, [$type, $sched_type, $alias3, $alias]); + } elsif ($type eq 'dirty-cpu' or $type eq 'dirty-io' + or $type eq 'dirty-cpu-test' or $type eq 'dirty-io-test') { + if ($dirty_schedulers eq 'yes') { + my($bif,$other) = (@args); + $bif =~ m@^([a-z_.'0-9]+):(.*)/(\d)$@ or error("invalid BIF"); + my($mod,$name,$arity) = ($1,$2,$3); + my $mfa = "$mod:$name/$arity"; + if (($type eq 'dirty-cpu') + or (($dirty_schedulers_test eq 'yes') + and ($type eq 'dirty-cpu-test'))) { + $dirty_bif_tab{$mfa} = 'dirty_cpu'; + } elsif (($type eq 'dirty-io') + or (($dirty_schedulers_test eq 'yes') + and ($type eq 'dirty-io-test'))) { + $dirty_bif_tab{$mfa} = 'dirty_io'; + } + } } else { error("invalid line"); } @@ -147,7 +203,7 @@ open_file("$include/erl_bif_list.h"); my $i; for ($i = 0; $i < @bif; $i++) { # module atom, function atom, arity, C function, table index - print "BIF_LIST($bif[$i]->[0],$bif[$i]->[1],$bif[$i]->[2],$bif[$i]->[3],$i)\n"; + print "BIF_LIST($bif[$i]->[0],$bif[$i]->[1],$bif[$i]->[2],$bif[$i]->[3],$bif[$i]->[5],$i)\n"; } # @@ -167,16 +223,24 @@ typedef struct bif_entry { int arity; BifFunction f; BifFunction traced; + BifFunction impl; } BifEntry; typedef struct erts_gc_bif { BifFunction bif; BifFunction gc_bif; + int exp_ix; } ErtsGcBif; +typedef struct erts_u_bif { + BifFunction bif; + int exp_ix; +} ErtsUBif; + extern BifEntry bif_table[]; extern Export* bif_export[]; extern const ErtsGcBif erts_gc_bifs[]; +extern const ErtsUBif erts_u_bifs[]; #define BIF_SIZE $bif_size @@ -184,21 +248,28 @@ EOF my $i; for ($i = 0; $i < @bif; $i++) { - print "#define BIF_$bif[$i]->[3] $i\n"; + print "#define BIF_$bif_info[$i]->[3] $i\n"; } print "\n"; for ($i = 0; $i < @bif; $i++) { - my $args = join(', ', 'Process*', 'Eterm*'); - my $name = $bif[$i]->[3]; + my $args = join(', ', 'Process*', 'Eterm*', 'UWord*'); + my $name = $bif_info[$i]->[3]; print "Eterm $name($args);\n"; - print "Eterm wrap_$name($args, UWord *I);\n"; + print "Eterm wrap_$name($args);\n"; print "Eterm erts_gc_$name(Process* p, Eterm* reg, Uint live);\n" - if $bif_type[$i] eq 'gcbif'; + if $bif_info[$i]->[0] eq 'gcbif'; + print "Eterm $bif_info[$i]->[2]($args);\n" + unless $bif_info[$i]->[1] eq 'normal'; print "\n"; } -print "#endif\n"; + +if ($hipe eq 'yes') { + print "\n#include \"hipe_nbif_impl.h\"\n"; +} + +print "\n#endif\n"; # # Generate the bif table file. @@ -229,7 +300,7 @@ includes("export.h", "sys.h", "erl_vm.h", "global.h", "erl_process.h", "bif.h", for ($i = 0; $i < @bif; $i++) { next if $bif[$i]->[3] eq $bif[$i]->[4]; # Skip unwrapped bifs my $arity = $bif[$i]->[2]; - my $func = $bif[$i]->[3]; + my $func = $bif_info[$i]->[3]; print "Eterm\n"; print "wrap_$func(Process* p, Eterm* args, UWord* I)\n"; print "{\n"; @@ -241,21 +312,101 @@ for ($i = 0; $i < @bif; $i++) { # Generate erl_gc_bifs.c. # -open_file("$src/erl_gc_bifs.c"); +open_file("$src/erl_guard_bifs.c"); my $i; includes("export.h", "sys.h", "erl_vm.h", "global.h", "erl_process.h", "bif.h", "erl_bif_table.h"); print "const ErtsGcBif erts_gc_bifs[] = {\n"; for ($i = 0; $i < @bif; $i++) { - next unless $bif_type[$i] eq 'gcbif'; - my $arity = $bif[$i]->[2]; - my $func = $bif[$i]->[3]; - print " {$func, erts_gc_$func},\n"; + next unless $bif_info[$i]->[0] eq 'gcbif'; + print " {$bif[$i]->[3], erts_gc_$bif[$i]->[3], BIF_$bif[$i]->[5]},\n"; +} +print " {NULL, NULL, -1}\n"; +print "};\n"; + +print "const ErtsUBif erts_u_bifs[] = {\n"; +for ($i = 0; $i < @bif; $i++) { + next unless $bif_info[$i]->[0] eq 'ubif'; + print " {$bif[$i]->[3], BIF_$bif[$i]->[5]},\n"; } -print " {0, 0}\n"; +print " {NULL, -1}\n"; print "};\n"; # +# Generate the dirty bif wrappers file. +# + +open_file("$src/erl_dirty_bif_wrap.c"); +my $i; +includes("erl_process.h", "erl_nfunc_sched.h", "erl_bif_table.h", "erl_atom_table.h"); +for ($i = 0; $i < @bif_info; $i++) { + next if $bif_info[$i]->[1] eq 'normal'; + my $dtype; + if ($bif_info[$i]->[1] eq 'dirty_cpu') { + $dtype = "ERTS_SCHED_DIRTY_CPU"; + } + else { + $dtype = "ERTS_SCHED_DIRTY_IO"; + } +print <<EOF; +Eterm $bif_info[$i]->[2](Process *c_p, Eterm *regs, BeamInstr *I) +{ + return erts_reschedule_bif(c_p, regs, I, $bif_info[$i]->[3], $dtype); +} + +EOF + +} + +if ($hipe eq 'yes') { + + # + # Generate the nbif_impl bif wrappers file. + # + + open_file("$src/hipe_nbif_impl.h"); + print <<EOF; + +#ifndef HIPE_NBIF_IMPL_H__ +#define HIPE_NBIF_IMPL_H__ + +EOF + + my $i; + for ($i = 0; $i < @bif; $i++) { + print <<EOF; +Eterm nbif_impl_$bif[$i]->[5](Process *c_p, Eterm *regs); +EOF + } + + print <<EOF; + +#endif /* ERL_HIPE_NBIF_IMPL_H__ */ + +EOF + + # + # Generate the nbif_impl bif wrappers file. + # + + open_file("$src/hipe_nbif_impl.c"); + my $i; + includes("erl_process.h", "erl_nfunc_sched.h", "erl_bif_table.h", "erl_atom_table.h"); + for ($i = 0; $i < @bif; $i++) { + + print <<EOF; +Eterm nbif_impl_$bif[$i]->[5](Process *c_p, Eterm *regs) +{ + return $bif[$i]->[3](c_p, regs, (UWord *) bif_export\[BIF_$bif[$i]->[5]\]); +} + +EOF + + } + +} # hipe + +# # Utilities follow. # diff --git a/erts/etc/common/heart.c b/erts/etc/common/heart.c index d67b997d6d..bc353e384e 100644 --- a/erts/etc/common/heart.c +++ b/erts/etc/common/heart.c @@ -48,13 +48,10 @@ * * HEART_BEATING * - * This program expects a heart beat messages. If it does not receive a - * heart beat message from Erlang within heart_beat_timeout seconds, it - * reboots the system. The variable heart_beat_timeout is exported (so - * that it can be set from the shell in VxWorks, as is the variable - * heart_beat_report_delay). When using Solaris, the system is rebooted - * by executing the command stored in the environment variable - * HEART_COMMAND. + * This program expects a heart beat message. If it does not receive a + * heart beat message from Erlang within heart_beat_timeout seconds, it + * reboots the system. The system is rebooted by executing the command + * stored in the environment variable HEART_COMMAND. * * BLOCKING DESCRIPTORS * @@ -149,27 +146,17 @@ struct msg { /* Maybe interesting to change */ /* Times in seconds */ -#define HEART_BEAT_BOOT_DELAY 60 /* 1 minute */ #define SELECT_TIMEOUT 5 /* Every 5 seconds we reset the watchdog timer */ /* heart_beat_timeout is the maximum gap in seconds between two - consecutive heart beat messages from Erlang, and HEART_BEAT_BOOT_DELAY - is the the extra delay that wd_keeper allows for, to give heart a - chance to reboot in the "normal" way before the hardware watchdog - enters the scene. heart_beat_report_delay is the time allowed for reporting - before rebooting under VxWorks. */ + consecutive heart beat messages from Erlang. */ int heart_beat_timeout = 60; -int heart_beat_report_delay = 30; -int heart_beat_boot_delay = HEART_BEAT_BOOT_DELAY; /* All current platforms have a process identifier that fits in an unsigned long and where 0 is an impossible or invalid value */ unsigned long heart_beat_kill_pid = 0; -#define VW_WD_TIMEOUT (heart_beat_timeout+heart_beat_report_delay+heart_beat_boot_delay) -#define SOL_WD_TIMEOUT (heart_beat_timeout+heart_beat_boot_delay) - /* reasons for reboot */ #define R_TIMEOUT (1) #define R_CLOSED (2) @@ -297,7 +284,6 @@ free_env_val(char *value) static void get_arguments(int argc, char** argv) { int i = 1; int h; - int w; unsigned long p; while (i < argc) { @@ -313,15 +299,6 @@ static void get_arguments(int argc, char** argv) { i++; } break; - case 'w': - if (strcmp(argv[i], "-wt") == 0) - if (sscanf(argv[i+1],"%i",&w) ==1) - if ((w > 10) && (w <= 65535)) { - heart_beat_boot_delay = w; - fprintf(stderr,"heart_beat_boot_delay = %d\n",w); - i++; - } - break; case 'p': if (strcmp(argv[i], "-pid") == 0) if (sscanf(argv[i+1],"%lu",&p) ==1){ @@ -347,7 +324,7 @@ static void get_arguments(int argc, char** argv) { } i++; } - debugf("arguments -ht %d -wt %d -pid %lu\n",h,w,p); + debugf("arguments -ht %d -pid %lu\n",h,p); } int main(int argc, char **argv) { @@ -674,11 +651,6 @@ void win_system(char *command) */ static void do_terminate(int erlin_fd, int reason) { - /* - When we get here, we have HEART_BEAT_BOOT_DELAY secs to finish - (plus heart_beat_report_delay if under VxWorks), so we don't need - to call wd_reset(). - */ int ret = 0, tmo=0; char *tmo_env; diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in index 0990fcf8a7..c7e2ac169d 100644 --- a/erts/etc/unix/etp-commands.in +++ b/erts/etc/unix/etp-commands.in @@ -1817,6 +1817,262 @@ document etp-proc-state % Print state of process %--------------------------------------------------------------------------- end +define etp-proc-state-int +# Args: int +# + if ($arg0 & 0x80000000) + printf "GARBAGE<0x80000000> | " + end + if ($arg0 & 0x40000000) + printf "dirty-running-sys | " + end + if ($arg0 & 0x20000000) + printf "dirty-running | " + end + if ($arg0 & 0x10000000) + printf "dirty-active-sys | " + end + if ($arg0 & 0x8000000) + printf "dirty-io-proc | " + end + if ($arg0 & 0x4000000) + printf "dirty-cpu-proc | " + end + if ($arg0 & 0x2000000) + printf "on-heap-msgq | " + end + if ($arg0 & 0x1000000) + printf "off-heap-msgq | " + end + if ($arg0 & 0x800000) + printf "delayed-sys | " + end + if ($arg0 & 0x400000) + printf "proxy | " + set $proxy_process = 1 + else + set $proxy_process = 0 + end + if ($arg0 & 0x200000) + printf "running-sys | " + end + if ($arg0 & 0x100000) + printf "active-sys | " + end + if ($arg0 & 0x80000) + printf "trapping-exit | " + end + if ($arg0 & 0x40000) + printf "bound | " + end + if ($arg0 & 0x20000) + printf "garbage-collecting | " + end + if ($arg0 & 0x10000) + printf "suspended | " + end + if ($arg0 & 0x8000) + printf "running | " + end + if ($arg0 & 0x4000) + printf "in-run-queue | " + end + if ($arg0 & 0x2000) + printf "active | " + end + if ($arg0 & 0x1000) + printf "pending-exit | " + end + if ($arg0 & 0x800) + printf "exiting | " + end + if ($arg0 & 0x400) + printf "free | " + end + if ($arg0 & 0x200) + printf "in-prq-low | " + end + if ($arg0 & 0x100) + printf "in-prq-normal | " + end + if ($arg0 & 0x80) + printf "in-prq-high | " + end + if ($arg0 & 0x40) + printf "in-prq-max | " + end + if ($arg0 & 0x30) == 0x0 + printf "prq-prio-max | " + else + if ($arg0 & 0x30) == 0x10 + printf "prq-prio-high | " + else + if ($arg0 & 0x30) == 0x20 + printf "prq-prio-normal | " + else + printf "prq-prio-low | " + end + end + end + if ($arg0 & 0xc) == 0x0 + printf "usr-prio-max | " + else + if ($arg0 & 0xc) == 0x4 + printf "usr-prio-high | " + else + if ($arg0 & 0xc) == 0x8 + printf "usr-prio-normal | " + else + printf "usr-prio-low | " + end + end + end + if ($arg0 & 0x3) == 0x0 + printf "act-prio-max\n" + else + if ($arg0 & 0x3) == 0x1 + printf "act-prio-high\n" + else + if ($arg0 & 0x3) == 0x2 + printf "act-prio-normal\n" + else + printf "act-prio-low\n" + end + end + end +end + +document etp-proc-state-int +%--------------------------------------------------------------------------- +% etp-proc-state-int int +% +% Print state of process state value +%--------------------------------------------------------------------------- +end + + +define etp-proc-state +# Args: Process* +# + set $state_int = *(((Uint32 *) &(((Process *) $arg0)->state))) + etp-proc-state-int $state_int +end + +document etp-proc-state +%--------------------------------------------------------------------------- +% etp-proc-state Process* +% +% Print state of process +%--------------------------------------------------------------------------- +end + +define etp-proc-flags-int +# Args: int +# + if ($arg0 & ~0x1ffffff) + printf "GARBAGE<%x> ", ($arg0 & ~0x1ffffff) + end + if ($arg0 & 0x1000000) + printf "dirty-minor-gc " + end + if ($arg0 & 0x800000) + printf "dirty-major-gc " + end + if ($arg0 & 0x400000) + printf "dirty-gc-hibernate " + end + if ($arg0 & 0x200000) + printf "dirty-cla " + end + if ($arg0 & 0x100000) + printf "delayed-del-proc " + end + if ($arg0 & 0x80000) + printf "hipe-mode " + end + if ($arg0 & 0x40000) + printf "have-blocked-nmsb " + end + if ($arg0 & 0x20000) + printf "shdlr-onln-wait-q " + end + if ($arg0 & 0x10000) + printf "delay-gc " + end + if ($arg0 & 0x8000) + printf "abandoned-heap-use " + end + if ($arg0 & 0x4000) + printf "off-heap-msgq-chng " + end + if ($arg0 & 0x2000) + printf "on-heap-msgq " + end + if ($arg0 & 0x1000) + printf "off-heap-msgq " + end + if ($arg0 & 0x800) + printf "disable-gc " + end + if ($arg0 & 0x400) + printf "force-gc " + end + if ($arg0 & 0x200) + printf "p2pnr-resched " + end + if ($arg0 & 0x100) + printf "have-blocked-msb " + end + if ($arg0 & 0x80) + printf "using-ddll " + end + if ($arg0 & 0x40) + printf "distribution " + end + if ($arg0 & 0x20) + printf "using-db " + end + if ($arg0 & 0x10) + printf "need-fullsweep " + end + if ($arg0 & 0x8) + printf "heap-grow " + end + if ($arg0 & 0x4) + printf "timo " + end + if ($arg0 & 0x2) + printf "inslpqueue " + end + if ($arg0 & 0x1) + printf "hibernate-sched " + end + printf "\n" +end + +document etp-proc-flags-int +%--------------------------------------------------------------------------- +% etp-proc-flags-int int +% +% Print flags of process flags value +%--------------------------------------------------------------------------- +end + + +define etp-proc-flags +# Args: Process* +# + set $flags_int = ((Process *) $arg0)->flags + etp-proc-flags-int $flags_int +end + +document etp-proc-flags +%--------------------------------------------------------------------------- +% etp-proc-flags Process* +% +% Print flags of process +%--------------------------------------------------------------------------- +end define etp-process-info # Args: Process* @@ -1826,6 +2082,8 @@ define etp-process-info etp-1 $etp_proc->common.id printf "\n State: " etp-proc-state $etp_proc + printf "\n Flags: " + etp-proc-flags $etp_proc if $proxy_process != 0 printf " Pointer: (Process *) %p\n", $etp_proc printf " *** PROXY process struct *** refer to: \n" @@ -2356,8 +2614,20 @@ define etp-rq-flags-int if ($arg0 & 0x4000000) printf " protected" end - if ($arg0 & ~0x7ffffff) - printf " GARBAGE(0x%x)", ($arg0 & ~0x3ffffff) + if ($arg0 & 0x8000000) + printf " exec" + end + if ($arg0 & 0x10000000) + printf " msb_exec" + end + if ($arg0 & 0x20000000) + printf " misc_op" + end + if ($arg0 & 0x40000000) + printf " halting" + end + if ($arg0 & ~0x7fffffff) + printf " GARBAGE(0x%x)", ($arg0 & ~0x7fffffff) end printf "\n" end @@ -2389,6 +2659,9 @@ define etp-ssi-flags if ($arg0 & 0x10) printf " suspended" end + if ($arg0 & 0x20) + printf " msb_exec" + end printf "\n" end @@ -2556,7 +2829,7 @@ define etp-run-queue-info-internal set $rq_flags = *((Uint32 *) &($runq->flags)) etp-rq-flags-int $rq_flags printf " Pointer: (ErtsRunQueue *) %p\n", $runq - +end define etp-disasm-1 set $code_ptr = ((BeamInstr*)$arg0) diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex 64d1a70e61..4f4027c74e 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 4406a82a36..c05bc813f0 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 8247c399a4..0799546c60 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 0161151785..1b28a929ce 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 df3bc9526b..e5381d3574 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 aae3976298..57b3023ea6 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 71f3c2ec8c..2fab34318e 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 74a0184818..ffddf2d54d 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 b601c048b3..3c6a6d4f41 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 77909b01f0..133fda4b13 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 5bbbaf14d5..99ad863b8b 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 1a573ce297..e52e442f8e 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 6afeb454d6..122406c834 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 6a7ad9164f..c683d395f3 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 15c3e01653..86ebb4dd4b 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -886,7 +886,7 @@ function_exported(_Module, _Function, _Arity) -> %% garbage_collect/0 -spec garbage_collect() -> true. garbage_collect() -> - erlang:nif_error(undefined). + erts_internal:garbage_collect(major). %% garbage_collect/1 -spec garbage_collect(Pid) -> GCResult when @@ -2333,6 +2333,10 @@ spawn_opt(_Tuple) -> SchedulerId :: pos_integer(), ActiveTime :: non_neg_integer(), TotalTime :: non_neg_integer(); + (scheduler_wall_time_all) -> [{SchedulerId, ActiveTime, TotalTime}] | undefined when + SchedulerId :: pos_integer(), + ActiveTime :: non_neg_integer(), + TotalTime :: non_neg_integer(); (total_active_tasks) -> ActiveTasks when ActiveTasks :: non_neg_integer(); (total_run_queue_lengths) -> TotalRunQueueLenghts when @@ -2532,6 +2536,7 @@ tuple_to_list(_Tuple) -> Alloc :: atom(); ({allocator_sizes, Alloc}) -> [_] when %% More or less anything Alloc :: atom(); + (atom_count) -> pos_integer(); (atom_limit) -> pos_integer(); (build_type) -> opt | debug | purify | quantify | purecov | gcov | valgrind | gprof | lcnt | frmptr; @@ -4013,6 +4018,7 @@ sched_wall_time(Ref, N, undefined) -> sched_wall_time(Ref, N, Acc) -> receive {Ref, undefined} -> sched_wall_time(Ref, N-1, undefined); + {Ref, SWTL} when erlang:is_list(SWTL) -> sched_wall_time(Ref, N-1, Acc ++ SWTL); {Ref, SWT} -> sched_wall_time(Ref, N-1, [SWT|Acc]) end. diff --git a/erts/test/install_SUITE.erl b/erts/test/install_SUITE.erl index 2c7e8972f6..f96dca9563 100644 --- a/erts/test/install_SUITE.erl +++ b/erts/test/install_SUITE.erl @@ -18,7 +18,6 @@ %% %CopyrightEnd% %% - %%%------------------------------------------------------------------- %%% File : install_SUITE.erl %%% Author : Rickard Green @@ -63,12 +62,12 @@ erlang_bindir = "", bindir_symlinks = ""}). -need_symlink_cases() -> +need_symlink_cases() -> [bin_unreachable_absolute, bin_unreachable_relative, bin_same_dir, bin_ok_symlink, bin_dirname_fail, bin_no_use_dirname_fail]. -dont_need_symlink_cases() -> +dont_need_symlink_cases() -> [bin_default, bin_default_dirty, bin_outside_eprfx, bin_outside_eprfx_dirty, bin_not_abs, bin_unreasonable_path, 'bin white space', @@ -78,10 +77,9 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap, {minutes, 1}}]. -all() -> +all() -> dont_need_symlink_cases() ++ need_symlink_cases(). - %% %% The test cases %% @@ -533,21 +531,19 @@ bin_no_srcfile(Config) when is_list(Config) -> ChkRes). %% -%% %% Auxiliary functions %% -%% expect(X, X) -> - io:format("result: ~p~n", [X]), + io:format("result: ~tp~n", [X]), io:format("-----------------------------------------------~n", []), ok; expect(X, Y) -> - io:format("expected: ~p~n", [X]), - io:format("got : ~p~n", [Y]), + io:format("expected: ~tp~n", [X]), + io:format("got : ~tp~n", [Y]), io:format("-----------------------------------------------~n", []), ct:fail({X,Y}). - + init_per_suite(Config) -> PD = proplists:get_value(priv_dir, Config), SymLinks = case os:type() of @@ -630,8 +626,8 @@ install_bin(Config, #inst{mkdirs = MkDirs, true -> ok; false -> {comment, "No symlink tests run, since symlinks not working"} end. - - + + install_bin2(Config, Inst, ChkRes) -> install_bin3(Config, Inst#inst{symlinks = false, ln_s = "ln"}, ChkRes), @@ -662,8 +658,6 @@ install_bin2(Config, Inst, ChkRes) -> false -> ok end. - - install_bin3(Config, #inst{cmd_prefix = CMD_PRFX, @@ -690,20 +684,20 @@ install_bin3(Config, ++ "\" --exec-prefix \"" ++ EXEC_PREFIX ++ "\" --test-file \"" ++ ResFile ++ "\" erl erlc", - io:format("CMD_PRFX = \"~s\"~n" - "LN_S = \"~s\"~n" - "BINDIR_SYMLINKS = \"~s\"~n" - "exec_prefix = \"~s\"~n" - "bindir = \"~s\"~n" - "erlang_bindir = \"~s\"~n" - "EXTRA_PREFIX = \"~s\"~n" - "DESTDIR = \"~s\"~n", + io:format("CMD_PRFX = \"~ts\"~n" + "LN_S = \"~ts\"~n" + "BINDIR_SYMLINKS = \"~ts\"~n" + "exec_prefix = \"~ts\"~n" + "bindir = \"~ts\"~n" + "erlang_bindir = \"~ts\"~n" + "EXTRA_PREFIX = \"~ts\"~n" + "DESTDIR = \"~ts\"~n", [CMD_PRFX, LN_S, BINDIR_SYMLINKS, EXEC_PREFIX, BINDIR, ERLANG_BINDIR, EXTRA_PREFIX, DESTDIR]), - io:format("$ ~s~n", [Cmd]), + io:format("$ ~ts~n", [Cmd]), CmdOutput = os:cmd(Cmd), - io:format("~s~n", [CmdOutput]), + io:format("~ts~n", [CmdOutput]), ChkRes(case file:consult(ResFile) of {ok, [Res]} -> Res; Err -> exit({result, Err}) diff --git a/erts/vsn.mk b/erts/vsn.mk index af0be85062..028b114068 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% # -VSN = 8.2 +VSN = 8.2.1 # Port number 4365 in 4.2 # Port number 4366 in 4.3 diff --git a/lib/asn1/doc/src/Makefile b/lib/asn1/doc/src/Makefile index 559836116f..9a388e4e8a 100644 --- a/lib/asn1/doc/src/Makefile +++ b/lib/asn1/doc/src/Makefile @@ -37,8 +37,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml -XML_REF3_FILES = asn1ct.xml \ - asn1rt.xml +XML_REF3_FILES = asn1ct.xml GEN_XML = \ asn1_spec.xml diff --git a/lib/asn1/doc/src/asn1ct.xml b/lib/asn1/doc/src/asn1ct.xml index e5a7b1bcc4..ebe1ce44dc 100644 --- a/lib/asn1/doc/src/asn1ct.xml +++ b/lib/asn1/doc/src/asn1ct.xml @@ -321,45 +321,6 @@ File3.asn</pre> </func> <func> - <name>encode(Module, Type, Value)-> {ok, Bytes} | {error, Reason}</name> - <fsummary>Encodes an ASN.1 value.</fsummary> - <type> - <v>Module = Type = atom()</v> - <v>Value = term()</v> - <v>Bytes = binary()</v> - <v>Reason = term()</v> - </type> - <desc> - <p>Encodes <c>Value</c> of <c>Type</c> defined in the <c>ASN.1</c> module - <c>Module</c>. To get as fast execution as possible, the - encode function performs only the rudimentary tests that input - <c>Value</c> is a correct instance of <c>Type</c>. So, for example, - the length of strings is - not always checked. Returns <c>{ok, Bytes}</c> if successful or - <c>{error, Reason}</c> if an error occurred. - </p> - <p>This function is deprecated. - Use <c>Module:encode(Type, Value)</c> instead.</p> - </desc> - </func> - - <func> - <name>decode(Module, Type, Bytes) -> {ok, Value} | {error, Reason}</name> - <fsummary>Decode from Bytes into an ASN.1 value.</fsummary> - <type> - <v>Module = Type = atom()</v> - <v>Value = Reason = term()</v> - <v>Bytes = binary()</v> - </type> - <desc> - <p>Decodes <c>Type</c> from <c>Module</c> from the binary - <c>Bytes</c>. Returns <c>{ok, Value}</c> if successful.</p> - <p>This function is deprecated. - Use <c>Module:decode(Type, Bytes)</c> instead.</p> - </desc> - </func> - - <func> <name>value(Module, Type) -> {ok, Value} | {error, Reason}</name> <fsummary>Creates an ASN.1 value for test purposes.</fsummary> <type> @@ -424,11 +385,11 @@ File3.asn</pre> <p>Schematically, the following occurs for each type in the module:</p> <code type="none"> {ok, Value} = asn1ct:value(Module, Type), -{ok, Bytes} = asn1ct:encode(Module, Type, Value), -{ok, Value} = asn1ct:decode(Module, Type, Bytes).</code> +{ok, Bytes} = Module:encode(Type, Value), +{ok, Value} = Module:decode(Type, Bytes).</code> <p>The <c>test</c> functions use the <c>*.asn1db</c> files for all included modules. If they are located in a different - directory than the current working directory, use the include + directory than the current working directory, use the <c>include</c> option to add paths. This is only needed when automatically generating values. For static values using <c>Value</c> no options are needed.</p> diff --git a/lib/asn1/doc/src/asn1rt.xml b/lib/asn1/doc/src/asn1rt.xml deleted file mode 100644 index 3f53ca0f56..0000000000 --- a/lib/asn1/doc/src/asn1rt.xml +++ /dev/null @@ -1,135 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE erlref SYSTEM "erlref.dtd"> - -<erlref> - <header> - <copyright> - <year>1997</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>asn1rt</title> - <prepared>Kenneth Lundin</prepared> - <responsible>Kenneth Lundin</responsible> - <docno>1</docno> - <approved>Kenneth Lundin</approved> - <checked></checked> - <date>97-10-04</date> - <rev>A</rev> - <file>asn1.sgml</file> - </header> - <module>asn1rt</module> - <modulesummary>ASN.1 runtime support functions</modulesummary> - <description> - <warning> - <p> - All functions in this module are deprecated and will be - removed in a future release. - </p> - </warning> - </description> - - <funcs> - - <func> - <name>decode(Module,Type,Bytes) -> {ok,Value}|{error,Reason}</name> - <fsummary>Decodes from Bytes into an ASN.1 value.</fsummary> - <type> - <v>Module = Type = atom()</v> - <v>Value = Reason = term()</v> - <v>Bytes = binary</v> - </type> - <desc> - <p>Decodes <c>Type</c> from <c>Module</c> from the binary <c>Bytes</c>. - Returns <c>{ok,Value}</c> if successful.</p> - <p>Use <c>Module:decode(Type, Bytes)</c> instead of this function.</p> - </desc> - </func> - - <func> - <name>encode(Module,Type,Value)-> {ok,Bytes} | {error,Reason}</name> - <fsummary>Encodes an ASN.1 value.</fsummary> - <type> - <v>Module = Type = atom()</v> - <v>Value = term()</v> - <v>Bytes = binary</v> - <v>Reason = term()</v> - </type> - <desc> - <p>Encodes <c>Value</c> of <c>Type</c> defined in the <c>ASN.1</c> - module <c>Module</c>. Returns a binary if successful. To get - as fast execution as possible, the encode function performs - only the rudimentary test that input <c>Value</c> is a correct - instance of <c>Type</c>. For example, the length of strings is - not always checked.</p> - <p>Use <c>Module:encode(Type, Value)</c> instead of this function.</p> - </desc> - </func> - - <func> - <name>info(Module) -> {ok,Info} | {error,Reason}</name> - <fsummary>Returns compiler information about the Module.</fsummary> - <type> - <v>Module = atom()</v> - <v>Info = list()</v> - <v>Reason = term()</v> - </type> - <desc> - <p>Returns the version of the <c>ASN.1</c> compiler that was - used to compile the module. It also returns the compiler options - that were used.</p> - <p>Use <c>Module:info()</c> instead of this function.</p> - </desc> - </func> - - <func> - <name>utf8_binary_to_list(UTF8Binary) -> {ok,UnicodeList} | {error,Reason}</name> - <fsummary>Transforms an UTF8 encoded binary to a unicode list.</fsummary> - <type> - <v>UTF8Binary = binary()</v> - <v>UnicodeList = [integer()]</v> - <v>Reason = term()</v> - </type> - <desc> - <p>Transforms a UTF8 encoded binary - to a list of integers, where each integer represents one - character as its unicode value. The function fails if the binary - is not a properly encoded UTF8 string.</p> - <p>Use <seealso marker="stdlib:unicode#characters_to_list-1">unicode:characters_to_list/1</seealso> instead of this function.</p> - </desc> - </func> - - <func> - <name>utf8_list_to_binary(UnicodeList) -> {ok,UTF8Binary} | {error,Reason}</name> - <fsummary>Transforms an unicode list to a UTF8 binary.</fsummary> - <type> - <v>UnicodeList = [integer()]</v> - <v>UTF8Binary = binary()</v> - <v>Reason = term()</v> - </type> - <desc> - <p>Transforms a list of integers, - where each integer represents one character as its unicode - value, to a UTF8 encoded binary.</p> - <p>Use <seealso marker="stdlib:unicode#characters_to_binary-1">unicode:characters_to_binary/1</seealso> instead of this function.</p> - </desc> - </func> - - </funcs> - -</erlref> - diff --git a/lib/asn1/src/Makefile b/lib/asn1/src/Makefile index 38cf2d496a..ba459f6cd3 100644 --- a/lib/asn1/src/Makefile +++ b/lib/asn1/src/Makefile @@ -68,7 +68,6 @@ CT_MODULES= \ $(EVAL_CT_MODULES) RT_MODULES= \ - asn1rt \ asn1rt_nif MODULES= $(CT_MODULES) $(RT_MODULES) diff --git a/lib/asn1/src/asn1.app.src b/lib/asn1/src/asn1.app.src index 1f8805ff5e..d2da727193 100644 --- a/lib/asn1/src/asn1.app.src +++ b/lib/asn1/src/asn1.app.src @@ -2,7 +2,6 @@ [{description, "The Erlang ASN1 compiler version %VSN%"}, {vsn, "%VSN%"}, {modules, [ - asn1rt, asn1rt_nif ]}, {registered, [ diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index 8783b5418d..4e030861f5 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -20,17 +20,12 @@ %% %% -module(asn1ct). --deprecated([decode/3,encode/3]). --compile([{nowarn_deprecated_function,{asn1rt,decode,3}}, - {nowarn_deprecated_function,{asn1rt,encode,2}}, - {nowarn_deprecated_function,{asn1rt,encode,3}}]). %% Compile Time functions for ASN.1 (e.g ASN.1 compiler). %%-compile(export_all). %% Public exports -export([compile/1, compile/2]). --export([encode/2, encode/3, decode/3]). -export([test/1, test/2, test/3, value/2, value/3]). %% Application internal exports -export([compile_asn/3,compile_asn1/3,compile_py/3,compile/3, @@ -1271,21 +1266,6 @@ pretty2(Module,AbsFile) -> start(Includes) when is_list(Includes) -> asn1_db:dbstart(Includes). - -encode(Module,Term) -> - asn1rt:encode(Module,Term). - -encode(Module,Type,Term) when is_list(Module) -> - asn1rt:encode(list_to_atom(Module),Type,Term); -encode(Module,Type,Term) -> - asn1rt:encode(Module,Type,Term). - -decode(Module,Type,Bytes) when is_list(Module) -> - asn1rt:decode(list_to_atom(Module),Type,Bytes); -decode(Module,Type,Bytes) -> - asn1rt:decode(Module,Type,Bytes). - - test(Module) -> test_module(Module, []). test(Module, [] = Options) -> test_module(Module, Options); @@ -1330,10 +1310,10 @@ test_type(Module, Type) -> test_value(Module, Type, Value) -> in_process(fun() -> - case catch encode(Module, Type, Value) of + case catch Module:encode(Type, Value) of {ok, Bytes} -> NewBytes = prepare_bytes(Bytes), - case decode(Module, Type, NewBytes) of + case Module:decode(Type, NewBytes) of {ok, Value} -> {ok, {Module, Type, Value}}; {ok, Res} -> diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl index 57cd3f8af6..b3d41dd9f3 100644 --- a/lib/asn1/src/asn1ct_value.erl +++ b/lib/asn1/src/asn1ct_value.erl @@ -19,7 +19,6 @@ %% %% -module(asn1ct_value). --compile([{nowarn_deprecated_function,{asn1rt,utf8_list_to_binary,1}}]). %% Generate Erlang values for ASN.1 types. %% The value is randomized within it's constraints @@ -292,8 +291,10 @@ from_type_prim(M, D) -> 'BMPString' -> adjust_list(size_random(C),c_string(C,"BMPString")); 'UTF8String' -> - {ok,Res}=asn1rt:utf8_list_to_binary(adjust_list(random(50),[$U,$T,$F,$8,$S,$t,$r,$i,$n,$g,16#ffff,16#fffffff,16#ffffff,16#fffff,16#fff])), - Res; + L = adjust_list(random(50), + [$U,$T,$F,$8,$S,$t,$r,$i,$n,$g, + 16#ffff,16#ffee,16#10ffff,16#ffff,16#fff]), + unicode:characters_to_binary(L); 'UniversalString' -> adjust_list(size_random(C),c_string(C,"UniversalString")); XX -> diff --git a/lib/asn1/src/asn1rt.erl b/lib/asn1/src/asn1rt.erl deleted file mode 100644 index 3e09ce2252..0000000000 --- a/lib/asn1/src/asn1rt.erl +++ /dev/null @@ -1,184 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% --module(asn1rt). --deprecated(module). - -%% Runtime functions for ASN.1 (i.e encode, decode) - --export([encode/2,encode/3,decode/3,load_driver/0,unload_driver/0,info/1]). - --export([utf8_binary_to_list/1,utf8_list_to_binary/1]). - -encode(Module,{Type,Term}) -> - encode(Module,Type,Term). - -encode(Module,Type,Term) -> - case catch apply(Module,encode,[Type,Term]) of - {'EXIT',undef} -> - {error,{asn1,{undef,Module,Type}}}; - Result -> - Result - end. - -decode(Module,Type,Bytes) -> - case catch apply(Module,decode,[Type,Bytes]) of - {'EXIT',undef} -> - {error,{asn1,{undef,Module,Type}}}; - Result -> - Result - end. - -%% Remove in R16A -load_driver() -> - ok. - -unload_driver() -> - ok. - -info(Module) -> - case catch apply(Module,info,[]) of - {'EXIT',{undef,_Reason}} -> - {error,{asn1,{undef,Module,info}}}; - Result -> - {ok,Result} - end. - -%% utf8_binary_to_list/1 transforms a utf8 encoded binary to a list of -%% unicode elements, where each element is the unicode integer value -%% of a utf8 character. -%% Bin is a utf8 encoded value. The return value is either {ok,Val} or -%% {error,Reason}. Val is a list of integers, where each integer is a -%% unicode character value. -utf8_binary_to_list(Bin) when is_binary(Bin) -> - utf8_binary_to_list(Bin,[]). - -utf8_binary_to_list(<<>>,Acc) -> - {ok,lists:reverse(Acc)}; -utf8_binary_to_list(Bin,Acc) -> - Len = utf8_binary_len(Bin), - case catch split_binary(Bin,Len) of - {CharBin,RestBin} -> - case utf8_binary_char(CharBin) of - C when is_integer(C) -> - utf8_binary_to_list(RestBin,[C|Acc]); - Err -> Err - end; - Err -> {error,{asn1,{bad_encoded_utf8string,Err}}} - end. - -utf8_binary_len(<<0:1,_:7,_/binary>>) -> - 1; -utf8_binary_len(<<1:1,1:1,0:1,_:5,_/binary>>) -> - 2; -utf8_binary_len(<<1:1,1:1,1:1,0:1,_:4,_/binary>>) -> - 3; -utf8_binary_len(<<1:1,1:1,1:1,1:1,0:1,_:3,_/binary>>) -> - 4; -utf8_binary_len(<<1:1,1:1,1:1,1:1,1:1,0:1,_:2,_/binary>>) -> - 5; -utf8_binary_len(<<1:1,1:1,1:1,1:1,1:1,1:1,0:1,_:1,_/binary>>) -> - 6; -utf8_binary_len(Bin) -> - {error,{asn1,{bad_utf8_length,Bin}}}. - -utf8_binary_char(<<0:1,Int:7>>) -> - Int; -utf8_binary_char(<<_:2,0:1,Int1:5,1:1,0:1,Int2:6>>) -> - (Int1 bsl 6) bor Int2; -utf8_binary_char(<<_:3,0:1,Int1:4,1:1,0:1,Int2:6,1:1,0:1,Int3:6>>) -> - <<Res:16>> = <<Int1:4,Int2:6,Int3:6>>, - Res; -utf8_binary_char(<<_:4,0:1,Int1:3,Rest/binary>>) -> - <<1:1,0:1,Int2:6,1:1,0:1,Int3:6,1:1,0:1,Int4:6>> = Rest, - <<Res:24>> = <<0:3,Int1:3,Int2:6,Int3:6,Int4:6>>, - Res; -utf8_binary_char(<<_:5,0:1,Int1:2,Rest/binary>>) -> - <<1:1,0:1,Int2:6,1:1,0:1,Int3:6,1:1,0:1,Int4:6,1:1,0:1,Int5:6>> = Rest, - <<Res:32>> = <<0:6,Int1:2,Int2:6,Int3:6,Int4:6,Int5:6>>, - Res; -utf8_binary_char(<<_:6,0:1,I:1,Rest/binary>>) -> - <<1:1,0:1,Int2:6,1:1,0:1,Int3:6,1:1,0:1,Int4:6,1:1,0:1, - Int5:6,1:1,0:1,Int6:6>> = Rest, - <<Res:32>> = <<0:1,I:1,Int2:6,Int3:6,Int4:6,Int5:6,Int6:6>>, - Res; -utf8_binary_char(Err) -> - {error,{asn1,{bad_utf8_character_encoding,Err}}}. - - -%% macros used for utf8 encoding --define(bit1to6_into_utf8byte(I),16#80 bor (I band 16#3f)). --define(bit7to12_into_utf8byte(I),16#80 bor ((I band 16#fc0) bsr 6)). --define(bit13to18_into_utf8byte(I),16#80 bor ((I band 16#3f000) bsr 12)). --define(bit19to24_into_utf8byte(I),16#80 bor ((Int band 16#fc0000) bsr 18)). --define(bit25to30_into_utf8byte(I),16#80 bor ((Int band 16#3f000000) bsr 24)). - -%% utf8_list_to_binary/1 transforms a list of integers to a -%% binary. Each element in the input list has the unicode (integer) -%% value of an utf8 character. -%% The return value is either {ok,Bin} or {error,Reason}. The -%% resulting binary is utf8 encoded. -utf8_list_to_binary(List) -> - utf8_list_to_binary(List,[]). - -utf8_list_to_binary([],Acc) when is_list(Acc) -> - {ok,list_to_binary(lists:reverse(Acc))}; -utf8_list_to_binary([],Acc) -> - {error,{asn1,Acc}}; -utf8_list_to_binary([H|T],Acc) -> - case catch utf8_encode(H,Acc) of - NewAcc when is_list(NewAcc) -> - utf8_list_to_binary(T,NewAcc); - Err -> Err - end. - - -utf8_encode(Int,Acc) when Int < 128 -> - %% range 16#00000000 - 16#0000007f - %% utf8 encoding: 0xxxxxxx - [Int|Acc]; -utf8_encode(Int,Acc) when Int < 16#800 -> - %% range 16#00000080 - 16#000007ff - %% utf8 encoding: 110xxxxx 10xxxxxx - [?bit1to6_into_utf8byte(Int),16#c0 bor (Int bsr 6)|Acc]; -utf8_encode(Int,Acc) when Int < 16#10000 -> - %% range 16#00000800 - 16#0000ffff - %% utf8 encoding: 1110xxxx 10xxxxxx 10xxxxxx - [?bit1to6_into_utf8byte(Int),?bit7to12_into_utf8byte(Int), - 16#e0 bor ((Int band 16#f000) bsr 12)|Acc]; -utf8_encode(Int,Acc) when Int < 16#200000 -> - %% range 16#00010000 - 16#001fffff - %% utf8 encoding: 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx - [?bit1to6_into_utf8byte(Int),?bit7to12_into_utf8byte(Int), - ?bit13to18_into_utf8byte(Int), - 16#f0 bor ((Int band 16#1c0000) bsr 18)|Acc]; -utf8_encode(Int,Acc) when Int < 16#4000000 -> - %% range 16#00200000 - 16#03ffffff - %% utf8 encoding: 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx - [?bit1to6_into_utf8byte(Int),?bit7to12_into_utf8byte(Int), - ?bit13to18_into_utf8byte(Int),?bit19to24_into_utf8byte(Int), - 16#f8 bor ((Int band 16#3000000) bsr 24)|Acc]; -utf8_encode(Int,Acc) -> - %% range 16#04000000 - 16#7fffffff - %% utf8 encoding: 1111110x 10xxxxxx ...(total 6 bytes) 10xxxxxx - [?bit1to6_into_utf8byte(Int),?bit7to12_into_utf8byte(Int), - ?bit13to18_into_utf8byte(Int),?bit19to24_into_utf8byte(Int), - ?bit25to30_into_utf8byte(Int), - 16#fc bor ((Int band 16#40000000) bsr 30)|Acc]. diff --git a/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl b/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl index 6cf8ecf451..cd6c74b995 100644 --- a/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl +++ b/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl @@ -120,10 +120,10 @@ run3(Erule) -> asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}, asn1_NOVALUE,asn1_NOVALUE}}}}}}}, io:format("~p:~p~n",[Erule,Val]), - {ok,List}= asn1rt:encode('EUTRA-RRC-Definitions','DL-DCCH-Message',Val), + {ok,List}= 'EUTRA-RRC-Definitions':encode('DL-DCCH-Message',Val), Enc = iolist_to_binary(List), io:format("Result from encode:~n~p~n",[Enc]), - {ok,Val2} = asn1rt:decode('EUTRA-RRC-Definitions','DL-DCCH-Message',Enc), + {ok,Val2} = 'EUTRA-RRC-Definitions':decode('DL-DCCH-Message', Enc), io:format("Result from decode:~n~p~n",[Val2]), case Val2 of Val -> ok; diff --git a/lib/asn1/test/asn1_SUITE_data/testobj.erl b/lib/asn1/test/asn1_SUITE_data/testobj.erl index a0e00f8314..e547ea4572 100644 --- a/lib/asn1/test/asn1_SUITE_data/testobj.erl +++ b/lib/asn1/test/asn1_SUITE_data/testobj.erl @@ -1410,16 +1410,14 @@ int2bin(Int) -> %%%%%%%%%%%%%%%%% wrappers %%%%%%%%%%%%%%%%%%%%%%%% wrapper_encode(Module,Type,Value) -> - case asn1rt:encode(Module,Type,Value) of - {ok,X} when binary(X) -> + case Module:encode(Type, Value) of + {ok,X} when is_binary(X) -> {ok, binary_to_list(X)}; - {ok,X} -> - {ok, binary_to_list(list_to_binary(X))}; Error -> Error end. wrapper_decode(Module, Type, Bytes) when is_binary(Bytes) -> - asn1rt:decode(Module, Type, Bytes); + Module:decode(Type, Bytes); wrapper_decode(Module, Type, Bytes) when is_list(Bytes) -> - asn1rt:decode(Module, Type, list_to_binary(Bytes)). + Module:decode(Type, list_to_binary(Bytes)). diff --git a/lib/asn1/test/testPrimStrings.erl b/lib/asn1/test/testPrimStrings.erl index cb97655c15..b7f0323301 100644 --- a/lib/asn1/test/testPrimStrings.erl +++ b/lib/asn1/test/testPrimStrings.erl @@ -19,8 +19,6 @@ %% %% -module(testPrimStrings). --compile([{nowarn_deprecated_function,{asn1rt,utf8_list_to_binary,1}}, - {nowarn_deprecated_function,{asn1rt,utf8_binary_to_list,1}}]). -export([bit_string/2]). -export([octet_string/1]). @@ -756,19 +754,21 @@ utf8_string(_Rules) -> 16#800, 16#ffff, 16#10000, - 16#1fffff, - 16#200000, - 16#3ffffff, - 16#4000000, - 16#7fffffff], + 16#1ffff, + 16#20000, + 16#2ffff, + 16#e0000, + 16#effff, + 16#F0000, + 16#10ffff], [begin - {ok,UTF8} = asn1rt:utf8_list_to_binary([Char]), - {ok,[Char]} = asn1rt:utf8_binary_to_list(UTF8), + UTF8 = unicode:characters_to_binary([Char]), + [Char] = unicode:characters_to_list([UTF8]), roundtrip('UTF', UTF8) end || Char <- AllRanges], - {ok,UTF8} = asn1rt:utf8_list_to_binary(AllRanges), - {ok,AllRanges} = asn1rt:utf8_binary_to_list(UTF8), + UTF8 = unicode:characters_to_binary(AllRanges), + AllRanges = unicode:characters_to_list(UTF8), roundtrip('UTF', UTF8), ok. diff --git a/lib/common_test/src/common_test.app.src b/lib/common_test/src/common_test.app.src index 77588af59b..dfa321c901 100644 --- a/lib/common_test/src/common_test.app.src +++ b/lib/common_test/src/common_test.app.src @@ -22,6 +22,7 @@ {vsn, "%VSN%"}, {modules, [ct_cover, ct, + ct_default_gl, ct_event, ct_framework, ct_ftp, diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile index b1eddfedd7..2f0fc2e05a 100644 --- a/lib/common_test/test/Makefile +++ b/lib/common_test/test/Makefile @@ -70,7 +70,8 @@ MODULES= \ test_server_SUITE \ test_server_test_lib \ ct_release_test_SUITE \ - ct_log_SUITE + ct_log_SUITE \ + ct_SUITE ERL_FILES= $(MODULES:%=%.erl) HRL_FILES= test_server_test_lib.hrl diff --git a/lib/common_test/test/ct_SUITE.erl b/lib/common_test/test/ct_SUITE.erl new file mode 100644 index 0000000000..eb98c2544f --- /dev/null +++ b/lib/common_test/test/ct_SUITE.erl @@ -0,0 +1,53 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(ct_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{timetrap,{seconds,30}}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(_TestCase, Config) -> + Config. + +end_per_testcase(_TestCase, _Config) -> + ok. + +all() -> + [app_file, appup_file]. + +%%%----------------------------------------------------------------- +%%% Test cases + +app_file(_Config) -> + ok = test_server:app_test(common_test), + ok. + +appup_file(_Config) -> + ok = test_server:appup_test(common_test). + diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl index 690d0af1bb..bc716fb5e3 100644 --- a/lib/common_test/test/ct_hooks_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE.erl @@ -70,20 +70,20 @@ suite() -> all() -> all(suite). -all(suite) -> +all(suite) -> lists:reverse( [ one_cth, two_cth, faulty_cth_no_init, faulty_cth_id_no_init, faulty_cth_exit_in_init, faulty_cth_exit_in_id, - faulty_cth_exit_in_init_scope_suite, minimal_cth, - minimal_and_maximal_cth, faulty_cth_undef, + faulty_cth_exit_in_init_scope_suite, minimal_cth, + minimal_and_maximal_cth, faulty_cth_undef, scope_per_suite_cth, scope_per_group_cth, scope_suite_cth, - scope_per_suite_state_cth, scope_per_group_state_cth, + scope_per_suite_state_cth, scope_per_group_state_cth, scope_suite_state_cth, fail_pre_suite_cth, double_fail_pre_suite_cth, fail_post_suite_cth, skip_pre_suite_cth, skip_pre_end_cth, skip_post_suite_cth, recover_post_suite_cth, update_config_cth, - state_update_cth, options_cth, same_id_cth, + state_update_cth, options_cth, same_id_cth, fail_n_skip_with_minimal_cth, prio_cth, no_config, data_dir, cth_log ] @@ -96,10 +96,10 @@ all(suite) -> %%%----------------------------------------------------------------- %%% -one_cth(Config) when is_list(Config) -> +one_cth(Config) when is_list(Config) -> do_test(one_empty_cth, "ct_cth_empty_SUITE.erl",[empty_cth], Config). -two_cth(Config) when is_list(Config) -> +two_cth(Config) when is_list(Config) -> do_test(two_empty_cth, "ct_cth_empty_SUITE.erl",[empty_cth,empty_cth], Config). @@ -119,13 +119,13 @@ minimal_cth(Config) when is_list(Config) -> minimal_and_maximal_cth(Config) when is_list(Config) -> do_test(minimal_and_maximal_cth, "ct_cth_empty_SUITE.erl", [minimal_cth, empty_cth],Config). - + faulty_cth_undef(Config) when is_list(Config) -> do_test(faulty_cth_undef, "ct_cth_empty_SUITE.erl", [undef_cth],Config). faulty_cth_exit_in_init_scope_suite(Config) when is_list(Config) -> - do_test(faulty_cth_exit_in_init_scope_suite, + do_test(faulty_cth_exit_in_init_scope_suite, "ct_exit_in_init_scope_suite_cth_SUITE.erl", [],Config). @@ -205,7 +205,7 @@ state_update_cth(Config) when is_list(Config) -> options_cth(Config) when is_list(Config) -> do_test(options_cth, "ct_cth_empty_SUITE.erl", [{empty_cth,[test]}],Config). - + same_id_cth(Config) when is_list(Config) -> do_test(same_id_cth, "ct_cth_empty_SUITE.erl", [same_id_cth,same_id_cth],Config). @@ -227,9 +227,10 @@ data_dir(Config) when is_list(Config) -> do_test(data_dir, "ct_data_dir_SUITE.erl", [verify_data_dir_cth],Config). -cth_log(Config) when is_list(Config) -> +cth_log(Config) when is_list(Config) -> %% test that cth_log_redirect writes properly to %% unexpected I/O log + ct:timetrap({minutes,10}), StartOpts = do_test(cth_log, "cth_log_SUITE.erl", [], Config), Logdir = proplists:get_value(logdir, StartOpts), UnexpIoLogs = @@ -266,7 +267,6 @@ do_test(Tag, SWC, CTHs, Config, Res) -> do_test(Tag, SWC, CTHs, Config, Res, 2). do_test(Tag, SuiteWildCard, CTHs, Config, Res, EC) -> - DataDir = ?config(data_dir, Config), Suites = filelib:wildcard( filename:join([DataDir,"cth/tests",SuiteWildCard])), @@ -275,7 +275,7 @@ do_test(Tag, SuiteWildCard, CTHs, Config, Res, EC) -> Res = ct_test_support:run(Opts, Config), Events = ct_test_support:get_events(ERPid, Config), - ct_test_support:log_events(Tag, + ct_test_support:log_events(Tag, reformat(Events, ?eh), ?config(priv_dir, Config), Opts), @@ -328,7 +328,7 @@ test_events(one_empty_cth) -> {?eh,cth,{empty_cth,pre_end_per_testcase,[test_case,'$proplist',[]]}}, {?eh,cth,{empty_cth,post_end_per_testcase,[test_case,'$proplist','_',[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,cth,{empty_cth,pre_end_per_suite, [ct_cth_empty_SUITE,'$proplist',[]]}}, @@ -360,7 +360,7 @@ test_events(two_empty_cth) -> {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, @@ -402,7 +402,7 @@ test_events(minimal_cth) -> {?eh,tc_start,{ct_cth_empty_SUITE,test_case}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,tc_done,{ct_cth_empty_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, @@ -426,7 +426,7 @@ test_events(minimal_and_maximal_cth) -> {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_suite,[ct_cth_empty_SUITE,'$proplist','_',[]]}}, @@ -452,11 +452,11 @@ test_events(faulty_cth_undef) -> {?eh,tc_auto_skip,{ct_cth_empty_SUITE,test_case, {failed, FailReason}}}, {?eh,cth,{'_',on_tc_skip,'_'}}, - + {?eh,tc_auto_skip,{ct_cth_empty_SUITE,end_per_suite, {failed, FailReason}}}, {?eh,cth,{'_',on_tc_skip,'_'}}, - + {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]; @@ -515,7 +515,7 @@ test_events(scope_per_suite_cth) -> {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_scope_per_suite_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_per_suite_cth_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite, [ct_scope_per_suite_cth_SUITE,'$proplist',[]]}}, @@ -541,7 +541,7 @@ test_events(scope_suite_cth) -> {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_scope_suite_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_suite_cth_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite,[ct_scope_suite_cth_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_suite,[ct_scope_suite_cth_SUITE,'$proplist','_',[]]}}, @@ -563,18 +563,18 @@ test_events(scope_per_group_cth) -> {?eh,cth,{'_',init,['_',[]]}}, {?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]},ok}}, - + {?eh,tc_start,{ct_scope_per_group_cth_SUITE,test_case}}, {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]}}}, {?eh,cth,{'_',pre_end_per_group,[group1,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[]]}}, {?eh,cth,{'_',terminate,[[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]},ok}}], - + {?eh,tc_start,{ct_scope_per_group_cth_SUITE,end_per_suite}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, @@ -595,7 +595,7 @@ test_events(scope_per_suite_state_cth) -> {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[test]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[test]]}}, {?eh,tc_done,{ct_scope_per_suite_state_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_per_suite_state_cth_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite, [ct_scope_per_suite_state_cth_SUITE,'$proplist',[test]]}}, @@ -621,7 +621,7 @@ test_events(scope_suite_state_cth) -> {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[test]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[test]]}}, {?eh,tc_done,{ct_scope_suite_state_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_suite_state_cth_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite,[ct_scope_suite_state_cth_SUITE,'$proplist',[test]]}}, {?eh,cth,{'_',post_end_per_suite,[ct_scope_suite_state_cth_SUITE,'$proplist','_',[test]]}}, @@ -643,18 +643,18 @@ test_events(scope_per_group_state_cth) -> {?eh,cth,{'_',init,['_',[test]]}}, {?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[test]]}}, {?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,{init_per_group,group1,[]},ok}}, - + {?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,test_case}}, {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[test]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[test]]}}, {?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,{end_per_group,group1,[]}}}, {?eh,cth,{'_',pre_end_per_group,[group1,'$proplist',[test]]}}, {?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[test]]}}, {?eh,cth,{'_',terminate,[[test]]}}, {?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,{end_per_group,group1,[]},ok}}], - + {?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,end_per_suite}}, {?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, @@ -666,7 +666,7 @@ test_events(fail_pre_suite_cth) -> {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{'_',init,['_',[]]}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist', @@ -676,7 +676,7 @@ test_events(fail_pre_suite_cth) -> {?eh,cth,{'_',on_tc_fail, [init_per_suite,{failed,"Test failure"},[]]}}, - + {?eh,tc_auto_skip,{ct_cth_empty_SUITE,test_case, {failed,{ct_cth_empty_SUITE,init_per_suite, {failed,"Test failure"}}}}}, @@ -685,7 +685,7 @@ test_events(fail_pre_suite_cth) -> {failed, {ct_cth_empty_SUITE, init_per_suite, {failed, "Test failure"}}}},[]]}}, - + {?eh,tc_auto_skip, {ct_cth_empty_SUITE, end_per_suite, {failed, {ct_cth_empty_SUITE, init_per_suite, {failed, "Test failure"}}}}}, @@ -694,7 +694,7 @@ test_events(fail_pre_suite_cth) -> {failed, {ct_cth_empty_SUITE, init_per_suite, {failed, "Test failure"}}}},[]]}}, - + {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,cth, {'_',terminate,[[]]}}, {?eh,stop_logging,[]} @@ -733,7 +733,7 @@ test_events(fail_post_suite_cth) -> {failed,{ct_cth_empty_SUITE,init_per_suite, {failed,"Test failure"}}}}}, {?eh,cth,{'_',on_tc_skip,[test_case,{tc_auto_skip,'_'},[]]}}, - + {?eh,tc_auto_skip, {ct_cth_empty_SUITE, end_per_suite, {failed, {ct_cth_empty_SUITE, init_per_suite, {failed, "Test failure"}}}}}, @@ -758,7 +758,7 @@ test_events(skip_pre_suite_cth) -> {?eh,tc_user_skip,{ct_cth_empty_SUITE,test_case,"Test skip"}}, {?eh,cth,{'_',on_tc_skip,[test_case,{tc_user_skip,"Test skip"},[]]}}, - + {?eh,tc_user_skip, {ct_cth_empty_SUITE, end_per_suite,"Test skip"}}, {?eh,test_done,{'DEF','STOP_TIME'}}, @@ -772,18 +772,18 @@ test_events(skip_pre_end_cth) -> {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,tc_start,{ct_scope_per_group_cth_SUITE,init_per_suite}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,init_per_suite,ok}}, - + [{?eh,tc_start,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]}}}, {?eh,cth,{'_',id,[[]]}}, {?eh,cth,{'_',init,['_',[]]}}, {?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]},ok}}, - + {?eh,tc_start,{ct_scope_per_group_cth_SUITE,test_case}}, {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]}}}, {?eh,cth,{'_',pre_end_per_group,[group1,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[]]}}, @@ -808,7 +808,7 @@ test_events(skip_post_suite_cth) -> {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{'_',init,['_',[]]}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist','$proplist',[]]}}, @@ -818,9 +818,9 @@ test_events(skip_post_suite_cth) -> {?eh,tc_user_skip,{ct_cth_empty_SUITE,test_case,"Test skip"}}, {?eh,cth,{'_',on_tc_skip,[test_case,{tc_user_skip,"Test skip"},[]]}}, - + {?eh,tc_user_skip, {ct_cth_empty_SUITE, end_per_suite,"Test skip"}}, - + {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,cth,{'_',terminate,[[]]}}, {?eh,stop_logging,[]} @@ -844,7 +844,7 @@ test_events(recover_post_suite_cth) -> {?eh,cth,{'_',post_end_per_testcase, [test_case, contains([tc_status]),'_',[]]}}, {?eh,tc_done,{Suite,test_case,ok}}, - + {?eh,tc_start,{Suite,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite, [Suite,not_contains([tc_status]),[]]}}, @@ -861,7 +861,7 @@ test_events(update_config_cth) -> {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{'_',init,['_',[]]}}, - + {?eh,tc_start,{ct_update_config_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite, [ct_update_config_SUITE,contains([]),[]]}}, @@ -941,7 +941,7 @@ test_events(update_config_cth) -> pre_init_per_suite]), ok,[]]}}, {?eh,tc_done,{ct_update_config_SUITE,{end_per_group,group1,[]},ok}}, - + {?eh,tc_start,{ct_update_config_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite, [ct_update_config_SUITE,contains( @@ -974,7 +974,7 @@ test_events(state_update_cth) -> {?eh,cth,{'_',init,['_',[]]}}, {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{'_',init_per_suite}}, - + {?eh,tc_done,{'_',end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,cth,{'_',terminate,[contains( @@ -1021,7 +1021,7 @@ test_events(options_cth) -> {?eh,cth,{empty_cth,pre_init_per_testcase,[test_case,'$proplist',[test]]}}, {?eh,cth,{empty_cth,post_end_per_testcase,[test_case,'$proplist','_',[test]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,cth,{empty_cth,pre_end_per_suite, [ct_cth_empty_SUITE,'$proplist',[test]]}}, @@ -1058,7 +1058,7 @@ test_events(same_id_cth) -> {negative, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {negative, @@ -1115,17 +1115,14 @@ test_events(fail_n_skip_with_minimal_cth) -> ]; test_events(prio_cth) -> - GenPre = fun(Func,States) -> - [{?eh,cth,{'_',Func,['_','_',State]}} || - State <- States] + [{?eh,cth,{'_',Func,['_','_',State]}} || State <- States] end, GenPost = fun(Func,States) -> - [{?eh,cth,{'_',Func,['_','_','_',State]}} || - State <- States] + [{?eh,cth,{'_',Func,['_','_','_',State]}} || State <- States] end, - + [{?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] ++ @@ -1136,7 +1133,7 @@ test_events(prio_cth) -> [[1100,100],[600,200],[600,600],[700],[800],[900],[1000], [1200,1050],[1100],[1200]]) ++ [{?eh,tc_done,{ct_cth_prio_SUITE,init_per_suite,ok}}, - + [{?eh,tc_start,{ct_cth_prio_SUITE,{init_per_group,'_',[]}}}] ++ GenPre(pre_init_per_group, @@ -1147,7 +1144,7 @@ test_events(prio_cth) -> [900],[900,900],[500,900],[1000],[1200,1050], [1100],[1200]]) ++ [{?eh,tc_done,{ct_cth_prio_SUITE,{init_per_group,'_',[]},ok}}] ++ - + [{?eh,tc_start,{ct_cth_prio_SUITE,test_case}}] ++ GenPre(pre_init_per_testcase, [[1100,100],[600,200],[600,600],[600],[700],[800], @@ -1161,7 +1158,7 @@ test_events(prio_cth) -> [{?eh,tc_done,{ct_cth_prio_SUITE,test_case,ok}}, {?eh,tc_start,{ct_cth_prio_SUITE,{end_per_group,'_',[]}}}] ++ - GenPre(pre_end_per_group, + GenPre(pre_end_per_group, lists:reverse( [[1100,100],[600,200],[600,600],[600],[700],[800], [900],[900,900],[500,900],[1000],[1200,1050], @@ -1300,7 +1297,7 @@ test_events(cth_log) -> [{suite,cth_log_SUITE},parallel]}}}, {?eh,tc_done,{ct_framework,{end_per_group,g1, [{suite,cth_log_SUITE},parallel]},ok}}]}, - + {?eh,tc_done,{cth_log_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} @@ -1309,7 +1306,6 @@ test_events(cth_log) -> test_events(ok) -> ok. - %% test events help functions contains(List) -> fun(Proplist) when is_list(Proplist) -> diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index c37f731d8c..cf60355a40 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -126,7 +126,7 @@ ERL_COMPILE_FLAGS += +native endif ERL_COMPILE_FLAGS += +inline +warn_unused_import \ -Werror \ - -I../../stdlib/include -I$(EGEN) -W + -I../../stdlib/include -I$(EGEN) -W +warn_missing_spec # ---------------------------------------------------- # Targets diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index 91e6d80da3..cdb32d5d55 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -25,6 +25,9 @@ -export([module/2]). +-spec module(beam_asm:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> Fs = [function(F) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index 9c8ed2277f..a2f5dc674c 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -24,9 +24,42 @@ -export([module/4]). -export([encode/2]). +-export_type([fail/0,label/0,reg/0,src/0,module_code/0,function_name/0]). + -import(lists, [map/2,member/2,keymember/3,duplicate/2,splitwith/2]). -include("beam_opcodes.hrl"). +%% Common types for describing operands for BEAM instructions. +-type reg_num() :: 0..1023. +-type reg() :: {'x',reg_num()} | {'y',reg_num()}. +-type src() :: reg() | + {'literal',term()} | + {'atom',atom()} | + {'integer',integer()} | + 'nil' | + {'float',float()}. +-type label() :: pos_integer(). +-type fail() :: {'f',label() | 0}. + +%% asm_instruction() describes only the instructions that +%% are used in BEAM files (as opposed to internal instructions +%% used only during optimization). + +-type asm_instruction() :: atom() | tuple(). + +-type function_name() :: atom(). + +-type exports() :: [{function_name(),arity()}]. + +-type asm_function() :: + {'function',function_name(),arity(),label(),[asm_instruction()]}. + +-type module_code() :: + {module(),[_],[_],[asm_function()],pos_integer()}. + +-spec module(module_code(), exports(), [_], [compile:option()]) -> + {'ok',binary()}. + module(Code, Abst, SourceFile, Opts) -> {ok,assemble(Code, Abst, SourceFile, Opts)}. @@ -439,6 +472,8 @@ encode_alloc_list_1([{floats,Floats}|T], Dict, Acc0) -> encode_alloc_list_1([], Dict, Acc) -> {iolist_to_binary(Acc),Dict}. +-spec encode(non_neg_integer(), pos_integer()) -> iodata(). + encode(Tag, N) when N < 0 -> encode1(Tag, negative_to_bytes(N)); encode(Tag, N) when N < 16 -> diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 6a35191f6e..6543e05e20 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -25,6 +25,9 @@ -export([module/2]). -import(lists, [reverse/1,reverse/2,foldl/3,member/2]). +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> Fs = [function(F) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. diff --git a/lib/compiler/src/beam_bs.erl b/lib/compiler/src/beam_bs.erl index 2aed98d4e7..beb055b23d 100644 --- a/lib/compiler/src/beam_bs.erl +++ b/lib/compiler/src/beam_bs.erl @@ -25,6 +25,9 @@ -export([module/2]). -import(lists, [mapfoldl/3,reverse/1]). +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs0,Lc0}, _Opt) -> {Fs,Lc} = mapfoldl(fun function/2, Lc0, Fs0), {ok,{Mod,Exp,Attr,Fs,Lc}}. diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index ae1b34ba49..9a4e7fb133 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -60,19 +60,26 @@ %%% data structures or passed to BIFs. %%% +-type label() :: beam_asm:label(). +-type func_info() :: {beam_asm:reg(),boolean()}. + -record(btb, - {f, %Gbtrees for all functions. - index, %{Label,Code} index (for liveness). - ok_br, %Labels that are OK. - must_not_save, %Must not save position when - % optimizing (reaches - % bs_context_to_binary). - must_save %Must save position when optimizing. + {f :: gb_trees:tree(label(), func_info()), + index :: beam_utils:code_index(), %{Label,Code} index (for liveness). + ok_br=gb_sets:empty() :: gb_sets:set(label()), %Labels that are OK. + must_not_save=false :: boolean(), %Must not save position when + % optimizing (reaches + % bs_context_to_binary). + must_save=false :: boolean() %Must save position when optimizing. }). + +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs0,Lc}, Opts) -> - D = #btb{f=btb_index(Fs0)}, - Fs = [function(F, D) || F <- Fs0], + FIndex = btb_index(Fs0), + Fs = [function(F, FIndex) || F <- Fs0], Code = {Mod,Exp,Attr,Fs,Lc}, case proplists:get_bool(bin_opt_info, Opts) of true -> @@ -92,10 +99,10 @@ format_error({no_bin_opt,Reason}) -> %%% Local functions. %%% -function({function,Name,Arity,Entry,Is}, D0) -> +function({function,Name,Arity,Entry,Is}, FIndex) -> try Index = beam_utils:index_labels(Is), - D = D0#btb{index=Index}, + D = #btb{f=FIndex,index=Index}, {function,Name,Arity,Entry,btb_opt_1(Is, D, [])} catch Class:Error -> @@ -179,15 +186,14 @@ btb_gen_save(false, _, Acc) -> Acc. %% a bs_context_to_binary instruction. %% -btb_reaches_match(Is, RegList, D0) -> +btb_reaches_match(Is, RegList, D) -> try Regs = btb_regs_from_list(RegList), - D = D0#btb{ok_br=gb_sets:empty(),must_not_save=false,must_save=false}, #btb{must_not_save=MustNotSave,must_save=MustSave} = - btb_reaches_match_1(Is, Regs, D), - case MustNotSave and MustSave of + btb_reaches_match_1(Is, Regs, D), + case MustNotSave andalso MustSave of true -> btb_error(must_and_must_not_save); - _ -> {ok,MustSave} + false -> {ok,MustSave} end catch throw:{error,_}=Error -> Error diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index 10805a3c36..b736d39f9c 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -26,6 +26,9 @@ -export([clean_labels/1]). -import(lists, [map/2,foldl/3,reverse/1,filter/2]). +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs0,_}, Opts) -> Order = [Lbl || {function,_,_,Lbl,_} <- Fs0], All = foldl(fun({function,_,_,Lbl,_}=Func,D) -> dict:store(Lbl, Func, D) end, @@ -39,6 +42,10 @@ module({Mod,Exp,Attr,Fs0,_}, Opts) -> {ok,{Mod,Exp,Attr,Fs,Lc}}. %% Remove all bs_save2/2 instructions not referenced by a bs_restore2/2. + +-spec bs_clean_saves([beam_utils:instruction()]) -> + [beam_utils:instruction()]. + bs_clean_saves(Is) -> Needed = bs_restores(Is, []), bs_clean_saves_1(Is, gb_sets:from_list(Needed), []). @@ -98,13 +105,18 @@ add_to_work_list(F, {Fs,Used}=Sets) -> %%% want to see the expanded code in a .S file. %%% --record(st, {lmap, %Translation tables for labels. - entry, %Number of entry label. - lc %Label counter +-type label() :: beam_asm:label(). + +-record(st, {lmap :: [{label(),label()}], %Translation tables for labels. + entry :: beam_asm:label(), %Number of entry label. + lc :: non_neg_integer() %Label counter }). +-spec clean_labels([beam_utils:instruction()]) -> + {[beam_utils:instruction()],pos_integer()}. + clean_labels(Fs0) -> - St0 = #st{lmap=[],lc=1}, + St0 = #st{lmap=[],entry=1,lc=1}, {Fs1,#st{lmap=Lmap0,lc=Lc}} = function_renumber(Fs0, St0, []), Lmap = gb_trees:from_orddict(ordsets:from_list(Lmap0)), Fs = function_replace(Fs1, Lmap, []), diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index 9087586b58..d379fdc4eb 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -29,6 +29,10 @@ -import(lists, [mapfoldl/3,reverse/1]). + +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs0,_}, _Opts) -> {Fs1,Lc1} = beam_clean:clean_labels(Fs0), {Fs,Lc} = mapfoldl(fun function/2, Lc1, Fs1), diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index 9565ab74c4..719d799fd7 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -28,7 +28,7 @@ string_table/1,lambda_table/1,literal_table/1, line_table/1]). --type label() :: non_neg_integer(). +-type label() :: beam_asm:label(). -type index() :: non_neg_integer(). @@ -38,13 +38,16 @@ -type line_tab() :: #{{Fname :: index(), Line :: term()} => index()}. -type literal_tab() :: dict:dict(Literal :: term(), index()). +-type lambda_info() :: {label(),{index(),label(),non_neg_integer()}}. +-type lambda_tab() :: {non_neg_integer(),[lambda_info()]}. + -record(asm, {atoms = #{} :: atom_tab(), exports = [] :: [{label(), arity(), label()}], locals = [] :: [{label(), arity(), label()}], imports = gb_trees:empty() :: import_tab(), strings = <<>> :: binary(), %String pool - lambdas = {0,[]}, %[{...}] + lambdas = {0,[]} :: lambda_tab(), literals = dict:new() :: literal_tab(), fnames = #{} :: fname_tab(), lines = #{} :: line_tab(), @@ -148,10 +151,7 @@ string(Str, Dict) when is_list(Str) -> lambda(Lbl, NumFree, #asm{lambdas={OldIndex,Lambdas0}}=Dict) -> %% Set Index the same as OldIndex. Index = OldIndex, - %% Initialize OldUniq to 0. It will be set to an unique value - %% based on the MD5 checksum of the BEAM code for the module. - OldUniq = 0, - Lambdas = [{Lbl,{OldIndex,Lbl,Index,NumFree,OldUniq}}|Lambdas0], + Lambdas = [{Lbl,{Index,Lbl,NumFree}}|Lambdas0], {OldIndex,Dict#asm{lambdas={OldIndex+1,Lambdas}}}. %% Returns the index for a literal (adding it to the literal table if necessary). @@ -185,6 +185,9 @@ line([{location,Name,Line}], #asm{lines=Lines,num_lines=N}=Dict0) -> {Index, Dict1#asm{lines=Lines#{Key=>Index},num_lines=N+1}} end. +-spec fname(nonempty_string(), bdict()) -> + {non_neg_integer(), bdict()}. + fname(Name, #asm{fnames=Fnames}=Dict) -> case Fnames of #{Name := Index} -> {Index,Dict}; @@ -239,8 +242,11 @@ lambda_table(#asm{locals=Loc0,lambdas={NumLambdas,Lambdas0}}) -> Lambdas1 = sofs:relation(Lambdas0), Loc = sofs:relation([{Lbl,{F,A}} || {F,A,Lbl} <- Loc0]), Lambdas2 = sofs:relative_product1(Lambdas1, Loc), + %% Initialize OldUniq to 0. It will be set to an unique value + %% based on the MD5 checksum of the BEAM code for the module. + OldUniq = 0, Lambdas = [<<F:32,A:32,Lbl:32,Index:32,NumFree:32,OldUniq:32>> || - {{_,Lbl,Index,NumFree,OldUniq},{F,A}} <- sofs:to_external(Lambdas2)], + {{Index,Lbl,NumFree},{F,A}} <- sofs:to_external(Lambdas2)], {NumLambdas,Lambdas}. %% Returns the literal table. diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl index 4a181c1923..9801c68ee2 100644 --- a/lib/compiler/src/beam_except.erl +++ b/lib/compiler/src/beam_except.erl @@ -33,6 +33,9 @@ -import(lists, [reverse/1]). +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> Fs = [function(F) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. @@ -49,9 +52,9 @@ function({function,Name,Arity,CLabel,Is0}) -> end. -record(st, - {lbl, %func_info label - loc, %location for func_info - arity %arity for function + {lbl :: beam_asm:label(), %func_info label + loc :: [_], %location for func_info + arity :: arity() %arity for function }). function_1(Is0) -> diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl index c9ff07b496..a4d45a4ca6 100644 --- a/lib/compiler/src/beam_flatten.erl +++ b/lib/compiler/src/beam_flatten.erl @@ -25,6 +25,9 @@ -import(lists, [reverse/1,reverse/2]). +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs,Lc}, _Opt) -> {ok,{Mod,Exp,Attr,[function(F) || F <- Fs],Lc}}. diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index e096270d8c..4365451356 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -130,6 +130,11 @@ -import(lists, [reverse/1,reverse/2,foldl/3]). +-type instruction() :: beam_utils:instruction(). + +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> Fs = [function(F) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. @@ -269,9 +274,9 @@ extract_seq_1(_, _) -> no. -record(st, { - entry, %Entry label (must not be moved). - mlbl, %Moved labels. - labels :: cerl_sets:set() %Set of referenced labels. + entry :: beam_asm:label(), %Entry label (must not be moved). + mlbl :: #{beam_asm:label() := [beam_asm:label()]}, %Moved labels. + labels :: cerl_sets:set() %Set of referenced labels. }). opt(Is0, CLabel) -> @@ -453,6 +458,8 @@ is_label_used(L, St) -> %% is_unreachable_after(Instruction) -> boolean() %% Test whether the code after Instruction is unreachable. +-spec is_unreachable_after(instruction()) -> boolean(). + is_unreachable_after({func_info,_M,_F,_A}) -> true; is_unreachable_after(return) -> true; is_unreachable_after({jump,_Lbl}) -> true; @@ -465,6 +472,8 @@ is_unreachable_after(I) -> is_exit_instruction(I). %% Test whether the instruction Instruction always %% causes an exit/failure. +-spec is_exit_instruction(instruction()) -> boolean(). + is_exit_instruction({call_ext,_,{extfunc,M,F,A}}) -> erl_bifs:is_exit_bif(M, F, A); is_exit_instruction(if_end) -> true; @@ -477,6 +486,8 @@ is_exit_instruction(_) -> false. %% Remove all unused labels. Also remove unreachable %% instructions following labels that are removed. +-spec remove_unused_labels([instruction()]) -> [instruction()]. + remove_unused_labels(Is) -> Used0 = initial_labels(Is), Used = foldl(fun ulbl/2, Used0, Is), diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl index d82ed8639d..94b47cf568 100644 --- a/lib/compiler/src/beam_listing.erl +++ b/lib/compiler/src/beam_listing.erl @@ -21,14 +21,24 @@ -export([module/2]). +-include("core_parse.hrl"). +-include("v3_kernel.hrl"). -include("v3_life.hrl"). -import(lists, [foreach/2]). -module(File, Core) when element(1, Core) == c_module -> +-type code() :: cerl:c_module() + | beam_utils:module_code() + | #k_mdef{} + | {module(),_,_,_} %v3_life + | [_]. %form-based format + +-spec module(file:io_device(), code()) -> 'ok'. + +module(File, #c_module{}=Core) -> %% This is a core module. io:put_chars(File, core_pp:format(Core)); -module(File, Kern) when element(1, Kern) == k_mdef -> +module(File, #k_mdef{}=Kern) -> %% This is a kernel module. io:put_chars(File, v3_kernel_pp:format(Kern)); %%io:put_chars(File, io_lib:format("~p~n", [Kern])); diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl index c8bef31824..6df5c02334 100644 --- a/lib/compiler/src/beam_peep.erl +++ b/lib/compiler/src/beam_peep.erl @@ -24,6 +24,9 @@ -import(lists, [reverse/1,member/2]). +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs0,_}, _Opts) -> %% First coalesce adjacent labels. {Fs1,Lc} = beam_clean:clean_labels(Fs0), diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl index 89cafe27ce..1403e1e05e 100644 --- a/lib/compiler/src/beam_receive.erl +++ b/lib/compiler/src/beam_receive.erl @@ -65,6 +65,9 @@ %%% as the SomeUniqInteger. %%% +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> Fs = [function(F) || F <- Fs0], Code = {Mod,Exp,Attr,Fs,Lc}, diff --git a/lib/compiler/src/beam_reorder.erl b/lib/compiler/src/beam_reorder.erl index 6a7c033ec6..910b7f6b0a 100644 --- a/lib/compiler/src/beam_reorder.erl +++ b/lib/compiler/src/beam_reorder.erl @@ -23,6 +23,9 @@ -export([module/2]). -import(lists, [member/2,reverse/1]). +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> Fs = [function(F) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl index feeab0af50..d041f18806 100644 --- a/lib/compiler/src/beam_split.erl +++ b/lib/compiler/src/beam_split.erl @@ -23,6 +23,9 @@ -import(lists, [reverse/1]). +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> Fs = [split_blocks(F) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl index d40669083e..4da0985085 100644 --- a/lib/compiler/src/beam_trim.erl +++ b/lib/compiler/src/beam_trim.erl @@ -24,10 +24,13 @@ -import(lists, [reverse/1,reverse/2,splitwith/2,sort/1]). -record(st, - {safe, %Safe labels. - lbl %Code at each label. + {safe :: gb_sets:set(beam_asm:label()), %Safe labels. + lbl :: beam_utils:code_index() %Code at each label. }). +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> Fs = [function(F) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 9866dcd070..050c599d6b 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -26,6 +26,9 @@ -import(lists, [filter/2,foldl/3,keyfind/3,member/2, reverse/1,reverse/2,sort/1]). +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> Fs = [function(F) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index ffeff9ea81..cc6e54ca16 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -28,11 +28,31 @@ live_opt/1,delete_live_annos/1,combine_heap_needs/2, split_even/1]). +-export_type([code_index/0,module_code/0,instruction/0]). + -import(lists, [member/2,sort/1,reverse/1,splitwith/2]). +%% instruction() describes all instructions that are used during optimzation +%% (from beam_a to beam_z). +-type instruction() :: atom() | tuple(). + +-type code_index() :: gb_trees:tree(beam_asm:label(), [instruction()]). + +-type int_function() :: {'function',beam_asm:function_name(),arity(), + beam_asm:label(),[instruction()]}. + +-type module_code() :: + {module(),[_],[_],[int_function()],pos_integer()}. + +%% Internal types. +-type fail() :: beam_asm:fail() | 'fail'. +-type test() :: {'test',atom(),fail(),[beam_asm:src()]} | + {'test',atom(),fail(),integer(),list(),beam_asm:reg()}. +-type result_cache() :: gb_trees:tree(beam_asm:label(), 'killed' | 'used'). + -record(live, - {lbl, %Label to code index. - res}). %Result cache for each label. + {lbl :: code_index(), %Label to code index. + res :: result_cache()}). %Result cache for each label. %% is_killed_block(Register, [Instruction]) -> true|false @@ -44,6 +64,8 @@ %% i.e. it is OK to enter the instruction sequence with Register %% containing garbage. +-spec is_killed_block(beam_asm:reg(), [instruction()]) -> boolean(). + is_killed_block({x,X}, [{set,_,_,{alloc,Live,_}}|_]) -> X >= Live; is_killed_block(R, [{set,Ds,Ss,_Op}|Is]) -> @@ -65,6 +87,8 @@ is_killed_block(_, []) -> false. %% The state (constructed by index_instructions/1) is used to allow us %% to determine the kill state across branches. +-spec is_killed(beam_asm:reg(), [instruction()], code_index()) -> boolean(). + is_killed(R, Is, D) -> St = #live{lbl=D,res=gb_trees:empty()}, case check_liveness(R, Is, St) of @@ -75,6 +99,8 @@ is_killed(R, Is, D) -> %% is_killed_at(Reg, Lbl, State) -> true|false %% Determine whether Reg is killed at label Lbl. +-spec is_killed_at(beam_asm:reg(), beam_asm:label(), code_index()) -> boolean(). + is_killed_at(R, Lbl, D) when is_integer(Lbl) -> St0 = #live{lbl=D,res=gb_trees:empty()}, case check_liveness_at(R, Lbl, St0) of @@ -89,6 +115,8 @@ is_killed_at(R, Lbl, D) when is_integer(Lbl) -> %% The state is used to allow us to determine the usage state %% across branches. +-spec is_not_used(beam_asm:reg(), [instruction()], code_index()) -> boolean(). + is_not_used(R, Is, D) -> St = #live{lbl=D,res=gb_trees:empty()}, case check_liveness(R, Is, St) of @@ -100,18 +128,25 @@ is_not_used(R, Is, D) -> %% Index the instruction sequence so that we can quickly %% look up the instruction following a specific label. +-spec index_labels([instruction()]) -> code_index(). + index_labels(Is) -> index_labels_1(Is, []). %% empty_label_index() -> State %% Create an empty label index. +-spec empty_label_index() -> code_index(). + empty_label_index() -> gb_trees:empty(). %% index_label(Label, [Instruction], State) -> State %% Add an index for a label. +-spec index_label(beam_asm:label(), [instruction()], code_index()) -> + code_index(). + index_label(Lbl, Is0, Acc) -> Is = drop_labels(Is0), gb_trees:enter(Lbl, Is, Acc). @@ -120,12 +155,16 @@ index_label(Lbl, Is0, Acc) -> %% code_at(Label, State) -> [I]. %% Retrieve the code at the given label. +-spec code_at(beam_asm:label(), code_index()) -> [instruction()]. + code_at(L, Ll) -> gb_trees:get(L, Ll). %% bif_to_test(Bif, [Op], Fail) -> {test,Test,Fail,[Op]} %% Convert a BIF to a test. Fail if not possible. +-spec bif_to_test(atom(), list(), fail()) -> test(). + bif_to_test(is_atom, [_]=Ops, Fail) -> {test,is_atom,Fail,Ops}; bif_to_test(is_boolean, [_]=Ops, Fail) -> {test,is_boolean,Fail,Ops}; bif_to_test(is_binary, [_]=Ops, Fail) -> {test,is_binary,Fail,Ops}; @@ -158,6 +197,9 @@ bif_to_test(is_record, [_,_,_]=Ops, Fail) -> {test,is_record,Fail,Ops}. %% Return 'true' if the test instruction does not modify any %% registers and/or bit syntax matching state. %% + +-spec is_pure_test(test()) -> boolean(). + is_pure_test({test,is_eq,_,[_,_]}) -> true; is_pure_test({test,is_ne,_,[_,_]}) -> true; is_pure_test({test,is_eq_exact,_,[_,_]}) -> true; @@ -180,7 +222,9 @@ is_pure_test({test,Op,_,Ops}) -> %% whose destination is a register that will not be used. %% Also insert {'%live',Live,Regs} annotations at the beginning %% and end of each block. -%% + +-spec live_opt([instruction()]) -> [instruction()]. + live_opt(Is0) -> {[{label,Fail}|_]=Bef,[Fi|Is]} = splitwith(fun({func_info,_,_,_}) -> false; @@ -193,7 +237,9 @@ live_opt(Is0) -> %% delete_live_annos([Instruction]) -> [Instruction]. %% Delete all live annotations. -%% + +-spec delete_live_annos([instruction()]) -> [instruction()]. + delete_live_annos([{block,Bl0}|Is]) -> case delete_live_annos(Bl0) of [] -> delete_live_annos(Is); @@ -208,6 +254,8 @@ delete_live_annos([]) -> []. %% combine_heap_needs(HeapNeed1, HeapNeed2) -> HeapNeed %% Combine the heap need for two allocation instructions. +-spec combine_heap_needs(term(), term()) -> term(). + combine_heap_needs({alloc,Alloc1}, {alloc,Alloc2}) -> {alloc,combine_alloc_lists(Alloc1, Alloc2)}; combine_heap_needs({alloc,Alloc}, Words) when is_integer(Words) -> @@ -220,6 +268,8 @@ combine_heap_needs(H1, H2) when is_integer(H1), is_integer(H2) -> %% split_even/1 %% [1,2,3,4,5,6] -> {[1,3,5],[2,4,6]} +-spec split_even(list()) -> {list(),list()}. + split_even(Rs) -> split_even(Rs, [], []). diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 5659077c5d..bf33ae0aeb 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -32,6 +32,10 @@ -import(lists, [reverse/1,foldl/3,foreach/2,dropwhile/2]). %% To be called by the compiler. + +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts) when is_atom(Mod), is_list(Exp), is_list(Attr), is_integer(Lc) -> case validate(Mod, Fs) of diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl index 6c7f8543c2..787e33c142 100644 --- a/lib/compiler/src/beam_z.erl +++ b/lib/compiler/src/beam_z.erl @@ -26,6 +26,9 @@ -import(lists, [dropwhile/2]). +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_asm:module_code()}. + module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> Fs = [function(F) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index b1be6ffc6d..6b936a7687 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -1584,6 +1584,8 @@ ann_make_list(_, [], Node) -> %% @doc Returns <code>true</code> if <code>Node</code> is an abstract %% map constructor, otherwise <code>false</code>. +-type map_op() :: #c_literal{val::'assoc'} | #c_literal{val::'exact'}. + -spec is_c_map(cerl()) -> boolean(). is_c_map(#c_map{}) -> @@ -1679,8 +1681,16 @@ update_c_map(#c_map{is_pat=true}=Old, M, Es) -> update_c_map(#c_map{is_pat=false}=Old, M, Es) -> ann_c_map(get_ann(Old), M, Es). +-spec map_pair_key(c_map_pair()) -> cerl(). + map_pair_key(#c_map_pair{key=K}) -> K. + +-spec map_pair_val(c_map_pair()) -> cerl(). + map_pair_val(#c_map_pair{val=V}) -> V. + +-spec map_pair_op(c_map_pair()) -> map_op(). + map_pair_op(#c_map_pair{op=Op}) -> Op. -spec c_map_pair(cerl(), cerl()) -> c_map_pair(). @@ -1699,6 +1709,8 @@ c_map_pair_exact(Key,Val) -> ann_c_map_pair(As,Op,K,V) -> #c_map_pair{op=Op, key = K, val=V, anno = As}. +-spec update_c_map_pair(c_map_pair(), map_op(), cerl(), cerl()) -> c_map_pair(). + update_c_map_pair(Old,Op,K,V) -> #c_map_pair{op=Op, key=K, val=V, anno = get_ann(Old)}. diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 8608d2daac..069add7890 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -147,8 +147,8 @@ env_compiler_options() -> env_default_opts(). %% Local functions %% --define(pass(P), {P,fun P/1}). --define(pass(P,T), {P,fun T/1,fun P/1}). +-define(pass(P), {P,fun P/2}). +-define(pass(P,T), {P,fun T/1,fun P/2}). env_default_opts() -> Key = "ERL_COMPILER_OPTIONS", @@ -173,17 +173,25 @@ env_default_opts() -> do_compile(Input, Opts0) -> Opts = expand_opts(Opts0), - {Pid,Ref} = - spawn_monitor(fun() -> - exit(try - internal(Input, Opts) - catch - error:Reason -> - {error,Reason} - end) - end), - receive - {'DOWN',Ref,process,Pid,Rep} -> Rep + IntFun = fun() -> try + internal(Input, Opts) + catch + error:Reason -> + {error,Reason} + end + end, + %% Dialyzer has already spawned workers. + case lists:member(dialyzer, Opts) of + true -> + IntFun(); + false -> + {Pid,Ref} = + spawn_monitor(fun() -> + exit(IntFun()) + end), + receive + {'DOWN',Ref,process,Pid,Rep} -> Rep + end end. expand_opts(Opts0) -> @@ -220,6 +228,8 @@ expand_opt(O, Os) -> [O|Os]. %% format_error(ErrorDescriptor) -> string() +-spec format_error(term()) -> iolist(). + format_error(no_native_support) -> "this system is not configured for native-code compilation."; format_error(no_crypto) -> @@ -280,34 +290,35 @@ format_error_reason({Reason, Stack}) when is_list(Stack) -> format_error_reason(Reason) -> io_lib:format("~tp", [Reason]). +-type err_warn_info() :: tuple(). + %% The compile state record. -record(compile, {filename="" :: file:filename(), dir="" :: file:filename(), base="" :: file:filename(), ifile="" :: file:filename(), ofile="" :: file:filename(), - module=[], - code=[], - core_code=[], - abstract_code=[], %Abstract code for debugger. - options=[] :: [option()], %Options for compilation + module=[] :: module() | [], + core_code=[] :: cerl:c_module() | [], + abstract_code=[] :: binary() | [], %Abstract code for debugger. + options=[] :: [option()], %Options for compilation mod_options=[] :: [option()], %Options for module_info encoding=none :: none | epp:source_encoding(), - errors=[], - warnings=[]}). + errors=[] :: [err_warn_info()], + warnings=[] :: [err_warn_info()]}). internal({forms,Forms}, Opts0) -> {_,Ps} = passes(forms, Opts0), Source = proplists:get_value(source, Opts0, ""), Opts1 = proplists:delete(source, Opts0), - Compile = #compile{code=Forms,options=Opts1,mod_options=Opts1}, - internal_comp(Ps, Source, "", Compile); + Compile = #compile{options=Opts1,mod_options=Opts1}, + internal_comp(Ps, Forms, Source, "", Compile); internal({file,File}, Opts) -> {Ext,Ps} = passes(file, Opts), Compile = #compile{options=Opts,mod_options=Opts}, - internal_comp(Ps, File, Ext, Compile). + internal_comp(Ps, none, File, Ext, Compile). -internal_comp(Passes, File, Suffix, St0) -> +internal_comp(Passes, Code0, File, Suffix, St0) -> Dir = filename:dirname(File), Base = filename:basename(File, Suffix), St1 = St0#compile{filename=File, dir=Dir, base=Base, @@ -317,36 +328,41 @@ internal_comp(Passes, File, Suffix, St0) -> Run0 = case member(time, Opts) of true -> io:format("Compiling ~tp\n", [File]), - fun run_tc/2; - false -> fun({_Name,Fun}, St) -> catch Fun(St) end + fun run_tc/3; + false -> + fun({_Name,Fun}, Code, St) -> + catch Fun(Code, St) + end end, Run = case keyfind(eprof, 1, Opts) of {eprof,EprofPass} -> - fun(P, St) -> - run_eprof(P, EprofPass, St) + fun(P, Code, St) -> + run_eprof(P, Code, EprofPass, St) end; false -> Run0 end, - case fold_comp(Passes, Run, St1) of - {ok,St2} -> comp_ret_ok(St2); + case fold_comp(Passes, Run, Code0, St1) of + {ok,Code,St2} -> comp_ret_ok(Code, St2); {error,St2} -> comp_ret_err(St2) end. -fold_comp([{delay,Ps0}|Passes], Run, #compile{options=Opts}=St) -> +fold_comp([{delay,Ps0}|Passes], Run, Code, #compile{options=Opts}=St) -> Ps = select_passes(Ps0, Opts) ++ Passes, - fold_comp(Ps, Run, St); -fold_comp([{Name,Test,Pass}|Ps], Run, St) -> + fold_comp(Ps, Run, Code, St); +fold_comp([{Name,Test,Pass}|Ps], Run, Code, St) -> case Test(St) of false -> %Pass is not needed. - fold_comp(Ps, Run, St); + fold_comp(Ps, Run, Code, St); true -> %Run pass in the usual way. - fold_comp([{Name,Pass}|Ps], Run, St) + fold_comp([{Name,Pass}|Ps], Run, Code, St) end; -fold_comp([{Name,Pass}|Ps], Run, St0) -> - case Run({Name,Pass}, St0) of - {ok,St1} -> fold_comp(Ps, Run, St1); - {error,_St1} = Error -> Error; +fold_comp([{Name,Pass}|Ps], Run, Code0, St0) -> + case Run({Name,Pass}, Code0, St0) of + {ok,Code,St1} -> + fold_comp(Ps, Run, Code, St1); + {error,_St1}=Error -> + Error; {'EXIT',Reason} -> Es = [{St0#compile.ifile,[{none,?MODULE,{crash,Name,Reason}}]}], {error,St0#compile{errors=St0#compile.errors ++ Es}}; @@ -354,11 +370,11 @@ fold_comp([{Name,Pass}|Ps], Run, St0) -> Es = [{St0#compile.ifile,[{none,?MODULE,{bad_return,Name,Other}}]}], {error,St0#compile{errors=St0#compile.errors ++ Es}} end; -fold_comp([], _Run, St) -> {ok,St}. +fold_comp([], _Run, Code, St) -> {ok,Code,St}. -run_tc({Name,Fun}, St) -> +run_tc({Name,Fun}, Code, St) -> T1 = erlang:monotonic_time(), - Val = (catch Fun(St)), + Val = (catch Fun(Code, St)), T2 = erlang:monotonic_time(), Elapsed = erlang:convert_time_unit(T2 - T1, native, millisecond), Mem0 = erts_debug:flat_size(Val)*erlang:system_info(wordsize), @@ -367,17 +383,17 @@ run_tc({Name,Fun}, St) -> [Name,Elapsed/1000,Mem]), Val. -run_eprof({Name,Fun}, Name, St) -> +run_eprof({Name,Fun}, Code, Name, St) -> io:format("~p: Running eprof\n", [Name]), c:appcall(tools, eprof, start_profiling, [[self()]]), - Val = (catch Fun(St)), + Val = (catch Fun(Code, St)), c:appcall(tools, eprof, stop_profiling, []), c:appcall(tools, eprof, analyze, []), Val; -run_eprof({_,Fun}, _, St) -> - catch Fun(St). +run_eprof({_,Fun}, Code, _, St) -> + catch Fun(Code, St). -comp_ret_ok(#compile{code=Code,warnings=Warn0,module=Mod,options=Opts}=St) -> +comp_ret_ok(Code, #compile{warnings=Warn0,module=Mod,options=Opts}=St) -> case werror(St) of true -> case member(report_warnings, Opts) of @@ -532,21 +548,21 @@ pass(_) -> none. %% select_passes([{pass,Mod}|Ps], Opts) -> - F = fun(St) -> - case catch Mod:module(St#compile.code, St#compile.options) of + F = fun(Code0, St) -> + case catch Mod:module(Code0, St#compile.options) of {ok,Code} -> - {ok,St#compile{code=Code}}; + {ok,Code,St}; {ok,Code,Ws} -> - {ok,St#compile{code=Code,warnings=St#compile.warnings++Ws}}; + {ok,Code,St#compile{warnings=St#compile.warnings++Ws}}; {error,Es} -> {error,St#compile{errors=St#compile.errors ++ Es}} end end, [{Mod,F}|select_passes(Ps, Opts)]; select_passes([{src_listing,Ext}|_], _Opts) -> - [{listing,fun (St) -> src_listing(Ext, St) end}]; + [{listing,fun (Code, St) -> src_listing(Ext, Code, St) end}]; select_passes([{listing,Ext}|_], _Opts) -> - [{listing,fun (St) -> listing(Ext, St) end}]; + [{listing,fun (Code, St) -> listing(Ext, Code, St) end}]; select_passes([done|_], _Opts) -> []; select_passes([{done,Ext}|_], Opts) -> @@ -662,14 +678,14 @@ core_passes() -> [{iff,clint0,?pass(core_lint_module)}, {delay, [{unless,no_copt, - [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/1}, + [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/2}, {iff,doldinline,{listing,"oldinline"}}, {pass,sys_core_fold}, {iff,dcorefold,{listing,"corefold"}}, - {core_inline_module,fun test_core_inliner/1,fun core_inline_module/1}, + {core_inline_module,fun test_core_inliner/1,fun core_inline_module/2}, {iff,dinline,{listing,"inline"}}, {core_fold_after_inlining,fun test_any_inliner/1, - fun core_fold_module_after_inlining/1}, + fun core_fold_module_after_inlining/2}, ?pass(core_transforms)]}, {iff,dcopt,{listing,"copt"}}, {iff,'to_core',{done,"core"}}]} @@ -741,7 +757,7 @@ asm_passes() -> | binary_passes()]. binary_passes() -> - [{native_compile,fun test_native/1,fun native_compile/1}, + [{native_compile,fun test_native/1,fun native_compile/2}, {unless,binary,?pass(save_binary,not_werror)}]. %%% @@ -749,9 +765,9 @@ binary_passes() -> %%% %% Remove the target file so we don't have an old one if the compilation fail. -remove_file(St) -> +remove_file(Code, St) -> _ = file:delete(St#compile.ofile), - {ok,St}. + {ok,Code,St}. -record(asm_module, {module, exports, @@ -799,28 +815,28 @@ collect_asm([{attributes, Attr} | Rest], R) -> collect_asm([X | Rest], R) -> collect_asm(Rest, R#asm_module{code=R#asm_module.code++[X]}). -beam_consult_asm(St) -> +beam_consult_asm(_Code, St) -> case file:consult(St#compile.ifile) of - {ok, Forms0} -> + {ok,Forms0} -> Encoding = epp:read_encoding(St#compile.ifile), - {Module, Forms} = preprocess_asm_forms(Forms0), - {ok,St#compile{module=Module, code=Forms, encoding=Encoding}}; + {Module,Forms} = preprocess_asm_forms(Forms0), + {ok,Forms,St#compile{module=Module,encoding=Encoding}}; {error,E} -> Es = [{St#compile.ifile,[{none,?MODULE,{open,E}}]}], {error,St#compile{errors=St#compile.errors ++ Es}} end. -read_beam_file(St) -> +read_beam_file(_Code, St) -> case file:read_file(St#compile.ifile) of {ok,Beam} -> Infile = St#compile.ifile, case no_native_compilation(Infile, St) of true -> - {ok,St#compile{module=none,code=none}}; + {ok,none,St#compile{module=none}}; false -> Mod0 = filename:rootname(filename:basename(Infile)), Mod = list_to_atom(Mod0), - {ok,St#compile{module=Mod,code=Beam,ofile=Infile}} + {ok,Beam,St#compile{module=Mod,ofile=Infile}} end; {error,E} -> Es = [{St#compile.ifile,[{none,?MODULE,{open,E}}]}], @@ -839,17 +855,17 @@ no_native_compilation(BeamFile, #compile{options=Opts0}) -> _ -> false end. -parse_module(St0) -> +parse_module(_Code, St0) -> case do_parse_module(utf8, St0) of - {ok,_}=Ret -> + {ok,_,_}=Ret -> Ret; {error,_}=Ret -> Ret; {invalid_unicode,File,Line} -> case do_parse_module(latin1, St0) of - {ok,St} -> + {ok,Code,St} -> Es = [{File,[{Line,?MODULE,reparsing_invalid_unicode}]}], - {ok,St#compile{warnings=Es++St#compile.warnings}}; + {ok,Code,St#compile{warnings=Es++St#compile.warnings}}; {error,St} -> Es = [{File,[{Line,?MODULE,reparsing_invalid_unicode}]}], {error,St#compile{errors=Es++St#compile.errors}} @@ -867,13 +883,13 @@ do_parse_module(DefEncoding, #compile{ifile=File,options=Opts,dir=Dir}=St) -> Encoding = proplists:get_value(encoding, Extra), case find_invalid_unicode(Forms, File) of none -> - {ok,St#compile{code=Forms,encoding=Encoding}}; + {ok,Forms,St#compile{encoding=Encoding}}; {invalid_unicode,_,_}=Ret -> case Encoding of none -> Ret; _ -> - {ok,St#compile{code=Forms,encoding=Encoding}} + {ok,Forms,St#compile{encoding=Encoding}} end end; {error,E} -> @@ -892,7 +908,7 @@ find_invalid_unicode([H|T], File0) -> end; find_invalid_unicode([], _) -> none. -parse_core(St) -> +parse_core(_Code, St) -> case file:read_file(St#compile.ifile) of {ok,Bin} -> case core_scan:string(binary_to_list(Bin)) of @@ -900,7 +916,7 @@ parse_core(St) -> case core_parse:parse(Toks) of {ok,Mod} -> Name = (Mod#c_module.name)#c_literal.val, - {ok,St#compile{module=Name,code=Mod}}; + {ok,Mod,St#compile{module=Name}}; {error,E} -> Es = [{St#compile.ifile,[E]}], {error,St#compile{errors=St#compile.errors ++ Es}} @@ -937,31 +953,36 @@ clean_parse_transforms_1([], Acc) -> reverse(Acc). transforms(Os) -> [ M || {parse_transform,M} <- Os ]. -transform_module(#compile{options=Opt,code=Code0}=St0) -> +transform_module(Code0, #compile{options=Opt}=St) -> %% Extract compile options from code into options field. case transforms(Opt ++ compile_options(Code0)) of - [] -> {ok,St0}; %No parse transforms. + [] -> + %% No parse transforms. + {ok,Code0,St}; Ts -> %% Remove parse_transform attributes from the abstract code to %% prevent parse transforms to be run more than once. Code = clean_parse_transforms(Code0), - St = St0#compile{code=Code}, - foldl_transform(St, Ts) + foldl_transform(Ts, Code, St) end. -foldl_transform(St, [T|Ts]) -> +foldl_transform([T|Ts], Code0, St) -> Name = "transform " ++ atom_to_list(T), case code:ensure_loaded(T) =:= {module,T} andalso - erlang:function_exported(T, parse_transform, 2) of + erlang:function_exported(T, parse_transform, 2) of true -> - Fun = fun(S) -> - T:parse_transform(S#compile.code, S#compile.options) + Fun = fun(Code, S) -> + T:parse_transform(Code, S#compile.options) end, Run = case member(time, St#compile.options) of - true -> fun run_tc/2; - false -> fun({_Name,F}, S) -> catch F(S) end + true -> + fun run_tc/3; + false -> + fun({_Name,F}, Code, S) -> + catch F(Code, S) + end end, - case Run({Name, Fun}, St) of + case Run({Name, Fun}, Code0, St) of {error,Es,Ws} -> {error,St#compile{warnings=St#compile.warnings ++ Ws, errors=St#compile.errors ++ Es}}; @@ -970,41 +991,44 @@ foldl_transform(St, [T|Ts]) -> {parse_transform,T,R}}]}], {error,St#compile{errors=St#compile.errors ++ Es}}; {warning, Forms, Ws} -> - foldl_transform( - St#compile{code=Forms, - warnings=St#compile.warnings ++ Ws}, Ts); + foldl_transform(Ts, Forms, + St#compile{warnings=St#compile.warnings ++ Ws}); Forms -> - foldl_transform(St#compile{code=Forms}, Ts) + foldl_transform(Ts, Forms, St) end; false -> Es = [{St#compile.ifile,[{none,compile, {undef_parse_transform,T}}]}], {error,St#compile{errors=St#compile.errors ++ Es}} end; -foldl_transform(St, []) -> {ok,St}. +foldl_transform([], Code, St) -> {ok,Code,St}. get_core_transforms(Opts) -> [M || {core_transform,M} <- Opts]. -core_transforms(St) -> +core_transforms(Code, St) -> %% The options field holds the complete list of options at this Ts = get_core_transforms(St#compile.options), - foldl_core_transforms(St, Ts). + foldl_core_transforms(Ts, Code, St). -foldl_core_transforms(St, [T|Ts]) -> +foldl_core_transforms([T|Ts], Code0, St) -> Name = "core transform " ++ atom_to_list(T), - Fun = fun(S) -> T:core_transform(S#compile.code, S#compile.options) end, + Fun = fun(Code, S) -> T:core_transform(Code, S#compile.options) end, Run = case member(time, St#compile.options) of - true -> fun run_tc/2; - false -> fun({_Name,F}, S) -> catch F(S) end + true -> + fun run_tc/3; + false -> + fun({_Name,F}, Code, S) -> + catch F(Code, S) + end end, - case Run({Name, Fun}, St) of + case Run({Name, Fun}, Code0, St) of {'EXIT',R} -> Es = [{St#compile.ifile,[{none,compile,{core_transform,T,R}}]}], {error,St#compile{errors=St#compile.errors ++ Es}}; Forms -> - foldl_core_transforms(St#compile{code=Forms}, Ts) + foldl_core_transforms(Ts, Forms, St) end; -foldl_core_transforms(St, []) -> {ok,St}. +foldl_core_transforms([], Code, St) -> {ok,Code,St}. %%% Fetches the module name from a list of forms. The module attribute must %%% be present. @@ -1025,31 +1049,28 @@ add_default_base(St, Forms) -> St end. -lint_module(St) -> - case erl_lint:module(St#compile.code, - St#compile.ifile, St#compile.options) of +lint_module(Code, St) -> + case erl_lint:module(Code, St#compile.ifile, St#compile.options) of {ok,Ws} -> %% Insert name of module as base name, if needed. This is %% for compile:forms to work with listing files. - St1 = add_default_base(St, St#compile.code), - {ok,St1#compile{warnings=St1#compile.warnings ++ Ws}}; + St1 = add_default_base(St, Code), + {ok,Code,St1#compile{warnings=St1#compile.warnings ++ Ws}}; {error,Es,Ws} -> {error,St#compile{warnings=St#compile.warnings ++ Ws, errors=St#compile.errors ++ Es}} end. -core_lint_module(St) -> - case core_lint:module(St#compile.code, St#compile.options) of +core_lint_module(Code, St) -> + case core_lint:module(Code, St#compile.options) of {ok,Ws} -> - {ok,St#compile{warnings=St#compile.warnings ++ Ws}}; + {ok,Code,St#compile{warnings=St#compile.warnings ++ Ws}}; {error,Es,Ws} -> {error,St#compile{warnings=St#compile.warnings ++ Ws, errors=St#compile.errors ++ Es}} end. -makedep(#compile{code=Code,options=Opts}=St) -> - Ifile = St#compile.ifile, - Ofile = St#compile.ofile, +makedep(Code0, #compile{ifile=Ifile,ofile=Ofile,options=Opts}=St) -> %% Get the target of the Makefile rule. Target0 = @@ -1081,7 +1102,7 @@ makedep(#compile{code=Code,options=Opts}=St) -> %% List the dependencies (includes) for this target. {MainRule,PhonyRules} = makedep_add_headers( Ifile, % The input file name. - Code, % The parsed source. + Code0, % The parsed source. [], % The list of dependencies already added. length(Target), % The current line length. Target, % The target. @@ -1101,7 +1122,8 @@ makedep(#compile{code=Code,options=Opts}=St) -> true -> MainRule ++ PhonyRules; _ -> MainRule end, - {ok,St#compile{code=iolist_to_binary([Makefile,"\n"])}}. + Code = iolist_to_binary([Makefile,"\n"]), + {ok,Code,St}. makedep_add_headers(Ifile, [{attribute,_,file,{File,_}}|Rest], Included, LineLen, MainTarget, Phony, Opts) -> @@ -1166,7 +1188,7 @@ makedep_add_header(Ifile, Included, LineLen, MainTarget, Phony, File) -> end end. -makedep_output(#compile{code=Code,options=Opts,ofile=Ofile}=St) -> +makedep_output(Code, #compile{options=Opts,ofile=Ofile}=St) -> %% Write this Makefile (Code) to the selected output. %% If no output is specified, the default is to write to a file named after %% the output file. @@ -1208,7 +1230,7 @@ makedep_output(#compile{code=Code,options=Opts,ofile=Ofile}=St) -> CloseOutput -> ok = file:close(Output1); true -> ok end, - {ok,St} + {ok,Code,St} catch error:_ -> %% Couldn't write to output Makefile. @@ -1225,33 +1247,33 @@ makedep_output(#compile{code=Code,options=Opts,ofile=Ofile}=St) -> {error,St#compile{errors=St#compile.errors++[Err]}} end. -expand_records(#compile{code=Code0,options=Opts}=St0) -> +expand_records(Code0, #compile{options=Opts}=St) -> Code = erl_expand_records:module(Code0, Opts), - {ok,St0#compile{code=Code}}. + {ok,Code,St}. -core(#compile{code=Forms,options=Opts0}=St) -> +core(Forms, #compile{options=Opts0}=St) -> Opts1 = lists:flatten([C || {attribute,_,compile,C} <- Forms] ++ Opts0), Opts = expand_opts(Opts1), {ok,Core,Ws} = v3_core:module(Forms, Opts), Mod = cerl:concrete(cerl:module_name(Core)), - {ok,St#compile{module=Mod,code=Core,options=Opts, - warnings=St#compile.warnings++Ws}}. + {ok,Core,St#compile{module=Mod,options=Opts, + warnings=St#compile.warnings++Ws}}. -core_fold_module_after_inlining(#compile{code=Code0,options=Opts}=St) -> +core_fold_module_after_inlining(Code0, #compile{options=Opts}=St) -> %% Inlining may produce code that generates spurious warnings. %% Ignore all warnings. {ok,Code,_Ws} = sys_core_fold:module(Code0, Opts), - {ok,St#compile{code=Code}}. + {ok,Code,St}. -v3_kernel(#compile{code=Code0,options=Opts,warnings=Ws0}=St) -> +v3_kernel(Code0, #compile{options=Opts,warnings=Ws0}=St) -> {ok,Code,Ws} = v3_kernel:module(Code0, Opts), case Ws =:= [] orelse test_core_inliner(St) of false -> - {ok,St#compile{code=Code,warnings=Ws0++Ws}}; + {ok,Code,St#compile{warnings=Ws0++Ws}}; true -> %% cerl_inline may produce code that generates spurious %% warnings. Ignore any such warnings. - {ok,St#compile{code=Code}} + {ok,Code,St} end. test_old_inliner(#compile{options=Opts}) -> @@ -1275,23 +1297,23 @@ test_core_inliner(#compile{options=Opts}) -> test_any_inliner(St) -> test_old_inliner(St) orelse test_core_inliner(St). -core_old_inliner(#compile{code=Code0,options=Opts}=St) -> +core_old_inliner(Code0, #compile{options=Opts}=St) -> {ok,Code} = sys_core_inline:module(Code0, Opts), - {ok,St#compile{code=Code}}. + {ok,Code,St}. -core_inline_module(#compile{code=Code0,options=Opts}=St) -> +core_inline_module(Code0, #compile{options=Opts}=St) -> Code = cerl_inline:core_transform(Code0, Opts), - {ok,St#compile{code=Code}}. + {ok,Code,St}. -save_abstract_code(#compile{ifile=File}=St) -> - case abstract_code(St) of - {ok,Code} -> - {ok,St#compile{abstract_code=Code}}; +save_abstract_code(Code, #compile{ifile=File}=St) -> + case abstract_code(Code, St) of + {ok,Abstr} -> + {ok,Code,St#compile{abstract_code=Abstr}}; {error,Es} -> {error,St#compile{errors=St#compile.errors ++ [{File,Es}]}} end. -abstract_code(#compile{code=Code0,options=Opts,ofile=OFile}) -> +abstract_code(Code0, #compile{options=Opts,ofile=OFile}) -> Code = erl_parse:anno_to_term(Code0), Abstr = erlang:term_to_binary({raw_abstract_v1,Code}, [compressed]), case member(encrypt_debug_info, Opts) of @@ -1313,7 +1335,7 @@ abstract_code(#compile{code=Code0,options=Opts,ofile=OFile}) -> end end; false -> - {ok, Abstr} + {ok,Abstr} end. encrypt_abs_code(Abstr, Key0) -> @@ -1351,18 +1373,17 @@ encrypt({des3_cbc=Type,Key,IVec,BlockSize}, Bin0) -> TypeString = atom_to_list(Type), list_to_binary([0,length(TypeString),TypeString,Bin]). -save_core_code(St) -> - {ok,St#compile{core_code=cerl:from_records(St#compile.code)}}. +save_core_code(Code, St) -> + {ok,Code,St#compile{core_code=cerl:from_records(Code)}}. -beam_asm(#compile{ifile=File,code=Code0, - abstract_code=Abst,mod_options=Opts0}=St) -> +beam_asm(Code0, #compile{ifile=File,abstract_code=Abst,mod_options=Opts0}=St) -> Source = paranoid_absname(File), Opts1 = lists:map(fun({debug_info_key,_}) -> {debug_info_key,'********'}; (Other) -> Other end, Opts0), Opts2 = [O || O <- Opts1, effects_code_generation(O)], case beam_asm:module(Code0, Abst, Source, Opts2) of - {ok,Code} -> {ok,St#compile{code=Code,abstract_code=[]}} + {ok,Code} -> {ok,Code,St#compile{abstract_code=[]}} end. paranoid_absname(""=File) -> @@ -1386,17 +1407,17 @@ is_native_enabled([no_native|_]) -> false; is_native_enabled([_|Opts]) -> is_native_enabled(Opts); is_native_enabled([]) -> false. -native_compile(#compile{code=none}=St) -> {ok,St}; -native_compile(St) -> +native_compile(none, St) -> {ok,none,St}; +native_compile(Code, St) -> case erlang:system_info(hipe_architecture) of undefined -> Ws = [{St#compile.ifile,[{none,compile,no_native_support}]}], - {ok,St#compile{warnings=St#compile.warnings ++ Ws}}; + {ok,Code,St#compile{warnings=St#compile.warnings ++ Ws}}; _ -> - native_compile_1(St) + native_compile_1(Code, St) end. -native_compile_1(St) -> +native_compile_1(Code, St) -> Opts0 = St#compile.options, IgnoreErrors = member(ignore_native_errors, Opts0), Opts = case keyfind(hipe, 1, Opts0) of @@ -1406,10 +1427,10 @@ native_compile_1(St) -> end, try hipe:compile(St#compile.module, St#compile.core_code, - St#compile.code, + Code, Opts) of {ok,{_Type,Bin}=T} when is_binary(Bin) -> - {ok,embed_native_code(St, T)}; + {ok,embed_native_code(Code, T),St}; {error,R} -> case IgnoreErrors of true -> @@ -1432,13 +1453,13 @@ native_compile_1(St) -> end end. -embed_native_code(St, {Architecture,NativeCode}) -> - {ok, _, Chunks0} = beam_lib:all_chunks(St#compile.code), +embed_native_code(Code, {Architecture,NativeCode}) -> + {ok, _, Chunks0} = beam_lib:all_chunks(Code), ChunkName = hipe_unified_loader:chunk_name(Architecture), Chunks1 = lists:keydelete(ChunkName, 1, Chunks0), Chunks = Chunks1 ++ [{ChunkName,NativeCode}], - {ok, BeamPlusNative} = beam_lib:build_module(Chunks), - St#compile{code=BeamPlusNative}. + {ok,BeamPlusNative} = beam_lib:build_module(Chunks), + BeamPlusNative. %% effects_code_generation(Option) -> true|false. %% Determine whether the option could have any effect on the @@ -1458,18 +1479,17 @@ effects_code_generation(Option) -> _ -> true end. -save_binary(#compile{code=none}=St) -> {ok,St}; -save_binary(#compile{module=Mod,ofile=Outfile, - options=Opts}=St) -> +save_binary(none, St) -> {ok,none,St}; +save_binary(Code, #compile{module=Mod,ofile=Outfile,options=Opts}=St) -> %% Test that the module name and output file name match. case member(no_error_module_mismatch, Opts) of true -> - save_binary_1(St); + save_binary_1(Code, St); false -> Base = filename:rootname(filename:basename(Outfile)), case atom_to_list(Mod) of Base -> - save_binary_1(St); + save_binary_1(Code, St); _ -> Es = [{St#compile.ofile, [{none,?MODULE,{module_name,Mod,Base}}]}], @@ -1477,14 +1497,14 @@ save_binary(#compile{module=Mod,ofile=Outfile, end end. -save_binary_1(St) -> +save_binary_1(Code, St) -> Ofile = St#compile.ofile, Tfile = tmpfile(Ofile), %Temp working file - case write_binary(Tfile, St#compile.code, St) of + case write_binary(Tfile, Code, St) of ok -> case file:rename(Tfile, Ofile) of ok -> - {ok,St}; + {ok,none,St}; {error,RenameError} -> Es0 = [{Ofile,[{none,?MODULE,{rename,Tfile,Ofile, RenameError}}]}], @@ -1584,6 +1604,9 @@ list_errors(_F, []) -> ok. %% tmpfile(ObjFile) -> TmpFile %% Work out the correct input and output file names. +-spec iofile(atom() | file:filename_all()) -> + {file:name_all(),file:name_all()}. + iofile(File) when is_atom(File) -> iofile(atom_to_list(File)); iofile(File) -> @@ -1624,29 +1647,29 @@ pre_defs([]) -> []. inc_paths(Opts) -> [ P || {i,P} <- Opts, is_list(P) ]. -src_listing(Ext, St) -> +src_listing(Ext, Code, St) -> listing(fun (Lf, {_Mod,_Exp,Fs}) -> do_src_listing(Lf, Fs); (Lf, Fs) -> do_src_listing(Lf, Fs) end, - Ext, St). + Ext, Code, St). do_src_listing(Lf, Fs) -> Opts = [lists:keyfind(encoding, 1, io:getopts(Lf))], foreach(fun (F) -> io:put_chars(Lf, [erl_pp:form(F, Opts),"\n"]) end, Fs). -listing(Ext, St0) -> +listing(Ext, Code, St0) -> St = St0#compile{encoding = none}, - listing(fun(Lf, Fs) -> beam_listing:module(Lf, Fs) end, Ext, St). + listing(fun(Lf, Fs) -> beam_listing:module(Lf, Fs) end, Ext, Code, St). -listing(LFun, Ext, St) -> +listing(LFun, Ext, Code, St) -> Lfile = outfile(St#compile.base, Ext, St#compile.options), case file:open(Lfile, [write,delayed_write]) of {ok,Lf} -> - Code = restore_expanded_types(Ext, St#compile.code), + Code = restore_expanded_types(Ext, Code), output_encoding(Lf, St), LFun(Lf, Code), ok = file:close(Lf), - {ok,St}; + {ok,Code,St}; {error,Error} -> Es = [{Lfile,[{none,compile,{write_error,Error}}]}], {error,St#compile{errors=St#compile.errors ++ Es}} @@ -1718,6 +1741,8 @@ help(_) -> %% compile(AbsFileName, Outfilename, Options) %% Compile entry point for erl_compile. +-spec compile(file:filename(), _, #options{}) -> 'ok' | 'error'. + compile(File0, _OutFile, Options) -> pre_load(), File = shorten_filename(File0), @@ -1726,6 +1751,8 @@ compile(File0, _OutFile, Options) -> Other -> Other end. +-spec compile_beam(file:filename(), _, #options{}) -> 'ok' | 'error'. + compile_beam(File0, _OutFile, Opts) -> File = shorten_filename(File0), case file(File, [from_beam|make_erl_options(Opts)]) of @@ -1733,6 +1760,8 @@ compile_beam(File0, _OutFile, Opts) -> Other -> Other end. +-spec compile_asm(file:filename(), _, #options{}) -> 'ok' | 'error'. + compile_asm(File0, _OutFile, Opts) -> File = shorten_filename(File0), case file(File, [from_asm|make_erl_options(Opts)]) of @@ -1740,6 +1769,8 @@ compile_asm(File0, _OutFile, Opts) -> Other -> Other end. +-spec compile_core(file:filename(), _, #options{}) -> 'ok' | 'error'. + compile_core(File0, _OutFile, Opts) -> File = shorten_filename(File0), case file(File, [from_core|make_erl_options(Opts)]) of diff --git a/lib/compiler/src/core_scan.erl b/lib/compiler/src/core_scan.erl index 11b52f6c5f..15bfc78c8b 100644 --- a/lib/compiler/src/core_scan.erl +++ b/lib/compiler/src/core_scan.erl @@ -49,13 +49,37 @@ -import(lists, [reverse/1]). +-type location() :: integer(). +-type category() :: atom(). +-type symbol() :: atom() | float() | integer() | string(). +-type token() :: {category(), Anno :: location(), symbol()} + | {category(), Anno :: location()}. +-type tokens() :: [token()]. +-type error_description() :: term(). +-type error_info() :: {erl_anno:location(), module(), error_description()}. + %% string([Char]) -> %% string([Char], StartPos) -> %% {ok, [Tok], EndPos} | %% {error, {Pos,core_scan,What}, EndPos} +-spec string(String) -> Return when + String :: string(), + Return :: {'ok', Tokens :: tokens(), EndLocation} + | {'error', ErrorInfo :: error_info(), ErrorLocation}, + EndLocation :: location(), + ErrorLocation :: location(). + string(Cs) -> string(Cs, 1). +-spec string(String, StartLocation) -> Return when + String :: string(), + Return :: {'ok', Tokens :: tokens(), EndLocation} + | {'error', ErrorInfo :: error_info(), ErrorLocation}, + StartLocation :: location(), + EndLocation :: location(), + ErrorLocation :: location(). + string(Cs, Sp) -> %% Add an 'eof' to always get correct handling. case string_pre_scan(Cs, [], Sp) of diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 50d28c0a5f..3673a339f6 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -1893,10 +1893,10 @@ case_opt_arg_1(E0, Cs0, LitExpr) -> true -> E = case_opt_compiler_generated(E0), Cs = case_opt_nomatch(E, Cs0, LitExpr), - case cerl:data_type(E) of - {atomic,_} -> + case cerl:is_literal(E) of + true -> case_opt_lit(E, Cs); - _ -> + false -> case_opt_data(E, Cs) end end. diff --git a/lib/compiler/src/sys_pre_attributes.erl b/lib/compiler/src/sys_pre_attributes.erl index bc93c85989..67adae5acf 100644 --- a/lib/compiler/src/sys_pre_attributes.erl +++ b/lib/compiler/src/sys_pre_attributes.erl @@ -25,10 +25,10 @@ -define(OPTION_TAG, attributes). --record(state, {forms, - pre_ops = [], - post_ops = [], - options}). +-record(state, {forms :: [form()], + pre_ops = [] :: [op()], + post_ops = [] :: [op()], + options :: [option()]}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Inserts, deletes and replaces Erlang compiler attributes. @@ -59,9 +59,23 @@ %% due to that the pre_transform pass did not find the attribute plus %% all insert operations. +-type attribute() :: atom(). +-type value() :: term(). +-type form() :: {function, integer(), atom(), arity(), _} + | {attribute, integer(), attribute(), _}. +-type option() :: compile:option() + | {'attribute', 'insert', attribute(), value()} + | {'attribute', 'replace', attribute(), value()} + | {'attribute', 'delete', attribute()}. +-type op() :: {'insert', attribute(), value()} + | {'replace', attribute(), value()} + | {'delete', attribute()}. + +-spec parse_transform([form()], [option()]) -> [form()]. + parse_transform(Forms, Options) -> S = #state{forms = Forms, options = Options}, - S2 = init_transform(S), + S2 = init_transform(Options, S), report_verbose("Pre options: ~p~n", [S2#state.pre_ops], S2), report_verbose("Post options: ~p~n", [S2#state.post_ops], S2), S3 = pre_transform(S2), @@ -71,13 +85,6 @@ parse_transform(Forms, Options) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Computes the lists of pre_ops and post_ops that are %% used in the real transformation. -init_transform(S) -> - case S#state.options of - Options when is_list(Options) -> - init_transform(Options, S); - Option -> - init_transform([Option], S) - end. init_transform([{attribute, insert, Name, Val} | Tail], S) -> Op = {insert, Name, Val}, @@ -92,12 +99,9 @@ init_transform([{attribute, delete, Name} | Tail], S) -> Op = {delete, Name}, PreOps = [Op | S#state.pre_ops], init_transform(Tail, S#state{pre_ops = PreOps}); -init_transform([], S) -> - S; init_transform([_ | T], S) -> init_transform(T, S); -init_transform(BadOpt, S) -> - report_error("Illegal option (ignored): ~p~n", [BadOpt], S), +init_transform([], S) -> S. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -176,18 +180,9 @@ attrs([], _, _) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Report functions. %% -%% Errors messages are controlled with the 'report_errors' compiler option %% Warning messages are controlled with the 'report_warnings' compiler option %% Verbose messages are controlled with the 'verbose' compiler option -report_error(Format, Args, S) -> - case is_error(S) of - true -> - io:format("~p: * ERROR * " ++ Format, [?MODULE | Args]); - false -> - ok - end. - report_warning(Format, Args, S) -> case is_warning(S) of true -> @@ -204,9 +199,6 @@ report_verbose(Format, Args, S) -> ok end. -is_error(S) -> - lists:member(report_errors, S#state.options) or is_verbose(S). - is_warning(S) -> lists:member(report_warnings, S#state.options) or is_verbose(S). diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 3627cdb7cd..47c1567f10 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -69,6 +69,10 @@ stk=[], %Stack table res=[]}). %Reserved regs: [{reserved,I,V}] +-type life_module() :: {module(),_,_,[_]}. + +-spec module(life_module(), [compile:option()]) -> {'ok',beam_asm:module_code()}. + module({Mod,Exp,Attr,Forms}, _Options) -> {Fs,St} = functions(Forms, {atom,Mod}), {ok,{Mod,Exp,Attr,Fs,St#cg.lcount}}. diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl index d5f6ee19c9..187e69a22c 100644 --- a/lib/compiler/src/v3_kernel_pp.erl +++ b/lib/compiler/src/v3_kernel_pp.erl @@ -47,7 +47,7 @@ canno(Cthing) -> element(2, Cthing). --spec format(cerl:cerl()) -> iolist(). +-spec format(#k_mdef{}) -> iolist(). format(Node) -> format(Node, #ctxt{}). diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index 0f2aeda87f..be3ade47ff 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -52,10 +52,15 @@ -include("v3_kernel.hrl"). -include("v3_life.hrl"). +-type fa() :: {atom(),arity()}. + %% These are not defined in v3_kernel.hrl. get_kanno(Kthing) -> element(2, Kthing). %%set_kanno(Kthing, Anno) -> setelement(2, Kthing, Anno). +-spec module(#k_mdef{}, [compile:option()]) -> + {'ok',{module(),[fa()],[_],[_]}}. + module(#k_mdef{name=M,exports=Es,attributes=As,body=Fs0}, _Opts) -> Fs1 = functions(Fs0, []), {ok,{M,Es,As,Fs1}}. @@ -416,6 +421,10 @@ add_var(V, F, L, Vdb) -> vdb_new(Vs) -> sort([{V,0,0} || {var,V} <- Vs]). +-type var() :: atom(). + +-spec vdb_find(var(), [vdb_entry()]) -> 'error' | vdb_entry(). + vdb_find(V, Vdb) -> case lists:keyfind(V, 1, Vdb) of false -> error; diff --git a/lib/compiler/src/v3_life.hrl b/lib/compiler/src/v3_life.hrl index 9d03a86ccd..5c76312067 100644 --- a/lib/compiler/src/v3_life.hrl +++ b/lib/compiler/src/v3_life.hrl @@ -20,8 +20,10 @@ %% This record contains variable life-time annotation for a %% kernel expression. Added by v3_life, used by v3_codegen. +-type vdb_entry() :: {atom(),non_neg_integer(),non_neg_integer()}. + -record(l, {ke, %Kernel expression - i=0, %Op number - vdb=[], %Variable database - a}). %Core annotation + i=0 :: non_neg_integer(), %Op number + vdb=[] :: [vdb_entry()], %Variable database + a=[] :: [term()]}). %Core annotation diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl index 3cb49433ce..adb96fb87d 100644 --- a/lib/compiler/test/lc_SUITE.erl +++ b/lib/compiler/test/lc_SUITE.erl @@ -19,7 +19,7 @@ %% -module(lc_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, +-export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, basic/1,deeply_nested/1,no_generator/1, @@ -32,11 +32,11 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,1}}]. -all() -> +all() -> test_lib:recompile(?MODULE), [{group,p}]. -groups() -> +groups() -> [{p,test_lib:parallel(), [basic, deeply_nested, @@ -214,6 +214,7 @@ shadow(Config) when is_list(Config) -> ok. effect(Config) when is_list(Config) -> + ct:timetrap({minutes,10}), [{42,{a,b,c}}] = do_effect(fun(F, L) -> [F({V1,V2}) || @@ -240,7 +241,7 @@ do_effect(Lc, L) -> lists:reverse(erase(?MODULE)). id(I) -> I. - + fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Args,_}|_]}}) -> ok; fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Arity,_}|_]}}) when length(Args) =:= Arity -> diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 0031f9b962..38b49c7a76 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -120,7 +120,7 @@ # endif #endif -#if defined(NID_chacha20) && !defined(OPENSSL_NO_CHACHA) && !defined(OPENSSL_NO_POLY1305) +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,1,0) # define HAVE_CHACHA20_POLY1305 #endif @@ -138,27 +138,6 @@ #include <openssl/ecdsa.h> #endif -/* - * FIXME: The support for ChaCha and Poly1305 is based on pre-releases - * of OpenSSL 1.1.0. It is seriously broken when used with the released - * OpenSSL 1.1.0 or later. - */ -#undef HAVE_CHACHA20_POLY1305 - -#if defined(HAVE_CHACHA20_POLY1305) -#include <openssl/chacha.h> -#include <openssl/poly1305.h> - -#if !defined(CHACHA20_NONCE_LEN) -# define CHACHA20_NONCE_LEN 8 -#endif -#if !defined(POLY1305_TAG_LEN) -# define POLY1305_TAG_LEN 16 -#endif - -#endif - - #ifdef VALGRIND # include <valgrind/memcheck.h> @@ -941,7 +920,7 @@ static ERL_NIF_TERM algo_hash[8]; /* increase when extending the list */ static int algo_pubkey_cnt, algo_pubkey_fips_cnt; static ERL_NIF_TERM algo_pubkey[7]; /* increase when extending the list */ static int algo_cipher_cnt, algo_cipher_fips_cnt; -static ERL_NIF_TERM algo_cipher[23]; /* increase when extending the list */ +static ERL_NIF_TERM algo_cipher[24]; /* increase when extending the list */ static void init_algorithms_types(ErlNifEnv* env) { @@ -2093,71 +2072,61 @@ out_err: } #endif /* HAVE_GCM_EVP_DECRYPT_BUG */ -#if defined(HAVE_CHACHA20_POLY1305) -static void -poly1305_update_with_length(poly1305_state *poly1305, - const unsigned char *data, size_t data_len) -{ - size_t j = data_len; - unsigned char length_bytes[8]; - unsigned i; - - for (i = 0; i < sizeof(length_bytes); i++) { - length_bytes[i] = j; - j >>= 8; - } - - CRYPTO_poly1305_update(poly1305, data, data_len); - CRYPTO_poly1305_update(poly1305, length_bytes, sizeof(length_bytes)); -} -#endif static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key,Iv,AAD,In) */ #if defined(HAVE_CHACHA20_POLY1305) + EVP_CIPHER_CTX *ctx; + const EVP_CIPHER *cipher = NULL; ErlNifBinary key, iv, aad, in; - unsigned char *outp; + unsigned char *outp, *tagp; ERL_NIF_TERM out, out_tag; - ErlNifUInt64 in_len_64; - unsigned char poly1305_key[32]; - poly1305_state poly1305; + int len; if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 32 - || !enif_inspect_binary(env, argv[1], &iv) || iv.size != CHACHA20_NONCE_LEN + || !enif_inspect_binary(env, argv[1], &iv) || iv.size == 0 || iv.size > 16 || !enif_inspect_iolist_as_binary(env, argv[2], &aad) || !enif_inspect_iolist_as_binary(env, argv[3], &in)) { return enif_make_badarg(env); } - /* Take from OpenSSL patch set/LibreSSL: - * - * The underlying ChaCha implementation may not overflow the block - * counter into the second counter word. Therefore we disallow - * individual operations that work on more than 2TB at a time. - * in_len_64 is needed because, on 32-bit platforms, size_t is only - * 32-bits and this produces a warning because it's always false. - * Casting to uint64_t inside the conditional is not sufficient to stop - * the warning. */ - in_len_64 = in.size; - if (in_len_64 >= (1ULL << 32) * 64 - 64) - return enif_make_badarg(env); + cipher = EVP_chacha20_poly1305(); + + ctx = EVP_CIPHER_CTX_new(); + + if (EVP_EncryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) + goto out_err; - memset(poly1305_key, 0, sizeof(poly1305_key)); - CRYPTO_chacha_20(poly1305_key, poly1305_key, sizeof(poly1305_key), key.data, iv.data, 0); + EVP_CIPHER_CTX_set_padding(ctx, 0); + + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_AEAD_SET_IVLEN, iv.size, NULL) != 1) + goto out_err; + if (EVP_EncryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) + goto out_err; + if (EVP_EncryptUpdate(ctx, NULL, &len, aad.data, aad.size) != 1) + goto out_err; outp = enif_make_new_binary(env, in.size, &out); - CRYPTO_poly1305_init(&poly1305, poly1305_key); - poly1305_update_with_length(&poly1305, aad.data, aad.size); - CRYPTO_chacha_20(outp, in.data, in.size, key.data, iv.data, 1); - poly1305_update_with_length(&poly1305, outp, in.size); + if (EVP_EncryptUpdate(ctx, outp, &len, in.data, in.size) != 1) + goto out_err; + if (EVP_EncryptFinal_ex(ctx, outp+len, &len) != 1) + goto out_err; + + tagp = enif_make_new_binary(env, 16, &out_tag); - CRYPTO_poly1305_finish(&poly1305, enif_make_new_binary(env, POLY1305_TAG_LEN, &out_tag)); + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_AEAD_GET_TAG, 16, tagp) != 1) + goto out_err; + + EVP_CIPHER_CTX_free(ctx); CONSUME_REDS(env, in); return enif_make_tuple2(env, out, out_tag); +out_err: + EVP_CIPHER_CTX_free(ctx); + return atom_error; #else return enif_raise_exception(env, atom_notsup); #endif @@ -2166,53 +2135,52 @@ static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ER static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key,Iv,AAD,In,Tag) */ #if defined(HAVE_CHACHA20_POLY1305) + EVP_CIPHER_CTX *ctx; + const EVP_CIPHER *cipher = NULL; ErlNifBinary key, iv, aad, in, tag; unsigned char *outp; ERL_NIF_TERM out; - ErlNifUInt64 in_len_64; - unsigned char poly1305_key[32]; - unsigned char mac[POLY1305_TAG_LEN]; - poly1305_state poly1305; + int len; if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 32 - || !enif_inspect_binary(env, argv[1], &iv) || iv.size != CHACHA20_NONCE_LEN + || !enif_inspect_binary(env, argv[1], &iv) || iv.size == 0 || iv.size > 16 || !enif_inspect_iolist_as_binary(env, argv[2], &aad) || !enif_inspect_iolist_as_binary(env, argv[3], &in) - || !enif_inspect_iolist_as_binary(env, argv[4], &tag) || tag.size != POLY1305_TAG_LEN) { + || !enif_inspect_iolist_as_binary(env, argv[4], &tag) || tag.size != 16) { return enif_make_badarg(env); } - /* Take from OpenSSL patch set/LibreSSL: - * - * The underlying ChaCha implementation may not overflow the block - * counter into the second counter word. Therefore we disallow - * individual operations that work on more than 2TB at a time. - * in_len_64 is needed because, on 32-bit platforms, size_t is only - * 32-bits and this produces a warning because it's always false. - * Casting to uint64_t inside the conditional is not sufficient to stop - * the warning. */ - in_len_64 = in.size; - if (in_len_64 >= (1ULL << 32) * 64 - 64) - return enif_make_badarg(env); - - memset(poly1305_key, 0, sizeof(poly1305_key)); - CRYPTO_chacha_20(poly1305_key, poly1305_key, sizeof(poly1305_key), key.data, iv.data, 0); + cipher = EVP_chacha20_poly1305(); - CRYPTO_poly1305_init(&poly1305, poly1305_key); - poly1305_update_with_length(&poly1305, aad.data, aad.size); - poly1305_update_with_length(&poly1305, in.data, in.size); - CRYPTO_poly1305_finish(&poly1305, mac); + ctx = EVP_CIPHER_CTX_new(); - if (memcmp(mac, tag.data, POLY1305_TAG_LEN) != 0) - return atom_error; + if (EVP_DecryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) + goto out_err; + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_AEAD_SET_IVLEN, iv.size, NULL) != 1) + goto out_err; + if (EVP_DecryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) + goto out_err; + if (EVP_DecryptUpdate(ctx, NULL, &len, aad.data, aad.size) != 1) + goto out_err; outp = enif_make_new_binary(env, in.size, &out); - CRYPTO_chacha_20(outp, in.data, in.size, key.data, iv.data, 1); + if (EVP_DecryptUpdate(ctx, outp, &len, in.data, in.size) != 1) + goto out_err; + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_AEAD_SET_TAG, tag.size, tag.data) != 1) + goto out_err; + if (EVP_DecryptFinal_ex(ctx, outp+len, &len) != 1) + goto out_err; + + EVP_CIPHER_CTX_free(ctx); CONSUME_REDS(env, in); return out; + +out_err: + EVP_CIPHER_CTX_free(ctx); + return atom_error; #else return enif_raise_exception(env, atom_notsup); #endif diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 0b62964efa..9767a13dfc 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -159,10 +159,11 @@ cmac(Type, Key, Data, MacSize) -> des3_cbc | des3_cbf | des3_cfb | des_ede3 | blowfish_cbc | blowfish_cfb64 | blowfish_ofb64 | aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | aes_ige256 | - aes_cbc | + aes_cbc | rc2_cbc, - Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(); - (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata()}) -> {binary(), binary()}. + Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(); + (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata()}) -> {binary(), binary()}; + (aes_gcm, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata(), TagLength::1..16}) -> {binary(), binary()}. block_encrypt(Type, Key, Ivec, Data) when Type =:= des_cbc; Type =:= des_cfb; diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 0c3b7a0445..31f4e89ffe 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -2249,16 +2249,49 @@ aes_gcm() -> 1} %% TagLength ]. -%% http://tools.ietf.org/html/draft-agl-tls-chacha20poly1305-04 +%% https://tools.ietf.org/html/rfc7539#appendix-A.5 chacha20_poly1305() -> [ - {chacha20_poly1305, hexstr2bin("4290bcb154173531f314af57f3be3b500" %% Key - "6da371ece272afa1b5dbdd1100a1007"), - hexstr2bin("86d09974840bded2a5ca"), %% PlainText - hexstr2bin("cd7cf67be39c794a"), %% Nonce - hexstr2bin("87e229d4500845a079c0"), %% AAD - hexstr2bin("e3e446f7ede9a19b62a4"), %% CipherText - hexstr2bin("677dabf4e3d24b876bb284753896e1d6")} %% CipherTag + {chacha20_poly1305, + hexstr2bin("1c9240a5eb55d38af333888604f6b5f0" %% Key + "473917c1402b80099dca5cbc207075c0"), + hexstr2bin("496e7465726e65742d44726166747320" %% PlainText + "61726520647261667420646f63756d65" + "6e74732076616c696420666f72206120" + "6d6178696d756d206f6620736978206d" + "6f6e74687320616e64206d6179206265" + "20757064617465642c207265706c6163" + "65642c206f72206f62736f6c65746564" + "206279206f7468657220646f63756d65" + "6e747320617420616e792074696d652e" + "20497420697320696e617070726f7072" + "6961746520746f2075736520496e7465" + "726e65742d4472616674732061732072" + "65666572656e6365206d617465726961" + "6c206f7220746f206369746520746865" + "6d206f74686572207468616e20617320" + "2fe2809c776f726b20696e2070726f67" + "726573732e2fe2809d"), + hexstr2bin("000000000102030405060708"), %% Nonce + hexstr2bin("f33388860000000000004e91"), %% AAD + hexstr2bin("64a0861575861af460f062c79be643bd" %% CipherText + "5e805cfd345cf389f108670ac76c8cb2" + "4c6cfc18755d43eea09ee94e382d26b0" + "bdb7b73c321b0100d4f03b7f355894cf" + "332f830e710b97ce98c8a84abd0b9481" + "14ad176e008d33bd60f982b1ff37c855" + "9797a06ef4f0ef61c186324e2b350638" + "3606907b6a7c02b0f9f6157b53c867e4" + "b9166c767b804d46a59b5216cde7a4e9" + "9040c5a40433225ee282a1b0a06c523e" + "af4534d7f83fa1155b0047718cbc546a" + "0d072b04b3564eea1b422273f548271a" + "0bb2316053fa76991955ebd63159434e" + "cebb4e466dae5a1073a6727627097a10" + "49e617d91d361094fa68f0ff77987130" + "305beaba2eda04df997b714d6c6f2c29" + "a6ad5cb4022b02709b"), + hexstr2bin("eead9d67890cbb22392336fea1851f38")} %% CipherTag ]. rsa_plain() -> diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index b5510731e0..ae1e4d8c38 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -94,9 +94,9 @@ loop(#server_state{parent = Parent} = State, {AnalPid, cserver, CServer, Plt} -> send_codeserver_plt(Parent, CServer, Plt), loop(State, Analysis, ExtCalls); - {AnalPid, done, Plt, DocPlt} -> + {AnalPid, done, MiniPlt, DocPlt} -> send_ext_calls(Parent, ExtCalls), - send_analysis_done(Parent, Plt, DocPlt); + send_analysis_done(Parent, MiniPlt, DocPlt); {AnalPid, ext_calls, NewExtCalls} -> loop(State, Analysis, NewExtCalls); {AnalPid, ext_types, ExtTypes} -> @@ -114,6 +114,7 @@ loop(#server_state{parent = Parent} = State, %% The Analysis %%-------------------------------------------------------------------- +%% Calls to erlang:garbage_collect() help to reduce the heap size. analysis_start(Parent, Analysis, LegalWarnings) -> CServer = dialyzer_codeserver:new(), Plt = Analysis#analysis.plt, @@ -150,12 +151,9 @@ analysis_start(Parent, Analysis, LegalWarnings) -> TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer0), TmpCServer2 = dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1), + erlang:garbage_collect(), ?timing(State#analysis_state.timing_server, "remote", - begin - TmpCServer3 = - dialyzer_utils:process_record_remote_types(TmpCServer2), - dialyzer_contracts:process_contract_remote_types(TmpCServer3) - end) + contracts_and_records(TmpCServer2)) catch throw:{error, _ErrorMsg} = Error -> exit(Error) end, @@ -164,48 +162,75 @@ analysis_start(Parent, Analysis, LegalWarnings) -> NewPlt1 = dialyzer_plt:insert_exported_types(NewPlt0, ExpTypes), State0 = State#analysis_state{plt = NewPlt1}, dump_callgraph(Callgraph, State0, Analysis), - State1 = State0#analysis_state{codeserver = NewCServer}, %% Remove all old versions of the files being analyzed AllNodes = dialyzer_callgraph:all_nodes(Callgraph), - Plt1 = dialyzer_plt:delete_list(NewPlt1, AllNodes), + Plt1_a = dialyzer_plt:delete_list(NewPlt1, AllNodes), + Plt1 = dialyzer_plt:insert_callbacks(Plt1_a, NewCServer), + State1 = State0#analysis_state{codeserver = NewCServer, plt = Plt1}, Exports = dialyzer_codeserver:get_exports(NewCServer), + NonExports = sets:subtract(sets:from_list(AllNodes), Exports), + NonExportsList = sets:to_list(NonExports), NewCallgraph = case Analysis#analysis.race_detection of true -> dialyzer_callgraph:put_race_detection(true, Callgraph); false -> Callgraph end, - State2 = analyze_callgraph(NewCallgraph, State1#analysis_state{plt = Plt1}), + State2 = analyze_callgraph(NewCallgraph, State1), + #analysis_state{plt = MiniPlt2, doc_plt = DocPlt} = State2, dialyzer_callgraph:dispose_race_server(NewCallgraph), rcv_and_send_ext_types(Parent), - NonExports = sets:subtract(sets:from_list(AllNodes), Exports), - NonExportsList = sets:to_list(NonExports), - Plt2 = dialyzer_plt:delete_list(State2#analysis_state.plt, NonExportsList), - send_codeserver_plt(Parent, CServer, State2#analysis_state.plt), - send_analysis_done(Parent, Plt2, State2#analysis_state.doc_plt). + %% Since the PLT is never used, a dummy is sent: + DummyPlt = dialyzer_plt:new(), + send_codeserver_plt(Parent, CServer, DummyPlt), + MiniPlt3 = dialyzer_plt:delete_list(MiniPlt2, NonExportsList), + send_analysis_done(Parent, MiniPlt3, DocPlt). + +contracts_and_records(CodeServer) -> + Fun = contrs_and_recs(CodeServer), + {Pid, Ref} = erlang:spawn_monitor(Fun), + dialyzer_codeserver:give_away(CodeServer, Pid), + Pid ! {self(), go}, + receive {'DOWN', Ref, process, Pid, Return} -> + Return + end. + +-spec contrs_and_recs(dialyzer_codeserver:codeserver()) -> + fun(() -> no_return()). + +contrs_and_recs(TmpCServer2) -> + fun() -> + Parent = receive {Pid, go} -> Pid end, + {TmpCServer3, RecordDict} = + dialyzer_utils:process_record_remote_types(TmpCServer2), + TmpServer4 = + dialyzer_contracts:process_contract_remote_types(TmpCServer3, + RecordDict), + dialyzer_codeserver:give_away(TmpServer4, Parent), + exit(TmpServer4) + end. analyze_callgraph(Callgraph, #analysis_state{codeserver = Codeserver, doc_plt = DocPlt, + plt = Plt, timing_server = TimingServer, parent = Parent, solvers = Solvers} = State) -> - Plt = dialyzer_plt:insert_callbacks(State#analysis_state.plt, Codeserver), - {NewPlt, NewDocPlt} = - case State#analysis_state.analysis_type of - plt_build -> - NewPlt0 = - dialyzer_succ_typings:analyze_callgraph(Callgraph, Plt, Codeserver, - TimingServer, Solvers, Parent), - {NewPlt0, DocPlt}; - succ_typings -> - {Warnings, NewPlt0, NewDocPlt0} = - dialyzer_succ_typings:get_warnings(Callgraph, Plt, DocPlt, Codeserver, - TimingServer, Solvers, Parent), - Warnings1 = filter_warnings(Warnings, Codeserver), - send_warnings(State#analysis_state.parent, Warnings1), - {NewPlt0, NewDocPlt0} - end, - dialyzer_callgraph:delete(Callgraph), - State#analysis_state{plt = NewPlt, doc_plt = NewDocPlt}. + case State#analysis_state.analysis_type of + plt_build -> + NewMiniPlt = + dialyzer_succ_typings:analyze_callgraph(Callgraph, Plt, Codeserver, + TimingServer, Solvers, Parent), + dialyzer_callgraph:delete(Callgraph), + State#analysis_state{plt = NewMiniPlt, doc_plt = DocPlt}; + succ_typings -> + {Warnings, NewMiniPlt, NewDocPlt} = + dialyzer_succ_typings:get_warnings(Callgraph, Plt, DocPlt, Codeserver, + TimingServer, Solvers, Parent), + dialyzer_callgraph:delete(Callgraph), + Warnings1 = filter_warnings(Warnings, Codeserver), + send_warnings(State#analysis_state.parent, Warnings1), + State#analysis_state{plt = NewMiniPlt, doc_plt = NewDocPlt} + end. %%-------------------------------------------------------------------- %% Build the callgraph and fill the codeserver. @@ -562,8 +587,9 @@ is_ok_fun({_Filename, _Line, {_M, _F, _A} = MFA}, Codeserver) -> is_ok_tag(Tag, {_F, _L, MorMFA}, Codeserver) -> not dialyzer_utils:is_suppressed_tag(MorMFA, Tag, Codeserver). -send_analysis_done(Parent, Plt, DocPlt) -> - Parent ! {self(), done, Plt, DocPlt}, +send_analysis_done(Parent, MiniPlt, DocPlt) -> + ok = dialyzer_plt:give_away(MiniPlt, Parent), + Parent ! {self(), done, MiniPlt, DocPlt}, ok. send_ext_calls(_Parent, none) -> @@ -576,7 +602,7 @@ send_ext_types(Parent, ExtTypes) -> Parent ! {self(), ext_types, ExtTypes}, ok. -send_codeserver_plt(Parent, CServer, Plt ) -> +send_codeserver_plt(Parent, CServer, Plt) -> Parent ! {self(), cserver, CServer, Plt}, ok. @@ -595,14 +621,14 @@ format_bad_calls([{{_, _, _}, {_, module_info, A}}|Left], CodeServer, Acc) format_bad_calls([{FromMFA, {M, F, A} = To}|Left], CodeServer, Acc) -> {_Var, FunCode} = dialyzer_codeserver:lookup_mfa_code(FromMFA, CodeServer), Msg = {call_to_missing, [M, F, A]}, - {File, Line} = find_call_file_and_line(FunCode, To), + {File, Line} = find_call_file_and_line(FromMFA, FunCode, To, CodeServer), WarningInfo = {File, Line, FromMFA}, NewAcc = [{?WARN_CALLGRAPH, WarningInfo, Msg}|Acc], format_bad_calls(Left, CodeServer, NewAcc); format_bad_calls([], _CodeServer, Acc) -> Acc. -find_call_file_and_line(Tree, MFA) -> +find_call_file_and_line({Module, _, _}, Tree, MFA, CodeServer) -> Fun = fun(SubTree, Acc) -> case cerl:is_c_call(SubTree) of @@ -615,7 +641,7 @@ find_call_file_and_line(Tree, MFA) -> case {cerl:concrete(M), cerl:concrete(F), A} of MFA -> Ann = cerl:get_ann(SubTree), - [{get_file(Ann), get_line(Ann)}|Acc]; + [{get_file(CodeServer, Module, Ann), get_line(Ann)}|Acc]; {erlang, make_fun, 3} -> [CA1, CA2, CA3] = cerl:call_args(SubTree), case @@ -631,7 +657,8 @@ find_call_file_and_line(Tree, MFA) -> of MFA -> Ann = cerl:get_ann(SubTree), - [{get_file(Ann), get_line(Ann)}|Acc]; + [{get_file(CodeServer, Module, Ann), + get_line(Ann)}|Acc]; _ -> Acc end; @@ -651,8 +678,10 @@ get_line([Line|_]) when is_integer(Line) -> Line; get_line([_|Tail]) -> get_line(Tail); get_line([]) -> -1. -get_file([{file, File}|_]) -> File; -get_file([_|Tail]) -> get_file(Tail). +get_file(Codeserver, Module, [{file, FakeFile}|_]) -> + dialyzer_codeserver:translate_fake_file(Codeserver, Module, FakeFile); +get_file(Codeserver, Module, [_|Tail]) -> + get_file(Codeserver, Module, Tail). -spec dump_callgraph(dialyzer_callgraph:callgraph(), #analysis_state{}, #analysis{}) -> 'ok'. diff --git a/lib/dialyzer/src/dialyzer_behaviours.erl b/lib/dialyzer/src/dialyzer_behaviours.erl index e79a5d1cd9..d380ab2a50 100644 --- a/lib/dialyzer/src/dialyzer_behaviours.erl +++ b/lib/dialyzer/src/dialyzer_behaviours.erl @@ -55,9 +55,9 @@ check_callbacks(Module, Attrs, Records, Plt, Codeserver) -> _ -> MFA = {Module,module_info,0}, {_Var,Code} = dialyzer_codeserver:lookup_mfa_code(MFA, Codeserver), - File = get_file(cerl:get_ann(Code)), + File = get_file(Codeserver, Module, cerl:get_ann(Code)), State = #state{plt = Plt, filename = File, behlines = BehLines, - codeserver = Codeserver, records = Records}, + codeserver = Codeserver, records = Records}, Warnings = get_warnings(Module, Behaviours, State), [add_tag_warning_info(Module, W, State) || W <- Warnings] end. @@ -206,12 +206,15 @@ add_tag_warning_info(Module, {_Tag, [_B, Fun, Arity|_R]} = Warn, State) -> dialyzer_codeserver:lookup_mfa_code({Module, Fun, Arity}, State#state.codeserver), Anns = cerl:get_ann(FunCode), - WarningInfo = {get_file(Anns), get_line(Anns), {Module, Fun, Arity}}, + File = get_file(State#state.codeserver, Module, Anns), + WarningInfo = {File, get_line(Anns), {Module, Fun, Arity}}, {?WARN_BEHAVIOUR, WarningInfo, Warn}. get_line([Line|_]) when is_integer(Line) -> Line; get_line([_|Tail]) -> get_line(Tail); get_line([]) -> -1. -get_file([{file, File}|_]) -> File; -get_file([_|Tail]) -> get_file(Tail). +get_file(Codeserver, Module, [{file, FakeFile}|_]) -> + dialyzer_codeserver:translate_fake_file(Codeserver, Module, FakeFile); +get_file(Codeserver, Module, [_|Tail]) -> + get_file(Codeserver, Module, Tail). diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl index 227ee2a892..68f3d7a240 100644 --- a/lib/dialyzer/src/dialyzer_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_callgraph.erl @@ -112,7 +112,11 @@ -opaque callgraph() :: #callgraph{}. --type active_digraph() :: {'d', digraph:graph()} | {'e', ets:tid(), ets:tid()}. +-type active_digraph() :: {'d', digraph:graph()} + | {'e', + Out :: ets:tid(), + In :: ets:tid(), + Map :: ets:tid()}. %%---------------------------------------------------------------------- @@ -241,24 +245,30 @@ find_non_local_calls([], Set) -> -spec get_depends_on(scc() | module(), callgraph()) -> [scc()]. -get_depends_on(SCC, #callgraph{active_digraph = {'e', Out, _In}}) -> - case ets_lookup_dict(SCC, Out) of - {ok, Value} -> Value; - error -> [] - end; +get_depends_on(SCC, #callgraph{active_digraph = {'e', Out, _In, Maps}}) -> + lookup_scc(SCC, Out, Maps); get_depends_on(SCC, #callgraph{active_digraph = {'d', DG}}) -> digraph:out_neighbours(DG, SCC). -spec get_required_by(scc() | module(), callgraph()) -> [scc()]. -get_required_by(SCC, #callgraph{active_digraph = {'e', _Out, In}}) -> - case ets_lookup_dict(SCC, In) of - {ok, Value} -> Value; - error -> [] - end; +get_required_by(SCC, #callgraph{active_digraph = {'e', _Out, In, Maps}}) -> + lookup_scc(SCC, In, Maps); get_required_by(SCC, #callgraph{active_digraph = {'d', DG}}) -> digraph:in_neighbours(DG, SCC). +lookup_scc(SCC, Table, Maps) -> + case ets_lookup_dict({'scc', SCC}, Maps) of + {ok, SCCInt} -> + case ets_lookup_dict(SCCInt, Table) of + {ok, Ints} -> + [ets:lookup_element(Maps, Int, 2) || Int <- Ints]; + error -> + [] + end; + error -> [] + end. + %%---------------------------------------------------------------------- %% Handling of modules & SCCs %%---------------------------------------------------------------------- @@ -575,9 +585,10 @@ digraph_delete(DG) -> active_digraph_delete({'d', DG}) -> digraph:delete(DG); -active_digraph_delete({'e', Out, In}) -> +active_digraph_delete({'e', Out, In, Maps}) -> ets:delete(Out), - ets:delete(In). + ets:delete(In), + ets:delete(Maps). digraph_edges(DG) -> digraph:edges(DG). @@ -751,37 +762,28 @@ to_ps(#callgraph{} = CG, File, Args) -> ok. condensation(G) -> - SCs = digraph_utils:strong_components(G), - V2I = ets:new(condensation_v2i, []), - I2C = ets:new(condensation_i2c, []), - I2I = ets:new(condensation_i2i, [bag]), - CFun = - fun(SC, N) -> - lists:foreach(fun(V) -> true = ets:insert(V2I, {V,N}) end, SC), - true = ets:insert(I2C, {N, SC}), - N + 1 - end, - lists:foldl(CFun, 1, SCs), - Fun1 = - fun({V1, V2}) -> - I1 = ets:lookup_element(V2I, V1, 2), - I2 = ets:lookup_element(V2I, V2, 2), - I1 =:= I2 orelse ets:insert(I2I, {I1, I2}) - end, - lists:foreach(Fun1, digraph:edges(G)), - Fun3 = - fun({I1, I2}, {Out, In}) -> - SC1 = ets:lookup_element(I2C, I1, 2), - SC2 = ets:lookup_element(I2C, I2, 2), - {dict:append(SC1, SC2, Out), dict:append(SC2, SC1, In)} - end, - {OutDict, InDict} = ets:foldl(Fun3, {dict:new(), dict:new()}, I2I), - [OutETS, InETS] = + SCCs = digraph_utils:strong_components(G), + %% Assign unique numbers to SCCs: + Ints = lists:seq(1, length(SCCs)), + IntToSCC = lists:zip(Ints, SCCs), + IntScc = sofs:relation(IntToSCC, [{int, scc}]), + %% Subsitute strong components for vertices in edges using the + %% unique numbers: + C2V = sofs:relation([{SC, V} || SC <- SCCs, V <- SC], [{scc, v}]), + I2V = sofs:relative_product(IntScc, C2V), % [{v, int}] + Es = sofs:relation(digraph:edges(G), [{v, v}]), + R1 = sofs:relative_product(I2V, Es), + R2 = sofs:relative_product(I2V, sofs:converse(R1)), + %% Create in- and out-neighbours: + In = sofs:relation_to_family(sofs:strict_relation(R2)), + R3 = sofs:converse(R2), + Out = sofs:relation_to_family(sofs:strict_relation(R3)), + [OutETS, InETS, MapsETS] = [ets:new(Name,[{read_concurrency, true}]) || - Name <- [callgraph_deps_out, callgraph_deps_in]], - ets:insert(OutETS, dict:to_list(OutDict)), - ets:insert(InETS, dict:to_list(InDict)), - ets:delete(V2I), - ets:delete(I2C), - ets:delete(I2I), - {{'e', OutETS, InETS}, SCs}. + Name <- [callgraph_deps_out, callgraph_deps_in, callgraph_scc_map]], + ets:insert(OutETS, sofs:to_external(Out)), + ets:insert(InETS, sofs:to_external(In)), + %% Create mappings from SCCs to unique integers, and the inverse: + ets:insert(MapsETS, lists:zip([{'scc', SCC} || SCC<- SCCs], Ints)), + ets:insert(MapsETS, IntToSCC), + {{'e', OutETS, InETS, MapsETS}, SCCs}. diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index b43711446b..158ee761af 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -630,8 +630,8 @@ cl_loop(State, LogCache) -> {BackendPid, warnings, Warnings} -> NewState = store_warnings(State, Warnings), cl_loop(NewState, LogCache); - {BackendPid, done, NewPlt, _NewDocPlt} -> - return_value(State, NewPlt); + {BackendPid, done, NewMiniPlt, _NewDocPlt} -> + return_value(State, NewMiniPlt); {BackendPid, ext_calls, ExtCalls} -> cl_loop(State#cl_state{external_calls = ExtCalls}, LogCache); {BackendPid, ext_types, ExtTypes} -> @@ -647,6 +647,7 @@ cl_loop(State, LogCache) -> cl_error(State, Msg); _Other -> %% io:format("Received ~p\n", [_Other]), + %% Note: {BackendPid, cserver, CodeServer, Plt} is ignored. cl_loop(State, LogCache) end. @@ -692,10 +693,13 @@ return_value(State = #cl_state{erlang_mode = ErlangMode, output_plt = OutputPlt, plt_info = PltInfo, stored_warnings = StoredWarnings}, - Plt) -> + MiniPlt) -> case OutputPlt =:= none of - true -> ok; - false -> dialyzer_plt:to_file(OutputPlt, Plt, ModDeps, PltInfo) + true -> + dialyzer_plt:delete(MiniPlt); + false -> + Plt = dialyzer_plt:restore_full_plt(MiniPlt), + dialyzer_plt:to_file(OutputPlt, Plt, ModDeps, PltInfo) end, UnknownWarnings = unknown_warnings(State), RetValue = diff --git a/lib/dialyzer/src/dialyzer_codeserver.erl b/lib/dialyzer/src/dialyzer_codeserver.erl index dd383ea828..f53c713bfe 100644 --- a/lib/dialyzer/src/dialyzer_codeserver.erl +++ b/lib/dialyzer/src/dialyzer_codeserver.erl @@ -22,7 +22,9 @@ -module(dialyzer_codeserver). -export([delete/1, - finalize_contracts/3, + store_temp_contracts/4, + give_away/2, + finalize_contracts/1, finalize_exported_types/2, finalize_records/2, get_contracts/1, @@ -31,7 +33,9 @@ get_exports/1, get_records/1, get_next_core_label/1, - get_temp_contracts/1, + get_temp_contracts/2, + contracts_modules/1, + store_contracts/4, get_temp_exported_types/1, get_temp_records/1, insert/3, @@ -41,6 +45,7 @@ is_exported/2, lookup_mod_code/2, lookup_mfa_code/2, + lookup_mfa_var_label/2, lookup_mod_records/2, lookup_mod_contracts/2, lookup_mfa_contract/2, @@ -49,21 +54,22 @@ set_next_core_label/2, set_temp_records/2, store_temp_records/3, - store_temp_contracts/4]). + translate_fake_file/3]). --export_type([codeserver/0, fun_meta_info/0]). +-export_type([codeserver/0, fun_meta_info/0, contracts/0]). -include("dialyzer.hrl"). %%-------------------------------------------------------------------- -type dict_ets() :: ets:tid(). +-type map_ets() :: ets:tid(). -type set_ets() :: ets:tid(). -type types() :: erl_types:type_table(). --type mod_records() :: dict:dict(module(), types()). +-type mod_records() :: erl_types:mod_records(). --type contracts() :: dict:dict(mfa(),dialyzer_contracts:file_contract()). +-type contracts() :: #{mfa() => dialyzer_contracts:file_contract()}. -type mod_contracts() :: dict:dict(module(), contracts()). %% A property-list of data compiled from -compile and -dialyzer attributes. @@ -74,16 +80,16 @@ -record(codeserver, {next_core_label = 0 :: label(), code :: dict_ets(), - exported_types :: set_ets() | 'undefined', % set(mfa()) - records :: dict_ets() | 'undefined', - contracts :: dict_ets() | 'undefined', - callbacks :: dict_ets() | 'undefined', + exported_types :: set_ets(), % set(mfa()) + records :: map_ets(), + contracts :: map_ets(), + callbacks :: map_ets(), fun_meta_info :: dict_ets(), % {mfa(), meta_info()} exports :: 'clean' | set_ets(), % set(mfa()) temp_exported_types :: 'clean' | set_ets(), % set(mfa()) - temp_records :: 'clean' | dict_ets(), - temp_contracts :: 'clean' | dict_ets(), - temp_callbacks :: 'clean' | dict_ets() + temp_records :: 'clean' | map_ets(), + temp_contracts :: 'clean' | map_ets(), + temp_callbacks :: 'clean' | map_ets() }). -opaque codeserver() :: #codeserver{}. @@ -97,7 +103,7 @@ ets_dict_find(Key, Table) -> _:_ -> error end. -ets_dict_store(Key, Element, Table) -> +ets_map_store(Key, Element, Table) -> true = ets:insert(Table, {Key, Element}), Table. @@ -121,9 +127,6 @@ ets_set_to_set(Table) -> Fold = fun({E}, Set) -> sets:add_element(E, Set) end, ets:foldl(Fold, sets:new(), Table). -ets_read_concurrent_table(Name) -> - ets:new(Name, [{read_concurrency, true}]). - %%-------------------------------------------------------------------- -spec new() -> codeserver(). @@ -131,6 +134,13 @@ ets_read_concurrent_table(Name) -> new() -> CodeOptions = [compressed, public, {read_concurrency, true}], Code = ets:new(dialyzer_codeserver_code, CodeOptions), + ReadOptions = [compressed, {read_concurrency, true}], + [Contracts, Callbacks, Records, ExportedTypes] = + [ets:new(Name, ReadOptions) || + Name <- [dialyzer_codeserver_contracts, + dialyzer_codeserver_callbacks, + dialyzer_codeserver_records, + dialyzer_codeserver_exported_types]], TempOptions = [public, {write_concurrency, true}], [Exports, FunMetaInfo, TempExportedTypes, TempRecords, TempContracts, TempCallbacks] = @@ -143,6 +153,10 @@ new() -> #codeserver{code = Code, exports = Exports, fun_meta_info = FunMetaInfo, + exported_types = ExportedTypes, + records = Records, + contracts = Contracts, + callbacks = Callbacks, temp_exported_types = TempExportedTypes, temp_records = TempRecords, temp_contracts = TempContracts, @@ -163,13 +177,15 @@ insert(Mod, ModCode, CS) -> Exports = cerl:module_exports(ModCode), Attrs = cerl:module_attrs(ModCode), Defs = cerl:module_defs(ModCode), + {Files, SmallDefs} = compress_file_anno(Defs), As = cerl:get_ann(ModCode), Funs = [{{Mod, cerl:fname_id(Var), cerl:fname_arity(Var)}, - Val} || Val = {Var, _Fun} <- Defs], - Keys = [Key || {Key, _Value} <- Funs], + Val, {Var, cerl_trees:get_label(Fun)}} || Val = {Var, Fun} <- SmallDefs], + Keys = [Key || {Key, _Value, _Label} <- Funs], ModEntry = {Mod, {Name, Exports, Attrs, Keys, As}}, - true = ets:insert(CS#codeserver.code, [ModEntry|Funs]), + ModFileEntry = {{mod, Mod}, Files}, + true = ets:insert(CS#codeserver.code, [ModEntry, ModFileEntry|Funs]), CS. -spec get_temp_exported_types(codeserver()) -> sets:set(mfa()). @@ -213,12 +229,12 @@ get_exports(#codeserver{exports = Exports}) -> -spec finalize_exported_types(sets:set(mfa()), codeserver()) -> codeserver(). -finalize_exported_types(Set, CS) -> - ExportedTypes = ets_read_concurrent_table(dialyzer_codeserver_exported_types), +finalize_exported_types(Set, + #codeserver{exported_types = ExportedTypes, + temp_exported_types = TempETypes} = CS) -> true = ets_set_insert_set(Set, ExportedTypes), - TempExpTypes = CS#codeserver.temp_exported_types, - true = ets:delete(TempExpTypes), - CS#codeserver{exported_types = ExportedTypes, temp_exported_types = clean}. + true = ets:delete(TempETypes), + CS#codeserver{temp_exported_types = clean}. -spec lookup_mod_code(atom(), codeserver()) -> cerl:c_module(). @@ -230,6 +246,11 @@ lookup_mod_code(Mod, CS) when is_atom(Mod) -> lookup_mfa_code({_M, _F, _A} = MFA, CS) -> table__lookup(CS#codeserver.code, MFA). +-spec lookup_mfa_var_label(mfa(), codeserver()) -> {cerl:c_var(), label()}. + +lookup_mfa_var_label({_M, _F, _A} = MFA, CS) -> + ets:lookup_element(CS#codeserver.code, MFA, 3). + -spec get_next_core_label(codeserver()) -> label(). get_next_core_label(#codeserver{next_core_label = NCL}) -> @@ -244,8 +265,8 @@ set_next_core_label(NCL, CS) -> lookup_mod_records(Mod, #codeserver{records = RecDict}) when is_atom(Mod) -> case ets_dict_find(Mod, RecDict) of - error -> dict:new(); - {ok, Dict} -> Dict + error -> maps:new(); + {ok, Map} -> Map end. -spec get_records(codeserver()) -> mod_records(). @@ -255,11 +276,11 @@ get_records(#codeserver{records = RecDict}) -> -spec store_temp_records(module(), types(), codeserver()) -> codeserver(). -store_temp_records(Mod, Dict, #codeserver{temp_records = TempRecDict} = CS) +store_temp_records(Mod, Map, #codeserver{temp_records = TempRecDict} = CS) when is_atom(Mod) -> - case dict:size(Dict) =:= 0 of + case maps:size(Map) =:= 0 of true -> CS; - false -> CS#codeserver{temp_records = ets_dict_store(Mod, Dict, TempRecDict)} + false -> CS#codeserver{temp_records = ets_map_store(Mod, Map, TempRecDict)} end. -spec get_temp_records(codeserver()) -> mod_records(). @@ -277,20 +298,20 @@ set_temp_records(Dict, CS) -> -spec finalize_records(mod_records(), codeserver()) -> codeserver(). -finalize_records(Dict, CS) -> - true = ets:delete(CS#codeserver.temp_records), - Records = ets_read_concurrent_table(dialyzer_codeserver_records), +finalize_records(Dict, #codeserver{temp_records = TmpRecords, + records = Records} = CS) -> + true = ets:delete(TmpRecords), true = ets_dict_store_dict(Dict, Records), - CS#codeserver{records = Records, temp_records = clean}. + CS#codeserver{temp_records = clean}. -spec lookup_mod_contracts(atom(), codeserver()) -> contracts(). lookup_mod_contracts(Mod, #codeserver{contracts = ContDict}) when is_atom(Mod) -> case ets_dict_find(Mod, ContDict) of - error -> dict:new(); + error -> maps:new(); {ok, Keys} -> - dict:from_list([get_file_contract(Key, ContDict)|| Key <- Keys]) + maps:from_list([get_file_contract(Key, ContDict)|| Key <- Keys]) end. get_file_contract(Key, ContDict) -> @@ -323,48 +344,69 @@ get_callbacks(#codeserver{callbacks = CallbDict}) -> -spec store_temp_contracts(module(), contracts(), contracts(), codeserver()) -> codeserver(). -store_temp_contracts(Mod, SpecDict, CallbackDict, +store_temp_contracts(Mod, SpecMap, CallbackMap, #codeserver{temp_contracts = Cn, temp_callbacks = Cb} = CS) when is_atom(Mod) -> - CS1 = - case dict:size(SpecDict) =:= 0 of - true -> CS; - false -> - CS#codeserver{temp_contracts = ets_dict_store(Mod, SpecDict, Cn)} - end, - case dict:size(CallbackDict) =:= 0 of - true -> CS1; - false -> - CS1#codeserver{temp_callbacks = ets_dict_store(Mod, CallbackDict, Cb)} - end. - --spec get_temp_contracts(codeserver()) -> {mod_contracts(), mod_contracts()}. + CS1 = CS#codeserver{temp_contracts = ets_map_store(Mod, SpecMap, Cn)}, + CS1#codeserver{temp_callbacks = ets_map_store(Mod, CallbackMap, Cb)}. -get_temp_contracts(#codeserver{temp_contracts = TempContDict, - temp_callbacks = TempCallDict}) -> - {ets_dict_to_dict(TempContDict), ets_dict_to_dict(TempCallDict)}. +-spec contracts_modules(codeserver()) -> [module()]. --spec finalize_contracts(mod_contracts(), mod_contracts(), codeserver()) -> - codeserver(). +contracts_modules(#codeserver{temp_contracts = TempContTable}) -> + ets:select(TempContTable, [{{'$1', '$2'}, [], ['$1']}]). -finalize_contracts(SpecDict, CallbackDict, CS) -> - Contracts = ets_read_concurrent_table(dialyzer_codeserver_contracts), - Callbacks = ets_read_concurrent_table(dialyzer_codeserver_callbacks), - Contracts = dict:fold(fun decompose_spec_dict/3, Contracts, SpecDict), - Callbacks = dict:fold(fun decompose_cb_dict/3, Callbacks, CallbackDict), - CS#codeserver{contracts = Contracts, callbacks = Callbacks, - temp_contracts = clean, temp_callbacks = clean}. +-spec store_contracts(module(), contracts(), contracts(), codeserver()) -> + codeserver(). -decompose_spec_dict(Mod, Dict, Table) -> - Keys = dict:fetch_keys(Dict), - true = ets:insert(Table, dict:to_list(Dict)), - true = ets:insert(Table, {Mod, Keys}), - Table. +store_contracts(Mod, SpecMap, CallbackMap, CS) -> + #codeserver{contracts = SpecDict, callbacks = CallbackDict} = CS, + Keys = maps:keys(SpecMap), + true = ets:insert(SpecDict, maps:to_list(SpecMap)), + true = ets:insert(SpecDict, {Mod, Keys}), + true = ets:insert(CallbackDict, maps:to_list(CallbackMap)), + CS. -decompose_cb_dict(_Mod, Dict, Table) -> - true = ets:insert(Table, dict:to_list(Dict)), - Table. +-spec get_temp_contracts(module(), codeserver()) -> + {contracts(), contracts()}. + +get_temp_contracts(Mod, #codeserver{temp_contracts = TempContDict, + temp_callbacks = TempCallDict}) -> + [{Mod, Contracts}] = ets:lookup(TempContDict, Mod), + true = ets:delete(TempContDict, Mod), + [{Mod, Callbacks}] = ets:lookup(TempCallDict, Mod), + true = ets:delete(TempCallDict, Mod), + {Contracts, Callbacks}. + +-spec give_away(codeserver(), pid()) -> 'ok'. + +give_away(#codeserver{temp_records = TempRecords, + temp_contracts = TempContracts, + temp_callbacks = TempCallbacks, + records = Records, + contracts = Contracts, + callbacks = Callbacks}, Pid) -> + _ = [true = ets:give_away(Table, Pid, any) || + Table <- [TempRecords, TempContracts, TempCallbacks, + Records, Contracts, Callbacks], + Table =/= clean], + ok. + +-spec finalize_contracts(codeserver()) -> codeserver(). + +finalize_contracts(#codeserver{temp_contracts = TempContDict, + temp_callbacks = TempCallDict} = CS) -> + true = ets:delete(TempContDict), + true = ets:delete(TempCallDict), + CS#codeserver{temp_contracts = clean, temp_callbacks = clean}. + +-spec translate_fake_file(codeserver(), module(), file:filename()) -> + file:filename(). + +translate_fake_file(#codeserver{code = Code}, Module, FakeFile) -> + Files = ets:lookup_element(Code, {mod, Module}, 2), + {FakeFile, File} = lists:keyfind(FakeFile, 1, Files), + File. table__lookup(TablePid, M) when is_atom(M) -> {Name, Exports, Attrs, Keys, As} = ets:lookup_element(TablePid, M, 2), @@ -372,3 +414,25 @@ table__lookup(TablePid, M) when is_atom(M) -> cerl:ann_c_module(As, Name, Exports, Attrs, Defs); table__lookup(TablePid, MFA) -> ets:lookup_element(TablePid, MFA, 2). + +compress_file_anno(Term) -> + {Files, SmallTerm} = compress_file_anno(Term, []), + {[{FakeFile, File} || {File, {file, FakeFile}} <- Files], SmallTerm}. + +compress_file_anno({file, F}, Fs) when is_list(F) -> + case lists:keyfind(F, 1, Fs) of + false -> + I = integer_to_list(length(Fs)), + FileI = {file, I}, + NFs = [{F, FileI}|Fs], + {NFs, FileI}; + {F, FileI} -> {Fs, FileI} + end; +compress_file_anno(T, Fs) when is_tuple(T) -> + {NFs, NL} = compress_file_anno(tuple_to_list(T), Fs), + {NFs, list_to_tuple(NL)}; +compress_file_anno([E|L], Fs) -> + {Fs1, NE} = compress_file_anno(E, Fs), + {NFs, NL} = compress_file_anno(L, Fs1), + {NFs, [NE|NL]}; +compress_file_anno(T, Fs) -> {Fs, T}. diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 7cc4a9d3eb..2078e58ce8 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -24,7 +24,7 @@ get_contract_return/2, %% get_contract_signature/1, is_overloaded/1, - process_contract_remote_types/1, + process_contract_remote_types/2, store_tmp_contract/5]). -export_type([file_contract/0, plt_contracts/0]). @@ -139,14 +139,13 @@ sequence([], _Delimiter) -> ""; sequence([H], _Delimiter) -> H; sequence([H|T], Delimiter) -> H ++ Delimiter ++ sequence(T, Delimiter). --spec process_contract_remote_types(dialyzer_codeserver:codeserver()) -> - dialyzer_codeserver:codeserver(). +-spec process_contract_remote_types(dialyzer_codeserver:codeserver(), + erl_types:mod_records()) -> + dialyzer_codeserver:codeserver(). -process_contract_remote_types(CodeServer) -> - {TmpContractDict, TmpCallbackDict} = - dialyzer_codeserver:get_temp_contracts(CodeServer), +process_contract_remote_types(CodeServer, RecordDict) -> + Mods = dialyzer_codeserver:contracts_modules(CodeServer), ExpTypes = dialyzer_codeserver:get_exported_types(CodeServer), - RecordDict = dialyzer_codeserver:get_records(CodeServer), ContractFun = fun({{_M, _F, _A}=MFA, {File, TmpContract, Xtra}}, C0) -> #tmp_contract{contract_funs = CFuns, forms = Forms} = TmpContract, @@ -158,20 +157,21 @@ process_contract_remote_types(CodeServer) -> {{MFA, {File, Contract, Xtra}}, C2} end, ModuleFun = - fun({ModuleName, ContractDict}, C3) -> - {NewContractList, C4} = - lists:mapfoldl(ContractFun, C3, dict:to_list(ContractDict)), - {{ModuleName, dict:from_list(NewContractList)}, C4} + fun(ModuleName) -> + Cache = erl_types:cache__new(), + {ContractMap, CallbackMap} = + dialyzer_codeserver:get_temp_contracts(ModuleName, CodeServer), + {NewContractList, Cache1} = + lists:mapfoldl(ContractFun, Cache, maps:to_list(ContractMap)), + {NewCallbackList, _NewCache} = + lists:mapfoldl(ContractFun, Cache1, maps:to_list(CallbackMap)), + dialyzer_codeserver:store_contracts(ModuleName, + maps:from_list(NewContractList), + maps:from_list(NewCallbackList), + CodeServer) end, - Cache = erl_types:cache__new(), - {NewContractList, C5} = - lists:mapfoldl(ModuleFun, Cache, dict:to_list(TmpContractDict)), - {NewCallbackList, _C6} = - lists:mapfoldl(ModuleFun, C5, dict:to_list(TmpCallbackDict)), - NewContractDict = dict:from_list(NewContractList), - NewCallbackDict = dict:from_list(NewCallbackList), - dialyzer_codeserver:finalize_contracts(NewContractDict, NewCallbackDict, - CodeServer). + lists:foreach(ModuleFun, Mods), + dialyzer_codeserver:finalize_contracts(CodeServer). -type opaques_fun() :: fun((module()) -> [erl_types:erl_type()]). @@ -390,7 +390,7 @@ solve_constraints(Contract, Call, Constraints) -> %% ?debug("Inf: ~s\n", [erl_types:t_to_string(Inf)]), %% erl_types:t_assign_variables_to_subtype(Contract, Inf). --type contracts() :: dict:dict(mfa(),dialyzer_contracts:file_contract()). +-type contracts() :: dialyzer_codeserver:contracts(). %% Checks the contracts for functions that are not implemented -spec contracts_without_fun(contracts(), [_], dialyzer_callgraph:callgraph()) -> @@ -400,12 +400,12 @@ contracts_without_fun(Contracts, AllFuns0, Callgraph) -> AllFuns1 = [{dialyzer_callgraph:lookup_name(Label, Callgraph), Arity} || {Label, Arity} <- AllFuns0], AllFuns2 = [{M, F, A} || {{ok, {M, F, _}}, A} <- AllFuns1], - AllContractMFAs = dict:fetch_keys(Contracts), + AllContractMFAs = maps:keys(Contracts), ErrorContractMFAs = AllContractMFAs -- AllFuns2, [warn_spec_missing_fun(MFA, Contracts) || MFA <- ErrorContractMFAs]. warn_spec_missing_fun({M, F, A} = MFA, Contracts) -> - {{File, Line}, _Contract, _Xtra} = dict:fetch(MFA, Contracts), + {{File, Line}, _Contract, _Xtra} = maps:get(MFA, Contracts), WarningInfo = {File, Line, MFA}, {?WARN_CONTRACT_SYNTAX, WarningInfo, {spec_missing_fun, [M, F, A]}}. @@ -438,11 +438,11 @@ insert_constraints([], Map) -> Map. -spec store_tmp_contract(mfa(), file_line(), spec_data(), contracts(), types()) -> contracts(). -store_tmp_contract(MFA, FileLine, {TypeSpec, Xtra}, SpecDict, RecordsDict) -> +store_tmp_contract(MFA, FileLine, {TypeSpec, Xtra}, SpecMap, RecordsDict) -> %% io:format("contract from form: ~p\n", [TypeSpec]), TmpContract = contract_from_form(TypeSpec, MFA, RecordsDict, FileLine), %% io:format("contract: ~p\n", [TmpContract]), - dict:store(MFA, {FileLine, TmpContract, Xtra}, SpecDict). + maps:put(MFA, {FileLine, TmpContract, Xtra}, SpecMap). contract_from_form(Forms, MFA, RecDict, FileLine) -> {CFuns, Forms1} = contract_from_form(Forms, MFA, RecDict, FileLine, [], []), @@ -670,7 +670,7 @@ get_invalid_contract_warnings(Modules, CodeServer, Plt, FindOpaques) -> get_invalid_contract_warnings_modules([Mod|Mods], CodeServer, Plt, FindOpaques, Acc) -> Contracts1 = dialyzer_codeserver:lookup_mod_contracts(Mod, CodeServer), - Contracts2 = dict:to_list(Contracts1), + Contracts2 = maps:to_list(Contracts1), Records = dialyzer_codeserver:lookup_mod_records(Mod, CodeServer), NewAcc = get_invalid_contract_warnings_funs(Contracts2, Plt, Records, FindOpaques, Acc), get_invalid_contract_warnings_modules(Mods, CodeServer, Plt, FindOpaques, NewAcc); diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index fdcf8269e4..f706ebfb02 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -522,7 +522,7 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], case is_race_analysis_enabled(State) of true -> Ann = cerl:get_ann(Tree), - File = get_file(Ann), + File = get_file(Ann, State), Line = abs(get_line(Ann)), dialyzer_races:store_race_call(Fun, ArgTypes, Args, {File, Line}, State); @@ -3083,7 +3083,7 @@ state__add_warning(#state{warnings = Warnings, warning_mode = true} = State, Ann = cerl:get_ann(Tree), case Force of true -> - WarningInfo = {get_file(Ann), + WarningInfo = {get_file(Ann, State), abs(get_line(Ann)), State#state.curr_fun}, Warn = {Tag, WarningInfo, Msg}, @@ -3093,7 +3093,9 @@ state__add_warning(#state{warnings = Warnings, warning_mode = true} = State, case is_compiler_generated(Ann) of true -> State; false -> - WarningInfo = {get_file(Ann), get_line(Ann), State#state.curr_fun}, + WarningInfo = {get_file(Ann, State), + get_line(Ann), + State#state.curr_fun}, Warn = {Tag, WarningInfo, Msg}, case Tag of ?WARN_CONTRACT_RANGE -> ok; @@ -3492,6 +3494,12 @@ state__put_races(Races, State) -> state__records_only(#state{records = Records}) -> #state{records = Records}. +-spec state__translate_file(file:filename(), state()) -> file:filename(). + +state__translate_file(FakeFile, State) -> + #state{codeserver = CodeServer, module = Module} = State, + dialyzer_codeserver:translate_fake_file(CodeServer, Module, FakeFile). + %%% =========================================================================== %%% %%% Races @@ -3563,9 +3571,11 @@ get_line([Line|_]) when is_integer(Line) -> Line; get_line([_|Tail]) -> get_line(Tail); get_line([]) -> -1. -get_file([]) -> []; -get_file([{file, File}|_]) -> File; -get_file([_|Tail]) -> get_file(Tail). +get_file([], _State) -> []; +get_file([{file, FakeFile}|_], State) -> + state__translate_file(FakeFile, State); +get_file([_|Tail], State) -> + get_file(Tail, State). is_compiler_generated(Ann) -> lists:member(compiler_generated, Ann) orelse (get_line(Ann) < 1). diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl index 91f7fbe467..d1b955044b 100644 --- a/lib/dialyzer/src/dialyzer_gui_wx.erl +++ b/lib/dialyzer/src/dialyzer_gui_wx.erl @@ -498,8 +498,9 @@ gui_loop(#gui_state{backend_pid = BackendPid, doc_plt = DocPlt, end, ExplanationPid = spawn_link(Fun), gui_loop(State#gui_state{expl_pid = ExplanationPid}); - {BackendPid, done, _NewPlt, NewDocPlt} -> + {BackendPid, done, NewMiniPlt, NewDocPlt} -> message(State, "Analysis done"), + dialyzer_plt:delete(NewMiniPlt), config_gui_stop(State), gui_loop(State#gui_state{doc_plt = NewDocPlt}); {'EXIT', BackendPid, {error, Reason}} -> diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl index 64b10af1ba..37c22fef48 100644 --- a/lib/dialyzer/src/dialyzer_plt.erl +++ b/lib/dialyzer/src/dialyzer_plt.erl @@ -51,7 +51,9 @@ get_specs/4, to_file/4, get_mini_plt/1, - restore_full_plt/2 + restore_full_plt/1, + delete/1, + give_away/2 ]). %% Debug utilities @@ -75,14 +77,16 @@ %%---------------------------------------------------------------------- -record(plt, {info = table_new() :: dict:dict(), - types = table_new() :: dict:dict(), + types = table_new() :: erl_types:mod_records(), contracts = table_new() :: dict:dict(), callbacks = table_new() :: dict:dict(), exported_types = sets:new() :: sets:set()}). -record(mini_plt, {info :: ets:tid(), + types :: ets:tid(), contracts :: ets:tid(), - callbacks :: ets:tid() + callbacks :: ets:tid(), + exported_types :: ets:tid() }). -opaque plt() :: #plt{} | #mini_plt{}. @@ -123,6 +127,10 @@ delete_module(#plt{info = Info, types = Types, -spec delete_list(plt(), [mfa() | integer()]) -> plt(). +delete_list(#mini_plt{info = Info, + contracts = Contracts}=Plt, List) -> + Plt#mini_plt{info = ets_table_delete_list(Info, List), + contracts = ets_table_delete_list(Contracts, List)}; delete_list(#plt{info = Info, types = Types, contracts = Contracts, callbacks = Callbacks, @@ -176,7 +184,7 @@ lookup(Plt, Label) when is_integer(Label) -> lookup_1(#mini_plt{info = Info}, MFAorLabel) -> ets_table_lookup(Info, MFAorLabel). --spec insert_types(plt(), dict:dict()) -> plt(). +-spec insert_types(plt(), erl_types:mod_records()) -> plt(). insert_types(PLT, Rec) -> PLT#plt{types = Rec}. @@ -186,7 +194,7 @@ insert_types(PLT, Rec) -> insert_exported_types(PLT, Set) -> PLT#plt{exported_types = Set}. --spec get_types(plt()) -> dict:dict(). +-spec get_types(plt()) -> erl_types:mod_records(). get_types(#plt{types = Types}) -> Types. @@ -246,8 +254,10 @@ from_file(FileName, ReturnInfo) -> Msg = io_lib:format("Old PLT file ~s\n", [FileName]), plt_error(Msg); ok -> + Types = [{Mod, maps:from_list(dict:to_list(Types))} || + {Mod, Types} <- dict:to_list(Rec#file_plt.types)], Plt = #plt{info = Rec#file_plt.info, - types = Rec#file_plt.types, + types = dict:from_list(Types), contracts = Rec#file_plt.contracts, callbacks = Rec#file_plt.callbacks, exported_types = Rec#file_plt.exported_types}, @@ -364,12 +374,14 @@ to_file(FileName, end, OldModDeps, ModDeps), ImplMd5 = compute_implementation_md5(), + FileTypes = dict:from_list([{Mod, dict:from_list(maps:to_list(MTypes))} || + {Mod, MTypes} <- dict:to_list(Types)]), Record = #file_plt{version = ?VSN, file_md5_list = MD5, info = Info, contracts = Contracts, callbacks = Callbacks, - types = Types, + types = FileTypes, exported_types = ExpTypes, mod_deps = NewModDeps, implementation_md5 = ImplMd5}, @@ -503,32 +515,100 @@ init_md5_list_1(Md5List, [], Acc) -> -spec get_mini_plt(plt()) -> plt(). -get_mini_plt(#plt{info = Info, contracts = Contracts, callbacks = Callbacks}) -> - [ETSInfo, ETSContracts, ETSCallbacks] = - [ets:new(Name, [public]) || Name <- [plt_info, plt_contracts, plt_callbacks]], +get_mini_plt(#plt{info = Info, + types = Types, + contracts = Contracts, + callbacks = Callbacks, + exported_types = ExpTypes}) -> + [ETSInfo, ETSTypes, ETSContracts, ETSCallbacks, ETSExpTypes] = + [ets:new(Name, [public]) || + Name <- [plt_info, plt_types, plt_contracts, plt_callbacks, + plt_exported_types]], CallbackList = dict:to_list(Callbacks), CallbacksByModule = [{M, [Cb || {{M1,_,_},_} = Cb <- CallbackList, M1 =:= M]} || M <- lists:usort([M || {{M,_,_},_} <- CallbackList])], - [true, true] = + [true, true, true] = [ets:insert(ETS, dict:to_list(Data)) || - {ETS, Data} <- [{ETSInfo, Info}, {ETSContracts, Contracts}]], + {ETS, Data} <- [{ETSInfo, Info}, + {ETSTypes, Types}, + {ETSContracts, Contracts}]], true = ets:insert(ETSCallbacks, CallbacksByModule), - #mini_plt{info = ETSInfo, contracts = ETSContracts, callbacks = ETSCallbacks}; + true = ets:insert(ETSExpTypes, [{ET} || ET <- sets:to_list(ExpTypes)]), + #mini_plt{info = ETSInfo, + types = ETSTypes, + contracts = ETSContracts, + callbacks = ETSCallbacks, + exported_types = ETSExpTypes}; get_mini_plt(undefined) -> undefined. --spec restore_full_plt(plt(), plt()) -> plt(). - -restore_full_plt(#mini_plt{info = ETSInfo, contracts = ETSContracts}, Plt) -> - Info = dict:from_list(ets:tab2list(ETSInfo)), - Contracts = dict:from_list(ets:tab2list(ETSContracts)), - ets:delete(ETSContracts), - ets:delete(ETSInfo), - Plt#plt{info = Info, contracts = Contracts}; -restore_full_plt(undefined, undefined) -> +-spec restore_full_plt(plt()) -> plt(). + +restore_full_plt(#mini_plt{info = ETSInfo, + types = ETSTypes, + contracts = ETSContracts, + callbacks = ETSCallbacks, + exported_types = ETSExpTypes} = MiniPlt) -> + Info = dict:from_list(tab2list(ETSInfo)), + Contracts = dict:from_list(tab2list(ETSContracts)), + Types = dict:from_list(tab2list(ETSTypes)), + Callbacks = + dict:from_list([Cb || {_M, Cbs} <- tab2list(ETSCallbacks), Cb <- Cbs]), + ExpTypes = sets:from_list([E || {E} <- tab2list(ETSExpTypes)]), + ok = delete(MiniPlt), + #plt{info = Info, + types = Types, + contracts = Contracts, + callbacks = Callbacks, + exported_types = ExpTypes}; +restore_full_plt(undefined) -> undefined. +-spec delete(plt()) -> 'ok'. + +delete(#mini_plt{info = ETSInfo, + types = ETSTypes, + contracts = ETSContracts, + callbacks = ETSCallbacks, + exported_types = ETSExpTypes}) -> + true = ets:delete(ETSContracts), + true = ets:delete(ETSTypes), + true = ets:delete(ETSInfo), + true = ets:delete(ETSCallbacks), + true = ets:delete(ETSExpTypes), + ok. + +-spec give_away(plt(), pid()) -> 'ok'. + +give_away(#mini_plt{info = ETSInfo, + types = ETSTypes, + contracts = ETSContracts, + callbacks = ETSCallbacks, + exported_types = ETSExpTypes}, + Pid) -> + true = ets:give_away(ETSContracts, Pid, any), + true = ets:give_away(ETSTypes, Pid, any), + true = ets:give_away(ETSInfo, Pid, any), + true = ets:give_away(ETSCallbacks, Pid, any), + true = ets:give_away(ETSExpTypes, Pid, any), + ok. + +%% Somewhat slower than ets:tab2list(), but uses less memory. +tab2list(T) -> + tab2list(ets:first(T), T, []). + +tab2list('$end_of_table', T, A) -> + case ets:first(T) of % no safe_fixtable()... + '$end_of_table' -> A; + Key -> tab2list(Key, T, A) + end; +tab2list(Key, T, A) -> + Vs = ets:lookup(T, Key), + Key1 = ets:next(T, Key), + ets:delete(T, Key), + tab2list(Key1, T, Vs ++ A). + %%--------------------------------------------------------------------------- %% Edoc @@ -600,6 +680,12 @@ table_delete_module1(Plt, Mod) -> table_delete_module2(Plt, Mod) -> dict:filter(fun(M, _Val) -> M =/= Mod end, Plt). +ets_table_delete_list(Tab, [H|T]) -> + ets:delete(Tab, H), + ets_table_delete_list(Tab, T); +ets_table_delete_list(Tab, []) -> + Tab. + table_delete_list(Plt, [H|T]) -> table_delete_list(dict:erase(H, Plt), T); table_delete_list(Plt, []) -> diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl index df12796dd4..3c90f46e95 100644 --- a/lib/dialyzer/src/dialyzer_succ_typings.erl +++ b/lib/dialyzer/src/dialyzer_succ_typings.erl @@ -89,7 +89,7 @@ analyze_callgraph(Callgraph, Plt, Codeserver, TimingServer, Solvers, Parent) -> NewState = init_state_and_get_success_typings(Callgraph, Plt, Codeserver, TimingServer, Solvers, Parent), - dialyzer_plt:restore_full_plt(NewState#st.plt, Plt). + NewState#st.plt. %%-------------------------------------------------------------------- @@ -104,6 +104,7 @@ init_state_and_get_success_typings(Callgraph, Plt, Codeserver, get_refined_success_typings(SCCs, #st{callgraph = Callgraph, timing_server = TimingServer} = State) -> + erlang:garbage_collect(), case find_succ_typings(SCCs, State) of {fixpoint, State1} -> State1; {not_fixpoint, NotFixpoint1, State1} -> @@ -148,8 +149,8 @@ get_warnings(Callgraph, Plt, DocPlt, Codeserver, ?timing(TimingServer, "warning", get_warnings_from_modules(Mods, InitState, MiniDocPlt)), {postprocess_warnings(CWarns ++ ModWarns, Codeserver), - dialyzer_plt:restore_full_plt(MiniPlt, Plt), - dialyzer_plt:restore_full_plt(MiniDocPlt, DocPlt)}. + MiniPlt, + dialyzer_plt:restore_full_plt(MiniDocPlt)}. get_warnings_from_modules(Mods, State, DocPlt) -> #st{callgraph = Callgraph, codeserver = Codeserver, @@ -167,10 +168,10 @@ collect_warnings(M, {Codeserver, Callgraph, Plt, DocPlt}) -> %% Check if there are contracts for functions that do not exist Warnings1 = dialyzer_contracts:contracts_without_fun(Contracts, AllFuns, Callgraph), + Attrs = cerl:module_attrs(ModCode), {Warnings2, FunTypes} = dialyzer_dataflow:get_warnings(ModCode, Plt, Callgraph, Codeserver, Records), - Attrs = cerl:module_attrs(ModCode), Warnings3 = dialyzer_behaviours:check_callbacks(M, Attrs, Records, Plt, Codeserver), DocPlt = insert_into_doc_plt(FunTypes, Callgraph, DocPlt), @@ -255,7 +256,7 @@ refine_one_module(M, {CodeServer, Callgraph, Plt, _Solvers}) -> NewFunTypes = dialyzer_dataflow:get_fun_types(ModCode, Plt, Callgraph, CodeServer, Records), Contracts1 = dialyzer_codeserver:lookup_mod_contracts(M, CodeServer), - Contracts = orddict:from_list(dict:to_list(Contracts1)), + Contracts = orddict:from_list(maps:to_list(Contracts1)), FindOpaques = find_opaques_fun(Records), DecoratedFunTypes = decorate_succ_typings(Contracts, Callgraph, NewFunTypes, FindOpaques), @@ -341,21 +342,25 @@ find_succ_typings(SCCs, #st{codeserver = Codeserver, callgraph = Callgraph, -spec find_succ_types_for_scc(scc(), typesig_init_data()) -> [mfa_or_funlbl()]. -find_succ_types_for_scc(SCC, {Codeserver, Callgraph, Plt, Solvers}) -> - SCC_Info = [{MFA, - dialyzer_codeserver:lookup_mfa_code(MFA, Codeserver), - dialyzer_codeserver:lookup_mod_records(M, Codeserver)} - || {M, _, _} = MFA <- SCC], +find_succ_types_for_scc(SCC0, {Codeserver, Callgraph, Plt, Solvers}) -> + SCC = [MFA || {_, _, _} = MFA <- SCC0], Contracts1 = [{MFA, dialyzer_codeserver:lookup_mfa_contract(MFA, Codeserver)} - || {_, _, _} = MFA <- SCC], + || MFA <- SCC], Contracts2 = [{MFA, Contract} || {MFA, {ok, Contract}} <- Contracts1], Contracts3 = orddict:from_list(Contracts2), Label = dialyzer_codeserver:get_next_core_label(Codeserver), - AllFuns = collect_fun_info([Fun || {_MFA, {_Var, Fun}, _Rec} <- SCC_Info]), + AllFuns = lists:append( + [begin + {_Var, Fun} = + dialyzer_codeserver:lookup_mfa_code(MFA, Codeserver), + collect_fun_info([Fun]) + end || MFA <- SCC]), + erlang:garbage_collect(), PropTypes = get_fun_types_from_plt(AllFuns, Callgraph, Plt), %% Assume that the PLT contains the current propagated types - FunTypes = dialyzer_typesig:analyze_scc(SCC_Info, Label, Callgraph, - Plt, PropTypes, Solvers), + FunTypes = dialyzer_typesig:analyze_scc(SCC, Label, Callgraph, + Codeserver, Plt, PropTypes, + Solvers), AllFunSet = sets:from_list([X || {X, _} <- AllFuns]), FilteredFunTypes = dict:filter(fun(X, _) -> sets:is_element(X, AllFunSet) end, FunTypes), diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 457db9df83..b33484bda4 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -22,7 +22,7 @@ -module(dialyzer_typesig). --export([analyze_scc/6]). +-export([analyze_scc/7]). -export([get_safe_underapprox/2]). %%-import(helper, %% 'helper' could be any module doing sanity checks... @@ -94,10 +94,9 @@ -type types() :: erl_types:type_table(). --type typesig_scc() :: [{mfa(), {cerl:c_var(), cerl:c_fun()}, types()}]. -type typesig_funmap() :: #{type_var() => type_var()}. --type prop_types() :: dict:dict(label(), types()). +-type prop_types() :: dict:dict(label(), erl_types:erl_type()). -record(state, {callgraph :: dialyzer_callgraph:callgraph() | 'undefined', @@ -114,7 +113,7 @@ plt :: dialyzer_plt:plt() | 'undefined', prop_types = dict:new() :: prop_types(), - records = dict:new() :: types(), + records = maps:new() :: types(), scc = [] :: ordsets:ordset(type_var()), mfas :: [mfa()], solvers = [] :: [solver()] @@ -153,11 +152,10 @@ %%----------------------------------------------------------------------------- %% Analysis of strongly connected components. %% -%% analyze_scc(SCC, NextLabel, CallGraph, PLT, PropTypes, Solvers) -> FunTypes +%% analyze_scc(SCC, NextLabel, CallGraph, CodeServer, +%% PLT, PropTypes, Solvers) -> FunTypes %% -%% SCC - [{MFA, Def, Records}] -%% where Def = {Var, Fun} as in the Core Erlang module definitions. -%% Records = dict(RecName, {Arity, [{FieldName, FieldType}]}) +%% SCC - [{MFA}] %% NextLabel - An integer that is higher than any label in the code. %% CallGraph - A callgraph as produced by dialyzer_callgraph.erl %% Note: The callgraph must have been built with all the @@ -169,28 +167,27 @@ %% Solvers - User specified solvers. %%----------------------------------------------------------------------------- --spec analyze_scc(typesig_scc(), label(), +-spec analyze_scc([mfa()], label(), dialyzer_callgraph:callgraph(), + dialyzer_codeserver:codeserver(), dialyzer_plt:plt(), prop_types(), [solver()]) -> prop_types(). -analyze_scc(SCC, NextLabel, CallGraph, Plt, PropTypes, Solvers0) -> +analyze_scc(SCC, NextLabel, CallGraph, CServer, Plt, PropTypes, Solvers0) -> Solvers = solvers(Solvers0), - assert_format_of_scc(SCC), - State1 = new_state(SCC, NextLabel, CallGraph, Plt, PropTypes, Solvers), - DefSet = add_def_list([Var || {_MFA, {Var, _Fun}, _Rec} <- SCC], sets:new()), - State2 = traverse_scc(SCC, DefSet, State1), + State1 = new_state(SCC, NextLabel, CallGraph, CServer, Plt, PropTypes, + Solvers), + DefSet = add_def_list(maps:values(State1#state.name_map), sets:new()), + ModRecs = [{M, dialyzer_codeserver:lookup_mod_records(M, CServer)} || + M <- lists:usort([M || {M, _, _} <- SCC])], + State2 = traverse_scc(SCC, CServer, DefSet, ModRecs, State1), State3 = state__finalize(State2), + erlang:garbage_collect(), Funs = state__scc(State3), pp_constrs_scc(Funs, State3), constraints_to_dot_scc(Funs, State3), T = solve(Funs, State3), dict:from_list(maps:to_list(T)). -assert_format_of_scc([{_MFA, {_Var, _Fun}, _Records}|Left]) -> - assert_format_of_scc(Left); -assert_format_of_scc([]) -> - ok. - solvers([]) -> [v2]; solvers(Solvers) -> Solvers. @@ -200,12 +197,14 @@ solvers(Solvers) -> Solvers. %% %% ============================================================================ -traverse_scc([{_MFA, Def, Rec}|Left], DefSet, AccState) -> +traverse_scc([{M,_,_}=MFA|Left], Codeserver, DefSet, ModRecs, AccState) -> + Def = dialyzer_codeserver:lookup_mfa_code(MFA, Codeserver), + {M, Rec} = lists:keyfind(M, 1, ModRecs), TmpState1 = state__set_rec_dict(AccState, Rec), DummyLetrec = cerl:c_letrec([Def], cerl:c_atom(foo)), {NewAccState, _} = traverse(DummyLetrec, DefSet, TmpState1), - traverse_scc(Left, DefSet, NewAccState); -traverse_scc([], _DefSet, AccState) -> + traverse_scc(Left, Codeserver, DefSet, ModRecs, NewAccState); +traverse_scc([], _Codeserver, _DefSet, _ModRecs, AccState) -> AccState. traverse(Tree, DefinedVars, State) -> @@ -2695,11 +2694,14 @@ pp_map(_S, _Map) -> %% %% ============================================================================ -new_state(SCC0, NextLabel, CallGraph, Plt, PropTypes, Solvers) -> - List = [{MFA, Var} || {MFA, {Var, _Fun}, _Rec} <- SCC0], +new_state(MFAs, NextLabel, CallGraph, CServer, Plt, PropTypes, Solvers) -> + List_SCC = + [begin + {Var, Label} = dialyzer_codeserver:lookup_mfa_var_label(MFA, CServer), + {{MFA, Var}, t_var(Label)} + end || MFA <- MFAs], + {List, SCC} = lists:unzip(List_SCC), NameMap = maps:from_list(List), - MFAs = [MFA || {MFA, _Var} <- List], - SCC = [mk_var(Fun) || {_MFA, {_Var, Fun}, _Rec} <- SCC0], SelfRec = case SCC of [OneF] -> diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 8480129dab..432d27571b 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -195,7 +195,7 @@ get_core_from_abstract_code(AbstrCode, Opts) -> get_record_and_type_info(AbstractCode) -> Module = get_module(AbstractCode), - get_record_and_type_info(AbstractCode, Module, dict:new()). + get_record_and_type_info(AbstractCode, Module, maps:new()). -spec get_record_and_type_info(abstract_code(), module(), type_table()) -> {'ok', type_table()} | {'error', string()}. @@ -208,7 +208,7 @@ get_record_and_type_info([{attribute, A, record, {Name, Fields0}}|Left], {ok, Fields} = get_record_fields(Fields0, RecDict), Arity = length(Fields), FN = {File, erl_anno:line(A)}, - NewRecDict = dict:store({record, Name}, {FN, [{Arity,Fields}]}, RecDict), + NewRecDict = maps:put({record, Name}, {FN, [{Arity,Fields}]}, RecDict), get_record_and_type_info(Left, Module, NewRecDict, File); get_record_and_type_info([{attribute, A, type, {{record, Name}, Fields0, []}} |Left], Module, RecDict, File) -> @@ -216,7 +216,7 @@ get_record_and_type_info([{attribute, A, type, {{record, Name}, Fields0, []}} {ok, Fields} = get_record_fields(Fields0, RecDict), Arity = length(Fields), FN = {File, erl_anno:line(A)}, - NewRecDict = dict:store({record, Name}, {FN, [{Arity, Fields}]}, RecDict), + NewRecDict = maps:put({record, Name}, {FN, [{Arity, Fields}]}, RecDict), get_record_and_type_info(Left, Module, NewRecDict, File); get_record_and_type_info([{attribute, A, Attr, {Name, TypeForm}}|Left], Module, RecDict, File) @@ -256,9 +256,9 @@ add_new_type(TypeOrOpaque, Name, TypeForm, ArgForms, Module, FN, false -> try erl_types:t_var_names(ArgForms) of ArgNames -> - dict:store({TypeOrOpaque, Name, Arity}, - {{Module, FN, TypeForm, ArgNames}, - erl_types:t_any()}, RecDict) + maps:put({TypeOrOpaque, Name, Arity}, + {{Module, FN, TypeForm, ArgNames}, + erl_types:t_any()}, RecDict) catch _:_ -> throw({error, flat_format("Type declaration for ~w does not " @@ -289,19 +289,18 @@ get_record_fields([{record_field, _Line, Name, _Init}|Left], RecDict, Acc) -> get_record_fields([], _RecDict, Acc) -> lists:reverse(Acc). --spec process_record_remote_types(codeserver()) -> codeserver(). +-spec process_record_remote_types(codeserver()) -> + {codeserver(), mod_records()}. %% The field types are cached. Used during analysis when handling records. process_record_remote_types(CServer) -> TempRecords = dialyzer_codeserver:get_temp_records(CServer), ExpTypes = dialyzer_codeserver:get_exported_types(CServer), - Cache = erl_types:cache__new(), - {TempRecords1, Cache1} = - process_opaque_types0(TempRecords, ExpTypes, Cache), + TempRecords1 = process_opaque_types0(TempRecords, ExpTypes), %% A cache (not the field type cache) is used for speeding things up a bit. VarTable = erl_types:var_table__new(), ModuleFun = - fun({Module, Record}, C0) -> + fun({Module, Record}) -> RecordFun = fun({Key, Value}, C2) -> case Key of @@ -327,24 +326,27 @@ process_record_remote_types(CServer) -> _Other -> {{Key, Value}, C2} end end, - {RecordList, C1} = - lists:mapfoldl(RecordFun, C0, dict:to_list(Record)), - {{Module, dict:from_list(RecordList)}, C1} + Cache = erl_types:cache__new(), + {RecordList, _NewCache} = + lists:mapfoldl(RecordFun, Cache, maps:to_list(Record)), + {Module, maps:from_list(RecordList)} end, - {NewRecordsList, C1} = - lists:mapfoldl(ModuleFun, Cache1, dict:to_list(TempRecords1)), + NewRecordsList = lists:map(ModuleFun, dict:to_list(TempRecords1)), NewRecords = dict:from_list(NewRecordsList), - _C8 = check_record_fields(NewRecords, ExpTypes, C1), - dialyzer_codeserver:finalize_records(NewRecords, CServer). + check_record_fields(NewRecords, ExpTypes), + {dialyzer_codeserver:finalize_records(NewRecords, CServer), NewRecords}. %% erl_types:t_from_form() substitutes the declaration of opaque types %% for the expanded type in some cases. To make sure the initial type, %% any(), is not used, the expansion is done twice. %% XXX: Recursive opaque types are not handled well. -process_opaque_types0(TempRecords0, TempExpTypes, Cache) -> - {TempRecords1, NewCache} = +process_opaque_types0(TempRecords0, TempExpTypes) -> + Cache = erl_types:cache__new(), + {TempRecords1, Cache1} = process_opaque_types(TempRecords0, TempExpTypes, Cache), - process_opaque_types(TempRecords1, TempExpTypes, NewCache). + {TempRecords, _NewCache} = + process_opaque_types(TempRecords1, TempExpTypes, Cache1), + TempRecords. process_opaque_types(TempRecords, TempExpTypes, Cache) -> VarTable = erl_types:var_table__new(), @@ -364,8 +366,8 @@ process_opaque_types(TempRecords, TempExpTypes, Cache) -> end end, {RecordList, C1} = - lists:mapfoldl(RecordFun, C0, dict:to_list(Record)), - {{Module, dict:from_list(RecordList)}, C1} + lists:mapfoldl(RecordFun, C0, maps:to_list(Record)), + {{Module, maps:from_list(RecordList)}, C1} %% dict:map(RecordFun, Record) end, {TempRecordList, NewCache} = @@ -373,7 +375,8 @@ process_opaque_types(TempRecords, TempExpTypes, Cache) -> {dict:from_list(TempRecordList), NewCache}. %% dict:map(ModuleFun, TempRecords). -check_record_fields(Records, TempExpTypes, Cache) -> +check_record_fields(Records, TempExpTypes) -> + Cache = erl_types:cache__new(), VarTable = erl_types:var_table__new(), CheckFun = fun({Module, Element}, C0) -> @@ -403,9 +406,10 @@ check_record_fields(Records, TempExpTypes, Cache) -> msg_with_position(Fun, FileLine) end end, - lists:foldl(ElemFun, C0, dict:to_list(Element)) + lists:foldl(ElemFun, C0, maps:to_list(Element)) end, - lists:foldl(CheckFun, Cache, dict:to_list(Records)). + _NewCache = lists:foldl(CheckFun, Cache, dict:to_list(Records)), + ok. msg_with_position(Fun, FileLine) -> try Fun() @@ -428,17 +432,17 @@ merge_records(NewRecords, OldRecords) -> %% %% ============================================================================ --type spec_dict() :: dict:dict(). --type callback_dict() :: dict:dict(). +-type spec_map() :: dialyzer_codeserver:contracts(). +-type callback_map() :: dialyzer_codeserver:contracts(). -spec get_spec_info(module(), abstract_code(), type_table()) -> - {'ok', spec_dict(), callback_dict()} | {'error', string()}. + {'ok', spec_map(), callback_map()} | {'error', string()}. -get_spec_info(ModName, AbstractCode, RecordsDict) -> +get_spec_info(ModName, AbstractCode, RecordsMap) -> OptionalCallbacks0 = get_optional_callbacks(AbstractCode, ModName), OptionalCallbacks = gb_sets:from_list(OptionalCallbacks0), - get_spec_info(AbstractCode, dict:new(), dict:new(), - RecordsDict, ModName, OptionalCallbacks, "nofile"). + get_spec_info(AbstractCode, maps:new(), maps:new(), + RecordsMap, ModName, OptionalCallbacks, "nofile"). get_optional_callbacks(Abs, ModName) -> [{ModName, F, A} || {F, A} <- get_optional_callbacks(Abs)]. @@ -456,7 +460,7 @@ get_optional_callbacks(Abs) -> %% are erl_types:erl_type() get_spec_info([{attribute, Anno, Contract, {Id, TypeSpec}}|Left], - SpecDict, CallbackDict, RecordsDict, ModName, OptCb, File) + SpecMap, CallbackMap, RecordsMap, ModName, OptCb, File) when ((Contract =:= 'spec') or (Contract =:= 'callback')), is_list(TypeSpec) -> Ln = erl_anno:line(Anno), @@ -465,24 +469,24 @@ get_spec_info([{attribute, Anno, Contract, {Id, TypeSpec}}|Left], {F, A} -> {ModName, F, A} end, Xtra = [optional_callback || gb_sets:is_member(MFA, OptCb)], - ActiveDict = + ActiveMap = case Contract of - spec -> SpecDict; - callback -> CallbackDict + spec -> SpecMap; + callback -> CallbackMap end, - try dict:find(MFA, ActiveDict) of + try maps:find(MFA, ActiveMap) of error -> SpecData = {TypeSpec, Xtra}, - NewActiveDict = + NewActiveMap = dialyzer_contracts:store_tmp_contract(MFA, {File, Ln}, SpecData, - ActiveDict, RecordsDict), - {NewSpecDict, NewCallbackDict} = + ActiveMap, RecordsMap), + {NewSpecMap, NewCallbackMap} = case Contract of - spec -> {NewActiveDict, CallbackDict}; - callback -> {SpecDict, NewActiveDict} + spec -> {NewActiveMap, CallbackMap}; + callback -> {SpecMap, NewActiveMap} end, - get_spec_info(Left, NewSpecDict, NewCallbackDict, - RecordsDict, ModName, OptCb, File); + get_spec_info(Left, NewSpecMap, NewCallbackMap, + RecordsMap, ModName, OptCb, File); {ok, {{OtherFile, L}, _D}} -> {Mod, Fun, Arity} = MFA, Msg = flat_format(" Contract/callback for function ~w:~w/~w " @@ -495,16 +499,16 @@ get_spec_info([{attribute, Anno, Contract, {Id, TypeSpec}}|Left], [Ln, Error])} end; get_spec_info([{attribute, _, file, {IncludeFile, _}}|Left], - SpecDict, CallbackDict, RecordsDict, ModName, OptCb, _File) -> - get_spec_info(Left, SpecDict, CallbackDict, - RecordsDict, ModName, OptCb, IncludeFile); -get_spec_info([_Other|Left], SpecDict, CallbackDict, - RecordsDict, ModName, OptCb, File) -> - get_spec_info(Left, SpecDict, CallbackDict, - RecordsDict, ModName, OptCb, File); -get_spec_info([], SpecDict, CallbackDict, - _RecordsDict, _ModName, _OptCb, _File) -> - {ok, SpecDict, CallbackDict}. + SpecMap, CallbackMap, RecordsMap, ModName, OptCb, _File) -> + get_spec_info(Left, SpecMap, CallbackMap, + RecordsMap, ModName, OptCb, IncludeFile); +get_spec_info([_Other|Left], SpecMap, CallbackMap, + RecordsMap, ModName, OptCb, File) -> + get_spec_info(Left, SpecMap, CallbackMap, + RecordsMap, ModName, OptCb, File); +get_spec_info([], SpecMap, CallbackMap, + _RecordsMap, _ModName, _OptCb, _File) -> + {ok, SpecMap, CallbackMap}. -spec get_fun_meta_info(module(), abstract_code(), [dial_warn_tag()]) -> dialyzer_codeserver:fun_meta_info() | {'error', string()}. @@ -700,7 +704,7 @@ format_errors([]) -> -spec format_sig(erl_types:erl_type()) -> string(). format_sig(Type) -> - format_sig(Type, dict:new()). + format_sig(Type, maps:new()). -spec format_sig(erl_types:erl_type(), type_table()) -> string(). @@ -952,9 +956,7 @@ label(Tree) -> -spec parallelism() -> integer(). parallelism() -> - CPUs = erlang:system_info(logical_processors_available), - Schedulers = erlang:system_info(schedulers), - min(CPUs, Schedulers). + erlang:system_info(schedulers_online). -spec family([{K,V}]) -> [{K,[V]}]. diff --git a/lib/dialyzer/test/small_SUITE_data/results/chars b/lib/dialyzer/test/small_SUITE_data/results/chars new file mode 100644 index 0000000000..2c1f8f8d17 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/chars @@ -0,0 +1,4 @@ + +chars.erl:29: Invalid type specification for function chars:f/1. The success typing is (#{'b':=50}) -> 'ok' +chars.erl:32: Function t1/0 has no local return +chars.erl:32: The call chars:f(#{'b':=50}) breaks the contract (#{'a':=49,'b'=>50,'c'=>51}) -> 'ok' diff --git a/lib/dialyzer/test/small_SUITE_data/src/anno.erl b/lib/dialyzer/test/small_SUITE_data/src/anno.erl new file mode 100644 index 0000000000..70f1d42141 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/anno.erl @@ -0,0 +1,18 @@ +-module(anno). + +%% OTP-14131 + +-export([t1/0, t2/0, t3/0]). + +t1() -> + A = erl_parse:anno_from_term({attribute, 1, module, my_test}), + compile:forms([A], []). + +t2() -> + A = erl_parse:new_anno({attribute, 1, module, my_test}), + compile:forms([A], []). + +t3() -> + A = erl_parse:new_anno({attribute, 1, module, my_test}), + T = erl_parse:anno_to_term(A), + {attribute, 1, module, my_test} = T. diff --git a/lib/dialyzer/test/small_SUITE_data/src/chars.erl b/lib/dialyzer/test/small_SUITE_data/src/chars.erl new file mode 100644 index 0000000000..1e9c8ab6b9 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/chars.erl @@ -0,0 +1,32 @@ +-module(chars). + +%% ERL-313 + +-export([t/0]). +-export([t1/0]). + +-record(r, {f :: $A .. $Z}). + +-type cs() :: $A..$Z | $a .. $z | $/. + +-spec t() -> $0-$0..$9-$0| $?. + +t() -> + c(#r{f = $z - 3}), + c($z - 3), + c($B). + +-spec c(cs()) -> $3-$0..$9-$0. + +c($A + 1) -> 2; +c(C) -> + case C of + $z - 3 -> 3; + #r{f = $z - 3} -> 7 + end. + +%% Display contract with character in warning: +-spec f(#{a := $1, b => $2, c => $3}) -> ok. % invalid type spec +f(_) -> ok. + +t1() -> f(#{b => $2}). % breaks the contract diff --git a/lib/eldap/test/Makefile b/lib/eldap/test/Makefile index 21a0da926f..81fa8f187a 100644 --- a/lib/eldap/test/Makefile +++ b/lib/eldap/test/Makefile @@ -42,7 +42,7 @@ TARGET_FILES= \ SPEC_FILES = eldap.spec -# COVER_FILE = eldap.cover +COVER_FILE = eldap.cover # ---------------------------------------------------- diff --git a/lib/eldap/test/eldap.cover b/lib/eldap/test/eldap.cover new file mode 100644 index 0000000000..8c15956e72 --- /dev/null +++ b/lib/eldap/test/eldap.cover @@ -0,0 +1,3 @@ +{incl_app,eldap,details}. + +{excl_mods, eldap, ['ELDAPv3']}. diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 5a4cf77b81..91ee104f77 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -228,7 +228,8 @@ -export([t_is_identifier/1]). -endif. --export_type([erl_type/0, opaques/0, type_table/0, var_table/0, cache/0]). +-export_type([erl_type/0, opaques/0, type_table/0, mod_records/0, + var_table/0, cache/0]). %%-define(DEBUG, true). @@ -371,8 +372,9 @@ -type type_value() :: {{module(), {file:name(), erl_anno:line()}, erl_parse:abstract_type(), ArgNames :: [atom()]}, erl_type()}. --type type_table() :: dict:dict(record_key() | type_key(), - record_value() | type_value()). +-type type_table() :: #{record_key() | type_key() => + record_value() | type_value()}. +-type mod_records() :: dict:dict(module(), type_table()). -opaque var_table() :: #{atom() => erl_type()}. @@ -741,16 +743,16 @@ decorate_tuples_in_sets([], _L, _Opaques, Acc) -> -spec t_opaque_from_records(type_table()) -> [erl_type()]. -t_opaque_from_records(RecDict) -> - OpaqueRecDict = - dict:filter(fun(Key, _Value) -> +t_opaque_from_records(RecMap) -> + OpaqueRecMap = + maps:filter(fun(Key, _Value) -> case Key of {opaque, _Name, _Arity} -> true; _ -> false end - end, RecDict), - OpaqueTypeDict = - dict:map(fun({opaque, Name, _Arity}, + end, RecMap), + OpaqueTypeMap = + maps:map(fun({opaque, Name, _Arity}, {{Module, _FileLine, _Form, ArgNames}, _Type}) -> %% Args = args_to_types(ArgNames), %% List = lists:zip(ArgNames, Args), @@ -759,8 +761,8 @@ t_opaque_from_records(RecDict) -> Rep = t_any(), % not used for anything right now Args = [t_any() || _ <- ArgNames], t_opaque(Module, Name, Args, Rep) - end, OpaqueRecDict), - [OpaqueType || {_Key, OpaqueType} <- dict:to_list(OpaqueTypeDict)]. + end, OpaqueRecMap), + [OpaqueType || {_Key, OpaqueType} <- maps:to_list(OpaqueTypeMap)]. %% Decompose opaque instances of type arg2 to structured types, in arg1 %% XXX: Same as t_unopaque @@ -794,10 +796,6 @@ list_struct_from_opaque(Types, Opaques) -> [t_struct_from_opaque(Type, Opaques) || Type <- Types]. %%----------------------------------------------------------------------------- - --type mod_records() :: dict:dict(module(), type_table()). - -%%----------------------------------------------------------------------------- %% Unit type. Signals non termination. %% @@ -3059,88 +3057,91 @@ is_compat_args([A1|Args1], [A2|Args2]) -> is_compat_args([], []) -> true; is_compat_args(_, _) -> false. -is_compat_arg(A1, A2) -> - is_specialization(A1, A2) orelse is_specialization(A2, A1). - --spec is_specialization(erl_type(), erl_type()) -> boolean(). - -%% Returns true if the first argument is a specialization of the -%% second argument in the sense that every type is a specialization of -%% any(). For example, {_,_} is a specialization of any(), but not of -%% tuple(). Does not handle variables, but any() and unions (sort of). - -is_specialization(T, T) -> true; -is_specialization(_, ?any) -> true; -is_specialization(?any, _) -> false; -is_specialization(?function(Domain1, Range1), ?function(Domain2, Range2)) -> - (is_specialization(Domain1, Domain2) andalso - is_specialization(Range1, Range2)); -is_specialization(?list(Contents1, Termination1, Size1), - ?list(Contents2, Termination2, Size2)) -> +-spec is_compat_arg(erl_type(), erl_type()) -> boolean(). + +%% The intention is that 'true' is to be returned iff one of the +%% arguments is a specialization of the other argument in the sense +%% that every type is a specialization of any(). For example, {_,_} is +%% a specialization of any(), but not of tuple(). Does not handle +%% variables, but any() and unions (sort of). However, the +%% implementation is more relaxed as any() is compatible to anything. + +is_compat_arg(T, T) -> true; +is_compat_arg(_, ?any) -> true; +is_compat_arg(?any, _) -> true; +is_compat_arg(?function(Domain1, Range1), ?function(Domain2, Range2)) -> + (is_compat_arg(Domain1, Domain2) andalso + is_compat_arg(Range1, Range2)); +is_compat_arg(?list(Contents1, Termination1, Size1), + ?list(Contents2, Termination2, Size2)) -> (Size1 =:= Size2 andalso - is_specialization(Contents1, Contents2) andalso - is_specialization(Termination1, Termination2)); -is_specialization(?product(Types1), ?product(Types2)) -> - specialization_list(Types1, Types2); -is_specialization(?tuple(?any, ?any, ?any), ?tuple(_, _, _)) -> false; -is_specialization(?tuple(_, _, _), ?tuple(?any, ?any, ?any)) -> false; -is_specialization(?tuple(Elements1, Arity, _), - ?tuple(Elements2, Arity, _)) when Arity =/= ?any -> - specialization_list(Elements1, Elements2); -is_specialization(?tuple_set([{Arity, List}]), - ?tuple(Elements2, Arity, _)) when Arity =/= ?any -> - specialization_list(sup_tuple_elements(List), Elements2); -is_specialization(?tuple(Elements1, Arity, _), - ?tuple_set([{Arity, List}])) when Arity =/= ?any -> - specialization_list(Elements1, sup_tuple_elements(List)); -is_specialization(?tuple_set(List1), ?tuple_set(List2)) -> + is_compat_arg(Contents1, Contents2) andalso + is_compat_arg(Termination1, Termination2)); +is_compat_arg(?product(Types1), ?product(Types2)) -> + is_compat_list(Types1, Types2); +is_compat_arg(?map(Pairs1, DefK1, DefV1), ?map(Pairs2, DefK2, DefV2)) -> + (is_compat_list(Pairs1, Pairs2) andalso + is_compat_arg(DefK1, DefK2) andalso + is_compat_arg(DefV1, DefV2)); +is_compat_arg(?tuple(?any, ?any, ?any), ?tuple(_, _, _)) -> false; +is_compat_arg(?tuple(_, _, _), ?tuple(?any, ?any, ?any)) -> false; +is_compat_arg(?tuple(Elements1, Arity, _), + ?tuple(Elements2, Arity, _)) when Arity =/= ?any -> + is_compat_list(Elements1, Elements2); +is_compat_arg(?tuple_set([{Arity, List}]), + ?tuple(Elements2, Arity, _)) when Arity =/= ?any -> + is_compat_list(sup_tuple_elements(List), Elements2); +is_compat_arg(?tuple(Elements1, Arity, _), + ?tuple_set([{Arity, List}])) when Arity =/= ?any -> + is_compat_list(Elements1, sup_tuple_elements(List)); +is_compat_arg(?tuple_set(List1), ?tuple_set(List2)) -> try - specialization_list_list([sup_tuple_elements(T) || {_Arity, T} <- List1], - [sup_tuple_elements(T) || {_Arity, T} <- List2]) + is_compat_list_list([sup_tuple_elements(T) || {_Arity, T} <- List1], + [sup_tuple_elements(T) || {_Arity, T} <- List2]) catch _:_ -> false end; -is_specialization(?opaque(_) = T1, T2) -> - is_specialization(t_opaque_structure(T1), T2); -is_specialization(T1, ?opaque(_) = T2) -> - is_specialization(T1, t_opaque_structure(T2)); -is_specialization(?union(List1)=T1, ?union(List2)=T2) -> - case specialization_union2(T1, T2) of - {yes, Type1, Type2} -> is_specialization(Type1, Type2); - no -> specialization_list(List1, List2) +is_compat_arg(?opaque(_) = T1, T2) -> + is_compat_arg(t_opaque_structure(T1), T2); +is_compat_arg(T1, ?opaque(_) = T2) -> + is_compat_arg(T1, t_opaque_structure(T2)); +is_compat_arg(?union(List1)=T1, ?union(List2)=T2) -> + case is_compat_union2(T1, T2) of + {yes, Type1, Type2} -> is_compat_arg(Type1, Type2); + no -> is_compat_list(List1, List2) end; -is_specialization(?union(List), T2) -> +is_compat_arg(?union(List), T2) -> case unify_union(List) of - {yes, Type} -> is_specialization(Type, T2); + {yes, Type} -> is_compat_arg(Type, T2); no -> false end; -is_specialization(T1, ?union(List)) -> +is_compat_arg(T1, ?union(List)) -> case unify_union(List) of - {yes, Type} -> is_specialization(T1, Type); + {yes, Type} -> is_compat_arg(T1, Type); no -> false end; -is_specialization(?var(_), _) -> exit(error); -is_specialization(_, ?var(_)) -> exit(error); -is_specialization(?none, _) -> false; -is_specialization(_, ?none) -> false; -is_specialization(?unit, _) -> false; -is_specialization(_, ?unit) -> false; -is_specialization(#c{}, #c{}) -> false. +is_compat_arg(?var(_), _) -> exit(error); +is_compat_arg(_, ?var(_)) -> exit(error); +is_compat_arg(?none, _) -> false; +is_compat_arg(_, ?none) -> false; +is_compat_arg(?unit, _) -> false; +is_compat_arg(_, ?unit) -> false; +is_compat_arg(#c{}, #c{}) -> false. -specialization_list_list(LL1, LL2) -> - length(LL1) =:= length(LL2) andalso specialization_list_list1(LL1, LL2). +is_compat_list_list(LL1, LL2) -> + length(LL1) =:= length(LL2) andalso is_compat_list_list1(LL1, LL2). -specialization_list_list1([], []) -> true; -specialization_list_list1([L1|LL1], [L2|LL2]) -> - specialization_list(L1, L2) andalso specialization_list_list1(LL1, LL2). +is_compat_list_list1([], []) -> true; +is_compat_list_list1([L1|LL1], [L2|LL2]) -> + is_compat_list(L1, L2) andalso is_compat_list_list1(LL1, LL2). -specialization_list(L1, L2) -> - length(L1) =:= length(L2) andalso specialization_list1(L1, L2). +is_compat_list(L1, L2) -> + length(L1) =:= length(L2) andalso is_compat_list1(L1, L2). -specialization_list1([], []) -> true; -specialization_list1([T1|L1], [T2|L2]) -> - is_specialization(T1, T2) andalso specialization_list1(L1, L2). +is_compat_list1([], []) -> true; +is_compat_list1([T1|L1], [T2|L2]) -> + is_compat_arg(T1, T2) andalso is_compat_list1(L1, L2). -specialization_union2(?union(List1)=T1, ?union(List2)=T2) -> +is_compat_union2(?union(List1)=T1, ?union(List2)=T2) -> case {unify_union(List1), unify_union(List2)} of {{yes, Type1}, {yes, Type2}} -> {yes, Type1, Type2}; {{yes, Type1}, no} -> {yes, Type1, T2}; @@ -4173,7 +4174,7 @@ t_map(Fun, T) -> -spec t_to_string(erl_type()) -> string(). t_to_string(T) -> - t_to_string(T, dict:new()). + t_to_string(T, maps:new()). -spec t_to_string(erl_type(), type_table()) -> string(). @@ -4534,6 +4535,8 @@ from_form({atom, _L, Atom}, _S, _D, L, C) -> {t_atom(Atom), L, C}; from_form({integer, _L, Int}, _S, _D, L, C) -> {t_integer(Int), L, C}; +from_form({char, _L, Char}, _S, _D, L, C) -> + {t_integer(Char), L, C}; from_form({op, _L, _Op, _Arg} = Op, _S, _D, L, C) -> case erl_eval:partial_eval(Op) of {integer, _, Val} -> @@ -5048,6 +5051,7 @@ check_record_fields({remote_type, _L, [{atom, _, _}, {atom, _, _}, Args]}, list_check_record_fields(Args, S, C); check_record_fields({atom, _L, _}, _S, C) -> C; check_record_fields({integer, _L, _}, _S, C) -> C; +check_record_fields({char, _L, _}, _S, C) -> C; check_record_fields({op, _L, _Op, _Arg}, _S, C) -> C; check_record_fields({op, _L, _Op, _Arg1, _Arg2}, _S, C) -> C; check_record_fields({type, _L, tuple, any}, _S, C) -> C; @@ -5149,6 +5153,7 @@ t_form_to_string({var, _L, Name}) -> atom_to_list(Name); t_form_to_string({atom, _L, Atom}) -> io_lib:write_string(atom_to_list(Atom), $'); % To quote or not to quote... ' t_form_to_string({integer, _L, Int}) -> integer_to_list(Int); +t_form_to_string({char, _L, Char}) -> integer_to_list(Char); t_form_to_string({op, _L, _Op, _Arg} = Op) -> case erl_eval:partial_eval(Op) of {integer, _, _} = Int -> t_form_to_string(Int); @@ -5231,7 +5236,7 @@ t_form_to_string({type, _L, union, Args}) -> t_form_to_string({type, _L, Name, []} = T) -> try M = mod, - D0 = dict:new(), + D0 = maps:new(), MR = dict:from_list([{M, D0}]), Site = {type, {M,Name,0}}, V = var_table__new(), @@ -5295,8 +5300,8 @@ is_erl_type(_) -> false. -spec lookup_record(atom(), type_table()) -> 'error' | {'ok', [{atom(), parse_form(), erl_type()}]}. -lookup_record(Tag, RecDict) when is_atom(Tag) -> - case dict:find({record, Tag}, RecDict) of +lookup_record(Tag, Table) when is_atom(Tag) -> + case maps:find({record, Tag}, Table) of {ok, {_FileLine, [{_Arity, Fields}]}} -> {ok, Fields}; {ok, {_FileLine, List}} when is_list(List) -> @@ -5310,18 +5315,18 @@ lookup_record(Tag, RecDict) when is_atom(Tag) -> -spec lookup_record(atom(), arity(), type_table()) -> 'error' | {'ok', [{atom(), parse_form(), erl_type()}]}. -lookup_record(Tag, Arity, RecDict) when is_atom(Tag) -> - case dict:find({record, Tag}, RecDict) of +lookup_record(Tag, Arity, Table) when is_atom(Tag) -> + case maps:find({record, Tag}, Table) of {ok, {_FileLine, [{Arity, Fields}]}} -> {ok, Fields}; {ok, {_FileLine, OrdDict}} -> orddict:find(Arity, OrdDict); error -> error end. -spec lookup_type(_, _, _) -> {'type' | 'opaque', type_value()} | 'error'. -lookup_type(Name, Arity, RecDict) -> - case dict:find({type, Name, Arity}, RecDict) of +lookup_type(Name, Arity, Table) -> + case maps:find({type, Name, Arity}, Table) of error -> - case dict:find({opaque, Name, Arity}, RecDict) of + case maps:find({opaque, Name, Arity}, Table) of error -> error; {ok, Found} -> {opaque, Found} end; @@ -5331,8 +5336,8 @@ lookup_type(Name, Arity, RecDict) -> -spec type_is_defined('type' | 'opaque', atom(), arity(), type_table()) -> boolean(). -type_is_defined(TypeOrOpaque, Name, Arity, RecDict) -> - dict:is_key({TypeOrOpaque, Name, Arity}, RecDict). +type_is_defined(TypeOrOpaque, Name, Arity, Table) -> + maps:is_key({TypeOrOpaque, Name, Arity}, Table). cannot_have_opaque(Type, TypeName, TypeNames) -> t_is_none(Type) orelse is_recursive(TypeName, TypeNames). diff --git a/lib/hipe/test/basic_SUITE_data/basic_num_bif.erl b/lib/hipe/test/basic_SUITE_data/basic_num_bif.erl new file mode 100644 index 0000000000..807c4b0d0d --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_num_bif.erl @@ -0,0 +1,217 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : basic_num_bif.erl +%%% Description : Taken from the compiler test suite +%%%------------------------------------------------------------------- +-module(basic_num_bif). + +-export([test/0]). + +%% Tests optimization of the BIFs: +%% abs/1 +%% float/1 +%% float_to_list/1 +%% integer_to_list/1 +%% list_to_float/1 +%% list_to_integer/1 +%% round/1 +%% trunc/1 + +test() -> + Funs = [fun t_abs/0, fun t_float/0, + fun t_float_to_list/0, fun t_integer_to_list/0, + fun t_list_to_float_safe/0, fun t_list_to_float_risky/0, + fun t_list_to_integer/0, fun t_round/0, fun t_trunc/0], + lists:foreach(fun (F) -> ok = F() end, Funs). + +t_abs() -> + %% Floats. + 5.5 = abs(5.5), + 0.0 = abs(0.0), + 100.0 = abs(-100.0), + %% Integers. + 5 = abs(5), + 0 = abs(0), + 100 = abs(-100), + %% The largest smallnum. OTP-3190. + X = (1 bsl 27) - 1, + X = abs(X), + X = abs(X-1)+1, + X = abs(X+1)-1, + X = abs(-X), + X = abs(-X-1)-1, + X = abs(-X+1)+1, + %% Bignums. + BigNum = 13984792374983749, + BigNum = abs(BigNum), + BigNum = abs(-BigNum), + ok. + +t_float() -> + 0.0 = float(0), + 2.5 = float(2.5), + 0.0 = float(0.0), + -100.55 = float(-100.55), + 42.0 = float(42), + -100.0 = float(-100), + %% Bignums. + 4294967305.0 = float(4294967305), + -4294967305.0 = float(-4294967305), + %% Extremely big bignums. + Big = list_to_integer(lists:duplicate(2000, $1)), + {'EXIT', {badarg, _}} = (catch float(Big)), + ok. + +%% Tests float_to_list/1. + +t_float_to_list() -> + test_ftl("0.0e+0", 0.0), + test_ftl("2.5e+1", 25.0), + test_ftl("2.5e+0", 2.5), + test_ftl("2.5e-1", 0.25), + test_ftl("-3.5e+17", -350.0e15), + ok. + +test_ftl(Expect, Float) -> + %% No on the next line -- we want the line number from t_float_to_list. + Expect = remove_zeros(lists:reverse(float_to_list(Float)), []). + +%% Removes any non-significant zeros in a floating point number. +%% Example: 2.500000e+01 -> 2.5e+1 + +remove_zeros([$+, $e|Rest], [$0, X|Result]) -> + remove_zeros([$+, $e|Rest], [X|Result]); +remove_zeros([$-, $e|Rest], [$0, X|Result]) -> + remove_zeros([$-, $e|Rest], [X|Result]); +remove_zeros([$0, $.|Rest], [$e|Result]) -> + remove_zeros(Rest, [$., $0, $e|Result]); +remove_zeros([$0|Rest], [$e|Result]) -> + remove_zeros(Rest, [$e|Result]); +remove_zeros([Char|Rest], Result) -> + remove_zeros(Rest, [Char|Result]); +remove_zeros([], Result) -> + Result. + +%% Tests integer_to_list/1. + +t_integer_to_list() -> + "0" = integer_to_list(0), + "42" = integer_to_list(42), + "-42" = integer_to_list(-42), + "-42" = integer_to_list(-42), + "32768" = integer_to_list(32768), + "268435455" = integer_to_list(268435455), + "-268435455" = integer_to_list(-268435455), + "123456932798748738738" = integer_to_list(123456932798748738738), + Big_List = lists:duplicate(2000, $1), + Big = list_to_integer(Big_List), + Big_List = integer_to_list(Big), + ok. + +%% Tests list_to_float/1. + +t_list_to_float_safe() -> + 0.0 = list_to_float("0.0"), + 0.0 = list_to_float("-0.0"), + 0.5 = list_to_float("0.5"), + -0.5 = list_to_float("-0.5"), + 100.0 = list_to_float("1.0e2"), + 127.5 = list_to_float("127.5"), + -199.5 = list_to_float("-199.5"), + ok. + +%% This might crash the emulator... +%% (Known to crash the Unix version of Erlang 4.4.1) + +t_list_to_float_risky() -> + Many_Ones = lists:duplicate(25000, $1), + _ = list_to_float("2."++Many_Ones), + {'EXIT', {badarg, _}} = (catch list_to_float("2"++Many_Ones)), + ok. + +%% Tests list_to_integer/1. + +t_list_to_integer() -> + 0 = list_to_integer("0"), + 0 = list_to_integer("00"), + 0 = list_to_integer("-0"), + 1 = list_to_integer("1"), + -1 = list_to_integer("-1"), + 42 = list_to_integer("42"), + -12 = list_to_integer("-12"), + 32768 = list_to_integer("32768"), + 268435455 = list_to_integer("268435455"), + -268435455 = list_to_integer("-268435455"), + %% Bignums. + 123456932798748738738 = list_to_integer("123456932798748738738"), + _ = list_to_integer(lists:duplicate(2000, $1)), + ok. + +%% Tests round/1. + +t_round() -> + 0 = round(0.0), + 0 = round(0.4), + 1 = round(0.5), + 0 = round(-0.4), + -1 = round(-0.5), + 255 = round(255.3), + 256 = round(255.6), + -1033 = round(-1033.3), + -1034 = round(-1033.6), + %% OTP-3722: + X = (1 bsl 27) - 1, + MX = -X, + MXm1 = -X-1, + MXp1 = -X+1, + F = X + 0.0, + X = round(F), + X = round(F+1)-1, + X = round(F-1)+1, + MX = round(-F), + MXm1 = round(-F-1), + MXp1 = round(-F+1), + X = round(F+0.1), + X = round(F+1+0.1)-1, + X = round(F-1+0.1)+1, + MX = round(-F+0.1), + MXm1 = round(-F-1+0.1), + MXp1 = round(-F+1+0.1), + X = round(F-0.1), + X = round(F+1-0.1)-1, + X = round(F-1-0.1)+1, + MX = round(-F-0.1), + MXm1 = round(-F-1-0.1), + MXp1 = round(-F+1-0.1), + 0.5 = abs(round(F+0.5)-(F+0.5)), + 0.5 = abs(round(F-0.5)-(F-0.5)), + 0.5 = abs(round(-F-0.5)-(-F-0.5)), + 0.5 = abs(round(-F+0.5)-(-F+0.5)), + %% Bignums. + 4294967296 = round(4294967296.1), + 4294967297 = round(4294967296.9), + -4294967296 = -round(4294967296.1), + -4294967297 = -round(4294967296.9), + ok. + +t_trunc() -> + 0 = trunc(0.0), + 5 = trunc(5.3333), + -10 = trunc(-10.978987), + %% The largest smallnum, converted to float (OTP-3722): + X = (1 bsl 27) - 1, + F = X + 0.0, + %% io:format("X = ~p/~w/~w, F = ~p/~w/~w, trunc(F) = ~p/~w/~w~n", + %% [X, X, binary_to_list(term_to_binary(X)), + %% F, F, binary_to_list(term_to_binary(F)), + %% trunc(F), trunc(F), binary_to_list(term_to_binary(trunc(F)))]), + X = trunc(F), + X = trunc(F+1)-1, + X = trunc(F-1)+1, + X = -trunc(-F), + X = -trunc(-F-1)-1, + X = -trunc(-F+1)+1, + %% Bignums. + 4294967305 = trunc(4294967305.7), + -4294967305 = trunc(-4294967305.7), + ok. diff --git a/lib/hipe/test/hipe_SUITE.erl b/lib/hipe/test/hipe_SUITE.erl index a5b3924aa8..b9adb660f2 100644 --- a/lib/hipe/test/hipe_SUITE.erl +++ b/lib/hipe/test/hipe_SUITE.erl @@ -16,7 +16,11 @@ %% -module(hipe_SUITE). --compile([export_all]). +-export([all/0, groups/0, + init_per_suite/1, end_per_suite/1, + init_per_group/2, end_per_group/2, + app/0, app/1, appup/0, appup/1]). + -include_lib("common_test/include/ct.hrl"). all() -> diff --git a/lib/hipe/test/opt_verify_SUITE.erl b/lib/hipe/test/opt_verify_SUITE.erl index 61952e81d7..86083fa02b 100644 --- a/lib/hipe/test/opt_verify_SUITE.erl +++ b/lib/hipe/test/opt_verify_SUITE.erl @@ -1,6 +1,9 @@ -module(opt_verify_SUITE). --compile([export_all]). +-export([all/0, groups/0, + init_per_suite/1, end_per_suite/1, + init_per_group/2, end_per_group/2, + call_elim/0, call_elim/1]). all() -> [call_elim]. @@ -23,23 +26,6 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. -call_elim_test_file(Config, FileName, Option) -> - PrivDir = test_server:lookup_config(priv_dir, Config), - TempOut = test_server:temp_name(filename:join(PrivDir, "call_elim_out")), - {ok, TestCase} = compile:file(FileName), - {ok, TestCase} = hipe:c(TestCase, [Option, {pp_range_icode, {file, TempOut}}]), - {ok, Icode} = file:read_file(TempOut), - ok = file:delete(TempOut), - Icode. - -substring_count(Icode, Substring) -> - substring_count(Icode, Substring, 0). -substring_count(Icode, Substring, N) -> - case string:str(Icode, Substring) of - 0 -> N; - I -> substring_count(lists:nthtail(I, Icode), Substring, N+1) - end. - call_elim() -> [{doc, "Test that the call elimination optimization pass is ok"}]. call_elim(Config) -> @@ -60,3 +46,20 @@ call_elim(Config) -> Icode6 = call_elim_test_file(Config, F3, no_icode_call_elim), 3 = substring_count(binary:bin_to_list(Icode6), "is_key"), ok. + +call_elim_test_file(Config, FileName, Option) -> + PrivDir = test_server:lookup_config(priv_dir, Config), + TempOut = test_server:temp_name(filename:join(PrivDir, "call_elim_out")), + {ok, TestCase} = compile:file(FileName), + {ok, TestCase} = hipe:c(TestCase, [Option, {pp_range_icode, {file, TempOut}}]), + {ok, Icode} = file:read_file(TempOut), + ok = file:delete(TempOut), + Icode. + +substring_count(Icode, Substring) -> + substring_count(Icode, Substring, 0). +substring_count(Icode, Substring, N) -> + case string:str(Icode, Substring) of + 0 -> N; + I -> substring_count(lists:nthtail(I, Icode), Substring, N+1) + end. diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index 705afec022..4217b3c4fb 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -83,7 +83,7 @@ <title>HTTP DATA TYPES</title> <p>Type definitions related to HTTP:</p> - <p><c>method() = head | get | put | post | trace | options | delete</c></p> + <p><c>method() = head | get | put | post | trace | options | delete | patch</c></p> <taglist> <tag><c>request()</c></tag> <item><p>= <c>{url(), headers()}</c></p> diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index 91d87289a2..bd5f6df39e 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -147,6 +147,26 @@ request(Method, Request, HttpOptions, Options) -> request(Method, Request, HttpOptions, Options, default_profile()). request(Method, + {Url, Headers, ContentType, TupleBody}, + HTTPOptions, Options, Profile) + when ((Method =:= post) orelse (Method =:= patch) orelse (Method =:= put) orelse (Method =:= delete)) + andalso (is_atom(Profile) orelse is_pid(Profile)) andalso + is_list(ContentType) andalso is_tuple(TupleBody)-> + case check_body_gen(TupleBody) of + ok -> + do_request(Method, {Url, Headers, ContentType, TupleBody}, HTTPOptions, Options, Profile); + Error -> + Error + end; +request(Method, + {Url, Headers, ContentType, Body}, + HTTPOptions, Options, Profile) + when ((Method =:= post) orelse (Method =:= patch) orelse (Method =:= put) orelse (Method =:= delete)) + andalso (is_atom(Profile) orelse is_pid(Profile)) andalso + is_list(ContentType) andalso (is_list(Body) orelse is_binary(Body)) -> + do_request(Method, {Url, Headers, ContentType, Body}, HTTPOptions, Options, Profile); + +request(Method, {Url, Headers}, HTTPOptions, Options, Profile) when (Method =:= options) orelse @@ -155,12 +175,6 @@ request(Method, (Method =:= delete) orelse (Method =:= trace) andalso (is_atom(Profile) orelse is_pid(Profile)) -> - ?hcrt("request", [{method, Method}, - {url, Url}, - {headers, Headers}, - {http_options, HTTPOptions}, - {options, Options}, - {profile, Profile}]), case uri_parse(Url, Options) of {error, Reason} -> {error, Reason}; @@ -172,21 +186,9 @@ request(Method, handle_request(Method, Url, ParsedUrl, Headers, [], [], HTTPOptions, Options, Profile) end - end; - -request(Method, - {Url, Headers, ContentType, Body}, - HTTPOptions, Options, Profile) - when ((Method =:= post) orelse (Method =:= patch) orelse (Method =:= put) orelse - (Method =:= delete)) andalso (is_atom(Profile) orelse is_pid(Profile)) -> - ?hcrt("request", [{method, Method}, - {url, Url}, - {headers, Headers}, - {content_type, ContentType}, - {body, Body}, - {http_options, HTTPOptions}, - {options, Options}, - {profile, Profile}]), + end. + +do_request(Method, {Url, Headers, ContentType, Body}, HTTPOptions, Options, Profile) -> case uri_parse(Url, Options) of {error, Reason} -> {error, Reason}; @@ -196,7 +198,6 @@ request(Method, HTTPOptions, Options, Profile) end. - %%-------------------------------------------------------------------------- %% cancel_request(RequestId) -> ok %% cancel_request(RequestId, Profile) -> ok @@ -209,7 +210,6 @@ cancel_request(RequestId) -> cancel_request(RequestId, Profile) when is_atom(Profile) orelse is_pid(Profile) -> - ?hcrt("cancel request", [{request_id, RequestId}, {profile, Profile}]), httpc_manager:cancel_request(RequestId, profile_name(Profile)). @@ -232,7 +232,6 @@ cancel_request(RequestId, Profile) set_options(Options) -> set_options(Options, default_profile()). set_options(Options, Profile) when is_atom(Profile) orelse is_pid(Profile) -> - ?hcrt("set options", [{options, Options}, {profile, Profile}]), case validate_options(Options) of {ok, Opts} -> httpc_manager:set_options(Opts, profile_name(Profile)); @@ -272,7 +271,6 @@ get_options(all = _Options, Profile) -> get_options(Options, Profile) when (is_list(Options) andalso (is_atom(Profile) orelse is_pid(Profile))) -> - ?hcrt("get options", [{options, Options}, {profile, Profile}]), case Options -- get_options() of [] -> try @@ -314,9 +312,6 @@ store_cookies(SetCookieHeaders, Url) -> store_cookies(SetCookieHeaders, Url, Profile) when is_atom(Profile) orelse is_pid(Profile) -> - ?hcrt("store cookies", [{set_cookie_headers, SetCookieHeaders}, - {url, Url}, - {profile, Profile}]), try begin %% Since the Address part is not actually used @@ -353,9 +348,6 @@ cookie_header(Url, Opts) when is_list(Opts) -> cookie_header(Url, Opts, Profile) when (is_list(Opts) andalso (is_atom(Profile) orelse is_pid(Profile))) -> - ?hcrt("cookie header", [{url, Url}, - {opts, Opts}, - {profile, Profile}]), try begin httpc_manager:which_cookies(Url, Opts, profile_name(Profile)) @@ -398,7 +390,6 @@ which_sessions() -> which_sessions(default_profile()). which_sessions(Profile) -> - ?hcrt("which sessions", [{profile, Profile}]), try begin httpc_manager:which_sessions(profile_name(Profile)) @@ -419,7 +410,6 @@ info() -> info(default_profile()). info(Profile) -> - ?hcrt("info", [{profile, Profile}]), try begin httpc_manager:info(profile_name(Profile)) @@ -440,7 +430,6 @@ reset_cookies() -> reset_cookies(default_profile()). reset_cookies(Profile) -> - ?hcrt("reset cookies", [{profile, Profile}]), try begin httpc_manager:reset_cookies(profile_name(Profile)) @@ -458,7 +447,6 @@ reset_cookies(Profile) -> %% same behavior as active once for sockets. %%------------------------------------------------------------------------- stream_next(Pid) -> - ?hcrt("stream next", [{handler, Pid}]), httpc_handler:stream_next(Pid). @@ -466,7 +454,6 @@ stream_next(Pid) -> %%% Behaviour callbacks %%%======================================================================== start_standalone(PropList) -> - ?hcrt("start standalone", [{proplist, PropList}]), case proplists:get_value(profile, PropList) of undefined -> {error, no_profile}; @@ -477,14 +464,11 @@ start_standalone(PropList) -> end. start_service(Config) -> - ?hcrt("start service", [{config, Config}]), httpc_profile_sup:start_child(Config). stop_service(Profile) when is_atom(Profile) -> - ?hcrt("stop service", [{profile, Profile}]), httpc_profile_sup:stop_child(Profile); stop_service(Pid) when is_pid(Pid) -> - ?hcrt("stop service", [{pid, Pid}]), case service_info(Pid) of {ok, [{profile, Profile}]} -> stop_service(Profile); @@ -510,7 +494,6 @@ service_info(Pid) -> %%%======================================================================== %%% Internal functions %%%======================================================================== - handle_request(Method, Url, {Scheme, UserInfo, Host, Port, Path, Query}, Headers0, ContentType, Body0, @@ -521,9 +504,6 @@ handle_request(Method, Url, try begin - ?hcrt("begin processing", [{started, Started}, - {new_headers, NewHeaders0}]), - {NewHeaders, Body} = case Body0 of {chunkify, ProcessBody, Acc} @@ -575,16 +555,13 @@ handle_request(Method, Url, {ok, RequestId} -> handle_answer(RequestId, Sync, Options); {error, Reason} -> - ?hcrd("request failed", [{reason, Reason}]), {error, Reason} end end catch error:{noproc, _} -> - ?hcrv("noproc", [{profile, Profile}]), {error, {not_started, Profile}}; throw:Error -> - ?hcrv("throw", [{error, Error}]), Error end. @@ -620,15 +597,10 @@ handle_answer(RequestId, false, _) -> handle_answer(RequestId, true, Options) -> receive {http, {RequestId, saved_to_file}} -> - ?hcrt("received saved-to-file", [{request_id, RequestId}]), {ok, saved_to_file}; {http, {RequestId, {_,_,_} = Result}} -> - ?hcrt("received answer", [{request_id, RequestId}, - {result, Result}]), return_answer(Options, Result); {http, {RequestId, {error, Reason}}} -> - ?hcrt("received error", [{request_id, RequestId}, - {reason, Reason}]), {error, Reason} end. @@ -1257,18 +1229,14 @@ child_name(Pid, [{Name, Pid} | _]) -> child_name(Pid, [_ | Children]) -> child_name(Pid, Children). -%% d(F) -> -%% d(F, []). - -%% d(F, A) -> -%% d(get(dbg), F, A). - -%% d(true, F, A) -> -%% io:format(user, "~w:~w:" ++ F ++ "~n", [self(), ?MODULE | A]); -%% d(_, _, _) -> -%% ok. - host_address(Host, false) -> Host; host_address(Host, true) -> string:strip(string:strip(Host, right, $]), left, $[). + +check_body_gen({Fun, _}) when is_function(Fun) -> + ok; +check_body_gen({chunkify, Fun, _}) when is_function(Fun) -> + ok; +check_body_gen(Gen) -> + {error, {bad_body_generator, Gen}}. diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 2e7df8e424..c99200777b 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -32,7 +32,6 @@ %% Internal Application API -export([ start_link/4, - %% connect_and_send/2, send/2, cancel/2, stream_next/1, @@ -165,14 +164,12 @@ info(Pid) -> %%-------------------------------------------------------------------- %% Request should not be streamed stream(BodyPart, #request{stream = none} = Request, _) -> - ?hcrt("stream - none", []), {false, BodyPart, Request}; %% Stream to caller stream(BodyPart, #request{stream = Self} = Request, Code) when ?IS_STREAMED(Code) andalso ((Self =:= self) orelse (Self =:= {self, once})) -> - ?hcrt("stream - self", [{stream, Self}, {code, Code}]), httpc_response:send(Request#request.from, {Request#request.id, stream, BodyPart}), {true, <<>>, Request}; @@ -182,10 +179,8 @@ stream(BodyPart, #request{stream = Self} = Request, Code) %% We keep this for backward compatibillity... stream(BodyPart, #request{stream = Filename} = Request, Code) when ?IS_STREAMED(Code) andalso is_list(Filename) -> - ?hcrt("stream - filename", [{stream, Filename}, {code, Code}]), case file:open(Filename, [write, raw, append, delayed_write]) of {ok, Fd} -> - ?hcrt("stream - file open ok", [{fd, Fd}]), stream(BodyPart, Request#request{stream = Fd}, 200); {error, Reason} -> exit({stream_to_file_failed, Reason}) @@ -194,7 +189,6 @@ stream(BodyPart, #request{stream = Filename} = Request, Code) %% Stream to file stream(BodyPart, #request{stream = Fd} = Request, Code) when ?IS_STREAMED(Code) -> - ?hcrt("stream to file", [{stream, Fd}, {code, Code}]), case file:write(Fd, BodyPart) of ok -> {true, <<>>, Request}; @@ -203,7 +197,6 @@ stream(BodyPart, #request{stream = Fd} = Request, Code) end; stream(BodyPart, Request,_) -> % only 200 and 206 responses can be streamed - ?hcrt("stream - ignore", [{request, Request}]), {false, BodyPart, Request}. @@ -257,22 +250,148 @@ init([Parent, Request, Options, ProfileName]) -> %% {stop, Reason, State} (terminate/2 is called) %% Description: Handling call messages %%-------------------------------------------------------------------- -handle_call(#request{address = Addr} = Request, _, +handle_call(Request, From, State) -> + try do_handle_call(Request, From, State) of + Result -> + Result + catch + _:Reason -> + {stop, {shutdown, Reason} , State} + end. + + +%%-------------------------------------------------------------------- +%% Function: handle_cast(Msg, State) -> {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} (terminate/2 is called) +%% Description: Handling cast messages +%%-------------------------------------------------------------------- +handle_cast(Msg, State) -> + try do_handle_cast(Msg, State) of + Result -> + Result + catch + _:Reason -> + {stop, {shutdown, Reason} , State} + end. + +%%-------------------------------------------------------------------- +%% Function: handle_info(Info, State) -> {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} (terminate/2 is called) +%% Description: Handling all non call/cast messages +%%-------------------------------------------------------------------- +handle_info(Info, State) -> + try do_handle_info(Info, State) of + Result -> + Result + catch + _:Reason -> + {stop, {shutdown, Reason} , State} + end. + +%%-------------------------------------------------------------------- +%% Function: terminate(Reason, State) -> _ (ignored by gen_server) +%% Description: Shutdown the httpc_handler +%%-------------------------------------------------------------------- + +%% Init error there is no socket to be closed. +terminate(normal, + #state{request = Request, + session = {send_failed, _} = Reason} = State) -> + maybe_send_answer(Request, + httpc_response:error(Request, Reason), + State), + ok; + +terminate(normal, + #state{request = Request, + session = {connect_failed, _} = Reason} = State) -> + maybe_send_answer(Request, + httpc_response:error(Request, Reason), + State), + ok; + +terminate(normal, #state{session = undefined}) -> + ok; + +%% Init error sending, no session information has been setup but +%% there is a socket that needs closing. +terminate(normal, + #state{session = #session{id = undefined} = Session}) -> + close_socket(Session); + +%% Socket closed remotely +terminate(normal, + #state{session = #session{socket = {remote_close, Socket}, + socket_type = SocketType, + id = Id}, + profile_name = ProfileName, + request = Request, + timers = Timers, + pipeline = Pipeline, + keep_alive = KeepAlive} = State) -> + %% Clobber session + (catch httpc_manager:delete_session(Id, ProfileName)), + + maybe_retry_queue(Pipeline, State), + maybe_retry_queue(KeepAlive, State), + + %% Cancel timers + cancel_timers(Timers), + + %% Maybe deliver answers to requests + deliver_answer(Request), + + %% And, just in case, close our side (**really** overkill) + http_transport:close(SocketType, Socket); + +terminate(_Reason, #state{session = #session{id = Id, + socket = Socket, + socket_type = SocketType}, + request = undefined, + profile_name = ProfileName, + timers = Timers, + pipeline = Pipeline, + keep_alive = KeepAlive} = State) -> + + %% Clobber session + (catch httpc_manager:delete_session(Id, ProfileName)), + + maybe_retry_queue(Pipeline, State), + maybe_retry_queue(KeepAlive, State), + + cancel_timer(Timers#timers.queue_timer, timeout_queue), + http_transport:close(SocketType, Socket); + +terminate(_Reason, #state{request = undefined}) -> + ok; + +terminate(Reason, #state{request = Request} = State) -> + NewState = maybe_send_answer(Request, + httpc_response:error(Request, Reason), + State), + terminate(Reason, NewState#state{request = undefined}). + +%%-------------------------------------------------------------------- +%% Func: code_change(_OldVsn, State, Extra) -> {ok, NewState} +%% Purpose: Convert process state when code is changed +%%-------------------------------------------------------------------- + +code_change(_, State, _) -> + {ok, State}. + +%%%-------------------------------------------------------------------- +%%% Internal functions +%%%-------------------------------------------------------------------- +do_handle_call(#request{address = Addr} = Request, _, #state{status = Status, session = #session{type = pipeline} = Session, timers = Timers, options = #options{proxy = Proxy} = _Options, profile_name = ProfileName} = State0) when Status =/= undefined -> - - ?hcrv("new request on a pipeline session", - [{request, Request}, - {profile, ProfileName}, - {status, Status}, - {timers, Timers}]), - Address = handle_proxy(Addr, Proxy), - case httpc_request:send(Address, Session, Request) of ok -> @@ -287,9 +406,8 @@ handle_call(#request{address = Addr} = Request, _, case State0#state.request of #request{} = OldRequest -> %% Old request not yet finished - ?hcrd("old request still not finished", []), %% Make sure to use the new value of timers in state - NewTimers = State1#state.timers, + NewTimers = State1#state.timers, NewPipeline = queue:in(Request, State1#state.pipeline), NewSession = Session#session{queue_length = @@ -297,7 +415,6 @@ handle_call(#request{address = Addr} = Request, _, queue:len(NewPipeline) + 1, client_close = ClientClose}, insert_session(NewSession, ProfileName), - ?hcrd("session updated", []), {reply, ok, State1#state{ request = OldRequest, pipeline = NewPipeline, @@ -306,7 +423,6 @@ handle_call(#request{address = Addr} = Request, _, undefined -> %% Note: tcp-message receiving has already been %% activated by handle_pipeline/2. - ?hcrd("no current request", []), cancel_timer(Timers#timers.queue_timer, timeout_queue), NewSession = @@ -314,18 +430,16 @@ handle_call(#request{address = Addr} = Request, _, client_close = ClientClose}, httpc_manager:insert_session(NewSession, ProfileName), NewTimers = Timers#timers{queue_timer = undefined}, - ?hcrd("session created", []), State = init_wait_for_response_state(Request, State1#state{session = NewSession, timers = NewTimers}), {reply, ok, State} end; {error, Reason} -> - ?hcri("failed sending request", [{reason, Reason}]), NewPipeline = queue:in(Request, State0#state.pipeline), - {stop, shutdown, {pipeline_failed, Reason}, State0#state{pipeline = NewPipeline}} + {stop, {shutdown, {pipeline_failed, Reason}}, State0#state{pipeline = NewPipeline}} end; -handle_call(#request{address = Addr} = Request, _, +do_handle_call(#request{address = Addr} = Request, _, #state{status = Status, session = #session{type = keep_alive} = Session, timers = Timers, @@ -333,17 +447,11 @@ handle_call(#request{address = Addr} = Request, _, profile_name = ProfileName} = State0) when Status =/= undefined -> - ?hcrv("new request on a keep-alive session", - [{request, Request}, - {profile, ProfileName}, - {status, Status}]), - ClientClose = httpc_request:is_client_closing(Request#request.headers), case State0#state.request of #request{} -> %% Old request not yet finished %% Make sure to use the new value of timers in state - ?hcrd("old request still not finished", []), NewKeepAlive = queue:in(Request, State0#state.keep_alive), NewSession = Session#session{queue_length = @@ -351,13 +459,11 @@ handle_call(#request{address = Addr} = Request, _, queue:len(NewKeepAlive) + 1, client_close = ClientClose}, insert_session(NewSession, ProfileName), - ?hcrd("session updated", []), {reply, ok, State0#state{keep_alive = NewKeepAlive, session = NewSession}}; undefined -> %% Note: tcp-message receiving has already been %% activated by handle_pipeline/2. - ?hcrd("no current request", []), cancel_timer(Timers#timers.queue_timer, timeout_queue), NewTimers = Timers#timers{queue_timer = undefined}, @@ -365,8 +471,6 @@ handle_call(#request{address = Addr} = Request, _, Address = handle_proxy(Addr, Proxy), case httpc_request:send(Address, Session, Request) of ok -> - ?hcrd("request sent", []), - %% Activate the request time out for the new request State2 = activate_request_timeout(State1#state{request = Request}), @@ -377,22 +481,13 @@ handle_call(#request{address = Addr} = Request, _, State = init_wait_for_response_state(Request, State2#state{session = NewSession}), {reply, ok, State}; {error, Reason} -> - ?hcri("failed sending request", [{reason, Reason}]), - {stop, shutdown, {keepalive_failed, Reason}, State1} + {stop, {shutdown, {keepalive_failed, Reason}}, State1} end end; - -handle_call(info, _, State) -> +do_handle_call(info, _, State) -> Info = handler_info(State), {reply, Info, State}. -%%-------------------------------------------------------------------- -%% Function: handle_cast(Msg, State) -> {noreply, State} | -%% {noreply, State, Timeout} | -%% {stop, Reason, State} (terminate/2 is called) -%% Description: Handling cast messages -%%-------------------------------------------------------------------- - %% When the request in process has been canceled the handler process is %% stopped and the pipelined requests will be reissued or remaining %% requests will be sent on a new connection. This is is @@ -405,145 +500,102 @@ handle_call(info, _, State) -> %% handle_keep_alive_queue/2 on the other hand will just skip the %% request as if it was never issued as in this case the request will %% not have been sent. -handle_cast({cancel, RequestId}, +do_handle_cast({cancel, RequestId}, #state{request = #request{id = RequestId} = Request, - profile_name = ProfileName, canceled = Canceled} = State) -> - ?hcrv("cancel current request", [{request_id, RequestId}, - {profile, ProfileName}, - {canceled, Canceled}]), {stop, normal, State#state{canceled = [RequestId | Canceled], request = Request#request{from = answer_sent}}}; -handle_cast({cancel, RequestId}, - #state{profile_name = ProfileName, - request = #request{id = CurrId}, - canceled = Canceled} = State) -> - ?hcrv("cancel", [{request_id, RequestId}, - {curr_req_id, CurrId}, - {profile, ProfileName}, - {canceled, Canceled}]), +do_handle_cast({cancel, RequestId}, + #state{request = #request{}, + canceled = Canceled} = State) -> {noreply, State#state{canceled = [RequestId | Canceled]}}; -handle_cast({cancel, RequestId}, - #state{profile_name = ProfileName, - request = undefined, - canceled = Canceled} = State) -> - ?hcrv("cancel", [{request_id, RequestId}, - {curr_req_id, undefined}, - {profile, ProfileName}, - {canceled, Canceled}]), +do_handle_cast({cancel, _}, + #state{request = undefined} = State) -> {noreply, State}; - -handle_cast(stream_next, #state{session = Session} = State) -> +do_handle_cast(stream_next, #state{session = Session} = State) -> activate_once(Session), %% Inactivate the #state.once here because we don't want %% next_body_chunk/1 to activate the socket twice. {noreply, State#state{once = inactive}}. - -%%-------------------------------------------------------------------- -%% Function: handle_info(Info, State) -> {noreply, State} | -%% {noreply, State, Timeout} | -%% {stop, Reason, State} (terminate/2 is called) -%% Description: Handling all non call/cast messages -%%-------------------------------------------------------------------- -handle_info({Proto, _Socket, Data}, +do_handle_info({Proto, _Socket, Data}, #state{mfa = {Module, Function, Args}, - request = #request{method = Method, - stream = Stream} = Request, + request = #request{method = Method} = Request, session = Session, status_line = StatusLine} = State) when (Proto =:= tcp) orelse (Proto =:= ssl) orelse (Proto =:= httpc_handler) -> - ?hcri("received data", [{proto, Proto}, - {module, Module}, - {function, Function}, - {method, Method}, - {stream, Stream}, - {session, Session}, - {status_line, StatusLine}]), - - FinalResult = - try Module:Function([Data | Args]) of - {ok, Result} -> - ?hcrd("data processed - ok", []), - handle_http_msg(Result, State); - {_, whole_body, _} when Method =:= head -> - ?hcrd("data processed - whole body", []), - handle_response(State#state{body = <<>>}); - {Module, whole_body, [Body, Length]} -> - ?hcrd("data processed - whole body", [{length, Length}]), - {_, Code, _} = StatusLine, - {Streamed, NewBody, NewRequest} = stream(Body, Request, Code), - %% When we stream we will not keep the already - %% streamed data, that would be a waste of memory. - NewLength = - case Streamed of - false -> - Length; - true -> - Length - size(Body) - end, - - NewState = next_body_chunk(State, Code), - NewMFA = {Module, whole_body, [NewBody, NewLength]}, - {noreply, NewState#state{mfa = NewMFA, - request = NewRequest}}; - {Module, decode_size, - [TotalChunk, HexList, + try Module:Function([Data | Args]) of + {ok, Result} -> + handle_http_msg(Result, State); + {_, whole_body, _} when Method =:= head -> + handle_response(State#state{body = <<>>}); + {Module, whole_body, [Body, Length]} -> + {_, Code, _} = StatusLine, + {Streamed, NewBody, NewRequest} = stream(Body, Request, Code), + %% When we stream we will not keep the already + %% streamed data, that would be a waste of memory. + NewLength = + case Streamed of + false -> + Length; + true -> + Length - size(Body) + end, + + NewState = next_body_chunk(State, Code), + NewMFA = {Module, whole_body, [NewBody, NewLength]}, + {noreply, NewState#state{mfa = NewMFA, + request = NewRequest}}; + {Module, decode_size, + [TotalChunk, HexList, AccHeaderSize, {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]} - when BodySoFar =/= <<>> -> - ?hcrd("data processed - decode_size", []), - %% The response body is chunk-encoded. Steal decoded - %% chunks as much as possible to stream. - {_, Code, _} = StatusLine, - {_, NewBody, NewRequest} = stream(BodySoFar, Request, Code), - NewState = next_body_chunk(State, Code), - NewMFA = {Module, decode_size, - [TotalChunk, HexList, + when BodySoFar =/= <<>> -> + %% The response body is chunk-encoded. Steal decoded + %% chunks as much as possible to stream. + {_, Code, _} = StatusLine, + {_, NewBody, NewRequest} = stream(BodySoFar, Request, Code), + NewState = next_body_chunk(State, Code), + NewMFA = {Module, decode_size, + [TotalChunk, HexList, AccHeaderSize, {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]}, + {noreply, NewState#state{mfa = NewMFA, + request = NewRequest}}; + {Module, decode_data, + [ChunkSize, TotalChunk, + {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]} + when TotalChunk =/= <<>> orelse BodySoFar =/= <<>> -> + %% The response body is chunk-encoded. Steal decoded + %% chunks as much as possible to stream. + ChunkSizeToSteal = min(ChunkSize, byte_size(TotalChunk)), + <<StolenChunk:ChunkSizeToSteal/binary, NewTotalChunk/binary>> = TotalChunk, + StolenBody = <<BodySoFar/binary, StolenChunk/binary>>, + NewChunkSize = ChunkSize - ChunkSizeToSteal, + {_, Code, _} = StatusLine, + + {_, NewBody, NewRequest} = stream(StolenBody, Request, Code), + NewState = next_body_chunk(State, Code), + NewMFA = {Module, decode_data, + [NewChunkSize, NewTotalChunk, + {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]}, {noreply, NewState#state{mfa = NewMFA, request = NewRequest}}; - {Module, decode_data, - [ChunkSize, TotalChunk, - {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]} - when TotalChunk =/= <<>> orelse BodySoFar =/= <<>> -> - ?hcrd("data processed - decode_data", []), - %% The response body is chunk-encoded. Steal decoded - %% chunks as much as possible to stream. - ChunkSizeToSteal = min(ChunkSize, byte_size(TotalChunk)), - <<StolenChunk:ChunkSizeToSteal/binary, NewTotalChunk/binary>> = TotalChunk, - StolenBody = <<BodySoFar/binary, StolenChunk/binary>>, - NewChunkSize = ChunkSize - ChunkSizeToSteal, - {_, Code, _} = StatusLine, - - {_, NewBody, NewRequest} = stream(StolenBody, Request, Code), - NewState = next_body_chunk(State, Code), - NewMFA = {Module, decode_data, - [NewChunkSize, NewTotalChunk, - {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]}, - {noreply, NewState#state{mfa = NewMFA, - request = NewRequest}}; - NewMFA -> - ?hcrd("data processed - new mfa", []), - activate_once(Session), - {noreply, State#state{mfa = NewMFA}} - catch - _:_Reason -> - ?hcrd("data processing exit", [{exit, _Reason}]), - ClientReason = {could_not_parse_as_http, Data}, - ClientErrMsg = httpc_response:error(Request, ClientReason), - NewState = answer_request(Request, ClientErrMsg, State), - {stop, normal, NewState} - end, - ?hcri("data processed", [{final_result, FinalResult}]), - FinalResult; - + NewMFA -> + activate_once(Session), + {noreply, State#state{mfa = NewMFA}} + catch + _:Reason -> + ClientReason = {could_not_parse_as_http, Data}, + ClientErrMsg = httpc_response:error(Request, ClientReason), + NewState = answer_request(Request, ClientErrMsg, State), + {stop, {shutdown, Reason}, NewState} + end; -handle_info({Proto, Socket, Data}, +do_handle_info({Proto, Socket, Data}, #state{mfa = MFA, request = Request, session = Session, @@ -568,200 +620,107 @@ handle_info({Proto, Socket, Data}, {noreply, State}; - %% The Server may close the connection to indicate that the %% whole body is now sent instead of sending an length %% indicator. -handle_info({tcp_closed, _}, State = #state{mfa = {_, whole_body, Args}}) -> +do_handle_info({tcp_closed, _}, State = #state{mfa = {_, whole_body, Args}}) -> handle_response(State#state{body = hd(Args)}); -handle_info({ssl_closed, _}, State = #state{mfa = {_, whole_body, Args}}) -> +do_handle_info({ssl_closed, _}, State = #state{mfa = {_, whole_body, Args}}) -> handle_response(State#state{body = hd(Args)}); %%% Server closes idle pipeline -handle_info({tcp_closed, _}, State = #state{request = undefined}) -> +do_handle_info({tcp_closed, _}, State = #state{request = undefined}) -> {stop, normal, State}; -handle_info({ssl_closed, _}, State = #state{request = undefined}) -> +do_handle_info({ssl_closed, _}, State = #state{request = undefined}) -> {stop, normal, State}; %%% Error cases -handle_info({tcp_closed, _}, #state{session = Session0} = State) -> +do_handle_info({tcp_closed, _}, #state{session = Session0} = State) -> Socket = Session0#session.socket, Session = Session0#session{socket = {remote_close, Socket}}, %% {stop, session_remotly_closed, State}; {stop, normal, State#state{session = Session}}; -handle_info({ssl_closed, _}, #state{session = Session0} = State) -> +do_handle_info({ssl_closed, _}, #state{session = Session0} = State) -> Socket = Session0#session.socket, Session = Session0#session{socket = {remote_close, Socket}}, %% {stop, session_remotly_closed, State}; {stop, normal, State#state{session = Session}}; -handle_info({tcp_error, _, _} = Reason, State) -> +do_handle_info({tcp_error, _, _} = Reason, State) -> {stop, Reason, State}; -handle_info({ssl_error, _, _} = Reason, State) -> +do_handle_info({ssl_error, _, _} = Reason, State) -> {stop, Reason, State}; %% Timeouts %% Internally, to a request handling process, a request timeout is %% seen as a canceled request. -handle_info({timeout, RequestId}, +do_handle_info({timeout, RequestId}, #state{request = #request{id = RequestId} = Request, canceled = Canceled, profile_name = ProfileName} = State) -> - ?hcri("timeout of current request", [{id, RequestId}]), httpc_response:send(Request#request.from, httpc_response:error(Request, timeout)), httpc_manager:request_done(RequestId, ProfileName), - ?hcrv("response (timeout) sent - now terminate", []), {stop, normal, State#state{request = Request#request{from = answer_sent}, canceled = [RequestId | Canceled]}}; -handle_info({timeout, RequestId}, +do_handle_info({timeout, RequestId}, #state{canceled = Canceled, profile_name = ProfileName} = State) -> - ?hcri("timeout", [{id, RequestId}]), Filter = fun(#request{id = Id, from = From} = Request) when Id =:= RequestId -> - ?hcrv("found request", [{id, Id}, {from, From}]), %% Notify the owner httpc_response:send(From, httpc_response:error(Request, timeout)), httpc_manager:request_done(RequestId, ProfileName), - ?hcrv("response (timeout) sent", []), [Request#request{from = answer_sent}]; (_) -> true end, case State#state.status of pipeline -> - ?hcrd("pipeline", []), Pipeline = queue:filter(Filter, State#state.pipeline), {noreply, State#state{canceled = [RequestId | Canceled], pipeline = Pipeline}}; keep_alive -> - ?hcrd("keep_alive", []), KeepAlive = queue:filter(Filter, State#state.keep_alive), {noreply, State#state{canceled = [RequestId | Canceled], keep_alive = KeepAlive}} end; -handle_info(timeout_queue, State = #state{request = undefined}) -> +do_handle_info(timeout_queue, State = #state{request = undefined}) -> {stop, normal, State}; %% Timing was such as the queue_timeout was not canceled! -handle_info(timeout_queue, #state{timers = Timers} = State) -> +do_handle_info(timeout_queue, #state{timers = Timers} = State) -> {noreply, State#state{timers = Timers#timers{queue_timer = undefined}}}; %% Setting up the connection to the server somehow failed. -handle_info({init_error, Tag, ClientErrMsg}, +do_handle_info({init_error, Reason, ClientErrMsg}, State = #state{request = Request}) -> - ?hcrv("init error", [{tag, Tag}, {client_error, ClientErrMsg}]), NewState = answer_request(Request, ClientErrMsg, State), - {stop, normal, NewState}; - + {stop, {shutdown, Reason}, NewState}; %%% httpc_manager process dies. -handle_info({'EXIT', _, _}, State = #state{request = undefined}) -> +do_handle_info({'EXIT', _, _}, State = #state{request = undefined}) -> {stop, normal, State}; %%Try to finish the current request anyway, %% there is a fairly high probability that it can be done successfully. %% Then close the connection, hopefully a new manager is started that %% can retry requests in the pipeline. -handle_info({'EXIT', _, _}, State) -> +do_handle_info({'EXIT', _, _}, State) -> {noreply, State#state{status = close}}. -%%-------------------------------------------------------------------- -%% Function: terminate(Reason, State) -> _ (ignored by gen_server) -%% Description: Shutdown the httpc_handler -%%-------------------------------------------------------------------- - -%% Init error there is no socket to be closed. -terminate(normal, - #state{request = Request, - session = {send_failed, AReason} = Reason} = State) -> - ?hcrd("terminate", [{send_reason, AReason}, {request, Request}]), - maybe_send_answer(Request, - httpc_response:error(Request, Reason), - State), - ok; - -terminate(normal, - #state{request = Request, - session = {connect_failed, AReason} = Reason} = State) -> - ?hcrd("terminate", [{connect_reason, AReason}, {request, Request}]), - maybe_send_answer(Request, - httpc_response:error(Request, Reason), - State), - ok; - -terminate(normal, #state{session = undefined}) -> - ok; - -%% Init error sending, no session information has been setup but -%% there is a socket that needs closing. -terminate(normal, - #state{session = #session{id = undefined} = Session}) -> - close_socket(Session); - -%% Socket closed remotely -terminate(normal, - #state{session = #session{socket = {remote_close, Socket}, - socket_type = SocketType, - id = Id}, - profile_name = ProfileName, - request = Request, - timers = Timers, - pipeline = Pipeline, - keep_alive = KeepAlive} = State) -> - ?hcrt("terminate(normal) - remote close", - [{id, Id}, {profile, ProfileName}]), - - %% Clobber session - (catch httpc_manager:delete_session(Id, ProfileName)), - - maybe_retry_queue(Pipeline, State), - maybe_retry_queue(KeepAlive, State), - - %% Cancel timers - cancel_timers(Timers), - - %% Maybe deliver answers to requests - deliver_answer(Request), - - %% And, just in case, close our side (**really** overkill) - http_transport:close(SocketType, Socket); - -terminate(Reason, #state{session = #session{id = Id, - socket = Socket, - socket_type = SocketType}, - request = undefined, - profile_name = ProfileName, - timers = Timers, - pipeline = Pipeline, - keep_alive = KeepAlive} = State) -> - ?hcrt("terminate", - [{id, Id}, {profile, ProfileName}, {reason, Reason}]), - - %% Clobber session - (catch httpc_manager:delete_session(Id, ProfileName)), - - maybe_retry_queue(Pipeline, State), - maybe_retry_queue(KeepAlive, State), - - cancel_timer(Timers#timers.queue_timer, timeout_queue), - http_transport:close(SocketType, Socket); +call(Msg, Pid) -> + call(Msg, Pid, infinity). -terminate(Reason, #state{request = undefined}) -> - ?hcrt("terminate", [{reason, Reason}]), - ok; +call(Msg, Pid, Timeout) -> + gen_server:call(Pid, Msg, Timeout). -terminate(Reason, #state{request = Request} = State) -> - ?hcrd("terminate", [{reason, Reason}, {request, Request}]), - NewState = maybe_send_answer(Request, - httpc_response:error(Request, Reason), - State), - terminate(Reason, NewState#state{request = undefined}). +cast(Msg, Pid) -> + gen_server:cast(Pid, Msg). maybe_retry_queue(Q, State) -> case queue:is_empty(Q) of @@ -776,45 +735,13 @@ maybe_send_answer(#request{from = answer_sent}, _Reason, State) -> maybe_send_answer(Request, Answer, State) -> answer_request(Request, Answer, State). -deliver_answer(#request{id = Id, from = From} = Request) +deliver_answer(#request{from = From} = Request) when is_pid(From) -> Response = httpc_response:error(Request, socket_closed_remotely), - ?hcrd("deliver answer", [{id, Id}, {from, From}, {response, Response}]), httpc_response:send(From, Response); -deliver_answer(Request) -> - ?hcrd("skip deliver answer", [{request, Request}]), +deliver_answer(_Request) -> ok. - -%%-------------------------------------------------------------------- -%% Func: code_change(_OldVsn, State, Extra) -> {ok, NewState} -%% Purpose: Convert process state when code is changed -%%-------------------------------------------------------------------- - -code_change(_, State, _) -> - {ok, State}. - - -%% new_http_options({http_options, TimeOut, AutoRedirect, SslOpts, -%% Auth, Relaxed}) -> -%% {http_options, "HTTP/1.1", TimeOut, AutoRedirect, SslOpts, -%% Auth, Relaxed}. - -%% old_http_options({http_options, _, TimeOut, AutoRedirect, -%% SslOpts, Auth, Relaxed}) -> -%% {http_options, TimeOut, AutoRedirect, SslOpts, Auth, Relaxed}. - -%% new_queue(Queue, Fun) -> -%% List = queue:to_list(Queue), -%% NewList = -%% lists:map(fun(Request) -> -%% Settings = -%% Fun(Request#request.settings), -%% Request#request{settings = Settings} -%% end, List), -%% queue:from_list(NewList). - - %%%-------------------------------------------------------------------- %%% Internal functions %%%-------------------------------------------------------------------- @@ -872,26 +799,21 @@ connect(SocketType, ToAddress, connect_and_send_first_request(Address, Request, #state{options = Options} = State) -> SocketType = socket_type(Request), ConnTimeout = (Request#request.settings)#http_options.connect_timeout, - ?hcri("connect", - [{address, Address}, {request, Request}, {options, Options}]), case connect(SocketType, Address, Options, ConnTimeout) of {ok, Socket} -> ClientClose = - httpc_request:is_client_closing( - Request#request.headers), + httpc_request:is_client_closing( + Request#request.headers), SessionType = httpc_manager:session_type(Options), SocketType = socket_type(Request), Session = #session{id = {Request#request.address, self()}, scheme = Request#request.scheme, socket = Socket, - socket_type = SocketType, - client_close = ClientClose, - type = SessionType}, - ?hcri("connected - now send first request", [{socket, Socket}]), - + socket_type = SocketType, + client_close = ClientClose, + type = SessionType}, case httpc_request:send(Address, Session, Request) of ok -> - ?hcri("first request sent", []), TmpState = State#state{request = Request, session = Session, mfa = init_mfa(Request, State), @@ -949,12 +871,6 @@ handler_info(#state{request = Request, options = _Options, timers = _Timers} = _State) -> - ?hcrt("handler info", [{request, Request}, - {session, Session}, - {pipeline, Pipeline}, - {keep_alive, KeepAlive}, - {status, Status}]), - %% Info about the current request RequestInfo = case Request of @@ -965,8 +881,6 @@ handler_info(#state{request = Request, [{id, Id}, {started, ReqStarted}] end, - ?hcrt("handler info", [{request_info, RequestInfo}]), - %% Info about the current session/socket SessionType = Session#session.type, QueueLen = case SessionType of @@ -979,22 +893,12 @@ handler_info(#state{request = Request, Socket = Session#session.socket, SocketType = Session#session.socket_type, - ?hcrt("handler info", [{session_type, SessionType}, - {queue_length, QueueLen}, - {scheme, Scheme}, - {socket, Socket}]), - SocketOpts = http_transport:getopts(SocketType, Socket), SocketStats = http_transport:getstat(SocketType, Socket), Remote = http_transport:peername(SocketType, Socket), Local = http_transport:sockname(SocketType, Socket), - ?hcrt("handler info", [{remote, Remote}, - {local, Local}, - {socket_opts, SocketOpts}, - {socket_stats, SocketStats}]), - SocketInfo = [{remote, Remote}, {local, Local}, {socket_opts, SocketOpts}, @@ -1014,7 +918,6 @@ handler_info(#state{request = Request, handle_http_msg({Version, StatusCode, ReasonPharse, Headers, Body}, State = #state{request = Request}) -> - ?hcrt("handle_http_msg", [{headers, Headers}]), case Headers#http_response_h.'content-type' of "multipart/byteranges" ++ _Param -> exit({not_yet_implemented, multypart_byteranges}); @@ -1028,15 +931,12 @@ handle_http_msg({Version, StatusCode, ReasonPharse, Headers, Body}, end; handle_http_msg({ChunkedHeaders, Body}, #state{status_line = {_, Code, _}, headers = Headers} = State) -> - ?hcrt("handle_http_msg", - [{chunked_headers, ChunkedHeaders}, {headers, Headers}]), NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders), {_, NewBody, NewRequest} = stream(Body, State#state.request, Code), handle_response(State#state{headers = NewHeaders, body = NewBody, request = NewRequest}); handle_http_msg(Body, #state{status_line = {_,Code, _}} = State) -> - ?hcrt("handle_http_msg", [{code, Code}]), {_, NewBody, NewRequest} = stream(Body, State#state.request, Code), handle_response(State#state{body = NewBody, request = NewRequest}). @@ -1051,41 +951,28 @@ handle_http_body(_, #state{status = {ssl_tunnel, Request}, {stop, normal, NewState}; handle_http_body(<<>>, #state{status_line = {_,304, _}} = State) -> - ?hcrt("handle_http_body - 304", []), handle_response(State#state{body = <<>>}); handle_http_body(<<>>, #state{status_line = {_,204, _}} = State) -> - ?hcrt("handle_http_body - 204", []), handle_response(State#state{body = <<>>}); handle_http_body(<<>>, #state{request = #request{method = head}} = State) -> - ?hcrt("handle_http_body - head", []), handle_response(State#state{body = <<>>}); handle_http_body(Body, #state{headers = Headers, max_body_size = MaxBodySize, status_line = {_,Code, _}, request = Request} = State) -> - ?hcrt("handle_http_body", - [{max_body_size, MaxBodySize}, {headers, Headers}, {code, Code}]), TransferEnc = Headers#http_response_h.'transfer-encoding', case case_insensitive_header(TransferEnc) of "chunked" -> - ?hcrt("handle_http_body - chunked", []), try http_chunk:decode(Body, State#state.max_body_size, State#state.max_header_size) of {Module, Function, Args} -> - ?hcrt("handle_http_body - new mfa", - [{module, Module}, - {function, Function}, - {args, Args}]), NewState = next_body_chunk(State, Code), {noreply, NewState#state{mfa = {Module, Function, Args}}}; {ok, {ChunkedHeaders, NewBody}} -> - ?hcrt("handle_http_body - new body", - [{chunked_headers, ChunkedHeaders}, - {new_body, NewBody}]), NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders), case Body of @@ -1107,7 +994,6 @@ handle_http_body(Body, #state{headers = Headers, {stop, normal, NewState} end; Enc when Enc =:= "identity"; Enc =:= undefined -> - ?hcrt("handle_http_body - identity", []), Length = list_to_integer(Headers#http_response_h.'content-length'), case ((Length =< MaxBodySize) orelse (MaxBodySize =:= nolimit)) of @@ -1131,7 +1017,6 @@ handle_http_body(Body, #state{headers = Headers, {stop, normal, NewState} end; Encoding when is_list(Encoding) -> - ?hcrt("handle_http_body - other", [{encoding, Encoding}]), NewState = answer_request(Request, httpc_response:error(Request, unknown_encoding), @@ -1152,18 +1037,10 @@ handle_response(#state{request = Request, options = Options, profile_name = ProfileName} = State) when Status =/= new -> - - ?hcrd("handle response", [{profile, ProfileName}, - {status, Status}, - {request, Request}, - {session, Session}, - {status_line, StatusLine}]), - handle_cookies(Headers, Request, Options, ProfileName), case httpc_response:result({StatusLine, Headers, Body}, Request) of %% 100-continue continue -> - ?hcrd("handle response - continue", []), %% Send request body {_, RequestBody} = Request#request.content, send_raw(Session, RequestBody), @@ -1180,7 +1057,6 @@ handle_response(#state{request = Request, %% Ignore unexpected 100-continue response and receive the %% actual response that the server will send right away. {ignore, Data} -> - ?hcrd("handle response - ignore", [{data, Data}]), Relaxed = (Request#request.settings)#http_options.relaxed, MFA = {httpc_response, parse, [State#state.max_header_size, Relaxed]}, @@ -1194,23 +1070,17 @@ handle_response(#state{request = Request, %% obsolete and the manager will create a new request %% with the same id as the current. {redirect, NewRequest, Data} -> - ?hcrt("handle response - redirect", - [{new_request, NewRequest}, {data, Data}]), ok = httpc_manager:redirect_request(NewRequest, ProfileName), handle_queue(State#state{request = undefined}, Data); {retry, TimeNewRequest, Data} -> - ?hcrt("handle response - retry", - [{time_new_request, TimeNewRequest}, {data, Data}]), ok = httpc_manager:retry_request(TimeNewRequest, ProfileName), handle_queue(State#state{request = undefined}, Data); {ok, Msg, Data} -> - ?hcrd("handle response - ok", []), stream_remaining_body(Body, Request, StatusLine), end_stream(StatusLine, Request), NewState = maybe_send_answer(Request, Msg, State), handle_queue(NewState, Data); {stop, Msg} -> - ?hcrd("handle response - stop", [{msg, Msg}]), end_stream(StatusLine, Request), NewState = maybe_send_answer(Request, Msg, State), {stop, normal, NewState} @@ -1245,28 +1115,19 @@ handle_pipeline(#state{status = pipeline, profile_name = ProfileName, options = #options{pipeline_timeout = TimeOut}} = State, Data) -> - - ?hcrd("handle pipeline", [{profile, ProfileName}, - {session, Session}, - {timeout, TimeOut}]), - case queue:out(State#state.pipeline) of {empty, _} -> - ?hcrd("pipeline queue empty", []), handle_empty_queue(Session, ProfileName, TimeOut, State); {{value, NextRequest}, Pipeline} -> - ?hcrd("pipeline queue non-empty", []), case lists:member(NextRequest#request.id, State#state.canceled) of true -> - ?hcrv("next request had been cancelled", []), %% See comment for handle_cast({cancel, RequestId}) {stop, normal, State#state{request = NextRequest#request{from = answer_sent}, pipeline = Pipeline}}; false -> - ?hcrv("next request", [{request, NextRequest}]), NewSession = Session#session{queue_length = %% Queue + current @@ -1283,25 +1144,16 @@ handle_keep_alive_queue(#state{status = keep_alive, options = #options{keep_alive_timeout = TimeOut, proxy = Proxy}} = State, Data) -> - - ?hcrd("handle keep_alive", [{profile, ProfileName}, - {session, Session}, - {timeout, TimeOut}]), - case queue:out(State#state.keep_alive) of {empty, _} -> - ?hcrd("keep_alive queue empty", []), handle_empty_queue(Session, ProfileName, TimeOut, State); {{value, NextRequest}, KeepAlive} -> - ?hcrd("keep_alive queue non-empty", []), case lists:member(NextRequest#request.id, State#state.canceled) of true -> - ?hcrv("next request has already been canceled", []), handle_keep_alive_queue( State#state{keep_alive = KeepAlive}, Data); false -> - ?hcrv("next request", [{request, NextRequest}]), #request{address = Addr} = NextRequest, Address = handle_proxy(Addr, Proxy), case httpc_request:send(Address, Session, NextRequest) of @@ -1314,7 +1166,6 @@ handle_keep_alive_queue(#state{status = keep_alive, end end end. - handle_empty_queue(Session, ProfileName, TimeOut, State) -> %% The server may choose too terminate an idle pipline| keep_alive session %% in this case we want to receive the close message @@ -1350,7 +1201,6 @@ init_wait_for_response_state(Request, State) -> status_line = undefined, headers = undefined, body = undefined}. - gather_data(<<>>, Session, State) -> activate_once(Session), {noreply, State}; @@ -1381,10 +1231,6 @@ activate_request_timeout( State; _ -> ReqId = Request#request.id, - ?hcrt("activate request timer", - [{request_id, ReqId}, - {time_consumed, t() - Request#request.started}, - {timeout, Timeout}]), Msg = {timeout, ReqId}, Ref = erlang:send_after(Timeout, self(), Msg), Request2 = Request#request{timer = Ref}, @@ -1427,10 +1273,6 @@ try_to_enable_pipeline_or_keep_alive( status_line = {Version, _, _}, headers = Headers, profile_name = ProfileName} = State) -> - ?hcrd("try to enable pipeline or keep-alive", - [{version, Version}, - {headers, Headers}, - {session, Session}]), case is_keep_alive_enabled_server(Version, Headers) andalso is_keep_alive_connection(Headers, Session) of true -> @@ -1455,7 +1297,6 @@ answer_request(#request{id = RequestId, from = From} = Request, Msg, #state{session = Session, timers = Timers, profile_name = ProfileName} = State) -> - ?hcrt("answer request", [{request, Request}, {msg, Msg}]), httpc_response:send(From, Msg), RequestTimers = Timers#timers.request_timers, TimerRef = @@ -1602,42 +1443,32 @@ socket_type(#request{scheme = http}) -> ip_comm; socket_type(#request{scheme = https, settings = Settings}) -> Settings#http_options.ssl. -%% socket_type(http) -> -%% ip_comm; -%% socket_type(https) -> -%% {ssl1, []}. %% Dummy value ok for ex setopts that does not use this value start_stream({_Version, _Code, _ReasonPhrase}, _Headers, #request{stream = none} = Request) -> - ?hcrt("start stream - none", []), {ok, Request}; start_stream({_Version, Code, _ReasonPhrase}, Headers, #request{stream = self} = Request) when ?IS_STREAMED(Code) -> - ?hcrt("start stream - self", [{code, Code}]), Msg = httpc_response:stream_start(Headers, Request, ignore), httpc_response:send(Request#request.from, Msg), {ok, Request}; start_stream({_Version, Code, _ReasonPhrase}, Headers, #request{stream = {self, once}} = Request) when ?IS_STREAMED(Code) -> - ?hcrt("start stream - self:once", [{code, Code}]), Msg = httpc_response:stream_start(Headers, Request, self()), httpc_response:send(Request#request.from, Msg), {ok, Request}; start_stream({_Version, Code, _ReasonPhrase}, _Headers, #request{stream = Filename} = Request) when ?IS_STREAMED(Code) andalso is_list(Filename) -> - ?hcrt("start stream", [{code, Code}, {filename, Filename}]), case file:open(Filename, [write, raw, append, delayed_write]) of {ok, Fd} -> - ?hcri("start stream - file open ok", [{fd, Fd}]), {ok, Request#request{stream = Fd}}; {error, Reason} -> exit({stream_to_file_failed, Reason}) end; start_stream(_StatusLine, _Headers, Request) -> - ?hcrt("start stream - no op", []), {ok, Request}. stream_remaining_body(<<>>, _, _) -> @@ -1648,16 +1479,12 @@ stream_remaining_body(Body, Request, {_, Code, _}) -> %% Note the end stream message is handled by httpc_response and will %% be sent by answer_request end_stream(_, #request{stream = none}) -> - ?hcrt("end stream - none", []), ok; end_stream(_, #request{stream = self}) -> - ?hcrt("end stream - self", []), ok; end_stream(_, #request{stream = {self, once}}) -> - ?hcrt("end stream - self:once", []), ok; end_stream({_,200,_}, #request{stream = Fd}) -> - ?hcrt("end stream - 200", [{stream, Fd}]), case file:close(Fd) of ok -> ok; @@ -1665,15 +1492,13 @@ end_stream({_,200,_}, #request{stream = Fd}) -> file:close(Fd) end; end_stream({_,206,_}, #request{stream = Fd}) -> - ?hcrt("end stream - 206", [{stream, Fd}]), case file:close(Fd) of ok -> ok; {error, enospc} -> % Could be due to delayed_write file:close(Fd) end; -end_stream(SL, R) -> - ?hcrt("end stream", [{status_line, SL}, {request, R}]), +end_stream(_, _) -> ok. @@ -1702,11 +1527,8 @@ handle_verbose(trace) -> handle_verbose(_) -> ok. - - send_raw(#session{socket = Socket, socket_type = SocketType}, {ProcessBody, Acc}) when is_function(ProcessBody, 1) -> - ?hcrt("send raw", [{acc, Acc}]), send_raw(SocketType, Socket, ProcessBody, Acc); send_raw(#session{socket = Socket, socket_type = SocketType}, Body) -> http_transport:send(SocketType, Socket, Body). @@ -1717,7 +1539,6 @@ send_raw(SocketType, Socket, ProcessBody, Acc) -> ok; {ok, Data, NewAcc} -> DataBin = iolist_to_binary(Data), - ?hcrd("send", [{data, DataBin}]), case http_transport:send(SocketType, Socket, DataBin) of ok -> send_raw(SocketType, Socket, ProcessBody, NewAcc); @@ -1883,16 +1704,3 @@ update_session(ProfileName, #session{id = SessionId} = Session, Pos, Value) -> end. -%% --------------------------------------------------------------------- - -call(Msg, Pid) -> - call(Msg, Pid, infinity). - -call(Msg, Pid, Timeout) -> - gen_server:call(Pid, Msg, Timeout). - -cast(Msg, Pid) -> - gen_server:cast(Pid, Msg). - -t() -> - http_util:timestamp(). diff --git a/lib/inets/src/http_client/httpc_response.erl b/lib/inets/src/http_client/httpc_response.erl index d8bdac24e3..0fd5faa466 100644 --- a/lib/inets/src/http_client/httpc_response.erl +++ b/lib/inets/src/http_client/httpc_response.erl @@ -363,7 +363,7 @@ redirect(Response = {StatusLine, Headers, Body}, Request) -> %% Automatic redirection {ok, {Scheme, _, Host, Port, Path, Query}} -> NewHeaders = - (Request#request.headers)#http_request_h{host = Host}, + (Request#request.headers)#http_request_h{host = Host++":"++integer_to_list(Port)}, NewRequest = Request#request{redircount = Request#request.redircount+1, diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index a64ae2b87c..8aea38037d 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -88,7 +88,8 @@ real_requests()-> stream_through_mfa, streaming_error, inet_opts, - invalid_headers + invalid_headers, + invalid_body ]. only_simulated() -> @@ -125,7 +126,9 @@ only_simulated() -> redirect_see_other, redirect_temporary_redirect, port_in_host_header, - relaxed + redirect_port_in_host_header, + relaxed, + multipart_chunks ]. misc() -> @@ -1000,10 +1003,25 @@ invalid_headers(Config) -> Request = {url(group_name(Config), "/dummy.html", Config), [{"cookie", undefined}]}, {error, _} = httpc:request(get, Request, [], []). +%%------------------------------------------------------------------------- + +invalid_body(Config) -> + URL = url(group_name(Config), "/dummy.html", Config), + try + httpc:request(post, {URL, [], <<"text/plain">>, "foobar"}, + [], []), + ct:fail(accepted_invalid_input) + catch + error:function_clause -> + ok + end. + +%%------------------------------------------------------------------------- remote_socket_close(Config) when is_list(Config) -> URL = url(group_name(Config), "/just_close.html", Config), {error, socket_closed_remotely} = httpc:request(URL). + %%------------------------------------------------------------------------- remote_socket_close_async(Config) when is_list(Config) -> @@ -1102,7 +1120,20 @@ port_in_host_header(Config) when is_list(Config) -> Request = {url(group_name(Config), "/ensure_host_header_with_port.html", Config), []}, {ok, {{_, 200, _}, _, Body}} = httpc:request(get, Request, [], []), inets_test_lib:check_body(Body). +%%------------------------------------------------------------------------- +redirect_port_in_host_header(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/redirect_ensure_host_header_with_port.html", Config), []}, + {ok, {{_, 200, _}, _, Body}} = httpc:request(get, Request, [], []), + inets_test_lib:check_body(Body). + +%%------------------------------------------------------------------------- +multipart_chunks(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/multipart_chunks.html", Config), []}, + {ok, Ref} = httpc:request(get, Request, [], [{sync, false}, {stream, self}]), + ok = receive_stream_n(Ref, 10), + httpc:cancel_request(Ref). + %%------------------------------------------------------------------------- timeout_memory_leak() -> [{doc, "Check OTP-8739"}]. @@ -1398,7 +1429,7 @@ dummy_server(Caller, SocketType, Inet, Extra) -> end. dummy_server_init(Caller, ip_comm, Inet, _) -> - BaseOpts = [binary, {packet, 0}, {reuseaddr,true}, {active, false}], + BaseOpts = [binary, {packet, 0}, {reuseaddr,true}, {keepalive, true}, {active, false}], {ok, ListenSocket} = gen_tcp:listen(0, [Inet | BaseOpts]), {ok, Port} = inet:port(ListenSocket), Caller ! {port, Port}, @@ -1680,6 +1711,12 @@ handle_uri(_,"/ensure_host_header_with_port.html",_,Headers,_,_) -> "HTTP/1.1 500 Internal Server Error\r\n" ++ "Content-Length:" ++ Len ++ "\r\n\r\n" ++ B end; +handle_uri(_,"/redirect_ensure_host_header_with_port.html",Port,_,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/ensure_host_header_with_port.html", + "HTTP/1.1 302 Found \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:0\r\n\r\n"; handle_uri(_,"/300.html",Port,_,Socket,_) -> NewUri = url_start(Socket) ++ @@ -1968,6 +2005,16 @@ handle_uri(_,"/missing_CR.html",_,_,_,_) -> "Content-Length:32\r\n\n" ++ "<HTML><BODY>foobar</BODY></HTML>"; +handle_uri(_,"/multipart_chunks.html",_,_,Socket,_) -> + Head = "HTTP/1.1 200 ok\r\n" ++ + "Transfer-Encoding:chunked\r\n" ++ + "Date: " ++ httpd_util:rfc1123_date() ++ "\r\n" + "Connection: Keep-Alive\r\n" ++ + "Content-Type: multipart/x-mixed-replace; boundary=chunk_boundary\r\n" ++ + "\r\n", + send(Socket, Head), + send_multipart_chunks(Socket), + http_chunk:encode_last(); handle_uri("HEAD",_,_,_,_,_) -> "HTTP/1.1 200 ok\r\n" ++ "Content-Length:0\r\n\r\n"; @@ -2264,3 +2311,21 @@ otp_8739_dummy_server_main(_Parent, ListenSocket) -> Error -> exit(Error) end. + +send_multipart_chunks(Socket) -> + send(Socket, http_chunk:encode("--chunk_boundary\r\n")), + send(Socket, http_chunk:encode("Content-Type: text/plain\r\nContent-Length: 4\r\n\r\n")), + send(Socket, http_chunk:encode("test\r\n")), + ct:sleep(500), + send_multipart_chunks(Socket). + +receive_stream_n(_, 0) -> + ok; +receive_stream_n(Ref, N) -> + receive + {http, {Ref, stream_start, _}} -> + receive_stream_n(Ref, N); + {http, {Ref,stream, Data}} -> + ct:pal("Data: ~p", [Data]), + receive_stream_n(Ref, N-1) + end. diff --git a/lib/kernel/doc/src/code.xml b/lib/kernel/doc/src/code.xml index f881fd76fd..878a450f0f 100644 --- a/lib/kernel/doc/src/code.xml +++ b/lib/kernel/doc/src/code.xml @@ -258,7 +258,7 @@ zip:create("mnesia-4.4.7.ez", both strings and atoms, but a future release will probably only allow the arguments that are documented.</p> - <p>As from Erlang/OTP R12B, functions in this module generally fail with an + <p>Functions in this module generally fail with an exception if they are passed an incorrect type (for example, an integer or a tuple where an atom is expected). An error tuple is returned if the argument type is correct, but there are some other errors (for example, a non-existing directory diff --git a/lib/kernel/doc/src/config.xml b/lib/kernel/doc/src/config.xml index c5f37fd036..c10f11b187 100644 --- a/lib/kernel/doc/src/config.xml +++ b/lib/kernel/doc/src/config.xml @@ -77,8 +77,8 @@ to update the application configurations.</p> <p>This means that specifying another <c>.config</c> file, or more <c>.config</c> files, leads to inconsistent update of application - configurations. Therefore, in Erlang 5.4/OTP R10B, the syntax of - <c>sys.config</c> was extended to allow pointing out other + configurations. There is, however, a syntax for + <c>sys.config</c> that allows pointing out other <c>.config</c> files:</p> <code type="none"> [{Application, [{Par, Val}]} | File].</code> diff --git a/lib/kernel/doc/src/heart.xml b/lib/kernel/doc/src/heart.xml index 59a046bf4d..5b5b71e521 100644 --- a/lib/kernel/doc/src/heart.xml +++ b/lib/kernel/doc/src/heart.xml @@ -37,10 +37,7 @@ the <c>heart</c> port program is to check that the Erlang runtime system it is supervising is still running. If the port program has not received any heartbeats within <c>HEART_BEAT_TIMEOUT</c> seconds - (defaults to 60 seconds), the system can be rebooted. Also, if - the system is equipped with a hardware watchdog timer and is - running Solaris, the watchdog can be used to supervise the entire - system.</p> + (defaults to 60 seconds), the system can be rebooted.</p> <p>An Erlang runtime system to be monitored by a heart program is to be started with command-line flag <c>-heart</c> (see also <seealso marker="erts:erl"><c>erl(1)</c></seealso>). @@ -51,17 +48,13 @@ or a terminated Erlang runtime system, environment variable <c>HEART_COMMAND</c> must be set before the system is started. If this variable is not set, a warning text is printed but - the system does not reboot. However, if the hardware watchdog is - used, it still triggers a reboot <c>HEART_BEAT_BOOT_DELAY</c> - seconds later (defaults to 60 seconds).</p> + the system does not reboot.</p> <p>To reboot on Windows, <c>HEART_COMMAND</c> can be set to <c>heart -shutdown</c> (included in the Erlang delivery) or to any other suitable program that can activate a reboot.</p> - <p>The hardware watchdog is not started under Solaris if - environment variable <c>HW_WD_DISABLE</c> is set.</p> - <p>The environment variables <c>HEART_BEAT_TIMEOUT</c> and - <c>HEART_BEAT_BOOT_DELAY</c> can be used to configure the heart - time-outs; they can be set in the operating system shell before Erlang + <p>The environment variable <c>HEART_BEAT_TIMEOUT</c> + can be used to configure the heart + time-outs; it can be set in the operating system shell before Erlang is started or be specified at the command line:</p> <pre> % <input>erl -heart -env HEART_BEAT_TIMEOUT 30 ...</input></pre> diff --git a/lib/kernel/doc/src/seq_trace.xml b/lib/kernel/doc/src/seq_trace.xml index ba7259219d..b80e87c118 100644 --- a/lib/kernel/doc/src/seq_trace.xml +++ b/lib/kernel/doc/src/seq_trace.xml @@ -427,12 +427,6 @@ prev_cnt := tcurr</code> built with <c>Erl_Interface</c> only maintains one trace token, which means that the C-node appears as one process from the sequential tracing point of view.</p> - <p>To be able to perform sequential tracing between - distributed Erlang nodes, the distribution protocol has been - extended (in a backward compatible way). An Erlang node - supporting sequential tracing can communicate with an older - (Erlang/OTP R3B) node but messages passed within that node can - not be traced.</p> </section> <section> diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl index 7b3f1e313a..ad92aafc2f 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -35,7 +35,8 @@ dump_monitors/1, dump_links/1, flat_size/1, get_internal_state/1, instructions/0, lock_counters/1, map_info/1, same/2, set_internal_state/2, - size_shared/1, copy_shared/1]). + size_shared/1, copy_shared/1, dirty_cpu/2, dirty_io/2, + dirty/3]). -spec breakpoint(MFA, Flag) -> non_neg_integer() when MFA :: {Module :: module(), @@ -182,6 +183,28 @@ same(_, _) -> set_internal_state(_, _) -> erlang:nif_error(undef). +-spec dirty_cpu(Term1, Term2) -> term() when + Term1 :: term(), + Term2 :: term(). + +dirty_cpu(_, _) -> + erlang:nif_error(undef). + +-spec dirty_io(Term1, Term2) -> term() when + Term1 :: term(), + Term2 :: term(). + +dirty_io(_, _) -> + erlang:nif_error(undef). + +-spec dirty(Term1, Term2, Term3) -> term() when + Term1 :: term(), + Term2 :: term(), + Term3 :: term(). + +dirty(_, _, _) -> + erlang:nif_error(undef). + %%% End of BIFs %% size(Term) diff --git a/lib/kernel/src/heart.erl b/lib/kernel/src/heart.erl index eea78aabdf..8fa48d56fb 100644 --- a/lib/kernel/src/heart.erl +++ b/lib/kernel/src/heart.erl @@ -198,16 +198,11 @@ start_portprogram() -> end. get_heart_timeouts() -> - HeartOpts = case os:getenv("HEART_BEAT_TIMEOUT") of - false -> ""; - H when is_list(H) -> - "-ht " ++ H - end, - HeartOpts ++ case os:getenv("HEART_BEAT_BOOT_DELAY") of - false -> ""; - W when is_list(W) -> - " -wt " ++ W - end. + case os:getenv("HEART_BEAT_TIMEOUT") of + false -> ""; + H when is_list(H) -> + "-ht " ++ H + end. check_start_heart() -> case init:get_argument(heart) of diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl index 2f9f81104a..13e73f027d 100644 --- a/lib/observer/src/crashdump_viewer.erl +++ b/lib/observer/src/crashdump_viewer.erl @@ -928,7 +928,10 @@ general_info(File) -> WholeLine -> WholeLine end, - GI = get_general_info(Fd,#general_info{created=Created}), + {Slogan,SysVsn} = get_slogan_and_sysvsn(Fd,[]), + GI = get_general_info(Fd,#general_info{created=Created, + slogan=Slogan, + system_vsn=SysVsn}), {MemTot,MemMax} = case lookup_index(?memory) of @@ -982,12 +985,20 @@ general_info(File) -> mem_max=MemMax, instr_info=InstrInfo}. +get_slogan_and_sysvsn(Fd,Acc) -> + case val(Fd,eof) of + "Slogan: " ++ SloganPart when Acc==[] -> + get_slogan_and_sysvsn(Fd,[SloganPart]); + "System version: " ++ SystemVsn -> + {lists:append(lists:reverse(Acc)),SystemVsn}; + eof -> + {lists:append(lists:reverse(Acc)),"-1"}; + SloganPart -> + get_slogan_and_sysvsn(Fd,[[$\n|SloganPart]|Acc]) + end. + get_general_info(Fd,GenInfo) -> case line_head(Fd) of - "Slogan" -> - get_general_info(Fd,GenInfo#general_info{slogan=val(Fd)}); - "System version" -> - get_general_info(Fd,GenInfo#general_info{system_vsn=val(Fd)}); "Compiled" -> get_general_info(Fd,GenInfo#general_info{compile_time=val(Fd)}); "Taints" -> diff --git a/lib/observer/src/etop.erl b/lib/observer/src/etop.erl index fcb900960b..925f4456bb 100644 --- a/lib/observer/src/etop.erl +++ b/lib/observer/src/etop.erl @@ -23,7 +23,7 @@ -export([start/0, start/1, config/2, stop/0, dump/1, help/0]). %% Internal -export([update/1]). --export([loadinfo/1, meminfo/2, getopt/2]). +-export([loadinfo/2, meminfo/2, getopt/2]). -include("etop.hrl"). -include("etop_defs.hrl"). @@ -319,18 +319,18 @@ output(graphical) -> exit({deprecated, "Use observer instead"}); output(text) -> etop_txt. -loadinfo(SysI) -> +loadinfo(SysI,Prev) -> #etop_info{n_procs = Procs, run_queue = RQ, now = Now, wall_clock = WC, runtime = RT} = SysI, - Cpu = calculate_cpu_utilization(WC,RT), + Cpu = calculate_cpu_utilization(WC,RT,Prev#etop_info.runtime), Clock = io_lib:format("~2.2.0w:~2.2.0w:~2.2.0w", tuple_to_list(element(2,calendar:now_to_datetime(Now)))), {Cpu,Procs,RQ,Clock}. -calculate_cpu_utilization({_,WC},{_,RT}) -> +calculate_cpu_utilization({_,WC},{_,RT},_) -> %% Old version of observer_backend, using statistics(wall_clock) %% and statistics(runtime) case {WC,RT} of @@ -341,15 +341,23 @@ calculate_cpu_utilization({_,WC},{_,RT}) -> _ -> round(100*RT/WC) end; -calculate_cpu_utilization(_,undefined) -> +calculate_cpu_utilization(_,undefined,_) -> %% First time collecting - no cpu utilization has been measured %% since scheduler_wall_time flag is not yet on 0; -calculate_cpu_utilization(_,RTInfo) -> +calculate_cpu_utilization(WC,RTInfo,undefined) -> + %% Second time collecting - RTInfo shows scheduler_wall_time since + %% flag was set to true. Faking previous values by setting + %% everything to zero. + ZeroRT = [{Id,0,0} || {Id,_,_} <- RTInfo], + calculate_cpu_utilization(WC,RTInfo,ZeroRT); +calculate_cpu_utilization(_,RTInfo,PrevRTInfo) -> %% New version of observer_backend, using statistics(scheduler_wall_time) - Sum = lists:foldl(fun({_,A,T},{AAcc,TAcc}) -> {A+AAcc,T+TAcc} end, + Sum = lists:foldl(fun({{_, A0, T0}, {_, A1, T1}},{AAcc,TAcc}) -> + {(A1 - A0)+AAcc,(T1 - T0)+TAcc} + end, {0,0}, - RTInfo), + lists:zip(PrevRTInfo,RTInfo)), case Sum of {0,0} -> 0; diff --git a/lib/observer/src/etop_txt.erl b/lib/observer/src/etop_txt.erl index 3b4c176478..6b8f9df24f 100644 --- a/lib/observer/src/etop_txt.erl +++ b/lib/observer/src/etop_txt.erl @@ -22,35 +22,35 @@ %%-compile(export_all). -export([init/1,stop/1]). --export([do_update/3]). +-export([do_update/4]). -include("etop.hrl"). -include("etop_defs.hrl"). --import(etop,[loadinfo/1,meminfo/2]). +-import(etop,[loadinfo/2,meminfo/2]). -define(PROCFORM,"~-15w~-20s~8w~8w~8w~8w ~-20s~n"). stop(Pid) -> Pid ! stop. init(Config) -> - loop(Config). + loop(#etop_info{},Config). -loop(Config) -> - Info = do_update(Config), +loop(Prev,Config) -> + Info = do_update(Prev,Config), receive stop -> stopped; - {dump,Fd} -> do_update(Fd,Info,Config), loop(Config); - {config,_,Config1} -> loop(Config1) - after Config#opts.intv -> loop(Config) + {dump,Fd} -> do_update(Fd,Info,Prev,Config), loop(Info,Config); + {config,_,Config1} -> loop(Info,Config1) + after Config#opts.intv -> loop(Info,Config) end. -do_update(Config) -> +do_update(Prev,Config) -> Info = etop:update(Config), - do_update(standard_io,Info,Config). + do_update(standard_io,Info,Prev,Config). -do_update(Fd,Info,Config) -> - {Cpu,NProcs,RQ,Clock} = loadinfo(Info), +do_update(Fd,Info,Prev,Config) -> + {Cpu,NProcs,RQ,Clock} = loadinfo(Info,Prev), io:nl(Fd), writedoubleline(Fd), case Info#etop_info.memi of diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index 59a2f9f205..1eaba31a3a 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -461,14 +461,16 @@ create_box(Parent, Data) -> link_entry(Panel,Value); _ -> Value = to_str(Value0), - case length(Value) > 100 of - true -> - Shown = lists:sublist(Value, 80), + case string:sub_word(lists:sublist(Value, 80),1,$\n) of + Value -> + %% Short string, no newlines - show all + wxStaticText:new(Panel, ?wxID_ANY, Value); + Shown -> + %% Long or with newlines, + %% use tooltip to show all TCtrl = wxStaticText:new(Panel, ?wxID_ANY, [Shown,"..."]), wxWindow:setToolTip(TCtrl,wxToolTip:new(Value)), - TCtrl; - false -> - wxStaticText:new(Panel, ?wxID_ANY, Value) + TCtrl end end, wxSizer:add(Line, 10, 0), % space of size 10 horisontally diff --git a/lib/observer/src/observer_pro_wx.erl b/lib/observer/src/observer_pro_wx.erl index ee6829b847..f07b9e295a 100644 --- a/lib/observer/src/observer_pro_wx.erl +++ b/lib/observer/src/observer_pro_wx.erl @@ -511,7 +511,13 @@ table_holder(#holder{info=Info, attrs=Attrs, table_holder(S0); {dump, Fd} -> EtopInfo = (S0#holder.etop)#etop_info{procinfo=array:to_list(Info)}, - etop_txt:do_update(Fd, EtopInfo, #opts{node=Node}), + %% The empty #etop_info{} below is a dummy previous info + %% value. It is used by etop to calculate the scheduler + %% utilization since last update. When dumping to file, + %% there is no previous measurement to use, so we just add + %% a dummy here, and the value shown will be since the + %% tool was started. + etop_txt:do_update(Fd, EtopInfo, #etop_info{}, #opts{node=Node}), file:close(Fd), table_holder(S0); stop -> diff --git a/lib/os_mon/src/memsup.erl b/lib/os_mon/src/memsup.erl index 4729d090f8..0a9a883390 100644 --- a/lib/os_mon/src/memsup.erl +++ b/lib/os_mon/src/memsup.erl @@ -701,6 +701,7 @@ get_os_wordsize_with_uname() -> "sparc64" -> 64; "amd64" -> 64; "ppc64" -> 64; + "s390x" -> 64; _ -> 32 end. diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index 05c09f8996..3d6238d998 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -1029,19 +1029,16 @@ do_pkix_crls_validate(OtpCert, [{DP, CRL, DeltaCRL} | Rest], All, Options, Revo end. sort_dp_crls(DpsAndCrls, FreshCB) -> - Sorted = do_sort_dp_crls(DpsAndCrls, dict:new()), - sort_crls(Sorted, FreshCB, []). - -do_sort_dp_crls([], Dict) -> - dict:to_list(Dict); -do_sort_dp_crls([{DP, CRL} | Rest], Dict0) -> - Dict = try dict:fetch(DP, Dict0) of - _ -> - dict:append(DP, CRL, Dict0) - catch _:_ -> - dict:store(DP, [CRL], Dict0) - end, - do_sort_dp_crls(Rest, Dict). + sort_crls(maps:to_list(lists:foldl(fun group_dp_crls/2, + #{}, + DpsAndCrls)), + FreshCB, []). + +group_dp_crls({DP,CRL}, M) -> + case M of + #{DP := CRLs} -> M#{DP := [CRL|CRLs]}; + _ -> M#{DP => [CRL]} + end. sort_crls([], _, Acc) -> Acc; diff --git a/lib/runtime_tools/doc/src/LTTng.xml b/lib/runtime_tools/doc/src/LTTng.xml index 82a4c79379..7aae5e5c41 100644 --- a/lib/runtime_tools/doc/src/LTTng.xml +++ b/lib/runtime_tools/doc/src/LTTng.xml @@ -1,4 +1,4 @@ -<?xml version="1.0" encoding="utf8" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE chapter SYSTEM "chapter.dtd"> <chapter> <header> diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl index e943fb4a3e..b27bc63d15 100644 --- a/lib/runtime_tools/src/observer_backend.erl +++ b/lib/runtime_tools/src/observer_backend.erl @@ -314,13 +314,12 @@ etop_collect(Collector) -> case SchedulerWallTime of undefined -> - spawn(fun() -> flag_holder_proc(Collector) end), + erlang:system_flag(scheduler_wall_time,true), + spawn(fun() -> flag_holder_proc(Collector) end), ok; _ -> ok - end, - - erlang:system_flag(scheduler_wall_time,true). + end. flag_holder_proc(Collector) -> Ref = erlang:monitor(process,Collector), diff --git a/lib/sasl/test/release_handler_SUITE_data/start b/lib/sasl/test/release_handler_SUITE_data/start index 87275045b1..eab2b77aed 100755 --- a/lib/sasl/test/release_handler_SUITE_data/start +++ b/lib/sasl/test/release_handler_SUITE_data/start @@ -21,8 +21,7 @@ then fi HEART_COMMAND=$ROOTDIR/bin/start -HW_WD_DISABLE=true -export HW_WD_DISABLE HEART_COMMAND +export HEART_COMMAND START_ERL_DATA=${1:-$RELDIR/start_erl.data} diff --git a/lib/sasl/test/release_handler_SUITE_data/start_client b/lib/sasl/test/release_handler_SUITE_data/start_client index 5ea94d6f7c..05d744f06e 100755 --- a/lib/sasl/test/release_handler_SUITE_data/start_client +++ b/lib/sasl/test/release_handler_SUITE_data/start_client @@ -24,8 +24,7 @@ RELDIR=$CLIENTDIR/releases # Note that this scripts is modified an copied to $CLIENTDIR/bin/start # in release_handler_SUITE:copy_client - therefore HEART_COMMAND is as follows: HEART_COMMAND=$CLIENTDIR/bin/start -HW_WD_DISABLE=true -export HW_WD_DISABLE HEART_COMMAND +export HEART_COMMAND START_ERL_DATA=${1:-$RELDIR/start_erl.data} diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index ca61782639..db09ec3dc5 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -8,6 +8,10 @@ %% {update, snmpa_local_db, soft, soft_purge, soft_purge, []} %% {add_module, snmpm_net_if_mt} [ + {<<"5\\.2\\.4">>, + [{load_module, snmp, soft_purge, soft_purge, []}, + {load_module, snmpc_lib, soft_purge, soft_purge, []}, + {load_module, snmpc_mib_gram, soft_purge, soft_purge, []}]}, {<<"5\\..*">>, [{restart_application, snmp}]}, {<<"4\\..*">>, [{restart_application, snmp}]} ], @@ -17,6 +21,10 @@ %% {remove, {snmpm_net_if_mt, soft_purge, soft_purge}} [ + {<<"5\\.2\\.4">>, + [{load_module, snmp, soft_purge, soft_purge, []}, + {load_module, snmpc_lib, soft_purge, soft_purge, []}, + {load_module, snmpc_mib_gram, soft_purge, soft_purge, []}]}, {<<"5\\..*">>, [{restart_application, snmp}]}, {<<"4\\..*">>, [{restart_application, snmp}]} ] diff --git a/lib/snmp/src/app/snmp.erl b/lib/snmp/src/app/snmp.erl index df3933ea01..8a736f688b 100644 --- a/lib/snmp/src/app/snmp.erl +++ b/lib/snmp/src/app/snmp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -573,9 +573,16 @@ print_mod_info(Prefix, {Module, Info}) -> CompDate = case key1search(compile_time, Info) of {value, {Year, Month, Day, Hour, Min, Sec}} -> - lists:flatten( - io_lib:format("~w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w", - [Year, Month, Day, Hour, Min, Sec])); + io_lib:format( + "~w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w", + [Year, Month, Day, Hour, Min, Sec]); + _ -> + "Not found" + end, + Digest = + case key1search(md5, Info) of + {value, MD5} when is_binary(MD5) -> + [io_lib:format("~2.16.0b", [Byte]) || <<Byte>> <= MD5]; _ -> "Not found" end, @@ -583,12 +590,14 @@ print_mod_info(Prefix, {Module, Info}) -> "~s Vsn: ~s~n" "~s App vsn: ~s~n" "~s Compiler ver: ~s~n" - "~s Compile time: ~s~n", + "~s Compile time: ~s~n" + "~s MD5 digest: ~s~n", [Prefix, Module, Prefix, Vsn, Prefix, AppVsn, - Prefix, CompVer, - Prefix, CompDate]), + Prefix, CompVer, + Prefix, CompDate, + Prefix, Digest]), ok. key1search(Key, Vals) -> @@ -617,7 +626,7 @@ versions1() -> Error -> Error end. - + versions2() -> case ms2() of {ok, Mods} -> @@ -625,25 +634,56 @@ versions2() -> Error -> Error end. - + version_info(Mods) -> SysInfo = sys_info(), OsInfo = os_info(), ModInfo = [mod_version_info(Mod) || Mod <- Mods], [{sys_info, SysInfo}, {os_info, OsInfo}, {mod_info, ModInfo}]. - + mod_version_info(Mod) -> Info = Mod:module_info(), - {value, {attributes, Attr}} = lists:keysearch(attributes, 1, Info), - {value, {vsn, [Vsn]}} = lists:keysearch(vsn, 1, Attr), - {value, {app_vsn, AppVsn}} = lists:keysearch(app_vsn, 1, Attr), - {value, {compile, Comp}} = lists:keysearch(compile, 1, Info), - {value, {version, Ver}} = lists:keysearch(version, 1, Comp), - {value, {time, Time}} = lists:keysearch(time, 1, Comp), - {Mod, [{vsn, Vsn}, - {app_vsn, AppVsn}, - {compiler_version, Ver}, - {compile_time, Time}]}. + {Mod, + case key1search(attributes, Info) of + {value, Attr} -> + case key1search(vsn, Attr) of + {value, [Vsn]} -> + [{vsn, Vsn}]; + not_found -> + [] + end ++ + case key1search(app_vsn, Attr) of + {value, AppVsn} -> + [{app_vsn, AppVsn}]; + not_found -> + [] + end; + not_found -> + [] + end ++ + case key1search(compile, Info) of + {value, Comp} -> + case key1search(version, Comp) of + {value, Ver} -> + [{compiler_version, Ver}]; + not_found -> + [] + end ++ + case key1search(time, Comp) of + {value, Ver} -> + [{compile_time, Ver}]; + not_found -> + [] + end; + not_found -> + [] + end ++ + case key1search(md5, Info) of + {value, Bin} -> + [{md5, Bin}]; + not_found -> + [] + end}. sys_info() -> SysArch = string:strip(erlang:system_info(system_architecture),right,$\n), diff --git a/lib/snmp/src/compile/snmpc_lib.erl b/lib/snmp/src/compile/snmpc_lib.erl index 51690b6e7e..33ddd78308 100644 --- a/lib/snmp/src/compile/snmpc_lib.erl +++ b/lib/snmp/src/compile/snmpc_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -99,7 +99,7 @@ make_ASN1type({{type_with_size,Type,{range,Lo,Hi}},Line}) -> print_error("Undefined type '~w'",[Type],Line), guess_string_type() end; -make_ASN1type({{integer_with_enum,Type,Enums},Line}) -> +make_ASN1type({{type_with_enum,Type,Enums},Line}) -> case lookup_vartype(Type) of {value,ASN1type} -> ASN1type#asn1_type{assocList = [{enums, Enums}]}; false -> diff --git a/lib/snmp/src/compile/snmpc_mib_gram.yrl b/lib/snmp/src/compile/snmpc_mib_gram.yrl index 743c3a6550..14a668127e 100644 --- a/lib/snmp/src/compile/snmpc_mib_gram.yrl +++ b/lib/snmp/src/compile/snmpc_mib_gram.yrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -387,10 +387,12 @@ syntax -> type : {{type, cat('$1')},line_of('$1')}. syntax -> type size : {{type_with_size, cat('$1'), '$2'},line_of('$1')}. syntax -> usertype size : {{type_with_size,val('$1'), '$2'},line_of('$1')}. syntax -> 'INTEGER' '{' namedbits '}' : - {{integer_with_enum, 'INTEGER', '$3'}, line_of('$1')}. + {{type_with_enum, 'INTEGER', '$3'}, line_of('$1')}. syntax -> 'BITS' '{' namedbits '}' : ensure_ver(2,'$1'), {{bits, '$3'}, line_of('$1')}. +syntax -> usertype '{' namedbits '}' : + {{type_with_enum, 'INTEGER', '$3'}, line_of('$1')}. syntax -> 'SEQUENCE' 'OF' usertype : {{sequence_of,val('$3')},line_of('$1')}. diff --git a/lib/snmp/test/snmp_compiler_test.erl b/lib/snmp/test/snmp_compiler_test.erl index 2c8851c2a7..9b3c2bfd2c 100644 --- a/lib/snmp/test/snmp_compiler_test.erl +++ b/lib/snmp/test/snmp_compiler_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2016. All Rights Reserved. +%% Copyright Ericsson AB 2003-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -56,7 +56,8 @@ otp_8574/1, otp_8595/1, otp_10799/1, - otp_10808/1 + otp_10808/1, + otp_14145/1 ]). @@ -135,7 +136,8 @@ all() -> ]. groups() -> - [{tickets, [], [otp_6150, otp_8574, otp_8595, otp_10799, otp_10808]}]. + [{tickets, [], + [otp_6150, otp_8574, otp_8595, otp_10799, otp_10808, otp_14145]}]. init_per_group(_GroupName, Config) -> Config. @@ -431,6 +433,30 @@ otp_10808(Config) when is_list(Config) -> %%====================================================================== +otp_14145(suite) -> + []; +otp_14145(Config) when is_list(Config) -> + put(tname, otp10808), + p("starting with Config: ~p~n", [Config]), + + Dir = ?config(case_top_dir, Config), + MibDir = ?config(mib_dir, Config), + MibName = "OTP14145-MIB", + MibFile = join(MibDir, MibName++".mib"), + ?line {ok, MibBin} = + snmpc:compile(MibFile, [{outdir, Dir}, + {verbosity, trace}, + {group_check, false}, + module_compliance]), + p("Mib: ~n~p~n", [MibBin]), + MIB = read_mib(MibBin), + Oid = [1,3,6,1,2,1,67,4], + check_mib(MIB#mib.mes, Oid, undefined), + ok. + + +%%====================================================================== + augments_extra_info(suite) -> []; augments_extra_info(Config) when is_list(Config) -> diff --git a/lib/snmp/test/snmp_test_data/OTP14145-MIB.mib b/lib/snmp/test/snmp_test_data/OTP14145-MIB.mib new file mode 100644 index 0000000000..f29c65c4c2 --- /dev/null +++ b/lib/snmp/test/snmp_test_data/OTP14145-MIB.mib @@ -0,0 +1,44 @@ +OTP14145-MIB DEFINITIONS ::= BEGIN + +IMPORTS + MODULE-IDENTITY, OBJECT-TYPE, + mib-2 FROM SNMPv2-SMI + InetAddressType, InetAddress FROM INET-ADDRESS-MIB + MODULE-COMPLIANCE, OBJECT-GROUP FROM SNMPv2-CONF; + +testMibId MODULE-IDENTITY + LAST-UPDATED "200608210000Z" -- 21 August 2006 + ORGANIZATION "a" + CONTACT-INFO "a" + DESCRIPTION "a" + REVISION "200608210000Z" -- 21 August 2006 + DESCRIPTION "a" + ::= { mib-2 67 } + +testObj OBJECT-TYPE + SYNTAX InetAddressType + -- SYNTAX InetAddress + MAX-ACCESS read-only + STATUS current + DESCRIPTION "a" + ::= { testMibId 2 } + +testObjId OBJECT IDENTIFIER ::= { testMibId 3 } + +testMibCompliance MODULE-COMPLIANCE + STATUS current + DESCRIPTION "a" + MODULE + OBJECT testObj + SYNTAX InetAddressType { ipv4(1), ipv6(2) } + -- SYNTAX InetAddress ( SIZE(4|16) ) + DESCRIPTION "a" + ::= { testMibId 4 } + +testObjGroup OBJECT-GROUP + OBJECTS { testObj } + STATUS current + DESCRIPTION "a" + ::= { testObjId 1 } + +END diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index 28eba0d0d6..30b8ee1124 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2016. All Rights Reserved. +# Copyright Ericsson AB 1997-2017. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = snmp -SNMP_VSN = 5.2.4 +SNMP_VSN = 5.2.5 PRE_VSN = APP_VSN = "$(APPLICATION)-$(SNMP_VSN)$(PRE_VSN)" diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl index ac35b70209..9b54ecb2dd 100644 --- a/lib/ssh/src/ssh_auth.erl +++ b/lib/ssh/src/ssh_auth.erl @@ -406,7 +406,11 @@ handle_userauth_info_response(#ssh_msg_userauth_info_response{num_responses = 1, kb_tries_left = KbTriesLeft, user = User, userauth_supported_methods = Methods} = Ssh) -> - SendOneEmpty = proplists:get_value(tstflg, Opts) == one_empty, + SendOneEmpty = + (proplists:get_value(tstflg,Opts) == one_empty) + orelse + proplists:get_value(one_empty, proplists:get_value(tstflg,Opts,[]), false), + case check_password(User, unicode:characters_to_list(Password), Opts, Ssh) of {true,Ssh1} when SendOneEmpty==true -> Msg = #ssh_msg_userauth_info_request{name = "", diff --git a/lib/ssh/src/ssh_bits.erl b/lib/ssh/src/ssh_bits.erl index 8bedaaf0c5..3ce7758447 100644 --- a/lib/ssh/src/ssh_bits.erl +++ b/lib/ssh/src/ssh_bits.erl @@ -30,39 +30,31 @@ -export([random/1]). %%%---------------------------------------------------------------- -name_list([Name]) -> to_bin(Name); -name_list([Name|Ns]) -> <<(to_bin(Name))/binary, ",", (name_list(Ns))/binary>>; -name_list([]) -> <<>>. - -to_bin(A) when is_atom(A) -> list_to_binary(atom_to_list(A)); -to_bin(S) when is_list(S) -> list_to_binary(S); -to_bin(B) when is_binary(B) -> B. +name_list(NamesList) -> list_to_binary(lists:join($,, NamesList)). %%%---------------------------------------------------------------- %%% Multi Precision Integer encoding mpint(-1) -> <<0,0,0,1,16#ff>>; mpint(0) -> <<0,0,0,0>>; -mpint(X) when X < 0 -> mpint_neg(X,0,[]); -mpint(X) -> mpint_pos(X,0,[]). - -mpint_neg(-1,I,Ds=[MSB|_]) -> - if MSB band 16#80 =/= 16#80 -> - <<?UINT32((I+1)), (list_to_binary([255|Ds]))/binary>>; - true -> - <<?UINT32(I), (list_to_binary(Ds))/binary>> - end; -mpint_neg(X,I,Ds) -> - mpint_neg(X bsr 8,I+1,[(X band 255)|Ds]). - -mpint_pos(0,I,Ds=[MSB|_]) -> - if MSB band 16#80 == 16#80 -> - <<?UINT32((I+1)), (list_to_binary([0|Ds]))/binary>>; - true -> - <<?UINT32(I), (list_to_binary(Ds))/binary>> +mpint(I) when I>0 -> + <<B1,V/binary>> = binary:encode_unsigned(I), + case B1 band 16#80 of + 16#80 -> + <<(size(V)+2):32/unsigned-big-integer, 0,B1,V/binary >>; + _ -> + <<(size(V)+1):32/unsigned-big-integer, B1,V/binary >> end; -mpint_pos(X,I,Ds) -> - mpint_pos(X bsr 8,I+1,[(X band 255)|Ds]). - +mpint(N) when N<0 -> + Sxn = 8*size(binary:encode_unsigned(-N)), + Sxn1 = Sxn+8, + <<W:Sxn1>> = <<1, 0:Sxn>>, + <<B1,V/binary>> = binary:encode_unsigned(W+N), + case B1 band 16#80 of + 16#80 -> + <<(size(V)+1):32/unsigned-big-integer, B1,V/binary >>; + _ -> + <<(size(V)+2):32/unsigned-big-integer, 255,B1,V/binary >> + end. %%%---------------------------------------------------------------- %% random/1 diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 7451c9e6d0..8718e92fa2 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -1206,7 +1206,7 @@ handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock, catch _C:_E -> disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Encountered unexpected input"}, + description = "Bad packet"}, StateName, D) end; @@ -1221,13 +1221,12 @@ handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock, {bad_mac, Ssh1} -> disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Bad mac"}, + description = "Bad packet"}, StateName, D0#data{ssh_params=Ssh1}); - {error, {exceeds_max_size,PacketLen}} -> + {error, {exceeds_max_size,_PacketLen}} -> disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Bad packet length " - ++ integer_to_list(PacketLen)}, + description = "Bad packet"}, StateName, D0) catch _C:_E -> diff --git a/lib/ssh/src/ssh_dbg.erl b/lib/ssh/src/ssh_dbg.erl index dff2bae9f2..0345bbdea7 100644 --- a/lib/ssh/src/ssh_dbg.erl +++ b/lib/ssh/src/ssh_dbg.erl @@ -50,50 +50,61 @@ messages(Write, MangleArg) when is_function(Write,2), is_function(MangleArg,1) -> catch dbg:start(), setup_tracer(Write, MangleArg), - dbg:p(new,c), + dbg:p(new,[c,timestamp]), dbg_ssh_messages(). dbg_ssh_messages() -> dbg:tp(ssh_message,encode,1, x), dbg:tp(ssh_message,decode,1, x), - dbg:tpl(ssh_transport,select_algorithm,3, x). - + dbg:tpl(ssh_transport,select_algorithm,3, x), + dbg:tp(ssh_transport,hello_version_msg,1, x), + dbg:tp(ssh_transport,handle_hello_version,1, x). + %%%---------------------------------------------------------------- stop() -> dbg:stop(). %%%================================================================ -msg_formater({trace,Pid,call,{ssh_message,encode,[Msg]}}, D) -> - fmt("~nSEND ~p ~s~n", [Pid,wr_record(shrink_bin(Msg))], D); -msg_formater({trace,_Pid,return_from,{ssh_message,encode,1},_Res}, D) -> +msg_formater({trace_ts,Pid,call,{ssh_message,encode,[Msg]},TS}, D) -> + fmt("~n~s SEND ~p ~s~n", [ts(TS),Pid,wr_record(shrink_bin(Msg))], D); +msg_formater({trace_ts,_Pid,return_from,{ssh_message,encode,1},_Res,_TS}, D) -> D; -msg_formater({trace,_Pid,call,{ssh_message,decode,_}}, D) -> +msg_formater({trace_ts,_Pid,call,{ssh_message,decode,_},_TS}, D) -> D; -msg_formater({trace,Pid,return_from,{ssh_message,decode,1},Msg}, D) -> - fmt("~n~p RECV ~s~n", [Pid,wr_record(shrink_bin(Msg))], D); +msg_formater({trace_ts,Pid,return_from,{ssh_message,decode,1},Msg,TS}, D) -> + fmt("~n~s ~p RECV ~s~n", [ts(TS),Pid,wr_record(shrink_bin(Msg))], D); -msg_formater({trace,_Pid,call,{ssh_transport,select_algorithm,_}}, D) -> +msg_formater({trace_ts,_Pid,call,{ssh_transport,select_algorithm,_},_TS}, D) -> + D; +msg_formater({trace_ts,Pid,return_from,{ssh_transport,select_algorithm,3},{ok,Alg},TS}, D) -> + fmt("~n~s ~p ALGORITHMS~n~s~n", [ts(TS),Pid, wr_record(Alg)], D); + +msg_formater({trace_ts,_Pid,call,{ssh_transport,hello_version_msg,_},_TS}, D) -> D; -msg_formater({trace,Pid,return_from,{ssh_transport,select_algorithm,3},{ok,Alg}}, D) -> - fmt("~n~p ALGORITHMS~n~s~n", [Pid, wr_record(Alg)], D); +msg_formater({trace_ts,Pid,return_from,{ssh_transport,hello_version_msg,1},Hello,TS}, D) -> + fmt("~n~s ~p TCP SEND HELLO~n ~p~n", [ts(TS),Pid,lists:flatten(Hello)], D); +msg_formater({trace_ts,Pid,call,{ssh_transport,handle_hello_version,[Hello]},TS}, D) -> + fmt("~n~s ~p RECV HELLO~n ~p~n", [ts(TS),Pid,lists:flatten(Hello)], D); +msg_formater({trace_ts,_Pid,return_from,{ssh_transport,handle_hello_version,1},_,_TS}, D) -> + D; -msg_formater({trace,Pid,send,{tcp,Sock,Bytes},Pid}, D) -> - fmt("~n~p TCP SEND on ~p~n ~p~n", [Pid,Sock, shrink_bin(Bytes)], D); +msg_formater({trace_ts,Pid,send,{tcp,Sock,Bytes},Pid,TS}, D) -> + fmt("~n~s ~p TCP SEND on ~p~n ~p~n", [ts(TS),Pid,Sock, shrink_bin(Bytes)], D); -msg_formater({trace,Pid,send,{tcp,Sock,Bytes},Dest}, D) -> - fmt("~n~p TCP SEND from ~p TO ~p~n ~p~n", [Pid,Sock,Dest, shrink_bin(Bytes)], D); +msg_formater({trace_ts,Pid,send,{tcp,Sock,Bytes},Dest,TS}, D) -> + fmt("~n~s ~p TCP SEND from ~p TO ~p~n ~p~n", [ts(TS),Pid,Sock,Dest, shrink_bin(Bytes)], D); -msg_formater({trace,Pid,send,ErlangMsg,Dest}, D) -> - fmt("~n~p ERL MSG SEND TO ~p~n ~p~n", [Pid,Dest, shrink_bin(ErlangMsg)], D); +msg_formater({trace_ts,Pid,send,ErlangMsg,Dest,TS}, D) -> + fmt("~n~s ~p ERL MSG SEND TO ~p~n ~p~n", [ts(TS),Pid,Dest, shrink_bin(ErlangMsg)], D); -msg_formater({trace,Pid,'receive',{tcp,Sock,Bytes}}, D) -> - fmt("~n~p TCP RECEIVE on ~p~n ~p~n", [Pid,Sock,shrink_bin(Bytes)], D); +msg_formater({trace_ts,Pid,'receive',{tcp,Sock,Bytes},TS}, D) -> + fmt("~n~s ~p TCP RECEIVE on ~p~n ~p~n", [ts(TS),Pid,Sock,shrink_bin(Bytes)], D); -msg_formater({trace,Pid,'receive',ErlangMsg}, D) -> - fmt("~n~p ERL MSG RECEIVE~n ~p~n", [Pid,shrink_bin(ErlangMsg)], D); +msg_formater({trace_ts,Pid,'receive',ErlangMsg,TS}, D) -> + fmt("~n~s ~p ERL MSG RECEIVE~n ~p~n", [ts(TS),Pid,shrink_bin(ErlangMsg)], D); msg_formater(M, D) -> @@ -106,6 +117,11 @@ msg_formater(M, D) -> fmt(Fmt, Args, D=#data{writer=Write,acc=Acc}) -> D#data{acc = Write(io_lib:format(Fmt, Args), Acc)}. +ts({_,_,Usec}=Now) -> + {_Date,{HH,MM,SS}} = calendar:now_to_local_time(Now), + io_lib:format("~.2.0w:~.2.0w:~.2.0w.~.6.0w",[HH,MM,SS,Usec]); +ts(_) -> + "-". %%%---------------------------------------------------------------- setup_tracer(Write, MangleArg) -> Handler = fun(Arg, D) -> @@ -116,11 +132,11 @@ setup_tracer(Write, MangleArg) -> ok. %%%---------------------------------------------------------------- -shrink_bin(B) when is_binary(B), size(B)>100 -> {'*** SHRINKED BIN', +shrink_bin(B) when is_binary(B), size(B)>256 -> {'*** SHRINKED BIN', size(B), - element(1,split_binary(B,20)), + element(1,split_binary(B,64)), '...', - element(2,split_binary(B,size(B)-20)) + element(2,split_binary(B,size(B)-64)) }; shrink_bin(L) when is_list(L) -> lists:map(fun shrink_bin/1, L); shrink_bin(T) when is_tuple(T) -> list_to_tuple(shrink_bin(tuple_to_list(T))); diff --git a/lib/ssh/src/ssh_sftp.erl b/lib/ssh/src/ssh_sftp.erl index afc2fb88ff..b937f0412d 100644 --- a/lib/ssh/src/ssh_sftp.erl +++ b/lib/ssh/src/ssh_sftp.erl @@ -37,7 +37,7 @@ -export([open/3, open_tar/3, opendir/2, close/2, readdir/2, pread/4, read/3, open/4, open_tar/4, opendir/3, close/3, readdir/3, pread/5, read/4, apread/4, aread/3, pwrite/4, write/3, apwrite/4, awrite/3, - pwrite/5, write/4, + pwrite/5, write/4, position/3, real_path/2, read_file_info/2, get_file_info/2, position/4, real_path/3, read_file_info/3, get_file_info/3, write_file_info/3, read_link_info/2, read_link/2, make_symlink/3, @@ -52,7 +52,7 @@ %% TODO: Should be placed elsewhere ssh_sftpd should not call functions in ssh_sftp! -export([info_to_attr/1, attr_to_info/1]). --record(state, +-record(state, { xf, rep_buf = <<>>, @@ -64,7 +64,7 @@ -record(fileinf, { - handle, + handle, offset, size, mode @@ -81,7 +81,7 @@ enc_text_buf = <<>>, % Encrypted text plain_text_buf = <<>> % Decrypted text }). - + -define(FILEOP_TIMEOUT, infinity). -define(NEXT_REQID(S), @@ -98,7 +98,7 @@ start_channel(Cm) when is_pid(Cm) -> start_channel(Socket) when is_port(Socket) -> start_channel(Socket, []); start_channel(Host) when is_list(Host) -> - start_channel(Host, []). + start_channel(Host, []). start_channel(Socket, Options) when is_port(Socket) -> Timeout = @@ -110,7 +110,7 @@ start_channel(Socket, Options) when is_port(Socket) -> TO end, case ssh:connect(Socket, Options, Timeout) of - {ok,Cm} -> + {ok,Cm} -> case start_channel(Cm, Options) of {ok, Pid} -> {ok, Pid, Cm}; @@ -124,13 +124,13 @@ start_channel(Cm, Opts) when is_pid(Cm) -> Timeout = proplists:get_value(timeout, Opts, infinity), {_, ChanOpts, SftpOpts} = handle_options(Opts, [], [], []), case ssh_xfer:attach(Cm, [], ChanOpts) of - {ok, ChannelId, Cm} -> - case ssh_channel:start(Cm, ChannelId, + {ok, ChannelId, Cm} -> + case ssh_channel:start(Cm, ChannelId, ?MODULE, [Cm, ChannelId, SftpOpts]) of {ok, Pid} -> case wait_for_version_negotiation(Pid, Timeout) of ok -> - {ok, Pid}; + {ok, Pid}; TimeOut -> TimeOut end; @@ -150,7 +150,7 @@ start_channel(Host, Port, Opts) -> Timeout = proplists:get_value(timeout, SftpOpts, infinity), case ssh_xfer:connect(Host, Port, SshOpts, ChanOpts, Timeout) of {ok, ChannelId, Cm} -> - case ssh_channel:start(Cm, ChannelId, ?MODULE, [Cm, + case ssh_channel:start(Cm, ChannelId, ?MODULE, [Cm, ChannelId, SftpOpts]) of {ok, Pid} -> case wait_for_version_negotiation(Pid, Timeout) of @@ -165,7 +165,7 @@ start_channel(Host, Port, Opts) -> {error, ignore} end; Error -> - Error + Error end. stop_channel(Pid) -> @@ -174,12 +174,12 @@ stop_channel(Pid) -> OldValue = process_flag(trap_exit, true), link(Pid), exit(Pid, ssh_sftp_stop_channel), - receive + receive {'EXIT', Pid, normal} -> ok after 5000 -> exit(Pid, kill), - receive + receive {'EXIT', Pid, killed} -> ok end @@ -209,9 +209,9 @@ open_tar(Pid, File, Mode, FileOpTimeout) -> erl_tar:init(Pid, write, fun(write, {_,Data}) -> write_to_remote_tar(Pid, Handle, to_bin(Data), FileOpTimeout); - (position, {_,Pos}) -> + (position, {_,Pos}) -> position(Pid, Handle, Pos, FileOpTimeout); - (close, _) -> + (close, _) -> close(Pid, Handle, FileOpTimeout) end); {true,false,[{crypto,{CryptoInitFun,CryptoEncryptFun,CryptoEndFun}}]} -> @@ -245,9 +245,9 @@ open_tar(Pid, File, Mode, FileOpTimeout) -> erl_tar:init(Pid, read, fun(read2, {_,Len}) -> read_repeat(Pid, Handle, Len, FileOpTimeout); - (position, {_,Pos}) -> + (position, {_,Pos}) -> position(Pid, Handle, Pos, FileOpTimeout); - (close, _) -> + (close, _) -> close(Pid, Handle, FileOpTimeout) end); {false,true,[{crypto,{CryptoInitFun,CryptoDecryptFun}}]} -> @@ -258,9 +258,9 @@ open_tar(Pid, File, Mode, FileOpTimeout) -> erl_tar:init(Pid, read, fun(read2, {_,Len}) -> read_buf(Pid, SftpHandle, BufHandle, Len, FileOpTimeout); - (position, {_,Pos}) -> + (position, {_,Pos}) -> position_buf(Pid, SftpHandle, BufHandle, Pos, FileOpTimeout); - (close, _) -> + (close, _) -> call(Pid, {erase_bufinf,BufHandle}, FileOpTimeout), close(Pid, SftpHandle, FileOpTimeout) end); @@ -292,7 +292,7 @@ pread(Pid, Handle, Offset, Len, FileOpTimeout) -> read(Pid, Handle, Len) -> read(Pid, Handle, Len, ?FILEOP_TIMEOUT). read(Pid, Handle, Len, FileOpTimeout) -> - call(Pid, {read,false,Handle, Len}, FileOpTimeout). + call(Pid, {read,false,Handle, Len}, FileOpTimeout). %% TODO this ought to be a cast! Is so in all practial meaning %% even if it is obscure! @@ -301,7 +301,7 @@ apread(Pid, Handle, Offset, Len) -> %% TODO this ought to be a cast! aread(Pid, Handle, Len) -> - call(Pid, {read,true,Handle, Len}, infinity). + call(Pid, {read,true,Handle, Len}, infinity). pwrite(Pid, Handle, Offset, Data) -> pwrite(Pid, Handle, Offset, Data, ?FILEOP_TIMEOUT). @@ -367,7 +367,7 @@ make_symlink(Pid, Name, Target) -> make_symlink(Pid, Name, Target, ?FILEOP_TIMEOUT). make_symlink(Pid, Name, Target, FileOpTimeout) -> call(Pid, {make_symlink,false, Name, Target}, FileOpTimeout). - + rename(Pid, FromFile, ToFile) -> rename(Pid, FromFile, ToFile, ?FILEOP_TIMEOUT). rename(Pid, FromFile, ToFile, FileOpTimeout) -> @@ -411,8 +411,8 @@ list_dir(Pid, Name, FileOpTimeout) -> close(Pid, Handle, FileOpTimeout), case Res of {ok, List} -> - NList = lists:foldl(fun({Nm, _Info},Acc) -> - [Nm|Acc] end, + NList = lists:foldl(fun({Nm, _Info},Acc) -> + [Nm|Acc] end, [], List), {ok,NList}; Error -> Error @@ -482,7 +482,7 @@ write_file_loop(Pid, Handle, Pos, Bin, Remain, PacketSz, FileOpTimeout) -> <<_:Pos/binary, Data:PacketSz/binary, _/binary>> = Bin, case write(Pid, Handle, Data, FileOpTimeout) of ok -> - write_file_loop(Pid, Handle, + write_file_loop(Pid, Handle, Pos+PacketSz, Bin, Remain-PacketSz, PacketSz, FileOpTimeout); Error -> @@ -510,7 +510,7 @@ init([Cm, ChannelId, Options]) -> Xf = #ssh_xfer{cm = Cm, channel = ChannelId}, {ok, #state{xf = Xf, - req_id = 0, + req_id = 0, rep_buf = <<>>, inf = new_inf(), opts = Options}}; @@ -519,7 +519,7 @@ init([Cm, ChannelId, Options]) -> Error -> {stop, {shutdown, Error}} end. - + %%-------------------------------------------------------------------- %% Function: handle_call/3 %% Description: Handling call messages @@ -541,7 +541,7 @@ handle_call({{timeout, Timeout}, wait_for_version_negotiation}, From, handle_call({_, wait_for_version_negotiation}, _, State) -> {reply, ok, State}; - + handle_call({{timeout, infinity}, Msg}, From, State) -> do_handle_call(Msg, From, State); handle_call({{timeout, Timeout}, Msg}, From, #state{req_id = Id} = State) -> @@ -555,13 +555,13 @@ code_change(_OldVsn, State, _Extra) -> {ok, State}. do_handle_call({get_bufinf,BufHandle}, _From, S=#state{inf=I0}) -> - {reply, dict:find(BufHandle,I0), S}; + {reply, maps:find(BufHandle,I0), S}; do_handle_call({put_bufinf,BufHandle,B}, _From, S=#state{inf=I0}) -> - {reply, ok, S#state{inf=dict:store(BufHandle,B,I0)}}; + {reply, ok, S#state{inf=maps:put(BufHandle,B,I0)}}; do_handle_call({erase_bufinf,BufHandle}, _From, S=#state{inf=I0}) -> - {reply, ok, S#state{inf=dict:erase(BufHandle,I0)}}; + {reply, ok, S#state{inf=maps:remove(BufHandle,I0)}}; do_handle_call({open, Async,FileName,Mode}, From, #state{xf = XF} = State) -> {Access,Flags,Attrs} = open_mode(XF#ssh_xfer.vsn, Mode), @@ -636,7 +636,7 @@ do_handle_call({pread,Async,Handle,At,Length}, From, State) -> binary -> {{ok,Data}, State2}; text -> {{ok,binary_to_list(Data)}, State2} end; - (Rep, State2) -> + (Rep, State2) -> {Rep, State2} end); Error -> @@ -777,7 +777,7 @@ do_handle_call(recv_window, _From, State) -> do_handle_call(stop, _From, State) -> {stop, shutdown, ok, State}; -do_handle_call(Call, _From, State) -> +do_handle_call(Call, _From, State) -> {reply, {error, bad_call, Call, State}, State}. %%-------------------------------------------------------------------- @@ -785,13 +785,13 @@ do_handle_call(Call, _From, State) -> %% %% Description: Handles channel messages %%-------------------------------------------------------------------- -handle_ssh_msg({ssh_cm, _ConnectionManager, - {data, _ChannelId, 0, Data}}, #state{rep_buf = Data0} = +handle_ssh_msg({ssh_cm, _ConnectionManager, + {data, _ChannelId, 0, Data}}, #state{rep_buf = Data0} = State0) -> State = handle_reply(State0, <<Data0/binary,Data/binary>>), {ok, State}; -handle_ssh_msg({ssh_cm, _ConnectionManager, +handle_ssh_msg({ssh_cm, _ConnectionManager, {data, _ChannelId, 1, Data}}, State) -> error_logger:format("ssh: STDERR: ~s\n", [binary_to_list(Data)]), {ok, State}; @@ -803,7 +803,7 @@ handle_ssh_msg({ssh_cm, _, {signal, _, _}}, State) -> %% Ignore signals according to RFC 4254 section 6.9. {ok, State}; -handle_ssh_msg({ssh_cm, _, {exit_signal, ChannelId, _, Error, _}}, +handle_ssh_msg({ssh_cm, _, {exit_signal, ChannelId, _, Error, _}}, State0) -> State = reply_all(State0, {error, Error}), {stop, ChannelId, State}; @@ -823,7 +823,7 @@ handle_msg({ssh_channel_up, _, _}, #state{opts = Options, xf = Xf} = State) -> {ok, State}; %% Version negotiation timed out -handle_msg({timeout, undefined, From}, +handle_msg({timeout, undefined, From}, #state{xf = #ssh_xfer{channel = ChannelId}} = State) -> ssh_channel:reply(From, {error, timeout}), {stop, ChannelId, State}; @@ -839,12 +839,12 @@ handle_msg({timeout, Id, From}, #state{req_list = ReqList0} = State) -> end; %% Connection manager goes down -handle_msg({'DOWN', _Ref, _Type, _Process, _}, +handle_msg({'DOWN', _Ref, _Type, _Process, _}, #state{xf = #ssh_xfer{channel = ChannelId}} = State) -> {stop, ChannelId, State}; - + %% Stopped by user -handle_msg({'EXIT', _, ssh_sftp_stop_channel}, +handle_msg({'EXIT', _, ssh_sftp_stop_channel}, #state{xf = #ssh_xfer{channel = ChannelId}} = State) -> {stop, ChannelId, State}; @@ -883,10 +883,10 @@ call(Pid, Msg, TimeOut) -> handle_reply(State, <<?UINT32(Len),Reply:Len/binary,Rest/binary>>) -> do_handle_reply(State, Reply, Rest); -handle_reply(State, Data) -> +handle_reply(State, Data) -> State#state{rep_buf = Data}. -do_handle_reply(#state{xf = Xf} = State, +do_handle_reply(#state{xf = Xf} = State, <<?SSH_FXP_VERSION, ?UINT32(Version), BinExt/binary>>, Rest) -> Ext = ssh_xfer:decode_ext(BinExt), case Xf#ssh_xfer.vsn of @@ -899,7 +899,7 @@ do_handle_reply(#state{xf = Xf} = State, ok end, ssh_channel:reply(From, ok) - end, + end, State#state{xf = Xf#ssh_xfer{vsn = Version, ext = Ext}, rep_buf = Rest}; do_handle_reply(State0, Data, Rest) -> @@ -919,9 +919,9 @@ handle_req_reply(State0, {_, ReqID, _} = XfReply) -> List = lists:keydelete(ReqID, 1, State0#state.req_list), State1 = State0#state { req_list = List }, case catch Fun(xreply(XfReply),State1) of - {'EXIT', _} -> + {'EXIT', _} -> State1; - State -> + State -> State end end. @@ -998,15 +998,15 @@ reply_all(State, Reply) -> make_reply(ReqID, true, From, State) -> {reply, {async, ReqID}, update_request_info(ReqID, State, - fun(Reply,State1) -> + fun(Reply,State1) -> async_reply(ReqID,Reply,From,State1) end)}; make_reply(ReqID, false, From, State) -> {noreply, update_request_info(ReqID, State, - fun(Reply,State1) -> - sync_reply(Reply, From, State1) + fun(Reply,State1) -> + sync_reply(Reply, From, State1) end)}. make_reply_post(ReqID, true, From, State, PostFun) -> @@ -1074,13 +1074,13 @@ attr_to_info(A) when is_record(A, ssh_xfer_attr) -> unix_to_datetime(undefined) -> undefined; unix_to_datetime(UTCSecs) -> - UTCDateTime = + UTCDateTime = calendar:gregorian_seconds_to_datetime(UTCSecs + 62167219200), erlang:universaltime_to_localtime(UTCDateTime). datetime_to_unix(undefined) -> undefined; -datetime_to_unix(LocalDateTime) -> +datetime_to_unix(LocalDateTime) -> UTCDateTime = erlang:localtime_to_universaltime(LocalDateTime), calendar:datetime_to_gregorian_seconds(UTCDateTime) - 62167219200. @@ -1128,11 +1128,11 @@ open_mode3(Modes) -> end, {[], Fl, A}. -%% accessors for inf dict -new_inf() -> dict:new(). +%% accessors for inf map +new_inf() -> #{}. add_new_handle(Handle, FileMode, Inf) -> - dict:store(Handle, #fileinf{offset=0, size=0, mode=FileMode}, Inf). + maps:put(Handle, #fileinf{offset=0, size=0, mode=FileMode}, Inf). update_size(Handle, NewSize, State) -> OldSize = get_size(Handle, State), @@ -1152,27 +1152,24 @@ update_offset(Handle, NewOffset, State0) -> %% access size and offset for handle put_size(Handle, Size, State) -> Inf0 = State#state.inf, - case dict:find(Handle, Inf0) of + case maps:find(Handle, Inf0) of {ok, FI} -> - State#state{inf=dict:store(Handle, FI#fileinf{size=Size}, Inf0)}; + State#state{inf=maps:put(Handle, FI#fileinf{size=Size}, Inf0)}; _ -> - State#state{inf=dict:store(Handle, #fileinf{size=Size,offset=0}, - Inf0)} + State#state{inf=maps:put(Handle, #fileinf{size=Size,offset=0}, Inf0)} end. put_offset(Handle, Offset, State) -> Inf0 = State#state.inf, - case dict:find(Handle, Inf0) of + case maps:find(Handle, Inf0) of {ok, FI} -> - State#state{inf=dict:store(Handle, FI#fileinf{offset=Offset}, - Inf0)}; + State#state{inf=maps:put(Handle, FI#fileinf{offset=Offset}, Inf0)}; _ -> - State#state{inf=dict:store(Handle, #fileinf{size=Offset, - offset=Offset}, Inf0)} + State#state{inf=maps:put(Handle, #fileinf{size=Offset, offset=Offset}, Inf0)} end. get_size(Handle, State) -> - case dict:find(Handle, State#state.inf) of + case maps:find(Handle, State#state.inf) of {ok, FI} -> FI#fileinf.size; _ -> @@ -1180,11 +1177,11 @@ get_size(Handle, State) -> end. %% get_offset(Handle, State) -> -%% {ok, FI} = dict:find(Handle, State#state.inf), +%% {ok, FI} = maps:find(Handle, State#state.inf), %% FI#fileinf.offset. get_mode(Handle, State) -> - case dict:find(Handle, State#state.inf) of + case maps:find(Handle, State#state.inf) of {ok, FI} -> FI#fileinf.mode; _ -> @@ -1192,14 +1189,14 @@ get_mode(Handle, State) -> end. erase_handle(Handle, State) -> - FI = dict:erase(Handle, State#state.inf), + FI = maps:remove(Handle, State#state.inf), State#state{inf = FI}. %% %% Caluclate a integer offset %% lseek_position(Handle, Pos, State) -> - case dict:find(Handle, State#state.inf) of + case maps:find(Handle, State#state.inf) of {ok, #fileinf{offset=O, size=S}} -> lseek_pos(Pos, O, S); _ -> @@ -1229,7 +1226,7 @@ lseek_pos({cur, Offset}, CurOffset, _CurSize) true -> {ok, NewOffset} end; -lseek_pos({eof, Offset}, _CurOffset, CurSize) +lseek_pos({eof, Offset}, _CurOffset, CurSize) when is_integer(Offset) andalso -(?SSH_FILEXFER_LARGEFILESIZE) =< Offset andalso Offset < ?SSH_FILEXFER_LARGEFILESIZE -> NewOffset = CurSize + Offset, @@ -1239,7 +1236,7 @@ lseek_pos({eof, Offset}, _CurOffset, CurSize) {ok, NewOffset} end; lseek_pos(_, _, _) -> - {error, einval}. + {error, einval}. %%%================================================================ %%% @@ -1277,13 +1274,13 @@ position_buf(Pid, SftpHandle, BufHandle, Pos, FileOpTimeout) -> case Pos of {cur,0} when Mode==write -> {ok,Size+size(Buf0)}; - + {cur,0} when Mode==read -> {ok,Size}; - + _ when Mode==read, is_integer(Pos) -> Skip = Pos-Size, - if + if Skip < 0 -> {error, cannot_rewind}; Skip == 0 -> @@ -1318,7 +1315,7 @@ read_buf(Pid, SftpHandle, BufHandle, WantedLen, FileOpTimeout) -> eof end. -do_the_read_buf(_Pid, _SftpHandle, WantedLen, _Packet, _FileOpTimeout, +do_the_read_buf(_Pid, _SftpHandle, WantedLen, _Packet, _FileOpTimeout, B=#bufinf{plain_text_buf=PlainBuf0, size = Size}) when size(PlainBuf0) >= WantedLen -> @@ -1327,7 +1324,7 @@ do_the_read_buf(_Pid, _SftpHandle, WantedLen, _Packet, _FileOpTimeout, {ok,ResultBin,B#bufinf{plain_text_buf=PlainBuf, size = Size + WantedLen}}; -do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, +do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, B0=#bufinf{plain_text_buf = PlainBuf0, enc_text_buf = EncBuf0, chunksize = undefined @@ -1335,12 +1332,12 @@ do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, when size(EncBuf0) > 0 -> %% We have (at least) one decodable byte waiting for decodeing. {ok,DecodedBin,B} = apply_crypto(EncBuf0, B0), - do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, + do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, B#bufinf{plain_text_buf = <<PlainBuf0/binary, DecodedBin/binary>>, enc_text_buf = <<>> }); - -do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, + +do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, B0=#bufinf{plain_text_buf = PlainBuf0, enc_text_buf = EncBuf0, chunksize = ChunkSize0 @@ -1349,11 +1346,11 @@ do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, %% We have (at least) one chunk of decodable bytes waiting for decodeing. <<ToDecode:ChunkSize0/binary, EncBuf/binary>> = EncBuf0, {ok,DecodedBin,B} = apply_crypto(ToDecode, B0), - do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, + do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, B#bufinf{plain_text_buf = <<PlainBuf0/binary, DecodedBin/binary>>, enc_text_buf = EncBuf }); - + do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, B=#bufinf{enc_text_buf = EncBuf0}) -> %% We must read more bytes and append to the buffer of encoded bytes. case read(Pid, SftpHandle, Packet, FileOpTimeout) of @@ -1370,7 +1367,7 @@ do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, B=#bufinf{enc write_buf(Pid, SftpHandle, BufHandle, PlainBin, FileOpTimeout) -> {ok,{_Window,Packet}} = send_window(Pid, FileOpTimeout), {ok,B0=#bufinf{plain_text_buf=PTB}} = call(Pid, {get_bufinf,BufHandle}, FileOpTimeout), - case do_the_write_buf(Pid, SftpHandle, Packet, FileOpTimeout, + case do_the_write_buf(Pid, SftpHandle, Packet, FileOpTimeout, B0#bufinf{plain_text_buf = <<PTB/binary,PlainBin/binary>>}) of {ok, B} -> call(Pid, {put_bufinf,BufHandle,B}, FileOpTimeout), @@ -1379,7 +1376,7 @@ write_buf(Pid, SftpHandle, BufHandle, PlainBin, FileOpTimeout) -> {error,Error} end. -do_the_write_buf(Pid, SftpHandle, Packet, FileOpTimeout, +do_the_write_buf(Pid, SftpHandle, Packet, FileOpTimeout, B=#bufinf{enc_text_buf = EncBuf0, size = Size}) when size(EncBuf0) >= Packet -> @@ -1421,9 +1418,9 @@ do_the_write_buf(_Pid, _SftpHandle, _Packet, _FileOpTimeout, B) -> apply_crypto(In, B=#bufinf{crypto_state = CState0, crypto_fun = F}) -> case F(In,CState0) of - {ok,EncodedBin,CState} -> + {ok,EncodedBin,CState} -> {ok, EncodedBin, B#bufinf{crypto_state=CState}}; - {ok,EncodedBin,CState,ChunkSize} -> + {ok,EncodedBin,CState,ChunkSize} -> {ok, EncodedBin, B#bufinf{crypto_state=CState, chunksize=ChunkSize}} end. diff --git a/lib/ssh/src/ssh_sftpd_file_api.erl b/lib/ssh/src/ssh_sftpd_file_api.erl index 78f452df67..e444e52ac0 100644 --- a/lib/ssh/src/ssh_sftpd_file_api.erl +++ b/lib/ssh/src/ssh_sftpd_file_api.erl @@ -36,7 +36,7 @@ -callback list_dir(file:name(), State::term()) -> {{ok, Filenames::term()}, State::term()} | {{error, Reason::term()}, State::term()}. -callback make_dir(Dir::term(), State::term()) -> - {{ok, State::term()},State::term()} | {{error, Reason::term()}, State::term()}. + {ok, State::term()} | {{error, Reason::term()}, State::term()}. -callback make_symlink(Path2::term(), Path::term(), State::term()) -> {ok, State::term()} | {{error, Reason::term()}, State::term()}. -callback open(Path::term(), Flags::term(), State::term()) -> diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 21ba34506a..53e9ef485b 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -367,7 +367,7 @@ handle_kexdh_init(#ssh_msg_kexdh_init{e = E}, h_sig = H_SIG }, Ssh0), {ok, SshPacket, Ssh1#ssh{keyex_key = {{Private, Public}, {G, P}}, - shared_secret = K, + shared_secret = ssh_bits:mpint(K), exchanged_hash = H, session_id = sid(Ssh1, H)}}; @@ -393,7 +393,7 @@ handle_kexdh_reply(#ssh_msg_kexdh_reply{public_host_key = PeerPubHostKey, case verify_host_key(Ssh0, PeerPubHostKey, H, H_SIG) of ok -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_newkeys{}, Ssh0), - {ok, SshPacket, Ssh#ssh{shared_secret = K, + {ok, SshPacket, Ssh#ssh{shared_secret = ssh_bits:mpint(K), exchanged_hash = H, session_id = sid(Ssh, H)}}; Error -> @@ -532,7 +532,7 @@ handle_kex_dh_gex_init(#ssh_msg_kex_dh_gex_init{e = E}, ssh_packet(#ssh_msg_kex_dh_gex_reply{public_host_key = MyPubHostKey, f = Public, h_sig = H_SIG}, Ssh0), - {ok, SshPacket, Ssh#ssh{shared_secret = K, + {ok, SshPacket, Ssh#ssh{shared_secret = ssh_bits:mpint(K), exchanged_hash = H, session_id = sid(Ssh, H) }}; @@ -568,7 +568,7 @@ handle_kex_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{public_host_key = PeerPubHostK case verify_host_key(Ssh0, PeerPubHostKey, H, H_SIG) of ok -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_newkeys{}, Ssh0), - {ok, SshPacket, Ssh#ssh{shared_secret = K, + {ok, SshPacket, Ssh#ssh{shared_secret = ssh_bits:mpint(K), exchanged_hash = H, session_id = sid(Ssh, H)}}; _Error -> @@ -618,7 +618,7 @@ handle_kex_ecdh_init(#ssh_msg_kex_ecdh_init{q_c = PeerPublic}, h_sig = H_SIG}, Ssh0), {ok, SshPacket, Ssh1#ssh{keyex_key = {{MyPublic,MyPrivate},Curve}, - shared_secret = K, + shared_secret = ssh_bits:mpint(K), exchanged_hash = H, session_id = sid(Ssh1, H)}} catch @@ -644,7 +644,7 @@ handle_kex_ecdh_reply(#ssh_msg_kex_ecdh_reply{public_host_key = PeerPubHostKey, case verify_host_key(Ssh0, PeerPubHostKey, H, H_SIG) of ok -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_newkeys{}, Ssh0), - {ok, SshPacket, Ssh#ssh{shared_secret = K, + {ok, SshPacket, Ssh#ssh{shared_secret = ssh_bits:mpint(K), exchanged_hash = H, session_id = sid(Ssh, H)}}; Error -> @@ -1577,7 +1577,7 @@ hash(SSH, Char, Bits) -> hash(_SSH, _Char, 0, _HASH) -> <<>>; hash(SSH, Char, N, HASH) -> - K = ssh_bits:mpint(SSH#ssh.shared_secret), +K = SSH#ssh.shared_secret, % K = ssh_bits:mpint(SSH#ssh.shared_secret), H = SSH#ssh.exchanged_hash, SessionID = SSH#ssh.session_id, K1 = HASH([K, H, Char, SessionID]), diff --git a/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl index dc3b7dc7e6..8ca29b9399 100644 --- a/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl +++ b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl @@ -54,15 +54,18 @@ -endif. -endif. +%% Public key records: +-include_lib("public_key/include/public_key.hrl"). %%% Properties: prop_ssh_decode() -> - ?FORALL(Msg, ssh_msg(), - try ssh_message:decode(Msg) + ?FORALL({Msg,KexFam}, ?LET(KF, kex_family(), {ssh_msg(KF),KF} ), + try ssh_message:decode(decode_state(Msg,KexFam)) of _ -> true catch + C:E -> io:format('~p:~p~n',[C,E]), false end @@ -71,122 +74,101 @@ prop_ssh_decode() -> %%% This fails because ssh_message is not symmetric in encode and decode regarding data types prop_ssh_decode_encode() -> - ?FORALL(Msg, ssh_msg(), - Msg == ssh_message:encode(ssh_message:decode(Msg)) + ?FORALL({Msg,KexFam}, ?LET(KF, kex_family(), {ssh_msg(KF),KF} ), + Msg == ssh_message:encode( + fix_asym( + ssh_message:decode(decode_state(Msg,KexFam)))) ). %%%================================================================ %%% -%%% Scripts to generate message generators -%%% - -%% awk '/^( |\t)+byte( |\t)+SSH/,/^( |\t)*$/{print}' rfc425?.txt | sed 's/^\( \|\\t\)*//' > msgs.txt - -%% awk '/^byte( |\t)+SSH/{print $2","}' < msgs.txt - -%% awk 'BEGIN{print "%%%---- BEGIN GENERATED";prev=0} END{print " >>.\n%%%---- END GENERATED"} /^byte( |\t)+SSH/{if (prev==1) print " >>.\n"; prev=1; printf "%c%s%c",39,$2,39; print "()->\n <<?"$2;next} /^string( |\t)+\"/{print " ,"$2;next} /^string( |\t)+.*address/{print " ,(ssh_string_address())/binary %%",$2,$3,$4,$5,$6;next}/^string( |\t)+.*US-ASCII/{print " ,(ssh_string_US_ASCII())/binary %%",$2,$3,$4,$5,$6;next} /^string( |\t)+.*UTF-8/{print " ,(ssh_string_UTF_8())/binary %% ",$2,$3,$4,$5,$6;next} /^[a-z0-9]+( |\t)/{print " ,(ssh_"$1"())/binary %%",$2,$3,$4,$5,$6;next} /^byte\[16\]( |\t)+/{print" ,(ssh_byte_16())/binary %%",$2,$3,$4,$5,$6;next} /^name-list( |\t)+/{print" ,(ssh_name_list())/binary %%",$2,$3,$4,$5,$6;next} /./{print "?? %%",$0}' < msgs.txt > gen.txt - -%%%================================================================ -%%% %%% Generators %%% -ssh_msg() -> ?LET(M,oneof( -[[msg_code('SSH_MSG_CHANNEL_CLOSE'),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_DATA'),gen_uint32(),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_EOF'),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_EXTENDED_DATA'),gen_uint32(),gen_uint32(),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_FAILURE'),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("direct-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("forwarded-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("session"),gen_uint32(),gen_uint32(),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("x11"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_OPEN_CONFIRMATION'),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_OPEN_FAILURE'),gen_uint32(),gen_uint32(),gen_string( ),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("env"),gen_boolean(),gen_string( ),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exec"),gen_boolean(),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-signal"),0,gen_string( ),gen_boolean(),gen_string( ),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-status"),0,gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("pty-req"),gen_boolean(),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("shell"),gen_boolean()], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("signal"),0,gen_string( )], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("subsystem"),gen_boolean(),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("window-change"),0,gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("x11-req"),gen_boolean(),gen_boolean(),gen_string( ),gen_string( ),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("xon-xoff"),0,gen_boolean()], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string( ),gen_boolean()], - [msg_code('SSH_MSG_CHANNEL_SUCCESS'),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_WINDOW_ADJUST'),gen_uint32(),gen_uint32()], -%%Assym [msg_code('SSH_MSG_DEBUG'),gen_boolean(),gen_string( ),gen_string( )], - [msg_code('SSH_MSG_DISCONNECT'),gen_uint32(),gen_string( ),gen_string( )], -%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("cancel-tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()], -%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()], -%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string( ),gen_boolean()], - [msg_code('SSH_MSG_IGNORE'),gen_string( )], - %% [msg_code('SSH_MSG_KEXDH_INIT'),gen_mpint()], - %% [msg_code('SSH_MSG_KEXDH_REPLY'),gen_string( ),gen_mpint(),gen_string( )], - %% [msg_code('SSH_MSG_KEXINIT'),gen_byte(16),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_boolean(),gen_uint32()], - [msg_code('SSH_MSG_KEX_DH_GEX_GROUP'),gen_mpint(),gen_mpint()], - [msg_code('SSH_MSG_NEWKEYS')], - [msg_code('SSH_MSG_REQUEST_FAILURE')], - [msg_code('SSH_MSG_REQUEST_SUCCESS')], - [msg_code('SSH_MSG_REQUEST_SUCCESS'),gen_uint32()], - [msg_code('SSH_MSG_SERVICE_ACCEPT'),gen_string( )], - [msg_code('SSH_MSG_SERVICE_REQUEST'),gen_string( )], - [msg_code('SSH_MSG_UNIMPLEMENTED'),gen_uint32()], - [msg_code('SSH_MSG_USERAUTH_BANNER'),gen_string( ),gen_string( )], - [msg_code('SSH_MSG_USERAUTH_FAILURE'),gen_name_list(),gen_boolean()], - [msg_code('SSH_MSG_USERAUTH_PASSWD_CHANGEREQ'),gen_string( ),gen_string( )], - [msg_code('SSH_MSG_USERAUTH_PK_OK'),gen_string( ),gen_string( )], - [msg_code('SSH_MSG_USERAUTH_SUCCESS')] -] - -), list_to_binary(M)). - - -%%%================================================================ -%%% -%%% Generator -%%% - -do() -> - io_lib:format('[~s~n]', - [write_gen( - files(["rfc4254.txt", - "rfc4253.txt", - "rfc4419.txt", - "rfc4252.txt", - "rfc4256.txt"]))]). - - -write_gen(L) when is_list(L) -> - string:join(lists:map(fun write_gen/1, L), ",\n "); -write_gen({MsgName,Args}) -> - lists:flatten(["[",generate_args([MsgName|Args]),"]"]). - -generate_args(As) -> string:join([generate_arg(A) || A <- As], ","). - -generate_arg({<<"string">>, <<"\"",B/binary>>}) -> - S = get_string($",B), - ["gen_string(\"",S,"\")"]; -generate_arg({<<"string">>, _}) -> "gen_string( )"; -generate_arg({<<"byte[",B/binary>>, _}) -> - io_lib:format("gen_byte(~p)",[list_to_integer(get_string($],B))]); -generate_arg({<<"byte">> ,_}) -> "gen_byte()"; -generate_arg({<<"uint16">>,_}) -> "gen_uint16()"; -generate_arg({<<"uint32">>,_}) -> "gen_uint32()"; -generate_arg({<<"uint64">>,_}) -> "gen_uint64()"; -generate_arg({<<"mpint">>,_}) -> "gen_mpint()"; -generate_arg({<<"name-list">>,_}) -> "gen_name_list()"; -generate_arg({<<"boolean">>,<<"FALSE">>}) -> "0"; -generate_arg({<<"boolean">>,<<"TRUE">>}) -> "1"; -generate_arg({<<"boolean">>,_}) -> "gen_boolean()"; -generate_arg({<<"....">>,_}) -> ""; %% FIXME -generate_arg(Name) when is_binary(Name) -> - lists:flatten(["msg_code('",binary_to_list(Name),"')"]). - +ssh_msg(<<"dh">>) -> + ?LET(M,oneof( + [ + [msg_code('SSH_MSG_KEXDH_INIT'),gen_mpint()], % 30 + [msg_code('SSH_MSG_KEXDH_REPLY'),gen_pubkey_string(rsa),gen_mpint(),gen_signature_string(rsa)] % 31 + | rest_ssh_msgs() + ]), + list_to_binary(M)); + +ssh_msg(<<"dh_gex">>) -> + ?LET(M,oneof( + [ + [msg_code('SSH_MSG_KEX_DH_GEX_REQUEST_OLD'),gen_uint32()], % 30 + [msg_code('SSH_MSG_KEX_DH_GEX_GROUP'),gen_mpint(),gen_mpint()] % 31 + | rest_ssh_msgs() + ]), + list_to_binary(M)); + + ssh_msg(<<"ecdh">>) -> + ?LET(M,oneof( + [ + [msg_code('SSH_MSG_KEX_ECDH_INIT'),gen_mpint()], % 30 + [msg_code('SSH_MSG_KEX_ECDH_REPLY'),gen_pubkey_string(ecdsa),gen_mpint(),gen_signature_string(ecdsa)] % 31 + | rest_ssh_msgs() + ]), + list_to_binary(M)). + + +rest_ssh_msgs() -> + [%% SSH_MSG_USERAUTH_INFO_RESPONSE + %% hard args SSH_MSG_USERAUTH_INFO_REQUEST + %% rfc4252 p12 error SSH_MSG_USERAUTH_REQUEST + [msg_code('SSH_MSG_KEX_DH_GEX_REQUEST'),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_KEX_DH_GEX_INIT'),gen_mpint()], + [msg_code('SSH_MSG_KEX_DH_GEX_REPLY'),gen_pubkey_string(rsa),gen_mpint(),gen_signature_string(rsa)], + [msg_code('SSH_MSG_CHANNEL_CLOSE'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_DATA'),gen_uint32(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_EOF'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_EXTENDED_DATA'),gen_uint32(),gen_uint32(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_FAILURE'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("direct-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("forwarded-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("session"),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("x11"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN_CONFIRMATION'),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN_FAILURE'),gen_uint32(),gen_uint32(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("env"),gen_boolean(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exec"),gen_boolean(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-signal"),0,gen_string( ),gen_boolean(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-status"),0,gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("pty-req"),gen_boolean(),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("shell"),gen_boolean()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("signal"),0,gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("subsystem"),gen_boolean(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("window-change"),0,gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("x11-req"),gen_boolean(),gen_boolean(),gen_string( ),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("xon-xoff"),0,gen_boolean()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string( ),gen_boolean()], + [msg_code('SSH_MSG_CHANNEL_SUCCESS'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_WINDOW_ADJUST'),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_DEBUG'),gen_boolean(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_DISCONNECT'),gen_uint32(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("cancel-tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string( ),gen_boolean()], + [msg_code('SSH_MSG_IGNORE'),gen_string( )], + [msg_code('SSH_MSG_KEXINIT'),gen_byte(16),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_boolean(),gen_uint32()], + [msg_code('SSH_MSG_NEWKEYS')], + [msg_code('SSH_MSG_REQUEST_FAILURE')], + [msg_code('SSH_MSG_REQUEST_SUCCESS')], + [msg_code('SSH_MSG_REQUEST_SUCCESS'),gen_uint32()], + [msg_code('SSH_MSG_SERVICE_ACCEPT'),gen_string( )], + [msg_code('SSH_MSG_SERVICE_REQUEST'),gen_string( )], + [msg_code('SSH_MSG_UNIMPLEMENTED'),gen_uint32()], + [msg_code('SSH_MSG_USERAUTH_BANNER'),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_USERAUTH_FAILURE'),gen_name_list(),gen_boolean()], + [msg_code('SSH_MSG_USERAUTH_PASSWD_CHANGEREQ'),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_USERAUTH_PK_OK'),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_USERAUTH_SUCCESS')] + ]. + +kex_family() -> oneof([<<"dh">>, <<"dh_gex">>, <<"ecdh">>]). gen_boolean() -> choose(0,1). @@ -202,10 +184,7 @@ gen_byte(N) when N>0 -> [gen_byte() || _ <- lists:seq(1,N)]. gen_char() -> choose($a,$z). -gen_mpint() -> ?LET(Size, choose(1,20), - ?LET(Str, vector(Size, gen_byte()), - gen_string( strip_0s(Str) ) - )). +gen_mpint() -> ?LET(I, largeint(), ssh_bits:mpint(I)). strip_0s([0|T]) -> strip_0s(T); strip_0s(X) -> X. @@ -230,13 +209,22 @@ gen_name() -> gen_string(). uint32_to_list(I) -> binary_to_list(<<I:32/unsigned-big-integer>>). -%%%---- -get_string(Delim, B) -> - binary_to_list( element(1, split_binary(B, count_string_chars(Delim,B,0))) ). - -count_string_chars(Delim, <<Delim,_/binary>>, Acc) -> Acc; -count_string_chars(Delim, <<_,B/binary>>, Acc) -> count_string_chars(Delim, B, Acc+1). +gen_pubkey_string(Type) -> + PubKey = case Type of + rsa -> #'RSAPublicKey'{modulus = 12345,publicExponent = 2}; + ecdsa -> {#'ECPoint'{point=[1,2,3,4,5]}, + {namedCurve,{1,2,840,10045,3,1,7}}} % 'secp256r1' nistp256 + end, + gen_string(public_key:ssh_encode(PubKey, ssh2_pubkey)). + +gen_signature_string(Type) -> + Signature = <<"hejhopp">>, + Id = case Type of + rsa -> "ssh-rsa"; + ecdsa -> "ecdsa-sha2-nistp256" + end, + gen_string(gen_string(Id) ++ gen_string(Signature)). -define(MSG_CODE(Name,Num), msg_code(Name) -> Num; @@ -273,124 +261,34 @@ msg_code(Num) -> Name ?MSG_CODE('SSH_MSG_CHANNEL_FAILURE', 100); ?MSG_CODE('SSH_MSG_USERAUTH_INFO_REQUEST', 60); ?MSG_CODE('SSH_MSG_USERAUTH_INFO_RESPONSE', 61); +?MSG_CODE('SSH_MSG_KEXDH_INIT', 30); +?MSG_CODE('SSH_MSG_KEXDH_REPLY', 31); ?MSG_CODE('SSH_MSG_KEX_DH_GEX_REQUEST_OLD', 30); ?MSG_CODE('SSH_MSG_KEX_DH_GEX_REQUEST', 34); ?MSG_CODE('SSH_MSG_KEX_DH_GEX_GROUP', 31); ?MSG_CODE('SSH_MSG_KEX_DH_GEX_INIT', 32); -?MSG_CODE('SSH_MSG_KEX_DH_GEX_REPLY', 33). - -%%%============================================================================= -%%%============================================================================= -%%%============================================================================= - -files(Fs) -> - Defs = lists:usort(lists:flatten(lists:map(fun file/1, Fs))), - DefinedIDs = lists:usort([binary_to_list(element(1,D)) || D <- Defs]), - WantedIDs = lists:usort(wanted_messages()), - Missing = WantedIDs -- DefinedIDs, - case Missing of - [] -> ok; - _ -> io:format('%% Warning: missing ~p~n', [Missing]) - end, - Defs. - - -file(F) -> - {ok,B} = file:read_file(F), - hunt_msg_def(B). - - -hunt_msg_def(<<"\n",B/binary>>) -> some_hope(skip_blanks(B)); -hunt_msg_def(<<_, B/binary>>) -> hunt_msg_def(B); -hunt_msg_def(<<>>) -> []. - -some_hope(<<"byte ", B/binary>>) -> try_message(skip_blanks(B)); -some_hope(B) -> hunt_msg_def(B). - -try_message(B = <<"SSH_MSG_",_/binary>>) -> - {ID,Rest} = get_id(B), - case lists:member(binary_to_list(ID), wanted_messages()) of - true -> - {Lines,More} = get_def_lines(skip_blanks(Rest), []), - [{ID,lists:reverse(Lines)} | hunt_msg_def(More)]; - false -> - hunt_msg_def(Rest) - end; -try_message(B) -> hunt_msg_def(B). - - -skip_blanks(<<32, B/binary>>) -> skip_blanks(B); -skip_blanks(<< 9, B/binary>>) -> skip_blanks(B); -skip_blanks(B) -> B. - -get_def_lines(B0 = <<"\n",B/binary>>, Acc) -> - {ID,Rest} = get_id(skip_blanks(B)), - case {size(ID), skip_blanks(Rest)} of - {0,<<"....",More/binary>>} -> - {Text,LineEnd} = get_to_eol(skip_blanks(More)), - get_def_lines(LineEnd, [{<<"....">>,Text}|Acc]); - {0,_} -> - {Acc,B0}; - {_,Rest1} -> - {Text,LineEnd} = get_to_eol(Rest1), - get_def_lines(LineEnd, [{ID,Text}|Acc]) - end; -get_def_lines(B, Acc) -> - {Acc,B}. - - -get_to_eol(B) -> split_binary(B, count_to_eol(B,0)). - -count_to_eol(<<"\n",_/binary>>, Acc) -> Acc; -count_to_eol(<<>>, Acc) -> Acc; -count_to_eol(<<_,B/binary>>, Acc) -> count_to_eol(B,Acc+1). - - -get_id(B) -> split_binary(B, count_id_chars(B,0)). - -count_id_chars(<<C,B/binary>>, Acc) when $A=<C,C=<$Z -> count_id_chars(B,Acc+1); -count_id_chars(<<C,B/binary>>, Acc) when $a=<C,C=<$z -> count_id_chars(B,Acc+1); -count_id_chars(<<C,B/binary>>, Acc) when $0=<C,C=<$9 -> count_id_chars(B,Acc+1); -count_id_chars(<<"_",B/binary>>, Acc) -> count_id_chars(B,Acc+1); -count_id_chars(<<"-",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g name-list -count_id_chars(<<"[",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g byte[16] -count_id_chars(<<"]",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g byte[16] -count_id_chars(_, Acc) -> Acc. - -wanted_messages() -> - ["SSH_MSG_CHANNEL_CLOSE", - "SSH_MSG_CHANNEL_DATA", - "SSH_MSG_CHANNEL_EOF", - "SSH_MSG_CHANNEL_EXTENDED_DATA", - "SSH_MSG_CHANNEL_FAILURE", - "SSH_MSG_CHANNEL_OPEN", - "SSH_MSG_CHANNEL_OPEN_CONFIRMATION", - "SSH_MSG_CHANNEL_OPEN_FAILURE", - "SSH_MSG_CHANNEL_REQUEST", - "SSH_MSG_CHANNEL_SUCCESS", - "SSH_MSG_CHANNEL_WINDOW_ADJUST", - "SSH_MSG_DEBUG", - "SSH_MSG_DISCONNECT", - "SSH_MSG_GLOBAL_REQUEST", - "SSH_MSG_IGNORE", - "SSH_MSG_KEXDH_INIT", - "SSH_MSG_KEXDH_REPLY", - "SSH_MSG_KEXINIT", - "SSH_MSG_KEX_DH_GEX_GROUP", - "SSH_MSG_KEX_DH_GEX_REQUEST", - "SSH_MSG_KEX_DH_GEX_REQUEST_OLD", - "SSH_MSG_NEWKEYS", - "SSH_MSG_REQUEST_FAILURE", - "SSH_MSG_REQUEST_SUCCESS", - "SSH_MSG_SERVICE_ACCEPT", - "SSH_MSG_SERVICE_REQUEST", - "SSH_MSG_UNIMPLEMENTED", - "SSH_MSG_USERAUTH_BANNER", - "SSH_MSG_USERAUTH_FAILURE", -%% hard args "SSH_MSG_USERAUTH_INFO_REQUEST", -%% "SSH_MSG_USERAUTH_INFO_RESPONSE", - "SSH_MSG_USERAUTH_PASSWD_CHANGEREQ", - "SSH_MSG_USERAUTH_PK_OK", -%%rfc4252 p12 error "SSH_MSG_USERAUTH_REQUEST", - "SSH_MSG_USERAUTH_SUCCESS"]. +?MSG_CODE('SSH_MSG_KEX_DH_GEX_REPLY', 33); +?MSG_CODE('SSH_MSG_KEX_ECDH_INIT', 30); +?MSG_CODE('SSH_MSG_KEX_ECDH_REPLY', 31). + +%%%==================================================== +%%%=== WARNING: Knowledge of the test object ahead! === +%%%==================================================== + +%% SSH message records: +-include_lib("ssh/src/ssh_connect.hrl"). +-include_lib("ssh/src/ssh_transport.hrl"). + +%%% Encoding and decodeing is asymetric so out=binary in=string. Sometimes. :( +fix_asym(#ssh_msg_global_request{name=N} = M) -> M#ssh_msg_global_request{name = binary_to_list(N)}; +fix_asym(#ssh_msg_debug{message=D,language=L} = M) -> M#ssh_msg_debug{message = binary_to_list(D), + language = binary_to_list(L)}; +fix_asym(#ssh_msg_kexinit{cookie=C} = M) -> M#ssh_msg_kexinit{cookie = <<C:128>>}; +fix_asym(M) -> M. + +%%% Message codes 30 and 31 are overloaded depending on kex family so arrange the decoder +%%% input as the test object does +decode_state(<<30,_/binary>>=Msg, KexFam) -> <<KexFam/binary, Msg/binary>>; +decode_state(<<31,_/binary>>=Msg, KexFam) -> <<KexFam/binary, Msg/binary>>; +decode_state(Msg, _) -> Msg. diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl index 8b2db0e1a8..14605ee44f 100644 --- a/lib/ssh/test/ssh_algorithms_SUITE.erl +++ b/lib/ssh/test/ssh_algorithms_SUITE.erl @@ -198,7 +198,7 @@ try_exec_simple_group(Group, Config) -> %%-------------------------------------------------------------------- %% Testing all default groups -simple_exec_groups() -> [{timetrap,{minutes,5}}]. +simple_exec_groups() -> [{timetrap,{minutes,8}}]. simple_exec_groups(Config) -> Sizes = interpolate( public_key:dh_gex_group_sizes() ), @@ -206,10 +206,8 @@ simple_exec_groups(Config) -> fun(Sz) -> ct:log("Try size ~p",[Sz]), ct:comment(Sz), - case simple_exec_group(Sz, Config) of - expected -> ct:log("Size ~p ok",[Sz]); - _ -> ct:log("Size ~p not ok",[Sz]) - end + simple_exec_group(Sz, Config), + ct:log("Size ~p ok",[Sz]) end, Sizes), ct:comment("~p",[lists:map(fun({_,I,_}) -> I; (I) -> I diff --git a/lib/ssh/test/ssh_benchmark_SUITE.erl b/lib/ssh/test/ssh_benchmark_SUITE.erl index c2bfc48449..85750f8fbd 100644 --- a/lib/ssh/test/ssh_benchmark_SUITE.erl +++ b/lib/ssh/test/ssh_benchmark_SUITE.erl @@ -30,7 +30,7 @@ suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}, - {timetrap,{minutes,3}} + {timetrap,{minutes,6}} ]. %%suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -70,9 +70,12 @@ init_per_group(opensshc_erld, Config) -> ssh_test_lib:setup_dsa(DataDir, UserDir), ssh_test_lib:setup_rsa(DataDir, UserDir), ssh_test_lib:setup_ecdsa("256", DataDir, UserDir), + AlgsD = ssh:default_algorithms(), + AlgsC = ssh_test_lib:default_algorithms(sshc), Common = ssh_test_lib:intersect_bi_dir( - ssh_test_lib:intersection(ssh:default_algorithms(), - ssh_test_lib:default_algorithms(sshc))), + ssh_test_lib:intersection(AlgsD, AlgsC)), + ct:pal("~p~n~nErld:~n~p~n~nOpenSSHc:~n~p~n~nCommon:~n~p", + [inet:gethostname(), AlgsD, AlgsC, Common]), [{c_kexs, ssh_test_lib:sshc(kex)}, {c_ciphers, ssh_test_lib:sshc(cipher)}, {common_algs, Common} @@ -427,13 +430,20 @@ function_algs_times_sizes(EncDecs, L) -> || {Alg,Size,Time} <- lists:foldl(fun increment/2, [], Raw)]. function_ats_result({ssh_transport,encrypt,2}, #call{args=[S,Data]}) -> - {{encrypt,S#ssh.encrypt}, size(Data)}; + {{encrypt,S#ssh.encrypt}, binsize(Data)}; function_ats_result({ssh_transport,decrypt,2}, #call{args=[S,Data]}) -> - {{decrypt,S#ssh.decrypt}, size(Data)}; + {{decrypt,S#ssh.decrypt}, binsize(Data)}; function_ats_result({ssh_message,encode,1}, #call{result=Data}) -> {encode, size(Data)}; function_ats_result({ssh_message,decode,1}, #call{args=[Data]}) -> {decode, size(Data)}. + +binsize(B) when is_binary(B) -> size(B); +binsize({B1,B2}) when is_binary(B1), is_binary(B2) -> size(B1) + size(B2); +binsize({B1,B2,_}) when is_binary(B1), is_binary(B2) -> size(B1) + size(B2). + + + increment({Alg,Sz,T}, [{Alg,SumSz,SumT}|Acc]) -> diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl index 8f060bebd8..86f5cb1746 100644 --- a/lib/ssh/test/ssh_options_SUITE.erl +++ b/lib/ssh/test/ssh_options_SUITE.erl @@ -831,10 +831,13 @@ supported_hash(HashAlg) -> really_do_hostkey_fingerprint_check(Config, HashAlg) -> PrivDir = proplists:get_value(priv_dir, Config), - UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth - file:make_dir(UserDir), + UserDirServer = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDirServer), SysDir = proplists:get_value(data_dir, Config), + UserDirClient = + ssh_test_lib:create_random_dir(Config), % Ensure no 'known_hosts' disturbs + %% All host key fingerprints. Trust that public_key has checked the ssh_hostkey_fingerprint %% function since that function is used by the ssh client... FPs = [case HashAlg of @@ -857,7 +860,7 @@ really_do_hostkey_fingerprint_check(Config, HashAlg) -> %% Start daemon with the public keys that we got fingerprints from {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, - {user_dir, UserDir}, + {user_dir, UserDirServer}, {password, "morot"}]), FP_check_fun = fun(PeerName, FP) -> @@ -876,7 +879,7 @@ really_do_hostkey_fingerprint_check(Config, HashAlg) -> end}, {user, "foo"}, {password, "morot"}, - {user_dir, UserDir}, + {user_dir, UserDirClient}, {user_interaction, false}]), ssh:stop_daemon(Pid). diff --git a/lib/ssh/test/ssh_property_test_SUITE.erl b/lib/ssh/test/ssh_property_test_SUITE.erl index 7ba2732a88..9b2a84d8e4 100644 --- a/lib/ssh/test/ssh_property_test_SUITE.erl +++ b/lib/ssh/test/ssh_property_test_SUITE.erl @@ -68,9 +68,6 @@ init_per_group(_, Config) -> end_per_group(_, Config) -> Config. -%%% Always skip the testcase that is not quite in phase with the -%%% ssh_message.erl code -init_per_testcase(decode_encode, _) -> {skip, "Fails - testcase is not ok"}; init_per_testcase(_TestCase, Config) -> Config. end_per_testcase(_TestCase, Config) -> Config. diff --git a/lib/ssh/test/ssh_sftp_SUITE.erl b/lib/ssh/test/ssh_sftp_SUITE.erl index 70662f5d93..acf76157a2 100644 --- a/lib/ssh/test/ssh_sftp_SUITE.erl +++ b/lib/ssh/test/ssh_sftp_SUITE.erl @@ -1038,7 +1038,7 @@ oldprep(Config) -> prepare(Config0) -> PrivDir = proplists:get_value(priv_dir, Config0), - Dir = filename:join(PrivDir, random_chars(10)), + Dir = filename:join(PrivDir, ssh_test_lib:random_chars(10)), file:make_dir(Dir), Keys = [filename, testfile, @@ -1058,8 +1058,6 @@ prepare(Config0) -> [{sftp_priv_dir,Dir} | Config2]. -random_chars(N) -> [crypto:rand_uniform($a,$z) || _<-lists:duplicate(N,x)]. - foldl_keydelete(Keys, L) -> lists:foldl(fun(K,E) -> lists:keydelete(K,1,E) end, L, diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index f93237f3e7..286ac6e882 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -113,19 +113,27 @@ std_simple_exec(Host, Port, Config) -> std_simple_exec(Host, Port, Config, []). std_simple_exec(Host, Port, Config, Opts) -> + ct:log("~p:~p std_simple_exec",[?MODULE,?LINE]), ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, Opts), + ct:log("~p:~p connected! ~p",[?MODULE,?LINE,ConnectionRef]), {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), - success = ssh_connection:exec(ConnectionRef, ChannelId, "23+21-2.", infinity), - Data = {ssh_cm, ConnectionRef, {data, ChannelId, 0, <<"42\n">>}}, - case ssh_test_lib:receive_exec_result(Data) of - expected -> - ok; - Other -> - ct:fail(Other) - end, - ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId), - ssh:close(ConnectionRef). - + ct:log("~p:~p session_channel ok ~p",[?MODULE,?LINE,ChannelId]), + ExecResult = ssh_connection:exec(ConnectionRef, ChannelId, "23+21-2.", infinity), + ct:log("~p:~p exec ~p",[?MODULE,?LINE,ExecResult]), + case ExecResult of + success -> + Expected = {ssh_cm, ConnectionRef, {data,ChannelId,0,<<"42\n">>}}, + case receive_exec_result(Expected) of + expected -> + ok; + Other -> + ct:fail(Other) + end, + receive_exec_end(ConnectionRef, ChannelId), + ssh:close(ConnectionRef); + _ -> + ct:fail(ExecResult) + end. start_shell(Port, IOServer) -> start_shell(Port, IOServer, []). @@ -834,3 +842,20 @@ get_kex_init(Conn, Ref, TRef) -> end end. +%%%---------------------------------------------------------------- +%%% Return a string with N random characters +%%% +random_chars(N) -> [crypto:rand_uniform($a,$z) || _<-lists:duplicate(N,x)]. + + +create_random_dir(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + Name = filename:join(PrivDir, random_chars(15)), + case file:make_dir(Name) of + ok -> + Name; + {error,eexist} -> + %% The Name already denotes an existing file system object, try again. + %% The likelyhood of always generating an existing file name is low + create_random_dir(Config) + end. diff --git a/lib/ssh/test/ssh_upgrade_SUITE.erl b/lib/ssh/test/ssh_upgrade_SUITE.erl index b5b27c369a..7b9b109fa1 100644 --- a/lib/ssh/test/ssh_upgrade_SUITE.erl +++ b/lib/ssh/test/ssh_upgrade_SUITE.erl @@ -199,6 +199,4 @@ close(#state{server = Server, connection = undefined}. -random_contents() -> list_to_binary( random_chars(3) ). - -random_chars(N) -> [crypto:rand_uniform($a,$z) || _<-lists:duplicate(N,x)]. +random_contents() -> list_to_binary( ssh_test_lib:random_chars(3) ). diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index edc7e0d8b2..916b41742e 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -424,6 +424,14 @@ marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_valid </taglist> </item> + + <tag><c>max_handshake_size</c></tag> + <item> + <p>Integer (24 bits unsigned). Used to limit the size of + valid TLS handshake packets to avoid DoS attacks. + Defaults to 256*1024.</p> + </item> + </taglist> </item> diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index c72ee44a95..0b7229b67e 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -765,7 +765,8 @@ handle_options(Opts0, Role) -> client, Role), crl_check = handle_option(crl_check, Opts, false), crl_cache = handle_option(crl_cache, Opts, {ssl_crl_cache, {internal, []}}), - v2_hello_compatible = handle_option(v2_hello_compatible, Opts, false) + v2_hello_compatible = handle_option(v2_hello_compatible, Opts, false), + max_handshake_size = handle_option(max_handshake_size, Opts, ?DEFAULT_MAX_HANDSHAKE_SIZE) }, CbInfo = proplists:get_value(cb_info, Opts, default_cb_info(Protocol)), @@ -780,7 +781,8 @@ handle_options(Opts0, Role) -> alpn_preferred_protocols, next_protocols_advertised, client_preferred_next_protocols, log_alert, server_name_indication, honor_cipher_order, padding_check, crl_check, crl_cache, - fallback, signature_algs, eccs, honor_ecc_order, beast_mitigation, v2_hello_compatible], + fallback, signature_algs, eccs, honor_ecc_order, beast_mitigation, v2_hello_compatible, + max_handshake_size], SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) @@ -1028,6 +1030,8 @@ validate_option(beast_mitigation, Value) when Value == one_n_minus_one orelse Value; validate_option(v2_hello_compatible, Value) when is_boolean(Value) -> Value; +validate_option(max_handshake_size, Value) when is_integer(Value) andalso Value =< ?MAX_UNIT24 -> + Value; validate_option(Opt, Value) -> throw({error, {options, {Opt, Value}}}). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 6e7c8c5ddd..6ed2fc83da 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -864,11 +864,11 @@ handle_call({close, {Pid, Timeout}}, From, StateName, State0, Connection) when i %% When downgrading an TLS connection to a transport connection %% we must recive the close alert from the peer before releasing the %% transport socket. - {next_state, downgrade, State, [{timeout, Timeout, downgrade}]}; + {next_state, downgrade, State#state{terminated = true}, [{timeout, Timeout, downgrade}]}; handle_call({close, _} = Close, From, StateName, State, Connection) -> %% Run terminate before returning so that the reuseaddr - %% inet-option - Result = Connection:terminate(Close, StateName, State), + %% inet-option works properly + Result = Connection:terminate(Close, StateName, State#state{terminated = true}), {stop_and_reply, {shutdown, normal}, {reply, From, Result}, State}; handle_call({shutdown, How0}, From, _, @@ -1010,7 +1010,10 @@ handle_info(Msg, StateName, #state{socket = Socket, error_tag = Tag} = State) -> terminate(_, _, #state{terminated = true}) -> %% Happens when user closes the connection using ssl:close/1 %% we want to guarantee that Transport:close has been called - %% when ssl:close/1 returns. + %% when ssl:close/1 returns unless it is a downgrade where + %% we want to guarantee that close alert is recived before + %% returning. In both cases terminate has been run manually + %% before run by gen_statem which will end up here ok; terminate({shutdown, transport_closed} = Reason, diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index fde92035a2..324b7dbde3 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -80,6 +80,9 @@ -define(CLIENT_KEY_EXCHANGE, 16). -define(FINISHED, 20). +-define(MAX_UNIT24, 8388607). +-define(DEFAULT_MAX_HANDSHAKE_SIZE, (256*1024)). + -record(random, { gmt_unix_time, % uint32 random_bytes % opaque random_bytes[28] diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 98b89bb811..c34af9f82c 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -142,7 +142,8 @@ signature_algs, eccs, honor_ecc_order :: boolean(), - v2_hello_compatible :: boolean() + v2_hello_compatible :: boolean(), + max_handshake_size :: integer() }). -record(socket_options, diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 32991d3079..77606911be 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -424,18 +424,26 @@ handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, ssl_options = Options} = State0) -> try {Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0, Options), - State = + State1 = State0#state{protocol_buffers = Buffers#protocol_buffers{tls_handshake_buffer = Buf}}, - Events = tls_handshake_events(Packets), - case StateName of - connection -> - ssl_connection:hibernate_after(StateName, State, Events); - _ -> - {next_state, StateName, State#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events} - end + case Packets of + [] -> + assert_buffer_sanity(Buf, Options), + {Record, State} = next_record(State1), + next_event(StateName, Record, State); + _ -> + Events = tls_handshake_events(Packets), + case StateName of + connection -> + ssl_connection:hibernate_after(StateName, State1, Events); + _ -> + {next_state, StateName, + State1#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events} + end + end catch throw:#alert{} = Alert -> - ssl_connection:handle_own_alert(Alert, Version, StateName, State0) + ssl_connection:handle_own_alert(Alert, Version, StateName, State0) end; %%% TLS record protocol level application data messages handle_common_event(internal, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, State) -> @@ -615,8 +623,6 @@ next_event(StateName, Record, State, Actions) -> {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} end. -tls_handshake_events([]) -> - throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, malformed_handshake)); tls_handshake_events(Packets) -> lists:map(fun(Packet) -> {next_event, internal, {handshake, Packet}} @@ -735,3 +741,25 @@ unprocessed_events(Events) -> %% handshake events left to process before we should %% process more TLS-records received on the socket. erlang:length(Events)-1. + + +assert_buffer_sanity(<<?BYTE(_Type), ?UINT24(Length), Rest/binary>>, #ssl_options{max_handshake_size = Max}) when + Length =< Max -> + case size(Rest) of + N when N < Length -> + true; + N when N > Length -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, + too_big_handshake_data)); + _ -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, + malformed_handshake_data)) + end; +assert_buffer_sanity(Bin, _) -> + case size(Bin) of + N when N < 3 -> + true; + _ -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, + malformed_handshake_data)) + end. diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 52c1af5b4c..de5895d7ba 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -136,7 +136,8 @@ options_tests() -> honor_server_cipher_order, honor_client_cipher_order, unordered_protocol_versions_server, - unordered_protocol_versions_client + unordered_protocol_versions_client, + max_handshake_size ]. options_tests_tls() -> @@ -3860,6 +3861,29 @@ unordered_protocol_versions_client(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg). %%-------------------------------------------------------------------- +max_handshake_size() -> + [{doc,"Test that we can set max_handshake_size to max value."}]. + +max_handshake_size(Config) when is_list(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, [{max_handshake_size, 8388607} |ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, [{max_handshake_size, 8388607} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok). + +%%-------------------------------------------------------------------- server_name_indication_option() -> [{doc,"Test API server_name_indication option to connect."}]. diff --git a/lib/stdlib/doc/src/dict.xml b/lib/stdlib/doc/src/dict.xml index c926ff1b5b..c229a18721 100644 --- a/lib/stdlib/doc/src/dict.xml +++ b/lib/stdlib/doc/src/dict.xml @@ -106,6 +106,16 @@ </func> <func> + <name name="take" arity="2"/> + <fsummary>Return value and new dictionary without element with this value.</fsummary> + <desc> + <p>This function returns value from dictionary and a + new dictionary without this value. + Returns <c>error</c> if the key is not present in the dictionary.</p> + </desc> + </func> + + <func> <name name="filter" arity="2"/> <fsummary>Select elements that satisfy a predicate.</fsummary> <desc> diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 5f5d2b7f36..05401a2d40 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -541,10 +541,6 @@ Error: fun containing local Erlang function calls <c><anno>Tab</anno></c> is not of the correct type, or if <c><anno>Item</anno></c> is not one of the allowed values, a <c>badarg</c> exception is raised.</p> - <warning> - <p>In Erlang/OTP R11B and earlier, this function would not fail but - return <c>undefined</c> for invalid values for <c>Item</c>.</p> - </warning> <p>In addition to the <c>{<anno>Item</anno>,<anno>Value</anno>}</c> pairs defined for <seealso marker="#info/1"><c>info/1</c></seealso>, the following items are allowed:</p> diff --git a/lib/stdlib/doc/src/gb_trees.xml b/lib/stdlib/doc/src/gb_trees.xml index 790d4b8bf1..5cfff021c1 100644 --- a/lib/stdlib/doc/src/gb_trees.xml +++ b/lib/stdlib/doc/src/gb_trees.xml @@ -109,6 +109,28 @@ </func> <func> + <name name="take" arity="2"/> + <fsummary>Returns a value and new tree without node with key <c>Key</c>.</fsummary> + <desc> + <p>Returns a value <c><anno>Value</anno></c> from node with key <c><anno>Key</anno></c> + and new <c><anno>Tree2</anno></c> without the node with this value. + Assumes that the node with key is present in the tree, + crashes otherwise.</p> + </desc> + </func> + + <func> + <name name="take_any" arity="2"/> + <fsummary>Returns a value and new tree without node with key <c>Key</c>.</fsummary> + <desc> + <p>Returns a value <c><anno>Value</anno></c> from node with key <c><anno>Key</anno></c> + and new <c><anno>Tree2</anno></c> without the node with this value. + Returns <c>error</c> if the node with the key is not present in + the tree.</p> + </desc> + </func> + + <func> <name name="empty" arity="0"/> <fsummary>Return an empty tree.</fsummary> <desc> diff --git a/lib/stdlib/doc/src/gen_event.xml b/lib/stdlib/doc/src/gen_event.xml index c24542002a..42e952fd46 100644 --- a/lib/stdlib/doc/src/gen_event.xml +++ b/lib/stdlib/doc/src/gen_event.xml @@ -350,13 +350,18 @@ gen_event:stop -----> Module:terminate/2 <func> <name>start() -> Result</name> - <name>start(EventMgrName) -> Result</name> + <name>start(EventMgrName | Options) -> Result</name> + <name>start(EventMgrName, Options) -> Result</name> <fsummary>Create a stand-alone event manager process.</fsummary> <type> - <v>EventMgrName = {local,Name} | {global,GlobalName} - | {via,Module,ViaName}</v> + <v>EventMgrName = {local,Name} | {global,GlobalName} | {via,Module,ViaName}</v> <v> Name = atom()</v> <v> GlobalName = ViaName = term()</v> + <v>Options = [Option]</v> + <v> Option = {debug,Dbgs} | {timeout,Time} | {spawn_opt,SOpts}</v> + <v> Dbgs = [Dbg]</v> + <v> Dbg = trace | log | statistics | {log_to_file,FileName} | {install,{Func,FuncState}}</v> + <v> SOpts = [term()]</v> <v>Result = {ok,Pid} | {error,{already_started,Pid}}</v> <v> Pid = pid()</v> </type> @@ -371,14 +376,19 @@ gen_event:stop -----> Module:terminate/2 <func> <name>start_link() -> Result</name> - <name>start_link(EventMgrName) -> Result</name> + <name>start_link(EventMgrName | Options) -> Result</name> + <name>start_link(EventMgrName, Options) -> Result</name> <fsummary>Create a generic event manager process in a supervision tree. </fsummary> <type> - <v>EventMgrName = {local,Name} | {global,GlobalName} - | {via,Module,ViaName}</v> + <v>EventMgrName = {local,Name} | {global,GlobalName} | {via,Module,ViaName}</v> <v> Name = atom()</v> <v> GlobalName = ViaName = term()</v> + <v>Options = [Option]</v> + <v> Option = {debug,Dbgs} | {timeout,Time} | {spawn_opt,SOpts}</v> + <v> Dbgs = [Dbg]</v> + <v> Dbg = trace | log | statistics | {log_to_file,FileName} | {install,{Func,FuncState}}</v> + <v> SOpts = [term()]</v> <v>Result = {ok,Pid} | {error,{already_started,Pid}}</v> <v> Pid = pid()</v> </type> diff --git a/lib/stdlib/doc/src/gen_fsm.xml b/lib/stdlib/doc/src/gen_fsm.xml index de06987d38..719ab2b558 100644 --- a/lib/stdlib/doc/src/gen_fsm.xml +++ b/lib/stdlib/doc/src/gen_fsm.xml @@ -534,11 +534,6 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4 the function call fails.</p> <p>Return value <c>Reply</c> is defined in the return value of <c>Module:StateName/3</c>.</p> - <note> - <p>The ancient behavior of sometimes consuming the server - exit message if the server died during the call while - linked to the client was removed in Erlang 5.6/OTP R12B.</p> - </note> </desc> </func> </funcs> diff --git a/lib/stdlib/doc/src/gen_server.xml b/lib/stdlib/doc/src/gen_server.xml index 4a7dd60858..662076b5f0 100644 --- a/lib/stdlib/doc/src/gen_server.xml +++ b/lib/stdlib/doc/src/gen_server.xml @@ -162,11 +162,6 @@ gen_server:abcast -----> Module:handle_cast/2 of <c>Module:handle_call/3</c>.</p> <p>The call can fail for many reasons, including time-out and the called <c>gen_server</c> process dying before or during the call.</p> - <note> - <p>The ancient behavior of sometimes consuming the server - exit message if the server died during the call while - linked to the client was removed in Erlang 5.6/OTP R12B.</p> - </note> </desc> </func> diff --git a/lib/stdlib/doc/src/orddict.xml b/lib/stdlib/doc/src/orddict.xml index 109b038cb5..26bbf499c6 100644 --- a/lib/stdlib/doc/src/orddict.xml +++ b/lib/stdlib/doc/src/orddict.xml @@ -113,6 +113,15 @@ </func> <func> + <name name="take" arity="2"/> + <fsummary>Return value and new dictionary without element with this value.</fsummary> + <desc> + <p>This function returns value from dictionary and new dictionary without this value. + Returns <c>error</c> if the key is not present in the dictionary.</p> + </desc> + </func> + + <func> <name name="filter" arity="2"/> <fsummary>Select elements that satisfy a predicate.</fsummary> <desc> diff --git a/lib/stdlib/src/dict.erl b/lib/stdlib/src/dict.erl index f921e28ef6..9449ba3dc2 100644 --- a/lib/stdlib/src/dict.erl +++ b/lib/stdlib/src/dict.erl @@ -38,7 +38,7 @@ %% Standard interface. -export([new/0,is_key/2,to_list/1,from_list/1,size/1,is_empty/1]). --export([fetch/2,find/2,fetch_keys/1,erase/2]). +-export([fetch/2,find/2,fetch_keys/1,erase/2,take/2]). -export([store/3,append/3,append_list/3,update/3,update/4,update_counter/3]). -export([fold/3,map/2,filter/2,merge/3]). @@ -172,6 +172,27 @@ erase_key(Key, [E|Bkt0]) -> {[E|Bkt1],Dc}; erase_key(_, []) -> {[],0}. +-spec take(Key, Dict) -> {Value, Dict1} | error when + Dict :: dict(Key, Value), + Dict1 :: dict(Key, Value), + Key :: term(), + Value :: term(). + +take(Key, D0) -> + Slot = get_slot(D0, Key), + case on_bucket(fun (B0) -> take_key(Key, B0) end, D0, Slot) of + {D1,{Value,Dc}} -> + {Value, maybe_contract(D1, Dc)}; + {_,error} -> error + end. + +take_key(Key, [?kv(Key,Val)|Bkt]) -> + {Bkt,{Val,1}}; +take_key(Key, [E|Bkt0]) -> + {Bkt1,Res} = take_key(Key, Bkt0), + {[E|Bkt1],Res}; +take_key(_, []) -> {[],error}. + -spec store(Key, Value, Dict1) -> Dict2 when Dict1 :: dict(Key, Value), Dict2 :: dict(Key, Value). diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 40a34aa30f..eafee346eb 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -1306,6 +1306,7 @@ partial_eval(Expr) -> ev_expr({op,_,Op,L,R}) -> erlang:Op(ev_expr(L), ev_expr(R)); ev_expr({op,_,Op,A}) -> erlang:Op(ev_expr(A)); ev_expr({integer,_,X}) -> X; +ev_expr({char,_,X}) -> X; ev_expr({float,_,X}) -> X; ev_expr({atom,_,X}) -> X; ev_expr({tuple,_,Es}) -> diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 9cd95705af..922455a6f2 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -33,7 +33,6 @@ list tail list_comprehension lc_expr lc_exprs binary_comprehension tuple -%struct record_expr record_tuple record_field record_fields map_expr map_tuple map_field map_field_assoc map_field_exact map_fields map_key if_expr if_clause if_clauses case_expr cr_clause cr_clauses receive_expr @@ -108,9 +107,8 @@ type_sig -> fun_type 'when' type_guards : {type, ?anno('$1'), bounded_fun, type_guards -> type_guard : ['$1']. type_guards -> type_guard ',' type_guards : ['$1'|'$3']. -type_guard -> atom '(' top_types ')' : {type, ?anno('$1'), constraint, - ['$1', '$3']}. -type_guard -> var '::' top_type : build_def('$1', '$3'). +type_guard -> atom '(' top_types ')' : build_compat_constraint('$1', '$3'). +type_guard -> var '::' top_type : build_constraint('$1', '$3'). top_types -> top_type : ['$1']. top_types -> top_type ',' top_types : ['$1'|'$3']. @@ -156,6 +154,7 @@ type -> '#' atom '{' field_types '}' : {type, ?anno('$1'), record, ['$2'|'$4']}. type -> binary_type : '$1'. type -> integer : '$1'. +type -> char : '$1'. type -> 'fun' '(' ')' : {type, ?anno('$1'), 'fun', []}. type -> 'fun' '(' fun_type_100 ')' : '$3'. @@ -268,7 +267,6 @@ expr_max -> binary : '$1'. expr_max -> list_comprehension : '$1'. expr_max -> binary_comprehension : '$1'. expr_max -> tuple : '$1'. -%%expr_max -> struct : '$1'. expr_max -> '(' expr ')' : '$2'. expr_max -> 'begin' exprs 'end' : {block,?anno('$1'),'$2'}. expr_max -> if_expr : '$1'. @@ -327,10 +325,6 @@ lc_expr -> binary '<=' expr : {b_generate,?anno('$2'),'$1','$3'}. tuple -> '{' '}' : {tuple,?anno('$1'),[]}. tuple -> '{' exprs '}' : {tuple,?anno('$1'),'$2'}. - -%%struct -> atom tuple : -%% {struct,?anno('$1'),element(3, '$1'),element(3, '$2')}. - map_expr -> '#' map_tuple : {map, ?anno('$1'),'$2'}. map_expr -> expr_max '#' map_tuple : @@ -1056,13 +1050,13 @@ build_typed_attribute({atom,Aa,Attr},_) -> end. build_type_spec({Kind,Aa}, {SpecFun, TypeSpecs}) - when (Kind =:= spec) or (Kind =:= callback) -> + when Kind =:= spec ; Kind =:= callback -> NewSpecFun = case SpecFun of {atom, _, Fun} -> {Fun, find_arity_from_specs(TypeSpecs)}; - {{atom,_, Mod}, {atom,_, Fun}} -> - {Mod,Fun,find_arity_from_specs(TypeSpecs)} + {{atom, _, Mod}, {atom, _, Fun}} -> + {Mod, Fun, find_arity_from_specs(TypeSpecs)} end, {attribute,Aa,Kind,{NewSpecFun, TypeSpecs}}. @@ -1076,11 +1070,24 @@ find_arity_from_specs([Spec|_]) -> {type, _, 'fun', [{type, _, product, Args},_]} = Fun, length(Args). -build_def({var, A, '_'}, _Types) -> +%% The 'is_subtype(V, T)' syntax is not supported as of Erlang/OTP +%% 19.0, but is kept for backward compatibility. +build_compat_constraint({atom, _, is_subtype}, [{var, _, _}=LHS, Type]) -> + build_constraint(LHS, Type); +build_compat_constraint({atom, _, is_subtype}, [LHS, _Type]) -> + ret_err(?anno(LHS), "bad type variable"); +build_compat_constraint({atom, A, Atom}, _Types) -> + ret_err(A, io_lib:format("unsupported constraint ~w", [Atom])). + +build_constraint({atom, _, is_subtype}, [{var, _, _}=LHS, Type]) -> + build_constraint(LHS, Type); +build_constraint({atom, A, Atom}, _Foo) -> + ret_err(A, io_lib:format("unsupported constraint ~w", [Atom])); +build_constraint({var, A, '_'}, _Types) -> ret_err(A, "bad type variable"); -build_def(LHS, Types) -> +build_constraint(LHS, Type) -> IsSubType = {atom, ?anno(LHS), is_subtype}, - {type, ?anno(LHS), constraint, [IsSubType, [LHS, Types]]}. + {type, ?anno(LHS), constraint, [IsSubType, [LHS, Type]]}. lift_unions(T1, {type, _Aa, union, List}) -> {type, ?anno(T1), union, [T1|List]}; @@ -1573,13 +1580,17 @@ new_anno(Term) -> Abstr :: erl_parse_tree(). anno_to_term(Abstract) -> - map_anno(fun erl_anno:to_term/1, Abstract). + F = fun(Anno, Acc) -> {erl_anno:to_term(Anno), Acc} end, + {NewAbstract, []} = modify_anno1(Abstract, [], F), + NewAbstract. -spec anno_from_term(Term) -> erl_parse_tree() when Term :: term(). anno_from_term(Term) -> - map_anno(fun erl_anno:from_term/1, Term). + F = fun(T, Acc) -> {erl_anno:from_term(T), Acc} end, + {NewTerm, []} = modify_anno1(Term, [], F), + NewTerm. %% Forms. modify_anno1({function,F,A}, Ac, _Mf) -> diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index 7f5ef4df42..c42ae981e7 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -481,46 +481,49 @@ find_first_body_line(Fd, HeaderSz0, LineNo, KeepFirst, Sections) -> %% Look for special comment on second line Line2 = get_line(Fd), {ok, HeaderSz2} = file:position(Fd, cur), - case classify_line(Line2) of - emu_args -> - %% Skip special comment on second line - Line3 = get_line(Fd), - {HeaderSz2, LineNo + 2, Fd, - Sections#sections{type = guess_type(Line3), - comment = undefined, - emu_args = Line2}}; - Line2Type -> - %% Look for special comment on third line - Line3 = get_line(Fd), - {ok, HeaderSz3} = file:position(Fd, cur), - Line3Type = classify_line(Line3), - if - Line3Type =:= emu_args -> - %% Skip special comment on third line - Line4 = get_line(Fd), - {HeaderSz3, LineNo + 3, Fd, - Sections#sections{type = guess_type(Line4), - comment = Line2, - emu_args = Line3}}; - Sections#sections.shebang =:= undefined, - KeepFirst =:= true -> - %% No shebang. Use the entire file - {HeaderSz0, LineNo, Fd, - Sections#sections{type = guess_type(Line2)}}; - Sections#sections.shebang =:= undefined -> - %% No shebang. Skip the first line - {HeaderSz1, LineNo, Fd, - Sections#sections{type = guess_type(Line2)}}; - Line2Type =:= comment -> - %% Skip shebang on first line and comment on second - {HeaderSz2, LineNo + 2, Fd, - Sections#sections{type = guess_type(Line3), - comment = Line2}}; - true -> - %% Just skip shebang on first line - {HeaderSz1, LineNo + 1, Fd, - Sections#sections{type = guess_type(Line2)}} - end + if + Sections#sections.shebang =:= undefined, + KeepFirst =:= true -> + %% No shebang. Use the entire file + {HeaderSz0, LineNo, Fd, + Sections#sections{type = guess_type(Line2)}}; + Sections#sections.shebang =:= undefined -> + %% No shebang. Skip the first line + {HeaderSz1, LineNo, Fd, + Sections#sections{type = guess_type(Line2)}}; + true -> + case classify_line(Line2) of + emu_args -> + %% Skip special comment on second line + Line3 = get_line(Fd), + {HeaderSz2, LineNo + 2, Fd, + Sections#sections{type = guess_type(Line3), + comment = undefined, + emu_args = Line2}}; + comment -> + %% Look for special comment on third line + Line3 = get_line(Fd), + {ok, HeaderSz3} = file:position(Fd, cur), + Line3Type = classify_line(Line3), + if + Line3Type =:= emu_args -> + %% Skip special comment on third line + Line4 = get_line(Fd), + {HeaderSz3, LineNo + 3, Fd, + Sections#sections{type = guess_type(Line4), + comment = Line2, + emu_args = Line3}}; + true -> + %% Skip shebang on first line and comment on second + {HeaderSz2, LineNo + 2, Fd, + Sections#sections{type = guess_type(Line3), + comment = Line2}} + end; + _ -> + %% Just skip shebang on first line + {HeaderSz1, LineNo + 1, Fd, + Sections#sections{type = guess_type(Line2)}} + end end. classify_line(Line) -> diff --git a/lib/stdlib/src/gb_trees.erl b/lib/stdlib/src/gb_trees.erl index 457287fa52..c0cdde012e 100644 --- a/lib/stdlib/src/gb_trees.erl +++ b/lib/stdlib/src/gb_trees.erl @@ -52,6 +52,13 @@ %% - delete_any(X, T): removes key X from tree T if the key is present %% in the tree, otherwise does nothing; returns new tree. %% +%% - take(X, T): removes element with key X from tree T; returns new tree +%% without removed element. Assumes that the key is present in the tree. +%% +%% - take_any(X, T): removes element with key X from tree T and returns +%% a new tree if the key is present; otherwise does nothing and returns +%% 'error'. +%% %% - balance(T): rebalances tree T. Note that this is rarely necessary, %% but may be motivated when a large number of entries have been %% deleted from the tree without further insertions. Rebalancing could @@ -114,7 +121,8 @@ -export([empty/0, is_empty/1, size/1, lookup/2, get/2, insert/3, update/3, enter/3, delete/2, delete_any/2, balance/1, is_defined/2, keys/1, values/1, to_list/1, from_orddict/1, - smallest/1, largest/1, take_smallest/1, take_largest/1, + smallest/1, largest/1, take/2, take_any/2, + take_smallest/1, take_largest/1, iterator/1, iterator_from/2, next/1, map/2]). @@ -416,6 +424,41 @@ merge(Smaller, Larger) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-spec take_any(Key, Tree1) -> {Value, Tree2} | 'error' when + Tree1 :: tree(Key, _), + Tree2 :: tree(Key, _), + Key :: term(), + Value :: term(). + +take_any(Key, Tree) -> + case is_defined(Key, Tree) of + true -> take(Key, Tree); + false -> error + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-spec take(Key, Tree1) -> {Value, Tree2} when + Tree1 :: tree(Key, _), + Tree2 :: tree(Key, _), + Key :: term(), + Value :: term(). + +take(Key, {S, T}) when is_integer(S), S >= 0 -> + {Value, Res} = take_1(Key, T), + {Value, {S - 1, Res}}. + +take_1(Key, {Key1, Value, Smaller, Larger}) when Key < Key1 -> + {Value2, Smaller1} = take_1(Key, Smaller), + {Value2, {Key1, Value, Smaller1, Larger}}; +take_1(Key, {Key1, Value, Smaller, Bigger}) when Key > Key1 -> + {Value2, Bigger1} = take_1(Key, Bigger), + {Value2, {Key1, Value, Smaller, Bigger1}}; +take_1(_, {_Key, Value, Smaller, Larger}) -> + {Value, merge(Smaller, Larger)}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + -spec take_smallest(Tree1) -> {Key, Value, Tree2} when Tree1 :: tree(Key, Value), Tree2 :: tree(Key, Value). diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index ccacf658e9..4839fe4f2c 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -32,7 +32,9 @@ %%% Modified by Martin - uses proc_lib, sys and gen! --export([start/0, start/1, start_link/0, start_link/1, stop/1, stop/3, +-export([start/0, start/1, start/2, + start_link/0, start_link/1, start_link/2, + stop/1, stop/3, notify/2, sync_notify/2, add_handler/3, add_sup_handler/3, delete_handler/3, swap_handler/3, swap_sup_handler/3, which_handlers/1, call/3, call/4, wake_hib/4]). @@ -117,30 +119,64 @@ -type del_handler_ret() :: ok | term() | {'EXIT',term()}. -type emgr_name() :: {'local', atom()} | {'global', atom()} - | {'via', atom(), term()}. + | {'via', atom(), term()}. +-type debug_flag() :: 'trace' | 'log' | 'statistics' | 'debug' + | {'logfile', string()}. +-type option() :: {'timeout', timeout()} + | {'debug', [debug_flag()]} + | {'spawn_opt', [proc_lib:spawn_option()]}. -type emgr_ref() :: atom() | {atom(), atom()} | {'global', atom()} - | {'via', atom(), term()} | pid(). + | {'via', atom(), term()} | pid(). -type start_ret() :: {'ok', pid()} | {'error', term()}. %%--------------------------------------------------------------------------- -define(NO_CALLBACK, 'no callback module'). +%% ----------------------------------------------------------------- +%% Starts a generic event handler. +%% start() +%% start(MgrName | Options) +%% start(MgrName, Options) +%% start_link() +%% start_link(MgrName | Options) +%% start_link(MgrName, Options) +%% MgrName ::= {local, atom()} | {global, atom()} | {via, atom(), term()} +%% Options ::= [{timeout, Timeout} | {debug, [Flag]} | {spawn_opt,SOpts}] +%% Flag ::= trace | log | {logfile, File} | statistics | debug +%% (debug == log && statistics) +%% Returns: {ok, Pid} | +%% {error, {already_started, Pid}} | +%% {error, Reason} +%% ----------------------------------------------------------------- + -spec start() -> start_ret(). start() -> gen:start(?MODULE, nolink, ?NO_CALLBACK, [], []). --spec start(emgr_name()) -> start_ret(). -start(Name) -> - gen:start(?MODULE, nolink, Name, ?NO_CALLBACK, [], []). +-spec start(emgr_name() | [option()]) -> start_ret(). +start(Name) when is_tuple(Name) -> + gen:start(?MODULE, nolink, Name, ?NO_CALLBACK, [], []); +start(Options) when is_list(Options) -> + gen:start(?MODULE, nolink, ?NO_CALLBACK, [], Options). + +-spec start(emgr_name(), [option()]) -> start_ret(). +start(Name, Options) -> + gen:start(?MODULE, nolink, Name, ?NO_CALLBACK, [], Options). -spec start_link() -> start_ret(). start_link() -> gen:start(?MODULE, link, ?NO_CALLBACK, [], []). --spec start_link(emgr_name()) -> start_ret(). -start_link(Name) -> - gen:start(?MODULE, link, Name, ?NO_CALLBACK, [], []). +-spec start_link(emgr_name() | [option()]) -> start_ret(). +start_link(Name) when is_tuple(Name) -> + gen:start(?MODULE, link, Name, ?NO_CALLBACK, [], []); +start_link(Options) when is_list(Options) -> + gen:start(?MODULE, link, ?NO_CALLBACK, [], Options). + +-spec start_link(emgr_name(), [option()]) -> start_ret(). +start_link(Name, Options) -> + gen:start(?MODULE, link, Name, ?NO_CALLBACK, [], Options). %% -spec init_it(pid(), 'self' | pid(), emgr_name(), module(), [term()], [_]) -> init_it(Starter, self, Name, Mod, Args, Options) -> @@ -160,7 +196,7 @@ add_sup_handler(M, Handler, Args) -> rpc(M, {add_sup_handler, Handler, Args, self()}). -spec notify(emgr_ref(), term()) -> 'ok'. -notify(M, Event) -> send(M, {notify, Event}). +notify(M, Event) -> send(M, {notify, Event}). -spec sync_notify(emgr_ref(), term()) -> 'ok'. sync_notify(M, Event) -> rpc(M, {sync_notify, Event}). @@ -193,7 +229,7 @@ stop(M) -> stop(M, Reason, Timeout) -> gen:stop(M, Reason, Timeout). -rpc(M, Cmd) -> +rpc(M, Cmd) -> {ok, Reply} = gen:call(M, self(), Cmd, infinity), Reply. @@ -421,7 +457,7 @@ server_add_handler({Mod,Id}, Args, MSL) -> Handler = #handler{module = Mod, id = Id}, server_add_handler(Mod, Handler, Args, MSL); -server_add_handler(Mod, Args, MSL) -> +server_add_handler(Mod, Args, MSL) -> Handler = #handler{module = Mod}, server_add_handler(Mod, Handler, Args, MSL). @@ -446,7 +482,7 @@ server_add_sup_handler({Mod,Id}, Args, MSL, Parent) -> id = Id, supervised = Parent}, server_add_handler(Mod, Handler, Args, MSL); -server_add_sup_handler(Mod, Args, MSL, Parent) -> +server_add_sup_handler(Mod, Args, MSL, Parent) -> link(Parent), Handler = #handler{module = Mod, supervised = Parent}, @@ -454,7 +490,7 @@ server_add_sup_handler(Mod, Args, MSL, Parent) -> %% server_delete_handler(HandlerId, Args, MSL) -> {Ret, MSL'} -server_delete_handler(HandlerId, Args, MSL, SName) -> +server_delete_handler(HandlerId, Args, MSL, SName) -> case split(HandlerId, MSL) of {Mod, Handler, MSL1} -> {do_terminate(Mod, Handler, Args, @@ -511,7 +547,7 @@ split_and_terminate(HandlerId, Args, MSL, SName, Handler2, Sup) -> %% server_notify(Event, Func, MSL, SName) -> MSL' -server_notify(Event, Func, [Handler|T], SName) -> +server_notify(Event, Func, [Handler|T], SName) -> case server_update(Handler, Func, Event, SName) of {ok, Handler1} -> {Hib, NewHandlers} = server_notify(Event, Func, T, SName), @@ -531,9 +567,9 @@ server_update(Handler1, Func, Event, SName) -> Mod1 = Handler1#handler.module, State = Handler1#handler.state, case catch Mod1:Func(Event, State) of - {ok, State1} -> + {ok, State1} -> {ok, Handler1#handler{state = State1}}; - {ok, State1, hibernate} -> + {ok, State1, hibernate} -> {hibernate, Handler1#handler{state = State1}}; {swap_handler, Args1, State1, Handler2, Args2} -> do_swap(Mod1, Handler1, Args1, State1, Handler2, Args2, SName); @@ -644,14 +680,14 @@ server_call_update(Handler1, Query, SName) -> Mod1 = Handler1#handler.module, State = Handler1#handler.state, case catch Mod1:handle_call(Query, State) of - {ok, Reply, State1} -> + {ok, Reply, State1} -> {{ok, Handler1#handler{state = State1}}, Reply}; - {ok, Reply, State1, hibernate} -> - {{hibernate, Handler1#handler{state = State1}}, + {ok, Reply, State1, hibernate} -> + {{hibernate, Handler1#handler{state = State1}}, Reply}; {swap_handler, Reply, Args1, State1, Handler2, Args2} -> {do_swap(Mod1,Handler1,Args1,State1,Handler2,Args2,SName), Reply}; - {remove_handler, Reply} -> + {remove_handler, Reply} -> do_terminate(Mod1, Handler1, remove_handler, State, remove, SName, normal), {no, Reply}; @@ -686,7 +722,7 @@ report_error(_Handler, normal, _, _, _) -> ok; report_error(_Handler, shutdown, _, _, _) -> ok; report_error(_Handler, {swapped,_,_}, _, _, _) -> ok; report_error(Handler, Reason, State, LastIn, SName) -> - Reason1 = + Reason1 = case Reason of {'EXIT',{undef,[{M,F,A,L}|MFAs]}} -> case code:is_loaded(M) of diff --git a/lib/stdlib/src/orddict.erl b/lib/stdlib/src/orddict.erl index 37cf0084f0..caa59099af 100644 --- a/lib/stdlib/src/orddict.erl +++ b/lib/stdlib/src/orddict.erl @@ -22,7 +22,7 @@ %% Standard interface. -export([new/0,is_key/2,to_list/1,from_list/1,size/1,is_empty/1]). --export([fetch/2,find/2,fetch_keys/1,erase/2]). +-export([fetch/2,find/2,fetch_keys/1,erase/2,take/2]). -export([store/3,append/3,append_list/3,update/3,update/4,update_counter/3]). -export([fold/3,map/2,filter/2,merge/3]). @@ -106,6 +106,23 @@ erase(Key, [{K,_}=E|Dict]) when Key > K -> erase(_Key, [{_K,_Val}|Dict]) -> Dict; %Key == K erase(_, []) -> []. +-spec take(Key, Orddict) -> {Value, Orddict1} | error when + Orddict :: orddict(Key, Value), + Orddict1 :: orddict(Key, Value), + Key :: term(), + Value :: term(). + +take(Key, Dict) -> + take_1(Key, Dict, []). + +take_1(Key, [{K,_}|_], _Acc) when Key < K -> + error; +take_1(Key, [{K,_}=P|D], Acc) when Key > K -> + take_1(Key, D, [P|Acc]); +take_1(_Key, [{_K,Value}|D], Acc) -> + {Value,lists:reverse(Acc, D)}; +take_1(_, [], _) -> error. + -spec store(Key, Value, Orddict1) -> Orddict2 when Orddict1 :: orddict(Key, Value), Orddict2 :: orddict(Key, Value). diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 4161ced9ab..f4257fb571 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -408,7 +408,7 @@ obsolete_1(docb_xml_check, _, _) -> %% Added in R15B obsolete_1(asn1rt, F, _) when F == load_driver; F == unload_driver -> - {deprecated,"deprecated (will be removed in OTP 18); has no effect as drivers are no longer used"}; + {removed,"removed (will be removed in OTP 18); has no effect as drivers are no longer used"}; obsolete_1(ssl, pid, 1) -> {removed,"was removed in R16; is no longer needed"}; obsolete_1(inviso, _, _) -> @@ -463,21 +463,23 @@ obsolete_1(wxCursor, new, 4) -> %% Added in OTP 17. obsolete_1(asn1ct, decode,3) -> - {deprecated,"deprecated; use Mod:decode/2 instead"}; + {removed,"removed; use Mod:decode/2 instead"}; +obsolete_1(asn1ct, encode, 2) -> + {removed,"removed; use Mod:encode/2 instead"}; obsolete_1(asn1ct, encode, 3) -> - {deprecated,"deprecated; use Mod:encode/2 instead"}; + {removed,"removed; use Mod:encode/2 instead"}; obsolete_1(asn1rt, decode,3) -> - {deprecated,"deprecated; use Mod:decode/2 instead"}; + {removed,"removed; use Mod:decode/2 instead"}; obsolete_1(asn1rt, encode, 2) -> - {deprecated,"deprecated; use Mod:encode/2 instead"}; + {removed,"removed; use Mod:encode/2 instead"}; obsolete_1(asn1rt, encode, 3) -> - {deprecated,"deprecated; use Mod:encode/2 instead"}; + {removed,"removed; use Mod:encode/2 instead"}; obsolete_1(asn1rt, info, 1) -> - {deprecated,"deprecated; use Mod:info/0 instead"}; + {removed,"removed; use Mod:info/0 instead"}; obsolete_1(asn1rt, utf8_binary_to_list, 1) -> - {deprecated,{unicode,characters_to_list,1}}; + {removed,{unicode,characters_to_list,1},"OTP 20"}; obsolete_1(asn1rt, utf8_list_to_binary, 1) -> - {deprecated,{unicode,characters_to_binary,1}}; + {removed,{unicode,characters_to_binary,1},"OTP 20"}; %% Added in OTP 18. obsolete_1(core_lib, get_anno, 1) -> diff --git a/lib/stdlib/test/dict_SUITE.erl b/lib/stdlib/test/dict_SUITE.erl index 47358d729f..e99af9ad42 100644 --- a/lib/stdlib/test/dict_SUITE.erl +++ b/lib/stdlib/test/dict_SUITE.erl @@ -23,10 +23,10 @@ -module(dict_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, - create/1,store/1,iterate/1]). + create/1,store/1,iterate/1,remove/1]). -include_lib("common_test/include/ct.hrl"). @@ -37,7 +37,7 @@ suite() -> {timetrap,{minutes,5}}]. all() -> - [create, store, iterate]. + [create, store, remove, iterate]. groups() -> []. @@ -92,6 +92,27 @@ store_1(List, M) -> end, D0. +remove(_Config) -> + test_all([{0,87}], fun remove_1/2). + +remove_1(List0, M) -> + %% Make sure that keys are unique. Randomize key order. + List1 = orddict:from_list(List0), + List2 = lists:sort([{rand:uniform(),E} || E <- List1]), + List = [E || {_,E} <- List2], + D0 = M(from_list, List), + remove_2(List, D0, M). + +remove_2([{Key,Val}|T], D0, M) -> + {Val,D1} = M(take, {Key,D0}), + error = M(take, {Key,D1}), + D2 = M(erase, {Key,D0}), + true = M(equal, {D1,D2}), + remove_2(T, D1, M); +remove_2([], D, M) -> + true = M(is_empty, D), + D. + %%% %%% Test specifics for gb_trees. %%% diff --git a/lib/stdlib/test/dict_test_lib.erl b/lib/stdlib/test/dict_test_lib.erl index 7c4c3572ae..f6fef7bdf4 100644 --- a/lib/stdlib/test/dict_test_lib.erl +++ b/lib/stdlib/test/dict_test_lib.erl @@ -33,7 +33,9 @@ new(Mod, Eq) -> (iterator, S) -> Mod:iterator(S); (iterator_from, {Start, S}) -> Mod:iterator_from(Start, S); (next, I) -> Mod:next(I); - (to_list, D) -> to_list(Mod, D) + (to_list, D) -> to_list(Mod, D); + (erase, {K,D}) -> erase(Mod, K, D); + (take, {K,D}) -> take(Mod, K, D) end. empty(Mod) -> @@ -67,3 +69,19 @@ enter(Mod, Key, Val, Dict) -> true -> Mod:store(Key, Val, Dict) end. + +erase(Mod, Key, Val) when Mod =:= dict; Mod =:= orddict -> + Mod:erase(Key, Val); +erase(gb_trees, Key, Val) -> + gb_trees:delete_any(Key, Val). + +take(gb_trees, Key, Val) -> + Res = try + gb_trees:take(Key, Val) + catch + error:_ -> + error + end, + Res = gb_trees:take_any(Key, Val); +take(Mod, Key, Val) -> + Mod:take(Key, Val). diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index c86e17f70c..c90f855b3b 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -64,7 +64,7 @@ predef/1, maps/1,maps_type/1,maps_parallel_match/1, otp_11851/1,otp_11879/1,otp_13230/1, - record_errors/1]). + record_errors/1, otp_xxxxx/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -84,7 +84,7 @@ all() -> too_many_arguments, basic_errors, bin_syntax_errors, predef, maps, maps_type, maps_parallel_match, otp_11851, otp_11879, otp_13230, - record_errors]. + record_errors, otp_xxxxx]. groups() -> [{unused_vars_warn, [], @@ -3869,6 +3869,55 @@ record_errors(Config) when is_list(Config) -> {3,erl_lint,{redefine_field,r,a}}],[]}}], run(Config, Ts). +otp_xxxxx(Config) -> + Ts = [{constraint1, + <<"-export([t/1]). + -spec t(X) -> X when is_subtype(integer()). + t(a) -> foo:bar(). + ">>, + [], + {errors, + [{2,erl_parse,"unsupported constraint " ++ ["is_subtype"]}], + []}}, + {constraint2, + <<"-export([t/1]). + -spec t(X) -> X when bad_atom(X, integer()). + t(a) -> foo:bar(). + ">>, + [], + {errors, + [{2,erl_parse,"unsupported constraint " ++ ["bad_atom"]}], + []}}, + {constraint3, + <<"-export([t/1]). + -spec t(X) -> X when is_subtype(bad_variable, integer()). + t(a) -> foo:bar(). + ">>, + [], + {errors,[{2,erl_parse,"bad type variable"}],[]}}, + {constraint4, + <<"-export([t/1]). + -spec t(X) -> X when is_subtype(atom(), integer()). + t(a) -> foo:bar(). + ">>, + [], + {errors,[{2,erl_parse,"bad type variable"}],[]}}, + {constraint5, + <<"-export([t/1]). + -spec t(X) -> X when is_subtype(X, integer()). + t(a) -> foo:bar(). + ">>, + [], + []}, + {constraint6, + <<"-export([t/1]). + -spec t(X) -> X when X :: integer(). + t(a) -> foo:bar(). + ">>, + [], + []}], + run(Config, Ts). + run(Config, Tests) -> F = fun({N,P,Ws,E}, BadL) -> case catch run_test(Config, P, Ws) of diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 13c5662741..31ea3210a8 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -825,12 +825,13 @@ type_examples() -> %% is_subtype(V, T) syntax, we need a few examples of the syntax. {ex31,<<"-spec t1(FooBar :: t99()) -> t99();" "(t2()) -> t2();" - "('\\'t::4'()) -> '\\'t::4'() when is_subtype('\\'t::4'(), t24);" - "(t23()) -> t23() when is_subtype(t23(), atom())," - " is_subtype(t23(), t14());" - "(t24()) -> t24() when is_subtype(t24(), atom())," - " is_subtype(t24(), t14())," - " is_subtype(t24(), '\\'t::4'()).">>}, + "('\\'t::4'()) -> {'\\'t::4'(), B}" + " when is_subtype(B, '\\'t::4'());" + "(t23()) -> C when is_subtype(C, atom())," + " is_subtype(C, t14());" + "(t24()) -> D when is_subtype(D, atom())," + " is_subtype(D, t14())," + " is_subtype(D, '\\'t::4'()).">>}, {ex32,<<"-spec mod:t2() -> any(). ">>}, {ex33,<<"-opaque attributes_data() :: " "[{'column', column()} | {'line', info_line()} |" diff --git a/lib/stdlib/test/escript_SUITE.erl b/lib/stdlib/test/escript_SUITE.erl index 28d69232a0..0b9106a99c 100644 --- a/lib/stdlib/test/escript_SUITE.erl +++ b/lib/stdlib/test/escript_SUITE.erl @@ -28,6 +28,7 @@ strange_name/1, emulator_flags/1, emulator_flags_no_shebang/1, + two_lines/1, module_script/1, beam_script/1, archive_script/1, @@ -49,7 +50,7 @@ suite() -> all() -> [basic, errors, strange_name, emulator_flags, - emulator_flags_no_shebang, + emulator_flags_no_shebang, two_lines, module_script, beam_script, archive_script, epp, create_and_extract, foldl, overflow, archive_script_file_access, unicode]. @@ -153,6 +154,18 @@ emulator_flags(Config) when is_list(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +two_lines(Config) when is_list(Config) -> + Data = proplists:get_value(data_dir, Config), + Dir = filename:absname(Data), %Get rid of trailing slash. + run(Dir, "two_lines -arg1 arg2 arg3", + [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n" + "ERL_FLAGS=false\n" + "unknown:[]\n" + "ExitCode:0">>]), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + emulator_flags_no_shebang(Config) when is_list(Config) -> Data = proplists:get_value(data_dir, Config), Dir = filename:absname(Data), %Get rid of trailing slash. diff --git a/lib/stdlib/test/escript_SUITE_data/two_lines b/lib/stdlib/test/escript_SUITE_data/two_lines new file mode 100755 index 0000000000..cf4e99639c --- /dev/null +++ b/lib/stdlib/test/escript_SUITE_data/two_lines @@ -0,0 +1,2 @@ +#! /usr/bin/env escript +main(MainArgs) -> io:format("main:~p\n", [MainArgs]), ErlArgs = init:get_arguments(), io:format("ERL_FLAGS=~p\n", [os:getenv("ERL_FLAGS")]), io:format("unknown:~p\n",[[E || E <- ErlArgs, element(1, E) =:= unknown]]). diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl index 4415c2d09d..9a7400c84e 100644 --- a/lib/stdlib/test/gen_event_SUITE.erl +++ b/lib/stdlib/test/gen_event_SUITE.erl @@ -21,22 +21,24 @@ -include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). -export([start/1, add_handler/1, add_sup_handler/1, delete_handler/1, swap_handler/1, swap_sup_handler/1, notify/1, sync_notify/1, call/1, info/1, hibernate/1, call_format_status/1, call_format_status_anon/1, - error_format_status/1, get_state/1, replace_state/1]). + error_format_status/1, get_state/1, replace_state/1, + start_opt/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> +all() -> [start, {group, test_all}, hibernate, call_format_status, call_format_status_anon, error_format_status, - get_state, replace_state]. + get_state, replace_state, + start_opt]. -groups() -> +groups() -> [{test_all, [], [add_handler, add_sup_handler, delete_handler, swap_handler, swap_sup_handler, notify, sync_notify, @@ -59,6 +61,9 @@ end_per_group(_GroupName, Config) -> %% Start an event manager. %% -------------------------------------- +-define(LMGR, {local, my_dummy_name}). +-define(GMGR, {global, my_dummy_name}). + start(Config) when is_list(Config) -> OldFl = process_flag(trap_exit, true), @@ -72,40 +77,36 @@ start(Config) when is_list(Config) -> [] = gen_event:which_handlers(Pid1), ok = gen_event:stop(Pid1), - {ok, Pid2} = gen_event:start({local, my_dummy_name}), + {ok, Pid2} = gen_event:start(?LMGR), [] = gen_event:which_handlers(my_dummy_name), [] = gen_event:which_handlers(Pid2), ok = gen_event:stop(my_dummy_name), - {ok, Pid3} = gen_event:start_link({local, my_dummy_name}), + {ok, Pid3} = gen_event:start_link(?LMGR), [] = gen_event:which_handlers(my_dummy_name), [] = gen_event:which_handlers(Pid3), ok = gen_event:stop(my_dummy_name), - {ok, Pid4} = gen_event:start_link({global, my_dummy_name}), - [] = gen_event:which_handlers({global, my_dummy_name}), + {ok, Pid4} = gen_event:start_link(?GMGR), + [] = gen_event:which_handlers(?GMGR), [] = gen_event:which_handlers(Pid4), - ok = gen_event:stop({global, my_dummy_name}), + ok = gen_event:stop(?GMGR), {ok, Pid5} = gen_event:start_link({via, dummy_via, my_dummy_name}), [] = gen_event:which_handlers({via, dummy_via, my_dummy_name}), [] = gen_event:which_handlers(Pid5), ok = gen_event:stop({via, dummy_via, my_dummy_name}), - {ok, _} = gen_event:start_link({local, my_dummy_name}), - {error, {already_started, _}} = - gen_event:start_link({local, my_dummy_name}), - {error, {already_started, _}} = - gen_event:start({local, my_dummy_name}), + {ok, _} = gen_event:start_link(?LMGR), + {error, {already_started, _}} = gen_event:start_link(?LMGR), + {error, {already_started, _}} = gen_event:start(?LMGR), ok = gen_event:stop(my_dummy_name), - {ok, Pid6} = gen_event:start_link({global, my_dummy_name}), - {error, {already_started, _}} = - gen_event:start_link({global, my_dummy_name}), - {error, {already_started, _}} = - gen_event:start({global, my_dummy_name}), + {ok, Pid6} = gen_event:start_link(?GMGR), + {error, {already_started, _}} = gen_event:start_link(?GMGR), + {error, {already_started, _}} = gen_event:start(?GMGR), - ok = gen_event:stop({global, my_dummy_name}, shutdown, 10000), + ok = gen_event:stop(?GMGR, shutdown, 10000), receive {'EXIT', Pid6, shutdown} -> ok after 10000 -> @@ -113,10 +114,8 @@ start(Config) when is_list(Config) -> end, {ok, Pid7} = gen_event:start_link({via, dummy_via, my_dummy_name}), - {error, {already_started, _}} = - gen_event:start_link({via, dummy_via, my_dummy_name}), - {error, {already_started, _}} = - gen_event:start({via, dummy_via, my_dummy_name}), + {error, {already_started, _}} = gen_event:start_link({via, dummy_via, my_dummy_name}), + {error, {already_started, _}} = gen_event:start({via, dummy_via, my_dummy_name}), exit(Pid7, shutdown), receive @@ -128,6 +127,83 @@ start(Config) when is_list(Config) -> process_flag(trap_exit, OldFl), ok. +start_opt(Config) when is_list(Config) -> + OldFl = process_flag(trap_exit, true), + + dummy_via:reset(), + + {ok, Pid0} = gen_event:start([]), %anonymous + [] = gen_event:which_handlers(Pid0), + ok = gen_event:stop(Pid0), + + {ok, Pid1} = gen_event:start_link([]), %anonymous + [] = gen_event:which_handlers(Pid1), + ok = gen_event:stop(Pid1), + + {ok, Pid2} = gen_event:start(?LMGR, []), + [] = gen_event:which_handlers(my_dummy_name), + [] = gen_event:which_handlers(Pid2), + ok = gen_event:stop(my_dummy_name), + + {ok, Pid3} = gen_event:start_link(?LMGR, []), + [] = gen_event:which_handlers(my_dummy_name), + [] = gen_event:which_handlers(Pid3), + ok = gen_event:stop(my_dummy_name), + + {ok, Pid4} = gen_event:start_link(?GMGR, []), + [] = gen_event:which_handlers(?GMGR), + [] = gen_event:which_handlers(Pid4), + ok = gen_event:stop(?GMGR), + + {ok, Pid5} = gen_event:start_link({via, dummy_via, my_dummy_name}, []), + [] = gen_event:which_handlers({via, dummy_via, my_dummy_name}), + [] = gen_event:which_handlers(Pid5), + ok = gen_event:stop({via, dummy_via, my_dummy_name}), + + {ok, _} = gen_event:start_link(?LMGR, []), + {error, {already_started, _}} = gen_event:start_link(?LMGR, []), + {error, {already_started, _}} = gen_event:start(?LMGR, []), + ok = gen_event:stop(my_dummy_name), + + {ok, Pid7} = gen_event:start_link(?GMGR), + {error, {already_started, _}} = gen_event:start_link(?GMGR, []), + {error, {already_started, _}} = gen_event:start(?GMGR, []), + + ok = gen_event:stop(?GMGR, shutdown, 10000), + receive + {'EXIT', Pid7, shutdown} -> ok + after 10000 -> + ct:fail(exit_gen_event) + end, + + {ok, Pid8} = gen_event:start_link({via, dummy_via, my_dummy_name}), + {error, {already_started, _}} = gen_event:start_link({via, dummy_via, my_dummy_name}, []), + {error, {already_started, _}} = gen_event:start({via, dummy_via, my_dummy_name}, []), + + exit(Pid8, shutdown), + receive + {'EXIT', Pid8, shutdown} -> ok + after 10000 -> + ct:fail(exit_gen_event) + end, + + %% test spawn_opt + MinHeapSz = 10000, + {ok, Pid9} = gen_event:start_link(?LMGR, [{spawn_opt, [{min_heap_size, MinHeapSz}]}]), + {error, {already_started, _}} = gen_event:start_link(?LMGR, []), + {error, {already_started, _}} = gen_event:start(?LMGR, []), + {heap_size, HeapSz} = erlang:process_info(Pid9, heap_size), + true = HeapSz > MinHeapSz, + ok = gen_event:stop(my_dummy_name), + + %% test debug opt + {ok, _} = gen_event:start_link(?LMGR, [{debug,[debug]}]), + {error, {already_started, _}} = gen_event:start_link(?LMGR, []), + {error, {already_started, _}} = gen_event:start(?LMGR, []), + ok = gen_event:stop(my_dummy_name), + + process_flag(trap_exit, OldFl), + ok. hibernate(Config) when is_list(Config) -> {ok,Pid} = gen_event:start({local, my_dummy_handler}), diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl index 8e7ac223a7..fe5eaccda5 100644 --- a/lib/stdlib/test/rand_SUITE.erl +++ b/lib/stdlib/test/rand_SUITE.erl @@ -283,13 +283,13 @@ gen(_, _, Acc) -> lists:reverse(Acc). %% Check that the algorithms generate sound values. basic_stats_uniform_1(Config) when is_list(Config) -> - ct:timetrap({minutes,6}), %% valgrind needs a lot of time + ct:timetrap({minutes,15}), %% valgrind needs a lot of time [basic_uniform_1(?LOOP, rand:seed_s(Alg), 0.0, array:new([{default, 0}])) || Alg <- algs()], ok. basic_stats_uniform_2(Config) when is_list(Config) -> - ct:timetrap({minutes,6}), %% valgrind needs a lot of time + ct:timetrap({minutes,15}), %% valgrind needs a lot of time [basic_uniform_2(?LOOP, rand:seed_s(Alg), 0, array:new([{default, 0}])) || Alg <- algs()], ok. @@ -396,7 +396,7 @@ crypto_uniform_n(N, State0) -> %% Not a test but measures the time characteristics of the different algorithms measure(Suite) when is_atom(Suite) -> []; measure(_Config) -> - ct:timetrap({minutes,6}), %% valgrind needs a lot of time + ct:timetrap({minutes,15}), %% valgrind needs a lot of time Algos = [crypto64|algs()], io:format("RNG uniform integer performance~n",[]), _ = measure_1(random, fun(State) -> {int, random:uniform_s(10000, State)} end), diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index 56d81eb1f2..15ccdea284 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -2326,7 +2326,7 @@ otp_6554(Config) when is_list(Config) -> "[unproper | list]).">>), %% Cheating: "exception error: no function clause matching " - "erl_eval:do_apply(4)" ++ _ = + "shell:apply_fun(4)" ++ _ = comm_err(<<"erlang:error(function_clause, [4]).">>), "exception error: no function clause matching " "lists:reverse(" ++ _ = diff --git a/lib/typer/src/typer.erl b/lib/typer/src/typer.erl index 6aee749741..3bff546243 100644 --- a/lib/typer/src/typer.erl +++ b/lib/typer/src/typer.erl @@ -136,8 +136,9 @@ extract(#analysis{macros = Macros, MergedRecords = dialyzer_utils:merge_records(NewRecords, OldRecords), CodeServer2 = dialyzer_codeserver:set_temp_records(MergedRecords, CodeServer1), CodeServer3 = dialyzer_codeserver:finalize_exported_types(NewExpTypes, CodeServer2), - CodeServer4 = dialyzer_utils:process_record_remote_types(CodeServer3), - dialyzer_contracts:process_contract_remote_types(CodeServer4) + {CodeServer4, RecordDict} = + dialyzer_utils:process_record_remote_types(CodeServer3), + dialyzer_contracts:process_contract_remote_types(CodeServer4, RecordDict) catch throw:{error, ErrorMsg} -> compile_error(ErrorMsg) @@ -149,7 +150,7 @@ extract(#analysis{macros = Macros, fun(Module, TmpPlt) -> {ok, ModuleContracts} = dict:find(Module, Contracts), SpecList = [{MFA, Contract} - || {MFA, {_FileLine, Contract}} <- dict:to_list(ModuleContracts)], + || {MFA, {_FileLine, Contract}} <- maps:to_list(ModuleContracts)], dialyzer_plt:insert_contract_list(TmpPlt, SpecList) end, NewTrustPLT = lists:foldl(FoldFun, TrustPLT, Modules), @@ -165,8 +166,10 @@ get_type_info(#analysis{callgraph = CallGraph, StrippedCallGraph = remove_external(CallGraph, TrustPLT), %% io:format("--- Analyzing callgraph... "), try - NewPlt = dialyzer_succ_typings:analyze_callgraph(StrippedCallGraph, - TrustPLT, CodeServer), + NewMiniPlt = dialyzer_succ_typings:analyze_callgraph(StrippedCallGraph, + TrustPLT, + CodeServer), + NewPlt = dialyzer_plt:restore_full_plt(NewMiniPlt), Analysis#analysis{callgraph = StrippedCallGraph, trust_plt = NewPlt} catch error:What -> @@ -217,7 +220,7 @@ get_external(Exts, Plt) -> -type fa() :: {atom(), arity()}. -type func_info() :: {line(), atom(), arity()}. --record(info, {records = map__new() :: map_dict(), +-record(info, {records = maps:new() :: erl_types:type_table(), functions = [] :: [func_info()], types = map__new() :: map_dict(), edoc = false :: boolean()}). @@ -260,7 +263,7 @@ write_inc_files(Inc) -> Functions = [Key || {Key, _} <- Val], Val1 = [{{F,A},Type} || {{_Line,F,A},Type} <- Val], Info = #info{types = map__from_list(Val1), - records = map__new(), + records = maps:new(), %% Note we need to sort functions here! functions = lists:keysort(1, Functions)}, %% io:format("Types ~p\n", [Info#info.types]), @@ -842,8 +845,9 @@ collect_info(Analysis) -> TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer), TmpCServer2 = dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1), - TmpCServer3 = dialyzer_utils:process_record_remote_types(TmpCServer2), - dialyzer_contracts:process_contract_remote_types(TmpCServer3) + {TmpCServer3, RecordDict} = + dialyzer_utils:process_record_remote_types(TmpCServer2), + dialyzer_contracts:process_contract_remote_types(TmpCServer3, RecordDict) catch throw:{error, ErrorMsg} -> fatal_error(ErrorMsg) diff --git a/lib/xmerl/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl index 5e0459ec21..9f6b27113e 100644 --- a/lib/xmerl/src/xmerl_scan.erl +++ b/lib/xmerl/src/xmerl_scan.erl @@ -2225,16 +2225,18 @@ processed_whole_element(S=#xmerl_scanner{hook_fun = _Hook, AllAttrs = case S#xmerl_scanner.default_attrs of true -> - [ #xmlAttribute{name = AttName, - parents = [{Name, Pos} | Parents], - language = Lang, - nsinfo = NSI, - namespace = Namespace, - value = AttValue, - normalized = true} || - {AttName, AttValue} <- get_default_attrs(S, Name), - AttValue =/= no_value, - not lists:keymember(AttName, #xmlAttribute.name, Attrs) ]; + DefaultAttrs = + [ #xmlAttribute{name = AttName, + parents = [{Name, Pos} | Parents], + language = Lang, + nsinfo = NSI, + namespace = Namespace, + value = AttValue, + normalized = true} || + {AttName, AttValue} <- get_default_attrs(S, Name), + AttValue =/= no_value, + not lists:keymember(AttName, #xmlAttribute.name, Attrs) ], + lists:append(Attrs, DefaultAttrs); false -> Attrs end, diff --git a/lib/xmerl/test/xmerl_SUITE.erl b/lib/xmerl/test/xmerl_SUITE.erl index e97b8c6a4b..cf7c0b7548 100644 --- a/lib/xmerl/test/xmerl_SUITE.erl +++ b/lib/xmerl/test/xmerl_SUITE.erl @@ -54,7 +54,8 @@ groups() -> cpd_expl_provided_DTD]}, {misc, [], [latin1_alias, syntax_bug1, syntax_bug2, syntax_bug3, - pe_ref1, copyright, testXSEIF, export_simple1, export]}, + pe_ref1, copyright, testXSEIF, export_simple1, export, + default_attrs_bug]}, {eventp_tests, [], [sax_parse_and_export]}, {ticket_tests, [], [ticket_5998, ticket_7211, ticket_7214, ticket_7430, @@ -223,6 +224,21 @@ syntax_bug3(Config) -> Err -> Err end. +default_attrs_bug(Config) -> + file:set_cwd(datadir(Config)), + Doc = "<!DOCTYPE doc [<!ATTLIST doc b CDATA \"default\">]>\n" + "<doc a=\"explicit\"/>", + {#xmlElement{attributes = [#xmlAttribute{name = a, value = "explicit"}, + #xmlAttribute{name = b, value = "default"}]}, + [] + } = xmerl_scan:string(Doc, [{default_attrs, true}]), + Doc2 = "<!DOCTYPE doc [<!ATTLIST doc b CDATA \"default\">]>\n" + "<doc b=\"also explicit\" a=\"explicit\"/>", + {#xmlElement{attributes = [#xmlAttribute{name = b, value = "also explicit"}, + #xmlAttribute{name = a, value = "explicit"}]}, + [] + } = xmerl_scan:string(Doc2, [{default_attrs, true}]). + pe_ref1(Config) -> file:set_cwd(datadir(Config)), {#xmlElement{},[]} = xmerl_scan:file(datadir_join(Config,[misc,"PE_ref1.xml"]),[{validation,true}]). diff --git a/otp_versions.table b/otp_versions.table index e21ca7fdf4..575a358010 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,4 @@ +OTP-19.2.1 : erts-8.2.1 # asn1-4.0.4 common_test-1.13 compiler-7.0.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.2 debugger-4.2.1 dialyzer-3.0.3 diameter-1.12.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.2 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.3 ic-4.4.2 inets-6.3.4 jinterface-1.7.1 kernel-5.1.1 megaco-3.18.1 mnesia-4.14.2 observer-2.3 odbc-2.12 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.3 reltool-0.7.2 runtime_tools-1.11 sasl-3.0.2 snmp-5.2.4 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 typer-0.9.11 wx-1.8 xmerl-1.3.12 : OTP-19.2 : common_test-1.13 compiler-7.0.3 crypto-3.7.2 dialyzer-3.0.3 edoc-0.8.1 erl_docgen-0.6.1 erl_interface-3.9.2 erts-8.2 eunit-2.3.2 hipe-3.15.3 inets-6.3.4 kernel-5.1.1 mnesia-4.14.2 observer-2.3 odbc-2.12 parsetools-2.1.4 public_key-1.3 runtime_tools-1.11 sasl-3.0.2 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 wx-1.8 # asn1-4.0.4 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 debugger-4.2.1 diameter-1.12.1 eldap-1.2.2 et-1.6 gs-1.6.2 ic-4.4.2 jinterface-1.7.1 megaco-3.18.1 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 percept-0.9 reltool-0.7.2 snmp-5.2.4 typer-0.9.11 xmerl-1.3.12 : OTP-19.1.6 : erts-8.1.1 # asn1-4.0.4 common_test-1.12.3 compiler-7.0.2 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.1 debugger-4.2.1 dialyzer-3.0.2 diameter-1.12.1 edoc-0.8 eldap-1.2.2 erl_docgen-0.6 erl_interface-3.9.1 et-1.6 eunit-2.3.1 gs-1.6.2 hipe-3.15.2 ic-4.4.2 inets-6.3.3 jinterface-1.7.1 kernel-5.1 megaco-3.18.1 mnesia-4.14.1 observer-2.2.2 odbc-2.11.3 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.3 percept-0.9 public_key-1.2 reltool-0.7.2 runtime_tools-1.10.1 sasl-3.0.1 snmp-5.2.4 ssh-4.3.6 ssl-8.0.3 stdlib-3.1 syntax_tools-2.1 tools-2.8.6 typer-0.9.11 wx-1.7.1 xmerl-1.3.12 : OTP-19.1.5 : ssh-4.3.6 # asn1-4.0.4 common_test-1.12.3 compiler-7.0.2 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.1 debugger-4.2.1 dialyzer-3.0.2 diameter-1.12.1 edoc-0.8 eldap-1.2.2 erl_docgen-0.6 erl_interface-3.9.1 erts-8.1 et-1.6 eunit-2.3.1 gs-1.6.2 hipe-3.15.2 ic-4.4.2 inets-6.3.3 jinterface-1.7.1 kernel-5.1 megaco-3.18.1 mnesia-4.14.1 observer-2.2.2 odbc-2.11.3 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.3 percept-0.9 public_key-1.2 reltool-0.7.2 runtime_tools-1.10.1 sasl-3.0.1 snmp-5.2.4 ssl-8.0.3 stdlib-3.1 syntax_tools-2.1 tools-2.8.6 typer-0.9.11 wx-1.7.1 xmerl-1.3.12 : diff --git a/system/doc/efficiency_guide/advanced.xml b/system/doc/efficiency_guide/advanced.xml index eee2648f34..e1760d0ded 100644 --- a/system/doc/efficiency_guide/advanced.xml +++ b/system/doc/efficiency_guide/advanced.xml @@ -87,15 +87,15 @@ </row> <row> <cell>Small Map</cell> - <cell>4 words + 2 words per entry (key and value) + the size of each key and value pair.</cell> + <cell>5 words + the size of all keys and values.</cell> </row> <row> - <cell>Large Map</cell> + <cell>Large Map (> 32 keys)</cell> <cell> - At least, 2 words + 2 x <c>N</c> words + 2 x log16(<c>N</c>) words + - the size of each key and value pair, where <c>N</c> is the number of pairs in the Map. - A large Map is represented as a tree internally where each node in the tree is a - "sparse tuple" of arity 16. + <c>N</c> x <c>F</c> words + the size of all keys and values.<br></br> + <c>N</c> is the number of keys in the Map.<br></br> + <c>F</c> is a sparsity factor that can vary between 1.6 and 1.8 + due to the probabilistic nature of the internal HAMT data structure. </cell> </row> <row> diff --git a/system/doc/efficiency_guide/binaryhandling.xml b/system/doc/efficiency_guide/binaryhandling.xml index 0295d18644..91fd9a7cd9 100644 --- a/system/doc/efficiency_guide/binaryhandling.xml +++ b/system/doc/efficiency_guide/binaryhandling.xml @@ -32,12 +32,9 @@ <file>binaryhandling.xml</file> </header> - <p>In R12B, the most natural way to construct and match binaries is - significantly faster than in earlier releases.</p> + <p>Binaries can be efficiently built in the following way:</p> - <p>To construct a binary, you can simply write as follows:</p> - - <p><em>DO</em> (in R12B) / <em>REALLY DO NOT</em> (in earlier releases)</p> + <p><em>DO</em></p> <code type="erl"><![CDATA[ my_list_to_binary(List) -> my_list_to_binary(List, <<>>). @@ -47,21 +44,13 @@ my_list_to_binary([H|T], Acc) -> my_list_to_binary([], Acc) -> Acc.]]></code> - <p>In releases before R12B, <c>Acc</c> is copied in every iteration. - In R12B, <c>Acc</c> is copied only in the first iteration and extra - space is allocated at the end of the copied binary. In the next iteration, - <c>H</c> is written into the extra space. When the extra space runs out, - the binary is reallocated with more extra space. The extra space allocated - (or reallocated) is twice the size of the - existing binary data, or 256, whichever is larger.</p> - - <p>The most natural way to match binaries is now the fastest:</p> + <p>Binaries can be efficiently matched like this:</p> - <p><em>DO</em> (in R12B)</p> + <p><em>DO</em></p> <code type="erl"><![CDATA[ my_binary_to_list(<<H,T/binary>>) -> [H|my_binary_to_list(T)]; -my_binary_to_list(<<>>) -> [].]]></code> +my_binary_to_list(<<>>) -> [].]]></code> <section> <title>How Binaries are Implemented</title> @@ -138,10 +127,7 @@ my_binary_to_list(<<>>) -> [].]]></code> pointer to the binary data. For each field that is matched out of a binary, the position in the match context is incremented.</p> - <p>In R11B, a match context was only used during a binary matching - operation.</p> - - <p>In R12B, the compiler tries to avoid generating code that + <p>The compiler tries to avoid generating code that creates a sub binary, only to shortly afterwards create a new match context and discard the sub binary. Instead of creating a sub binary, the match context is kept.</p> @@ -155,7 +141,7 @@ my_binary_to_list(<<>>) -> [].]]></code> <section> <title>Constructing Binaries</title> - <p>In R12B, appending to a binary or bitstring + <p>Appending to a binary or bitstring is specially optimized by the <em>runtime system</em>:</p> <code type="erl"><![CDATA[ @@ -292,7 +278,7 @@ Bin = <<Bin1,...>> %% Bin1 will be COPIED <p>Let us revisit the example in the beginning of the previous section:</p> - <p><em>DO</em> (in R12B)</p> + <p><em>DO</em></p> <code type="erl"><![CDATA[ my_binary_to_list(<<H,T/binary>>) -> [H|my_binary_to_list(T)]; @@ -304,15 +290,14 @@ my_binary_to_list(<<>>) -> [].]]></code> byte of the binary. 1 byte is matched out and the match context is updated to point to the second byte in the binary.</p> - <p>In R11B, at this point a - <seealso marker="#sub_binary">sub binary</seealso> - would be created. In R12B, - the compiler sees that there is no point in creating a sub binary, - because there will soon be a call to a function (in this case, + <p>At this point it would make sense to create a + <seealso marker="#sub_binary">sub binary</seealso>, + but in this particular example the compiler sees that + there will soon be a call to a function (in this case, to <c>my_binary_to_list/1</c> itself) that immediately will create a new match context and discard the sub binary.</p> - <p>Therefore, in R12B, <c>my_binary_to_list/1</c> calls itself + <p>Therefore <c>my_binary_to_list/1</c> calls itself with the match context instead of with a sub binary. The instruction that initializes the matching operation basically does nothing when it sees that it was passed a match context instead of a binary.</p> @@ -321,34 +306,10 @@ my_binary_to_list(<<>>) -> [].]]></code> the match context will simply be discarded (removed in the next garbage collection, as there is no longer any reference to it).</p> - <p>To summarize, <c>my_binary_to_list/1</c> in R12B only needs to create - <em>one</em> match context and no sub binaries. In R11B, if the binary - contains <em>N</em> bytes, <em>N+1</em> match contexts and <em>N</em> - sub binaries are created.</p> - - <p>In R11B, the fastest way to match binaries is as follows:</p> + <p>To summarize, <c>my_binary_to_list/1</c> only needs to create + <em>one</em> match context and no sub binaries.</p> - <p><em>DO NOT</em> (in R12B)</p> - <code type="erl"><![CDATA[ -my_complicated_binary_to_list(Bin) -> - my_complicated_binary_to_list(Bin, 0). - -my_complicated_binary_to_list(Bin, Skip) -> - case Bin of - <<_:Skip/binary,Byte,_/binary>> -> - [Byte|my_complicated_binary_to_list(Bin, Skip+1)]; - <<_:Skip/binary>> -> - [] - end.]]></code> - - <p>This function cleverly avoids building sub binaries, but it cannot - avoid building a match context in each recursion step. - Therefore, in both R11B and R12B, - <c>my_complicated_binary_to_list/1</c> builds <em>N+1</em> match - contexts. (In a future Erlang/OTP release, the compiler might be able - to generate code that reuses the match context.)</p> - - <p>Returning to <c>my_binary_to_list/1</c>, notice that the match context + <p>Notice that the match context in <c>my_binary_to_list/1</c> was discarded when the entire binary had been traversed. What happens if the iteration stops before it has reached the end of the binary? Will the optimization still work?</p> @@ -544,5 +505,15 @@ count3(<<>>, Count) -> Count.]]></code> not matched out.</p> </section> </section> + + <section> + <title>Historical Note</title> + + <p>Binary handling was significantly improved in R12B. Because + code that was efficient in R11B might not be efficient in R12B, + and vice versa, earlier revisions of this Efficiency Guide contained + some information about binary handling in R11B.</p> + </section> + </chapter> diff --git a/system/doc/efficiency_guide/commoncaveats.xml b/system/doc/efficiency_guide/commoncaveats.xml index ecfeff0349..94b1c0b222 100644 --- a/system/doc/efficiency_guide/commoncaveats.xml +++ b/system/doc/efficiency_guide/commoncaveats.xml @@ -148,10 +148,10 @@ multiple_setelement(T0) -> <p><c>size/1</c> returns the size for both tuples and binaries.</p> - <p>Using the new BIFs <c>tuple_size/1</c> and <c>byte_size/1</c>, introduced - in R12B, gives the compiler and the runtime system more opportunities for - optimization. Another advantage is that the new BIFs can help Dialyzer to - find more bugs in your program.</p> + <p>Using the BIFs <c>tuple_size/1</c> and <c>byte_size/1</c> + gives the compiler and the runtime system more opportunities for + optimization. Another advantage is that the BIFs give Dialyzer more + type information.</p> </section> <section> diff --git a/system/doc/efficiency_guide/functions.xml b/system/doc/efficiency_guide/functions.xml index 4a8248e65c..1d0f1f68b7 100644 --- a/system/doc/efficiency_guide/functions.xml +++ b/system/doc/efficiency_guide/functions.xml @@ -65,7 +65,7 @@ atom_map1(six) -> 6.</code> thus, quite efficient even if there are many values) to select which one of the first three clauses to execute (if any).</item> - <item>>If none of the first three clauses match, the fourth clause + <item>If none of the first three clauses match, the fourth clause match as a variable always matches.</item> <item>If the guard test <c>is_integer(Int)</c> succeeds, the fourth @@ -183,15 +183,6 @@ explicit_map_pairs(Map, Xs0, Ys0) -> A fun contains an (indirect) pointer to the function that implements the fun.</p> - <warning><p><em>Tuples are not fun(s)</em>. - A "tuple fun", <c>{Module,Function}</c>, is not a fun. - The cost for calling a "tuple fun" is similar to that - of <c>apply/3</c> or worse. - Using "tuple funs" is <em>strongly discouraged</em>, - as they might not be supported in a future Erlang/OTP release, - and because there exists a superior alternative from R10B, - namely the <c>fun Module:Function/Arity</c> syntax.</p></warning> - <p><c>apply/3</c> must look up the code for the function to execute in a hash table. It is therefore always slower than a direct call or a fun call.</p> diff --git a/system/doc/efficiency_guide/introduction.xml b/system/doc/efficiency_guide/introduction.xml index ca4a41c798..b650008ae8 100644 --- a/system/doc/efficiency_guide/introduction.xml +++ b/system/doc/efficiency_guide/introduction.xml @@ -46,14 +46,6 @@ to find out where the performance bottlenecks are and optimize only the bottlenecks. Let other code stay as clean as possible.</p> - <p>Fortunately, compiler and runtime optimizations introduced in - Erlang/OTP R12B makes it easier to write code that is both clean and - efficient. For example, the ugly workarounds needed in R11B and earlier - releases to get the most speed out of binary pattern matching are - no longer necessary. In fact, the ugly code is slower - than the clean code (because the clean code has become faster, not - because the uglier code has become slower).</p> - <p>This Efficiency Guide cannot really teach you how to write efficient code. It can give you a few pointers about what to avoid and what to use, and some understanding of how certain language features are implemented. diff --git a/system/doc/efficiency_guide/listhandling.xml b/system/doc/efficiency_guide/listhandling.xml index 2ebc877820..ec258d7c2a 100644 --- a/system/doc/efficiency_guide/listhandling.xml +++ b/system/doc/efficiency_guide/listhandling.xml @@ -90,7 +90,7 @@ tail_recursive_fib(N, Current, Next, Fibs) -> <p>Lists comprehensions still have a reputation for being slow. They used to be implemented using funs, which used to be slow.</p> - <p>In recent Erlang/OTP releases (including R12B), a list comprehension:</p> + <p>A list comprehension:</p> <code type="erl"><![CDATA[ [Expr(E) || E <- List]]]></code> @@ -102,7 +102,7 @@ tail_recursive_fib(N, Current, Next, Fibs) -> [Expr(E)|'lc^0'(Tail, Expr)]; 'lc^0'([], _Expr) -> [].</code> - <p>In R12B, if the result of the list comprehension will <em>obviously</em> + <p>If the result of the list comprehension will <em>obviously</em> not be used, a list will not be constructed. For example, in this code:</p> <code type="erl"><![CDATA[ @@ -131,6 +131,14 @@ some_function(...), 'lc^0'(Tail, Expr); 'lc^0'([], _Expr) -> [].</code> + <p>The compiler also understands that assigning to '_' means that + the value will not used. Therefore, the code in the following example + will also be optimized:</p> + + <code type="erl"><![CDATA[ +_ = [io:put_chars(E) || E <- List], +ok.]]></code> + </section> <section> @@ -209,11 +217,11 @@ some_function(...), <section> <title>Recursive List Functions</title> - <p>In Section 7.2, the following myth was exposed: + <p>In section about myths, the following myth was exposed: <seealso marker="myths#tail_recursive">Tail-Recursive Functions are Much Faster Than Recursive Functions</seealso>.</p> - <p>To summarize, in R12B there is usually not much difference between + <p>There is usually not much difference between a body-recursive list function and tail-recursive function that reverses the list at the end. Therefore, concentrate on writing beautiful code and forget about the performance of your list functions. In the diff --git a/system/doc/efficiency_guide/myths.xml b/system/doc/efficiency_guide/myths.xml index 5d3ad78b23..778cd06c09 100644 --- a/system/doc/efficiency_guide/myths.xml +++ b/system/doc/efficiency_guide/myths.xml @@ -24,7 +24,7 @@ The Initial Developer of the Original Code is Ericsson AB. </legalnotice> - <title>The Eight Myths of Erlang Performance</title> + <title>The Seven Myths of Erlang Performance</title> <prepared>Bjorn Gustavsson</prepared> <docno></docno> <date>2007-11-10</date> @@ -35,80 +35,33 @@ <marker id="myths"></marker> <p>Some truths seem to live on well beyond their best-before date, perhaps because "information" spreads faster from person-to-person - than a single release note that says, for example, that funs - have become faster.</p> + than a single release note that says, for example, that body-recursive + calls have become faster.</p> <p>This section tries to kill the old truths (or semi-truths) that have become myths.</p> <section> - <title>Myth: Funs are Slow</title> - <p>Funs used to be very slow, slower than <c>apply/3</c>. - Originally, funs were implemented using nothing more than - compiler trickery, ordinary tuples, <c>apply/3</c>, and a great - deal of ingenuity.</p> - - <p>But that is history. Funs was given its own data type - in R6B and was further optimized in R7B. - Now the cost for a fun call falls roughly between the cost for a call - to a local function and <c>apply/3</c>.</p> - </section> - - <section> - <title>Myth: List Comprehensions are Slow</title> - - <p>List comprehensions used to be implemented using funs, and in the - old days funs were indeed slow.</p> - - <p>Nowadays, the compiler rewrites list comprehensions into an ordinary - recursive function. Using a tail-recursive function with - a reverse at the end would be still faster. Or would it? - That leads us to the next myth.</p> - </section> - - <section> <title>Myth: Tail-Recursive Functions are Much Faster Than Recursive Functions</title> <p><marker id="tail_recursive"></marker>According to the myth, - recursive functions leave references - to dead terms on the stack and the garbage collector has to copy - all those dead terms, while tail-recursive functions immediately - discard those terms.</p> - - <p>That used to be true before R7B. In R7B, the compiler started - to generate code that overwrites references to terms that will never - be used with an empty list, so that the garbage collector would not - keep dead values any longer than necessary.</p> - - <p>Even after that optimization, a tail-recursive function is - still most of the times faster than a body-recursive function. Why?</p> - - <p>It has to do with how many words of stack that are used in each - recursive call. In most cases, a recursive function uses more words - on the stack for each recursion than the number of words a tail-recursive - would allocate on the heap. As more memory is used, the garbage - collector is invoked more frequently, and it has more work traversing - the stack.</p> - - <p>In R12B and later releases, there is an optimization that - in many cases reduces the number of words used on the stack in - body-recursive calls. A body-recursive list function and a - tail-recursive function that calls <seealso - marker="stdlib:lists#reverse/1">lists:reverse/1</seealso> at - the end will use the same amount of memory. - <c>lists:map/2</c>, <c>lists:filter/2</c>, list comprehensions, - and many other recursive functions now use the same amount of space - as their tail-recursive equivalents.</p> - - <p>So, which is faster? - It depends. On Solaris/Sparc, the body-recursive function seems to - be slightly faster, even for lists with a lot of elements. On the x86 - architecture, tail-recursion was up to about 30% faster.</p> - - <p>So, the choice is now mostly a matter of taste. If you really do need - the utmost speed, you must <em>measure</em>. You can no longer be - sure that the tail-recursive list function always is the fastest.</p> + using a tail-recursive function that builds a list in reverse + followed by a call to <c>lists:reverse/1</c> is faster than + a body-recursive function that builds the list in correct order; + the reason being that body-recursive functions use more memory than + tail-recursive functions.</p> + + <p>That was true to some extent before R12B. It was even more true + before R7B. Today, not so much. A body-recursive function + generally uses the same amount of memory as a tail-recursive + function. It is generally not possible to predict whether the + tail-recursive or the body-recursive version will be + faster. Therefore, use the version that makes your code cleaner + (hint: it is usually the body-recursive version).</p> + + <p>For a more thorough discussion about tail and body recursion, + see <url href="http://ferd.ca/erlang-s-tail-recursion-is-not-a-silver-bullet.html">Erlang's Tail Recursion is Not a Silver Bullet</url>.</p> <note><p>A tail-recursive function that does not need to reverse the list at the end is faster than a body-recursive function, @@ -199,6 +152,29 @@ vanilla_reverse([], Acc) -> <p>That was once true, but from R6B the BEAM compiler can see that a variable is not used.</p> + + <p>Similarly, trivial transformations on the source-code level + such as converting a <c>case</c> statement to clauses at the + top-level of the function seldom makes any difference to the + generated code.</p> + </section> + + <section> + <title>Myth: A NIF Always Speeds Up Your Program</title> + + <p>Rewriting Erlang code to a NIF to make it faster should be + seen as a last resort. It is only guaranteed to be dangerous, + but not guaranteed to speed up the program.</p> + + <p>Doing too much work in each NIF call will + <seealso marker="erts:erl_nif#WARNING">degrade responsiveness + of the VM</seealso>. Doing too little work may mean that + the gain of the faster processing in the NIF is eaten up by + the overhead of calling the NIF and checking the arguments.</p> + + <p>Be sure to read about + <seealso marker="erts:erl_nif#lengthy_work">Long-running NIFs</seealso> + before writing a NIF.</p> </section> </chapter> diff --git a/system/doc/efficiency_guide/part.xml b/system/doc/efficiency_guide/part.xml index 6e10a0c031..5673ddd320 100644 --- a/system/doc/efficiency_guide/part.xml +++ b/system/doc/efficiency_guide/part.xml @@ -39,5 +39,6 @@ <xi:include href="drivers.xml"/> <xi:include href="advanced.xml"/> <xi:include href="profiling.xml"/> + <xi:include href="retired_myths.xml"/> </part> diff --git a/system/doc/efficiency_guide/processes.xml b/system/doc/efficiency_guide/processes.xml index b9982353be..afa4325d8e 100644 --- a/system/doc/efficiency_guide/processes.xml +++ b/system/doc/efficiency_guide/processes.xml @@ -146,14 +146,14 @@ loop() -> <section> <title>Constant Pool</title> - <p>Constant Erlang terms (also called <em>literals</em>) are now + <p>Constant Erlang terms (also called <em>literals</em>) are kept in constant pools; each loaded module has its own pool. - The following function does no longer build the tuple every time + The following function does not build the tuple every time it is called (only to have it discarded the next time the garbage collector was run), but the tuple is located in the module's constant pool:</p> - <p><em>DO</em> (in R12B and later)</p> + <p><em>DO</em></p> <code type="erl"> days_in_month(M) -> element(M, {31,28,31,30,31,30,31,31,30,31,30,31}).</code> @@ -235,9 +235,7 @@ true return the same value. Sharing has been lost.</p> <p>In a future Erlang/OTP release, it might be implemented a - way to (optionally) preserve sharing. There are no plans to make - preserving of sharing the default behaviour, as that would - penalize the vast majority of Erlang applications.</p> + way to (optionally) preserve sharing.</p> </section> </section> diff --git a/system/doc/efficiency_guide/retired_myths.xml b/system/doc/efficiency_guide/retired_myths.xml new file mode 100644 index 0000000000..37f46566cd --- /dev/null +++ b/system/doc/efficiency_guide/retired_myths.xml @@ -0,0 +1,63 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2016</year> + <year>2016</year> + <holder>Ericsson AB, All Rights Reserved</holder> + </copyright> + <legalnotice> + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + The Initial Developer of the Original Code is Ericsson AB. + </legalnotice> + <marker id="retired_myths"/> + <title>Retired Myths</title> + <prepared>Bjorn Gustavsson</prepared> + <docno></docno> + <date>2016-06-07</date> + <rev></rev> + <file>retired_myths.xml</file> + </header> + + <p>We belive that the truth finally has caught with the following, + retired myths.</p> + + <section> + <title>Myth: Funs are Slow</title> + <p>Funs used to be very slow, slower than <c>apply/3</c>. + Originally, funs were implemented using nothing more than + compiler trickery, ordinary tuples, <c>apply/3</c>, and a great + deal of ingenuity.</p> + + <p>But that is history. Funs was given its own data type + in R6B and was further optimized in R7B. + Now the cost for a fun call falls roughly between the cost for a call + to a local function and <c>apply/3</c>.</p> + </section> + + <section> + <title>Myth: List Comprehensions are Slow</title> + + <p>List comprehensions used to be implemented using funs, and in the + old days funs were indeed slow.</p> + + <p>Nowadays, the compiler rewrites list comprehensions into an ordinary + recursive function. Using a tail-recursive function with + a reverse at the end would be still faster. Or would it? + That leads us to the myth that tail-recursive functions are faster + than body-recursive functions.</p> + </section> +</chapter> diff --git a/system/doc/reference_manual/character_set.xml b/system/doc/reference_manual/character_set.xml index d25f2c001d..f0f4c23608 100644 --- a/system/doc/reference_manual/character_set.xml +++ b/system/doc/reference_manual/character_set.xml @@ -32,9 +32,9 @@ <section> <title>Character Set</title> - <p>Since Erlang 4.8/OTP R5A, the syntax of Erlang tokens is extended to - allow the use of the full ISO-8859-1 (Latin-1) character set. This - is noticeable in the following ways:</p> + <p>The syntax of Erlang tokens allow the use of the full + ISO-8859-1 (Latin-1) character set. This is noticeable in the + following ways:</p> <list type="bulleted"> <item> <p>All the Latin-1 printable characters can be used and are diff --git a/system/doc/reference_manual/data_types.xml b/system/doc/reference_manual/data_types.xml index e63825b97d..107e403903 100644 --- a/system/doc/reference_manual/data_types.xml +++ b/system/doc/reference_manual/data_types.xml @@ -50,10 +50,7 @@ <item><em><c>base</c></em><c>#</c><em><c>value</c></em> <br></br> Integer with the base <em><c>base</c></em>, that must be an - integer in the range 2..36. <br></br> - - In Erlang 5.2/OTP R9B and earlier versions, the allowed range - is 2..16.</item> + integer in the range 2..36.</item> </list> <p><em>Examples:</em></p> <pre> diff --git a/system/doc/reference_manual/errors.xml b/system/doc/reference_manual/errors.xml index e764cf431f..3e2d306561 100644 --- a/system/doc/reference_manual/errors.xml +++ b/system/doc/reference_manual/errors.xml @@ -49,8 +49,7 @@ The Erlang programming language has built-in features for handling of run-time errors.</p> <p>A run-time error can also be emulated by calling - <c>erlang:error(Reason)</c> or <c>erlang:error(Reason, Args)</c> - (those appeared in Erlang 5.4/OTP-R10).</p> + <c>erlang:error(Reason)</c> or <c>erlang:error(Reason, Args)</c>.</p> <p>A run-time error is another name for an exception of class <c>error</c>. </p> @@ -79,7 +78,6 @@ <p>Exceptions are run-time errors or generated errors and are of three different classes, with different origins. The <seealso marker="expressions#try">try</seealso> expression - (new in Erlang 5.4/OTP R10B) can distinguish between the different classes, whereas the <seealso marker="expressions#catch">catch</seealso> expression cannot. They are described in @@ -94,7 +92,7 @@ <cell align="left" valign="middle"><c>error</c></cell> <cell align="left" valign="middle">Run-time error, for example, <c>1+a</c>, or the process called - <c>erlang:error/1,2</c> (new in Erlang 5.4/OTP R10B)</cell> + <c>erlang:error/1,2</c></cell> </row> <row> <cell align="left" valign="middle"><c>exit</c></cell> @@ -111,7 +109,7 @@ and a stack trace (which aids in finding the code location of the exception).</p> <p>The stack trace can be retrieved using - <c>erlang:get_stacktrace/0</c> (new in Erlang 5.4/OTP R10B) + <c>erlang:get_stacktrace/0</c> from within a <c>try</c> expression, and is returned for exceptions of class <c>error</c> from a <c>catch</c> expression.</p> <p>An exception of class <c>error</c> is also known as a run-time diff --git a/system/doc/reference_manual/expressions.xml b/system/doc/reference_manual/expressions.xml index 1a3d19aed1..acd1dec901 100644 --- a/system/doc/reference_manual/expressions.xml +++ b/system/doc/reference_manual/expressions.xml @@ -123,10 +123,9 @@ member(_Elem, []) -> or <c>receive</c> expression must be bound in all branches to have a value outside the expression. Otherwise they are regarded as 'unsafe' outside the expression.</p> - <p>For the <c>try</c> expression introduced in - Erlang 5.4/OTP R10B, variable scoping is limited so that + <p>For the <c>try</c> expression variable scoping is limited so that variables bound in the expression are always 'unsafe' outside - the expression. This is to be improved.</p> + the expression.</p> </section> <section> @@ -189,7 +188,6 @@ f([$p,$r,$e,$f,$i,$x | Str]) -> ...</pre> <pre> case {Value, Result} of {?THRESHOLD+1, ok} -> ...</pre> - <p>This feature was added in Erlang 5.0/OTP R7.</p> </section> </section> @@ -1348,8 +1346,8 @@ catch ExceptionBodyN end</code> <p>This is an enhancement of - <seealso marker="#catch">catch</seealso> that appeared in - Erlang 5.4/OTP R10B. It gives the possibility to:</p> + <seealso marker="#catch">catch</seealso>. + It gives the possibility to:</p> <list type="bulleted"> <item>Distinguish between different exception classes.</item> <item>Choose to handle only the desired ones.</item> diff --git a/system/doc/reference_manual/introduction.xml b/system/doc/reference_manual/introduction.xml index abb4ed407d..5701462443 100644 --- a/system/doc/reference_manual/introduction.xml +++ b/system/doc/reference_manual/introduction.xml @@ -80,8 +80,8 @@ <item>A <em>list</em> is any number of items. For example, an argument list can consist of zero, one, or more arguments.</item> </list> - <p>If a feature has been added recently, in Erlang 5.0/OTP R7 or - later, this is mentioned in the text.</p> + <p>If a feature has been added in R13A or later, + this is mentioned in the text.</p> </section> <section> diff --git a/system/doc/reference_manual/macros.xml b/system/doc/reference_manual/macros.xml index 5f24473557..b6c740dd10 100644 --- a/system/doc/reference_manual/macros.xml +++ b/system/doc/reference_manual/macros.xml @@ -286,7 +286,6 @@ t.erl:5: Warning: -warning("Macro VERSION not defined -- using default version." argument, is expanded to a string containing the tokens of the argument. This is similar to the <c>#arg</c> stringifying construction in C.</p> - <p>The feature was added in Erlang 5.0/OTP R7.</p> <p><em>Example:</em></p> <code type="none"> -define(TESTCALL(Call), io:format("Call ~s: ~w~n", [??Call, Call])). diff --git a/system/doc/reference_manual/records.xml b/system/doc/reference_manual/records.xml index 12a3e697cd..1eb13b353e 100644 --- a/system/doc/reference_manual/records.xml +++ b/system/doc/reference_manual/records.xml @@ -72,9 +72,9 @@ <pre> #Name{Field1=Expr1,...,FieldK=ExprK, _=ExprL}</pre> <p>Omitted fields then get the value of evaluating <c>ExprL</c> - instead of their default values. This feature was added in - Erlang 5.1/OTP R8 and is primarily intended to be used to create - patterns for ETS and Mnesia match functions.</p> + instead of their default values. This feature is primarily + intended to be used to create patterns for ETS and Mnesia match + functions.</p> <p><em>Example:</em></p> <pre> -record(person, {name, phone, address}). diff --git a/system/doc/tutorial/c_portdriver.xmlsrc b/system/doc/tutorial/c_portdriver.xmlsrc index 933e2395a3..da680642b6 100644 --- a/system/doc/tutorial/c_portdriver.xmlsrc +++ b/system/doc/tutorial/c_portdriver.xmlsrc @@ -161,8 +161,8 @@ decode([Int]) -> Int.</pre> <title>Running the Example</title> <p><em>Step 1.</em> Compile the C code:</p> <pre> -unix> <input>gcc -o exampledrv -fpic -shared complex.c port_driver.c</input> -windows> <input>cl -LD -MD -Fe exampledrv.dll complex.c port_driver.c</input></pre> +unix> <input>gcc -o example_drv.so -fpic -shared complex.c port_driver.c</input> +windows> <input>cl -LD -MD -Fe example_drv.dll complex.c port_driver.c</input></pre> <p><em>Step 2.</em> Start Erlang and compile the Erlang code:</p> <pre> > <input>erl</input> |