diff options
Diffstat (limited to 'erts')
55 files changed, 1654 insertions, 708 deletions
diff --git a/erts/configure.in b/erts/configure.in index 9dec562f33..508e99a415 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -2766,6 +2766,20 @@ if test X${enable_hipe} = Xyes && test X$ARCH = Xamd64; then LDFLAGS=$saved_LDFLAGS])])]) fi +if test X${enable_hipe} = Xyes; then + case $OPSYS in + linux) + ppcBEAMLDFLAGS="-Wl,-m,elf32ppc" + ppc64BEAMLDFLAGS="-Wl,-m,elf64ppc,-T,hipe/elf64ppc.x" + ;; + darwin) + amd64BEAMLDFLAGS="-pagezero_size 0x10000000" + ;; + esac + archVarName="${ARCH}BEAMLDFLAGS" + eval HIPEBEAMLDFLAGS=\$$archVarName +fi +AC_SUBST(HIPEBEAMLDFLAGS) if test X${enable_fp_exceptions} = Xauto ; then case $host_os in @@ -3760,6 +3774,39 @@ dnl LM_FIND_EMU_CC dnl +dnl Test whether code pointers are always short (32 bits). +dnl + +AC_MSG_CHECKING([whether the code model is small]) +saved_LDFLAGS="$LDFLAGS" +LDFLAGS="$LDFLAGS $HIPEBEAMLDFLAGS" +AC_TRY_RUN([ + #include <stdlib.h> + int main() { + if ((unsigned long long)&main < (1ull << 32)) { + exit(0); + } + exit(1); + } +], +erl_code_model_small=yes, +erl_code_model_small=no, +erl_code_model_small=no) +AC_MSG_RESULT([$erl_code_model_small]) +LDFLAGS="$saved_LDFLAGS" +case $erl_code_model_small in + yes) + AC_DEFINE(CODE_MODEL_SMALL,[1], + [Define if the code model is small (code fits below 2Gb)]) + CODE_MODEL=small + ;; + no) + CODE_MODEL=unknown + ;; +esac +AC_SUBST(CODE_MODEL) + +dnl dnl DTrace & LTTNG dnl case $DYNAMIC_TRACE_FRAMEWORK in diff --git a/erts/doc/src/Makefile b/erts/doc/src/Makefile index 444adf4a6e..9e68373af8 100644 --- a/erts/doc/src/Makefile +++ b/erts/doc/src/Makefile @@ -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. @@ -16,7 +16,7 @@ # limitations under the License. # # %CopyrightEnd% -# +# SPECS_ESRC = ../../preloaded/src/ @@ -66,9 +66,7 @@ XML_REF3_FILES = \ zlib.xml XML_PART_FILES = \ - part.xml \ - part_notes.xml \ - part_notes_history.xml + part.xml XML_CHAPTER_FILES = \ tty.xml \ @@ -116,9 +114,9 @@ SPECS_FILES = $(XML_REF3_EFILES:%.xml=$(SPECDIR)/specs_%.xml) TOP_SPECS_FILE = specs.xml # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += +XML_FLAGS += KERNEL_SRC=$(ERL_TOP)/lib/kernel/src KERNEL_INCLUDE=$(ERL_TOP)/lib/kernel/include @@ -146,7 +144,7 @@ $(INFO_FILE): $(INFO_FILE_SRC) $(ERL_TOP)/make/$(TARGET)/otp.mk sed -e 's;%RELEASE%;$(SYSTEM_VSN);' $(INFO_FILE_SRC) > $(INFO_FILE) -debug opt: +debug opt: clean: rm -rf $(HTMLDIR)/* @@ -154,7 +152,7 @@ clean: rm -f $(MAN3DIR)/* rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f $(SPECDIR)/* - rm -f errs core *~ + rm -f errs core *~ $(SPECDIR)/specs_%.xml: escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \ @@ -162,7 +160,7 @@ $(SPECDIR)/specs_%.xml: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index dc58cdeb13..bd824b3405 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -776,6 +776,10 @@ <p>Sets the number of IO poll threads to use when polling for I/O. The maximum number of poll threads allowed is 1024. The default is 1. </p> + <p>A good way to check if more IO poll threads are needed is to use + <seealso marker="runtime_tools:msacc">microstate accounting</seealso> + and see what the load of the IO poll thread is. If it is high it could + be a good idea to add more threads.</p> </item> <tag><marker id="+IOPp"/><c>+IOPp PollSetsPercentage</c></tag> <item> @@ -789,7 +793,7 @@ <item> <p>Similar to <seealso marker="#+IOt"><c>+IOt</c></seealso> but uses percentages to set the number of IO poll threads to create, based on - the number of schedulers configures. If both <c>+IOPt</c> and + the number of schedulers configured. If both <c>+IOPt</c> and <c>+IOt</c> are used, <c>+IOPt</c> is ignored. </p> </item> @@ -1637,9 +1641,7 @@ <tag>The <c>.erlang</c> startup file</tag> <item> <p>When Erlang/OTP is started, the system searches for a file named - <c>.erlang</c> in the directory where Erlang/OTP is started. If not - found, the user's home directory is searched for an <c>.erlang</c> - file.</p> + <c>.erlang</c> in the user's home directory.</p> <p>If an <c>.erlang</c> file is found, it is assumed to contain valid Erlang expressions. These expressions are evaluated as if they were input to the shell.</p> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 06f568c832..d0588fe3c1 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -2029,6 +2029,18 @@ helper() -> where the exception occurred or the function was called. </item> </taglist> + <warning><p>Developers should rely on stacktrace entries only for + debugging purposes.</p> + <p>The VM performs tail call optimization, which + does not add new entries to the stacktrace, and also limits stacktraces + to a certain depth. Furthermore, compiler options, optimizations and + future changes may add or remove stacktrace entries, causing any code + that expects the stacktrace to be in a certain order or contain specific + items to fail.</p> + <p>The only exception to this rule is <c>error:undef</c> which + guarantees to include the <anno>Module</anno>, <anno>Function</anno> and <anno>Arity</anno> + of the attempted function as the first stacktrace entry.</p> + </warning> <p>See also <seealso marker="#error/1"><c>error/1</c></seealso> and <seealso marker="#error/2"><c>error/2</c></seealso>.</p> @@ -3826,6 +3838,12 @@ RealSystem = system + MissedSystem</code> </item> <tag><c>{env, <anno>Env</anno>}</c></tag> <item> + <p> + Types:<br/> + <c><anno>Name</anno> = </c><seealso marker="kernel:os#type-env_var_name"><c>os:env_var_name()</c></seealso><br/> + <c><anno>Val</anno> = </c><seealso marker="kernel:os#type-env_var_value"><c>os:env_var_value()</c></seealso><c> | false</c><br/> + <c>Env = [{<anno>Name</anno>, <anno>Val</anno>}]</c> + </p> <p>Only valid for <c>{spawn, <anno>Command</anno>}</c>, and <c>{spawn_executable, <anno>FileName</anno>}</c>. The environment of the started process is extended using @@ -3840,7 +3858,13 @@ RealSystem = system + MissedSystem</code> exception is <c><anno>Val</anno></c> being the atom <c>false</c> (in analogy with <seealso marker="kernel:os#getenv/1"><c>os:getenv/1</c></seealso>, - which removes the environment variable.</p> + which removes the environment variable. + </p> + <p> + For information about encoding requirements, see documentation + of the types for <c><anno>Name</anno></c> and + <c><anno>Val</anno></c>. + </p> </item> <tag><c>{args, [ string() | binary() ]}</c></tag> <item> @@ -6475,17 +6499,24 @@ lists:map( <p><c><anno>MSAcc_Thread_Type</anno></c>s:</p> <taglist> <tag><c>scheduler</c></tag> - <item>The main execution threads that do most of the work.</item> + <item>The main execution threads that do most of the work. See + <seealso marker="erts:erl#+S">erl +S</seealso> for more details.</item> <tag><c>dirty_cpu_scheduler</c></tag> - <item>The threads for long running cpu intensive work.</item> + <item>The threads for long running cpu intensive work. See + <seealso marker="erts:erl#+SDcpu">erl +SDcpu</seealso> for more details.</item> <tag><c>dirty_io_scheduler</c></tag> - <item>The threads for long running I/O work.</item> + <item>The threads for long running I/O work. See + <seealso marker="erts:erl#+SDio">erl +SDio</seealso> for more details.</item> <tag><c>async</c></tag> <item>Async threads are used by various linked-in drivers (mainly the - file drivers) do offload non-CPU intensive work.</item> + file drivers) do offload non-CPU intensive work. See + <seealso marker="erts:erl#+async_thread_pool_size">erl +A</seealso> for more details.</item> <tag><c>aux</c></tag> <item>Takes care of any work that is not specifically assigned to a scheduler.</item> + <tag><c>poll</c></tag> + <item>Does the IO polling for the emulator. See + <seealso marker="erts:erl#+IOt">erl +IOt</seealso> for more details.</item> </taglist> <p>The following <c><anno>MSAcc_Thread_State</anno></c>s are available. All states are exclusive, meaning that a thread cannot be in two diff --git a/erts/doc/src/fascicules.xml b/erts/doc/src/fascicules.xml deleted file mode 100644 index 1c371bd9c8..0000000000 --- a/erts/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - ERTS User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - ERTS Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index 9968b531f9..ff3c798179 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -31,6 +31,23 @@ </header> <p>This document describes the changes made to the ERTS application.</p> +<section><title>Erts 9.1.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed bug that could cause a VM crash when a corrupt + message is received on distribution channel from other + node.</p> + <p> + Own Id: OTP-14661 Aux Id: ERIERL-80 </p> + </item> + </list> + </section> + +</section> + <section><title>Erts 9.1.1</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -983,6 +1000,91 @@ </section> +<section><title>Erts 8.3.5.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A timer internal bit-field used for storing scheduler id + was too small. As a result, VM internal timer data + structures could become inconsistent when using 1024 + schedulers on the system. Note that systems with less + than 1024 schedulers are not effected by this bug.</p> + <p> + This bug was introduced in ERTS version 7.0 (OTP 18.0).</p> + <p> + Own Id: OTP-14548 Aux Id: OTP-11997, ERL-468 </p> + </item> + <item> + <p> + Fixed bug in <c>binary_to_term</c> and + <c>binary_to_atom</c> that could cause VM crash. + Typically happens when the last character of an UTF8 + string is in the range 128 to 255, but truncated to only + one byte. Bug exists in <c>binary_to_term</c> since ERTS + version 5.10.2 (OTP_R16B01) and <c>binary_to_atom</c> + since ERTS version 9.0 (OTP-20.0).</p> + <p> + Own Id: OTP-14590 Aux Id: ERL-474 </p> + </item> + <item> + <p> + Fix bug causing VM crash when a module with + <c>-on_load</c> directive is loaded while + <c>erlang:trace(on_load, ...)</c> is enabled.</p> + <p> + Own Id: OTP-14612</p> + </item> + <item> + <p> + Fixed bug that could cause a VM crash when a corrupt + message is received on distribution channel from other + node.</p> + <p> + Own Id: OTP-14661 Aux Id: ERIERL-80 </p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 8.3.5.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix performance bug in pre-allocators that could cause + them to permanently fall back on normal more expensive + memory allocation. Pre-allocators are used for quick + allocation of short lived meta data used by messages and + other scheduled tasks. Bug exists since OTP_R15B02.</p> + <p> + Own Id: OTP-14491</p> + </item> + <item> + <p>Fixed a bug that prevented TCP sockets from being + closed properly on send timeouts.</p> + <p> + Own Id: OTP-14509</p> + </item> + <item> + <p> + Fixed bug in operator <c>bxor</c> causing erroneuos + result when one operand is a big <em>negative</em> + integer with the lowest <c>N*W</c> bits as zero and the + other operand not larger than <c>N*W</c> bits. <c>N</c> + is an integer of 1 or larger and <c>W</c> is 32 or 64 + depending on word size.</p> + <p> + Own Id: OTP-14514</p> + </item> + </list> + </section> + +</section> + <section><title>Erts 8.3.5.1</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/erts/doc/src/part_notes.xml b/erts/doc/src/part_notes.xml deleted file mode 100644 index e579b7635d..0000000000 --- a/erts/doc/src/part_notes.xml +++ /dev/null @@ -1,38 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2004</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>ERTS Release Notes</title> - <prepared></prepared> - <docno></docno> - <date>2004-09-07</date> - <rev>1.0</rev> - </header> - <description> - <p>The Erlang Runtime System application <em>ERTS</em>.</p> - <p>For information about older versions, see - <url href="part_notes_history_frame.html">Release Notes History</url>.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/erts/doc/src/part_notes_history.xml b/erts/doc/src/part_notes_history.xml deleted file mode 100644 index 277683a2b5..0000000000 --- a/erts/doc/src/part_notes_history.xml +++ /dev/null @@ -1,36 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2006</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>ERTS Release Notes History</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p>The Erlang Runtime System application <em>ERTS</em>.</p> - </description> - <xi:include href="notes_history.xml"/> -</part> - diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 915cad4e18..3117b24bcc 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -240,16 +240,7 @@ ARCH=@ARCH@ ultrasparcCFLAGS=-Wa,-xarch=v8plusa ARCHCFLAGS=$($(ARCH)CFLAGS) -ifdef HIPE_ENABLED -ifeq ($(OPSYS),linux) -ppcBEAMLDFLAGS=-Wl,-m,elf32ppc -ppc64BEAMLDFLAGS=-Wl,-m,elf64ppc,-T,hipe/elf64ppc.x -endif -ifeq ($(OPSYS),darwin) -amd64BEAMLDFLAGS=-pagezero_size 0x10000000 -endif -HIPEBEAMLDFLAGS=$($(ARCH)BEAMLDFLAGS) -endif +HIPEBEAMLDFLAGS=@HIPEBEAMLDFLAGS@ ERTS_BUILD_FALLBACK_POLL=@ERTS_BUILD_FALLBACK_POLL@ @@ -499,7 +490,6 @@ ifeq ($(TARGET),win32) RELEASE_INCLUDES += sys/$(ERLANG_OSTYPE)/erl_win_dyn_driver.h endif - .PHONY: release_spec ifdef VOID_EMULATOR release_spec: @@ -578,6 +568,7 @@ $(TTF_DIR)/beam_tr_funcs.h \ $(TTF_DIR)/OPCODES-GENERATED: $(OPCODE_TABLES) utils/beam_makeops $(gen_verbose)LANG=C $(PERL) utils/beam_makeops \ -wordsize @EXTERNAL_WORD_SIZE@ \ + -code-model @CODE_MODEL@ \ -outdir $(TTF_DIR) \ -DUSE_VM_PROBES=$(if $(USE_VM_PROBES),1,0) \ -DNO_FPE_SIGNALS=$(if $filter(unreliable,$(FPE)),1,0) \ @@ -711,16 +702,27 @@ $(OBJDIR)/beams.$(RES_EXT): $(TARGET)/beams.rc endif +# We disable the implicit rule of .S -> .o so that the verbose asm +# generate is not used for compiling erts. This is only a problem on +# old solaris make +%.o : %.S + # Usually the same as the default rule, but certain platforms (e.g. win32) mix # different compilers $(OBJDIR)/beam_emu.o: beam/beam_emu.c $(V_EMU_CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ +$(OBJDIR)/beam_emu.S: beam/beam_emu.c + $(V_EMU_CC) -S -fverbose-asm $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ + $(OBJDIR)/%_pg.o: beam/%.c $(V_CC) $(PROFILE_GENERATE) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ $(OBJDIR)/%_pu.o: beam/%.c $(PROFILE_USE_DEPS) $(V_CC) $(PROFILE_USE) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ +$(OBJDIR)/%_pu.S: beam/%.c $(PROFILE_USE_DEPS) + $(V_CC) -S -fverbose-asm $(PROFILE_USE) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ + $(OBJDIR)/PROFILE: $(BINDIR)/$(PROFILE_EXECUTABLE) $(V_at)echo " PROFILE ${PROFILE_EXECUTABLE}" $(V_at)rm -f $(OBJDIR)/erl*.profraw @@ -732,6 +734,8 @@ $(OBJDIR)/PROFILE: $(BINDIR)/$(PROFILE_EXECUTABLE) -noshell -s estone_SUITE pgo -s init stop >> $(OBJDIR)/PROFILE_LOG $(V_at)touch $@ +.SECONDARY: $(patsubst %.o,%_pu.gcda,$(PROFILE_OBJS)) + $(OBJDIR)/%_pu.gcda: $(OBJDIR)/PROFILE $(V_at)mv $(OBJDIR)/$*_pg.gcda $@ $(V_at)touch $@ @@ -739,6 +743,25 @@ $(OBJDIR)/%_pu.gcda: $(OBJDIR)/PROFILE $(OBJDIR)/default.profdata: $(OBJDIR)/PROFILE $(V_LLVM_PROFDATA) merge -output $@ $(OBJDIR)/*.profraw +ifeq ($(ERTS_BUILD_FALLBACK_POLL),yes) +# Have to treat erl_poll differently as the same .c file is used +# twice for kernel poll builds. +$(OBJDIR)/erl_poll.o: sys/common/erl_poll.c + $(V_CC) -DERTS_KERNEL_POLL_VERSION $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ + +# Do a copy in order to make debuggers less confused +$(TTF_DIR)/erl_poll.flbk.c: sys/common/erl_poll.c + $(V_at) cp $< $@ + @touch $@ + +$(OBJDIR)/erl_poll.flbk.o: $(TTF_DIR)/erl_poll.flbk.c + $(V_CC) -DERTS_NO_KERNEL_POLL_VERSION $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ +endif + + +# ---------------------------------------------------------------------- +# General targets +# $(OBJDIR)/%.o: beam/%.c $(V_CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ @@ -772,12 +795,6 @@ $(BINDIR)/$(CS_EXECUTABLE): $(TTF_DIR)/GENERATED $(PRELOAD_SRC) $(CS_OBJ) $(ERTS $(ld_verbose)$(CS_PURIFY) $(LD) $(CS_LDFLAGS) -o $(BINDIR)/$(CS_EXECUTABLE) \ $(CS_CFLAGS) $(COMMON_INCLUDES) $(CS_OBJ) $(CS_LIBS) -$(OBJDIR)/%.kp.o: sys/common/%.c - $(V_CC) -DERTS_KERNEL_POLL_VERSION $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ - -$(OBJDIR)/%.nkp.o: sys/common/%.c - $(V_CC) -DERTS_NO_KERNEL_POLL_VERSION $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ - ifeq ($(GCC),yes) $(OBJDIR)/erl_goodfit_alloc.o: beam/erl_goodfit_alloc.c @@ -928,14 +945,8 @@ $(STATIC_NIF_LIBS) $(STATIC_DRIVER_LIBS): echo "=== Leaving lib after making static libs" endif -ifeq ($(ERTS_BUILD_FALLBACK_POLL),yes) -OS_OBJS += $(OBJDIR)/erl_poll.kp.o \ - $(OBJDIR)/erl_poll.nkp.o -else -OS_OBJS += $(OBJDIR)/erl_poll.o -endif - -OS_OBJS += $(OBJDIR)/erl_check_io.o \ +OS_OBJS += $(OBJDIR)/erl_poll.o \ + $(OBJDIR)/erl_check_io.o \ $(OBJDIR)/erl_mseg.o \ $(OBJDIR)/erl_mmap.o \ $(OBJDIR)/erl_$(ERLANG_OSTYPE)_sys_ddll.o \ @@ -943,6 +954,10 @@ OS_OBJS += $(OBJDIR)/erl_check_io.o \ $(OBJDIR)/erl_sys_common_misc.o \ $(OBJDIR)/erl_os_monotonic_time_extender.o +ifeq ($(ERTS_BUILD_FALLBACK_POLL),yes) +OS_OBJS += $(OBJDIR)/erl_poll.flbk.o +endif + HIPE_ARCH64_OBJS=$(OBJDIR)/hipe_bif64.o HIPE_x86_OS_OBJS=$(HIPE_x86_$(OPSYS)_OBJS) @@ -1099,8 +1114,7 @@ SED_REPL_O=s|^\([^:]*:\)|$$(OBJDIR)/\1|g SED_REPL_O_ZLIB=s|^\([^:]*:\)|$$(ZLIB_OBJDIR)/\1|g SED_REPL_TTF_DIR=s|$(TTF_DIR)/|$$(TTF_DIR)/|g SED_REPL_ERL_TOP=s|\([ ]\)$(ERL_TOP)/|\1$$(ERL_TOP)/|g;s|^$(ERL_TOP)/|$$(ERL_TOP)/|g -SED_REPL_POLL=s|$$(OBJDIR)/erl_poll.o|$$(OBJDIR)/erl_poll.kp.o $$(OBJDIR)/erl_poll.nkp.o|g -SED_REPL_CHK_IO=s|$$(OBJDIR)/erl_check_io.o|$$(OBJDIR)/erl_check_io.kp.o $$(OBJDIR)/erl_check_io.nkp.o|g +SED_REPL_POLL=s|$$(OBJDIR)/erl_poll.o|$$(OBJDIR)/erl_poll.o $$(OBJDIR)/erl_poll.flbk.o|g SED_REPL_TTF_COMP_FLAGS=s|\([^/]\)erl_compile_flags\.h|\1$$(TTF_DIR)/erl_compile_flags\.h|g ifeq ($(TARGET),win32) @@ -1111,7 +1125,7 @@ SED_PREFIX= endif ifeq ($(ERTS_BUILD_FALLBACK_POLL),yes) -SED_SUFFIX=;$(SED_REPL_POLL);$(SED_REPL_CHK_IO) +SED_SUFFIX=;$(SED_REPL_POLL) else SED_SUFFIX= endif @@ -1165,6 +1179,10 @@ DEP_FLAGS=-MM $(MG_FLAG) $(CFLAGS) $(INCLUDES) -Inifs/common -Idrivers/common -I SYS_SRC=$(ALL_SYS_SRC) endif +.PHONY: check_emu_registers +check_emu_registers: $(OBJDIR)/beam_emu$(PROFILE_MARKER).S + utils/beam_emu_vars -vars 'c_p E HTOP FCALLS I reg' $^ + .PHONY: $(TARGET)/gen_git_version.mk $(TARGET)/gen_git_version.mk: # We touch beam/erl_bif.info.c if we regenerated the git version to force a diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 00822d1415..87367b44ab 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -768,36 +768,45 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) ErtsCodeIndex code_ix; Module* modp; + if (BIF_ARG_2 != am_false && BIF_ARG_2 != am_true) { + BIF_ERROR(BIF_P, BADARG); + } + if (!erts_try_seize_code_write_permission(BIF_P)) { ERTS_BIF_YIELD2(bif_export[BIF_finish_after_on_load_2], BIF_P, BIF_ARG_1, BIF_ARG_2); } - /* ToDo: Use code_ix staging instead of thread blocking */ - - erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_thr_progress_block(); - code_ix = erts_active_code_ix(); modp = erts_get_module(BIF_ARG_1, code_ix); - if (!modp || !modp->on_load || !modp->on_load->code_hdr) { - error: - erts_thr_progress_unblock(); - erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + if (!modp || !modp->on_load || !modp->on_load->code_hdr + || !modp->on_load->code_hdr->on_load_function_ptr) { + erts_release_code_write_permission(); BIF_ERROR(BIF_P, BADARG); } - if (modp->on_load->code_hdr->on_load_function_ptr == NULL) { - goto error; - } - if (BIF_ARG_2 != am_false && BIF_ARG_2 != am_true) { - goto error; - } if (BIF_ARG_2 == am_true) { + struct m mods[1]; + int is_blocking = 0; int i, num_exps; + erts_start_staging_code_ix(0); + code_ix = erts_staging_code_ix(); + modp = erts_get_module(BIF_ARG_1, code_ix); + + ASSERT(modp && modp->on_load && modp->on_load->code_hdr + && modp->on_load->code_hdr->on_load_function_ptr); + + if (erts_is_default_trace_enabled() + || IF_HIPE(hipe_need_blocking(modp))) { + + erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erts_thr_progress_block(); + is_blocking = 1; + } + /* * Make the code with the on_load function current. */ @@ -831,11 +840,13 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) } } modp->curr.code_hdr->on_load_function_ptr = NULL; - set_default_trace_pattern(BIF_ARG_1); - #ifdef HIPE - hipe_redirect_to_module(modp); - #endif - } else if (BIF_ARG_2 == am_false) { + + mods[0].modp = modp; + mods[0].module = BIF_ARG_1; + mods[0].exception = THE_NON_VALUE; + return staging_epilogue(BIF_P, 1, am_true, is_blocking, mods, 1, 0); + } + else if (BIF_ARG_2 == am_false) { int i, num_exps; /* @@ -855,8 +866,6 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) ep->beam[1] = 0; } } - erts_thr_progress_unblock(); - erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); erts_release_code_write_permission(); BIF_RET(am_true); } diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index c81380c14d..fe1e15701b 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -419,9 +419,11 @@ erts_install_breakpoints(BpFunctions* f) for (i = 0; i < n; i++) { ErtsCodeInfo* ci = f->matching[i].ci; - BeamInstr *pc = erts_codeinfo_to_code(ci); GenericBp* g = ci->u.gen_bp; - if (*pc != br && g) { + BeamInstr volatile *pc = erts_codeinfo_to_code(ci); + BeamInstr instr = *pc; + + if (!BeamIsOpCode(instr, op_i_generic_breakpoint) && g) { Module* modp = f->matching[i].mod; /* @@ -435,11 +437,16 @@ erts_install_breakpoints(BpFunctions* f) /* * The following write is not protected by any lock. We * assume that the hardware guarantees that a write of an - * aligned word-size (or half-word) writes is atomic - * (i.e. that other processes executing this code will not - * see a half pointer). + * aligned word-size writes is atomic (i.e. that other + * processes executing this code will not see a half + * pointer). + * + * The contents of *pc is marked 'volatile' to ensure that + * the compiler will do a single full-word write, and not + * try any fancy optimizations to write a half word. */ - *pc = br; + instr = BeamSetCodeAddr(instr, br); + *pc = instr; modp->curr.num_breakpoints++; } } @@ -634,6 +641,49 @@ erts_clear_export_break(Module* modp, ErtsCodeInfo *ci) ASSERT(ci->u.gen_bp == NULL); } +/* + * If c_p->cp is a trace return instruction, we set cp + * to be the place where we again start to execute code. + * + * cp is used by match spec {caller} to get the calling + * function, and if we don't do this fixup it will be + * 'undefined'. This has the odd side effect of {caller} + * not really being which function is the caller, but + * rather which function we are about to return to. + */ +static void fixup_cp_before_trace(Process *c_p, int *return_to_trace) +{ + Eterm *cpp, *E = c_p->stop; + BeamInstr w = *c_p->cp; + if (BeamIsOpCode(w, op_return_trace)) { + cpp = &E[2]; + } else if (BeamIsOpCode(w, op_i_return_to_trace)) { + *return_to_trace = 1; + cpp = &E[0]; + } else if (BeamIsOpCode(w, op_i_return_time_trace)) { + cpp = &E[0]; + } else { + cpp = NULL; + } + if (cpp) { + for (;;) { + BeamInstr w = *cp_val(*cpp); + if (BeamIsOpCode(w, op_return_trace)) { + cpp += 3; + } else if (BeamIsOpCode(w, op_i_return_to_trace)) { + *return_to_trace = 1; + cpp += 1; + } else if (BeamIsOpCode(w, op_i_return_time_trace)) { + cpp += 2; + } else { + break; + } + } + c_p->cp = (BeamInstr *) cp_val(*cpp); + ASSERT(is_CP(*cpp)); + } +} + BeamInstr erts_generic_breakpoint(Process* c_p, ErtsCodeInfo *info, Eterm* reg) { @@ -744,6 +794,7 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) GenericBp* g; GenericBpData* bp = NULL; Uint bp_flags = 0; + int return_to_trace = 0; ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); @@ -759,6 +810,8 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) */ if (!applying) { p->cp = I; + } else { + fixup_cp_before_trace(p, &return_to_trace); } if (bp_flags & (ERTS_BPF_LOCAL_TRACE|ERTS_BPF_GLOBAL_TRACE) && IS_TRACED_FL(p, F_TRACE_CALLS)) { @@ -937,49 +990,18 @@ static ErtsTracer do_call_trace(Process* c_p, ErtsCodeInfo* info, Eterm* reg, int local, Binary* ms, ErtsTracer tracer) { - Eterm* cpp; int return_to_trace = 0; - BeamInstr w; BeamInstr *cp_save = c_p->cp; Uint32 flags; Uint need = 0; Eterm* E = c_p->stop; - w = *c_p->cp; - if (BeamIsOpCode(w, op_return_trace)) { - cpp = &E[2]; - } else if (BeamIsOpCode(w, op_i_return_to_trace)) { - return_to_trace = 1; - cpp = &E[0]; - } else if (BeamIsOpCode(w, op_i_return_time_trace)) { - cpp = &E[0]; - } else { - cpp = NULL; - } - if (cpp) { - for (;;) { - BeamInstr w = *cp_val(*cpp); - if (BeamIsOpCode(w, op_return_trace)) { - cpp += 3; - } else if (BeamIsOpCode(w, op_i_return_to_trace)) { - return_to_trace = 1; - cpp += 1; - } else if (BeamIsOpCode(w, op_i_return_time_trace)) { - cpp += 2; - } else { - break; - } - } - cp_save = c_p->cp; - c_p->cp = (BeamInstr *) cp_val(*cpp); - ASSERT(is_CP(*cpp)); - } - ERTS_UNREQ_PROC_MAIN_LOCK(c_p); + fixup_cp_before_trace(c_p, &return_to_trace); + flags = erts_call_trace(c_p, info, ms, reg, local, &tracer); - ERTS_REQ_PROC_MAIN_LOCK(c_p); - if (cpp) { - c_p->cp = cp_save; - } + + /* restore cp after potential fixup */ + c_p->cp = cp_save; ASSERT(!ERTS_PROC_IS_EXITING(c_p)); if ((flags & MATCH_SET_RETURN_TO_TRACE) && !return_to_trace) { diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index 0f332da63f..70078c8c59 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -201,7 +201,7 @@ void debug_dump_code(BeamInstr *I, int num) for (i = 0; i < NUM_SPECIFIC_OPS; i++) { if (BeamIsOpCode(instr, i) && opc[i].name[0] != '\0') { code_ptr += print_op(ERTS_PRINT_DSBUF, (void *) dsbufp, - i, opc[i].sz-1, code_ptr+1) + 1; + i, opc[i].sz-1, code_ptr) + 1; break; } } @@ -321,7 +321,7 @@ erts_debug_disassemble_1(BIF_ALIST_1) for (i = 0; i < NUM_SPECIFIC_OPS; i++) { if (BeamIsOpCode(instr, i) && opc[i].name[0] != '\0') { code_ptr += print_op(ERTS_PRINT_DSBUF, (void *) dsbufp, - i, opc[i].sz-1, code_ptr+1) + 1; + i, opc[i].sz-1, code_ptr) + 1; break; } } @@ -405,8 +405,11 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) * Avoid copying because instructions containing bignum operands * are bigger than actually declared. */ - ap = (BeamInstr *) addr; + addr++; + ap = addr; } else { + BeamInstr instr_word = addr++[0]; + /* * Copy all arguments to a local buffer for the unpacking. */ @@ -431,23 +434,22 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) case 'q': *ap++ = *--sp; break; - case 'i': /* Initialize packing accumulator. */ - *ap++ = packed; - break; - case 's': - *ap++ = packed & 0x3ff; - packed >>= 10; +#ifdef ARCH_64 + case '1': /* Tightest shift */ + *ap++ = (packed & BEAM_TIGHTEST_MASK) << 3; + packed >>= BEAM_TIGHTEST_SHIFT; break; - case '0': /* Tight shift */ +#endif + case '2': /* Tight shift */ *ap++ = packed & BEAM_TIGHT_MASK; packed >>= BEAM_TIGHT_SHIFT; break; - case '6': /* Shift 16 steps */ + case '3': /* Loose shift */ *ap++ = packed & BEAM_LOOSE_MASK; packed >>= BEAM_LOOSE_SHIFT; break; #ifdef ARCH_64 - case 'w': /* Shift 32 steps */ + case '4': /* Shift 32 steps */ *ap++ = packed & BEAM_WIDE_MASK; packed >>= BEAM_WIDE_SHIFT; break; @@ -458,8 +460,18 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) case 'P': packed = *--sp; break; +#if defined(ARCH_64) && defined(CODE_MODEL_SMALL) + case '#': /* -1 */ + case '$': /* -2 */ + case '%': /* -3 */ + case '&': /* -4 */ + case '\'': /* -5 */ + case '(': /* -6 */ + packed = (packed << BEAM_WIDE_SHIFT) | BeamExtraData(instr_word); + break; +#endif default: - ASSERT(0); + erts_exit(ERTS_ERROR_EXIT, "beam_debug: invalid packing op: %c\n", *prog); } } ap = args; @@ -744,7 +756,7 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) erts_print(to, to_arg, " x(%d)", loader_x_reg_index(ap[0])); break; case LOADER_Y_REG: - erts_print(to, to_arg, " x(%d)", loader_y_reg_index(ap[0])); + erts_print(to, to_arg, " y(%d)", loader_y_reg_index(ap[0]) - CP_SIZE); break; default: erts_print(to, to_arg, " %T", (Eterm) ap[0]); @@ -765,7 +777,7 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) erts_print(to, to_arg, " x(%d)", loader_x_reg_index(ap[0])); break; case LOADER_Y_REG: - erts_print(to, to_arg, " x(%d)", loader_y_reg_index(ap[0])); + erts_print(to, to_arg, " y(%d)", loader_y_reg_index(ap[0]) - CP_SIZE); break; default: erts_print(to, to_arg, " %T", (Eterm) ap[0]); @@ -788,7 +800,7 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) erts_print(to, to_arg, " x(%d)", loader_x_reg_index(ap[0])); break; case LOADER_Y_REG: - erts_print(to, to_arg, " y(%d)", loader_y_reg_index(ap[0])); + erts_print(to, to_arg, " y(%d)", loader_y_reg_index(ap[0]) - CP_SIZE); break; default: erts_print(to, to_arg, " %T", (Eterm) ap[0]); diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 9a77c63390..aa94fbf536 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -50,14 +50,16 @@ #if defined(NO_JUMP_TABLE) # define OpCase(OpCode) case op_##OpCode # define CountCase(OpCode) case op_count_##OpCode -# define IsOpCode(InstrWord, OpCode) ((InstrWord) == (BeamInstr)op_##OpCode) -# define Goto(Rel) {Go = (Rel); goto emulator_loop;} +# define IsOpCode(InstrWord, OpCode) (BeamCodeAddr(InstrWord) == (BeamInstr)op_##OpCode) +# define Goto(Rel) {Go = BeamCodeAddr(Rel); goto emulator_loop;} +# define GotoPF(Rel) Goto(Rel) #else # define OpCase(OpCode) lb_##OpCode # define CountCase(OpCode) lb_count_##OpCode -# define IsOpCode(InstrWord, OpCode) ((InstrWord) == (BeamInstr)&&lb_##OpCode) -# define Goto(Rel) goto *((void *)Rel) -# define LabelAddr(Label) &&Label +# define IsOpCode(InstrWord, OpCode) (BeamCodeAddr(InstrWord) == (BeamInstr)&&lb_##OpCode) +# define Goto(Rel) goto *((void *)BeamCodeAddr(Rel)) +# define GotoPF(Rel) goto *((void *)Rel) +# define LabelAddr(Label) &&Label #endif #ifdef ERTS_ENABLE_LOCK_CHECK @@ -131,11 +133,11 @@ do { \ /* We don't check the range if an ordinary switch is used */ #ifdef NO_JUMP_TABLE -#define VALID_INSTR(IP) ((UWord)(IP) < (NUMBER_OF_OPCODES*2+10)) +# define VALID_INSTR(IP) (BeamCodeAddr(IP) < (NUMBER_OF_OPCODES*2+10)) #else -#define VALID_INSTR(IP) \ - ((SWord)LabelAddr(emulator_loop) <= (SWord)(IP) && \ - (SWord)(IP) < (SWord)LabelAddr(end_emulator_loop)) +# define VALID_INSTR(IP) \ + ((BeamInstr)LabelAddr(emulator_loop) <= BeamCodeAddr(IP) && \ + BeamCodeAddr(IP) < (BeamInstr)LabelAddr(end_emulator_loop)) #endif /* NO_JUMP_TABLE */ #define SET_CP(p, ip) \ @@ -234,15 +236,18 @@ void** beam_ops; #define fb(N) ((Sint)(Sint32)(N)) #define jb(N) ((Sint)(Sint32)(N)) #define tb(N) (N) -#define xb(N) (*(Eterm *) (((unsigned char *)reg) + (N))) -#define yb(N) (*(Eterm *) (((unsigned char *)E) + (N))) +#define xb(N) (*ADD_BYTE_OFFSET(reg, N)) +#define yb(N) (*ADD_BYTE_OFFSET(E, N)) #define Sb(N) (*REG_TARGET_PTR(N)) #define lb(N) (*(double *) (((unsigned char *)&(freg[0].fd)) + (N))) #define Qb(N) (N) #define Ib(N) (N) + #define x(N) reg[N] #define y(N) E[N] #define r(N) x(N) +#define Q(N) (N*sizeof(Eterm *)) +#define l(N) (freg[N].fd) /* * Check that we haven't used the reductions and jump to function pointed to by @@ -1006,6 +1011,18 @@ init_emulator_finish(void) int i; Export* ep; +#if defined(ARCH_64) && defined(CODE_MODEL_SMALL) + for (i = 0; i < NUMBER_OF_OPCODES; i++) { + BeamInstr instr = BeamOpCodeAddr(i); + if (instr >= (1ull << 32)) { + erts_exit(ERTS_ERROR_EXIT, + "This run-time was supposed be compiled with all code below 2Gb,\n" + "but the instruction '%s' is located at %016lx.\n", + opc[i].name, instr); + } + } +#endif + beam_apply[0] = BeamOpCodeAddr(op_i_apply); beam_apply[1] = BeamOpCodeAddr(op_normal_exit); beam_exit[0] = BeamOpCodeAddr(op_error_action_code); diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 9835b1c096..bbccd0b79d 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -806,11 +806,6 @@ erts_finish_loading(Binary* magic, Process* c_p, struct erl_module_instance* inst_p; Uint size; - /* - * No other process may run since we will update the export - * table which is not protected by any locks. - */ - ERTS_LC_ASSERT(erts_initialized == 0 || erts_has_code_write_permission() || erts_thr_progress_is_blocking()); /* @@ -2578,23 +2573,31 @@ load_code(LoaderState* stp) sp++; } break; - case 'i': /* Initialize packing accumulator. */ - packed = code[--ci]; +#ifdef ARCH_64 + case '1': /* Tightest shift (always 10 bits) */ + ci--; + ASSERT((code[ci] & ~0x1FF8ull) == 0); /* Fits in 10 bits */ + packed = (packed << BEAM_TIGHTEST_SHIFT); + packed |= code[ci] >> 3; + if (packed_label) { + packed_label->packed++; + } break; - case '0': /* Tight shift */ +#endif + case '2': /* Tight shift (10 or 16 bits) */ packed = (packed << BEAM_TIGHT_SHIFT) | code[--ci]; if (packed_label) { packed_label->packed++; } break; - case '6': /* Shift 16 steps */ + case '3': /* Loose shift (16 bits) */ packed = (packed << BEAM_LOOSE_SHIFT) | code[--ci]; if (packed_label) { packed_label->packed++; } break; #ifdef ARCH_64 - case 'w': /* Shift 32 steps */ + case '4': /* Wide shift (32 bits) */ { Uint w = code[--ci]; @@ -2646,8 +2649,31 @@ load_code(LoaderState* stp) sp++; packed = 0; break; +#if defined(ARCH_64) && defined(CODE_MODEL_SMALL) + case '#': /* -1 */ + case '$': /* -2 */ + case '%': /* -3 */ + case '&': /* -4 */ + case '\'': /* -5 */ + case '(': /* -6 */ + /* Pack accumulator contents into instruction word. */ + { + Sint pos = ci - (*prog - '#' + 1); + /* Are the high 32 bits of the instruction word zero? */ + ASSERT((code[pos] & ~((1ull << BEAM_WIDE_SHIFT)-1)) == 0); + code[pos] |= packed << BEAM_WIDE_SHIFT; + if (packed_label) { + ASSERT(packed_label->packed == 1); + packed_label->pos = pos; + packed_label->packed = 2; + packed_label = 0; + } + packed >>= BEAM_WIDE_SHIFT; + } + break; +#endif default: - ASSERT(0); + erts_exit(ERTS_ERROR_EXIT, "beam_load: invalid packing op: %c\n", *prog); } } ASSERT(sp == stack); /* Incorrect program? */ diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index bf5487d31e..878b971b07 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -259,6 +259,7 @@ type MREF_TAB_BKTS STANDARD SYSTEM magic_ref_table_buckets type MREF_TAB LONG_LIVED SYSTEM magic_ref_table type MINDIRECTION FIXED_SIZE SYSTEM magic_indirection type BINARY_FIND SHORT_LIVED PROCESSES binary_find +type OPEN_PORT_ENV TEMPORARY SYSTEM open_port_env type THR_Q_EL STANDARD SYSTEM thr_q_element type THR_Q_EL_SL FIXED_SIZE SYSTEM sl_thr_q_element diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 17c936f041..27bbf70c0b 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -3674,6 +3674,12 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) Eterm *hp = HAlloc(BIF_P, hsz); BIF_RET(uword_to_big(size, hp)); } + } else if (ERTS_IS_ATOM_STR("scheduler_dump", BIF_ARG_1)) { +#if defined(ERTS_HAVE_TRY_CATCH) && defined(ERTS_SYS_SUSPEND_SIGNAL) + BIF_RET(am_true); +#else + BIF_RET(am_false); +#endif } } else if (is_tuple(BIF_ARG_1)) { diff --git a/erts/emulator/beam/erl_bif_os.c b/erts/emulator/beam/erl_bif_os.c index 5cd172c26f..910325a2f4 100644 --- a/erts/emulator/beam/erl_bif_os.c +++ b/erts/emulator/beam/erl_bif_os.c @@ -37,6 +37,8 @@ #include "dist.h" #include "erl_version.h" +static int check_env_name(char *name); + /* * Return the pid for the Erlang process in the host OS. */ @@ -101,8 +103,10 @@ BIF_RETTYPE os_getenv_1(BIF_ALIST_1) key_str = erts_convert_filename_to_native(BIF_ARG_1,buf,STATIC_BUF_SIZE, ERTS_ALC_T_TMP,1,0,&len); - if (!key_str) { - BIF_ERROR(p, BADARG); + if (!check_env_name(key_str)) { + if (key_str && key_str != &buf[0]) + erts_free(ERTS_ALC_T_TMP, key_str); + BIF_ERROR(p, BADARG); } if (key_str != &buf[0]) @@ -143,25 +147,20 @@ BIF_RETTYPE os_putenv_2(BIF_ALIST_2) { char def_buf_key[STATIC_BUF_SIZE]; char def_buf_value[STATIC_BUF_SIZE]; - char *key_buf, *value_buf; + char *key_buf = NULL, *value_buf = NULL; key_buf = erts_convert_filename_to_native(BIF_ARG_1,def_buf_key, STATIC_BUF_SIZE, ERTS_ALC_T_TMP,0,0,NULL); - if (!key_buf) { - BIF_ERROR(BIF_P, BADARG); - } + if (!check_env_name(key_buf)) + goto badarg; + value_buf = erts_convert_filename_to_native(BIF_ARG_2,def_buf_value, STATIC_BUF_SIZE, ERTS_ALC_T_TMP,1,0, NULL); - if (!value_buf) { - if (key_buf != def_buf_key) { - erts_free(ERTS_ALC_T_TMP, key_buf); - } - BIF_ERROR(BIF_P, BADARG); - } - + if (!value_buf) + goto badarg; if (erts_sys_putenv(key_buf, value_buf)) { if (key_buf != def_buf_key) { @@ -179,6 +178,13 @@ BIF_RETTYPE os_putenv_2(BIF_ALIST_2) erts_free(ERTS_ALC_T_TMP, value_buf); } BIF_RET(am_true); + +badarg: + if (key_buf && key_buf != def_buf_key) + erts_free(ERTS_ALC_T_TMP, key_buf); + if (value_buf && value_buf != def_buf_value) + erts_free(ERTS_ALC_T_TMP, value_buf); + BIF_ERROR(BIF_P, BADARG); } BIF_RETTYPE os_unsetenv_1(BIF_ALIST_1) @@ -188,20 +194,21 @@ BIF_RETTYPE os_unsetenv_1(BIF_ALIST_1) key_buf = erts_convert_filename_to_native(BIF_ARG_1,buf,STATIC_BUF_SIZE, ERTS_ALC_T_TMP,0,0,NULL); - if (!key_buf) { - BIF_ERROR(BIF_P, BADARG); - } + if (!check_env_name(key_buf)) + goto badarg; + + if (erts_sys_unsetenv(key_buf)) + goto badarg; - if (erts_sys_unsetenv(key_buf)) { - if (key_buf != buf) { - erts_free(ERTS_ALC_T_TMP, key_buf); - } - BIF_ERROR(BIF_P, BADARG); - } if (key_buf != buf) { erts_free(ERTS_ALC_T_TMP, key_buf); } BIF_RET(am_true); + +badarg: + if (key_buf && key_buf != buf) + erts_free(ERTS_ALC_T_TMP, key_buf); + BIF_ERROR(BIF_P, BADARG); } BIF_RETTYPE os_set_signal_2(BIF_ALIST_2) { @@ -217,3 +224,27 @@ BIF_RETTYPE os_set_signal_2(BIF_ALIST_2) { error: BIF_ERROR(BIF_P, BADARG); } + +static int +check_env_name(char *raw_name) +{ + byte *c = (byte *) raw_name; + int encoding; + + if (!c) + return 0; + + encoding = erts_get_native_filename_encoding(); + + if (erts_raw_env_char_is_7bit_ascii_char('\0', c, encoding)) + return 0; /* Do not allow empty name... */ + + /* Verify no '=' characters in variable name... */ + do { + if (erts_raw_env_char_is_7bit_ascii_char('=', c, encoding)) + return 0; + c = erts_raw_env_next_char(c, encoding); + } while (!erts_raw_env_char_is_7bit_ascii_char('\0', c, encoding)); + + return 1; /* Seems ok... */ +} diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c index 3b8e70d44a..c4a4dd5863 100644 --- a/erts/emulator/beam/erl_bif_port.c +++ b/erts/emulator/beam/erl_bif_port.c @@ -45,7 +45,7 @@ #include "dtrace-wrapper.h" static Port *open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump); -static byte* convert_environment(Process* p, Eterm env); +static char* convert_environment(Eterm env); static char **convert_args(Eterm); static void free_args(char **); @@ -718,11 +718,11 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump) goto badarg; } } else if (option == am_env) { - byte* bytes; - if ((bytes = convert_environment(p, *tp)) == NULL) { + if (opts.envir) /* ignore previous env option... */ + erts_free(ERTS_ALC_T_OPEN_PORT_ENV, opts.envir); + opts.envir = convert_environment(*tp); + if (!opts.envir) goto badarg; - } - opts.envir = (char *) bytes; } else if (option == am_args) { char **av; char **oav = opts.argv; @@ -956,6 +956,8 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump) erts_atomic32_read_bor_relb(&port->state, sflgs); do_return: + if (opts.envir) + erts_free(ERTS_ALC_T_OPEN_PORT_ENV, opts.envir); if (name_buf) erts_free(ERTS_ALC_T_TMP, (void *) name_buf); if (opts.argv) { @@ -1021,74 +1023,129 @@ static void free_args(char **av) } erts_free(ERTS_ALC_T_TMP, av); } - -static byte* convert_environment(Process* p, Eterm env) +#ifdef DEBUG +#define ERTS_CONV_ENV_BUF_EXTRA 2 +#else +#define ERTS_CONV_ENV_BUF_EXTRA 1024 +#endif + +static char* convert_environment(Eterm env) { - Eterm all; - Eterm* temp_heap; - Eterm* hp; - Uint heap_size; - Sint n; - Sint size; + /* + * Returns environment buffer in memory allocated + * as ERTS_ALC_T_OPEN_PORT_ENV. Caller *needs* + * to deallocate... + */ + + Sint size, alloc_size; byte* bytes; int encoding = erts_get_native_filename_encoding(); - if ((n = erts_list_length(env)) < 0) { - return NULL; - } - heap_size = 2*(5*n+1); - temp_heap = hp = (Eterm *) erts_alloc(ERTS_ALC_T_TMP, heap_size*sizeof(Eterm)); - bytes = NULL; /* Indicating error */ + alloc_size = ERTS_CONV_ENV_BUF_EXTRA; + bytes = erts_alloc(ERTS_ALC_T_OPEN_PORT_ENV, + alloc_size); + size = 0; - /* - * All errors below are handled by jumping to 'done', to ensure that the memory - * gets deallocated. Do NOT return directly from this function. - */ + /* ERTS_CONV_ENV_BUF_EXTRA >= for end delimiter... */ + ERTS_CT_ASSERT(ERTS_CONV_ENV_BUF_EXTRA >= 2); - all = CONS(hp, make_small(0), NIL); - hp += 2; + while (is_list(env)) { + Sint var_sz, val_sz, need; + byte *str, *limit; + Eterm tmp, *tp, *consp; - while(is_list(env)) { - Eterm tmp; - Eterm* tp; + consp = list_val(env); + tmp = CAR(consp); + if (is_not_tuple_arity(tmp, 2)) + goto error; - tmp = CAR(list_val(env)); - if (is_not_tuple_arity(tmp, 2)) { - goto done; - } tp = tuple_val(tmp); - tmp = CONS(hp, make_small(0), NIL); - hp += 2; - if (tp[2] != am_false) { - tmp = CONS(hp, tp[2], tmp); - hp += 2; - } - tmp = CONS(hp, make_small('='), tmp); - hp += 2; - tmp = CONS(hp, tp[1], tmp); - hp += 2; - all = CONS(hp, tmp, all); - hp += 2; - env = CDR(list_val(env)); - } - if (is_not_nil(env)) { - goto done; - } - if ((size = erts_native_filename_need(all, encoding, 1)) < 0) { - goto done; + /* Check encoding of env variable... */ + if (is_not_list(tp[1])) + goto error; + var_sz = erts_native_filename_need(tp[1], encoding); + if (var_sz <= 0) + goto error; + /* Check encoding of value... */ + if (tp[2] == am_false || is_nil(tp[2])) + val_sz = 0; + else if (is_not_list(tp[2])) + goto error; + else { + val_sz = erts_native_filename_need(tp[2], encoding); + if (val_sz < 0) + goto error; + } + + /* Ensure enough memory... */ + need = size; + need += var_sz + val_sz; + /* '=' and '\0' */ + need += 2 * erts_raw_env_7bit_ascii_char_need(encoding); + if (need > alloc_size) { + alloc_size = (need - alloc_size) + alloc_size; + alloc_size += ERTS_CONV_ENV_BUF_EXTRA; + bytes = erts_realloc(ERTS_ALC_T_OPEN_PORT_ENV, + bytes, alloc_size); + } + + /* Write environment variable name... */ + str = bytes + size; + erts_native_filename_put(tp[1], encoding, str); + /* empty variable name is not allowed... */ + if (erts_raw_env_char_is_7bit_ascii_char('\0', str, encoding)) + goto error; + + /* + * Drop null characters at the end and verify that we do + * not have any '=' characters in the name... + */ + limit = str + var_sz; + while (str < limit) { + if (erts_raw_env_char_is_7bit_ascii_char('\0', str, encoding)) + break; + if (erts_raw_env_char_is_7bit_ascii_char('=', str, encoding)) + goto error; + str = erts_raw_env_next_char(str, encoding); + } + + /* Write the equals sign... */ + str = erts_raw_env_7bit_ascii_char_put('=', str, encoding); + + /* Write the value... */ + if (val_sz > 0) { + limit = str + val_sz; + erts_native_filename_put(tp[2], encoding, str); + while (str < limit) { + if (erts_raw_env_char_is_7bit_ascii_char('\0', str, encoding)) + break; + str = erts_raw_env_next_char(str, encoding); + } + } + + /* Delimit... */ + str = erts_raw_env_7bit_ascii_char_put('\0', str, encoding); + + size = str - bytes; + ASSERT(size <= alloc_size); + + env = CDR(consp); } - /* - * Put the result in a binary (no risk for a memory leak that way). - */ - (void) erts_new_heap_binary(p, NULL, size, &bytes); - erts_native_filename_put(all,encoding,bytes); + /* End delimit... */ + (void) erts_raw_env_7bit_ascii_char_put('\0', &bytes[size], encoding); + + if (is_nil(env)) + return (char *) bytes; + +error: + + if (bytes) + erts_free(ERTS_ALC_T_OPEN_PORT_ENV, bytes); - done: - erts_free(ERTS_ALC_T_TMP, temp_heap); - return bytes; + return (char *) NULL; /* error... */ } /* ------------ decode_packet() and friends: */ diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 61fdf86a56..3d12b3bc21 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -12476,9 +12476,9 @@ send_exit_signal(Process *c_p, /* current process if and only if ((state & ERTS_PSFLG_TRAP_EXIT) && (reason != am_kill || (flags & ERTS_XSIG_FLG_IGN_KILL))) { - /* have to release the status lock in order to send the exit message */ - erts_proc_unlock(rp, *rp_locks & ERTS_PROC_LOCKS_XSIG_SEND); - *rp_locks &= ~ERTS_PROC_LOCKS_XSIG_SEND; + /* have to release the status and trace lock in order to send the exit message */ + erts_proc_unlock(rp, *rp_locks & (ERTS_PROC_LOCKS_XSIG_SEND|ERTS_PROC_LOCK_TRACE)); + *rp_locks &= ~(ERTS_PROC_LOCKS_XSIG_SEND|ERTS_PROC_LOCK_TRACE); if (have_seqtrace(token) && token_update) seq_trace_update_send(token_update); if (is_value(exit_tuple)) diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c index efd2ca3db2..b7a5c45fea 100644 --- a/erts/emulator/beam/erl_unicode.c +++ b/erts/emulator/beam/erl_unicode.c @@ -1988,7 +1988,7 @@ char *erts_convert_filename_to_encoding(Eterm name, char *statbuf, size_t statbu is_list(name) || (allow_empty && is_nil(name))) { Sint need; - if ((need = erts_native_filename_need(name, encoding, 0)) < 0) { + if ((need = erts_native_filename_need(name, encoding)) < 0) { return NULL; } if (encoding == ERL_FILENAME_WIN_WCHAR) { @@ -2152,7 +2152,7 @@ Eterm erts_convert_native_to_filename(Process *p, byte *bytes) } -Sint erts_native_filename_need(Eterm ioterm, int encoding, int allow_null) +Sint erts_native_filename_need(Eterm ioterm, int encoding) { Eterm *objp; Eterm obj; @@ -2195,21 +2195,19 @@ Sint erts_native_filename_need(Eterm ioterm, int encoding, int allow_null) default: need = -1; } - if (!allow_null) { - /* - * Do not allow null in - * the middle of filenames - */ - if (need > 0) { - byte *name = ap->name; - int len = ap->len; - for (i = 0; i < len; i++) { - if (name[i] == 0) - seen_null = 1; - else if (seen_null) { - need = -1; - break; - } + /* + * Do not allow null in + * the middle of filenames + */ + if (need > 0) { + byte *name = ap->name; + int len = ap->len; + for (i = 0; i < len; i++) { + if (name[i] == 0) + seen_null = 1; + else if (seen_null) { + need = -1; + break; } } } @@ -2243,17 +2241,15 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */ if (is_small(obj)) { /* Always small */ for(;;) { Uint x = unsigned_val(obj); - if (!allow_null) { - /* - * Do not allow null in - * the middle of filenames - */ - if (x == 0) - seen_null = 1; - else if (seen_null) { - DESTROY_ESTACK(stack); - return ((Sint) -1); - } + /* + * Do not allow null in + * the middle of filenames + */ + if (x == 0) + seen_null = 1; + else if (seen_null) { + DESTROY_ESTACK(stack); + return ((Sint) -1); } switch (encoding) { case ERL_FILENAME_LATIN1: @@ -2528,6 +2524,38 @@ void erts_copy_utf8_to_utf16_little(byte *target, byte *bytes, int num_chars) } /* + * *** Requirements on Raw Filename Format *** + * + * These requirements are due to the 'filename' module + * in stdlib. This since it is documented that it + * should be able to operate on raw filenames as well + * as ordinary filenames. + * + * A raw filename *must* be a byte sequence where: + * 1. Codepoints 0-127 (7-bit ascii) *must* be encoded + * as a byte with the corresponding value. That is, + * the most significant bit in the byte encoding the + * codepoint is never set. + * 2. Codepoints greater than 127 *must* be encoded + * with the most significant bit set in *every* byte + * encoding it. + * + * Latin1 and UTF-8 meet these requirements while + * UTF-16 and UTF-32 don't. + * + * On Windows filenames are natively stored as malformed + * UTF-16LE (lonely surrogates may appear). A more correct + * description than UTF-16 would be an array of 16-bit + * words... In order to meet the requirements of the + * raw file format we convert the malformed UTF-16LE to + * malformed UTF-8 which meet the requirements. + * + * Note that these requirements are today only OTP + * internal (erts-stdlib internal) requirements that + * could be changed. + */ + +/* * This internal bif converts a filename to whatever format is suitable for the file driver * It also adds zero termination so that prim_file needn't bother with the character encoding * of the file driver @@ -2538,6 +2566,12 @@ BIF_RETTYPE prim_file_internal_name2native_1(BIF_ALIST_1) Sint need; Eterm bin_term; byte* bin_p; + + /* + * See comment on "Requirements on Raw Filename Format" + * above. + */ + /* Prim file explicitly does not allow atoms, although we could very well cope with it. Instead of letting 'file' handle them, it would probably be more efficient to handle them here. Subject to @@ -2609,7 +2643,7 @@ BIF_RETTYPE prim_file_internal_name2native_1(BIF_ALIST_1) } /* binary */ - if ((need = erts_native_filename_need(BIF_ARG_1, encoding, 0)) < 0) { + if ((need = erts_native_filename_need(BIF_ARG_1, encoding)) < 0) { BIF_ERROR(BIF_P,BADARG); } if (encoding == ERL_FILENAME_WIN_WCHAR) { @@ -2644,6 +2678,11 @@ BIF_RETTYPE prim_file_internal_native2name_1(BIF_ALIST_1) Eterm ret; int mac = 0; + /* + * See comment on "Requirements on Raw Filename Format" + * above. + */ + if (is_not_binary(BIF_ARG_1)) { BIF_ERROR(BIF_P,BADARG); } diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index 661538eadd..76980b5871 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -209,6 +209,15 @@ extern void** beam_ops; # define BeamOpCodeAddr(OpCode) ((BeamInstr)beam_ops[(OpCode)]) #endif -#define BeamIsOpCode(InstrWord, OpCode) ((InstrWord) == BeamOpCodeAddr(OpCode)) +#if defined(ARCH_64) && defined(CODE_MODEL_SMALL) +# define BeamCodeAddr(InstrWord) ((BeamInstr)(Uint32)(InstrWord)) +# define BeamSetCodeAddr(InstrWord, Addr) (((InstrWord) & ~((1ull << 32)-1)) | (Addr)) +# define BeamExtraData(InstrWord) ((InstrWord) >> 32) +#else +# define BeamCodeAddr(InstrWord) ((BeamInstr)(InstrWord)) +# define BeamSetCodeAddr(InstrWord, Addr) (Addr) +#endif + +#define BeamIsOpCode(InstrWord, OpCode) (BeamCodeAddr(InstrWord) == BeamOpCodeAddr(OpCode)) #endif /* __ERL_VM_H__ */ diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 604172857a..09aeba00fa 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1238,7 +1238,7 @@ void erts_init_unicode(void); Sint erts_unicode_set_loop_limit(Sint limit); void erts_native_filename_put(Eterm ioterm, int encoding, byte *p) ; -Sint erts_native_filename_need(Eterm ioterm, int encoding, int allow_null); +Sint erts_native_filename_need(Eterm ioterm, int encoding); void erts_copy_utf8_to_utf16_little(byte *target, byte *bytes, int num_chars); int erts_analyze_utf8(byte *source, Uint size, byte **err_pos, Uint *num_chars, int *left); diff --git a/erts/emulator/beam/instrs.tab b/erts/emulator/beam/instrs.tab index 07cc4bd527..20d356a81d 100644 --- a/erts/emulator/beam/instrs.tab +++ b/erts/emulator/beam/instrs.tab @@ -857,8 +857,7 @@ catch(Y, Fail) { } catch_end(Y) { - c_p->catches--; - make_blank($Y); + $try_end($Y); if (is_non_value(r(0))) { c_p->fvalue = NIL; if (x(1) == am_throw) { @@ -888,12 +887,15 @@ catch_end(Y) { try_end(Y) { c_p->catches--; make_blank($Y); - if (is_non_value(r(0))) { - c_p->fvalue = NIL; - r(0) = x(1); - x(1) = x(2); - x(2) = x(3); - } +} + +try_case(Y) { + $try_end($Y); + ASSERT(is_non_value(r(0))); + c_p->fvalue = NIL; + r(0) = x(1); + x(1) = x(2); + x(2) = x(3); } try_case_end(Src) { diff --git a/erts/emulator/beam/macros.tab b/erts/emulator/beam/macros.tab index 0d175a7ec6..e0b5f56b53 100644 --- a/erts/emulator/beam/macros.tab +++ b/erts/emulator/beam/macros.tab @@ -38,7 +38,7 @@ REFRESH_GEN_DEST() { // zero, except in a few bit syntax instructions.) SET_I_REL(Offset) { - ASSERT(VALID_INSTR(*(I + ($Offset)))); + ASSERT(VALID_INSTR(*(I + ($Offset) + $IP_ADJUSTMENT))); I += $Offset + $IP_ADJUSTMENT; } diff --git a/erts/emulator/beam/module.h b/erts/emulator/beam/module.h index 9a81e6035b..a3f1ce1705 100644 --- a/erts/emulator/beam/module.h +++ b/erts/emulator/beam/module.h @@ -45,7 +45,7 @@ typedef struct erl_module { int seen; /* Used by finish_loading() */ struct erl_module_instance curr; - struct erl_module_instance old; /* protected by "old_code" rwlock */ + struct erl_module_instance old; /* active protected by "old_code" rwlock */ struct erl_module_instance* on_load; } Module; diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 75ff40606b..7a2c39b3a8 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -99,21 +99,21 @@ line Loc | func_info M F A => func_info M F A | line Loc line I -allocate t t -allocate_heap t I t +allocate t t? +allocate_heap t I t? %cold deallocate Q %hot init y -allocate_zero t t -allocate_heap_zero t I t +allocate_zero t t? +allocate_heap_zero t I t? trim N Remaining => i_trim N i_trim t -test_heap I t +test_heap I t? allocate_heap S u==0 R => allocate S R allocate_heap_zero S u==0 R => allocate_zero S R @@ -158,19 +158,19 @@ is_tuple Fail=f S | select_tuple_arity S=d Fail=f Size=u Rest=* => \ select_tuple_arity S=d Fail=f Size=u Rest=* => \ gen_select_tuple_arity(S, Fail, Size, Rest) -i_select_val_bins xy f I +i_select_val_bins xy f? I -i_select_val_lins xy f I +i_select_val_lins xy f? I -i_select_val2 xy f c c +i_select_val2 xy f? c c -i_select_tuple_arity xy f I +i_select_tuple_arity xy f? I -i_select_tuple_arity2 xy f A A +i_select_tuple_arity2 xy f? A A -i_jump_on_val_zero xy f I +i_jump_on_val_zero xy f? I -i_jump_on_val xy f I W +i_jump_on_val xy f? I W get_list xy xy xy @@ -188,7 +188,8 @@ catch_end y # Try/catch. try Y F => catch Y F -try_case Y => try_end Y + +try_case y try_end y %cold @@ -213,9 +214,9 @@ i_get_tuple_element2y x P y y i_get_tuple_element3 x P x %cold -is_number f x -is_number f y +is_number f? xy %hot + is_number Fail=f i => is_number Fail=f na => jump Fail is_number Fail Literal=q => move Literal x | is_number Fail x @@ -446,37 +447,37 @@ is_ne_exact Lbl C=c R=xy => is_ne_exact Lbl R C is_ne_exact Lbl R=xy C=ian => i_is_ne_exact_immed Lbl R C is_ne_exact Lbl R=xy C=q => i_is_ne_exact_literal Lbl R C -i_is_eq_exact_immed f rxy c +i_is_eq_exact_immed f? rxy c -i_is_eq_exact_literal f xy c +i_is_eq_exact_literal f? xy c -i_is_ne_exact_immed f xy c +i_is_ne_exact_immed f? xy c -i_is_ne_exact_literal f xy c +i_is_ne_exact_literal f? xy c is_eq_exact Lbl Y=y X=x => is_eq_exact Lbl X Y -is_eq_exact f x xy -is_eq_exact f y y +is_eq_exact f? x xy +is_eq_exact f? y y -is_ne_exact f S S +is_ne_exact f? S S -is_lt f x x -is_lt f x c -is_lt f c x +is_lt f? x x +is_lt f? x c +is_lt f? c x %cold -is_lt f s s +is_lt f? s s %hot -is_ge f x x -is_ge f x c -is_ge f c x +is_ge f? x x +is_ge f? x c +is_ge f? c x %cold -is_ge f s s +is_ge f? s s %hot -is_eq f s s +is_eq f? s s -is_ne f s s +is_ne f? s s # # Putting things. @@ -583,7 +584,7 @@ is_tagged_tuple Fail Literal=q Arity Atom => \ move Literal x | is_tagged_tuple Fail x Arity Atom is_tagged_tuple Fail=f c Arity Atom => jump Fail -is_tagged_tuple f rxy A a +is_tagged_tuple f? rxy A a # Test tuple & arity (head) @@ -591,14 +592,14 @@ is_tuple Fail Literal=q => move Literal x | is_tuple Fail x is_tuple Fail=f c => jump Fail is_tuple Fail=f S=xy | test_arity Fail=f S=xy Arity => is_tuple_of_arity Fail S Arity -is_tuple_of_arity f rxy A +is_tuple_of_arity f? rxy A -is_tuple f rxy +is_tuple f? rxy test_arity Fail Literal=q Arity => move Literal x | test_arity Fail x Arity test_arity Fail=f c Arity => jump Fail -test_arity f xy A +test_arity f? xy A get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \ get_tuple_element Reg=x P3 D3=x | \ @@ -619,16 +620,16 @@ is_integer Fail Literal=q => move Literal x | is_integer Fail x is_integer Fail=f S=x | allocate Need Regs => is_integer_allocate Fail S Need Regs -is_integer_allocate f x t t +is_integer_allocate f? x t t -is_integer f xy +is_integer f? xy is_list Fail=f n => is_list Fail Literal=q => move Literal x | is_list Fail x is_list Fail=f c => jump Fail -is_list f x +is_list f? x %cold -is_list f y +is_list f? y %hot is_nonempty_list Fail=f S=x | allocate Need Rs => is_nonempty_list_allocate Fail S Need Rs @@ -638,21 +639,21 @@ is_nonempty_list F=f x==0 | test_heap I1 I2 => is_nonempty_list_test_heap F I1 I is_nonempty_list Fail=f S=x | get_list S D1=x D2=x => \ is_nonempty_list_get_list Fail S D1 D2 -is_nonempty_list_allocate f rx t t -is_nonempty_list_test_heap f I t -is_nonempty_list_get_list f rx x x -is_nonempty_list f xy +is_nonempty_list_allocate f? rx t t +is_nonempty_list_test_heap f? I t +is_nonempty_list_get_list f? rx x x +is_nonempty_list f? xy -is_atom f x +is_atom f? x %cold -is_atom f y +is_atom f? y %hot is_atom Fail=f a => is_atom Fail=f niq => jump Fail -is_float f x +is_float f? x %cold -is_float f y +is_float f? y %hot is_float Fail=f nai => jump Fail is_float Fail Literal=q => move Literal x | is_float Fail x @@ -660,13 +661,13 @@ is_float Fail Literal=q => move Literal x | is_float Fail x is_nil Fail=f n => is_nil Fail=f qia => jump Fail -is_nil f xy +is_nil f? xy is_binary Fail Literal=q => move Literal x | is_binary Fail x is_binary Fail=f c => jump Fail -is_binary f x +is_binary f? x %cold -is_binary f y +is_binary f? y %hot # XXX Deprecated. @@ -674,27 +675,27 @@ is_bitstr Fail Term => is_bitstring Fail Term is_bitstring Fail Literal=q => move Literal x | is_bitstring Fail x is_bitstring Fail=f c => jump Fail -is_bitstring f x +is_bitstring f? x %cold -is_bitstring f y +is_bitstring f? y %hot is_reference Fail=f cq => jump Fail -is_reference f x +is_reference f? x %cold -is_reference f y +is_reference f? y %hot is_pid Fail=f cq => jump Fail -is_pid f x +is_pid f? x %cold -is_pid f y +is_pid f? y %hot is_port Fail=f cq => jump Fail -is_port f x +is_port f? x %cold -is_port f y +is_port f? y %hot is_boolean Fail=f a==am_true => @@ -702,19 +703,19 @@ is_boolean Fail=f a==am_false => is_boolean Fail=f ac => jump Fail %cold -is_boolean f xy +is_boolean f? xy %hot is_function2 Fail=f acq Arity => jump Fail is_function2 Fail=f Fun a => jump Fail -is_function2 f S s +is_function2 f? S s # Allocating & initializing. allocate Need Regs | init Y => allocate_init Need Regs Y init Y1 | init Y2 => init2 Y1 Y2 -allocate_init t t y +allocate_init t t? y ################################################################# # External function and bif calls. @@ -1004,13 +1005,13 @@ node y # Note: 'I' is sufficient because this instruction will only be used # if the arity fits in 24 bits. -i_fast_element xy j I d +i_fast_element xy j? I d -i_element xy j s d +i_element xy j? s d -bif1 f b s d +bif1 f? b s d bif1_body b s d -i_bif2 f b s s d +i_bif2 f? b s s d i_bif2_body b s s d # @@ -1062,7 +1063,7 @@ make_fun2 OldIndex=u => gen_make_fun2(OldIndex) i_make_fun W t %hot -is_function f xy +is_function f? xy is_function Fail=f c => jump Fail func_info M F A => i_func_info u M F A @@ -1091,24 +1092,24 @@ i_bs_match_string x f W W bs_get_integer2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \ gen_get_integer2(Fail, Ms, Live, Sz, Unit, Flags, Dst) -i_bs_get_integer_small_imm x W f t x -i_bs_get_integer_imm x W t f t x -i_bs_get_integer f t t x s x -i_bs_get_integer_8 x f x -i_bs_get_integer_16 x f x +i_bs_get_integer_small_imm x W f? t x +i_bs_get_integer_imm x W t f? t x +i_bs_get_integer f? t t x s x +i_bs_get_integer_8 x f? x +i_bs_get_integer_16 x f? x %if ARCH_64 -i_bs_get_integer_32 x f x +i_bs_get_integer_32 x f? x %endif # Fetching binaries from binaries. bs_get_binary2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \ gen_get_binary2(Fail, Ms, Live, Sz, Unit, Flags, Dst) -i_bs_get_binary_imm2 f x t W t x -i_bs_get_binary2 f x t s t x -i_bs_get_binary_all2 f x t t x -i_bs_get_binary_all_reuse x f t +i_bs_get_binary_imm2 f? x t W t x +i_bs_get_binary2 f x t? s t x +i_bs_get_binary_all2 f? x t t x +i_bs_get_binary_all_reuse x f? t # Fetching float from binaries. bs_get_float2 Fail=f Ms=x Live=u Sz=s Unit=u Flags=u Dst=d => \ @@ -1116,29 +1117,32 @@ bs_get_float2 Fail=f Ms=x Live=u Sz=s Unit=u Flags=u Dst=d => \ bs_get_float2 Fail=f Ms=x Live=u Sz=q Unit=u Flags=u Dst=d => jump Fail -i_bs_get_float2 f x t s t x +i_bs_get_float2 f? x t s t x # Miscellanous bs_skip_bits2 Fail=f Ms=x Sz=sq Unit=u Flags=u => \ gen_skip_bits2(Fail, Ms, Sz, Unit, Flags) -i_bs_skip_bits_imm2 f x W -i_bs_skip_bits2 f x xy t -i_bs_skip_bits_all2 f x t +i_bs_skip_bits_imm2 f? x W +i_bs_skip_bits2 f? x xy t +i_bs_skip_bits_all2 f? x t bs_test_tail2 Fail=f Ms=x Bits=u==0 => bs_test_zero_tail2 Fail Ms bs_test_tail2 Fail=f Ms=x Bits=u => bs_test_tail_imm2 Fail Ms Bits -bs_test_zero_tail2 f x -bs_test_tail_imm2 f x W +bs_test_zero_tail2 f? x +bs_test_tail_imm2 f? x W bs_test_unit F Ms Unit=u==8 => bs_test_unit8 F Ms -bs_test_unit f x t -bs_test_unit8 f x +bs_test_unit f? x t +bs_test_unit8 f? x # An y register operand for bs_context_to_binary is rare, # but can happen because of inlining. +bs_context_to_binary Y=y | line L | badmatch Y => \ + move Y x | bs_context_to_binary x | line L | badmatch x + bs_context_to_binary Y=y => move Y x | bs_context_to_binary x bs_context_to_binary x @@ -1147,14 +1151,14 @@ bs_context_to_binary x # Utf8/utf16/utf32 support. (R12B-5) # bs_get_utf8 Fail=f Ms=x u u Dst=d => i_bs_get_utf8 Ms Fail Dst -i_bs_get_utf8 x f x +i_bs_get_utf8 x f? x bs_skip_utf8 Fail=f Ms=x u u => i_bs_get_utf8 Ms Fail x bs_get_utf16 Fail=f Ms=x u Flags=u Dst=d => i_bs_get_utf16 Ms Fail Flags Dst bs_skip_utf16 Fail=f Ms=x u Flags=u => i_bs_get_utf16 Ms Fail Flags x -i_bs_get_utf16 x f t x +i_bs_get_utf16 x f? t x bs_get_utf32 Fail=f Ms=x Live=u Flags=u Dst=d => \ bs_get_integer2 Fail Ms Live i=32 u=1 Flags Dst | \ @@ -1183,13 +1187,13 @@ bs_init2 Fail Sz Words=u==0 Regs Flags Dst => \ bs_init2 Fail Sz Words Regs Flags Dst => \ i_bs_init_fail_heap Sz Words Fail Regs Dst -i_bs_init_fail xy j t x +i_bs_init_fail xy j? t? x -i_bs_init_fail_heap s I j t x +i_bs_init_fail_heap s I j? t? x -i_bs_init W t x +i_bs_init W t? x -i_bs_init_heap W I t x +i_bs_init_heap W I t? x bs_init_bits Fail Sz=o Words Regs Flags Dst => system_limit Fail @@ -1202,16 +1206,16 @@ bs_init_bits Fail Sz Words=u==0 Regs Flags Dst => \ bs_init_bits Fail Sz Words Regs Flags Dst => \ i_bs_init_bits_fail_heap Sz Words Fail Regs Dst -i_bs_init_bits_fail xy j t x +i_bs_init_bits_fail xy j? t? x -i_bs_init_bits_fail_heap s I j t x +i_bs_init_bits_fail_heap s I j? t? x -i_bs_init_bits W t x -i_bs_init_bits_heap W I t x +i_bs_init_bits W t? x +i_bs_init_bits_heap W I t? x bs_add Fail S1=i==0 S2 Unit=u==1 D => move S2 D -bs_add j s s t x +bs_add j? s s t? x bs_append Fail Size Extra Live Unit Bin Flags Dst => \ move Bin x | i_bs_append Fail Extra Live Unit Size Dst @@ -1221,8 +1225,8 @@ bs_private_append Fail Size Unit Bin Flags Dst => \ bs_init_writable -i_bs_append j I t t s x -i_bs_private_append j t s S x +i_bs_append j? I t? t s x +i_bs_private_append j? t s S x # # Storing integers into binaries. @@ -1231,8 +1235,8 @@ i_bs_private_append j t s S x bs_put_integer Fail=j Sz=sq Unit=u Flags=u Src=s => \ gen_put_integer(Fail, Sz, Unit, Flags, Src) -i_new_bs_put_integer j s t s -i_new_bs_put_integer_imm j W t s +i_new_bs_put_integer j? s t s +i_new_bs_put_integer_imm j? W t s # # Utf8/utf16/utf32 support. (R12B-5) @@ -1248,14 +1252,14 @@ i_bs_utf16_size s x bs_put_utf8 Fail u Src=s => i_bs_put_utf8 Fail Src -i_bs_put_utf8 j s +i_bs_put_utf8 j? s -bs_put_utf16 j t s +bs_put_utf16 j? t s bs_put_utf32 Fail=j Flags=u Src=s => \ i_bs_validate_unicode Fail Src | bs_put_integer Fail i=32 u=1 Flags Src -i_bs_validate_unicode j s +i_bs_validate_unicode j? s # # Storing floats into binaries. @@ -1265,8 +1269,8 @@ bs_put_float Fail Sz=q Unit Flags Val => badarg Fail bs_put_float Fail=j Sz=s Unit=u Flags=u Src=s => \ gen_put_float(Fail, Sz, Unit, Flags, Src) -i_new_bs_put_float j s t s -i_new_bs_put_float_imm j W t s +i_new_bs_put_float j? s t s +i_new_bs_put_float_imm j? W t s # # Storing binaries into binaries. @@ -1275,9 +1279,9 @@ i_new_bs_put_float_imm j W t s bs_put_binary Fail=j Sz=s Unit=u Flags=u Src=s => \ gen_put_binary(Fail, Sz, Unit, Flags, Src) -i_new_bs_put_binary j s t s -i_new_bs_put_binary_imm j W s -i_new_bs_put_binary_all j s t +i_new_bs_put_binary j? s t s +i_new_bs_put_binary_imm j? W s +i_new_bs_put_binary_all j? s t # # Warning: The i_bs_put_string and i_new_bs_put_string instructions @@ -1391,12 +1395,12 @@ new_map Dst Live Size Rest=* | is_small_map_literal_keys(Size, Rest) => \ new_map d t I i_new_small_map_lit d t q update_map_assoc s d t I -update_map_exact j s d t I +update_map_exact j? s d t I is_map Fail Lit=q | literal_is_map(Lit) => is_map Fail cq => jump Fail -is_map f xy +is_map f? xy ## Transform has_map_fields #{ K1 := _, K2 := _ } to has_map_elements @@ -1410,14 +1414,14 @@ get_map_elements Fail Src=xy Size=u==2 Rest=* => \ get_map_elements Fail Src Size Rest=* | map_key_sort(Size, Rest) => \ gen_get_map_elements(Fail, Src, Size, Rest) -i_get_map_elements f s I +i_get_map_elements f? s I i_get_map_element Fail Src=xy Key=y Dst => \ move Key x | i_get_map_element Fail Src x Dst -i_get_map_element_hash f xy c I xy +i_get_map_element_hash f? xy c I xy -i_get_map_element f xy x xy +i_get_map_element f? xy x xy # # Convert the plus operations to a generic plus instruction. @@ -1485,32 +1489,32 @@ gc_bif1 Fail I u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src I Dst i_increment rxy W t d -i_plus x xy j t d -i_plus s s j t d +i_plus x xy j? t d +i_plus s s j? t d -i_minus x x j t d -i_minus s s j t d +i_minus x x j? t d +i_minus s s j? t d -i_times j t s s d +i_times j? t s s d -i_m_div j t s s d -i_int_div j t s s d +i_m_div j? t s s d +i_int_div j? t s s d -i_rem x x j t d -i_rem s s j t d +i_rem x x j? t d +i_rem s s j? t d -i_bsl s s j t d -i_bsr s s j t d +i_bsl s s j? t d +i_bsr s s j? t d -i_band x c j t d -i_band s s j t d +i_band x c j? t d +i_band s s j? t d -i_bor j I s s d -i_bxor j I s s d +i_bor j? I s s d +i_bxor j? I s s d i_int_bnot Fail Src=c Live Dst => move Src x | i_int_bnot Fail x Live Dst -i_int_bnot j S t d +i_int_bnot j? S t d # # Old guard BIFs that creates heap fragments are no longer allowed. @@ -1534,9 +1538,9 @@ gc_bif2 Fail I Bif S1 S2 Dst => \ gc_bif3 Fail I Bif S1 S2 S3 Dst => \ gen_guard_bif3(Fail, I, Bif, S1, S2, S3, Dst) -i_gc_bif1 j W s t d +i_gc_bif1 j? W s t? d -i_gc_bif2 j W t s s d +i_gc_bif2 j? W t? s s d ii_gc_bif3/7 @@ -1545,7 +1549,7 @@ ii_gc_bif3/7 ii_gc_bif3 Fail Bif Live S1 S2 S3 Dst => \ move S1 x | i_gc_bif3 Fail Bif Live S2 S3 Dst -i_gc_bif3 j W t s s d +i_gc_bif3 j? W t? s s d # # The following instruction is specially handled in beam_load.c diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 9106091ca6..bf7d310568 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -824,11 +824,16 @@ int erts_sys_unsetenv(char *key); char *erts_read_env(char *key); void erts_free_read_env(void *value); -#if defined(ERTS_THR_HAVE_SIG_FUNCS) && !defined(ETHR_UNUSABLE_SIGUSRX) +#if defined(ERTS_THR_HAVE_SIG_FUNCS) && \ + (!defined(ETHR_UNUSABLE_SIGUSRX) || defined(SIGRTMIN)) extern void sys_thr_resume(erts_tid_t tid); extern void sys_thr_suspend(erts_tid_t tid); -#define ERTS_SYS_SUSPEND_SIGNAL SIGUSR2 -#endif +#ifdef SIGRTMIN +#define ERTS_SYS_SUSPEND_SIGNAL (SIGRTMIN+1) +#else +#define ERTS_SYS_SUSPEND_SIGNAL (SIGUSR2) +#endif /* SIGRTMIN */ +#endif /* HAVE_SIG_FUNCS */ /* utils.c */ @@ -1170,4 +1175,52 @@ int erts_get_printable_characters(void); void erts_init_sys_common_misc(void); +ERTS_GLB_INLINE Sint erts_raw_env_7bit_ascii_char_need(int encoding); +ERTS_GLB_INLINE byte *erts_raw_env_7bit_ascii_char_put(byte c, byte *p, + int encoding); +ERTS_GLB_INLINE int erts_raw_env_char_is_7bit_ascii_char(byte c, byte *p, + int encoding); +ERTS_GLB_INLINE byte *erts_raw_env_next_char(byte *p, int encoding); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE Sint +erts_raw_env_7bit_ascii_char_need(int encoding) +{ + return (encoding == ERL_FILENAME_WIN_WCHAR) ? 2 : 1; +} + +ERTS_GLB_INLINE byte * +erts_raw_env_7bit_ascii_char_put(byte c, + byte *p, + int encoding) +{ + *(p++) = c; + if (encoding == ERL_FILENAME_WIN_WCHAR) + *(p++) = 0; + return p; +} + +ERTS_GLB_INLINE int +erts_raw_env_char_is_7bit_ascii_char(byte c, + byte *p, + int encoding) +{ + if (encoding == ERL_FILENAME_WIN_WCHAR) + return (p[0] == c) & (p[1] == 0); + else + return p[0] == c; +} + +ERTS_GLB_INLINE byte * +erts_raw_env_next_char(byte *p, int encoding) +{ + if (encoding == ERL_FILENAME_WIN_WCHAR) + return p + 2; + else + return p + 1; +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + #endif diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 7b1f4a0e9c..554c48059f 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -2199,13 +2199,16 @@ static int inet_reply_ok(inet_descriptor* desc) ErlDrvTermData caller = desc->caller; int i = 0; + desc->caller = 0; + if (is_not_internal_pid(caller)) + return 0; + i = LOAD_ATOM(spec, i, am_inet_reply); i = LOAD_PORT(spec, i, desc->dport); i = LOAD_ATOM(spec, i, am_ok); i = LOAD_TUPLE(spec, i, 3); ASSERT(i == sizeof(spec)/sizeof(*spec)); - desc->caller = 0; return erl_drv_send_term(desc->dport, caller, spec, i); } diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index b17170c8b8..bf00de2204 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -57,6 +57,7 @@ MODULES= \ dirty_nif_SUITE \ distribution_SUITE \ driver_SUITE \ + dump_SUITE \ efile_SUITE \ erts_debug_SUITE \ estone_SUITE \ diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl index f0871ead7d..5e5cd6f578 100644 --- a/erts/emulator/test/alloc_SUITE.erl +++ b/erts/emulator/test/alloc_SUITE.erl @@ -89,10 +89,11 @@ mmsc_flags() -> mmsc_flags(Env) -> case os:getenv(Env) of false -> false; - V -> case string:str(V, "+MMsc") of - 0 -> false; - P -> Env ++ "=" ++ string:substr(V, P) - end + V -> + case string:find(V, "+MMsc") of + nomatch -> false; + SubStr -> Env ++ "=" ++ SubStr + end end. erts_mmap_do(Config, SCO, SCRPM, SCRFSD) -> diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl index 04b7f2de15..146c37b118 100644 --- a/erts/emulator/test/bif_SUITE.erl +++ b/erts/emulator/test/bif_SUITE.erl @@ -731,10 +731,12 @@ erlang_halt(Config) when is_list(Config) -> [broken_halt, "Validate correct crash dump"]), {ok,_} = wait_until_stable_size(CrashDump,-1), {ok, Bin} = file:read_file(CrashDump), - case {string:str(binary_to_list(Bin),"\n=end\n"), - string:str(binary_to_list(Bin),"\r\n=end\r\n")} of - {0,0} -> ct:fail("Could not find end marker in crash dump"); - _ -> ok + case {string:find(Bin, <<"\n=end\n">>), + string:find(Bin, <<"\r\n=end\r\n">>)} of + {nomatch,nomatch} -> + ct:fail("Could not find end marker in crash dump"); + {_,_} -> + ok end. wait_until_stable_size(_File,-10) -> diff --git a/erts/emulator/test/decode_packet_SUITE.erl b/erts/emulator/test/decode_packet_SUITE.erl index 54ee4d5567..0ccdbd7ee8 100644 --- a/erts/emulator/test/decode_packet_SUITE.erl +++ b/erts/emulator/test/decode_packet_SUITE.erl @@ -239,7 +239,7 @@ packet_size(Config) when is_list(Config) -> %% Test OTP-9389, long HTTP header lines. Opts = [{packet_size, 128}], Pkt = list_to_binary(["GET / HTTP/1.1\r\nHost: localhost\r\nLink: /", - string:chars($Y, 64), "\r\n\r\n"]), + lists:duplicate(64, $Y), "\r\n\r\n"]), <<Pkt1:50/binary, Pkt2/binary>> = Pkt, {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest1} = erlang:decode_packet(http, Pkt1, Opts), @@ -250,7 +250,7 @@ packet_size(Config) when is_list(Config) -> erlang:decode_packet(httph, list_to_binary([Rest2, Pkt2]), Opts), Pkt3 = list_to_binary(["GET / HTTP/1.1\r\nHost: localhost\r\nLink: /", - string:chars($Y, 129), "\r\n\r\n"]), + lists:duplicate(129, $Y), "\r\n\r\n"]), {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest3} = erlang:decode_packet(http, Pkt3, Opts), {ok, {http_header,_,'Host',_,"localhost"}, Rest4} = @@ -509,9 +509,9 @@ decode_line(Bin,MaxLen) -> end. find_in_binary(Byte, Bin) -> - case string:chr(binary_to_list(Bin),Byte) of - 0 -> notfound; - P -> P + case string:find(Bin, [Byte]) of + nomatch -> notfound; + Suffix -> byte_size(Bin) - byte_size(Suffix) + 1 end. ssl(Config) when is_list(Config) -> @@ -562,7 +562,7 @@ decode_pkt(Type,Bin,Opts) -> otp_9389(Config) when is_list(Config) -> Opts = [{packet_size, 16384}, {line_length, 3000}], Pkt = list_to_binary(["GET / HTTP/1.1\r\nHost: localhost\r\nLink: /", - string:chars($X, 8192), + lists:duplicate(8192, $X), "\r\nContent-Length: 0\r\n\r\n"]), <<Pkt1:5000/binary, Pkt2/binary>> = Pkt, {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest1} = diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl index 17cd1d1a3b..2d0ae9c83e 100644 --- a/erts/emulator/test/distribution_SUITE.erl +++ b/erts/emulator/test/distribution_SUITE.erl @@ -786,8 +786,8 @@ dist_auto_connect_once(Config) when is_list(Config) -> {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]), {ok,[NN2]} = do_inet_rpc(Sock,erlang,nodes,[]), {ok,[NN]} = do_inet_rpc(Sock2,erlang,nodes,[]), - [_,HostPartPeer] = string:tokens(atom_to_list(NN),"@"), - [_,MyHostPart] = string:tokens(atom_to_list(node()),"@"), + [_,HostPartPeer] = string:lexemes(atom_to_list(NN),"@"), + [_,MyHostPart] = string:lexemes(atom_to_list(node()),"@"), % Give net_kernel a chance to change the state of the node to up to. receive after 1000 -> ok end, case HostPartPeer of @@ -2094,7 +2094,7 @@ start_relay_node(Node, Args) -> [{args, Args ++ " -setcookie "++Cookie++" -pa "++Pa++" "++ RunArg}]), - [N,H] = string:tokens(atom_to_list(NN),"@"), + [N,H] = string:lexemes(atom_to_list(NN),"@"), {ok, Sock} = gen_tcp:accept(LSock), pang = net_adm:ping(NN), {N,H,Sock}. diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index 33d0b708cf..475e03087a 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -1192,9 +1192,9 @@ check_driver_system_info_result(Result) -> io:format("All names: ~p~n", [?EXPECTED_SYSTEM_INFO_NAMES]), io:format("Result: ~p~n", [Result]), {[], Ns, DDVSN} = chk_sis(lists:map(fun (Str) -> - string:tokens(Str, "=") + string:lexemes(Str, "=") end, - string:tokens(Result, " ")), + string:lexemes(Result, " ")), ?EXPECTED_SYSTEM_INFO_NAMES), case {DDVSN, drv_vsn_str2tup(erlang:system_info(driver_version))} of @@ -2438,7 +2438,7 @@ wait_until(Fun) -> end. drv_vsn_str2tup(Str) -> - [Major, Minor] = string:tokens(Str, "."), + [Major, Minor] = string:lexemes(Str, "."), {list_to_integer(Major), list_to_integer(Minor)}. %% Build port data from a template. diff --git a/erts/emulator/test/dump_SUITE.erl b/erts/emulator/test/dump_SUITE.erl new file mode 100644 index 0000000000..38fa198ea6 --- /dev/null +++ b/erts/emulator/test/dump_SUITE.erl @@ -0,0 +1,125 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-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. +%% 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(dump_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +-export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2]). + +-export([signal_abort/1]). + +-export([load/0]). + +-include_lib("kernel/include/file.hrl"). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. + +all() -> + [signal_abort]. + +init_per_testcase(signal_abort, Config) -> + SO = erlang:system_info(schedulers_online), + erts_debug:set_internal_state(available_internal_state, true), + Dump = erts_debug:get_internal_state(scheduler_dump), + erts_debug:set_internal_state(available_internal_state, false), + if SO < 3 -> + {skip, "not enough schedulers"}; + not Dump -> + {skip, "the platform does not support scheduler dump"}; + Dump -> + Config + end. + +end_per_testcase(_, Config) -> + Config. + +%%% +%%% The test cases ------------------------------------------------------------- +%%% + +%% Test that a snapshot is taken of other schedulers using a signal +%% when a crash dump is generated. +signal_abort(Config) -> + + Dump = filename:join(proplists:get_value(priv_dir, Config),"signal_abort.dump"), + + {ok, Node} = start_node(Config), + + _P1 = spawn(Node, ?MODULE, load, []), + _P2 = spawn(Node, ?MODULE, load, []), + _P3 = spawn(Node, ?MODULE, load, []), + _P4 = spawn(Node, ?MODULE, load, []), + _P5 = spawn(Node, ?MODULE, load, []), + _P6 = spawn(Node, ?MODULE, load, []), + + timer:sleep(500), + + true = rpc:call(Node, os, putenv, ["ERL_CRASH_DUMP",Dump]), + rpc:call(Node, erlang, halt, ["dump"]), + + {ok, Bin} = get_dump_when_done(Dump), + + ct:log("~s",[Bin]), + + {match, Matches} = re:run(Bin,"Current Process: <",[global]), + + ct:log("Found ~p",[Matches]), + + true = length(Matches) > 1, + + file:delete(Dump), + + ok. + +get_dump_when_done(Dump) -> + case file:read_file_info(Dump) of + {ok, #file_info{ size = Sz }} -> + get_dump_when_done(Dump, Sz); + {error, enoent} -> + timer:sleep(100), + get_dump_when_done(Dump) + end. + +get_dump_when_done(Dump, Sz) -> + timer:sleep(100), + case file:read_file_info(Dump) of + {ok, #file_info{ size = Sz }} -> + file:read_file(Dump); + {ok, #file_info{ size = NewSz }} -> + get_dump_when_done(Dump, NewSz) + end. + +load() -> + lists:seq(1,10000), + load(). + +start_node(Config) 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}]). diff --git a/erts/emulator/test/exception_SUITE.erl b/erts/emulator/test/exception_SUITE.erl index 0f27251fcb..be9b63d534 100644 --- a/erts/emulator/test/exception_SUITE.erl +++ b/erts/emulator/test/exception_SUITE.erl @@ -31,6 +31,10 @@ -include_lib("common_test/include/ct.hrl"). -import(lists, [foreach/2]). +%% The range analysis of the HiPE compiler results in a system limit error +%% during compilation instead of at runtime, so do not perform this analysis. +-compile([{hipe, [no_icode_range]}]). + suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap, {minutes, 1}}]. diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl index 92ddc23592..08a7b4560c 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -21,7 +21,7 @@ -module(match_spec_SUITE). -export([all/0, suite/0, not_run/1]). --export([test_1/1, test_2/1, test_3/1, bad_match_spec_bin/1, +-export([test_1/1, test_2/1, test_3/1, caller_and_return_to/1, bad_match_spec_bin/1, trace_control_word/1, silent/1, silent_no_ms/1, silent_test/1, ms_trace2/1, ms_trace3/1, ms_trace_dead/1, boxed_and_small/1, destructive_in_test_bif/1, guard_exceptions/1, @@ -47,7 +47,7 @@ suite() -> all() -> case test_server:is_native(match_spec_SUITE) of false -> - [test_1, test_2, test_3, bad_match_spec_bin, + [test_1, test_2, test_3, caller_and_return_to, bad_match_spec_bin, trace_control_word, silent, silent_no_ms, silent_test, ms_trace2, ms_trace3, ms_trace_dead, boxed_and_small, destructive_in_test_bif, guard_exceptions, unary_plus, unary_minus, fpe, @@ -180,6 +180,50 @@ test_3(Config) when is_list(Config) -> collect(P1, [{trace, P1, call, {?MODULE, f2, [a, b]}, [true]}]), ok. +%% Test that caller and return to work as they should +%% There was a bug where caller would be undefined when return_to was set +%% for r the bif erlang:put(). +caller_and_return_to(Config) -> + tr( + fun do_put_wrapper/0, + fun (Tracee) -> + MsgCaller = [{'_',[],[{message,{caller}}]}], + 1 = erlang:trace(Tracee, true, [call,return_to]), + 1 = erlang:trace_pattern( {?MODULE,do_put,1}, MsgCaller, [local]), + 1 = erlang:trace_pattern( {?MODULE,do_the_put,1}, MsgCaller, [local]), + 1 = erlang:trace_pattern( {erlang,integer_to_list,1}, MsgCaller, [local]), + 1 = erlang:trace_pattern( {erlang,put,2}, MsgCaller, [local]), + + [{trace,Tracee,call,{?MODULE,do_put,[test]},{?MODULE,do_put_wrapper,0}}, + {trace,Tracee,call,{?MODULE,do_the_put,[test]},{?MODULE,do_put,1}}, + {trace,Tracee,call,{erlang,integer_to_list,[1]},{?MODULE,do_the_put,1}}, + {trace,Tracee,return_to,{?MODULE,do_the_put,1}}, + {trace,Tracee,call,{erlang,put,[test,"1"]},{?MODULE,do_put,1}}, + {trace,Tracee,return_to,{?MODULE,do_put,1}}, + + %% These last trace messages are a bit strange... + %% if call tracing had been enabled for do_put_wrapper + %% then caller and return_to would have been {?MODULE,do_put_wrapper,1} + %% but since it is not, they are set to do_put instead, but we still + %% get the do_put_wrapper return_to message... + {trace,Tracee,call,{erlang,integer_to_list,[2]},{?MODULE,do_put,1}}, + {trace,Tracee,return_to,{?MODULE,do_put,1}}, + {trace,Tracee,return_to,{?MODULE,do_put_wrapper,0}} + ] + end), + ok. + +do_put_wrapper() -> + do_put(test), + ok. + +do_put(Var) -> + do_the_put(Var), + erlang:integer_to_list(id(2)). +do_the_put(Var) -> + Lst = erlang:integer_to_list(id(1)), + erlang:put(Var, Lst). + otp_9422(Config) when is_list(Config) -> Laps = 10000, Fun1 = fun() -> otp_9422_tracee() end, diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index 1c76eb8019..17555d63c6 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -145,7 +145,7 @@ t_float_to_string(Config) when is_list(Config) -> 123456789012345678.0, [{decimals, 237}])), {'EXIT', {badarg, _}} = (catch float_to_binary( 123456789012345678.0, [{decimals, 237}])), - test_fts("1." ++ string:copies("0", 249) ++ "e+00", + test_fts("1." ++ lists:duplicate(249, $0) ++ "e+00", 1.0, [{scientific, 249}, compact]), X1 = float_to_list(1.0), diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index 730a17d7e8..f29528a22f 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -1662,13 +1662,7 @@ spawn_executable(Config) when is_list(Config) -> [ExactFile2,"hello world","dlrow olleh"] = run_echo_args_2(unicode:characters_to_binary("\""++ExactFile2++"\" "++"\"hello world\" \"dlrow olleh\"")), - ExeExt = - case string:to_lower(lists:last(string:tokens(ExactFile2,"."))) of - "exe" -> - ".exe"; - _ -> - "" - end, + ExeExt = filename:extension(ExactFile2), Executable2 = "spoky name"++ExeExt, file:copy(ExactFile1,filename:join([SpaceDir,Executable2])), ExactFile3 = filename:nativename(filename:join([SpaceDir,Executable2])), @@ -1836,7 +1830,7 @@ collect_data(Port) -> end. parse_echo_args_output(Data) -> - [lists:last(string:tokens(S,"|")) || S <- string:tokens(Data,"\r\n")]. + [lists:last(string:lexemes(S,"|")) || S <- string:lexemes(Data,["\r\n",$\n])]. %% Test that the emulator does not mix up ports when the port table wraps mix_up_ports(Config) when is_list(Config) -> @@ -1962,7 +1956,7 @@ max_ports() -> erlang:system_info(port_limit). port_ix(Port) when is_port(Port) -> - ["#Port",_,PortIxStr] = string:tokens(erlang:port_to_list(Port), + ["#Port",_,PortIxStr] = string:lexemes(erlang:port_to_list(Port), "<.>"), list_to_integer(PortIxStr). diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index 7afb82a1b8..7eebbe8b19 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -894,11 +894,9 @@ adjust_schedulers_online() -> read_affinity(Data) -> Exp = "pid " ++ os:getpid() ++ "'s current affinity mask", - case string:tokens(Data, ":") of + case string:lexemes(Data, ":") of [Exp, DirtyAffinityStr] -> - AffinityStr = string:strip(string:strip(DirtyAffinityStr, - both, $ ), - both, $\n), + AffinityStr = string:trim(DirtyAffinityStr), case catch erlang:list_to_integer(AffinityStr, 16) of Affinity when is_integer(Affinity) -> Affinity; diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl index 56522039da..fdf4aab24d 100644 --- a/erts/emulator/test/system_info_SUITE.erl +++ b/erts/emulator/test/system_info_SUITE.erl @@ -308,9 +308,9 @@ memory_test(_Config) -> mem_workers_call(MWs, fun () -> - list_to_atom("an ugly atom "++integer_to_list(erlang:system_info(scheduler_id))), - list_to_atom("another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))), - list_to_atom("yet another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))) + _ = list_to_atom("an ugly atom "++integer_to_list(erlang:system_info(scheduler_id))), + _ = list_to_atom("another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))), + _ = list_to_atom("yet another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))) end, []), cmp_memory(MWs, "new atoms"), diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl index 72acd33033..a81aa64057 100644 --- a/erts/emulator/test/trace_SUITE.erl +++ b/erts/emulator/test/trace_SUITE.erl @@ -38,7 +38,7 @@ system_monitor_long_gc_1/1, system_monitor_long_gc_2/1, system_monitor_large_heap_1/1, system_monitor_large_heap_2/1, system_monitor_long_schedule/1, - bad_flag/1, trace_delivered/1]). + bad_flag/1, trace_delivered/1, trap_exit_self_receive/1]). -include_lib("common_test/include/ct.hrl"). @@ -61,7 +61,8 @@ all() -> more_system_monitor_args, system_monitor_long_gc_1, system_monitor_long_gc_2, system_monitor_large_heap_1, system_monitor_long_schedule, - system_monitor_large_heap_2, bad_flag, trace_delivered]. + system_monitor_large_heap_2, bad_flag, trace_delivered, + trap_exit_self_receive]. init_per_testcase(_Case, Config) -> [{receiver,spawn(fun receiver/0)}|Config]. @@ -1709,6 +1710,31 @@ trace_delivered(Config) when is_list(Config) -> ok end. +%% This testcase checks that receive trace works on exit signal messages +%% when the sender of the exit signal is the process itself. +trap_exit_self_receive(Config) -> + Parent = self(), + Proc = spawn_link(fun() -> process(Parent) end), + + 1 = erlang:trace(Proc, true, ['receive']), + Proc ! {trap_exit_please, true}, + {trace, Proc, 'receive', {trap_exit_please, true}} = receive_first_trace(), + + %% Make the process call exit(self(), signal) + Reason1 = make_ref(), + Proc ! {exit_signal_please, Reason1}, + {trace, Proc, 'receive', {exit_signal_please, Reason1}} = receive_first_trace(), + {trace, Proc, 'receive', {'EXIT', Proc, Reason1}} = receive_first_trace(), + receive {Proc, {'EXIT', Proc, Reason1}} -> ok end, + receive_nothing(), + + unlink(Proc), + Reason2 = make_ref(), + Proc ! {exit_please, Reason2}, + {trace, Proc, 'receive', {exit_please, Reason2}} = receive_first_trace(), + receive_nothing(), + ok. + drop_trace_until_down(Proc, Mon) -> drop_trace_until_down(Proc, Mon, false, 0, 0). @@ -1791,6 +1817,9 @@ process(Dest) -> process(Dest); {exit_please, Reason} -> exit(Reason); + {exit_signal_please, Reason} -> + exit(self(), Reason), + process(Dest); {trap_exit_please, State} -> process_flag(trap_exit, State), process(Dest); diff --git a/erts/emulator/utils/beam_emu_vars b/erts/emulator/utils/beam_emu_vars new file mode 100755 index 0000000000..c798a4dada --- /dev/null +++ b/erts/emulator/utils/beam_emu_vars @@ -0,0 +1,122 @@ +#!/usr/bin/perl -w +use strict; + +# Analyse beam_emu.s and try to find out the registers +# used for the important variables in process_main(). +# +# Works for .s files from clang or gcc. For gcc, the -fverbose-asm +# option must be used. +# +# Example: +# +# $ beam-emu-vars -vars 'c_p E HTOP FCALLS I reg freg' beam_emu.s +# E: %r13 +# FCALLS: %rcx:98 %rax:88 16(%rsp):50 %rdi:6 +# HTOP: %r10:382 64(%rsp):88 72(%rsp):9 24(%rsp):7 %rcx:6 %r15:6 80(%rsp):3 88(%rsp):2 +# I: %rbx +# c_p: %rbp +# freg: 48(%rsp):11 %rcx:8 %rdi:5 %rax:4 +# reg: %r12 +# +# That means that E, I, c_p, reg seems to be assigned to permanent registers. +# HTOP seems to be assigned %r10, but it is saved to a scratch location +# before any function calls. FCALLS and freg seems to be saved in a location on +# the stack and loaded into a register when used. +# +# The exit status will be 0 if all variables are assigned to registers (most of +# the time), and 1 if one or more variables are assigned to a stack location. + +my $vars = 'c_p E FCALLS freg HTOP I reg'; + +while (@ARGV and $ARGV[0] =~ /^-(.*)/) { + $_ = $1; + shift; + ($vars = shift), next if /^vars/; + die "$0: Bad option: -$_\n"; +} + +my @vars = split(" ", $vars); +my %vars; +@vars{@vars} = @vars; + +my $inside; +my %count; + +if (@ARGV != 1) { + usage(); +} + +while (<>) { + if (!$inside && /[.]globl\s*_?process_main/) { + $inside = 1; + } elsif ($inside && /[.]globl/) { + last; + } + if ($inside) { + if (/##DEBUG_VALUE:\s*process_main:([A-Za-z]*)\s*<-\s*(.*)/) { + # clang + my($var,$reg) = ($1,$2); + next if $reg =~ /^[-\d]+$/; # Ignore if number. + $count{$var}->{$reg}++ if $vars{$var}; + next; + } + + # Parse gcc verbose arguments. Comments are marked with + # one '#' (clang marks its comments with two '#'). + my($src,$dst,$comment) = /movq\s+([^#]+), ([^#]+)#(?!#)\s*(.*)/; + next unless $comment; + $dst =~ s/\s*$//; + my($vsrc,$vdst) = split /,/, $comment, 2; + $vdst =~ s/^\s//; + update_count(\%count, $vsrc, $src); + update_count(\%count, $vdst, $dst); + if ($vars{$vdst} and $vsrc eq '%sfp') { + $count{$vdst}->{$src}++; + } + } +} + +my @first; + +OUTER: +for my $var (sort keys %count) { + my $total = 0; + + foreach my $reg (keys %{$count{$var}}) { + $total += $count{$var}->{$reg}++; + } + + foreach my $reg (keys %{$count{$var}}) { + if ($count{$var}->{$reg} > 0.9*$total) { + print "$var: $reg\n"; + push @first, $var; + next OUTER; + } + } + + my @r; + foreach my $reg (keys %{$count{$var}}) { + push @r, $reg; + } + @r = sort { $count{$var}->{$b} <=> $count{$var}->{$a} } @r; + @r = map { "$_:$count{$var}->{$_}" } @r; + push @first, $r[0]; + print "$var: ", join(' ', @r), "\n"; +} + +foreach (@first) { + exit 1 if /%rsp/; +} +exit 0; + +sub update_count { + my($count_ref,$var,$reg) = @_; + return unless $vars{$var}; + ${${$count_ref}{$var}}{$reg}++; +} + +sub usage { + die qq[usage: beam_emu_vars [ -vars "var1 var2..." ] <filename>.s\n\n] . + "The exit status is 0 if all variables are assigned to registers,\n" . + "and 1 if one or more variables are allocated to a stack location.\n"; +} diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 64a9a49ac8..d7791d23fa 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -24,6 +24,17 @@ use constant COLD => 0; use constant WARM => 1; use constant HOT => 2; +# Instructions for packing +use constant PACK_JUMP => 1; +use constant PACK_IN_INSTR_WORD => 2; +use constant PACK_OPT_IN_INSTR_WORD => 4; + +# Packing commands +use constant PACK_CMD_TIGHTEST => '1'; +use constant PACK_CMD_TIGHT => '2'; +use constant PACK_CMD_LOOSE => '3'; +use constant PACK_CMD_WIDE => '4'; + $BEAM_FORMAT_NUMBER = undef; my $target = \&emulator_output; @@ -32,30 +43,15 @@ my $verbose = 0; my $hotness = 1; my $num_file_opcodes = 0; my $wordsize = 32; -my %defs; # Defines (from command line). +my $code_pointers_are_short = 0; # Whether code pointers (to C code) are short. +my $code_model = 'unknown'; +my %defs; # Defines (from command line). # This is shift counts and mask for the packer. my $WHOLE_WORD = ''; -my @pack_instr; -my @pack_shift; -my @pack_mask; - -$pack_instr[2] = ['6', 'i']; -$pack_instr[3] = ['0', '0', 'i']; -$pack_instr[4] = ['6', '6', '6', 'i']; # Only for 64 bit wordsize - -$pack_shift[2] = ['0', 'BEAM_LOOSE_SHIFT']; -$pack_shift[3] = ['0', 'BEAM_TIGHT_SHIFT', '(2*BEAM_TIGHT_SHIFT)']; -$pack_shift[4] = ['0', 'BEAM_LOOSE_SHIFT', # Only for 64 bit wordsize - '(2*BEAM_LOOSE_SHIFT)', - '(3*BEAM_LOOSE_SHIFT)']; - -$pack_mask[2] = ['BEAM_LOOSE_MASK', $WHOLE_WORD]; -$pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK']; -$pack_mask[4] = ['BEAM_LOOSE_MASK', # Only for 64 bit wordsize - 'BEAM_LOOSE_MASK', - 'BEAM_LOOSE_MASK', - $WHOLE_WORD]; + +my @basic_pack_options = (0); +my @extended_pack_options = @basic_pack_options; # There are two types of instructions: generic and specific. # The generic instructions are those generated by the Beam compiler. @@ -250,6 +246,7 @@ while (@ARGV && $ARGV[0] =~ /^-(.*)/) { ($target = \&compiler_output), next if /^compiler/; ($outdir = shift), next if /^outdir/; ($wordsize = shift), next if /^wordsize/; + ($code_model = shift), next if /^code-model/; ($verbose = 1), next if /^v/; ($defs{$1} = $2), next if /^D(\w+)=(\w+)/; die "$0: Bad option: -$_\n"; @@ -261,14 +258,21 @@ if ($wordsize == 32) { } elsif ($wordsize == 64) { $defs{'ARCH_32'} = 0; $defs{'ARCH_64'} = 1; + $code_pointers_are_short = $code_model eq 'small'; } # -# Initialize number of arguments per packed word. +# Initialize pack options. # if ($wordsize == 64) { - $pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', $WHOLE_WORD]; + @basic_pack_options = (0,PACK_JUMP); + @extended_pack_options = @basic_pack_options; + if ($code_pointers_are_short) { + foreach (@basic_pack_options) { + push @extended_pack_options, $_ | PACK_IN_INSTR_WORD; + } + } } # @@ -450,15 +454,7 @@ while (<>) { # Parse specific instructions (only present in emulator/loader): # Name Arg1 Arg2... # - my($name, @args) = split; - error("too many operands") - if @args > $max_spec_operands; - syntax_check($name, @args); - my $arity = @args; - if (defined $gen_opnum{$name,$arity} and $obsolete[$gen_opnum{$name,$arity}]) { - error("specific instructions may not be specified for obsolete instructions"); - } - save_specific_ops($name, $arity, $hotness, @args); + my($name,$arity) = parse_specific_op($_); if (defined $op_num) { error("specific instructions must not be numbered"); } elsif (!defined($gen_arity{$name}) && !defined($unnumbered{$name,$arity})) { @@ -531,10 +527,9 @@ sub emulator_output { foreach $key (keys %specific_op) { foreach (@{$specific_op{$key}}) { my($name, $hotness, @args) = @$_; - my $sign = join('', @args); my $print_name = print_name($name, @args); - my($size, $code, $pack_spec) = cg_basic($name, @args); + my($size, $code, $pack_spec) = cg_basic(name => $name, args => \@args); if (defined $code) { $code = "OpCase($print_name):\n$code"; push @generated_code, [$hotness,$code,($print_name)]; @@ -602,6 +597,7 @@ sub emulator_output { foreach (@{$specific_op{$key}}) { my($name, $hot, @args) = @{$_}; my($sign) = join('', @args); + $sign =~ s/[?]//g; # The primitive types should sort before other types. @@ -619,6 +615,7 @@ sub emulator_output { my $print_name = $items{$sort_key}; my $info = $spec_op_info{$print_name}; my(@args) = @{$info->{'args'}}; + @args = map { s/[?]$//; $_ } @args; my $arity = @args; # @@ -732,12 +729,19 @@ sub emulator_output { print "#if !defined(ARCH_64)\n"; print qq[ #error "64-bit architecture assumed, but ARCH_64 not defined"\n]; print "#endif\n"; + if ($code_pointers_are_short) { + print "#if !defined(CODE_MODEL_SMALL)\n"; + print qq[ #error "small code model assumed, but CODE_MODEL_SMALL not defined"\n]; + print "#endif\n"; + } print "#define BEAM_WIDE_MASK 0xFFFFFFFFull\n"; print "#define BEAM_LOOSE_MASK 0xFFFFull\n"; print "#define BEAM_TIGHT_MASK 0xFFFFull\n"; + print "#define BEAM_TIGHTEST_MASK 0x3FFull\n"; print "#define BEAM_WIDE_SHIFT 32\n"; print "#define BEAM_LOOSE_SHIFT 16\n"; print "#define BEAM_TIGHT_SHIFT 16\n"; + print "#define BEAM_TIGHTEST_SHIFT 10\n"; } print "\n"; @@ -852,6 +856,7 @@ sub emulator_output { sub print_name { my($name,@args) = @_; my $sign = join '', @args; + $sign =~ s/[?]//g; $sign ne '' ? "${name}_$sign" : $name; } @@ -971,40 +976,54 @@ sub compiler_output { } # -# Check an operation for validity. +# Parse and store a specific operation. # -sub syntax_check { - my($name, @args) = @_; - my($i); +sub parse_specific_op { + my($name, @args) = split " ", shift; + my $arity = @args; + # Check for various errors. error("Bad opcode name '$name'") unless $name =~ /^[a-z][\w\d_]*$/; - for ($i = 0; $i < @args; $i++) { - foreach my $type (split(//, $args[$i])) { + error("too many operands") + if @args > $max_spec_operands; + for (my $i = 0; $i < $arity; $i++) { + my $arg = $args[$i]; + $arg =~ s/[?]$//; + foreach my $type (split(//, $arg)) { error("Argument " . ($i+1) . ": invalid type '$type'") unless defined $arg_size{$type}; } } -} - -sub save_specific_ops { - my($name,$arity,$hot,@args) = @_; - my(@res) = (""); + if (defined $gen_opnum{$name,$arity} and $obsolete[$gen_opnum{$name,$arity}]) { + error("specific instructions may not be specified for obsolete instructions"); + } + # Expand operands with multiple types to multiple instructions. + # (For example, "get_list xy xy xy" will be expanded to six instructions.) + my @res = ([]); foreach my $arg (@args) { - my @new_res = (); + my @old_res = @res; + @res = (); + my $marker = ($arg =~ s/[?]$//) ? '?' : ''; foreach my $type (split(//, $arg)) { - foreach my $args (@res) { - push @new_res, "$args$type"; + foreach my $args_ref (@old_res) { + my @args = @$args_ref; + push @args, "$type$marker"; + push @res, \@args; } } - @res = @new_res; } + + # Store each specific instruction. my $key = "$name/$arity"; - foreach my $args (@res) { - @args = split //, $args; - push @{$specific_op{$key}}, [$name,$hot,@args]; + foreach my $args_ref (@res) { + @args = @$args_ref; + push @{$specific_op{$key}}, [$name,$hotness,@args]; } + + # Done. + ($name,$arity); } sub parse_c_args { @@ -1110,9 +1129,28 @@ sub combine_instruction_group { # Variables. my %offsets; my @instrs; - my %num_references; + my %num_references; # Number of references from other sub instructions. my $group_size = 999; + # + # Calculate the number of references from other sub instructions. + # This number is useful in several ways: + # + # * If this number is 0, it is only used as the entry point for a + # function, implying that it does not need a label and that operands + # can be packed into the instruction word. + # + # * We'll use this number in the sort key, as a tie breaker for sub instructions + # at the same instruction offset. + # + foreach my $ref_instr (@in_instrs) { + my(undef,undef,$first_sub,@other_subs) = @$ref_instr; + $num_references{$first_sub} += 0; # Make sure it is defined. + foreach my $sub (@other_subs) { + $num_references{$sub}++; + } + } + # Do basic error checking. Associate operands of instructions # with the correct micro instructions. Calculate offsets for micro # instructions. @@ -1138,12 +1176,13 @@ sub combine_instruction_group { foreach (0..$#c_args) { push @first, shift @rest; } - my $size = cg_combined_size($s, 1, @first); + my $size = cg_combined_size(name => $s, + first => $num_references{$s} == 0, + args => \@first); $offsets{$s} = $offset unless defined $offsets{$s} and $offsets{$s} < $offset; $offset += $size - 1; my $label = micro_label($s); - $num_references{$label} = 0; push @new_subs, [$opcase,$label,$s,$size-1,@first]; $opcase = ''; } @@ -1162,9 +1201,8 @@ sub combine_instruction_group { my($opcase,$label,$s,$size,@args) = @{$subs[$i]}; my $next = ''; (undef,$next) = @{$subs[$i+1]} if $i < $#subs; - $num_references{$next}++ if $next; my $instr_info = "$opcase:$label:$next:$s:$size:@args"; - push @all_instrs, [$label,$offsets{$s},$instr_info]; + push @all_instrs, [$label,$s,$offsets{$s},$instr_info]; } } @@ -1172,8 +1210,8 @@ sub combine_instruction_group { my %label_to_offset; my %order_to_offset; foreach my $instr (@all_instrs) { - my($label,$offset,$instr_info) = @$instr; - my $sort_key = sprintf("%02d.%02d", $offset, $num_references{$label}); + my($label,$s,$offset,$instr_info) = @$instr; + my $sort_key = sprintf("%02d.%02d", $offset, $num_references{$s}); push @{$order_to_instrs{$sort_key}}, $instr_info; $label_to_offset{$label} = $offset; $order_to_offset{$sort_key} = $offset; @@ -1212,7 +1250,7 @@ sub combine_instruction_group { $gcode .= "OpCase($opcase):\n"; push @opcase_labels, $opcase; } - if ($num_references{$label}) { + if ($num_references{$s}) { $gcode .= "$label:\n"; } @@ -1229,8 +1267,13 @@ sub combine_instruction_group { } my($gen_code,$down,$up) = - cg_combined_code($s, 1, $flags, $offset, - $group_size-$offset, $inc, @first); + cg_combined_code(name => $s, + first => $num_references{$s} == 0, + extra_comments => $flags, + offset => $offset, + comp_size => $group_size-$offset, + inc => $inc, + args =>\@first); my $spec_label = "$opcase$label"; $down{$spec_label} = $down; $up{$spec_label} = $up; @@ -1279,8 +1322,8 @@ sub micro_label { # sub cg_basic { - my($name,@args) = @_; - my($size,$code,$pack_spec) = code_gen($name, 1, '', 0, undef, undef, @args); + my %params = (@_, pack_options => \@extended_pack_options); + my($size,$code,$pack_spec) = code_gen(%params); $pack_spec = build_pack_spec($pack_spec); ($size,$code,$pack_spec); } @@ -1290,8 +1333,10 @@ sub cg_basic { # sub cg_combined_size { - my($name,$pack,@args) = @_; - my($size) = code_gen($name, $pack, '', 0, undef, undef, @args); + my %params = (@_, pack_options => \@basic_pack_options); + $params{pack_options} = \@extended_pack_options + if $params{first}; + my($size) = code_gen(%params); $size; } @@ -1300,8 +1345,10 @@ sub cg_combined_size { # sub cg_combined_code { - my($name,$pack,$extra_comments,$offset,$comp_size,$inc,@args) = @_; - my($size,$code,$pack_spec) = code_gen(@_); + my %params = (@_, pack_options => \@basic_pack_options); + $params{pack_options} = \@extended_pack_options + if $params{first}; + my($size,$code,$pack_spec) = code_gen(%params); if ($pack_spec eq '') { ($code,'',''); } else { @@ -1311,8 +1358,16 @@ sub cg_combined_code { } sub code_gen { - my($name,$pack,$extra_comments,$offset,$comp_size,$inc,@args) = @_; - my $group_size = defined $comp_size ? $comp_size + $inc : undef; + my %params = (extra_comments => '', + offset => 0, + inc => 0, + @_); + my $name = $params{name}; + my $extra_comments = $params{extra_comments}; + my $offset = $params{offset}; + my $inc = $params{inc}; + my @args = @{$params{args}}; + my $size = 0; my $flags = ''; my @f; @@ -1326,8 +1381,9 @@ sub code_gen { # my $c_code_ref = $c_code{$name}; - if ($pack and defined $c_code_ref and $name ne 'catch') { - ($var_decls, $pack_spec, @args) = do_pack($offset, @args); + if (defined $c_code_ref and $name ne 'catch') { + my $pack_options = $params{pack_options}; + ($var_decls, $pack_spec, @args) = do_pack($name, $offset, $pack_options, @args); } # @@ -1337,6 +1393,7 @@ sub code_gen { my $need_block = 0; my $arg_offset = $offset; + @args = map { s/[?]$//g; $_ } @args; foreach (@args) { my($this_size) = $arg_size{$_}; SWITCH: @@ -1399,7 +1456,7 @@ sub code_gen { return ($size+1, undef, ''); } - $group_size = $size unless defined $group_size; + my $group_size = ($params{comp_size} || $size) + $inc; # # Generate main body of the implementation. @@ -1418,7 +1475,7 @@ sub code_gen { $bindings{$var} = $f[$i]; } $bindings{'NEXT_INSTRUCTION'} = "I+" . ($group_size+$offset+1); - $bindings{'IP_ADJUSTMENT'} = defined $inc ? $inc : 0; + $bindings{'IP_ADJUSTMENT'} = $inc; $c_code = eval { expand_all($c_code, \%bindings) }; unless (defined $c_code) { warn $@; @@ -1441,10 +1498,10 @@ sub code_gen { "ASSERT(VALID_INSTR(*I));\n" . "Goto(*I);"; } else { - $var_decls .= "BeamInstr next_pf = I[$instr_offset];\n"; + $var_decls .= "BeamInstr next_pf = BeamCodeAddr(I[$instr_offset]);\n"; $dispatch_next = "\nI += $instr_offset;\n" . "ASSERT(VALID_INSTR(next_pf));\n" . - "Goto(next_pf);"; + "GotoPF(next_pf);"; } # @@ -1603,9 +1660,51 @@ sub needs_do_wrapper { } sub do_pack { - my($offset,@args) = @_; + my($name,$offset,$pack_opts_ref,@args) = @_; + my @pack_opts = @$pack_opts_ref; + my $opt_arg_pos = -1; + + # Look for an optional use operand not as the first argument. + if (@args and $args[0] !~ /[?]$/) { + for (my $pos = 0; $pos < @args; $pos++) { + if ($args[$pos] =~ /[?]$/) { + $opt_arg_pos = $pos; + last; + } + } + } + + @args = map { s/[?]$//; $_ } @args; # Remove any optional use marker. + + # If there is an optional operand, extend the array of pack options. + if ($opt_arg_pos >= 0) { + my @new_pack_opts = grep { $_ & PACK_IN_INSTR_WORD } @pack_opts; + @new_pack_opts = map { + ($_ & ~ PACK_IN_INSTR_WORD) | PACK_OPT_IN_INSTR_WORD; + } @new_pack_opts; + push @pack_opts, @new_pack_opts; + } + + my $ret = ['', ':', @args]; + my $score = 0; + + foreach my $options (@pack_opts) { + my $this_opt_arg_pos = ($options & PACK_OPT_IN_INSTR_WORD) ? $opt_arg_pos : -1; + my($this_score,$this_result) = + do_pack_one($name, $options, $this_opt_arg_pos, $offset, @args); + if ($this_score > $score) { + $ret = $this_result; + $score = $this_score; + } + } + return @$ret; +} + +sub do_pack_one { + my($name,$options,$opt_arg_pos,$offset,@args) = @_; my($packable_args) = 0; my @bits_needed; # Bits needed for each argument. + my $pack_in_iw = $options & PACK_IN_INSTR_WORD; # # Define the minimum number of bits needed for the packable argument types. @@ -1619,6 +1718,10 @@ sub do_pack { 't' => 16); if ($wordsize == 64) { $bits_needed{'I'} = 32; + if ($options & PACK_JUMP) { + $bits_needed{'f'} = 32; + $bits_needed{'j'} = 32; + } } # @@ -1631,51 +1734,48 @@ sub do_pack { } else { push @bits_needed, 0; } - } - - # - # Try to pack 'f' and 'j', but not at expense at worse packing - # for other operands. For example, given the arguments "f x x", we - # want the 'x' operands to be packed, not 'f' and 'x' packed and - # the final 'x' not packed. - # - - if ($wordsize == 64 and $packable_args == 1) { - for (my $i = 0; $i < @args; $i++) { - if ($args[$i] =~ /^[fj]$/) { - $bits_needed[$i] = 32; - $packable_args++; - last; - } + if ($arg =~ /^[fj]$/) { + # Only pack the first occurrence of 'f' or 'j'. + delete $bits_needed{'f'}; + delete $bits_needed{'j'}; } } # - # Nothing to pack unless there are at least 2 packable arguments. + # Return if there is nothing to pack. # - return ('', ':', @args) if $packable_args < 2; + if ($packable_args == 0) { + return (-1); + } elsif ($packable_args == 1 and $options == 0) { + return (-1); + } # # Determine how many arguments we should pack into each word. # my @args_per_word; my @need_wide_mask; - my $bits = 0; - my $word = 0; - $args_per_word[0] = 0; - $need_wide_mask[0] = 0; - for (my $i = 0; $i < @args; $i++) { - if ($bits_needed[$i]) { - my $needed = $bits_needed[$i]; - - my $next_word = sub { - $word++; - $args_per_word[$word] = 0; - $need_wide_mask[$word] = 0; - $bits = 0; - }; + my $bits; + my $this_wordsize; + my $word = -1; + + my $next_word = sub { + $word++; + $args_per_word[$word] = 0; + $need_wide_mask[$word] = 0; + $bits = 0; + $this_wordsize = $wordsize; + }; + + $next_word->(); + $this_wordsize = 32 if $pack_in_iw; + for (my $arg_num = 0; $arg_num < @args; $arg_num++) { + my $needed = $bits_needed[$arg_num]; + + next unless $needed; + next if $arg_num == $opt_arg_pos; - if ($bits+$needed > $wordsize) { # Does not fit. + if ($bits+$needed > $this_wordsize) { # Does not fit. $next_word->(); } if ($args_per_word[$word] == 4) { # Can't handle more than 4 args. @@ -1695,15 +1795,16 @@ sub do_pack { # Can only pack two things in a word where one # item is 32 bits. Force the next item into # the next word. - $bits = $wordsize; + $bits = $this_wordsize; } - } } # # Try to balance packing between words. # - if ($args_per_word[$#args_per_word] == 1) { + if (@args_per_word == 1 and $args_per_word[0] == 1 and $pack_in_iw) { + # Don't rebalance. + } elsif ($args_per_word[$#args_per_word] == 1) { if ($args_per_word[$#args_per_word-1] < 3) { pop @args_per_word; } else { @@ -1728,12 +1829,19 @@ sub do_pack { # beginning). my $up = ''; # Pack commands (storing back while # moving forward). + my $arg_num = 0; # Number of argument. - # Skip an unpackable argument. + # Skip an unpackable argument. Also handle packing of + # an single operand into the instruction word. my $skip_unpackable = sub { my($arg) = @_; - if ($arg_size{$arg}) { + if ($arg_num == $opt_arg_pos) { + my $pack = chr(ord('#') + $arg_num); + $down = PACK_CMD_WIDE . "$pack$down"; + my $unpack = "BeamExtraData(I[0])"; + $args[$arg_num] = "packed:$arg:0:${arg}b($unpack)"; + } elsif ($arg_size{$arg}) { # Save the argument on the pack engine's stack. my $push = 'g'; if ($type_bit{$arg} & $type_bit{'q'}) { @@ -1753,43 +1861,50 @@ sub do_pack { # the packing engine works from right-to-left, but we must generate # the instructions from left-to-right because we must calculate # instruction sizes from left-to-right. - - my $arg_num = 0; for (my $word = 0; $word < @args_per_word; $word++) { my $ap = 0; # Argument number within word. my $packed_var = "tmp_packed" . ($word+1); my $args_per_word = $args_per_word[$word]; - my @shift; - my @mask; - my @instr; - - if ($need_wide_mask[$word]) { - @shift = ('0', 'BEAM_WIDE_SHIFT'); - @mask = ('BEAM_WIDE_MASK', $WHOLE_WORD); - @instr = ('w', 'w'); - } else { - @shift = @{$pack_shift[$args_per_word]}; - @mask = @{$pack_mask[$args_per_word]}; - @instr = @{$pack_instr[$args_per_word]}; - } + my $pack_word_size = ($pack_in_iw && $word == 0) ? 32 : $wordsize; + + my($shref,$mref,$iref,$unpack_suffix) = + get_pack_parameters($name, $args_per_word, $pack_word_size, + $need_wide_mask[$word]); + my @shift = @$shref; + my @mask = @$mref; + my @instr = @$iref; while ($ap < $args_per_word) { my $reg = $args[$arg_num]; my $this_size = $arg_size{$reg}; + if ($bits_needed[$arg_num]) { $this_size = 0; if ($ap == 0) { - $pack_prefix .= "Eterm $packed_var = " . - arg_offset($size+$offset) . ";\n"; - $up .= "p"; - $down = "P$down"; - $this_size = 1; + my $packed_data; + if ($pack_in_iw and $word == 0) { + $packed_data = "BeamExtraData(I[0])"; + if ($args_per_word == 1) { + $packed_var = $packed_data; + } else { + $pack_prefix .= "Eterm $packed_var = $packed_data;\n"; + } + my $pack = chr(ord('#') + $size); + $down = "$pack$down"; + } else { + $packed_data = arg_offset($size + $offset); + $pack_prefix .= "Eterm $packed_var = $packed_data;\n"; + $down = "P$down"; + $up .= "p"; + $this_size = 1; + } } $down = "$instr[$ap]$down"; my $unpack = make_unpack($packed_var, $shift[$ap], $mask[$ap]); - $args[$arg_num] = "packed:$reg:$this_size:$reg" . "b($unpack)"; + my $macro = "$reg$unpack_suffix"; + $args[$arg_num] = "packed:$reg:$this_size:$macro($unpack)"; $ap++; } else { @@ -1804,12 +1919,107 @@ sub do_pack { # Skip any unpackable arguments at the end. # while ($arg_num < @args) { - $skip_unpackable->($args[$arg_num]); + my $arg = $args[$arg_num]; + $skip_unpackable->($arg); + $size += $arg_size{$arg}; $arg_num++; } my $pack_spec = "$down:$up"; - return ($pack_prefix, $pack_spec, @args); + my $score = pack_score($options, @args); + + return ($score, [$pack_prefix,$pack_spec,@args]); +} + +sub get_pack_parameters { + my($name,$args_per_word,$pack_word_size,$wide_mask) = @_; + my(@shift,@mask,@instr); + my $unpack_suffix = 'b'; + + if ($wide_mask and $args_per_word > 1) { + @shift = ('0', 'BEAM_WIDE_SHIFT'); + @mask = ('BEAM_WIDE_MASK', $WHOLE_WORD); + @instr = (PACK_CMD_WIDE) x 2; + } elsif ($args_per_word == 1) { + @shift = ('0'); + @mask = ($WHOLE_WORD); + @instr = (PACK_CMD_WIDE); + } elsif ($args_per_word == 2) { + if ($pack_word_size != $wordsize) { + # 64-bit word size, pack 32 bits into instruction word. + @shift = ('0', 'BEAM_TIGHT_SHIFT'); + @mask = ('BEAM_TIGHT_MASK', $WHOLE_WORD); + @instr = (PACK_CMD_TIGHT) x 2; + } else { + # 32/64 bit word size + @shift = ('0', 'BEAM_LOOSE_SHIFT'); + @mask = ('BEAM_LOOSE_MASK', $WHOLE_WORD); + @instr = (PACK_CMD_LOOSE) x 2; + } + } elsif ($args_per_word == 3) { + if ($pack_word_size != $wordsize) { + # 64-bit word size, pack 3 register numbers into instruction word. + @shift = ('0', 'BEAM_TIGHTEST_SHIFT', '(2*BEAM_TIGHTEST_SHIFT)'); + @mask = ('BEAM_TIGHTEST_MASK', 'BEAM_TIGHTEST_MASK', $WHOLE_WORD); + @instr = (PACK_CMD_TIGHTEST) x 3; + $unpack_suffix = ''; + } else { + # 32/64 bit word size. + @shift = ('0', 'BEAM_TIGHT_SHIFT', '(2*BEAM_TIGHT_SHIFT)'); + if ($wordsize == 32) { + @mask = ('BEAM_TIGHT_MASK') x 3; + } elsif ($wordsize == 64) { + @mask = ('BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', $WHOLE_WORD); + } + @instr = (PACK_CMD_TIGHT) x 3; + } + } elsif ($args_per_word == 4) { + # 64 bit word size only. + @shift = ('0', + 'BEAM_LOOSE_SHIFT', + '(2*BEAM_LOOSE_SHIFT)', + '(3*BEAM_LOOSE_SHIFT)'); + @mask = ('BEAM_LOOSE_MASK', 'BEAM_LOOSE_MASK', + 'BEAM_LOOSE_MASK', $WHOLE_WORD); + @instr = (PACK_CMD_LOOSE) x 4; + } + + unless (@shift) { + error("$name: internal packing error: args_per_word=$args_per_word, " . + "pack_word_size=$pack_word_size"); + } + + (\@shift,\@mask,\@instr,$unpack_suffix); +} + +sub pack_score { + my($options,@args) = @_; + my $size = 0; + + # Calculate the number of words. + foreach (@args) { + if (/^packed:[^:]*:(\d+)/) { + $size += $1; + } else { + $size += $arg_size{$_} + } + } + + # Less numbers of words give a higher score; for the same number of + # words, using PACK_JUMP or PACK_IN_INSTR_WORD gives a lower score. + my $score = 1 + 10*($max_spec_operands - $size); + if (($options & PACK_OPT_IN_INSTR_WORD) != 0) { + $score += 4; + } elsif ($options == PACK_IN_INSTR_WORD) { + $score += 0; + } elsif ($options == PACK_JUMP) { + $score += 1; + } elsif ($options == (PACK_JUMP|PACK_IN_INSTR_WORD)) { + $score += 2; + } elsif ($options == 0) { + $score += 3; + } + $score; } sub make_unpack { diff --git a/erts/etc/common/dialyzer.c b/erts/etc/common/dialyzer.c index 0e74eb065b..b45d5c7ca7 100644 --- a/erts/etc/common/dialyzer.c +++ b/erts/etc/common/dialyzer.c @@ -255,7 +255,7 @@ int main(int argc, char** argv) } PUSH("+B"); - PUSH2("-boot", "start_clean"); + PUSH2("-boot", "no_dot_erlang"); PUSH3("-run", "dialyzer", "plain_cl"); PUSH("-extra"); diff --git a/erts/etc/common/erlc.c b/erts/etc/common/erlc.c index 8cfd98bcc4..aa99c69100 100644 --- a/erts/etc/common/erlc.c +++ b/erts/etc/common/erlc.c @@ -234,7 +234,7 @@ int main(int argc, char** argv) PUSH("+A0"); PUSH("-noinput"); PUSH2("-mode", "minimal"); - PUSH2("-boot", "start_clean"); + PUSH2("-boot", "no_dot_erlang"); PUSH3("-s", "erl_compile", "compile_cmdline"); PUSH("-extra"); diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index d61a3cbf95..08e326b33b 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -31,6 +31,7 @@ #ifdef __WIN32__ # include "erl_version.h" # include "init_file.h" +# include <Shlobj.h> #endif #define NO 0 @@ -1531,17 +1532,16 @@ static void get_parameters(int argc, char** argv) static void get_home(void) { - int len; - char tmpstr[MAX_PATH+1]; + wchar_t *profile; char* homedrive; char* homepath; homedrive = get_env("HOMEDRIVE"); homepath = get_env("HOMEPATH"); if (!homedrive || !homepath) { - if (len = GetWindowsDirectory(tmpstr,MAX_PATH)) { - home = emalloc(len+1); - strcpy(home,tmpstr); + if (SHGetKnownFolderPath(&FOLDERID_Profile, 0, NULL, &profile) == S_OK) { + home = utf16_to_utf8(profile); + /* CoTaskMemFree(profile); */ } else error("HOMEDRIVE or HOMEPATH is not set and GetWindowsDir failed"); } else { diff --git a/erts/etc/common/escript.c b/erts/etc/common/escript.c index 8241675200..d739d21f12 100644 --- a/erts/etc/common/escript.c +++ b/erts/etc/common/escript.c @@ -521,7 +521,7 @@ main(int argc, char** argv) free_env_val(env); PUSH("+B"); - PUSH2("-boot", "start_clean"); + PUSH2("-boot", "no_dot_erlang"); PUSH("-noshell"); /* diff --git a/erts/etc/common/typer.c b/erts/etc/common/typer.c index b64cbb4a92..f13135d883 100644 --- a/erts/etc/common/typer.c +++ b/erts/etc/common/typer.c @@ -177,7 +177,7 @@ main(int argc, char** argv) } PUSH("+B"); - PUSH2("-boot", "start_clean"); + PUSH2("-boot", "no_dot_erlang"); PUSH3("-run", "typer", "start"); PUSH("-extra"); diff --git a/erts/etc/unix/cerl.src b/erts/etc/unix/cerl.src index 8d5882cf32..9dd8d85abe 100644 --- a/erts/etc/unix/cerl.src +++ b/erts/etc/unix/cerl.src @@ -45,6 +45,8 @@ # -valgrind Run emulator compiled for valgrind # -lcnt Run emulator compiled for lock counting # -icount Run emulator compiled for instruction counting +# -rr Run emulator under "rr record" +# Can be combined with compile targets (like -debug) except valgrind. # -nox Unset the DISPLAY variable to disable us of X Windows # # FIXME For GDB you can also set the break point using "-break FUNCTION". @@ -84,6 +86,8 @@ GDBARGS= TYPE= debug= run_valgrind=no +run_rr=no +skip_erlexec=no # Default rootdir ROOTDIR=%SRC_ROOTDIR% @@ -225,6 +229,13 @@ while [ $# -gt 0 ]; do cargs="$cargs -valgrind" TYPE=.valgrind run_valgrind=yes + skip_erlexec=yes + ;; + "-rr") + shift + cargs="$cargs -rr" + run_rr=yes + skip_erlexec=yes ;; *) break @@ -246,7 +257,19 @@ PROGNAME="$PROGNAME$cargs" EMU="$EMU$TYPE" EMU_NAME=`$EXEC -emu_name_exit $eeargs` -if [ $run_valgrind != yes ]; then +if [ $skip_erlexec = yes ]; then + emu_xargs=`echo $xargs | sed "s|+|-|g"` + beam_args=`$EXEC -emu_args_exit ${1+"$@"}` + + # Prepare for some argument passing voodoo: + # $beam_args is a list of command line arguments separated by newlines. + # Make "$@" represent those arguments verbatim (including spaces and quotes). + SAVE_IFS="$IFS" + IFS=' +' + set -- $beam_args + IFS="$SAVE_IFS" +else xargs="$xargs -pz $PRELOADED --" fi if [ "x$GDB" = "x" ]; then @@ -254,7 +277,6 @@ if [ "x$GDB" = "x" ]; then valversion=`valgrind --version` valmajor=`echo $valversion | sed 's,[a-z]*\-\([0-9]*\).*,\1,'` valminor=`echo $valversion | sed 's,[a-z]*\-[0-9]*.\([0-9]*\).*,\1,'` - emu_xargs=`echo $xargs | sed "s|+|-|g"` if [ "x$VALGRIND_LOG_XML" = "x" ]; then valgrind_xml= log_file_prefix="--log-file=" @@ -294,17 +316,10 @@ if [ "x$GDB" = "x" ]; then sched_arg= fi - beam_args=`$EXEC -emu_args_exit ${1+"$@"}` - - # Time for some argument passing voodoo: - # $beam_args is a list of command line arguments separated by newlines. - # Make "$@" represent those arguments verbatim (including spaces and quotes). - SAVE_IFS="$IFS" - IFS=' -' - set -- $beam_args - IFS="$SAVE_IFS" exec $taskset1 valgrind $valgrind_xml $valgrind_log $valgrind_misc_flags $BINDIR/$EMU_NAME $sched_arg $emu_xargs "$@" -pz $PRELOADED + + elif [ $run_rr = yes ]; then + exec rr record --ignore-nested $BINDIR/$EMU_NAME $emu_xargs "$@" -pz $PRELOADED else exec $EXEC $eeargs $xargs ${1+"$@"} fi diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex e258ff5480..181a718287 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index d43fdc454c..f743b7d26b 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -2110,7 +2110,7 @@ nodes(_Arg) -> | stream | {line, L :: non_neg_integer()} | {cd, Dir :: string() | binary()} - | {env, Env :: [{Name :: string(), Val :: string() | false}]} + | {env, Env :: [{Name :: os:env_var_name(), Val :: os:env_var_value() | false}]} | {args, [string() | binary()]} | {arg0, string() | binary()} | exit_status @@ -2344,7 +2344,8 @@ spawn_opt(_Tuple) -> MSAcc_Thread :: #{ type := MSAcc_Thread_Type, id := MSAcc_Thread_Id, counters := MSAcc_Counters}, - MSAcc_Thread_Type :: scheduler | async | aux, + MSAcc_Thread_Type :: async | aux | dirty_io_scheduler + | dirty_cpu_scheduler | poll | scheduler, MSAcc_Thread_Id :: non_neg_integer(), MSAcc_Counters :: #{ MSAcc_Thread_State => non_neg_integer() }, MSAcc_Thread_State :: alloc | aux | bif | busy_wait | check_io | diff --git a/erts/preloaded/src/erts.app.src b/erts/preloaded/src/erts.app.src index beb29a7c89..e2ab8686d2 100644 --- a/erts/preloaded/src/erts.app.src +++ b/erts/preloaded/src/erts.app.src @@ -37,7 +37,7 @@ {registered, []}, {applications, []}, {env, []}, - {runtime_dependencies, ["stdlib-3.4.3", "kernel-5.4.1", "sasl-3.0.1"]} + {runtime_dependencies, ["stdlib-3.5", "kernel-6.0", "sasl-3.0.1"]} ]}. %% vim: ft=erlang diff --git a/erts/start_scripts/Makefile b/erts/start_scripts/Makefile index 20fea99016..e730422ed8 100644 --- a/erts/start_scripts/Makefile +++ b/erts/start_scripts/Makefile @@ -171,7 +171,6 @@ $(ERL_TOP)/bin/no_dot_erlang.script: $(ERLC) $(SCRIPT_PATH) +no_warn_sasl +otp_build +no_dot_erlang -o $@ $(SS_ROOT)/no_dot_erlang.rel ) ## Special target used from system/build/Makefile for source code release bootstrap. -## Add no_dot_erlang after next release bootstrap_scripts: $(SS_ROOT)/start_clean.rel $(V_at)$(INSTALL_DIR) $(TESTROOT)/bin $(V_at)$(INSTALL_DIR) $(SS_TMP) @@ -181,6 +180,10 @@ bootstrap_scripts: $(SS_ROOT)/start_clean.rel $(V_at)( cd $(SS_TMP) && \ $(ERLC) $(BOOTSTRAP_SCRIPT_PATH) +otp_build +no_module_tests \ -o $(TESTROOT)/bin/start_clean.script $(SS_ROOT)/start_clean.rel ) + $(V_at)( cd $(SS_TMP) && \ + $(ERLC) $(BOOTSTRAP_SCRIPT_PATH) +otp_build +no_module_tests \ + -o $(TESTROOT)/bin/no_dot_erlang.script $(SS_ROOT)/no_dot_erlang.rel ) + clean: $(V_at)$(RM) $(REL_SCRIPTS) $(INSTALL_SCRIPTS) diff --git a/erts/vsn.mk b/erts/vsn.mk index 1c6472a0ab..3d7ff2db66 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% # -VSN = 9.1.1 +VSN = 9.1.2 # Port number 4365 in 4.2 # Port number 4366 in 4.3 |