diff options
Diffstat (limited to 'erts')
113 files changed, 3823 insertions, 2044 deletions
diff --git a/erts/Makefile.in b/erts/Makefile.in index 2e63fc469e..8b86fbadf2 100644 --- a/erts/Makefile.in +++ b/erts/Makefile.in @@ -16,6 +16,9 @@ # # %CopyrightEnd% # + +.NOTPARALLEL: + include $(ERL_TOP)/make/target.mk include vsn.mk diff --git a/erts/aclocal.m4 b/erts/aclocal.m4 index 231e176d1b..bd228a2d1f 100644 --- a/erts/aclocal.m4 +++ b/erts/aclocal.m4 @@ -1366,8 +1366,6 @@ case "$GCC-$host_cpu" in ;; esac - - AC_DEFINE(ETHR_HAVE_ETHREAD_DEFINES, 1, \ [Define if you have all ethread defines]) @@ -1648,11 +1646,11 @@ dnl Freely inspired by AC_TRY_LINK. (Maybe better to create a dnl AC_LANG_JAVA instead...) AC_DEFUN(ERL_TRY_LINK_JAVA, [java_link='$JAVAC conftest.java 1>&AC_FD_CC' -changequote(�, �)dnl +changequote(, )dnl cat > conftest.java <<EOF -�$1� +$1 class conftest { public static void main(String[] args) { - �$2� + $2 ; return; }} EOF changequote([, ])dnl diff --git a/erts/autoconf/win32.config.cache.static b/erts/autoconf/win32.config.cache.static index d25b1df9d9..b387db2b22 100755 --- a/erts/autoconf/win32.config.cache.static +++ b/erts/autoconf/win32.config.cache.static @@ -96,7 +96,6 @@ ac_cv_func_sbrk=${ac_cv_func_sbrk=no} ac_cv_func_select=${ac_cv_func_select=no} ac_cv_func_setlocale=${ac_cv_func_setlocale=yes} ac_cv_func_setsid=${ac_cv_func_setsid=no} -ac_cv_func_setvbuf_reversed=${ac_cv_func_setvbuf_reversed=yes} ac_cv_func_socket=${ac_cv_func_socket=no} ac_cv_func_strchr=${ac_cv_func_strchr=yes} ac_cv_func_strerror=${ac_cv_func_strerror=yes} @@ -124,7 +123,6 @@ ac_cv_header_ieeefp_h=${ac_cv_header_ieeefp_h=no} ac_cv_header_inttypes_h=${ac_cv_header_inttypes_h=no} ac_cv_header_langinfo_h=${ac_cv_header_langinfo_h=no} ac_cv_header_limits_h=${ac_cv_header_limits_h=yes} -ac_cv_header_mach_o_dyld_h=${ac_cv_header_mach_o_dyld_h=no} ac_cv_header_malloc_h=${ac_cv_header_malloc_h=yes} ac_cv_header_memory_h=${ac_cv_header_memory_h=yes} ac_cv_header_net_errno_h=${ac_cv_header_net_errno_h=no} diff --git a/erts/configure.in b/erts/configure.in index 1e497332de..fafa1c7e92 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -907,16 +907,6 @@ fi AC_SUBST(ERLANG_OSTYPE) -dnl Which sysv4 would this be, and what is it for??? -dnl XXX: replace with feature tests. -case $host_os in - sysv4*) - AC_DEFINE(SOCKOPT_CONNECT_STAT,[],[Obscure SYSV feature]) - AC_DEFINE(NO_PRAGMA_WEAK,[],[Obscure SYSV feature]) - LIBS="$LIBS -lgen -lc -L /usr/ucblib -lucb" - ;; -esac - # Check how to export functions from the emulator executable, needed # when dynamically loaded drivers are loaded (so that they can find # emulator functions). @@ -1477,7 +1467,7 @@ AC_CHECK_HEADERS(fcntl.h limits.h unistd.h syslog.h dlfcn.h ieeefp.h \ sys/types.h sys/stropts.h sys/sysctl.h \ sys/ioctl.h sys/time.h sys/uio.h \ sys/socket.h sys/sockio.h sys/socketio.h \ - net/errno.h malloc.h mach-o/dyld.h arpa/nameser.h \ + net/errno.h malloc.h arpa/nameser.h \ pty.h util.h utmp.h langinfo.h poll.h sdkddkver.h) AC_CHECK_HEADER(sys/resource.h, @@ -1802,11 +1792,6 @@ AC_CHECK_FUNCS([ieee_handler fpsetmask finite isnan isinf res_gethostbyname dlop AC_CHECK_DECLS([posix2time],,,[#include <time.h>]) -if test "X$host" = "Xwin32"; then - ac_cv_func_setvbuf_reversed=yes -fi -AC_FUNC_SETVBUF_REVERSED - disable_vfork=false if test "x$EMU_THR_LIB_NAME" != "x"; then AC_MSG_CHECKING([if vfork is known to hang multithreaded applications]) @@ -4305,7 +4290,6 @@ dnl Note that the output files are relative to $srcdir AC_OUTPUT( emulator/$host/Makefile:emulator/Makefile.in emulator/zlib/$host/Makefile:emulator/zlib/Makefile.in - emulator/pcre/$host/Makefile:emulator/pcre/Makefile.in epmd/src/$host/Makefile:epmd/src/Makefile.in etc/common/$host/Makefile:etc/common/Makefile.in include/internal/$host/ethread.mk:include/internal/ethread.mk.in @@ -4319,7 +4303,7 @@ dnl The ones below should be moved to their respective lib dnl ../lib/ic/c_src/$host/Makefile:../lib/ic/c_src/Makefile.in ../lib/os_mon/c_src/$host/Makefile:../lib/os_mon/c_src/Makefile.in - ../lib/ssl/c_src/$host/Makefile:../lib/ssl/c_src/Makefile.in +dnl ../lib/ssl/c_src/$host/Makefile:../lib/ssl/c_src/Makefile.in ../lib/crypto/c_src/$host/Makefile:../lib/crypto/c_src/Makefile.in ../lib/orber/c_src/$host/Makefile:../lib/orber/c_src/Makefile.in ../lib/runtime_tools/c_src/$host/Makefile:../lib/runtime_tools/c_src/Makefile.in diff --git a/erts/doc/src/absform.xml b/erts/doc/src/absform.xml index 4c84412dd6..88e8b284fb 100644 --- a/erts/doc/src/absform.xml +++ b/erts/doc/src/absform.xml @@ -285,7 +285,8 @@ <item>If E is <c><![CDATA[fun Name / Arity]]></c>, then Rep(E) = <c><![CDATA[{'fun',LINE,{function,Name,Arity}}]]></c>.</item> <item>If E is <c><![CDATA[fun Module:Name/Arity]]></c>, then - Rep(E) = <c><![CDATA[{'fun',LINE,{function,Module,Name,Arity}}]]></c>.</item> + Rep(E) = <c><![CDATA[{'fun',LINE,{function,Rep(Module),Rep(Name),Rep(Arity)}}]]></c>. + (Before the R15 release: Rep(E) = <c><![CDATA[{'fun',LINE,{function,Module,Name,Arity}}]]></c>.)</item> <item>If E is <c><![CDATA[fun Fc_1 ; ... ; Fc_k end]]></c> where each <c><![CDATA[Fc_i]]></c> is a function clause then Rep(E) = <c><![CDATA[{'fun',LINE,{clauses,[Rep(Fc_1), ..., Rep(Fc_k)]}}]]></c>.</item> diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index 02082e57c6..39c79a29df 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -587,6 +587,13 @@ <p>Enables auto load tracing, displaying info while loading code.</p> </item> + <tag><c><![CDATA[+L]]></c></tag> + <item> + <p>Don't load information about source filenames and line numbers. + This will save some memory, but exceptions will not contain + information about the filenames and line numbers. + </p> + </item> <tag><marker id="erts_alloc"><c><![CDATA[+MFlag Value]]></c></marker></tag> <item> <p>Memory allocator specific flags, see @@ -987,7 +994,7 @@ the <c><![CDATA[-extra]]></c> section, i.e. the end of the command line following after an <c><![CDATA[-extra]]></c> flag.</p> </item> - <tag><c><![CDATA[ERL_ZFLAGS]]></c>and <c><![CDATA[ERL_FLAGS]]></c></tag> + <tag><c><![CDATA[ERL_ZFLAGS]]></c> and <c><![CDATA[ERL_FLAGS]]></c></tag> <item> <p>The content of these environment variables will be added to the end of the command line for <c><![CDATA[erl]]></c>.</p> diff --git a/erts/doc/src/erl_ext_fig.gif b/erts/doc/src/erl_ext_fig.gif Binary files differindex 14d6bbc871..14d6bbc871 100755..100644 --- a/erts/doc/src/erl_ext_fig.gif +++ b/erts/doc/src/erl_ext_fig.gif diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 48839e9081..8daa67aa87 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -692,6 +692,10 @@ typedef enum { <fsummary>Determine if a term is an exception</fsummary> <desc><p>Return true if <c>term</c> is an exception.</p></desc> </func> + <func><name><ret>int</ret><nametext>enif_is_number(ErlNifEnv* env, ERL_NIF_TERM term)</nametext></name> + <fsummary>Determine if a term is a number (integer or float)</fsummary> + <desc><p>Return true if <c>term</c> is a number.</p></desc> + </func> <func><name><ret>int</ret><nametext>enif_is_fun(ErlNifEnv* env, ERL_NIF_TERM term)</nametext></name> <fsummary>Determine if a term is a fun</fsummary> <desc><p>Return true if <c>term</c> is a fun.</p></desc> @@ -822,6 +826,13 @@ typedef enum { <desc><p>Create an ordinary list containing the elements of array <c>arr</c> of length <c>cnt</c>. An empty list is returned if <c>cnt</c> is 0.</p></desc> </func> + <func><name><ret>int</ret><nametext>enif_make_reverse_list(ErlNifEnv* env, ERL_NIF_TERM term, ERL_NIF_TERM *list)</nametext></name> + <fsummary>Create the reverse list of the list <c>term</c>.</fsummary> + <desc><p>Set <c>*list</c> to the reverse list of the list <c>term</c> and return true, + or return false if <c>term</c> is not a list. This function should only be used on + short lists as a copy will be created of the list which will not be released until after the + nif returns.</p></desc> + </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_long(ErlNifEnv* env, long int i)</nametext></name> <fsummary>Create an integer term from a long int</fsummary> <desc><p>Create an integer term from a <c>long int</c>.</p></desc> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index aef31f5b98..b923a5f1fc 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -550,15 +550,6 @@ false</pre> </desc> </func> <func> - <name name="concat_binary" arity="1"/> - <fsummary>Concatenate a list of binaries (deprecated)</fsummary> - <desc> - <p>Do not use; use - <seealso marker="#list_to_binary/1">list_to_binary/1</seealso> - instead.</p> - </desc> - </func> - <func> <name>erlang:crc32(Data) -> integer() >= 0</name> <fsummary>Compute crc32 (IEEE 802.3) checksum</fsummary> <type> @@ -811,8 +802,7 @@ false</pre> <type> <v>MonitorRef = reference()</v> <v>OptionList = [Option]</v> - <v>Option = flush</v> - <v>Option = info</v> + <v> Option = flush | info</v> </type> <desc> <p>The returned value is <c>true</c> unless <c>info</c> is part @@ -1205,11 +1195,16 @@ true </item> <tag><c>{new_uniq, Uniq}</c></tag> <item> - <p><c>Uniq</c> (a binary) is a unique value for this fun.</p> + <p><c>Uniq</c> (a binary) is a unique value for this fun. + It is calculated from the compiled code for the entire module.</p> </item> <tag><c>{uniq, Uniq}</c></tag> <item> - <p><c>Uniq</c> (an integer) is a unique value for this fun.</p> + <p><c>Uniq</c> (an integer) is a unique value for this fun. + Starting in the R15 release, this integer is calculated from + the compiled code for the entire module. Before R15, this + integer was based on only the body of the fun. + </p> </item> </taglist> </desc> @@ -1353,17 +1348,18 @@ true </desc> </func> <func> - <name>erlang:get_stacktrace() -> [{Module, Function, Arity | Args}]</name> + <name>erlang:get_stacktrace() -> [{Module, Function, Arity | Args, Location}]</name> <fsummary>Get the call stack back-trace of the last exception</fsummary> <type> <v>Module = Function = atom()</v> <v>Arity = arity()</v> <v>Args = [term()]</v> + <v>Location = [{atom(),term()}]</v> </type> <desc> <p>Get the call stack back-trace (<em>stacktrace</em>) of the last exception in the calling process as a list of - <c>{Module,Function,Arity}</c> tuples. + <c>{Module,Function,Arity,Location}</c> tuples. The <c>Arity</c> field in the first tuple may be the argument list of that function call instead of an arity integer, depending on the exception.</p> @@ -1373,6 +1369,25 @@ true <p>The stacktrace is the same data as the <c>catch</c> operator returns, for example:</p> <p><c>{'EXIT',{badarg,Stacktrace}} = catch abs(x)</c></p> + <p><c>Location</c> is a (possibly empty) list of two-tuples that + may indicate the location in the source code of the function. + The first element is an atom that describes the type of + information in the second element. Currently the following + items may occur:</p> + <taglist> + <tag><c>file</c></tag> + <item> + <p>The second element of the tuple is a string (list of + characters) representing the filename of the source file + of the function.</p> + </item> + <tag><c>line</c></tag> + <item> + <p>The second element of the tuple is the line number + (an integer greater than zero) in the source file + where the exception occurred or the function was called.</p> + </item> + </taglist> <p>See also <seealso marker="#error/1">erlang:error/1</seealso> and <seealso marker="#error/2">erlang:error/2</seealso>.</p> @@ -3880,11 +3895,26 @@ os_prompt%</pre> catches in this process. This <c>InfoTuple</c> may be changed or removed without prior notice.</p> </item> - <tag><c>{current_function, {Module, Function, Args}}</c></tag> + <tag><c>{current_function, {Module, Function, Arity}}</c></tag> <item> - <p><c>Module</c>, <c>Function</c>, <c>Args</c> is + <p><c>Module</c>, <c>Function</c>, <c>Arity</c> is the current function call of the process.</p> </item> + <tag><c>{current_location, {Module, Function, Arity, Location}}</c></tag> + <item> + <p><c>Module</c>, <c>Function</c>, <c>Arity</c> is + the current function call of the process. + <c>Location</c> is a list of two-tuples that describes the + location in the source code. + </p> + </item> + <tag><c>{current_stacktrace, Stack}</c></tag> + <item> + <p>Return the current call stack back-trace (<em>stacktrace</em>) + of the process. The stack has the same format as returned by + <seealso marker="#get_stacktrace/1">erlang:get_stacktrace/0</seealso>. + </p> + </item> <tag><c>{dictionary, Dictionary}</c></tag> <item> <p><c>Dictionary</c> is the dictionary of the process.</p> @@ -4151,11 +4181,14 @@ os_prompt%</pre> equivalent to <c>erlang:Class(Reason)</c>. <c>Reason</c> is any term and <c>Stacktrace</c> is a list as returned from <c>get_stacktrace()</c>, that is a list of - 3-tuples <c>{Module, Function, Arity | Args}</c> where - <c>Module</c> and <c>Function</c> are atoms and the third - element is an integer arity or an argument list. The - stacktrace may also contain <c>{Fun, Args}</c> tuples where + 4-tuples <c>{Module, Function, Arity | Args, + Location}</c> where <c>Module</c> and <c>Function</c> + are atoms and the third element is an integer arity or an + argument list. The stacktrace may also contain <c>{Fun, + Args, Location}</c> tuples where <c>Fun</c> is a local fun and <c>Args</c> is an argument list.</p> + <p>The <c>Location</c> element at the end is optional. + Omitting it is equivalent to specifying an empty list.</p> <p>The stacktrace is used as the exception stacktrace for the calling process; it will be truncated to the current maximum stacktrace depth.</p> diff --git a/erts/doc/src/make.dep b/erts/doc/src/make.dep deleted file mode 100644 index 98bac78235..0000000000 --- a/erts/doc/src/make.dep +++ /dev/null @@ -1,32 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/gandalf/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: absform.tex alt_dist.tex book.tex crash_dump.tex \ - driver.tex driver_entry.tex epmd.tex erl.tex \ - erl_dist_protocol.tex erl_driver.tex erl_ext_dist.tex \ - erl_prim_loader.tex erl_set_memory_block.tex \ - erlang.tex erlc.tex erlsrv.tex erts_alloc.tex \ - escript.tex inet_cfg.tex init.tex match_spec.tex \ - part.tex ref_man.tex run_erl.tex start.tex \ - start_erl.tex tty.tex werl.tex zlib.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: erl_ext_fig.ps - diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 15244a6589..708d4ca0a3 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -291,7 +291,8 @@ else LIBS += $(ERL_TOP)/erts/emulator/pcre/obj/$(TARGET)/$(TYPE)/$(LIB_PREFIX)epcre$(LIB_SUFFIX) endif -DEPLIBS += $(ERL_TOP)/erts/emulator/pcre/obj/$(TARGET)/$(TYPE)/$(LIB_PREFIX)epcre$(LIB_SUFFIX) +EPCRE_LIB = $(ERL_TOP)/erts/emulator/pcre/obj/$(TARGET)/$(TYPE)/$(LIB_PREFIX)epcre$(LIB_SUFFIX) +DEPLIBS += $(EPCRE_LIB) PERFCTR_PATH=@PERFCTR_PATH@ USE_PERFCTR=@USE_PERFCTR@ @@ -382,7 +383,7 @@ ifeq ($(FLAVOR)-@ERTS_BUILD_SMP_EMU@,smp-no) all: @echo '*** Omitted build of emulator with smp support' else -all: generate erts_lib zlib pcre $(BINDIR)/$(EMULATOR_EXECUTABLE) $(UNIX_ONLY_BUILDS) +all: generate erts_lib zlib $(BINDIR)/$(EMULATOR_EXECUTABLE) $(UNIX_ONLY_BUILDS) ifeq ($(OMIT_OMIT_FP),yes) @echo '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *' @echo '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *' @@ -403,8 +404,8 @@ zlib: @set -e ; cd zlib && $(MAKE) TYPE=$(TYPE) $(TYPE) endif -pcre: - @set -e ; cd pcre && $(MAKE) TYPE=$(TYPE) $(TYPE) + +include pcre/pcre.mk erts_lib: cd $(ERL_TOP)/erts/lib_src && $(MAKE) $(TYPE) @@ -420,9 +421,9 @@ endif $(RM) -rf $(BINDIR)/child_setup $(BINDIR)/child_setup.* $(RM) -f $(BINDIR)/hipe_mkliterals $(BINDIR)/hipe_mkliterals.* @set -e ; cd zlib && $(MAKE) clean - @set -e ; cd pcre && $(MAKE) clean + rm -f $(OBJS) $(OBJDIR)/libepcre.a -.PHONY: all zlib pcre clean +.PHONY: all zlib clean docs: @@ -467,10 +468,11 @@ release_docs_spec: # Generated source code. Put in $(TARGET) directory # +_create_dirs := $(shell mkdir -p $(CREATE_DIRS)) + .PHONY : generate -GENERATE= $(CREATE_DIRS) \ - $(TTF_DIR)/beam_opcodes.h \ +GENERATE= $(TTF_DIR)/beam_opcodes.h \ $(TARGET)/erl_bif_table.c \ $(TARGET)/erl_version.h \ $(TTF_DIR)/driver_tab.c \ @@ -672,14 +674,8 @@ endif # rebuilding (is this a good idea?) add a dummy dependency to this target. # -ifeq ($(findstring clearmake,$(MAKE)),clearmake) -BEAMFILE_MAKEFLAG=-T -else -BEAMFILE_MAKEFLAG= -endif - $(ERL_TOP)/lib/%.beam: - cd $(@D)/../src && $(MAKE) $(BEAMFILE_MAKEFLAG) ../ebin/$(@F) + cd $(@D)/../src && $(MAKE) ../ebin/$(@F) # ---------------------------------------------------------------------- @@ -858,7 +854,7 @@ $(OBJDIR)/%.o: hipe/%.c $(BINDIR)/hipe_mkliterals$(TF_MARKER): $(OBJDIR)/hipe_mkliterals.o $(CC) $(CFLAGS) $(INCLUDES) -o $@ $< -$(OBJDIR)/hipe_mkliterals.o: $(TTF_DIR)/hipe_x86_asm.h $(TTF_DIR)/hipe_ppc_asm.h +$(OBJDIR)/hipe_mkliterals.o: $(TTF_DIR)/hipe_x86_asm.h $(TTF_DIR)/hipe_ppc_asm.h $(TTF_DIR)/beam_opcodes.h $(TTF_DIR)/hipe_literals.h: $(BINDIR)/hipe_mkliterals$(TF_MARKER) $(BINDIR)/hipe_mkliterals$(TF_MARKER) -c > $@ diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 37738faae3..71454b3e57 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -158,6 +158,8 @@ atom cr atom crlf atom creation atom current_function +atom current_location +atom current_stacktrace atom data atom debug_flags atom delay_trap diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index e6dba10fde..294b1578be 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -67,8 +67,6 @@ load_module_2(BIF_ALIST_2) erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); erts_smp_thr_progress_block(); - erts_export_consolidate(); - hp = HAlloc(BIF_P, 3); sz = binary_size(BIF_ARG_2); if ((i = erts_load_module(BIF_P, 0, diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 67748698e1..dd31376a2d 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -612,9 +612,13 @@ static void bp_hash_delete(bp_time_hash_t *hash) { static void bp_time_diff(bp_data_time_item_t *item, /* out */ process_breakpoint_time_t *pbt, /* in */ Uint ms, Uint s, Uint us) { - int dms,ds,dus; + int ds,dus; +#ifdef DEBUG + int dms; + dms = ms - pbt->ms; +#endif ds = s - pbt->s; dus = us - pbt->us; @@ -622,7 +626,9 @@ static void bp_time_diff(bp_data_time_item_t *item, /* out */ * this is ok. */ +#ifdef DEBUG ASSERT(dms >= 0 || ds >= 0 || dus >= 0); +#endif if (dus < 0) { dus += 1000000; diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index 2b4448f93b..8041c92162 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -50,15 +50,18 @@ void dbg_bt(Process* p, Eterm* sp); void dbg_where(BeamInstr* addr, Eterm x0, Eterm* reg); static int print_op(int to, void *to_arg, int op, int size, BeamInstr* addr); -Eterm -erts_debug_same_2(Process* p, Eterm term1, Eterm term2) + +BIF_RETTYPE +erts_debug_same_2(BIF_ALIST_2) { - return (term1 == term2) ? am_true : am_false; + return (BIF_ARG_1 == BIF_ARG_2) ? am_true : am_false; } -Eterm -erts_debug_flat_size_1(Process* p, Eterm term) +BIF_RETTYPE +erts_debug_flat_size_1(BIF_ALIST_1) { + Process* p = BIF_P; + Eterm term = BIF_ARG_1; Uint size = size_object(term); if (IS_USMALL(0, size)) { @@ -69,9 +72,13 @@ erts_debug_flat_size_1(Process* p, Eterm term) } } -Eterm -erts_debug_breakpoint_2(Process* p, Eterm MFA, Eterm bool) + +BIF_RETTYPE +erts_debug_breakpoint_2(BIF_ALIST_2) { + Process* p = BIF_P; + Eterm MFA = BIF_ARG_1; + Eterm bool = BIF_ARG_2; Eterm* tp; Eterm mfa[3]; int i; @@ -176,9 +183,11 @@ erts_debug_instructions_0(BIF_ALIST_0) return res; } -Eterm -erts_debug_disassemble_1(Process* p, Eterm addr) +BIF_RETTYPE +erts_debug_disassemble_1(BIF_ALIST_1) { + Process* p = BIF_P; + Eterm addr = BIF_ARG_1; erts_dsprintf_buf_t *dsbufp; Eterm* hp; Eterm* tp; diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 73c9fdc5d7..9c5450bd48 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -304,44 +304,6 @@ extern int count_instructions; PROCESS_MAIN_CHK_LOCKS((P)); \ ERTS_SMP_UNREQ_PROC_MAIN_LOCK((P)) -#if defined(HYBRID) -# define POST_BIF_GC_SWAPIN_0(_p, _res) \ - if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \ - _res = erts_gc_after_bif_call((_p), (_res), NULL, 0); \ - } \ - SWAPIN - -# define POST_BIF_GC_SWAPIN(_p, _res, _regs, _arity) \ - if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \ - _regs[0] = r(0); \ - _res = erts_gc_after_bif_call((_p), (_res), _regs, (_arity)); \ - r(0) = _regs[0]; \ - } \ - SWAPIN -#else -# define POST_BIF_GC_SWAPIN_0(_p, _res) \ - ERTS_SMP_REQ_PROC_MAIN_LOCK((_p)); \ - PROCESS_MAIN_CHK_LOCKS((_p)); \ - ERTS_VERIFY_UNUSED_TEMP_ALLOC((_p)); \ - if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \ - _res = erts_gc_after_bif_call((_p), (_res), NULL, 0); \ - E = (_p)->stop; \ - } \ - HTOP = HEAP_TOP((_p)) - -# define POST_BIF_GC_SWAPIN(_p, _res, _regs, _arity) \ - ERTS_VERIFY_UNUSED_TEMP_ALLOC((_p)); \ - ERTS_SMP_REQ_PROC_MAIN_LOCK((_p)); \ - PROCESS_MAIN_CHK_LOCKS((_p)); \ - if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \ - _regs[0] = r(0); \ - _res = erts_gc_after_bif_call((_p), (_res), _regs, (_arity)); \ - r(0) = _regs[0]; \ - E = (_p)->stop; \ - } \ - HTOP = HEAP_TOP((_p)) -#endif - #define db(N) (N) #define tb(N) (N) #define xb(N) (*(Eterm *) (((unsigned char *)reg) + (N))) @@ -795,11 +757,11 @@ extern int count_instructions; } \ } while (0) -#define IsFunction2(F, A, Action) \ - do { \ - if (is_function_2(c_p, F, A) != am_true ) {\ - Action; \ - } \ +#define IsFunction2(F, A, Action) \ + do { \ + if (erl_is_function(c_p, F, A) != am_true ) { \ + Action; \ + } \ } while (0) #define IsTupleOfArity(Src, Arity, Fail) \ @@ -1146,26 +1108,11 @@ void process_main(void) Eterm *tmp_big; /* Temporary buffer for small bignums if !HEAP_ON_C_STACK. */ #endif -#ifndef ERTS_SMP -#if !HALFWORD_HEAP - static Eterm save_reg[ERTS_X_REGS_ALLOCATED]; - /* X registers -- not used directly, but - * through 'reg', because using it directly - * needs two instructions on a SPARC, - * while using it through reg needs only - * one. - */ -#endif /* - * Floating point registers. - */ - static FloatDef freg[MAX_REG]; -#else - /* X regisers and floating point registers are located in + * X registers and floating point registers are located in * scheduler specific data. */ register FloatDef *freg; -#endif /* * For keeping the negative old value of 'reds' when call saving is active. @@ -1202,14 +1149,6 @@ void process_main(void) init_done = 1; goto init_emulator; } -#ifndef ERTS_SMP -#if !HALFWORD_HEAP - reg = save_reg; /* XXX: probably wastes a register on x86 */ -#else - /* Registers need to be heap allocated (correct memory range) for tracing to work */ - reg = erts_alloc(ERTS_ALC_T_BEAM_REGISTER, ERTS_X_REGS_ALLOCATED * sizeof(Eterm)); -#endif -#endif c_p = NULL; reds_used = 0; goto do_schedule1; @@ -1230,10 +1169,8 @@ void process_main(void) #endif ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); -#ifdef ERTS_SMP - reg = c_p->scheduler_data->save_reg; - freg = c_p->scheduler_data->freg; -#endif + reg = ERTS_PROC_GET_SCHDATA(c_p)->x_reg_array; + freg = ERTS_PROC_GET_SCHDATA(c_p)->f_reg_array; #if !HEAP_ON_C_STACK tmp_big = ERTS_PROC_GET_SCHDATA(c_p)->beam_emu_tmp_heap; #endif @@ -1567,9 +1504,17 @@ void process_main(void) PRE_BIF_SWAPOUT(c_p); c_p->fcalls = FCALLS - 1; - result = send_2(c_p, r(0), x(1)); + reg[0] = r(0); + result = erl_send(c_p, r(0), x(1)); PreFetch(0, next); - POST_BIF_GC_SWAPIN(c_p, result, reg, 2); + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + if (c_p->mbuf || MSO(c_p).overhead >= BIN_VHEAP_SZ(c_p)) { + result = erts_gc_after_bif_call(c_p, result, reg, 2); + r(0) = reg[0]; + E = c_p->stop; + } + HTOP = HEAP_TOP(c_p); FCALLS = c_p->fcalls; if (is_value(result)) { r(0) = result; @@ -1577,10 +1522,9 @@ void process_main(void) NextPF(0, next); } else if (c_p->freason == TRAP) { SET_CP(c_p, I+1); - SET_I(*((BeamInstr **) (BeamInstr) ((c_p)->def_arg_reg + 3))); + SET_I(c_p->i); SWAPIN; - r(0) = c_p->def_arg_reg[0]; - x(1) = c_p->def_arg_reg[1]; + r(0) = reg[0]; Dispatch(); } goto find_func_info; @@ -2235,16 +2179,16 @@ void process_main(void) OpCase(bif1_fbsd): { - Eterm (*bf)(Process*, Eterm); - Eterm arg; + Eterm (*bf)(Process*, Eterm*); + Eterm tmp_reg[1]; Eterm result; - GetArg1(2, arg); + GetArg1(2, tmp_reg[0]); bf = (BifFunction) Arg(1); c_p->fcalls = FCALLS; PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - result = (*bf)(c_p, arg); + result = (*bf)(c_p, tmp_reg); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); @@ -2263,17 +2207,17 @@ void process_main(void) OpCase(bif1_body_bsd): { - Eterm (*bf)(Process*, Eterm); + Eterm (*bf)(Process*, Eterm*); - Eterm arg; + Eterm tmp_reg[1]; Eterm result; - GetArg1(1, arg); + GetArg1(1, tmp_reg[0]); bf = (BifFunction) Arg(0); c_p->fcalls = FCALLS; PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - result = (*bf)(c_p, arg); + result = (*bf)(c_p, tmp_reg); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); @@ -2282,7 +2226,7 @@ void process_main(void) if (is_value(result)) { StoreBifResult(2, result); } - reg[0] = arg; + reg[0] = tmp_reg[0]; SWAPOUT; I = handle_error(c_p, I, reg, bf); goto post_error_handling; @@ -2406,14 +2350,15 @@ void process_main(void) */ OpCase(i_bif2_fbd): { - Eterm (*bf)(Process*, Eterm, Eterm); + Eterm tmp_reg[2] = {tmp_arg1, tmp_arg2}; + Eterm (*bf)(Process*, Eterm*); Eterm result; bf = (BifFunction) Arg(1); c_p->fcalls = FCALLS; PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - result = (*bf)(c_p, tmp_arg1, tmp_arg2); + result = (*bf)(c_p, tmp_reg); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); @@ -2431,13 +2376,14 @@ void process_main(void) */ OpCase(i_bif2_body_bd): { - Eterm (*bf)(Process*, Eterm, Eterm); + Eterm tmp_reg[2] = {tmp_arg1, tmp_arg2}; + Eterm (*bf)(Process*, Eterm*); Eterm result; bf = (BifFunction) Arg(0); PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - result = (*bf)(c_p, tmp_arg1, tmp_arg2); + result = (*bf)(c_p, tmp_reg); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); @@ -2457,77 +2403,9 @@ void process_main(void) * The most general BIF call. The BIF may build any amount of data * on the heap. The result is always returned in r(0). */ - OpCase(call_bif0_e): - { - Eterm (*bf)(Process*, BeamInstr*) = GET_BIF_ADDRESS(Arg(0)); - - PRE_BIF_SWAPOUT(c_p); - c_p->fcalls = FCALLS - 1; - if (FCALLS <= 0) { - save_calls(c_p, (Export *) Arg(0)); - } - - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - r(0) = (*bf)(c_p, I); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(r(0))); - ERTS_HOLE_CHECK(c_p); - POST_BIF_GC_SWAPIN_0(c_p, r(0)); - FCALLS = c_p->fcalls; - if (is_value(r(0))) { - CHECK_TERM(r(0)); - Next(1); - } - else if (c_p->freason == TRAP) { - goto call_bif_trap3; - } - - /* - * Error handling. SWAPOUT is not needed because it was done above. - */ - ASSERT(c_p->stop == E); - reg[0] = r(0); - I = handle_error(c_p, I, reg, bf); - goto post_error_handling; - } - - OpCase(call_bif1_e): - { - Eterm (*bf)(Process*, Eterm, BeamInstr*) = GET_BIF_ADDRESS(Arg(0)); - Eterm result; - BeamInstr *next; - - c_p->fcalls = FCALLS - 1; - if (FCALLS <= 0) { - save_calls(c_p, (Export *) Arg(0)); - } - PreFetch(1, next); - PRE_BIF_SWAPOUT(c_p); - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - result = (*bf)(c_p, r(0), I); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); - ERTS_HOLE_CHECK(c_p); - POST_BIF_GC_SWAPIN(c_p, result, reg, 1); - FCALLS = c_p->fcalls; - if (is_value(result)) { - r(0) = result; - CHECK_TERM(r(0)); - NextPF(1, next); - } else if (c_p->freason == TRAP) { - goto call_bif_trap3; - } - - /* - * Error handling. SWAPOUT is not needed because it was done above. - */ - ASSERT(c_p->stop == E); - reg[0] = r(0); - I = handle_error(c_p, I, reg, bf); - goto post_error_handling; - } - - OpCase(call_bif2_e): + OpCase(call_bif_e): { - Eterm (*bf)(Process*, Eterm, Eterm, BeamInstr*) = GET_BIF_ADDRESS(Arg(0)); + Eterm (*bf)(Process*, Eterm*, BeamInstr*) = GET_BIF_ADDRESS(Arg(0)); Eterm result; BeamInstr *next; @@ -2537,61 +2415,29 @@ void process_main(void) save_calls(c_p, (Export *) Arg(0)); } PreFetch(1, next); - CHECK_TERM(r(0)); - CHECK_TERM(x(1)); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - result = (*bf)(c_p, r(0), x(1), I); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); - ERTS_HOLE_CHECK(c_p); - POST_BIF_GC_SWAPIN(c_p, result, reg, 2); - FCALLS = c_p->fcalls; - if (is_value(result)) { - r(0) = result; - CHECK_TERM(r(0)); - NextPF(1, next); - } else if (c_p->freason == TRAP) { - goto call_bif_trap3; - } - - /* - * Error handling. SWAPOUT is not needed because it was done above. - */ - ASSERT(c_p->stop == E); reg[0] = r(0); - I = handle_error(c_p, I, reg, bf); - goto post_error_handling; - } - - OpCase(call_bif3_e): - { - Eterm (*bf)(Process*, Eterm, Eterm, Eterm, BeamInstr*) = GET_BIF_ADDRESS(Arg(0)); - Eterm result; - BeamInstr *next; - - PRE_BIF_SWAPOUT(c_p); - c_p->fcalls = FCALLS - 1; - if (FCALLS <= 0) { - save_calls(c_p, (Export *) Arg(0)); - } - PreFetch(1, next); - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - result = (*bf)(c_p, r(0), x(1), x(2), I); + result = (*bf)(c_p, reg, I); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); ERTS_HOLE_CHECK(c_p); - POST_BIF_GC_SWAPIN(c_p, result, reg, 3); + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + if (c_p->mbuf || MSO(c_p).overhead >= BIN_VHEAP_SZ(c_p)) { + Uint arity = ((Export *)Arg(0))->code[2]; + result = erts_gc_after_bif_call(c_p, result, reg, arity); + E = c_p->stop; + } + HTOP = HEAP_TOP(c_p); FCALLS = c_p->fcalls; if (is_value(result)) { r(0) = result; CHECK_TERM(r(0)); NextPF(1, next); } else if (c_p->freason == TRAP) { - call_bif_trap3: SET_CP(c_p, I+2); - SET_I(*((BeamInstr **) (UWord) ((c_p)->def_arg_reg + 3))); + SET_I(c_p->i); SWAPIN; - r(0) = c_p->def_arg_reg[0]; - x(1) = c_p->def_arg_reg[1]; - x(2) = c_p->def_arg_reg[2]; + r(0) = reg[0]; Dispatch(); } @@ -2599,7 +2445,6 @@ void process_main(void) * Error handling. SWAPOUT is not needed because it was done above. */ ASSERT(c_p->stop == E); - reg[0] = r(0); I = handle_error(c_p, I, reg, bf); goto post_error_handling; } @@ -3352,64 +3197,23 @@ void process_main(void) ASSERT(bif_nif_arity <= 3); ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - switch (bif_nif_arity) { - case 3: - { - Eterm (*bf)(Process*, Eterm, Eterm, Eterm, BeamInstr*) = vbf; - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - nif_bif_result = (*bf)(c_p, r(0), x(1), x(2), I); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || - is_non_value(nif_bif_result)); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - } - break; - case 2: - { - Eterm (*bf)(Process*, Eterm, Eterm, BeamInstr*) = vbf; - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - nif_bif_result = (*bf)(c_p, r(0), x(1), I); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || - is_non_value(nif_bif_result)); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - } - break; - case 1: - { - Eterm (*bf)(Process*, Eterm, BeamInstr*) = vbf; - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - nif_bif_result = (*bf)(c_p, r(0), I); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || - is_non_value(nif_bif_result)); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - } - break; - case 0: - { - Eterm (*bf)(Process*, BeamInstr*) = vbf; - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - nif_bif_result = (*bf)(c_p, I); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || - is_non_value(nif_bif_result)); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - break; - } - default: - erl_exit(1, "apply_bif: invalid arity: %u\n", - bif_nif_arity); + reg[0] = r(0); + { + Eterm (*bf)(Process*, Eterm*, BeamInstr*) = vbf; + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + nif_bif_result = (*bf)(c_p, reg, I); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || + is_non_value(nif_bif_result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); } apply_bif_or_nif_epilogue: ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); ERTS_HOLE_CHECK(c_p); if (c_p->mbuf) { - reg[0] = r(0); nif_bif_result = erts_gc_after_bif_call(c_p, nif_bif_result, reg, bif_nif_arity); - r(0) = reg[0]; } SWAPIN; /* There might have been a garbage collection. */ FCALLS = c_p->fcalls; @@ -3420,17 +3224,14 @@ void process_main(void) c_p->cp = 0; Goto(*I); } else if (c_p->freason == TRAP) { - SET_I(*((BeamInstr **) (UWord) ((c_p)->def_arg_reg + 3))); - r(0) = c_p->def_arg_reg[0]; - x(1) = c_p->def_arg_reg[1]; - x(2) = c_p->def_arg_reg[2]; + SET_I(c_p->i); + r(0) = reg[0]; if (c_p->flags & F_HIBERNATE_SCHED) { c_p->flags &= ~F_HIBERNATE_SCHED; goto do_schedule; } Dispatch(); } - reg[0] = r(0); I = handle_error(c_p, c_p->cp, reg, vbf); goto post_error_handling; } @@ -3993,8 +3794,7 @@ void process_main(void) * too big numbers). */ if (is_not_small(val) || val > make_small(0x10FFFFUL) || - (make_small(0xD800UL) <= val && val <= make_small(0xDFFFUL)) || - val == make_small(0xFFFEUL) || val == make_small(0xFFFFUL)) { + (make_small(0xD800UL) <= val && val <= make_small(0xDFFFUL))) { goto badarg; } Next(2); @@ -4013,8 +3813,8 @@ void process_main(void) * the valid range). */ if (is_not_small(tmp_arg1) || tmp_arg1 > make_small(0x10FFFFUL) || - (make_small(0xD800UL) <= tmp_arg1 && tmp_arg1 <= make_small(0xDFFFUL)) || - tmp_arg1 == make_small(0xFFFEUL) || tmp_arg1 == make_small(0xFFFFUL)) { + (make_small(0xD800UL) <= tmp_arg1 && + tmp_arg1 <= make_small(0xDFFFUL))) { ErlBinMatchBuffer *mb = ms_matchbuffer(tmp_arg2); mb->offset -= 32; @@ -4889,92 +4689,6 @@ void process_main(void) } /* - * Instructions for allocating on the message area. - */ - - OpCase(i_global_cons): - { - BeamInstr *next; -#ifdef HYBRID - Eterm *hp; - - PreFetch(0,next); - TestGlobalHeap(2,2,hp); - hp[0] = r(0); - hp[1] = x(1); - r(0) = make_list(hp); -#ifndef INCREMENTAL - global_htop += 2; -#endif - NextPF(0,next); -#else - PreFetch(0,next); - c_p->freason = EXC_INTERNAL_ERROR; - goto find_func_info; -#endif - } - - OpCase(i_global_tuple): - { - BeamInstr *next; - int len; -#ifdef HYBRID - Eterm list; - Eterm *hp; -#endif - - if ((len = list_length(r(0))) < 0) { - goto badarg; - } - - PreFetch(0,next); -#ifdef HYBRID - TestGlobalHeap(len + 1,1,hp); - list = r(0); - r(0) = make_tuple(hp); - *hp++ = make_arityval(len); - while(is_list(list)) - { - Eterm* cons = list_val(list); - *hp++ = CAR(cons); - list = CDR(cons); - } -#ifndef INCREMENTAL - global_htop += len + 1; -#endif - NextPF(0,next); -#else - c_p->freason = EXC_INTERNAL_ERROR; - goto find_func_info; -#endif - } - - OpCase(i_global_copy): - { - BeamInstr *next; - PreFetch(0,next); -#ifdef HYBRID - if (!IS_CONST(r(0))) - { - BM_SWAP_TIMER(system,copy); - SWAPOUT; - reg[0] = r(0); - reg[1] = NIL; - r(0) = copy_struct_lazy(c_p,r(0),0); - ASSERT(ma_src_top == 0); - ASSERT(ma_dst_top == 0); - ASSERT(ma_offset_top == 0); - SWAPIN; - BM_SWAP_TIMER(copy,system); - } - NextPF(0,next); -#else - c_p->freason = EXC_INTERNAL_ERROR; - goto find_func_info; -#endif - } - - /* * New floating point instructions. */ @@ -5152,10 +4866,8 @@ void process_main(void) c_p->def_arg_reg[4] = -neg_o_reds; reg[0] = r(0); c_p = hipe_mode_switch(c_p, cmd, reg); -#ifdef ERTS_SMP - reg = c_p->scheduler_data->save_reg; - freg = c_p->scheduler_data->freg; -#endif + reg = ERTS_PROC_GET_SCHDATA(c_p)->x_reg_array; + freg = ERTS_PROC_GET_SCHDATA(c_p)->f_reg_array; ERL_BITS_RELOAD_STATEP(c_p); neg_o_reds = -c_p->def_arg_reg[4]; FCALLS = c_p->fcalls; @@ -5269,8 +4981,8 @@ void process_main(void) OpCase(int_code_end): OpCase(label_L): - OpCase(too_old_compiler): OpCase(on_load): + OpCase(line_I): erl_exit(1, "meta op\n"); /* @@ -5687,6 +5399,25 @@ expand_error_value(Process* c_p, Uint freason, Eterm Value) { * that c_p->ftrace will point to a cons cell which holds the given args * and the saved data (encoded as a bignum). * + * There is an issue with line number information. Line number + * information is associated with the address *before* an operation + * that may fail or be stored stored on the stack. But continuation + * pointers point after its call instruction, not before. To avoid + * finding the wrong line number, we'll need to adjust them so that + * they point at the beginning of the call instruction or inside the + * call instruction. Since its impractical to point at the beginning, + * we'll do the simplest thing and decrement the continuation pointers + * by one. + * + * Here is an example of what can go wrong. Without the adjustment + * of continuation pointers, the call at line 42 below would seem to + * be at line 43: + * + * line 42 + * call ... + * line 43 + * gc_bif ... + * * (It would be much better to put the arglist - when it exists - in the * error value instead of in the actual trace; e.g. '{badarg, Args}' * instead of using 'badarg' with Args in the trace. The arglist may @@ -5753,7 +5484,7 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf, } /* Save second stack entry if CP is valid and different from pc */ if (depth > 0 && c_p->cp != 0 && c_p->cp != pc) { - s->trace[s->depth++] = c_p->cp; + s->trace[s->depth++] = c_p->cp - 1; depth--; } s->pc = NULL; @@ -5773,13 +5504,13 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf, /* Save first stack entry */ ASSERT(c_p->cp); if (depth > 0) { - s->trace[s->depth++] = c_p->cp; + s->trace[s->depth++] = c_p->cp - 1; depth--; } s->pc = NULL; /* Ignore pc */ } else { if (depth > 0 && c_p->cp != 0 && c_p->cp != pc) { - s->trace[s->depth++] = c_p->cp; + s->trace[s->depth++] = c_p->cp - 1; depth--; } s->pc = pc; @@ -5794,24 +5525,31 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf, } /* Save the actual stack trace */ + erts_save_stacktrace(c_p, s, depth); +} + +void +erts_save_stacktrace(Process* p, struct StackTrace* s, int depth) +{ if (depth > 0) { Eterm *ptr; BeamInstr *prev = s->depth ? s->trace[s->depth-1] : NULL; BeamInstr i_return_trace = beam_return_trace[0]; BeamInstr i_return_to_trace = beam_return_to_trace[0]; + /* * Traverse the stack backwards and add all unique continuation * pointers to the buffer, up to the maximum stack trace size. * * Skip trace stack frames. */ - ptr = c_p->stop; - if (ptr < STACK_START(c_p) - && (is_not_CP(*ptr)|| (*cp_val(*ptr) != i_return_trace && - *cp_val(*ptr) != i_return_to_trace)) - && c_p->cp) { - /* Can not follow cp here - code may be unloaded */ - BeamInstr *cpp = c_p->cp; + ptr = p->stop; + if (ptr < STACK_START(p) && + (is_not_CP(*ptr)|| (*cp_val(*ptr) != i_return_trace && + *cp_val(*ptr) != i_return_to_trace)) && + p->cp) { + /* Cannot follow cp here - code may be unloaded */ + BeamInstr *cpp = p->cp; if (cpp == beam_exception_trace || cpp == beam_return_trace) { /* Skip return_trace parameters */ ptr += 2; @@ -5820,7 +5558,7 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf, ptr += 1; } } - while (ptr < STACK_START(c_p) && depth > 0) { + while (ptr < STACK_START(p) && depth > 0) { if (is_CP(*ptr)) { if (*cp_val(*ptr) == i_return_trace) { /* Skip stack frame variables */ @@ -5835,7 +5573,7 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf, if (cp != prev) { /* Record non-duplicates only */ prev = cp; - s->trace[s->depth++] = cp; + s->trace[s->depth++] = cp - 1; depth--; } ptr++; @@ -5903,9 +5641,14 @@ build_stacktrace(Process* c_p, Eterm exc) { struct StackTrace* s; Eterm args; int depth; - BeamInstr* current; - Eterm Where = NIL; - Eterm *next_p = &Where; + FunctionInfo fi; + FunctionInfo* stk; + FunctionInfo* stkp; + Eterm res = NIL; + Uint heap_size; + Eterm* hp; + Eterm mfa; + int i; if (! (s = get_trace_from_exc(exc))) { return NIL; @@ -5924,64 +5667,56 @@ build_stacktrace(Process* c_p, Eterm exc) { * saved s->current should already contain the proper value. */ if (s->pc != NULL) { - current = find_function_from_pc(s->pc); + erts_lookup_function_info(&fi, s->pc, 1); + } else if (GET_EXC_INDEX(s->freason) == + GET_EXC_INDEX(EXC_FUNCTION_CLAUSE)) { + erts_lookup_function_info(&fi, s->current, 1); } else { - current = s->current; + erts_set_current_function(&fi, s->current); } + /* - * If current is still NULL, default to the initial function + * If fi.current is still NULL, default to the initial function * (e.g. spawn_link(erlang, abs, [1])). */ - if (current == NULL) { - current = c_p->initial; + if (fi.current == NULL) { + erts_set_current_function(&fi, c_p->initial); args = am_true; /* Just in case */ } else { args = get_args_from_exc(exc); } - depth = s->depth; - /* - * Add the {M,F,A} for the current function - * (where A is arity or [Argument]). + * Look up all saved continuation pointers and calculate + * needed heap space. */ - { - int i; - Eterm mfa; - Uint heap_size = 6*(depth+1); - Eterm* hp = HAlloc(c_p, heap_size); - Eterm* hp_end = hp + heap_size; - - if (args != am_true) { - /* We have an arglist - use it */ - mfa = TUPLE3(hp, current[0], current[1], args); - } else { - Eterm arity = make_small(current[2]); - mfa = TUPLE3(hp, current[0], current[1], arity); + depth = s->depth; + stk = stkp = (FunctionInfo *) erts_alloc(ERTS_ALC_T_TMP, + depth*sizeof(FunctionInfo)); + heap_size = fi.needed + 2; + for (i = 0; i < depth; i++) { + erts_lookup_function_info(stkp, s->trace[i], 1); + if (stkp->current) { + heap_size += stkp->needed + 2; + stkp++; } - hp += 4; - ASSERT(*next_p == NIL); - *next_p = CONS(hp, mfa, NIL); - next_p = &CDR(list_val(*next_p)); - hp += 2; + } - /* - * Finally, we go through the saved continuation pointers. - */ - for (i = 0; i < depth; i++) { - BeamInstr *fi = find_function_from_pc((BeamInstr *) s->trace[i]); - if (fi == NULL) continue; - mfa = TUPLE3(hp, fi[0], fi[1], make_small(fi[2])); - hp += 4; - ASSERT(*next_p == NIL); - *next_p = CONS(hp, mfa, NIL); - next_p = &CDR(list_val(*next_p)); - hp += 2; - } - ASSERT(hp <= hp_end); - HRelease(c_p, hp_end, hp); + /* + * Allocate heap space and build the stacktrace. + */ + hp = HAlloc(c_p, heap_size); + while (stkp > stk) { + stkp--; + hp = erts_build_mfa_item(stkp, hp, am_true, &mfa); + res = CONS(hp, mfa, res); + hp += 2; } - return Where; + hp = erts_build_mfa_item(&fi, hp, args, &mfa); + res = CONS(hp, mfa, res); + + erts_free(ERTS_ALC_T_TMP, (void *) stk); + return res; } diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index fceb352cf3..3836f1ae96 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -158,6 +158,7 @@ typedef struct { #define LITERAL_CHUNK 6 #define ATTR_CHUNK 7 #define COMPILE_CHUNK 8 +#define LINE_CHUNK 9 #define NUM_CHUNK_TYPES (sizeof(chunk_types)/sizeof(chunk_types[0])) @@ -182,6 +183,7 @@ static Uint chunk_types[] = { MakeIffId('L', 'i', 't', 'T'), /* 6 */ MakeIffId('A', 't', 't', 'r'), /* 7 */ MakeIffId('C', 'I', 'n', 'f'), /* 8 */ + MakeIffId('L', 'i', 'n', 'e'), /* 9 */ }; /* @@ -231,6 +233,15 @@ struct string_patch { }; /* + * This structure associates a code offset with a source code location. + */ + +typedef struct { + int pos; /* Position in code */ + Uint32 loc; /* Location in source code */ +} LineInstr; + +/* * This structure contains all information about the module being loaded. */ @@ -325,6 +336,19 @@ typedef struct { Literal* literals; /* Array of literals. */ LiteralPatch* literal_patches; /* Operands that need to be patched. */ Uint total_literal_size; /* Total heap size for all literals. */ + + /* + * Line table. + */ + BeamInstr* line_item; /* Line items from the BEAM file. */ + int num_line_items; /* Number of line items. */ + LineInstr* line_instr; /* Line instructions */ + int num_line_instrs; /* Maximum number of line instructions */ + int current_li; /* Current line instruction */ + int* func_line; /* Mapping from function to first line instr */ + Eterm* fname; /* List of file names */ + int num_fnames; /* Number of filenames in fname table */ + int loc_size; /* Size of location info in bytes (2/4) */ } LoaderState; typedef struct { @@ -332,6 +356,27 @@ typedef struct { Eterm* func_tab[1]; /* Pointers to each function. */ } LoadedCode; +/* + * Layout of the line table. + */ + +#define MI_LINE_FNAME_PTR 0 +#define MI_LINE_LOC_TAB 1 +#define MI_LINE_LOC_SIZE 2 +#define MI_LINE_FUNC_TAB 3 + +#define LINE_INVALID_LOCATION (0) + +/* + * Macros for manipulating locations. + */ + +#define IS_VALID_LOCATION(File, Line) \ + ((unsigned) (File) < 255 && (unsigned) (Line) < ((1 << 24) - 1)) +#define MAKE_LOCATION(File, Line) (((File) << 24) | (Line)) +#define LOC_FILE(Loc) ((Loc) >> 24) +#define LOC_LINE(Loc) ((Loc) & ((1 << 24)-1)) + #define GetTagAndValue(Stp, Tag, Val) \ do { \ BeamInstr __w; \ @@ -468,6 +513,7 @@ static int load_import_table(LoaderState* stp); static int read_export_table(LoaderState* stp); static int read_lambda_table(LoaderState* stp); static int read_literal_table(LoaderState* stp); +static int read_line_table(LoaderState* stp); static int read_code_header(LoaderState* stp); static int load_code(LoaderState* stp); static GenOp* gen_element(LoaderState* stp, GenOpArg Fail, GenOpArg Index, @@ -506,6 +552,8 @@ static Eterm native_addresses(Process* p, Eterm mod); int patch_funentries(Eterm Patchlist); int patch(Eterm Addresses, Uint fe); static int safe_mul(UWord a, UWord b, UWord* resp); +static void lookup_loc(FunctionInfo* fi, BeamInstr* pc, + BeamInstr* modp, int idx); static int must_swap_floats; @@ -698,6 +746,26 @@ bin_load(Process *c_p, ErtsProcLocks c_p_locks, } /* + * Read the line table (if present). + */ + + CHKBLK(ERTS_ALC_T_CODE,state.code); + if (state.chunks[LINE_CHUNK].size > 0) { + define_file(&state, "line table", LINE_CHUNK); + if (!read_line_table(&state)) { + goto load_error; + } + } + + /* + * Since the literal table *may* have contained external + * funs (containing references to export entries), now is + * the time to consolidate the export tables. + */ + + erts_export_consolidate(); + + /* * Load the code chunk. */ @@ -805,6 +873,22 @@ bin_load(Process *c_p, ErtsProcLocks c_p_locks, state.genop_blocks = next; } + if (state.line_item != 0) { + erts_free(ERTS_ALC_T_LOADER_TMP, state.line_item); + } + + if (state.line_instr != 0) { + erts_free(ERTS_ALC_T_LOADER_TMP, state.line_instr); + } + + if (state.func_line != 0) { + erts_free(ERTS_ALC_T_LOADER_TMP, state.func_line); + } + + if (state.fname != 0) { + erts_free(ERTS_ALC_T_LOADER_TMP, state.fname); + } + return rval; } @@ -835,6 +919,10 @@ init_state(LoaderState* stp) stp->string_patches = 0; stp->may_load_nif = 0; stp->on_load = 0; + stp->line_item = 0; + stp->line_instr = 0; + stp->func_line = 0; + stp->fname = 0; } static int @@ -1324,6 +1412,138 @@ read_literal_table(LoaderState* stp) return 0; } +static int +read_line_table(LoaderState* stp) +{ + unsigned version; + unsigned flags; + int num_line_items; + BeamInstr* lp; + int i; + BeamInstr fname_index; + BeamInstr tag; + + /* + * If the emulator flag ignoring the line information was given, + * return immediately. + */ + + if (erts_no_line_info) { + return 1; + } + + /* + * Check version of line table. + */ + + GetInt(stp, 4, version); + if (version != 0) { + /* + * Wrong version. Silently ignore the line number chunk. + */ + return 1; + } + + /* + * Read the remaining header words. The flag word is reserved + * for possible future use; for the moment we ignore it. + */ + GetInt(stp, 4, flags); + GetInt(stp, 4, stp->num_line_instrs); + GetInt(stp, 4, num_line_items); + GetInt(stp, 4, stp->num_fnames); + + /* + * Calculate space and allocate memory for the line item table. + */ + + num_line_items++; + lp = (BeamInstr *) erts_alloc(ERTS_ALC_T_LOADER_TMP, + num_line_items * sizeof(BeamInstr)); + stp->line_item = lp; + stp->num_line_items = num_line_items; + + /* + * The zeroth entry in the line item table is special. + * It contains the undefined location. + */ + + *lp++ = LINE_INVALID_LOCATION; + num_line_items--; + + /* + * Read all the line items. + */ + + stp->loc_size = stp->num_fnames ? 4 : 2; + fname_index = 0; + while (num_line_items-- > 0) { + BeamInstr val; + BeamInstr loc; + + GetTagAndValue(stp, tag, val); + if (tag == TAG_i) { + if (IS_VALID_LOCATION(fname_index, val)) { + loc = MAKE_LOCATION(fname_index, val); + } else { + /* + * Too many files or huge line number. Silently invalidate + * the location. + */ + loc = LINE_INVALID_LOCATION; + } + *lp++ = loc; + if (val > 0xFFFF) { + stp->loc_size = 4; + } + } else if (tag == TAG_a) { + if (val > stp->num_fnames) { + LoadError2(stp, "file index overflow (%d/%d)", + val, stp->num_fnames); + } + fname_index = val; + num_line_items++; + } else { + LoadError1(stp, "bad tag '%c' (expected 'a' or 'i')", + tag_to_letter[tag]); + } + } + + /* + * Read all filenames. + */ + + if (stp->num_fnames != 0) { + stp->fname = (Eterm *) erts_alloc(ERTS_ALC_T_LOADER_TMP, + stp->num_fnames * + sizeof(Eterm)); + for (i = 0; i < stp->num_fnames; i++) { + byte* fname; + Uint n; + + GetInt(stp, 2, n); + GetString(stp, fname, n); + stp->fname[i] = am_atom_put((char*)fname, n); + } + } + + /* + * Allocate the arrays to be filled while code is being loaded. + */ + stp->line_instr = (LineInstr *) erts_alloc(ERTS_ALC_T_LOADER_TMP, + stp->num_line_instrs * + sizeof(LineInstr)); + stp->current_li = 0; + stp->func_line = (int *) erts_alloc(ERTS_ALC_T_LOADER_TMP, + stp->num_functions * + sizeof(int)); + + return 1; + + load_error: + return 0; +} + static int read_code_header(LoaderState* stp) @@ -1358,10 +1578,15 @@ read_code_header(LoaderState* stp) /* * Verify the number of the highest opcode used. */ - GetInt(stp, 4, opcode_max); if (opcode_max > MAX_GENERIC_OPCODE) { - LoadError2(stp, "use of opcode %d; this emulator supports only up to %d", + LoadError2(stp, + "This BEAM file was compiled for a later version" + " of the run-time system than " ERLANG_OTP_RELEASE ".\n" + " To fix this, please recompile this module with an " + ERLANG_OTP_RELEASE " compiler.\n" + " (Use of opcode %d; this emulator supports " + "only up to %d.)", opcode_max, MAX_GENERIC_OPCODE); } @@ -1415,7 +1640,7 @@ load_code(LoaderState* stp) { int i; int ci; - int last_func_start = 0; + int last_func_start = 0; /* Needed by nif loading and line instructions */ char* sign; int arg; /* Number of current argument. */ int num_specific; /* Number of specific ops for current. */ @@ -1428,6 +1653,14 @@ load_code(LoaderState* stp) GenOp** last_op_next = NULL; int arity; + /* + * The size of the loaded func_info instruction is needed + * by both the nif functionality and line instructions. + */ + enum { + FUNC_INFO_SZ = 5 + }; + code = stp->code; code_buffer_size = stp->code_buffer_size; ci = stp->ci; @@ -1667,14 +1900,6 @@ load_code(LoaderState* stp) } /* - * Special error message instruction. - */ - if (stp->genop->op == genop_too_old_compiler_0) { - LoadError0(stp, "please re-compile this module with an " - ERLANG_OTP_RELEASE " compiler"); - } - - /* * From the collected generic instruction, find the specific * instruction. */ @@ -1725,7 +1950,27 @@ load_code(LoaderState* stp) ERLANG_OTP_RELEASE " compiler "); } - LoadError0(stp, "no specific operation found"); + /* + * Some generic instructions should have a special + * error message. + */ + switch (stp->genop->op) { + case genop_too_old_compiler_0: + LoadError0(stp, "please re-compile this module with an " + ERLANG_OTP_RELEASE " compiler"); + case genop_unsupported_guard_bif_3: + { + Eterm Mod = (Eterm) stp->genop->a[0].val; + Eterm Name = (Eterm) stp->genop->a[1].val; + Uint arity = (Uint) stp->genop->a[2].val; + FREE_GENOP(stp, stp->genop); + stp->genop = 0; + LoadError3(stp, "unsupported guard BIF: %T:%T/%d\n", + Mod, Name, arity); + } + default: + LoadError0(stp, "no specific operation found"); + } } stp->specific_op = specific; @@ -2014,7 +2259,6 @@ load_code(LoaderState* stp) case op_i_func_info_IaaI: { Uint offset; - enum { FINFO_SZ = 5 }; if (function_number >= stp->num_functions) { LoadError1(stp, "too many functions in module (header said %d)", @@ -2022,27 +2266,37 @@ load_code(LoaderState* stp) } if (stp->may_load_nif) { - const int finfo_ix = ci - FINFO_SZ; + const int finfo_ix = ci - FUNC_INFO_SZ; enum { MIN_FUNC_SZ = 3 }; if (finfo_ix - last_func_start < MIN_FUNC_SZ && last_func_start) { /* Must make room for call_nif op */ int pad = MIN_FUNC_SZ - (finfo_ix - last_func_start); ASSERT(pad > 0 && pad < MIN_FUNC_SZ); CodeNeed(pad); - sys_memmove(&code[finfo_ix+pad], &code[finfo_ix], FINFO_SZ*sizeof(BeamInstr)); + sys_memmove(&code[finfo_ix+pad], &code[finfo_ix], + FUNC_INFO_SZ*sizeof(BeamInstr)); sys_memset(&code[finfo_ix], 0, pad*sizeof(BeamInstr)); ci += pad; stp->labels[last_label].value += pad; } } last_func_start = ci; + + /* + * Save current offset of into the line instruction array. + */ + + if (stp->func_line) { + stp->func_line[function_number] = stp->current_li; + } + /* * Save context for error messages. */ stp->function = code[ci-2]; stp->arity = code[ci-1]; - ASSERT(stp->labels[last_label].value == ci - FINFO_SZ); + ASSERT(stp->labels[last_label].value == ci - FUNC_INFO_SZ); offset = MI_FUNCTIONS + function_number; code[offset] = stp->labels[last_label].patches; stp->labels[last_label].patches = offset; @@ -2105,6 +2359,45 @@ load_code(LoaderState* stp) stp->catches = ci-3; break; + case op_line_I: + if (stp->line_item) { + BeamInstr item = code[ci-1]; + BeamInstr loc; + int li; + if (item >= stp->num_line_items) { + LoadError2(stp, "line instruction index overflow (%d/%d)", + item, stp->num_line_items); + } + li = stp->current_li; + if (li >= stp->num_line_instrs) { + LoadError2(stp, "line instruction table overflow (%d/%d)", + li, stp->num_line_instrs); + } + loc = stp->line_item[item]; + + if (ci - 2 == last_func_start) { + /* + * This line instruction directly follows the func_info + * instruction. Its address must be adjusted to point to + * func_info instruction. + */ + stp->line_instr[li].pos = last_func_start - FUNC_INFO_SZ; + stp->line_instr[li].loc = stp->line_item[item]; + stp->current_li++; + } else if (li <= stp->func_line[function_number-1] || + stp->line_instr[li-1].loc != loc) { + /* + * Only store the location if it is different + * from the previous location in the same function. + */ + stp->line_instr[li].pos = ci - 2; + stp->line_instr[li].loc = stp->line_item[item]; + stp->current_li++; + } + } + ci -= 2; /* Get rid of the instruction */ + break; + /* * End of code found. */ @@ -2141,6 +2434,8 @@ load_code(LoaderState* stp) #define no_fpe_signals(St) 0 #endif +#define never(St) 0 + /* * Predicate that tests whether a jump table can be used. */ @@ -3396,10 +3691,7 @@ gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, BifFunction bf; NEW_GENOP(stp, op); - op->op = genop_i_gc_bif1_5; - op->arity = 5; - op->a[0] = Fail; - op->a[1].type = TAG_u; + op->next = NULL; bf = stp->import[Bif.val].bf; /* The translations here need to have a reverse counterpart in beam_emu.c:translate_gc_bif for error handling to work properly. */ @@ -3420,19 +3712,30 @@ gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, } else if (bf == trunc_1) { op->a[1].val = (BeamInstr) (void *) erts_gc_trunc_1; } else { - abort(); + op->op = genop_unsupported_guard_bif_3; + op->arity = 3; + op->a[0].type = TAG_a; + op->a[0].val = stp->import[Bif.val].module; + op->a[1].type = TAG_a; + op->a[1].val = stp->import[Bif.val].function; + op->a[2].type = TAG_u; + op->a[2].val = stp->import[Bif.val].arity; + return op; } + op->op = genop_i_gc_bif1_5; + op->arity = 5; + op->a[0] = Fail; + op->a[1].type = TAG_u; op->a[2] = Src; op->a[3] = Live; op->a[4] = Dst; - op->next = NULL; return op; } /* - * This is used by the ops.tab rule that rewrites gc_bifs with two parameters + * This is used by the ops.tab rule that rewrites gc_bifs with two parameters. * The instruction returned is then again rewritten to an i_load instruction - * folowed by i_gc_bif2_jIId, to handle literals properly. + * followed by i_gc_bif2_jIId, to handle literals properly. * As opposed to the i_gc_bif1_jIsId, the instruction i_gc_bif2_jIId is * always rewritten, regardless of if there actually are any literals. */ @@ -3444,31 +3747,39 @@ gen_guard_bif2(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, BifFunction bf; NEW_GENOP(stp, op); - op->op = genop_ii_gc_bif2_6; - op->arity = 6; - op->a[0] = Fail; - op->a[1].type = TAG_u; + op->next = NULL; bf = stp->import[Bif.val].bf; /* The translations here need to have a reverse counterpart in beam_emu.c:translate_gc_bif for error handling to work properly. */ if (bf == binary_part_2) { op->a[1].val = (BeamInstr) (void *) erts_gc_binary_part_2; } else { - abort(); + op->op = genop_unsupported_guard_bif_3; + op->arity = 3; + op->a[0].type = TAG_a; + op->a[0].val = stp->import[Bif.val].module; + op->a[1].type = TAG_a; + op->a[1].val = stp->import[Bif.val].function; + op->a[2].type = TAG_u; + op->a[2].val = stp->import[Bif.val].arity; + return op; } + op->op = genop_ii_gc_bif2_6; + op->arity = 6; + op->a[0] = Fail; + op->a[1].type = TAG_u; op->a[2] = S1; op->a[3] = S2; op->a[4] = Live; op->a[5] = Dst; - op->next = NULL; return op; } /* - * This is used by the ops.tab rule that rewrites gc_bifs with three parameters + * This is used by the ops.tab rule that rewrites gc_bifs with three parameters. * The instruction returned is then again rewritten to a move instruction that * uses r[0] for temp storage, followed by an i_load instruction, - * folowed by i_gc_bif3_jIsId, to handle literals properly. Rewriting + * followed by i_gc_bif3_jIsId, to handle literals properly. Rewriting * always occur, as with the gc_bif2 counterpart. */ static GenOp* @@ -3479,18 +3790,27 @@ gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, BifFunction bf; NEW_GENOP(stp, op); - op->op = genop_ii_gc_bif3_7; - op->arity = 7; - op->a[0] = Fail; - op->a[1].type = TAG_u; + op->next = NULL; bf = stp->import[Bif.val].bf; /* The translations here need to have a reverse counterpart in beam_emu.c:translate_gc_bif for error handling to work properly. */ if (bf == binary_part_3) { op->a[1].val = (BeamInstr) (void *) erts_gc_binary_part_3; } else { - abort(); + op->op = genop_unsupported_guard_bif_3; + op->arity = 3; + op->a[0].type = TAG_a; + op->a[0].val = stp->import[Bif.val].module; + op->a[1].type = TAG_a; + op->a[1].val = stp->import[Bif.val].function; + op->a[2].type = TAG_u; + op->a[2].val = stp->import[Bif.val].arity; + return op; } + op->op = genop_ii_gc_bif3_7; + op->arity = 7; + op->a[0] = Fail; + op->a[1].type = TAG_u; op->a[2] = S1; op->a[3] = S2; op->a[4] = S3; @@ -3570,6 +3890,7 @@ freeze_code(LoaderState* stp) Uint size; unsigned catches; Sint decoded_size; + Uint line_size; /* * Verify that there was a correct 'FunT' chunk if there were @@ -3580,13 +3901,19 @@ freeze_code(LoaderState* stp) LoadError0(stp, stp->lambda_error); } - /* * Calculate the final size of the code. */ - - size = (stp->ci * sizeof(BeamInstr)) + (stp->total_literal_size * sizeof(Eterm)) + - strtab_size + attr_size + compile_size; + if (stp->line_instr == 0) { + line_size = 0; + } else { + line_size = (MI_LINE_FUNC_TAB + (stp->num_functions + 1) + + (stp->current_li+1) + stp->num_fnames) * + sizeof(Eterm) + (stp->current_li+1) * stp->loc_size; + } + size = (stp->ci * sizeof(BeamInstr)) + + (stp->total_literal_size * sizeof(Eterm)) + + strtab_size + attr_size + compile_size + line_size; /* * Move the code to its final location. @@ -3674,15 +4001,66 @@ freeze_code(LoaderState* stp) } literal_end += stp->total_literal_size; } - + CHKBLK(ERTS_ALC_T_CODE,code); + /* - * Place the string table and, optionally, attributes, after the literal heap. + * If there is line information, place it here. */ - CHKBLK(ERTS_ALC_T_CODE,code); + if (stp->line_instr == 0) { + code[MI_LINE_TABLE] = (BeamInstr) 0; + str_table = (byte *) literal_end; + } else { + Eterm* line_tab = (Eterm *) literal_end; + Eterm* p; + int ftab_size = stp->num_functions; + int num_instrs = stp->current_li; + Eterm* first_line_item; + + code[MI_LINE_TABLE] = (BeamInstr) line_tab; + p = line_tab + MI_LINE_FUNC_TAB; + + first_line_item = (p + ftab_size + 1); + for (i = 0; i < ftab_size; i++) { + *p++ = (Eterm) (BeamInstr) (first_line_item + stp->func_line[i]); + } + *p++ = (Eterm) (BeamInstr) (first_line_item + num_instrs); + ASSERT(p == first_line_item); + for (i = 0; i < num_instrs; i++) { + *p++ = (Eterm) (BeamInstr) (code + stp->line_instr[i].pos); + } + *p++ = (Eterm) (BeamInstr) (code + stp->ci - 1); + + line_tab[MI_LINE_FNAME_PTR] = (Eterm) (BeamInstr) p; + memcpy(p, stp->fname, stp->num_fnames*sizeof(Eterm)); + p += stp->num_fnames; + + line_tab[MI_LINE_LOC_TAB] = (Eterm) (BeamInstr) p; + line_tab[MI_LINE_LOC_SIZE] = stp->loc_size; + if (stp->loc_size == 2) { + Uint16* locp = (Uint16 *) p; + for (i = 0; i < num_instrs; i++) { + *locp++ = (Uint16) stp->line_instr[i].loc; + } + *locp++ = LINE_INVALID_LOCATION; + str_table = (byte *) locp; + } else { + Uint32* locp = (Uint32 *) p; + ASSERT(stp->loc_size == 4); + for (i = 0; i < num_instrs; i++) { + *locp++ = stp->line_instr[i].loc; + } + *locp++ = LINE_INVALID_LOCATION; + str_table = (byte *) locp; + } - sys_memcpy(literal_end, stp->chunks[STR_CHUNK].start, strtab_size); + CHKBLK(ERTS_ALC_T_CODE,code); + } + + /* + * Place the string table and, optionally, attributes here. + */ + sys_memcpy(str_table, stp->chunks[STR_CHUNK].start, strtab_size); CHKBLK(ERTS_ALC_T_CODE,code); - str_table = (byte *) literal_end; if (attr_size) { byte* attr = str_table + strtab_size; sys_memcpy(attr, stp->chunks[ATTR_CHUNK].start, stp->chunks[ATTR_CHUNK].size); @@ -3899,6 +4277,7 @@ transform_engine(LoaderState* st) GenOp* instr; Uint* pc; int rval; + static Uint restart_fail[1] = {TOP_fail}; ASSERT(gen_opc[st->genop->op].transform != -1); pc = op_transform + gen_opc[st->genop->op].transform; @@ -3912,7 +4291,6 @@ transform_engine(LoaderState* st) ASSERT(restart != NULL); pc = restart; ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ - ASSERT(*pc == TOP_try_me_else || *pc == TOP_fail); instr = st->genop; #define RETURN(r) rval = (r); goto do_return; @@ -3925,7 +4303,9 @@ transform_engine(LoaderState* st) op = *pc++; switch (op) { - case TOP_is_op: + case TOP_next_instr: + instr = instr->next; + ap = 0; if (instr == NULL) { /* * We'll need at least one more instruction to decide whether @@ -4112,10 +4492,6 @@ transform_engine(LoaderState* st) case TOP_next_arg: ap++; break; - case TOP_next_instr: - instr = instr->next; - ap = 0; - break; case TOP_commit: instr = instr->next; /* The next_instr was optimized away. */ @@ -4133,8 +4509,8 @@ transform_engine(LoaderState* st) #endif break; -#if defined(TOP_call) - case TOP_call: +#if defined(TOP_call_end) + case TOP_call_end: { GenOp** lastp; GenOp* new_instr; @@ -4171,7 +4547,7 @@ transform_engine(LoaderState* st) *lastp = st->genop; st->genop = new_instr; } - break; + RETURN(TE_OK); #endif case TOP_new_instr: /* @@ -4180,12 +4556,10 @@ transform_engine(LoaderState* st) NEW_GENOP(st, instr); instr->next = st->genop; st->genop = instr; + instr->op = op = *pc++; + instr->arity = gen_opc[op].arity; ap = 0; break; - case TOP_store_op: - instr->op = *pc++; - instr->arity = *pc++; - break; case TOP_store_type: i = *pc++; instr->a[ap].type = i; @@ -4195,21 +4569,25 @@ transform_engine(LoaderState* st) i = *pc++; instr->a[ap].val = i; break; - case TOP_store_var: + case TOP_store_var_next_arg: i = *pc++; ASSERT(i < TE_MAX_VARS); instr->a[ap].type = var[i].type; instr->a[ap].val = var[i].val; + ap++; break; case TOP_try_me_else: restart = pc + 1; restart += *pc++; ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ break; + case TOP_try_me_else_fail: + restart = restart_fail; + break; case TOP_end: RETURN(TE_OK); case TOP_fail: - RETURN(TE_FAIL) + RETURN(TE_FAIL); default: ASSERT(0); } @@ -4810,17 +5188,24 @@ compilation_info_for_module(Process* p, /* Process whose heap to use. */ return result; } - /* - * Returns a pointer to {module, function, arity}, or NULL if not found. + * Find a function from the given pc and fill information in + * the FunctionInfo struct. If the full_info is non-zero, fill + * in all available information (including location in the + * source code). If no function is found, the 'current' field + * will be set to NULL. */ -BeamInstr * -find_function_from_pc(BeamInstr* pc) + +void +erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info) { Range* low = modules; Range* high = low + num_loaded_modules; Range* mid = mid_module; + fi->current = NULL; + fi->needed = 5; + fi->loc = LINE_INVALID_LOCATION; while (low < high) { if (pc < mid->start) { high = mid; @@ -4837,25 +5222,159 @@ find_function_from_pc(BeamInstr* pc) high1 = mid1; } else if (pc < mid1[1]) { mid_module = mid; - return mid1[0]+2; + fi->current = mid1[0]+2; + if (full_info) { + BeamInstr** fp = (BeamInstr **) (mid->start + + MI_FUNCTIONS); + int idx = mid1 - fp; + lookup_loc(fi, pc, mid->start, idx); + } + return; } else { low1 = mid1 + 1; } } - return NULL; + return; } mid = low + (high-low) / 2; } - return NULL; +} + +static void +lookup_loc(FunctionInfo* fi, BeamInstr* orig_pc, BeamInstr* modp, int idx) +{ + Eterm* line = (Eterm *) modp[MI_LINE_TABLE]; + Eterm* low; + Eterm* high; + Eterm* mid; + Eterm pc; + + if (line == 0) { + return; + } + + pc = (Eterm) (BeamInstr) orig_pc; + fi->fname_ptr = (Eterm *) (BeamInstr) line[MI_LINE_FNAME_PTR]; + low = (Eterm *) (BeamInstr) line[MI_LINE_FUNC_TAB+idx]; + high = (Eterm *) (BeamInstr) line[MI_LINE_FUNC_TAB+idx+1]; + while (high > low) { + mid = low + (high-low) / 2; + if (pc < mid[0]) { + high = mid; + } else if (pc < mid[1]) { + int file; + int index = mid - (Eterm *) (BeamInstr) line[MI_LINE_FUNC_TAB]; + + if (line[MI_LINE_LOC_SIZE] == 2) { + Uint16* loc_table = + (Uint16 *) (BeamInstr) line[MI_LINE_LOC_TAB]; + fi->loc = loc_table[index]; + } else { + Uint32* loc_table = + (Uint32 *) (BeamInstr) line[MI_LINE_LOC_TAB]; + ASSERT(line[MI_LINE_LOC_SIZE] == 4); + fi->loc = loc_table[index]; + } + if (fi->loc == LINE_INVALID_LOCATION) { + return; + } + fi->needed += 3+2+3+2; + file = LOC_FILE(fi->loc); + if (file == 0) { + /* Special case: Module name with ".erl" appended */ + Atom* mod_atom = atom_tab(atom_val(fi->current[0])); + fi->needed += 2*(mod_atom->len+4); + } else { + Atom* ap = atom_tab(atom_val((fi->fname_ptr)[file-1])); + fi->needed += 2*ap->len; + } + return; + } else { + low = mid + 1; + } + } +} + +/* + * Build a single {M,F,A,Loction} item to be part of + * a stack trace. + */ +Eterm* +erts_build_mfa_item(FunctionInfo* fi, Eterm* hp, Eterm args, Eterm* mfa_p) +{ + BeamInstr* current = fi->current; + Eterm loc = NIL; + + if (fi->loc != LINE_INVALID_LOCATION) { + Eterm tuple; + int line = LOC_LINE(fi->loc); + int file = LOC_FILE(fi->loc); + Eterm file_term = NIL; + + if (file == 0) { + Atom* ap = atom_tab(atom_val(fi->current[0])); + file_term = buf_to_intlist(&hp, ".erl", 4, NIL); + file_term = buf_to_intlist(&hp, (char*)ap->name, ap->len, file_term); + } else { + Atom* ap = atom_tab(atom_val((fi->fname_ptr)[file-1])); + file_term = buf_to_intlist(&hp, (char*)ap->name, ap->len, NIL); + } + + tuple = TUPLE2(hp, am_line, make_small(line)); + hp += 3; + loc = CONS(hp, tuple, loc); + hp += 2; + tuple = TUPLE2(hp, am_file, file_term); + hp += 3; + loc = CONS(hp, tuple, loc); + hp += 2; + } + + if (is_list(args) || is_nil(args)) { + *mfa_p = TUPLE4(hp, current[0], current[1], args, loc); + } else { + Eterm arity = make_small(current[2]); + *mfa_p = TUPLE4(hp, current[0], current[1], arity, loc); + } + return hp + 5; +} + +/* + * Force setting of the current function in a FunctionInfo + * structure. No source code location will be associated with + * the function. + */ +void +erts_set_current_function(FunctionInfo* fi, BeamInstr* current) +{ + fi->current = current; + fi->needed = 5; + fi->loc = LINE_INVALID_LOCATION; +} + + +/* + * Returns a pointer to {module, function, arity}, or NULL if not found. + */ +BeamInstr* +find_function_from_pc(BeamInstr* pc) +{ + FunctionInfo fi; + + erts_lookup_function_info(&fi, pc, 0); + return fi.current; } /* * Read a specific chunk from a Beam binary. */ -Eterm -code_get_chunk_2(Process* p, Eterm Bin, Eterm Chunk) +BIF_RETTYPE +code_get_chunk_2(BIF_ALIST_2) { + Process* p = BIF_P; + Eterm Bin = BIF_ARG_1; + Eterm Chunk = BIF_ARG_2; LoaderState state; Uint chunk = 0; ErlSubBin* sb; @@ -4920,9 +5439,11 @@ code_get_chunk_2(Process* p, Eterm Bin, Eterm Chunk) * Calculate the MD5 for a module. */ -Eterm -code_module_md5_1(Process* p, Eterm Bin) +BIF_RETTYPE +code_module_md5_1(BIF_ALIST_1) { + Process* p = BIF_P; + Eterm Bin = BIF_ARG_1; LoaderState state; byte* temp_alloc = NULL; @@ -5179,7 +5700,17 @@ patch_funentries(Eterm Patchlist) fe = erts_get_fun_entry(Mod, uniq, index); fe->native_address = (Uint *)native_address; - erts_refc_dec(&fe->refc, 1); + + /* Deliberate MEMORY LEAK of native fun entries!!! + * + * Uncomment line below when hipe code upgrade and purging works correctly. + * Today we may get cases when old (leaked) native code of a purged module + * gets called and tries to create instances of a deleted fun entry. + * + * Reproduced on a debug emulator with stdlib_test/qlc_SUITE:join_merge + * + * erts_refc_dec(&fe->refc, 1); + */ if (!patch(Addresses, (Uint) fe)) return 0; diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h index 26e3054c4b..9d4a60fed1 100644 --- a/erts/emulator/beam/beam_load.h +++ b/erts/emulator/beam/beam_load.h @@ -108,6 +108,11 @@ extern Uint erts_total_code_size; #define MI_ON_LOAD_FUNCTION_PTR 10 /* + * Pointer to the line table (or NULL if none). + */ +#define MI_LINE_TABLE 11 + +/* * Start of function pointer table. This table contains pointers to * all functions in the module plus an additional pointer just beyond * the end of the last function. @@ -116,5 +121,5 @@ extern Uint erts_total_code_size; * this table. */ -#define MI_FUNCTIONS 11 +#define MI_FUNCTIONS 12 #endif /* _BEAM_LOAD_H */ diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 8edc863767..8ab363a1ec 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -1108,9 +1108,9 @@ BIF_RETTYPE hibernate_3(BIF_ALIST_3) /**********************************************************************/ -BIF_RETTYPE get_stacktrace_0(Process* p) +BIF_RETTYPE get_stacktrace_0(BIF_ALIST_0) { - Eterm t = build_stacktrace(p, p->ftrace); + Eterm t = build_stacktrace(BIF_P, BIF_P->ftrace); BIF_RET(t); } @@ -1120,10 +1120,10 @@ BIF_RETTYPE get_stacktrace_0(Process* p) * the process, and the final error value will be {Term,StackTrace}. */ -BIF_RETTYPE error_1(Process* p, Eterm term) +BIF_RETTYPE error_1(BIF_ALIST_1) { - p->fvalue = term; - BIF_ERROR(p, EXC_ERROR); + BIF_P->fvalue = BIF_ARG_1; + BIF_ERROR(BIF_P, EXC_ERROR); } /**********************************************************************/ @@ -1132,12 +1132,12 @@ BIF_RETTYPE error_1(Process* p, Eterm term) * in the stacktrace. */ -BIF_RETTYPE error_2(Process* p, Eterm value, Eterm args) +BIF_RETTYPE error_2(BIF_ALIST_2) { - Eterm* hp = HAlloc(p, 3); + Eterm* hp = HAlloc(BIF_P, 3); - p->fvalue = TUPLE2(hp, value, args); - BIF_ERROR(p, EXC_ERROR_2); + BIF_P->fvalue = TUPLE2(hp, BIF_ARG_1, BIF_ARG_2); + BIF_ERROR(BIF_P, EXC_ERROR_2); } /**********************************************************************/ @@ -1147,10 +1147,10 @@ BIF_RETTYPE error_2(Process* p, Eterm value, Eterm args) * It is useful in stub functions for NIFs. */ -BIF_RETTYPE nif_error_1(Process* p, Eterm term) +BIF_RETTYPE nif_error_1(BIF_ALIST_1) { - p->fvalue = term; - BIF_ERROR(p, EXC_ERROR); + BIF_P->fvalue = BIF_ARG_1; + BIF_ERROR(BIF_P, EXC_ERROR); } /**********************************************************************/ @@ -1160,12 +1160,12 @@ BIF_RETTYPE nif_error_1(Process* p, Eterm term) * It is useful in stub functions for NIFs. */ -BIF_RETTYPE nif_error_2(Process* p, Eterm value, Eterm args) +BIF_RETTYPE nif_error_2(BIF_ALIST_2) { - Eterm* hp = HAlloc(p, 3); + Eterm* hp = HAlloc(BIF_P, 3); - p->fvalue = TUPLE2(hp, value, args); - BIF_ERROR(p, EXC_ERROR_2); + BIF_P->fvalue = TUPLE2(hp, BIF_ARG_1, BIF_ARG_2); + BIF_ERROR(BIF_P, EXC_ERROR_2); } /**********************************************************************/ @@ -1184,14 +1184,19 @@ BIF_RETTYPE exit_1(BIF_ALIST_1) * If there is an error in the argument format, * return the atom 'badarg' instead. */ -Eterm -raise_3(Process *c_p, Eterm class, Eterm value, Eterm stacktrace) { +BIF_RETTYPE raise_3(BIF_ALIST_3) +{ + Process *c_p = BIF_P; + Eterm class = BIF_ARG_1; + Eterm value = BIF_ARG_2; + Eterm stacktrace = BIF_ARG_3; Eterm reason; Eterm l, *hp, *hp_end, *tp; int depth, cnt; size_t sz; + int must_copy = 0; struct StackTrace *s; - + if (class == am_error) { c_p->fvalue = value; reason = EXC_ERROR; @@ -1207,35 +1212,74 @@ raise_3(Process *c_p, Eterm class, Eterm value, Eterm stacktrace) { /* Check syntax of stacktrace, and count depth. * Accept anything that can be returned from erlang:get_stacktrace/0, * as well as a 2-tuple with a fun as first element that the - * error_handler may need to give us. + * error_handler may need to give us. Also allow old-style + * MFA three-tuples. */ for (l = stacktrace, depth = 0; is_list(l); l = CDR(list_val(l)), depth++) { Eterm t = CAR(list_val(l)); - int arity; + Eterm location = NIL; + if (is_not_tuple(t)) goto error; tp = tuple_val(t); - arity = arityval(tp[0]); - if ((arity == 3) && is_atom(tp[1]) && is_atom(tp[2])) continue; - if ((arity == 2) && is_fun(tp[1])) continue; - goto error; + switch (arityval(tp[0])) { + case 2: + /* {Fun,Args} */ + if (is_fun(tp[1])) { + must_copy = 1; + } else { + goto error; + } + break; + case 3: + /* + * One of: + * {Fun,Args,Location} + * {M,F,A} + */ + if (is_fun(tp[1])) { + location = tp[3]; + } else if (is_atom(tp[1]) && is_atom(tp[2])) { + must_copy = 1; + } else { + goto error; + } + break; + case 4: + if (!(is_atom(tp[1]) && is_atom(tp[2]))) { + goto error; + } + location = tp[4]; + break; + default: + goto error; + } + if (is_not_list(location) && is_not_nil(location)) { + goto error; + } } if (is_not_nil(l)) goto error; /* Create stacktrace and store */ - if (depth <= erts_backtrace_depth) { + if (erts_backtrace_depth < depth) { + depth = erts_backtrace_depth; + must_copy = 1; + } + if (must_copy) { + cnt = depth; + c_p->ftrace = NIL; + } else { + /* No need to copy the stacktrace */ cnt = 0; c_p->ftrace = stacktrace; - } else { - cnt = depth = erts_backtrace_depth; - c_p->ftrace = NIL; } + tp = &c_p->ftrace; sz = (offsetof(struct StackTrace, trace) + sizeof(Eterm) - 1) / sizeof(Eterm); - hp = HAlloc(c_p, sz + 2*(cnt + 1)); - hp_end = hp + sz + 2*(cnt + 1); + hp = HAlloc(c_p, sz + (2+6)*(cnt + 1)); + hp_end = hp + sz + (2+6)*(cnt + 1); s = (struct StackTrace *) hp; s->header = make_neg_bignum_header(sz - 1); s->freason = reason; @@ -1243,13 +1287,29 @@ raise_3(Process *c_p, Eterm class, Eterm value, Eterm stacktrace) { s->current = NULL; s->depth = 0; hp += sz; - if (cnt > 0) { + if (must_copy) { + int cnt; + /* Copy list up to depth */ for (cnt = 0, l = stacktrace; cnt < depth; cnt++, l = CDR(list_val(l))) { + Eterm t; + Eterm *tpp; + int arity; + ASSERT(*tp == NIL); - *tp = CONS(hp, CAR(list_val(l)), *tp); + t = CAR(list_val(l)); + tpp = tuple_val(t); + arity = arityval(tpp[0]); + if (arity == 2) { + t = TUPLE3(hp, tpp[1], tpp[2], NIL); + hp += 4; + } else if (arity == 3 && is_atom(tpp[1])) { + t = TUPLE4(hp, tpp[1], tpp[2], tpp[3], NIL); + hp += 5; + } + *tp = CONS(hp, t, *tp); tp = &CDR(list_val(*tp)); hp += 2; } @@ -1257,7 +1317,7 @@ raise_3(Process *c_p, Eterm class, Eterm value, Eterm stacktrace) { c_p->ftrace = CONS(hp, c_p->ftrace, make_big((Eterm *) s)); hp += 2; ASSERT(hp <= hp_end); - + HRelease(c_p, hp_end, hp); BIF_ERROR(c_p, reason); error: @@ -1675,10 +1735,10 @@ BIF_RETTYPE whereis_1(BIF_ALIST_1) * erlang:'!'/2 */ -Eterm -ebif_bang_2(Process* p, Eterm To, Eterm Message) +BIF_RETTYPE +ebif_bang_2(BIF_ALIST_2) { - return send_2(p, To, Message); + return erl_send(BIF_P, BIF_ARG_1, BIF_ARG_2); } @@ -2015,8 +2075,13 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend) { } -Eterm -send_3(Process *p, Eterm to, Eterm msg, Eterm opts) { +BIF_RETTYPE send_3(BIF_ALIST_3) +{ + Process *p = BIF_P; + Eterm to = BIF_ARG_1; + Eterm msg = BIF_ARG_2; + Eterm opts = BIF_ARG_3; + int connect = !0; int suspend = !0; Eterm l = opts; @@ -2080,8 +2145,13 @@ send_3(Process *p, Eterm to, Eterm msg, Eterm opts) { BIF_ERROR(p, BADARG); } -Eterm -send_2(Process *p, Eterm to, Eterm msg) { +BIF_RETTYPE send_2(BIF_ALIST_2) +{ + return erl_send(BIF_P, BIF_ARG_1, BIF_ARG_2); +} + +Eterm erl_send(Process *p, Eterm to, Eterm msg) +{ Sint result = do_send(p, to, msg, !0); if (result > 0) { @@ -3257,8 +3327,11 @@ time_to_parts(Eterm date, Sint* year, Sint* month, Sint* day, /* return the universal time */ BIF_RETTYPE -localtime_to_universaltime_2(Process *p, Eterm localtime, Eterm dst) +localtime_to_universaltime_2(BIF_ALIST_2) { + Process *p = BIF_P; + Eterm localtime = BIF_ARG_1; + Eterm dst = BIF_ARG_2; Sint year, month, day; Sint hour, minute, second; int isdst; @@ -3507,9 +3580,10 @@ BIF_RETTYPE erts_debug_display_1(BIF_ALIST_1) } -Eterm -display_string_1(Process* p, Eterm string) +BIF_RETTYPE display_string_1(BIF_ALIST_1) { + Process* p = BIF_P; + Eterm string = BIF_ARG_1; int len = is_string(string); char *str; @@ -3525,8 +3599,7 @@ display_string_1(Process* p, Eterm string) BIF_RET(am_true); } -Eterm -display_nl_0(Process* p) +BIF_RETTYPE display_nl_0(BIF_ALIST_0) { erts_fprintf(stderr, "\n"); BIF_RET(am_true); @@ -3590,8 +3663,13 @@ BIF_RETTYPE function_exported_3(BIF_ALIST_3) /**********************************************************************/ -BIF_RETTYPE is_builtin_3(Process* p, Eterm Mod, Eterm Name, Eterm Arity) +BIF_RETTYPE is_builtin_3(BIF_ALIST_3) { + Process* p = BIF_P; + Eterm Mod = BIF_ARG_1; + Eterm Name = BIF_ARG_2; + Eterm Arity = BIF_ARG_3; + if (is_not_atom(Mod) || is_not_atom(Name) || is_not_small(Arity)) { BIF_ERROR(p, BADARG); } @@ -3656,9 +3734,11 @@ BIF_RETTYPE make_fun_3(BIF_ALIST_3) BIF_RET(make_export(hp)); } -Eterm -fun_to_list_1(Process* p, Eterm fun) +BIF_RETTYPE fun_to_list_1(BIF_ALIST_1) { + Process* p = BIF_P; + Eterm fun = BIF_ARG_1; + if (is_not_any_fun(fun)) BIF_ERROR(p, BADARG); BIF_RET(term2list_dsprintf(p, fun)); @@ -3996,7 +4076,7 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) erts_backtrace_depth = n; BIF_RET(make_small(oval)); } else if (BIF_ARG_1 == am_trace_control_word) { - BIF_RET(db_set_trace_control_word_1(BIF_P, BIF_ARG_2)); + BIF_RET(db_set_trace_control_word(BIF_P, BIF_ARG_2)); } else if (BIF_ARG_1 == am_sequential_tracer) { Eterm old_value = erts_set_system_seq_tracer(BIF_P, ERTS_PROC_LOCK_MAIN, @@ -4236,8 +4316,7 @@ void erts_bif_prep_await_proc_exit_data_trap(Process *c_p, Eterm pid, Eterm ret) { if (skip_current_msgq(c_p)) { - Eterm unused; - ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, pid, am_data, ret); + ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p, pid, am_data, ret); } } @@ -4245,8 +4324,7 @@ void erts_bif_prep_await_proc_exit_reason_trap(Process *c_p, Eterm pid) { if (skip_current_msgq(c_p)) { - Eterm unused; - ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, + ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p, pid, am_reason, am_undefined); } } @@ -4261,7 +4339,6 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, { ASSERT(is_atom(module) && is_atom(function)); if (skip_current_msgq(c_p)) { - Eterm unused; Eterm term; Eterm *hp; int i; @@ -4273,7 +4350,7 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, hp += 2; } term = TUPLE3(hp, module, function, term); - ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, pid, am_apply, term); + ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p, pid, am_apply, term); } } diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h index 8faa09feb8..d20089a9fb 100644 --- a/erts/emulator/beam/bif.h +++ b/erts/emulator/beam/bif.h @@ -26,14 +26,14 @@ extern Export* erts_format_cpu_topology_trap; #define BIF_P A__p -#define BIF_ALIST_0 Process* A__p -#define BIF_ALIST_1 Process* A__p, Eterm A_1 -#define BIF_ALIST_2 Process* A__p, Eterm A_1, Eterm A_2 -#define BIF_ALIST_3 Process* A__p, Eterm A_1, Eterm A_2, Eterm A_3 +#define BIF_ALIST_0 Process* A__p, Eterm* BIF__ARGS +#define BIF_ALIST_1 Process* A__p, Eterm* BIF__ARGS +#define BIF_ALIST_2 Process* A__p, Eterm* BIF__ARGS +#define BIF_ALIST_3 Process* A__p, Eterm* BIF__ARGS -#define BIF_ARG_1 A_1 -#define BIF_ARG_2 A_2 -#define BIF_ARG_3 A_3 +#define BIF_ARG_1 (BIF__ARGS[0]) +#define BIF_ARG_2 (BIF__ARGS[1]) +#define BIF_ARG_3 (BIF__ARGS[2]) #define BUMP_ALL_REDS(p) do { \ if (!ERTS_PROC_GET_SAVED_CALLS_BUF((p))) \ @@ -122,89 +122,106 @@ do { \ } while (0) -#define ERTS_BIF_PREP_TRAP0(Ret, Trap, Proc) \ -do { \ - (Proc)->arity = 0; \ - *((UWord *) (UWord) ((Proc)->def_arg_reg + 3)) = (UWord) ((Trap)->address); \ - (Proc)->freason = TRAP; \ - (Ret) = THE_NON_VALUE; \ +#define ERTS_BIF_PREP_TRAP0(Ret, Trap, Proc) \ +do { \ + (Proc)->arity = 0; \ + (Proc)->i = (BeamInstr*) ((Trap)->address); \ + (Proc)->freason = TRAP; \ + (Ret) = THE_NON_VALUE; \ } while (0) -#define ERTS_BIF_PREP_TRAP1(Ret, Trap, Proc, A0) \ -do { \ - (Proc)->arity = 1; \ - (Proc)->def_arg_reg[0] = (Eterm) (A0); \ - *((UWord *) (UWord) ((Proc)->def_arg_reg + 3)) = (UWord) ((Trap)->address); \ - (Proc)->freason = TRAP; \ - (Ret) = THE_NON_VALUE; \ +#define ERTS_BIF_PREP_TRAP1(Ret, Trap, Proc, A0) \ +do { \ + Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \ + (Proc)->arity = 1; \ + reg[0] = (Eterm) (A0); \ + (Proc)->i = (BeamInstr*) ((Trap)->address); \ + (Proc)->freason = TRAP; \ + (Ret) = THE_NON_VALUE; \ } while (0) -#define ERTS_BIF_PREP_TRAP2(Ret, Trap, Proc, A0, A1) \ -do { \ - (Proc)->arity = 2; \ - (Proc)->def_arg_reg[0] = (Eterm) (A0); \ - (Proc)->def_arg_reg[1] = (Eterm) (A1); \ - *((UWord *) (UWord) ((Proc)->def_arg_reg + 3)) = (UWord) ((Trap)->address); \ - (Proc)->freason = TRAP; \ - (Ret) = THE_NON_VALUE; \ +#define ERTS_BIF_PREP_TRAP2(Ret, Trap, Proc, A0, A1) \ +do { \ + Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \ + (Proc)->arity = 2; \ + reg[0] = (Eterm) (A0); \ + reg[1] = (Eterm) (A1); \ + (Proc)->i = (BeamInstr*) ((Trap)->address); \ + (Proc)->freason = TRAP; \ + (Ret) = THE_NON_VALUE; \ +} while (0) + +#define ERTS_BIF_PREP_TRAP3(Ret, Trap, Proc, A0, A1, A2) \ +do { \ + Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \ + (Proc)->arity = 3; \ + reg[0] = (Eterm) (A0); \ + reg[1] = (Eterm) (A1); \ + reg[2] = (Eterm) (A2); \ + (Proc)->i = (BeamInstr*) ((Trap)->address); \ + (Proc)->freason = TRAP; \ + (Ret) = THE_NON_VALUE; \ } while (0) -#define ERTS_BIF_PREP_TRAP3(Ret, Trap, Proc, A0, A1, A2)\ +#define ERTS_BIF_PREP_TRAP3_NO_RET(Trap, Proc, A0, A1, A2)\ do { \ + Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \ (Proc)->arity = 3; \ - (Proc)->def_arg_reg[0] = (Eterm) (A0); \ - (Proc)->def_arg_reg[1] = (Eterm) (A1); \ - (Proc)->def_arg_reg[2] = (Eterm) (A2); \ - *((UWord *) (UWord) ((Proc)->def_arg_reg + 3)) = (UWord) ((Trap)->address); \ + reg[0] = (Eterm) (A0); \ + reg[1] = (Eterm) (A1); \ + reg[2] = (Eterm) (A2); \ + (Proc)->i = (BeamInstr*) ((Trap)->address); \ (Proc)->freason = TRAP; \ - (Ret) = THE_NON_VALUE; \ } while (0) -#define BIF_TRAP0(p, Trap_) do { \ - (p)->arity = 0; \ - *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) ((Trap_)->address); \ - (p)->freason = TRAP; \ - return THE_NON_VALUE; \ +#define BIF_TRAP0(p, Trap_) do { \ + (p)->arity = 0; \ + (p)->i = (BeamInstr*) ((Trap_)->address); \ + (p)->freason = TRAP; \ + return THE_NON_VALUE; \ } while(0) -#define BIF_TRAP1(Trap_, p, A0) do { \ - (p)->arity = 1; \ - (p)->def_arg_reg[0] = (A0); \ - *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) ((Trap_)->address); \ - (p)->freason = TRAP; \ - return THE_NON_VALUE; \ +#define BIF_TRAP1(Trap_, p, A0) do { \ + Eterm* reg = ERTS_PROC_GET_SCHDATA((p))->x_reg_array; \ + (p)->arity = 1; \ + reg[0] = (A0); \ + (p)->i = (BeamInstr*) ((Trap_)->address); \ + (p)->freason = TRAP; \ + return THE_NON_VALUE; \ } while(0) -#define BIF_TRAP2(Trap_, p, A0, A1) do { \ - (p)->arity = 2; \ - (p)->def_arg_reg[0] = (A0); \ - (p)->def_arg_reg[1] = (A1); \ - *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) ((Trap_)->address); \ - (p)->freason = TRAP; \ - return THE_NON_VALUE; \ +#define BIF_TRAP2(Trap_, p, A0, A1) do { \ + Eterm* reg = ERTS_PROC_GET_SCHDATA((p))->x_reg_array; \ + (p)->arity = 2; \ + reg[0] = (A0); \ + reg[1] = (A1); \ + (p)->i = (BeamInstr*) ((Trap_)->address); \ + (p)->freason = TRAP; \ + return THE_NON_VALUE; \ } while(0) -#define BIF_TRAP3(Trap_, p, A0, A1, A2) do { \ - (p)->arity = 3; \ - (p)->def_arg_reg[0] = (A0); \ - (p)->def_arg_reg[1] = (A1); \ - (p)->def_arg_reg[2] = (A2); \ - *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) ((Trap_)->address); \ - (p)->freason = TRAP; \ - return THE_NON_VALUE; \ +#define BIF_TRAP3(Trap_, p, A0, A1, A2) do { \ + Eterm* reg = ERTS_PROC_GET_SCHDATA((p))->x_reg_array; \ + (p)->arity = 3; \ + reg[0] = (A0); \ + reg[1] = (A1); \ + reg[2] = (A2); \ + (p)->i = (BeamInstr*) ((Trap_)->address); \ + (p)->freason = TRAP; \ + return THE_NON_VALUE; \ } while(0) -#define BIF_TRAP_CODE_PTR_0(p, Code_) do { \ - (p)->arity = 0; \ - *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) (Code_); \ - (p)->freason = TRAP; \ - return THE_NON_VALUE; \ +#define BIF_TRAP_CODE_PTR_0(p, Code_) do { \ + (p)->arity = 0; \ + (p)->i = (BeamInstr*) (Code_); \ + (p)->freason = TRAP; \ + return THE_NON_VALUE; \ } while(0) -#define BIF_TRAP_CODE_PTR_(p, Code_) do { \ - *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) (Code_); \ - (p)->freason = TRAP; \ - return THE_NON_VALUE; \ +#define BIF_TRAP_CODE_PTR_(p, Code_) do { \ + (p)-> i = (BeamInstr*) (Code_); \ + (p)->freason = TRAP; \ + return THE_NON_VALUE; \ } while(0) extern Export bif_return_trap_export; diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index d18de9ae5d..b90ea6b478 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -1584,6 +1584,62 @@ big_to_double(Wterm x, double* resp) return 0; } +/* + * Logic has been copied from erl_bif_guard.c and slightly + * modified to use a static instead of dynamic heap + */ +Eterm +double_to_big(double x, Eterm *heap) +{ + int is_negative; + int ds; + ErtsDigit* xp; + Eterm res; + int i; + size_t sz; + Eterm* hp; + double dbase; + + if (x >= 0) { + is_negative = 0; + } else { + is_negative = 1; + x = -x; + } + + /* Unscale & (calculate exponent) */ + ds = 0; + dbase = ((double) (D_MASK) + 1); + while (x >= 1.0) { + x /= dbase; /* "shift" right */ + ds++; + } + sz = BIG_NEED_SIZE(ds); /* number of words including arity */ + + hp = heap; + res = make_big(hp); + xp = (ErtsDigit*) (hp + 1); + + for (i = ds - 1; i >= 0; i--) { + ErtsDigit d; + + x *= dbase; /* "shift" left */ + d = x; /* trunc */ + xp[i] = d; /* store digit */ + x -= d; /* remove integer part */ + } + while ((ds & (BIG_DIGITS_PER_WORD - 1)) != 0) { + xp[ds++] = 0; + } + + if (is_negative) { + *hp = make_neg_bignum_header(sz-1); + } else { + *hp = make_pos_bignum_header(sz-1); + } + return res; +} + /* ** Estimate the number of decimal digits (include sign) diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index 2afc37004f..256f1c2b45 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -140,6 +140,7 @@ Eterm big_lshift(Eterm, Sint, Eterm*); int big_comp (Wterm, Wterm); int big_ucomp (Eterm, Eterm); int big_to_double(Wterm x, double* resp); +Eterm double_to_big(double, Eterm*); Eterm small_to_big(Sint, Eterm*); Eterm uint_to_big(Uint, Eterm*); Eterm uword_to_big(UWord, Eterm*); diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c index 1fb39c6c67..29461877c5 100644 --- a/erts/emulator/beam/binary.c +++ b/erts/emulator/beam/binary.c @@ -356,8 +356,10 @@ BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg) { Eterm bin; Uint size; - int offset; byte* bytes; +#ifdef DEBUG + int offset; +#endif if (is_nil(arg)) { BIF_RET(new_binary(p,(byte*)"",0)); @@ -372,7 +374,11 @@ BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg) } bin = new_binary(p, (byte *)NULL, size); bytes = binary_bytes(bin); - offset = io_list_to_buf(arg, (char*) bytes, size); +#ifdef DEBUG + offset = +#endif + io_list_to_buf(arg, (char*) bytes, size); + ASSERT(offset == 0); BIF_RET(bin); diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 8d37ae9f9b..784e55ecd2 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -95,7 +95,7 @@ process_killer(void) erts_printf("(k)ill (n)ext (r)eturn:\n"); while(1) { if ((j = sys_get_key(0)) <= 0) - halt_0(0); + erl_exit(0, ""); switch(j) { case 'k': if (rp->status == P_WAITING) { diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index d62eed21b4..264374789c 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -2731,85 +2731,92 @@ BIF_RETTYPE is_alive_0(BIF_ALIST_0) /**********************************************************************/ /* erlang:monitor_node(Node, Bool, Options) -> Bool */ -BIF_RETTYPE monitor_node_3(BIF_ALIST_3) +static BIF_RETTYPE +monitor_node(Process* p, Eterm Node, Eterm Bool, Eterm Options) { DistEntry *dep; ErtsLink *lnk; Eterm l; - for (l = BIF_ARG_3; l != NIL && is_list(l); l = CDR(list_val(l))) { + for (l = Options; l != NIL && is_list(l); l = CDR(list_val(l))) { Eterm t = CAR(list_val(l)); /* allow_passive_connect the only available option right now */ if (t != am_allow_passive_connect) { - BIF_ERROR(BIF_P, BADARG); + BIF_ERROR(p, BADARG); } } if (l != NIL) { - BIF_ERROR(BIF_P, BADARG); + BIF_ERROR(p, BADARG); } - if (is_not_atom(BIF_ARG_1) || - ((BIF_ARG_2 != am_true) && (BIF_ARG_2 != am_false)) || + if (is_not_atom(Node) || + ((Bool != am_true) && (Bool != am_false)) || ((erts_this_node->sysname == am_Noname) - && (BIF_ARG_1 != erts_this_node->sysname))) { - BIF_ERROR(BIF_P, BADARG); + && (Node != erts_this_node->sysname))) { + BIF_ERROR(p, BADARG); } - dep = erts_sysname_to_connected_dist_entry(BIF_ARG_1); + dep = erts_sysname_to_connected_dist_entry(Node); if (!dep) { do_trap: - BIF_TRAP3(dmonitor_node_trap, BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + BIF_TRAP3(dmonitor_node_trap, p, Node, Bool, Options); } if (dep == erts_this_dist_entry) goto done; - erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_LINK); erts_smp_de_rlock(dep); if (ERTS_DE_IS_NOT_CONNECTED(dep)) { - erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK); + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK); erts_smp_de_runlock(dep); goto do_trap; } erts_smp_de_links_lock(dep); erts_smp_de_runlock(dep); - if (BIF_ARG_2 == am_true) { + if (Bool == am_true) { ASSERT(dep->cid != NIL); lnk = erts_add_or_lookup_link(&(dep->node_links), LINK_NODE, - BIF_P->id); + p->id); ++ERTS_LINK_REFC(lnk); - lnk = erts_add_or_lookup_link(&(BIF_P->nlinks), LINK_NODE, BIF_ARG_1); + lnk = erts_add_or_lookup_link(&(p->nlinks), LINK_NODE, Node); ++ERTS_LINK_REFC(lnk); } else { - lnk = erts_lookup_link(dep->node_links, BIF_P->id); + lnk = erts_lookup_link(dep->node_links, p->id); if (lnk != NULL) { if ((--ERTS_LINK_REFC(lnk)) == 0) { erts_destroy_link(erts_remove_link(&(dep->node_links), - BIF_P->id)); + p->id)); } } - lnk = erts_lookup_link(BIF_P->nlinks, BIF_ARG_1); + lnk = erts_lookup_link(p->nlinks, Node); if (lnk != NULL) { if ((--ERTS_LINK_REFC(lnk)) == 0) { - erts_destroy_link(erts_remove_link(&(BIF_P->nlinks), - BIF_ARG_1)); + erts_destroy_link(erts_remove_link(&(p->nlinks), + Node)); } } } erts_smp_de_links_unlock(dep); - erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK); + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK); done: erts_deref_dist_entry(dep); BIF_RET(am_true); } +BIF_RETTYPE monitor_node_3(BIF_ALIST_3) +{ + BIF_RET(monitor_node(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3)); +} + + /* monitor_node(Node, Bool) -> Bool */ BIF_RETTYPE monitor_node_2(BIF_ALIST_2) { - BIF_RET(monitor_node_3(BIF_P,BIF_ARG_1,BIF_ARG_2,NIL)); + BIF_RET(monitor_node(BIF_P, BIF_ARG_1, BIF_ARG_2, NIL)); } BIF_RETTYPE net_kernel_dflag_unicode_io_1(BIF_ALIST_1) diff --git a/erts/emulator/beam/erl_arith.c b/erts/emulator/beam/erl_arith.c index 64fad9fe0e..5150a8a507 100644 --- a/erts/emulator/beam/erl_arith.c +++ b/erts/emulator/beam/erl_arith.c @@ -164,14 +164,14 @@ BIF_RETTYPE bxor_2(BIF_ALIST_2) BIF_RET(erts_bxor(BIF_P, BIF_ARG_1, BIF_ARG_2)); } -BIF_RETTYPE bsl_2(Process* p, Eterm arg1, Eterm arg2) +BIF_RETTYPE bsl_2(BIF_ALIST_2) { - BIF_RET(shift(p, arg1, arg2, 0)); + BIF_RET(shift(BIF_P, BIF_ARG_1, BIF_ARG_2, 0)); } -BIF_RETTYPE bsr_2(Process* p, Eterm arg1, Eterm arg2) +BIF_RETTYPE bsr_2(BIF_ALIST_2) { - BIF_RET(shift(p, arg1, arg2, 1)); + BIF_RET(shift(BIF_P, BIF_ARG_1, BIF_ARG_2, 1)); } static Eterm diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c index 684fa5d12f..6d022e0d11 100644 --- a/erts/emulator/beam/erl_bif_binary.c +++ b/erts/emulator/beam/erl_bif_binary.c @@ -65,6 +65,10 @@ static Export binary_copy_trap_export; static BIF_RETTYPE binary_copy_trap(BIF_ALIST_2); static Uint max_loop_limit; +static BIF_RETTYPE +binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3); +static BIF_RETTYPE +binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3); void erts_init_bif_binary(void) { @@ -1399,6 +1403,12 @@ static BIF_RETTYPE binary_matches_trap(BIF_ALIST_3) BIF_RETTYPE binary_match_3(BIF_ALIST_3) { + return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); +} + +static BIF_RETTYPE +binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) +{ Uint hsstart; Uint hsend; Eterm *tp; @@ -1408,17 +1418,17 @@ BIF_RETTYPE binary_match_3(BIF_ALIST_3) int runres; Eterm result; - if (is_not_binary(BIF_ARG_1)) { + if (is_not_binary(arg1)) { goto badarg; } - if (parse_match_opts_list(BIF_ARG_3,BIF_ARG_1,&hsstart,&hsend)) { + if (parse_match_opts_list(arg3,arg1,&hsstart,&hsend)) { goto badarg; } if (hsend == 0) { BIF_RET(am_nomatch); } - if (is_tuple(BIF_ARG_2)) { - tp = tuple_val(BIF_ARG_2); + if (is_tuple(arg2)) { + tp = tuple_val(arg2); if (arityval(*tp) != 2 || is_not_atom(tp[1])) { goto badarg; } @@ -1437,13 +1447,13 @@ BIF_RETTYPE binary_match_3(BIF_ALIST_3) goto badarg; } bin_term = tp[2]; - } else if (do_binary_match_compile(BIF_ARG_2,&type,&bin)) { + } else if (do_binary_match_compile(arg2,&type,&bin)) { goto badarg; } - runres = do_binary_match(BIF_P,BIF_ARG_1,hsstart,hsend,type,bin,NIL,&result); + runres = do_binary_match(p,arg1,hsstart,hsend,type,bin,NIL,&result); if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) { - Eterm *hp = HAlloc(BIF_P, PROC_BIN_SIZE); - bin_term = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), bin); + Eterm *hp = HAlloc(p, PROC_BIN_SIZE); + bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin); } else if (bin_term == NIL) { erts_bin_free(bin); } @@ -1451,17 +1461,23 @@ BIF_RETTYPE binary_match_3(BIF_ALIST_3) case DO_BIN_MATCH_OK: BIF_RET(result); case DO_BIN_MATCH_RESTART: - BUMP_ALL_REDS(BIF_P); - BIF_TRAP3(&binary_match_trap_export, BIF_P, BIF_ARG_1, result, bin_term); + BUMP_ALL_REDS(p); + BIF_TRAP3(&binary_match_trap_export, p, arg1, result, bin_term); default: goto badarg; } badarg: - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } BIF_RETTYPE binary_matches_3(BIF_ALIST_3) { + return binary_matches(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); +} + +static BIF_RETTYPE +binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) +{ Uint hsstart, hsend; Eterm *tp; Eterm type; @@ -1470,17 +1486,17 @@ BIF_RETTYPE binary_matches_3(BIF_ALIST_3) int runres; Eterm result; - if (is_not_binary(BIF_ARG_1)) { + if (is_not_binary(arg1)) { goto badarg; } - if (parse_match_opts_list(BIF_ARG_3,BIF_ARG_1,&hsstart,&hsend)) { + if (parse_match_opts_list(arg3,arg1,&hsstart,&hsend)) { goto badarg; } if (hsend == 0) { BIF_RET(NIL); } - if (is_tuple(BIF_ARG_2)) { - tp = tuple_val(BIF_ARG_2); + if (is_tuple(arg2)) { + tp = tuple_val(arg2); if (arityval(*tp) != 2 || is_not_atom(tp[1])) { goto badarg; } @@ -1499,14 +1515,14 @@ BIF_RETTYPE binary_matches_3(BIF_ALIST_3) goto badarg; } bin_term = tp[2]; - } else if (do_binary_match_compile(BIF_ARG_2,&type,&bin)) { + } else if (do_binary_match_compile(arg2,&type,&bin)) { goto badarg; } - runres = do_binary_matches(BIF_P,BIF_ARG_1,hsstart,hsend,type,bin, + runres = do_binary_matches(p,arg1,hsstart,hsend,type,bin, NIL,&result); if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) { - Eterm *hp = HAlloc(BIF_P, PROC_BIN_SIZE); - bin_term = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), bin); + Eterm *hp = HAlloc(p, PROC_BIN_SIZE); + bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin); } else if (bin_term == NIL) { erts_bin_free(bin); } @@ -1514,26 +1530,26 @@ BIF_RETTYPE binary_matches_3(BIF_ALIST_3) case DO_BIN_MATCH_OK: BIF_RET(result); case DO_BIN_MATCH_RESTART: - BUMP_ALL_REDS(BIF_P); - BIF_TRAP3(&binary_matches_trap_export, BIF_P, BIF_ARG_1, result, + BUMP_ALL_REDS(p); + BIF_TRAP3(&binary_matches_trap_export, p, arg1, result, bin_term); default: goto badarg; } badarg: - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } BIF_RETTYPE binary_match_2(BIF_ALIST_2) { - return binary_match_3(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0)); + return binary_match(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0)); } BIF_RETTYPE binary_matches_2(BIF_ALIST_2) { - return binary_matches_3(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0)); + return binary_matches(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0)); } diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c index d714eacd06..a9fd28c66b 100644 --- a/erts/emulator/beam/erl_bif_ddll.c +++ b/erts/emulator/beam/erl_bif_ddll.c @@ -142,9 +142,11 @@ static void ddll_no_more_references(void *vdh); * really load and add as LOADED {ok,loaded} {ok,pending_driver} * {error, permanent} {error,load_error()} */ -BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, - Eterm name_term, Eterm options) +BIF_RETTYPE erl_ddll_try_load_3(BIF_ALIST_3) { + Eterm path_term = BIF_ARG_1; + Eterm name_term = BIF_ARG_2; + Eterm options = BIF_ARG_3; char *path = NULL; Uint path_len; char *name = NULL; @@ -236,7 +238,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, sys_strcpy(path+path_len,name); #if DDLL_SMP - erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); lock_drv_list(); #endif if ((drv = lookup_driver(name)) != NULL) { @@ -247,7 +249,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, } else { dh = drv->handle; if (dh->status == ERL_DE_OK) { - int is_last = is_last_user(dh,p); + int is_last = is_last_user(dh, BIF_P); if (reload == 1 && !is_last) { /*Want reload if no other users, but there are others...*/ @@ -261,7 +263,8 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, soft_error_term = am_inconsistent; goto soft_error; } - if ((old = find_proc_entry(dh, p, ERL_DE_PROC_LOADED)) == + if ((old = find_proc_entry(dh, BIF_P, + ERL_DE_PROC_LOADED)) == NULL) { soft_error_term = am_not_loaded_by_this_process; goto soft_error; @@ -272,7 +275,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, } /* Reload requested and granted */ dereference_all_processes(dh); - set_driver_reloading(dh, p, path, name, flags); + set_driver_reloading(dh, BIF_P, path, name, flags); if (dh->flags & ERL_DE_FL_KILL_PORTS) { kill_ports = 1; } @@ -286,7 +289,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, soft_error_term = am_inconsistent; goto soft_error; } - add_proc_loaded(dh,p); + add_proc_loaded(dh, BIF_P); erts_ddll_reference_driver(dh); monitor = 0; ok_term = mkatom("already_loaded"); @@ -308,7 +311,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, notify_all(dh, drv->name, ERL_DE_PROC_AWAIT_UNLOAD, am_UP, am_unload_cancelled); - add_proc_loaded(dh,p); + add_proc_loaded(dh, BIF_P); erts_ddll_reference_driver(dh); monitor = 0; ok_term = mkatom("already_loaded"); @@ -325,7 +328,8 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, goto soft_error; } /* Load of granted unload... */ - add_proc_loaded_deref(dh,p); /* Dont reference, will happen after reload */ + /* Don't reference, will happen after reload */ + add_proc_loaded_deref(dh, BIF_P); ++monitor; ok_term = am_pending_driver; } else { /* ERL_DE_PERMANENT */ @@ -345,7 +349,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, goto soft_error; } else { dh->flags = flags; - add_proc_loaded(dh,p); + add_proc_loaded(dh, BIF_P); first_ddll_reference(dh); monitor = 0; ok_term = mkatom("loaded"); @@ -397,18 +401,18 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, #if DDLL_SMP erts_ddll_reference_driver(dh); unlock_drv_list(); - erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); lock_drv_list(); erts_ddll_dereference_driver(dh); #endif - p->flags |= F_USING_DDLL; + BIF_P->flags |= F_USING_DDLL; if (monitor) { - Eterm mref = add_monitor(p, dh, ERL_DE_PROC_AWAIT_LOAD); - hp = HAlloc(p,4); + Eterm mref = add_monitor(BIF_P, dh, ERL_DE_PROC_AWAIT_LOAD); + hp = HAlloc(BIF_P, 4); t = TUPLE3(hp, am_ok, ok_term, mref); } else { - hp = HAlloc(p,3); + hp = HAlloc(BIF_P, 3); t = TUPLE2(hp, am_ok, ok_term); } #if DDLL_SMP @@ -416,33 +420,33 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, #endif erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) path); erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); - ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p)); + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P)); BIF_RET(t); soft_error: #if DDLL_SMP unlock_drv_list(); - erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); #endif if (do_build_load_error) { - soft_error_term = build_load_error(p, build_this_load_error); + soft_error_term = build_load_error(BIF_P, build_this_load_error); } - hp = HAlloc(p,3); + hp = HAlloc(BIF_P, 3); t = TUPLE2(hp, am_error, soft_error_term); erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) path); erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); - ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p)); + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P)); BIF_RET(t); error: assert_drv_list_not_locked(); - ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p)); + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P)); if (path != NULL) { erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) path); } if (name != NULL) { erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); } - BIF_ERROR(p,BADARG); + BIF_ERROR(BIF_P, BADARG); } /* @@ -481,8 +485,10 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, any AWAIT_LOAD-waiters with {'DOWN', ref(), driver, name(), load_cancelled} If the driver made itself permanent, {'UP', ref(), driver, name(), permanent} */ -Eterm erl_ddll_try_unload_2(Process *p, Eterm name_term, Eterm options) +Eterm erl_ddll_try_unload_2(BIF_ALIST_2) { + Eterm name_term = BIF_ARG_1; + Eterm options = BIF_ARG_2; char *name = NULL; Eterm ok_term = NIL; Eterm soft_error_term = NIL; @@ -495,7 +501,7 @@ Eterm erl_ddll_try_unload_2(Process *p, Eterm name_term, Eterm options) Eterm l; int kill_ports = 0; - erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); for(l = options; is_list(l); l = CDR(list_val(l))) { Eterm opt = CAR(list_val(l)); @@ -548,7 +554,7 @@ Eterm erl_ddll_try_unload_2(Process *p, Eterm name_term, Eterm options) if (dh->flags & ERL_DE_FL_KILL_PORTS) { kill_ports = 1; } - if ((pe = find_proc_entry(dh, p, ERL_DE_PROC_LOADED)) == NULL) { + if ((pe = find_proc_entry(dh, BIF_P, ERL_DE_PROC_LOADED)) == NULL) { if (num_procs(dh, ERL_DE_PROC_LOADED) > 0) { soft_error_term = am_not_loaded_by_this_process; goto soft_error; @@ -624,22 +630,22 @@ done: #if DDLL_SMP erts_ddll_reference_driver(dh); unlock_drv_list(); - erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); lock_drv_list(); erts_ddll_dereference_driver(dh); #endif erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); - p->flags |= F_USING_DDLL; + BIF_P->flags |= F_USING_DDLL; if (monitor > 0) { - Eterm mref = add_monitor(p, dh, ERL_DE_PROC_AWAIT_UNLOAD); - hp = HAlloc(p,4); + Eterm mref = add_monitor(BIF_P, dh, ERL_DE_PROC_AWAIT_UNLOAD); + hp = HAlloc(BIF_P, 4); t = TUPLE3(hp, am_ok, ok_term, mref); } else { - hp = HAlloc(p,3); + hp = HAlloc(BIF_P, 3); t = TUPLE2(hp, am_ok, ok_term); } if (kill_ports > 1) { - ERTS_BIF_CHK_EXITED(p); /* May be exited by port killing */ + ERTS_BIF_CHK_EXITED(BIF_P); /* May be exited by port killing */ } #if DDLL_SMP unlock_drv_list(); @@ -651,8 +657,8 @@ soft_error: unlock_drv_list(); #endif erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); - erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); - hp = HAlloc(p,3); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + hp = HAlloc(BIF_P, 3); t = TUPLE2(hp, am_error, soft_error_term); BIF_RET(t); @@ -661,21 +667,21 @@ soft_error: if (name != NULL) { erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); } - erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); - BIF_ERROR(p,BADARG); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + BIF_ERROR(BIF_P, BADARG); } /* * A shadow of the "real" demonitor BIF */ -BIF_RETTYPE erl_ddll_demonitor_1(Process *p, Eterm ref) +BIF_RETTYPE erl_ddll_demonitor_1(BIF_ALIST_1) { - if (is_not_internal_ref(ref)) { - BIF_ERROR(p, BADARG); + if (is_not_internal_ref(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); } - if (p->flags & F_USING_DDLL) { - erts_ddll_remove_monitor(p, ref, ERTS_PROC_LOCK_MAIN); + if (BIF_P->flags & F_USING_DDLL) { + erts_ddll_remove_monitor(BIF_P, BIF_ARG_1, ERTS_PROC_LOCK_MAIN); } BIF_RET(am_true); } @@ -683,18 +689,18 @@ BIF_RETTYPE erl_ddll_demonitor_1(Process *p, Eterm ref) /* * A shadow of the "real" monitor BIF */ -BIF_RETTYPE erl_ddll_monitor_2(Process *p, Eterm dr, Eterm what) +BIF_RETTYPE erl_ddll_monitor_2(BIF_ALIST_2) { - if (dr != am_driver) { - BIF_ERROR(p,BADARG); + if (BIF_ARG_1 != am_driver) { + BIF_ERROR(BIF_P, BADARG); } - return erts_ddll_monitor_driver(p, what, ERTS_PROC_LOCK_MAIN); + return erts_ddll_monitor_driver(BIF_P, BIF_ARG_2, ERTS_PROC_LOCK_MAIN); } /* * Return list of loaded drivers {ok,[string()]} */ -Eterm erl_ddll_loaded_drivers_0(Process *p) +BIF_RETTYPE erl_ddll_loaded_drivers_0(BIF_ALIST_0) { Eterm *hp; int need = 3; @@ -706,7 +712,7 @@ Eterm erl_ddll_loaded_drivers_0(Process *p) for (drv = driver_list; drv; drv = drv->next) { need += sys_strlen(drv->name)*2+2; } - hp = HAlloc(p,need); + hp = HAlloc(BIF_P, need); for (drv = driver_list; drv; drv = drv->next) { Eterm l; l = buf_to_intlist(&hp, drv->name, sys_strlen(drv->name), NIL); @@ -726,8 +732,11 @@ Eterm erl_ddll_loaded_drivers_0(Process *p) * item is processes, driver_options, port_count, linked_in_driver, * permanent, awaiting_load, awaiting_unload */ -Eterm erl_ddll_info_2(Process *p, Eterm name_term, Eterm item) +BIF_RETTYPE erl_ddll_info_2(BIF_ALIST_2) { + Process *p = BIF_P; + Eterm name_term = BIF_ARG_1; + Eterm item = BIF_ARG_2; char *name = NULL; Eterm res = NIL; erts_driver_t *drv; @@ -850,8 +859,10 @@ Eterm erl_ddll_info_2(Process *p, Eterm name_term, Eterm item) * Backend for erl_ddll:format_error, handles all "soft" errors returned by builtins, * possibly by calling the system specific error handler */ -Eterm erl_ddll_format_error_int_1(Process *p, Eterm code_term) +BIF_RETTYPE erl_ddll_format_error_int_1(BIF_ALIST_1) { + Process *p = BIF_P; + Eterm code_term = BIF_ARG_1; char *errstring = NULL; int errint; int len; diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index d4d5691f62..a79feaebdb 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -124,6 +124,16 @@ static char erts_system_version[] = ("Erlang " ERLANG_OTP_RELEASE # define PERFMON_GETPCR _IOR('P', 2, unsigned long long) #endif +/* Cached, pre-built {OsType,OsFlavor} and {Major,Minor,Build} tuples */ +static Eterm os_type_tuple; +static Eterm os_version_tuple; + +static BIF_RETTYPE port_info(Process* p, Eterm portid, Eterm item); + +static Eterm +current_function(Process* p, Process* rp, Eterm** hpp, int full_info); +static Eterm current_stacktrace(Process* p, Process* rp, Eterm** hpp); + static Eterm bld_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh) { @@ -559,6 +569,8 @@ static Eterm pi_args[] = { am_suspending, am_min_heap_size, am_min_bin_vheap_size, + am_current_location, + am_current_stacktrace, #ifdef HYBRID am_message_binary #endif @@ -607,8 +619,10 @@ pi_arg2ix(Eterm arg) case am_suspending: return 26; case am_min_heap_size: return 27; case am_min_bin_vheap_size: return 28; + case am_current_location: return 29; + case am_current_stacktrace: return 30; #ifdef HYBRID - case am_message_binary: return 29; + case am_message_binary: return 31; #endif default: return -1; } @@ -1011,35 +1025,15 @@ process_info_aux(Process *BIF_P, break; case am_current_function: - if (rp->current == NULL) { - rp->current = find_function_from_pc(rp->i); - } - if (rp->current == NULL) { - hp = HAlloc(BIF_P, 3); - res = am_undefined; - } else { - BeamInstr* current; - - if (rp->current[0] == am_erlang && - rp->current[1] == am_process_info && - (rp->current[2] == 1 || rp->current[2] == 2) && - (current = find_function_from_pc(rp->cp)) != NULL) { - - /* - * The current function is erlang:process_info/2, - * which is not the answer that the application want. - * We will use the function pointed into by rp->cp - * instead. - */ + res = current_function(BIF_P, rp, &hp, 0); + break; - rp->current = current; - } + case am_current_location: + res = current_function(BIF_P, rp, &hp, 1); + break; - hp = HAlloc(BIF_P, 3+4); - res = TUPLE3(hp, rp->current[0], - rp->current[1], make_small(rp->current[2])); - hp += 4; - } + case am_current_stacktrace: + res = current_stacktrace(BIF_P, rp, &hp); break; case am_initial_call: @@ -1613,6 +1607,113 @@ process_info_aux(Process *BIF_P, } #undef MI_INC +static Eterm +current_function(Process* BIF_P, Process* rp, Eterm** hpp, int full_info) +{ + Eterm* hp; + Eterm res; + FunctionInfo fi; + + if (rp->current == NULL) { + erts_lookup_function_info(&fi, rp->i, full_info); + rp->current = fi.current; + } else if (full_info) { + erts_lookup_function_info(&fi, rp->i, full_info); + if (fi.current == NULL) { + /* Use the current function without location info */ + erts_set_current_function(&fi, rp->current); + } + } + + if (BIF_P->id == rp->id) { + FunctionInfo fi2; + + /* + * The current function is erlang:process_info/{1,2}, + * which is not the answer that the application want. + * We will use the function pointed into by rp->cp + * instead if it can be looked up. + */ + erts_lookup_function_info(&fi2, rp->cp, full_info); + if (fi2.current) { + fi = fi2; + rp->current = fi2.current; + } + } + + /* + * Return the result. + */ + if (rp->current == NULL) { + hp = HAlloc(BIF_P, 3); + res = am_undefined; + } else if (full_info) { + hp = HAlloc(BIF_P, 3+fi.needed); + hp = erts_build_mfa_item(&fi, hp, am_true, &res); + } else { + hp = HAlloc(BIF_P, 3+4); + res = TUPLE3(hp, rp->current[0], + rp->current[1], make_small(rp->current[2])); + hp += 4; + } + *hpp = hp; + return res; +} + +static Eterm +current_stacktrace(Process* p, Process* rp, Eterm** hpp) +{ + Uint sz; + struct StackTrace* s; + int depth; + FunctionInfo* stk; + FunctionInfo* stkp; + Uint heap_size; + int i; + Eterm* hp = *hpp; + Eterm mfa; + Eterm res = NIL; + + depth = 8; + sz = offsetof(struct StackTrace, trace) + sizeof(BeamInstr *)*depth; + s = (struct StackTrace *) erts_alloc(ERTS_ALC_T_TMP, sz); + s->depth = 0; + if (rp->i) { + s->trace[s->depth++] = rp->i; + depth--; + } + if (depth > 0 && rp->cp != 0) { + s->trace[s->depth++] = rp->cp - 1; + depth--; + } + erts_save_stacktrace(rp, s, depth); + + depth = s->depth; + stk = stkp = (FunctionInfo *) erts_alloc(ERTS_ALC_T_TMP, + depth*sizeof(FunctionInfo)); + heap_size = 3; + for (i = 0; i < depth; i++) { + erts_lookup_function_info(stkp, s->trace[i], 1); + if (stkp->current) { + heap_size += stkp->needed + 2; + stkp++; + } + } + + hp = HAlloc(p, heap_size); + while (stkp > stk) { + stkp--; + hp = erts_build_mfa_item(stkp, hp, am_true, &mfa); + res = CONS(hp, mfa, res); + hp += 2; + } + + erts_free(ERTS_ALC_T_TMP, stk); + erts_free(ERTS_ALC_T_TMP, s); + *hpp = hp; + return res; +} + #if defined(VALGRIND) static int check_if_xml(void) { @@ -2029,7 +2130,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) BIF_RET(am_undefined); #endif } else if (BIF_ARG_1 == am_trace_control_word) { - BIF_RET(db_get_trace_control_word_0(BIF_P)); + BIF_RET(db_get_trace_control_word(BIF_P)); } else if (ERTS_IS_ATOM_STR("ets_realloc_moves", BIF_ARG_1)) { BIF_RET((erts_ets_realloc_always_moves) ? am_true : am_false); } else if (ERTS_IS_ATOM_STR("ets_always_compress", BIF_ARG_1)) { @@ -2156,16 +2257,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) return erts_instr_get_type_info(BIF_P); } else if (BIF_ARG_1 == am_os_type) { - Eterm type = am_atom_put(os_type, strlen(os_type)); - Eterm flav, tup; - char *buf = erts_alloc(ERTS_ALC_T_TMP, 1024); /* More than enough */ - - os_flavor(buf, 1024); - flav = am_atom_put(buf, strlen(buf)); - hp = HAlloc(BIF_P, 3); - tup = TUPLE2(hp, type, flav); - erts_free(ERTS_ALC_T_TMP, (void *) buf); - BIF_RET(tup); + BIF_RET(os_type_tuple); } else if (BIF_ARG_1 == am_allocator) { BIF_RET(erts_allocator_options((void *) BIF_P)); @@ -2191,16 +2283,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) BIF_RET(am_false); } else if (BIF_ARG_1 == am_os_version) { - int major, minor, build; - Eterm tup; - - os_version(&major, &minor, &build); - hp = HAlloc(BIF_P, 4); - tup = TUPLE3(hp, - make_small(major), - make_small(minor), - make_small(build)); - BIF_RET(tup); + BIF_RET(os_version_tuple); } else if (BIF_ARG_1 == am_version) { int n = strlen(ERLANG_VERSION); @@ -2648,9 +2731,11 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) BIF_ERROR(BIF_P, BADARG); } -Eterm -port_info_1(Process* p, Eterm pid) +BIF_RETTYPE +port_info_1(BIF_ALIST_1) { + Process* p = BIF_P; + Eterm pid = BIF_ARG_1; static Eterm keys[] = { am_name, am_links, @@ -2673,7 +2758,7 @@ port_info_1(Process* p, Eterm pid) for (i = 0; i < ASIZE(keys); i++) { Eterm item; - item = port_info_2(p, pid, keys[i]); + item = port_info(p, pid, keys[i]); if (is_non_value(item)) { return THE_NON_VALUE; } @@ -2682,7 +2767,7 @@ port_info_1(Process* p, Eterm pid) } items[i] = item; } - reg_name = port_info_2(p, pid, am_registered_name); + reg_name = port_info(p, pid, am_registered_name); /* * Build the resulting list. @@ -2718,24 +2803,27 @@ port_info_1(Process* p, Eterm pid) BIF_RETTYPE port_info_2(BIF_ALIST_2) { + return port_info(BIF_P, BIF_ARG_1, BIF_ARG_2); +} + +static BIF_RETTYPE port_info(Process* p, Eterm portid, Eterm item) +{ BIF_RETTYPE ret; - Eterm portid = BIF_ARG_1; Port *prt; - Eterm item = BIF_ARG_2; Eterm res; Eterm* hp; int count; if (is_internal_port(portid)) - prt = erts_id2port(portid, BIF_P, ERTS_PROC_LOCK_MAIN); + prt = erts_id2port(portid, p, ERTS_PROC_LOCK_MAIN); else if (is_atom(portid)) - erts_whereis_name(BIF_P, ERTS_PROC_LOCK_MAIN, + erts_whereis_name(p, ERTS_PROC_LOCK_MAIN, portid, NULL, 0, 0, &prt); else if (is_external_port(portid) && external_port_dist_entry(portid) == erts_this_dist_entry) BIF_RET(am_undefined); else { - BIF_ERROR(BIF_P, BADARG); + BIF_ERROR(p, BADARG); } if (!prt) { @@ -2743,7 +2831,7 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2) } if (item == am_id) { - hp = HAlloc(BIF_P, 3); + hp = HAlloc(p, 3); res = make_small(internal_port_number(portid)); } else if (item == am_links) { @@ -2755,10 +2843,10 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2) erts_doforall_links(prt->nlinks, &collect_one_link, &mic); - hp = HAlloc(BIF_P, 3 + mic.sz); + hp = HAlloc(p, 3 + mic.sz); res = NIL; for (i = 0; i < mic.mi_i; i++) { - item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity); + item = STORE_NC(&hp, &MSO(p), mic.mi[i].entity); res = CONS(hp, item, res); hp += 2; } @@ -2774,11 +2862,11 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2) erts_doforall_monitors(prt->monitors, &collect_one_origin_monitor, &mic); - hp = HAlloc(BIF_P, 3 + mic.sz); + hp = HAlloc(p, 3 + mic.sz); res = NIL; for (i = 0; i < mic.mi_i; i++) { Eterm t; - item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity); + item = STORE_NC(&hp, &MSO(p), mic.mi[i].entity); t = TUPLE2(hp, am_process, item); hp += 3; res = CONS(hp, t, res); @@ -2790,25 +2878,25 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2) else if (item == am_name) { count = sys_strlen(prt->name); - hp = HAlloc(BIF_P, 3 + 2*count); + hp = HAlloc(p, 3 + 2*count); res = buf_to_intlist(&hp, prt->name, count, NIL); } else if (item == am_connected) { - hp = HAlloc(BIF_P, 3); + hp = HAlloc(p, 3); res = prt->connected; /* internal pid */ } else if (item == am_input) { Uint hsz = 3; Uint n = prt->bytes_in; (void) erts_bld_uint(NULL, &hsz, n); - hp = HAlloc(BIF_P, hsz); + hp = HAlloc(p, hsz); res = erts_bld_uint(&hp, NULL, n); } else if (item == am_output) { Uint hsz = 3; Uint n = prt->bytes_out; (void) erts_bld_uint(NULL, &hsz, n); - hp = HAlloc(BIF_P, hsz); + hp = HAlloc(p, hsz); res = erts_bld_uint(&hp, NULL, n); } else if (item == am_registered_name) { @@ -2818,7 +2906,7 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2) ERTS_BIF_PREP_RET(ret, NIL); goto done; } else { - hp = HAlloc(BIF_P, 3); + hp = HAlloc(p, 3); res = reg->name; } } @@ -2830,7 +2918,7 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2) Uint size = 0; ErlHeapFragment* bp; - hp = HAlloc(BIF_P, 3); + hp = HAlloc(p, 3); erts_doforall_links(prt->nlinks, &one_link_size, &size); @@ -2847,18 +2935,18 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2) hard to retrieve... */ (void) erts_bld_uint(NULL, &hsz, size); - hp = HAlloc(BIF_P, hsz); + hp = HAlloc(p, hsz); res = erts_bld_uint(&hp, NULL, size); } else if (item == am_queue_size) { Uint ioq_size = erts_port_ioq_size(prt); Uint hsz = 3; (void) erts_bld_uint(NULL, &hsz, ioq_size); - hp = HAlloc(BIF_P, hsz); + hp = HAlloc(p, hsz); res = erts_bld_uint(&hp, NULL, ioq_size); } else if (ERTS_IS_ATOM_STR("locking", item)) { - hp = HAlloc(BIF_P, 3); + hp = HAlloc(p, 3); #ifndef ERTS_SMP res = am_false; #else @@ -2877,7 +2965,7 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2) #endif } else { - ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + ERTS_BIF_PREP_ERROR(ret, p, BADARG); goto done; } @@ -2891,9 +2979,12 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2) } -Eterm -fun_info_2(Process* p, Eterm fun, Eterm what) +BIF_RETTYPE +fun_info_2(BIF_ALIST_2) { + Process* p = BIF_P; + Eterm fun = BIF_ARG_1; + Eterm what = BIF_ARG_2; Eterm* hp; Eterm val; @@ -4043,6 +4134,27 @@ BIF_RETTYPE erts_debug_lock_counters_1(BIF_ALIST_1) BIF_ERROR(BIF_P, BADARG); } +static void os_info_init(void) +{ + Eterm type = am_atom_put(os_type, strlen(os_type)); + Eterm flav; + int major, minor, build; + char* buf = erts_alloc(ERTS_ALC_T_TMP, 1024); /* More than enough */ + Eterm* hp; + + os_flavor(buf, 1024); + flav = am_atom_put(buf, strlen(buf)); + erts_free(ERTS_ALC_T_TMP, (void *) buf); + hp = erts_alloc(ERTS_ALC_T_LL_TEMP_TERM, (3+4)*sizeof(Eterm)); + os_type_tuple = TUPLE2(hp, type, flav); + hp += 3; + os_version(&major, &minor, &build); + os_version_tuple = TUPLE3(hp, + make_small(major), + make_small(minor), + make_small(build)); +} + void erts_bif_info_init(void) { @@ -4052,4 +4164,5 @@ erts_bif_info_init(void) alloc_info_trap = erts_export_put(am_erlang, am_alloc_info, 1); alloc_sizes_trap = erts_export_put(am_erlang, am_alloc_sizes, 1); process_info_init(); + os_info_init(); } diff --git a/erts/emulator/beam/erl_bif_lists.c b/erts/emulator/beam/erl_bif_lists.c index 47c48e74d6..1805366cfe 100644 --- a/erts/emulator/beam/erl_bif_lists.c +++ b/erts/emulator/beam/erl_bif_lists.c @@ -34,27 +34,7 @@ static Eterm keyfind(int Bif, Process* p, Eterm Key, Eterm Pos, Eterm List); -/* - * erlang:'++'/2 - */ - -Eterm -ebif_plusplus_2(Process* p, Eterm A, Eterm B) -{ - return append_2(p, A, B); -} - -/* - * erlang:'--'/2 - */ - -Eterm -ebif_minusminus_2(Process* p, Eterm A, Eterm B) -{ - return subtract_2(p, A, B); -} - -BIF_RETTYPE append_2(BIF_ALIST_2) +static BIF_RETTYPE append(Process* p, Eterm A, Eterm B) { Eterm list; Eterm copy; @@ -63,18 +43,18 @@ BIF_RETTYPE append_2(BIF_ALIST_2) Eterm* hp; int i; - if ((i = list_length(BIF_ARG_1)) < 0) { - BIF_ERROR(BIF_P, BADARG); + if ((i = list_length(A)) < 0) { + BIF_ERROR(p, BADARG); } if (i == 0) { - BIF_RET(BIF_ARG_2); - } else if (is_nil(BIF_ARG_2)) { - BIF_RET(BIF_ARG_1); + BIF_RET(B); + } else if (is_nil(B)) { + BIF_RET(A); } need = 2*i; - hp = HAlloc(BIF_P, need); - list = BIF_ARG_1; + hp = HAlloc(p, need); + list = A; copy = last = CONS(hp, CAR(list_val(list)), make_list(hp+2)); list = CDR(list_val(list)); hp += 2; @@ -85,12 +65,31 @@ BIF_RETTYPE append_2(BIF_ALIST_2) list = CDR(listp); hp += 2; } - CDR(list_val(last)) = BIF_ARG_2; + CDR(list_val(last)) = B; BIF_RET(copy); } +/* + * erlang:'++'/2 + */ + +Eterm +ebif_plusplus_2(BIF_ALIST_2) +{ + return append(BIF_P, BIF_ARG_1, BIF_ARG_2); +} + +BIF_RETTYPE append_2(BIF_ALIST_2) +{ + return append(BIF_P, BIF_ARG_1, BIF_ARG_2); +} + +/* + * erlang:'--'/2 + */ + #define SMALL_VEC_SIZE 10 -BIF_RETTYPE subtract_2(BIF_ALIST_2) +static Eterm subtract(Process* p, Eterm A, Eterm B) { Eterm list; Eterm* hp; @@ -103,17 +102,17 @@ BIF_RETTYPE subtract_2(BIF_ALIST_2) int n; int m; - if ((n = list_length(BIF_ARG_1)) < 0) { - BIF_ERROR(BIF_P, BADARG); + if ((n = list_length(A)) < 0) { + BIF_ERROR(p, BADARG); } - if ((m = list_length(BIF_ARG_2)) < 0) { - BIF_ERROR(BIF_P, BADARG); + if ((m = list_length(B)) < 0) { + BIF_ERROR(p, BADARG); } if (n == 0) BIF_RET(NIL); if (m == 0) - BIF_RET(BIF_ARG_1); + BIF_RET(A); /* allocate element vector */ if (n <= SMALL_VEC_SIZE) @@ -123,7 +122,7 @@ BIF_RETTYPE subtract_2(BIF_ALIST_2) /* PUT ALL ELEMENTS IN VP */ vp = vec_p; - list = BIF_ARG_1; + list = A; i = n; while(i--) { Eterm* listp = list_val(list); @@ -132,7 +131,7 @@ BIF_RETTYPE subtract_2(BIF_ALIST_2) } /* UNMARK ALL DELETED CELLS */ - list = BIF_ARG_2; + list = B; m = 0; /* number of deleted elements */ while(is_list(list)) { Eterm* listp = list_val(list); @@ -153,11 +152,11 @@ BIF_RETTYPE subtract_2(BIF_ALIST_2) if (m == n) /* All deleted ? */ res = NIL; else if (m == 0) /* None deleted ? */ - res = BIF_ARG_1; + res = A; else { /* REBUILD LIST */ res = NIL; need = 2*(n - m); - hp = HAlloc(BIF_P, need); + hp = HAlloc(p, need); vp = vec_p + n - 1; while(vp >= vec_p) { if (is_value(*vp)) { @@ -172,6 +171,16 @@ BIF_RETTYPE subtract_2(BIF_ALIST_2) BIF_RET(res); } +BIF_RETTYPE ebif_minusminus_2(BIF_ALIST_2) +{ + return subtract(BIF_P, BIF_ARG_1, BIF_ARG_2); +} + +BIF_RETTYPE subtract_2(BIF_ALIST_2) +{ + return subtract(BIF_P, BIF_ARG_1, BIF_ARG_2); +} + BIF_RETTYPE lists_member_2(BIF_ALIST_2) { Eterm term; @@ -278,11 +287,12 @@ BIF_RETTYPE lists_reverse_2(BIF_ALIST_2) } BIF_RETTYPE -lists_keymember_3(Process* p, Eterm Key, Eterm Pos, Eterm List) +lists_keymember_3(BIF_ALIST_3) { Eterm res; - res = keyfind(BIF_lists_keymember_3, p, Key, Pos, List); + res = keyfind(BIF_lists_keymember_3, BIF_P, + BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); if (is_value(res) && is_tuple(res)) { return am_true; } else { @@ -291,23 +301,25 @@ lists_keymember_3(Process* p, Eterm Key, Eterm Pos, Eterm List) } BIF_RETTYPE -lists_keysearch_3(Process* p, Eterm Key, Eterm Pos, Eterm List) +lists_keysearch_3(BIF_ALIST_3) { Eterm res; - res = keyfind(BIF_lists_keysearch_3, p, Key, Pos, List); + res = keyfind(BIF_lists_keysearch_3, BIF_P, + BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); if (is_non_value(res) || is_not_tuple(res)) { return res; } else { /* Tuple */ - Eterm* hp = HAlloc(p, 3); + Eterm* hp = HAlloc(BIF_P, 3); return TUPLE2(hp, am_value, res); } } BIF_RETTYPE -lists_keyfind_3(Process* p, Eterm Key, Eterm Pos, Eterm List) +lists_keyfind_3(BIF_ALIST_3) { - return keyfind(BIF_lists_keyfind_3, p, Key, Pos, List); + return keyfind(BIF_lists_keyfind_3, BIF_P, + BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); } static Eterm diff --git a/erts/emulator/beam/erl_bif_op.c b/erts/emulator/beam/erl_bif_op.c index deda7adc1f..13f8b1f63c 100644 --- a/erts/emulator/beam/erl_bif_op.c +++ b/erts/emulator/beam/erl_bif_op.c @@ -225,18 +225,23 @@ BIF_RETTYPE is_function_1(BIF_ALIST_1) BIF_RETTYPE is_function_2(BIF_ALIST_2) { + BIF_RET(erl_is_function(BIF_P, BIF_ARG_1, BIF_ARG_2)); +} + +Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2) +{ Sint arity; /* * Verify argument 2 (arity); arity must be >= 0. */ - if (is_small(BIF_ARG_2)) { - arity = signed_val(BIF_ARG_2); + if (is_small(arg2)) { + arity = signed_val(arg2); if (arity < 0) { error: - BIF_ERROR(BIF_P, BADARG); + BIF_ERROR(p, BADARG); } - } else if (is_big(BIF_ARG_2) && !bignum_header_is_neg(*big_val(BIF_ARG_2))) { + } else if (is_big(arg2) && !bignum_header_is_neg(*big_val(arg2))) { /* A positive bignum is OK, but can't possibly match. */ arity = -1; } else { @@ -244,20 +249,20 @@ BIF_RETTYPE is_function_2(BIF_ALIST_2) goto error; } - if (is_fun(BIF_ARG_1)) { - ErlFunThing* funp = (ErlFunThing *) fun_val(BIF_ARG_1); + if (is_fun(arg1)) { + ErlFunThing* funp = (ErlFunThing *) fun_val(arg1); if (funp->arity == (Uint) arity) { BIF_RET(am_true); } - } else if (is_export(BIF_ARG_1)) { - Export* exp = (Export *) EXPAND_POINTER((export_val(BIF_ARG_1))[1]); + } else if (is_export(arg1)) { + Export* exp = (Export *) EXPAND_POINTER((export_val(arg1))[1]); if (exp->code[2] == (Uint) arity) { BIF_RET(am_true); } - } else if (is_tuple(BIF_ARG_1)) { - Eterm* tp = tuple_val(BIF_ARG_1); + } else if (is_tuple(arg1)) { + Eterm* tp = tuple_val(arg1); if (tp[0] == make_arityval(2) && is_atom(tp[1]) && is_atom(tp[2])) { BIF_RET(am_true); } diff --git a/erts/emulator/beam/erl_bif_os.c b/erts/emulator/beam/erl_bif_os.c index 954b1f9729..58d48199fa 100644 --- a/erts/emulator/beam/erl_bif_os.c +++ b/erts/emulator/beam/erl_bif_os.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * Copyright Ericsson AB 1999-2010. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -53,20 +53,18 @@ BIF_RETTYPE os_timestamp_0(BIF_ALIST_0) } -Eterm -os_getpid_0(Process* p) +BIF_RETTYPE os_getpid_0(BIF_ALIST_0) { char pid_string[21]; /* enough for a 64 bit number */ int n; Eterm* hp; sys_get_pid(pid_string); /* In sys.c */ n = sys_strlen(pid_string); - hp = HAlloc(p, n*2); + hp = HAlloc(BIF_P, n*2); BIF_RET(buf_to_intlist(&hp, pid_string, n, NIL)); } -Eterm -os_getenv_0(Process* p) +BIF_RETTYPE os_getenv_0(BIF_ALIST_0) { GETENV_STATE state; char *cp; @@ -80,7 +78,7 @@ os_getenv_0(Process* p) ret = NIL; while ((cp = getenv_string(&state)) != NULL) { len = strlen(cp); - hp = HAlloc(p, len*2+2); + hp = HAlloc(BIF_P, len*2+2); str = buf_to_intlist(&hp, cp, len, NIL); ret = CONS(hp, str, ret); } @@ -90,9 +88,11 @@ os_getenv_0(Process* p) return ret; } -Eterm -os_getenv_1(Process* p, Eterm key) + +BIF_RETTYPE os_getenv_1(BIF_ALIST_1) { + Process* p = BIF_P; + Eterm key = BIF_ARG_1; Eterm str; int len, res; char *key_str, *val; @@ -145,9 +145,11 @@ os_getenv_1(Process* p, Eterm key) BIF_RET(str); } -Eterm -os_putenv_2(Process* p, Eterm key, Eterm value) +BIF_RETTYPE os_putenv_2(BIF_ALIST_2) { + Process* p = BIF_P; + Eterm key = BIF_ARG_1; + Eterm value = BIF_ARG_2; char def_buf[1024]; char *buf = NULL; int sep_ix, i, key_len, value_len, tot_len; diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c index 3fd35dd963..b21cda6347 100644 --- a/erts/emulator/beam/erl_bif_port.c +++ b/erts/emulator/beam/erl_bif_port.c @@ -48,6 +48,9 @@ static void free_args(char **); char *erts_default_arg0 = "default"; +static BIF_RETTYPE +port_call(Process* p, Eterm arg1, Eterm arg2, Eterm arg3); + BIF_RETTYPE open_port_2(BIF_ALIST_2) { int port_num; @@ -117,11 +120,9 @@ id_or_name2port(Process *c_p, Eterm id) #define ERTS_PORT_COMMAND_FLAG_FORCE (((Uint32) 1) << 0) #define ERTS_PORT_COMMAND_FLAG_NOSUSPEND (((Uint32) 1) << 1) -static BIF_RETTYPE do_port_command(Process *BIF_P, - Eterm BIF_ARG_1, - Eterm BIF_ARG_2, - Eterm BIF_ARG_3, - Uint32 flags) +static BIF_RETTYPE +do_port_command(Process *BIF_P, Eterm arg1, Eterm arg2, Eterm arg3, + Uint32 flags) { BIF_RETTYPE res; Port *p; @@ -135,7 +136,7 @@ static BIF_RETTYPE do_port_command(Process *BIF_P, profile_runnable_proc(BIF_P, am_inactive); } - p = id_or_name2port(BIF_P, BIF_ARG_1); + p = id_or_name2port(BIF_P, arg1); if (!p) { if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) { trace_virtual_sched(BIF_P, am_in); @@ -172,13 +173,13 @@ static BIF_RETTYPE do_port_command(Process *BIF_P, monitor_generic(BIF_P, am_busy_port, p->id); } ERTS_BIF_PREP_YIELD3(res, bif_export[BIF_port_command_3], BIF_P, - BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + arg1, arg2, arg3); } } else { int wres; erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); ERTS_SMP_CHK_NO_PROC_LOCKS; - wres = erts_write_to_port(BIF_P->id, p, BIF_ARG_2); + wres = erts_write_to_port(BIF_P->id, p, arg2); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); if (wres != 0) { ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG); @@ -237,11 +238,17 @@ BIF_RETTYPE port_command_3(BIF_ALIST_3) BIF_RETTYPE port_call_2(BIF_ALIST_2) { - return port_call_3(BIF_P,BIF_ARG_1,make_small(0),BIF_ARG_2); + return port_call(BIF_P,BIF_ARG_1, make_small(0), BIF_ARG_2); } BIF_RETTYPE port_call_3(BIF_ALIST_3) { + return port_call(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); +} + +static BIF_RETTYPE +port_call(Process* c_p, Eterm arg1, Eterm arg2, Eterm arg3) +{ Uint op; Port *p; Uint size; @@ -266,15 +273,15 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3) /* trace of port scheduling with virtual process descheduling * lock wait */ - if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) { - trace_virtual_sched(BIF_P, am_out); + if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(c_p, am_out); } if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { - profile_runnable_proc(BIF_P, am_inactive); + profile_runnable_proc(c_p, am_inactive); } - p = id_or_name2port(BIF_P, BIF_ARG_1); + p = id_or_name2port(c_p, arg1); if (!p) { error: if (port_resp != port_result && @@ -286,22 +293,22 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3) /* Need to virtual schedule in the process if there * was an error. */ - if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) { - trace_virtual_sched(BIF_P, am_in); + if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(c_p, am_in); } if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { - profile_runnable_proc(BIF_P, am_active); + profile_runnable_proc(c_p, am_active); } if (p) erts_port_release(p); #ifdef ERTS_SMP - ERTS_SMP_BIF_CHK_PENDING_EXIT(BIF_P, ERTS_PROC_LOCK_MAIN); + ERTS_SMP_BIF_CHK_PENDING_EXIT(c_p, ERTS_PROC_LOCK_MAIN); #else - ERTS_BIF_CHK_EXITED(BIF_P); + ERTS_BIF_CHK_EXITED(c_p); #endif - BIF_ERROR(BIF_P, BADARG); + BIF_ERROR(c_p, BADARG); } if ((drv = p->drv_ptr) == NULL) { @@ -310,10 +317,10 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3) if (drv->call == NULL) { goto error; } - if (!term_to_Uint(BIF_ARG_2, &op)) { + if (!term_to_Uint(arg2, &op)) { goto error; } - p->caller = BIF_P->id; + p->caller = c_p->id; /* Lock taken, virtual schedule of port */ if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) { @@ -323,19 +330,19 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3) if (erts_system_profile_flags.runnable_ports && !erts_port_is_scheduled(p)) { profile_runnable_port(p, am_active); } - size = erts_encode_ext_size(BIF_ARG_3); + size = erts_encode_ext_size(arg3); if (size > sizeof(port_input)) bytes = erts_alloc(ERTS_ALC_T_PORT_CALL_BUF, size); endp = bytes; - erts_encode_ext(BIF_ARG_3, &endp); + erts_encode_ext(arg3, &endp); real_size = endp - bytes; if (real_size > size) { erl_exit(1, "%s, line %d: buffer overflow: %d word(s)\n", __FILE__, __LINE__, endp - (bytes + size)); } - erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); prc = (char *) port_resp; fpe_was_unmasked = erts_block_fpe(); ret = drv->call((ErlDrvData)p->drv_data, @@ -356,7 +363,7 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3) port_resp = (byte *) prc; p->caller = NIL; - erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); #ifdef HARDDEBUG { int z; @@ -382,14 +389,14 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3) if (result_size < 0) { goto error; } - hp = HAlloc(BIF_P, result_size); + hp = HAlloc(c_p, result_size); hp_end = hp + result_size; endp = port_resp; - res = erts_decode_ext(&hp, &MSO(BIF_P), &endp); + res = erts_decode_ext(&hp, &MSO(c_p), &endp); if (res == THE_NON_VALUE) { goto error; } - HRelease(BIF_P, hp_end, hp); + HRelease(c_p, hp_end, hp); if (port_resp != port_result && !(ret_flags & DRIVER_CALL_KEEP_BUFFER)) { driver_free(port_resp); } @@ -398,16 +405,16 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3) if (p) erts_port_release(p); #ifdef ERTS_SMP - ERTS_SMP_BIF_CHK_PENDING_EXIT(BIF_P, ERTS_PROC_LOCK_MAIN); + ERTS_SMP_BIF_CHK_PENDING_EXIT(c_p, ERTS_PROC_LOCK_MAIN); #else - ERTS_BIF_CHK_EXITED(BIF_P); + ERTS_BIF_CHK_EXITED(c_p); #endif - if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) { - trace_virtual_sched(BIF_P, am_in); + if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(c_p, am_in); } if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { - profile_runnable_proc(BIF_P, am_active); + profile_runnable_proc(c_p, am_active); } return res; diff --git a/erts/emulator/beam/erl_bif_re.c b/erts/emulator/beam/erl_bif_re.c index 26891c4348..6b843d2e08 100644 --- a/erts/emulator/beam/erl_bif_re.c +++ b/erts/emulator/beam/erl_bif_re.c @@ -45,6 +45,7 @@ static Export *urun_trap_exportp = NULL; static Export *ucompile_trap_exportp = NULL; static BIF_RETTYPE re_exec_trap(BIF_ALIST_3); +static BIF_RETTYPE re_run(Process *p, Eterm arg1, Eterm arg2, Eterm arg3); static void *erts_erts_pcre_malloc(size_t size) { return erts_alloc(ERTS_ALC_T_RE_HEAP,size); @@ -414,8 +415,8 @@ build_compile_result(Process *p, Eterm error_tag, pcre *result, int errcode, con * Compile BIFs */ -BIF_RETTYPE -re_compile_2(BIF_ALIST_2) +static BIF_RETTYPE +re_compile(Process* p, Eterm arg1, Eterm arg2) { Uint slen; char *expr; @@ -429,43 +430,49 @@ re_compile_2(BIF_ALIST_2) int unicode = 0; - if (parse_options(BIF_ARG_2,&options,NULL,&pflags,NULL,NULL) + if (parse_options(arg2,&options,NULL,&pflags,NULL,NULL) < 0) { - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } if (pflags & PARSE_FLAG_UNIQUE_EXEC_OPT) { - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } unicode = (pflags & PARSE_FLAG_UNICODE) ? 1 : 0; - if (pflags & PARSE_FLAG_UNICODE && !is_binary(BIF_ARG_1)) { - BIF_TRAP2(ucompile_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2); + if (pflags & PARSE_FLAG_UNICODE && !is_binary(arg1)) { + BIF_TRAP2(ucompile_trap_exportp, p, arg1, arg2); } - if (erts_iolist_size(BIF_ARG_1, &slen)) { - BIF_ERROR(BIF_P,BADARG); + if (erts_iolist_size(arg1, &slen)) { + BIF_ERROR(p,BADARG); } expr = erts_alloc(ERTS_ALC_T_RE_TMP_BUF, slen + 1); - if (io_list_to_buf(BIF_ARG_1, expr, slen) != 0) { + if (io_list_to_buf(arg1, expr, slen) != 0) { erts_free(ERTS_ALC_T_RE_TMP_BUF, expr); - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } expr[slen]='\0'; result = erts_pcre_compile2(expr, options, &errcode, &errstr, &errofset, default_table); - ret = build_compile_result(BIF_P, am_error, result, errcode, + ret = build_compile_result(p, am_error, result, errcode, errstr, errofset, unicode, 1); erts_free(ERTS_ALC_T_RE_TMP_BUF, expr); BIF_RET(ret); } BIF_RETTYPE +re_compile_2(BIF_ALIST_2) +{ + return re_compile(BIF_P, BIF_ARG_1, BIF_ARG_2); +} + +BIF_RETTYPE re_compile_1(BIF_ALIST_1) { - return re_compile_2(BIF_P,BIF_ARG_1,NIL); + return re_compile(BIF_P, BIF_ARG_1, NIL); } /* @@ -845,8 +852,8 @@ build_capture(Eterm capture_spec[CAPSPEC_SIZE], const pcre *code) /* * The actual re:run/2,3 BIFs */ -BIF_RETTYPE -re_run_3(BIF_ALIST_3) +static BIF_RETTYPE +re_run(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) { const pcre *code_tmp; RestartContext restart; @@ -865,15 +872,15 @@ re_run_3(BIF_ALIST_3) Eterm capture[CAPSPEC_SIZE]; int is_list_cap; - if (parse_options(BIF_ARG_3,&comp_options,&options,&pflags,&startoffset,capture) + if (parse_options(arg3,&comp_options,&options,&pflags,&startoffset,capture) < 0) { - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } is_list_cap = ((pflags & PARSE_FLAG_CAPTURE_OPT) && (capture[CAPSPEC_TYPE] == am_list)); - if (is_not_tuple(BIF_ARG_2) || (arityval(*tuple_val(BIF_ARG_2)) != 4)) { - if (is_binary(BIF_ARG_2) || is_list(BIF_ARG_2) || is_nil(BIF_ARG_2)) { + if (is_not_tuple(arg2) || (arityval(*tuple_val(arg2)) != 4)) { + if (is_binary(arg2) || is_list(arg2) || is_nil(arg2)) { /* Compile from textual RE */ Uint slen; char *expr; @@ -884,19 +891,19 @@ re_run_3(BIF_ALIST_3) int capture_count; if (pflags & PARSE_FLAG_UNICODE && - (!is_binary(BIF_ARG_2) || !is_binary(BIF_ARG_1) || + (!is_binary(arg2) || !is_binary(arg1) || (is_list_cap && !(pflags & PARSE_FLAG_GLOBAL)))) { - BIF_TRAP3(urun_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + BIF_TRAP3(urun_trap_exportp, p, arg1, arg2, arg3); } - if (erts_iolist_size(BIF_ARG_2, &slen)) { - BIF_ERROR(BIF_P,BADARG); + if (erts_iolist_size(arg2, &slen)) { + BIF_ERROR(p,BADARG); } expr = erts_alloc(ERTS_ALC_T_RE_TMP_BUF, slen + 1); - if (io_list_to_buf(BIF_ARG_2, expr, slen) != 0) { + if (io_list_to_buf(arg2, expr, slen) != 0) { erts_free(ERTS_ALC_T_RE_TMP_BUF, expr); - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } expr[slen]='\0'; result = erts_pcre_compile2(expr, comp_options, &errcode, @@ -905,11 +912,11 @@ re_run_3(BIF_ALIST_3) erts_free(ERTS_ALC_T_RE_TMP_BUF, expr); /* Compilation error gives badarg except in the compile function */ - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } if (pflags & PARSE_FLAG_GLOBAL) { Eterm precompiled = - build_compile_result(BIF_P, am_error, + build_compile_result(p, am_error, result, errcode, errstr, errofset, (pflags & @@ -917,13 +924,13 @@ re_run_3(BIF_ALIST_3) 0); Eterm *hp,r; erts_free(ERTS_ALC_T_RE_TMP_BUF, expr); - hp = HAlloc(BIF_P,4); - /* BIF_ARG_2 is in the tuple just to make exceptions right */ - r = TUPLE3(hp,BIF_ARG_3, + hp = HAlloc(p,4); + /* arg2 is in the tuple just to make exceptions right */ + r = TUPLE3(hp,arg3, ((pflags & PARSE_FLAG_UNIQUE_COMPILE_OPT) ? am_true : - am_false), BIF_ARG_2); - BIF_TRAP3(grun_trap_exportp, BIF_P, BIF_ARG_1, precompiled, r); + am_false), arg2); + BIF_TRAP3(grun_trap_exportp, p, arg1, precompiled, r); } erts_pcre_fullinfo(result, NULL, PCRE_INFO_SIZE, &code_size); @@ -935,31 +942,31 @@ re_run_3(BIF_ALIST_3) erts_free(ERTS_ALC_T_RE_TMP_BUF, expr); /*unicode = (pflags & PARSE_FLAG_UNICODE) ? 1 : 0;*/ } else { - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } } else { if (pflags & PARSE_FLAG_UNIQUE_COMPILE_OPT) { - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } - tp = tuple_val(BIF_ARG_2); + tp = tuple_val(arg2); if (tp[1] != am_re_pattern || is_not_small(tp[2]) || is_not_small(tp[3]) || is_not_binary(tp[4])) { - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } if (unsigned_val(tp[3]) && - (!is_binary(BIF_ARG_1) || + (!is_binary(arg1) || (is_list_cap && !(pflags & PARSE_FLAG_GLOBAL)))) { /* unicode */ - BIF_TRAP3(urun_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2, - BIF_ARG_3); + BIF_TRAP3(urun_trap_exportp, p, arg1, arg2, + arg3); } if (pflags & PARSE_FLAG_GLOBAL) { Eterm *hp,r; - hp = HAlloc(BIF_P,3); - r = TUPLE2(hp,BIF_ARG_3,am_false); - BIF_TRAP3(grun_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2, + hp = HAlloc(p,3); + r = TUPLE2(hp,arg3,am_false); + BIF_TRAP3(grun_trap_exportp, p, arg1, arg2, r); } @@ -968,7 +975,7 @@ re_run_3(BIF_ALIST_3) if ((code_tmp = (const pcre *) erts_get_aligned_binary_bytes(tp[4], &temp_alloc)) == NULL) { erts_free_aligned_binary_bytes(temp_alloc); - BIF_ERROR(BIF_P, BADARG); + BIF_ERROR(p, BADARG); } restart.code = erts_alloc(ERTS_ALC_T_RE_SUBJECT, code_size); memcpy(restart.code, code_tmp, code_size); @@ -980,7 +987,7 @@ re_run_3(BIF_ALIST_3) restart.ovector = erts_alloc(ERTS_ALC_T_RE_SUBJECT, ovsize * sizeof(int)); restart.extra.flags = PCRE_EXTRA_TABLES | PCRE_EXTRA_LOOP_LIMIT; restart.extra.tables = default_table; - restart.extra.loop_limit = ERTS_BIF_REDS_LEFT(BIF_P) * LOOP_FACTOR; + restart.extra.loop_limit = ERTS_BIF_REDS_LEFT(p) * LOOP_FACTOR; loop_limit_tmp = max_loop_limit; /* To lesser probability of race in debug situation (erts_debug) */ if (restart.extra.loop_limit > loop_limit_tmp) { @@ -996,7 +1003,7 @@ re_run_3(BIF_ALIST_3) if ((restart.ret_info = build_capture(capture,restart.code)) == NULL) { erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ovector); erts_free(ERTS_ALC_T_RE_SUBJECT, restart.code); - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } } @@ -1004,7 +1011,7 @@ re_run_3(BIF_ALIST_3) copying, also binary returns can be sub binaries in that case */ restart.flags = 0; - if (is_binary(BIF_ARG_1)) { + if (is_binary(arg1)) { Eterm real_bin; Uint offset; Eterm* bptr; @@ -1012,9 +1019,9 @@ re_run_3(BIF_ALIST_3) int bitsize; ProcBin* pb; - ERTS_GET_REAL_BIN(BIF_ARG_1, real_bin, offset, bitoffs, bitsize); + ERTS_GET_REAL_BIN(arg1, real_bin, offset, bitoffs, bitsize); - slength = binary_size(BIF_ARG_1); + slength = binary_size(arg1); bptr = binary_val(real_bin); if (bitsize != 0 || bitoffs != 0 || (*bptr != HEADER_PROC_BIN)) { goto handle_iolist; @@ -1027,24 +1034,24 @@ re_run_3(BIF_ALIST_3) restart.flags |= RESTART_FLAG_SUBJECT_IN_BINARY; } else { handle_iolist: - if (erts_iolist_size(BIF_ARG_1, &slength)) { + if (erts_iolist_size(arg1, &slength)) { erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ovector); erts_free(ERTS_ALC_T_RE_SUBJECT, restart.code); if (restart.ret_info != NULL) { erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ret_info); } - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } restart.subject = erts_alloc(ERTS_ALC_T_RE_SUBJECT, slength); - if (io_list_to_buf(BIF_ARG_1, restart.subject, slength) != 0) { + if (io_list_to_buf(arg1, restart.subject, slength) != 0) { erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ovector); erts_free(ERTS_ALC_T_RE_SUBJECT, restart.code); erts_free(ERTS_ALC_T_RE_SUBJECT, restart.subject); if (restart.ret_info != NULL) { erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ret_info); } - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } } @@ -1056,7 +1063,7 @@ handle_iolist: rc = erts_pcre_exec(restart.code, &(restart.extra), restart.subject, slength, startoffset, options, restart.ovector, ovsize); ASSERT(loop_count != 0xFFFFFFFF); - BUMP_REDS(BIF_P, loop_count / LOOP_FACTOR); + BUMP_REDS(p, loop_count / LOOP_FACTOR); if (rc == PCRE_ERROR_LOOP_LIMIT) { /* Trap */ Binary *mbp = erts_create_magic_binary(sizeof(RestartContext), @@ -1065,17 +1072,17 @@ handle_iolist: Eterm magic_bin; Eterm *hp; memcpy(restartp,&restart,sizeof(RestartContext)); - BUMP_ALL_REDS(BIF_P); - hp = HAlloc(BIF_P, PROC_BIN_SIZE); - magic_bin = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), mbp); + BUMP_ALL_REDS(p); + hp = HAlloc(p, PROC_BIN_SIZE); + magic_bin = erts_mk_magic_binary_term(&hp, &MSO(p), mbp); BIF_TRAP3(&re_exec_trap_export, - BIF_P, - BIF_ARG_1, - BIF_ARG_2 /* To avoid GC of precompiled code, XXX: not utilized yet */, + p, + arg1, + arg2 /* To avoid GC of precompiled code, XXX: not utilized yet */, magic_bin); } - res = build_exec_return(BIF_P, rc, &restart, BIF_ARG_1); + res = build_exec_return(p, rc, &restart, arg1); cleanup_restart_context(&restart); @@ -1083,9 +1090,15 @@ handle_iolist: } BIF_RETTYPE +re_run_3(BIF_ALIST_3) +{ + return re_run(BIF_P,BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); +} + +BIF_RETTYPE re_run_2(BIF_ALIST_2) { - return re_run_3(BIF_P,BIF_ARG_1, BIF_ARG_2, NIL); + return re_run(BIF_P,BIF_ARG_1, BIF_ARG_2, NIL); } /* diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index 3e942dcc55..b0a58c80ea 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -48,6 +48,11 @@ static Binary *erts_default_meta_match_spec; static struct trace_pattern_flags erts_default_trace_pattern_flags; static Eterm erts_default_meta_tracer_pid; +static Eterm +trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist); +static BIF_RETTYPE +system_monitor(Process *p, Eterm monitor_pid, Eterm list); + static void new_seq_trace_token(Process* p); /* help func for seq_trace_2*/ static int already_traced(Process *p, Process *tracee_p, Eterm tracer); static int port_already_traced(Process *p, Port *tracee_port, Eterm tracer); @@ -77,13 +82,19 @@ erts_bif_trace_init(void) */ Eterm -trace_pattern_2(Process* p, Eterm MFA, Eterm Pattern) +trace_pattern_2(BIF_ALIST_2) { - return trace_pattern_3(p,MFA,Pattern,NIL); + return trace_pattern(BIF_P, BIF_ARG_1, BIF_ARG_2, NIL); } Eterm -trace_pattern_3(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) +trace_pattern_3(BIF_ALIST_3) +{ + return trace_pattern(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); +} + +static Eterm +trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) { DeclareTmpHeap(mfa,3,p); /* Not really heap here, but might be when setting pattern */ int i; @@ -436,9 +447,12 @@ erts_trace_flags(Eterm List, return 0; } -Eterm -trace_3(Process* p, Eterm pid_spec, Eterm how, Eterm list) +Eterm trace_3(BIF_ALIST_3) { + Process* p = BIF_P; + Eterm pid_spec = BIF_ARG_1; + Eterm how = BIF_ARG_2; + Eterm list = BIF_ARG_3; int on; Eterm tracer = NIL; int matches = 0; @@ -821,9 +835,11 @@ static int already_traced(Process *c_p, Process *tracee_p, Eterm tracer) * Return information about a process or an external function being traced. */ -Eterm -trace_info_2(Process* p, Eterm What, Eterm Key) +Eterm trace_info_2(BIF_ALIST_2) { + Process* p = BIF_P; + Eterm What = BIF_ARG_1; + Eterm Key = BIF_ARG_2; Eterm res; if (What == am_on_load) { res = trace_info_on_load(p, Key); @@ -1753,23 +1769,20 @@ new_seq_trace_token(Process* p) } } -BIF_RETTYPE seq_trace_info_1(BIF_ALIST_1) +BIF_RETTYPE erl_seq_trace_info(Process *p, Eterm item) { - Eterm item; Eterm res; Eterm* hp; Uint current_flag; - if (is_not_atom(BIF_ARG_1)) { - BIF_ERROR(BIF_P, BADARG); + if (is_not_atom(item)) { + BIF_ERROR(p, BADARG); } - item = BIF_ARG_1; - - if (SEQ_TRACE_TOKEN(BIF_P) == NIL) { + if (SEQ_TRACE_TOKEN(p) == NIL) { if ((item == am_send) || (item == am_receive) || (item == am_print) || (item == am_timestamp)) { - hp = HAlloc(BIF_P,3); + hp = HAlloc(p,3); res = TUPLE2(hp, item, am_false); BIF_RET(res); } else if ((item == am_label) || (item == am_serial)) { @@ -1779,35 +1792,40 @@ BIF_RETTYPE seq_trace_info_1(BIF_ALIST_1) } } - if (BIF_ARG_1 == am_send) { + if (item == am_send) { current_flag = SEQ_TRACE_SEND; - } else if (BIF_ARG_1 == am_receive) { + } else if (item == am_receive) { current_flag = SEQ_TRACE_RECEIVE; - } else if (BIF_ARG_1 == am_print) { + } else if (item == am_print) { current_flag = SEQ_TRACE_PRINT; - } else if (BIF_ARG_1 == am_timestamp) { + } else if (item == am_timestamp) { current_flag = SEQ_TRACE_TIMESTAMP; } else { current_flag = 0; } if (current_flag) { - res = unsigned_val(SEQ_TRACE_TOKEN_FLAGS(BIF_P)) & current_flag ? + res = unsigned_val(SEQ_TRACE_TOKEN_FLAGS(p)) & current_flag ? am_true : am_false; } else if (item == am_label) { - res = SEQ_TRACE_TOKEN_LABEL(BIF_P); + res = SEQ_TRACE_TOKEN_LABEL(p); } else if (item == am_serial) { - hp = HAlloc(BIF_P, 3); - res = TUPLE2(hp, SEQ_TRACE_TOKEN_LASTCNT(BIF_P), SEQ_TRACE_TOKEN_SERIAL(BIF_P)); + hp = HAlloc(p, 3); + res = TUPLE2(hp, SEQ_TRACE_TOKEN_LASTCNT(p), SEQ_TRACE_TOKEN_SERIAL(p)); } else { error: - BIF_ERROR(BIF_P, BADARG); + BIF_ERROR(p, BADARG); } - hp = HAlloc(BIF_P, 3); + hp = HAlloc(p, 3); res = TUPLE2(hp, item, res); BIF_RET(res); } +BIF_RETTYPE seq_trace_info_1(BIF_ALIST_1) +{ + BIF_RET(erl_seq_trace_info(BIF_P, BIF_ARG_1)); +} + /* seq_trace_print(Message) -> true | false This function passes Message to the system_tracer @@ -1920,23 +1938,35 @@ static Eterm system_monitor_get(Process *p) } -BIF_RETTYPE system_monitor_0(Process *p) { - BIF_RET(system_monitor_get(p)); +BIF_RETTYPE system_monitor_0(BIF_ALIST_0) +{ + BIF_RET(system_monitor_get(BIF_P)); } -BIF_RETTYPE system_monitor_1(Process *p, Eterm spec) { +BIF_RETTYPE system_monitor_1(BIF_ALIST_1) +{ + Process* p = BIF_P; + Eterm spec = BIF_ARG_1; + if (spec == am_undefined) { - BIF_RET(system_monitor_2(p, spec, NIL)); + BIF_RET(system_monitor(p, spec, NIL)); } else if (is_tuple(spec)) { Eterm *tp = tuple_val(spec); if (tp[0] != make_arityval(2)) goto error; - BIF_RET(system_monitor_2(p, tp[1], tp[2])); + BIF_RET(system_monitor(p, tp[1], tp[2])); } error: BIF_ERROR(p, BADARG); } -BIF_RETTYPE system_monitor_2(Process *p, Eterm monitor_pid, Eterm list) { +BIF_RETTYPE system_monitor_2(BIF_ALIST_2) +{ + return system_monitor(BIF_P, BIF_ARG_1, BIF_ARG_2); +} + +static BIF_RETTYPE +system_monitor(Process *p, Eterm monitor_pid, Eterm list) +{ Eterm prev; int system_blocked = 0; @@ -2054,11 +2084,16 @@ static Eterm system_profile_get(Process *p) { } } -BIF_RETTYPE system_profile_0(Process *p) { - BIF_RET(system_profile_get(p)); +BIF_RETTYPE system_profile_0(BIF_ALIST_0) +{ + BIF_RET(system_profile_get(BIF_P)); } -BIF_RETTYPE system_profile_2(Process *p, Eterm profiler, Eterm list) { +BIF_RETTYPE system_profile_2(BIF_ALIST_2) +{ + Process *p = BIF_P; + Eterm profiler = BIF_ARG_1; + Eterm list = BIF_ARG_2; Eterm prev; int system_blocked = 0; Process *profiler_p = NULL; diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c index 326a5c136b..6f7309f493 100644 --- a/erts/emulator/beam/erl_bits.c +++ b/erts/emulator/beam/erl_bits.c @@ -845,8 +845,7 @@ erts_bs_put_utf8(ERL_BITS_PROTO_1(Eterm arg)) dst[1] = 0x80 | (val & 0x3F); num_bits = 16; } else if (val < 0x10000UL) { - if ((0xD800 <= val && val <= 0xDFFF) || - val == 0xFFFE || val == 0xFFFF) { + if (0xD800 <= val && val <= 0xDFFF) { return 0; } dst[0] = 0xE0 | (val >> 12); @@ -886,8 +885,7 @@ erts_bs_put_utf16(ERL_BITS_PROTO_2(Eterm arg, Uint flags)) return 0; } val = unsigned_val(arg); - if (val > 0x10FFFF || (0xD800 <= val && val <= 0xDFFF) || - val == 0xFFFE || val == 0xFFFF) { + if (val > 0x10FFFF || (0xD800 <= val && val <= 0xDFFF)) { return 0; } @@ -1652,8 +1650,7 @@ erts_bs_get_utf8(ErlBinMatchBuffer* mb) return THE_NON_VALUE; } result = (((result << 6) + a) << 6) + b - (Eterm) 0x000E2080UL; - if ((0xD800 <= result && result <= 0xDFFF) || - result == 0xFFFE || result == 0xFFFF) { + if (0xD800 <= result && result <= 0xDFFF) { return THE_NON_VALUE; } mb->offset += 24; @@ -1723,9 +1720,6 @@ erts_bs_get_utf16(ErlBinMatchBuffer* mb, Uint flags) w1 = (src[0] << 8) | src[1]; } if (w1 < 0xD800 || w1 > 0xDFFF) { - if (w1 == 0xFFFE || w1 == 0xFFFF) { - return THE_NON_VALUE; - } mb->offset += 16; return make_small(w1); } else if (w1 > 0xDBFF) { diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 259ebd838e..0079c13287 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -129,8 +129,6 @@ static Uint meta_main_tab_slot_mask; /* The slot index part of an unnamed tab static Uint meta_main_tab_seq_incr; static Uint meta_main_tab_seq_cnt = 0; /* To give unique(-ish) table identifiers */ - - /* ** The meta hash table of all NAMED ets tables */ @@ -202,12 +200,17 @@ static int free_table_cont(Process *p, int first, int clean_meta_tab); static void print_table(int to, void *to_arg, int show, DbTable* tb); -static BIF_RETTYPE ets_select_delete_1(Process *p, Eterm a1); -static BIF_RETTYPE ets_select_count_1(Process *p, Eterm a1); -static BIF_RETTYPE ets_select_trap_1(Process *p, Eterm a1); -static BIF_RETTYPE ets_delete_trap(Process *p, Eterm a1); +static BIF_RETTYPE ets_select_delete_1(BIF_ALIST_1); +static BIF_RETTYPE ets_select_count_1(BIF_ALIST_1); +static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1); +static BIF_RETTYPE ets_delete_trap(BIF_ALIST_1); static Eterm table_info(Process* p, DbTable* tb, Eterm What); +static BIF_RETTYPE ets_select1(Process* p, Eterm arg1); +static BIF_RETTYPE ets_select2(Process* p, Eterm arg1, Eterm arg2); +static BIF_RETTYPE ets_select3(Process* p, Eterm arg1, Eterm arg2, Eterm arg3); + + /* * Exported global */ @@ -1296,7 +1299,9 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) Uint32 status; Sint keypos; int is_named, is_fine_locked, frequent_read, is_compressed; +#ifdef DEBUG int cret; +#endif DeclareTmpHeap(meta_tuple,3,BIF_P); DbTableMethod* meth; erts_smp_rwmtx_t *mmtl; @@ -1444,7 +1449,10 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) tb->common.fixations = NULL; tb->common.compress = is_compressed; - cret = meth->db_create(BIF_P, tb); +#ifdef DEBUG + cret = +#endif + meth->db_create(BIF_P, tb); ASSERT(cret == DB_ERROR_NONE); erts_smp_spin_lock(&meta_main_tab_main_lock); @@ -1941,8 +1949,10 @@ BIF_RETTYPE ets_delete_object_2(BIF_ALIST_2) /* ** This is for trapping, cannot be called directly. */ -static BIF_RETTYPE ets_select_delete_1(Process *p, Eterm a1) +static BIF_RETTYPE ets_select_delete_1(BIF_ALIST_1) { + Process *p = BIF_P; + Eterm a1 = BIF_ARG_1; BIF_RETTYPE result; DbTable* tb; int cret; @@ -2108,7 +2118,7 @@ BIF_RETTYPE ets_slot_2(BIF_ALIST_2) BIF_RETTYPE ets_match_1(BIF_ALIST_1) { - return ets_select_1(BIF_P, BIF_ARG_1); + return ets_select1(BIF_P, BIF_ARG_1); } BIF_RETTYPE ets_match_2(BIF_ALIST_2) @@ -2124,7 +2134,7 @@ BIF_RETTYPE ets_match_2(BIF_ALIST_2) ms = TUPLE3(hp, BIF_ARG_2, NIL, ms); hp += 4; ms = CONS(hp, ms, NIL); - res = ets_select_2(BIF_P, BIF_ARG_1, ms); + res = ets_select2(BIF_P, BIF_ARG_1, ms); UnUseTmpHeap(8,BIF_P); return res; } @@ -2142,7 +2152,7 @@ BIF_RETTYPE ets_match_3(BIF_ALIST_3) ms = TUPLE3(hp, BIF_ARG_2, NIL, ms); hp += 4; ms = CONS(hp, ms, NIL); - res = ets_select_3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3); + res = ets_select3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3); UnUseTmpHeap(8,BIF_P); return res; } @@ -2150,6 +2160,12 @@ BIF_RETTYPE ets_match_3(BIF_ALIST_3) BIF_RETTYPE ets_select_3(BIF_ALIST_3) { + return ets_select3(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); +} + +static BIF_RETTYPE +ets_select3(Process* p, Eterm arg1, Eterm arg2, Eterm arg3) +{ BIF_RETTYPE result; DbTable* tb; int cret; @@ -2160,22 +2176,22 @@ BIF_RETTYPE ets_select_3(BIF_ALIST_3) CHECK_TABLES(); /* Chunk size strictly greater than 0 */ - if (is_not_small(BIF_ARG_3) || (chunk_size = signed_val(BIF_ARG_3)) <= 0) { - BIF_ERROR(BIF_P, BADARG); + if (is_not_small(arg3) || (chunk_size = signed_val(arg3)) <= 0) { + BIF_ERROR(p, BADARG); } - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) { - BIF_ERROR(BIF_P, BADARG); + if ((tb = db_get_table(p, arg1, DB_READ, LCK_READ)) == NULL) { + BIF_ERROR(p, BADARG); } - safety = ITERATION_SAFETY(BIF_P,tb); + safety = ITERATION_SAFETY(p,tb); if (safety == ITER_UNSAFE) { local_fix_table(tb); } - cret = tb->common.meth->db_select_chunk(BIF_P, tb, - BIF_ARG_2, chunk_size, + cret = tb->common.meth->db_select_chunk(p, tb, + arg2, chunk_size, 0 /* not reversed */, &ret); - if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) { - fix_table_locked(BIF_P, tb); + if (DID_TRAP(p,ret) && safety != ITER_SAFE) { + fix_table_locked(p, tb); } if (safety == ITER_UNSAFE) { local_unfix_table(tb); @@ -2187,22 +2203,24 @@ BIF_RETTYPE ets_select_3(BIF_ALIST_3) ERTS_BIF_PREP_RET(result, ret); break; case DB_ERROR_SYSRES: - ERTS_BIF_PREP_ERROR(result, BIF_P, SYSTEM_LIMIT); + ERTS_BIF_PREP_ERROR(result, p, SYSTEM_LIMIT); break; default: - ERTS_BIF_PREP_ERROR(result, BIF_P, BADARG); + ERTS_BIF_PREP_ERROR(result, p, BADARG); break; } - erts_match_set_release_result(BIF_P); + erts_match_set_release_result(p); return result; } /* We get here instead of in the real BIF when trapping */ -static BIF_RETTYPE ets_select_trap_1(Process *p, Eterm a1) +static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1) { + Process *p = BIF_P; + Eterm a1 = BIF_ARG_1; BIF_RETTYPE result; DbTable* tb; int cret; @@ -2247,6 +2265,11 @@ static BIF_RETTYPE ets_select_trap_1(Process *p, Eterm a1) BIF_RETTYPE ets_select_1(BIF_ALIST_1) { + return ets_select1(BIF_P, BIF_ARG_1); +} + +static BIF_RETTYPE ets_select1(Process *p, Eterm arg1) +{ BIF_RETTYPE result; DbTable* tb; int cret; @@ -2260,28 +2283,27 @@ BIF_RETTYPE ets_select_1(BIF_ALIST_1) * Make sure that the table exists. */ - if (!is_tuple(BIF_ARG_1)) { - if (BIF_ARG_1 == am_EOT) { + if (!is_tuple(arg1)) { + if (arg1 == am_EOT) { BIF_RET(am_EOT); } - BIF_ERROR(BIF_P, BADARG); + BIF_ERROR(p, BADARG); } - tptr = tuple_val(BIF_ARG_1); + tptr = tuple_val(arg1); if (arityval(*tptr) < 1 || - (tb = db_get_table(BIF_P, tptr[1], DB_READ, LCK_READ)) == NULL) { - BIF_ERROR(BIF_P, BADARG); + (tb = db_get_table(p, tptr[1], DB_READ, LCK_READ)) == NULL) { + BIF_ERROR(p, BADARG); } - safety = ITERATION_SAFETY(BIF_P,tb); + safety = ITERATION_SAFETY(p,tb); if (safety == ITER_UNSAFE) { local_fix_table(tb); } - cret = tb->common.meth->db_select_continue(BIF_P,tb, - BIF_ARG_1, &ret); + cret = tb->common.meth->db_select_continue(p,tb, arg1, &ret); - if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) { - fix_table_locked(BIF_P, tb); + if (DID_TRAP(p,ret) && safety != ITER_SAFE) { + fix_table_locked(p, tb); } if (safety == ITER_UNSAFE) { local_unfix_table(tb); @@ -2293,20 +2315,26 @@ BIF_RETTYPE ets_select_1(BIF_ALIST_1) ERTS_BIF_PREP_RET(result, ret); break; case DB_ERROR_SYSRES: - ERTS_BIF_PREP_ERROR(result, BIF_P, SYSTEM_LIMIT); + ERTS_BIF_PREP_ERROR(result, p, SYSTEM_LIMIT); break; default: - ERTS_BIF_PREP_ERROR(result, BIF_P, BADARG); + ERTS_BIF_PREP_ERROR(result, p, BADARG); break; } - erts_match_set_release_result(BIF_P); + erts_match_set_release_result(p); return result; } BIF_RETTYPE ets_select_2(BIF_ALIST_2) { + return ets_select2(BIF_P, BIF_ARG_1, BIF_ARG_2); +} + +static BIF_RETTYPE +ets_select2(Process* p, Eterm arg1, Eterm arg2) +{ BIF_RETTYPE result; DbTable* tb; int cret; @@ -2319,19 +2347,19 @@ BIF_RETTYPE ets_select_2(BIF_ALIST_2) * Make sure that the table exists. */ - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) { - BIF_ERROR(BIF_P, BADARG); + if ((tb = db_get_table(p, arg1, DB_READ, LCK_READ)) == NULL) { + BIF_ERROR(p, BADARG); } - safety = ITERATION_SAFETY(BIF_P,tb); + safety = ITERATION_SAFETY(p,tb); if (safety == ITER_UNSAFE) { local_fix_table(tb); } - cret = tb->common.meth->db_select(BIF_P, tb, BIF_ARG_2, + cret = tb->common.meth->db_select(p, tb, arg2, 0, &ret); - if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) { - fix_table_locked(BIF_P, tb); + if (DID_TRAP(p,ret) && safety != ITER_SAFE) { + fix_table_locked(p, tb); } if (safety == ITER_UNSAFE) { local_unfix_table(tb); @@ -2343,21 +2371,23 @@ BIF_RETTYPE ets_select_2(BIF_ALIST_2) ERTS_BIF_PREP_RET(result, ret); break; case DB_ERROR_SYSRES: - ERTS_BIF_PREP_ERROR(result, BIF_P, SYSTEM_LIMIT); + ERTS_BIF_PREP_ERROR(result, p, SYSTEM_LIMIT); break; default: - ERTS_BIF_PREP_ERROR(result, BIF_P, BADARG); + ERTS_BIF_PREP_ERROR(result, p, BADARG); break; } - erts_match_set_release_result(BIF_P); + erts_match_set_release_result(p); return result; } /* We get here instead of in the real BIF when trapping */ -static BIF_RETTYPE ets_select_count_1(Process *p, Eterm a1) +static BIF_RETTYPE ets_select_count_1(BIF_ALIST_1) { + Process *p = BIF_P; + Eterm a1 = BIF_ARG_1; BIF_RETTYPE result; DbTable* tb; int cret; @@ -2498,7 +2528,7 @@ BIF_RETTYPE ets_select_reverse_3(BIF_ALIST_3) BIF_RETTYPE ets_select_reverse_1(BIF_ALIST_1) { - return ets_select_1(BIF_P, BIF_ARG_1); + return ets_select1(BIF_P, BIF_ARG_1); } BIF_RETTYPE ets_select_reverse_2(BIF_ALIST_2) @@ -2552,7 +2582,7 @@ BIF_RETTYPE ets_select_reverse_2(BIF_ALIST_2) */ BIF_RETTYPE ets_match_object_1(BIF_ALIST_1) { - return ets_select_1(BIF_P, BIF_ARG_1); + return ets_select1(BIF_P, BIF_ARG_1); } BIF_RETTYPE ets_match_object_2(BIF_ALIST_2) @@ -2568,7 +2598,7 @@ BIF_RETTYPE ets_match_object_2(BIF_ALIST_2) ms = TUPLE3(hp, BIF_ARG_2, NIL, ms); hp += 4; ms = CONS(hp, ms, NIL); - res = ets_select_2(BIF_P, BIF_ARG_1, ms); + res = ets_select2(BIF_P, BIF_ARG_1, ms); UnUseTmpHeap(8,BIF_P); return res; } @@ -2586,7 +2616,7 @@ BIF_RETTYPE ets_match_object_3(BIF_ALIST_3) ms = TUPLE3(hp, BIF_ARG_2, NIL, ms); hp += 4; ms = CONS(hp, ms, NIL); - res = ets_select_3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3); + res = ets_select3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3); UnUseTmpHeap(8,BIF_P); return res; } @@ -2605,7 +2635,9 @@ BIF_RETTYPE ets_info_1(BIF_ALIST_1) int i; Eterm* hp; /*Process* rp = NULL;*/ + /* If/when we implement lockless private tables: Eterm owner; + */ if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ)) == NULL) { if (is_atom(BIF_ARG_1) || is_small(BIF_ARG_1)) { @@ -2614,7 +2646,9 @@ BIF_RETTYPE ets_info_1(BIF_ALIST_1) BIF_ERROR(BIF_P, BADARG); } + /* If/when we implement lockless private tables: owner = tb->common.owner; + */ /* If/when we implement lockless private tables: if ((tb->common.status & DB_PRIVATE) && owner != BIF_P->id) { @@ -3520,8 +3554,10 @@ static void free_heir_data(DbTable* tb) #endif } -static BIF_RETTYPE ets_delete_trap(Process *p, Eterm cont) +static BIF_RETTYPE ets_delete_trap(BIF_ALIST_1) { + Process *p = BIF_P; + Eterm cont = BIF_ARG_1; int trap; Eterm* ptr = big_val(cont); DbTable *tb = *((DbTable **) (UWord) (ptr + 1)); diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index c6f0d80e32..312050b931 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -344,8 +344,8 @@ static int do_partly_bound_can_match_lesser(Eterm a, Eterm b, int *done); static int do_partly_bound_can_match_greater(Eterm a, Eterm b, int *done); -static BIF_RETTYPE ets_select_reverse(Process *p, Eterm a1, - Eterm a2, Eterm a3); +static BIF_RETTYPE ets_select_reverse(BIF_ALIST_3); + /* Method interface functions */ static int db_first_tree(Process *p, DbTable *tbl, @@ -844,8 +844,12 @@ static int db_slot_tree(Process *p, DbTable *tbl, -static BIF_RETTYPE ets_select_reverse(Process *p, Eterm a1, Eterm a2, Eterm a3) +static BIF_RETTYPE ets_select_reverse(BIF_ALIST_3) { + Process *p = BIF_P; + Eterm a1 = BIF_ARG_1; + Eterm a2 = BIF_ARG_2; + Eterm a3 = BIF_ARG_3; Eterm list; Eterm result; Eterm* hp; diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 68b7b7aa6a..4821a7d9fb 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -496,7 +496,7 @@ static erts_smp_atomic32_t trace_control_word; /* This needs to be here, before the bif table... */ -static Eterm db_set_trace_control_word_fake_1(Process *p, Eterm val); +static Eterm db_set_trace_control_word_fake_1(BIF_ALIST_1); /* ** The table of callable bif's, i e guard bif's and @@ -909,14 +909,18 @@ static void db_free_tmp_uncompressed(DbTerm* obj); /* ** Pseudo BIF:s to be callable from the PAM VM. */ - -BIF_RETTYPE db_get_trace_control_word_0(Process *p) +BIF_RETTYPE db_get_trace_control_word(Process *p) { Uint32 tcw = (Uint32) erts_smp_atomic32_read_acqb(&trace_control_word); BIF_RET(erts_make_integer((Uint) tcw, p)); } -BIF_RETTYPE db_set_trace_control_word_1(Process *p, Eterm new) +BIF_RETTYPE db_get_trace_control_word_0(BIF_ALIST_0) +{ + BIF_RET(db_get_trace_control_word(BIF_P)); +} + +BIF_RETTYPE db_set_trace_control_word(Process *p, Eterm new) { Uint val; Uint32 old_tcw; @@ -924,20 +928,27 @@ BIF_RETTYPE db_set_trace_control_word_1(Process *p, Eterm new) BIF_ERROR(p, BADARG); if (val != ((Uint32)val)) BIF_ERROR(p, BADARG); - + old_tcw = (Uint32) erts_smp_atomic32_xchg_relb(&trace_control_word, (erts_aint32_t) val); BIF_RET(erts_make_integer((Uint) old_tcw, p)); } -static Eterm db_set_trace_control_word_fake_1(Process *p, Eterm new) +BIF_RETTYPE db_set_trace_control_word_1(BIF_ALIST_1) { + BIF_RET(db_set_trace_control_word(BIF_P, BIF_ARG_1)); +} + +static Eterm db_set_trace_control_word_fake_1(BIF_ALIST_1) +{ + Process *p = BIF_P; + Eterm new = BIF_ARG_1; Uint val; if (!term_to_Uint(new, &val)) BIF_ERROR(p, BADARG); if (val != ((Uint32)val)) BIF_ERROR(p, BADARG); - BIF_RET(db_get_trace_control_word_0(p)); + BIF_RET(db_get_trace_control_word(p)); } /* @@ -1705,6 +1716,7 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, Process *current_scheduled; ErtsSchedulerData *esdp; Eterm (*bif)(Process*, ...); + Eterm bif_args[3]; int fail_label; int atomic_trace; #if HALFWORD_HEAP @@ -1958,7 +1970,7 @@ restart: break; case matchCall0: bif = (Eterm (*)(Process*, ...)) *pc++; - t = (*bif)(build_proc); + t = (*bif)(build_proc, bif_args); if (is_non_value(t)) { if (do_catch) t = FAIL_TERM; @@ -1969,7 +1981,7 @@ restart: break; case matchCall1: bif = (Eterm (*)(Process*, ...)) *pc++; - t = (*bif)(build_proc, esp[-1]); + t = (*bif)(build_proc, esp-1); if (is_non_value(t)) { if (do_catch) t = FAIL_TERM; @@ -1980,7 +1992,9 @@ restart: break; case matchCall2: bif = (Eterm (*)(Process*, ...)) *pc++; - t = (*bif)(build_proc, esp[-1], esp[-2]); + bif_args[0] = esp[-1]; + bif_args[1] = esp[-2]; + t = (*bif)(build_proc, bif_args); if (is_non_value(t)) { if (do_catch) t = FAIL_TERM; @@ -1992,7 +2006,10 @@ restart: break; case matchCall3: bif = (Eterm (*)(Process*, ...)) *pc++; - t = (*bif)(build_proc, esp[-1], esp[-2], esp[-3]); + bif_args[0] = esp[-1]; + bif_args[1] = esp[-2]; + bif_args[2] = esp[-3]; + t = (*bif)(build_proc, bif_args); if (is_non_value(t)) { if (do_catch) t = FAIL_TERM; @@ -2847,7 +2864,9 @@ void* db_store_term_comp(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj) Uint new_sz = offset + db_size_dbterm_comp(tb, obj); byte* basep; DbTerm* newp; +#ifdef DEBUG byte* top; +#endif ASSERT(tb->compress); if (old != 0) { @@ -2869,7 +2888,10 @@ void* db_store_term_comp(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj) } newp->size = size_object(obj); - top = copy_to_comp(tb, obj, newp, new_sz); +#ifdef DEBUG + top = +#endif + copy_to_comp(tb, obj, newp, new_sz); ASSERT(top <= basep + new_sz); /* ToDo: Maybe realloc if ((basep+new_sz) - top) > WASTED_SPACE_LIMIT */ @@ -4971,7 +4993,7 @@ static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace) static Eterm seq_trace_fake(Process *p, Eterm arg1) { - Eterm result = seq_trace_info_1(p,arg1); + Eterm result = erl_seq_trace_info(p, arg1); if (is_tuple(result) && *tuple_val(result) == 2) { return (tuple_val(result))[2]; } diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index bb1751d309..6a96e174e1 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -326,8 +326,10 @@ ERTS_GLB_INLINE int db_eq(DbTableCommon* tb, Eterm a, DbTerm* b) (T)->common.owner == (P)->id) /* Function prototypes */ -Eterm db_get_trace_control_word_0(Process *p); -Eterm db_set_trace_control_word_1(Process *p, Eterm val); +BIF_RETTYPE db_get_trace_control_word(Process* p); +BIF_RETTYPE db_set_trace_control_word(Process* p, Eterm tcw); +BIF_RETTYPE db_get_trace_control_word_0(BIF_ALIST_0); +BIF_RETTYPE db_set_trace_control_word_1(BIF_ALIST_1); void db_initialize_util(void); Eterm db_getkey(int keypos, Eterm obj); diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 8faaf9f367..c29352a227 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -315,7 +315,12 @@ erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity) if (is_non_value(result)) { if (p->freason == TRAP) { - cost = erts_garbage_collect(p, 0, p->def_arg_reg, p->arity); + #if HIPE + if (regs == NULL) { + regs = ERTS_PROC_GET_SCHDATA(p)->x_reg_array; + } + #endif + cost = erts_garbage_collect(p, 0, regs, p->arity); } else { cost = erts_garbage_collect(p, 0, regs, arity); } diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 05fa10964a..7c047891d9 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -130,6 +130,8 @@ int erts_modified_timing_level; int erts_no_crash_dump = 0; /* Use -d to suppress crash dump. */ +int erts_no_line_info = 0; /* -L: Don't load line information */ + /* * Other global variables. */ @@ -982,7 +984,9 @@ erl_start(int argc, char **argv) case 'l': display_loads++; break; - + case 'L': + erts_no_line_info = 1; + break; case 'v': #ifdef DEBUG if (argv[i][2] == '\0') { diff --git a/erts/emulator/beam/erl_monitors.c b/erts/emulator/beam/erl_monitors.c index 47597f302b..1a84950120 100644 --- a/erts/emulator/beam/erl_monitors.c +++ b/erts/emulator/beam/erl_monitors.c @@ -948,8 +948,10 @@ static void erts_dump_links(ErtsLink *root, int indent) erts_destroy_tmp_dsbuf(dsbufp); } -Eterm erts_debug_dump_monitors_1(Process *p, Eterm pid) +Eterm erts_debug_dump_monitors_1(BIF_ALIST_1) { + Process *p = BIF_P; + Eterm pid = BIF_ARG_1; Process *rp; DistEntry *dep; rp = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, pid, ERTS_PROC_LOCK_LINK); @@ -976,8 +978,10 @@ Eterm erts_debug_dump_monitors_1(Process *p, Eterm pid) } } -Eterm erts_debug_dump_links_1(Process *p, Eterm pid) +Eterm erts_debug_dump_links_1(BIF_ALIST_1) { + Process *p = BIF_P; + Eterm pid = BIF_ARG_1; Process *rp; DistEntry *dep; if (is_internal_port(pid)) { diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 818156fce6..62798bb2c1 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -131,10 +131,13 @@ static void pre_nif_noproc(ErlNifEnv* env, struct erl_module_nif* mod_nif) env->tmp_obj_list = NULL; } -/* Temporary object header, auto-deallocated when NIF returns. */ +/* Temporary object header, auto-deallocated when NIF returns + * or when independent environment is cleared. + */ struct enif_tmp_obj_t { struct enif_tmp_obj_t* next; void (*dtor)(struct enif_tmp_obj_t*); + ErtsAlcType_t allocator; /*char data[];*/ }; @@ -245,7 +248,7 @@ ErlNifEnv* enif_alloc_env(void) msg_env->env.hp_end = phony_heap; msg_env->env.heap_frag = NULL; msg_env->env.mod_nif = NULL; - msg_env->env.tmp_obj_list = (struct enif_tmp_obj_t*) 1; /* invalid non-NULL */ + msg_env->env.tmp_obj_list = NULL; msg_env->env.proc = &msg_env->phony_proc; memset(&msg_env->phony_proc, 0, sizeof(Process)); HEAP_START(&msg_env->phony_proc) = phony_heap; @@ -290,6 +293,7 @@ void enif_clear_env(ErlNifEnv* env) menv->env.hp = menv->env.hp_end = HEAP_TOP(p); ASSERT(!is_offheap(&MSO(p))); + free_tmp_objs(env); } int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, ErlNifEnv* msg_env, ERL_NIF_TERM msg) @@ -436,24 +440,36 @@ int enif_is_exception(ErlNifEnv* env, ERL_NIF_TERM term) return term == THE_NON_VALUE; } +int enif_is_number(ErlNifEnv* env, ERL_NIF_TERM term) +{ + return is_number(term); +} + +static ERTS_INLINE int is_proc_bound(ErlNifEnv* env) +{ + return env->mod_nif != NULL; +} + static void aligned_binary_dtor(struct enif_tmp_obj_t* obj) { - erts_free_aligned_binary_bytes_extra((byte*)obj,ERTS_ALC_T_TMP); + erts_free_aligned_binary_bytes_extra((byte*)obj, obj->allocator); } int enif_inspect_binary(ErlNifEnv* env, Eterm bin_term, ErlNifBinary* bin) { + ErtsAlcType_t allocator = is_proc_bound(env) ? ERTS_ALC_T_TMP : ERTS_ALC_T_NIF; union { struct enif_tmp_obj_t* tmp; byte* raw_ptr; }u; u.tmp = NULL; - bin->data = erts_get_aligned_binary_bytes_extra(bin_term, &u.raw_ptr, ERTS_ALC_T_TMP, + bin->data = erts_get_aligned_binary_bytes_extra(bin_term, &u.raw_ptr, allocator, sizeof(struct enif_tmp_obj_t)); if (bin->data == NULL) { return 0; } if (u.tmp != NULL) { + u.tmp->allocator = allocator; u.tmp->next = env->tmp_obj_list; u.tmp->dtor = &aligned_binary_dtor; env->tmp_obj_list = u.tmp; @@ -467,12 +483,13 @@ int enif_inspect_binary(ErlNifEnv* env, Eterm bin_term, ErlNifBinary* bin) static void tmp_alloc_dtor(struct enif_tmp_obj_t* obj) { - erts_free(ERTS_ALC_T_TMP, obj); + erts_free(obj->allocator, obj); } int enif_inspect_iolist_as_binary(ErlNifEnv* env, Eterm term, ErlNifBinary* bin) { struct enif_tmp_obj_t* tobj; + ErtsAlcType_t allocator; Uint sz; if (is_binary(term)) { return enif_inspect_binary(env,term,bin); @@ -487,8 +504,10 @@ int enif_inspect_iolist_as_binary(ErlNifEnv* env, Eterm term, ErlNifBinary* bin) if (erts_iolist_size(term, &sz)) { return 0; } - - tobj = erts_alloc(ERTS_ALC_T_TMP, sz + sizeof(struct enif_tmp_obj_t)); + + allocator = is_proc_bound(env) ? ERTS_ALC_T_TMP : ERTS_ALC_T_NIF; + tobj = erts_alloc(allocator, sz + sizeof(struct enif_tmp_obj_t)); + tobj->allocator = allocator; tobj->next = env->tmp_obj_list; tobj->dtor = &tmp_alloc_dtor; env->tmp_obj_list = tobj; @@ -677,6 +696,7 @@ Eterm enif_make_sub_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term, ErlSubBin* sb; Eterm orig; Uint offset, bit_offset, bit_size; +#ifdef DEBUG unsigned src_size; ASSERT(is_binary(bin_term)); @@ -684,6 +704,7 @@ Eterm enif_make_sub_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term, ASSERT(pos <= src_size); ASSERT(size <= src_size); ASSERT(pos + size <= src_size); +#endif sb = (ErlSubBin*) alloc_heap(env, ERL_SUB_BIN_SIZE); ERTS_GET_REAL_BIN(bin_term, orig, offset, bit_offset, bit_size); sb->thing_word = HEADER_SUB_BIN; @@ -1022,6 +1043,29 @@ void enif_system_info(ErlNifSysInfo *sip, size_t si_size) driver_system_info(sip, si_size); } +int enif_make_reverse_list(ErlNifEnv* env, ERL_NIF_TERM term, ERL_NIF_TERM *list) { + Eterm *listptr, ret = NIL, *hp; + + if (is_nil(term)) { + *list = term; + return 1; + } + + ret = NIL; + + while (is_not_nil(term)) { + if (is_not_list(term)) { + return 0; + } + hp = alloc_heap(env, 2); + listptr = list_val(term); + ret = CONS(hp, CAR(listptr), ret); + term = CDR(listptr); + } + *list = ret; + return 1; +} + ErlNifMutex* enif_mutex_create(char *name) { return erl_drv_mutex_create(name); } void enif_mutex_destroy(ErlNifMutex *mtx) { erl_drv_mutex_destroy(mtx); } @@ -1716,8 +1760,10 @@ struct readonly_check_t }; static void add_readonly_check(ErlNifEnv* env, unsigned char* ptr, unsigned sz) { - struct readonly_check_t* obj = erts_alloc(ERTS_ALC_T_TMP, + ErtsAlcType_t allocator = is_proc_bound(env) ? ERTS_ALC_T_TMP : ERTS_ALC_T_NIF; + struct readonly_check_t* obj = erts_alloc(allocator, sizeof(struct readonly_check_t)); + obj->hdr.allocator = allocator; obj->hdr.next = env->tmp_obj_list; env->tmp_obj_list = &obj->hdr; obj->hdr.dtor = &readonly_check_dtor; @@ -1734,7 +1780,7 @@ static void readonly_check_dtor(struct enif_tmp_obj_t* o) " %x != %x\r\nABORTING\r\n", chksum, obj->checksum); abort(); } - erts_free(ERTS_ALC_T_TMP, obj); + erts_free(obj->hdr.allocator, obj); } static unsigned calc_checksum(unsigned char* ptr, unsigned size) { diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index d028567faf..fea527f954 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -32,9 +32,10 @@ ** 2.0: R14A ** 2.1: R14B02 "vm_variant" ** 2.2: R14B03 enif_is_exception +** 2.3: R15 enif_make_reverse_list */ #define ERL_NIF_MAJOR_VERSION 2 -#define ERL_NIF_MINOR_VERSION 2 +#define ERL_NIF_MINOR_VERSION 3 #include <stdlib.h> diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index c991b61abe..6396af09d0 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -136,6 +136,8 @@ ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_int64,(ErlNifEnv*, ErlNifSInt64)); ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_uint64,(ErlNifEnv*, ErlNifUInt64)); #endif ERL_NIF_API_FUNC_DECL(int,enif_is_exception,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(int,enif_make_reverse_list,(ErlNifEnv*, ERL_NIF_TERM term, ERL_NIF_TERM *list)); +ERL_NIF_API_FUNC_DECL(int,enif_is_number,(ErlNifEnv*, ERL_NIF_TERM term)); /* ** Add new entries here to keep compatibility on Windows!!! @@ -256,12 +258,207 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_exception,(ErlNifEnv*, ERL_NIF_TERM term)); #endif # define enif_is_exception ERL_NIF_API_FUNC_MACRO(enif_is_exception) +# define enif_make_reverse_list ERL_NIF_API_FUNC_MACRO(enif_make_reverse_list) +# define enif_is_number ERL_NIF_API_FUNC_MACRO(enif_is_number) /* ** Add new entries here */ #endif + +#if defined(__GNUC__) && !(defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) + +/* Inline functions for compile time type checking of arguments to + variadic functions. +*/ + +# define ERL_NIF_INLINE __inline__ + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple1(ErlNifEnv* env, + ERL_NIF_TERM e1) +{ + return enif_make_tuple(env, 1, e1); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple2(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2) +{ + return enif_make_tuple(env, 2, e1, e2); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple3(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3) +{ + return enif_make_tuple(env, 3, e1, e2, e3); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple4(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4) +{ + return enif_make_tuple(env, 4, e1, e2, e3, e4); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple5(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5) +{ + return enif_make_tuple(env, 5, e1, e2, e3, e4, e5); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple6(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6) +{ + return enif_make_tuple(env, 6, e1, e2, e3, e4, e5, e6); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple7(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7) +{ + return enif_make_tuple(env, 7, e1, e2, e3, e4, e5, e6, e7); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple8(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7, + ERL_NIF_TERM e8) +{ + return enif_make_tuple(env, 8, e1, e2, e3, e4, e5, e6, e7, e8); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple9(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7, + ERL_NIF_TERM e8, + ERL_NIF_TERM e9) +{ + return enif_make_tuple(env, 9, e1, e2, e3, e4, e5, e6, e7, e8, e9); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list1(ErlNifEnv* env, + ERL_NIF_TERM e1) +{ + return enif_make_list(env, 1, e1); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list2(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2) +{ + return enif_make_list(env, 2, e1, e2); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list3(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3) +{ + return enif_make_list(env, 3, e1, e2, e3); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list4(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4) +{ + return enif_make_list(env, 4, e1, e2, e3, e4); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list5(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5) +{ + return enif_make_list(env, 5, e1, e2, e3, e4, e5); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list6(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6) +{ + return enif_make_list(env, 6, e1, e2, e3, e4, e5, e6); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list7(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7) +{ + return enif_make_list(env, 7, e1, e2, e3, e4, e5, e6, e7); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list8(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7, + ERL_NIF_TERM e8) +{ + return enif_make_list(env, 8, e1, e2, e3, e4, e5, e6, e7, e8); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list9(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7, + ERL_NIF_TERM e8, + ERL_NIF_TERM e9) +{ + return enif_make_list(env, 9, e1, e2, e3, e4, e5, e6, e7, e8, e9); +} + +# undef ERL_NIF_INLINE + +#else /* fallback with macros */ + #ifndef enif_make_list1 # define enif_make_list1(ENV,E1) enif_make_list(ENV,1,E1) # define enif_make_list2(ENV,E1,E2) enif_make_list(ENV,2,E1,E2) @@ -281,6 +478,11 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_exception,(ErlNifEnv*, ERL_NIF_TERM term)); # define enif_make_tuple7(ENV,E1,E2,E3,E4,E5,E6,E7) enif_make_tuple(ENV,7,E1,E2,E3,E4,E5,E6,E7) # define enif_make_tuple8(ENV,E1,E2,E3,E4,E5,E6,E7,E8) enif_make_tuple(ENV,8,E1,E2,E3,E4,E5,E6,E7,E8) # define enif_make_tuple9(ENV,E1,E2,E3,E4,E5,E6,E7,E8,E9) enif_make_tuple(ENV,9,E1,E2,E3,E4,E5,E6,E7,E8,E9) +#endif + +#endif /* __GNUC__ && !WIN32 */ + +#ifndef enif_make_pid # define enif_make_pid(ENV, PID) ((const ERL_NIF_TERM)((PID)->pid)) diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 9db2e874c6..a3c1c9577b 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -3482,11 +3482,14 @@ erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online) erts_bits_init_state(&esdp->erl_bits_state); esdp->match_pseudo_process = NULL; esdp->free_process = NULL; -#if HALFWORD_HEAP - /* Registers need to be heap allocated (correct memory range) for tracing to work */ - esdp->save_reg = erts_alloc(ERTS_ALC_T_BEAM_REGISTER, ERTS_X_REGS_ALLOCATED * sizeof(Eterm)); -#endif #endif + esdp->x_reg_array = + erts_alloc_permanent_cache_aligned(ERTS_ALC_T_BEAM_REGISTER, + ERTS_X_REGS_ALLOCATED * + sizeof(Eterm)); + esdp->f_reg_array = + erts_alloc_permanent_cache_aligned(ERTS_ALC_T_BEAM_REGISTER, + MAX_REG * sizeof(FloatDef)); #if !HEAP_ON_C_STACK esdp->num_tmp_heap_used = 0; #endif diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 0c8204b4ce..4027fade35 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -433,19 +433,15 @@ typedef struct { } ErtsAuxWorkData; struct ErtsSchedulerData_ { - -#ifdef ERTS_SMP /* * Keep X registers first (so we get as many low * numbered registers as possible in the same cache * line). */ -#if !HALFWORD_HEAP - Eterm save_reg[ERTS_X_REGS_ALLOCATED]; /* X registers */ -#else - Eterm *save_reg; -#endif - FloatDef freg[MAX_REG]; /* Floating point registers. */ + Eterm* x_reg_array; /* X registers */ + FloatDef* f_reg_array; /* Floating point registers. */ + +#ifdef ERTS_SMP ethr_tid tid; /* Thread id */ struct erl_bits_state erl_bits_state; /* erl_bits.c state */ void *match_pseudo_process; /* erl_db_util.c:db_prog_match() */ diff --git a/erts/emulator/beam/erl_process_lock.c b/erts/emulator/beam/erl_process_lock.c index 83379d7352..b4d20480c5 100644 --- a/erts/emulator/beam/erl_process_lock.c +++ b/erts/emulator/beam/erl_process_lock.c @@ -669,7 +669,9 @@ proc_safelock(Process *a_proc, ErtsProcLocks b_need_locks) { Process *p1, *p2; +#ifdef ERTS_ENABLE_LOCK_CHECK Eterm pid1, pid2; +#endif erts_pix_lock_t *pix_lck1, *pix_lck2; ErtsProcLocks need_locks1, have_locks1, need_locks2, have_locks2; ErtsProcLocks unlock_mask; @@ -684,24 +686,32 @@ proc_safelock(Process *a_proc, if (a_proc) { if (a_proc->id < b_proc->id) { p1 = a_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid1 = a_proc->id; +#endif pix_lck1 = a_pix_lck; need_locks1 = a_need_locks; have_locks1 = a_have_locks; p2 = b_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid2 = b_proc->id; +#endif pix_lck2 = b_pix_lck; need_locks2 = b_need_locks; have_locks2 = b_have_locks; } else if (a_proc->id > b_proc->id) { p1 = b_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid1 = b_proc->id; +#endif pix_lck1 = b_pix_lck; need_locks1 = b_need_locks; have_locks1 = b_have_locks; p2 = a_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid2 = a_proc->id; +#endif pix_lck2 = a_pix_lck; need_locks2 = a_need_locks; have_locks2 = a_have_locks; @@ -710,12 +720,16 @@ proc_safelock(Process *a_proc, ERTS_LC_ASSERT(a_proc == b_proc); ERTS_LC_ASSERT(a_proc->id == b_proc->id); p1 = a_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid1 = a_proc->id; +#endif pix_lck1 = a_pix_lck; need_locks1 = a_need_locks | b_need_locks; have_locks1 = a_have_locks | b_have_locks; p2 = NULL; +#ifdef ERTS_ENABLE_LOCK_CHECK pid2 = 0; +#endif pix_lck2 = NULL; need_locks2 = 0; have_locks2 = 0; @@ -723,12 +737,16 @@ proc_safelock(Process *a_proc, } else { p1 = b_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid1 = b_proc->id; +#endif pix_lck1 = b_pix_lck; need_locks1 = b_need_locks; have_locks1 = b_have_locks; p2 = NULL; +#ifdef ERTS_ENABLE_LOCK_CHECK pid2 = 0; +#endif pix_lck2 = NULL; need_locks2 = 0; have_locks2 = 0; diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index 1d75fa313c..bc20b2d798 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -331,7 +331,13 @@ _ET_DECLARE_CHECKED(Uint,thing_subtag,Eterm) * we now use a non-zero bit-pattern in debug mode. */ #if ET_DEBUG -#define THE_NON_VALUE _make_header(0,_TAG_HEADER_FLOAT) +# ifdef HIPE + /* A very large (or negative) value as work-around for ugly hipe-bifs + that return untagged integers (eg hipe_bs_put_utf8) */ +# define THE_NON_VALUE _make_header((Uint)~0,_TAG_HEADER_FLOAT) +# else +# define THE_NON_VALUE _make_header(0,_TAG_HEADER_FLOAT) +# endif #else #define THE_NON_VALUE (0) #endif diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index ec99f76e53..b487dbf054 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -2094,8 +2094,7 @@ void save_calls(Process *p, Export *e) * entries instead of the original BIF functions. */ Eterm -erts_bif_trace(int bif_index, Process* p, - Eterm arg1, Eterm arg2, Eterm arg3, BeamInstr *I) +erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) { Eterm result; int meta = !!(erts_bif_trace_flags[bif_index] & BIF_TRACE_AS_META); @@ -2109,10 +2108,10 @@ erts_bif_trace(int bif_index, Process* p, * no tracing will occur. Doing the whole else branch will * also do nothing, only slower. */ - Eterm (*func)(Process*, Eterm, Eterm, Eterm, BeamInstr*) = bif_table[bif_index].f; - result = func(p, arg1, arg2, arg3, I); + Eterm (*func)(Process*, Eterm*, BeamInstr*) = bif_table[bif_index].f; + result = func(p, args, I); } else { - Eterm (*func)(Process*, Eterm, Eterm, Eterm, BeamInstr*); + Eterm (*func)(Process*, Eterm*, BeamInstr*); Export* ep = bif_export[bif_index]; Uint32 flags = 0, flags_meta = 0; int global = !!(erts_bif_trace_flags[bif_index] & BIF_TRACE_AS_GLOBAL); @@ -2124,8 +2123,6 @@ erts_bif_trace(int bif_index, Process* p, * export entry */ BeamInstr *cp = p->cp; - Eterm args[3] = {arg1, arg2, arg3}; - /* * Make continuation pointer OK, it is not during direct BIF calls, * but it is correct during apply of bif. @@ -2157,7 +2154,7 @@ erts_bif_trace(int bif_index, Process* p, func = bif_table[bif_index].f; - result = func(p, arg1, arg2, arg3, I); + result = func(p, args, I); if (applying && (flags & MATCH_SET_RETURN_TO_TRACE)) { BeamInstr i_return_trace = beam_return_trace[0]; diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c index 158eb361a4..fca785a4de 100644 --- a/erts/emulator/beam/erl_unicode.c +++ b/erts/emulator/beam/erl_unicode.c @@ -47,7 +47,7 @@ typedef struct _restart_context { static Uint max_loop_limit; -static BIF_RETTYPE utf8_to_list(BIF_ALIST_1); +static BIF_RETTYPE utf8_to_list(Process *p, Eterm arg1); static BIF_RETTYPE finalize_list_to_list(Process *p, byte *bytes, Eterm rest, @@ -348,12 +348,6 @@ static int copy_utf8_bin(byte *target, byte *source, Uint size, return copied; } - if (((*source) == 0xEF) && (source[1] == 0xBF) && - ((source[2] == 0xBE) || (source[2] == 0xBF))) { - *err_pos = source; - return copied; - } - *(target++) = *(source++); *(target++) = *(source++); *(target++) = *(source++); @@ -714,9 +708,8 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */ target[(*pos)++] = (((byte) (x & 0x3F)) | ((byte) 0x80)); } else if (x < 0x10000) { - if ((x >= 0xD800 && x <= 0xDFFF) || - (x == 0xFFFE) || - (x == 0xFFFF)) { /* Invalid unicode range */ + if (x >= 0xD800 && x <= 0xDFFF) { + /* Invalid unicode range */ *err = 1; goto done; } @@ -1230,10 +1223,6 @@ int erts_analyze_utf8(byte *source, Uint size, ((source[1] & 0x20) != 0)) { return ERTS_UTF8_ERROR; } - if (((*source) == 0xEF) && (source[1] == 0xBF) && - ((source[2] == 0xBE) || (source[2] == 0xBF))) { - return ERTS_UTF8_ERROR; - } source += 3; size -= 3; } else if (((*source) & ((byte) 0xF8)) == 0xF0) { @@ -1839,13 +1828,13 @@ static BIF_RETTYPE characters_to_list_trap_4(BIF_ALIST_1) * Instead of building an utf8 buffer, we analyze the binary given and use that. */ -static BIF_RETTYPE utf8_to_list(BIF_ALIST_1) +static BIF_RETTYPE utf8_to_list(Process* p, Eterm arg) { - if (!is_binary(BIF_ARG_1) || aligned_binary_size(BIF_ARG_1) < 0) { - BIF_ERROR(BIF_P,BADARG); + if (!is_binary(arg) || aligned_binary_size(arg) < 0) { + BIF_ERROR(p, BADARG); } - return do_bif_utf8_to_list(BIF_P, BIF_ARG_1, 0U, 0U, 0U, - ERTS_UTF8_ANALYZE_MORE,NIL); + return do_bif_utf8_to_list(p, arg, 0U, 0U, 0U, + ERTS_UTF8_ANALYZE_MORE, NIL); } @@ -2166,9 +2155,8 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */ } else if (x < 0x800) { need += 2; } else if (x < 0x10000) { - if ((x >= 0xD800 && x <= 0xDFFF) || - (x == 0xFFFE) || - (x == 0xFFFF)) { /* Invalid unicode range */ + if (x >= 0xD800 && x <= 0xDFFF) { + /* Invalid unicode range */ DESTROY_ESTACK(stack); return ((Sint) -1); } @@ -2314,9 +2302,7 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */ *p++ = (((byte) (x & 0x3F)) | ((byte) 0x80)); } else if (x < 0x10000) { - ASSERT(!((x >= 0xD800 && x <= 0xDFFF) || - (x == 0xFFFE) || - (x == 0xFFFF))); + ASSERT(!(x >= 0xD800 && x <= 0xDFFF)); *p++ = (((byte) (x >> 12)) | ((byte) 0xE0)); *p++ = ((((byte) (x >> 6)) & 0x3F) | diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index 0b07e894cf..5dc307e383 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -55,7 +55,7 @@ heap data on the C stack or if we use the buffers in the scheduler data. */ #define TMP_HEAP_SIZE 128 /* Number of Eterm in the schedulers small heap for transient heap data */ -#define CMP_TMP_HEAP_SIZE 2 /* cmp wants its own tmp-heap... */ +#define CMP_TMP_HEAP_SIZE 32 /* cmp wants its own tmp-heap... */ #define ERL_ARITH_TMP_HEAP_SIZE 4 /* as does erl_arith... */ #define BEAM_EMU_TMP_HEAP_SIZE 2 /* and beam_emu... */ diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 6953e7fe7d..80ce4b969c 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -988,16 +988,16 @@ BIF_RETTYPE erts_debug_dist_ext_to_term_2(BIF_ALIST_2) } -Eterm -term_to_binary_1(Process* p, Eterm Term) +BIF_RETTYPE term_to_binary_1(BIF_ALIST_1) { - return erts_term_to_binary(p, Term, 0, TERM_TO_BINARY_DFLAGS); + return erts_term_to_binary(BIF_P, BIF_ARG_1, 0, TERM_TO_BINARY_DFLAGS); } - -Eterm -term_to_binary_2(Process* p, Eterm Term, Eterm Flags) +BIF_RETTYPE term_to_binary_2(BIF_ALIST_2) { + Process* p = BIF_P; + Eterm Term = BIF_ARG_1; + Eterm Flags = BIF_ARG_2; int level = 0; Uint flags = TERM_TO_BINARY_DFLAGS; @@ -1256,8 +1256,11 @@ BIF_RETTYPE binary_to_term_2(BIF_ALIST_2) } Eterm -external_size_1(Process* p, Eterm Term) +external_size_1(BIF_ALIST_1) { + Process* p = BIF_P; + Eterm Term = BIF_ARG_1; + Uint size = erts_encode_ext_size(Term); if (IS_USMALL(0, size)) { BIF_RET(make_small(size)); @@ -1268,13 +1271,13 @@ external_size_1(Process* p, Eterm Term) } Eterm -external_size_2(Process* p, Eterm Term, Eterm Flags) +external_size_2(BIF_ALIST_2) { Uint size; Uint flags = TERM_TO_BINARY_DFLAGS; - while (is_list(Flags)) { - Eterm arg = CAR(list_val(Flags)); + while (is_list(BIF_ARG_2)) { + Eterm arg = CAR(list_val(BIF_ARG_2)); Eterm* tp; if (is_tuple(arg) && *(tp = tuple_val(arg)) == make_arityval(2)) { @@ -1293,19 +1296,19 @@ external_size_2(Process* p, Eterm Term, Eterm Flags) } } else { error: - BIF_ERROR(p, BADARG); + BIF_ERROR(BIF_P, BADARG); } - Flags = CDR(list_val(Flags)); + BIF_ARG_2 = CDR(list_val(BIF_ARG_2)); } - if (is_not_nil(Flags)) { + if (is_not_nil(BIF_ARG_2)) { goto error; } - size = erts_encode_ext_size_2(Term, flags); + size = erts_encode_ext_size_2(BIF_ARG_1, flags); if (IS_USMALL(0, size)) { BIF_RET(make_small(size)); } else { - Eterm* hp = HAlloc(p, BIG_UINT_HEAP_SIZE); + Eterm* hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE); BIF_RET(uint_to_big(size, hp)); } } diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index ba0b96870e..4a4973baab 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -37,6 +37,7 @@ #include "erl_process.h" #include "erl_sys_driver.h" #include "erl_debug.h" +#include "error.h" typedef struct port Port; #include "erl_port_task.h" @@ -845,18 +846,35 @@ void erts_queue_monitor_message(Process *, Eterm, Eterm); void erts_init_bif(void); +Eterm erl_send(Process *p, Eterm to, Eterm msg); + +/* erl_bif_op.c */ + +Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2); /* erl_bif_port.c */ /* erl_bif_trace.c */ +Eterm erl_seq_trace_info(Process *p, Eterm arg1); void erts_system_monitor_clear(Process *c_p); void erts_system_profile_clear(Process *c_p); /* beam_load.c */ +typedef struct { + BeamInstr* current; /* Pointer to: Mod, Name, Arity */ + Uint needed; /* Heap space needed for entire tuple */ + Uint32 loc; /* Location in source code */ + Eterm* fname_ptr; /* Pointer to fname table */ +} FunctionInfo; + int erts_load_module(Process *c_p, ErtsProcLocks c_p_locks, Eterm group_leader, Eterm* mod, byte* code, int size); void init_load(void); BeamInstr* find_function_from_pc(BeamInstr* pc); +Eterm* erts_build_mfa_item(FunctionInfo* fi, Eterm* hp, + Eterm args, Eterm* mfa_p); +void erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info); +void erts_set_current_function(FunctionInfo* fi, BeamInstr* current); Eterm erts_module_info_0(Process* p, Eterm module); Eterm erts_module_info_1(Process* p, Eterm module, Eterm what); Eterm erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info); @@ -1047,6 +1065,7 @@ void init_emulator(void); void process_main(void); Eterm build_stacktrace(Process* c_p, Eterm exc); Eterm expand_error_value(Process* c_p, Uint freason, Eterm Value); +void erts_save_stacktrace(Process* p, struct StackTrace* s, int depth); /* erl_init.c */ @@ -1068,6 +1087,7 @@ extern ErtsModifiedTimings erts_modified_timings[]; #define ERTS_MODIFIED_TIMING_INPUT_REDS \ (erts_modified_timings[erts_modified_timing_level].input_reds) +extern int erts_no_line_info; extern Eterm erts_error_logger_warnings; extern int erts_initialized; extern int erts_compat_rel; @@ -1621,8 +1641,7 @@ void monitor_generic(Process *p, Eterm type, Eterm spec); Uint erts_trace_flag2bit(Eterm flag); int erts_trace_flags(Eterm List, Uint *pMask, Eterm *pTracer, int *pCpuTimestamp); -Eterm erts_bif_trace(int bif_index, Process* p, - Eterm arg1, Eterm arg2, Eterm arg3, BeamInstr *I); +Eterm erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr *I); #ifdef ERTS_SMP void erts_send_pending_trace_msgs(ErtsSchedulerData *esdp); diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 304ce22ef2..fc53a88a3a 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -25,30 +25,12 @@ # instruction transformations; thus, they never occur in BEAM files. # -# Special instruction used to generate an error message when -# trying to load a module compiled by the V1 compiler (R5 & R6). -# (Specially treated in beam_load.c.) +# The too_old_compiler/0 instruction is specially handled in beam_load.c +# to produce a user-friendly message informing the user that the module +# needs to be re-compiled with a modern compiler. too_old_compiler/0 -too_old_compiler - -# -# Obsolete instruction usage follow. (Nowdays we use f with -# a zero label instead of p.) -# - -is_list p S => too_old_compiler -is_nonempty_list p R => too_old_compiler -is_nil p R => too_old_compiler - -is_tuple p S => too_old_compiler -test_arity p S Arity => too_old_compiler - -is_integer p R => too_old_compiler -is_float p R => too_old_compiler -is_atom p R => too_old_compiler - -is_eq_exact p S1 S2 => too_old_compiler +too_old_compiler | never() => # In R9C and earlier, the loader used to insert special instructions inside # the module_info/0,1 functions. (In R10B and later, the compiler inserts @@ -88,12 +70,42 @@ i_time_breakpoint i_return_time_trace i_return_to_trace i_yield -i_global_cons -i_global_tuple -i_global_copy return +# +# To ensure that a "move Src x(0)" instruction can be combined +# with the following call instruction, we need to make sure that +# there is no line/1 instruction between the move and the call. +# + +move S r | line Loc | call_ext Ar Func => \ + line Loc | move S r | call_ext Ar Func +move S r | line Loc | call_ext_last Ar Func=u$is_bif D => \ + line Loc | move S r | call_ext_last Ar Func D +move S r | line Loc | call_ext_only Ar Func=u$is_bif => \ + line Loc | move S r | call_ext_only Ar Func +move S r | line Loc | call Ar Func => \ + line Loc | move S r | call Ar Func + +# +# A tail-recursive call to an external function (non-BIF) will +# never be saved on the stack, so there is no reason to keep +# the line instruction. (The compiler did not remove the line +# instruction because it cannot tell the difference between +# BIFs and ordinary Erlang functions.) +# + +line Loc | call_ext_last Ar Func=u$is_not_bif D => \ + call_ext_last Ar Func D +line Loc | call_ext_only Ar Func=u$is_not_bif => \ + call_ext_only Ar Func + +line Loc | func_info M F A => func_info M F A | line Loc + +line I + + %macro: allocate Allocate -pack %macro: allocate_zero AllocateZero -pack %macro: allocate_heap AllocateHeap -pack @@ -277,8 +289,6 @@ raise s s badarg j system_limit j -move R R => - move C=cxy r | jump Lbl => move_jump Lbl C %macro: move_jump MoveJump -nonext @@ -585,8 +595,6 @@ get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst | original_reg Reg original_reg Reg Pos => -get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst - original_reg/2 extract_next_element D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \ @@ -837,11 +845,11 @@ call_ext_only u==3 u$func:erlang:apply/3 => i_apply_only # thus there is no need to generate any return instruction. # -call_ext_last u==1 Bif=u$bif:erlang:exit/1 D => call_bif1 Bif -call_ext_last u==1 Bif=u$bif:erlang:throw/1 D => call_bif1 Bif +call_ext_last u==1 Bif=u$bif:erlang:exit/1 D => call_bif Bif +call_ext_last u==1 Bif=u$bif:erlang:throw/1 D => call_bif Bif -call_ext_only u==1 Bif=u$bif:erlang:exit/1 => call_bif1 Bif -call_ext_only u==1 Bif=u$bif:erlang:throw/1 => call_bif1 Bif +call_ext_only u==1 Bif=u$bif:erlang:exit/1 => call_bif Bif +call_ext_only u==1 Bif=u$bif:erlang:throw/1 => call_bif Bif # # The error/1 and error/2 BIFs never execute the instruction following them; @@ -851,13 +859,13 @@ call_ext_only u==1 Bif=u$bif:erlang:throw/1 => call_bif1 Bif # the continuation pointer on the stack. # -call_ext_last u==1 Bif=u$bif:erlang:error/1 D => call_bif1 Bif -call_ext_last u==2 Bif=u$bif:erlang:error/2 D => call_bif2 Bif +call_ext_last u==1 Bif=u$bif:erlang:error/1 D => call_bif Bif +call_ext_last u==2 Bif=u$bif:erlang:error/2 D => call_bif Bif call_ext_only Ar=u==1 Bif=u$bif:erlang:error/1 => \ - allocate u Ar | call_bif1 Bif + allocate u Ar | call_bif Bif call_ext_only Ar=u==2 Bif=u$bif:erlang:error/2 => \ - allocate u Ar | call_bif2 Bif + allocate u Ar | call_bif Bif # # The yield/0 BIF is an instruction @@ -875,47 +883,18 @@ call_ext_last u==3 u$func:erlang:hibernate/3 D => i_hibernate call_ext_only u==3 u$func:erlang:hibernate/3 => i_hibernate # -# Hybrid memory architecture need special cons and tuple instructions -# that allocate on the message area. These looks like BIFs in the BEAM code. -# - -call_ext u==2 u$func:hybrid:cons/2 => i_global_cons -call_ext_last u==2 u$func:hybrid:cons/2 D => i_global_cons | deallocate_return D -call_ext_only Ar=u==2 u$func:hybrid:cons/2 => i_global_cons | return - -call_ext u==1 u$func:hybrid:tuple/1 => i_global_tuple -call_ext_last u==1 u$func:hybrid:tuple/1 D => i_global_tuple | deallocate_return D -call_ext_only Ar=u==1 u$func:hybrid:tuple/1 => i_global_tuple | return - -call_ext u==1 u$func:hybrid:copy/1 => i_global_copy -call_ext_last u==1 u$func:hybrid:copy/1 D => i_global_copy | deallocate_return D -call_ext_only u==1 Ar=u$func:hybrid:copy/1 => i_global_copy | return - -# # The general case for BIFs that have no special instructions. # A BIF used in the tail must be followed by a return instruction. # # To make trapping and stack backtraces work correctly, we make sure that # the continuation pointer is always stored on the stack. -call_ext u==0 Bif=u$is_bif => call_bif0 Bif -call_ext u==1 Bif=u$is_bif => call_bif1 Bif -call_ext u==2 Bif=u$is_bif => call_bif2 Bif -call_ext u==3 Bif=$is_bif => call_bif3 Bif +call_ext u Bif=u$is_bif => call_bif Bif -call_ext_last u==0 Bif=u$is_bif D => call_bif0 Bif | deallocate_return D -call_ext_last u==1 Bif=u$is_bif D => call_bif1 Bif | deallocate_return D -call_ext_last u==2 Bif=u$is_bif D => call_bif2 Bif | deallocate_return D -call_ext_last u==3 Bif=u$is_bif D => call_bif3 Bif | deallocate_return D +call_ext_last u Bif=u$is_bif D => call_bif Bif | deallocate_return D -call_ext_only Ar=u==0 Bif=u$is_bif => \ - allocate u Ar | call_bif0 Bif | deallocate_return u -call_ext_only Ar=u==1 Bif=u$is_bif => \ - allocate u Ar | call_bif1 Bif | deallocate_return u -call_ext_only Ar=u==2 Bif=u$is_bif => \ - allocate u Ar | call_bif2 Bif | deallocate_return u -call_ext_only Ar=u==3 Bif=u$is_bif => \ - allocate u Ar | call_bif3 Bif | deallocate_return u +call_ext_only Ar=u Bif=u$is_bif => \ + allocate u Ar | call_bif Bif | deallocate_return u # # Any remaining calls are calls to Erlang functions, not BIFs. @@ -928,9 +907,9 @@ move S=c r | call_ext Ar=u Func=u$is_not_bif => i_move_call_ext S r Func move S=c r | call_ext_last Ar=u Func=u$is_not_bif D => i_move_call_ext_last Func D S r move S=c r | call_ext_only Ar=u Func=u$is_not_bif => i_move_call_ext_only Func S r -call_ext Ar=u Func => i_call_ext Func -call_ext_last Ar=u Func D => i_call_ext_last Func D -call_ext_only Ar=u Func => i_call_ext_only Func +call_ext Ar Func => i_call_ext Func +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 @@ -942,10 +921,7 @@ i_apply_fun_only i_hibernate -call_bif0 e -call_bif1 e -call_bif2 e -call_bif3 e +call_bif e # # Calls to non-building and guard BIFs. @@ -964,7 +940,7 @@ bif1 p Bif S1 Dst => bif1_body Bif S1 Dst bif1_body Bif Literal=q Dst => move Literal x | bif1_body Bif x Dst bif2 p Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2_body Bif Dst -bif2 Fail=f Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst +bif2 Fail Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst i_get s d @@ -1047,8 +1023,8 @@ i_move_call_ext_only e c r # Fun calls. -call_fun Arity=u | deallocate D | return => i_call_fun_last Arity D -call_fun Arity=u => i_call_fun Arity +call_fun Arity | deallocate D | return => i_call_fun_last Arity D +call_fun Arity => i_call_fun Arity i_call_fun I i_call_fun_last I P @@ -1304,13 +1280,13 @@ i_bs_utf16_size s d bs_put_utf8 Fail=j Flags=u Literal=q => \ move Literal x | bs_put_utf8 Fail Flags x -bs_put_utf8 Fail=j u Src=s => i_bs_put_utf8 Fail Src +bs_put_utf8 Fail u Src=s => i_bs_put_utf8 Fail Src i_bs_put_utf8 j s bs_put_utf16 Fail=j Flags=u Literal=q => \ move Literal x | bs_put_utf16 Fail Flags x -bs_put_utf16 Fail=j Flags=u Src=s => i_bs_put_utf16 Fail Flags Src +bs_put_utf16 Fail Flags=u Src=s => i_bs_put_utf16 Fail Flags Src i_bs_put_utf16 j I s @@ -1475,34 +1451,13 @@ bif1 Fail u$bif:erlang:trunc/1 s d => too_old_compiler # # Guard BIFs. # -gc_bif1 Fail I Bif=u$bif:erlang:length/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:size/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:bit_size/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:byte_size/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:abs/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:float/1 Src Dst=d => \ +gc_bif1 Fail I Bif Src Dst => \ gen_guard_bif1(Fail, I, Bif, Src, Dst) -gc_bif1 Fail I Bif=u$bif:erlang:round/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:trunc/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif2 Fail I Bif=u$bif:erlang:binary_part/2 S1 S2 Dst=d => \ +gc_bif2 Fail I Bif S1 S2 Dst => \ gen_guard_bif2(Fail, I, Bif, S1, S2, Dst) -gc_bif3 Fail I Bif=u$bif:erlang:binary_part/3 S1 S2 S3 Dst=d => \ +gc_bif3 Fail I Bif S1 S2 S3 Dst => \ gen_guard_bif3(Fail, I, Bif, S1, S2, S3, Dst) i_gc_bif1 Fail Bif V=q Live D => move V x | i_gc_bif1 Fail Bif x Live D @@ -1520,6 +1475,15 @@ ii_gc_bif3/7 ii_gc_bif3 Fail Bif S1 S2 S3 Live D => move S1 x | i_fetch S2 S3 | i_gc_bif3 Fail Bif x Live D i_gc_bif3 j I s I d + +# +# The following instruction is specially handled in beam_load.c +# to produce a user-friendly message if an unsupported guard BIF is +# encountered. +# +unsupported_guard_bif/3 +unsupported_guard_bif A B C | never() => + # # R13B03 # diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index aa86f4590d..1bd178f280 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -2647,7 +2647,7 @@ tailrecur_ne: FloatDef f1, f2; Eterm big; #if HEAP_ON_C_STACK - Eterm big_buf[2]; /* If HEAP_ON_C_STACK */ + Eterm big_buf[32]; /* If HEAP_ON_C_STACK */ #else Eterm *big_buf = erts_get_scheduler_data()->cmp_tmp_heap; #endif @@ -2658,41 +2658,108 @@ tailrecur_ne: Eterm aw = a; Eterm bw = b; #endif +#define MAX_LOSSLESS_FLOAT ((double)((1LL << 53) - 2)) +#define MIN_LOSSLESS_FLOAT ((double)(((1LL << 53) - 2)*-1)) b_tag = tag_val_def(bw); switch(_NUMBER_CODE(a_tag, b_tag)) { case SMALL_BIG: - big = small_to_big(signed_val(a), big_buf); - j = big_comp(big, bw); + j = big_sign(bw) ? 1 : -1; + break; + case BIG_SMALL: + j = big_sign(aw) ? -1 : 1; break; case SMALL_FLOAT: - f1.fd = signed_val(a); GET_DOUBLE(bw, f2); - j = float_comp(f1.fd, f2.fd); - break; - case BIG_SMALL: - big = small_to_big(signed_val(b), big_buf); - j = big_comp(aw, big); + if (f2.fd < MAX_LOSSLESS_FLOAT && f2.fd > MIN_LOSSLESS_FLOAT) { + // Float is within the no loss limit + f1.fd = signed_val(aw); + j = float_comp(f1.fd, f2.fd); +#if ERTS_SIZEOF_ETERM == 8 + } else if (f2.fd > (double) (MAX_SMALL + 1)) { + // Float is a positive bignum, i.e. bigger + j = -1; + } else if (f2.fd < (double) (MIN_SMALL - 1)) { + // Float is a negative bignum, i.e. smaller + j = 1; + } else { // Float is a Sint but less precise + j = signed_val(aw) - (Sint) f2.fd; + } +#else + } else { + // If float is positive it is bigger than small + j = (f2.fd > 0.0) ? -1 : 1; + } +#endif // ERTS_SIZEOF_ETERM == 8 break; case BIG_FLOAT: - if (big_to_double(aw, &f1.fd) < 0) { - j = big_sign(a) ? -1 : 1; + GET_DOUBLE(bw, f2); + if ((f2.fd < (double) (MAX_SMALL + 1)) + && (f2.fd > (double) (MIN_SMALL - 1))) { + // Float is a Sint + j = big_sign(aw) ? -1 : 1; + } else if ((pow(2.0,(big_arity(aw)-1.0)*D_EXP)-1.0) > fabs(f2.fd)) { + // If bignum size shows that it is bigger than the abs float + j = big_sign(aw) ? -1 : 1; + } else if ((pow(2.0,(big_arity(aw))*D_EXP)-1.0) < fabs(f2.fd)) { + // If bignum size shows that it is smaller than the abs float + j = f2.fd < 0 ? 1 : -1; + } else if (f2.fd < MAX_LOSSLESS_FLOAT && f2.fd > MIN_LOSSLESS_FLOAT) { + // Float is within the no loss limit + if (big_to_double(aw, &f1.fd) < 0) { + j = big_sign(aw) ? -1 : 1; + } else { + j = float_comp(f1.fd, f2.fd); + } } else { - GET_DOUBLE(bw, f2); - j = float_comp(f1.fd, f2.fd); + big = double_to_big(f2.fd, big_buf); + j = big_comp(aw, big); } break; case FLOAT_SMALL: GET_DOUBLE(aw, f1); - f2.fd = signed_val(b); - j = float_comp(f1.fd, f2.fd); + if (f1.fd < MAX_LOSSLESS_FLOAT && f1.fd > MIN_LOSSLESS_FLOAT) { + // Float is within the no loss limit + f2.fd = signed_val(bw); + j = float_comp(f1.fd, f2.fd); +#if ERTS_SIZEOF_ETERM == 8 + } else if (f1.fd > (double) (MAX_SMALL + 1)) { + // Float is a positive bignum, i.e. bigger + j = 1; + } else if (f1.fd < (double) (MIN_SMALL - 1)) { + // Float is a negative bignum, i.e. smaller + j = -1; + } else { // Float is a Sint but less precise it + j = (Sint) f1.fd - signed_val(bw); + } +#else + } else { + // If float is positive it is bigger than small + j = (f1.fd > 0.0) ? 1 : -1; + } +#endif // ERTS_SIZEOF_ETERM == 8 break; case FLOAT_BIG: - if (big_to_double(bw, &f2.fd) < 0) { - j = big_sign(b) ? 1 : -1; + GET_DOUBLE(aw, f1); + if ((f1.fd < (double) (MAX_SMALL + 1)) + && (f1.fd > (double) (MIN_SMALL - 1))) { // Float is a Sint + j = big_sign(bw) ? 1 : -1; + } else if ((pow(2.0, (big_arity(bw) - 1.0) * D_EXP) - 1.0) > fabs(f1.fd)) { + // If bignum size shows that it is bigger than the abs float + j = big_sign(bw) ? 1 : -1; + } else if ((pow(2.0,(big_arity(bw))*D_EXP)-1.0) < fabs(f1.fd)) { + // If bignum size shows that it is smaller than the abs float + j = f1.fd < 0 ? -1 : 1; + } else if (f1.fd < MAX_LOSSLESS_FLOAT && f1.fd > MIN_LOSSLESS_FLOAT) { + // Float is within the no loss limit + if (big_to_double(bw, &f2.fd) < 0) { + j = big_sign(bw) ? 1 : -1; + } else { + j = float_comp(f1.fd, f2.fd); + } } else { - GET_DOUBLE(aw, f1); - j = float_comp(f1.fd, f2.fd); + big = double_to_big(f1.fd, big_buf); + j = big_comp(big, bw); } break; default: diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index f0ff3f54c5..52f1b5312b 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -69,6 +69,7 @@ #define FILE_RESP_EOF 8 #define FILE_RESP_FNAME 9 #define FILE_RESP_ALL_DATA 10 +#define FILE_RESP_LFNAME 11 /* Options */ @@ -184,6 +185,7 @@ static ErlDrvSysInfo sys_info; # define RESBUFSIZE BUFSIZ #endif +#define READDIR_CHUNKS (5) @@ -317,15 +319,16 @@ struct t_preadv { Sint64 offsets[1]; }; -#define READDIR_BUFSIZE (8*1024) -#if READDIR_BUFSIZE < (FILENAME_CHARSIZE*2*(MAXPATHLEN+1)) +#define READDIR_BUFSIZE (8*1024)*READDIR_CHUNKS +#if READDIR_BUFSIZE < (1 + (2 + MAXPATHLEN)*FILENAME_CHARSIZE*READDIR_CHUNKS) # undef READDIR_BUFSIZE -# define READDIR_BUFSIZE (FILENAME_CHARSIZE*2*(MAXPATHLEN+1)) +# define READDIR_BUFSIZE (1 + (2 + MAXPATHLEN)*FILENAME_CHARSIZE*READDIR_CHUNKS) #endif struct t_readdir_buf { - struct t_readdir_buf *next; - char buf[READDIR_BUFSIZE]; + struct t_readdir_buf *next; + size_t n; + char buf[READDIR_BUFSIZE]; }; struct t_data @@ -1598,54 +1601,46 @@ static void invoke_lseek(void *data) static void invoke_readdir(void *data) { struct t_data *d = (struct t_data *) data; - int s; char *p = NULL; - int buf_sz = 0; - size_t tmp_bs; + size_t file_bs; + size_t n = 0, total = 0; + struct t_readdir_buf *b = NULL; + int res = 0; d->again = 0; d->errInfo.posix_errno = 0; - while (1) { - char *str; - if (buf_sz < (4 /* sz */ + 1 /* cmd */ + - FILENAME_CHARSIZE*(MAXPATHLEN + 1))) { - struct t_readdir_buf *b; - if (p) { - put_int32(0, p); /* EOB */ - } - b = EF_SAFE_ALLOC(sizeof(struct t_readdir_buf)); - b->next = NULL; - if (d->c.read_dir.last_buf) - d->c.read_dir.last_buf->next = b; - else - d->c.read_dir.first_buf = b; - d->c.read_dir.last_buf = b; - p = &b->buf[0]; - buf_sz = READDIR_BUFSIZE - 4/* EOB */; - } - - p[4] = FILE_RESP_FNAME; - buf_sz -= 4 + 1; - str = p + 4 + 1; - ASSERT(buf_sz >= MAXPATHLEN + 1); - tmp_bs = buf_sz; - s = efile_readdir(&d->errInfo, d->b, &d->dir_handle, str, &tmp_bs); - - if (s) { - put_int32(tmp_bs + 1 /* 1 byte for opcode */, p); - p += 4 + tmp_bs + 1; - ASSERT(p == (str + tmp_bs)); - buf_sz -= tmp_bs; - } - else { - put_int32(1, p); - p += 4 + 1; - put_int32(0, p); /* EOB */ - d->result_ok = (d->errInfo.posix_errno == 0); - break; + do { + total = READDIR_BUFSIZE; + n = 1; + b = EF_SAFE_ALLOC(sizeof(struct t_readdir_buf)); + b->next = NULL; + + if (d->c.read_dir.last_buf) { + d->c.read_dir.last_buf->next = b; + } else { + d->c.read_dir.first_buf = b; } - } + d->c.read_dir.last_buf = b; + + p = &b->buf[0]; + p[0] = FILE_RESP_LFNAME; + file_bs = READDIR_BUFSIZE - n; + + do { + res = efile_readdir(&d->errInfo, d->b, &d->dir_handle, p + n + 2, &file_bs); + + if (res) { + put_int16((Uint16)file_bs, p + n); + n += 2 + file_bs; + file_bs = READDIR_BUFSIZE - n; + } + } while( res && ((total - n - 2) >= MAXPATHLEN*FILENAME_CHARSIZE)); + + b->n = n; + } while(res); + + d->result_ok = (d->errInfo.posix_errno == 0); } static void invoke_open(void *data) @@ -2053,30 +2048,24 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data) free_data(data); break; case FILE_READDIR: - if (!d->result_ok) + if (!d->result_ok) { reply_error(desc, &d->errInfo); - else { + } else { struct t_readdir_buf *b1 = d->c.read_dir.first_buf; + char op = FILE_RESP_LFNAME; + TRACE_C('R'); ASSERT(b1); + while (b1) { struct t_readdir_buf *b2 = b1; char *p = &b1->buf[0]; - int sz = get_int32(p); - while (sz) { /* 0 == EOB */ - p += 4; - if (sz - 1 > 0) { - driver_output2(desc->port, p, 1, p+1, sz-1); - } else { - driver_output2(desc->port, p, 1, NULL, 0); - } - p += sz; - sz = get_int32(p); - } + driver_output2(desc->port, p, 1, p + 1, b1->n - 1); b1 = b1->next; EF_FREE(b2); } - + driver_output2(desc->port, &op, 1, NULL, 0); + d->c.read_dir.first_buf = NULL; d->c.read_dir.last_buf = NULL; } @@ -2126,6 +2115,7 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data) cq_execute(desc); } + /********************************************************************* * Driver entry point -> output */ @@ -2246,19 +2236,46 @@ file_output(ErlDrvData e, char* buf, int count) #endif { size_t resbufsize; - char resbuf[RESBUFSIZE+1]; + size_t n = 0, total = 0; + int res = 0; + char resbuf[READDIR_BUFSIZE]; + EFILE_DIR_HANDLE dir_handle; /* Handle to open directory. */ + total = READDIR_BUFSIZE; errInfo.posix_errno = 0; - dir_handle = NULL; - resbuf[0] = FILE_RESP_FNAME; - resbufsize = RESBUFSIZE; - - while (efile_readdir(&errInfo, name, &dir_handle, - resbuf+1, &resbufsize)) { - driver_output2(desc->port, resbuf, 1, resbuf+1, resbufsize); - resbufsize = RESBUFSIZE; - } + dir_handle = NULL; + resbuf[0] = FILE_RESP_LFNAME; + + /* Fill the buffer with multiple directory listings before sending it to the + * receiving process. READDIR_CHUNKS is minimum number of files sent to the + * receiver. + * Format for each driver_output2: + * ------------------------------------ + * | Type | Len | Filename | ... + * | 1 byte | 2 bytes | Len bytes | ... + * ------------------------------------ + */ + + do { + n = 1; + resbufsize = READDIR_BUFSIZE - n; + + do { + res = efile_readdir(&errInfo, name, &dir_handle, resbuf + n + 2, &resbufsize); + + if (res) { + put_int16((Uint16)resbufsize, resbuf + n); + n += 2 + resbufsize; + resbufsize = READDIR_BUFSIZE - n; + } + } while( res && ((total - n - 2) >= MAXPATHLEN*FILENAME_CHARSIZE)); + + if (n > 1) { + driver_output2(desc->port, resbuf, 1, resbuf + 1, n - 1); + } + } while(res); + if (errInfo.posix_errno != 0) { reply_error(desc, &errInfo); return; @@ -2476,13 +2493,20 @@ file_flush(ErlDrvData e) { static int file_control(ErlDrvData e, unsigned int command, char* buf, int len, char **rbuf, int rlen) { + /* + * warning: variable ‘desc’ set but not used + * [-Wunused-but-set-variable] + * ... no kidding ... + * + * file_descriptor *desc = (file_descriptor *)e; switch (command) { default: return 0; - } /* switch (command) */ + } ASSERT(0); - desc = NULL; /* XXX Avoid warning while empty switch */ + desc = NULL; + */ return 0; } diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 43114c6039..426917bd2c 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -9307,7 +9307,7 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event) goto done; } } -#endif /* SOCKOPT_CONNECT_STAT */ +#endif /* SO_ERROR */ #endif /* !__WIN32__ */ desc->inet.state = TCP_STATE_CONNECTED; @@ -10112,7 +10112,7 @@ static int packet_inet_output(udp_descriptor* udesc, HANDLE event) goto done; } } -#endif /* SOCKOPT_CONNECT_STAT */ +#endif /* SO_ERROR */ #endif /* !__WIN32__ */ desc->state = PACKET_STATE_CONNECTED; diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c index d782b044a9..45d39a559f 100644 --- a/erts/emulator/drivers/unix/ttsl_drv.c +++ b/erts/emulator/drivers/unix/ttsl_drv.c @@ -242,7 +242,7 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf) #ifndef HAVE_TERMCAP return ERL_DRV_ERROR_GENERAL; #else - char *s, *t, c, *l; + char *s, *t, *l; int canon, echo, sig; /* Terminal characteristics */ int flag; extern int using_oldshell; /* set this to let the rest of erts know */ @@ -262,7 +262,6 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf) s++; /* Find end of this argument (start of next) and insert NUL. */ if ((t = strchr(s, ' '))) { - c = *t; *t = '\0'; } if ((flag = ((*s == '+') ? 1 : ((*s == '-') ? -1 : 0)))) { diff --git a/erts/emulator/drivers/win32/win_efile.c b/erts/emulator/drivers/win32/win_efile.c index 931bb196f1..931bb196f1 100755..100644 --- a/erts/emulator/drivers/win32/win_efile.c +++ b/erts/emulator/drivers/win32/win_efile.c diff --git a/erts/emulator/hipe/hipe_abi.txt b/erts/emulator/hipe/hipe_abi.txt index d0ec162342..9d4726de9d 100644 --- a/erts/emulator/hipe/hipe_abi.txt +++ b/erts/emulator/hipe/hipe_abi.txt @@ -62,7 +62,7 @@ exceptional condition, it puts an error code in p->freason and returns THE_NON_VALUE (zero, except in debug mode). If p->freason == TRAP, then the BIF redirects its call to some -other function, given by p->def_arg_reg[]. +other function, given by p->i The BIF and the new callee may have different arities. The "hipe_${ARCH}_bifs.m4" macro files take care of these issues diff --git a/erts/emulator/hipe/hipe_amd64_bifs.m4 b/erts/emulator/hipe/hipe_amd64_bifs.m4 index 0ba763cbea..97a8267647 100644 --- a/erts/emulator/hipe/hipe_amd64_bifs.m4 +++ b/erts/emulator/hipe/hipe_amd64_bifs.m4 @@ -20,24 +20,37 @@ changecom(`/*', `*/')dnl include(`hipe/hipe_amd64_asm.m4') +#`include' "config.h" #`include' "hipe_literals.h" + `#if THE_NON_VALUE == 0 #define TEST_GOT_EXN testq %rax, %rax #else #define TEST_GOT_EXN cmpq $THE_NON_VALUE, %rax #endif' -`#define TEST_GOT_MBUF movq P_MBUF(P), %rdx; testq %rdx, %rdx; jnz 3f; 2: -#define JOIN3(A,B,C) A##B##C -#define HANDLE_GOT_MBUF(ARITY) 3: call JOIN3(nbif_,ARITY,_gc_after_bif); jmp 2b' +define(TEST_GOT_MBUF,`movq P_MBUF(P), %rdx # `TEST_GOT_MBUF' + testq %rdx, %rdx + jnz 3f +2:') +define(HANDLE_GOT_MBUF,` +3: call nbif_$1_gc_after_bif # `HANDLE_GOT_MBUF' + jmp 2b') + +`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) +# define CALL_BIF(F) movq $CSYM(F), P_BIF_CALLEE(P); call CSYM(hipe_debug_bif_wrapper) +#else +# define CALL_BIF(F) call CSYM(F) +#endif' /* * standard_bif_interface_1(nbif_name, cbif_name) * standard_bif_interface_2(nbif_name, cbif_name) * standard_bif_interface_3(nbif_name, cbif_name) + * standard_bif_interface_0(nbif_name, cbif_name) * - * Generate native interface for a BIF with 1-3 parameters and + * Generate native interface for a BIF with 0-3 parameters and * standard failure mode. */ define(standard_bif_interface_1, @@ -54,7 +67,11 @@ ASYM($1): /* make the call on the C stack */ SWITCH_ERLANG_TO_C - call CSYM($2) + pushq %rsi + movq %rsp, %rsi /* Eterm* BIF__ARGS */ + sub $(8), %rsp /* stack frame 16-byte alignment */ + CALL_BIF($2) + add $(1*8 + 8), %rsp TEST_GOT_MBUF SWITCH_C_TO_ERLANG @@ -82,7 +99,11 @@ ASYM($1): /* make the call on the C stack */ SWITCH_ERLANG_TO_C - call CSYM($2) + pushq %rdx + pushq %rsi + movq %rsp, %rsi /* Eterm* BIF__ARGS */ + CALL_BIF($2) + add $(2*8), %rsp TEST_GOT_MBUF SWITCH_C_TO_ERLANG @@ -111,7 +132,13 @@ ASYM($1): /* make the call on the C stack */ SWITCH_ERLANG_TO_C - call CSYM($2) + pushq %rcx + pushq %rdx + pushq %rsi + movq %rsp, %rsi /* Eterm* BIF__ARGS */ + sub $(8), %rsp /* stack frame 16-byte alignment */ + CALL_BIF($2) + add $(3*8 + 8), %rsp TEST_GOT_MBUF SWITCH_C_TO_ERLANG @@ -124,13 +151,7 @@ ASYM($1): TYPE_FUNCTION(ASYM($1)) #endif') -/* - * fail_bif_interface_0(nbif_name, cbif_name) - * - * Generate native interface for a BIF with 0 parameters and - * standard failure mode. - */ -define(fail_bif_interface_0, +define(standard_bif_interface_0, ` #ifndef HAVE_$1 #`define' HAVE_$1 @@ -143,7 +164,7 @@ ASYM($1): /* make the call on the C stack */ SWITCH_ERLANG_TO_C - call CSYM($2) + CALL_BIF($2) TEST_GOT_MBUF SWITCH_C_TO_ERLANG diff --git a/erts/emulator/hipe/hipe_arm_bifs.m4 b/erts/emulator/hipe/hipe_arm_bifs.m4 index 3664fb6502..e0c6f09796 100644 --- a/erts/emulator/hipe/hipe_arm_bifs.m4 +++ b/erts/emulator/hipe/hipe_arm_bifs.m4 @@ -20,18 +20,27 @@ changecom(`/*', `*/')dnl include(`hipe/hipe_arm_asm.m4') +#`include' "config.h" #`include' "hipe_literals.h" .text .p2align 2 -`#define JOIN3(A,B,C) A##B##C -#define TEST_GOT_MBUF(ARITY) ldr r1, [P, #P_MBUF]; cmp r1, #0; blne JOIN3(nbif_,ARITY,_gc_after_bif)' +`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) +# define CALL_BIF(F) mov r14, #F; str r14, [r0, #P_BIF_CALLEE]; bl hipe_debug_bif_wrapper +#else +# define CALL_BIF(F) bl F +#endif' + +define(TEST_GOT_MBUF,`ldr r1, [P, #P_MBUF] /* `TEST_GOT_MBUF' */ + cmp r1, #0 + blne nbif_$1_gc_after_bif') /* * standard_bif_interface_1(nbif_name, cbif_name) * standard_bif_interface_2(nbif_name, cbif_name) * standard_bif_interface_3(nbif_name, cbif_name) + * standard_bif_interface_0(nbif_name, cbif_name) * * Generate native interface for a BIF with 1-3 parameters and * standard failure mode. @@ -48,7 +57,9 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - bl $2 + str r1, [r0, #P_ARG0] /* Store BIF__ARGS in def_arg_reg[] */ + add r1, r0, #P_ARG0 + CALL_BIF($2) TEST_GOT_MBUF(1) /* Restore registers. Check for exception. */ @@ -73,7 +84,10 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - bl $2 + str r1, [r0, #P_ARG0] /* Store BIF__ARGS in def_arg_reg[] */ + str r2, [r0, #P_ARG1] + add r1, r0, #P_ARG0 + CALL_BIF($2) TEST_GOT_MBUF(2) /* Restore registers. Check for exception. */ @@ -99,7 +113,11 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - bl $2 + str r1, [r0, #P_ARG0] /* Store BIF__ARGS in def_arg_reg[] */ + str r2, [r0, #P_ARG1] + str r3, [r0, #P_ARG2] + add r1, r0, #P_ARG0 + CALL_BIF($2) TEST_GOT_MBUF(3) /* Restore registers. Check for exception. */ @@ -111,13 +129,7 @@ $1: .type $1, %function #endif') -/* - * fail_bif_interface_0(nbif_name, cbif_name) - * - * Generate native interface for a BIF with 0 parameters and - * standard failure mode. - */ -define(fail_bif_interface_0, +define(standard_bif_interface_0, ` #ifndef HAVE_$1 #`define' HAVE_$1 @@ -128,7 +140,8 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - bl $2 + /* ignore empty BIF__ARGS */ + CALL_BIF($2) TEST_GOT_MBUF(0) /* Restore registers. Check for exception. */ diff --git a/erts/emulator/hipe/hipe_bif0.h b/erts/emulator/hipe/hipe_bif0.h index f02e8862dc..c512d66f9d 100644 --- a/erts/emulator/hipe/hipe_bif0.h +++ b/erts/emulator/hipe/hipe_bif0.h @@ -29,7 +29,7 @@ extern Uint *hipe_bifs_find_pc_from_mfa(Eterm mfa); extern void hipe_mfa_info_table_init(void); extern void *hipe_get_remote_na(Eterm m, Eterm f, unsigned int a); -extern Eterm hipe_find_na_or_make_stub(Process*, Eterm, Eterm, Eterm); +extern BIF_RETTYPE hipe_find_na_or_make_stub(BIF_ALIST_3); extern int hipe_find_mfa_from_ra(const void *ra, Eterm *m, Eterm *f, unsigned int *a); #if defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) || defined(__arm__) extern void *hipe_mfa_get_trampoline(Eterm m, Eterm f, unsigned int a); diff --git a/erts/emulator/hipe/hipe_bif2.c b/erts/emulator/hipe/hipe_bif2.c index 2660f74a82..ee97541e15 100644 --- a/erts/emulator/hipe/hipe_bif2.c +++ b/erts/emulator/hipe/hipe_bif2.c @@ -166,3 +166,26 @@ BIF_RETTYPE hipe_bifs_show_message_area_0(BIF_ALIST_0) BIF_RET(am_false); #endif } + +#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) + +BIF_RETTYPE hipe_debug_bif_wrapper(BIF_ALIST_1); + +# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) \ + if ((P)) erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN) +# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) \ + if ((P)) erts_proc_lc_unrequire_lock((P), ERTS_PROC_LOCK_MAIN) + +BIF_RETTYPE hipe_debug_bif_wrapper(BIF_ALIST_1) +{ + typedef BIF_RETTYPE Bif(BIF_ALIST_1); + Bif* fp = (Bif*) (BIF_P->hipe.bif_callee); + BIF_RETTYPE res; + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(BIF_P); + res = (*fp)(BIF_P, BIF__ARGS); + ERTS_SMP_REQ_PROC_MAIN_LOCK(BIF_P); + return res; +} + +#endif /* ERTS_ENABLE_LOCK_CHECK && ERTS_SMP */ + diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4 index 9780437847..48c7c1bc9b 100644 --- a/erts/emulator/hipe/hipe_bif_list.m4 +++ b/erts/emulator/hipe/hipe_bif_list.m4 @@ -70,24 +70,18 @@ ****************************************************************/ /* + * standard_bif_interface_0(nbif_name, cbif_name) * standard_bif_interface_1(nbif_name, cbif_name) * standard_bif_interface_2(nbif_name, cbif_name) * standard_bif_interface_3(nbif_name, cbif_name) * - * A BIF with implicit P parameter, 1-3 ordinary parameters, + * A BIF with implicit P parameter, 0-3 ordinary parameters, * which may fail. * HP and FCALLS may be read and updated. * HP_LIMIT, NSP, NSP_LIMIT, and NRA may not be accessed. */ /* - * fail_bif_interface_0(nbif_name, cbif_name) - * - * A zero-arity BIF which may fail, otherwise - * identical to standard_bif_interface_N. - */ - -/* * nofail_primop_interface_0(nbif_name, cbif_name) * nofail_primop_interface_1(nbif_name, cbif_name) * nofail_primop_interface_2(nbif_name, cbif_name) @@ -150,7 +144,7 @@ /* * Zero-arity BIFs that can fail. */ -fail_bif_interface_0(nbif_processes_0, processes_0) +standard_bif_interface_0(nbif_processes_0, processes_0) /* * BIFs and primops that may do a GC (change heap limit and walk the native stack). @@ -175,10 +169,10 @@ gc_bif_interface_0(nbif_hipe_bifs_nstack_used_size_0, hipe_bifs_nstack_used_size /* * Arithmetic operators called indirectly by the HiPE compiler. */ -standard_bif_interface_2(nbif_add_2, erts_mixed_plus) -standard_bif_interface_2(nbif_sub_2, erts_mixed_minus) -standard_bif_interface_2(nbif_mul_2, erts_mixed_times) -standard_bif_interface_2(nbif_div_2, erts_mixed_div) +standard_bif_interface_2(nbif_add_2, splus_2) +standard_bif_interface_2(nbif_sub_2, sminus_2) +standard_bif_interface_2(nbif_mul_2, stimes_2) +standard_bif_interface_2(nbif_div_2, div_2) standard_bif_interface_2(nbif_intdiv_2, intdiv_2) standard_bif_interface_2(nbif_rem_2, rem_2) standard_bif_interface_2(nbif_bsl_2, bsl_2) @@ -260,11 +254,6 @@ noproc_primop_interface_1(nbif_atomic_inc, hipe_atomic_inc) ',)dnl /* - * Implement standard_bif_interface_0 as nofail_primop_interface_0. - */ -define(standard_bif_interface_0,`nofail_primop_interface_0($1, $2)') - -/* * Standard BIFs. * BIF_LIST(ModuleAtom,FunctionAtom,Arity,CFun,Index) */ diff --git a/erts/emulator/hipe/hipe_mkliterals.c b/erts/emulator/hipe/hipe_mkliterals.c index bced90785d..61e15f1d58 100644 --- a/erts/emulator/hipe/hipe_mkliterals.c +++ b/erts/emulator/hipe/hipe_mkliterals.c @@ -1,9 +1,8 @@ /* * %CopyrightBegin% - - * + * * Copyright Ericsson AB 2001-2011. All Rights Reserved. - * + * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in * compliance with the License. You should have received a copy of the @@ -212,6 +211,11 @@ static const unsigned int CRCTABLE[256] = { 0xB40BBE37, 0xC30C8EA1, 0x5A05DF1B, 0x2D02EF8D, }; +/* For hipe cross compiler. Hard code all values. + No calls by hipe compiler to query the running emulator. +*/ +static int is_xcomp = 0; + /* * The algorithm for calculating the 32 bit CRC checksum is based upon * documentation and algorithms provided by Dr. Ross N. Williams in the @@ -243,7 +247,7 @@ crc_update_buf(unsigned int crc_value, } static unsigned int -crc_update_int(unsigned int crc_value, const unsigned int *p) +crc_update_int(unsigned int crc_value, const int *p) { return crc_update_buf(crc_value, p, sizeof *p); } @@ -256,7 +260,7 @@ crc_update_int(unsigned int crc_value, const unsigned int *p) */ static const struct literal { const char *name; - unsigned int value; + int value; } literals[] = { /* Field offsets in a process struct */ { "P_HP", offsetof(struct process, htop) }, @@ -289,6 +293,9 @@ static const struct literal { { "P_NRA", offsetof(struct process, hipe.nra) }, #endif { "P_NARITY", offsetof(struct process, hipe.narity) }, +# if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) + { "P_BIF_CALLEE", offsetof(struct process, hipe.bif_callee) }, +# endif #endif /* HIPE */ /* process flags bits */ @@ -298,7 +305,7 @@ static const struct literal { { "FREASON_TRAP", TRAP }, /* special Erlang constants */ - { "THE_NON_VALUE", THE_NON_VALUE }, + { "THE_NON_VALUE", (int)THE_NON_VALUE }, /* funs */ #ifdef HIPE @@ -452,7 +459,7 @@ static const struct rts_param { unsigned int nr; const char *name; unsigned int is_defined; - unsigned int value; + int value; } rts_params[] = { { 1, "P_OFF_HEAP_FUNS", #if !defined(HYBRID) @@ -528,12 +535,12 @@ static void compute_crc(void) static void c_define_literal(FILE *fp, const struct literal *literal) { - fprintf(fp, "#define %s %u\n", literal->name, literal->value); + fprintf(fp, "#define %s %d\n", literal->name, literal->value); } static void e_define_literal(FILE *fp, const struct literal *literal) { - fprintf(fp, "-define(%s, %u).\n", literal->name, literal->value); + fprintf(fp, "-define(%s, %d).\n", literal->name, literal->value); } static void print_literals(FILE *fp, void (*print_literal)(FILE*, const struct literal*)) @@ -560,7 +567,7 @@ static void print_atom_literals(FILE *fp, void (*print_atom_literal)(FILE*, cons static void c_define_param(FILE *fp, const struct rts_param *param) { if (param->is_defined) - fprintf(fp, "#define %s %u\n", param->name, param->value); + fprintf(fp, "#define %s %d\n", param->name, param->value); } static void c_case_param(FILE *fp, const struct rts_param *param) @@ -568,7 +575,7 @@ static void c_case_param(FILE *fp, const struct rts_param *param) fprintf(fp, " \\\n"); fprintf(fp, "\tcase %u: ", param->nr); if (param->is_defined) - fprintf(fp, "value = %u", param->value); + fprintf(fp, "value = %d", param->value); else fprintf(fp, "is_defined = 0"); fprintf(fp, "; break;"); @@ -576,7 +583,15 @@ static void c_case_param(FILE *fp, const struct rts_param *param) static void e_define_param(FILE *fp, const struct rts_param *param) { - fprintf(fp, "-define(%s, hipe_bifs:get_rts_param(%u)).\n", param->name, param->nr); + if (is_xcomp) { + if (param->is_defined) + fprintf(fp, "-define(%s, %d).\n", param->name, param->value); + else + fprintf(fp, "-define(%s, []).\n", param->name); + } + else { + fprintf(fp, "-define(%s, hipe_bifs:get_rts_param(%u)).\n", param->name, param->nr); + } } static void print_params(FILE *fp, void (*print_param)(FILE*,const struct rts_param*)) @@ -613,19 +628,40 @@ static int do_e(FILE *fp, const char* this_exe) fprintf(fp, "\n"); print_params(fp, e_define_param); fprintf(fp, "\n"); - fprintf(fp, "-define(HIPE_SYSTEM_CRC, hipe_bifs:system_crc(%u)).\n", literals_crc); + if (is_xcomp) { + fprintf(fp, "-define(HIPE_SYSTEM_CRC, %u).\n", system_crc); + } + else { + fprintf(fp, "-define(HIPE_SYSTEM_CRC, hipe_bifs:system_crc(%u)).\n", + literals_crc); + } return 0; } int main(int argc, const char **argv) { + int i; + int (*do_func_ptr)(FILE *, const char*) = NULL; + compute_crc(); - if (argc == 2) { - if (strcmp(argv[1], "-c") == 0) - return do_c(stdout, argv[0]); - if (strcmp(argv[1], "-e") == 0) - return do_e(stdout, argv[0]); + for (i = 1; i < argc; i++) { + if (strcmp(argv[i], "-c") == 0) + do_func_ptr = &do_c; + else if (strcmp(argv[i], "-e") == 0) + do_func_ptr = &do_e; + else if (strcmp(argv[i], "-x") == 0) + is_xcomp = 1; + else + goto error; + } + if (do_func_ptr) { + return do_func_ptr(stdout, argv[0]); } - fprintf(stderr, "usage: %s [-c | -e] > output-file\n", argv[0]); +error: + fprintf(stderr, "usage: %s [-x] [-c | -e] > output-file\n" + "\t-c\tC header file\n" + "\t-e\tErlang header file\n" + "\t-x\tCross compile. No dependencies to compiling emulator\n", + argv[0]); return 1; } diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c index e3e8367b62..4d75883fc5 100644 --- a/erts/emulator/hipe/hipe_mode_switch.c +++ b/erts/emulator/hipe/hipe_mode_switch.c @@ -35,6 +35,17 @@ #include "hipe_stack.h" #include "hipe_bif0.h" /* hipe_mfa_info_table_init() */ +#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) +# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) \ + if ((P)) erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN) +# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) \ + if ((P)) erts_proc_lc_unrequire_lock((P), ERTS_PROC_LOCK_MAIN) +#else +# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) +# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) +#endif + + /* * Internal debug support. * #define HIPE_DEBUG to the desired debug level: @@ -318,8 +329,8 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) * Native code called a BIF, which "failed" with a TRAP to BEAM. * Prior to returning, the BIF stored (see BIF_TRAP<N>): - * the callee's address in p->def_arg_reg[3] - * the callee's parameters in p->def_arg_reg[0..2] + * the callee's address in p->i + * the callee's parameters in reg[0..2] * the callee's arity in p->arity (for BEAM gc purposes) * * We need to remove the BIF's parameters from the native @@ -331,19 +342,8 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) */ unsigned int i, is_recursive = 0; - /* Save p->arity, then update it with the original BIF's arity. - Get rid of any stacked parameters in that call. */ - /* XXX: hipe_call_from_native_is_recursive() copies data to - reg[], which is useless in the TRAP case. Maybe write a - specialised hipe_trap_from_native_is_recursive() later. */ if (p->hipe.nsp != NULL) { - unsigned int callee_arity; - callee_arity = p->arity; - p->arity = p->hipe.narity; /* caller's arity */ - is_recursive = hipe_call_from_native_is_recursive(p, reg); - - p->i = (Eterm *)(p->def_arg_reg[3]); - p->arity = callee_arity; + is_recursive = hipe_trap_from_native_is_recursive(p); } /* Schedule next process if current process was hibernated or is waiting @@ -353,15 +353,14 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) goto do_schedule; } if (p->status == P_WAITING) { + for (i = 0; i < p->arity; ++i) + p->arg_reg[i] = reg[i]; goto do_schedule; } - for (i = 0; i < p->arity; ++i) - reg[i] = p->def_arg_reg[i]; - if (is_recursive) hipe_push_beam_trap_frame(p, reg, p->arity); - + result = HIPE_MODE_SWITCH_RES_CALL; break; } @@ -470,10 +469,12 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) #if !(NR_ARG_REGS > 5) int reds_in = p->def_arg_reg[5]; #endif + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(p); p = schedule(p, reds_in - p->fcalls); + ERTS_SMP_REQ_PROC_MAIN_LOCK(p); #ifdef ERTS_SMP p->hipe_smp.have_receive_locks = 0; - reg = p->scheduler_data->save_reg; + reg = p->scheduler_data->x_reg_array; #endif } { @@ -648,7 +649,7 @@ Eterm hipe_build_stacktrace(Process *p, struct StackTrace *s) if (depth < 1) return NIL; - heap_size = 6 * depth; /* each [{M,F,A}|_] is 2+4 == 6 words */ + heap_size = 7 * depth; /* each [{M,F,A,[]}|_] is 2+5 == 7 words */ hp = HAlloc(p, heap_size); hp_end = hp + heap_size; @@ -659,8 +660,8 @@ Eterm hipe_build_stacktrace(Process *p, struct StackTrace *s) ra = (const void*)s->trace[i]; if (!hipe_find_mfa_from_ra(ra, &m, &f, &a)) continue; - mfa = TUPLE3(hp, m, f, make_small(a)); - hp += 4; + mfa = TUPLE4(hp, m, f, make_small(a), NIL); + hp += 5; next = CONS(hp, mfa, NIL); *next_p = next; next_p = &CDR(list_val(next)); diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index dfb4ca794a..77dee6f9e9 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -41,9 +41,9 @@ */ /* for -Wmissing-prototypes :-( */ -extern Eterm hipe_check_process_code_2(Process*, Eterm, Eterm); -extern Eterm hipe_garbage_collect_1(Process*, Eterm); -extern Eterm hipe_show_nstack_1(Process*, Eterm); +extern Eterm hipe_check_process_code_2(BIF_ALIST_2); +extern Eterm hipe_garbage_collect_1(BIF_ALIST_1); +extern Eterm hipe_show_nstack_1(BIF_ALIST_1); /* Used when a BIF can trigger a stack walk. */ static __inline__ void hipe_set_narity(Process *p, unsigned int arity) @@ -56,7 +56,7 @@ Eterm hipe_check_process_code_2(BIF_ALIST_2) Eterm ret; hipe_set_narity(BIF_P, 2); - ret = check_process_code_2(BIF_P, BIF_ARG_1, BIF_ARG_2); + ret = check_process_code_2(BIF_P, BIF__ARGS); hipe_set_narity(BIF_P, 0); return ret; } @@ -66,7 +66,7 @@ Eterm hipe_garbage_collect_1(BIF_ALIST_1) Eterm ret; hipe_set_narity(BIF_P, 1); - ret = garbage_collect_1(BIF_P, BIF_ARG_1); + ret = garbage_collect_1(BIF_P, BIF__ARGS); hipe_set_narity(BIF_P, 0); return ret; } @@ -76,7 +76,7 @@ Eterm hipe_show_nstack_1(BIF_ALIST_1) Eterm ret; hipe_set_narity(BIF_P, 1); - ret = hipe_bifs_show_nstack_1(BIF_P, BIF_ARG_1); + ret = hipe_bifs_show_nstack_1(BIF_P, BIF__ARGS); hipe_set_narity(BIF_P, 0); return ret; } @@ -99,8 +99,10 @@ void hipe_gc(Process *p, Eterm need) * has begun. * XXX: BUG: native code should check return status */ -Eterm hipe_set_timeout(Process *p, Eterm timeout_value) +BIF_RETTYPE hipe_set_timeout(BIF_ALIST_1) { + Process* p = BIF_P; + Eterm timeout_value = BIF_ARG_1; #if !defined(ARCH_64) Uint time_val; #endif @@ -286,8 +288,13 @@ static struct StackTrace *get_trace_from_exc(Eterm exc) * This does what the (misnamed) Beam instruction 'raise_ss' does, * namely, a proper re-throw of an exception that was caught by 'try'. */ -Eterm hipe_rethrow(Process *c_p, Eterm exc, Eterm value) + +BIF_RETTYPE hipe_rethrow(BIF_ALIST_2) { + Process* c_p = BIF_P; + Eterm exc = BIF_ARG_1; + Eterm value = BIF_ARG_2; + c_p->fvalue = value; if (c_p->freason == EXC_NULL) { /* a safety check for the R10-0 case; should not happen */ @@ -411,8 +418,12 @@ Eterm hipe_bs_utf8_size(Eterm arg) return make_small(4); } -Eterm hipe_bs_put_utf8(Process *p, Eterm arg, byte *base, unsigned int offset) +BIF_RETTYPE hipe_bs_put_utf8(BIF_ALIST_3) { + Process* p = BIF_P; + Eterm arg = BIF_ARG_1; + byte* base = (byte*) BIF_ARG_2; + Uint offset = (Uint) BIF_ARG_3; byte *save_bin_buf; Uint save_bin_offset; int res; @@ -468,13 +479,21 @@ Eterm hipe_bs_put_utf16(Process *p, Eterm arg, byte *base, unsigned int offset, return new_offset; } -Eterm hipe_bs_put_utf16be(Process *p, Eterm arg, byte *base, unsigned int offset) +BIF_RETTYPE hipe_bs_put_utf16be(BIF_ALIST_3) { + Process *p = BIF_P; + Eterm arg = BIF_ARG_1; + byte *base = (byte*) BIF_ARG_2; + Uint offset = (Uint) BIF_ARG_3; return hipe_bs_put_utf16(p, arg, base, offset, 0); } -Eterm hipe_bs_put_utf16le(Process *p, Eterm arg, byte *base, unsigned int offset) +BIF_RETTYPE hipe_bs_put_utf16le(BIF_ALIST_3) { + Process *p = BIF_P; + Eterm arg = BIF_ARG_1; + byte *base = (byte*) BIF_ARG_2; + Uint offset = (Uint) BIF_ARG_3; return hipe_bs_put_utf16(p, arg, base, offset, BSF_LITTLE); } @@ -489,8 +508,10 @@ static int validate_unicode(Eterm arg) return 1; } -Eterm hipe_bs_validate_unicode(Process *p, Eterm arg) +BIF_RETTYPE hipe_bs_validate_unicode(BIF_ALIST_1) { + Process *p = BIF_P; + Eterm arg = BIF_ARG_1; if (!validate_unicode(arg)) BIF_ERROR(p, BADARG); return NIL; diff --git a/erts/emulator/hipe/hipe_native_bif.h b/erts/emulator/hipe/hipe_native_bif.h index 13a02b84a2..8c9dec180e 100644 --- a/erts/emulator/hipe/hipe_native_bif.h +++ b/erts/emulator/hipe/hipe_native_bif.h @@ -23,6 +23,7 @@ #ifndef HIPE_NATIVE_BIF_H #define HIPE_NATIVE_BIF_H +#include "bif.h" #include "hipe_arch.h" /* @@ -71,24 +72,24 @@ AEXTERN(void,nbif_select_msg,(Process*)); AEXTERN(Eterm,nbif_cmp_2,(void)); AEXTERN(Eterm,nbif_eq_2,(void)); -Eterm hipe_nonclosure_address(Process*, Eterm, Uint); -Eterm hipe_conv_big_to_float(Process*, Eterm); +BIF_RETTYPE hipe_nonclosure_address(BIF_ALIST_2); +BIF_RETTYPE hipe_conv_big_to_float(BIF_ALIST_1); void hipe_fclearerror_error(Process*); void hipe_select_msg(Process*); void hipe_gc(Process*, Eterm); -Eterm hipe_set_timeout(Process*, Eterm); +BIF_RETTYPE hipe_set_timeout(BIF_ALIST_1); void hipe_handle_exception(Process*); -Eterm hipe_rethrow(Process *c_p, Eterm exc, Eterm value); +BIF_RETTYPE hipe_rethrow(BIF_ALIST_2); char *hipe_bs_allocate(int); Binary *hipe_bs_reallocate(Binary*, int); int hipe_bs_put_small_float(Process*, Eterm, Uint, byte*, unsigned, unsigned); void hipe_bs_put_bits(Eterm, Uint, byte*, unsigned, unsigned); Eterm hipe_bs_utf8_size(Eterm); -Eterm hipe_bs_put_utf8(Process*, Eterm, byte*, unsigned int); +BIF_RETTYPE hipe_bs_put_utf8(BIF_ALIST_3); Eterm hipe_bs_utf16_size(Eterm); -Eterm hipe_bs_put_utf16be(Process*, Eterm, byte*, unsigned int); -Eterm hipe_bs_put_utf16le(Process*, Eterm, byte*, unsigned int); -Eterm hipe_bs_validate_unicode(Process*, Eterm); +BIF_RETTYPE hipe_bs_put_utf16be(BIF_ALIST_3); +BIF_RETTYPE hipe_bs_put_utf16le(BIF_ALIST_3); +BIF_RETTYPE hipe_bs_validate_unicode(BIF_ALIST_1); struct erl_bin_match_buffer; int hipe_bs_validate_unicode_retract(struct erl_bin_match_buffer*, Eterm); diff --git a/erts/emulator/hipe/hipe_ppc_asm.m4 b/erts/emulator/hipe/hipe_ppc_asm.m4 index 0eb5c441e6..343402f9f0 100644 --- a/erts/emulator/hipe/hipe_ppc_asm.m4 +++ b/erts/emulator/hipe/hipe_ppc_asm.m4 @@ -31,12 +31,23 @@ define(LOAD,ld)dnl define(STORE,std)dnl define(CMPI,cmpdi)dnl define(WSIZE,8)dnl +`#define STORE_IA(ADDR, DST, TMP) \ + addis TMP, 0, ADDR@highest SEMI\ + ori TMP, TMP, ADDR@higher SEMI\ + rldicr TMP, TMP, 32, 31 SEMI\ + oris TMP, TMP, ADDR@h SEMI\ + ori TMP, TMP, ADDR@l SEMI\ + std TMP, DST' ',` /* 32-bit PowerPC */ define(LOAD,lwz)dnl define(STORE,stw)dnl define(CMPI,cmpwi)dnl define(WSIZE,4)dnl +`#define STORE_IA(ADDR, DST, TMP) \ + lis TMP, ADDR@ha SEMI\ + addi TMP, TMP, ADDR@l SEMI\ + stw TMP, DST' ')dnl `#define LOAD 'LOAD `#define STORE 'STORE diff --git a/erts/emulator/hipe/hipe_ppc_bifs.m4 b/erts/emulator/hipe/hipe_ppc_bifs.m4 index 203fefe1a1..d09551d10d 100644 --- a/erts/emulator/hipe/hipe_ppc_bifs.m4 +++ b/erts/emulator/hipe/hipe_ppc_bifs.m4 @@ -20,21 +20,34 @@ changecom(`/*', `*/')dnl include(`hipe/hipe_ppc_asm.m4') +#`include' "config.h" #`include' "hipe_literals.h" +`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) +# define CALL_BIF(F) STORE_IA(CSYM(F), P_BIF_CALLEE(P), r29); bl CSYM(hipe_debug_bif_wrapper) +#else +# define CALL_BIF(F) bl CSYM(F) +#endif' + .text .p2align 2 -`#define TEST_GOT_MBUF LOAD r4, P_MBUF(P) SEMI CMPI r4, 0 SEMI bne- 3f SEMI 2: -#define JOIN3(A,B,C) A##B##C -#define HANDLE_GOT_MBUF(ARITY) 3: bl CSYM(JOIN3(nbif_,ARITY,_gc_after_bif)) SEMI b 2b' +define(TEST_GOT_MBUF,`LOAD r4, P_MBUF(P) # `TEST_GOT_MBUF' + CMPI r4, 0 + bne- 3f +2:') +define(HANDLE_GOT_MBUF,` +3: bl CSYM(nbif_$1_gc_after_bif) # `HANDLE_GOT_MBUF' + b 2b') + /* * standard_bif_interface_1(nbif_name, cbif_name) * standard_bif_interface_2(nbif_name, cbif_name) * standard_bif_interface_3(nbif_name, cbif_name) + * standard_bif_interface_0(nbif_name, cbif_name) * - * Generate native interface for a BIF with 1-3 parameters and + * Generate native interface for a BIF with 0-3 parameters and * standard failure mode. */ define(standard_bif_interface_1, @@ -49,7 +62,9 @@ ASYM($1): /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - bl CSYM($2) + STORE r4, P_ARG0(r3) # Store BIF__ARGS in def_arg_reg[] + addi r4, r3, P_ARG0 + CALL_BIF($2) TEST_GOT_MBUF /* Restore registers. Check for exception. */ @@ -77,7 +92,10 @@ ASYM($1): /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - bl CSYM($2) + STORE r4, P_ARG0(r3) # Store BIF__ARGS in def_arg_reg[] + STORE r5, P_ARG1(r3) + addi r4, r3, P_ARG0 + CALL_BIF($2) TEST_GOT_MBUF /* Restore registers. Check for exception. */ @@ -106,7 +124,11 @@ ASYM($1): /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - bl CSYM($2) + STORE r4, P_ARG0(r3) # Store BIF__ARGS in def_arg_reg[] + STORE r5, P_ARG1(r3) + STORE r6, P_ARG2(r3) + addi r4, r3, P_ARG0 + CALL_BIF($2) TEST_GOT_MBUF /* Restore registers. Check for exception. */ @@ -121,13 +143,7 @@ ASYM($1): TYPE_FUNCTION(ASYM($1)) #endif') -/* - * fail_bif_interface_0(nbif_name, cbif_name) - * - * Generate native interface for a BIF with 0 parameters and - * standard failure mode. - */ -define(fail_bif_interface_0, +define(standard_bif_interface_0, ` #ifndef HAVE_$1 #`define' HAVE_$1 @@ -138,7 +154,8 @@ ASYM($1): /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - bl CSYM($2) + /* ignore empty BIF__ARGS */ + CALL_BIF($2) TEST_GOT_MBUF /* Restore registers. Check for exception. */ @@ -173,7 +190,8 @@ ASYM($1): /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_GC - bl CSYM($2) + /* ignore empty BIF__ARGS */ + CALL_BIF($2) TEST_GOT_MBUF /* Restore registers. */ @@ -196,7 +214,9 @@ ASYM($1): /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_GC - bl CSYM($2) + STORE r4, P_ARG0(r3) # Store BIF__ARGS in def_arg_reg[] + addi r4, r3, P_ARG0 + CALL_BIF($2) TEST_GOT_MBUF /* Restore registers. Check for exception. */ @@ -224,7 +244,10 @@ ASYM($1): /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_GC - bl CSYM($2) + STORE r4, P_ARG0(r3) # Store BIF__ARGS in def_arg_reg[] + STORE r5, P_ARG1(r3) + addi r4, r3, P_ARG0 + CALL_BIF($2) TEST_GOT_MBUF /* Restore registers. Check for exception. */ diff --git a/erts/emulator/hipe/hipe_process.h b/erts/emulator/hipe/hipe_process.h index 5effacb398..43f47d1a28 100644 --- a/erts/emulator/hipe/hipe_process.h +++ b/erts/emulator/hipe/hipe_process.h @@ -42,6 +42,9 @@ struct hipe_process_state { void (*nra)(void); /* Native code return address. */ #endif unsigned int narity; /* Arity of BIF call, for stack walks. */ +#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) + void (*bif_callee)(void); /* When calling BIF's via debug wrapper */ +#endif }; extern void hipe_arch_print_pcb(struct hipe_process_state *p); diff --git a/erts/emulator/hipe/hipe_risc_glue.h b/erts/emulator/hipe/hipe_risc_glue.h index e74023e3e9..cc2671c016 100644 --- a/erts/emulator/hipe/hipe_risc_glue.h +++ b/erts/emulator/hipe/hipe_risc_glue.h @@ -199,6 +199,22 @@ hipe_call_from_native_is_recursive(Process *p, Eterm reg[]) return 0; } +/* BEAM called native, which called BIF that returned trap + * Discard bif parameters. + * If tailcall, also clean up native stub continuation. */ +static __inline__ int +hipe_trap_from_native_is_recursive(Process *p) +{ + if (p->hipe.narity > NR_ARG_REGS) { + p->hipe.nsp += (p->hipe.narity - NR_ARG_REGS); + } + if (p->hipe.nra != (void(*)(void))&nbif_return) + return 1; + hipe_pop_risc_nra_frame(p); + return 0; +} + + /* Native makes a call which needs to unload the parameters. This differs from hipe_call_from_native_is_recursive() in that it doesn't check for or pop the BEAM-calls-native frame. diff --git a/erts/emulator/hipe/hipe_sparc_bifs.m4 b/erts/emulator/hipe/hipe_sparc_bifs.m4 index 03db7f3413..ca5af45d58 100644 --- a/erts/emulator/hipe/hipe_sparc_bifs.m4 +++ b/erts/emulator/hipe/hipe_sparc_bifs.m4 @@ -20,27 +20,42 @@ changecom(`/*', `*/')dnl include(`hipe/hipe_sparc_asm.m4') +#`include' "config.h" #`include' "hipe_literals.h" .section ".text" .align 4 +`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) +# define CALL_BIF(F) set F, %o7; st %o7, [%o0+P_BIF_CALLEE]; call hipe_debug_bif_wrapper +#else +# define CALL_BIF(F) call F +#endif' + /* * Test for exception. This macro executes its delay slot. */ -`#define __TEST_GOT_EXN(LABEL) cmp %o0, THE_NON_VALUE; bz,pn %icc, LABEL -#define TEST_GOT_EXN(ARITY) __TEST_GOT_EXN(JOIN3(nbif_,ARITY,_simple_exception))' +define(TEST_GOT_EXN,`cmp %o0, THE_NON_VALUE ! `TEST_GOT_EXN' + bz,pn %icc, nbif_$1_simple_exception') -`#define TEST_GOT_MBUF ld [P+P_MBUF], %o1; cmp %o1, 0; bne 3f; nop; 2: -#define JOIN3(A,B,C) A##B##C -#define HANDLE_GOT_MBUF(ARITY) 3: call JOIN3(nbif_,ARITY,_gc_after_bif); nop; b 2b; nop' +define(TEST_GOT_MBUF,`ld [P+P_MBUF], %o1 ! `TEST_GOT_MBUF' + cmp %o1, 0 + bne 3f + nop +2:') +define(HANDLE_GOT_MBUF,` +3: call nbif_$1_gc_after_bif ! `HANDLE_GOT_MBUF' + nop + b 2b + nop') /* * standard_bif_interface_1(nbif_name, cbif_name) * standard_bif_interface_2(nbif_name, cbif_name) * standard_bif_interface_3(nbif_name, cbif_name) + * standard_bif_interface_0(nbif_name, cbif_name) * - * Generate native interface for a BIF with 1-3 parameters and + * Generate native interface for a BIF with 0-3 parameters and * standard failure mode. */ define(standard_bif_interface_1, @@ -55,7 +70,9 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - call $2 + st %o1, [%o0+P_ARG0] ! Store BIF__ARGS in def_arg_reg + add %o0, P_ARG0, %o1 + CALL_BIF($2) nop TEST_GOT_MBUF @@ -81,7 +98,10 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - call $2 + st %o1, [%o0+P_ARG0] ! Store BIF__ARGS in def_arg_reg + st %o2, [%o0+P_ARG1] + add %o0, P_ARG0, %o1 + CALL_BIF($2) nop TEST_GOT_MBUF @@ -108,7 +128,11 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - call $2 + st %o1, [%o0+P_ARG0] ! Store BIF__ARGS in def_arg_reg + st %o2, [%o0+P_ARG1] + st %o3, [%o0+P_ARG2] + add %o0, P_ARG0, %o1 + CALL_BIF($2) nop TEST_GOT_MBUF @@ -121,13 +145,7 @@ $1: .type $1, #function #endif') -/* - * fail_bif_interface_0(nbif_name, cbif_name) - * - * Generate native interface for a BIF with 0 parameters and - * standard failure mode. - */ -define(fail_bif_interface_0, +define(standard_bif_interface_0, ` #ifndef HAVE_$1 #`define' HAVE_$1 @@ -138,7 +156,8 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - call $2 + /* ignore empty BIF__ARGS */ + CALL_BIF($2) nop TEST_GOT_MBUF @@ -171,7 +190,8 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_GC - call $2 + /* ignore empty BIF__ARGS */ + CALL_BIF($2) nop TEST_GOT_MBUF @@ -195,7 +215,9 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_GC - call $2 + st %o1, [%o0+P_ARG0] ! Store BIF__ARGS in def_arg_reg + add %o0, P_ARG0, %o1 + CALL_BIF($2) nop TEST_GOT_MBUF @@ -221,7 +243,10 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_GC - call $2 + st %o1, [%o0+P_ARG0] ! Store BIF__ARGS in def_arg_reg + st %o2, [%o0+P_ARG1] + add %o0, P_ARG0, %o1 + CALL_BIF($2) nop TEST_GOT_MBUF diff --git a/erts/emulator/hipe/hipe_x86_bifs.m4 b/erts/emulator/hipe/hipe_x86_bifs.m4 index 1bb6488b00..2ea69bde3c 100644 --- a/erts/emulator/hipe/hipe_x86_bifs.m4 +++ b/erts/emulator/hipe/hipe_x86_bifs.m4 @@ -20,6 +20,7 @@ changecom(`/*', `*/')dnl include(`hipe/hipe_x86_asm.m4') +#`include' "config.h" #`include' "hipe_literals.h" `#if THE_NON_VALUE == 0 @@ -28,16 +29,27 @@ include(`hipe/hipe_x86_asm.m4') #define TEST_GOT_EXN cmpl $THE_NON_VALUE,%eax #endif' -`#define TEST_GOT_MBUF movl P_MBUF(P), %edx; testl %edx, %edx; jnz 3f; 2: -#define JOIN3(A,B,C) A##B##C -#define HANDLE_GOT_MBUF(ARITY) 3: call JOIN3(nbif_,ARITY,_gc_after_bif); jmp 2b' +`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) +# define CALL_BIF(F) movl $CSYM(F), P_BIF_CALLEE(P); call CSYM(hipe_debug_bif_wrapper) +#else +# define CALL_BIF(F) call CSYM(F) +#endif' + +define(TEST_GOT_MBUF,`movl P_MBUF(P), %edx # `TEST_GOT_MBUF' + testl %edx, %edx + jnz 3f +2:') +define(HANDLE_GOT_MBUF,` +3: call nbif_$1_gc_after_bif # `HANDLE_GOT_MBUF' + jmp 2b') /* * standard_bif_interface_1(nbif_name, cbif_name) * standard_bif_interface_2(nbif_name, cbif_name) * standard_bif_interface_3(nbif_name, cbif_name) + * standard_bif_interface_0(nbif_name, cbif_name) * - * Generate native interface for a BIF with 1-3 parameters and + * Generate native interface for a BIF with 0-3 parameters and * standard failure mode. */ define(standard_bif_interface_1, @@ -56,8 +68,10 @@ ASYM($1): /* make the call on the C stack */ NBIF_ARG_REG(0,P) - NBIF_ARG(1,1,0) - call CSYM($2) + NBIF_ARG(2,1,0) + lea 8(%esp), %eax + NBIF_ARG_REG(1,%eax) # BIF__ARGS + CALL_BIF($2) TEST_GOT_MBUF /* switch to native stack */ @@ -88,9 +102,11 @@ ASYM($1): /* make the call on the C stack */ NBIF_ARG_REG(0,P) - NBIF_ARG(1,2,0) - NBIF_ARG(2,2,1) - call CSYM($2) + NBIF_ARG(2,2,0) + NBIF_ARG(3,2,1) + lea 8(%esp), %eax + NBIF_ARG_REG(1,%eax) # BIF__ARGS + CALL_BIF($2) TEST_GOT_MBUF /* switch to native stack */ @@ -121,10 +137,12 @@ ASYM($1): /* make the call on the C stack */ NBIF_ARG_REG(0,P) - NBIF_ARG(1,3,0) - NBIF_ARG(2,3,1) - NBIF_ARG(3,3,2) - call CSYM($2) + NBIF_ARG(2,3,0) + NBIF_ARG(3,3,1) + NBIF_ARG(4,3,2) + lea 8(%esp), %eax + NBIF_ARG_REG(1,%eax) # BIF__ARGS + CALL_BIF($2) TEST_GOT_MBUF /* switch to native stack */ @@ -139,13 +157,7 @@ ASYM($1): TYPE_FUNCTION(ASYM($1)) #endif') -/* - * fail_bif_interface_0(nbif_name, cbif_name) - * - * Generate native interface for a BIF with 0 parameters and - * standard failure mode. - */ -define(fail_bif_interface_0, +define(standard_bif_interface_0, ` #ifndef HAVE_$1 #`define' HAVE_$1 @@ -158,7 +170,8 @@ ASYM($1): /* make the call on the C stack */ NBIF_ARG_REG(0,P) - call CSYM($2) + /* skip BIF__ARGS */ + CALL_BIF($2) TEST_GOT_MBUF /* switch to native stack */ diff --git a/erts/emulator/hipe/hipe_x86_glue.h b/erts/emulator/hipe/hipe_x86_glue.h index a7b0f164be..b0db93267c 100644 --- a/erts/emulator/hipe/hipe_x86_glue.h +++ b/erts/emulator/hipe/hipe_x86_glue.h @@ -186,6 +186,25 @@ hipe_call_from_native_is_recursive(Process *p, Eterm reg[]) return 0; } +/* BEAM called native, which called BIF that returned trap + * Discard bif parameters. + * If tailcall, also clean up native stub continuation. */ +static __inline__ int +hipe_trap_from_native_is_recursive(Process *p) +{ + Eterm nra = *(p->hipe.nsp++); + + if (p->hipe.narity > NR_ARG_REGS) { + p->hipe.nsp += (p->hipe.narity - NR_ARG_REGS); + } + if (nra != (Eterm)nbif_return) { + *--(p->hipe.nsp) = nra; + return 1; + } + return 0; +} + + /* Native makes a call which needs to unload the parameters. This differs from hipe_call_from_native_is_recursive() in that it doesn't check for or pop the BEAM-calls-native frame. diff --git a/erts/emulator/pcre/Makefile b/erts/emulator/pcre/Makefile deleted file mode 100644 index 72eea01130..0000000000 --- a/erts/emulator/pcre/Makefile +++ /dev/null @@ -1,26 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2008-2009. All Rights Reserved. -# -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. -# -# %CopyrightEnd% -# -# -# Invoke with GNU make or clearmake -C gnu. -# - -include $(ERL_TOP)/make/run_make.mk - -table: - $(MAKE) -f $(TARGET)/Makefile $@
\ No newline at end of file diff --git a/erts/emulator/pcre/Makefile.in b/erts/emulator/pcre/Makefile.in deleted file mode 100644 index f62700ec4e..0000000000 --- a/erts/emulator/pcre/Makefile.in +++ /dev/null @@ -1,165 +0,0 @@ -# Makefile for zlib -# Copyright (C) 1995-1996 Jean-loup Gailly. -# For conditions of distribution and use, see copyright notice in zlib.h - -# To compile and test, type: -# ./configure; make test -# The call of configure is optional if you don't have special requirements - -# To install /usr/local/lib/libz.* and /usr/local/include/zlib.h, type: -# make install -# To install in $HOME instead of /usr/local, use: -# make install prefix=$HOME - -# %ExternalCopyright% - -ARFLAGS = rc - -O = \ -pcre_latin_1_table.o \ -pcre_compile.o \ -pcre_config.o \ -pcre_dfa_exec.o \ -pcre_exec.o \ -pcre_fullinfo.o \ -pcre_get.o \ -pcre_globals.o \ -pcre_info.o \ -pcre_maketables.o \ -pcre_newline.o \ -pcre_ord2utf8.o \ -pcre_refcount.o \ -pcre_study.o \ -pcre_tables.o \ -pcre_try_flipped.o \ -pcre_ucp_searchfuncs.o \ -pcre_valid_utf8.o \ -pcre_version.o \ -pcre_xclass.o - -OBJS = $(O:%=$(OBJDIR)/%) - -GENINC = pcre_exec_loop_break_cases.inc - -#### Begin OTP targets - -include $(ERL_TOP)/make/target.mk - -# On windows we need a separate zlib during debug build -ifeq ($(TARGET),win32) - -ifeq ($(TYPE),debug) -CFLAGS = $(subst -O2, -g, @CFLAGS@ @DEFS@ @DEBUG_FLAGS@ @EMU_THR_DEFS@ -DERLANG_INTEGRATION) -else # debug -CFLAGS = @CFLAGS@ @DEFS@ @EMU_THR_DEFS@ -DERLANG_INTEGRATION -endif # debug - -else # win32 - -ifeq ($(TYPE),debug) -TYPE_FLAGS = @DEBUG_CFLAGS@ -else # debug -ifeq ($(TYPE),gcov) -TYPE_FLAGS = -O0 -fprofile-arcs -ftest-coverage -else # gcov -TYPE_FLAGS = -O3 -endif # gcov -endif # debug - -CFLAGS = $(TYPE_FLAGS) $(subst -O2,, @CFLAGS@) @DEFS@ @EMU_THR_DEFS@ -DERLANG_INTEGRATION - -endif # win32 - -OBJDIR = $(ERL_TOP)/erts/emulator/pcre/obj/$(TARGET)/$(TYPE) - -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -ifeq ($(TARGET), win32) -LIBRARY=$(OBJDIR)/epcre.lib -else -LIBRARY=$(OBJDIR)/libepcre.a -endif - -all: $(LIBRARY) - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - -tests release_tests: - -docs release_docs release_docs_spec: - -clean: - rm -f $(OBJS) $(OBJDIR)/libepcre.a - -#### end OTP targets - -ifeq ($(TARGET), win32) -$(LIBRARY): $(OBJS) - $(AR) -out:$@ $(OBJS) -else -$(LIBRARY): $(OBJS) - $(AR) $(ARFLAGS) $@ $(OBJS) - -@ ($(RANLIB) $@ || true) 2>/dev/null -endif - -$(OBJDIR)/%.o: %.c - $(CC) -c $(CFLAGS) -o $@ $< - -$(GENINC): pcre_exec.c - for x in `grep -n COST_CHK pcre_exec.c | grep -v 'COST_CHK(N)' | awk -F: '{print $$1}'`; \ - do \ - N=`expr $$x + 100`; \ - echo "case $$N: goto L_LOOP_COUNT_$${x};"; \ - done > $(GENINC) - -table: ./gen_table - ./gen_table pcre_latin_1_table.c - -./gen_table: pcre_make_latin1_default.c make_latin1_table.c - $(CC) $(CFLAGS) -o gen_table pcre_make_latin1_default.c make_latin1_table.c - -# DO NOT DELETE THIS LINE -- make depend depends on it. - -$(OBJDIR)/pcre_chartables.o: pcre_chartables.c pcre_internal.h local_config.h \ - pcre.h ucp.h -$(OBJDIR)/pcre_compile.o: pcre_compile.c pcre_internal.h local_config.h \ - pcre.h ucp.h -$(OBJDIR)/pcre_config.o: pcre_config.c pcre_internal.h local_config.h pcre.h \ - ucp.h -$(OBJDIR)/pcre_dfa_exec.o: pcre_dfa_exec.c pcre_internal.h local_config.h \ - pcre.h ucp.h -$(OBJDIR)/pcre_exec.o: pcre_exec.c pcre_internal.h local_config.h pcre.h ucp.h \ - $(GENINC) -$(OBJDIR)/pcre_fullinfo.o: pcre_fullinfo.c pcre_internal.h local_config.h \ - pcre.h ucp.h -$(OBJDIR)/pcre_get.o: pcre_get.c pcre_internal.h local_config.h pcre.h ucp.h -$(OBJDIR)/pcre_globals.o: pcre_globals.c pcre_internal.h local_config.h \ - pcre.h ucp.h -$(OBJDIR)/pcre_info.o: pcre_info.c pcre_internal.h local_config.h pcre.h ucp.h -$(OBJDIR)/pcre_maketables.o: pcre_maketables.c pcre_internal.h local_config.h \ - pcre.h ucp.h -$(OBJDIR)/pcre_newline.o: pcre_newline.c pcre_internal.h local_config.h \ - pcre.h ucp.h -$(OBJDIR)/pcre_ord2utf8.o: pcre_ord2utf8.c pcre_internal.h local_config.h \ - pcre.h ucp.h -$(OBJDIR)/pcre_refcount.o: pcre_refcount.c pcre_internal.h local_config.h \ - pcre.h ucp.h -$(OBJDIR)/pcre_study.o: pcre_study.c pcre_internal.h local_config.h pcre.h \ - ucp.h -$(OBJDIR)/pcre_tables.o: pcre_tables.c pcre_internal.h local_config.h pcre.h \ - ucp.h -$(OBJDIR)/pcre_try_flipped.o: pcre_try_flipped.c pcre_internal.h \ - local_config.h pcre.h ucp.h -$(OBJDIR)/pcre_ucp_searchfuncs.o: pcre_ucp_searchfuncs.c pcre_internal.h \ - local_config.h pcre.h ucp.h ucpinternal.h ucptable.h -$(OBJDIR)/pcre_valid_utf8.o: pcre_valid_utf8.c pcre_internal.h local_config.h \ - pcre.h ucp.h -pcre_version.o: pcre_version.c pcre_internal.h local_config.h pcre.h \ - ucp.h -$(OBJDIR)/pcre_xclass.o: pcre_xclass.c pcre_internal.h local_config.h pcre.h \ - ucp.h diff --git a/erts/emulator/pcre/pcre.mk b/erts/emulator/pcre/pcre.mk new file mode 100644 index 0000000000..b752c11459 --- /dev/null +++ b/erts/emulator/pcre/pcre.mk @@ -0,0 +1,113 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2011. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +ARFLAGS = rc + +PCRE_O = \ +pcre_latin_1_table.o \ +pcre_compile.o \ +pcre_config.o \ +pcre_dfa_exec.o \ +pcre_exec.o \ +pcre_fullinfo.o \ +pcre_get.o \ +pcre_globals.o \ +pcre_info.o \ +pcre_maketables.o \ +pcre_newline.o \ +pcre_ord2utf8.o \ +pcre_refcount.o \ +pcre_study.o \ +pcre_tables.o \ +pcre_try_flipped.o \ +pcre_ucp_searchfuncs.o \ +pcre_valid_utf8.o \ +pcre_version.o \ +pcre_xclass.o + +PCRE_OBJS = $(PCRE_O:%=$(PCRE_OBJDIR)/%) + +GENINC = pcre/pcre_exec_loop_break_cases.inc + +PCRE_OBJDIR = $(ERL_TOP)/erts/emulator/pcre/obj/$(TARGET)/$(TYPE) + +PCRE_CFLAGS = $(filter-out -DDEBUG,$(CFLAGS)) -DERLANG_INTEGRATION + +ifeq ($(TARGET), win32) +$(EPCRE_LIB): $(PCRE_OBJS) + $(AR) -out:$@ $(PCRE_OBJS) +else +$(EPCRE_LIB): $(PCRE_OBJS) + $(AR) $(ARFLAGS) $@ $(PCRE_OBJS) + -@ ($(RANLIB) $@ || true) 2>/dev/null +endif + +$(PCRE_OBJDIR)/%.o: pcre/%.c + $(CC) -c $(PCRE_CFLAGS) -o $@ $< + +$(GENINC): pcre/pcre_exec.c + for x in `grep -n COST_CHK pcre/pcre_exec.c | grep -v 'COST_CHK(N)' | awk -F: '{print $$1}'`; \ + do \ + N=`expr $$x + 100`; \ + echo "case $$N: goto L_LOOP_COUNT_$${x};"; \ + done > $(GENINC) + +# Dependencies. + +$(PCRE_OBJDIR)/pcre_chartables.o: pcre/pcre_chartables.c pcre/pcre_internal.h \ + pcre/local_config.h pcre/pcre.h pcre/ucp.h +$(PCRE_OBJDIR)/pcre_compile.o: pcre/pcre_compile.c pcre/pcre_internal.h \ + pcre/local_config.h pcre/pcre.h pcre/ucp.h +$(PCRE_OBJDIR)/pcre_config.o: pcre/pcre_config.c pcre/pcre_internal.h \ + pcre/local_config.h pcre/pcre.h pcre/ucp.h +$(PCRE_OBJDIR)/pcre_dfa_exec.o: pcre/pcre_dfa_exec.c pcre/pcre_internal.h \ + pcre/local_config.h pcre/pcre.h pcre/ucp.h +$(PCRE_OBJDIR)/pcre_exec.o: pcre/pcre_exec.c pcre/pcre_internal.h \ + pcre/local_config.h pcre/pcre.h pcre/ucp.h $(GENINC) +$(PCRE_OBJDIR)/pcre_fullinfo.o: pcre/pcre_fullinfo.c pcre/pcre_internal.h \ + pcre/local_config.h pcre/pcre.h pcre/ucp.h +$(PCRE_OBJDIR)/pcre_get.o: pcre/pcre_get.c pcre/pcre_internal.h \ + pcre/local_config.h pcre/pcre.h pcre/ucp.h +$(PCRE_OBJDIR)/pcre_globals.o: pcre/pcre_globals.c pcre/pcre_internal.h \ + pcre/local_config.h pcre/pcre.h pcre/ucp.h +$(PCRE_OBJDIR)/pcre_info.o: pcre/pcre_info.c pcre/pcre_internal.h \ + pcre/local_config.h pcre/pcre.h pcre/ucp.h +$(PCRE_OBJDIR)/pcre_maketables.o: pcre/pcre_maketables.c pcre/pcre_internal.h \ + pcre/local_config.h pcre/pcre.h pcre/ucp.h +$(PCRE_OBJDIR)/pcre_newline.o: pcre/pcre_newline.c pcre/pcre_internal.h \ + pcre/local_config.h pcre/pcre.h pcre/ucp.h +$(PCRE_OBJDIR)/pcre_ord2utf8.o: pcre/pcre_ord2utf8.c pcre/pcre_internal.h \ + pcre/local_config.h pcre/pcre.h pcre/ucp.h +$(PCRE_OBJDIR)/pcre/pcre_refcount.o: pcre/pcre_refcount.c pcre/pcre_internal.h \ + pcre/local_config.h pcre/pcre.h pcre/ucp.h +$(PCRE_OBJDIR)/pcre_study.o: pcre/pcre_study.c pcre/pcre_internal.h \ + pcre/local_config.h pcre/pcre.h pcre/ucp.h +$(PCRE_OBJDIR)/pcre_tables.o: pcre/pcre_tables.c pcre/pcre_internal.h \ + pcre/local_config.h pcre/pcre.h pcre/ucp.h +$(PCRE_OBJDIR)/pcre_try_flipped.o: pcre/pcre_try_flipped.c pcre/pcre_internal.h \ + pcre/local_config.h pcre/pcre.h pcre/ucp.h +$(PCRE_OBJDIR)/pcre_ucp_searchfuncs.o: pcre/pcre_ucp_searchfuncs.c \ + pcre/pcre_internal.h pcre/local_config.h pcre/pcre.h pcre/ucp.h \ + pcre/ucpinternal.h pcre/ucptable.h +$(PCRE_OBJDIR)/pcre_valid_utf8.o: pcre/pcre_valid_utf8.c pcre/pcre_internal.h \ + pcre/local_config.h pcre/pcre.h pcre/ucp.h +pcre_version.o: pcre/pcre_version.c pcre/pcre_internal.h pcre/local_config.h \ + pcre/pcre.h pcre/ucp.h +$(PCRE_OBJDIR)/pcre/pcre_xclass.o: pcre/pcre_xclass.c pcre/pcre_internal.h \ + pcre/local_config.h pcre/pcre.h pcre/ucp.h diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 7f851e6007..c6b63350e5 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -948,18 +948,13 @@ void os_flavor(char* namebuf, /* Where to return the name. */ unsigned size) /* Size of name buffer. */ { - static int called = 0; - static struct utsname uts; /* Information about the system. */ - - if (!called) { - char* s; + struct utsname uts; /* Information about the system. */ + char* s; - (void) uname(&uts); - called = 1; - for (s = uts.sysname; *s; s++) { - if (isupper((int) *s)) { - *s = tolower((int) *s); - } + (void) uname(&uts); + for (s = uts.sysname; *s; s++) { + if (isupper((int) *s)) { + *s = tolower((int) *s); } } strcpy(namebuf, uts.sysname); @@ -2764,8 +2759,8 @@ smp_sig_notify(char c) static void * signal_dispatcher_thread_func(void *unused) { - int initialized = 0; #if !CHLDWTHR + int initialized = 0; int notify_check_children = 0; #endif #ifdef ERTS_ENABLE_LOCK_CHECK @@ -2805,8 +2800,8 @@ signal_dispatcher_thread_func(void *unused) */ switch (buf[i]) { case 0: /* Emulator initialized */ - initialized = 1; #if !CHLDWTHR + initialized = 1; if (!notify_check_children) #endif break; diff --git a/erts/emulator/sys/vxworks/sys.c b/erts/emulator/sys/vxworks/sys.c index fc7e6cec08..d6d1fe64e0 100644 --- a/erts/emulator/sys/vxworks/sys.c +++ b/erts/emulator/sys/vxworks/sys.c @@ -2036,9 +2036,6 @@ int erl_memory_show(int p0, int p1, int p2, int p3, int p4, int p5, erts_printf("The memory block used by elib is save_malloc'ed " "at 0x%08x.\n", (unsigned int) alloc_pool_ptr); } -#ifdef NO_FIX_ALLOC - erts_printf("Fix_alloc is disabled in this build\n"); -#endif erts_printf("Statistics from elib_malloc:\n"); ELIB_LOCK; diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index fed5854112..d9fc876482 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -33,7 +33,6 @@ %% erlang:external_size/1 %% size(Binary) %% iolist_size/1 -%% concat_binary/1 %% split_binary/2 %% hash(Binary, N) %% phash(Binary, N) @@ -47,7 +46,7 @@ init_per_testcase/2, end_per_testcase/2, copy_terms/1, conversions/1, deep_lists/1, deep_bitstr_lists/1, bad_list_to_binary/1, bad_binary_to_list/1, - t_split_binary/1, bad_split/1, t_concat_binary/1, + t_split_binary/1, bad_split/1, terms/1, terms_float/1, external_size/1, t_iolist_size/1, t_hash/1, bad_size/1, @@ -68,7 +67,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, all() -> [copy_terms, conversions, deep_lists, deep_bitstr_lists, - t_split_binary, bad_split, t_concat_binary, + t_split_binary, bad_split, bad_list_to_binary, bad_binary_to_list, terms, terms_float, external_size, t_iolist_size, bad_binary_to_term_2, safe_binary_to_term2, @@ -93,7 +92,6 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Config. @@ -381,41 +379,6 @@ bad_split(Config) when is_list(Config) -> bad_split(Bin, Pos) -> {'EXIT',{badarg,_}} = (catch split_binary(Bin, Pos)). -%% Tests concat_binary/2 and size/1. - -t_concat_binary(suite) -> []; -t_concat_binary(Config) when is_list(Config) -> - test_concat([]), - - test_concat([[]]), - test_concat([[], []]), - test_concat([[], [], []]), - - test_concat([[1], []]), - test_concat([[], [2]]), - test_concat([[], [3], []]), - - test_concat([[1, 2, 3], [4, 5, 6, 7]]), - test_concat([[1, 2, 3], [4, 5, 6, 7], [9, 10]]), - - test_concat([lists:seq(0, 255), lists:duplicate(1024, $@), - lists:duplicate(2048, $a), - lists:duplicate(4000, $b)]), - ok. - -test_concat(Lists) -> - test_concat(Lists, 0, [], []). - -test_concat([List|Rest], Size, Combined, Binaries) -> - ?line Bin = list_to_binary(List), - ?line test_concat(Rest, Size+length(List), Combined++List, [Bin|Binaries]); -test_concat([], Size, Combined, Binaries0) -> - ?line Binaries = lists:reverse(Binaries0), - ?line Bin = concat_binary(Binaries), - ?line Size = size(Bin), - ?line Size = iolist_size(Bin), - ?line Combined = binary_to_list(Bin). - t_hash(doc) -> "Test hash/2 with different type of binaries."; t_hash(Config) when is_list(Config) -> test_hash([]), diff --git a/erts/emulator/test/bs_match_misc_SUITE.erl b/erts/emulator/test/bs_match_misc_SUITE.erl index b022f96740..15427661f3 100644 --- a/erts/emulator/test/bs_match_misc_SUITE.erl +++ b/erts/emulator/test/bs_match_misc_SUITE.erl @@ -23,7 +23,7 @@ bound_var/1,bound_tail/1,t_float/1,little_float/1,sean/1, kenneth/1,encode_binary/1,native/1,happi/1, size_var/1,wiger/1,x0_context/1,huge_float_field/1, - writable_binary_matched/1,otp_7198/1]). + writable_binary_matched/1,otp_7198/1,unordered_bindings/1]). -include_lib("test_server/include/test_server.hrl"). @@ -33,7 +33,7 @@ all() -> [bound_var, bound_tail, t_float, little_float, sean, kenneth, encode_binary, native, happi, size_var, wiger, x0_context, huge_float_field, writable_binary_matched, - otp_7198]. + otp_7198, unordered_bindings]. groups() -> []. @@ -553,5 +553,15 @@ otp_7198_scan(<<C, Rest/binary>>, TokAcc) when otp_7198_scan(Rest, [{'KEYWORD', C} | TokAcc]) end. +unordered_bindings(Config) when is_list(Config) -> + {<<1,2,3,4>>,<<42,42>>,<<3,3,3>>} = + unordered_bindings(4, 2, 3, <<1,2,3,4, 42,42, 3,3,3, 3>>), + ok. + +unordered_bindings(CompressedLength, HashSize, PadLength, T) -> + <<Content:CompressedLength/binary,Mac:HashSize/binary, + Padding:PadLength/binary,PadLength>> = T, + {Content,Mac,Padding}. + id(I) -> I. diff --git a/erts/emulator/test/bs_utf_SUITE.erl b/erts/emulator/test/bs_utf_SUITE.erl index 72c656c400..4ab7d674a6 100644 --- a/erts/emulator/test/bs_utf_SUITE.erl +++ b/erts/emulator/test/bs_utf_SUITE.erl @@ -64,8 +64,7 @@ end_per_group(_GroupName, Config) -> utf8_roundtrip(Config) when is_list(Config) -> ?line utf8_roundtrip(0, 16#D7FF), - ?line utf8_roundtrip(16#E000, 16#FFFD), - ?line utf8_roundtrip(16#10000, 16#10FFFF), + ?line utf8_roundtrip(16#E000, 16#10FFFF), ok. utf8_roundtrip(First, Last) when First =< Last -> @@ -91,8 +90,7 @@ utf16_roundtrip(Config) when is_list(Config) -> do_utf16_roundtrip(Fun) -> do_utf16_roundtrip(0, 16#D7FF, Fun), - do_utf16_roundtrip(16#E000, 16#FFFD, Fun), - do_utf16_roundtrip(16#10000, 16#10FFFF, Fun). + do_utf16_roundtrip(16#E000, 16#10FFFF, Fun). do_utf16_roundtrip(First, Last, Fun) when First =< Last -> Fun(First), @@ -129,8 +127,7 @@ utf32_roundtrip(Config) when is_list(Config) -> do_utf32_roundtrip(Fun) -> do_utf32_roundtrip(0, 16#D7FF, Fun), - do_utf32_roundtrip(16#E000, 16#FFFD, Fun), - do_utf32_roundtrip(16#10000, 16#10FFFF, Fun). + do_utf32_roundtrip(16#E000, 16#10FFFF, Fun). do_utf32_roundtrip(First, Last, Fun) when First =< Last -> Fun(First), @@ -158,7 +155,6 @@ utf32_little_roundtrip(Char) -> utf8_illegal_sequences(Config) when is_list(Config) -> ?line fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. ?line fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line fail_range(16#FFFE, 16#FFFF), %Non-characters. %% Illegal first character. ?line [fail(<<I,16#8F,16#8F,16#8F>>) || I <- lists:seq(16#80, 16#BF)], @@ -251,7 +247,6 @@ fail_1(_) -> ok. utf16_illegal_sequences(Config) when is_list(Config) -> ?line utf16_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. ?line utf16_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line utf16_fail_range(16#FFFE, 16#FFFF), %Non-characters. ?line lonely_hi_surrogate(16#D800, 16#DFFF), ?line leading_lo_surrogate(16#DC00, 16#DFFF), @@ -300,7 +295,6 @@ leading_lo_surrogate(_, _, _) -> ok. utf32_illegal_sequences(Config) when is_list(Config) -> ?line utf32_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. ?line utf32_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line utf32_fail_range(16#FFFE, 16#FFFF), %Non-characters. ?line utf32_fail_range(-100, -1), ok. diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl index 93fdc157f7..3e2bee06d1 100644 --- a/erts/emulator/test/call_trace_SUITE.erl +++ b/erts/emulator/test/call_trace_SUITE.erl @@ -934,6 +934,10 @@ exception_nocatch(Config) when is_list(Config) -> exception_nocatch(). exception_nocatch() -> + Deep4LocThrow = get_deep_4_loc({throw,[42]}), + Deep4LocError = get_deep_4_loc({error,[42]}), + Deep4LocBadmatch = get_deep_4_loc({'=',[a,b]}), + Prog = [{'_',[],[{exception_trace}]}], ?line 1 = erlang:trace_pattern({?MODULE,deep_1,'_'}, Prog), ?line 1 = erlang:trace_pattern({?MODULE,deep_2,'_'}, Prog), @@ -959,8 +963,9 @@ exception_nocatch() -> {trace,t2,exception_from,{erlang,throw,1}, {error,{nocatch,Q2}}}], exception_from, {error,{nocatch,Q2}}), - ?line expect({trace,T2,exit,{{nocatch,Q2},[{erlang,throw,[Q2]}, - {?MODULE,deep_4,1}]}}), + ?line expect({trace,T2,exit,{{nocatch,Q2},[{erlang,throw,[Q2],[]}, + {?MODULE,deep_4,1, + Deep4LocThrow}]}}), ?line Q3 = {dump,[dump,{dump}]}, ?line T3 = exception_nocatch(?LINE, error, [Q3], 4, @@ -968,18 +973,29 @@ exception_nocatch() -> {trace,t3,exception_from,{erlang,error,1}, {error,Q3}}], exception_from, {error,Q3}), - ?line expect({trace,T3,exit,{Q3,[{erlang,error,[Q3]}, - {?MODULE,deep_4,1}]}}), + ?line expect({trace,T3,exit,{Q3,[{erlang,error,[Q3],[]}, + {?MODULE,deep_4,1,Deep4LocError}]}}), ?line T4 = exception_nocatch(?LINE, '=', [17,4711], 5, [], exception_from, {error,{badmatch,4711}}), - ?line expect({trace,T4,exit,{{badmatch,4711},[{?MODULE,deep_4,1}]}}), + ?line expect({trace,T4,exit,{{badmatch,4711}, + [{?MODULE,deep_4,1,Deep4LocBadmatch}]}}), %% ?line erlang:trace_pattern({?MODULE,'_','_'}, false), ?line erlang:trace_pattern({erlang,'_','_'}, false), ?line expect(), ?line ok. +get_deep_4_loc(Arg) -> + try + deep_4(Arg), + ?t:fail(should_not_return_to_here) + catch + _:_ -> + [{?MODULE,deep_4,1,Loc0}|_] = erlang:get_stacktrace(), + Loc0 + end. + exception_nocatch(Line, B, Q, N, Extra, Tag, R) -> ?line io:format("== Subtest: ~w", [Line]), ?line Go = make_ref(), diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index 29cbdedd17..61eeec5ffd 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -25,7 +25,7 @@ t_check_process_code_ets/1, external_fun/1,get_chunk/1,module_md5/1,make_stub/1, make_stub_many_funs/1,constant_pools/1, - false_dependency/1,coverage/1]). + false_dependency/1,coverage/1,fun_confusion/1]). -include_lib("test_server/include/test_server.hrl"). @@ -35,7 +35,7 @@ all() -> [new_binary_types, t_check_process_code, t_check_process_code_ets, t_check_old_code, external_fun, get_chunk, module_md5, make_stub, make_stub_many_funs, - constant_pools, false_dependency, coverage]. + constant_pools, false_dependency, coverage, fun_confusion]. groups() -> []. @@ -278,7 +278,8 @@ t_check_old_code(Config) when is_list(Config) -> external_fun(Config) when is_list(Config) -> ?line false = erlang:function_exported(another_code_test, x, 1), - ?line ExtFun = erlang:make_fun(id(another_code_test), x, 1), + AnotherCodeTest = id(another_code_test), + ExtFun = fun AnotherCodeTest:x/1, ?line {'EXIT',{undef,_}} = (catch ExtFun(answer)), ?line false = erlang:function_exported(another_code_test, x, 1), ?line false = lists:member(another_code_test, erlang:loaded()), @@ -555,6 +556,30 @@ coverage(Config) when is_list(Config) -> ?line {'EXIT',{badarg,_}} = (catch erlang:module_loaded(42)), ok. +fun_confusion(Config) when is_list(Config) -> + Data = ?config(data_dir, Config), + Src = filename:join(Data, "fun_confusion"), + Mod = fun_confusion, + + %% Load first version of module. + compile_load(Mod, Src, 1), + F1 = Mod:f(), + 1 = F1(), + + %% Load second version of module. + compile_load(Mod, Src, 2), + F2 = Mod:f(), + + %% F1 should refer to the old code, not the newly loaded code. + 1 = F1(), + 2 = F2(), + ok. + +compile_load(Mod, Src, Ver) -> + {ok,Mod,Code1} = compile:file(Src, [binary,{d,version,Ver}]), + {module,Mod} = code:load_binary(Mod, "fun_confusion.beam", Code1), + ok. + %% Utilities. make_sub_binary(Bin) when is_binary(Bin) -> diff --git a/erts/emulator/test/code_SUITE_data/fun_confusion.erl b/erts/emulator/test/code_SUITE_data/fun_confusion.erl new file mode 100644 index 0000000000..16000861df --- /dev/null +++ b/erts/emulator/test/code_SUITE_data/fun_confusion.erl @@ -0,0 +1,31 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(fun_confusion). + +-export([f/0]). + +f() -> + fun() -> version() end. + +version() -> + %% Changing the value returned here should change + %% the identity of the fun in f/0. + ?version. + diff --git a/erts/emulator/test/exception_SUITE.erl b/erts/emulator/test/exception_SUITE.erl index 9d6fc9521d..109cec25cb 100644 --- a/erts/emulator/test/exception_SUITE.erl +++ b/erts/emulator/test/exception_SUITE.erl @@ -23,9 +23,10 @@ init_per_group/2,end_per_group/2, badmatch/1, pending_errors/1, nil_arith/1, stacktrace/1, nested_stacktrace/1, raise/1, gunilla/1, per/1, - exception_with_heap_frag/1]). + exception_with_heap_frag/1, line_numbers/1]). -export([bad_guy/2]). +-export([crash/1]). -include_lib("test_server/include/test_server.hrl"). -import(lists, [foreach/2]). @@ -35,7 +36,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [badmatch, pending_errors, nil_arith, stacktrace, nested_stacktrace, raise, gunilla, per, - exception_with_heap_frag]. + exception_with_heap_frag, line_numbers]. groups() -> []. @@ -141,14 +142,20 @@ pending_exit_message(Args, Expected) -> end, process_flag(trap_exit, false). -pending({badarg, [{erlang,Bif,BifArgs},{?MODULE,Func,Arity}|_]}, Func, Args, _Code) - when is_atom(Bif), is_list(BifArgs), length(Args) == Arity -> +pending({badarg,[{erlang,Bif,BifArgs,Loc1}, + {?MODULE,Func,Arity,Loc2}|_]}, + Func, Args, _Code) + when is_atom(Bif), is_list(BifArgs), length(Args) =:= Arity, + is_list(Loc1), is_list(Loc2) -> ok; -pending({undef,[{non_existing_module,foo,[]}|_]}, _, _, _) -> +pending({undef,[{non_existing_module,foo,[],Loc}|_]}, _, _, _) + when is_list(Loc) -> ok; -pending({function_clause,[{?MODULE,Func,Args}|_]}, Func, Args, _Code) -> +pending({function_clause,[{?MODULE,Func,Args,Loc}|_]}, Func, Args, _Code) + when is_list(Loc) -> ok; -pending({Code,[{?MODULE,Func,Arity}|_]}, Func, Args, Code) when length(Args) == Arity -> +pending({Code,[{?MODULE,Func,Arity,Loc}|_]}, Func, Args, Code) + when length(Args) =:= Arity, is_list(Loc) -> ok; pending(Reason, _Function, _Args, _Code) -> test_server:fail({bad_exit_reason,Reason}). @@ -255,24 +262,24 @@ stacktrace(Conf) when is_list(Conf) -> ?line {_,Mref} = spawn_monitor(fun() -> exit({Tag,erlang:get_stacktrace()}) end), ?line {Tag,[]} = receive {'DOWN',Mref,_,_,Info} -> Info end, V = [make_ref()|self()], - ?line {value2,{caught1,badarg,[{erlang,abs,[V]}|_]=St1}} = + ?line {value2,{caught1,badarg,[{erlang,abs,[V],_}|_]=St1}} = stacktrace_1({'abs',V}, error, {value,V}), ?line St1 = erase(stacktrace1), ?line St1 = erase(stacktrace2), ?line St1 = erlang:get_stacktrace(), - ?line {caught2,{error,badarith},[{?MODULE,my_add,2}|_]=St2} = + ?line {caught2,{error,badarith},[{?MODULE,my_add,2,_}|_]=St2} = stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}), - ?line [{?MODULE,my_div,2}|_] = erase(stacktrace1), + ?line [{?MODULE,my_div,2,_}|_] = erase(stacktrace1), ?line St2 = erase(stacktrace2), ?line St2 = erlang:get_stacktrace(), - ?line {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3}|_]=St3} = + ?line {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3,_}|_]=St3} = stacktrace_1({value,V}, error, {value,V}), ?line St3 = erase(stacktrace1), ?line St3 = erase(stacktrace2), ?line St3 = erlang:get_stacktrace(), - ?line {caught2,{throw,V},[{?MODULE,foo,1}|_]=St4} = + ?line {caught2,{throw,V},[{?MODULE,foo,1,_}|_]=St4} = stacktrace_1({value,V}, error, {throw,V}), - ?line [{?MODULE,stacktrace_1,3}|_] = erase(stacktrace1), + ?line [{?MODULE,stacktrace_1,3,_}|_] = erase(stacktrace1), ?line St4 = erase(stacktrace2), ?line St4 = erlang:get_stacktrace(), @@ -280,8 +287,8 @@ stacktrace(Conf) when is_list(Conf) -> ?line stacktrace_2() catch error:{badmatch,_} -> - [{?MODULE,stacktrace_2,0}, - {?MODULE,stacktrace,1}|_] = + [{?MODULE,stacktrace_2,0,_}, + {?MODULE,stacktrace,1,_}|_] = erlang:get_stacktrace(), ok end. @@ -315,15 +322,15 @@ nested_stacktrace(Conf) when is_list(Conf) -> nested_stacktrace_1({{value,{V,x1}},void,{V,x1}}, {void,void,void}), ?line {caught1, - [{?MODULE,my_add,2}|_], + [{?MODULE,my_add,2,_}|_], value2, - [{?MODULE,my_add,2}|_]} = + [{?MODULE,my_add,2,_}|_]} = nested_stacktrace_1({{'add',{V,x1}},error,badarith}, {{value,{V,x2}},void,{V,x2}}), ?line {caught1, - [{?MODULE,my_add,2}|_], - {caught2,[{erlang,abs,[V]}|_]}, - [{erlang,abs,[V]}|_]} = + [{?MODULE,my_add,2,_}|_], + {caught2,[{erlang,abs,[V],_}|_]}, + [{erlang,abs,[V],_}|_]} = nested_stacktrace_1({{'add',{V,x1}},error,badarith}, {{'abs',V},error,badarg}), ok. @@ -362,14 +369,14 @@ raise(Conf) when is_list(Conf) -> end, ?line A = erlang:get_stacktrace(), ?line A = get(raise), - ?line [{?MODULE,my_div,2}|_] = A, + ?line [{?MODULE,my_div,2,_}|_] = A, %% N = 8, % Must be even ?line N = erlang:system_flag(backtrace_depth, N), + ?line B = odd_even(N, []), ?line try even(N) catch error:function_clause -> ok end, - ?line B = odd_even(N, []), ?line B = erlang:get_stacktrace(), %% ?line C0 = odd_even(N+1, []), @@ -387,19 +394,12 @@ raise(Conf) when is_list(Conf) -> odd_even(N, R) when is_integer(N), N > 1 -> odd_even(N-1, [if (N rem 2) == 0 -> - {?MODULE,even,1}; + {?MODULE,even,1,[{file,"odd_even.erl"},{line,3}]}; true -> - {?MODULE,odd,1} + {?MODULE,odd,1,[{file,"odd_even.erl"},{line,6}]} end|R]); odd_even(1, R) -> - [{?MODULE,odd,[1]}|R]. - -even(N) when is_integer(N), N > 1, (N rem 2) == 0 -> - odd(N-1)++[N]. - -odd(N) when is_integer(N), N > 1, (N rem 2) == 1 -> - even(N-1)++[N]. - + [{?MODULE,odd,[1],[{file,"odd_even.erl"},{line,5}]}|R]. foo({value,Value}) -> Value; foo({'div',{A,B}}) -> @@ -526,4 +526,186 @@ do_exception_with_heap_frag(Bin, [Sz|Sizes]) -> do_exception_with_heap_frag(Bin, Sizes); do_exception_with_heap_frag(_, []) -> ok. +line_numbers(Config) when is_list(Config) -> + {'EXIT',{{case_clause,bad_tag}, + [{?MODULE,line1,2, + [{file,"fake_file.erl"},{line,3}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(bad_tag, 0)), + {'EXIT',{badarith, + [{?MODULE,line1,2, + [{file,"fake_file.erl"},{line,5}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(a, not_an_integer)), + {'EXIT',{{badmatch,{ok,1}}, + [{?MODULE,line1,2, + [{file,"fake_file.erl"},{line,7}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(a, 0)), + {'EXIT',{crash, + [{?MODULE,crash,1, + [{file,"fake_file.erl"},{line,14}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(a, 41)), + + ModFile = ?MODULE_STRING++".erl", + [{?MODULE,maybe_crash,1,[{file,"call.erl"},{line,28}]}, + {?MODULE,call1,0,[{file,"call.erl"},{line,14}]}, + {?MODULE,close_calls,1,[{file,"call.erl"},{line,5}]}, + {?MODULE,line_numbers,1,[{file,ModFile},{line,_}]}|_] = + close_calls(call1), + [{?MODULE,maybe_crash,1,[{file,"call.erl"},{line,28}]}, + {?MODULE,call2,0,[{file,"call.erl"},{line,18}]}, + {?MODULE,close_calls,1,[{file,"call.erl"},{line,6}]}, + {?MODULE,line_numbers,1,[{file,ModFile},{line,_}]}|_] = + close_calls(call2), + [{?MODULE,maybe_crash,1,[{file,"call.erl"},{line,28}]}, + {?MODULE,call3,0,[{file,"call.erl"},{line,22}]}, + {?MODULE,close_calls,1,[{file,"call.erl"},{line,7}]}, + {?MODULE,line_numbers,1,[{file,ModFile},{line,_}]}|_] = + close_calls(call3), + no_crash = close_calls(other), + + <<0,0>> = build_binary1(16), + {'EXIT',{badarg, + [{?MODULE,build_binary1,1, + [{file,"bit_syntax.erl"},{line,72503}]}, + {?MODULE,line_numbers,1, + [{file,ModFile},{line,_}]}|_]}} = + (catch build_binary1(bad_size)), + + <<7,1,2,3>> = build_binary2(8, <<1,2,3>>), + {'EXIT',{badarg, + [{?MODULE,build_binary2,2, + [{file,"bit_syntax.erl"},{line,72507}]}, + {?MODULE,line_numbers,1, + [{file,ModFile},{line,_}]}|_]}} = + (catch build_binary2(bad_size, <<>>)), + {'EXIT',{badarg, + [{erlang,bit_size,[bad_binary],[]}, + {?MODULE,build_binary2,2, + [{file,"bit_syntax.erl"},{line,72507}]}, + {?MODULE,line_numbers,1, + [{file,ModFile},{line,_}]}|_]}} = + (catch build_binary2(8, bad_binary)), + + {'EXIT',{function_clause, + [{?MODULE,do_call_abs,[y,y], + [{file,"gc_bif.erl"},{line,18}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch do_call_abs(y, y)), + {'EXIT',{badarg, + [{erlang,abs,[[]],[]}, + {?MODULE,do_call_abs,2, + [{file,"gc_bif.erl"},{line,19}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch do_call_abs(x, [])), + + {'EXIT',{{badmatch,"42"}, + [{MODULE,applied_bif_1,1,[{file,"applied_bif.erl"},{line,5}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch applied_bif_1(42)), + + {'EXIT',{{badmatch,{current_location, + {?MODULE,applied_bif_2,0, + [{file,"applied_bif.erl"},{line,9}]}}}, + [{MODULE,applied_bif_2,0,[{file,"applied_bif.erl"},{line,10}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch applied_bif_2()), + + ok. + id(I) -> I. + +-file("odd_even.erl", 1). %Line 1 +even(N) when is_integer(N), N > 1, (N rem 2) == 0 -> + odd(N-1)++[N]. %Line 3 + +odd(N) when is_integer(N), N > 1, (N rem 2) == 1 -> + even(N-1)++[N]. %Line 6 + +%% +%% If the compiler removes redundant line instructions (any +%% line instruction with the same location as the previous), +%% and the loader also removes line instructions before +%% tail-recursive calls to external functions, then the +%% badmatch exception in line 7 below will be reported as +%% occurring in line 6. +%% +%% That means that any removal of redundant line instructions +%% must all be done in the compiler OR in the loader. +%% +-file("fake_file.erl", 1). %Line 1 +line1(Tag, X) -> %Line 2 + case Tag of %Line 3 + a -> + Y = X + 1, %Line 5 + Res = id({ok,Y}), %Line 6 + ?MODULE:crash({ok,42} = Res); %Line 7 + b -> + x = id(x), %Line 9 + ok %Line 10 + end. %Line 11 + +crash(_) -> %Line 13 + erlang:error(crash). %Line 14 + +-file("call.erl", 1). %Line 1 +close_calls(Where) -> %Line 2 + put(where_to_crash, Where), %Line 3 + try + call1(), %Line 5 + call2(), %Line 6 + call3(), %Line 7 + no_crash %Line 8 + catch error:crash -> + erlang:get_stacktrace() %Line 10 + end. %Line 11 + +call1() -> %Line 13 + maybe_crash(call1), %Line 14 + ok. %Line 15 + +call2() -> %Line 17 + maybe_crash(call2), %Line 18 + ok. %Line 19 + +call3() -> %Line 21 + maybe_crash(call3), %Line 22 + ok. %Line 23 + +maybe_crash(Name) -> %Line 25 + case get(where_to_crash) of %Line 26 + Name -> + erlang:error(crash); %Line 28 + _ -> + ok %Line 30 + end. + +-file("bit_syntax.erl", 72500). %Line 72500 +build_binary1(Size) -> %Line 72501 + id(42), %Line 72502 + <<0:Size>>. %Line 72503 + +build_binary2(Size, Bin) -> %Line 72505 + id(0), %Line 72506 + <<7:Size,Bin/binary>>. %Line 72507 + +-file("gc_bif.erl", 17). +do_call_abs(x, Arg) -> %Line 18 + abs(Arg). %Line 19 + +%% Make sure a BIF that is applied does not leave the p->cp +%% set (and thus generating an extra entry on the stack). + +-file("applied_bif.erl", 1). +%% Explicit apply. +applied_bif_1(I) -> %Line 3 + L = apply(erlang, integer_to_list, [I]), %Line 4 + fail = L, %Line 5 + ok. %Line 6 +%% Implicit apply. +applied_bif_2() -> %Line 8 + R = process_info(self(), current_location), %Line 9 + fail = R, %Line 10 + ok. %Line 11 diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl index 736510339f..46466427c5 100644 --- a/erts/emulator/test/float_SUITE.erl +++ b/erts/emulator/test/float_SUITE.erl @@ -25,7 +25,7 @@ init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, fpe/1,fp_drv/1,fp_drv_thread/1,denormalized/1,match/1, - bad_float_unpack/1]). + bad_float_unpack/1,cmp_zero/1, cmp_integer/1, cmp_bignum/1]). -export([otp_7178/1]). @@ -41,10 +41,10 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [fpe, fp_drv, fp_drv_thread, otp_7178, denormalized, - match, bad_float_unpack]. + match, bad_float_unpack, {group, comparison}]. groups() -> - []. + [{comparison, [parallel], [cmp_zero, cmp_integer, cmp_bignum]}]. init_per_suite(Config) -> Config. @@ -187,6 +187,101 @@ bad_float_unpack(Config) when is_list(Config) -> bad_float_unpack_match(<<F:64/float>>) -> F; bad_float_unpack_match(<<I:64/integer-signed>>) -> I. +cmp_zero(_Config) -> + cmp(0.5e-323,0). + +cmp_integer(_Config) -> + Axis = (1 bsl 53)-2.0, %% The point where floating points become unprecise + span_cmp(Axis,2,200), + cmp(Axis*Axis,round(Axis)). + +cmp_bignum(_Config) -> + span_cmp((1 bsl 58) - 1.0),%% Smallest bignum float + + %% Test when the big num goes from I to I+1 in size + [span_cmp((1 bsl (32*I)) - 1.0) || I <- lists:seq(2,30)], + + %% Test bignum greater then largest float + cmp((1 bsl (64*16)) - 1, (1 bsl (64*15)) * 1.0), + %% Test when num is much larger then float + [cmp((1 bsl (32*I)) - 1, (1 bsl (32*(I-2))) * 1.0) || I <- lists:seq(3,30)], + %% Test when float is much larger than num + [cmp((1 bsl (64*15)) * 1.0, (1 bsl (32*(I)))) || I <- lists:seq(1,29)], + + %% Test that all int == float works as they should + [true = 1 bsl N == (1 bsl N)*1.0 || N <- lists:seq(0, 1023)], + [true = (1 bsl N)*-1 == (1 bsl N)*-1.0 || N <- lists:seq(0, 1023)]. + +span_cmp(Axis) -> + span_cmp(Axis, 25). +span_cmp(Axis, Length) -> + span_cmp(Axis, round(Axis) bsr 52, Length). +span_cmp(Axis, Incr, Length) -> + [span_cmp(Axis, Incr, Length, 1 bsl (1 bsl I)) || I <- lists:seq(0,6)]. +%% This function creates tests around number axis. Both <, > and == is tested +%% for both negative and positive numbers. +%% +%% Axis: The number around which to do the tests eg. (1 bsl 58) - 1.0 +%% Incr: How much to increment the test numbers inbetween each test. +%% Length: Length/2 is the number of Incr away from Axis to test on the +%% negative and positive plane. +%% Diff: How much the float and int should differ when comparing +span_cmp(Axis, Incr, Length, Diff) -> + [begin + cmp(round(Axis*-1.0)+Diff+I*Incr,Axis*-1.0+I*Incr), + cmp(Axis*-1.0+I*Incr,round(Axis*-1.0)-Diff+I*Incr) + end || I <- lists:seq((Length div 2)*-1,(Length div 2))], + [begin + cmp(round(Axis)+Diff+I*Incr,Axis+I*Incr), + cmp(Axis+I*Incr,round(Axis)-Diff+I*Incr) + end || I <- lists:seq((Length div 2)*-1,(Length div 2))]. + +cmp(Big,Small) when is_float(Big) -> + BigGtSmall = lists:flatten( + io_lib:format("~f > ~p",[Big,Small])), + BigLtSmall = lists:flatten( + io_lib:format("~f < ~p",[Big,Small])), + BigEqSmall = lists:flatten( + io_lib:format("~f == ~p",[Big,Small])), + SmallGtBig = lists:flatten( + io_lib:format("~p > ~f",[Small,Big])), + SmallLtBig = lists:flatten( + io_lib:format("~p < ~f",[Small,Big])), + SmallEqBig = lists:flatten( + io_lib:format("~p == ~f",[Small,Big])), + cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig, + SmallEqBig,BigEqSmall); +cmp(Big,Small) when is_float(Small) -> + BigGtSmall = lists:flatten( + io_lib:format("~p > ~f",[Big,Small])), + BigLtSmall = lists:flatten( + io_lib:format("~p < ~f",[Big,Small])), + BigEqSmall = lists:flatten( + io_lib:format("~p == ~f",[Big,Small])), + SmallGtBig = lists:flatten( + io_lib:format("~f > ~p",[Small,Big])), + SmallLtBig = lists:flatten( + io_lib:format("~f < ~p",[Small,Big])), + SmallEqBig = lists:flatten( + io_lib:format("~f == ~p",[Small,Big])), + cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig, + SmallEqBig,BigEqSmall). + +cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig, + SmallEqBig,BigEqSmall) -> + {_,_,_,true} = {Big,Small,BigGtSmall, + Big > Small}, + {_,_,_,false} = {Big,Small,BigLtSmall, + Big < Small}, + {_,_,_,false} = {Big,Small,SmallGtBig, + Small > Big}, + {_,_,_,true} = {Big,Small,SmallLtBig, + Small < Big}, + {_,_,_,false} = {Big,Small,SmallEqBig, + Small == Big}, + {_,_,_,false} = {Big,Small,BigEqSmall, + Big == Small}. + id(I) -> I. start_node(Config) when is_list(Config) -> diff --git a/erts/emulator/test/guard_SUITE.erl b/erts/emulator/test/guard_SUITE.erl index f41324c2cc..a5df9b59a0 100644 --- a/erts/emulator/test/guard_SUITE.erl +++ b/erts/emulator/test/guard_SUITE.erl @@ -421,7 +421,7 @@ try_gbif(Id, X, Y) -> try_fail_gbif(Id, X, Y) -> case catch guard_bif(Id, X, Y) of - {'EXIT', {function_clause,[{?MODULE,guard_bif,[Id,X,Y]}|_]}} -> + {'EXIT',{function_clause,[{?MODULE,guard_bif,[Id,X,Y],_}|_]}} -> io:format("guard_bif(~p, ~p, ~p) -- ok", [Id,X,Y]); Other -> ?line ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", @@ -493,9 +493,9 @@ type_tests(Test, [Type|T], Allowed) -> end; false -> case catch type_test(Test, Value) of - {'EXIT', {function_clause, {?MODULE,type_test,[Test,Value]}}} -> - ok; - {'EXIT', {function_clause,[{?MODULE,type_test,[Test,Value]}|_]}} -> + {'EXIT',{function_clause, + [{?MODULE,type_test,[Test,Value],Loc}|_]}} + when is_list(Loc) -> ok; {'EXIT',Other} -> ?line test_server:fail({unexpected_error_reason,Other}); diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index f6344791f1..370363bf9e 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -35,7 +35,9 @@ resource_takeover/1, threading/1, send/1, send2/1, send3/1, send_threaded/1, neg/1, is_checks/1, - get_length/1, make_atom/1, make_string/1]). + get_length/1, make_atom/1, make_string/1, reverse_list_test/1, + otp_9668/1 + ]). -export([many_args_100/100]). @@ -60,7 +62,9 @@ all() -> iolist_as_binary, resource, resource_binary, resource_takeover, threading, send, send2, send3, send_threaded, neg, is_checks, get_length, make_atom, - make_string]. + make_string,reverse_list_test, + otp_9668 + ]. groups() -> []. @@ -1165,7 +1169,28 @@ is_checks(Config) when is_list(Config) -> ?line ensure_lib_loaded(Config, 1), ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], - {hejsan, "hejsan", [$h,"ejs",<<"an">>]}), + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 12), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -12), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 18446744073709551617), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551617), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 99.146), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -99.146), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 18446744073709551616.2e2), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551616.2e2), try ?line error = check_is_exception(), ?line throw(expected_badarg) @@ -1208,6 +1233,27 @@ make_string(Config) when is_list(Config) -> AStringWithAccents = [$E,$r,$l,$a,$n,$g,$ ,16#e4,$r,$ ,$e,$t,$t,$ ,$g,$e,$n,$e,$r,$e,$l,$l,$t,$ ,$p,$r,$o,$g,$r,$a,$m,$s,$p,$r,16#e5,$k], ?line Strings = {A0String,A0String,A0String,A0String0, AStringWithAccents}. +reverse_list_test(Config) -> + ?line ensure_lib_loaded(Config, 1), + List = lists:seq(1,100), + RevList = lists:reverse(List), + ?line RevList = reverse_list(List), + ?line badarg = reverse_list(foo). + +otp_9668(doc) -> ["Memory leak of tmp-buffer when inspecting iolist or unaligned binary in unbound environment"]; +otp_9668(Config) -> + ensure_lib_loaded(Config, 1), + TmpMem = tmpmem(), + IOList = ["This",' ',<<"is">>,' ',[<<"an iolist">>,'.']], + otp_9668_nif(IOList), + + <<_:5/bitstring,UnalignedBin:10/binary,_/bitstring>> = <<"Abuse me as unaligned">>, + otp_9668_nif(UnalignedBin), + + ?line verify_tmpmem(TmpMem), + ok. + + tmpmem() -> case erlang:system_info({allocator,temp_alloc}) of false -> undefined; @@ -1296,7 +1342,7 @@ get_resource(_,_) -> ?nif_stub. release_resource(_) -> ?nif_stub. last_resource_dtor_call() -> ?nif_stub. make_new_resource(_,_) -> ?nif_stub. -check_is(_,_,_,_,_,_,_,_,_,_) -> ?nif_stub. +check_is(_,_,_,_,_,_,_,_,_,_,_) -> ?nif_stub. check_is_exception() -> ?nif_stub. length_test(_,_,_,_,_) -> ?nif_stub. make_atoms() -> ?nif_stub. @@ -1314,8 +1360,10 @@ send_blob_thread(_,_,_) -> ?nif_stub. join_send_thread(_) -> ?nif_stub. copy_blob(_) -> ?nif_stub. send_term(_,_) -> ?nif_stub. +reverse_list(_) -> ?nif_stub. echo_int(_) -> ?nif_stub. type_sizes() -> ?nif_stub. +otp_9668_nif(_) -> ?nif_stub. nif_stub_error(Line) -> exit({nif_not_loaded,module,?MODULE,line,Line}). diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 92f1bab8dd..7d7903af25 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -832,6 +832,7 @@ static ERL_NIF_TERM release_resource(ErlNifEnv* env, int argc, const ERL_NIF_TER * argv[7] an empty list * argv[8] a non-empty list * argv[9] a tuple + * argv[10] a number (small, big integer or float) */ static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { @@ -848,6 +849,7 @@ static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] if (!enif_is_list(env, argv[7])) return enif_make_badarg(env); if (!enif_is_list(env, argv[8])) return enif_make_badarg(env); if (!enif_is_tuple(env, argv[9])) return enif_make_badarg(env); + if (!enif_is_number(env, argv[10])) return enif_make_badarg(env); return ok_atom; } @@ -1421,6 +1423,34 @@ static ERL_NIF_TERM send_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ return enif_make_int(env, ret); } +static ERL_NIF_TERM reverse_list(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { + ERL_NIF_TERM rev_list; + + if(!enif_make_reverse_list(env, argv[0], &rev_list)) + return enif_make_atom(env, "badarg"); + return rev_list; +} + +static ERL_NIF_TERM otp_9668_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + /* Inspect in process independent env */ + ErlNifEnv* myenv = enif_alloc_env(); + ERL_NIF_TERM mycopy = enif_make_copy(myenv, argv[0]); + ErlNifBinary obin, cbin; + + if ((enif_inspect_binary(env, argv[0], &obin) + && enif_inspect_binary(myenv, mycopy, &cbin)) + || + (enif_inspect_iolist_as_binary(env, argv[0], &obin) + && enif_inspect_iolist_as_binary(myenv, mycopy, &cbin))) + { + assert(obin.size == cbin.size); + assert(memcmp(obin.data, cbin.data, obin.size) == 0); + } + enif_free_env(myenv); + return atom_ok; +} + static ErlNifFunc nif_funcs[] = { {"lib_version", 0, lib_version}, @@ -1447,7 +1477,7 @@ static ErlNifFunc nif_funcs[] = {"release_resource", 1, release_resource}, {"last_resource_dtor_call", 0, last_resource_dtor_call}, {"make_new_resource", 2, make_new_resource}, - {"check_is", 10, check_is}, + {"check_is", 11, check_is}, {"check_is_exception", 0, check_is_exception}, {"length_test", 5, length_test}, {"make_atoms", 0, make_atoms}, @@ -1466,8 +1496,10 @@ static ErlNifFunc nif_funcs[] = {"join_send_thread", 1, join_send_thread}, {"copy_blob", 1, copy_blob}, {"send_term", 2, send_term}, + {"reverse_list",1, reverse_list}, {"echo_int", 1, echo_int}, - {"type_sizes", 0, type_sizes} + {"type_sizes", 0, type_sizes}, + {"otp_9668_nif", 1, otp_9668_nif} }; ERL_NIF_INIT(nif_SUITE,nif_funcs,load,reload,upgrade,unload) diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index f68e712268..fdc55a4cc5 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -35,7 +35,7 @@ self_exit/1, normal_suicide_exit/1, abnormal_suicide_exit/1, t_exit_2_catch/1, trap_exit_badarg/1, trap_exit_badarg_in_bif/1, exit_and_timeout/1, exit_twice/1, - t_process_info/1, process_info_other_msg/1, + t_process_info/1, process_info_other/1, process_info_other_msg/1, process_info_other_dist_msg/1, process_info_2_list/1, process_info_lock_reschedule/1, process_info_lock_reschedule2/1, @@ -64,7 +64,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [spawn_with_binaries, t_exit_1, {group, t_exit_2}, trap_exit_badarg, trap_exit_badarg_in_bif, - t_process_info, process_info_other_msg, + t_process_info, process_info_other, process_info_other_msg, process_info_other_dist_msg, process_info_2_list, process_info_lock_reschedule, process_info_lock_reschedule2, @@ -258,7 +258,9 @@ trap_exit_badarg() -> ?line Pid = fun_spawn(fun() -> bad_guy(kb_128()) end), ?line Garbage = kb_128(), ?line receive - {'EXIT', Pid, {badarg,[{erlang,abs,[Garbage]},{?MODULE,bad_guy,1}|_]}} -> + {'EXIT',Pid,{badarg,[{erlang,abs,[Garbage],Loc1}, + {?MODULE,bad_guy,1,Loc2}|_]}} + when is_list(Loc1), is_list(Loc2) -> ok; Other -> ?line ok = io:format("Bad EXIT message: ~P", [Other, 30]), @@ -410,7 +412,7 @@ etwice_high(Low) -> exit(Low, first), exit(Low, second). -%% Tests the process_info/1 BIF. +%% Tests the process_info/2 BIF. t_process_info(Config) when is_list(Config) -> ?line [] = process_info(self(), registered_name), ?line register(my_name, self()), @@ -418,13 +420,100 @@ t_process_info(Config) when is_list(Config) -> ?line {status, running} = process_info(self(), status), ?line {min_heap_size, 233} = process_info(self(), min_heap_size), ?line {min_bin_vheap_size, 46368} = process_info(self(), min_bin_vheap_size), - ?line {current_function, {?MODULE, t_process_info, 1}} = + ?line {current_function,{?MODULE,t_process_info,1}} = process_info(self(), current_function), + ?line {current_function,{?MODULE,t_process_info,1}} = + apply(erlang, process_info, [self(),current_function]), + + %% current_location and current_stacktrace + {Line1,Res1} = {?LINE,process_info(self(), current_location)}, + verify_loc(Line1, Res1), + {Line2,Res2} = {?LINE,apply(erlang, process_info, + [self(),current_location])}, + verify_loc(Line2, Res2), + pi_stacktrace([{?MODULE,t_process_info,1,?LINE}]), + ?line Gleader = group_leader(), ?line {group_leader, Gleader} = process_info(self(), group_leader), ?line {'EXIT',{badarg,_Info}} = (catch process_info('not_a_pid')), ok. +pi_stacktrace(Expected0) -> + {Line,Res} = {?LINE,erlang:process_info(self(), current_stacktrace)}, + {current_stacktrace,Stack} = Res, + Expected = [{?MODULE,pi_stacktrace,1,Line}|Expected0], + pi_stacktrace_1(Stack, Expected). + +pi_stacktrace_1([{M,F,A,Loc}|Stk], [{M,F,A,Line}|Exp]) -> + case Loc of + [] -> + %% No location info for some reason (+L, native code). + io:format("Missing location information for ~w:~w/~w", + [M,F,A]), + ok; + [_|_] -> + Line = proplists:get_value(line, Loc), + File = proplists:get_value(file, Loc), + File = ?MODULE_STRING ++ ".erl" + end, + pi_stacktrace_1(Stk, Exp); +pi_stacktrace_1([_|_], []) -> ok. + +verify_loc(Line, {current_location,{?MODULE,t_process_info=F,1=A,Loc}}) -> + case Loc of + [] -> + %% No location info for some reason (+L, native code). + io:format("Missing location information for ~w:~w/~w", + [?MODULE,F,A]), + ok; + [_|_] -> + Line = proplists:get_value(line, Loc), + File = proplists:get_value(file, Loc), + File = ?MODULE_STRING ++ ".erl" + end. + +process_info_other(Config) when is_list(Config) -> + Self = self(), + Pid = spawn_link(fun() -> process_info_looper(Self) end), + receive after 1 -> ok end, + pio_current_location(10000, Pid, 0, 0), + pio_current_stacktrace(). + +pio_current_location(0, _, Pi, Looper) -> + io:format("~w call(s) to erlang:process_info/2", [Pi]), + io:format("~w call(s) to ~w:process_info_looper/1", [Looper,?MODULE]); +pio_current_location(N, Pid, Pi, Looper) -> + erlang:yield(), + {current_location,Where} = process_info(Pid, current_location), + case Where of + {erlang,process_info,2,[]} -> + pio_current_location(N-1, Pid, Pi+1, Looper); + {?MODULE,process_info_looper,1,Loc} when is_list(Loc) -> + pio_current_location(N-1, Pid, Pi, Looper+1) + end. + +pio_current_stacktrace() -> + L = [begin + {current_stacktrace,Stk} = process_info(P, current_stacktrace), + {P,Stk} + end || P <- processes()], + [erlang:garbage_collect(P) || {P,_} <- L], + erlang:garbage_collect(), + [verify_stacktrace(Stk) || {_,Stk} <- L], + ok. + +verify_stacktrace([{M,F,A,Loc}|T]) + when is_atom(M), + is_atom(F), + is_integer(A), + is_list(Loc) -> + verify_stacktrace(T); +verify_stacktrace([]) -> ok. + +process_info_looper(Parent) -> + process_info(Parent, current_location), + process_info_looper(Parent). + %% Tests the process_info/1 BIF on another process with messages. process_info_other_msg(Config) when is_list(Config) -> Self = self(), diff --git a/erts/emulator/test/trace_local_SUITE.erl b/erts/emulator/test/trace_local_SUITE.erl index 091e960610..32e2a98e3c 100644 --- a/erts/emulator/test/trace_local_SUITE.erl +++ b/erts/emulator/test/trace_local_SUITE.erl @@ -767,8 +767,8 @@ exception_test(Opts, Func0, Args0) -> end, ?line R1 = exc_slave(ExcOpts, Func, Args), - ?line Stack2 = [{?MODULE,exc_top,3},{?MODULE,slave,2}], - ?line Stack3 = [{?MODULE,exc,2}|Stack2], + ?line Stack2 = [{?MODULE,exc_top,3,[]},{?MODULE,slave,2,[]}], + ?line Stack3 = [{?MODULE,exc,2,[]}|Stack2], ?line Rs = case x_exc_top(ExcOpts, Func, Args) of % Emulation {crash,{Reason,Stack}}=R when is_list(Stack) -> @@ -789,21 +789,29 @@ exception_test(Opts, Func0, Args0) -> end, ?line expect({nm}). -exception_validate(R1, [R2|Rs]) -> +exception_validate(R0, Rs0) -> + R = clean_location(R0), + Rs = [clean_location(E) || E <- Rs0], + exception_validate_1(R, Rs). + +exception_validate_1(R1, [R2|Rs]) -> case [R1|R2] of [R|R] -> ok; - [{crash,{badarg,[{lists,reverse,[L1a,L1b]}|T]}}| - {crash,{badarg,[{lists,reverse,[L2a,L2b]}|T]}}] -> + [{crash,{badarg,[{lists,reverse,[L1a,L1b],_}|T]}}| + {crash,{badarg,[{lists,reverse,[L2a,L2b],_}|T]}}] -> same({crash,{badarg,[{lists,reverse, - [lists:reverse(L1b, L1a),[]]}|T]}}, + [lists:reverse(L1b, L1a),[]],[]}|T]}}, {crash,{badarg,[{lists,reverse, - [lists:reverse(L2b, L2a),[]]}|T]}}); + [lists:reverse(L2b, L2a),[]],[]}|T]}}); _ when is_list(Rs), Rs =/= [] -> exception_validate(R1, Rs) end. - +clean_location({crash,{Reason,Stk0}}) -> + Stk = [{M,F,A,[]} || {M,F,A,_} <- Stk0], + {crash,{Reason,Stk}}; +clean_location(Term) -> Term. %%% Tracee target functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% @@ -1057,10 +1065,10 @@ x_exc_exception(_Rtt, M, F, _, Arity, CR) -> x_exc_stacktrace() -> x_exc_stacktrace(erlang:get_stacktrace()). %% Truncate stacktrace to below exc/2 -x_exc_stacktrace([{?MODULE,x_exc,4}|_]) -> []; -x_exc_stacktrace([{?MODULE,x_exc_func,4}|_]) -> []; -x_exc_stacktrace([{?MODULE,x_exc_body,4}|_]) -> []; -x_exc_stacktrace([{?MODULE,exc,2}|_]) -> []; +x_exc_stacktrace([{?MODULE,x_exc,4,_}|_]) -> []; +x_exc_stacktrace([{?MODULE,x_exc_func,4,_}|_]) -> []; +x_exc_stacktrace([{?MODULE,x_exc_body,4,_}|_]) -> []; +x_exc_stacktrace([{?MODULE,exc,2,_}|_]) -> []; x_exc_stacktrace([H|T]) -> [H|x_exc_stacktrace(T)]. diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index ebf7db3277..58c36c3bdc 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -105,7 +105,9 @@ my %match_engine_ops; # All opcodes for the match engine. my %gen_transform_offset; my @transformations; my @call_table; +my %call_table; my @pred_table; +my %pred_table; # Operand types for generic instructions. @@ -187,6 +189,12 @@ sub define_type_bit { } # +# Pre-define the 'fail' instruction. It is used internally +# by the 'try_me_else_fail' instruction. +# +$match_engine_ops{'TOP_fail'} = 1; + +# # Sanity checks. # @@ -1304,7 +1312,8 @@ sub tr_gen { foreach $ref (@g) { my($line, $orig_transform, $from_ref, $to_ref) = @$ref; - my $so_far = tr_gen_from($line, @$from_ref); + my $used_ref = used_vars($from_ref, $to_ref); + my $so_far = tr_gen_from($line, $used_ref, @$from_ref); tr_gen_to($line, $orig_transform, $so_far, @$to_ref); } @@ -1313,9 +1322,22 @@ sub tr_gen { # my($offset) = 0; print "Uint op_transform[] = {\n"; - foreach $key (keys %gen_transform) { + foreach $key (sort keys %gen_transform) { $gen_transform_offset{$key} = $offset; - foreach $instr (@{$gen_transform{$key}}) { + my @instr = @{$gen_transform{$key}}; + + # + # If the last instruction is 'fail', remove it and + # convert the previous 'try_me_else' to 'try_me_else_fail'. + # + if (is_instr($instr[$#instr], 'fail')) { + pop(@instr); + my $i = $#instr; + $i-- while !is_instr($instr[$i], 'try_me_else'); + $instr[$i] = make_op('', 'try_me_else_fail'); + } + + foreach $instr (@instr) { my($size, $instr_ref, $comment) = @$instr; my($op, @args) = @$instr_ref; print " "; @@ -1342,8 +1364,48 @@ sub tr_gen { print "};\n\n"; } +sub used_vars { + my($from_ref,$to_ref) = @_; + my %used; + my %seen; + + foreach my $ref (@$from_ref) { + my($name,$arity,@ops) = @$ref; + if ($name =~ /^[.]/) { + foreach my $var (@ops) { + $used{$var} = 1; + } + } else { + # Any variable that is used at least twice on the + # left-hand side is used. (E.g. "move R R".) + foreach my $op (@ops) { + my($var, $type, $type_val) = @$op; + next if $var eq ''; + $used{$var} = 1 if $seen{$var}; + $seen{$var} = 1; + } + } + } + + foreach my $ref (@$to_ref) { + my($name, $arity, @ops) = @$ref; + if ($name =~ /^[.]/) { + foreach my $var (@ops) { + $used{$var} = 1; + } + } else { + foreach my $op (@ops) { + my($var, $type, $type_val) = @$op; + next if $var eq ''; + $used{$var} = 1; + } + } + } + \%used; +} + sub tr_gen_from { - my($line, @tr) = @_; + my($line,$used_ref,@tr) = @_; my(%var) = (); my(%var_type); my($var_num) = 0; @@ -1353,25 +1415,30 @@ sub tr_gen_from { my(@fix_pred_funcs); my($op, $ref); # Loop variables. my $where = "left side of transformation in line $line: "; + my %var_used = %$used_ref; + my $may_fail = 0; + my $is_first = 1; foreach $ref (@tr) { my($name, $arity, @ops) = @$ref; my($key) = "$name/$arity"; my($opnum); + $may_fail = 1 unless $is_first; + $is_first = 0; + # # A name starting with a period is a C pred function to be called. # if ($name =~ /^\.(\w+)/) { $name = $1; + $may_fail = 1; my $var; my(@args); - my $next_instr = pop(@code); # Get rid of 'next_instr' push(@fix_pred_funcs, scalar(@code)); push(@code, [$name, @ops]); - push(@code, $next_instr); next; } @@ -1383,17 +1450,21 @@ sub tr_gen_from { unless defined $gen_opnum{$name,$arity}; $opnum = $gen_opnum{$name,$arity}; - push(@code, &make_op("$name/$arity", 'is_op', $opnum)); + push(@code, make_op("$name/$arity", 'next_instr', $opnum)); $min_window++; foreach $op (@ops) { my($var, $type, $type_val, $cond, $val) = @$op; + my $ignored_var = "$var (ignored)"; if ($type ne '' && $type ne '*') { + $may_fail = 1; + # # The is_bif, is_not_bif, and is_func instructions have # their own built-in type test and don't need to # be guarded with a type test instruction. # + $ignored_var = ''; unless ($cond eq 'is_bif' or $cond eq 'is_not_bif' or $cond eq 'is_func') { @@ -1407,7 +1478,7 @@ sub tr_gen_from { push(@code, &make_op($types, 'is_type', $type_mask)); } else { $cond = ''; - push(@code, &make_op($types, 'is_type_eq', + push(@code, &make_op("$types== $val", 'is_type_eq', $type_mask, $val)); } } @@ -1415,46 +1486,55 @@ sub tr_gen_from { if ($cond eq 'is_func') { my($m, $f, $a) = split(/:/, $val); + $ignored_var = ''; + $may_fail = 1; push(@code, &make_op('', "$cond", "am_$m", "am_$f", $a)); } elsif ($cond ne '') { + $ignored_var = ''; + $may_fail = 1; push(@code, &make_op('', "$cond", $val)); } if ($var ne '') { if (defined $var{$var}) { + $ignored_var = ''; + $may_fail = 1; push(@code, &make_op($var, 'is_same_var', $var{$var})); } elsif ($type eq '*') { # # Reserve a hole for a 'rest_args' instruction. # + $ignored_var = ''; push(@fix_rest_args, scalar(@code)); push(@code, $var); - } else { + } elsif ($var_used{$var}) { + $ignored_var = ''; $var_type{$var} = 'scalar'; $var{$var} = $var_num; $var_num++; push(@code, &make_op($var, 'set_var', $var{$var})); } } - if (is_set_var_instr($code[$#code])) { + if (is_instr($code[$#code], 'set_var')) { my $ref = pop @code; my $comment = $ref->[2]; my $var = $ref->[1][1]; push(@code, make_op($comment, 'set_var_next_arg', $var)); } else { - push(@code, &make_op('', 'next_arg')); + push(@code, &make_op($ignored_var, 'next_arg')); } } - push(@code, &make_op('', 'next_instr')); - pop(@code) if $code[$#code]->[1][0] eq 'next_arg'; + + # Remove redundant 'next_arg' instructions before the end + # of the instruction. + pop(@code) while is_instr($code[$#code], 'next_arg'); } # # Insert the commit operation. # - pop(@code); # Get rid of 'next_instr' - push(@code, &make_op('', 'commit')); + push(@code, make_op($may_fail ? '' : 'always reached', 'commit')); # # If there is an rest_args instruction, we must insert its correct @@ -1484,9 +1564,8 @@ sub tr_gen_from { push(@args, "var+$var{$var}"); } } - splice(@code, $index, 1, &make_op("$name()", - 'pred', scalar(@pred_table))); - push(@pred_table, [$name, @args]); + my $pi = tr_next_index(\@pred_table, \%pred_table, $name, @args); + splice(@code, $index, 1, make_op("$name()", 'pred', $pi)); } $te_max_vars = $var_num @@ -1503,6 +1582,10 @@ sub tr_gen_to { my($op, $ref); # Loop variables. my($where) = "right side of transformation in line $line: "; + my $last_instr = $code[$#code]; + my $cannot_fail = is_instr($last_instr, 'commit') && + (get_comment($last_instr) =~ /^always/); + foreach $ref (@tr) { my($name, $arity, @ops) = @$ref; @@ -1524,9 +1607,10 @@ sub tr_gen_to { push(@args, "var+$var{$var}"); } } - pop(@code); # Get rid of 'next_instr' - push(@code, &make_op("$name()", 'call', scalar(@call_table))); - push(@call_table, [$name, @args]); + pop(@code); # Get rid of 'commit' instruction + my $index = tr_next_index(\@call_table, \%call_table, + $name, @args); + push(@code, make_op("$name()", 'call_end', $index)); last; } @@ -1543,27 +1627,27 @@ sub tr_gen_to { # Create code to build the generic instruction. # - push(@code, &make_op('', 'new_instr')); - push(@code, &make_op("$name/$arity", 'store_op', $opnum, $arity)); + push(@code, make_op("$name/$arity", 'new_instr', $opnum)); foreach $op (@ops) { my($var, $type, $type_val) = @$op; if ($var ne '') { &error($where, "variable '$var' unbound") unless defined $var{$var}; - push(@code, &make_op($var, 'store_var', $var{$var})); + push(@code, &make_op($var, 'store_var_next_arg', $var{$var})); } elsif ($type ne '') { push(@code, &make_op('', 'store_type', "TAG_$type")); if ($type_val) { push(@code, &make_op('', 'store_val', $type_val)); } + push(@code, make_op('', 'next_arg')); } - push(@code, &make_op('', 'next_arg')); } - pop(@code) if $code[$#code]->[1][0] eq 'next_arg'; + pop(@code) if is_instr($code[$#code], 'next_arg'); } - push(@code, &make_op('', 'end')); + push(@code, make_op('', 'end')) + unless is_instr($code[$#code], 'call_end'); # # Chain together all codes segments having the same first operation. @@ -1575,11 +1659,20 @@ sub tr_gen_to { $min_window{$key} = $min_window if $min_window{$key} > $min_window; - pop(@{$gen_transform{$key}}) + my $prev_last; + $prev_last = pop(@{$gen_transform{$key}}) if defined @{$gen_transform{$key}}; # Fail - my(@prefix) = (&make_op($comment), &make_op('', 'try_me_else', &tr_code_len(@code))); - unshift(@code, @prefix); - push(@{$gen_transform{$key}}, @code, &make_op('', 'fail')); + + if ($prev_last && !is_instr($prev_last, 'fail')) { + error("Line $line: A previous transformation shadows '$orig_transform'"); + } + unless ($cannot_fail) { + unshift(@code, make_op('', 'try_me_else', + tr_code_len(@code))); + push(@code, make_op(""), make_op("$key", 'fail')); + } + unshift(@code, make_op($comment)); + push(@{$gen_transform{$key}}, @code), } sub tr_code_len { @@ -1597,21 +1690,38 @@ sub make_op { [scalar(@op), [@op], $comment]; } -sub is_set_var_instr { - my($ref) = @_; +sub is_instr { + my($ref,$op) = @_; return 0 unless ref($ref) eq 'ARRAY'; - $ref->[1][0] eq 'set_var'; + $ref->[1][0] eq $op; +} + +sub get_comment { + my($ref,$op) = @_; + return '' unless ref($ref) eq 'ARRAY'; + $ref->[2]; +} + +sub tr_next_index { + my($lref,$href,$name,@args) = @_; + my $code = "RVAL = $name(" . join(', ', 'st', @args) . "); break;\n"; + my $index; + + if (defined $$href{$code}) { + $index = $$href{$code}; + } else { + $index = scalar(@$lref); + push(@$lref, $code); + $$href{$code} = $index; + } + $index; } sub tr_gen_call { my(@call_table) = @_; my($i); - print "\n"; for ($i = 0; $i < @call_table; $i++) { - my $ref = $call_table[$i]; - my($name, @args) = @$ref; - print "case $i: RVAL = $name(", join(', ', 'st', @args), "); break;\n"; + print "case $i: $call_table[$i]"; } - print "\n"; } diff --git a/erts/emulator/utils/make_preload b/erts/emulator/utils/make_preload index d0671e998d..d22f08f993 100755 --- a/erts/emulator/utils/make_preload +++ b/erts/emulator/utils/make_preload @@ -88,6 +88,7 @@ foreach $file (@ARGV) { print "unsigned char preloaded_$module", "[] = {\n"; for ($i = 0; $i < length($_); $i++) { if ($i % 8 == 0 && $comment ne '') { + $comment =~ s@/\*@..@g; # Comment start -- avoid warning. $comment =~ s@\*/@..@g; # Comment terminator. print " /* $comment */\n "; $comment = ''; diff --git a/erts/emulator/utils/make_tables b/erts/emulator/utils/make_tables index 918ef62094..91efb4c023 100755 --- a/erts/emulator/utils/make_tables +++ b/erts/emulator/utils/make_tables @@ -181,8 +181,7 @@ for ($i = 0; $i < @bif; $i++) { print "\n"; for ($i = 0; $i < @bif; $i++) { - my $arity = $bif[$i]->[2]; - my $args = join(', ', 'Process*', ('Eterm') x $arity); + my $args = join(', ', 'Process*', 'Eterm*'); print "Eterm $bif[$i]->[3]($args);\n"; print "Eterm wrap_$bif[$i]->[3]($args, UWord *I);\n"; } @@ -219,28 +218,10 @@ for ($i = 0; $i < @bif; $i++) { next if $bif[$i]->[3] eq $bif[$i]->[4]; # Skip unwrapped bifs my $arity = $bif[$i]->[2]; my $func = $bif[$i]->[3]; - my $arg; print "Eterm\n"; - print "wrap_$func(Process* p"; - for ($arg = 1; $arg <= $arity; $arg++) { - print ", Eterm arg$arg"; - } - print ", UWord *I)\n"; + print "wrap_$func(Process* p, Eterm* args, UWord* I)\n"; print "{\n"; - print " return erts_bif_trace($i, p"; - for ($arg = 1; $arg <= 3; $arg++) { - if ($arg <= $arity) { - print ", arg$arg"; - #} elsif ($arg == ($arity + 1)) { - # # Place I in correct position - # print ", (Eterm) I"; - } else { - print ", 0"; - } - } - # I is always last, as well as in the correct position - # Note that "last" and "correct position" may be the same... - print ", I);\n"; + print " return erts_bif_trace($i, p, args, I);\n"; print "}\n\n"; } @@ -261,19 +242,9 @@ for ($i = 0; $i < @bif; $i++) { my $orig_func = $1; $orig_func = $implementation[$i] if $implementation[$i]; print "Eterm\n"; - print "$func(Process* p"; - for ($arg = 1; $arg <= $arity; $arg++) { - print ", Eterm arg$arg"; - } - print ")\n"; + print "$func(Process* p, Eterm* BIF__ARGS)\n"; print "{\n"; - print " return $orig_func(p"; - for ($arg = 1; $arg <= 3; $arg++) { - if ($arg <= $arity) { - print ", arg$arg"; - } - } - print ");\n"; + print " return $orig_func(p, BIF__ARGS);\n"; print "}\n\n"; } diff --git a/erts/etc/win32/nsis/erlang_uninst.ico b/erts/etc/win32/nsis/erlang_uninst.ico Binary files differindex edbd8a6f2c..edbd8a6f2c 100755..100644 --- a/erts/etc/win32/nsis/erlang_uninst.ico +++ b/erts/etc/win32/nsis/erlang_uninst.ico diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex d36b6d450b..ffee1f489f 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 9b0237dc04..dda24d4405 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam Binary files differindex 5723aedaa5..37fd8bb832 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam Binary files differindex 4c5797a126..e255cc803f 100644 --- a/erts/preloaded/ebin/otp_ring0.beam +++ b/erts/preloaded/ebin/otp_ring0.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex 79ff3ea2f8..6227b562a1 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam Binary files differindex 7e7588627b..22c51c79c0 100644 --- a/erts/preloaded/ebin/prim_inet.beam +++ b/erts/preloaded/ebin/prim_inet.beam diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam Binary files differindex 4a937f30aa..7e1a5d1fdb 100644 --- a/erts/preloaded/ebin/prim_zip.beam +++ b/erts/preloaded/ebin/prim_zip.beam diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam Binary files differindex 576890c59f..ebf9f8e6d6 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 fcd67f6633..e9a59a7aaf 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -35,7 +35,7 @@ -export([delay_trap/2]). -export([set_cookie/2, get_cookie/0]). -export([nodes/0]). --export([concat_binary/1]). + -export([list_to_integer/2,integer_to_list/2]). -export([flush_monitor_message/2]). -export([set_cpu_topology/1, format_cpu_topology/1]). @@ -44,7 +44,6 @@ -export([alloc_info/1, alloc_sizes/1]). -deprecated([hash/2]). --deprecated([concat_binary/1]). % Get rid of autoimports of spawn to avoid clashes with ourselves. -compile({no_auto_import,[spawn/1]}). @@ -537,11 +536,6 @@ set_cookie(Node, C) when Node =/= nonode@nohost, is_atom(Node) -> get_cookie() -> auth:get_cookie(). --spec concat_binary(ListOfBinaries) -> binary() when - ListOfBinaries :: iolist(). -concat_binary(List) -> - list_to_binary(List). - -spec integer_to_list(Integer, Base) -> string() when Integer :: integer(), Base :: 2..36. diff --git a/erts/preloaded/src/prim_file.erl b/erts/preloaded/src/prim_file.erl index fd2d4a1530..30b7a5246a 100644 --- a/erts/preloaded/src/prim_file.erl +++ b/erts/preloaded/src/prim_file.erl @@ -111,6 +111,7 @@ -define(FILE_RESP_EOF, 8). -define(FILE_RESP_FNAME, 9). -define(FILE_RESP_ALL_DATA, 10). +-define(FILE_RESP_LFNAME, 11). %% Open modes for the driver's open function. -define(EFILE_MODE_READ, 1). @@ -914,6 +915,8 @@ drv_get_response(Port, R) when is_list(R) -> {ok, R}; {ok, Name} -> drv_get_response(Port, [Name|R]); + {append, Names} -> + drv_get_response(Port, append(Names, R)); Error -> Error end; @@ -938,6 +941,8 @@ drv_get_response(Port) -> %%%----------------------------------------------------------------- %%% Utility functions. +append([I | Is], R) when is_list(R) -> append(Is, [I | R]); +append([], R) -> R. %% Converts a list of mode atoms into a mode word for the driver. @@ -1067,7 +1072,7 @@ translate_response(?FILE_RESP_N2DATA, {ok, {Size, Offset, D}}; translate_response(?FILE_RESP_N2DATA = X, L0) when is_list(L0) -> {Offset, L1} = get_uint64(L0), - {ReadSize, L2} = get_uint64(L1), + {ReadSize, L2} = get_uint64(L1), {Size, L3} = get_uint64(L2), case {ReadSize, L3} of {0, []} -> @@ -1087,6 +1092,12 @@ translate_response(?FILE_RESP_FNAME, Data) when is_binary(Data) -> {ok, prim_file:internal_native2name(Data)}; translate_response(?FILE_RESP_FNAME, Data) -> {ok, Data}; +translate_response(?FILE_RESP_LFNAME, []) -> + ok; +translate_response(?FILE_RESP_LFNAME, Data) when is_binary(Data) -> + {append, transform_lfname(Data)}; +translate_response(?FILE_RESP_LFNAME, Data) -> + {append, transform_lfname(Data)}; translate_response(?FILE_RESP_ALL_DATA, Data) -> {ok, Data}; translate_response(X, Data) -> @@ -1199,6 +1210,14 @@ transform_ldata(0, List, [Size | Sizes], R) -> {Front, Rear} = lists_split(List, Size), transform_ldata(0, Rear, Sizes, [Front | R]). +transform_lfname(<<>>) -> []; +transform_lfname(<<L:16, Name:L/binary, Names/binary>>) -> + [ prim_file:internal_native2name(Name) | transform_lfname(Names)]; +transform_lfname([]) -> []; +transform_lfname([L1,L2|Names]) -> + L = (L1 bsl 8) bor L2, + {Name, Rest} = lists_split(Names, L), + [Name | transform_lfname(Rest)]. lists_split(List, 0) when is_list(List) -> diff --git a/erts/test/nt_SUITE.erl b/erts/test/nt_SUITE.erl index 7d6da28ad6..f9bd15a0ce 100644 --- a/erts/test/nt_SUITE.erl +++ b/erts/test/nt_SUITE.erl @@ -490,12 +490,12 @@ middleman(Waitfor) -> match_event(_X, []) -> nomatch; match_event({Time,Cat,Fac,Sev,Mes},[{Pid,Ref,{Cat,Fac,Sev,MesRE}} | Tail]) -> - case regexp:match(Mes,MesRE) of - {match,_,_} -> + case re:run(Mes,MesRE,[{capture,none}]) of + match -> %%io:format("Match!~n"), {ok,{Pid,Ref,Time,Mes},Tail}; - _Z -> - %%io:format("No match (~p)~n",[_Z]), + nomatch -> + %%io:format("No match~n"), case match_event({Time,Cat,Fac,Sev,Mes},Tail) of {ok,X,Rest} -> {ok,X,[{Pid,Ref,{Cat,Fac,Sev,MesRE}} | Rest]}; diff --git a/erts/test/z_SUITE.erl b/erts/test/z_SUITE.erl index 8fceab32a6..482ecb8fba 100644 --- a/erts/test/z_SUITE.erl +++ b/erts/test/z_SUITE.erl @@ -166,9 +166,12 @@ core_search_conf(RunByTS, DBTop, XDir) -> file_inspect(#core_search_conf{file = File}, Core) -> FRes0 = os:cmd(File ++ " " ++ Core), - FRes = case regexp:match(FRes0, Core) of - {match, S, E} -> + 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); @@ -178,19 +181,13 @@ file_inspect(#core_search_conf{file = File}, Core) -> " " ++ lists:sublist(FRes0, E+1, L+1) - end; - _ -> FRes0 + end end, - case regexp:match(FRes, "[Tt][Ee][Xx][Tt]") of + case re:run(FRes, "text|ascii", [caseless,{capture,none}]) of + match -> + not_a_core; nomatch -> - case regexp:match(FRes, "[Aa][Ss][Cc][Ii][Ii]") of - nomatch -> - probably_a_core; - _ -> - not_a_core - end; - _ -> - not_a_core + probably_a_core end. mk_readable(F) -> diff --git a/erts/vsn.mk b/erts/vsn.mk index 18799d2fba..d56d03146d 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -17,8 +17,8 @@ # %CopyrightEnd% # -VSN = 5.8.5 -SYSTEM_VSN = R14B04 +VSN = 5.9 +SYSTEM_VSN = R15A # Port number 4365 in 4.2 # Port number 4366 in 4.3 |
