diff options
Diffstat (limited to 'erts')
71 files changed, 2319 insertions, 1025 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/erlang.xml b/erts/doc/src/erlang.xml index 0a2852b895..b40aae5d28 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -440,6 +440,16 @@ Z = erlang:adler32_combine(X,Y,iolist_size(Data2)).</code> <seealso marker="#binary_to_atom/2"><c>binary_to_atom/2</c></seealso>, but the atom must exist.</p> <p>Failure: <c>badarg</c> if the atom does not exist.</p> + <note> + <p>Note that the compiler may optimize away atoms. For + example, the compiler will rewrite + <c>atom_to_list(some_atom)</c> to <c>"some_atom"</c>. If + that expression is the only mention of the atom + <c>some_atom</c> in the containing module, the atom will not + be created when the module is loaded, and a subsequent call + to <c>binary_to_existing_atom(<<"some_atom">>, utf8)</c> + will fail.</p> + </note> </desc> </func> @@ -2621,6 +2631,15 @@ os_prompt%</pre> but only if there already exists such atom.</p> <p>Failure: <c>badarg</c> if there does not already exist an atom whose text representation is <c><anno>String</anno></c>.</p> + <note> + <p>Note that the compiler may optimize away atoms. For + example, the compiler will rewrite + <c>atom_to_list(some_atom)</c> to <c>"some_atom"</c>. If + that expression is the only mention of the atom + <c>some_atom</c> in the containing module, the atom will not + be created when the module is loaded, and a subsequent call + to <c>list_to_existing_atom("some_atom")</c> will fail.</p> + </note> </desc> </func> @@ -3807,6 +3826,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 @@ -3821,7 +3846,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> 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 10b963a4e8..ff3c798179 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -31,6 +31,225 @@ </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> + <list> + <item> + <p>The new zlib module returned a data_error when + inflating concatenated streams, which was incompatible + with the old module's behavior of returning the + uncompressed data up to the end of the first stream.</p> + <p> + Own Id: OTP-14648</p> + </item> + <item> + <p>zlib:gunzip/1 will no longer stop at the end of the + first stream when decompressing concatenated gzip + files.</p> + <p> + Own Id: OTP-14649</p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 9.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Changed <c>erlang:apply/2</c> to raise a <c>badarg</c> + exception if the second argument is not a proper list. + Previous behavior was a misleading <c>undef</c> + exception.</p> + <p> + Own Id: OTP-14490 Aux Id: ERL-432 </p> + </item> + <item> + <p>On macOS, <c>crypto</c> would crash if <c>observer</c> + had been started before <c>crypto</c>. On the beta for + macOS 10.13 (High Sierra), <c>crypto</c> would crash. + Both of those bugs have been fixed.</p> + <p> + Own Id: OTP-14499 Aux Id: ERL-251 ERL-439 </p> + </item> + <item> + <p> + Fixed bug in enif_whereis_pid/port that could cause heap + corruption in rare cases.</p> + <p> + Own Id: OTP-14523</p> + </item> + <item> + <p> + Fix so that trace messages generated when in a dirty nif + are flushed correctly when the dirty nif is done + executing.</p> + <p> + Own Id: OTP-14538</p> + </item> + <item> + <p> + Fix escape code handling when using ANSI color codes in + the shell.</p> + <p> + Own Id: OTP-14549 Aux Id: PR1536 </p> + </item> + <item> + <p> + Upgraded the ERTS internal PCRE library from version 8.40 + to version 8.41. See <url + href="http://pcre.org/original/changelog.txt">http://pcre.org/original/changelog.txt</url> + for information about changes made to PCRE. This library + implements major parts of the <seealso + marker="stdlib:re"><c>re</c></seealso> regular + expressions module.</p> + <p> + Own Id: OTP-14574</p> + </item> + <item> + <p> + Fixed a bug causing <c>statistics(runtime)</c> to produce + negative values and a bug in + <c>statistics(wall_clock)</c> causing it to produce + values one second too long.</p> + <p> + <c>statistics(runtime)</c> now also use + <c>getrusage()</c> as source when available preventing + the returned value from wrapping as frequent as before.</p> + <p> + Own Id: OTP-14597 Aux Id: ERL-465 </p> + </item> + <item> + <p> + Fixed small memory leak that could occur when sending to + a terminating port.</p> + <p> + Own Id: OTP-14609</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>A warning that the compiler may optimize away atoms + have been added to the documentation of + <c>list_to_existing_atom/1</c> and + <c>binary_to_existing_atom/2</c>.</p> + <p> + Own Id: OTP-14614 Aux Id: ERL-453 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p>Lock counting can now be fully toggled at runtime in + the lock counting emulator (<c>-emu_type lcnt</c>). + Everything is enabled by default to match the old + behavior, but specific categories can be toggled at will + with minimal runtime overhead when disabled. Refer to the + documentation on <c>lcnt:rt_mask/1</c> for details.</p> + <p> + Own Id: OTP-13170</p> + </item> + <item> + <p>The <c>zlib</c> module has been refactored and all its + operations will now yield appropriately, allowing them to + be used freely in concurrent applications.</p> <p>The + following functions have been deprecated, but will not + produce compiler warnings until OTP 21: + <c>zlib:adler32</c>, <c>zlib:crc32</c>, + <c>zlib:inflateChunk</c>, <c>zlib:getBufSize</c>, + <c>zlib:setBufSize</c>.</p> <p>The behavior of throwing + an error when a dictionary is required for decompression + has also been deprecated. Refer to the documentation on + <c>inflateSetDictionary/2</c> for details.</p> + <p> + Own Id: OTP-14185</p> + </item> + <item> + <p><c>lcnt:collect</c> and <c>lcnt:clear</c> will no + longer block all other threads in the runtime system.</p> + <p> + Own Id: OTP-14412</p> + </item> + <item> + <p>Add <c>erlang:iolist_to_iovec/1</c>, which converts an + iolist() to an erlang:iovec(), which suitable for use + with <c>enif_inspect_iovec</c>.</p> + <p> + Own Id: OTP-14520</p> + </item> + <item> + <p>When provided with bad arguments, the <c>zlib</c> + module will now raise named exceptions instead of just + <c>badarg</c>. For example, <c>not_initialized</c> when + using <c>zlib:inflate/2</c> with an uninitialized + stream.</p> + <p> + Own Id: OTP-14527</p> + </item> + <item> + <p> + <c>erlang:halt/2</c> allows any Unicode string as slogan + for the crash dump.</p> + <p> + Own Id: OTP-14553</p> + </item> + <item> + <p>Add new nif API functions for managing an I/O Queue. + The added functions are:</p> <list type="bulleted"> + <item><seealso marker="erl_nif#enif_ioq_create"> + <c>enif_ioq_create()</c></seealso></item> <item><seealso + marker="erl_nif#enif_ioq_destroy"> + <c>enif_ioq_destroy()</c></seealso></item> <item><seealso + marker="erl_nif#enif_ioq_enq_binary"> + <c>enif_ioq_enq_binary()</c></seealso></item> + <item><seealso marker="erl_nif#enif_ioq_enqv"> + <c>enif_ioq_enqv()</c></seealso></item> <item><seealso + marker="erl_nif#enif_ioq_deq"> + <c>enif_ioq_deq()</c></seealso></item> <item><seealso + marker="erl_nif#enif_ioq_peek"> + <c>enif_ioq_peek()</c></seealso></item> <item><seealso + marker="erl_nif#enif_inspect_iovec"> + <c>enif_inspect_iovec()</c></seealso></item> + <item><seealso marker="erl_nif#enif_free_iovec"> + <c>enif_free_iovec()</c></seealso></item> </list> + <p> + Own Id: OTP-14598</p> + </item> + </list> + </section> + +</section> + <section><title>Erts 9.0.5</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -781,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 3069c5cb34..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 $@ @@ -1175,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/arith_instrs.tab b/erts/emulator/beam/arith_instrs.tab index 7c9cd47e28..b828e86788 100644 --- a/erts/emulator/beam/arith_instrs.tab +++ b/erts/emulator/beam/arith_instrs.tab @@ -51,8 +51,7 @@ plus.fetch(Op1, Op2) { plus.execute(Fail, Live, Dst) { if (ERTS_LIKELY(is_both_small(PlusOp1, PlusOp2))) { Sint i = signed_val(PlusOp1) + signed_val(PlusOp2); - ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); - if (ERTS_LIKELY(MY_IS_SSMALL(i))) { + if (ERTS_LIKELY(IS_SSMALL(i))) { $Dst = make_small(i); $NEXT0(); } @@ -74,8 +73,7 @@ minus.fetch(Op1, Op2) { minus.execute(Fail, Live, Dst) { if (ERTS_LIKELY(is_both_small(MinusOp1, MinusOp2))) { Sint i = signed_val(MinusOp1) - signed_val(MinusOp2); - ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); - if (ERTS_LIKELY(MY_IS_SSMALL(i))) { + if (ERTS_LIKELY(IS_SSMALL(i))) { $Dst = make_small(i); $NEXT0(); } @@ -87,9 +85,6 @@ i_increment := increment.fetch.execute; increment.head() { Eterm increment_reg_val; - Eterm increment_val; - Uint live; - Eterm result; } increment.fetch(Src) { @@ -97,11 +92,13 @@ increment.fetch(Src) { } increment.execute(IncrementVal, Live, Dst) { - increment_val = $IncrementVal; + Eterm increment_val = $IncrementVal; + Uint live; + Eterm result; + if (ERTS_LIKELY(is_small(increment_reg_val))) { Sint i = signed_val(increment_reg_val) + increment_val; - ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); - if (ERTS_LIKELY(MY_IS_SSMALL(i))) { + if (ERTS_LIKELY(IS_SSMALL(i))) { $Dst = make_small(i); $NEXT0(); } @@ -142,7 +139,7 @@ i_int_div(Fail, Live, Op1, Op2, Dst) { $BIF_ERROR_ARITY_2($Fail, BIF_intdiv_2, op1, op2); } else if (ERTS_LIKELY(is_both_small(op1, op2))) { Sint ires = signed_val(op1) / signed_val(op2); - if (ERTS_LIKELY(MY_IS_SSMALL(ires))) { + if (ERTS_LIKELY(IS_SSMALL(ires))) { $Dst = make_small(ires); $NEXT0(); } @@ -369,10 +366,10 @@ shift.execute(Fail, Live, Dst) { reg[0] = Op1; reg[1] = Op2; SWAPOUT; - if (I[0] == (BeamInstr) OpCode(i_bsl_ssjtd)) { + if (IsOpCode(I[0], i_bsl_ssjtd)) { I = handle_error(c_p, I, reg, &bif_export[BIF_bsl_2]->info.mfa); } else { - ASSERT(I[0] == (BeamInstr) OpCode(i_bsr_ssjtd)); + ASSERT(IsOpCode(I[0], i_bsr_ssjtd)); I = handle_error(c_p, I, reg, &bif_export[BIF_bsr_2]->info.mfa); } goto post_error_handling; diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 7f8dc42aca..00822d1415 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -259,7 +259,7 @@ struct m { Binary* code; Eterm module; Module* modp; - Uint exception; + Eterm exception; }; static Eterm staging_epilogue(Process* c_p, int, Eterm res, int, struct m*, int, int); @@ -278,7 +278,7 @@ exception_list(Process* p, Eterm tag, struct m* mp, Sint exceptions) Eterm res = NIL; while (exceptions > 0) { - if (mp->exception) { + if (is_value(mp->exception)) { res = CONS(hp, mp->module, res); hp += 2; exceptions--; @@ -379,9 +379,9 @@ finish_loading_1(BIF_ALIST_1) exceptions = 0; for (i = 0; i < n; i++) { - p[i].exception = 0; + p[i].exception = THE_NON_VALUE; if (p[i].modp->seen) { - p[i].exception = 1; + p[i].exception = am_duplicated; exceptions++; } p[i].modp->seen = 1; @@ -415,9 +415,9 @@ finish_loading_1(BIF_ALIST_1) exceptions = 0; for (i = 0; i < n; i++) { - p[i].exception = 0; + p[i].exception = THE_NON_VALUE; if (p[i].modp->curr.code_hdr && p[i].modp->old.code_hdr) { - p[i].exception = 1; + p[i].exception = am_not_purged; exceptions++; } } @@ -438,7 +438,7 @@ finish_loading_1(BIF_ALIST_1) retval = erts_finish_loading(p[i].code, BIF_P, 0, &mod); ASSERT(retval == NIL || retval == am_on_load); if (retval == am_on_load) { - p[i].exception = 1; + p[i].exception = am_on_load; exceptions++; } } @@ -469,7 +469,8 @@ staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking, erts_commit_staging_code_ix(); for (i=0; i < nmods; i++) { - if (mods[i].modp->curr.code_hdr) { + if (mods[i].modp->curr.code_hdr + && mods[i].exception != am_on_load) { set_default_trace_pattern(mods[i].module); } #ifdef HIPE @@ -686,6 +687,7 @@ BIF_RETTYPE delete_module_1(BIF_ALIST_1) Eterm retval; mod.module = BIF_ARG_1; mod.modp = modp; + mod.exception = THE_NON_VALUE; retval = staging_epilogue(BIF_P, success, res, is_blocking, &mod, 1, 0); return retval; } @@ -821,11 +823,11 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) ep->beam[1] = 0; } else { if (ep->addressv[code_ix] == ep->beam && - ep->beam[0] == (BeamInstr) em_apply_bif) { + BeamIsOpCode(ep->beam[0], op_apply_bif)) { continue; } - ep->addressv[code_ix] = ep->beam; - ep->beam[0] = (BeamInstr) em_call_error_handler; + ep->addressv[code_ix] = ep->beam; + ep->beam[0] = BeamOpCodeAddr(op_call_error_handler); } } modp->curr.code_hdr->on_load_function_ptr = NULL; @@ -847,7 +849,7 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) if (ep == NULL || ep->info.mfa.module != BIF_ARG_1) { continue; } - if (ep->beam[0] == (BeamInstr) em_apply_bif) { + if (BeamIsOpCode(ep->beam[0], op_apply_bif)) { continue; } ep->beam[1] = 0; @@ -1764,22 +1766,23 @@ delete_code(Module* modp) Export *ep = export_list(i, code_ix); if (ep != NULL && (ep->info.mfa.module == module)) { if (ep->addressv[code_ix] == ep->beam) { - if (ep->beam[0] == (BeamInstr) em_apply_bif) { + if (BeamIsOpCode(ep->beam[0], op_apply_bif)) { continue; } - else if (ep->beam[0] == - (BeamInstr) BeamOp(op_i_generic_breakpoint)) { + else if (BeamIsOpCode(ep->beam[0], op_i_generic_breakpoint)) { ERTS_LC_ASSERT(erts_thr_progress_is_blocking()); ASSERT(modp->curr.num_traced_exports > 0); DBG_TRACE_MFA_P(&ep->info.mfa, "export trace cleared, code_ix=%d", code_ix); erts_clear_export_break(modp, &ep->info); } - else ASSERT(ep->beam[0] == (BeamInstr) em_call_error_handler - || !erts_initialized); - } + else { + ASSERT(BeamIsOpCode(ep->beam[0], op_call_error_handler) || + !erts_initialized); + } + } ep->addressv[code_ix] = ep->beam; - ep->beam[0] = (BeamInstr) em_call_error_handler; + ep->beam[0] = BeamOpCodeAddr(op_call_error_handler); ep->beam[1] = 0; DBG_TRACE_MFA_P(&ep->info.mfa, "export invalidation, code_ix=%d", code_ix); diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 49ec59c989..fe1e15701b 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -203,7 +203,7 @@ erts_bp_match_functions(BpFunctions* f, ErtsCodeMFA *mfa, int specified) for (fi = 0; fi < num_functions; fi++) { ci = code_hdr->functions[fi]; - ASSERT(ci->op == (BeamInstr) BeamOp(op_i_func_info_IaaI)); + ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI)); if (erts_is_function_native(ci)) { continue; } @@ -265,11 +265,11 @@ erts_bp_match_export(BpFunctions* f, ErtsCodeMFA *mfa, int specified) pc = ep->beam; if (ep->addressv[code_ix] == pc) { - if ((*pc == (BeamInstr) em_apply_bif || - *pc == (BeamInstr) em_call_error_handler)) { - continue; + if (BeamIsOpCode(*pc, op_apply_bif) || + BeamIsOpCode(*pc, op_call_error_handler)) { + continue; } - ASSERT(*pc == (BeamInstr) BeamOp(op_i_generic_breakpoint)); + ASSERT(BeamIsOpCode(*pc, op_i_generic_breakpoint)); } else if (erts_is_function_native(erts_code_to_codeinfo(ep->addressv[code_ix]))) { continue; } @@ -366,8 +366,8 @@ consolidate_bp_data(Module* modp, ErtsCodeInfo *ci, int local) } ASSERT(modp->curr.num_breakpoints >= 0); ASSERT(modp->curr.num_traced_exports >= 0); - ASSERT(*erts_codeinfo_to_code(ci) != - (BeamInstr) BeamOp(op_i_generic_breakpoint)); + ASSERT(! BeamIsOpCode(*erts_codeinfo_to_code(ci), + op_i_generic_breakpoint)); } ci->u.gen_bp = NULL; Free(g); @@ -415,13 +415,15 @@ erts_install_breakpoints(BpFunctions* f) { Uint i; Uint n = f->matched; - BeamInstr br = (BeamInstr) BeamOp(op_i_generic_breakpoint); + BeamInstr br = BeamOpCodeAddr(op_i_generic_breakpoint); 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++; } } @@ -460,7 +467,7 @@ static void uninstall_breakpoint(ErtsCodeInfo *ci) { BeamInstr *pc = erts_codeinfo_to_code(ci); - if (*pc == (BeamInstr) BeamOp(op_i_generic_breakpoint)) { + if (BeamIsOpCode(*pc, op_i_generic_breakpoint)) { GenericBp* g = ci->u.gen_bp; if (g->data[erts_active_bp_ix()].flags == 0) { /* @@ -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) { @@ -642,7 +692,7 @@ erts_generic_breakpoint(Process* c_p, ErtsCodeInfo *info, Eterm* reg) Uint bp_flags; ErtsBpIndex ix = erts_active_bp_ix(); - ASSERT(info->op == (BeamInstr) BeamOp(op_i_func_info_IaaI)); + ASSERT(BeamIsOpCode(info->op, op_i_func_info_IaaI)); g = info->u.gen_bp; bp = &g->data[ix]; @@ -695,9 +745,9 @@ erts_generic_breakpoint(Process* c_p, ErtsCodeInfo *info, Eterm* reg) Eterm w; erts_trace_time_call(c_p, info, bp->time); w = (BeamInstr) *c_p->cp; - if (! (w == (BeamInstr) BeamOp(op_i_return_time_trace) || - w == (BeamInstr) BeamOp(op_return_trace) || - w == (BeamInstr) BeamOp(op_i_return_to_trace)) ) { + if (! (BeamIsOpCode(w, op_i_return_time_trace) || + BeamIsOpCode(w, op_return_trace) || + BeamIsOpCode(w, op_i_return_to_trace)) ) { Eterm* E = c_p->stop; ASSERT(c_p->htop <= E && E <= c_p->hend); if (E - 2 < c_p->htop) { @@ -717,7 +767,7 @@ erts_generic_breakpoint(Process* c_p, ErtsCodeInfo *info, Eterm* reg) } if (bp_flags & ERTS_BPF_DEBUG) { - return (BeamInstr) BeamOp(op_i_debug_breakpoint); + return BeamOpCodeAddr(op_i_debug_breakpoint); } else { return g->orig_instr; } @@ -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 (w == (BeamInstr) BeamOp(op_return_trace)) { - cpp = &E[2]; - } else if (w == (BeamInstr) BeamOp(op_i_return_to_trace)) { - return_to_trace = 1; - cpp = &E[0]; - } else if (w == (BeamInstr) BeamOp(op_i_return_time_trace)) { - cpp = &E[0]; - } else { - cpp = NULL; - } - if (cpp) { - for (;;) { - BeamInstr w = *cp_val(*cpp); - if (w == (BeamInstr) BeamOp(op_return_trace)) { - cpp += 3; - } else if (w == (BeamInstr) BeamOp(op_i_return_to_trace)) { - return_to_trace = 1; - cpp += 1; - } else if (w == (BeamInstr) BeamOp(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) { @@ -1293,7 +1315,7 @@ erts_find_local_func(ErtsCodeMFA *mfa) { n = (BeamInstr) code_hdr->num_functions; for (i = 0; i < n; ++i) { ci = code_hdr->functions[i]; - ASSERT(((BeamInstr) BeamOp(op_i_func_info_IaaI)) == ci->op); + ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI)); ASSERT(mfa->module == ci->mfa.module || is_nil(ci->mfa.module)); if (mfa->function == ci->mfa.function && mfa->arity == ci->mfa.arity) { @@ -1708,7 +1730,7 @@ check_break(ErtsCodeInfo *ci, Uint break_flags) { GenericBp* g = ci->u.gen_bp; - ASSERT(ci->op == (BeamInstr) BeamOp(op_i_func_info_IaaI)); + ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI)); if (erts_is_function_native(ci)) { return 0; } diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index 4e91bfffe8..70078c8c59 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -199,9 +199,9 @@ void debug_dump_code(BeamInstr *I, int num) erts_print(ERTS_PRINT_DSBUF, (void *) dsbufp, HEXF ": ", code_ptr); instr = (BeamInstr) code_ptr[0]; for (i = 0; i < NUM_SPECIFIC_OPS; i++) { - if (instr == (BeamInstr) BeamOp(i) && opc[i].name[0] != '\0') { + 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; } } @@ -319,9 +319,9 @@ erts_debug_disassemble_1(BIF_ALIST_1) erts_print(ERTS_PRINT_DSBUF, (void *) dsbufp, HEXF ": ", code_ptr); instr = (BeamInstr) code_ptr[0]; for (i = 0; i < NUM_SPECIFIC_OPS; i++) { - if (instr == (BeamInstr) BeamOp(i) && opc[i].name[0] != '\0') { + 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; @@ -629,13 +641,20 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) unpacked = ap; ap = addr + size; + + /* + * In the code below, never use ap[-1], ap[-2], ... + * (will not work if the arguments have been packed). + * + * Instead use unpacked[-1], unpacked[-2], ... + */ switch (op) { case op_i_select_val_lins_xfI: case op_i_select_val_lins_yfI: case op_i_select_val_bins_xfI: case op_i_select_val_bins_yfI: { - int n = ap[-1]; + int n = unpacked[-1]; int ix = n; Sint32* jump_tab = (Sint32 *)(ap + n); @@ -656,7 +675,7 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) case op_i_select_tuple_arity_xfI: case op_i_select_tuple_arity_yfI: { - int n = ap[-1]; + int n = unpacked[-1]; int ix = n - 1; /* without sentinel */ Sint32* jump_tab = (Sint32 *)(ap + n); @@ -698,7 +717,7 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) case op_i_jump_on_val_xfIW: case op_i_jump_on_val_yfIW: { - int n = ap[-2]; + int n = unpacked[-2]; Sint32* jump_tab = (Sint32 *) ap; size += (n+1) / 2; @@ -712,7 +731,7 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) case op_i_jump_on_val_zero_xfI: case op_i_jump_on_val_zero_yfI: { - int n = ap[-1]; + int n = unpacked[-1]; Sint32* jump_tab = (Sint32 *) ap; size += (n+1) / 2; @@ -737,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]); @@ -758,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]); @@ -781,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 81c4417b1e..aa94fbf536 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -50,15 +50,16 @@ #if defined(NO_JUMP_TABLE) # define OpCase(OpCode) case op_##OpCode # define CountCase(OpCode) case op_count_##OpCode -# define OpCode(OpCode) ((Uint*)op_##OpCode) -# define Goto(Rel) {Go = (int)(UWord)(Rel); goto emulator_loop;} -# define LabelAddr(Addr) &&##Addr +# 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 Goto(Rel) goto *((void *)Rel) -# define LabelAddr(Label) &&Label -# define OpCode(OpCode) (&&lb_##OpCode) +# 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 @@ -107,6 +108,8 @@ do { \ # define CHECK_ARGS(T) #endif +#define CHECK_ALIGNED(Dst) ASSERT((((Uint)&Dst) & (sizeof(Uint)-1)) == 0) + #define GET_BIF_MODULE(p) (p->info.mfa.module) #define GET_BIF_FUNCTION(p) (p->info.mfa.function) #define GET_BIF_ARITY(p) (p->info.mfa.arity) @@ -130,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) \ @@ -159,11 +162,6 @@ BeamInstr beam_apply[2]; BeamInstr beam_exit[1]; BeamInstr beam_continue_exit[1]; -BeamInstr* em_call_error_handler; -BeamInstr* em_apply_bif; -BeamInstr* em_call_nif; -BeamInstr* em_call_bif_e; - /* NOTE These should be the only variables containing trace instructions. ** Sometimes tests are form the instruction value, and sometimes @@ -238,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 @@ -255,8 +256,8 @@ void** beam_ops; #define DispatchMacro() \ do { \ - BeamInstr* dis_next; \ - dis_next = (BeamInstr *) *I; \ + BeamInstr dis_next; \ + dis_next = *I; \ CHECK_ARGS(I); \ if (FCALLS > 0 || FCALLS > neg_o_reds) { \ FCALLS--; \ @@ -264,12 +265,12 @@ void** beam_ops; } else { \ goto context_switch; \ } \ - } while (0) + } while (0) \ #define DispatchMacroFun() \ do { \ - BeamInstr* dis_next; \ - dis_next = (BeamInstr *) *I; \ + BeamInstr dis_next; \ + dis_next = *I; \ CHECK_ARGS(I); \ if (FCALLS > 0 || FCALLS > neg_o_reds) { \ FCALLS--; \ @@ -279,23 +280,23 @@ void** beam_ops; } \ } while (0) -#define DispatchMacrox() \ - do { \ - if (FCALLS > 0) { \ - Eterm* dis_next; \ - SET_I(((Export *) Arg(0))->addressv[erts_active_code_ix()]); \ - dis_next = (Eterm *) *I; \ - FCALLS--; \ - CHECK_ARGS(I); \ - Goto(dis_next); \ - } else if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p) \ - && FCALLS > neg_o_reds) { \ - goto save_calls1; \ - } else { \ - SET_I(((Export *) Arg(0))->addressv[erts_active_code_ix()]); \ - CHECK_ARGS(I); \ - goto context_switch; \ - } \ +#define DispatchMacrox() \ + do { \ + if (FCALLS > 0) { \ + BeamInstr dis_next; \ + SET_I(((Export *) Arg(0))->addressv[erts_active_code_ix()]); \ + dis_next = *I; \ + FCALLS--; \ + CHECK_ARGS(I); \ + Goto(dis_next); \ + } else if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p) \ + && FCALLS > neg_o_reds) { \ + goto save_calls1; \ + } else { \ + SET_I(((Export *) Arg(0))->addressv[erts_active_code_ix()]); \ + CHECK_ARGS(I); \ + goto context_switch; \ + } \ } while (0) #ifdef DEBUG @@ -382,6 +383,7 @@ do { \ * The following functions are called directly by process_main(). * Don't inline them. */ +static void init_emulator_finish(void) NOINLINE; static ErtsCodeMFA *ubif2mfa(void* uf) NOINLINE; static ErtsCodeMFA *gcbif2mfa(void* gcf) NOINLINE; static BeamInstr* handle_error(Process* c_p, BeamInstr* pc, @@ -627,7 +629,7 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array) #ifndef NO_JUMP_TABLE static void* opcodes[] = { DEFINE_OPCODES }; #else - int Go; + register BeamInstr Go; #endif #endif @@ -703,7 +705,7 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array) { int reds; Eterm* argp; - BeamInstr *next; + BeamInstr next; int i; argp = c_p->arg_reg; @@ -735,7 +737,7 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array) ERTS_DBG_CHK_REDS(c_p, FCALLS); - next = (BeamInstr *) *I; + next = *I; SWAPIN; ASSERT(VALID_INSTR(next)); @@ -963,9 +965,6 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array) init_emulator: { - int i; - Export* ep; - #ifndef NO_JUMP_TABLE #ifdef ERTS_OPCODE_COUNTER_SUPPORT #ifdef DEBUG @@ -977,35 +976,8 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array) beam_ops = opcodes; #endif /* ERTS_OPCODE_COUNTER_SUPPORT */ #endif /* NO_JUMP_TABLE */ - - em_call_error_handler = OpCode(call_error_handler); - em_apply_bif = OpCode(apply_bif); - em_call_nif = OpCode(call_nif); - em_call_bif_e = OpCode(call_bif_e); - - beam_apply[0] = (BeamInstr) OpCode(i_apply); - beam_apply[1] = (BeamInstr) OpCode(normal_exit); - beam_exit[0] = (BeamInstr) OpCode(error_action_code); - beam_continue_exit[0] = (BeamInstr) OpCode(continue_exit); - beam_return_to_trace[0] = (BeamInstr) OpCode(i_return_to_trace); - beam_return_trace[0] = (BeamInstr) OpCode(return_trace); - beam_exception_trace[0] = (BeamInstr) OpCode(return_trace); /* UGLY */ - beam_return_time_trace[0] = (BeamInstr) OpCode(i_return_time_trace); - - /* - * Enter all BIFs into the export table. - */ - for (i = 0; i < BIF_SIZE; i++) { - ep = erts_export_put(bif_table[i].module, - bif_table[i].name, - bif_table[i].arity); - bif_export[i] = ep; - ep->beam[0] = (BeamInstr) OpCode(apply_bif); - ep->beam[1] = (BeamInstr) bif_table[i].f; - /* XXX: set func info for bifs */ - ep->info.op = (BeamInstr) BeamOp(op_i_func_info_IaaI); - } + init_emulator_finish(); return; } #ifdef NO_JUMP_TABLE @@ -1017,19 +989,65 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array) save_calls1: { - Eterm* dis_next; + BeamInstr dis_next; save_calls(c_p, (Export *) Arg(0)); SET_I(((Export *) Arg(0))->addressv[erts_active_code_ix()]); - dis_next = (Eterm *) *I; + dis_next = *I; FCALLS--; Goto(dis_next); } } /* + * One-time initialization of emulator. Does not need to be + * in process_main(). + */ +static void +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); + beam_continue_exit[0] = BeamOpCodeAddr(op_continue_exit); + beam_return_to_trace[0] = BeamOpCodeAddr(op_i_return_to_trace); + beam_return_trace[0] = BeamOpCodeAddr(op_return_trace); + beam_exception_trace[0] = BeamOpCodeAddr(op_return_trace); /* UGLY */ + beam_return_time_trace[0] = BeamOpCodeAddr(op_i_return_time_trace); + + /* + * Enter all BIFs into the export table. + */ + for (i = 0; i < BIF_SIZE; i++) { + ep = erts_export_put(bif_table[i].module, + bif_table[i].name, + bif_table[i].arity); + bif_export[i] = ep; + ep->beam[0] = BeamOpCodeAddr(op_apply_bif); + ep->beam[1] = (BeamInstr) bif_table[i].f; + /* XXX: set func info for bifs */ + ep->info.op = BeamOpCodeAddr(op_i_func_info_IaaI); + } +} + +/* * erts_dirty_process_main() is what dirty schedulers execute. Since they handle * only NIF calls they do not need to be able to execute all BEAM * instructions. @@ -1250,12 +1268,12 @@ void erts_dirty_process_main(ErtsSchedulerData *esdp) ERTS_UNREQ_PROC_MAIN_LOCK(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - if (em_apply_bif == (BeamInstr *) *I) { + if (BeamIsOpCode(*I, op_apply_bif)) { exiting = erts_call_dirty_bif(esdp, c_p, I, reg); } else { - ASSERT(em_call_nif == (BeamInstr *) *I); - exiting = erts_call_dirty_nif(esdp, c_p, I, reg); + ASSERT(BeamIsOpCode(*I, op_call_nif)); + exiting = erts_call_dirty_nif(esdp, c_p, I, reg); } ASSERT(!(c_p->flags & F_HIBERNATE_SCHED)); @@ -2090,8 +2108,8 @@ apply_bif_error_adjustment(Process *p, Export *ep, * and apply_last_IP. */ if (I - && ep->beam[0] == (BeamInstr) em_apply_bif - && (ep == bif_export[BIF_error_1] + && BeamIsOpCode(ep->beam[0], op_apply_bif) + && (ep == bif_export[BIF_error_1] || ep == bif_export[BIF_error_2] || ep == bif_export[BIF_exit_1] || ep == bif_export[BIF_throw_1])) { @@ -3197,8 +3215,8 @@ erts_is_builtin(Eterm Mod, Eterm Name, int arity) if ((ep = export_get(&e)) == NULL) { return 0; } - return ep->addressv[erts_active_code_ix()] == ep->beam - && (ep->beam[0] == (BeamInstr) em_apply_bif); + return ep->addressv[erts_active_code_ix()] == ep->beam && + BeamIsOpCode(ep->beam[0], op_apply_bif); } diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 3f9dc2c1aa..00dd28b26c 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -55,12 +55,6 @@ ErlDrvBinary* erts_gzinflate_buffer(char*, int); #define DEFINED 1 #define EXPORTED 2 -#ifdef NO_JUMP_TABLE -# define BeamOpCode(Op) ((BeamInstr)(Op)) -#else -# define BeamOpCode(Op) ((BeamInstr)beam_ops[Op]) -#endif - #if defined(WORDS_BIGENDIAN) # define NATIVE_ENDIAN(F) \ if ((F).val & BSF_NATIVE) { \ @@ -849,10 +843,9 @@ erts_finish_loading(Binary* magic, Process* c_p, continue; } if (ep->addressv[code_ix] == ep->beam) { - if (ep->beam[0] == (BeamInstr) em_apply_bif) { + if (BeamIsOpCode(ep->beam[0], op_apply_bif)) { continue; - } else if (ep->beam[0] == - (BeamInstr) BeamOp(op_i_generic_breakpoint)) { + } else if (BeamIsOpCode(ep->beam[0], op_i_generic_breakpoint)) { ERTS_LC_ASSERT(erts_thr_progress_is_blocking()); ASSERT(mod_tab_p->curr.num_traced_exports > 0); erts_clear_export_break(mod_tab_p, &ep->info); @@ -1482,7 +1475,7 @@ load_import_table(LoaderState* stp) * the BIF function. */ if ((e = erts_active_export_entry(mod, func, arity)) != NULL) { - if (e->beam[0] == (BeamInstr) em_apply_bif) { + if (BeamIsOpCode(e->beam[0], op_apply_bif)) { stp->import[i].bf = (BifFunction) e->beam[1]; if (func == am_load_nif && mod == am_erlang && arity == 2) { stp->may_load_nif = 1; @@ -1576,7 +1569,7 @@ is_bif(Eterm mod, Eterm func, unsigned arity) if (e == NULL) { return 0; } - if (e->beam[0] != (BeamInstr) em_apply_bif) { + if (! BeamIsOpCode(e->beam[0], op_apply_bif)) { return 0; } if (mod == am_erlang && func == am_apply && arity == 3) { @@ -2323,7 +2316,7 @@ load_code(LoaderState* stp) stp->specific_op = specific; CodeNeed(opc[stp->specific_op].sz+16); /* Extra margin for packing */ last_instr_start = ci + opc[stp->specific_op].adjust; - code[ci++] = BeamOpCode(stp->specific_op); + code[ci++] = BeamOpCodeAddr(stp->specific_op); } /* @@ -2585,23 +2578,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]; @@ -2643,18 +2644,41 @@ load_code(LoaderState* stp) } ci++; break; - case 'P': /* Put packed operands. */ + case 'P': /* Put packed operands (on the stack). */ sp->instr = packed; sp->patch_pos = 0; - sp++; - packed = 0; if (packed_label) { - packed_label->pos = ci; + sp->patch_pos = &packed_label->pos; packed_label = 0; } + 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? */ @@ -5079,7 +5103,7 @@ final_touch(LoaderState* stp, struct erl_module_instance* inst_p) while (index != 0) { BeamInstr next = codev[index]; BeamInstr* abs_addr; - codev[index] = BeamOpCode(op_catch_yf); + codev[index] = BeamOpCodeAddr(op_catch_yf); /* We must make the address of the label absolute again. */ abs_addr = (BeamInstr *)codev + index + codev[index+2]; catches = beam_catches_cons(abs_addr, catches); @@ -6033,9 +6057,9 @@ int erts_is_function_native(ErtsCodeInfo *ci) { #ifdef HIPE - ASSERT(ci->op == (BeamInstr) BeamOp(op_i_func_info_IaaI)); - return erts_codeinfo_to_code(ci)[0] == (BeamInstr) BeamOp(op_hipe_trap_call) - || erts_codeinfo_to_code(ci)[0] == (BeamInstr) BeamOp(op_hipe_trap_call_closure); + ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI)); + return BeamIsOpCode(erts_codeinfo_to_code(ci)[0], op_hipe_trap_call) || + BeamIsOpCode(erts_codeinfo_to_code(ci)[0], op_hipe_trap_call_closure); #else return 0; #endif @@ -6104,7 +6128,7 @@ exported_from_module(Process* p, /* Process whose heap to use. */ Eterm tuple; if (ep->addressv[code_ix] == ep->beam && - ep->beam[0] == (BeamInstr) em_call_error_handler) { + BeamIsOpCode(ep->beam[0], op_call_error_handler)) { /* There is a call to the function, but it does not exist. */ continue; } @@ -6375,7 +6399,7 @@ make_stub(ErtsCodeInfo* info, Eterm mod, Eterm func, Uint arity, Uint native, Be { DBG_TRACE_MFA(mod,func,arity,"make beam stub at %p", erts_codeinfo_to_code(info)); ASSERT(WORDS_PER_FUNCTION == 6); - info->op = (BeamInstr) BeamOp(op_i_func_info_IaaI); + info->op = BeamOpCodeAddr(op_i_func_info_IaaI); info->u.ncallee = (void (*)(void)) native; info->mfa.module = mod; info->mfa.function = func; @@ -6480,7 +6504,7 @@ stub_final_touch(LoaderState* stp, ErtsCodeInfo* ci) for (i = 0, lp = stp->lambdas; i < n; i++, lp++) { ErlFunEntry* fe = stp->lambdas[i].fe; if (lp->function == ci->mfa.function && lp->arity == ci->mfa.arity) { - *erts_codeinfo_to_code(ci) = (Eterm) BeamOpCode(op_hipe_trap_call_closure); + *erts_codeinfo_to_code(ci) = BeamOpCodeAddr(op_hipe_trap_call_closure); fe->address = erts_codeinfo_to_code(ci); } } @@ -6804,7 +6828,7 @@ erts_make_stub_module(Process* p, Eterm hipe_magic_bin, Eterm Beam, Eterm Info) * as the body until we know what kind of trap we should put there. */ code_hdr->functions[i] = (ErtsCodeInfo*)fp; - op = (Eterm) BeamOpCode(op_hipe_trap_call); /* Might be changed later. */ + op = BeamOpCodeAddr(op_hipe_trap_call); /* Might be changed later. */ fp = make_stub((ErtsCodeInfo*)fp, hipe_stp->module, func, arity, (Uint)native_address, op); } @@ -6814,7 +6838,7 @@ erts_make_stub_module(Process* p, Eterm hipe_magic_bin, Eterm Beam, Eterm Info) */ code_hdr->functions[i] = (ErtsCodeInfo*)fp; - *fp++ = (BeamInstr) BeamOp(op_int_code_end); + *fp++ = BeamOpCodeAddr(op_int_code_end); /* * Copy attributes and compilation information. diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h index c4a90d3f3a..156c3c45e2 100644 --- a/erts/emulator/beam/beam_load.h +++ b/erts/emulator/beam/beam_load.h @@ -37,11 +37,6 @@ typedef struct gen_op_entry { extern const GenOpEntry gen_opc[]; -extern BeamInstr beam_debug_apply[]; -extern BeamInstr* em_call_error_handler; -extern BeamInstr* em_apply_bif; -extern BeamInstr* em_call_nif; - struct ErtsLiteralArea_; /* diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 80f391e91e..ad555bb195 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -5031,7 +5031,7 @@ void erts_init_trap_export(Export* ep, Eterm m, Eterm f, Uint a, ep->info.mfa.module = m; ep->info.mfa.function = f; ep->info.mfa.arity = a; - ep->beam[0] = (BeamInstr) em_apply_bif; + ep->beam[0] = BeamOpCodeAddr(op_apply_bif); ep->beam[1] = (BeamInstr) bif; } @@ -5096,7 +5096,7 @@ schedule(Process *c_p, Process *dirty_shadow_proc, { ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(c_p)); (void) erts_nif_export_schedule(c_p, dirty_shadow_proc, - mfa, pc, (BeamInstr) em_apply_bif, + mfa, pc, BeamOpCodeAddr(op_apply_bif), dfunc, ifunc, module, function, argc, argv); @@ -5145,7 +5145,6 @@ static BIF_RETTYPE dirty_bif_exception(BIF_ALIST_2) } -extern BeamInstr* em_call_bif_e; static BIF_RETTYPE call_bif(Process *c_p, Eterm *reg, BeamInstr *I); BIF_RETTYPE @@ -5218,13 +5217,13 @@ erts_schedule_bif(Process *proc, mfa = &exp->info.mfa; } #endif - else if (em_call_bif_e == (BeamInstr *) *i) { + else if (BeamIsOpCode(*i, op_call_bif_e)) { /* Pointer to bif export in i+1 */ exp = (Export *) i[1]; pc = i; mfa = &exp->info.mfa; } - else if (em_apply_bif == (BeamInstr *) *i) { + else if (BeamIsOpCode(*i, op_apply_bif)) { /* Pointer to bif in i+1, and mfa in i-3 */ pc = c_p->cp; mfa = erts_code_to_codemfa(i); diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index 48efce20e7..7556205063 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -70,7 +70,20 @@ typedef Uint dsize_t; /* Vector size type */ /* Check for small */ #define IS_USMALL(sgn,x) ((sgn) ? ((x) <= MAX_SMALL+1) : ((x) <= MAX_SMALL)) -#define IS_SSMALL(x) (((x) >= MIN_SMALL) && ((x) <= MAX_SMALL)) + +/* + * It seems that both clang and gcc will generate sub-optimal code + * for the more obvious way to write the range check: + * + * #define IS_SSMALL(x) (((x) >= MIN_SMALL) && ((x) <= MAX_SMALL)) + * + * Note that IS_SSMALL() may be used in the 32-bit emulator with + * a Uint64 argument. Therefore, we must test the size of the argument + * to ensure that the cast does not discard the high-order 32 bits. + */ +#define _IS_SSMALL32(x) (((Uint32) ((((x)) >> (SMALL_BITS-1)) + 1)) < 2) +#define _IS_SSMALL64(x) (((Uint64) ((((x)) >> (SMALL_BITS-1)) + 1)) < 2) +#define IS_SSMALL(x) (sizeof(x) == sizeof(Uint32) ? _IS_SSMALL32(x) : _IS_SSMALL64(x)) /* The heap size needed for a bignum */ #define BIG_NEED_SIZE(x) ((x) + 1) diff --git a/erts/emulator/beam/bs_instrs.tab b/erts/emulator/beam/bs_instrs.tab index a4d4afe7d4..9f03b19731 100644 --- a/erts/emulator/beam/bs_instrs.tab +++ b/erts/emulator/beam/bs_instrs.tab @@ -364,11 +364,9 @@ i_bs_init_bits_fail := bs_init_bits.fail.verify.execute; i_bs_init_bits_fail_heap := bs_init_bits.fail_heap.verify.execute; bs_init_bits.head() { - Eterm new_binary; Eterm num_bits_term; Uint num_bits; Uint alloc; - Uint num_bytes; } bs_init_bits.plain(NumBits) { @@ -410,7 +408,9 @@ bs_init_bits.verify(Fail) { } bs_init_bits.execute(Live, Dst) { - num_bytes = ((Uint64)num_bits+(Uint64)7) >> 3; + Eterm new_binary; + Uint num_bytes = ((Uint64)num_bits+(Uint64)7) >> 3; + if (num_bits & 7) { alloc += ERL_SUB_BIN_SIZE; } @@ -709,9 +709,6 @@ i_bs_validate_unicode_retract(Fail, Src, Ms) { i_bs_start_match2 := bs_start_match.fetch.execute; bs_start_match.head() { - Uint slots; - Uint live; - Eterm header; Eterm context; } @@ -720,6 +717,9 @@ bs_start_match.fetch(Src) { } bs_start_match.execute(Fail, Live, Slots, Dst) { + Uint slots; + Uint live; + Eterm header; if (!is_boxed(context)) { $FAIL($Fail); } @@ -942,13 +942,10 @@ bs_context_to_binary := ctx_to_bin.fetch.execute; i_bs_get_binary_all_reuse := ctx_to_bin.fetch_bin.execute; ctx_to_bin.head() { - Eterm context; - ErlBinMatchBuffer* mb; - ErlSubBin* sb; - Uint size; - Uint offs; - Uint orig; - Uint hole_size; + Eterm context; + ErlBinMatchBuffer* mb; + Uint size; + Uint offs; } ctx_to_bin.fetch(Src) { @@ -976,8 +973,9 @@ ctx_to_bin.fetch_bin(Src, Fail, Unit) { } ctx_to_bin.execute() { - orig = mb->orig; - sb = (ErlSubBin *) boxed_val(context); + Uint hole_size; + Uint orig = mb->orig; + ErlSubBin* sb = (ErlSubBin *) boxed_val(context); hole_size = 1 + header_arity(sb->thing_word) - ERL_SUB_BIN_SIZE; sb->thing_word = HEADER_SUB_BIN; sb->size = BYTE_OFFSET(size); diff --git a/erts/emulator/beam/code_ix.h b/erts/emulator/beam/code_ix.h index 9e3280cd98..42976d2301 100644 --- a/erts/emulator/beam/code_ix.h +++ b/erts/emulator/beam/code_ix.h @@ -176,7 +176,7 @@ int erts_has_code_write_permission(void); ERTS_GLB_INLINE BeamInstr *erts_codeinfo_to_code(ErtsCodeInfo *ci) { - ASSERT(ci->op == (BeamInstr) BeamOp(op_i_func_info_IaaI) || !ci->op); + ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI) || !ci->op); ASSERT_MFA(&ci->mfa); return (BeamInstr*)(ci + 1); } @@ -185,7 +185,7 @@ ERTS_GLB_INLINE ErtsCodeInfo *erts_code_to_codeinfo(BeamInstr *I) { ErtsCodeInfo *ci = ((ErtsCodeInfo *)(((char *)(I)) - sizeof(ErtsCodeInfo))); - ASSERT(ci->op == (BeamInstr) BeamOp(op_i_func_info_IaaI) || !ci->op); + ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI) || !ci->op); ASSERT_MFA(&ci->mfa); return ci; } 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_arith.c b/erts/emulator/beam/erl_arith.c index f2a3e411ec..b6625db0d3 100644 --- a/erts/emulator/beam/erl_arith.c +++ b/erts/emulator/beam/erl_arith.c @@ -114,7 +114,7 @@ BIF_RETTYPE intdiv_2(BIF_ALIST_2) } if (is_both_small(BIF_ARG_1,BIF_ARG_2)){ Sint ires = signed_val(BIF_ARG_1) / signed_val(BIF_ARG_2); - if (MY_IS_SSMALL(ires)) + if (IS_SSMALL(ires)) BIF_RET(make_small(ires)); } BIF_RET(erts_int_div(BIF_P, BIF_ARG_1, BIF_ARG_2)); @@ -340,8 +340,7 @@ erts_mixed_plus(Process* p, Eterm arg1, Eterm arg2) switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): ires = signed_val(arg1) + signed_val(arg2); - ASSERT(MY_IS_SSMALL(ires) == IS_SSMALL(ires)); - if (MY_IS_SSMALL(ires)) { + if (IS_SSMALL(ires)) { return make_small(ires); } else { hp = HAlloc(p, 2); @@ -486,8 +485,7 @@ erts_mixed_minus(Process* p, Eterm arg1, Eterm arg2) switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): ires = signed_val(arg1) - signed_val(arg2); - ASSERT(MY_IS_SSMALL(ires) == IS_SSMALL(ires)); - if (MY_IS_SSMALL(ires)) { + if (IS_SSMALL(ires)) { return make_small(ires); } else { hp = HAlloc(p, 2); @@ -1181,8 +1179,7 @@ erts_gc_mixed_plus(Process* p, Eterm* reg, Uint live) switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): ires = signed_val(arg1) + signed_val(arg2); - ASSERT(MY_IS_SSMALL(ires) == IS_SSMALL(ires)); - if (MY_IS_SSMALL(ires)) { + if (IS_SSMALL(ires)) { return make_small(ires); } else { if (ERTS_NEED_GC(p, 2)) { @@ -1349,8 +1346,7 @@ erts_gc_mixed_minus(Process* p, Eterm* reg, Uint live) switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): ires = signed_val(arg1) - signed_val(arg2); - ASSERT(MY_IS_SSMALL(ires) == IS_SSMALL(ires)); - if (MY_IS_SSMALL(ires)) { + if (IS_SSMALL(ires)) { return make_small(ires); } else { if (ERTS_NEED_GC(p, 2)) { 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 4b73be55c6..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)) < 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_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index 3fe089a00e..22942b40c4 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -966,12 +966,12 @@ static int function_is_traced(Process *p, if ((ep = export_get(&e)) != NULL) { pc = ep->beam; if (ep->addressv[erts_active_code_ix()] == pc && - *pc != (BeamInstr) em_call_error_handler) { + ! BeamIsOpCode(*pc, op_call_error_handler)) { int r = 0; - ASSERT(*pc == (BeamInstr) em_apply_bif || - *pc == (BeamInstr) BeamOp(op_i_generic_breakpoint)); + ASSERT(BeamIsOpCode(*pc, op_apply_bif) || + BeamIsOpCode(*pc, op_i_generic_breakpoint)); if (erts_is_trace_break(&ep->info, ms, 0)) { return FUNC_TRACE_GLOBAL_TRACE; @@ -1361,14 +1361,14 @@ erts_set_trace_pattern(Process*p, ErtsCodeMFA *mfa, int specified, if (ep->addressv[code_ix] != pc) { fp[i].mod->curr.num_traced_exports++; #ifdef DEBUG - ep->info.op = (BeamInstr) BeamOp(op_i_func_info_IaaI); + ep->info.op = BeamOpCodeAddr(op_i_func_info_IaaI); #endif - ep->beam[0] = (BeamInstr) BeamOp(op_trace_jump_W); + ep->beam[0] = BeamOpCodeAddr(op_trace_jump_W); ep->beam[1] = (BeamInstr) ep->addressv[code_ix]; } erts_set_call_trace_bif(ci, match_prog_set, 0); if (ep->addressv[code_ix] != pc) { - ep->beam[0] = (BeamInstr) BeamOp(op_i_generic_breakpoint); + ep->beam[0] = BeamOpCodeAddr(op_i_generic_breakpoint); } } else if (!on && flags.breakpoint) { /* Turn off breakpoint tracing -- nothing to do here. */ @@ -1378,8 +1378,8 @@ erts_set_trace_pattern(Process*p, ErtsCodeMFA *mfa, int specified, * before turning on breakpoint tracing. */ erts_clear_call_trace_bif(ci, 0); - if (ep->beam[0] == (BeamInstr) BeamOp(op_i_generic_breakpoint)) { - ep->beam[0] = (BeamInstr) BeamOp(op_trace_jump_W); + if (BeamIsOpCode(ep->beam[0], op_i_generic_breakpoint)) { + ep->beam[0] = BeamOpCodeAddr(op_trace_jump_W); } } } @@ -1671,7 +1671,7 @@ uninstall_exp_breakpoints(BpFunctions* f) if (ep->addressv[code_ix] != ep->beam) { continue; } - ASSERT(ep->beam[0] == (BeamInstr) BeamOp(op_trace_jump_W)); + ASSERT(BeamIsOpCode(ep->beam[0], op_trace_jump_W)); ep->addressv[code_ix] = (BeamInstr *) ep->beam[1]; } } @@ -1690,7 +1690,7 @@ clean_export_entries(BpFunctions* f) if (ep->addressv[code_ix] == ep->beam) { continue; } - if (ep->beam[0] == (BeamInstr) BeamOp(op_trace_jump_W)) { + if (BeamIsOpCode(ep->beam[0], op_trace_jump_W)) { ep->beam[0] = (BeamInstr) 0; ep->beam[1] = (BeamInstr) 0; } diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 8344c164fa..97a1ca915f 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -337,7 +337,7 @@ erts_heap_sizes(Process* p) for (i = num_heap_sizes-1; i >= 0; i--) { n += 2; - if (!MY_IS_SSMALL(heap_sizes[i])) { + if (!IS_SSMALL(heap_sizes[i])) { big += BIG_UINT_HEAP_SIZE; } } @@ -352,7 +352,7 @@ erts_heap_sizes(Process* p) Eterm num; Sint sz = heap_sizes[i]; - if (MY_IS_SSMALL(sz)) { + if (IS_SSMALL(sz)) { num = make_small(sz); } else { num = uint_to_big(sz, bigp); diff --git a/erts/emulator/beam/erl_io_queue.c b/erts/emulator/beam/erl_io_queue.c index a01b676d39..190ba6bbb9 100644 --- a/erts/emulator/beam/erl_io_queue.c +++ b/erts/emulator/beam/erl_io_queue.c @@ -973,9 +973,10 @@ static int iol2v_append_binary(iol2v_state_t *state, Eterm bin_term) { UWord binary_size; Uint byte_offset, bit_offset, bit_size; + byte *binary_data; + Eterm *parent_header; Eterm parent_binary; - byte *binary_data; ASSERT(state->bytereds_available > state->bytereds_spent); @@ -1001,14 +1002,14 @@ static int iol2v_append_binary(iol2v_state_t *state, Eterm bin_term) { erts_emasculate_writable_binary(pb); } - binary_data = pb->bytes; + binary_data = &((byte*)pb->bytes)[byte_offset]; } else { ErlHeapBin *hb = (ErlHeapBin*)parent_header; ASSERT(thing_subtag(*parent_header) == HEAP_BINARY_SUBTAG); ASSERT(is_bin_small); - binary_data = &((unsigned char*)&hb->data)[byte_offset]; + binary_data = &((byte*)&hb->data)[byte_offset]; } if (!is_bin_small && (state->acc_size == 0 || !is_acc_small)) { diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 3418a7f4df..abf194cf94 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -550,14 +550,11 @@ erts_msg_attached_data_size_aux(ErtsMessage *msg) sz = erts_decode_dist_ext_size(msg->data.dist_ext); if (sz < 0) { - /* Bad external; remove it */ - if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) { - ErlHeapFragment *heap_frag; - heap_frag = erts_dist_ext_trailer(msg->data.dist_ext); - erts_cleanup_offheap(&heap_frag->off_heap); - } - erts_free_dist_ext_copy(msg->data.dist_ext); - msg->data.dist_ext = NULL; + /* Bad external + * We leave the message intact in this case as it's not worth the trouble + * to make all callers remove it from queue. It will be detected again + * and removed from message queue later anyway. + */ return 0; } diff --git a/erts/emulator/beam/erl_nfunc_sched.h b/erts/emulator/beam/erl_nfunc_sched.h index 9be0e6f7c7..b8a4e4ebc3 100644 --- a/erts/emulator/beam/erl_nfunc_sched.h +++ b/erts/emulator/beam/erl_nfunc_sched.h @@ -211,8 +211,8 @@ erts_proc_shadow2real(Process *c_p) #define ERTS_NFUNC_SCHED_INTERNALS__ #define ERTS_I_BEAM_OP_TO_NIF_EXPORT(I) \ - (ASSERT(BeamOp(op_apply_bif) == (BeamInstr *) (*(I)) \ - || BeamOp(op_call_nif) == (BeamInstr *) (*(I))), \ + (ASSERT(BeamIsOpCode(*(I), op_apply_bif) || \ + BeamIsOpCode(*(I), op_call_nif)), \ ((NifExport *) (((char *) (I)) - offsetof(NifExport, exp.beam[0])))) diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 43441e0228..f7f12efe28 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -292,7 +292,7 @@ schedule(ErlNifEnv* env, NativeFunPtr direct_fp, NativeFunPtr indirect_fp, ep = erts_nif_export_schedule(c_p, dirty_shadow_proc, c_p->current, c_p->cp, - (BeamInstr) em_call_nif, + BeamOpCodeAddr(op_call_nif), direct_fp, indirect_fp, mod, func_name, argc, (const Eterm *) argv); @@ -3613,7 +3613,7 @@ static ErtsCodeInfo** get_func_pp(BeamCodeHeader* mod_code, Eterm f_atom, unsign int j; for (j = 0; j < n; ++j) { ErtsCodeInfo* ci = mod_code->functions[j]; - ASSERT(ci->op == (BeamInstr) BeamOp(op_i_func_info_IaaI)); + ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI)); if (f_atom == ci->mfa.function && arity == ci->mfa.arity) { return mod_code->functions+j; @@ -3982,13 +3982,12 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) code_ptr = erts_codeinfo_to_code(ci); if (ci->u.gen_bp == NULL) { - code_ptr[0] = (BeamInstr) BeamOp(op_call_nif); + code_ptr[0] = BeamOpCodeAddr(op_call_nif); } else { /* Function traced, patch the original instruction word */ GenericBp* g = ci->u.gen_bp; - ASSERT(code_ptr[0] == - (BeamInstr) BeamOp(op_i_generic_breakpoint)); - g->orig_instr = (BeamInstr) BeamOp(op_call_nif); + ASSERT(BeamIsOpCode(code_ptr[0], op_i_generic_breakpoint)); + g->orig_instr = BeamOpCodeAddr(op_call_nif); } if (f->flags) { code_ptr[3] = (BeamInstr) f->fptr; diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 938dd1b9ac..3d12b3bc21 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -8432,11 +8432,13 @@ erts_start_schedulers(void) erts_atomic_init_nob(&runq_supervisor_sleeping, 0); if (0 != ethr_event_init(&runq_supervision_event)) erts_exit(ERTS_ERROR_EXIT, "Failed to create run-queue supervision event\n"); - if (0 != ethr_thr_create(&runq_supervisor_tid, - runq_supervisor, - NULL, - &opts)) - erts_exit(ERTS_ERROR_EXIT, "Failed to create run-queue supervision thread\n"); + res = ethr_thr_create(&runq_supervisor_tid, + runq_supervisor, + NULL, + &opts); + if (0 != res) + erts_exit(ERTS_ERROR_EXIT, "Failed to create run-queue supervision thread, " + "error = %d\n", res); } @@ -8471,7 +8473,7 @@ erts_start_schedulers(void) opts.suggested_stack_size = erts_dcpu_sched_thread_suggested_stack_size; res = ethr_thr_create(&esdp->tid,sched_dirty_cpu_thread_func,(void*)esdp,&opts); if (res != 0) - erts_exit(ERTS_ERROR_EXIT, "Failed to create dirty cpu scheduler thread %d\n", ix); + erts_exit(ERTS_ERROR_EXIT, "Failed to create dirty cpu scheduler thread %d, error = %d\n", ix, res); } for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) { ErtsSchedulerData *esdp = ERTS_DIRTY_IO_SCHEDULER_IX(ix); @@ -8479,7 +8481,7 @@ erts_start_schedulers(void) opts.suggested_stack_size = erts_dio_sched_thread_suggested_stack_size; res = ethr_thr_create(&esdp->tid,sched_dirty_io_thread_func,(void*)esdp,&opts); if (res != 0) - erts_exit(ERTS_ERROR_EXIT, "Failed to create dirty io scheduler thread %d\n", ix); + erts_exit(ERTS_ERROR_EXIT, "Failed to create dirty io scheduler thread %d, error = %d\n", ix, res); } } @@ -8489,7 +8491,7 @@ erts_start_schedulers(void) res = ethr_thr_create(&tid, aux_thread, NULL, &opts); if (res != 0) - erts_exit(ERTS_ERROR_EXIT, "Failed to create aux thread\n"); + erts_exit(ERTS_ERROR_EXIT, "Failed to create aux thread, error = %d\n", res); for (ix = 0; ix < erts_no_poll_threads; ix++) { erts_snprintf(opts.name, 16, "%d_poller", ix); @@ -12474,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_term.h b/erts/emulator/beam/erl_term.h index 842802f8d9..6daf043117 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -270,7 +270,6 @@ _ET_DECLARE_CHECKED(Eterm*,list_val,Wterm) #define is_byte(x) (((x) & ((~(Uint)0 << (_TAG_IMMED1_SIZE+8)) + _TAG_IMMED1_MASK)) == _TAG_IMMED1_SMALL) #define is_valid_bit_size(x) (((Sint)(x)) >= 0 && ((x) & 0x7F) == _TAG_IMMED1_SMALL) #define is_not_valid_bit_size(x) (!is_valid_bit_size((x))) -#define MY_IS_SSMALL(x) (((Uint) ((((x)) >> (SMALL_BITS-1)) + 1)) < 2) #define _unchecked_unsigned_val(x) ((x) >> _TAG_IMMED1_SIZE) _ET_DECLARE_CHECKED(Uint,unsigned_val,Eterm) #define unsigned_val(x) _ET_APPLY(unsigned_val,(x)) diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c index 2d1d1443a7..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) { + if ((need = erts_native_filename_need(name, encoding)) < 0) { return NULL; } if (encoding == ERL_FILENAME_WIN_WCHAR) { @@ -2152,12 +2152,13 @@ Eterm erts_convert_native_to_filename(Process *p, byte *bytes) } -Sint erts_native_filename_need(Eterm ioterm, int encoding) +Sint erts_native_filename_need(Eterm ioterm, int encoding) { Eterm *objp; Eterm obj; DECLARE_ESTACK(stack); Sint need = 0; + int seen_null = 0; if (is_atom(ioterm)) { Atom* ap; @@ -2194,6 +2195,22 @@ Sint erts_native_filename_need(Eterm ioterm, int encoding) default: need = -1; } + /* + * 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; + } + } + } DESTROY_ESTACK(stack); return need; } @@ -2224,6 +2241,16 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */ if (is_small(obj)) { /* Always small */ for(;;) { Uint x = unsigned_val(obj); + /* + * 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: if (x > 255) { @@ -2497,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 @@ -2507,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 @@ -2515,6 +2580,7 @@ BIF_RETTYPE prim_file_internal_name2native_1(BIF_ALIST_1) BIF_ERROR(BIF_P,BADARG); } if (is_binary(BIF_ARG_1)) { + int seen_null = 0; byte *temp_alloc = NULL; byte *bytes; byte *err_pos; @@ -2524,10 +2590,18 @@ BIF_RETTYPE prim_file_internal_name2native_1(BIF_ALIST_1) size = binary_size(BIF_ARG_1); bytes = erts_get_aligned_binary_bytes(BIF_ARG_1, &temp_alloc); if (encoding != ERL_FILENAME_WIN_WCHAR) { + Uint i; /*Add 0 termination only*/ bin_term = new_binary(BIF_P, NULL, size+1); bin_p = binary_bytes(bin_term); - memcpy(bin_p,bytes,size); + for (i = 0; i < size; i++) { + /* Don't allow null in the middle of filenames... */ + if (bytes[i] == 0) + seen_null = 1; + else if (seen_null) + goto bin_name_error; + bin_p[i] = bytes[i]; + } bin_p[size]=0; erts_free_aligned_binary_bytes(temp_alloc); BIF_RET(bin_term); @@ -2541,6 +2615,11 @@ BIF_RETTYPE prim_file_internal_name2native_1(BIF_ALIST_1) bin_term = new_binary(BIF_P, 0, (size+1)*2); bin_p = binary_bytes(bin_term); while (size--) { + /* Don't allow null in the middle of filenames... */ + if (*bytes == 0) + seen_null = 1; + else if (seen_null) + goto bin_name_error; *bin_p++ = *bytes++; *bin_p++ = 0; } @@ -2558,11 +2637,14 @@ BIF_RETTYPE prim_file_internal_name2native_1(BIF_ALIST_1) bin_p[num_chars*2+1] = 0; erts_free_aligned_binary_bytes(temp_alloc); BIF_RET(bin_term); + bin_name_error: + erts_free_aligned_binary_bytes(temp_alloc); + BIF_ERROR(BIF_P,BADARG); } /* binary */ - if ((need = erts_native_filename_need(BIF_ARG_1,encoding)) < 0) { - BIF_ERROR(BIF_P,BADARG); + if ((need = erts_native_filename_need(BIF_ARG_1, encoding)) < 0) { + BIF_ERROR(BIF_P,BADARG); } if (encoding == ERL_FILENAME_WIN_WCHAR) { need += 2; @@ -2596,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 295130f60c..76980b5871 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -200,11 +200,24 @@ extern int erts_pd_initial_size;/* Initial Process dictionary table size */ #include "erl_term.h" -#ifdef NO_JUMP_TABLE -#define BeamOp(Op) (Op) +#if defined(NO_JUMP_TABLE) +# define BeamOpsAreInitialized() (1) +# define BeamOpCodeAddr(OpCode) ((BeamInstr)(OpCode)) #else extern void** beam_ops; -#define BeamOp(Op) beam_ops[(Op)] +# define BeamOpsAreInitialized() (beam_ops != 0) +# define BeamOpCodeAddr(OpCode) ((BeamInstr)beam_ops[(OpCode)]) #endif +#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/export.c b/erts/emulator/beam/export.c index c81503f722..946ffeffb8 100644 --- a/erts/emulator/beam/export.c +++ b/erts/emulator/beam/export.c @@ -48,7 +48,6 @@ static erts_atomic_t total_entries_bytes; */ erts_mtx_t export_staging_lock; -extern BeamInstr* em_call_error_handler; extern BeamInstr* em_call_traced_function; struct export_entry @@ -130,7 +129,10 @@ export_alloc(struct export_entry* tmpl_e) obj->info.mfa.module = tmpl->info.mfa.module; obj->info.mfa.function = tmpl->info.mfa.function; obj->info.mfa.arity = tmpl->info.mfa.arity; - obj->beam[0] = (BeamInstr) em_call_error_handler; + obj->beam[0] = 0; + if (BeamOpsAreInitialized()) { + obj->beam[0] = BeamOpCodeAddr(op_call_error_handler); + } obj->beam[1] = 0; for (ix=0; ix<ERTS_NUM_CODE_IX; ix++) { @@ -267,7 +269,7 @@ erts_find_function(Eterm m, Eterm f, unsigned int a, ErtsCodeIndex code_ix) ee = hash_get(&export_tables[code_ix].htable, init_template(&templ, m, f, a)); if (ee == NULL || (ee->ep->addressv[code_ix] == ee->ep->beam && - ee->ep->beam[0] != (BeamInstr) BeamOp(op_i_generic_breakpoint))) { + ! BeamIsOpCode(ee->ep->beam[0], op_i_generic_breakpoint))) { return NULL; } return ee->ep; diff --git a/erts/emulator/beam/export.h b/erts/emulator/beam/export.h index be6cce07bf..194e514b12 100644 --- a/erts/emulator/beam/export.h +++ b/erts/emulator/beam/export.h @@ -73,7 +73,7 @@ extern erts_mtx_t export_staging_lock; #include "beam_load.h" /* For em_* extern declarations */ #define ExportIsBuiltIn(EntryPtr) \ (((EntryPtr)->addressv[erts_active_code_ix()] == (EntryPtr)->beam) && \ - ((EntryPtr)->beam[0] == (BeamInstr) em_apply_bif)) + (BeamIsOpCode((EntryPtr)->beam[0], op_apply_bif))) #if ERTS_GLB_INLINE_INCL_FUNC_DEF diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 60cf09dc07..970158933f 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -3115,7 +3115,7 @@ dec_term(ErtsDistExternal *edep, #if defined(ARCH_64) *objp = make_small(sn); #else - if (MY_IS_SSMALL(sn)) { + if (IS_SSMALL(sn)) { *objp = make_small(sn); } else { *objp = small_to_big(sn, hp); diff --git a/erts/emulator/beam/instrs.tab b/erts/emulator/beam/instrs.tab index 7ea9dee299..07cc4bd527 100644 --- a/erts/emulator/beam/instrs.tab +++ b/erts/emulator/beam/instrs.tab @@ -375,7 +375,6 @@ i_element := element_group.fetch.execute; element_group.head() { - Eterm element_index; Eterm element_tuple; } @@ -384,7 +383,7 @@ element_group.fetch(Src) { } element_group.execute(Fail, Index, Dst) { - element_index = $Index; + Eterm element_index = $Index; if (ERTS_LIKELY(is_small(element_index) && is_tuple(element_tuple))) { Eterm* tp = tuple_val(element_tuple); @@ -831,12 +830,14 @@ badmatch(Src) { c_p->fvalue = $Src; c_p->freason = BADMATCH; goto find_func_info; + //| -no_next; } case_end(Src) { c_p->fvalue = $Src; c_p->freason = EXC_CASE_CLAUSE; goto find_func_info; + //| -no_next; } if_end() { diff --git a/erts/emulator/beam/macros.tab b/erts/emulator/beam/macros.tab index 6f9b78af6f..e0b5f56b53 100644 --- a/erts/emulator/beam/macros.tab +++ b/erts/emulator/beam/macros.tab @@ -28,9 +28,18 @@ REFRESH_GEN_DEST() { dst_ptr = REG_TARGET_PTR(dst); } +// $Offset is relative to the start of the instruction (not to the +// location of the failure label reference). Since combined +// instructions may increment the instruction pointer (e.g. in +// 'increment') for some of the instructions in the group, we actually +// use a virtual start position common to all instructions in the +// group. To calculate the correct virtual position, we will need to +// add $IP_ADJUSTMENT to the offset. ($IP_ADJUSTMENT will usually be +// zero, except in a few bit syntax instructions.) + SET_I_REL(Offset) { - ASSERT(VALID_INSTR(*(I + ($Offset)))); - I += $Offset; + ASSERT(VALID_INSTR(*(I + ($Offset) + $IP_ADJUSTMENT))); + I += $Offset + $IP_ADJUSTMENT; } SET_CP_I_ABS(Target) { diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 87ff92d354..4a915c7762 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 @@ -213,9 +213,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 +446,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 +583,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 +591,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 +619,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 +638,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 +660,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 +674,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 +702,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. @@ -961,11 +961,11 @@ call_ext_last Ar Func D => i_call_ext_last Func D call_ext_only Ar Func => i_call_ext_only Func i_apply -i_apply_last P +i_apply_last Q i_apply_only i_apply_fun -i_apply_fun_last P +i_apply_fun_last Q i_apply_fun_only %cold @@ -1004,13 +1004,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 +1062,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 +1091,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 +1116,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 +1150,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 +1186,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 +1205,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 +1224,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 +1234,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 +1251,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 +1268,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 +1278,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 +1394,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 +1413,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 +1488,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 +1537,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 +1548,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..e94348614d 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -1170,4 +1170,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/beam/trace_instrs.tab b/erts/emulator/beam/trace_instrs.tab index b10442c5e7..3eee81c053 100644 --- a/erts/emulator/beam/trace_instrs.tab +++ b/erts/emulator/beam/trace_instrs.tab @@ -61,12 +61,12 @@ i_return_to_trace() { Uint *cpp = (Uint*) E; for(;;) { ASSERT(is_CP(*cpp)); - if (*cp_val(*cpp) == (BeamInstr) OpCode(return_trace)) { + if (IsOpCode(*cp_val(*cpp), return_trace)) { do ++cpp; while (is_not_CP(*cpp)); cpp += 2; - } else if (*cp_val(*cpp) == (BeamInstr) OpCode(i_return_to_trace)) { + } else if (IsOpCode(*cp_val(*cpp), i_return_to_trace)) { do ++cpp; while (is_not_CP(*cpp)); diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index a1b15a2199..4e1d2f0d7f 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -1261,6 +1261,50 @@ static void free_read_line(void *data) EF_FREE(d); } +void read_file_zero_size(struct t_data* d); +#define ZERO_FILE_CHUNK (64 * 1024) + +/* [ERL-327] Some special files like /proc/... have reported size 0 */ +void read_file_zero_size(struct t_data* d) { + size_t total_read_size = 0; + size_t allocated_size = ZERO_FILE_CHUNK; /* allocd in invoke_read_file */ + for (;;) { + size_t read_result; + + /* Read until we hit EOF (read less than FILE_SEGMENT_READ) */ + d->result_ok = efile_read(&d->errInfo, + EFILE_MODE_READ, + (int) d->fd, + (d->c.read_file.binp->orig_bytes + + total_read_size), + ZERO_FILE_CHUNK, + &read_result); + if (!d->result_ok) { + break; + } + + total_read_size += read_result; + d->c.read_file.offset += read_result; + if (read_result < ZERO_FILE_CHUNK) { + break; + } + + /* Grow before the next read call */ + allocated_size = total_read_size + ZERO_FILE_CHUNK; + d->c.read_file.binp = driver_realloc_binary(d->c.read_file.binp, + allocated_size); + } + + /* Finalize the memory usage. Hopefully it was read fully on the first + * go, so the binary allocation overhead becomes: + * alloc ZERO_FILE_CHUNK (64kb) -> realloc real_size */ + if (allocated_size != total_read_size) { + d->c.read_file.binp = driver_realloc_binary(d->c.read_file.binp, + total_read_size); + } + d->again = 0; +} + static void invoke_read_file(void *data) { struct t_data *d = (struct t_data *) data; @@ -1279,9 +1323,15 @@ static void invoke_read_file(void *data) } d->fd = fd; d->c.read_file.size = (int) size; - if (size < 0 || size != d->c.read_file.size || - ! (d->c.read_file.binp = - driver_alloc_binary(d->c.read_file.size))) { + + /* For zero sized files allocate a reasonable chunk to attempt reading + * anyway. Note: This will eat ZERO_FILE_CHUNK bytes for any 0 file + * and free them immediately after (if the file was empty). */ + ERTS_ASSERT(size >= 0); + d->c.read_file.binp = driver_alloc_binary(size != 0 ? (size_t)size + : ZERO_FILE_CHUNK); + + if (size < 0 || size != d->c.read_file.size || !d->c.read_file.binp) { d->result_ok = 0; d->errInfo.posix_errno = ENOMEM; goto close; @@ -1290,6 +1340,11 @@ static void invoke_read_file(void *data) } /* Invariant: d->c.read_file.size >= d->c.read_file.offset */ + if (d->c.read_file.size == 0) { + read_file_zero_size(d); + goto close; + } + read_size = (size_t) (d->c.read_file.size - d->c.read_file.offset); if (! read_size) goto close; chop = d->again && read_size >= FILE_SEGMENT_READ*2; diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c index 05663648e9..380031bf13 100644 --- a/erts/emulator/hipe/hipe_bif0.c +++ b/erts/emulator/hipe/hipe_bif0.c @@ -53,8 +53,6 @@ #include "hipe_literals.h" #endif -#define BeamOpCode(Op) ((Uint)BeamOp(Op)) - int term_to_Sint32(Eterm term, Sint *sp) { @@ -615,7 +613,7 @@ static ErtsCodeInfo* hipe_find_emu_address(Eterm mod, Eterm name, unsigned int a n = code_hdr->num_functions; for (i = 0; i < n; ++i) { ErtsCodeInfo *ci = code_hdr->functions[i]; - ASSERT(ci->op == BeamOpCode(op_i_func_info_IaaI)); + ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI)); if (ci->mfa.function == name && ci->mfa.arity == arity) return ci; } diff --git a/erts/emulator/hipe/hipe_bif1.c b/erts/emulator/hipe/hipe_bif1.c index 3d3df4fd48..73d07f0ce5 100644 --- a/erts/emulator/hipe/hipe_bif1.c +++ b/erts/emulator/hipe/hipe_bif1.c @@ -32,11 +32,10 @@ #include "big.h" #include "error.h" #include "beam_load.h" +#include "erl_vm.h" #include "hipe_bif0.h" #include "hipe_bif1.h" -#define BeamOpCode(Op) ((Uint)BeamOp(Op)) - BIF_RETTYPE hipe_bifs_call_count_on_1(BIF_ALIST_1) { ErtsCodeInfo *ci; @@ -46,17 +45,17 @@ BIF_RETTYPE hipe_bifs_call_count_on_1(BIF_ALIST_1) ci = hipe_bifs_find_pc_from_mfa(BIF_ARG_1); if (!ci) BIF_ERROR(BIF_P, BADARG); - ASSERT(ci->op == BeamOpCode(op_i_func_info_IaaI)); + ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI)); pc = erts_codeinfo_to_code(ci); - if (pc[0] == BeamOpCode(op_hipe_trap_call)) + if (BeamIsOpCode(pc[0], op_hipe_trap_call)) BIF_ERROR(BIF_P, BADARG); - if (pc[0] == BeamOpCode(op_hipe_call_count)) + if (BeamIsOpCode(pc[0], op_hipe_call_count)) BIF_RET(NIL); hcc = erts_alloc(ERTS_ALC_T_HIPE_SL, sizeof(*hcc)); hcc->count = 0; hcc->opcode = pc[0]; ci->u.hcc = hcc; - pc[0] = BeamOpCode(op_hipe_call_count); + pc[0] = BeamOpCodeAddr(op_hipe_call_count); BIF_RET(am_true); } @@ -70,9 +69,9 @@ BIF_RETTYPE hipe_bifs_call_count_off_1(BIF_ALIST_1) ci = hipe_bifs_find_pc_from_mfa(BIF_ARG_1); if (!ci) BIF_ERROR(BIF_P, BADARG); - ASSERT(ci->op == BeamOpCode(op_i_func_info_IaaI)); + ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI)); pc = erts_codeinfo_to_code(ci); - if (pc[0] != BeamOpCode(op_hipe_call_count)) + if (! BeamIsOpCode(pc[0], op_hipe_call_count)) BIF_RET(am_false); hcc = ci->u.hcc; count = hcc->count; @@ -91,9 +90,9 @@ BIF_RETTYPE hipe_bifs_call_count_get_1(BIF_ALIST_1) ci = hipe_bifs_find_pc_from_mfa(BIF_ARG_1); if (!ci) BIF_ERROR(BIF_P, BADARG); - ASSERT(ci->op == BeamOpCode(op_i_func_info_IaaI)); + ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI)); pc = erts_codeinfo_to_code(ci); - if (pc[0] != BeamOpCode(op_hipe_call_count)) + if (! BeamIsOpCode(pc[0], op_hipe_call_count)) BIF_RET(am_false); hcc = ci->u.hcc; BIF_RET(make_small(hcc->count)); @@ -109,9 +108,9 @@ BIF_RETTYPE hipe_bifs_call_count_clear_1(BIF_ALIST_1) ci = hipe_bifs_find_pc_from_mfa(BIF_ARG_1); if (!ci) BIF_ERROR(BIF_P, BADARG); - ASSERT(ci->op == BeamOpCode(op_i_func_info_IaaI)); + ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI)); pc = erts_codeinfo_to_code(ci); - if (pc[0] != BeamOpCode(op_hipe_call_count)) + if (! BeamIsOpCode(pc[0], op_hipe_call_count)) BIF_RET(am_false); hcc = ci->u.hcc; count = hcc->count; diff --git a/erts/emulator/hipe/hipe_instrs.tab b/erts/emulator/hipe/hipe_instrs.tab index bcce196a1d..a01baebddf 100644 --- a/erts/emulator/hipe/hipe_instrs.tab +++ b/erts/emulator/hipe/hipe_instrs.tab @@ -45,7 +45,7 @@ hipe_trap.call() { * ... remainder of original BEAM code */ ErtsCodeInfo *ci = erts_code_to_codeinfo(I); - ASSERT(ci->op == (Uint) OpCode(i_func_info_IaaI)); + ASSERT(IsOpCode(ci->op, i_func_info_IaaI)); c_p->hipe.u.ncallee = ci->u.ncallee; ++hipe_trap_count; $HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL | (ci->mfa.arity << 8)); @@ -53,7 +53,7 @@ hipe_trap.call() { hipe_trap.call_closure() { ErtsCodeInfo *ci = erts_code_to_codeinfo(I); - ASSERT(ci->op == (Uint) OpCode(i_func_info_IaaI)); + ASSERT(IsOpCode(ci->op, i_func_info_IaaI)); c_p->hipe.u.ncallee = ci->u.ncallee; ++hipe_trap_count; $HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (ci->mfa.arity << 8)); @@ -132,7 +132,7 @@ hipe_call_count() { */ ErtsCodeInfo *ci = erts_code_to_codeinfo(I); struct hipe_call_count *hcc = ci->u.hcc; - ASSERT(ci->op == (Uint) OpCode(i_func_info_IaaI)); + ASSERT(IsOpCode(ci->op, i_func_info_IaaI)); ASSERT(hcc != NULL); ASSERT(VALID_INSTR(hcc->opcode)); ++(hcc->count); diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c index b7f81fc4a6..8b497c9970 100644 --- a/erts/emulator/hipe/hipe_mode_switch.c +++ b/erts/emulator/hipe/hipe_mode_switch.c @@ -155,8 +155,6 @@ void hipe_check_pcb(Process *p, const char *file, unsigned line) #include "hipe_arm_glue.h" #endif -#define BeamOpCode(Op) ((Uint)BeamOp(Op)) - Uint hipe_beam_pc_return[1]; /* needed in hipe_debug.c */ Uint hipe_beam_pc_throw[1]; /* needed in hipe_debug.c */ Uint hipe_beam_pc_resume[1]; /* needed by hipe_set_timeout() */ @@ -166,9 +164,9 @@ void hipe_mode_switch_init(void) { hipe_arch_glue_init(); - hipe_beam_pc_return[0] = BeamOpCode(op_hipe_trap_return); - hipe_beam_pc_throw[0] = BeamOpCode(op_hipe_trap_throw); - hipe_beam_pc_resume[0] = BeamOpCode(op_hipe_trap_resume); + hipe_beam_pc_return[0] = BeamOpCodeAddr(op_hipe_trap_return); + hipe_beam_pc_throw[0] = BeamOpCodeAddr(op_hipe_trap_throw); + hipe_beam_pc_resume[0] = BeamOpCodeAddr(op_hipe_trap_resume); hipe_beam_catch_throw = make_catch(beam_catches_cons(hipe_beam_pc_throw, BEAM_CATCHES_NIL)); @@ -182,8 +180,8 @@ void hipe_set_call_trap(ErtsCodeInfo* ci, void *nfun, int is_closure) HIPE_ASSERT(ci->op == BeamOpCode(op_i_func_info_IaaI)); bfun[0] = is_closure - ? BeamOpCode(op_hipe_trap_call_closure) - : BeamOpCode(op_hipe_trap_call); + ? BeamOpCodeAddr(op_hipe_trap_call_closure) + : BeamOpCodeAddr(op_hipe_trap_call); ci->u.ncallee = (void (*)(void)) nfun; } diff --git a/erts/emulator/nifs/common/zlib_nif.c b/erts/emulator/nifs/common/zlib_nif.c index a1a65e1946..a9c5b05e47 100644 --- a/erts/emulator/nifs/common/zlib_nif.c +++ b/erts/emulator/nifs/common/zlib_nif.c @@ -69,11 +69,27 @@ typedef enum { ST_DEFLATE = 1, ST_INFLATE = 2, ST_CLOSED = 3 -} zlib_state; +} zlib_state_t; + +/* Controls what to do when the user attempts to decompress more data after + * Z_STREAM_END has been returned: + * + * - 'cut' wipes all further input and returns empty results until reset by + * the user. This is the default behavior, matching that of the old driver. + * - 'reset' resets the state without discarding any input, making it possible + * to decompress blindly concatenated streams. + * - 'error' crashes with a data error. */ +typedef enum { + EOS_BEHAVIOR_ERROR = 0, + EOS_BEHAVIOR_RESET = 1, + EOS_BEHAVIOR_CUT = 2 +} zlib_eos_behavior_t; typedef struct { z_stream s; - zlib_state state; + zlib_state_t state; + + zlib_eos_behavior_t eos_behavior; /* These refer to the plaintext CRC, and are only needed for zlib:crc32/1 * which is deprecated. */ @@ -102,7 +118,6 @@ typedef struct { static ERL_NIF_TERM zlib_open(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM zlib_close(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM zlib_deflateInit(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM zlib_deflateInit2(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM zlib_deflateSetDictionary(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM zlib_deflateReset(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM zlib_deflateEnd(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); @@ -110,7 +125,6 @@ static ERL_NIF_TERM zlib_deflateParams(ErlNifEnv *env, int argc, const ERL_NIF_T static ERL_NIF_TERM zlib_deflate(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM zlib_inflateInit(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM zlib_inflateInit2(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM zlib_inflateSetDictionary(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM zlib_inflateGetDictionary(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM zlib_inflateReset(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); @@ -130,8 +144,7 @@ static ERL_NIF_TERM zlib_enqueue_input(ErlNifEnv *env, int argc, const ERL_NIF_T static ErlNifFunc nif_funcs[] = { /* deflate */ - {"deflateInit_nif", 2, zlib_deflateInit}, - {"deflateInit_nif", 6, zlib_deflateInit2}, + {"deflateInit_nif", 6, zlib_deflateInit}, {"deflateSetDictionary_nif", 2, zlib_deflateSetDictionary}, {"deflateReset_nif", 1, zlib_deflateReset}, {"deflateEnd_nif", 1, zlib_deflateEnd}, @@ -139,8 +152,7 @@ static ErlNifFunc nif_funcs[] = { {"deflate_nif", 4, zlib_deflate}, /* inflate */ - {"inflateInit_nif", 1, zlib_inflateInit}, - {"inflateInit_nif", 2, zlib_inflateInit2}, + {"inflateInit_nif", 3, zlib_inflateInit}, {"inflateSetDictionary_nif", 2, zlib_inflateSetDictionary}, {"inflateGetDictionary_nif", 1, zlib_inflateGetDictionary}, {"inflateReset_nif", 1, zlib_inflateReset}, @@ -509,9 +521,11 @@ static ERL_NIF_TERM zlib_open(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[ d->s.opaque = d; d->s.data_type = Z_BINARY; - d->state = ST_NONE; + d->eos_behavior = EOS_BEHAVIOR_CUT; d->eos_seen = 0; + d->state = ST_NONE; + d->want_output_crc = 0; d->want_input_crc = 0; d->is_raw_stream = 0; @@ -551,42 +565,6 @@ static ERL_NIF_TERM zlib_close(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv static ERL_NIF_TERM zlib_deflateInit(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { zlib_data_t *d; - int level, res; - - if(argc != 2 || !get_zlib_data(env, argv[0], &d) || - !enif_get_int(env, argv[1], &level)) { - return enif_make_badarg(env); - } else if(!zlib_process_check(env, d)) { - return enif_raise_exception(env, am_not_on_controlling_process); - } else if(d->state != ST_NONE) { - return enif_raise_exception(env, am_already_initialized); - } - - res = deflateInit(&d->s, level); - - if(res == Z_OK) { - d->state = ST_DEFLATE; - d->eos_seen = 0; - - /* FIXME: crc32/1 is documented as returning "the current calculated - * checksum," but failed to mention that the old implementation only - * calculated it when WindowBits < 0 (See zlib_deflateInit2). - * - * We could fix this behavior by setting d->want_input_crc to 1 here, - * but we've decided to retain this quirk since the performance hit is - * quite significant. */ - d->want_output_crc = 0; - d->want_input_crc = 0; - - d->output_crc = crc32(0L, Z_NULL, 0); - d->input_crc = crc32(0L, Z_NULL, 0); - } - - return zlib_return(env, res); -} - -static ERL_NIF_TERM zlib_deflateInit2(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { - zlib_data_t *d; int level, method, windowBits, memLevel, strategy, res; if(argc != 6 || !get_zlib_data(env, argv[0], &d) @@ -741,39 +719,12 @@ static ERL_NIF_TERM zlib_deflate(ErlNifEnv *env, int argc, const ERL_NIF_TERM ar static ERL_NIF_TERM zlib_inflateInit(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { zlib_data_t *d; - int res; - if(argc != 1 || !get_zlib_data(env, argv[0], &d)) { - return enif_make_badarg(env); - } else if(!zlib_process_check(env, d)) { - return enif_raise_exception(env, am_not_on_controlling_process); - } else if(d->state != ST_NONE) { - return enif_raise_exception(env, am_already_initialized); - } - - res = inflateInit(&d->s); - - if(res == Z_OK) { - d->state = ST_INFLATE; - d->eos_seen = 0; - - d->want_output_crc = 0; - d->want_input_crc = 0; - d->is_raw_stream = 0; - - d->output_crc = crc32(0L, Z_NULL, 0); - d->input_crc = crc32(0L, Z_NULL, 0); - } - - return zlib_return(env, res); -} + int windowBits, eosBehavior, res; -static ERL_NIF_TERM zlib_inflateInit2(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { - zlib_data_t *d; - int windowBits, res; - - if(argc != 2 || !get_zlib_data(env, argv[0], &d) - || !enif_get_int(env, argv[1], &windowBits)) { + if(argc != 3 || !get_zlib_data(env, argv[0], &d) + || !enif_get_int(env, argv[1], &windowBits) + || !enif_get_int(env, argv[2], &eosBehavior)) { return enif_make_badarg(env); } else if(!zlib_process_check(env, d)) { return enif_raise_exception(env, am_not_on_controlling_process); @@ -785,6 +736,8 @@ static ERL_NIF_TERM zlib_inflateInit2(ErlNifEnv *env, int argc, const ERL_NIF_TE if(res == Z_OK) { d->state = ST_INFLATE; + + d->eos_behavior = eosBehavior; d->eos_seen = 0; d->is_raw_stream = (windowBits < 0); @@ -934,6 +887,28 @@ static ERL_NIF_TERM zlib_inflate(ErlNifEnv *env, int argc, const ERL_NIF_TERM ar return enif_raise_exception(env, am_not_initialized); } + if(d->eos_seen) { + int res; + + switch(d->eos_behavior) { + case EOS_BEHAVIOR_ERROR: + return zlib_return(env, Z_DATA_ERROR); + case EOS_BEHAVIOR_RESET: + res = inflateReset(&d->s); + + if(res != Z_OK) { + return zlib_return(env, res); + } + + d->eos_seen = 0; + break; + case EOS_BEHAVIOR_CUT: + zlib_reset_input(d); + + return enif_make_tuple2(env, am_finished, enif_make_list(env, 0)); + } + } + return zlib_codec(&inflate, env, d, input_chunk_size, output_chunk_size, flush); } diff --git a/erts/emulator/pcre/README.pcre_update.md b/erts/emulator/pcre/README.pcre_update.md index 8caf575d31..599e3d0d12 100644 --- a/erts/emulator/pcre/README.pcre_update.md +++ b/erts/emulator/pcre/README.pcre_update.md @@ -2,7 +2,7 @@ ## The basic changes to the PCRE library -To work with the Erlang VM, PCRE has been changed in two important ways: +To work with the Erlang VM, PCRE has been changed in three important ways: 1. The main execution machine in pcre\_exec has been modified so that matching can be interrupted and restarted. This functionality utilizes diff --git a/erts/emulator/test/beam_SUITE.erl b/erts/emulator/test/beam_SUITE.erl index 6a54fa87e0..bdf8f6c34e 100644 --- a/erts/emulator/test/beam_SUITE.erl +++ b/erts/emulator/test/beam_SUITE.erl @@ -113,20 +113,41 @@ packed_registers(Config) when is_list(Config) -> VarName = list_to_atom("M"++integer_to_list(V)), merl:var(VarName) end || V <- Seq], + MoreNewVars = [begin + VarName = list_to_atom("MM"++integer_to_list(V)), + merl:var(VarName) + end || V <- Seq], + TupleEls = [?Q("id(_@Value@)") || {_,Value} <- S0], S = [?Q("_@Var = id(_@Value@)") || {Var,Value} <- S0], Code = ?Q(["-module('@Mod@').\n" "-export([f/0]).\n" "f() ->\n" + "Tuple = id({_@TupleEls}),\n" + "{_@MoreNewVars} = Tuple,\n" "_@S,\n" "_ = id(0),\n" "L = [_@Vars],\n" "_ = id(1),\n" "[_@NewVars] = L,\n" %Test get_list/3. "_ = id(2),\n" - "id([_@Vars,_@NewVars]).\n" + "id([_@Vars,_@NewVars,_@MoreNewVars]).\n" "id(I) -> I.\n"]), merl:compile_and_load(Code), - CombinedSeq = Seq ++ Seq, + + %% Optionally print the generated code. + PrintCode = false, %Change to true to print code. + + case PrintCode of + false -> + ok; + true -> + merl:print(Code), + erts_debug:df(Mod), + {ok,Dis} = file:read_file(atom_to_list(Mod)++".dis"), + io:put_chars(Dis) + end, + + CombinedSeq = Seq ++ Seq ++ Seq, CombinedSeq = Mod:f(), %% Clean up. diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl index 28be4bfe37..17cd1d1a3b 100644 --- a/erts/emulator/test/distribution_SUITE.erl +++ b/erts/emulator/test/distribution_SUITE.erl @@ -56,6 +56,7 @@ bad_dist_ext_process_info/1, bad_dist_ext_control/1, bad_dist_ext_connection_id/1, + bad_dist_ext_size/1, start_epmd_false/1, epmd_module/1]). %% Internal exports. @@ -92,6 +93,7 @@ groups() -> [dist_auto_connect_never, dist_auto_connect_once]}, {bad_dist_ext, [], [bad_dist_ext_receive, bad_dist_ext_process_info, + bad_dist_ext_size, bad_dist_ext_control, bad_dist_ext_connection_id]}]. %% Tests pinging a node in different ways. @@ -1674,6 +1676,57 @@ bad_dist_ext_connection_id(Config) when is_list(Config) -> stop_node(Offender), stop_node(Victim). +%% OTP-14661: Bad message is discovered by erts_msg_attached_data_size +bad_dist_ext_size(Config) when is_list(Config) -> + {ok, Offender} = start_node(bad_dist_ext_process_info_offender), + %%Prog = "Prog=/home/uabseri/src/otp_new3/bin/cerl -rr -debug", + Prog = [], + {ok, Victim} = start_node(bad_dist_ext_process_info_victim, [], Prog), + start_node_monitors([Offender,Victim]), + + Parent = self(), + P = spawn_link(Victim, + fun () -> + Parent ! {self(), started}, + receive check_msgs -> ok end, %% DID CRASH HERE + bad_dist_ext_check_msgs([one]), + Parent ! {self(), messages_checked} + end), + + receive {P, started} -> ok end, + P ! one, + + Suspended = make_ref(), + S = spawn(Victim, + fun () -> + erlang:suspend_process(P), + Parent ! Suspended, + receive after infinity -> ok end + end), + + receive Suspended -> ok end, + pong = rpc:call(Victim, net_adm, ping, [Offender]), + verify_up(Offender, Victim), + send_bad_msgs(Offender, P, 1, dmsg_bad_tag()), + + %% Make sure bad msgs has reached Victim + rpc:call(Offender, rpc, call, [Victim, erlang, node, []]), + + verify_still_up(Offender, Victim), + + rpc:call(Victim, erlang, process_info, [P, total_heap_size]), + + verify_down(Offender, connection_closed, Victim, killed), + + P ! check_msgs, + exit(S, bang), % resume Victim + receive {P, messages_checked} -> ok end, + + unlink(P), + verify_no_down(Offender, Victim), + stop_node(Offender), + stop_node(Victim). + bad_dist_struct_check_msgs([]) -> receive @@ -1778,9 +1831,12 @@ send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,PayLoad) -> send_bad_msg(BadNode, To) -> send_bad_msgs(BadNode, To, 1). -send_bad_msgs(BadNode, To, Repeat) when is_atom(BadNode), - is_pid(To), - is_integer(Repeat) -> +send_bad_msgs(BadNode, To, Repeat) -> + send_bad_msgs(BadNode, To, Repeat, dmsg_bad_atom_cache_ref()). + +send_bad_msgs(BadNode, To, Repeat, BadTerm) when is_atom(BadNode), + is_pid(To), + is_integer(Repeat) -> Parent = self(), Done = make_ref(), spawn_link(BadNode, @@ -1790,7 +1846,7 @@ send_bad_msgs(BadNode, To, Repeat) when is_atom(BadNode), DCtrl = dctrl(Node), DData = [dmsg_hdr(), dmsg_ext({?DOP_SEND, ?COOKIE, To}), - dmsg_bad_atom_cache_ref()], + BadTerm], repeat(fun () -> dctrl_send(DCtrl, DData) end, Repeat), Parent ! Done end), @@ -1878,6 +1934,9 @@ dmsg_ext(Term) -> dmsg_bad_atom_cache_ref() -> [$R, 137]. +dmsg_bad_tag() -> %% Will fail early at heap size calculation + [$?, 66]. + start_epmd_false(Config) when is_list(Config) -> %% Start a node with the option -start_epmd false. {ok, OtherNode} = start_node(start_epmd_false, "-start_epmd false"), diff --git a/erts/emulator/test/efile_SUITE.erl b/erts/emulator/test/efile_SUITE.erl index f0e1bcf04b..08d5597d78 100644 --- a/erts/emulator/test/efile_SUITE.erl +++ b/erts/emulator/test/efile_SUITE.erl @@ -19,16 +19,20 @@ -module(efile_SUITE). -export([all/0, suite/0]). --export([iter_max_files/1, async_dist/1]). +-export([async_dist/1, + iter_max_files/1, + proc_zero_sized_files/1 + ]). -export([do_iter_max_files/2, do_async_dist/1]). -include_lib("common_test/include/ct.hrl"). +-include_lib("stdlib/include/assert.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [iter_max_files, async_dist]. + [iter_max_files, async_dist, proc_zero_sized_files]. do_async_dist(Dir) -> X = 100, @@ -162,3 +166,44 @@ open_files(Name) -> % io:format("Error reason: ~p", [_Reason]), [] end. + +%% @doc If /proc filesystem exists (no way to know if it is real proc or just +%% a /proc directory), let's read some zero sized files 500 times each, while +%% ensuring that response isn't empty << >> +proc_zero_sized_files(Config) when is_list(Config) -> + {Type, Flavor} = os:type(), + %% Some files which exist on Linux but might be missing on other systems + Inputs = ["/proc/cpuinfo", + "/proc/meminfo", + "/proc/partitions", + "/proc/swaps", + "/proc/version", + "/proc/uptime", + %% curproc is present on freebsd + "/proc/curproc/cmdline"], + case filelib:is_dir("/proc") of + false -> {skip, "/proc not found"}; % skip the test if no /proc + _ when Type =:= unix andalso Flavor =:= sunos -> + %% SunOS has a /proc, but no zero sized special files + {skip, "sunos does not have any zero sized special files"}; + true -> + %% Take away files which do not exist in proc + Inputs1 = lists:filter(fun filelib:is_file/1, Inputs), + + %% Fail if none of mentioned files exist in /proc, did we just get + %% a normal /proc directory without any special files? + ?assertNotEqual([], Inputs1), + + %% For 6 inputs and 500 attempts each this do run anywhere + %% between 500 and 3000 function calls. + lists:foreach( + fun(Filename) -> do_proc_zero_sized(Filename, 500) end, + Inputs1) + end. + +%% @doc Test one file N times to also trigger possible leaking fds and memory +do_proc_zero_sized(_Filename, 0) -> ok; +do_proc_zero_sized(Filename, N) -> + Data = file:read_file(Filename), + ?assertNotEqual(<<>>, Data), + do_proc_zero_sized(Filename, N-1). diff --git a/erts/emulator/test/emulator_smoke.spec b/erts/emulator/test/emulator_smoke.spec index b2d0de8835..fc98ba6823 100644 --- a/erts/emulator/test/emulator_smoke.spec +++ b/erts/emulator/test/emulator_smoke.spec @@ -7,3 +7,4 @@ [consistency],"Not reliable in October and March"}. {cases,'Dir',crypto_SUITE,[t_md5]}. {cases,'Dir',float_SUITE,[fpe,cmp_integer]}. +{cases,'Dir',erts_debug_SUITE,[df]}. diff --git a/erts/emulator/test/exception_SUITE.erl b/erts/emulator/test/exception_SUITE.erl index e473a10be7..0f27251fcb 100644 --- a/erts/emulator/test/exception_SUITE.erl +++ b/erts/emulator/test/exception_SUITE.erl @@ -662,6 +662,15 @@ line_numbers(Config) when is_list(Config) -> {?MODULE,line_numbers,1,_}|_]}} = (catch applied_bif_2()), + {'EXIT',{badarith, + [{?MODULE,increment1,1,[{file,"increment.erl"},{line,45}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch increment1(x)), + {'EXIT',{badarith, + [{?MODULE,increment2,1,[{file,"increment.erl"},{line,48}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch increment2(x)), + ok. id(I) -> I. @@ -762,3 +771,15 @@ applied_bif_2() -> %Line 8 R = process_info(self(), current_location), %Line 9 fail = R, %Line 10 ok. %Line 11 + +%% The increment instruction used to decrement the instruction +%% pointer, which would cause the line number in a stack trace to +%% be the previous line number. + +-file("increment.erl", 42). +increment1(Arg) -> %Line 43 + Res = id(Arg), %Line 44 + Res + 1. %Line 45 +increment2(Arg) -> %Line 46 + _ = id(Arg), %Line 47 + Arg + 1. %Line 48 diff --git a/erts/emulator/test/iovec_SUITE.erl b/erts/emulator/test/iovec_SUITE.erl index 28df36d293..49dc64b0d2 100644 --- a/erts/emulator/test/iovec_SUITE.erl +++ b/erts/emulator/test/iovec_SUITE.erl @@ -24,7 +24,8 @@ -export([integer_lists/1, binary_lists/1, empty_lists/1, empty_binary_lists/1, mixed_lists/1, improper_lists/1, illegal_lists/1, cons_bomb/1, - iolist_to_iovec_idempotence/1, iolist_to_iovec_correctness/1]). + sub_binary_lists/1, iolist_to_iovec_idempotence/1, + iolist_to_iovec_correctness/1]). -include_lib("common_test/include/ct.hrl"). @@ -34,8 +35,8 @@ suite() -> all() -> [integer_lists, binary_lists, empty_lists, empty_binary_lists, mixed_lists, - illegal_lists, improper_lists, cons_bomb, iolist_to_iovec_idempotence, - iolist_to_iovec_correctness]. + sub_binary_lists, illegal_lists, improper_lists, cons_bomb, + iolist_to_iovec_idempotence, iolist_to_iovec_correctness]. init_per_suite(Config) -> Config. @@ -46,15 +47,16 @@ end_per_suite(Config) -> integer_lists(Config) when is_list(Config) -> Variations = gen_variations([I || I <- lists:seq(1, 255)]), + equivalence_test(fun erlang:iolist_to_iovec/1, Variations). - equivalence_test(fun erlang:iolist_to_iovec/1, Variations), - - ok. +sub_binary_lists(Config) when is_list(Config) -> + Parent = <<0:256/unit:8, "gazurka">>, + <<0:196/unit:8, Child/binary>> = Parent, + equivalence_test(fun erlang:iolist_to_iovec/1, gen_variations(Child)). binary_lists(Config) when is_list(Config) -> Variations = gen_variations([<<I:8>> || I <- lists:seq(1, 255)]), - equivalence_test(fun erlang:iolist_to_iovec/1, Variations), - ok. + equivalence_test(fun erlang:iolist_to_iovec/1, Variations). empty_lists(Config) when is_list(Config) -> Variations = gen_variations([[] || _ <- lists:seq(1, 256)]), @@ -70,8 +72,7 @@ empty_binary_lists(Config) when is_list(Config) -> mixed_lists(Config) when is_list(Config) -> Variations = gen_variations([<<>>, lists:seq(1, 40), <<12, 45, 78>>]), - equivalence_test(fun erlang:iolist_to_iovec/1, Variations), - ok. + equivalence_test(fun erlang:iolist_to_iovec/1, Variations). illegal_lists(Config) when is_list(Config) -> BitStrs = gen_variations(["gurka", <<1:1>>, "gaffel"]), @@ -82,18 +83,15 @@ illegal_lists(Config) when is_list(Config) -> Variations = BitStrs ++ BadInts ++ Atoms ++ BadTails, - illegality_test(fun erlang:iolist_to_iovec/1, Variations), - - ok. + illegality_test(fun erlang:iolist_to_iovec/1, Variations). improper_lists(Config) when is_list(Config) -> Variations = [ [[[[1 | <<2>>] | <<3>>] | <<4>>] | <<5>>], - [[<<"test">>, 3] | <<"improper tail">>], - [1, 2, 3 | <<"improper tail">>] + [[<<1>>, 2] | <<3, 4, 5>>], + [1, 2, 3 | <<4, 5>>] ], - equivalence_test(fun erlang:iolist_to_iovec/1, Variations), - ok. + equivalence_test(fun erlang:iolist_to_iovec/1, Variations). cons_bomb(Config) when is_list(Config) -> IntBase = gen_variations([I || I <- lists:seq(1, 255)]), @@ -108,8 +106,7 @@ cons_bomb(Config) when is_list(Config) -> end, Variations = gen_variations([IntBase, BinBase, MixBase], Rounds), - equivalence_test(fun erlang:iolist_to_iovec/1, Variations), - ok. + equivalence_test(fun erlang:iolist_to_iovec/1, Variations). iolist_to_iovec_idempotence(Config) when is_list(Config) -> IntVariations = gen_variations([I || I <- lists:seq(1, 255)]), @@ -134,11 +131,15 @@ iolist_to_iovec_correctness(Config) when is_list(Config) -> ok. illegality_test(Fun, Variations) -> - [{'EXIT',{badarg, _}} = (catch Fun(Variation)) || Variation <- Variations]. + [{'EXIT',{badarg, _}} = (catch Fun(Variation)) || Variation <- Variations], + ok. equivalence_test(Fun, [Head | _] = Variations) -> + %% Check that each variation is equal to the others, and that the sum of + %% them is equal to the input. Comparand = Fun(Head), - [is_iolist_equal(Comparand, Fun(Variation)) || Variation <- Variations], + [true = is_iolist_equal(Comparand, Fun(V)) || V <- Variations], + true = is_iolist_equal(Variations, Fun(Variations)), ok. is_iolist_equal(A, B) -> 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/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 bb31db7eb5..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. @@ -80,7 +76,10 @@ my %gen_opnum; my %num_specific; my %gen_to_spec; my %specific_op; -my %group_size; # Group size for specific operators. + +# Information about each specific operator. Key is the print name (e.g. get_list_xxy). +# Value is a hash. +my %spec_op_info; my %gen_arity; my @gen_arity; @@ -247,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"; @@ -258,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; + } + } } # @@ -447,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})) { @@ -523,6 +522,36 @@ sub emulator_output { my $key; # Loop variable. # + # Generate code and meta information for all instructions. + # + foreach $key (keys %specific_op) { + foreach (@{$specific_op{$key}}) { + my($name, $hotness, @args) = @$_; + my $print_name = print_name($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)]; + } + + # Note: Some of the information below will be modified + # for combined instructions. + my %info = ('size' => $size, + 'pack_spec' => $pack_spec, + 'adj' => 0, + 'args' => \@args); + $spec_op_info{$print_name} = \%info; + } + } + + # + # Combine micro instruction into instruction blocks and generate + # code for them. + # + combine_micro_instructions(); + + # # Information about opcodes (beam_opcodes.c). # $name = "$outdir/beam_opcodes.c"; @@ -551,14 +580,9 @@ sub emulator_output { print "\n"; # - # Combine micro instruction into instruction blocks. - # - combine_micro_instructions(); - - # # Generate code for specific ops. # - my($spec_opnum) = 0; + my $spec_opnum = 0; print "const OpEntry opc[] = {\n"; foreach $key (sort keys %specific_op) { $gen_to_spec{$key} = $spec_opnum; @@ -573,38 +597,26 @@ 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. - my($sort_key) = $sign; + my $sort_key = $sign; eval "\$sort_key =~ tr/$genop_types/./"; $sort_key .= ":$sign"; - $items{$sort_key} = [$name, $hot, $sign, @args]; + my $print_name = print_name($name, @args); + $items{$sort_key} = $print_name; } # # Now call the generator for the sorted result. # - foreach (sort keys %items) { - my($name, $hot, $sign, @args) = @{$items{$_}}; + foreach my $sort_key (sort keys %items) { + my $print_name = $items{$sort_key}; + my $info = $spec_op_info{$print_name}; + my(@args) = @{$info->{'args'}}; + @args = map { s/[?]$//; $_ } @args; my $arity = @args; - my($instr) = "${name}_$sign"; - $instr =~ s/_$//; - - # - # Call a generator to calculate size and generate macros - # for the emulator. - # - my($size, $code, $pack) = - basic_generator($name, 1, '', 0, undef, @args); - - # - # Save the generated $code for later. - # - if (defined $code) { - $code = "OpCase($instr):\n$code"; - push @generated_code, [$hot,$code,($instr)]; - } # # Calculate the bit mask which should be used to match this @@ -626,7 +638,6 @@ sub emulator_output { } printf "/* %3d */ ", $spec_opnum; - my $print_name = $sign ne '' ? "${name}_$sign" : $name; my $init = "{"; my $sep = ""; foreach (@bits) { @@ -634,12 +645,12 @@ sub emulator_output { $sep = ","; } $init .= "}"; - my $adj = 0; - if (defined $group_size{$print_name}) { - $adj = $size - $group_size{$print_name}; - } - init_item($print_name, $init, $involves_r, $size, $adj, $pack, $sign); - $op_to_name[$spec_opnum] = $instr; + my $adj = $info->{'adj'}; + my $size = $info->{'size'}; + my $pack_spec = $info->{'pack_spec'}; + my $sign = join '', @args; + init_item($print_name, $init, $involves_r, $size, $adj, $pack_spec, $sign); + $op_to_name[$spec_opnum] = $print_name; $spec_opnum++; } } @@ -718,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"; @@ -835,6 +853,13 @@ sub emulator_output { print_code(COLD); } +sub print_name { + my($name,@args) = @_; + my $sign = join '', @args; + $sign =~ s/[?]//g; + $sign ne '' ? "${name}_$sign" : $name; +} + sub init_item { my($sep) = ""; @@ -951,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 { @@ -1090,8 +1129,27 @@ sub combine_instruction_group { # Variables. my %offsets; my @instrs; - my %num_references; - my $group_size = 0; + 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 @@ -1108,8 +1166,9 @@ sub combine_instruction_group { my $offset = 0; my @rest = @args; my @new_subs; - my $opcase = $specific; - $opcase .= "_" . join '', @args if @args; + my $print_name = print_name($specific, @args); + my $opcase = $print_name; + my $last = $subs[$#subs]; foreach my $s (@subs) { my $code = $c_code{$s}; my(undef,undef,@c_args) = @{$code}; @@ -1117,16 +1176,18 @@ sub combine_instruction_group { foreach (0..$#c_args) { push @first, shift @rest; } - my($size,undef) = basic_generator($s, 0, '', 0, undef, @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; + 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 = ''; } - $group_size = $offset if $group_size < $offset; + $spec_op_info{$print_name}->{'size'} = $offset + 1; + $group_size = $offset if $group_size >= $offset; push @instrs, [$specific_key,@new_subs]; } } @@ -1140,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]; } } @@ -1150,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; @@ -1162,6 +1222,8 @@ sub combine_instruction_group { # Now generate the code for the entire group. my $offset = 0; my @opcase_labels; + my %down; + my %up; for(my $i = 0; $i < @slots; $i++) { my $key = $slots[$i]; @@ -1182,36 +1244,69 @@ sub combine_instruction_group { my $seen_key = "$label:$next:" . scalar(@first); next if $opcase eq '' and $seen{$seen_key}; $seen{$seen_key} = 1; + $seen_key .= $opcase; if ($opcase ne '') { $gcode .= "OpCase($opcase):\n"; push @opcase_labels, $opcase; - $group_size{$opcase} = $group_size + 1; } - if ($num_references{$label}) { + if ($num_references{$s}) { $gcode .= "$label:\n"; } my $flags = ''; my $transfer_to_next = ''; - my $dec = 0; + my $inc = 0; unless ($i == $#slots) { $flags = "-no_next"; my $next_offset = $label_to_offset{$next}; - $dec = $next_offset - ($offset + $size); - $transfer_to_next = "I -= $dec;\n" if $dec; + $inc = ($offset + $size) - $next_offset; + $transfer_to_next = "I += $inc;\n" if $inc; $transfer_to_next .= "goto $next;\n\n"; } - my(undef,$gen_code) = - basic_generator($s, 0, $flags, $offset, - $group_size-$offset-$dec, @first); + my($gen_code,$down,$up) = + 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; $gcode .= $gen_code . $transfer_to_next; } $offset = $order_to_offset{$slots[$i+1]} if $i < $#slots; } + foreach my $print_name (@opcase_labels) { + my $info = $spec_op_info{$print_name}; + $info->{'adj'} = $info->{'size'} - $group_size - 1; + } + + # + # Assemble pack specifications for all instructions in the group. + # + foreach my $instr (@instrs) { + my(undef,@subs) = @{$instr}; + my $down = ''; + my $up = ''; + for (my $i = 0; $i < @subs; $i++) { + my($opcase,$label) = @{$subs[$i]}; + my $spec_label = "$opcase$label"; + if (defined $down{$spec_label}) { + $down = $down{$spec_label} . $down; + $up = $up . $up{$spec_label}; + } + } + my $print_name = $subs[0]->[0]; + my $info = $spec_op_info{$print_name}; + $info->{'pack_spec'} = build_pack_spec("$down:$up"); + } + ($group_hotness,"{\n$gcode\n}\n\n",@opcase_labels); } @@ -1223,12 +1318,56 @@ sub micro_label { # -# Basic implementation of instruction in emulator loop -# (assuming no packing). +# Basic code generation for one instruction. +# + +sub cg_basic { + 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); +} + +# +# Calculate size for a micro instruction. # -sub basic_generator { - my($name,$hot,$extra_comments,$offset,$group_size,@args) = @_; +sub cg_combined_size { + my %params = (@_, pack_options => \@basic_pack_options); + $params{pack_options} = \@extended_pack_options + if $params{first}; + my($size) = code_gen(%params); + $size; +} + +# +# Generate code for a micro instruction. +# + +sub cg_combined_code { + 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 { + my($down,$up) = split /:/, $pack_spec; + ($code,$down,$up); + } +} + +sub code_gen { + 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; @@ -1242,8 +1381,9 @@ sub basic_generator { # my $c_code_ref = $c_code{$name}; - if ($hot and defined $c_code_ref and $name ne 'catch') { - ($var_decls, $pack_spec, @args) = do_pack(@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); } # @@ -1253,6 +1393,7 @@ sub basic_generator { my $need_block = 0; my $arg_offset = $offset; + @args = map { s/[?]$//g; $_ } @args; foreach (@args) { my($this_size) = $arg_size{$_}; SWITCH: @@ -1315,7 +1456,7 @@ sub basic_generator { 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. @@ -1334,6 +1475,7 @@ sub basic_generator { $bindings{$var} = $f[$i]; } $bindings{'NEXT_INSTRUCTION'} = "I+" . ($group_size+$offset+1); + $bindings{'IP_ADJUSTMENT'} = $inc; $c_code = eval { expand_all($c_code, \%bindings) }; unless (defined $c_code) { warn $@; @@ -1356,11 +1498,10 @@ sub basic_generator { "ASSERT(VALID_INSTR(*I));\n" . "Goto(*I);"; } else { - $var_decls .= "BeamInstr* _nextpf = " . - "(BeamInstr *) I[$instr_offset];\n"; + $var_decls .= "BeamInstr next_pf = BeamCodeAddr(I[$instr_offset]);\n"; $dispatch_next = "\nI += $instr_offset;\n" . - "ASSERT(VALID_INSTR(_nextpf));\n" . - "Goto(_nextpf);"; + "ASSERT(VALID_INSTR(next_pf));\n" . + "GotoPF(next_pf);"; } # @@ -1457,7 +1598,7 @@ sub expand_macro { my %new_bindings; # Keep the special, pre-defined bindings. - foreach my $key (qw(NEXT_INSTRUCTION)) { + foreach my $key (qw(NEXT_INSTRUCTION IP_ADJUSTMENT)) { $new_bindings{$key} = $bindings{$key}; } @@ -1519,9 +1660,51 @@ sub needs_do_wrapper { } sub do_pack { - my(@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. @@ -1535,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; + } } # @@ -1547,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. @@ -1611,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 { @@ -1644,13 +1829,19 @@ sub do_pack { # beginning). my $up = ''; # Pack commands (storing back while # moving forward). - my $did_some_packing = 0; # Nothing packed yet. + 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} and $did_some_packing) { + 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'}) { @@ -1662,11 +1853,6 @@ sub do_pack { } $down = "$push${down}"; $up = "${up}p"; - } else { - # The argument has either zero size (e.g. r(0)), - # or is to the left of the first packed argument - # and will never be accessed. No need to do - # anything. } }; @@ -1675,44 +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; - $did_some_packing = 1; if ($ap == 0) { - $pack_prefix .= "Eterm $packed_var = " . - arg_offset($size) . ";\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 { @@ -1727,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 $pack_spec = "$down:$up"; + 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 { @@ -1744,6 +2031,17 @@ sub make_unpack { $e; } +sub build_pack_spec { + my $pack_spec = shift; + return '' if $pack_spec eq ''; + my($down,$up) = split /:/, $pack_spec; + while ($down =~ /[gfq]$/ and $up =~ /^p/) { + $down = substr($down, 0, -1); + $up = substr($up, 1); + } + "$down$up"; +} + sub quote { local($_) = @_; return "'$_'" if $_ eq 'try'; diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 452f3dcc07..181a718287 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam Binary files differindex 267b5cb0a8..5048bdb846 100644 --- a/erts/preloaded/ebin/zlib.beam +++ b/erts/preloaded/ebin/zlib.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index c6c105d36a..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 diff --git a/erts/preloaded/src/erts.app.src b/erts/preloaded/src/erts.app.src index 7ab06164b4..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.0", "kernel-5.0", "sasl-3.0.1"]} + {runtime_dependencies, ["stdlib-3.5", "kernel-6.0", "sasl-3.0.1"]} ]}. %% vim: ft=erlang diff --git a/erts/preloaded/src/zlib.erl b/erts/preloaded/src/zlib.erl index dca5a42779..3170ab6351 100644 --- a/erts/preloaded/src/zlib.erl +++ b/erts/preloaded/src/zlib.erl @@ -23,7 +23,7 @@ -export([open/0,close/1,deflateInit/1,deflateInit/2,deflateInit/6, deflateSetDictionary/2,deflateReset/1,deflateParams/3, deflate/2,deflate/3,deflateEnd/1, - inflateInit/1,inflateInit/2, + inflateInit/1,inflateInit/2,inflateInit/3, inflateSetDictionary/2,inflateGetDictionary/1, inflateReset/1, inflate/2,inflate/3,inflateEnd/1, inflateChunk/2,inflateChunk/1, @@ -68,6 +68,13 @@ -define(MAX_WBITS, 15). +-define(DEFAULT_MEMLEVEL, 8). +-define(DEFAULT_WBITS, 15). + +-define(EOS_BEHAVIOR_ERROR, 0). +-define(EOS_BEHAVIOR_RESET, 1). +-define(EOS_BEHAVIOR_CUT, 2). + %% Chunk sizes are hardcoded on account of them screwing with the %% predictability of the system. zlib is incapable of trapping so we need to %% ensure that it never operates on any significant amount of data. @@ -130,10 +137,7 @@ deflateInit(Z) -> Z :: zstream(), Level :: zlevel(). deflateInit(Z, Level) -> - deflateInit_nif(Z, arg_level(Level)). - -deflateInit_nif(_Z, _Level) -> - erlang:nif_error(undef). + deflateInit(Z, Level, deflated, ?DEFAULT_WBITS, ?DEFAULT_MEMLEVEL, default). -spec deflateInit(Z, Level, Method, WindowBits, MemLevel, Strategy) -> 'ok' when Z :: zstream(), @@ -225,16 +229,21 @@ deflateEnd_nif(_Z) -> -spec inflateInit(Z) -> 'ok' when Z :: zstream(). inflateInit(Z) -> - inflateInit_nif(Z). -inflateInit_nif(_Z) -> - erlang:nif_error(undef). + inflateInit(Z, ?DEFAULT_WBITS). -spec inflateInit(Z, WindowBits) -> 'ok' when Z :: zstream(), WindowBits :: zwindowbits(). inflateInit(Z, WindowBits) -> - inflateInit_nif(Z, WindowBits). -inflateInit_nif(_Z, _WindowBits) -> + inflateInit(Z, WindowBits, cut). + +-spec inflateInit(Z, WindowBits, EoSBehavior) -> 'ok' when + Z :: zstream(), + WindowBits :: zwindowbits(), + EoSBehavior :: error | reset | cut. +inflateInit(Z, WindowBits, EoSBehavior) -> + inflateInit_nif(Z, arg_bitsz(WindowBits), arg_eos_behavior(EoSBehavior)). +inflateInit_nif(_Z, _WindowBits, _EoSBehavior) -> erlang:nif_error(undef). -spec inflateSetDictionary(Z, Dictionary) -> 'ok' when @@ -532,7 +541,7 @@ gzip(Data) -> gunzip(Data) -> Z = open(), Bs = try - inflateInit(Z, 16+?MAX_WBITS), + inflateInit(Z, 16+?MAX_WBITS, reset), B = inflate(Z, Data), inflateEnd(Z), B @@ -652,6 +661,11 @@ arg_strategy(_) -> erlang:error(bad_compression_strategy). arg_method(deflated) -> ?Z_DEFLATED; arg_method(_) -> erlang:error(bad_compression_method). +arg_eos_behavior(error) -> ?EOS_BEHAVIOR_ERROR; +arg_eos_behavior(reset) -> ?EOS_BEHAVIOR_RESET; +arg_eos_behavior(cut) -> ?EOS_BEHAVIOR_CUT; +arg_eos_behavior(_) -> erlang:error(bad_eos_behavior). + -spec arg_bitsz(zwindowbits()) -> zwindowbits(). arg_bitsz(Bits) when is_integer(Bits) andalso ((8 =< Bits andalso Bits < 48) orelse @@ -678,4 +692,4 @@ enqueue_input_1(Z, IOVec) -> end. enqueue_nif(_Z, _IOVec) -> - erlang:nif_error(undef).
\ No newline at end of file + erlang:nif_error(undef). diff --git a/erts/test/erlexec_SUITE.erl b/erts/test/erlexec_SUITE.erl index 44d7f63387..db993abe52 100644 --- a/erts/test/erlexec_SUITE.erl +++ b/erts/test/erlexec_SUITE.erl @@ -59,7 +59,7 @@ otp_8209(Config) when is_list(Config) -> {ok,[[PName]]} = init:get_argument(progname), SNameS = "erlexec_test_01", SName = list_to_atom(SNameS++"@"++ - hd(tl(string:tokens(atom_to_list(node()),"@")))), + hd(tl(string:lexemes(atom_to_list(node()),"@")))), Cmd = PName ++ " dummy_param -sname "++SNameS++" -setcookie "++ atom_to_list(erlang:get_cookie()), open_port({spawn,Cmd},[]), @@ -75,7 +75,7 @@ cleanup_node(SNameS,0) -> {error, {would_not_die,list_to_atom(SNameS)}}; cleanup_node(SNameS,N) -> SName = list_to_atom(SNameS++"@"++ - hd(tl(string:tokens(atom_to_list(node()),"@")))), + hd(tl(string:lexemes(atom_to_list(node()),"@")))), case rpc:call(SName,init,stop,[]) of {badrpc,_} -> ok; @@ -322,7 +322,7 @@ zdbbl_dist_buf_busy_limit(Config) when is_list(Config) -> {ok,[[PName]]} = init:get_argument(progname), SNameS = "erlexec_test_02", SName = list_to_atom(SNameS++"@"++ - hd(tl(string:tokens(atom_to_list(node()),"@")))), + hd(tl(string:lexemes(atom_to_list(node()),"@")))), Cmd = PName ++ " -sname "++SNameS++" -setcookie "++ atom_to_list(erlang:get_cookie()) ++ " +zdbbl " ++ integer_to_list(LimKB), @@ -400,7 +400,7 @@ emu_args(CmdLineArgs) -> {ok,[[Erl]]} = init:get_argument(progname), EmuCL = os:cmd(Erl ++ " -emu_args_exit " ++ CmdLineArgs), io:format("EmuCL = ~ts", [EmuCL]), - split_emu_clt(string:tokens(EmuCL, [$ ,$\t,$\n,$\r])). + split_emu_clt(string:lexemes(EmuCL, [$ ,$\t,$\n,$\r])). split_emu_clt(EmuCLT) -> split_emu_clt(EmuCLT, [], [], [], emu). diff --git a/erts/test/install_SUITE.erl b/erts/test/install_SUITE.erl index d6c6d6f30e..324b398caa 100644 --- a/erts/test/install_SUITE.erl +++ b/erts/test/install_SUITE.erl @@ -580,7 +580,7 @@ end_per_testcase(_Case, _Config) -> ok. make_dirs(Root, Suffix) -> - do_make_dirs(Root, string:tokens(Suffix, [$/])). + do_make_dirs(Root, string:lexemes(Suffix, [$/])). do_make_dirs(_Root, []) -> ""; @@ -709,4 +709,4 @@ join("") -> join([""|Ds]) -> join(Ds); join([D|Ds]) -> - "/" ++ string:strip(D, both, $/) ++ join(Ds). + "/" ++ string:trim(D, both, [$/]) ++ join(Ds). diff --git a/erts/test/nt_SUITE.erl b/erts/test/nt_SUITE.erl index 624e5484ba..3081b58835 100644 --- a/erts/test/nt_SUITE.erl +++ b/erts/test/nt_SUITE.erl @@ -117,7 +117,7 @@ wait_for_node(Name) -> do_wait_for_it(FullName,30). make_full_name(Name) -> - [_,Suffix] = string:tokens(atom_to_list(node()),"@"), + [_,Suffix] = string:lexemes(atom_to_list(node()),"@"), list_to_atom(Name ++ "@" ++ Suffix). @@ -171,7 +171,7 @@ service_env(Config) when is_list(Config) -> ["ERLSRV_SERVICE_NAME"]), "erlsrv.exe" = filename:basename( hd( - string:tokens( + string:lexemes( rpc:call(make_full_name(Name), os, getenv, diff --git a/erts/test/otp_SUITE.erl b/erts/test/otp_SUITE.erl index 54fcfd935f..3abe45c141 100644 --- a/erts/test/otp_SUITE.erl +++ b/erts/test/otp_SUITE.erl @@ -336,7 +336,7 @@ not_recommended_calls(Config, Apps0, MFA) -> _ -> AppStrings = [atom_to_list(A) || A <- SkippedApps], Mess = io_lib:format("Application(s) not present: ~s\n", - [string:join(AppStrings, ", ")]), + [lists:join(", ", AppStrings)]), {comment, Mess} end; _ -> @@ -463,7 +463,7 @@ runtime_dependencies(Config) -> have_rdep(_App, [], _Dep) -> false; have_rdep(App, [RDep | RDeps], Dep) -> - [AppStr, _VsnStr] = string:tokens(RDep, "-"), + [AppStr, _VsnStr] = string:lexemes(RDep, "-"), case Dep == list_to_atom(AppStr) of true -> io:format("~p -> ~s~n", [App, RDep]), diff --git a/erts/test/run_erl_SUITE.erl b/erts/test/run_erl_SUITE.erl index fe1ccba1e2..08edd930b4 100644 --- a/erts/test/run_erl_SUITE.erl +++ b/erts/test/run_erl_SUITE.erl @@ -255,7 +255,7 @@ do_run_erl(Config, Case, Opt) -> net_kernel:monitor_nodes(true), open_port({spawn,Cmd}, []), - [_,Host] = string:tokens(atom_to_list(node()), "@"), + [_,Host] = string:lexemes(atom_to_list(node()), "@"), Node = list_to_atom(NodeName++"@"++Host), receive diff --git a/erts/test/upgrade_SUITE.erl b/erts/test/upgrade_SUITE.erl index a5639d927d..31ceb06314 100644 --- a/erts/test/upgrade_SUITE.erl +++ b/erts/test/upgrade_SUITE.erl @@ -287,7 +287,7 @@ create_relfile(Node,CreateDir,RelName0,RelVsn) -> true -> case filename:split(Path) -- SplitLibDir of [AppVsn,"ebin"] -> - case string:tokens(AppVsn,"-") of + case string:lexemes(AppVsn,"-") of [AppStr,Vsn] -> App = list_to_atom(AppStr), case lists:member(App,Exclude) of diff --git a/erts/test/z_SUITE.erl b/erts/test/z_SUITE.erl index d474c71c4f..cd7a894eb5 100644 --- a/erts/test/z_SUITE.erl +++ b/erts/test/z_SUITE.erl @@ -132,22 +132,9 @@ core_search_conf(RunByTS, DBTop, XDir) -> file_inspect(#core_search_conf{file = File}, Core) -> FRes0 = os:cmd(File ++ " " ++ Core), - FRes = case string:str(FRes0, Core) of - 0 -> - FRes0; - S -> - L = length(FRes0), - E = length(Core), - case S of - 1 -> - lists:sublist(FRes0, E+1, L+1); - _ -> - lists:sublist(FRes0, 1, S-1) - ++ - " " - ++ - lists:sublist(FRes0, E+1, L+1) - end + FRes = case string:split(FRes0, Core) of + [S1] -> S1; + [S1,S2] -> lists:flatten(S1 ++ " " ++ S2) end, case re:run(FRes, "text|ascii", [caseless,{capture,none}]) of match -> @@ -194,9 +181,6 @@ mod_time_list(F) -> [0,0,0,0,0,0] end. -str_strip(S) -> - string:strip(string:strip(string:strip(S), both, $\n), both, $\r). - dump_core(#core_search_conf{ cerl = false }, _) -> ok; dump_core(_, {ignore, _Core}) -> @@ -232,7 +216,7 @@ format_core(#core_search_conf{file = false}, Core, Ignore) -> io:format(" ~s~s " ++ time_fstr() ++ "~s~n", [Ignore, Core] ++ mod_time_list(Core)); format_core(#core_search_conf{file = File}, Core, Ignore) -> - FRes = str_strip(os:cmd(File ++ " " ++ Core)), + FRes = string:trim(os:cmd(File ++ " " ++ Core)), case catch re:run(FRes, Core, [caseless,{capture,none}]) of match -> io:format(" ~s~s " ++ time_fstr() ++ "~n", diff --git a/erts/vsn.mk b/erts/vsn.mk index c231c9c27d..3d7ff2db66 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% # -VSN = 9.0.5 +VSN = 9.1.2 # Port number 4365 in 4.2 # Port number 4366 in 4.3 |