diff options
791 files changed, 40084 insertions, 7173 deletions
diff --git a/.gitignore b/.gitignore index 3a9e53dc94..b391ecbe57 100644 --- a/.gitignore +++ b/.gitignore @@ -35,6 +35,8 @@ i386-pc-solaris[0-9]*.[0-9]* i386-unknown-freebsd[0-9]*.[0-9]* tile-tilera-linux-gnu powerpc-unknown-linux-gnu +i386-elf-ose +powerpc-unknown-ose # Mac OS X a.out.dSYM/ @@ -97,6 +99,9 @@ lib/wx/priv/win32/ lib/wx/win32/ make/win32/ +# OSE +*.d + # Used by ic & orber & cos* applications. IDL-GENERATED diff --git a/HOWTO/INSTALL-ANDROID.md b/HOWTO/INSTALL-ANDROID.md new file mode 100644 index 0000000000..31698d4ce3 --- /dev/null +++ b/HOWTO/INSTALL-ANDROID.md @@ -0,0 +1,52 @@ +Cross Compiling Erlang/OTP - ANDROID +==================================== + +Introduction +------------ + +This document describes how to cross compile Erlang OTP to Android/Rasberry Pi platforms. + +### Download and Install Android NDK ### + +https://developer.android.com/tools/sdk/ndk/index.html + +### Define System Variables ### + +export NDK_ROOT=/usr/local/android +export NDK_PLAT=android-9 +export PATH=$NDK_ROOT/toolchains/arm-linux-androideabi-4.8/prebuilt/darwin-x86_64/bin:$PATH + +### Configure OTP ### + +./otp_build configure \ + --xcomp-conf=./xcomp/erl-xcomp-arm-android.conf \ + --without-ssl + +### Compile OTP ### + +make noboot [-j4] + +### Make Release ### + +./otp_build release -a /usr/local/otp_R16B03_arm + +### Target Deployment ### + +Make a tarball out of /usr/local/otp_R16B03_arm and copy it to target device +(e.g. Raspberry Pi). Extract it and install + +./Install /usr/local/otp_R16B03_arm + +Android SDK (adb tool) is used to deploy OTP/Erlang to target device for +evaluation purpose only. + +adb push /usr/local/otp_R16B03_arm /mnt/sdcard/otp_R16B03_arm +adb shell + +### Known Issues ### + + * native inet:gethostbyname/1 return {error, nxdomain} on Raspberry PI. Use dns resolver to by-pass the issue (see http://www.erlang.org/doc/apps/erts/inet_cfg.html) + +### References ### + + The port derives some solutions from https://code.google.com/p/erlang4android/ diff --git a/HOWTO/INSTALL-CROSS.md b/HOWTO/INSTALL-CROSS.md index b01de12e44..10f463c06d 100644 --- a/HOWTO/INSTALL-CROSS.md +++ b/HOWTO/INSTALL-CROSS.md @@ -520,12 +520,35 @@ When a variable has been set, no warning will be issued. `posix_memalign` implementation that accepts larger than page size alignment. +* `erl_xcomp_ose_ldflags_pass1` - Linker flags for the OSE module (pass 1) + +* `erl_xcomp_ose_ldflags_pass2` - Linker flags for the OSE module (pass 2) + +* `erl_xcomp_ose_OSEROOT` - OSE installation root directory + +* `erl_xcomp_ose_STRIP` - Strip utility shipped with the OSE distribution + +* `erl_xcomp_ose_LM_POST_LINK` - OSE postlink tool + +* `erl_xcomp_ose_LM_SET_CONF` - Sets the configuration for an OSE load module + +* `erl_xcomp_ose_LM_ELF_SIZE` - Prints the section size information for an + OSE load module + +* `erl_xcomp_ose_LM_LCF` - OSE load module linker configuration file + +* `erl_xcomp_ose_BEAM_LM_CONF` - Beam OSE load module configuration file + +* `erl_xcomp_ose_EPMD_LM_CONF` - EPMD OSE load module configuration file + +* `erl_xcomp_ose_RUN_ERL_LM_CONF` - run_erl_lm OSE load module configuration file + Copyright and License --------------------- %CopyrightBegin% -Copyright Ericsson AB 2009-2013. All Rights Reserved. +Copyright Ericsson AB 2009-2014. 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 diff --git a/HOWTO/INSTALL.md b/HOWTO/INSTALL.md index c9f4062b83..368947b36c 100644 --- a/HOWTO/INSTALL.md +++ b/HOWTO/INSTALL.md @@ -217,7 +217,7 @@ Step 4: Run the following commands to configure the build: $ ./configure [ options ] -If you are building it from git you will need to run `autoconf` to generate configure file. +If you are building it from git you will need to run `./otp_build autoconf` to generate configure file. By default, Erlang/OTP will be installed in `/usr/local/{bin,lib/erlang}`. To instead install in `<BaseDir>/{bin,lib/erlang}`, use the `--prefix=<BaseDir>` option. @@ -268,12 +268,22 @@ Some of the available `configure` options are: default if possible) * `--{enable,disable}-hipe` - HiPE support (enabled by default on supported platforms) +* `--{enable,disable}-fp-exceptions` - Floating point exceptions (an + optimization for floating point operations). The default differs + depending on operating system and hardware platform. Note that by + enabling this you might get a seemingly working system that sometimes + fail on floating point operations. * `--enable-darwin-universal` - Build universal binaries on darwin i386. * `--enable-darwin-64bit` - Build 64-bit binaries on darwin * `--enable-m64-build` - Build 64-bit binaries using the `-m64` flag to `(g)cc` * `--enable-m32-build` - Build 32-bit binaries using the `-m32` flag to `(g)cc` +* `--with-assumed-cache-line-size=SIZE` - Set assumed cache-line size in + bytes. Default is 64. Valid values are powers of two between and + including 16 and 8192. The runtime system use this value in order to + try to avoid false sharing. A too large value wastes memory. A to + small value will increase the amount of false sharing. * `--{with,without}-termcap` - termcap (without implies that only the old Erlang shell can be used) * `--with-javac=JAVAC` - Specify Java compiler to use @@ -288,7 +298,7 @@ Some of the available `configure` options are: memory accesses. If `configure` should inform you about no native atomic implementation available, you typically want to try using the `libatomic_ops` library. It can be downloaded from - <http://www.hpl.hp.com/research/linux/atomic_ops/>. + <https://github.com/ivmai/libatomic_ops/>. * `--disable-smp-require-native-atomics` - By default `configure` will fail if an SMP runtime system is about to be built, and no implementation for native atomic memory accesses can be found. If this happens, you are diff --git a/Makefile.in b/Makefile.in index a64c2872fd..c667eb5f79 100644 --- a/Makefile.in +++ b/Makefile.in @@ -397,9 +397,9 @@ endif ERL_TOP=$(ERL_TOP) PATH=$(INST_PATH_PREFIX)"$${PATH}" \ $(MAKE) BUILD_ALL=1 TESTROOT="$(RELEASE_ROOT)" release ifeq ($(RELEASE_ROOT),) - $(INSTALL_DATA) "$(ERL_TOP)/OTP_VERSION" "$(OTP_DEFAULT_RELEASE_PATH)" + $(INSTALL_DATA) "$(ERL_TOP)/OTP_VERSION" "$(OTP_DEFAULT_RELEASE_PATH)/releases/@OTP_REL@" else - $(INSTALL_DATA) "$(ERL_TOP)/OTP_VERSION" "$(RELEASE_ROOT)" + $(INSTALL_DATA) "$(ERL_TOP)/OTP_VERSION" "$(RELEASE_ROOT)/releases/@OTP_REL@" endif # --------------------------------------------------------------- @@ -987,6 +987,11 @@ TEST_DIRS := \ erts/epmd/test \ erts/emulator/test +# Any applications listed in SKIP-APPLICATIONS should be skipped +SKIP_FILE := $(wildcard lib/SKIP-APPLICATIONS) +SKIP_TEST_DIRS := $(if $(SKIP_FILE),$(foreach APP,$(shell cat $(SKIP_FILE)),lib/$(APP)/test)) +TEST_DIRS := $(filter-out $(SKIP_TEST_DIRS),$(TEST_DIRS)) + .PHONY: tests release_tests $(TEST_DIRS) tests release_tests: $(TEST_DIRS) @@ -1033,9 +1038,9 @@ install.Install: install.otp_version: ifeq ($(ERLANG_LIBDIR),) - $(INSTALL_DATA) "$(ERL_TOP)/OTP_VERSION" "$(OTP_DEFAULT_RELEASE_PATH)" + $(INSTALL_DATA) "$(ERL_TOP)/OTP_VERSION" "$(OTP_DEFAULT_RELEASE_PATH)/releases/@OTP_REL@" else - $(INSTALL_DATA) "$(ERL_TOP)/OTP_VERSION" "$(ERLANG_LIBDIR)" + $(INSTALL_DATA) "$(ERL_TOP)/OTP_VERSION" "$(ERLANG_LIBDIR)/releases/@OTP_REL@" endif # diff --git a/OTP_VERSION b/OTP_VERSION index c86282f25f..cfc4bcdf57 100644 --- a/OTP_VERSION +++ b/OTP_VERSION @@ -1 +1 @@ -17.0-rc1 +17.0-rc2 diff --git a/aclocal.m4 b/aclocal.m4 index 46b30a16b3..2b47f7c4bc 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -74,6 +74,21 @@ AC_ARG_VAR(erl_xcomp_clock_gettime_cpu_time, [clock_gettime() can be used for re AC_ARG_VAR(erl_xcomp_after_morecore_hook, [__after_morecore_hook can track malloc()s core memory usage: yes|no (only used when cross compiling)]) AC_ARG_VAR(erl_xcomp_dlsym_brk_wrappers, [dlsym(RTLD_NEXT, _) brk wrappers can track malloc()s core memory usage: yes|no (only used when cross compiling)]) +dnl Cross compilation variables for OSE +AC_ARG_VAR(erl_xcomp_ose_ldflags_pass1, [Linker flags for the OSE module (pass 1) (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_ldflags_pass2, [Linker flags for the OSE module (pass 2) (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_OSEROOT, [OSE installation root directory (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_STRIP, [Strip utility shipped with the OSE distribution(only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_POST_LINK, [OSE postlink tool (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_SET_CONF, [Sets the configuration for an OSE load module (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_ELF_SIZE, [Prints the section size information for an OSE load module (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_LCF, [OSE load module linker configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_BEAM_LM_CONF, [BEAM OSE load module default configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_EPMD_LM_CONF, [EPMD OSE load module default configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_RUN_ERL_LM_CONF, [run_erl_lm OSE load module default configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_CONFD, [OSE confd source file]) +AC_ARG_VAR(erl_xcomp_ose_CRT0_LM, [OSE crt0 lm source file]) + ]) AC_DEFUN(ERL_XCOMP_SYSROOT_INIT, @@ -488,6 +503,8 @@ AC_CACHE_VAL(ac_cv_sys_ipv6_support, #ifdef __WIN32__ #include <winsock2.h> #include <ws2tcpip.h> +#elif __OSE__ +#error "no ipv6" #else #include <netinet/in.h> #endif], @@ -500,6 +517,8 @@ else #ifdef __WIN32__ #include <winsock2.h> #include <ws2tcpip.h> +#elif __OSE__ +#error "no ipv6" #else #include <netinet/in.h> #endif], @@ -728,6 +747,12 @@ if test "X$host_os" = "Xwin32"; then THR_LIBS= THR_LIB_NAME=win32_threads THR_LIB_TYPE=win32_threads +elif test "X$host_os" = "Xose"; then + AC_MSG_RESULT(yes) + THR_DEFS="-DOSE_THREADS" + THR_LIBS= + THR_LIB_NAME=ose_threads + THR_LIB_TYPE=ose_threads else AC_MSG_RESULT(no) THR_DEFS= @@ -1078,9 +1103,22 @@ case "$THR_LIB_NAME" in test "$ethr_have_native_atomics" = "yes" && ethr_have_native_spinlock=yes ;; - pthread) - ETHR_THR_LIB_BASE_DIR=pthread - AC_DEFINE(ETHR_PTHREADS, 1, [Define if you have pthreads]) + pthread|ose_threads) + case "$THR_LIB_NAME" in + pthread) + ETHR_THR_LIB_BASE_DIR=pthread + AC_DEFINE(ETHR_PTHREADS, 1, [Define if you have pthreads]) + ;; + ose_threads) + AC_DEFINE(ETHR_OSE_THREADS, 1, + [Define if you have OSE style threads]) + ETHR_THR_LIB_BASE_DIR=ose + AC_CHECK_HEADER(ose_spi/ose_spi.h, + AC_DEFINE(HAVE_OSE_SPI_H, 1, + [Define if you have the "ose_spi/ose_spi.h" header file.])) + ;; + esac + if test "x$THR_LIB_NAME" == "xpthread"; then case $host_os in openbsd*) # The default stack size is insufficient for our needs @@ -1139,6 +1177,7 @@ case "$THR_LIB_NAME" in *) ;; esac + fi dnl We sometimes need ETHR_DEFS in order to find certain headers dnl (at least for pthread.h on osf1). saved_cppflags="$CPPFLAGS" @@ -1151,7 +1190,6 @@ case "$THR_LIB_NAME" in dnl dnl Check for headers dnl - AC_CHECK_HEADER(pthread.h, \ AC_DEFINE(ETHR_HAVE_PTHREAD_H, 1, \ [Define if you have the <pthread.h> header file.])) @@ -1184,7 +1222,7 @@ case "$THR_LIB_NAME" in dnl dnl Check for functions dnl - + if test "x$THR_LIB_NAME" == "xpthread"; then AC_CHECK_FUNC(pthread_spin_lock, \ [ethr_have_native_spinlock=yes \ AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \ @@ -1311,6 +1349,8 @@ case "$THR_LIB_NAME" in AC_MSG_RESULT([$linux_futex]) test $linux_futex = yes && AC_DEFINE(ETHR_HAVE_LINUX_FUTEX, 1, [Define if you have a linux futex implementation.]) + fi + AC_CHECK_SIZEOF(int) AC_CHECK_SIZEOF(long) AC_CHECK_SIZEOF(long long) diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex f5800105d3..b57eef57ab 100644 --- a/bootstrap/bin/start.boot +++ b/bootstrap/bin/start.boot diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot Binary files differindex f5800105d3..b57eef57ab 100644 --- a/bootstrap/bin/start_clean.boot +++ b/bootstrap/bin/start_clean.boot diff --git a/bootstrap/lib/compiler/ebin/beam_a.beam b/bootstrap/lib/compiler/ebin/beam_a.beam Binary files differindex 459db28f43..87e9759ffe 100644 --- a/bootstrap/lib/compiler/ebin/beam_a.beam +++ b/bootstrap/lib/compiler/ebin/beam_a.beam diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam Binary files differindex 8684b356ff..42ff7e9c1f 100644 --- a/bootstrap/lib/compiler/ebin/beam_asm.beam +++ b/bootstrap/lib/compiler/ebin/beam_asm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_block.beam b/bootstrap/lib/compiler/ebin/beam_block.beam Binary files differindex c161220c93..11482a1451 100644 --- a/bootstrap/lib/compiler/ebin/beam_block.beam +++ b/bootstrap/lib/compiler/ebin/beam_block.beam diff --git a/bootstrap/lib/compiler/ebin/beam_bool.beam b/bootstrap/lib/compiler/ebin/beam_bool.beam Binary files differindex fb414eb9b1..f339e76fce 100644 --- a/bootstrap/lib/compiler/ebin/beam_bool.beam +++ b/bootstrap/lib/compiler/ebin/beam_bool.beam diff --git a/bootstrap/lib/compiler/ebin/beam_clean.beam b/bootstrap/lib/compiler/ebin/beam_clean.beam Binary files differindex f6e3059e86..f6a9ff987d 100644 --- a/bootstrap/lib/compiler/ebin/beam_clean.beam +++ b/bootstrap/lib/compiler/ebin/beam_clean.beam diff --git a/bootstrap/lib/compiler/ebin/beam_disasm.beam b/bootstrap/lib/compiler/ebin/beam_disasm.beam Binary files differindex 2b645cdf75..c129898523 100644 --- a/bootstrap/lib/compiler/ebin/beam_disasm.beam +++ b/bootstrap/lib/compiler/ebin/beam_disasm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_flatten.beam b/bootstrap/lib/compiler/ebin/beam_flatten.beam Binary files differindex bf2d341c05..35dae78125 100644 --- a/bootstrap/lib/compiler/ebin/beam_flatten.beam +++ b/bootstrap/lib/compiler/ebin/beam_flatten.beam diff --git a/bootstrap/lib/compiler/ebin/beam_jump.beam b/bootstrap/lib/compiler/ebin/beam_jump.beam Binary files differindex 75c02f082f..2b839bc997 100644 --- a/bootstrap/lib/compiler/ebin/beam_jump.beam +++ b/bootstrap/lib/compiler/ebin/beam_jump.beam diff --git a/bootstrap/lib/compiler/ebin/beam_opcodes.beam b/bootstrap/lib/compiler/ebin/beam_opcodes.beam Binary files differindex 5047d223c2..eaf39a378e 100644 --- a/bootstrap/lib/compiler/ebin/beam_opcodes.beam +++ b/bootstrap/lib/compiler/ebin/beam_opcodes.beam diff --git a/bootstrap/lib/compiler/ebin/beam_split.beam b/bootstrap/lib/compiler/ebin/beam_split.beam Binary files differindex 874245d501..1d12f2cf1d 100644 --- a/bootstrap/lib/compiler/ebin/beam_split.beam +++ b/bootstrap/lib/compiler/ebin/beam_split.beam diff --git a/bootstrap/lib/compiler/ebin/beam_utils.beam b/bootstrap/lib/compiler/ebin/beam_utils.beam Binary files differindex 7da67b85ee..8507db5454 100644 --- a/bootstrap/lib/compiler/ebin/beam_utils.beam +++ b/bootstrap/lib/compiler/ebin/beam_utils.beam diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam Binary files differindex 8c685feb27..07225dc8b1 100644 --- a/bootstrap/lib/compiler/ebin/beam_validator.beam +++ b/bootstrap/lib/compiler/ebin/beam_validator.beam diff --git a/bootstrap/lib/compiler/ebin/beam_z.beam b/bootstrap/lib/compiler/ebin/beam_z.beam Binary files differindex 2c4ca55563..ad551bcc8c 100644 --- a/bootstrap/lib/compiler/ebin/beam_z.beam +++ b/bootstrap/lib/compiler/ebin/beam_z.beam diff --git a/bootstrap/lib/compiler/ebin/cerl.beam b/bootstrap/lib/compiler/ebin/cerl.beam Binary files differindex dc6bd455e7..ff6f0ea0fd 100644 --- a/bootstrap/lib/compiler/ebin/cerl.beam +++ b/bootstrap/lib/compiler/ebin/cerl.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_clauses.beam b/bootstrap/lib/compiler/ebin/cerl_clauses.beam Binary files differindex ec41e1098b..2357df79f4 100644 --- a/bootstrap/lib/compiler/ebin/cerl_clauses.beam +++ b/bootstrap/lib/compiler/ebin/cerl_clauses.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_inline.beam b/bootstrap/lib/compiler/ebin/cerl_inline.beam Binary files differindex 5604f26896..2f7f220ebd 100644 --- a/bootstrap/lib/compiler/ebin/cerl_inline.beam +++ b/bootstrap/lib/compiler/ebin/cerl_inline.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_trees.beam b/bootstrap/lib/compiler/ebin/cerl_trees.beam Binary files differindex 53e45c6742..1338631c23 100644 --- a/bootstrap/lib/compiler/ebin/cerl_trees.beam +++ b/bootstrap/lib/compiler/ebin/cerl_trees.beam diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam Binary files differindex 1aa96eb292..eb682b953c 100644 --- a/bootstrap/lib/compiler/ebin/compile.beam +++ b/bootstrap/lib/compiler/ebin/compile.beam diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app index 83554a68a5..f415965277 100644 --- a/bootstrap/lib/compiler/ebin/compiler.app +++ b/bootstrap/lib/compiler/ebin/compiler.app @@ -18,7 +18,7 @@ {application, compiler, [{description, "ERTS CXC 138 10"}, - {vsn, "4.9.4"}, + {vsn, "5.0"}, {modules, [ beam_a, beam_asm, @@ -67,4 +67,6 @@ ]}, {registered, []}, {applications, [kernel, stdlib]}, - {env, []}]}. + {env, []}, + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","hipe-3.10.3","erts-6.0", + "crypto-3.3"]}]}. diff --git a/bootstrap/lib/compiler/ebin/compiler.appup b/bootstrap/lib/compiler/ebin/compiler.appup index 2c0d46d5f5..13c2644004 100644 --- a/bootstrap/lib/compiler/ebin/compiler.appup +++ b/bootstrap/lib/compiler/ebin/compiler.appup @@ -1 +1,21 @@ -{"4.9.4",[],[]}. +%% -*- erlang -*- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. 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% +{"4.9.4", + [{<<".*">>,[{restart_application, compiler}]}], + [{<<".*">>,[{restart_application, compiler}]}] +}. diff --git a/bootstrap/lib/compiler/ebin/core_lint.beam b/bootstrap/lib/compiler/ebin/core_lint.beam Binary files differindex dca9efc2f3..e172ec6af7 100644 --- a/bootstrap/lib/compiler/ebin/core_lint.beam +++ b/bootstrap/lib/compiler/ebin/core_lint.beam diff --git a/bootstrap/lib/compiler/ebin/core_parse.beam b/bootstrap/lib/compiler/ebin/core_parse.beam Binary files differindex 8c5816c52d..121ef65275 100644 --- a/bootstrap/lib/compiler/ebin/core_parse.beam +++ b/bootstrap/lib/compiler/ebin/core_parse.beam diff --git a/bootstrap/lib/compiler/ebin/core_pp.beam b/bootstrap/lib/compiler/ebin/core_pp.beam Binary files differindex 5de821db8b..fbfd68a93b 100644 --- a/bootstrap/lib/compiler/ebin/core_pp.beam +++ b/bootstrap/lib/compiler/ebin/core_pp.beam diff --git a/bootstrap/lib/compiler/ebin/erl_bifs.beam b/bootstrap/lib/compiler/ebin/erl_bifs.beam Binary files differindex e2dc90c887..27136581c1 100644 --- a/bootstrap/lib/compiler/ebin/erl_bifs.beam +++ b/bootstrap/lib/compiler/ebin/erl_bifs.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam Binary files differindex 4cfa4db1d5..39be60c555 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_fold.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_fold.beam diff --git a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam Binary files differindex 6a6216e80f..5c14528eff 100644 --- a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam +++ b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam diff --git a/bootstrap/lib/compiler/ebin/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam Binary files differindex bd2c8f3c3d..6bf28f441e 100644 --- a/bootstrap/lib/compiler/ebin/v3_codegen.beam +++ b/bootstrap/lib/compiler/ebin/v3_codegen.beam diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam Binary files differindex 52a1086004..6b322b8da0 100644 --- a/bootstrap/lib/compiler/ebin/v3_core.beam +++ b/bootstrap/lib/compiler/ebin/v3_core.beam diff --git a/bootstrap/lib/compiler/ebin/v3_kernel.beam b/bootstrap/lib/compiler/ebin/v3_kernel.beam Binary files differindex fd7df78757..f5dcecb807 100644 --- a/bootstrap/lib/compiler/ebin/v3_kernel.beam +++ b/bootstrap/lib/compiler/ebin/v3_kernel.beam diff --git a/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam b/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam Binary files differindex 1af163078c..1798a279b0 100644 --- a/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam +++ b/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam diff --git a/bootstrap/lib/kernel/ebin/application_master.beam b/bootstrap/lib/kernel/ebin/application_master.beam Binary files differindex 14329fa051..365bc7b53d 100644 --- a/bootstrap/lib/kernel/ebin/application_master.beam +++ b/bootstrap/lib/kernel/ebin/application_master.beam diff --git a/bootstrap/lib/kernel/ebin/disk_log_server.beam b/bootstrap/lib/kernel/ebin/disk_log_server.beam Binary files differindex ec9422d41b..8c1622c7d8 100644 --- a/bootstrap/lib/kernel/ebin/disk_log_server.beam +++ b/bootstrap/lib/kernel/ebin/disk_log_server.beam diff --git a/bootstrap/lib/kernel/ebin/dist_util.beam b/bootstrap/lib/kernel/ebin/dist_util.beam Binary files differindex 4cd98bd217..ea09695075 100644 --- a/bootstrap/lib/kernel/ebin/dist_util.beam +++ b/bootstrap/lib/kernel/ebin/dist_util.beam diff --git a/bootstrap/lib/kernel/ebin/global.beam b/bootstrap/lib/kernel/ebin/global.beam Binary files differindex 1629089858..d25be3994c 100644 --- a/bootstrap/lib/kernel/ebin/global.beam +++ b/bootstrap/lib/kernel/ebin/global.beam diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam Binary files differindex 31a54ecef4..46263fae7b 100644 --- a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam +++ b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app index f491239a45..1fd4edd044 100644 --- a/bootstrap/lib/kernel/ebin/kernel.app +++ b/bootstrap/lib/kernel/ebin/kernel.app @@ -114,6 +114,7 @@ pg2]}, {applications, []}, {env, [{error_logger, tty}]}, - {mod, {kernel, []}} + {mod, {kernel, []}}, + {runtime_dependencies, ["erts-6.0", "stdlib-2.0", "sasl-2.4"]} ] }. diff --git a/bootstrap/lib/kernel/ebin/kernel.appup b/bootstrap/lib/kernel/ebin/kernel.appup index b58d066898..fda418ae8a 100644 --- a/bootstrap/lib/kernel/ebin/kernel.appup +++ b/bootstrap/lib/kernel/ebin/kernel.appup @@ -1,7 +1,7 @@ %% -*- erlang -*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2014. 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 @@ -16,12 +16,10 @@ %% %% %CopyrightEnd% {"3.0", - %% Up from - max two major revisions back + %% Up from - max one major revision back [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R16 - {<<"2\\.15(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R15 - %% Down to - max two major revisions back + {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R16 + %% Down to - max one major revision back [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R16 - {<<"2\\.15(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R15 + {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R16 }. diff --git a/bootstrap/lib/kernel/ebin/os.beam b/bootstrap/lib/kernel/ebin/os.beam Binary files differindex b8b01b31ab..b1b92ca36b 100644 --- a/bootstrap/lib/kernel/ebin/os.beam +++ b/bootstrap/lib/kernel/ebin/os.beam diff --git a/bootstrap/lib/kernel/include/dist.hrl b/bootstrap/lib/kernel/include/dist.hrl index e32c112e63..77556d1303 100644 --- a/bootstrap/lib/kernel/include/dist.hrl +++ b/bootstrap/lib/kernel/include/dist.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2014. 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 @@ -37,3 +37,4 @@ -define(DFLAG_DIST_HDR_ATOM_CACHE,16#2000). -define(DFLAG_SMALL_ATOM_TAGS, 16#4000). -define(DFLAG_UTF8_ATOMS, 16#10000). +-define(DFLAG_MAP_TAG, 16#20000). diff --git a/bootstrap/lib/stdlib/ebin/dets.beam b/bootstrap/lib/stdlib/ebin/dets.beam Binary files differindex ac36354796..6f430b8c6c 100644 --- a/bootstrap/lib/stdlib/ebin/dets.beam +++ b/bootstrap/lib/stdlib/ebin/dets.beam diff --git a/bootstrap/lib/stdlib/ebin/edlin_expand.beam b/bootstrap/lib/stdlib/ebin/edlin_expand.beam Binary files differindex 269cf1f2f7..e182f67bd8 100644 --- a/bootstrap/lib/stdlib/ebin/edlin_expand.beam +++ b/bootstrap/lib/stdlib/ebin/edlin_expand.beam diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam Binary files differindex a5462e86d3..7013e29466 100644 --- a/bootstrap/lib/stdlib/ebin/epp.beam +++ b/bootstrap/lib/stdlib/ebin/epp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_compile.beam b/bootstrap/lib/stdlib/ebin/erl_compile.beam Binary files differindex 88da2b246f..e650afbf6d 100644 --- a/bootstrap/lib/stdlib/ebin/erl_compile.beam +++ b/bootstrap/lib/stdlib/ebin/erl_compile.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam Binary files differindex 9c97f56e00..aab2f38b91 100644 --- a/bootstrap/lib/stdlib/ebin/erl_eval.beam +++ b/bootstrap/lib/stdlib/ebin/erl_eval.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex 98f7a236ae..50b3e3c9d3 100644 --- a/bootstrap/lib/stdlib/ebin/erl_lint.beam +++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam Binary files differindex c1c114dd3c..3d36ee85b7 100644 --- a/bootstrap/lib/stdlib/ebin/erl_parse.beam +++ b/bootstrap/lib/stdlib/ebin/erl_parse.beam diff --git a/bootstrap/lib/stdlib/ebin/filename.beam b/bootstrap/lib/stdlib/ebin/filename.beam Binary files differindex d3700da35e..4c64d477aa 100644 --- a/bootstrap/lib/stdlib/ebin/filename.beam +++ b/bootstrap/lib/stdlib/ebin/filename.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_event.beam b/bootstrap/lib/stdlib/ebin/gen_event.beam Binary files differindex 46f1512a24..d45e508d22 100644 --- a/bootstrap/lib/stdlib/ebin/gen_event.beam +++ b/bootstrap/lib/stdlib/ebin/gen_event.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_fsm.beam b/bootstrap/lib/stdlib/ebin/gen_fsm.beam Binary files differindex d6719e68d9..bf5bbb7839 100644 --- a/bootstrap/lib/stdlib/ebin/gen_fsm.beam +++ b/bootstrap/lib/stdlib/ebin/gen_fsm.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_server.beam b/bootstrap/lib/stdlib/ebin/gen_server.beam Binary files differindex 806c4d58d7..fe95ca0826 100644 --- a/bootstrap/lib/stdlib/ebin/gen_server.beam +++ b/bootstrap/lib/stdlib/ebin/gen_server.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam Binary files differindex f7b0b05ebb..fa7e6fcbc3 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam Binary files differindex 1146ef9ab8..defe4fa5a0 100644 --- a/bootstrap/lib/stdlib/ebin/otp_internal.beam +++ b/bootstrap/lib/stdlib/ebin/otp_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc_pt.beam b/bootstrap/lib/stdlib/ebin/qlc_pt.beam Binary files differindex f53c840702..6184f0c295 100644 --- a/bootstrap/lib/stdlib/ebin/qlc_pt.beam +++ b/bootstrap/lib/stdlib/ebin/qlc_pt.beam diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index 31c7222100..1d255fb2c8 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -102,5 +102,8 @@ {registered,[timer_server,rsh_starter,take_over_monitor,pool_master, dets]}, {applications, [kernel]}, - {env, []}]}. + {env, []}, + {runtime_dependencies, ["sasl-2.4","kernel-3.0","erts-6.0","crypto-3.3", + "compiler-5.0"]} +]}. diff --git a/bootstrap/lib/stdlib/ebin/stdlib.appup b/bootstrap/lib/stdlib/ebin/stdlib.appup index 0871dc5a98..d4db0c865e 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.appup +++ b/bootstrap/lib/stdlib/ebin/stdlib.appup @@ -1,7 +1,7 @@ %% -*- erlang -*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2014. 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 @@ -16,12 +16,10 @@ %% %% %CopyrightEnd% {"2.0", - %% Up from - max two major revisions back + %% Up from - max one major revision back [{<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R16 - {<<"1\\.18(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R15 - %% Down to - max two major revisions back + {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R16 + %% Down to - max one major revision back [{<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R16 - {<<"1\\.18(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R15 + {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R16 }. diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam Binary files differindex 5fe8747341..40d9b28a18 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor.beam diff --git a/bootstrap/lib/stdlib/ebin/sys.beam b/bootstrap/lib/stdlib/ebin/sys.beam Binary files differindex 2aed63dc88..1413b822f2 100644 --- a/bootstrap/lib/stdlib/ebin/sys.beam +++ b/bootstrap/lib/stdlib/ebin/sys.beam diff --git a/configure.in b/configure.in index f6cccb4f4b..be906dcb4e 100644 --- a/configure.in +++ b/configure.in @@ -2,7 +2,7 @@ dnl Process this file with autoconf to produce a configure script. dnl %CopyrightBegin% dnl -dnl Copyright Ericsson AB 1998-2012. All Rights Reserved. +dnl Copyright Ericsson AB 1998-2014. All Rights Reserved. dnl dnl The contents of this file are subject to the Erlang Public License, dnl Version 1.1, (the "License"); you may not use this file except in @@ -209,7 +209,7 @@ AS_HELP_STRING([--enable-dirty-schedulers], [enable dirty scheduler support])) AC_ARG_ENABLE(halfword-emulator, AS_HELP_STRING([--enable-halfword-emulator], - [enable halfword emulator (only for 64bit builds)])) + [enable halfword emulator (only for 64bit builds). Note: Halfword emulator is marked as deprecated and scheduled for removal in future major release.])) AC_ARG_ENABLE(smp-support, AS_HELP_STRING([--enable-smp-support], [enable smp support]) diff --git a/erts/Makefile.in b/erts/Makefile.in index e3db37d3fd..47298cccba 100644 --- a/erts/Makefile.in +++ b/erts/Makefile.in @@ -48,6 +48,7 @@ debug opt clean: ( cd $$d && $(MAKE) $@ FLAVOR=$(FLAVOR) ) || exit $$? ; \ fi ; \ done + (cd preloaded/src && $(MAKE) ../ebin/erts.app) # ---------------------------------------------------------------------- # These are "convenience targets", provided as shortcuts for developers @@ -135,6 +136,10 @@ release: ( cd $$d && $(MAKE) $@ ) || exit $$? ; \ fi ; \ done + ( $(MAKE) -f "$(ERL_TOP)/make/otp_released_app.mk" \ + APP_PWD="$(ERL_TOP)/erts" APP_VSN=VSN APP=erts \ + TESTROOT="$(TESTROOT)" update) \ + || exit $$? .PHONY: release_docs release_docs: diff --git a/erts/aclocal.m4 b/erts/aclocal.m4 index 46b30a16b3..2b47f7c4bc 100644 --- a/erts/aclocal.m4 +++ b/erts/aclocal.m4 @@ -74,6 +74,21 @@ AC_ARG_VAR(erl_xcomp_clock_gettime_cpu_time, [clock_gettime() can be used for re AC_ARG_VAR(erl_xcomp_after_morecore_hook, [__after_morecore_hook can track malloc()s core memory usage: yes|no (only used when cross compiling)]) AC_ARG_VAR(erl_xcomp_dlsym_brk_wrappers, [dlsym(RTLD_NEXT, _) brk wrappers can track malloc()s core memory usage: yes|no (only used when cross compiling)]) +dnl Cross compilation variables for OSE +AC_ARG_VAR(erl_xcomp_ose_ldflags_pass1, [Linker flags for the OSE module (pass 1) (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_ldflags_pass2, [Linker flags for the OSE module (pass 2) (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_OSEROOT, [OSE installation root directory (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_STRIP, [Strip utility shipped with the OSE distribution(only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_POST_LINK, [OSE postlink tool (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_SET_CONF, [Sets the configuration for an OSE load module (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_ELF_SIZE, [Prints the section size information for an OSE load module (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_LCF, [OSE load module linker configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_BEAM_LM_CONF, [BEAM OSE load module default configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_EPMD_LM_CONF, [EPMD OSE load module default configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_RUN_ERL_LM_CONF, [run_erl_lm OSE load module default configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_CONFD, [OSE confd source file]) +AC_ARG_VAR(erl_xcomp_ose_CRT0_LM, [OSE crt0 lm source file]) + ]) AC_DEFUN(ERL_XCOMP_SYSROOT_INIT, @@ -488,6 +503,8 @@ AC_CACHE_VAL(ac_cv_sys_ipv6_support, #ifdef __WIN32__ #include <winsock2.h> #include <ws2tcpip.h> +#elif __OSE__ +#error "no ipv6" #else #include <netinet/in.h> #endif], @@ -500,6 +517,8 @@ else #ifdef __WIN32__ #include <winsock2.h> #include <ws2tcpip.h> +#elif __OSE__ +#error "no ipv6" #else #include <netinet/in.h> #endif], @@ -728,6 +747,12 @@ if test "X$host_os" = "Xwin32"; then THR_LIBS= THR_LIB_NAME=win32_threads THR_LIB_TYPE=win32_threads +elif test "X$host_os" = "Xose"; then + AC_MSG_RESULT(yes) + THR_DEFS="-DOSE_THREADS" + THR_LIBS= + THR_LIB_NAME=ose_threads + THR_LIB_TYPE=ose_threads else AC_MSG_RESULT(no) THR_DEFS= @@ -1078,9 +1103,22 @@ case "$THR_LIB_NAME" in test "$ethr_have_native_atomics" = "yes" && ethr_have_native_spinlock=yes ;; - pthread) - ETHR_THR_LIB_BASE_DIR=pthread - AC_DEFINE(ETHR_PTHREADS, 1, [Define if you have pthreads]) + pthread|ose_threads) + case "$THR_LIB_NAME" in + pthread) + ETHR_THR_LIB_BASE_DIR=pthread + AC_DEFINE(ETHR_PTHREADS, 1, [Define if you have pthreads]) + ;; + ose_threads) + AC_DEFINE(ETHR_OSE_THREADS, 1, + [Define if you have OSE style threads]) + ETHR_THR_LIB_BASE_DIR=ose + AC_CHECK_HEADER(ose_spi/ose_spi.h, + AC_DEFINE(HAVE_OSE_SPI_H, 1, + [Define if you have the "ose_spi/ose_spi.h" header file.])) + ;; + esac + if test "x$THR_LIB_NAME" == "xpthread"; then case $host_os in openbsd*) # The default stack size is insufficient for our needs @@ -1139,6 +1177,7 @@ case "$THR_LIB_NAME" in *) ;; esac + fi dnl We sometimes need ETHR_DEFS in order to find certain headers dnl (at least for pthread.h on osf1). saved_cppflags="$CPPFLAGS" @@ -1151,7 +1190,6 @@ case "$THR_LIB_NAME" in dnl dnl Check for headers dnl - AC_CHECK_HEADER(pthread.h, \ AC_DEFINE(ETHR_HAVE_PTHREAD_H, 1, \ [Define if you have the <pthread.h> header file.])) @@ -1184,7 +1222,7 @@ case "$THR_LIB_NAME" in dnl dnl Check for functions dnl - + if test "x$THR_LIB_NAME" == "xpthread"; then AC_CHECK_FUNC(pthread_spin_lock, \ [ethr_have_native_spinlock=yes \ AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \ @@ -1311,6 +1349,8 @@ case "$THR_LIB_NAME" in AC_MSG_RESULT([$linux_futex]) test $linux_futex = yes && AC_DEFINE(ETHR_HAVE_LINUX_FUTEX, 1, [Define if you have a linux futex implementation.]) + fi + AC_CHECK_SIZEOF(int) AC_CHECK_SIZEOF(long) AC_CHECK_SIZEOF(long long) diff --git a/erts/configure.in b/erts/configure.in index 02e5d12918..9ebb56e3bc 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -2,7 +2,7 @@ dnl Process this file with autoconf to produce a configure script. -*-m4-*- dnl %CopyrightBegin% dnl -dnl Copyright Ericsson AB 1997-2013. All Rights Reserved. +dnl Copyright Ericsson AB 1997-2014. All Rights Reserved. dnl dnl The contents of this file are subject to the Erlang Public License, dnl Version 1.1, (the "License"); you may not use this file except in @@ -144,7 +144,7 @@ AS_HELP_STRING([--enable-dirty-schedulers], [enable dirty scheduler support]), AC_ARG_ENABLE(halfword-emulator, AS_HELP_STRING([--enable-halfword-emulator], - [enable halfword emulator (only for 64bit builds)]), + [enable halfword emulator (only for 64bit builds). Note: Halfword emulator is marked as deprecated and scheduled for removal in future major release.]), [ case "$enableval" in no) enable_halfword_emualtor=no ;; *) enable_halfword_emulator=yes ;; @@ -347,6 +347,25 @@ AS_HELP_STRING([--enable-clock-gettime], *) clock_gettime_correction=yes ;; esac ], clock_gettime_correction=unknown) +AC_ARG_WITH(assumed-cache-line-size, +AS_HELP_STRING([--with-assumed-cache-line-size=SIZE], + [specify assumed cache line size in bytes (valid values are powers of two between and including 16 and 8192; default is 64)])) + +dnl Require the assumed cache-line size to be a power of two between 16 and 8192 +case "$with_assumed_cache_line_size" in + ""|no|yes) + with_assumed_cache_line_size=64;; + 16|32|64|128|256|512|1024|2048|4096|8192) + ;; + *) + AC_MSG_ERROR([Invalid assumed cache-line size of $with_assumed_cache_line_size bytes]) + ;; +esac + +AC_DEFINE_UNQUOTED(ASSUMED_CACHE_LINE_SIZE, + $with_assumed_cache_line_size, + [Assumed cache-line size (in bytes)]) + dnl Magic test for clearcase. OTP_RELEASE= if test "${ERLANG_COMMERCIAL_BUILD}" != ""; then @@ -436,6 +455,17 @@ AS_HELP_STRING([--enable-static-drivers], [comma seperated list of linked-in dri STATIC_DRIVERS=no) AC_SUBST(STATIC_DRIVERS) +AC_ARG_WITH(ets-write-concurrency-locks, + AS_HELP_STRING([--with-ets-write-concurrency-locks={8,16,32,64,128,256}], + [specify how many locks the write_concurrency option for ets should use.]) + AS_HELP_STRING([--without-ets-write-concurrency-locks], + [use the default number of write_concurrency locks (default)])) + +if test X"$with_ets_write_concurrency_locks" != X""; then + AC_DEFINE_UNQUOTED(ERTS_DB_HASH_LOCK_CNT,$with_ets_write_concurrency_locks, + [Define to override the default number of write_concurrency locks]) +fi + dnl ---------------------------------------------------------------------- dnl Checks for programs. dnl ---------------------------------------------------------------------- @@ -786,6 +816,16 @@ if test "$enable_halfword_emulator" = "yes"; then [Define if building a halfword-heap 64bit emulator]) ENABLE_ALLOC_TYPE_VARS="$ENABLE_ALLOC_TYPE_VARS halfword" AC_MSG_RESULT([yes]) + + test -f "$ERL_TOP/erts/CONF_INFO" || + echo "" > "$ERL_TOP/erts/CONF_INFO" + cat >> $ERL_TOP/erts/CONF_INFO <<EOF + + The HALFWORD emulator has been enabled. + This is a DEPRECATED feature scheduled for removal + in a future major release. + +EOF else AC_MSG_ERROR(no; halfword emulator not supported on this architecture) fi @@ -915,7 +955,10 @@ dnl what the user say. This might not be the right way to do it, but dnl for now that is the way we do it. USER_LD=$LD USER_LDFLAGS="$LDFLAGS" -LD='$(CC)' +case $host in + *ose) ;; + *) LD='$(CC)' ;; +esac AC_SUBST(LD) LDFLAG_RUNTIME_LIBRARY_PATH="$CFLAG_RUNTIME_LIBRARY_PATH" @@ -926,12 +969,15 @@ dnl AC_CYGWIN is deprecated AC_EXEEXT AC_OBJEXT -dnl This is the os flavour, should be unix, vxworks or win32 -if test "X$host" = "Xwin32"; then - ERLANG_OSTYPE=win32 -else - ERLANG_OSTYPE=unix -fi +dnl This is the os flavour, should be unix, ose, vxworks or win32 +case $host in + win32) + ERLANG_OSTYPE=win32 ;; + *ose) + ERLANG_OSTYPE=ose ;; + *) + ERLANG_OSTYPE=unix ;; +esac AC_SUBST(ERLANG_OSTYPE) @@ -996,6 +1042,8 @@ AC_CHECK_LIB(dl, dlopen) AC_CHECK_LIB(inet, main) AC_CHECK_LIB(util, openpty) +AC_CHECK_LIB(systemd-daemon, sd_listen_fds) + dnl Try to find a thread library. dnl dnl ETHR_LIB_NAME, ETHR_LIBS, ETHR_X_LIBS, ETHR_THR_LIB_BASE and ETHR_DEFS @@ -1115,7 +1163,7 @@ fi AC_SUBST(ERTS_BUILD_SMP_EMU) -AC_CHECK_FUNCS([posix_fadvise]) +AC_CHECK_FUNCS([posix_fadvise closefrom]) AC_CHECK_HEADERS([linux/falloc.h]) dnl * Old glibcs have broken fallocate64(). Make sure not to use it. AC_CACHE_CHECK([whether fallocate() works],i_cv_fallocate_works,[ @@ -1216,7 +1264,7 @@ case "$enable_threads"-"$found_threads" in AC_MSG_RESULT(yes; enabled by user) ;; unknown-yes) case $host_os in - solaris*|linux*|darwin*|win32) + solaris*|linux*|darwin*|win32|ose) emu_threads=yes AC_MSG_RESULT(yes; default on this platform) ;; @@ -1243,6 +1291,7 @@ if test $emu_threads != yes; then AC_MSG_CHECKING(whether dirty schedulers should be enabled) if test "x$enable_dirty_schedulers" != "xno"; then AC_DEFINE(ERL_NIF_DIRTY_SCHEDULER_SUPPORT, 1, [Dirty scheduler support]) + AC_DEFINE(ERL_DRV_DIRTY_SCHEDULER_SUPPORT, 1, [Dirty scheduler support]) AC_MSG_RESULT(yes) else AC_MSG_RESULT(no) @@ -1271,6 +1320,7 @@ else EMU_THR_DEFS="$EMU_THR_DEFS -DERTS_DIRTY_SCHEDULERS" AC_DEFINE(ERTS_DIRTY_SCHEDULERS, 1, [Define if the emulator supports dirty schedulers]) AC_DEFINE(ERL_NIF_DIRTY_SCHEDULER_SUPPORT, 1, [Dirty scheduler support]) + AC_DEFINE(ERL_DRV_DIRTY_SCHEDULER_SUPPORT, 1, [Dirty scheduler support]) AC_MSG_RESULT(yes) else AC_MSG_RESULT(no) @@ -1296,7 +1346,7 @@ else enable_child_waiter_thread=no fi ;; - win32) + win32|ose) # Child waiter thread cannot be enabled disable_child_waiter_thread=yes enable_child_waiter_thread=no @@ -1629,6 +1679,8 @@ AC_CHECK_MEMBERS([struct ifreq.ifr_enaddr], [], [], #endif ]) +AC_CHECK_HEADERS(systemd/sd-daemon.h) + dnl ---------------------------------------------------------------------- dnl Check the availability for libdlpi dnl ---------------------------------------------------------------------- @@ -2028,7 +2080,7 @@ AC_CHECK_FUNCS([getipnodebyname getipnodebyaddr gethostbyname2]) AC_CHECK_FUNCS([ieee_handler fpsetmask finite isnan isinf res_gethostbyname dlopen \ pread pwrite memmove strerror strerror_r strncasecmp \ gethrtime localtime_r gmtime_r inet_pton \ - mmap mremap memcpy mallopt sbrk _sbrk __sbrk brk _brk __brk \ + memcpy mallopt sbrk _sbrk __sbrk brk _brk __brk \ flockfile fstat strlcpy strlcat setsid posix2time time2posix \ setlocale nl_langinfo poll mlockall]) @@ -2069,6 +2121,17 @@ case $host_os in AC_CHECK_FUNCS([writev]) ;; esac +case $host_os in + *ose) + AC_MSG_CHECKING([for mmap]) + AC_MSG_RESULT(not using for OSE) + AC_MSG_CHECKING([for mremap]) + AC_MSG_RESULT(not using for OSE) ;; + *) + AC_CHECK_FUNCS([mmap mremap]) ;; +esac + + AC_CHECK_DECLS([posix2time, time2posix],,,[#include <time.h>]) disable_vfork=false @@ -2777,6 +2840,9 @@ esac if test X${enable_fp_exceptions} = Xauto ; then case $host_os in + *linux*) + enable_fp_exceptions=no + AC_MSG_NOTICE([Floating point exceptions disabled by default on Linux]) ;; darwin*) enable_fp_exceptions=no AC_MSG_NOTICE([Floating point exceptions disabled by default on MacOS X]) ;; @@ -3920,7 +3986,7 @@ AC_SUBST(STATIC_KERBEROS_LIBS) AC_SUBST(SSL_LINK_WITH_ZLIB) AC_SUBST(STATIC_ZLIB_LIBS) -std_ssl_locations="/usr/local /usr/sfw /usr /opt/local /usr/pkg /usr/local/openssl /usr/lib/openssl /usr/openssl /usr/local/ssl /usr/lib/ssl /usr/ssl" +std_ssl_locations="/usr/local /usr/sfw /usr /opt/local /usr/pkg /usr/local/openssl /usr/lib/openssl /usr/openssl /usr/local/ssl /usr/lib/ssl /usr/ssl /" AC_ARG_WITH(ssl-zlib, AS_HELP_STRING([--with-ssl-zlib=PATH], @@ -4027,6 +4093,7 @@ for a in ssl crypto ssh; do done SSL_DYNAMIC_ONLY=$enable_dynamic_ssl +SSL_STATIC_ONLY=no case "$erl_xcomp_without_sysroot-$with_ssl" in yes-* | no-no) @@ -4146,6 +4213,10 @@ case "$erl_xcomp_without_sysroot-$with_ssl" in else is_real_ssl=no fi + elif test -f "$dir/lib/powerpc/libsslcrypto.a"; then + SSL_CRYPTO_LIBNAME=sslcrypto + SSL_LIBDIR="$dir/lib/powerpc/" + SSL_RUNTIME_LIBDIR="$rdir/lib/powerpc/" else if test "x$ac_cv_sizeof_void_p" = "x8"; then if test -f "$dir/lib64/libcrypto.a"; then @@ -4169,8 +4240,10 @@ case "$erl_xcomp_without_sysroot-$with_ssl" in SSL_LIBDIR="$dir/lib" fi fi - if test '!' -f $SSL_LIBDIR/libcrypto.a; then + if test '!' -f "$SSL_LIBDIR/lib${SSL_CRYPTO_LIBNAME}.a"; then SSL_DYNAMIC_ONLY=yes + elif test '!' -f "$SSL_LIBDIR/lib${SSL_CRYPTO_LIBNAME}.so" -a '!' -f "$SSL_LIBDIR/lib${SSL_CRYPTO_LIBNAME}.dylib"; then + SSL_STATIC_ONLY=yes fi SSL_BINDIR="$rdir/bin" if test "x$is_real_ssl" = "xyes" ; then @@ -4192,13 +4265,20 @@ case "$erl_xcomp_without_sysroot-$with_ssl" in if test "x$ssl_found" = "xyes"; then if test "x$MIXED_CYGWIN" = "xyes" -o "x$MIXED_MSYS" = "xyes"; then ssl_linkable=yes + elif test "x${SSL_CRYPTO_LIBNAME}" = "xsslcrypto"; then + # This should only be triggered seen OSE + ssl_linkable=yes else saveCFLAGS="$CFLAGS" saveLDFLAGS="$LDFLAGS" saveLIBS="$LIBS" CFLAGS="$CFLAGS $SSL_INCLUDE" - LDFLAGS="$LDFLAGS -L$SSL_LIBDIR" - LIBS="-lcrypto" + if test "x$SSL_STATIC_ONLY" = "xyes"; then + LIBS="${SSL_LIBDIR}/lib${SSL_CRYPTO_LIBNAME}.a" + else + LDFLAGS="$LDFLAGS -L$SSL_LIBDIR" + LIBS="$LIBS -l${SSL_CRYPTO_LIBNAME}" + fi AC_TRY_LINK([ #include <stdio.h> #include <openssl/hmac.h>], @@ -4326,6 +4406,9 @@ dnl so it is - be adoptable # This probably wont work, but that's what the user said, so... SSL_LIBDIR="$with_ssl/lib" fi + elif test -f "$dir/lib/powerpc/libsslcrypto.a"; then + SSL_CRYPTO_LIBNAME=sslcrypto + SSL_LIBDIR="$with_ssl/lib/powerpc/" elif test "x$ac_cv_sizeof_void_p" = "x8"; then if test -f "$with_ssl/lib64/libcrypto.a"; then SSL_LIBDIR="$with_ssl/lib64" @@ -4341,8 +4424,10 @@ dnl so it is - be adoptable else SSL_LIBDIR="$with_ssl/lib" fi - if test '!' -f $SSL_LIBDIR/libcrypto.a; then + if test '!' -f "${SSL_LIBDIR}/lib${SSL_CRYPTO_LIBNAME}.a"; then SSL_DYNAMIC_ONLY=yes + elif test '!' -f ${SSL_LIBDIR}/lib${SSL_CRYPTO_LIBNAME}.so -a '!' -f "$SSL_LIBDIR/lib${SSL_CRYPTO_LIBNAME}.dylib"; then + SSL_STATIC_ONLY=yes fi SSL_INCLUDE="-I$with_ssl/include" SSL_APP=ssl @@ -4736,6 +4821,7 @@ AC_OUTPUT( Makefile:Makefile.in ../make/$host/otp.mk:../make/otp.mk.in ../make/$host/otp_ded.mk:../make/otp_ded.mk.in + ../make/$host/ose_lm.mk:../make/ose_lm.mk.in dnl dnl The ones below should be moved to their respective lib dnl diff --git a/erts/doc/src/driver_entry.xml b/erts/doc/src/driver_entry.xml index 48dfcb09b1..b34ca136f3 100644 --- a/erts/doc/src/driver_entry.xml +++ b/erts/doc/src/driver_entry.xml @@ -245,10 +245,14 @@ typedef struct erl_drv_entry { something that the <c>WaitForMultipleObjects</c> API function understands). (Some trickery in the emulator allows more than the built-in limit of 64 <c>Events</c> to be used.)</p> + <p>On Enea OSE the <c>event</c> is one or more signals that can + be retrieved using <seealso marker="ose:ose_erl_driver#erl_drv_ose_get_signal">erl_drv_ose_get_signal</seealso>.</p> <p>To use this with threads and asynchronous routines, create a - pipe on unix and an Event on Windows. When the routine + pipe on unix, an Event on Windows or a unique signal number on + Enea OSE. When the routine completes, write to the pipe (use <c>SetEvent</c> on - Windows), this will make the emulator call + Windows or send a message to the emulator process on Enea OSE), + this will make the emulator call <c>ready_input</c> or <c>ready_output</c>.</p> <p>Spurious events may happen. That is, calls to <c>ready_input</c> or <c>ready_output</c> even though no real events are signaled. In diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index 4aa3033f40..9724a1345a 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -536,7 +536,7 @@ <tag><marker id="file_name_encoding"></marker><c><![CDATA[+fnl]]></c></tag> <item> <p>The VM works with file names as if they are encoded using the ISO-latin-1 encoding, disallowing Unicode characters with codepoints beyond 255.</p> - <p>See <seealso marker="stdlib:unicode_usage#unicode_file_names">STDLIB User's Guide</seealso> for more infomation about unicode file names.</p> + <p>See <seealso marker="stdlib:unicode_usage#unicode_file_names">STDLIB User's Guide</seealso> for more infomation about unicode file names. Note that this value also applies to command-line parameters and environment variables (see <seealso marker="stdlib:unicode_usage#unicode_in_environment_and_parameters">STDLIB User's Guide</seealso>).</p> </item> <tag><c><![CDATA[+fnu[{w|i|e}]]]></c></tag> <item> @@ -555,7 +555,7 @@ encountered. <c>w</c> is the default. Note that <c>file:read_link/1</c> will always return an error if the link points to an invalid file name.</p> - <p>See <seealso marker="stdlib:unicode_usage#unicode_file_names">STDLIB User's Guide</seealso> for more infomation about unicode file names.</p> + <p>See <seealso marker="stdlib:unicode_usage#unicode_file_names">STDLIB User's Guide</seealso> for more infomation about unicode file names. Note that this value also applies to command-line parameters and environment variables (see <seealso marker="stdlib:unicode_usage#unicode_in_environment_and_parameters">STDLIB User's Guide</seealso>).</p> </item> <tag><c><![CDATA[+fna[{w|i|e}]]]></c></tag> <item> @@ -572,7 +572,7 @@ settings cause the behavior of <c>+fnl</c> to be selected, then <c>w</c>, <c>i</c>, or <c>e</c> will not have any effect.</p> - <p>See <seealso marker="stdlib:unicode_usage#unicode_file_names">STDLIB User's Guide</seealso> for more infomation about unicode file names.</p> + <p>See <seealso marker="stdlib:unicode_usage#unicode_file_names">STDLIB User's Guide</seealso> for more infomation about unicode file names. Note that this value also applies to command-line parameters and environment variables (see <seealso marker="stdlib:unicode_usage#unicode_in_environment_and_parameters">STDLIB User's Guide</seealso>).</p> </item> <tag><c><![CDATA[+hms Size]]></c></tag> <item> diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml index 710c9b19cf..ad37813ac0 100644 --- a/erts/doc/src/erl_driver.xml +++ b/erts/doc/src/erl_driver.xml @@ -315,10 +315,13 @@ <c>ERL_DRV_EXTENDED_MINOR_VERSION</c> will be incremented when new features are added. The runtime system uses the minor version of the driver to determine what features to use. - The runtime system will refuse to load a driver if the major + The runtime system will normally refuse to load a driver if the major versions differ, or if the major versions are equal and the minor version used by the driver is greater than the one used - by the runtime system.</p> + by the runtime system. Old drivers with lower major versions + will however be allowed after a bump of the major version during + a transition period of two major releases. Such old drivers might + however fail if deprecated features are used.</p> <p>The emulator will refuse to load a driver that does not use the extended driver interface, to allow for 64-bit capable drivers, @@ -1035,7 +1038,9 @@ typedef struct ErlIOVec { <c>select</c>/<c>poll</c> can use). On windows, the Win32 API function <c>WaitForMultipleObjects</c> is used. This places other restrictions on the event object. - Refer to the Win32 SDK documentation.</p> + Refer to the Win32 SDK documentation. + On Enea OSE, the receive function is used. See the <seealso + marker="ose:ose_erl_driver"></seealso> for more details.</p> <p>The <c>on</c> parameter should be <c>1</c> for setting events and <c>0</c> for clearing them.</p> <p>The <c>mode</c> argument is a bitwise-or combination of @@ -1047,7 +1052,7 @@ typedef struct ErlIOVec { <seealso marker="driver_entry#ready_output">ready_output</seealso>. </p> <note> - <p>Some OS (Windows) do not differentiate between read and write events. + <p>Some OS (Windows and Enea OSE) do not differentiate between read and write events. The call-back for a fired event then only depends on the value of <c>mode</c>.</p> </note> <p><c>ERL_DRV_USE</c> specifies if we are using the event object or if we want to close it. diff --git a/erts/doc/src/erl_ext_dist.xml b/erts/doc/src/erl_ext_dist.xml index f91ed78122..fa083db4c7 100644 --- a/erts/doc/src/erl_ext_dist.xml +++ b/erts/doc/src/erl_ext_dist.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>2007</year> - <year>2013</year> + <year>2014</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -573,6 +573,33 @@ </section> <section> + <marker id="MAP_EXT"/> + <title>MAP_EXT</title> + + <table align="left"> + <row> + <cell align="center">1</cell> + <cell align="center">4</cell> + <cell align="center">N</cell> + </row> + <row> + <cell align="center">116</cell> + <cell align="center">Arity</cell> + <cell align="center">Pairs</cell> + </row> + <tcaption></tcaption></table> + <p> + <c>MAP_EXT</c> encodes a map. The <c>Arity</c> field is an unsigned + 4 byte integer in big endian format that determines the number of + key-value pairs in the map. Key and value pairs (<c>Ki => Vi</c>) + are encoded in the <c>Pairs</c> section in the following order: + <c>K1, V1, K2, V2,..., Kn, Vn</c>. + Duplicate keys are <em>not allowed</em> within the same map. + </p> + <p><em>Since: </em>OTP 17.0</p> + </section> + + <section> <marker id="NIL_EXT"/> <title>NIL_EXT</title> diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 8b19725c02..6b1f4cccf8 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -316,6 +316,32 @@ ok <p>The library initialization callbacks <c>load</c>, <c>reload</c> and <c>upgrade</c> are all thread-safe even for shared state data.</p> </item> + + <tag><marker id="version_management"/>Version Management</tag> + <item><p> + When a NIF library is built, information about NIF API version + is compiled into the library. When a NIF library is loaded the + runtime system verifies that the library is of a compatible version. + <c>erl_nif.h</c> defines <c>ERL_NIF_MAJOR_VERSION</c>, and + <c>ERL_NIF_MINOR_VERSION</c>. <c>ERL_NIF_MAJOR_VERSION</c> will be + incremented when NIF library incompatible changes are made to the + Erlang runtime system. Normally it will suffice to recompile the NIF + library when the <c>ERL_NIF_MAJOR_VERSION</c> has changed, but it + could, under rare circumstances, mean that NIF libraries have to + be slightly modified. If so, this will of course be documented. + <c>ERL_NIF_MINOR_VERSION</c> will be incremented when + new features are added. The runtime system uses the minor version + to determine what features to use. + </p><p> + The runtime system will normally refuse to load a NIF library if + the major versions differ, or if the major versions are equal and + the minor version used by the NIF library is greater than the one + used by the runtime system. Old NIF libraries with lower major + versions will however be allowed after a bump of the major version + during a transition period of two major releases. Such old NIF + libraries might however fail if deprecated features are used. + </p></item> + <tag>Dirty NIFs</tag> <item><p><marker id="dirty_nifs"/><em>Note that the dirty NIF functionality is experimental</em> and that you have to enable support for dirty diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 0f312fb430..7aaded200c 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -887,7 +887,7 @@ <fsummary>Print a term on standard output</fsummary> <desc> <p>Prints a text representation of <c><anno>Term</anno></c> on the standard - output.</p> + output. On OSE the term is printed to the ramlog.</p> <warning> <p>This BIF is intended for debugging only.</p> </warning> @@ -5203,9 +5203,16 @@ ok <c>erlang:system_info(schedulers_online)</c>. </p> <p>Returns the old value of the flag.</p> - <p><em>Note that the dirty schedulers functionality is experimental</em>, and - that you have to enable support for dirty schedulers when building OTP in - order to try the functionality out.</p> + <p>Note that the number of dirty CPU schedulers online may change if the number of + schedulers online changes. For example, if there are 12 schedulers and all are + online, and 6 dirty CPU schedulers, all online as well, and <c>system_flag/2</c> + is used to set the number of schedulers online to 6, then the number of dirty + CPU schedulers online is automatically decreased by half as well, down to 3. + Similarly, the number of dirty CPU schedulers online increases proportionally + to increases in the number of schedulers online.</p> + <p><em>Note that the dirty schedulers functionality is experimental</em>, and + that you have to enable support for dirty schedulers when building OTP in order + to try out the functionality.</p> <p>For more information see <seealso marker="#system_info_dirty_cpu_schedulers">erlang:system_info(dirty_cpu_schedulers)</seealso> and @@ -5438,6 +5445,15 @@ ok <![CDATA[1 <= SchedulersOnline <= erlang:system_info(schedulers)]]>. </p> <p>Returns the old value of the flag.</p> + <p>Note that if the emulator was built with support for <seealso + marker="#system_flag_dirty_cpu_schedulers_online">dirty schedulers</seealso>, + changing the number of schedulers online can also change the number of dirty + CPU schedulers online. For example, if there are 12 schedulers and all are + online, and 6 dirty CPU schedulers, all online as well, and <c>system_flag/2</c> + is used to set the number of schedulers online to 6, then the number of dirty + CPU schedulers online is automatically decreased by half as well, down to 3. + Similarly, the number of dirty CPU schedulers online increases proportionally + to increases in the number of schedulers online.</p> <p>For more information see, <seealso marker="#system_info_schedulers">erlang:system_info(schedulers)</seealso>, and @@ -5817,12 +5833,13 @@ ok boot time and cannot be changed after that. The number of dirty CPU scheduler threads online can however be changed at any time. The number of dirty CPU schedulers can be set on startup by passing - the <seealso marker="erts:erl#+SDcpu">+SDcpu</seealso> command line flag, see - <seealso marker="erts:erl#+SDcpu">erl(1)</seealso>. + the <seealso marker="erts:erl#+SDcpu">+SDcpu</seealso> or + <seealso marker="erts:erl#+SDPcpu">+SDPcpu</seealso> command line flags, + see <seealso marker="erts:erl#+SDcpu">erl(1)</seealso>. </p> <p><em>Note that the dirty schedulers functionality is experimental</em>, and that you have to enable support for dirty schedulers when building OTP in - order to try the functionality out.</p> + order to try out the functionality.</p> <p>See also <seealso marker="#system_flag_dirty_cpu_schedulers_online">erlang:system_flag(dirty_cpu_schedulers_online, DirtyCPUSchedulersOnline)</seealso>, <seealso marker="#system_info_dirty_cpu_schedulers_online">erlang:system_info(dirty_cpu_schedulers_online)</seealso>, <seealso marker="#system_info_dirty_io_schedulers">erlang:system_info(dirty_io_schedulers)</seealso>, @@ -5844,7 +5861,7 @@ ok </p> <p><em>Note that the dirty schedulers functionality is experimental</em>, and that you have to enable support for dirty schedulers when building OTP in - order to try the functionality out.</p> + order to try out the functionality.</p> <p>For more information, see <seealso marker="#system_info_dirty_cpu_schedulers">erlang:system_info(dirty_cpu_schedulers)</seealso>, <seealso marker="#system_info_dirty_io_schedulers">erlang:system_info(dirty_io_schedulers)</seealso>, @@ -5864,7 +5881,7 @@ ok </p> <p><em>Note that the dirty schedulers functionality is experimental</em>, and that you have to enable support for dirty schedulers when building OTP in - order to try the functionality out.</p> + order to try out the functionality.</p> <p>For more information, see <seealso marker="#system_info_dirty_cpu_schedulers">erlang:system_info(dirty_cpu_schedulers)</seealso>, <seealso marker="#system_info_dirty_cpu_schedulers_online">erlang:system_info(dirty_cpu_schedulers_online)</seealso>, and @@ -6104,8 +6121,8 @@ ok <c>erlang:system_info()</c> argument giving the exact OTP version. This since the exact OTP version in the general case is hard to determine. For more information see - <seealso marker="doc/installation_guide:otp_version">the - documentation of the OTP version in the installation + <seealso marker="doc/system_principles:versions">the + documentation of versions in the system principles guide</seealso>.</p> </item> <tag><marker id="system_info_port_parallelism"><c>port_parallelism</c></marker></tag> @@ -6572,11 +6589,12 @@ ok some details of the encoding. This option was introduced in R11B-4. Currently, the allowed values for <c><anno>Version</anno></c> are <c>0</c> and <c>1</c>.</p> - <p><c>{minor_version, 1}</c> forces any floats in the term to be encoded + <p><c>{minor_version, 1}</c> is since 17.0 the default, it forces any floats in + the term to be encoded in a more space-efficient and exact way (namely in the 64-bit IEEE format, rather than converted to a textual representation). <c>binary_to_term/1</c> - in R11B-4 and later is able decode the new representation.</p> - <p><c>{minor_version, 0}</c> is currently the default, meaning that floats + in R11B-4 and later is able decode this representation.</p> + <p><c>{minor_version, 0}</c> meaning that floats will be encoded using a textual representation; this option is useful if you want to ensure that releases prior to R11B-4 can decode resulting binary.</p> diff --git a/erts/doc/src/escript.xml b/erts/doc/src/escript.xml index d2b09d4515..9159d68f60 100644 --- a/erts/doc/src/escript.xml +++ b/erts/doc/src/escript.xml @@ -4,7 +4,7 @@ <comref> <header> <copyright> - <year>2007</year><year>2013</year> + <year>2007</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -92,6 +92,18 @@ $ <input>escript factorial 5</input> </pre> marker="stdlib:epp#encoding">encoding</seealso> it can be located on the second line.</p> + <note><p> + The encoding specified by the above mentioned comment + applies to the script itself. The encoding of the + I/O-server, however, has to be set explicitly like this: +<code>io:setopts([{encoding, unicode}])</code></p> + <p>The default encoding of the I/O-server for <c>standard_io</c> + is <c>latin1</c> + since the script runs in a non-interactive terminal + (see <seealso marker="stdlib:unicode_usage#unicode_options_summary"> + Using Unicode in Erlang</seealso>). + </p></note> + <p>On the third line (or second line depending on the presence of the Emacs directive), it is possible to give arguments to the emulator, such as </p> @@ -141,8 +153,9 @@ halt(1).</pre> -include_lib("kernel/include/file.hrl").</pre> <p>to include the record definitions for the records used by the <c>file:read_link_info/1</c> function. You can also select - encoding here, but if there is a valid encoding comment on - the second line it takes precedence.</p> + encoding by including a encoding comment here, but if there + is a valid encoding comment on the second line it takes + precedence.</p> <p>The script will be checked for syntactic and semantic correctness before being run. If there are warnings (such as @@ -163,7 +176,7 @@ halt(1).</pre> If much of the execution takes place in interpreted code it may be worthwhile to compile it, even though the compilation itself will take a little while. It is also possible to supply - <c>native</c> instead of compile, this will compile the script + <c>native</c> instead of <c>compile</c>, this will compile the script using the native flag, again depending on the characteristics of the escript this could or could not be worth while.</p> @@ -223,8 +236,13 @@ factorial 5 = 120 <v>EmuArgs = string() | 'undefined'</v> <v>Body = {source, SourceCode} | {beam, BeamCode} - | {archive, ZipArchive}</v> - <v>SourceCode = BeamCode = ZipArchive = binary()</v> + | {archive, ZipArchive} + | {archive, ZipFiles, ZipOptions}</v> + <v>SourceCode = BeamCode = file:filename() | binary()</v> + <v>ZipArchive = <seealso marker="stdlib:zip#type-filename">zip:filename()</seealso> | binary()</v> + <v>ZipFiles = [ZipFile]</v> + <v>ZipFile = file:filename() | {file:filename(), binary()} | {file:filename(), binary(), file:file_info()}</v> + <v>ZipOptions = [<seealso marker="stdlib:zip#type-create_option">zip:create_option()</seealso>]</v> </type> <desc> <p>The <marker id="create_2"></marker> <c>create/2</c> @@ -239,7 +257,7 @@ factorial 5 = 120 can either be returned as a binary or written to file.</p> <p>As an example of how the function can be used, we create an - interpreted escript which uses emu_args to set some emulator + interpreted escript which uses <c>emu_args</c> to set some emulator flag. In this case it happens to disable the smp_support. We do also extract the different sections from the newly created script:</p> diff --git a/erts/doc/src/run_erl.xml b/erts/doc/src/run_erl.xml index 684f7b1ddd..28e94c6da8 100644 --- a/erts/doc/src/run_erl.xml +++ b/erts/doc/src/run_erl.xml @@ -58,7 +58,7 @@ first argument to run_erl on the command line.</item> <tag>pipe_dir</tag> <item>This is where to put the named pipe, usually - <c><![CDATA[/tmp/]]></c>. It shall be suffixed by a <c><![CDATA[/]]></c> (slash), + <c><![CDATA[/tmp/]]></c> on Unix or <c><![CDATA[/pipe/]]></c> on OSE. It shall be suffixed by a <c><![CDATA[/]]></c> (slash), i.e. not <c><![CDATA[/tmp/epipies]]></c>, but <c><![CDATA[/tmp/epipes/]]></c>. </item> <tag>log_dir</tag> <item>This is where the log files are written. There will be one diff --git a/erts/doc/src/time_correction.xml b/erts/doc/src/time_correction.xml index d52cc7f3e2..7f7c28fc30 100644 --- a/erts/doc/src/time_correction.xml +++ b/erts/doc/src/time_correction.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="utf8" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE chapter SYSTEM "chapter.dtd"> <chapter> <header> <copyright> - <year>1999</year><year>2013</year> + <year>1999</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 5e5b98bbd6..58639c7190 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -22,6 +22,9 @@ include ../vsn.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk -include $(TARGET)/gen_git_version.mk +ifeq ($(findstring ose,$(TARGET)),ose) +include $(ERL_TOP)/make/$(TARGET)/ose_lm.mk +endif ENABLE_ALLOC_TYPE_VARS = @ENABLE_ALLOC_TYPE_VARS@ HIPE_ENABLED=@HIPE_ENABLED@ @@ -234,7 +237,9 @@ HCC = @HCC@ LD = @LD@ DEXPORT = @DEXPORT@ RANLIB = @RANLIB@ +ifneq ($(findstring ose,$(TARGET)),ose) STRIP = strip +endif PERL = @PERL@ RM = @RM@ MKDIR = @MKDIR@ @@ -373,7 +378,9 @@ LIBS += -l$(ERTS_INTERNAL_LIB)$(TYPEMARKER) endif # erts_internal_r +ifneq ($(TARGET),arm-unknown-linux-androideabi) LIBS += @LIBRT@ +endif LIBS += @LIBCARBON@ @@ -409,13 +416,6 @@ else UNIX_ONLY_BUILDS = endif -ifeq ($(TARGET), win32) -TMPVAR := $(shell LANG=C $(PERL) utils/make_compiler_flags -o $(TTF_DIR)/erl_compile_flags.h -v CONFIG_H "N/A" -v CFLAGS "$(CFLAGS)" -v LDFLAGS "$(LDFLAGS)") -else -# We force this to be run every time this makefile is executed -TMPVAR := $(shell LANG=C $(PERL) utils/make_compiler_flags -o $(TTF_DIR)/erl_compile_flags.h -f CONFIG_H "$(ERL_TOP)/erts/$(TARGET)/config.h" -v CFLAGS "$(CFLAGS)" -v LDFLAGS "$(LDFLAGS)") -endif - .PHONY: all ifdef VOID_EMULATOR all: @@ -494,6 +494,15 @@ release_docs_spec: _create_dirs := $(shell mkdir -p $(CREATE_DIRS)) + +# has to be run after _create_dirs +ifeq ($(TARGET), win32) +TMPVAR := $(shell LANG=C $(PERL) utils/make_compiler_flags -o $(TTF_DIR)/erl_compile_flags.h -v CONFIG_H "N/A" -v CFLAGS "$(CFLAGS)" -v LDFLAGS "$(LDFLAGS)") +else +# We force this to be run every time this makefile is executed +TMPVAR := $(shell LANG=C $(PERL) utils/make_compiler_flags -o $(TTF_DIR)/erl_compile_flags.h -f CONFIG_H "$(ERL_TOP)/erts/$(TARGET)/config.h" -v CFLAGS "$(CFLAGS)" -v LDFLAGS "$(LDFLAGS)") +endif + GENERATE = HIPE_ASM = @@ -684,6 +693,14 @@ $(OBJDIR)/%.o: $(TTF_DIR)/%.c $(OBJDIR)/%.o: sys/$(ERLANG_OSTYPE)/%.c $(V_CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ +ifeq ($(findstring ose,$(TARGET)),ose) +$(OBJDIR)/ose_confd.o: $(OSE_CONFD) + $(V_CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ + +$(OBJDIR)/crt0_lm.o: $(CRT0_LM) + $(V_CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ +endif + $(OBJDIR)/%.o: sys/common/%.c $(V_CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ @@ -786,7 +803,8 @@ DRV_OBJS = \ $(OBJDIR)/efile_drv.o \ $(OBJDIR)/inet_drv.o \ $(OBJDIR)/zlib_drv.o \ - $(OBJDIR)/ram_file_drv.o + $(OBJDIR)/ram_file_drv.o \ + $(OBJDIR)/ttsl_drv.o OS_OBJS = \ $(OBJDIR)/win_efile.o \ $(OBJDIR)/win_con.o \ @@ -798,6 +816,30 @@ OS_OBJS = \ $(OBJDIR)/sys_interrupt.o \ $(OBJDIR)/sys_env.o \ $(OBJDIR)/dosmap.o + +else +ifeq ($(findstring ose,$(TARGET)),ose) +OS_OBJS = \ + $(OBJDIR)/sys.o \ + $(OBJDIR)/driver_tab.o \ + $(OBJDIR)/ose_efile.o \ + $(OBJDIR)/gzio.o \ + $(OBJDIR)/elib_memmove.o + +OS_OBJS += $(OBJDIR)/ose_confd.o \ + $(OBJDIR)/crt0_lm.o + +OS_OBJS += $(OBJDIR)/sys_float.o \ + $(OBJDIR)/sys_time.o + +DRV_OBJS = \ + $(OBJDIR)/efile_drv.o \ + $(OBJDIR)/ose_signal_drv.o \ + $(OBJDIR)/inet_drv.o \ + $(OBJDIR)/zlib_drv.o \ + $(OBJDIR)/ram_file_drv.o \ + $(OBJDIR)/ttsl_drv.o + else OS_OBJS = \ $(OBJDIR)/sys.o \ @@ -812,10 +854,10 @@ DRV_OBJS = \ $(OBJDIR)/efile_drv.o \ $(OBJDIR)/inet_drv.o \ $(OBJDIR)/zlib_drv.o \ - $(OBJDIR)/ram_file_drv.o + $(OBJDIR)/ram_file_drv.o \ + $(OBJDIR)/ttsl_drv.o +endif endif - - DRV_OBJS += $(OBJDIR)/ttsl_drv.o ifneq ($(STATIC_NIFS),no) STATIC_NIF_LIBS = $(STATIC_NIFS) @@ -836,7 +878,9 @@ endif ifeq ($(COMPILE_STATIC_LIBS),yes) $(STATIC_NIF_LIBS) $(STATIC_DRIVER_LIBS): - $(MAKE) BUILD_STATIC_LIBS=1 TYPE=$(TYPE) -C $(ERL_TOP)/lib/ static_lib + echo "=== Entering lib to make static libs" + (cd $(ERL_TOP)/lib/ && $(MAKE) BUILD_STATIC_LIBS=1 TYPE=$(TYPE) static_lib) + echo "=== Leaving lib after making static libs" endif ifeq ($(ERTS_ENABLE_KERNEL_POLL),yes) @@ -986,6 +1030,13 @@ $(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS) $(ld_verbose)$(PURIFY) $(LD) -dll -def:sys/$(ERLANG_OSTYPE)/erl.def -implib:$(BINDIR)/erl_dll.lib -o $(BINDIR)/$(EMULATOR_EXECUTABLE) \ $(LDFLAGS) $(DEXPORT) $(INIT_OBJS) $(OBJS) $(STATIC_NIF_LIBS) \ $(STATIC_DRIVER_LIBS) $(LIBS) + +else +ifeq ($(findstring ose,$(TARGET)),ose) +$(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS) $(LCF) + $(call build-ose-load-module, $@, $(INIT_OBJS) $(OBJS), $(STATIC_NIF_LIBS) \ + $(STATIC_DRIVER_LIBS) $(LIBS), $(BEAM_LMCONF)) + else $(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS) echo $(DEPLIBS) @@ -994,6 +1045,7 @@ $(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS) $(STATIC_NIF_LIBS) $(STATIC_DRIVER_LIBS) $(LIBS) endif +endif # ---------------------------------------------------------------------- # Dependencies @@ -1039,7 +1091,9 @@ BEAM_SRC=$(wildcard beam/*.c) DRV_COMMON_SRC=$(wildcard drivers/common/*.c) DRV_OSTYPE_SRC=$(wildcard drivers/$(ERLANG_OSTYPE)/*.c) ALL_SYS_SRC=$(wildcard sys/$(ERLANG_OSTYPE)/*.c) $(wildcard sys/common/*.c) -TARGET_SRC=$(wildcard $(TARGET)/*.c) $(wildcard $(TTF_DIR)/*.c) +# We use $(shell ls) here instead of wildcard as $(wildcard ) resolved at +# loadtime of the makefile and at that time these files are not generated yet. +TARGET_SRC=$(shell ls $(TARGET)/*.c) $(shell ls $(TTF_DIR)/*.c) # I do not want the -MG flag on windows, it does not work properly for a # windows build. diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 96547ba743..d28e519ae1 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -179,6 +179,7 @@ atom dexit atom depth atom dgroup_leader atom dictionary +atom dirty_cpu_schedulers_online atom disable_trace atom disabled atom display_items diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 3f92c5b025..df1983a83d 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -201,7 +201,7 @@ finish_loading_1(BIF_ALIST_1) * to keep the elements in. */ - n = list_length(BIF_ARG_1); + n = erts_list_length(BIF_ARG_1); if (n == -1) { ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG); goto done; diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 68907a771a..4e711c89e0 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -46,7 +46,8 @@ #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) + if ((P)) erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN,\ + __FILE__, __LINE__) # define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) \ if ((P)) erts_proc_lc_unrequire_lock((P), ERTS_PROC_LOCK_MAIN) #else @@ -641,7 +642,7 @@ erts_generic_breakpoint(Process* c_p, BeamInstr* I, Eterm* reg) erts_smp_atomic_inc_nob(&bp->count->acount); } - if (bp_flags & ERTS_BPF_TIME_TRACE_ACTIVE) { + if (bp_flags & ERTS_BPF_TIME_TRACE_ACTIVE && erts_is_tracer_proc_valid(c_p)) { Eterm w; erts_trace_time_call(c_p, I, bp->time); w = (BeamInstr) *c_p->cp; @@ -729,7 +730,8 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) } } if (bp_flags & ERTS_BPF_TIME_TRACE_ACTIVE && - IS_TRACED_FL(p, F_TRACE_CALLS)) { + IS_TRACED_FL(p, F_TRACE_CALLS) && + erts_is_tracer_proc_valid(p)) { BeamInstr *pc = (BeamInstr *)ep->code+3; erts_trace_time_call(p, pc, bp->time); } diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 6f295530b9..9634faff1d 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -71,7 +71,8 @@ do { \ ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); \ } while (0) # define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) \ - if ((P)) erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN) + if ((P)) erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN,\ + __FILE__, __LINE__) # define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) \ if ((P)) erts_proc_lc_unrequire_lock((P), ERTS_PROC_LOCK_MAIN) # else @@ -1190,11 +1191,16 @@ void process_main(void) * c_p->arg_reg before calling the scheduler. */ if (!init_done) { + /* This should only be reached during the init phase when only the main + * process is running. I.e. there is no race for init_done. + */ init_done = 1; goto init_emulator; } + c_p = NULL; reds_used = 0; + goto do_schedule1; do_schedule: @@ -1203,7 +1209,11 @@ void process_main(void) if (start_time != 0) { Sint64 diff = erts_timestamp_millis() - start_time; - if (diff > 0 && (Uint) diff > erts_system_monitor_long_schedule) { + if (diff > 0 && (Uint) diff > erts_system_monitor_long_schedule +#ifdef ERTS_DIRTY_SCHEDULERS + && !ERTS_SCHEDULER_IS_DIRTY(c_p->scheduler_data) +#endif + ) { BeamInstr *inptr = find_function_from_pc(start_time_i); BeamInstr *outptr = find_function_from_pc(c_p->i); monitor_long_schedule_proc(c_p,inptr,outptr,(Uint) diff); @@ -1291,7 +1301,7 @@ void process_main(void) (Eterm)fptr[1], (Uint)fptr[2], NULL, fun_buf); } else { - erts_snprintf(fun_buf, sizeof(fun_buf), + erts_snprintf(fun_buf, sizeof(DTRACE_CHARBUF_NAME(fun_buf)), "<unknown/%p>", next); } } diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 53df7876d8..e96177cfd9 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -5870,7 +5870,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) Funcs = tp[1]; Patchlist = tp[2]; - if ((n = list_length(Funcs)) < 0) { + if ((n = erts_list_length(Funcs)) < 0) { goto error; } if ((bytes = erts_get_aligned_binary_bytes(Beam, &temp_alloc)) == NULL) { diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 9c4801041f..06a1230ca0 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -2675,7 +2675,7 @@ BIF_RETTYPE list_to_atom_1(BIF_ALIST_1) if (i < 0) { erts_free(ERTS_ALC_T_TMP, (void *) buf); - i = list_length(BIF_ARG_1); + i = erts_list_length(BIF_ARG_1); if (i > MAX_ATOM_CHARACTERS) { BIF_ERROR(BIF_P, SYSTEM_LIMIT); } @@ -2953,7 +2953,7 @@ BIF_RETTYPE list_to_integer_2(BIF_ALIST_2) char *buf = NULL; int base; - i = list_length(BIF_ARG_1); + i = erts_list_length(BIF_ARG_1); if (i < 0) BIF_ERROR(BIF_P, BADARG); @@ -3292,7 +3292,7 @@ BIF_RETTYPE list_to_float_1(BIF_ALIST_1) Eterm res; char *buf = NULL; - i = list_length(BIF_ARG_1); + i = erts_list_length(BIF_ARG_1); if (i < 0) BIF_ERROR(BIF_P, BADARG); @@ -3407,7 +3407,7 @@ BIF_RETTYPE list_to_tuple_1(BIF_ALIST_1) Eterm* hp; int len; - if ((len = list_length(list)) < 0 || len > ERTS_MAX_TUPLE_SIZE) { + if ((len = erts_list_length(list)) < 0 || len > ERTS_MAX_TUPLE_SIZE) { BIF_ERROR(BIF_P, BADARG); } @@ -4333,7 +4333,11 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) switch (erts_set_schedulers_online(BIF_P, ERTS_PROC_LOCK_MAIN, signed_val(BIF_ARG_2), - &old_no)) { + &old_no +#ifdef ERTS_DIRTY_SCHEDULERS + , 0 +#endif + )) { case ERTS_SCHDLR_SSPND_DONE: BIF_RET(make_small(old_no)); case ERTS_SCHDLR_SSPND_YIELD_RESTART: @@ -4465,6 +4469,33 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) ref, old ? am_true : am_false); } +#if defined(ERTS_SMP) && defined(ERTS_DIRTY_SCHEDULERS) + } else if (BIF_ARG_1 == am_dirty_cpu_schedulers_online) { + Sint old_no; + if (!is_small(BIF_ARG_2)) + goto error; + switch (erts_set_schedulers_online(BIF_P, + ERTS_PROC_LOCK_MAIN, + signed_val(BIF_ARG_2), + &old_no, + 1)) { + case ERTS_SCHDLR_SSPND_DONE: + BIF_RET(make_small(old_no)); + case ERTS_SCHDLR_SSPND_YIELD_RESTART: + ERTS_VBUMP_ALL_REDS(BIF_P); + BIF_TRAP2(bif_export[BIF_system_flag_2], + BIF_P, BIF_ARG_1, BIF_ARG_2); + case ERTS_SCHDLR_SSPND_YIELD_DONE: + ERTS_BIF_YIELD_RETURN_X(BIF_P, make_small(old_no), + am_dirty_cpu_schedulers_online); + case ERTS_SCHDLR_SSPND_EINVAL: + goto error; + default: + ASSERT(0); + BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); + break; + } +#endif } else if (ERTS_IS_ATOM_STR("scheduling_statistics", BIF_ARG_1)) { int what; if (ERTS_IS_ATOM_STR("disable", BIF_ARG_2)) diff --git a/erts/emulator/beam/code_ix.c b/erts/emulator/beam/code_ix.c index c66d5a2f05..4344558348 100644 --- a/erts/emulator/beam/code_ix.c +++ b/erts/emulator/beam/code_ix.c @@ -58,7 +58,8 @@ void erts_code_ix_init(void) erts_smp_atomic32_init_nob(&the_staging_code_index, 0); erts_smp_mtx_init(&code_write_permission_mtx, "code_write_permission"); #ifdef ERTS_ENABLE_LOCK_CHECK - erts_tsd_key_create(&has_code_write_permission); + erts_tsd_key_create(&has_code_write_permission, + "erts_has_code_write_permission"); #endif CIX_TRACE("init"); } diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 3a987e213b..50548850eb 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -48,7 +48,8 @@ copy_object(Eterm obj, Process* to) if (DTRACE_ENABLED(copy_object)) { DTRACE_CHARBUF(proc_name, 64); - erts_snprintf(proc_name, sizeof(proc_name), "%T", to->common.id); + erts_snprintf(proc_name, sizeof(DTRACE_CHARBUF_NAME(proc_name)), + "%T", to->common.id); DTRACE2(copy_object, proc_name, size); } #endif diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 6ecf3f0722..ec07ddcd9c 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -851,9 +851,12 @@ erts_dsig_send_msg(ErtsDSigData *dsdp, Eterm remote, Eterm message) #ifdef USE_VM_PROBES *node_name = *sender_name = *receiver_name = '\0'; if (DTRACE_ENABLED(message_send) || DTRACE_ENABLED(message_send_remote)) { - erts_snprintf(node_name, sizeof(node_name), "%T", dsdp->dep->sysname); - erts_snprintf(sender_name, sizeof(sender_name), "%T", sender->common.id); - erts_snprintf(receiver_name, sizeof(receiver_name), "%T", remote); + erts_snprintf(node_name, sizeof(DTRACE_CHARBUF_NAME(node_name)), + "%T", dsdp->dep->sysname); + erts_snprintf(sender_name, sizeof(DTRACE_CHARBUF_NAME(sender_name)), + "%T", sender->common.id); + erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)), + "%T", remote); msize = size_object(message); if (token != NIL && token != am_have_dt_utag) { tok_label = signed_val(SEQ_TRACE_T_LABEL(token)); @@ -908,9 +911,11 @@ erts_dsig_send_reg_msg(ErtsDSigData *dsdp, Eterm remote_name, Eterm message) #ifdef USE_VM_PROBES *node_name = *sender_name = *receiver_name = '\0'; if (DTRACE_ENABLED(message_send) || DTRACE_ENABLED(message_send_remote)) { - erts_snprintf(node_name, sizeof(node_name), "%T", dsdp->dep->sysname); - erts_snprintf(sender_name, sizeof(sender_name), "%T", sender->common.id); - erts_snprintf(receiver_name, sizeof(receiver_name), + erts_snprintf(node_name, sizeof(DTRACE_CHARBUF_NAME(node_name)), + "%T", dsdp->dep->sysname); + erts_snprintf(sender_name, sizeof(DTRACE_CHARBUF_NAME(sender_name)), + "%T", sender->common.id); + erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)), "{%T,%s}", remote_name, node_name); msize = size_object(message); if (token != NIL && token != am_have_dt_utag) { @@ -971,11 +976,14 @@ erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote, #ifdef USE_VM_PROBES *node_name = *sender_name = *remote_name = '\0'; if (DTRACE_ENABLED(process_exit_signal_remote)) { - erts_snprintf(node_name, sizeof(node_name), "%T", dsdp->dep->sysname); - erts_snprintf(sender_name, sizeof(sender_name), "%T", sender->common.id); - erts_snprintf(remote_name, sizeof(remote_name), + erts_snprintf(node_name, sizeof(DTRACE_CHARBUF_NAME(node_name)), + "%T", dsdp->dep->sysname); + erts_snprintf(sender_name, sizeof(DTRACE_CHARBUF_NAME(sender_name)), + "%T", sender->common.id); + erts_snprintf(remote_name, sizeof(DTRACE_CHARBUF_NAME(remote_name)), "{%T,%s}", remote, node_name); - erts_snprintf(reason_str, sizeof(reason), "%T", reason); + erts_snprintf(reason_str, sizeof(DTRACE_CHARBUF_NAME(reason_str)), + "%T", reason); if (token != NIL && token != am_have_dt_utag) { tok_label = signed_val(SEQ_TRACE_T_LABEL(token)); tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token)); @@ -1797,8 +1805,9 @@ dsig_send(ErtsDSigData *dsdp, Eterm ctl, Eterm msg, int force_busy) DTRACE_CHARBUF(port_str, 64); DTRACE_CHARBUF(remote_str, 64); - erts_snprintf(port_str, sizeof(port_str), "%T", cid); - erts_snprintf(remote_str, sizeof(remote_str), + erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), + "%T", cid); + erts_snprintf(remote_str, sizeof(DTRACE_CHARBUF_NAME(remote_str)), "%T", dep->sysname); DTRACE3(dist_port_not_busy, erts_this_node_sysname, port_str, remote_str); @@ -1855,9 +1864,11 @@ dsig_send(ErtsDSigData *dsdp, Eterm ctl, Eterm msg, int force_busy) DTRACE_CHARBUF(remote_str, 64); DTRACE_CHARBUF(pid_str, 16); - erts_snprintf(port_str, sizeof(port_str), "%T", cid); - erts_snprintf(remote_str, sizeof(remote_str), "%T", dep->sysname); - erts_snprintf(pid_str, sizeof(pid_str), "%T", c_p->common.id); + erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), "%T", cid); + erts_snprintf(remote_str, sizeof(DTRACE_CHARBUF_NAME(remote_str)), + "%T", dep->sysname); + erts_snprintf(pid_str, sizeof(DTRACE_CHARBUF_NAME(pid_str)), + "%T", c_p->common.id); DTRACE4(dist_port_busy, erts_this_node_sysname, port_str, remote_str, pid_str); } @@ -1890,8 +1901,9 @@ dist_port_command(Port *prt, ErtsDistOutputBuf *obuf) DTRACE_CHARBUF(port_str, 64); DTRACE_CHARBUF(remote_str, 64); - erts_snprintf(port_str, sizeof(port_str), "%T", prt->common.id); - erts_snprintf(remote_str, sizeof(remote_str), + erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), + "%T", prt->common.id); + erts_snprintf(remote_str, sizeof(DTRACE_CHARBUF_NAME(remote_str)), "%T", prt->dist_entry->sysname); DTRACE4(dist_output, erts_this_node_sysname, port_str, remote_str, size); @@ -1944,8 +1956,9 @@ dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf) DTRACE_CHARBUF(port_str, 64); DTRACE_CHARBUF(remote_str, 64); - erts_snprintf(port_str, sizeof(port_str), "%T", prt->common.id); - erts_snprintf(remote_str, sizeof(remote_str), + erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), + "%T", prt->common.id); + erts_snprintf(remote_str, sizeof(DTRACE_CHARBUF_NAME(remote_str)), "%T", prt->dist_entry->sysname); DTRACE4(dist_outputv, erts_this_node_sysname, port_str, remote_str, size); @@ -2280,8 +2293,9 @@ erts_dist_port_not_busy(Port *prt) DTRACE_CHARBUF(port_str, 64); DTRACE_CHARBUF(remote_str, 64); - erts_snprintf(port_str, sizeof(port_str), "%T", prt->common.id); - erts_snprintf(remote_str, sizeof(remote_str), + erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), + "%T", prt->common.id); + erts_snprintf(remote_str, sizeof(DTRACE_CHARBUF_NAME(remote_str)), "%T", prt->dist_entry->sysname); DTRACE3(dist_port_not_busy, erts_this_node_sysname, port_str, remote_str); @@ -3246,10 +3260,10 @@ send_nodes_mon_msgs(Process *c_p, Eterm what, Eterm node, Eterm type, Eterm reas DTRACE_CHARBUF(type_str, 12); DTRACE_CHARBUF(reason_str, 64); - erts_snprintf(what_str, sizeof(what_str), "%T", what); - erts_snprintf(node_str, sizeof(node_str), "%T", node); - erts_snprintf(type_str, sizeof(type_str), "%T", type); - erts_snprintf(reason_str, sizeof(reason_str), "%T", reason); + erts_snprintf(what_str, sizeof(DTRACE_CHARBUF_NAME(what_str)), "%T", what); + erts_snprintf(node_str, sizeof(DTRACE_CHARBUF_NAME(node_str)), "%T", node); + erts_snprintf(type_str, sizeof(DTRACE_CHARBUF_NAME(type_str)), "%T", type); + erts_snprintf(reason_str, sizeof(DTRACE_CHARBUF_NAME(reason_str)), "%T", reason); DTRACE5(dist_monitor, erts_this_node_sysname, what_str, node_str, type_str, reason_str); } diff --git a/erts/emulator/beam/dist.h b/erts/emulator/beam/dist.h index ff8f5e106f..f32b999198 100644 --- a/erts/emulator/beam/dist.h +++ b/erts/emulator/beam/dist.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2014. 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 @@ -40,13 +40,16 @@ #define DFLAG_SMALL_ATOM_TAGS 0x4000 #define DFLAG_INTERNAL_TAGS 0x8000 #define DFLAG_UTF8_ATOMS 0x10000 +#define DFLAG_MAP_TAG 0x20000 /* All flags that should be enabled when term_to_binary/1 is used. */ #define TERM_TO_BINARY_DFLAGS (DFLAG_EXTENDED_REFERENCES \ | DFLAG_NEW_FUN_TAGS \ + | DFLAG_NEW_FLOATS \ | DFLAG_EXTENDED_PIDS_PORTS \ | DFLAG_EXPORT_PTR_TAG \ - | DFLAG_BIT_BINARIES) + | DFLAG_BIT_BINARIES \ + | DFLAG_MAP_TAG) /* opcodes used in distribution messages */ #define DOP_LINK 1 diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 64b3e01ed4..05ac24e04d 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -585,7 +585,8 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) if (ncpu < 1) ncpu = 1; - erts_tsd_key_create(&erts_allctr_prelock_tsd_key); + erts_tsd_key_create(&erts_allctr_prelock_tsd_key, + "erts_allctr_prelock_tsd_key"); erts_sys_alloc_init(); erts_init_utils_mem(); diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h index f83f6b39cf..d3109b9432 100644 --- a/erts/emulator/beam/erl_alloc.h +++ b/erts/emulator/beam/erl_alloc.h @@ -209,8 +209,8 @@ int erts_is_allctr_wrapper_prelocked(void); void *erts_alloc_permanent_cache_aligned(ErtsAlcType_t type, Uint size); #ifndef ERTS_CACHE_LINE_SIZE -/* Assume a cache line size of 64 bytes */ -# define ERTS_CACHE_LINE_SIZE ((UWord) 64) +/* Assumed cache line size */ +# define ERTS_CACHE_LINE_SIZE ((UWord) ASSUMED_CACHE_LINE_SIZE) # define ERTS_CACHE_LINE_MASK (ERTS_CACHE_LINE_SIZE - 1) #endif @@ -492,7 +492,7 @@ static TYPE * \ NAME##_alloc(void) \ { \ ErtsSchedulerData *esdp = erts_get_scheduler_data(); \ - if (!esdp) \ + if (!esdp || ERTS_SCHEDULER_IS_DIRTY(esdp)) \ return NULL; \ return (TYPE *) erts_sspa_alloc(sspa_data_##NAME##__, \ (int) esdp->no - 1); \ diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index b4e52770e3..17ac6316b7 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -414,6 +414,21 @@ type PRT_REP_EXIT STANDARD SYSTEM port_report_exit +endif ++if ose + +type SYS_READ_BUF TEMPORARY SYSTEM sys_read_buf +type FD_TAB LONG_LIVED SYSTEM fd_tab +type FD_ENTRY_BUF STANDARD SYSTEM fd_entry_buf +type FD_SIG_LIST SHORT_LIVED SYSTEM fd_sig_list +type DRV_EV STANDARD SYSTEM driver_event +type CS_PROG_PATH LONG_LIVED SYSTEM cs_prog_path +type ENVIRONMENT TEMPORARY SYSTEM environment +type PUTENV_STR SYSTEM SYSTEM putenv_string +type PRT_REP_EXIT STANDARD SYSTEM port_report_exit + ++endif + + +if win32 type DRV_DATA_BUF SYSTEM SYSTEM drv_data_buf diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index c6cea0185f..45f0cc4312 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -5561,11 +5561,11 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) erts_mtx_init_x_opt(&allctr->mutex, "alcu_allocator", make_small(allctr->alloc_no), - ERTS_LCNT_LT_ALLOC); + ERTS_LCNT_LT_ALLOC,1); #else erts_mtx_init_x(&allctr->mutex, "alcu_allocator", - make_small(allctr->alloc_no)); + make_small(allctr->alloc_no),1); #endif /*ERTS_ENABLE_LOCK_COUNT*/ #ifdef DEBUG diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c index f0cec1c53c..decae6b2ca 100644 --- a/erts/emulator/beam/erl_async.c +++ b/erts/emulator/beam/erl_async.c @@ -166,6 +166,7 @@ async_ready_q(Uint sched_id) #endif + void erts_init_async(void) { @@ -226,11 +227,23 @@ erts_init_async(void) thr_opts.suggested_stack_size = erts_async_thread_suggested_stack_size; +#ifdef ETHR_HAVE_THREAD_NAMES + thr_opts.name = malloc(sizeof(char)*(strlen("async_XXXX")+1)); +#endif + for (i = 0; i < erts_async_max_threads; i++) { ErtsAsyncQ *aq = async_q(i); + +#ifdef ETHR_HAVE_THREAD_NAMES + sprintf(thr_opts.name, "async_%d", i+1); +#endif + erts_thr_create(&aq->thr_id, async_main, (void*) aq, &thr_opts); } +#ifdef ETHR_HAVE_THREAD_NAMES + free(thr_opts.name); +#endif /* Wait for async threads to initialize... */ erts_mtx_lock(&async->init.data.mtx); @@ -279,7 +292,8 @@ static ERTS_INLINE void async_add(ErtsAsync *a, ErtsAsyncQ* q) if (DTRACE_ENABLED(aio_pool_add)) { DTRACE_CHARBUF(port_str, 16); - erts_snprintf(port_str, sizeof(port_str), "%T", a->port); + erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), + "%T", a->port); /* DTRACE TODO: Get the queue length from erts_thr_q_enqueue() ? */ len = -1; DTRACE2(aio_pool_add, port_str, len); @@ -314,7 +328,8 @@ static ERTS_INLINE ErtsAsync *async_get(ErtsThrQ_t *q, if (DTRACE_ENABLED(aio_pool_get)) { DTRACE_CHARBUF(port_str, 16); - erts_snprintf(port_str, sizeof(port_str), "%T", a->port); + erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), + "%T", a->port); /* DTRACE TODO: Get the length from erts_thr_q_dequeue() ? */ len = -1; DTRACE2(aio_pool_get, port_str, len); diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c index 1728b200f7..56cd2ba04f 100644 --- a/erts/emulator/beam/erl_bif_ddll.c +++ b/erts/emulator/beam/erl_bif_ddll.c @@ -1548,8 +1548,10 @@ static int do_load_driver_entry(DE_Handle *dh, char *path, char *name) switch (dp->extended_marker) { case ERL_DRV_EXTENDED_MARKER: - if (ERL_DRV_EXTENDED_MAJOR_VERSION != dp->major_version - || ERL_DRV_EXTENDED_MINOR_VERSION < dp->minor_version) { + if (dp->major_version < ERL_DRV_MIN_REQUIRED_MAJOR_VERSION_ON_LOAD + || (ERL_DRV_EXTENDED_MAJOR_VERSION < dp->major_version + || (ERL_DRV_EXTENDED_MAJOR_VERSION == dp->major_version + && ERL_DRV_EXTENDED_MINOR_VERSION < dp->minor_version))) { /* Incompatible driver version */ res = ERL_DE_LOAD_ERROR_INCORRECT_VERSION; goto error; diff --git a/erts/emulator/beam/erl_bif_lists.c b/erts/emulator/beam/erl_bif_lists.c index 1805366cfe..820ed2385d 100644 --- a/erts/emulator/beam/erl_bif_lists.c +++ b/erts/emulator/beam/erl_bif_lists.c @@ -43,7 +43,7 @@ static BIF_RETTYPE append(Process* p, Eterm A, Eterm B) Eterm* hp; int i; - if ((i = list_length(A)) < 0) { + if ((i = erts_list_length(A)) < 0) { BIF_ERROR(p, BADARG); } if (i == 0) { @@ -102,10 +102,10 @@ static Eterm subtract(Process* p, Eterm A, Eterm B) int n; int m; - if ((n = list_length(A)) < 0) { + if ((n = erts_list_length(A)) < 0) { BIF_ERROR(p, BADARG); } - if ((m = list_length(B)) < 0) { + if ((m = erts_list_length(B)) < 0) { BIF_ERROR(p, BADARG); } diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c index f298422267..afb33c1cdb 100644 --- a/erts/emulator/beam/erl_bif_port.c +++ b/erts/emulator/beam/erl_bif_port.c @@ -882,7 +882,7 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump) DTRACE_CHARBUF(port_str, DTRACE_TERM_BUF_SIZE); dtrace_proc_str(p, process_str); - erts_snprintf(port_str, sizeof(port_str), "%T", port->common.id); + erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), "%T", port->common.id); DTRACE3(port_open, process_str, name_buf, port_str); } #endif @@ -941,7 +941,8 @@ static char **convert_args(Eterm l) if (is_not_list(l) && is_not_nil(l)) { return NULL; } - n = list_length(l); + + n = erts_list_length(l); /* We require at least one element in argv[0] + NULL at end */ pp = erts_alloc(ERTS_ALC_T_TMP, (n + 2) * sizeof(char **)); pp[i++] = erts_default_arg0; @@ -986,7 +987,7 @@ static byte* convert_environment(Process* p, Eterm env) byte* bytes; int encoding = erts_get_native_filename_encoding(); - if ((n = list_length(env)) < 0) { + if ((n = erts_list_length(env)) < 0) { return NULL; } heap_size = 2*(5*n+1); diff --git a/erts/emulator/beam/erl_cpu_topology.c b/erts/emulator/beam/erl_cpu_topology.c index 88c6c34881..f594cb9392 100644 --- a/erts/emulator/beam/erl_cpu_topology.c +++ b/erts/emulator/beam/erl_cpu_topology.c @@ -1699,7 +1699,7 @@ erts_early_init_cpu_topology(int no_schedulers, } max_main_threads = erts_get_cpu_configured(cpuinfo); - if (max_main_threads > no_schedulers) + if (max_main_threads > no_schedulers || max_main_threads < 0) max_main_threads = no_schedulers; *max_main_threads_p = max_main_threads; diff --git a/erts/emulator/beam/erl_db_hash.h b/erts/emulator/beam/erl_db_hash.h index d17bd9f693..908cec11d4 100644 --- a/erts/emulator/beam/erl_db_hash.h +++ b/erts/emulator/beam/erl_db_hash.h @@ -33,7 +33,12 @@ typedef struct hash_db_term { DbTerm dbterm; /* The actual term */ } HashDbTerm; +#ifdef ERTS_DB_HASH_LOCK_CNT +#define DB_HASH_LOCK_CNT ERTS_DB_HASH_LOCK_CNT +#else #define DB_HASH_LOCK_CNT 64 +#endif + typedef struct db_table_hash_fine_locks { union { erts_smp_rwmtx_t lck; diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index 25029ba90f..a62a83a928 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -485,7 +485,7 @@ static int db_first_tree(Process *p, DbTable *tbl, Eterm *ret) *ret = am_EOT; return DB_ERROR_NONE; } - /* Walk down to the tree to the left */ + /* Walk down the tree to the left */ if ((stack = get_static_stack(tb)) != NULL) { stack->pos = stack->slot = 0; } @@ -531,7 +531,7 @@ static int db_last_tree(Process *p, DbTable *tbl, Eterm *ret) *ret = am_EOT; return DB_ERROR_NONE; } - /* Walk down to the tree to the left */ + /* Walk down the tree to the right */ if ((stack = get_static_stack(tb)) != NULL) { stack->pos = stack->slot = 0; } diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 3986ccd4d3..3927615e04 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -483,7 +483,8 @@ void match_pseudo_process_init(void) { #ifdef ERTS_SMP - erts_smp_tsd_key_create(&match_pseudo_process_key); + erts_smp_tsd_key_create(&match_pseudo_process_key, + "erts_match_pseudo_process_key"); erts_smp_install_exit_handler(destroy_match_pseudo_process); #else match_pseudo_process = create_match_pseudo_process(); diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index ab9ee63104..3ecb379326 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -136,6 +136,22 @@ typedef struct { #define ERL_DRV_EXTENDED_MINOR_VERSION 0 /* + * The emulator will refuse to load a driver with a major version + * lower than ERL_DRV_MIN_REQUIRED_MAJOR_VERSION_ON_LOAD. The load + * may however fail if user have not removed use of deprecated + * symbols. + * + * The ERL_DRV_MIN_REQUIRED_MAJOR_VERSION_ON_LOAD have to allow + * loading of drivers built at least two major OTP releases + * ago. + * + * Bump of major version to 3 happened in OTP 17. That is, in + * OTP 19 we can increase ERL_DRV_MIN_REQUIRED_MAJOR_VERSION_ON_LOAD + * to 3. + */ +#define ERL_DRV_MIN_REQUIRED_MAJOR_VERSION_ON_LOAD 2 + +/* * The emulator will refuse to load a driver with different major * version than the one used by the emulator. */ @@ -271,7 +287,6 @@ typedef struct ErlDrvCond_ ErlDrvCond; typedef struct ErlDrvRWLock_ ErlDrvRWLock; typedef int ErlDrvTSDKey; - /* * */ @@ -680,6 +695,16 @@ EXTERN char *driver_dl_error(void); EXTERN int erl_drv_putenv(char *key, char *value); EXTERN int erl_drv_getenv(char *key, char *value, size_t *value_size); +#ifdef __OSE__ +typedef ErlDrvUInt ErlDrvOseEventId; +EXTERN union SIGNAL *erl_drv_ose_get_signal(ErlDrvEvent ev); +EXTERN ErlDrvEvent erl_drv_ose_event_alloc(SIGSELECT sig, ErlDrvOseEventId handle, + ErlDrvOseEventId (*resolve_signal)(union SIGNAL *sig), void *extra); +EXTERN void erl_drv_ose_event_free(ErlDrvEvent ev); +EXTERN void erl_drv_ose_event_fetch(ErlDrvEvent ev, SIGSELECT *sig, + ErlDrvOseEventId *handle, void **extra); +#endif + #endif /* !ERL_DRIVER_TYPES_ONLY */ #ifdef WIN32_DYNAMIC_ERL_DRIVER diff --git a/erts/emulator/beam/erl_drv_nif.h b/erts/emulator/beam/erl_drv_nif.h index ea013a49a3..3f829ea7ea 100644 --- a/erts/emulator/beam/erl_drv_nif.h +++ b/erts/emulator/beam/erl_drv_nif.h @@ -41,6 +41,13 @@ typedef struct { int suggested_stack_size; } ErlDrvThreadOpts; +#if defined(ERL_DRV_DIRTY_SCHEDULER_SUPPORT) || defined(ERL_NIF_DIRTY_SCHEDULER_SUPPORT) +typedef enum { + ERL_DRV_DIRTY_JOB_CPU_BOUND = 1, + ERL_DRV_DIRTY_JOB_IO_BOUND = 2 +} ErlDrvDirtyJobFlags; +#endif + #endif /* __ERL_DRV_NIF_H__ */ diff --git a/erts/emulator/beam/erl_drv_thread.c b/erts/emulator/beam/erl_drv_thread.c index 4f1bba8657..147249f751 100644 --- a/erts/emulator/beam/erl_drv_thread.c +++ b/erts/emulator/beam/erl_drv_thread.c @@ -78,8 +78,6 @@ struct ErlDrvTid_ { static ethr_tsd_key tid_key; -static ethr_thr_opts def_ethr_opts = ETHR_THR_OPTS_DEFAULT_INITER; - #else /* USE_THREADS */ static Uint tsd_len; static void **tsd; @@ -123,7 +121,7 @@ void erl_drv_thr_init(void) { int i; #ifdef USE_THREADS - int res = ethr_tsd_key_create(&tid_key); + int res = ethr_tsd_key_create(&tid_key,"erts_tid_key"); if (res == 0) res = ethr_install_exit_handler(thread_exit_handler); if (res != 0) @@ -605,6 +603,7 @@ erl_drv_thread_create(char *name, struct ErlDrvTid_ *dtid; ethr_thr_opts ethr_opts; ethr_thr_opts *use_opts; + ethr_thr_opts def_ethr_opts = ETHR_THR_OPTS_DEFAULT_INITER; if (!opts) use_opts = NULL; diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 2022f70cbb..aa15d2cc57 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -406,8 +406,10 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE); #endif - if (p->flags & F_DISABLE_GC) + if (p->flags & F_DISABLE_GC) { + ASSERT(need == 0); return 1; + } esdp = erts_get_scheduler_data(); diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index c17256f466..d54658f1ea 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -178,6 +178,11 @@ int erts_compat_rel; static int no_schedulers; static int no_schedulers_online; +#ifdef ERTS_DIRTY_SCHEDULERS +static int no_dirty_cpu_schedulers; +static int no_dirty_cpu_schedulers_online; +static int no_dirty_io_schedulers; +#endif #ifdef DEBUG Uint32 verbose; /* See erl_debug.h for information about verbose */ @@ -304,7 +309,13 @@ erl_init(int ncpu, erts_init_sys_common_misc(); erts_init_process(ncpu, proc_tab_sz, legacy_proc_tab); erts_init_scheduling(no_schedulers, - no_schedulers_online); + no_schedulers_online +#ifdef ERTS_DIRTY_SCHEDULERS + , no_dirty_cpu_schedulers, + no_dirty_cpu_schedulers_online, + no_dirty_io_schedulers +#endif + ); erts_init_cpu_topology(); /* Must be after init_scheduling */ erts_init_gc(); /* Must be after init_scheduling */ erts_alloc_late_init(); @@ -709,7 +720,7 @@ early_init(int *argc, char **argv) /* #endif #ifdef ERTS_SMP erts_smp_atomic32_init_nob(&erts_writing_erl_crash_dump, 0L); - erts_tsd_key_create(&erts_is_crash_dumping_key); + erts_tsd_key_create(&erts_is_crash_dumping_key,"erts_is_crash_dumping_key"); #else erts_writing_erl_crash_dump = 0; #endif @@ -780,7 +791,7 @@ early_init(int *argc, char **argv) /* case 'A': { /* set number of threads in thread pool */ char *arg = get_arg(argv[i]+2, argv[i+1], &i); - if (((erts_async_max_threads = atoi(arg)) < 0) || + if (((erts_async_max_threads = atoi(arg)) < ERTS_MIN_NO_OF_ASYNC_THREADS) || (erts_async_max_threads > ERTS_MAX_NO_OF_ASYNC_THREADS)) { erts_fprintf(stderr, "bad number of async threads %s\n", @@ -835,7 +846,7 @@ early_init(int *argc, char **argv) /* else if (argv[i][2] == 'D') { char *arg; char *type = argv[i]+3; - if (strcmp(type, "Pcpu") == 0) { + if (strncmp(type, "Pcpu", 4) == 0) { int ptot, ponln; arg = get_arg(argv[i]+7, argv[i+1], &i); switch (sscanf(arg, "%d:%d", &ptot, &ponln)) { @@ -872,7 +883,7 @@ early_init(int *argc, char **argv) /* VERBOSE(DEBUG_SYSTEM, ("using %d:%d dirty CPU scheduler percentages\n", dirty_cpu_scheds_pctg, dirty_cpu_scheds_onln_pctg)); - } else if (strcmp(type, "cpu") == 0) { + } else if (strncmp(type, "cpu", 3) == 0) { int tot, onln; arg = get_arg(argv[i]+6, argv[i+1], &i); switch (sscanf(arg, "%d:%d", &tot, &onln)) { @@ -923,7 +934,7 @@ early_init(int *argc, char **argv) /* } VERBOSE(DEBUG_SYSTEM, ("using %d:%d dirty CPU scheduler(s)\n", tot, onln)); - } else if (strcmp(type, "io") == 0) { + } else if (strncmp(type, "io", 2) == 0) { arg = get_arg(argv[i]+5, argv[i+1], &i); dirty_io_scheds = atoi(arg); if (dirty_io_scheds < 0 || @@ -1055,9 +1066,9 @@ early_init(int *argc, char **argv) /* erts_no_schedulers = (Uint) no_schedulers; #endif #ifdef ERTS_DIRTY_SCHEDULERS - erts_no_dirty_cpu_schedulers = dirty_cpu_scheds; - erts_no_dirty_cpu_schedulers_online = dirty_cpu_scheds_online; - erts_no_dirty_io_schedulers = dirty_io_scheds; + erts_no_dirty_cpu_schedulers = no_dirty_cpu_schedulers = dirty_cpu_scheds; + no_dirty_cpu_schedulers_online = dirty_cpu_scheds_online; + erts_no_dirty_io_schedulers = no_dirty_io_schedulers = dirty_io_scheds; #endif erts_early_init_scheduling(no_schedulers); diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index a8ff94ac89..7e3a90779d 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -241,6 +241,8 @@ struct erts_lc_locked_lock_t_ { erts_lc_locked_lock_t *prev; UWord extra; Sint16 id; + char *file; + unsigned int line; Uint16 flags; }; @@ -430,47 +432,51 @@ make_my_locked_locks(void) } static ERTS_INLINE erts_lc_locked_lock_t * -new_locked_lock(erts_lc_lock_t *lck, Uint16 op_flags) +new_locked_lock(erts_lc_lock_t *lck, Uint16 op_flags, + char *file, unsigned int line) { erts_lc_locked_lock_t *l_lck = (erts_lc_locked_lock_t *) lc_alloc(); l_lck->next = NULL; l_lck->prev = NULL; l_lck->id = lck->id; l_lck->extra = lck->extra; + l_lck->file = file; + l_lck->line = line; l_lck->flags = lck->flags | op_flags; return l_lck; } static void -print_lock2(char *prefix, Sint16 id, Wterm extra, Uint16 flags, char *suffix) +raw_print_lock(char *prefix, Sint16 id, Wterm extra, Uint16 flags, + char* file, unsigned int line, char *suffix) { char *lname = (0 <= id && id < ERTS_LOCK_ORDER_SIZE ? erts_lock_order[id].name : "unknown"); + erts_fprintf(stderr,"%s'%s:",prefix,lname); + if (is_not_immed(extra)) - erts_fprintf(stderr, - "%s'%s:%p%s'%s%s", - prefix, - lname, - _unchecked_boxed_val(extra), - lock_type(flags), - rw_op_str(flags), - suffix); + erts_fprintf(stderr,"%p",_unchecked_boxed_val(extra)); else - erts_fprintf(stderr, - "%s'%s:%T%s'%s%s", - prefix, - lname, - extra, - lock_type(flags), - rw_op_str(flags), - suffix); + erts_fprintf(stderr,"%T",extra); + erts_fprintf(stderr,"%s",lock_type(flags)); + + if (file) + erts_fprintf(stderr,"(%s:%d)",file,line); + + erts_fprintf(stderr,"'%s%s",rw_op_str(flags),suffix); +} + +static void +print_lock2(char *prefix, Sint16 id, Wterm extra, Uint16 flags, char *suffix) +{ + raw_print_lock(prefix, id, extra, flags, NULL, 0, suffix); } static void print_lock(char *prefix, erts_lc_lock_t *lck, char *suffix) { - print_lock2(prefix, lck->id, lck->extra, lck->flags, suffix); + raw_print_lock(prefix, lck->id, lck->extra, lck->flags, NULL, 0, suffix); } static void @@ -486,7 +492,8 @@ print_curr_locks(erts_lc_locked_locks_t *l_lcks) "Currently these locks are locked by the %s thread:\n", l_lcks->thread_name); for (l_lck = l_lcks->locked.first; l_lck; l_lck = l_lck->next) - print_lock2(" ", l_lck->id, l_lck->extra, l_lck->flags, "\n"); + raw_print_lock(" ", l_lck->id, l_lck->extra, l_lck->flags, + l_lck->file, l_lck->line, "\n"); } } @@ -1002,7 +1009,8 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, Uint16 op_flags) #endif } -void erts_lc_trylock_flg(int locked, erts_lc_lock_t *lck, Uint16 op_flags) +void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, Uint16 op_flags, + char *file, unsigned int line) { erts_lc_locked_locks_t *l_lcks; erts_lc_locked_lock_t *l_lck; @@ -1014,7 +1022,7 @@ void erts_lc_trylock_flg(int locked, erts_lc_lock_t *lck, Uint16 op_flags) return; l_lcks = make_my_locked_locks(); - l_lck = locked ? new_locked_lock(lck, op_flags) : NULL; + l_lck = locked ? new_locked_lock(lck, op_flags, file, line) : NULL; if (!l_lcks->locked.last) { ASSERT(!l_lcks->locked.first); @@ -1055,13 +1063,14 @@ void erts_lc_trylock_flg(int locked, erts_lc_lock_t *lck, Uint16 op_flags) } -void erts_lc_require_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags) +void erts_lc_require_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags, + char *file, unsigned int line) { erts_lc_locked_locks_t *l_lcks = make_my_locked_locks(); erts_lc_locked_lock_t *l_lck = l_lcks->locked.first; if (!find_lock(&l_lck, lck)) required_not_locked(l_lcks, lck); - l_lck = new_locked_lock(lck, op_flags); + l_lck = new_locked_lock(lck, op_flags, file, line); if (!l_lcks->required.last) { ASSERT(!l_lcks->required.first); l_lck->next = l_lck->prev = NULL; @@ -1129,7 +1138,8 @@ void erts_lc_unrequire_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags) lc_free((void *) l_lck); } -void erts_lc_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags) +void erts_lc_lock_flg_x(erts_lc_lock_t *lck, Uint16 op_flags, + char *file, unsigned int line) { erts_lc_locked_locks_t *l_lcks; erts_lc_locked_lock_t *l_lck; @@ -1141,7 +1151,7 @@ void erts_lc_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags) return; l_lcks = make_my_locked_locks(); - l_lck = new_locked_lock(lck, op_flags); + l_lck = new_locked_lock(lck, op_flags, file, line); if (!l_lcks->locked.last) { ASSERT(!l_lcks->locked.first); @@ -1232,15 +1242,15 @@ erts_lc_trylock_force_busy(erts_lc_lock_t *lck) } void -erts_lc_trylock(int locked, erts_lc_lock_t *lck) +erts_lc_trylock_x(int locked, erts_lc_lock_t *lck, char *file, unsigned int line) { - erts_lc_trylock_flg(locked, lck, 0); + erts_lc_trylock_flg_x(locked, lck, 0, file, line); } void -erts_lc_lock(erts_lc_lock_t *lck) +erts_lc_lock_x(erts_lc_lock_t *lck, char *file, unsigned int line) { - erts_lc_lock_flg(lck, 0); + erts_lc_lock_flg_x(lck, 0, file, line); } void @@ -1254,9 +1264,9 @@ void erts_lc_might_unlock(erts_lc_lock_t *lck) erts_lc_might_unlock_flg(lck, 0); } -void erts_lc_require_lock(erts_lc_lock_t *lck) +void erts_lc_require_lock(erts_lc_lock_t *lck, char *file, unsigned int line) { - erts_lc_require_lock_flg(lck, 0); + erts_lc_require_lock_flg(lck, 0, file, line); } void erts_lc_unrequire_lock(erts_lc_lock_t *lck) @@ -1322,7 +1332,7 @@ erts_lc_init(void) if (ethr_spinlock_init(&free_blocks_lock) != 0) lc_abort(); - erts_tsd_key_create(&locks_key); + erts_tsd_key_create(&locks_key,"erts_lock_check_key"); } void diff --git a/erts/emulator/beam/erl_lock_check.h b/erts/emulator/beam/erl_lock_check.h index 068340abe7..3f7f417e61 100644 --- a/erts/emulator/beam/erl_lock_check.h +++ b/erts/emulator/beam/erl_lock_check.h @@ -35,6 +35,11 @@ #ifdef ERTS_ENABLE_LOCK_CHECK +#ifndef ERTS_ENABLE_LOCK_POSITION +/* Enable in order for _x variants of mtx functions to be used. */ +#define ERTS_ENABLE_LOCK_POSITION 1 +#endif + typedef struct { int inited; Sint16 id; @@ -79,13 +84,16 @@ void erts_lc_have_locks(int *resv, erts_lc_lock_t *lcks, int len); void erts_lc_have_lock_ids(int *resv, int *ids, int len); void erts_lc_check_no_locked_of_type(Uint16 flags); int erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, Uint16 op_flags); -void erts_lc_trylock_flg(int locked, erts_lc_lock_t *lck, Uint16 op_flags); -void erts_lc_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags); +void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, Uint16 op_flags, + char *file, unsigned int line); +void erts_lc_lock_flg_x(erts_lc_lock_t *lck, Uint16 op_flags, + char *file, unsigned int line); void erts_lc_unlock_flg(erts_lc_lock_t *lck, Uint16 op_flags); void erts_lc_might_unlock_flg(erts_lc_lock_t *lck, Uint16 op_flags); int erts_lc_trylock_force_busy(erts_lc_lock_t *lck); -void erts_lc_trylock(int locked, erts_lc_lock_t *lck); -void erts_lc_lock(erts_lc_lock_t *lck); +void erts_lc_trylock_x(int locked, erts_lc_lock_t *lck, + char* file, unsigned int line); +void erts_lc_lock_x(erts_lc_lock_t *lck, char* file, unsigned int line); void erts_lc_unlock(erts_lc_lock_t *lck); void erts_lc_might_unlock(erts_lc_lock_t *lck); void erts_lc_init_lock(erts_lc_lock_t *lck, char *name, Uint16 flags); @@ -96,10 +104,11 @@ int erts_lc_assert_failed(char *file, int line, char *assertion); void erts_lc_set_thread_name(char *thread_name); void erts_lc_pll(void); -void erts_lc_require_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags); +void erts_lc_require_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags, + char *file, unsigned int line); void erts_lc_unrequire_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags); -void erts_lc_require_lock(erts_lc_lock_t *lck); +void erts_lc_require_lock(erts_lc_lock_t *lck, char *file, unsigned int line); void erts_lc_unrequire_lock(erts_lc_lock_t *lck); int erts_lc_is_emu_thr(void); @@ -116,4 +125,9 @@ int erts_lc_is_emu_thr(void); #define ERTS_LC_ASSERT(A) ((void) 1) #endif /* #ifdef ERTS_ENABLE_LOCK_CHECK */ +#define erts_lc_lock(lck) erts_lc_lock_x(lck,__FILE__,__LINE__) +#define erts_lc_trylock(res,lck) erts_lc_trylock_x(res,lck,__FILE__,__LINE__) +#define erts_lc_lock_flg(lck) erts_lc_lock_flg_x(lck,__FILE__,__LINE__) +#define erts_lc_trylock_flg(res,lck) erts_lc_trylock_flg_x(res,lck,__FILE__,__LINE__) + #endif /* #ifndef ERTS_LOCK_CHECK_H__ */ diff --git a/erts/emulator/beam/erl_lock_count.c b/erts/emulator/beam/erl_lock_count.c index 5f75b0ac0b..6f44bf097b 100644 --- a/erts/emulator/beam/erl_lock_count.c +++ b/erts/emulator/beam/erl_lock_count.c @@ -236,7 +236,7 @@ void erts_lcnt_init() { /* init tsd */ lcnt_n_thr = 0; - ethr_tsd_key_create(&lcnt_thr_data_key); + ethr_tsd_key_create(&lcnt_thr_data_key,"lcnt_data"); lcnt_lock(); diff --git a/erts/emulator/beam/erl_lock_count.h b/erts/emulator/beam/erl_lock_count.h index a4fc91b510..75f7cd028b 100644 --- a/erts/emulator/beam/erl_lock_count.h +++ b/erts/emulator/beam/erl_lock_count.h @@ -61,8 +61,14 @@ #define ERTS_LOCK_COUNT_H__ #ifdef ERTS_ENABLE_LOCK_COUNT +#ifndef ERTS_ENABLE_LOCK_POSITION +/* Enable in order for _x variants of mtx functions to be used. */ +#define ERTS_ENABLE_LOCK_POSITION 1 +#endif + #include "ethread.h" + #define ERTS_LCNT_MAX_LOCK_LOCATIONS (10) #define ERTS_LCNT_LT_SPINLOCK (((Uint16) 1) << 0) diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c index 2fff7f9390..fdd2d0c0f6 100644 --- a/erts/emulator/beam/erl_map.c +++ b/erts/emulator/beam/erl_map.c @@ -647,22 +647,24 @@ int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res) { *mhp++ = tup; if (is_immed(key)) { - while(n--) { + while (1) { if (*ks == key) { goto found_key; - } else { + } else if (--n) { *mhp++ = *vs++; *thp++ = *ks++; - } + } else + break; } } else { - while(n--) { + while(1) { if (EQ(*ks, key)) { goto found_key; - } else { + } else if (--n) { *mhp++ = *vs++; *thp++ = *ks++; - } + } else + break; } } @@ -676,7 +678,7 @@ int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res) { found_key: /* Copy rest of keys and values */ - if (n) { + if (--n) { sys_memcpy(mhp, vs+1, n*sizeof(Eterm)); sys_memcpy(thp, ks+1, n*sizeof(Eterm)); } diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 6a9030fd99..0eb8117980 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -896,8 +896,10 @@ erts_send_message(Process* sender, #ifdef USE_VM_PROBES *sender_name = *receiver_name = '\0'; if (DTRACE_ENABLED(message_send)) { - erts_snprintf(sender_name, sizeof(DTRACE_CHARBUF_NAME(sender_name)), "%T", sender->common.id); - erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)), "%T", receiver->common.id); + erts_snprintf(sender_name, sizeof(DTRACE_CHARBUF_NAME(sender_name)), + "%T", sender->common.id); + erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)), + "%T", receiver->common.id); } #endif if (SEQ_TRACE_TOKEN(sender) != NIL && !(flags & ERTS_SND_FLG_NO_SEQ_TRACE)) { diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 4126df6f34..063dba056e 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -876,7 +876,7 @@ int enif_get_list_cell(ErlNifEnv* env, Eterm term, Eterm* head, Eterm* tail) int enif_get_list_length(ErlNifEnv* env, Eterm term, unsigned* len) { if (is_not_list(term) && is_not_nil(term)) return 0; - *len = list_length(term); + *len = erts_list_length(term); return 1; } @@ -1570,6 +1570,13 @@ enif_schedule_dirty_nif(ErlNifEnv* env, int flags, a = erts_smp_atomic32_read_acqb(&proc->state); while (1) { n = state = a; + /* + * clear any current dirty flags and dirty queue indicators, + * in case the application is shifting a job from one type + * of dirty scheduler to the other + */ + n &= ~(ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC + |ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q); if (chkflgs == ERL_NIF_DIRTY_JOB_CPU_BOUND) n |= ERTS_PSFLG_DIRTY_CPU_PROC; else @@ -1600,22 +1607,15 @@ enif_schedule_dirty_nif_finalizer(ErlNifEnv* env, ERL_NIF_TERM result, ERL_NIF_TERM (*fp)(ErlNifEnv*, ERL_NIF_TERM)) { #ifdef USE_THREADS - erts_aint32_t state, n, a; Process* proc = env->proc; Eterm* reg = ERTS_PROC_GET_SCHDATA(proc)->x_reg_array; Export* ep; - a = erts_smp_atomic32_read_acqb(&proc->state); - while (1) { - n = state = a; - if (!(n & (ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q))) - break; - n &= ~(ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC - |ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q); - a = erts_smp_atomic32_cmpxchg_mb(&proc->state, n, state); - if (a == state) - break; - } + erts_smp_atomic32_read_band_mb(&proc->state, + ~(ERTS_PSFLG_DIRTY_CPU_PROC + |ERTS_PSFLG_DIRTY_IO_PROC + |ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q + |ERTS_PSFLG_DIRTY_IO_PROC_IN_Q)); if (!(ep = ERTS_PROC_GET_DIRTY_SCHED_TRAP_EXPORT(proc))) alloc_proc_psd(proc, &ep); ERTS_VBUMP_ALL_REDS(proc); @@ -2049,8 +2049,10 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) (entry = erts_sys_ddll_call_nif_init(init_func)) == NULL)) { ret = load_nif_error(BIF_P, bad_lib, "Library init-call unsuccessful"); } - else if (entry->major != ERL_NIF_MAJOR_VERSION - || entry->minor > ERL_NIF_MINOR_VERSION + else if (entry->major < ERL_NIF_MIN_REQUIRED_MAJOR_VERSION_ON_LOAD + || (ERL_NIF_MAJOR_VERSION < entry->major + || (ERL_NIF_MAJOR_VERSION == entry->major + && ERL_NIF_MINOR_VERSION < entry->minor)) || (entry->major==2 && entry->minor == 5)) { /* experimental maps */ ret = load_nif_error(BIF_P, bad_lib, "Library version (%d.%d) not compatible (with %d.%d).", diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index 7613446f64..5b93c2398e 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -46,6 +46,18 @@ #define ERL_NIF_MAJOR_VERSION 2 #define ERL_NIF_MINOR_VERSION 6 +/* + * The emulator will refuse to load a nif-lib with a major version + * lower than ERL_NIF_MIN_REQUIRED_MAJOR_VERSION_ON_LOAD. The load + * may however fail if user have not removed use of deprecated + * symbols. + * + * The ERL_NIF_MIN_REQUIRED_MAJOR_VERSION_ON_LOAD have to allow + * loading of nif-libs built at least two major OTP releases + * ago. + */ +#define ERL_NIF_MIN_REQUIRED_MAJOR_VERSION_ON_LOAD 2 + #include <stdlib.h> #ifdef SIZEOF_CHAR @@ -172,8 +184,8 @@ typedef ErlDrvThreadOpts ErlNifThreadOpts; #ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT typedef enum { - ERL_NIF_DIRTY_JOB_CPU_BOUND = 1, - ERL_NIF_DIRTY_JOB_IO_BOUND = 2 + ERL_NIF_DIRTY_JOB_CPU_BOUND = ERL_DRV_DIRTY_JOB_CPU_BOUND, + ERL_NIF_DIRTY_JOB_IO_BOUND = ERL_DRV_DIRTY_JOB_IO_BOUND }ErlNifDirtyTaskFlags; #endif diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c index d4108067d0..31d9a1e26e 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -1681,7 +1681,8 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) reds = ERTS_PORT_REDS_INPUT; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); DTRACE_DRIVER(driver_ready_input, pp); - /* NOTE some windows drivers use ->ready_input for input and output */ + /* NOTE some windows/ose drivers use ->ready_input + for input and output */ (*pp->drv_ptr->ready_input)((ErlDrvData) pp->drv_data, ptp->u.alive.td.io.event); io_tasks_executed++; @@ -2034,9 +2035,9 @@ begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p) DTRACE_CHARBUF(pid_str, 16); ErtsProcList* plp2 = plp; - erts_snprintf(port_str, sizeof(port_str), "%T", pp->common.id); + erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), "%T", pp->common.id); while (plp2 != NULL) { - erts_snprintf(pid_str, sizeof(pid_str), "%T", plp2->pid); + erts_snprintf(pid_str, sizeof(DTRACE_CHARBUF_NAME(pid_str)), "%T", plp2->pid); DTRACE2(process_port_unblocked, pid_str, port_str); } } diff --git a/erts/emulator/beam/erl_port_task.h b/erts/emulator/beam/erl_port_task.h index 123253a057..1d30465ec9 100644 --- a/erts/emulator/beam/erl_port_task.h +++ b/erts/emulator/beam/erl_port_task.h @@ -185,11 +185,13 @@ erts_port_task_init_sched(ErtsPortTaskSched *ptsp, Eterm instr_id) ptsp->taskq.in.last = NULL; erts_smp_atomic32_init_nob(&ptsp->flags, 0); #ifdef ERTS_SMP + erts_mtx_init_x(&ptsp->mtx, lock_str, instr_id, #ifdef ERTS_ENABLE_LOCK_COUNT - if (!(erts_lcnt_rt_options & ERTS_LCNT_OPT_PORTLOCK)) - lock_str = NULL; + (erts_lcnt_rt_options & ERTS_LCNT_OPT_PORTLOCK) +#else + 1 #endif - erts_mtx_init_x(&ptsp->mtx, lock_str, instr_id); + ); #endif } diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 937881212a..8bf0cc9491 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -44,6 +44,7 @@ #include "dtrace-wrapper.h" #include "erl_ptab.h" + #define ERTS_DELAYED_WAKEUP_INFINITY (~(Uint64) 0) #define ERTS_DELAYED_WAKEUP_REDUCTIONS ((Uint64) CONTEXT_REDS/2) @@ -53,7 +54,11 @@ #define ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST (CONTEXT_REDS/10) +#ifndef ERTS_SCHED_MIN_SPIN #define ERTS_SCHED_SPIN_UNTIL_YIELD 100 +#else +#define ERTS_SCHED_SPIN_UNTIL_YIELD 1 +#endif #define ERTS_SCHED_SYS_SLEEP_SPINCOUNT_VERY_LONG 40 #define ERTS_SCHED_AUX_WORK_SLEEP_SPINCOUNT_FACT_VERY_LONG 1000 @@ -148,7 +153,6 @@ int erts_sched_balance_util = 0; Uint erts_no_schedulers; #ifdef ERTS_DIRTY_SCHEDULERS Uint erts_no_dirty_cpu_schedulers; -Uint erts_no_dirty_cpu_schedulers_online; Uint erts_no_dirty_io_schedulers; #endif @@ -188,6 +192,13 @@ static ErtsAuxWorkData *aux_thread_aux_work_data; #define ERTS_SCHDLR_SSPND_CHNG_SET(VAL, OLD_VAL) \ erts_smp_atomic32_set_nob(&schdlr_sspnd.changing, (VAL)) +#ifdef ERTS_DIRTY_SCHEDULERS +#define ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET(VAL, OLD_VAL) \ + erts_smp_atomic32_set_nob(&schdlr_sspnd.dirty_cpu_changing, (VAL)) +#define ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET(VAL, OLD_VAL) \ + erts_smp_atomic32_set_nob(&schdlr_sspnd.dirty_io_changing, (VAL)) +#endif + #else #define ERTS_SCHDLR_SSPND_CHNG_SET(VAL, OLD_VAL) \ @@ -198,6 +209,23 @@ do { \ ASSERT(old_val__ == (OLD_VAL)); \ } while (0) +#ifdef ERTS_DIRTY_SCHEDULERS +#define ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET(VAL, OLD_VAL) \ +do { \ + erts_aint32_t old_val__; \ + old_val__ = erts_smp_atomic32_xchg_nob(&schdlr_sspnd.dirty_cpu_changing, \ + (VAL)); \ + ASSERT(old_val__ == (OLD_VAL)); \ +} while (0) +#define ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET(VAL, OLD_VAL) \ +do { \ + erts_aint32_t old_val__; \ + old_val__ = erts_smp_atomic32_xchg_nob(&schdlr_sspnd.dirty_io_changing, \ + (VAL)); \ + ASSERT(old_val__ == (OLD_VAL)); \ +} while (0) +#endif + #endif @@ -207,11 +235,29 @@ static struct { int online; int curr_online; int wait_curr_online; +#ifdef ERTS_DIRTY_SCHEDULERS + int dirty_cpu_online; + int dirty_cpu_curr_online; + int dirty_cpu_wait_curr_online; + int dirty_io_online; + int dirty_io_curr_online; + int dirty_io_wait_curr_online; +#endif erts_smp_atomic32_t changing; erts_smp_atomic32_t active; +#ifdef ERTS_DIRTY_SCHEDULERS + erts_smp_atomic32_t dirty_cpu_changing; + erts_smp_atomic32_t dirty_cpu_active; + erts_smp_atomic32_t dirty_io_changing; + erts_smp_atomic32_t dirty_io_active; +#endif struct { int ongoing; long wait_active; +#ifdef ERTS_DIRTY_SCHEDULERS + long dirty_cpu_wait_active; + long dirty_io_wait_active; +#endif ErtsProcList *procs; } msb; /* Multi Scheduling Block */ } schdlr_sspnd; @@ -467,7 +513,7 @@ dbg_chk_aux_work_val(erts_aint32_t value) #ifdef ERTS_SMP static void handle_pending_exiters(ErtsProcList *); - +static void wake_scheduler(ErtsRunQueue *rq); #endif #if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) @@ -507,7 +553,7 @@ void erts_pre_init_process(void) { #ifdef USE_THREADS - erts_tsd_key_create(&sched_data_key); + erts_tsd_key_create(&sched_data_key, "erts_sched_data_key"); #endif #ifdef ERTS_ENABLE_LOCK_CHECK @@ -1306,6 +1352,9 @@ static ERTS_INLINE void haw_thr_prgr_current_check_progress(ErtsAuxWorkData *awdp) { ErtsThrPrgrVal current = awdp->current_thr_prgr; +#ifdef ERTS_DIRTY_SCHEDULERS + ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); +#endif if (current != ERTS_THR_PRGR_INVALID && !erts_thr_progress_equal(current, erts_thr_progress_current())) { /* @@ -1322,6 +1371,10 @@ handle_delayed_aux_work_wakeup(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, in { int jix, max_jix; +#ifdef ERTS_DIRTY_SCHEDULERS + ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); +#endif + ASSERT(awdp->delayed_wakeup.next != ERTS_DELAYED_WAKEUP_INFINITY); if (!waiting && awdp->delayed_wakeup.next > awdp->esdp->reductions) @@ -1477,6 +1530,9 @@ handle_misc_aux_work_thr_prgr(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting) { +#ifdef ERTS_DIRTY_SCHEDULERS + ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); +#endif if (!erts_thr_progress_has_reached_this(haw_thr_prgr_current(awdp), awdp->misc.thr_prgr)) return aux_work & ~ERTS_SSI_AUX_WORK_MISC_THR_PRGR; @@ -1561,6 +1617,9 @@ handle_async_ready(ErtsAuxWorkData *awdp, int waiting) { ErtsSchedulerSleepInfo *ssi = awdp->ssi; +#ifdef ERTS_DIRTY_SCHEDULERS + ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); +#endif unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_ASYNC_READY); if (erts_check_async_ready(awdp->async_ready.queue)) { if (set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_ASYNC_READY) @@ -1585,6 +1644,9 @@ handle_async_ready_clean(ErtsAuxWorkData *awdp, { void *thr_prgr_p; +#ifdef ERTS_DIRTY_SCHEDULERS + ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); +#endif #ifdef ERTS_SMP if (awdp->async_ready.need_thr_prgr && !erts_thr_progress_has_reached_this(haw_thr_prgr_current(awdp), @@ -1622,6 +1684,9 @@ handle_fix_alloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting) ErtsSchedulerSleepInfo *ssi = awdp->ssi; erts_aint32_t res; +#ifdef ERTS_DIRTY_SCHEDULERS + ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); +#endif unset_aux_work_flags(ssi, (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC)); aux_work &= ~(ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM @@ -1655,11 +1720,7 @@ erts_alloc_ensure_handle_delayed_dealloc_call(int ix) { #ifdef DEBUG ErtsSchedulerData *esdp = erts_get_scheduler_data(); -#ifdef ERTS_DIRTY_SCHEDULERS - if (esdp && ERTS_SCHEDULER_IS_DIRTY(esdp)) - return; -#endif - ASSERT(!esdp || ix == (int) esdp->no); + ASSERT(!esdp || (ERTS_SCHEDULER_IS_DIRTY(esdp) || ix == (int) esdp->no)); #endif set_aux_work_flags_wakeup_nob(ERTS_SCHED_SLEEP_INFO_IX(ix-1), ERTS_SSI_AUX_WORK_DD); @@ -1673,6 +1734,9 @@ handle_delayed_dealloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waitin ErtsThrPrgrVal wakeup = ERTS_THR_PRGR_INVALID; int more_work = 0; +#ifdef ERTS_DIRTY_SCHEDULERS + ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); +#endif unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD); erts_alloc_scheduler_handle_delayed_dealloc((void *) awdp->esdp, &need_thr_progress, @@ -1712,6 +1776,9 @@ handle_delayed_dealloc_thr_prgr(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, i ErtsThrPrgrVal wakeup = ERTS_THR_PRGR_INVALID; ErtsThrPrgrVal current = haw_thr_prgr_current(awdp); +#ifdef ERTS_DIRTY_SCHEDULERS + ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); +#endif if (!erts_thr_progress_has_reached_this(current, awdp->dd.thr_prgr)) return aux_work & ~ERTS_SSI_AUX_WORK_DD_THR_PRGR; @@ -1759,6 +1826,9 @@ handle_thr_prgr_later_op(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int wait int lops; ErtsThrPrgrVal current = haw_thr_prgr_current(awdp); +#ifdef ERTS_DIRTY_SCHEDULERS + ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); +#endif for (lops = 0; lops < ERTS_MAX_THR_PRGR_LATER_OPS; lops++) { ErtsThrPrgrLaterOp *lop = awdp->later_op.first; if (!erts_thr_progress_has_reached_this(current, lop->later)) @@ -1917,6 +1987,14 @@ erts_smp_notify_check_children_needed(void) for (i = 0; i < erts_no_schedulers; i++) set_aux_work_flags_wakeup_nob(ERTS_SCHED_SLEEP_INFO_IX(i), ERTS_SSI_AUX_WORK_CHECK_CHILDREN); +#ifdef ERTS_DIRTY_SCHEDULERS + for (i = 0; i < erts_no_dirty_cpu_schedulers; i++) + set_aux_work_flags_wakeup_nob(ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(i), + ERTS_SSI_AUX_WORK_CHECK_CHILDREN); + for (i = 0; i < erts_no_dirty_io_schedulers; i++) + set_aux_work_flags_wakeup_nob(ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(i), + ERTS_SSI_AUX_WORK_CHECK_CHILDREN); +#endif } static ERTS_INLINE erts_aint32_t @@ -2302,14 +2380,24 @@ try_set_sys_scheduling(void) #endif static ERTS_INLINE int -prepare_for_sys_schedule(void) +prepare_for_sys_schedule(ErtsSchedulerData *esdp) { #ifdef ERTS_SMP while (!erts_port_task_have_outstanding_io_tasks() && try_set_sys_scheduling()) { - if (!erts_port_task_have_outstanding_io_tasks()) - return 1; +#ifdef ERTS_SCHED_ONLY_POLL_SCHED_1 + if (esdp->no != 1) { + /* If we are not scheduler 1 and ERTS_SCHED_ONLY_POLL_SCHED_1 is used + then we make sure to wake scheduler 1 */ + ErtsRunQueue *rq = ERTS_RUNQ_IX(0); clear_sys_scheduling(); + wake_scheduler(rq); + return 0; + } +#endif + if (!erts_port_task_have_outstanding_io_tasks()) + return 1; + clear_sys_scheduling(); } return 0; #else @@ -2615,6 +2703,8 @@ aux_thread(void *unused) erts_thr_progress_active(NULL, thr_prgr_active = 0); erts_thr_progress_prepare_wait(NULL); + ERTS_SCHED_FAIR_YIELD(); + flgs = sched_spin_wait(ssi, 0); if (flgs & ERTS_SSI_FLG_SLEEPING) { @@ -2682,7 +2772,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) * be waiting in erl_sys_schedule() */ - if (ERTS_SCHEDULER_IS_DIRTY(esdp) || !prepare_for_sys_schedule()) { + if (ERTS_SCHEDULER_IS_DIRTY(esdp) || !prepare_for_sys_schedule(esdp)) { sched_waiting(esdp->no, rq); @@ -2697,15 +2787,15 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) while (1) { - aux_work = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0 : - erts_atomic32_read_acqb(&ssi->aux_work); + aux_work = erts_atomic32_read_acqb(&ssi->aux_work); if (aux_work) { - if (!thr_prgr_active) { + if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && !thr_prgr_active) { erts_thr_progress_active(esdp, thr_prgr_active = 1); sched_wall_time_change(esdp, 1); } aux_work = handle_aux_work(&esdp->aux_work_data, aux_work, 1); - if (aux_work && erts_thr_progress_update(esdp)) + if (aux_work && !ERTS_SCHEDULER_IS_DIRTY(esdp) + && erts_thr_progress_update(esdp)) erts_thr_progress_leader_update(esdp); } @@ -2720,6 +2810,8 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) erts_thr_progress_prepare_wait(esdp); } + ERTS_SCHED_FAIR_YIELD(); + flgs = sched_spin_wait(ssi, spincount); if (flgs & ERTS_SSI_FLG_SLEEPING) { ASSERT(flgs & ERTS_SSI_FLG_WAITING); @@ -2775,6 +2867,10 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) #ifdef ERTS_DIRTY_SCHEDULERS ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp)); #endif + +#ifdef ERTS_SCHED_ONLY_POLL_SCHED_1 + ASSERT(esdp->no == 1); +#endif sched_waiting_sys(esdp->no, rq); @@ -2795,7 +2891,6 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) sched_wall_time_change(esdp, working = 0); ASSERT(!erts_port_task_have_outstanding_io_tasks()); - erl_sys_schedule(1); /* Might give us something to do */ dt = erts_do_time_read_and_reset(); @@ -2841,7 +2936,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) * Got to check that we still got I/O tasks; otherwise * we have to continue checking for I/O... */ - if (!prepare_for_sys_schedule()) { + if (!prepare_for_sys_schedule(esdp)) { spincount *= ERTS_SCHED_TSE_SLEEP_SPINCOUNT_FACT; goto tse_wait; } @@ -2863,7 +2958,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) * Got to check that we still got I/O tasks; otherwise * we have to wait in erl_sys_schedule() after all... */ - if (!prepare_for_sys_schedule()) { + if (!prepare_for_sys_schedule(esdp)) { /* * Not allowed to wait in erl_sys_schedule; * do tse wait instead... @@ -2990,7 +3085,7 @@ wake_scheduler(ErtsRunQueue *rq) #ifdef ERTS_DIRTY_SCHEDULERS static void -wake_dirty_scheduler(ErtsRunQueue *rq) +wake_dirty_schedulers(ErtsRunQueue *rq, int one) { ErtsSchedulerSleepInfo *ssi; ErtsSchedulerSleepList *sl; @@ -3000,9 +3095,27 @@ wake_dirty_scheduler(ErtsRunQueue *rq) sl = &rq->sleepers; erts_smp_spin_lock(&sl->lock); ssi = sl->list; - if (!ssi) + if (!ssi) { erts_smp_spin_unlock(&sl->lock); - else { + if (one) + wake_scheduler(rq); + } else if (one) { + erts_aint32_t flgs; + if (ssi->prev) + ssi->prev->next = ssi->next; + else { + ASSERT(sl->list == ssi); + sl->list = ssi->next; + } + if (ssi->next) + ssi->next->prev = ssi->prev; + + erts_smp_spin_unlock(&sl->lock); + + ERTS_THR_MEMORY_BARRIER; + flgs = ssi_flags_set_wake(ssi); + erts_sched_finish_poke(ssi, flgs); + } else { sl->list = NULL; erts_smp_spin_unlock(&sl->lock); @@ -3154,7 +3267,7 @@ smp_notify_inc_runq(ErtsRunQueue *runq) if (runq) { #ifdef ERTS_DIRTY_SCHEDULERS if (ERTS_RUNQ_IX_IS_DIRTY(runq->ix)) - wake_dirty_scheduler(runq); + wake_dirty_schedulers(runq, 1); else #endif wake_scheduler(runq); @@ -3452,6 +3565,7 @@ suspend_run_queue(ErtsRunQueue *rq) } static void scheduler_ix_resume_wake(Uint ix); +static void scheduler_ssi_resume_wake(ErtsSchedulerSleepInfo *ssi); static ERTS_INLINE void resume_run_queue(ErtsRunQueue *rq) @@ -3478,7 +3592,10 @@ resume_run_queue(ErtsRunQueue *rq) erts_smp_runq_unlock(rq); - scheduler_ix_resume_wake(rq->ix); +#ifdef ERTS_DIRTY_SCHEDULERS + if (!ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) +#endif + scheduler_ix_resume_wake(rq->ix); } typedef struct { @@ -3509,20 +3626,28 @@ evacuate_run_queue(ErtsRunQueue *rq, int prio_q; ErtsRunQueue *to_rq; ErtsMigrationPaths *mps; - ErtsMigrationPath *mp; + ErtsMigrationPath *mp = NULL; ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); (void) ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_PROTECTED); - mps = erts_get_migration_paths_managed(); - mp = &mps->mpath[rq->ix]; +#ifdef ERTS_DIRTY_SCHEDULERS + if (!ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) +#endif + { + mps = erts_get_migration_paths_managed(); + mp = &mps->mpath[rq->ix]; + } /* Evacuate scheduled misc ops */ if (rq->misc.start) { ErtsMiscOpList *start, *end; +#ifdef ERTS_DIRTY_SCHEDULERS + ASSERT(!ERTS_RUNQ_IX_IS_DIRTY(rq->ix)); +#endif to_rq = mp->misc_evac_runq; if (!to_rq) return; @@ -3551,6 +3676,9 @@ evacuate_run_queue(ErtsRunQueue *rq, if (rq->ports.start) { Port *prt; +#ifdef ERTS_DIRTY_SCHEDULERS + ASSERT(!ERTS_RUNQ_IX_IS_DIRTY(rq->ix)); +#endif to_rq = mp->prio[ERTS_PORT_PRIO_LEVEL].runq; if (!to_rq) return; @@ -3586,15 +3714,26 @@ evacuate_run_queue(ErtsRunQueue *rq, erts_aint32_t state; Process *proc; int notify = 0; +#ifdef ERTS_DIRTY_SCHEDULERS + int requeue; +#endif to_rq = NULL; - if (!mp->prio[prio_q].runq) - return; - if (prio_q == PRIORITY_NORMAL && !mp->prio[PRIORITY_LOW].runq) - return; +#ifdef ERTS_DIRTY_SCHEDULERS + if (!ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) +#endif + { + if (!mp->prio[prio_q].runq) + return; + if (prio_q == PRIORITY_NORMAL && !mp->prio[PRIORITY_LOW].runq) + return; + } proc = dequeue_process(rq, prio_q, &state); while (proc) { +#ifdef ERTS_DIRTY_SCHEDULERS + requeue = 1; +#endif if (ERTS_PSFLG_BOUND & state) { /* Bound processes get stuck here... */ proc->next = NULL; @@ -3603,12 +3742,43 @@ evacuate_run_queue(ErtsRunQueue *rq, else sbpp->first = proc; sbpp->last = proc; +#ifdef ERTS_DIRTY_SCHEDULERS + requeue = 0; +#endif } +#ifdef ERTS_DIRTY_SCHEDULERS + else if (state & ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q) { + erts_aint32_t old; + old = erts_smp_atomic32_read_band_nob(&proc->state, + ~(ERTS_PSFLG_DIRTY_CPU_PROC + | ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q)); + /* assert that no other dirty flags are set */ + ASSERT(!(old & (ERTS_PSFLG_DIRTY_IO_PROC|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q))); + } else if (state & ERTS_PSFLG_DIRTY_IO_PROC_IN_Q) { + erts_aint32_t old; + old = erts_smp_atomic32_read_band_nob(&proc->state, + ~(ERTS_PSFLG_DIRTY_IO_PROC + | ERTS_PSFLG_DIRTY_IO_PROC_IN_Q)); + /* assert that no other dirty flags are set */ + ASSERT(!(old & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q))); + } + if (requeue) { +#else else { +#endif int prio = (int) ERTS_PSFLGS_GET_PRQ_PRIO(state); erts_smp_runq_unlock(rq); - to_rq = mp->prio[prio].runq; +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) + /* + * dirty run queues evacuate only to run + * queue 0 during multi-scheduling blocking + */ + to_rq = ERTS_RUNQ_IX(0); + else +#endif + to_rq = mp->prio[prio].runq; RUNQ_SET_RQ(&proc->run_queue, to_rq); erts_smp_runq_lock(to_rq); @@ -4722,13 +4892,20 @@ wakeup_other_check(ErtsRunQueue *rq, Uint32 flags) rq->wakeup_other += (left_len*wo_reds + ERTS_WAKEUP_OTHER_FIXED_INC); if (rq->wakeup_other > wakeup_other.limit) { - int empty_rqs = - erts_smp_atomic32_read_acqb(&no_empty_run_queues); - if (flags & ERTS_RUNQ_FLG_PROTECTED) - (void) ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_PROTECTED); - if (empty_rqs != 0) - wake_scheduler_on_empty_runq(rq); - rq->wakeup_other = 0; +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix) && rq->waiting) + wake_dirty_schedulers(rq, 1); + else +#endif + { + int empty_rqs = + erts_smp_atomic32_read_acqb(&no_empty_run_queues); + if (flags & ERTS_RUNQ_FLG_PROTECTED) + (void) ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_PROTECTED); + if (empty_rqs != 0) + wake_scheduler_on_empty_runq(rq); + rq->wakeup_other = 0; + } } } rq->wakeup_other_reds = 0; @@ -4889,11 +5066,17 @@ erts_early_init_scheduling(int no_schedulers) wakeup_other.threshold = ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_MEDIUM; wakeup_other.type = ERTS_SCHED_WAKEUP_OTHER_TYPE_DEFAULT; #endif +#ifndef ERTS_SCHED_MIN_SPIN sched_busy_wait.sys_schedule = ERTS_SCHED_SYS_SLEEP_SPINCOUNT_MEDIUM; sched_busy_wait.tse = (ERTS_SCHED_SYS_SLEEP_SPINCOUNT_MEDIUM * ERTS_SCHED_TSE_SLEEP_SPINCOUNT_FACT); sched_busy_wait.aux_work = (ERTS_SCHED_SYS_SLEEP_SPINCOUNT_MEDIUM * ERTS_SCHED_AUX_WORK_SLEEP_SPINCOUNT_FACT_MEDIUM); +#else + sched_busy_wait.sys_schedule = ERTS_SCHED_SYS_SLEEP_SPINCOUNT_NONE; + sched_busy_wait.tse = ERTS_SCHED_SYS_SLEEP_SPINCOUNT_NONE; + sched_busy_wait.aux_work = ERTS_SCHED_SYS_SLEEP_SPINCOUNT_NONE; +#endif } int @@ -5009,8 +5192,12 @@ erts_sched_set_wake_cleanup_threshold(char *str) static void init_aux_work_data(ErtsAuxWorkData *awdp, ErtsSchedulerData *esdp, char *dawwp) { - if (!esdp || ERTS_SCHEDULER_IS_DIRTY(esdp)) + if (!esdp) awdp->sched_id = 0; +#ifdef ERTS_DIRTY_SCHEDULERS + else if (ERTS_SCHEDULER_IS_DIRTY(esdp)) + awdp->sched_id = (int) ERTS_DIRTY_SCHEDULER_NO(esdp); +#endif else awdp->sched_id = (int) esdp->no; awdp->esdp = esdp; @@ -5076,11 +5263,11 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num, #ifdef ERTS_DIRTY_SCHEDULERS if (ERTS_RUNQ_IX_IS_DIRTY(runq->ix)) { esdp->no = 0; - esdp->dirty_no = (Uint) num; + ERTS_DIRTY_SCHEDULER_NO(esdp) = (Uint) num; } else { esdp->no = (Uint) num; - esdp->dirty_no = 0; + ERTS_DIRTY_SCHEDULER_NO(esdp) = 0; } #else esdp->no = (Uint) num; @@ -5111,7 +5298,12 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num, } void -erts_init_scheduling(int no_schedulers, int no_schedulers_online) +erts_init_scheduling(int no_schedulers, int no_schedulers_online +#ifdef ERTS_DIRTY_SCHEDULERS + , int no_dirty_cpu_schedulers, int no_dirty_cpu_schedulers_online, + int no_dirty_io_schedulers +#endif + ) { int ix, n, no_ssi; char *daww_ptr; @@ -5133,6 +5325,12 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online) ASSERT(no_schedulers_online <= no_schedulers); ASSERT(no_schedulers_online >= 1); ASSERT(no_schedulers >= 1); +#ifdef ERTS_DIRTY_SCHEDULERS + ASSERT(no_dirty_cpu_schedulers <= no_schedulers); + ASSERT(no_dirty_cpu_schedulers >= 1); + ASSERT(no_dirty_cpu_schedulers_online <= no_schedulers_online); + ASSERT(no_dirty_cpu_schedulers_online >= 1); +#endif /* Create and initialize run queues */ @@ -5169,10 +5367,9 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online) #ifdef ERTS_DIRTY_SCHEDULERS #ifdef ERTS_SMP - if (ERTS_RUNQ_IX_IS_DIRTY(ix)) { + if (ERTS_RUNQ_IX_IS_DIRTY(ix)) erts_smp_spinlock_init(&rq->sleepers.lock, "dirty_run_queue_sleep_list"); - rq->sleepers.list = NULL; - } + rq->sleepers.list = NULL; #endif #endif @@ -5236,6 +5433,10 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online) n = (int) no_schedulers; erts_no_schedulers = n; +#ifdef ERTS_DIRTY_SCHEDULERS + erts_no_dirty_cpu_schedulers = no_dirty_cpu_schedulers; + erts_no_dirty_io_schedulers = no_dirty_io_schedulers; +#endif /* Create and initialize scheduler sleep info */ #ifdef ERTS_SMP @@ -5267,21 +5468,21 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online) aligned_dirty_cpu_sched_sleep_info = erts_alloc_permanent_cache_aligned( ERTS_ALC_T_SCHDLR_SLP_INFO, - erts_no_dirty_cpu_schedulers*sizeof(ErtsAlignedSchedulerSleepInfo)); - for (ix = 0; ix < erts_no_dirty_cpu_schedulers; ix++) { + no_dirty_cpu_schedulers*sizeof(ErtsAlignedSchedulerSleepInfo)); + for (ix = 0; ix < no_dirty_cpu_schedulers; ix++) { ErtsSchedulerSleepInfo *ssi = &aligned_dirty_cpu_sched_sleep_info[ix].ssi; erts_smp_atomic32_init_nob(&ssi->flags, 0); - ssi->event = NULL; /* initialized in sched_thread_func */ + ssi->event = NULL; /* initialized in sched_dirty_cpu_thread_func */ erts_atomic32_init_nob(&ssi->aux_work, 0); } aligned_dirty_io_sched_sleep_info = erts_alloc_permanent_cache_aligned( ERTS_ALC_T_SCHDLR_SLP_INFO, - erts_no_dirty_io_schedulers*sizeof(ErtsAlignedSchedulerSleepInfo)); - for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) { + no_dirty_io_schedulers*sizeof(ErtsAlignedSchedulerSleepInfo)); + for (ix = 0; ix < no_dirty_io_schedulers; ix++) { ErtsSchedulerSleepInfo *ssi = &aligned_dirty_io_sched_sleep_info[ix].ssi; erts_smp_atomic32_init_nob(&ssi->flags, 0); - ssi->event = NULL; /* initialized in sched_thread_func */ + ssi->event = NULL; /* initialized in sched_dirty_io_thread_func */ erts_atomic32_init_nob(&ssi->aux_work, 0); } #endif @@ -5314,8 +5515,8 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online) erts_aligned_dirty_cpu_scheduler_data = erts_alloc_permanent_cache_aligned( ERTS_ALC_T_SCHDLR_DATA, - erts_no_dirty_cpu_schedulers*sizeof(ErtsAlignedSchedulerData)); - for (ix = 0; ix < erts_no_dirty_cpu_schedulers; ix++) { + no_dirty_cpu_schedulers*sizeof(ErtsAlignedSchedulerData)); + for (ix = 0; ix < no_dirty_cpu_schedulers; ix++) { ErtsSchedulerData *esdp = ERTS_DIRTY_CPU_SCHEDULER_IX(ix); init_scheduler_data(esdp, ix+1, ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix), ERTS_DIRTY_CPU_RUNQ, NULL, 0); @@ -5323,8 +5524,8 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online) erts_aligned_dirty_io_scheduler_data = erts_alloc_permanent_cache_aligned( ERTS_ALC_T_SCHDLR_DATA, - erts_no_dirty_io_schedulers*sizeof(ErtsAlignedSchedulerData)); - for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) { + no_dirty_io_schedulers*sizeof(ErtsAlignedSchedulerData)); + for (ix = 0; ix < no_dirty_io_schedulers; ix++) { ErtsSchedulerData *esdp = ERTS_DIRTY_IO_SCHEDULER_IX(ix); init_scheduler_data(esdp, ix+1, ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix), ERTS_DIRTY_IO_RUNQ, NULL, 0); @@ -5354,6 +5555,16 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online) schdlr_sspnd.curr_online = no_schedulers; schdlr_sspnd.msb.ongoing = 0; erts_smp_atomic32_init_nob(&schdlr_sspnd.active, no_schedulers); +#ifdef ERTS_DIRTY_SCHEDULERS + erts_smp_atomic32_init_nob(&schdlr_sspnd.dirty_cpu_changing, 0); + schdlr_sspnd.dirty_cpu_online = no_dirty_cpu_schedulers_online; + schdlr_sspnd.dirty_cpu_curr_online = no_dirty_cpu_schedulers; + erts_smp_atomic32_init_nob(&schdlr_sspnd.dirty_cpu_active, no_dirty_cpu_schedulers); + erts_smp_atomic32_init_nob(&schdlr_sspnd.dirty_io_changing, 0); + schdlr_sspnd.dirty_io_online = no_dirty_io_schedulers; + schdlr_sspnd.dirty_io_curr_online = no_dirty_io_schedulers; + erts_smp_atomic32_init_nob(&schdlr_sspnd.dirty_io_active, no_dirty_io_schedulers); +#endif schdlr_sspnd.msb.procs = NULL; init_no_runqs(no_schedulers_online, no_schedulers_online); balance_info.last_active_runqs = no_schedulers; @@ -5379,6 +5590,21 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online) schdlr_sspnd.curr_online *= 2; /* Boot strapping... */ ERTS_SCHDLR_SSPND_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_ONLN | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0); +#ifdef ERTS_DIRTY_SCHEDULERS + schdlr_sspnd.dirty_cpu_wait_curr_online = no_dirty_cpu_schedulers_online; + schdlr_sspnd.dirty_cpu_curr_online *= 2; + ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_ONLN + | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0); + for (ix = no_dirty_cpu_schedulers_online; ix < no_dirty_cpu_schedulers; ix++) { + ErtsSchedulerData* esdp = ERTS_DIRTY_CPU_SCHEDULER_IX(ix); + erts_smp_atomic32_read_bor_nob(&esdp->ssi->flags, ERTS_SSI_FLG_SUSPENDED); + } + + schdlr_sspnd.dirty_io_wait_curr_online = no_dirty_io_schedulers; + schdlr_sspnd.dirty_io_curr_online *= 2; + ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_ONLN + | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0); +#endif erts_smp_atomic32_init_nob(&doing_sys_schedule, 0); @@ -5497,9 +5723,16 @@ free_proxy_proc(Process *proxy) erts_free(ERTS_ALC_T_PROC, proxy); } +#define ERTS_ENQUEUE_NOT 0 +#define ERTS_ENQUEUE_NORMAL_QUEUE 1 +#ifdef ERTS_DIRTY_SCHEDULERS +#define ERTS_ENQUEUE_DIRTY_CPU_QUEUE 2 +#define ERTS_ENQUEUE_DIRTY_IO_QUEUE 3 +#endif static ERTS_INLINE int -check_enqueue_in_prio_queue(erts_aint32_t *prq_prio_p, +check_enqueue_in_prio_queue(Process *c_p, + erts_aint32_t *prq_prio_p, erts_aint32_t *newp, erts_aint32_t actual) { @@ -5511,56 +5744,105 @@ check_enqueue_in_prio_queue(erts_aint32_t *prq_prio_p, *prq_prio_p = aprio; #ifdef ERTS_DIRTY_SCHEDULERS - if (!(actual & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC))) { + if (actual & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)) { + /* + * If we have system tasks of a priority higher + * or equal to the user priority, we enqueue + * on ordinary run-queue and take care of + * those system tasks first. + */ + if (actual & ERTS_PSFLG_ACTIVE_SYS) { + erts_aint32_t uprio, stprio, qmask; + uprio = (actual >> ERTS_PSFLGS_USR_PRIO_OFFSET) & ERTS_PSFLGS_PRIO_MASK; + if (aprio < uprio) + goto enqueue_normal_runq; /* system tasks with higher prio */ + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_STATUS); + qmask = c_p->sys_task_qs->qmask; + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS); + switch (qmask & -qmask) { + case MAX_BIT: + stprio = PRIORITY_MAX; + break; + case HIGH_BIT: + stprio = PRIORITY_HIGH; + break; + case NORMAL_BIT: + stprio = PRIORITY_NORMAL; + break; + case LOW_BIT: + stprio = PRIORITY_LOW; + break; + default: + stprio = PRIORITY_LOW+1; + break; + } + if (stprio <= uprio) + goto enqueue_normal_runq; /* system tasks with higher prio */ + } + + /* Enqueue in dirty run queue if not already enqueued */ + if (actual & (ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q)) + return ERTS_ENQUEUE_NOT; /* already in queue */ + if (actual & ERTS_PSFLG_DIRTY_CPU_PROC) { + *newp |= ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q; + if (actual & ERTS_PSFLG_IN_RUNQ) + return -ERTS_ENQUEUE_DIRTY_CPU_QUEUE; /* use proxy */ + *newp |= ERTS_PSFLG_IN_RUNQ; + return ERTS_ENQUEUE_DIRTY_CPU_QUEUE; + } + *newp |= ERTS_PSFLG_DIRTY_IO_PROC_IN_Q; + if (actual & ERTS_PSFLG_IN_RUNQ) + return -ERTS_ENQUEUE_DIRTY_IO_QUEUE; /* use proxy */ + *newp |= ERTS_PSFLG_IN_RUNQ; + return ERTS_ENQUEUE_DIRTY_IO_QUEUE; + } + + enqueue_normal_runq: #endif - max_qbit = (actual >> ERTS_PSFLGS_IN_PRQ_MASK_OFFSET) & ERTS_PSFLGS_QMASK; - max_qbit |= 1 << ERTS_PSFLGS_QMASK_BITS; - max_qbit &= -max_qbit; - /* - * max_qbit now either contain bit set for highest prio queue or a bit - * out of range (which will have a value larger than valid range). - */ + max_qbit = (actual >> ERTS_PSFLGS_IN_PRQ_MASK_OFFSET) & ERTS_PSFLGS_QMASK; + max_qbit |= 1 << ERTS_PSFLGS_QMASK_BITS; + max_qbit &= -max_qbit; + /* + * max_qbit now either contain bit set for highest prio queue or a bit + * out of range (which will have a value larger than valid range). + */ - if (qbit >= max_qbit) - return 0; /* Already queued in higher or equal prio */ + if (qbit >= max_qbit) + return ERTS_ENQUEUE_NOT; /* Already queued in higher or equal prio */ - /* Need to enqueue (if already enqueued, it is in lower prio) */ - *newp |= qbit << ERTS_PSFLGS_IN_PRQ_MASK_OFFSET; + /* Need to enqueue (if already enqueued, it is in lower prio) */ + *newp |= qbit << ERTS_PSFLGS_IN_PRQ_MASK_OFFSET; - if ((actual & (ERTS_PSFLG_IN_RUNQ|ERTS_PSFLGS_USR_PRIO_MASK)) - != (aprio << ERTS_PSFLGS_USR_PRIO_OFFSET)) { - /* - * Process struct already enqueued, or actual prio not - * equal to user prio, i.e., enqueue using proxy. - */ - return -1; - } -#ifdef ERTS_DIRTY_SCHEDULERS - } else { - if (actual & ERTS_PSFLG_DIRTY_CPU_PROC) - *newp |= ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q; - else - *newp |= ERTS_PSFLG_DIRTY_IO_PROC_IN_Q; + if ((actual & (ERTS_PSFLG_IN_RUNQ|ERTS_PSFLGS_USR_PRIO_MASK)) + != (aprio << ERTS_PSFLGS_USR_PRIO_OFFSET)) { + /* + * Process struct already enqueued, or actual prio not + * equal to user prio, i.e., enqueue using proxy. + */ + return -ERTS_ENQUEUE_NORMAL_QUEUE; } -#endif /* * Enqueue using process struct. */ *newp &= ~ERTS_PSFLGS_PRQ_PRIO_MASK; *newp |= ERTS_PSFLG_IN_RUNQ | (aprio << ERTS_PSFLGS_PRQ_PRIO_OFFSET); - return 1; + return ERTS_ENQUEUE_NORMAL_QUEUE; } /* - * scheduler_out_process() return with c_rq locked. + * schedule_out_process() return with c_rq locked. */ static ERTS_INLINE int schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Process *proxy) { erts_aint32_t a, e, n, enq_prio = -1; - int res = 0; int enqueue; /* < 0 -> use proxy */ + Process* sched_p; + ErtsRunQueue* runq; +#ifdef ERTS_SMP + int check_emigration_need; +#endif a = state; @@ -5569,20 +5851,20 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces ASSERT(a & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS)); - enqueue = 0; + enqueue = ERTS_ENQUEUE_NOT; n &= ~(ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS); if (a & ERTS_PSFLG_ACTIVE_SYS || (a & (ERTS_PSFLG_ACTIVE|ERTS_PSFLG_SUSPENDED)) == ERTS_PSFLG_ACTIVE) { - enqueue = check_enqueue_in_prio_queue(&enq_prio, &n, a); + enqueue = check_enqueue_in_prio_queue(p, &enq_prio, &n, a); } a = erts_smp_atomic32_cmpxchg_mb(&p->state, n, e); if (a == e) break; } - if (!enqueue) { - + switch (enqueue) { + case ERTS_ENQUEUE_NOT: if (erts_system_profile_flags.runnable_procs) { if (!(a & ERTS_PSFLG_ACTIVE_SYS) @@ -5595,60 +5877,76 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces if (proxy) free_proxy_proc(proxy); - } - else { - Process *sched_p; - ErtsRunQueue *runq; - ASSERT(!(n & ERTS_PSFLG_SUSPENDED) || (n & ERTS_PSFLG_ACTIVE_SYS)); + erts_smp_runq_lock(c_rq); + return 0; #ifdef ERTS_DIRTY_SCHEDULERS #ifdef ERTS_SMP - if (ERTS_PSFLG_DIRTY_CPU_PROC & a) - runq = ERTS_DIRTY_CPU_RUNQ; - else if (ERTS_PSFLG_DIRTY_IO_PROC & a) - runq = ERTS_DIRTY_IO_RUNQ; - else + case ERTS_ENQUEUE_DIRTY_CPU_QUEUE: + case -ERTS_ENQUEUE_DIRTY_CPU_QUEUE: + runq = ERTS_DIRTY_CPU_RUNQ; + ASSERT(ERTS_SCHEDULER_IS_DIRTY_CPU(runq->scheduler)); +#ifdef ERTS_SMP + check_emigration_need = 0; +#endif + break; + + case ERTS_ENQUEUE_DIRTY_IO_QUEUE: + case -ERTS_ENQUEUE_DIRTY_IO_QUEUE: + runq = ERTS_DIRTY_IO_RUNQ; + ASSERT(ERTS_SCHEDULER_IS_DIRTY_IO(runq->scheduler)); +#ifdef ERTS_SMP + check_emigration_need = 0; +#endif + break; #endif #endif - runq = erts_get_runq_proc(p); - if (enqueue < 0) - sched_p = make_proxy_proc(proxy, p, enq_prio); - else { - sched_p = p; - if (proxy) - free_proxy_proc(proxy); - } + default: + ASSERT(enqueue == ERTS_ENQUEUE_NORMAL_QUEUE + || enqueue == -ERTS_ENQUEUE_NORMAL_QUEUE); + runq = erts_get_runq_proc(p); #ifdef ERTS_SMP - if (!(ERTS_PSFLG_BOUND & n) -#ifdef ERTS_DIRTY_SCHEDULERS - && !(n & (ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q)) + check_emigration_need = !(ERTS_PSFLG_BOUND & n); #endif - ) { - ErtsRunQueue *new_runq = erts_check_emigration_need(runq, enq_prio); - if (new_runq) { - RUNQ_SET_RQ(&sched_p->run_queue, new_runq); - runq = new_runq; - } + break; + } + + ASSERT(!(n & ERTS_PSFLG_SUSPENDED) || (n & ERTS_PSFLG_ACTIVE_SYS)); + + if (enqueue < 0) + sched_p = make_proxy_proc(proxy, p, enq_prio); + else { + sched_p = p; + if (proxy) + free_proxy_proc(proxy); + } + +#ifdef ERTS_SMP + if (check_emigration_need) { + ErtsRunQueue *new_runq = erts_check_emigration_need(runq, enq_prio); + if (new_runq) { + RUNQ_SET_RQ(&sched_p->run_queue, new_runq); + runq = new_runq; } + } #endif - ASSERT(runq); - res = 1; - erts_smp_runq_lock(runq); + ASSERT(runq); + + erts_smp_runq_lock(runq); - /* Enqueue the process */ - enqueue_process(runq, (int) enq_prio, sched_p); + /* Enqueue the process */ + enqueue_process(runq, (int) enq_prio, sched_p); - if (runq == c_rq) - return res; - erts_smp_runq_unlock(runq); - smp_notify_inc_runq(runq); - } + if (runq == c_rq) + return 1; + erts_smp_runq_unlock(runq); + smp_notify_inc_runq(runq); erts_smp_runq_lock(c_rq); - return res; + return 1; } static ERTS_INLINE void @@ -5704,7 +6002,7 @@ change_proc_schedule_state(Process *p, erts_aint32_t e; n = e = a; - enqueue = 0; + enqueue = ERTS_ENQUEUE_NOT; if (a & ERTS_PSFLG_FREE) break; /* We don't want to schedule free processes... */ @@ -5725,13 +6023,13 @@ change_proc_schedule_state(Process *p, * process may be in a run queue via proxy, need * further inspection... */ - enqueue = check_enqueue_in_prio_queue(enq_prio_p, &n, a); + enqueue = check_enqueue_in_prio_queue(p, enq_prio_p, &n, a); } a = erts_smp_atomic32_cmpxchg_mb(&p->state, n, e); if (a == e) break; - if (enqueue == 0 && n == a) + if (enqueue == ERTS_ENQUEUE_NOT && n == a) break; } @@ -5765,7 +6063,7 @@ schedule_process(Process *p, erts_aint32_t in_state) ERTS_PSFLG_ACTIVE, &state, &enq_prio); - if (enqueue) + if (enqueue != ERTS_ENQUEUE_NOT) add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio), state, enq_prio); @@ -5792,14 +6090,14 @@ schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy) if (a & ERTS_PSFLG_FREE) return; /* We don't want to schedule free processes... */ - enqueue = 0; + enqueue = ERTS_ENQUEUE_NOT; n |= ERTS_PSFLG_ACTIVE_SYS; if (!(a & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS))) - enqueue = check_enqueue_in_prio_queue(&enq_prio, &n, a); + enqueue = check_enqueue_in_prio_queue(p, &enq_prio, &n, a); a = erts_smp_atomic32_cmpxchg_mb(&p->state, n, e); if (a == e) break; - if (a == n && !enqueue) + if (a == n && enqueue == ERTS_ENQUEUE_NOT) goto cleanup; } @@ -5815,7 +6113,7 @@ schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy) } - if (enqueue) { + if (enqueue != ERTS_ENQUEUE_NOT) { Process *sched_p; if (enqueue > 0) sched_p = p; @@ -5938,6 +6236,12 @@ static void scheduler_ix_resume_wake(Uint ix) { ErtsSchedulerSleepInfo *ssi = ERTS_SCHED_SLEEP_INFO_IX(ix); + scheduler_ssi_resume_wake(ssi); +} + +static void +scheduler_ssi_resume_wake(ErtsSchedulerSleepInfo *ssi) +{ erts_aint32_t xflgs = (ERTS_SSI_FLG_SLEEPING | ERTS_SSI_FLG_TSE_SLEEPING | ERTS_SSI_FLG_WAITING @@ -6028,12 +6332,20 @@ sched_set_suspended_sleeptype(ErtsSchedulerSleepInfo *ssi) } } +#ifdef ERTS_DIRTY_SCHEDULERS + static void suspend_scheduler(ErtsSchedulerData *esdp) { erts_aint32_t flgs; erts_aint32_t changing; +#ifdef ERTS_DIRTY_SCHEDULERS + long no = (long) (ERTS_SCHEDULER_IS_DIRTY(esdp) + ? ERTS_DIRTY_SCHEDULER_NO(esdp) + : esdp->no); +#else long no = (long) esdp->no; +#endif ErtsSchedulerSleepInfo *ssi = esdp->ssi; long active_schedulers; int curr_online = 1; @@ -6041,21 +6353,305 @@ suspend_scheduler(ErtsSchedulerData *esdp) erts_aint32_t aux_work; int thr_prgr_active = 1; ErtsStuckBoundProcesses sbp = {NULL, NULL}; + int* ss_onlinep; + int* ss_curr_onlinep; + int* ss_wait_curr_onlinep; + long* ss_wait_activep; + long ss_wait_active_target; + erts_smp_atomic32_t* ss_changingp; + erts_smp_atomic32_t* ss_activep; /* * Schedulers may be suspended in two different ways: * - A scheduler may be suspended since it is not online. * All schedulers with scheduler ids greater than - * schdlr_sspnd.online are suspended. + * schdlr_sspnd.online are suspended; same for dirty + * schedulers and schdlr_sspnd.dirty_cpu_online and + * schdlr_sspnd.dirty_io_online. * - Multi scheduling is blocked. All schedulers except the - * scheduler with scheduler id 1 are suspended. + * scheduler with scheduler id 1 are suspended, and all + * dirty CPU and dirty I/O schedulers are suspended. * * Regardless of why a scheduler is suspended, it ends up here. */ + ASSERT(ERTS_SCHEDULER_IS_DIRTY(esdp) || no != 1); + #ifdef ERTS_DIRTY_SCHEDULERS - ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp)); + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) { + if (erts_smp_mtx_trylock(&schdlr_sspnd.mtx) == EBUSY) { + erts_smp_runq_unlock(esdp->run_queue); + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + erts_smp_runq_lock(esdp->run_queue); + } + if (ongoing_multi_scheduling_block()) + evacuate_run_queue(esdp->run_queue, &sbp); + } else +#endif + evacuate_run_queue(esdp->run_queue, &sbp); + + erts_smp_runq_unlock(esdp->run_queue); + +#ifdef ERTS_DIRTY_SCHEDULERS + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) +#endif + { + erts_sched_check_cpu_bind_prep_suspend(esdp); + + if (erts_system_profile_flags.scheduler) + profile_scheduler(make_small(esdp->no), am_inactive); + + sched_wall_time_change(esdp, 0); + + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + } + + flgs = sched_prep_spin_suspended(ssi, ERTS_SSI_FLG_SUSPENDED); + if (flgs & ERTS_SSI_FLG_SUSPENDED) { + +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) { + if (ERTS_RUNQ_IS_DIRTY_CPU_RUNQ(esdp->run_queue)) { + active_schedulers = erts_smp_atomic32_dec_read_nob(&schdlr_sspnd.dirty_cpu_active); + ASSERT(active_schedulers >= 0); + changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_changing); + ss_onlinep = &schdlr_sspnd.dirty_cpu_online; + ss_curr_onlinep = &schdlr_sspnd.dirty_cpu_curr_online; + ss_wait_curr_onlinep = &schdlr_sspnd.dirty_cpu_wait_curr_online; + ss_changingp = &schdlr_sspnd.dirty_cpu_changing; + ss_wait_activep = &schdlr_sspnd.msb.dirty_cpu_wait_active; + ss_activep = &schdlr_sspnd.dirty_cpu_active; + } else { + active_schedulers = erts_smp_atomic32_dec_read_nob(&schdlr_sspnd.dirty_io_active); + ASSERT(active_schedulers >= 0); + changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_io_changing); + ss_onlinep = &schdlr_sspnd.dirty_io_online; + ss_curr_onlinep = &schdlr_sspnd.dirty_io_curr_online; + ss_wait_curr_onlinep = &schdlr_sspnd.dirty_io_wait_curr_online; + ss_changingp = &schdlr_sspnd.dirty_io_changing; + ss_wait_activep = &schdlr_sspnd.msb.dirty_io_wait_active; + ss_activep = &schdlr_sspnd.dirty_io_active; + } + ss_wait_active_target = 0; + } + else +#endif + { + active_schedulers = erts_smp_atomic32_dec_read_nob(&schdlr_sspnd.active); + ASSERT(active_schedulers >= 1); + changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); + ss_onlinep = &schdlr_sspnd.online; + ss_curr_onlinep = &schdlr_sspnd.curr_online; + ss_wait_curr_onlinep = &schdlr_sspnd.wait_curr_online; + ss_changingp = &schdlr_sspnd.changing; + ss_wait_activep = &schdlr_sspnd.msb.wait_active; + ss_activep = &schdlr_sspnd.active; + ss_wait_active_target = 1; + } + if (changing & ERTS_SCHDLR_SSPND_CHNG_MSB) { + if (active_schedulers == *ss_wait_activep) + wake = 1; + if (active_schedulers == ss_wait_active_target) { + changing = erts_smp_atomic32_read_band_nob(ss_changingp, + ~ERTS_SCHDLR_SSPND_CHNG_MSB); + changing &= ~ERTS_SCHDLR_SSPND_CHNG_MSB; + } + } + + while (1) { + if (changing & ERTS_SCHDLR_SSPND_CHNG_ONLN) { + int changed = 0; + if (no > *ss_onlinep && curr_online) { + (*ss_curr_onlinep)--; + curr_online = 0; + changed = 1; + } + else if (no <= *ss_onlinep && !curr_online) { + (*ss_curr_onlinep)++; + curr_online = 1; + changed = 1; + } + if (changed + && *ss_curr_onlinep == *ss_wait_curr_onlinep) + wake = 1; + if (*ss_onlinep == *ss_curr_onlinep) { + changing = erts_smp_atomic32_read_band_nob(ss_changingp, + ~ERTS_SCHDLR_SSPND_CHNG_ONLN); + changing &= ~ERTS_SCHDLR_SSPND_CHNG_ONLN; + } + } + + if (wake) { + erts_smp_cnd_signal(&schdlr_sspnd.cnd); + wake = 0; + } + + if (curr_online && !ongoing_multi_scheduling_block()) { + flgs = erts_smp_atomic32_read_acqb(&ssi->flags); + if (!(flgs & ERTS_SSI_FLG_SUSPENDED)) + break; + } + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + + while (1) { + erts_aint32_t qmask; + erts_aint32_t flgs; + + qmask = (ERTS_RUNQ_FLGS_GET(esdp->run_queue) + & ERTS_RUNQ_FLGS_QMASK); + aux_work = erts_atomic32_read_acqb(&ssi->aux_work); + if (aux_work|qmask) { + if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && !thr_prgr_active) { + erts_thr_progress_active(esdp, thr_prgr_active = 1); + sched_wall_time_change(esdp, 1); + } + if (aux_work) + aux_work = handle_aux_work(&esdp->aux_work_data, + aux_work, + 1); + + if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && + (aux_work && erts_thr_progress_update(esdp))) + erts_thr_progress_leader_update(esdp); + if (qmask) { +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) { + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + erts_smp_runq_lock(esdp->run_queue); + if (ongoing_multi_scheduling_block()) + evacuate_run_queue(esdp->run_queue, &sbp); + erts_smp_runq_unlock(esdp->run_queue); + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + } else +#endif + { + erts_smp_runq_lock(esdp->run_queue); + evacuate_run_queue(esdp->run_queue, &sbp); + erts_smp_runq_unlock(esdp->run_queue); + } + } + } + + if (!aux_work) { +#ifdef ERTS_DIRTY_SCHEDULERS + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) #endif + { + if (thr_prgr_active) { + erts_thr_progress_active(esdp, thr_prgr_active = 0); + sched_wall_time_change(esdp, 0); + } + erts_thr_progress_prepare_wait(esdp); + } + flgs = sched_spin_suspended(ssi, + ERTS_SCHED_SUSPEND_SLEEP_SPINCOUNT); + if (flgs == (ERTS_SSI_FLG_SLEEPING + | ERTS_SSI_FLG_WAITING + | ERTS_SSI_FLG_SUSPENDED)) { + flgs = sched_set_suspended_sleeptype(ssi); + if (flgs == (ERTS_SSI_FLG_SLEEPING + | ERTS_SSI_FLG_TSE_SLEEPING + | ERTS_SSI_FLG_WAITING + | ERTS_SSI_FLG_SUSPENDED)) { + int res; + + do { + res = erts_tse_wait(ssi->event); + } while (res == EINTR); + } + } +#ifdef ERTS_DIRTY_SCHEDULERS + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) +#endif + erts_thr_progress_finalize_wait(esdp); + } + + flgs = sched_prep_spin_suspended(ssi, (ERTS_SSI_FLG_WAITING + | ERTS_SSI_FLG_SUSPENDED)); + if (!(flgs & ERTS_SSI_FLG_SUSPENDED)) + break; + changing = erts_smp_atomic32_read_nob(ss_changingp); + if (changing & ~ERTS_SCHDLR_SSPND_CHNG_WAITER) + break; + } + + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + changing = erts_smp_atomic32_read_nob(ss_changingp); + } + + active_schedulers = erts_smp_atomic32_inc_read_nob(ss_activep); + changing = erts_smp_atomic32_read_nob(ss_changingp); + if ((changing & ERTS_SCHDLR_SSPND_CHNG_MSB) + && *ss_onlinep == active_schedulers) { + erts_smp_atomic32_read_band_nob(ss_changingp, + ~ERTS_SCHDLR_SSPND_CHNG_MSB); + } + +#ifdef ERTS_DIRTY_SCHEDULERS + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) +#endif + ASSERT(no <= *ss_onlinep); + ASSERT(!ongoing_multi_scheduling_block()); + + } + + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + + ASSERT(curr_online); + +#ifdef ERTS_DIRTY_SCHEDULERS + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) +#endif + { + if (erts_system_profile_flags.scheduler) + profile_scheduler(make_small(esdp->no), am_active); + + if (!thr_prgr_active) { + erts_thr_progress_active(esdp, thr_prgr_active = 1); + sched_wall_time_change(esdp, 1); + } + } + + erts_smp_runq_lock(esdp->run_queue); + non_empty_runq(esdp->run_queue); + +#ifdef ERTS_DIRTY_SCHEDULERS + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) +#endif + { + schedule_bound_processes(esdp->run_queue, &sbp); + + erts_sched_check_cpu_bind_post_suspend(esdp); + } +} + +#else /* !ERTS_DIRTY_SCHEDULERS */ + +static void +suspend_scheduler(ErtsSchedulerData *esdp) +{ + erts_aint32_t flgs; + erts_aint32_t changing; + long no = (long) esdp->no; + ErtsSchedulerSleepInfo *ssi = esdp->ssi; + long active_schedulers; + int curr_online = 1; + int wake = 0; + erts_aint32_t aux_work; + int thr_prgr_active = 1; + ErtsStuckBoundProcesses sbp = {NULL, NULL}; + + /* + * Schedulers may be suspended in two different ways: + * - A scheduler may be suspended since it is not online. + * All schedulers with scheduler ids greater than + * schdlr_sspnd.online are suspended. + * - Multi scheduling is blocked. All schedulers except the + * scheduler with scheduler id 1 are suspended. + * + * Regardless of why a scheduler is suspended, it ends up here. + */ + ASSERT(no != 1); evacuate_run_queue(esdp->run_queue, &sbp); @@ -6219,6 +6815,8 @@ suspend_scheduler(ErtsSchedulerData *esdp) erts_sched_check_cpu_bind_post_suspend(esdp); } +#endif + ErtsSchedSuspendResult erts_schedulers_state(Uint *total, Uint *online, @@ -6230,40 +6828,315 @@ erts_schedulers_state(Uint *total, { int res = ERTS_SCHDLR_SSPND_EINVAL; erts_aint32_t changing; - if (total) { - ASSERT(online); - ASSERT(active); - erts_smp_mtx_lock(&schdlr_sspnd.mtx); - changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); - if (yield_allowed && (changing & ~ERTS_SCHDLR_SSPND_CHNG_WAITER)) - res = ERTS_SCHDLR_SSPND_YIELD_RESTART; - else { - *active = *online = schdlr_sspnd.online; - if (ongoing_multi_scheduling_block()) - *active = 1; - res = ERTS_SCHDLR_SSPND_DONE; - } - erts_smp_mtx_unlock(&schdlr_sspnd.mtx); - *total = erts_no_schedulers; + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); +#ifdef ERTS_DIRTY_SCHEDULERS + changing |= (erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_changing) + | erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_io_changing)); +#endif + if (yield_allowed && (changing & ~ERTS_SCHDLR_SSPND_CHNG_WAITER)) + res = ERTS_SCHDLR_SSPND_YIELD_RESTART; + else { + if (active) + *active = schdlr_sspnd.online; + if (online) + *online = schdlr_sspnd.online; + if (ongoing_multi_scheduling_block() && active) + *active = 1; +#ifdef ERTS_DIRTY_SCHEDULERS + if (dirty_cpu_online) + *dirty_cpu_online = schdlr_sspnd.dirty_cpu_online; +#endif + res = ERTS_SCHDLR_SSPND_DONE; } + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + if (total) + *total = erts_no_schedulers; #ifdef ERTS_DIRTY_SCHEDULERS if (dirty_cpu) *dirty_cpu = erts_no_dirty_cpu_schedulers; - if (dirty_cpu_online) - *dirty_cpu_online = erts_no_dirty_cpu_schedulers_online; if (dirty_io) *dirty_io = erts_no_dirty_io_schedulers; -#else - if (dirty_cpu) - *dirty_cpu = 0; - if (dirty_cpu_online) - *dirty_cpu_online = 0; - if (dirty_io) - *dirty_io = 0; #endif return res; } +#ifdef ERTS_DIRTY_SCHEDULERS + +ErtsSchedSuspendResult +erts_set_schedulers_online(Process *p, + ErtsProcLocks plocks, + Sint new_no, + Sint *old_no +#ifdef ERTS_DIRTY_SCHEDULERS + , int dirty_only +#endif + ) +{ + ErtsSchedulerData *esdp; + int ix, res = -1, no, have_unlocked_plocks, end_wait; + erts_aint32_t changing = 0; +#ifdef ERTS_DIRTY_SCHEDULERS + ErtsSchedulerSleepInfo* ssi; + int dirty_no, change_dirty; +#endif + + if (new_no < 1) + return ERTS_SCHDLR_SSPND_EINVAL; +#ifdef ERTS_DIRTY_SCHEDULERS + else if (dirty_only && erts_no_dirty_cpu_schedulers < new_no) + return ERTS_SCHDLR_SSPND_EINVAL; +#endif + else if (erts_no_schedulers < new_no) + return ERTS_SCHDLR_SSPND_EINVAL; + + esdp = ERTS_PROC_GET_SCHDATA(p); + end_wait = 0; + + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + + have_unlocked_plocks = 0; + no = (int) new_no; + +#ifdef ERTS_DIRTY_SCHEDULERS + ASSERT(schdlr_sspnd.dirty_cpu_online <= erts_no_dirty_cpu_schedulers); + if (dirty_only) { + if (no > schdlr_sspnd.online) { + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + return ERTS_SCHDLR_SSPND_EINVAL; + } + dirty_no = no; + } else { + /* + * Adjust the number of dirty CPU schedulers online relative to the + * adjustment made to the number of normal schedulers online. + */ + int total_pct = erts_no_dirty_cpu_schedulers*100/erts_no_schedulers; + int onln_pct = no*total_pct/schdlr_sspnd.online; + dirty_no = schdlr_sspnd.dirty_cpu_online*onln_pct/100; + if (dirty_no == 0) + dirty_no = 1; + ASSERT(dirty_no <= erts_no_dirty_cpu_schedulers); + } +#endif + changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); +#ifdef ERTS_DIRTY_SCHEDULERS + changing |= erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_changing); +#endif + if (changing) { + res = ERTS_SCHDLR_SSPND_YIELD_RESTART; + } + else { + int online = *old_no = schdlr_sspnd.online; +#ifdef ERTS_DIRTY_SCHEDULERS + int dirty_online = schdlr_sspnd.dirty_cpu_online; + + if (dirty_only) { + *old_no = schdlr_sspnd.dirty_cpu_online; + if (dirty_no == schdlr_sspnd.dirty_cpu_online) { + res = ERTS_SCHDLR_SSPND_DONE; + } + change_dirty = 1; + } else { +#endif + if (no == schdlr_sspnd.online) { +#ifdef ERTS_DIRTY_SCHEDULERS + dirty_only = 1; + if (dirty_no == schdlr_sspnd.dirty_cpu_online) +#endif + res = ERTS_SCHDLR_SSPND_DONE; +#ifdef ERTS_DIRTY_SCHEDULERS + else + change_dirty = 1; +#endif + } +#ifdef ERTS_DIRTY_SCHEDULERS + else + change_dirty = (dirty_no != schdlr_sspnd.dirty_cpu_online); + } +#endif + if (res == -1) + { + int increase = (no > online); +#ifdef ERTS_DIRTY_SCHEDULERS + if (!dirty_only) { +#endif + ERTS_SCHDLR_SSPND_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_ONLN + | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0); + schdlr_sspnd.online = no; +#ifdef ERTS_DIRTY_SCHEDULERS + } else + increase = (dirty_no > dirty_online); + if (change_dirty) { + ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_ONLN + | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0); + schdlr_sspnd.dirty_cpu_online = dirty_no; + } +#endif + if (increase) { + int ix; +#ifdef ERTS_DIRTY_SCHEDULERS + if (!dirty_only) { +#endif + schdlr_sspnd.wait_curr_online = no; + if (ongoing_multi_scheduling_block()) { + for (ix = online; ix < no; ix++) + erts_sched_poke(ERTS_SCHED_SLEEP_INFO_IX(ix)); + } + else { + if (plocks) { + have_unlocked_plocks = 1; + erts_smp_proc_unlock(p, plocks); + } + change_no_used_runqs(no); + + for (ix = online; ix < no; ix++) + resume_run_queue(ERTS_RUNQ_IX(ix)); + + for (ix = no; ix < erts_no_run_queues; ix++) + suspend_run_queue(ERTS_RUNQ_IX(ix)); + } +#ifdef ERTS_DIRTY_SCHEDULERS + } + if (change_dirty) { + schdlr_sspnd.dirty_cpu_wait_curr_online = dirty_no; + ASSERT(schdlr_sspnd.dirty_cpu_curr_online != + schdlr_sspnd.dirty_cpu_wait_curr_online); + if (ongoing_multi_scheduling_block()) { + for (ix = dirty_online; ix < dirty_no; ix++) { + ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); + erts_sched_poke(ssi); + } + } else { + for (ix = dirty_online; ix < dirty_no; ix++) { + ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); + scheduler_ssi_resume_wake(ssi); + erts_smp_atomic32_read_band_nob(&ssi->flags, + ~ERTS_SSI_FLG_SUSPENDED); + } + wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0); + } + } +#endif + res = ERTS_SCHDLR_SSPND_DONE; + } + else /* if (no < online) */ { +#ifdef ERTS_DIRTY_SCHEDULERS + if (change_dirty) { + schdlr_sspnd.dirty_cpu_wait_curr_online = dirty_no; + ASSERT(schdlr_sspnd.dirty_cpu_curr_online != + schdlr_sspnd.dirty_cpu_wait_curr_online); + if (ongoing_multi_scheduling_block()) { + for (ix = dirty_no; ix < dirty_online; ix++) { + ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); + erts_sched_poke(ssi); + } + } else { + for (ix = dirty_no; ix < dirty_online; ix++) { + ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); + erts_smp_atomic32_read_bor_nob(&ssi->flags, + ERTS_SSI_FLG_SUSPENDED); + } + wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0); + } + } + if (dirty_only) { + res = ERTS_SCHDLR_SSPND_DONE; + } + else +#endif + { + if (p->scheduler_data->no <= no) { + res = ERTS_SCHDLR_SSPND_DONE; + schdlr_sspnd.wait_curr_online = no; + } + else { + /* + * Yield! Current process needs to migrate + * before bif returns. + */ + res = ERTS_SCHDLR_SSPND_YIELD_DONE; + schdlr_sspnd.wait_curr_online = no+1; + } + + if (ongoing_multi_scheduling_block()) { + for (ix = no; ix < online; ix++) + erts_sched_poke(ERTS_SCHED_SLEEP_INFO_IX(ix)); + } + else { + if (plocks) { + have_unlocked_plocks = 1; + erts_smp_proc_unlock(p, plocks); + } + + change_no_used_runqs(no); + for (ix = no; ix < erts_no_run_queues; ix++) + suspend_run_queue(ERTS_RUNQ_IX(ix)); + + for (ix = no; ix < online; ix++) { + ErtsRunQueue *rq = ERTS_RUNQ_IX(ix); + wake_scheduler(rq); + } + } + } + } + +#ifdef ERTS_DIRTY_SCHEDULERS + if (change_dirty) { + while (schdlr_sspnd.dirty_cpu_curr_online != schdlr_sspnd.dirty_cpu_wait_curr_online) + erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); + ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER); + erts_smp_atomic32_read_band_nob(&schdlr_sspnd.dirty_cpu_changing, + ~ERTS_SCHDLR_SSPND_CHNG_WAITER); + } + if (!dirty_only) +#endif + { + if (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online) { + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + if (plocks && !have_unlocked_plocks) { + have_unlocked_plocks = 1; + erts_smp_proc_unlock(p, plocks); + } + erts_thr_progress_active(esdp, 0); + erts_thr_progress_prepare_wait(esdp); + end_wait = 1; + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + } + + while (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online) + erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); + + ASSERT(res != ERTS_SCHDLR_SSPND_DONE + ? (ERTS_SCHDLR_SSPND_CHNG_WAITER + & erts_smp_atomic32_read_nob(&schdlr_sspnd.changing)) + : (ERTS_SCHDLR_SSPND_CHNG_WAITER + == erts_smp_atomic32_read_nob(&schdlr_sspnd.changing))); + erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, + ~ERTS_SCHDLR_SSPND_CHNG_WAITER); + } + } + } + + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); +#ifdef ERTS_DIRTY_SCHEDULERS + ASSERT(schdlr_sspnd.dirty_cpu_online <= schdlr_sspnd.online); + if (!dirty_only) +#endif + { + if (end_wait) { + erts_thr_progress_finalize_wait(esdp); + erts_thr_progress_active(esdp, 1); + } + if (have_unlocked_plocks) + erts_smp_proc_lock(p, plocks); + } + + return res; +} + +#else /* !ERTS_DIRTY_SCHEDULERS */ + ErtsSchedSuspendResult erts_set_schedulers_online(Process *p, ErtsProcLocks plocks, @@ -6352,10 +7225,6 @@ erts_set_schedulers_online(Process *p, ErtsRunQueue *rq = ERTS_RUNQ_IX(ix); wake_scheduler(rq); } -#ifdef ERTS_DIRTY_SCHEDULERS - wake_dirty_scheduler(ERTS_DIRTY_CPU_RUNQ); - wake_dirty_scheduler(ERTS_DIRTY_IO_RUNQ); -#endif } } @@ -6396,15 +7265,24 @@ erts_set_schedulers_online(Process *p, return res; } +#endif + ErtsSchedSuspendResult erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int all) { - int ix, res, have_unlocked_plocks = 0; + int ix, res, have_unlocked_plocks = 0, online; erts_aint32_t changing; ErtsProcList *plp; +#ifdef ERTS_DIRTY_SCHEDULERS + ErtsSchedulerSleepInfo* ssi; +#endif erts_smp_mtx_lock(&schdlr_sspnd.mtx); changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); +#ifdef ERTS_DIRTY_SCHEDULERS + changing |= (erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_changing) + | erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_io_changing)); +#endif if (changing) { res = ERTS_SCHDLR_SSPND_YIELD_RESTART; /* Yield */ } @@ -6414,10 +7292,13 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int all) erts_proclist_store_last(&schdlr_sspnd.msb.procs, plp); p->flags |= F_HAVE_BLCKD_MSCHED; ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.active) == 1); +#ifdef ERTS_DIRTY_SCHEDULERS + ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_active) == 0); + ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_io_active) == 0); +#endif ASSERT(p->scheduler_data->no == 1); res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED; - } - else { + } else { int online = schdlr_sspnd.online; p->flags |= F_HAVE_BLCKD_MSCHED; if (plocks) { @@ -6429,6 +7310,35 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int all) if (online == 1) { res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED; ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.active) == 1); +#ifdef ERTS_DIRTY_SCHEDULERS + ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_active) == 1); + ASSERT(!(erts_smp_atomic32_read_nob(&ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(0)->flags) + & ERTS_SSI_FLG_SUSPENDED)); + schdlr_sspnd.msb.dirty_cpu_wait_active = 0; + ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_MSB + | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0); + ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(0); + erts_smp_atomic32_read_bor_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED); + wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0); + while (erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_active) + != schdlr_sspnd.msb.dirty_cpu_wait_active) + erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); + ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER); + + schdlr_sspnd.msb.dirty_io_wait_active = 0; + ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_MSB + | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0); + for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) { + ssi = ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix); + erts_smp_atomic32_read_bor_nob(&ssi->flags, + ERTS_SSI_FLG_SUSPENDED); + } + wake_dirty_schedulers(ERTS_DIRTY_IO_RUNQ, 0); + while (erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_io_active) + != schdlr_sspnd.msb.dirty_io_wait_active) + erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); + ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER); +#endif ASSERT(p->scheduler_data->no == 1); } else { @@ -6447,6 +7357,37 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int all) schdlr_sspnd.msb.wait_active = 2; } +#ifdef ERTS_DIRTY_SCHEDULERS + schdlr_sspnd.msb.dirty_cpu_wait_active = 0; + ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_MSB + | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0); + for (ix = 0; ix < erts_no_dirty_cpu_schedulers; ix++) { + ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); + erts_smp_atomic32_read_bor_nob(&ssi->flags, + ERTS_SSI_FLG_SUSPENDED); + } + wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0); + while (erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_active) + != schdlr_sspnd.msb.dirty_cpu_wait_active) + erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); + ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER); + ASSERT(schdlr_sspnd.dirty_cpu_curr_online == schdlr_sspnd.dirty_cpu_online); + + schdlr_sspnd.msb.dirty_io_wait_active = 0; + ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_MSB + | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0); + for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) { + ssi = ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix); + erts_smp_atomic32_read_bor_nob(&ssi->flags, + ERTS_SSI_FLG_SUSPENDED); + } + wake_dirty_schedulers(ERTS_DIRTY_IO_RUNQ, 0); + while (erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_io_active) + != schdlr_sspnd.msb.dirty_io_wait_active) + erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); + ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER); + ASSERT(schdlr_sspnd.dirty_io_curr_online == schdlr_sspnd.dirty_io_online); +#endif change_no_used_runqs(1); for (ix = 1; ix < erts_no_run_queues; ix++) suspend_run_queue(ERTS_RUNQ_IX(ix)); @@ -6487,6 +7428,7 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int all) erts_smp_mtx_lock(&schdlr_sspnd.mtx); } + ASSERT(res != ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED ? (ERTS_SCHDLR_SSPND_CHNG_WAITER & erts_smp_atomic32_read_nob(&schdlr_sspnd.changing)) @@ -6527,12 +7469,12 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int all) p->flags &= ~F_HAVE_BLCKD_MSCHED; schdlr_sspnd.msb.ongoing = 0; if (schdlr_sspnd.online == 1) { - /* No schedulers to resume */ + /* No normal schedulers to resume */ ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.active) == 1); ERTS_SCHDLR_SSPND_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_MSB); } else { - int online = schdlr_sspnd.online; + online = schdlr_sspnd.online; if (plocks) { have_unlocked_plocks = 1; erts_smp_proc_unlock(p, plocks); @@ -6547,6 +7489,27 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int all) for (ix = online; ix < erts_no_run_queues; ix++) suspend_run_queue(ERTS_RUNQ_IX(ix)); } +#ifdef ERTS_DIRTY_SCHEDULERS + ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET(ERTS_SCHDLR_SSPND_CHNG_MSB, 0); + schdlr_sspnd.msb.dirty_cpu_wait_active = schdlr_sspnd.dirty_cpu_online; + for (ix = 0; ix < schdlr_sspnd.dirty_cpu_online; ix++) { + ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); + scheduler_ssi_resume_wake(ssi); + erts_smp_atomic32_read_band_nob(&ssi->flags, + ~ERTS_SSI_FLG_SUSPENDED); + } + wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0); + + ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET(ERTS_SCHDLR_SSPND_CHNG_MSB, 0); + schdlr_sspnd.msb.dirty_io_wait_active = erts_no_dirty_io_schedulers; + for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) { + ssi = ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix); + scheduler_ssi_resume_wake(ssi); + erts_smp_atomic32_read_band_nob(&ssi->flags, + ~ERTS_SSI_FLG_SUSPENDED); + } + wake_dirty_schedulers(ERTS_DIRTY_IO_RUNQ, 0); +#endif res = ERTS_SCHDLR_SSPND_DONE; } } @@ -6673,7 +7636,11 @@ sched_thread_func(void *vesdp) erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, ~ERTS_SCHDLR_SSPND_CHNG_ONLN); if (no != 1) +#ifdef ERTS_DIRTY_SCHEDULERS + erts_smp_cnd_broadcast(&schdlr_sspnd.cnd); +#else erts_smp_cnd_signal(&schdlr_sspnd.cnd); +#endif } if (no == 1) { @@ -6710,7 +7677,9 @@ sched_dirty_cpu_thread_func(void *vesdp) { ErtsThrPrgrCallbacks callbacks; ErtsSchedulerData *esdp = vesdp; - Uint no = esdp->dirty_no; + Uint no = ERTS_DIRTY_SCHEDULER_NO(esdp); + ERTS_DIRTY_SCHEDULER_TYPE(esdp) = ERTS_DIRTY_CPU_SCHEDULER; + ASSERT(no != 0); ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(no-1)->event = erts_tse_fetch(); callbacks.arg = (void *) esdp->ssi; callbacks.wakeup = thr_prgr_wakeup; @@ -6738,6 +7707,24 @@ sched_dirty_cpu_thread_func(void *vesdp) #endif erts_thread_init_float(); + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_changing) + & ERTS_SCHDLR_SSPND_CHNG_ONLN); + + if (--schdlr_sspnd.dirty_cpu_curr_online == schdlr_sspnd.dirty_cpu_wait_curr_online) { + erts_smp_atomic32_read_band_nob(&schdlr_sspnd.dirty_cpu_changing, + ~ERTS_SCHDLR_SSPND_CHNG_ONLN); + if (no != 1) + erts_smp_cnd_broadcast(&schdlr_sspnd.cnd); + } + + if (no == 1) { + while (schdlr_sspnd.dirty_cpu_curr_online != schdlr_sspnd.dirty_cpu_wait_curr_online) + erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); + ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER); + } + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + process_main(); /* No schedulers should *ever* terminate */ erl_exit(ERTS_ABORT_EXIT, @@ -6751,7 +7738,9 @@ sched_dirty_io_thread_func(void *vesdp) { ErtsThrPrgrCallbacks callbacks; ErtsSchedulerData *esdp = vesdp; - Uint no = esdp->dirty_no; + Uint no = ERTS_DIRTY_SCHEDULER_NO(esdp); + ERTS_DIRTY_SCHEDULER_TYPE(esdp) = ERTS_DIRTY_IO_SCHEDULER; + ASSERT(no != 0); ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(no-1)->event = erts_tse_fetch(); callbacks.arg = (void *) esdp->ssi; callbacks.wakeup = thr_prgr_wakeup; @@ -6779,6 +7768,24 @@ sched_dirty_io_thread_func(void *vesdp) #endif erts_thread_init_float(); + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_io_changing) + & ERTS_SCHDLR_SSPND_CHNG_ONLN); + + if (--schdlr_sspnd.dirty_io_curr_online == schdlr_sspnd.dirty_io_wait_curr_online) { + erts_smp_atomic32_read_band_nob(&schdlr_sspnd.dirty_io_changing, + ~ERTS_SCHDLR_SSPND_CHNG_ONLN); + if (no != 1) + erts_smp_cnd_broadcast(&schdlr_sspnd.cnd); + } + + if (no == 1) { + while (schdlr_sspnd.dirty_io_curr_online != schdlr_sspnd.dirty_io_wait_curr_online) + erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); + ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER); + } + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + process_main(); /* No schedulers should *ever* terminate */ erl_exit(ERTS_ABORT_EXIT, @@ -6795,16 +7802,23 @@ void erts_start_schedulers(void) { int res = 0; - Uint actual = 0; + Uint actual; Uint wanted = erts_no_schedulers; Uint wanted_no_schedulers = erts_no_schedulers; ethr_thr_opts opts = ETHR_THR_OPTS_DEFAULT_INITER; opts.detached = 1; +#ifdef ETHR_HAVE_THREAD_NAMES + opts.name = malloc(80); +#endif + #ifdef ERTS_SMP if (erts_runq_supervision_interval) { opts.suggested_stack_size = 16; +#ifdef ETHR_HAVE_THREAD_NAMES + sprintf(opts.name, "runq_supervisor"); +#endif erts_atomic_init_nob(&runq_supervisor_sleeping, 0); if (0 != ethr_event_init(&runq_supervision_event)) erl_exit(1, "Failed to create run-queue supervision event\n"); @@ -6826,17 +7840,27 @@ erts_start_schedulers(void) res = ENOTSUP; } - while (actual < wanted) { + for (actual = 0; actual < wanted; actual++) { ErtsSchedulerData *esdp = ERTS_SCHEDULER_IX(actual); - actual++; - ASSERT(actual == esdp->no); - res = ethr_thr_create(&esdp->tid,sched_thread_func,(void*)esdp,&opts); + + ASSERT(actual == esdp->no - 1); + +#ifdef ETHR_HAVE_THREAD_NAMES + sprintf(opts.name, "scheduler_%d", actual + 1); +#endif + +#ifdef __OSE__ + /* This should be done in the bind strategy */ + opts.coreNo = (actual+1) % ose_num_cpus(); +#endif + + res = ethr_thr_create(&esdp->tid, sched_thread_func, (void*)esdp, &opts); + if (res != 0) { - actual--; - break; + break; } } - + erts_no_schedulers = actual; #ifdef ERTS_DIRTY_SCHEDULERS @@ -6845,12 +7869,18 @@ erts_start_schedulers(void) int ix; for (ix = 0; ix < erts_no_dirty_cpu_schedulers; ix++) { ErtsSchedulerData *esdp = ERTS_DIRTY_CPU_SCHEDULER_IX(ix); +#ifdef ETHR_HAVE_THREAD_NAMES + sprintf(opts.name,"dirty_cpu_scheduler_%d", ix + 1); +#endif res = ethr_thr_create(&esdp->tid,sched_dirty_cpu_thread_func,(void*)esdp,&opts); if (res != 0) erl_exit(1, "Failed to create dirty cpu scheduler thread %d\n", ix); } for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) { ErtsSchedulerData *esdp = ERTS_DIRTY_IO_SCHEDULER_IX(ix); +#ifdef ETHR_HAVE_THREAD_NAMES + sprintf(opts.name,"dirty_io_scheduler_%d", ix + 1); +#endif res = ethr_thr_create(&esdp->tid,sched_dirty_io_thread_func,(void*)esdp,&opts); if (res != 0) erl_exit(1, "Failed to create dirty io scheduler thread %d\n", ix); @@ -6861,6 +7891,14 @@ erts_start_schedulers(void) ERTS_THR_MEMORY_BARRIER; +#ifdef ETHR_HAVE_THREAD_NAMES + sprintf(opts.name, "aux"); +#endif + +#ifdef __OSE__ + opts.coreNo = 0; +#endif /* __OSE__ */ + res = ethr_thr_create(&aux_tid, aux_thread, NULL, &opts); if (res != 0) erl_exit(1, "Failed to create aux thread\n"); @@ -6880,6 +7918,10 @@ erts_start_schedulers(void) actual, actual == 1 ? " was" : "s were"); erts_send_error_to_logger_nogl(dsbufp); } + +#ifdef ETHR_HAVE_THREAD_NAMES + free(opts.name); +#endif } #endif /* ERTS_SMP */ @@ -7995,7 +9037,6 @@ Process *schedule(Process *p, int calls) || flags & ERTS_RUNQ_FLG_NONEMPTY); if (flags & (ERTS_RUNQ_FLG_CHK_CPU_BIND|ERTS_RUNQ_FLG_SUSPENDED)) { - if (flags & ERTS_RUNQ_FLG_SUSPENDED) { suspend_scheduler(esdp); flags = ERTS_RUNQ_FLGS_GET_NOB(rq); @@ -8006,21 +9047,31 @@ Process *schedule(Process *p, int calls) erts_sched_check_cpu_bind(esdp); } } +#ifdef ERTS_DIRTY_SCHEDULERS + else if (ERTS_SCHEDULER_IS_DIRTY(esdp) + && (erts_smp_atomic32_read_acqb(&esdp->ssi->flags) + & ERTS_SSI_FLG_SUSPENDED)) + suspend_scheduler(esdp); +#endif - if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + { erts_aint32_t aux_work; - int leader_update = erts_thr_progress_update(esdp); + int leader_update = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0 + : erts_thr_progress_update(esdp); aux_work = erts_atomic32_read_acqb(&esdp->ssi->aux_work); - if (aux_work | leader_update) { + if (aux_work | leader_update | ERTS_SCHED_FAIR) { erts_smp_runq_unlock(rq); if (leader_update) erts_thr_progress_leader_update(esdp); + else if (ERTS_SCHED_FAIR) + ERTS_SCHED_FAIR_YIELD(); if (aux_work) handle_aux_work(&esdp->aux_work_data, aux_work, 0); erts_smp_runq_lock(rq); } - ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); + ERTS_SMP_LC_ASSERT(ERTS_SCHEDULER_IS_DIRTY(esdp) + || !erts_thr_progress_is_blocking()); } ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); @@ -8035,6 +9086,17 @@ Process *schedule(Process *p, int calls) flags = ERTS_RUNQ_FLGS_GET_NOB(rq); +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix) && rq->halt_in_progress) { + /* + * TODO: if halt in progress, need to put the dirty scheduler + * to sleep somewhere around here to prevent it from picking up + * new work + */ + } + else +#endif + if ((!(flags & ERTS_RUNQ_FLGS_QMASK) && !rq->misc.start) || (rq->halt_in_progress && ERTS_EMPTY_RUNQ_PORTS(rq))) { /* Prepare for scheduler wait */ @@ -8077,7 +9139,8 @@ Process *schedule(Process *p, int calls) goto check_activities_to_run; } else if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && - (fcalls > input_reductions && prepare_for_sys_schedule())) { + (fcalls > input_reductions && + prepare_for_sys_schedule(esdp))) { /* * Schedule system-level activities. */ @@ -8182,11 +9245,15 @@ Process *schedule(Process *p, int calls) + ERTS_PSFLGS_IN_PRQ_MASK_OFFSET)); #ifdef ERTS_DIRTY_SCHEDULERS - /* if a non-dirty scheduler picks up a process marked as already being - in a dirty run queue, just drop it and go get another process */ - if (state & (ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q) && - !ERTS_SCHEDULER_IS_DIRTY(esdp)) - goto pick_next_process; + ASSERT((state & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)) != + (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)); + if (state & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)) { + ASSERT((ERTS_SCHEDULER_IS_DIRTY_CPU(esdp) && (state & ERTS_PSFLG_DIRTY_CPU_PROC)) || + (ERTS_SCHEDULER_IS_DIRTY_IO(esdp) && (state & ERTS_PSFLG_DIRTY_IO_PROC))); + if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && !(state & ERTS_PSFLG_ACTIVE_SYS)) + goto pick_next_process; + state &= ~(ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q); + } #endif if (!(state & ERTS_PSFLG_PROXY)) @@ -8322,7 +9389,11 @@ Process *schedule(Process *p, int calls) if (state & ERTS_PSFLG_RUNNING_SYS) { reds -= execute_sys_tasks(p, &state, reds); - if (reds <= 0) { + if (reds <= 0 +#ifdef ERTS_DIRTY_SCHEDULERS + || (state & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)) +#endif + ) { p->fcalls = reds; goto sched_out_proc; } @@ -9379,7 +10450,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). * Check for errors. */ - if (is_not_atom(mod) || is_not_atom(func) || ((arity = list_length(args)) < 0)) { + if (is_not_atom(mod) || is_not_atom(func) || ((arity = erts_list_length(args)) < 0)) { so->error_code = BADARG; goto error; } @@ -10087,7 +11158,7 @@ save_pending_exiter(Process *p) erts_smp_runq_unlock(rq); #ifdef ERTS_DIRTY_SCHEDULERS if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) - wake_dirty_scheduler(rq); + wake_dirty_schedulers(rq, 0); else #endif wake_scheduler(rq); @@ -10242,7 +11313,7 @@ send_exit_signal(Process *c_p, /* current process if and only dtrace_pid_str(from, sender_str); dtrace_proc_str(rp, receiver_str); - erts_snprintf(reason_buf, sizeof(reason_buf) - 1, "%T", reason); + erts_snprintf(reason_buf, sizeof(DTRACE_CHARBUF_NAME(reason_buf)) - 1, "%T", reason); DTRACE3(process_exit_signal, sender_str, receiver_str, reason_buf); } #endif @@ -11148,6 +12219,10 @@ void erl_halt(int code) if (-1 == erts_smp_atomic32_cmpxchg_acqb(&erts_halt_progress, erts_no_schedulers, -1)) { +#ifdef ERTS_DIRTY_SCHEDULERS + ERTS_DIRTY_CPU_RUNQ->halt_in_progress = 1; + ERTS_DIRTY_IO_RUNQ->halt_in_progress = 1; +#endif erts_halt_code = code; notify_reap_ports_relb(); } diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index dcb9251d0d..ed6dadbffa 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -109,7 +109,6 @@ extern int erts_sched_balance_util; extern Uint erts_no_schedulers; #ifdef ERTS_DIRTY_SCHEDULERS extern Uint erts_no_dirty_cpu_schedulers; -extern Uint erts_no_dirty_cpu_schedulers_online; extern Uint erts_no_dirty_io_schedulers; #endif extern Uint erts_no_run_queues; @@ -544,6 +543,21 @@ typedef struct { #endif } ErtsAuxWorkData; +#ifdef ERTS_DIRTY_SCHEDULERS +typedef enum { + ERTS_DIRTY_CPU_SCHEDULER, + ERTS_DIRTY_IO_SCHEDULER +} ErtsDirtySchedulerType; + +typedef union { + struct { + ErtsDirtySchedulerType type: 1; + unsigned num: 31; + } s; + Uint no; +} ErtsDirtySchedId; +#endif + struct ErtsSchedulerData_ { /* * Keep X registers first (so we get as many low @@ -570,7 +584,7 @@ struct ErtsSchedulerData_ { Process *current_process; Uint no; /* Scheduler number for normal schedulers */ #ifdef ERTS_DIRTY_SCHEDULERS - Uint dirty_no; /* Scheduler number for dirty schedulers */ + ErtsDirtySchedId dirty_no; /* Scheduler number for dirty schedulers */ #endif Port *current_port; ErtsRunQueue *run_queue; @@ -607,6 +621,13 @@ extern ErtsAlignedSchedulerData *erts_aligned_dirty_io_scheduler_data; extern ErtsSchedulerData *erts_scheduler_data; #endif +#ifdef ERTS_SCHED_FAIR +#define ERTS_SCHED_FAIR_YIELD() ETHR_YIELD() +#else +#define ERTS_SCHED_FAIR 0 +#define ERTS_SCHED_FAIR_YIELD() +#endif + #if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) int erts_smp_lc_runq_is_locked(ErtsRunQueue *); #endif @@ -1292,6 +1313,8 @@ extern struct erts_system_profile_flags_t erts_system_profile_flags; &erts_aligned_run_queues[(IX)].runq) #define ERTS_DIRTY_CPU_RUNQ (&erts_aligned_run_queues[-1].runq) #define ERTS_DIRTY_IO_RUNQ (&erts_aligned_run_queues[-2].runq) +#define ERTS_RUNQ_IS_DIRTY_CPU_RUNQ(RQ) ((RQ)->ix == -1) +#define ERTS_RUNQ_IS_DIRTY_IO_RUNQ(RQ) ((RQ)->ix == -2) #else #define ERTS_RUNQ_IX_IS_DIRTY(IX) 0 #endif @@ -1305,21 +1328,37 @@ extern struct erts_system_profile_flags_t erts_system_profile_flags; #define ERTS_DIRTY_IO_SCHEDULER_IX(IX) \ (ASSERT(0 <= (IX) && (IX) < erts_no_dirty_io_schedulers), \ &erts_aligned_dirty_io_scheduler_data[(IX)].esd) +#define ERTS_DIRTY_SCHEDULER_NO(ESDP) \ + ((ESDP)->dirty_no.s.num) +#define ERTS_DIRTY_SCHEDULER_TYPE(ESDP) \ + ((ESDP)->dirty_no.s.type) #ifdef ERTS_SMP #define ERTS_SCHEDULER_IS_DIRTY(ESDP) \ - ((ESDP)->dirty_no != 0) + ((ESDP)->dirty_no.s.num != 0) +#define ERTS_SCHEDULER_IS_DIRTY_CPU(ESDP) \ + ((ESDP)->dirty_no.s.type == 0) +#define ERTS_SCHEDULER_IS_DIRTY_IO(ESDP) \ + ((ESDP)->dirty_no.s.type == 1) #else #define ERTS_SCHEDULER_IS_DIRTY(ESDP) 0 +#define ERTS_SCHEDULER_IS_DIRTY_CPU(ESDP) 0 +#define ERTS_SCHEDULER_IS_DIRTY_IO(ESDP) 0 #endif #else #define ERTS_RUNQ_IX_IS_DIRTY(IX) 0 #define ERTS_SCHEDULER_IS_DIRTY(ESDP) 0 +#define ERTS_SCHEDULER_IS_DIRTY_CPU(ESDP) 0 +#define ERTS_SCHEDULER_IS_DIRTY_IO(ESDP) 0 #endif void erts_pre_init_process(void); void erts_late_init_process(void); void erts_early_init_scheduling(int); -void erts_init_scheduling(int, int); +void erts_init_scheduling(int, int +#ifdef ERTS_DIRTY_SCHEDULERS + , int, int, int +#endif + ); int erts_set_gc_state(Process *c_p, int enable); Eterm erts_sched_wall_time_request(Process *c_p, int set, int enable); @@ -1526,7 +1565,11 @@ ErtsSchedSuspendResult erts_set_schedulers_online(Process *p, ErtsProcLocks plocks, Sint new_no, - Sint *old_no); + Sint *old_no +#ifdef ERTS_DIRTY_SCHEDULERS + , int dirty_only +#endif + ); ErtsSchedSuspendResult erts_block_multi_scheduling(Process *, ErtsProcLocks, int, int); int erts_is_multi_scheduling_blocked(void); @@ -2009,12 +2052,6 @@ erts_get_runq_current(ErtsSchedulerData *esdp) #endif } -#ifdef ERTS_ENABLE_LOCK_COUNT - -#define erts_smp_runq_lock(rq) erts_smp_mtx_lock_x(&(rq)->mtx, __FILE__, __LINE__) - -#else - ERTS_GLB_INLINE void erts_smp_runq_lock(ErtsRunQueue *rq) { @@ -2023,6 +2060,10 @@ erts_smp_runq_lock(ErtsRunQueue *rq) #endif } +#ifdef ERTS_ENABLE_LOCK_COUNT + +#define erts_smp_runq_lock(rq) erts_smp_mtx_lock_x(&(rq)->mtx, __FILE__, __LINE__) + #endif ERTS_GLB_INLINE int diff --git a/erts/emulator/beam/erl_process_dict.c b/erts/emulator/beam/erl_process_dict.c index a611b52af2..23e5bf737f 100644 --- a/erts/emulator/beam/erl_process_dict.c +++ b/erts/emulator/beam/erl_process_dict.c @@ -659,7 +659,7 @@ static void shrink(Process *p, Eterm* ret) } else { int needed = 4; if (is_list(hi) && is_list(lo)) { - needed = 2*list_length(hi); + needed = 2*erts_list_length(hi); } if (HeapWordsLeft(p) < needed) { BUMP_REDS(p, erts_garbage_collect(p, needed, ret, 1)); diff --git a/erts/emulator/beam/erl_process_lock.c b/erts/emulator/beam/erl_process_lock.c index 2db5df06b4..82cc68222d 100644 --- a/erts/emulator/beam/erl_process_lock.c +++ b/erts/emulator/beam/erl_process_lock.c @@ -117,7 +117,7 @@ erts_init_proc_lock(int cpus) for (i = 0; i < ERTS_NO_OF_PIX_LOCKS; i++) { #ifdef ERTS_ENABLE_LOCK_COUNT erts_mtx_init_x(&erts_pix_locks[i].u.mtx, - "pix_lock", make_small(i)); + "pix_lock", make_small(i), 1); #else erts_mtx_init(&erts_pix_locks[i].u.mtx, "pix_lock"); #endif @@ -901,7 +901,7 @@ erts_pid2proc_opt(Process *c_p, busy = (int) erts_smp_proc_raw_trylock__(proc, need_locks); #if ERTS_PROC_LOCK_OWN_IMPL && defined(ERTS_ENABLE_LOCK_CHECK) - erts_proc_lc_trylock(proc, need_locks, !busy); + erts_proc_lc_trylock(proc, need_locks, !busy, __FILE__,__LINE__); #endif #ifdef ERTS_PROC_LOCK_DEBUG if (!busy) @@ -1001,8 +1001,8 @@ erts_pid2proc_opt(Process *c_p, void erts_proc_lock_init(Process *p) { -#if ERTS_PROC_LOCK_OWN_IMPL int i; +#if ERTS_PROC_LOCK_OWN_IMPL /* We always start with all locks locked */ #if ERTS_PROC_LOCK_ATOMIC_IMPL erts_smp_atomic32_init_nob(&p->lock.flags, @@ -1013,25 +1013,33 @@ erts_proc_lock_init(Process *p) for (i = 0; i <= ERTS_PROC_LOCK_MAX_BIT; i++) p->lock.queue[i] = NULL; #ifdef ERTS_ENABLE_LOCK_CHECK - erts_proc_lc_trylock(p, ERTS_PROC_LOCKS_ALL, 1); + erts_proc_lc_trylock(p, ERTS_PROC_LOCKS_ALL, 1,__FILE__,__LINE__); #endif #elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL - erts_mtx_init_x(&p->lock.main, "proc_main", p->common.id); + +#ifdef ERTS_ENABLE_LOCK_COUNT + int do_lock_count = 1; +#else + int do_lock_count = 0; +#endif + + erts_mtx_init_x(&p->lock.main, "proc_main", p->common.id, do_lock_count); ethr_mutex_lock(&p->lock.main.mtx); #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_trylock(1, &p->lock.main.lc); #endif - erts_mtx_init_x(&p->lock.link, "proc_link", p->common.id); + erts_mtx_init_x(&p->lock.link, "proc_link", p->common.id, do_lock_count); ethr_mutex_lock(&p->lock.link.mtx); #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_trylock(1, &p->lock.link.lc); #endif - erts_mtx_init_x(&p->lock.msgq, "proc_msgq", p->common.id); + erts_mtx_init_x(&p->lock.msgq, "proc_msgq", p->common.id, do_lock_count); ethr_mutex_lock(&p->lock.msgq.mtx); #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_trylock(1, &p->lock.msgq.lc); #endif - erts_mtx_init_x(&p->lock.status, "proc_status", p->common.id); + erts_mtx_init_x(&p->lock.status, "proc_status", p->common.id, + do_lock_count); ethr_mutex_lock(&p->lock.status.mtx); #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_trylock(1, &p->lock.status.lc); @@ -1210,50 +1218,51 @@ void erts_lcnt_enable_proc_lock_count(int enable) #if ERTS_PROC_LOCK_OWN_IMPL void -erts_proc_lc_lock(Process *p, ErtsProcLocks locks) +erts_proc_lc_lock(Process *p, ErtsProcLocks locks, char *file, unsigned int line) { erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1, p->common.id, ERTS_LC_FLG_LT_PROCLOCK); if (locks & ERTS_PROC_LOCK_MAIN) { lck.id = lc_id.proc_lock_main; - erts_lc_lock(&lck); + erts_lc_lock_x(&lck,file,line); } if (locks & ERTS_PROC_LOCK_LINK) { lck.id = lc_id.proc_lock_link; - erts_lc_lock(&lck); + erts_lc_lock_x(&lck,file,line); } if (locks & ERTS_PROC_LOCK_MSGQ) { lck.id = lc_id.proc_lock_msgq; - erts_lc_lock(&lck); + erts_lc_lock_x(&lck,file,line); } if (locks & ERTS_PROC_LOCK_STATUS) { lck.id = lc_id.proc_lock_status; - erts_lc_lock(&lck); + erts_lc_lock_x(&lck,file,line); } } void -erts_proc_lc_trylock(Process *p, ErtsProcLocks locks, int locked) +erts_proc_lc_trylock(Process *p, ErtsProcLocks locks, int locked, + char* file, unsigned int line) { erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1, p->common.id, ERTS_LC_FLG_LT_PROCLOCK); if (locks & ERTS_PROC_LOCK_MAIN) { lck.id = lc_id.proc_lock_main; - erts_lc_trylock(locked, &lck); + erts_lc_trylock_x(locked, &lck, file, line); } if (locks & ERTS_PROC_LOCK_LINK) { lck.id = lc_id.proc_lock_link; - erts_lc_trylock(locked, &lck); + erts_lc_trylock_x(locked, &lck, file, line); } if (locks & ERTS_PROC_LOCK_MSGQ) { lck.id = lc_id.proc_lock_msgq; - erts_lc_trylock(locked, &lck); + erts_lc_trylock_x(locked, &lck, file, line); } if (locks & ERTS_PROC_LOCK_STATUS) { lck.id = lc_id.proc_lock_status; - erts_lc_trylock(locked, &lck); + erts_lc_trylock_x(locked, &lck, file, line); } } @@ -1319,7 +1328,8 @@ erts_proc_lc_might_unlock(Process *p, ErtsProcLocks locks) } void -erts_proc_lc_require_lock(Process *p, ErtsProcLocks locks) +erts_proc_lc_require_lock(Process *p, ErtsProcLocks locks, char *file, + unsigned int line) { #if ERTS_PROC_LOCK_OWN_IMPL erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1, @@ -1327,29 +1337,29 @@ erts_proc_lc_require_lock(Process *p, ErtsProcLocks locks) ERTS_LC_FLG_LT_PROCLOCK); if (locks & ERTS_PROC_LOCK_MAIN) { lck.id = lc_id.proc_lock_main; - erts_lc_require_lock(&lck); + erts_lc_require_lock(&lck, file, line); } if (locks & ERTS_PROC_LOCK_LINK) { lck.id = lc_id.proc_lock_link; - erts_lc_require_lock(&lck); + erts_lc_require_lock(&lck, file, line); } if (locks & ERTS_PROC_LOCK_MSGQ) { lck.id = lc_id.proc_lock_msgq; - erts_lc_require_lock(&lck); + erts_lc_require_lock(&lck, file, line); } if (locks & ERTS_PROC_LOCK_STATUS) { lck.id = lc_id.proc_lock_status; - erts_lc_require_lock(&lck); + erts_lc_require_lock(&lck, file, line); } #elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL if (locks & ERTS_PROC_LOCK_MAIN) - erts_lc_require_lock(&p->lock.main.lc); + erts_lc_require_lock(&p->lock.main.lc, file, line); if (locks & ERTS_PROC_LOCK_LINK) - erts_lc_require_lock(&p->lock.link.lc); + erts_lc_require_lock(&p->lock.link.lc, file, line); if (locks & ERTS_PROC_LOCK_MSGQ) - erts_lc_require_lock(&p->lock.msgq.lc); + erts_lc_require_lock(&p->lock.msgq.lc, file, line); if (locks & ERTS_PROC_LOCK_STATUS) - erts_lc_require_lock(&p->lock.status.lc); + erts_lc_require_lock(&p->lock.status.lc, file, line); #endif } diff --git a/erts/emulator/beam/erl_process_lock.h b/erts/emulator/beam/erl_process_lock.h index 9dd503f3cb..052d992d3f 100644 --- a/erts/emulator/beam/erl_process_lock.h +++ b/erts/emulator/beam/erl_process_lock.h @@ -215,7 +215,7 @@ typedef struct erts_proc_lock_t_ { /* Lock counter implemetation */ -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION #define erts_smp_proc_lock__(P,I,L) erts_smp_proc_lock_x__(P,I,L,__FILE__,__LINE__) #define erts_smp_proc_lock(P,L) erts_smp_proc_lock_x(P,L,__FILE__,__LINE__) #endif @@ -243,8 +243,10 @@ void erts_lcnt_enable_proc_lock_count(int enable); erts_proc_lc_chk_no_proc_locks(__FILE__, __LINE__) #define ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(P) \ erts_proc_lc_chk_only_proc_main((P)) -void erts_proc_lc_lock(Process *p, ErtsProcLocks locks); -void erts_proc_lc_trylock(Process *p, ErtsProcLocks locks, int locked); +void erts_proc_lc_lock(Process *p, ErtsProcLocks locks, + char *file, unsigned int line); +void erts_proc_lc_trylock(Process *p, ErtsProcLocks locks, int locked, + char *file, unsigned int line); void erts_proc_lc_unlock(Process *p, ErtsProcLocks locks); void erts_proc_lc_might_unlock(Process *p, ErtsProcLocks locks); void erts_proc_lc_chk_have_proc_locks(Process *p, ErtsProcLocks locks); @@ -253,7 +255,8 @@ void erts_proc_lc_chk_only_proc_main(Process *p); void erts_proc_lc_chk_no_proc_locks(char *file, int line); ErtsProcLocks erts_proc_lc_my_proc_locks(Process *p); int erts_proc_lc_trylock_force_busy(Process *p, ErtsProcLocks locks); -void erts_proc_lc_require_lock(Process *p, ErtsProcLocks locks); +void erts_proc_lc_require_lock(Process *p, ErtsProcLocks locks, + char* file, unsigned int line); void erts_proc_lc_unrequire_lock(Process *p, ErtsProcLocks locks); #else #define ERTS_SMP_CHK_NO_PROC_LOCKS @@ -372,7 +375,7 @@ ERTS_GLB_INLINE int erts_lc_pix_lock_is_locked(erts_pix_lock_t *); ERTS_GLB_INLINE ErtsProcLocks erts_smp_proc_raw_trylock__(Process *p, ErtsProcLocks locks); -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION ERTS_GLB_INLINE void erts_smp_proc_lock_x__(Process *, erts_pix_lock_t *, ErtsProcLocks, @@ -482,7 +485,7 @@ busy_main: } ERTS_GLB_INLINE void -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION erts_smp_proc_lock_x__(Process *p, erts_pix_lock_t *pix_lck, ErtsProcLocks locks, @@ -528,7 +531,7 @@ erts_smp_proc_lock__(Process *p, erts_lcnt_proc_lock_post_x(&(p->lock), locks, file, line); #endif #ifdef ERTS_ENABLE_LOCK_CHECK - erts_proc_lc_lock(p, locks); + erts_proc_lc_lock(p, locks, file, line); #endif #ifdef ERTS_PROC_LOCK_DEBUG @@ -695,7 +698,7 @@ erts_smp_proc_trylock__(Process *p, #endif #ifdef ERTS_ENABLE_LOCK_CHECK - erts_proc_lc_trylock(p, locks, res == 0); + erts_proc_lc_trylock(p, locks, res == 0, __FILE__, __LINE__); #endif #if ERTS_PROC_LOCK_ATOMIC_IMPL @@ -741,7 +744,7 @@ erts_proc_lock_op_debug(Process *p, ErtsProcLocks locks, int locked) #endif /* ERTS_SMP */ -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION ERTS_GLB_INLINE void erts_smp_proc_lock_x(Process *, ErtsProcLocks, char *file, unsigned int line); #else ERTS_GLB_INLINE void erts_smp_proc_lock(Process *, ErtsProcLocks); @@ -756,13 +759,13 @@ ERTS_GLB_INLINE void erts_smp_proc_add_refc(Process *, Sint32); #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE void -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION erts_smp_proc_lock_x(Process *p, ErtsProcLocks locks, char *file, unsigned int line) #else erts_smp_proc_lock(Process *p, ErtsProcLocks locks) #endif { -#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_COUNT) +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_POSITION) erts_smp_proc_lock_x__(p, #if ERTS_PROC_LOCK_ATOMIC_IMPL NULL, diff --git a/erts/emulator/beam/erl_ptab.c b/erts/emulator/beam/erl_ptab.c index fa5482b841..eabf016081 100644 --- a/erts/emulator/beam/erl_ptab.c +++ b/erts/emulator/beam/erl_ptab.c @@ -756,7 +756,8 @@ erts_ptab_delete_element(ErtsPTab *ptab, pix = erts_ptab_id2pix(ptab, ptab_el->id); - ASSERT(erts_get_scheduler_id()); /* *Need* to be a scheduler */ + /* *Need* to be an managed thread */ + ERTS_SMP_LC_ASSERT(erts_thr_progress_is_managed_thread()); erts_ptab_rlock(ptab); maybe_save = ptab->list.data.deleted.end != NULL; diff --git a/erts/emulator/beam/erl_smp.h b/erts/emulator/beam/erl_smp.h index ecb5525022..c38ef47d87 100644 --- a/erts/emulator/beam/erl_smp.h +++ b/erts/emulator/beam/erl_smp.h @@ -26,10 +26,13 @@ #define ERL_SMP_H #include "erl_threads.h" -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION #define erts_smp_mtx_lock(L) erts_smp_mtx_lock_x(L, __FILE__, __LINE__) +#define erts_smp_mtx_trylock(L) erts_smp_mtx_trylock_x(L, __FILE__, __LINE__) #define erts_smp_spin_lock(L) erts_smp_spin_lock_x(L, __FILE__, __LINE__) +#define erts_smp_rwmtx_tryrlock(L) erts_smp_rwmtx_tryrlock_x(L, __FILE__, __LINE__) #define erts_smp_rwmtx_rlock(L) erts_smp_rwmtx_rlock_x(L, __FILE__, __LINE__) +#define erts_smp_rwmtx_tryrwlock(L) erts_smp_rwmtx_tryrwlock_x(L, __FILE__, __LINE__) #define erts_smp_rwmtx_rwlock(L) erts_smp_rwmtx_rwlock_x(L, __FILE__, __LINE__) #define erts_smp_read_lock(L) erts_smp_read_lock_x(L, __FILE__, __LINE__) #define erts_smp_write_lock(L) erts_smp_write_lock_x(L, __FILE__, __LINE__) @@ -131,10 +134,11 @@ ERTS_GLB_INLINE void erts_smp_mtx_init_locked_x(erts_smp_mtx_t *mtx, ERTS_GLB_INLINE void erts_smp_mtx_init(erts_smp_mtx_t *mtx, char *name); ERTS_GLB_INLINE void erts_smp_mtx_init_locked(erts_smp_mtx_t *mtx, char *name); ERTS_GLB_INLINE void erts_smp_mtx_destroy(erts_smp_mtx_t *mtx); -ERTS_GLB_INLINE int erts_smp_mtx_trylock(erts_smp_mtx_t *mtx); -#ifdef ERTS_ENABLE_LOCK_COUNT -ERTS_GLB_INLINE void erts_smp_mtx_lock_x(erts_smp_mtx_t *mtx, char *file, int line); +#ifdef ERTS_ENABLE_LOCK_POSITION +ERTS_GLB_INLINE int erts_smp_mtx_trylock_x(erts_smp_mtx_t *mtx, char *file, unsigned int line); +ERTS_GLB_INLINE void erts_smp_mtx_lock_x(erts_smp_mtx_t *mtx, char *file, unsigned int line); #else +ERTS_GLB_INLINE int erts_smp_mtx_trylock(erts_smp_mtx_t *mtx); ERTS_GLB_INLINE void erts_smp_mtx_lock(erts_smp_mtx_t *mtx); #endif ERTS_GLB_INLINE void erts_smp_mtx_unlock(erts_smp_mtx_t *mtx); @@ -159,16 +163,18 @@ ERTS_GLB_INLINE void erts_smp_rwmtx_init_opt(erts_smp_rwmtx_t *rwmtx, ERTS_GLB_INLINE void erts_smp_rwmtx_init(erts_smp_rwmtx_t *rwmtx, char *name); ERTS_GLB_INLINE void erts_smp_rwmtx_destroy(erts_smp_rwmtx_t *rwmtx); -ERTS_GLB_INLINE int erts_smp_rwmtx_tryrlock(erts_smp_rwmtx_t *rwmtx); -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION +ERTS_GLB_INLINE int erts_smp_rwmtx_tryrlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line); ERTS_GLB_INLINE void erts_smp_rwmtx_rlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line); ERTS_GLB_INLINE void erts_smp_rwmtx_rwlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line); +ERTS_GLB_INLINE int erts_smp_rwmtx_tryrwlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line); #else +ERTS_GLB_INLINE int erts_smp_rwmtx_tryrlock(erts_smp_rwmtx_t *rwmtx); ERTS_GLB_INLINE void erts_smp_rwmtx_rlock(erts_smp_rwmtx_t *rwmtx); ERTS_GLB_INLINE void erts_smp_rwmtx_rwlock(erts_smp_rwmtx_t *rwmtx); +ERTS_GLB_INLINE int erts_smp_rwmtx_tryrwlock(erts_smp_rwmtx_t *rwmtx); #endif ERTS_GLB_INLINE void erts_smp_rwmtx_runlock(erts_smp_rwmtx_t *rwmtx); -ERTS_GLB_INLINE int erts_smp_rwmtx_tryrwlock(erts_smp_rwmtx_t *rwmtx); ERTS_GLB_INLINE void erts_smp_rwmtx_rwunlock(erts_smp_rwmtx_t *rwmtx); ERTS_GLB_INLINE int erts_smp_lc_rwmtx_is_rlocked(erts_smp_rwmtx_t *mtx); ERTS_GLB_INLINE int erts_smp_lc_rwmtx_is_rwlocked(erts_smp_rwmtx_t *mtx); @@ -179,7 +185,7 @@ ERTS_GLB_INLINE void erts_smp_spinlock_init(erts_smp_spinlock_t *lock, char *name); ERTS_GLB_INLINE void erts_smp_spinlock_destroy(erts_smp_spinlock_t *lock); ERTS_GLB_INLINE void erts_smp_spin_unlock(erts_smp_spinlock_t *lock); -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION ERTS_GLB_INLINE void erts_smp_spin_lock_x(erts_smp_spinlock_t *lock, char *file, unsigned int line); #else ERTS_GLB_INLINE void erts_smp_spin_lock(erts_smp_spinlock_t *lock); @@ -192,7 +198,7 @@ ERTS_GLB_INLINE void erts_smp_rwlock_init(erts_smp_rwlock_t *lock, char *name); ERTS_GLB_INLINE void erts_smp_rwlock_destroy(erts_smp_rwlock_t *lock); ERTS_GLB_INLINE void erts_smp_read_unlock(erts_smp_rwlock_t *lock); -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION ERTS_GLB_INLINE void erts_smp_read_lock_x(erts_smp_rwlock_t *lock, char *file, unsigned int line); ERTS_GLB_INLINE void erts_smp_write_lock_x(erts_smp_rwlock_t *lock, char *file, unsigned int line); #else @@ -202,7 +208,8 @@ ERTS_GLB_INLINE void erts_smp_write_lock(erts_smp_rwlock_t *lock); ERTS_GLB_INLINE void erts_smp_write_unlock(erts_smp_rwlock_t *lock); ERTS_GLB_INLINE int erts_smp_lc_rwlock_is_rlocked(erts_smp_rwlock_t *lock); ERTS_GLB_INLINE int erts_smp_lc_rwlock_is_rwlocked(erts_smp_rwlock_t *lock); -ERTS_GLB_INLINE void erts_smp_tsd_key_create(erts_smp_tsd_key_t *keyp); +ERTS_GLB_INLINE void erts_smp_tsd_key_create(erts_smp_tsd_key_t *keyp, + char *keyname); ERTS_GLB_INLINE void erts_smp_tsd_key_delete(erts_smp_tsd_key_t key); ERTS_GLB_INLINE void erts_smp_tsd_set(erts_smp_tsd_key_t key, void *value); ERTS_GLB_INLINE void * erts_smp_tsd_get(erts_smp_tsd_key_t key); @@ -835,7 +842,7 @@ ERTS_GLB_INLINE void erts_smp_mtx_init_x(erts_smp_mtx_t *mtx, char *name, Eterm extra) { #ifdef ERTS_SMP - erts_mtx_init_x(mtx, name, extra); + erts_mtx_init_x(mtx, name, extra, 1); #endif } @@ -843,7 +850,7 @@ ERTS_GLB_INLINE void erts_smp_mtx_init_locked_x(erts_smp_mtx_t *mtx, char *name, Eterm extra) { #ifdef ERTS_SMP - erts_mtx_init_locked_x(mtx, name, extra); + erts_mtx_init_locked_x(mtx, name, extra, 1); #endif } @@ -872,9 +879,15 @@ erts_smp_mtx_destroy(erts_smp_mtx_t *mtx) } ERTS_GLB_INLINE int +#ifdef ERTS_ENABLE_LOCK_POSITION +erts_smp_mtx_trylock_x(erts_smp_mtx_t *mtx, char *file, unsigned int line) +#else erts_smp_mtx_trylock(erts_smp_mtx_t *mtx) +#endif { -#ifdef ERTS_SMP +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_POSITION) + return erts_mtx_trylock_x(mtx,file,line); +#elif defined(ERTS_SMP) return erts_mtx_trylock(mtx); #else return 0; @@ -884,13 +897,13 @@ erts_smp_mtx_trylock(erts_smp_mtx_t *mtx) ERTS_GLB_INLINE void -#ifdef ERTS_ENABLE_LOCK_COUNT -erts_smp_mtx_lock_x(erts_smp_mtx_t *mtx, char *file, int line) +#ifdef ERTS_ENABLE_LOCK_POSITION +erts_smp_mtx_lock_x(erts_smp_mtx_t *mtx, char *file, unsigned int line) #else erts_smp_mtx_lock(erts_smp_mtx_t *mtx) #endif { -#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_COUNT) +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_POSITION) erts_mtx_lock_x(mtx, file, line); #elif defined(ERTS_SMP) erts_mtx_lock(mtx); @@ -1020,9 +1033,15 @@ erts_smp_rwmtx_destroy(erts_smp_rwmtx_t *rwmtx) } ERTS_GLB_INLINE int +#ifdef ERTS_ENABLE_LOCK_POSITION +erts_smp_rwmtx_tryrlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line) +#else erts_smp_rwmtx_tryrlock(erts_smp_rwmtx_t *rwmtx) +#endif { -#ifdef ERTS_SMP +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_POSITION) + return erts_rwmtx_tryrlock_x(rwmtx, file, line); +#elif defined(ERTS_SMP) return erts_rwmtx_tryrlock(rwmtx); #else return 0; @@ -1030,13 +1049,13 @@ erts_smp_rwmtx_tryrlock(erts_smp_rwmtx_t *rwmtx) } ERTS_GLB_INLINE void -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION erts_smp_rwmtx_rlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line) #else erts_smp_rwmtx_rlock(erts_smp_rwmtx_t *rwmtx) #endif { -#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_COUNT) +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_POSITION) erts_rwmtx_rlock_x(rwmtx, file, line); #elif defined(ERTS_SMP) erts_rwmtx_rlock(rwmtx); @@ -1053,9 +1072,15 @@ erts_smp_rwmtx_runlock(erts_smp_rwmtx_t *rwmtx) ERTS_GLB_INLINE int +#ifdef ERTS_ENABLE_LOCK_POSITION +erts_smp_rwmtx_tryrwlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line) +#else erts_smp_rwmtx_tryrwlock(erts_smp_rwmtx_t *rwmtx) +#endif { -#ifdef ERTS_SMP +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_POSITION) + return erts_rwmtx_tryrwlock_x(rwmtx, file, line); +#elif defined(ERTS_SMP) return erts_rwmtx_tryrwlock(rwmtx); #else return 0; @@ -1063,13 +1088,13 @@ erts_smp_rwmtx_tryrwlock(erts_smp_rwmtx_t *rwmtx) } ERTS_GLB_INLINE void -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION erts_smp_rwmtx_rwlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line) #else erts_smp_rwmtx_rwlock(erts_smp_rwmtx_t *rwmtx) #endif { -#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_COUNT) +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_POSITION) erts_rwmtx_rwlock_x(rwmtx, file, line); #elif defined(ERTS_SMP) erts_rwmtx_rwlock(rwmtx); @@ -1171,13 +1196,13 @@ erts_smp_spin_unlock(erts_smp_spinlock_t *lock) } ERTS_GLB_INLINE void -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION erts_smp_spin_lock_x(erts_smp_spinlock_t *lock, char *file, unsigned int line) #else erts_smp_spin_lock(erts_smp_spinlock_t *lock) #endif { -#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_COUNT) +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_POSITION) erts_spin_lock_x(lock, file, line); #elif defined(ERTS_SMP) erts_spin_lock(lock); @@ -1237,13 +1262,13 @@ erts_smp_read_unlock(erts_smp_rwlock_t *lock) } ERTS_GLB_INLINE void -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION erts_smp_read_lock_x(erts_smp_rwlock_t *lock, char *file, unsigned int line) #else erts_smp_read_lock(erts_smp_rwlock_t *lock) #endif { -#if defined(ERTS_ENABLE_LOCK_COUNT) && defined(ERTS_SMP) +#if defined(ERTS_ENABLE_LOCK_POSITION) && defined(ERTS_SMP) erts_read_lock_x(lock, file, line); #elif defined(ERTS_SMP) erts_read_lock(lock); @@ -1263,13 +1288,13 @@ erts_smp_write_unlock(erts_smp_rwlock_t *lock) } ERTS_GLB_INLINE void -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION erts_smp_write_lock_x(erts_smp_rwlock_t *lock, char *file, unsigned int line) #else erts_smp_write_lock(erts_smp_rwlock_t *lock) #endif { -#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_COUNT) +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_POSITION) erts_write_lock_x(lock, file, line); #elif defined(ERTS_SMP) erts_write_lock(lock); @@ -1299,10 +1324,10 @@ erts_smp_lc_rwlock_is_rwlocked(erts_smp_rwlock_t *lock) } ERTS_GLB_INLINE void -erts_smp_tsd_key_create(erts_smp_tsd_key_t *keyp) +erts_smp_tsd_key_create(erts_smp_tsd_key_t *keyp, char* keyname) { #ifdef ERTS_SMP - erts_tsd_key_create(keyp); + erts_tsd_key_create(keyp,keyname); #endif } diff --git a/erts/emulator/beam/erl_thr_progress.c b/erts/emulator/beam/erl_thr_progress.c index cf5e3dc012..545a0343d0 100644 --- a/erts/emulator/beam/erl_thr_progress.c +++ b/erts/emulator/beam/erl_thr_progress.c @@ -417,7 +417,8 @@ void erts_thr_progress_pre_init(void) { intrnl = NULL; - erts_tsd_key_create(&erts_thr_prgr_data_key__); + erts_tsd_key_create(&erts_thr_prgr_data_key__, + "erts_thr_prgr_data_key"); init_nob(&erts_thr_prgr__.current, ERTS_THR_PRGR_VAL_FIRST); } diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h index 759c8f4c33..80026104db 100644 --- a/erts/emulator/beam/erl_threads.h +++ b/erts/emulator/beam/erl_threads.h @@ -281,10 +281,13 @@ #define ERTS_THR_READ_MEMORY_BARRIER ETHR_READ_MEMORY_BARRIER #define ERTS_THR_DATA_DEPENDENCY_READ_MEMORY_BARRIER ETHR_READ_DEPEND_MEMORY_BARRIER -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION #define erts_mtx_lock(L) erts_mtx_lock_x(L, __FILE__, __LINE__) +#define erts_mtx_trylock(L) erts_mtx_trylock_x(L, __FILE__, __LINE__) #define erts_spin_lock(L) erts_spin_lock_x(L, __FILE__, __LINE__) +#define erts_rwmtx_tryrlock(L) erts_rwmtx_tryrlock_x(L, __FILE__, __LINE__) #define erts_rwmtx_rlock(L) erts_rwmtx_rlock_x(L, __FILE__, __LINE__) +#define erts_rwmtx_tryrwlock(L) erts_rwmtx_tryrwlock_x(L, __FILE__, __LINE__) #define erts_rwmtx_rwlock(L) erts_rwmtx_rwlock_x(L, __FILE__, __LINE__) #define erts_read_lock(L) erts_read_lock_x(L, __FILE__, __LINE__) #define erts_write_lock(L) erts_write_lock_x(L, __FILE__, __LINE__) @@ -461,18 +464,24 @@ ERTS_GLB_INLINE void erts_thr_exit(void *res); ERTS_GLB_INLINE void erts_thr_install_exit_handler(void (*exit_handler)(void)); ERTS_GLB_INLINE erts_tid_t erts_thr_self(void); ERTS_GLB_INLINE int erts_equal_tids(erts_tid_t x, erts_tid_t y); -ERTS_GLB_INLINE void erts_mtx_init_x(erts_mtx_t *mtx, char *name, Eterm extra); -ERTS_GLB_INLINE void erts_mtx_init_x_opt(erts_mtx_t *mtx, char *name, Eterm extra, Uint16 opt); +ERTS_GLB_INLINE void erts_mtx_init_x(erts_mtx_t *mtx, char *name, Eterm extra, + int enable_lcnt); +ERTS_GLB_INLINE void erts_mtx_init_x_opt(erts_mtx_t *mtx, char *name, Eterm extra, + Uint16 opt, int enable_lcnt); ERTS_GLB_INLINE void erts_mtx_init_locked_x(erts_mtx_t *mtx, char *name, - Eterm extra); + Eterm extra, + int enable_lcnt); ERTS_GLB_INLINE void erts_mtx_init(erts_mtx_t *mtx, char *name); ERTS_GLB_INLINE void erts_mtx_init_locked(erts_mtx_t *mtx, char *name); ERTS_GLB_INLINE void erts_mtx_destroy(erts_mtx_t *mtx); -ERTS_GLB_INLINE int erts_mtx_trylock(erts_mtx_t *mtx); -#ifdef ERTS_ENABLE_LOCK_COUNT -ERTS_GLB_INLINE void erts_mtx_lock_x(erts_mtx_t *mtx, char *file, unsigned int line); +#ifdef ERTS_ENABLE_LOCK_POSITION +ERTS_GLB_INLINE int erts_mtx_trylock_x(erts_mtx_t *mtx, char *file, + unsigned int line); +ERTS_GLB_INLINE void erts_mtx_lock_x(erts_mtx_t *mtx, char *file, + unsigned int line); #else +ERTS_GLB_INLINE int erts_mtx_trylock(erts_mtx_t *mtx); ERTS_GLB_INLINE void erts_mtx_lock(erts_mtx_t *mtx); #endif ERTS_GLB_INLINE void erts_mtx_unlock(erts_mtx_t *mtx); @@ -496,16 +505,18 @@ ERTS_GLB_INLINE void erts_rwmtx_init_opt(erts_rwmtx_t *rwmtx, ERTS_GLB_INLINE void erts_rwmtx_init(erts_rwmtx_t *rwmtx, char *name); ERTS_GLB_INLINE void erts_rwmtx_destroy(erts_rwmtx_t *rwmtx); -ERTS_GLB_INLINE int erts_rwmtx_tryrlock(erts_rwmtx_t *rwmtx); -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION +ERTS_GLB_INLINE int erts_rwmtx_tryrlock_x(erts_rwmtx_t *rwmtx, char *file, unsigned int line); ERTS_GLB_INLINE void erts_rwmtx_rlock_x(erts_rwmtx_t *rwmtx, char *file, unsigned int line); ERTS_GLB_INLINE void erts_rwmtx_rwlock_x(erts_rwmtx_t *rwmtx, char *file, unsigned int line); +ERTS_GLB_INLINE int erts_rwmtx_tryrwlock_x(erts_rwmtx_t *rwmtx, char *file, unsigned int line); #else +ERTS_GLB_INLINE int erts_rwmtx_tryrlock(erts_rwmtx_t *rwmtx); ERTS_GLB_INLINE void erts_rwmtx_rlock(erts_rwmtx_t *rwmtx); ERTS_GLB_INLINE void erts_rwmtx_rwlock(erts_rwmtx_t *rwmtx); +ERTS_GLB_INLINE int erts_rwmtx_tryrwlock(erts_rwmtx_t *rwmtx); #endif ERTS_GLB_INLINE void erts_rwmtx_runlock(erts_rwmtx_t *rwmtx); -ERTS_GLB_INLINE int erts_rwmtx_tryrwlock(erts_rwmtx_t *rwmtx); ERTS_GLB_INLINE void erts_rwmtx_rwunlock(erts_rwmtx_t *rwmtx); ERTS_GLB_INLINE int erts_lc_rwmtx_is_rlocked(erts_rwmtx_t *mtx); ERTS_GLB_INLINE int erts_lc_rwmtx_is_rwlocked(erts_rwmtx_t *mtx); @@ -571,7 +582,7 @@ ERTS_GLB_INLINE void erts_spinlock_init(erts_spinlock_t *lock, char *name); ERTS_GLB_INLINE void erts_spinlock_destroy(erts_spinlock_t *lock); ERTS_GLB_INLINE void erts_spin_unlock(erts_spinlock_t *lock); -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION ERTS_GLB_INLINE void erts_spin_lock_x(erts_spinlock_t *lock, char *file, unsigned int line); #else ERTS_GLB_INLINE void erts_spin_lock(erts_spinlock_t *lock); @@ -584,7 +595,7 @@ ERTS_GLB_INLINE void erts_rwlock_init(erts_rwlock_t *lock, char *name); ERTS_GLB_INLINE void erts_rwlock_destroy(erts_rwlock_t *lock); ERTS_GLB_INLINE void erts_read_unlock(erts_rwlock_t *lock); -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION ERTS_GLB_INLINE void erts_read_lock_x(erts_rwlock_t *lock, char *file, unsigned int line); ERTS_GLB_INLINE void erts_write_lock_x(erts_rwlock_t *lock, char *file, unsigned int line); #else @@ -594,7 +605,7 @@ ERTS_GLB_INLINE void erts_write_lock(erts_rwlock_t *lock); ERTS_GLB_INLINE void erts_write_unlock(erts_rwlock_t *lock); ERTS_GLB_INLINE int erts_lc_rwlock_is_rlocked(erts_rwlock_t *lock); ERTS_GLB_INLINE int erts_lc_rwlock_is_rwlocked(erts_rwlock_t *lock); -ERTS_GLB_INLINE void erts_tsd_key_create(erts_tsd_key_t *keyp); +ERTS_GLB_INLINE void erts_tsd_key_create(erts_tsd_key_t *keyp, char *keyname); ERTS_GLB_INLINE void erts_tsd_key_delete(erts_tsd_key_t key); ERTS_GLB_INLINE void erts_tsd_set(erts_tsd_key_t key, void *value); ERTS_GLB_INLINE void * erts_tsd_get(erts_tsd_key_t key); @@ -1549,7 +1560,7 @@ erts_equal_tids(erts_tid_t x, erts_tid_t y) } ERTS_GLB_INLINE void -erts_mtx_init_x(erts_mtx_t *mtx, char *name, Eterm extra) +erts_mtx_init_x(erts_mtx_t *mtx, char *name, Eterm extra, int enable_lcnt) { #ifdef USE_THREADS int res = ethr_mutex_init(&mtx->mtx); @@ -1559,13 +1570,17 @@ erts_mtx_init_x(erts_mtx_t *mtx, char *name, Eterm extra) erts_lc_init_lock_x(&mtx->lc, name, ERTS_LC_FLG_LT_MUTEX, extra); #endif #ifdef ERTS_ENABLE_LOCK_COUNT - erts_lcnt_init_lock_x(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX, extra); + if (enable_lcnt) + erts_lcnt_init_lock_x(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX, extra); + else + erts_lcnt_init_lock_x(&mtx->lcnt, NULL, ERTS_LCNT_LT_MUTEX, extra); #endif #endif } ERTS_GLB_INLINE void -erts_mtx_init_x_opt(erts_mtx_t *mtx, char *name, Eterm extra, Uint16 opt) +erts_mtx_init_x_opt(erts_mtx_t *mtx, char *name, Eterm extra, Uint16 opt, + int enable_lcnt) { #ifdef USE_THREADS int res = ethr_mutex_init(&mtx->mtx); @@ -1575,14 +1590,17 @@ erts_mtx_init_x_opt(erts_mtx_t *mtx, char *name, Eterm extra, Uint16 opt) erts_lc_init_lock_x(&mtx->lc, name, ERTS_LC_FLG_LT_MUTEX, extra); #endif #ifdef ERTS_ENABLE_LOCK_COUNT - erts_lcnt_init_lock_x(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX | opt, extra); + if (enable_lcnt) + erts_lcnt_init_lock_x(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX | opt, extra); + else + erts_lcnt_init_lock_x(&mtx->lcnt, NULL, ERTS_LCNT_LT_MUTEX | opt, extra); #endif #endif } ERTS_GLB_INLINE void -erts_mtx_init_locked_x(erts_mtx_t *mtx, char *name, Eterm extra) +erts_mtx_init_locked_x(erts_mtx_t *mtx, char *name, Eterm extra, int enable_lcnt) { #ifdef USE_THREADS int res = ethr_mutex_init(&mtx->mtx); @@ -1592,7 +1610,10 @@ erts_mtx_init_locked_x(erts_mtx_t *mtx, char *name, Eterm extra) erts_lc_init_lock_x(&mtx->lc, name, ERTS_LC_FLG_LT_MUTEX, extra); #endif #ifdef ERTS_ENABLE_LOCK_COUNT - erts_lcnt_init_lock_x(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX, extra); + if (enable_lcnt) + erts_lcnt_init_lock_x(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX, extra); + else + erts_lcnt_init_lock_x(&mtx->lcnt, NULL, ERTS_LCNT_LT_MUTEX, extra); #endif ethr_mutex_lock(&mtx->mtx); #ifdef ERTS_ENABLE_LOCK_CHECK @@ -1670,7 +1691,11 @@ erts_mtx_destroy(erts_mtx_t *mtx) } ERTS_GLB_INLINE int +#ifdef ERTS_ENABLE_LOCK_POSITION +erts_mtx_trylock_x(erts_mtx_t *mtx, char *file, unsigned int line) +#else erts_mtx_trylock(erts_mtx_t *mtx) +#endif { #ifdef USE_THREADS int res; @@ -1684,8 +1709,12 @@ erts_mtx_trylock(erts_mtx_t *mtx) res = ethr_mutex_trylock(&mtx->mtx); #ifdef ERTS_ENABLE_LOCK_CHECK +#ifdef ERTS_ENABLE_LOCK_POSITION + erts_lc_trylock_x(res == 0, &mtx->lc,file,line); +#else erts_lc_trylock(res == 0, &mtx->lc); #endif +#endif #ifdef ERTS_ENABLE_LOCK_COUNT erts_lcnt_trylock(&mtx->lcnt, res); #endif @@ -1697,7 +1726,7 @@ erts_mtx_trylock(erts_mtx_t *mtx) } ERTS_GLB_INLINE void -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION erts_mtx_lock_x(erts_mtx_t *mtx, char *file, unsigned int line) #else erts_mtx_lock(erts_mtx_t *mtx) @@ -1705,8 +1734,12 @@ erts_mtx_lock(erts_mtx_t *mtx) { #ifdef USE_THREADS #ifdef ERTS_ENABLE_LOCK_CHECK +#ifdef ERTS_ENABLE_LOCK_POSITION + erts_lc_lock_x(&mtx->lc, file, line); +#else erts_lc_lock(&mtx->lc); #endif +#endif #ifdef ERTS_ENABLE_LOCK_COUNT erts_lcnt_lock(&mtx->lcnt); #endif @@ -1857,7 +1890,10 @@ erts_rwmtx_init_opt_x(erts_rwmtx_t *rwmtx, erts_lc_init_lock_x(&rwmtx->lc, name, ERTS_LC_FLG_LT_RWMUTEX, extra); #endif #ifdef ERTS_ENABLE_LOCK_COUNT - erts_lcnt_init_lock_x(&rwmtx->lcnt, name, ERTS_LCNT_LT_RWMUTEX, extra); + if (name && name[0] == '\0') + erts_lcnt_init_lock_x(&rwmtx->lcnt, NULL, ERTS_LCNT_LT_RWMUTEX, extra); + else + erts_lcnt_init_lock_x(&rwmtx->lcnt, name, ERTS_LCNT_LT_RWMUTEX, extra); #endif #endif } @@ -1921,7 +1957,11 @@ erts_rwmtx_destroy(erts_rwmtx_t *rwmtx) } ERTS_GLB_INLINE int +#ifdef ERTS_ENABLE_LOCK_POSITION +erts_rwmtx_tryrlock_x(erts_rwmtx_t *rwmtx, char *file, unsigned int line) +#else erts_rwmtx_tryrlock(erts_rwmtx_t *rwmtx) +#endif { #ifdef USE_THREADS int res; @@ -1935,8 +1975,12 @@ erts_rwmtx_tryrlock(erts_rwmtx_t *rwmtx) res = ethr_rwmutex_tryrlock(&rwmtx->rwmtx); #ifdef ERTS_ENABLE_LOCK_CHECK +#ifdef ERTS_ENABLE_LOCK_POSITION + erts_lc_trylock_flg_x(res == 0, &rwmtx->lc, ERTS_LC_FLG_LO_READ,file,line); +#else erts_lc_trylock_flg(res == 0, &rwmtx->lc, ERTS_LC_FLG_LO_READ); #endif +#endif #ifdef ERTS_ENABLE_LOCK_COUNT erts_lcnt_trylock_opt(&rwmtx->lcnt, res, ERTS_LCNT_LO_READ); #endif @@ -1948,7 +1992,7 @@ erts_rwmtx_tryrlock(erts_rwmtx_t *rwmtx) } ERTS_GLB_INLINE void -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION erts_rwmtx_rlock_x(erts_rwmtx_t *rwmtx, char *file, unsigned int line) #else erts_rwmtx_rlock(erts_rwmtx_t *rwmtx) @@ -1956,8 +2000,12 @@ erts_rwmtx_rlock(erts_rwmtx_t *rwmtx) { #ifdef USE_THREADS #ifdef ERTS_ENABLE_LOCK_CHECK +#ifdef ERTS_ENABLE_LOCK_POSITION + erts_lc_lock_flg_x(&rwmtx->lc, ERTS_LC_FLG_LO_READ,file,line); +#else erts_lc_lock_flg(&rwmtx->lc, ERTS_LC_FLG_LO_READ); #endif +#endif #ifdef ERTS_ENABLE_LOCK_COUNT erts_lcnt_lock_opt(&rwmtx->lcnt, ERTS_LCNT_LO_READ); #endif @@ -1984,7 +2032,11 @@ erts_rwmtx_runlock(erts_rwmtx_t *rwmtx) ERTS_GLB_INLINE int +#ifdef ERTS_ENABLE_LOCK_POSITION +erts_rwmtx_tryrwlock_x(erts_rwmtx_t *rwmtx, char *file, unsigned int line) +#else erts_rwmtx_tryrwlock(erts_rwmtx_t *rwmtx) +#endif { #ifdef USE_THREADS int res; @@ -1998,8 +2050,12 @@ erts_rwmtx_tryrwlock(erts_rwmtx_t *rwmtx) res = ethr_rwmutex_tryrwlock(&rwmtx->rwmtx); #ifdef ERTS_ENABLE_LOCK_CHECK +#ifdef ERTS_ENABLE_LOCK_POSITION + erts_lc_trylock_flg_x(res == 0, &rwmtx->lc, ERTS_LC_FLG_LO_READ_WRITE,file,line); +#else erts_lc_trylock_flg(res == 0, &rwmtx->lc, ERTS_LC_FLG_LO_READ_WRITE); #endif +#endif #ifdef ERTS_ENABLE_LOCK_COUNT erts_lcnt_trylock_opt(&rwmtx->lcnt, res, ERTS_LCNT_LO_READ_WRITE); #endif @@ -2011,7 +2067,7 @@ erts_rwmtx_tryrwlock(erts_rwmtx_t *rwmtx) } ERTS_GLB_INLINE void -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION erts_rwmtx_rwlock_x(erts_rwmtx_t *rwmtx, char *file, unsigned int line) #else erts_rwmtx_rwlock(erts_rwmtx_t *rwmtx) @@ -2019,8 +2075,12 @@ erts_rwmtx_rwlock(erts_rwmtx_t *rwmtx) { #ifdef USE_THREADS #ifdef ERTS_ENABLE_LOCK_CHECK +#ifdef ERTS_ENABLE_LOCK_POSITION + erts_lc_lock_flg_x(&rwmtx->lc, ERTS_LC_FLG_LO_READ_WRITE,file,line); +#else erts_lc_lock_flg(&rwmtx->lc, ERTS_LC_FLG_LO_READ_WRITE); #endif +#endif #ifdef ERTS_ENABLE_LOCK_COUNT erts_lcnt_lock_opt(&rwmtx->lcnt, ERTS_LCNT_LO_READ_WRITE); #endif @@ -2426,7 +2486,7 @@ erts_spin_unlock(erts_spinlock_t *lock) } ERTS_GLB_INLINE void -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION erts_spin_lock_x(erts_spinlock_t *lock, char *file, unsigned int line) #else erts_spin_lock(erts_spinlock_t *lock) @@ -2434,8 +2494,12 @@ erts_spin_lock(erts_spinlock_t *lock) { #ifdef USE_THREADS #ifdef ERTS_ENABLE_LOCK_CHECK +#ifdef ERTS_ENABLE_LOCK_POSITION + erts_lc_lock_x(&lock->lc,file,line); +#else erts_lc_lock(&lock->lc); #endif +#endif #ifdef ERTS_ENABLE_LOCK_COUNT erts_lcnt_lock(&lock->lcnt); #endif @@ -2545,7 +2609,7 @@ erts_read_unlock(erts_rwlock_t *lock) } ERTS_GLB_INLINE void -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION erts_read_lock_x(erts_rwlock_t *lock, char *file, unsigned int line) #else erts_read_lock(erts_rwlock_t *lock) @@ -2553,8 +2617,12 @@ erts_read_lock(erts_rwlock_t *lock) { #ifdef USE_THREADS #ifdef ERTS_ENABLE_LOCK_CHECK +#ifdef ERTS_ENABLE_LOCK_POSITION + erts_lc_lock_flg_x(&lock->lc, ERTS_LC_FLG_LO_READ,file,line); +#else erts_lc_lock_flg(&lock->lc, ERTS_LC_FLG_LO_READ); #endif +#endif #ifdef ERTS_ENABLE_LOCK_COUNT erts_lcnt_lock_opt(&lock->lcnt, ERTS_LCNT_LO_READ); #endif @@ -2584,7 +2652,7 @@ erts_write_unlock(erts_rwlock_t *lock) } ERTS_GLB_INLINE void -#ifdef ERTS_ENABLE_LOCK_COUNT +#ifdef ERTS_ENABLE_LOCK_POSITION erts_write_lock_x(erts_rwlock_t *lock, char *file, unsigned int line) #else erts_write_lock(erts_rwlock_t *lock) @@ -2592,8 +2660,12 @@ erts_write_lock(erts_rwlock_t *lock) { #ifdef USE_THREADS #ifdef ERTS_ENABLE_LOCK_CHECK +#ifdef ERTS_ENABLE_LOCK_POSITION + erts_lc_lock_flg_x(&lock->lc, ERTS_LC_FLG_LO_READ_WRITE,file,line); +#else erts_lc_lock_flg(&lock->lc, ERTS_LC_FLG_LO_READ_WRITE); #endif +#endif #ifdef ERTS_ENABLE_LOCK_COUNT erts_lcnt_lock_opt(&lock->lcnt, ERTS_LCNT_LO_READ_WRITE); #endif @@ -2635,10 +2707,10 @@ erts_lc_rwlock_is_rwlocked(erts_rwlock_t *lock) } ERTS_GLB_INLINE void -erts_tsd_key_create(erts_tsd_key_t *keyp) +erts_tsd_key_create(erts_tsd_key_t *keyp, char *keyname) { #ifdef USE_THREADS - int res = ethr_tsd_key_create(keyp); + int res = ethr_tsd_key_create(keyp, keyname); if (res) erts_thr_fatal_error(res, "create thread specific data key"); #endif diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index ff7fdfcfca..305058ceff 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -151,6 +151,11 @@ do { \ message dispatcher thread takes care of that). */ #define ERTS_GET_TRACER_REF(RES, TPID, TRACEE_FLGS) \ do { (RES) = (TPID); } while(0) +int +erts_is_tracer_proc_valid(Process* p) +{ + return 1; +} #else #define ERTS_NULL_TRACER_REF NULL #define ERTS_TRACER_REF_TYPE Process * @@ -163,6 +168,20 @@ do { \ return; \ } \ } while (0) +int +erts_is_tracer_proc_valid(Process* p) +{ + Process* tracer; + + tracer = erts_proc_lookup(ERTS_TRACER_PROC(p)); + if (tracer && ERTS_TRACE_FLAGS(tracer) & F_TRACER) { + return 1; + } else { + ERTS_TRACER_PROC(p) = NIL; + ERTS_TRACE_FLAGS(p) = ~TRACEE_FLAGS; + return 0; + } +} #endif static Uint active_sched; @@ -3309,6 +3328,8 @@ sys_msg_dispatcher_func(void *unused) if (erts_thr_progress_update(NULL)) erts_thr_progress_leader_update(NULL); + ERTS_SCHED_FAIR_YIELD(); + #ifdef DEBUG_PRINTOUTS print_msg_type(smqp); #endif @@ -3467,12 +3488,20 @@ static void init_sys_msg_dispatcher(void) { erts_smp_thr_opts_t thr_opts = ERTS_SMP_THR_OPTS_DEFAULT_INITER; +#ifdef __OSE__ + thr_opts.coreNo = 0; +#endif thr_opts.detached = 1; init_smq_element_alloc(); sys_message_queue = NULL; sys_message_queue_end = NULL; erts_smp_cnd_init(&smq_cnd); erts_smp_mtx_init(&smq_mtx, "sys_msg_q"); + +#ifdef ETHR_HAVE_THREAD_NAMES + thr_opts.name = "sys_msg_dispatcher"; +#endif + erts_smp_thr_create(&sys_msg_dispatcher_tid, sys_msg_dispatcher_func, NULL, diff --git a/erts/emulator/beam/erl_trace.h b/erts/emulator/beam/erl_trace.h index 853c6cb0d8..4f2c70d6e7 100644 --- a/erts/emulator/beam/erl_trace.h +++ b/erts/emulator/beam/erl_trace.h @@ -39,6 +39,7 @@ void erts_change_default_tracing(int setflags, Uint *flagsp, Eterm *tracerp); void erts_get_default_tracing(Uint *flagsp, Eterm *tracerp); void erts_set_system_monitor(Eterm monitor); Eterm erts_get_system_monitor(void); +int erts_is_tracer_proc_valid(Process* p); #ifdef ERTS_SMP void erts_check_my_tracer_proc(Process *); diff --git a/erts/emulator/beam/erl_utils.h b/erts/emulator/beam/erl_utils.h index 43a19e97f1..0807649ea1 100644 --- a/erts/emulator/beam/erl_utils.h +++ b/erts/emulator/beam/erl_utils.h @@ -150,7 +150,7 @@ void erts_silence_warn_unused_result(long unused); int erts_fit_in_bits_int64(Sint64); int erts_fit_in_bits_int32(Sint32); -int list_length(Eterm); +int erts_list_length(Eterm); int erts_is_builtin(Eterm, Eterm, int); Uint32 make_broken_hash(Eterm); Uint32 block_hash(byte *, unsigned, Uint32); diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 9fb2dbd8bf..656de7c49a 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -529,7 +529,7 @@ Uint erts_encode_ext_size(Eterm term) Uint erts_encode_ext_size_2(Eterm term, unsigned dflags) { - return encode_size_struct2(NULL, term, TERM_TO_BINARY_DFLAGS|dflags) + return encode_size_struct2(NULL, term, dflags) + 1 /* VERSION_MAGIC */; } @@ -1068,7 +1068,7 @@ static BIF_RETTYPE term_to_binary_trap_1(BIF_ALIST_1) BIF_RET(res); } } - + BIF_RETTYPE term_to_binary_1(BIF_ALIST_1) { Eterm res = erts_term_to_binary_int(BIF_P, BIF_ARG_1, 0, TERM_TO_BINARY_DFLAGS, NULL); @@ -1099,10 +1099,10 @@ BIF_RETTYPE term_to_binary_2(BIF_ALIST_2) if (tp[1] == am_minor_version && is_small(tp[2])) { switch (signed_val(tp[2])) { case 0: - flags = TERM_TO_BINARY_DFLAGS; + flags = TERM_TO_BINARY_DFLAGS & ~DFLAG_NEW_FLOATS; break; case 1: - flags = TERM_TO_BINARY_DFLAGS|DFLAG_NEW_FLOATS; + flags = TERM_TO_BINARY_DFLAGS; break; default: goto error; @@ -1605,9 +1605,9 @@ external_size_2(BIF_ALIST_2) if (tp[1] == am_minor_version && is_small(tp[2])) { switch (signed_val(tp[2])) { case 0: + flags &= ~DFLAG_NEW_FLOATS; break; case 1: - flags |= DFLAG_NEW_FLOATS; break; default: goto error; @@ -2562,29 +2562,25 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, { map_t *mp = (map_t*)map_val(obj); Uint size = map_get_size(mp); - Eterm *mptr; *ep++ = MAP_EXT; put_int32(size, ep); ep += 4; - /* Push values first */ if (size > 0) { - mptr = map_get_values(mp); + Eterm *kptr = map_get_keys(mp); + Eterm *vptr = map_get_values(mp); + for (i = size-1; i >= 1; i--) { WSTACK_PUSH(s, ENC_TERM); - WSTACK_PUSH(s, (UWord) mptr[i]); + WSTACK_PUSH(s, (UWord) vptr[i]); + WSTACK_PUSH(s, ENC_TERM); + WSTACK_PUSH(s, (UWord) kptr[i]); } WSTACK_PUSH(s, ENC_TERM); - WSTACK_PUSH(s, (UWord) mptr[0]); + WSTACK_PUSH(s, (UWord) vptr[0]); - mptr = map_get_keys(mp); - for (i = size-1; i >= 1; i--) { - WSTACK_PUSH(s, ENC_TERM); - WSTACK_PUSH(s, (UWord) mptr[i]); - } - - obj = mptr[0]; + obj = kptr[0]; goto L_jump_start; } } @@ -3518,16 +3514,16 @@ dec_term_atom_common: keys = make_tuple(hp); *hp++ = make_arityval(size); - kptr = hp; hp += size; + kptr = hp - 1; mp = (map_t*)hp; hp += MAP_HEADER_SIZE; - vptr = hp; hp += size; + vptr = hp - 1; - /* kptr, first word for keys - * vptr, first word for values + /* kptr, last word for keys + * vptr, last word for values */ /* @@ -3542,27 +3538,12 @@ dec_term_atom_common: mp->keys = keys; *objp = make_map(mp); - /* We assume the map is wellformed, meaning: - * - ascending key order - * - unique keys - */ - - objp = vptr + size - 1; - n = size; - - while (n-- > 0) { - *objp = (Eterm) COMPRESS_POINTER(next); - next = objp; - objp--; - } - - objp = kptr + size - 1; - n = size; - - while (n-- > 0) { - *objp = (Eterm) COMPRESS_POINTER(next); - next = objp; - objp--; + for (n = size; n; n--) { + *vptr = (Eterm) COMPRESS_POINTER(next); + *kptr = (Eterm) COMPRESS_POINTER(vptr); + next = kptr; + vptr--; + kptr--; } } break; @@ -4459,3 +4440,66 @@ error: #undef SKIP2 #undef CHKSIZE } + + +#ifdef HIPE +BIF_RETTYPE hipe_wrapper_term_to_binary_1(BIF_ALIST_1); +BIF_RETTYPE hipe_wrapper_term_to_binary_2(BIF_ALIST_2); +BIF_RETTYPE hipe_wrapper_erts_internal_binary_to_term_1(BIF_ALIST_1); +BIF_RETTYPE hipe_wrapper_erts_internal_binary_to_term_2(BIF_ALIST_2); + +/* Hipe wrappers used by native code for BIFs that disable GC while trapping. + * + * Problem: + * When native code calls a BIF that traps, hipe_mode_switch will push a + * "trap frame" on the Erlang stack in order to find its way back from beam_emu + * back to native caller when finally done. If GC is disabled and stack/heap + * is full there is no place to push the "trap frame". + * + * Solution: + * We reserve space on stack for the "trap frame" here before the BIF is called. + * If the BIF does not trap, the space is reclaimed here before returning. + * If the BIF traps, hipe_push_beam_trap_frame() will detect that a "trap frame" + * already is reserved and use it. + */ +BIF_RETTYPE hipe_wrapper_term_to_binary_1(BIF_ALIST_1) +{ + Eterm res; + hipe_reserve_beam_trap_frame(BIF_P, BIF__ARGS, 1); + res = term_to_binary_1(BIF_P, BIF__ARGS); + if (is_value(res) || BIF_P->freason != TRAP) { + hipe_unreserve_beam_trap_frame(BIF_P); + } + return res; +} +BIF_RETTYPE hipe_wrapper_term_to_binary_2(BIF_ALIST_2) +{ + Eterm res; + hipe_reserve_beam_trap_frame(BIF_P, BIF__ARGS, 2); + res = term_to_binary_2(BIF_P, BIF__ARGS); + if (is_value(res) || BIF_P->freason != TRAP) { + hipe_unreserve_beam_trap_frame(BIF_P); + } + return res; +} +BIF_RETTYPE hipe_wrapper_erts_internal_binary_to_term_1(BIF_ALIST_1) +{ + Eterm res; + hipe_reserve_beam_trap_frame(BIF_P, BIF__ARGS, 1); + res = erts_internal_binary_to_term_1(BIF_P, BIF__ARGS); + if (is_value(res) || BIF_P->freason != TRAP) { + hipe_unreserve_beam_trap_frame(BIF_P); + } + return res; +} +BIF_RETTYPE hipe_wrapper_erts_internal_binary_to_term_2(BIF_ALIST_2) +{ + Eterm res; + hipe_reserve_beam_trap_frame(BIF_P, BIF__ARGS, 2); + res = erts_internal_binary_to_term_2(BIF_P, BIF__ARGS); + if (is_value(res) || BIF_P->freason != TRAP) { + hipe_unreserve_beam_trap_frame(BIF_P); + } + return res; +} +#endif /*HIPE*/ diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 3b16cdeb4a..edf4a28784 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -49,7 +49,9 @@ #include "erl_map.h" extern ErlDrvEntry fd_driver_entry; +#ifndef __OSE__ extern ErlDrvEntry vanilla_driver_entry; +#endif extern ErlDrvEntry spawn_driver_entry; extern ErlDrvEntry *driver_tab[]; /* table of static drivers, only used during initialization */ @@ -245,11 +247,13 @@ static ERTS_INLINE void port_init_instr(Port *prt ASSERT(prt->drv_ptr && prt->lock); if (!prt->drv_ptr->lock) { char *lock_str = "port_lock"; + erts_mtx_init_locked_x(prt->lock, lock_str, id, #ifdef ERTS_ENABLE_LOCK_COUNT - if (!(erts_lcnt_rt_options & ERTS_LCNT_OPT_PORTLOCK)) - lock_str = NULL; + (erts_lcnt_rt_options & ERTS_LCNT_OPT_PORTLOCK) +#else + 0 #endif - erts_mtx_init_locked_x(prt->lock, lock_str, id); + ); } #endif erts_port_task_init_sched(&prt->sched, id); @@ -910,8 +914,8 @@ int erts_port_handle_xports(Port *prt) (iov)->iov_base = (ptr); \ (iov)->iov_len = (len); \ if (sizeof((iov)->iov_len) < sizeof(len) \ - /* Check if (len) overflowed (iov)->iov_len */ \ - && ((len) >> (sizeof((iov)->iov_len)*CHAR_BIT)) != 0) { \ + /* Check if (len) overflowed (iov)->iov_len */ \ + && (iov)->iov_len != (len)) { \ goto L_overflow; \ } \ *(bv)++ = (bin); \ @@ -2469,7 +2473,7 @@ set_port_connected(int bang_op, DTRACE_CHARBUF(newprocess_str, DTRACE_TERM_BUF_SIZE); dtrace_pid_str(connect, process_str); - erts_snprintf(port_str, sizeof(port_str), "%T", prt->common.id); + erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), "%T", prt->common.id); dtrace_proc_str(rp, newprocess_str); DTRACE4(port_connect, process_str, port_str, prt->name, newprocess_str); } @@ -2743,8 +2747,10 @@ void erts_init_io(int port_tab_size, &drv_list_rwmtx_opts, "driver_list"); driver_list = NULL; - erts_smp_tsd_key_create(&driver_list_lock_status_key); - erts_smp_tsd_key_create(&driver_list_last_error_key); + erts_smp_tsd_key_create(&driver_list_lock_status_key, + "erts_driver_list_lock_status_key"); + erts_smp_tsd_key_create(&driver_list_last_error_key, + "erts_driver_list_last_error_key"); erts_ptab_init_table(&erts_port, ERTS_ALC_T_PORT_TABLE, @@ -2764,7 +2770,9 @@ void erts_init_io(int port_tab_size, erts_smp_rwmtx_rwlock(&erts_driver_list_lock); init_driver(&fd_driver, &fd_driver_entry, NULL); +#ifndef __OSE__ init_driver(&vanilla_driver, &vanilla_driver_entry, NULL); +#endif init_driver(&spawn_driver, &spawn_driver_entry, NULL); erts_init_static_drivers(); for (dp = driver_tab; *dp != NULL; dp++) @@ -3583,9 +3591,9 @@ erts_deliver_port_exit(Port *p, Eterm from, Eterm reason, int send_closed) DTRACE_CHARBUF(port_str, DTRACE_TERM_BUF_SIZE); DTRACE_CHARBUF(rreason_str, 64); - erts_snprintf(from_str, sizeof(from_str), "%T", from); + erts_snprintf(from_str, sizeof(DTRACE_CHARBUF_NAME(from_str)), "%T", from); dtrace_port_str(p, port_str); - erts_snprintf(rreason_str, sizeof(rreason_str), "%T", rreason); + erts_snprintf(rreason_str, sizeof(DTRACE_CHARBUF_NAME(rreason_str)), "%T", rreason); DTRACE4(port_exit, from_str, port_str, p->name, rreason_str); } #endif @@ -4652,7 +4660,7 @@ set_busy_port(ErlDrvPort dprt, int on) #ifdef USE_VM_PROBES if (DTRACE_ENABLED(port_busy)) { - erts_snprintf(port_str, sizeof(port_str), + erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), "%T", prt->common.id); DTRACE1(port_busy, port_str); } @@ -4665,7 +4673,7 @@ set_busy_port(ErlDrvPort dprt, int on) #ifdef USE_VM_PROBES if (DTRACE_ENABLED(port_not_busy)) { - erts_snprintf(port_str, sizeof(port_str), + erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), "%T", prt->common.id); DTRACE1(port_not_busy, port_str); } @@ -4717,9 +4725,9 @@ erts_port_resume_procs(Port *prt) DTRACE_CHARBUF(pid_str, 16); ErtsProcList* plp2 = plp; - erts_snprintf(port_str, sizeof(port_str), "%T", prt->common.id); + erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), "%T", prt->common.id); while (plp2 != NULL) { - erts_snprintf(pid_str, sizeof(pid_str), "%T", plp2->pid); + erts_snprintf(pid_str, sizeof(DTRACE_CHARBUF_NAME(pid_str)), "%T", plp2->pid); DTRACE2(process_port_unblocked, pid_str, port_str); } } @@ -7306,10 +7314,11 @@ init_driver(erts_driver_t *drv, ErlDrvEntry *de, DE_Handle *handle) erts_atom_put((byte *) drv->name, sys_strlen(drv->name), ERTS_ATOM_ENC_LATIN1, - 1) + 1), #else - NIL + NIL, #endif + 1 ); } #endif diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 8406f5344a..68fcc177ae 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -1470,17 +1470,22 @@ apply_last I P # put_map_assoc F n Dst Live Size Rest=* => new_map F Dst Live Size Rest -put_map_exact F n Dst Live Size Rest=* => new_map F Dst Live Size Rest -put_map_assoc F Src Dst Live Size Rest=* => \ +put_map_assoc F Src=s Dst Live Size Rest=* => \ update_map_assoc F Src Dst Live Size Rest -put_map_exact F Src Dst Live Size Rest=* => \ +put_map_assoc F Src Dst Live Size Rest=* => \ + move Src x | update_map_assoc F x Dst Live Size Rest +put_map_exact F n Dst Live Size Rest=* => new_map F Dst Live Size Rest +put_map_exact F Src=s Dst Live Size Rest=* => \ update_map_exact F Src Dst Live Size Rest +put_map_exact F Src Dst Live Size Rest=* => \ + move Src x | update_map_exact F x Dst Live Size Rest new_map j d I I update_map_assoc j s d I I update_map_exact j s d I I -is_map Fail cq => jump Fail +is_map Fail Literal=q => move Literal x | is_map Fail x +is_map Fail c => jump Fail %macro: is_map IsMap -fail_action is_map f r diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 189d9ebac8..05f07e57b2 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -38,6 +38,8 @@ #if defined (__WIN32__) # include "erl_win_sys.h" +#elif defined (__OSE__) +# include "erl_ose_sys.h" #else # include "erl_unix_sys.h" #ifndef UNIX @@ -152,10 +154,14 @@ typedef ERTS_SYS_FD_TYPE ErtsSysFdType; /* In VC++, noreturn is a declspec that has to be before the types, * but in GNUC it is an att ribute to be placed between return type * and function name, hence __decl_noreturn <types> __noreturn <function name> + * + * at some platforms (e.g. Android) __noreturn is defined at sys/cdef.h */ #if __GNUC__ # define __decl_noreturn -# define __noreturn __attribute__((noreturn)) +# ifndef __noreturn +# define __noreturn __attribute__((noreturn)) +# endif #else # if defined(__WIN32__) && defined(_MSC_VER) # define __noreturn diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 7da555b18d..738f793020 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -258,7 +258,7 @@ erl_grow_wstack(ErtsWStack* s, UWord* default_wstack) * Returns -1 if not a proper list (i.e. not terminated with NIL) */ int -list_length(Eterm list) +erts_list_length(Eterm list) { int i = 0; @@ -2125,7 +2125,11 @@ tailrecur_ne: if (!is_boxed(b) || *boxed_val_rel(b,b_base) != *aa) goto not_equal; bb = map_val_rel(b,b_base); - if ((sz = map_get_size((map_t*)aa)) == 0) goto pop_next; + sz = map_get_size((map_t*)aa); + + if (sz != map_get_size((map_t*)bb)) goto not_equal; + if (sz == 0) goto pop_next; + aa += 2; bb += 2; sz += 1; /* increment for tuple-keys */ diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index e040864d24..b62e9a0306 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -99,7 +99,16 @@ #ifdef HAVE_CONFIG_H # include "config.h" #endif + +#ifndef __OSE__ +#include <ctype.h> +#include <sys/types.h> #include <stdlib.h> +#else +#include "ctype.h" +#include "sys/types.h" +#include "stdlib.h" +#endif /* Need (NON)BLOCKING macros for sendfile */ #ifndef WANT_NONBLOCKING @@ -113,8 +122,7 @@ #include "erl_threads.h" #include "gzio.h" #include "dtrace-wrapper.h" -#include <ctype.h> -#include <sys/types.h> + void erl_exit(int n, char *fmt, ...); @@ -765,6 +773,9 @@ file_init(void) : 0); driver_system_info(&sys_info, sizeof(ErlDrvSysInfo)); + /* run initiation of efile_driver if needed */ + efile_init(); + #ifdef USE_VM_PROBES erts_mtx_init(&dt_driver_mutex, "efile_drv dtrace mutex"); pthread_key_create(&dt_driver_key, NULL); @@ -911,6 +922,7 @@ static void reply_Uint_posix_error(file_descriptor *desc, Uint num, driver_output2(desc->port, response, t-response, NULL, 0); } +#ifdef HAVE_SENDFILE static void reply_string_error(file_descriptor *desc, char* str) { char response[256]; /* Response buffer. */ char* s; @@ -921,6 +933,7 @@ static void reply_string_error(file_descriptor *desc, char* str) { *t = tolower(*s); driver_output2(desc->port, response, t-response, NULL, 0); } +#endif static int reply_error(file_descriptor *desc, Efile_error *errInfo) /* The error codes. */ diff --git a/erts/emulator/drivers/common/erl_efile.h b/erts/emulator/drivers/common/erl_efile.h index 95c036db8f..5a8e3bc5db 100644 --- a/erts/emulator/drivers/common/erl_efile.h +++ b/erts/emulator/drivers/common/erl_efile.h @@ -127,7 +127,7 @@ struct t_sendfile_hdtl { /* * Functions. */ - +int efile_init(void); int efile_mkdir(Efile_error* errInfo, char* name); int efile_rmdir(Efile_error* errInfo, char* name); int efile_delete_file(Efile_error* errInfo, char* name); diff --git a/erts/emulator/drivers/common/gzio.c b/erts/emulator/drivers/common/gzio.c index 8ec2c3f762..1ef1602ec9 100644 --- a/erts/emulator/drivers/common/gzio.c +++ b/erts/emulator/drivers/common/gzio.c @@ -20,6 +20,7 @@ #endif #include <ctype.h> #include "erl_driver.h" +#include "erl_efile.h" #include "sys.h" #ifdef __WIN32__ @@ -229,6 +230,7 @@ local ErtsGzFile gz_open (path, mode) errno = 0; #if defined(FILENAMES_16BIT) { + FILE* efile_wfopen(const WCHAR* name, const WCHAR* mode); WCHAR wfmode[80]; int i = 0; int j; @@ -236,7 +238,7 @@ local ErtsGzFile gz_open (path, mode) wfmode[i++] = (WCHAR) fmode[j]; } wfmode[i++] = L'\0'; - s->file = _wfopen((WCHAR *)path, wfmode); + s->file = efile_wfopen((WCHAR *)path, wfmode); if (s->file == NULL) { return s->destroy(s), (ErtsGzFile)Z_NULL; } @@ -597,6 +599,15 @@ erts_gzseek(ErtsGzFile file, int offset, int whence) int pos; gz_stream* s = (gz_stream *) file; + switch (whence) { + case EFILE_SEEK_SET: whence = SEEK_SET; break; + case EFILE_SEEK_CUR: whence = SEEK_CUR; break; + case EFILE_SEEK_END: whence = SEEK_END; break; + default: + errno = EINVAL; + return -1; + } + if (s == NULL) { errno = EINVAL; return -1; diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 4a861b121c..e33594b026 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -93,6 +93,10 @@ typedef unsigned long long llu_t; #define INT16_MAX (32767) #endif +#ifdef __OSE__ +#include "inet.h" +#endif + #ifdef __WIN32__ #define STRNCASECMP strncasecmp @@ -196,6 +200,7 @@ typedef unsigned long long llu_t; #define HAVE_MULTICAST_SUPPORT +#define HAVE_UDP #define ERRNO_BLOCK WSAEWOULDBLOCK @@ -289,7 +294,135 @@ static BOOL (WINAPI *fpSetHandleInformation)(HANDLE,DWORD,DWORD); static unsigned long zero_value = 0; static unsigned long one_value = 1; -#else /* #ifdef __WIN32__ */ +#elif defined (__OSE__) + +/* + * Some notes about how inet (currently only tcp) works on OSE. + * The driver uses OSE signals to communicate with the one_inet + * process. Because of the difference in how signals and file descriptors + * work the whole select/deselect mechanic is very different. + * In ose when a sock_select is done a function is called. That function + * notes the changes that the driver want to do, but does not act on it. + * later when the function returns the new desired state is compared + * to the previous state and the apprioriate actions are taken. The action + * is usually to either request more data from the stack or stop requesting + * data. + * + * One thing to note is that the driver never does select/deselect. It always + * listens for the signals. Flow of data is regulated by sending or not sending + * signals to the ose inet process. + * + * The interesting functions to look at are: + * * inet_driver_select : called when sock_select is called + * * tcp_inet_ose_dispatch_signal : checks state changes and sends new signals + * * tcp_inet_drv_output_ose : ready output callback, reads signals and calls + * dispatch_signal + * * tcp_inet_drv_input_ose : ready input callback. + */ + +#include "efs.h" +#include "sys/socket.h" +#include "sys/uio.h" +#include "sfk/sys/sfk_uio.h" +#include "netinet/in.h" +#include "netinet/tcp.h" +#include "netdb.h" +#include "ose_spi/socket.sig" + + +static ssize_t writev_fallback(int fd, const struct iovec *iov, int iovcnt, int max_sz); + +#define INVALID_SOCKET -1 +#define INVALID_EVENT -1 +#define SOCKET_ERROR -1 + +#define SOCKET int +#define HANDLE int +#define FD_READ ERL_DRV_READ +#define FD_WRITE ERL_DRV_WRITE +#define FD_CLOSE 0 +#define FD_CONNECT (1<<4) +#define FD_ACCEPT (1<<5) +#define SOCK_FD_ERROR (1<<6) + +#define sock_connect(s, addr, len) connect((s), (addr), (len)) +#define sock_listen(s, b) listen((s), (b)) +#define sock_bind(s, addr, len) bind((s), (addr), (len)) +#define sock_getopt(s,t,n,v,l) getsockopt((s),(t),(n),(v),(l)) +#define sock_setopt(s,t,n,v,l) setsockopt((s),(t),(n),(v),(l)) +#define sock_name(s, addr, len) getsockname((s), (addr), (len)) +#define sock_peer(s, addr, len) getpeername((s), (addr), (len)) +#define sock_ntohs(x) ntohs((x)) +#define sock_ntohl(x) ntohl((x)) +#define sock_htons(x) htons((x)) +#define sock_htonl(x) htonl((x)) + +#define sock_accept(s, addr, len) accept((s), (addr), (len)) +#define sock_send(s,buf,len,flag) inet_send((s),(buf),(len),(flag)) +#define sock_sendto(s,buf,blen,flag,addr,alen) \ + sendto((s),(buf),(blen),(flag),(addr),(alen)) +#define sock_sendv(s, vec, size, np, flag) \ + (*(np) = writev_fallback((s), (struct iovec*)(vec), (size), (*(np)))) +#define sock_sendmsg(s,msghdr,flag) sendmsg((s),(msghdr),(flag)) + +#define sock_open(af, type, proto) socket((af), (type), (proto)) +#define sock_close(s) close((s)) +#define sock_dup(s) dup((s)) +#define sock_shutdown(s, how) shutdown((s), (how)) + +#define sock_hostname(buf, len) gethostname((buf), (len)) +#define sock_getservbyname(name,proto) getservbyname((name), (proto)) +#define sock_getservbyport(port,proto) getservbyport((port), (proto)) + +#define sock_recv(s,buf,len,flag) recv((s),(buf),(len),(flag)) +#define sock_recvfrom(s,buf,blen,flag,addr,alen) \ + recvfrom((s),(buf),(blen),(flag),(addr),(alen)) +#define sock_recvmsg(s,msghdr,flag) recvmsg((s),(msghdr),(flag)) + +#define sock_errno() errno +#define sock_create_event(d) ((d)->s) /* return file descriptor */ +#define sock_close_event(e) /* do nothing */ + +#ifndef WANT_NONBLOCKING +#define WANT_NONBLOCKING +#endif +#include "sys.h" + +typedef unsigned long u_long; +#define IN_CLASSA(a) ((((in_addr_t)(a)) & 0x80000000) == 0) +#define IN_CLASSA_NET 0xff000000 +#define IN_CLASSA_NSHIFT 24 +#define IN_CLASSA_HOST (0xffffffff & ~IN_CLASSA_NET) +#define IN_CLASSA_MAX 128 + +#define IN_CLASSB(a) ((((in_addr_t)(a)) & 0xc0000000) == 0x80000000) +#define IN_CLASSB_NET 0xffff0000 +#define IN_CLASSB_NSHIFT 16 +#define IN_CLASSB_HOST (0xffffffff & ~IN_CLASSB_NET) +#define IN_CLASSB_MAX 65536 + +#define IN_CLASSC(a) ((((in_addr_t)(a)) & 0xe0000000) == 0xc0000000) +#define IN_CLASSC_NET 0xffffff00 +#define IN_CLASSC_NSHIFT 8 +#define IN_CLASSC_HOST (0xffffffff & ~IN_CLASSC_NET) + +#define IN_CLASSD(a) ((((in_addr_t)(a)) & 0xf0000000) == 0xe0000000) +#define IN_MULTICAST(a) IN_CLASSD(a) + +#define IN_EXPERIMENTAL(a) ((((in_addr_t)(a)) & 0xe0000000) == 0xe0000000) +#define IN_BADCLASS(a) ((((in_addr_t)(a)) & 0xf0000000) == 0xf0000000) + +#define sock_select(d, flags, onoff) do { \ + ASSERT(!(d)->is_ignored); \ + (d)->event_mask = (onoff) ? \ + ((d)->event_mask | (flags)) : \ + ((d)->event_mask & ~(flags)); \ + DEBUGF(("(%s / %d) sock_select(%ld): flags=%02X, onoff=%d, event_mask=%02lX, s=%d\r\n", \ + __FILE__, __LINE__, (long) (d)->port, (flags), (onoff), (unsigned long) (d)->event_mask, (d)->s)); \ + inet_driver_select((d), (flags), (onoff)); \ + } while(0) + +#else /* !__OSE__ && !__WIN32__ */ #include <sys/time.h> #ifdef NETDB_H_NEEDS_IN_H @@ -330,6 +463,8 @@ static unsigned long one_value = 1; #include <setns.h> #endif +#define HAVE_UDP + /* SCTP support -- currently for UNIX platforms only: */ #undef HAVE_SCTP #if defined(HAVE_SCTP_H) @@ -552,13 +687,13 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n) (d)->event_mask = (onoff) ? \ ((d)->event_mask | (flags)) : \ ((d)->event_mask & ~(flags)); \ - DEBUGF(("sock_select(%ld): flags=%02X, onoff=%d, event_mask=%02lX\r\n", \ - (long) (d)->port, (flags), (onoff), (unsigned long) (d)->event_mask)); \ + DEBUGF(("(%s / %d) sock_select(%ld): flags=%02X, onoff=%d, event_mask=%02lX\r\n", \ + __FILE__, __LINE__, (long) (d)->port, (flags), (onoff), (unsigned long) (d)->event_mask)); \ inet_driver_select((d)->port, (ErlDrvEvent)(long)(d)->event, (flags), (onoff)); \ } while(0) -#endif /* #ifdef __WIN32__ #else */ +#endif /* !__WIN32__ && !__OSE__ */ #ifdef HAVE_SOCKLEN_T # define SOCKLEN_T socklen_t @@ -1011,6 +1146,13 @@ typedef struct { char *netns; /* Socket network namespace name as full file path */ #endif +#ifdef __OSE__ + int select_state; /* state to keep track of whether we + should trigger another read/write + request at end of ready_input/output */ + ErlDrvEvent events[6]; +#endif + } inet_descriptor; @@ -1026,8 +1168,10 @@ static void tcp_inet_stop(ErlDrvData); static void tcp_inet_command(ErlDrvData, char*, ErlDrvSizeT); static void tcp_inet_commandv(ErlDrvData, ErlIOVec*); static void tcp_inet_flush(ErlDrvData drv_data); +#ifndef __OSE__ static void tcp_inet_drv_input(ErlDrvData, ErlDrvEvent); static void tcp_inet_drv_output(ErlDrvData data, ErlDrvEvent event); +#endif static ErlDrvData tcp_inet_start(ErlDrvPort, char* command); static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData, unsigned int, char*, ErlDrvSizeT, char**, ErlDrvSizeT); @@ -1039,7 +1183,72 @@ static void tcp_inet_event(ErlDrvData, ErlDrvEvent); static void find_dynamic_functions(void); #endif -static struct erl_drv_entry tcp_inet_driver_entry = +#ifdef __OSE__ +/* The structure of the signal used for requesting asynchronous + * notification from the stack. Under normal circumstances the network stack + * shouldn't overwrite the value set in the fd field by the sender + * of the request */ +struct OseAsyncSig { + struct FmEvent event; + int fd; +}; + +union SIGNAL { + SIGSELECT signo; + struct OseAsyncSig async; +}; + +static ErlDrvSSizeT tcp_inet_ctl_ose(ErlDrvData e, unsigned int cmd, + char* buf, ErlDrvSizeT len, + char** rbuf, ErlDrvSizeT rsize); +static void tcp_inet_commandv_ose(ErlDrvData e, ErlIOVec* ev); +static void tcp_inet_drv_output_ose(ErlDrvData data, ErlDrvEvent event); +static void tcp_inet_drv_input_ose(ErlDrvData data, ErlDrvEvent event); +static ErlDrvOseEventId inet_resolve_signal(union SIGNAL *sig); + +#ifdef INET_DRV_DEBUG + +static char *read_req = "SO_EVENT_READ_REQUEST"; +static char *read_rep = "SO_EVENT_READ_REPLY"; +static char *write_req = "SO_EVENT_WRITE_REQUEST"; +static char *write_rep = "SO_EVENT_WRITE_REPLY"; +static char *eof_req = "SO_EVENT_EOF_REQUEST"; +static char *eof_rep = "SO_EVENT_EOF_REPLY"; +static char *accept_req = "SO_EVENT_ACCEPT_REQUEST"; +static char *accept_rep = "SO_EVENT_ACCEPT_REPLY"; +static char *connect_req = "SO_EVENT_CONNECT_REQUEST"; +static char *connect_rep = "SO_EVENT_CONNECT_REPLY"; +static char *error_req = "SO_EVENT_ERROR_REQUEST"; +static char *error_rep = "SO_EVENT_ERROR_REPLY"; +static char signo_tmp[32]; + +static char *signo_to_string(SIGSELECT signo) { + switch (signo) { + case SO_EVENT_READ_REQUEST: { return read_req; } + case SO_EVENT_READ_REPLY: { return read_rep; } + case SO_EVENT_WRITE_REQUEST: { return write_req; } + case SO_EVENT_WRITE_REPLY: { return write_rep; } + case SO_EVENT_EOF_REQUEST: { return eof_req; } + case SO_EVENT_EOF_REPLY: { return eof_rep; } + case SO_EVENT_ACCEPT_REQUEST: { return accept_req; } + case SO_EVENT_ACCEPT_REPLY: { return accept_rep; } + case SO_EVENT_CONNECT_REQUEST: { return connect_req; } + case SO_EVENT_CONNECT_REPLY: { return connect_rep; } + case SO_EVENT_ERROR_REQUEST: { return error_req; } + case SO_EVENT_ERROR_REPLY: { return error_rep; } + } + + snprintf(signo_tmp,32,"0x%x",signo); + + return signo_tmp; +} + +#endif + +#endif /* __OSE__ */ + + +static struct erl_drv_entry tcp_inet_driver_entry = { tcp_inet_init, /* inet_init will add this driver !! */ tcp_inet_start, @@ -1048,6 +1257,9 @@ static struct erl_drv_entry tcp_inet_driver_entry = #ifdef __WIN32__ tcp_inet_event, NULL, +#elif defined(__OSE__) + tcp_inet_drv_input_ose, /*ready_input*/ + tcp_inet_drv_output_ose, /*ready_output*/ #else tcp_inet_drv_input, tcp_inet_drv_output, @@ -1055,9 +1267,17 @@ static struct erl_drv_entry tcp_inet_driver_entry = "tcp_inet", NULL, NULL, +#ifdef __OSE__ + tcp_inet_ctl_ose, +#else tcp_inet_ctl, +#endif tcp_inet_timeout, +#ifdef __OSE__ + tcp_inet_commandv_ose, +#else tcp_inet_commandv, +#endif NULL, tcp_inet_flush, NULL, @@ -1073,6 +1293,7 @@ static struct erl_drv_entry tcp_inet_driver_entry = +#ifdef HAVE_UDP static int packet_inet_init(void); static void packet_inet_stop(ErlDrvData); static void packet_inet_command(ErlDrvData, char*, ErlDrvSizeT); @@ -1122,6 +1343,7 @@ static struct erl_drv_entry udp_inet_driver_entry = NULL, inet_stop_select }; +#endif #ifdef HAVE_SCTP static struct erl_drv_entry sctp_inet_driver_entry = @@ -1185,6 +1407,7 @@ static int tcp_deliver(tcp_descriptor* desc, int len); static int tcp_inet_output(tcp_descriptor* desc, HANDLE event); static int tcp_inet_input(tcp_descriptor* desc, HANDLE event); +#ifdef HAVE_UDP typedef struct { inet_descriptor inet; /* common data structure (DON'T MOVE) */ int read_packets; /* Number of packets to read per invocation */ @@ -1196,10 +1419,19 @@ typedef struct { static int packet_inet_input(udp_descriptor* udesc, HANDLE event); static int packet_inet_output(udp_descriptor* udesc, HANDLE event); +#endif /* convert descriptor poiner to inet_descriptor pointer */ #define INETP(d) (&(d)->inet) +#ifdef __OSE__ +static void inet_driver_select(inet_descriptor* desc, + int flags, int onoff); +static void tcp_inet_ose_dispatch_signals(tcp_descriptor *desc, + int prev_select_state, + union SIGNAL *sig); +#endif + static int async_ref = 0; /* async reference id generator */ #define NEW_ASYNC_ID() ((async_ref++) & 0xffff) @@ -1216,7 +1448,6 @@ static int async_ref = 0; /* async reference id generator */ static ErlDrvTermData am_ok; static ErlDrvTermData am_tcp; -static ErlDrvTermData am_udp; static ErlDrvTermData am_error; static ErlDrvTermData am_einval; static ErlDrvTermData am_inet_async; @@ -1226,10 +1457,13 @@ static ErlDrvTermData am_closed; static ErlDrvTermData am_tcp_passive; static ErlDrvTermData am_tcp_closed; static ErlDrvTermData am_tcp_error; -static ErlDrvTermData am_udp_passive; -static ErlDrvTermData am_udp_error; static ErlDrvTermData am_empty_out_q; static ErlDrvTermData am_ssl_tls; +#ifdef HAVE_UDP +static ErlDrvTermData am_udp; +static ErlDrvTermData am_udp_passive; +static ErlDrvTermData am_udp_error; +#endif #ifdef HAVE_SCTP static ErlDrvTermData am_sctp; static ErlDrvTermData am_sctp_passive; @@ -1437,6 +1671,7 @@ static void *realloc_wrapper(void *current, ErlDrvSizeT size){ # define SCTP_ANC_BUFF_SIZE INET_DEF_BUFFER/2 /* XXX: not very good... */ #endif +#ifdef HAVE_UDP static int load_ip_port(ErlDrvTermData* spec, int i, char* buf) { spec[i++] = ERL_DRV_INT; @@ -1471,6 +1706,7 @@ static int load_ip_address(ErlDrvTermData* spec, int i, int family, char* buf) } return i; } +#endif #ifdef HAVE_SCTP @@ -1637,10 +1873,12 @@ static void release_buffer(ErlDrvBinary* buf) } } +#ifdef HAVE_UDP static ErlDrvBinary* realloc_buffer(ErlDrvBinary* buf, ErlDrvSizeT newsz) { return driver_realloc_binary(buf, newsz); } +#endif /* use a TRICK, access the refc field to see if any one else has * a ref to this buffer then call driver_free_binary else @@ -3301,6 +3539,7 @@ static int tcp_error_message(tcp_descriptor* desc, int err) return erl_drv_output_term(desc->inet.dport, spec, i); } +#ifdef HAVE_UDP /* ** active mode message: ** {udp, S, IP, Port, [H1,...Hsz | Data]} or @@ -3391,6 +3630,7 @@ static int packet_binary_message ASSERT(i <= PACKET_ERL_DRV_TERM_DATA_LEN); return erl_drv_output_term(desc->dport, spec, i); } +#endif /* ** active mode message: send active-to-passive transition message @@ -3405,6 +3645,9 @@ static int packet_binary_message DEBUGF(("packet_passive_message(%ld):\r\n", (long)desc->port)); +#if !defined(HAVE_UDP) && !defined(HAVE_SCTP) + i = LOAD_ATOM(spec, i, am_tcp_passive); +#else if (desc->sprotocol == IPPROTO_TCP) i = LOAD_ATOM(spec, i, am_tcp_passive); else { @@ -3414,12 +3657,14 @@ static int packet_binary_message i = LOAD_ATOM(spec, i, am_udp_passive); #endif } +#endif i = LOAD_PORT(spec, i, desc->dport); i = LOAD_TUPLE(spec, i, 2); ASSERT(i <= 6); return erl_drv_output_term(desc->dport, spec, i); } +#ifdef HAVE_UDP /* ** send active message {udp_error|sctp_error, S, Error} */ @@ -3446,7 +3691,7 @@ static int packet_error_message(udp_descriptor* udesc, int err) ASSERT(i == sizeof(spec)/sizeof(*spec)); return erl_drv_output_term(desc->dport, spec, i); } - +#endif /* ** active=TRUE: @@ -3511,7 +3756,7 @@ tcp_reply_binary_data(tcp_descriptor* desc, ErlDrvBinary* bin, int offs, int len return code; } - +#ifdef HAVE_UDP static int packet_reply_binary_data(inet_descriptor* desc, unsigned int hsz, ErlDrvBinary * bin, int offs, int len, @@ -3534,6 +3779,7 @@ packet_reply_binary_data(inet_descriptor* desc, unsigned int hsz, return code; } } +#endif /* ---------------------------------------------------------------------------- @@ -3709,7 +3955,9 @@ static int inet_init() INIT_ATOM(ok); INIT_ATOM(tcp); +#ifdef HAVE_UDP INIT_ATOM(udp); +#endif INIT_ATOM(error); INIT_ATOM(einval); INIT_ATOM(inet_async); @@ -3719,8 +3967,10 @@ static int inet_init() INIT_ATOM(tcp_passive); INIT_ATOM(tcp_closed); INIT_ATOM(tcp_error); +#ifdef HAVE_UDP INIT_ATOM(udp_passive); INIT_ATOM(udp_error); +#endif INIT_ATOM(empty_out_q); INIT_ATOM(ssl_tls); @@ -3739,7 +3989,10 @@ static int inet_init() /* add TCP, UDP and SCTP drivers */ add_driver_entry(&tcp_inet_driver_entry); +#ifdef HAVE_UDP add_driver_entry(&udp_inet_driver_entry); +#endif + #ifdef HAVE_SCTP /* Check the size of SCTP AssocID -- currently both this driver and the Erlang part require 32 bit: */ @@ -4068,6 +4321,16 @@ static void desc_close(inet_descriptor* desc) desc->forced_events = 0; desc->send_would_block = 0; #endif +#ifdef __OSE__ + if (desc->events[0]) { + driver_select(desc->port,desc->events[0],FD_READ|FD_WRITE|ERL_DRV_USE,0); + driver_select(desc->port,desc->events[1],FD_READ|FD_WRITE|ERL_DRV_USE,0); + driver_select(desc->port,desc->events[2],FD_READ|FD_WRITE|ERL_DRV_USE,0); + driver_select(desc->port,desc->events[3],FD_READ|FD_WRITE|ERL_DRV_USE,0); + driver_select(desc->port,desc->events[4],FD_READ|FD_WRITE|ERL_DRV_USE,0); + driver_select(desc->port,desc->events[5],FD_READ|FD_WRITE|ERL_DRV_USE,0); + } +#else /* * We should close the fd here, but the other driver might still * be selecting on it. @@ -4077,6 +4340,7 @@ static void desc_close(inet_descriptor* desc) ERL_DRV_USE, 0); else inet_stop_select((ErlDrvEvent)(long)desc->event,NULL); +#endif desc->event = INVALID_EVENT; /* closed by stop_select callback */ desc->s = INVALID_SOCKET; desc->event_mask = 0; @@ -4118,6 +4382,64 @@ static int erl_inet_close(inet_descriptor* desc) return 0; } +#ifdef __OSE__ +static void inet_select_init(inet_descriptor* desc) +{ + desc->events[0] = + erl_drv_ose_event_alloc(SO_EVENT_READ_REPLY, + desc->s, + inet_resolve_signal, + NULL); + driver_select(desc->port, desc->events[0], + ERL_DRV_READ|ERL_DRV_USE, 1); + + desc->events[1] = + erl_drv_ose_event_alloc(SO_EVENT_EOF_REPLY, + desc->s, + inet_resolve_signal, + NULL); + driver_select(desc->port, desc->events[1], + ERL_DRV_READ|ERL_DRV_USE, 1); + + desc->events[2] = + erl_drv_ose_event_alloc(SO_EVENT_ACCEPT_REPLY, + desc->s, + inet_resolve_signal, + NULL); + driver_select(desc->port, desc->events[2], + ERL_DRV_READ|ERL_DRV_USE, 1); + + /* trigger tcp_inet_input */ + desc->events[3] = + erl_drv_ose_event_alloc(SO_EVENT_WRITE_REPLY, + desc->s, + inet_resolve_signal, + NULL); + driver_select(desc->port, desc->events[3], + ERL_DRV_WRITE|ERL_DRV_USE, 1); + + desc->events[4] = + erl_drv_ose_event_alloc(SO_EVENT_CONNECT_REPLY, + desc->s, + inet_resolve_signal, + NULL); + driver_select(desc->port, desc->events[4], + ERL_DRV_WRITE|ERL_DRV_USE, 1); + + desc->events[5] = + erl_drv_ose_event_alloc(SO_EVENT_ERROR_REPLY, + desc->s, + inet_resolve_signal, + NULL); + driver_select(desc->port, desc->events[5], + ERL_DRV_WRITE|ERL_DRV_USE, 1); + + /* Issue a select on error event before any other select to be sure we are + prepared to receive error notifications from the stack, even in the + situations when select isn't issued */ + sock_select(desc, SOCK_FD_ERROR, 1); +} +#endif static ErlDrvSSizeT inet_ctl_open(inet_descriptor* desc, int domain, int type, char** rbuf, ErlDrvSizeT rsize) @@ -4201,6 +4523,10 @@ static ErlDrvSSizeT inet_ctl_open(inet_descriptor* desc, int domain, int type, #ifdef __WIN32__ driver_select(desc->port, desc->event, ERL_DRV_READ, 1); #endif +#ifdef __OSE__ + inet_select_init(desc); +#endif + desc->state = INET_STATE_OPEN; desc->stype = type; desc->sfamily = domain; @@ -4220,7 +4546,14 @@ static ErlDrvSSizeT inet_ctl_fdopen(inet_descriptor* desc, int domain, int type, return ctl_error(sock_errno(), rbuf, rsize); if (name.sa.sa_family != domain) return ctl_error(EINVAL, rbuf, rsize); +#ifdef __OSE__ + /* for fdopen duplicating the sd will allow to uniquely identify + the signal from OSE with erlang port */ + desc->s = sock_dup(s); +#else desc->s = s; +#endif + if ((desc->event = sock_create_event(desc)) == INVALID_EVENT) return ctl_error(sock_errno(), rbuf, rsize); SET_NONBLOCKING(desc->s); @@ -4230,8 +4563,15 @@ static ErlDrvSSizeT inet_ctl_fdopen(inet_descriptor* desc, int domain, int type, desc->state = INET_STATE_BOUND; /* assume bound */ if (type == SOCK_STREAM) { /* check if connected */ sz = sizeof(name); - if (!IS_SOCKET_ERROR(sock_peer(s, (struct sockaddr*) &name, &sz))) + if (!IS_SOCKET_ERROR(sock_peer(s, (struct sockaddr*) &name, &sz))) { desc->state = INET_STATE_CONNECTED; +#ifdef __OSE__ + /* since we are dealing with different descriptors (i.e. inet and + socket) the select part should be initialized with the right + values */ + inet_select_init(desc); +#endif + } } desc->prebound = 1; /* used to prevent a real close since @@ -4257,8 +4597,7 @@ struct addr_if { #ifndef SIOCGIFNETMASK -static struct in_addr net_mask(in) -struct in_addr in; +static struct in_addr net_mask(struct in_addr in) { register u_long i = sock_ntohl(in.s_addr); @@ -5821,6 +6160,7 @@ static int inet_set_opts(inet_descriptor* desc, char* ptr, int len) } continue; +#ifdef HAVE_UDP case INET_LOPT_UDP_READ_PACKETS: if (desc->stype == SOCK_DGRAM) { udp_descriptor* udesc = (udp_descriptor*) desc; @@ -5828,6 +6168,7 @@ static int inet_set_opts(inet_descriptor* desc, char* ptr, int len) udesc->read_packets = ival; } continue; +#endif #ifdef HAVE_SETNS case INET_LOPT_NETNS: @@ -6794,6 +7135,7 @@ static ErlDrvSSizeT inet_fill_opts(inet_descriptor* desc, } continue; +#ifdef HAVE_UDP case INET_LOPT_UDP_READ_PACKETS: if (desc->stype == SOCK_DGRAM) { *ptr++ = opt; @@ -6803,6 +7145,7 @@ static ErlDrvSSizeT inet_fill_opts(inet_descriptor* desc, TRUNCATE_TO(0,ptr); } continue; +#endif #ifdef HAVE_SETNS case INET_LOPT_NETNS: @@ -7933,6 +8276,15 @@ static ErlDrvData inet_start(ErlDrvPort port, int size, int protocol) #ifdef HAVE_SETNS desc->netns = NULL; #endif +#ifdef __OSE__ + desc->select_state = 0; + desc->events[0] = NULL; + desc->events[1] = NULL; + desc->events[2] = NULL; + desc->events[3] = NULL; + desc->events[4] = NULL; + desc->events[5] = NULL; +#endif return (ErlDrvData)desc; } @@ -8653,6 +9005,11 @@ static tcp_descriptor* tcp_inet_copy(tcp_descriptor* desc,SOCKET s, copy_desc->inet.port = port; copy_desc->inet.dport = driver_mk_port(port); + +#ifdef __OSE__ + inet_select_init(©_desc->inet); +#endif + *err = 0; return copy_desc; } @@ -8714,8 +9071,22 @@ static void tcp_inet_stop(ErlDrvData e) inet_stop(INETP(desc)); } +#ifdef __OSE__ - +static ErlDrvSSizeT tcp_inet_ctl_ose(ErlDrvData e, unsigned int cmd, + char* buf, ErlDrvSizeT len, + char** rbuf, ErlDrvSizeT rsize) { + + tcp_descriptor* desc = (tcp_descriptor*)e; + int prev_select_state = INETP(desc)->select_state; + + ErlDrvSSizeT res = tcp_inet_ctl(e,cmd,buf,len,rbuf,rsize); + + tcp_inet_ose_dispatch_signals((tcp_descriptor*)e,prev_select_state,NULL); + + return res; +} +#endif /* TCP requests from Erlang */ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd, @@ -8931,7 +9302,7 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd, ErlDrvTermData caller = driver_caller(desc->inet.port); tcp_descriptor* accept_desc; int err; - + if ((accept_desc = tcp_inet_copy(desc,s,caller,&err)) == NULL) { sock_close(s); return ctl_error(err, rbuf, rsize); @@ -8965,7 +9336,8 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd, char tbuf[2]; int n; - DEBUGF(("tcp_inet_ctl(%ld): RECV\r\n", (long)desc->inet.port)); + DEBUGF(("tcp_inet_ctl(%ld): RECV (s=%d)\r\n", + (long)desc->inet.port, desc->inet.s)); /* INPUT: Timeout(4), Length(4) */ if (!IS_CONNECTED(INETP(desc))) { if (desc->tcp_add_flags & TCP_ADDF_DELAYED_CLOSE_RECV) { @@ -9137,6 +9509,16 @@ static void tcp_inet_command(ErlDrvData e, char *buf, ErlDrvSizeT len) DEBUGF(("tcp_inet_command(%ld) }\r\n", (long)desc->inet.port)); } +#ifdef __OSE__ + +static void tcp_inet_commandv_ose(ErlDrvData e, ErlIOVec* ev) { + int prev_select_state = INETP((tcp_descriptor*)e)->select_state; + tcp_inet_commandv(e, ev); + tcp_inet_ose_dispatch_signals((tcp_descriptor*)e,prev_select_state,NULL); +} + +#endif + static void tcp_inet_commandv(ErlDrvData e, ErlIOVec* ev) { @@ -9200,6 +9582,22 @@ static void inet_stop_select(ErlDrvEvent event, void* _) { #ifdef __WIN32__ WSACloseEvent((HANDLE)event); +#elif defined(__OSE__) + ErlDrvOseEventId id; + union SIGNAL *sig; + erl_drv_ose_event_fetch(event, NULL, &id,NULL); + DEBUGF(("inet_stop_select(?#?) {s=%d\n",id)); + sock_close((int)id); + /* On socket close all the signals waiting to be processed as part of the + select should be deallocated */ + while((sig = erl_drv_ose_get_signal(event))) { + DEBUGF(("inet_stop_select(?#?): Freeing signal %s\n", + signo_to_string(sig->signo))); + free_buf(&sig); + } + erl_drv_ose_event_free(event); + DEBUGF(("inet_stop_select(?#?) }\n")); + #else sock_close((SOCKET)(long)event); #endif @@ -9319,12 +9717,13 @@ static int tcp_remain(tcp_descriptor* desc, int* len) int n = desc->i_ptr - ptr; /* number of bytes read */ int tlen; - DEBUGF(("tcp_remain(%ld): s=%d, n=%d, nfill=%d nsz=%d\r\n", - (long)desc->inet.port, desc->inet.s, n, nfill, nsz)); + DEBUGF(("tcp_remain(%ld): s=%d, n=%d, nfill=%d nsz=%d, tlen %d\r\n", + (long)desc->inet.port, desc->inet.s, n, nfill, nsz, tlen)); tlen = packet_get_length(desc->inet.htype, ptr, n, desc->inet.psize, desc->i_bufsz, &desc->http_state); + if (tlen > 0) { if (tlen <= n) { /* got a packet */ *len = tlen; @@ -9732,7 +10131,146 @@ static void tcp_inet_event(ErlDrvData e, ErlDrvEvent event) return; } -#endif /* WIN32 */ +#elif defined(__OSE__) /* !__WIN32__ */ +/* The specific resolve signal function. It will return the socket descriptor + for which the select was issued */ +static ErlDrvOseEventId inet_resolve_signal(union SIGNAL *sig) { + DEBUGF(("%s(?#?): s=%d got signal %s, status = %d, extra = %d, sender = 0x%x\n", + __FUNCTION__,sig->async.fd,signo_to_string(sig->signo), + sig->async.event.status, + sig->async.event.extra,sender(&sig))); + if (sig->signo == SO_EVENT_READ_REPLY || + sig->signo == SO_EVENT_ACCEPT_REPLY || + sig->signo == SO_EVENT_EOF_REPLY || + sig->signo == SO_EVENT_WRITE_REPLY || + sig->signo == SO_EVENT_ERROR_REPLY || + sig->signo == SO_EVENT_CONNECT_REPLY ) { + return sig->async.fd; + } + + return -1; +} + +static void inet_driver_select(inet_descriptor* desc, + int flags, int onoff) { + ASSERT(!desc->is_ignored); + + if(onoff) { + desc->select_state |= flags; + } else { + desc->select_state &= ~flags; + } +} + +static ssize_t writev_fallback(int fd, const struct iovec *iov, int iovcnt, int max_sz) +{ + size_t data_len = 0; + size_t sent = 0; + ssize_t n; + int i; + + for(i = 0; i < iovcnt; i++) + { + data_len = iov[i].iov_len; +tryagain: + n = sock_send(fd, iov[i].iov_base, data_len, 0); + if (IS_SOCKET_ERROR(n)) { + /* If buffer length is greater than the amount stack is able to + * send out then try to send at least max_sz (this comes with + * SO_EVENT_WRITE_REPLY signal*/ + if ((errno == EMSGSIZE) && (max_sz > 0) && (data_len > max_sz)) { + data_len = max_sz; + goto tryagain; + } + break; + } + sent += n; + } + return sent; +} + +#define OSE_EVENT_REQ(TCP_DESC,EVENT) do { \ + union SIGNAL *sig = alloc(sizeof(struct OseAsyncSig), EVENT); \ + sig->async.fd = INETP(TCP_DESC)->s; \ + ose_request_event(INETP(TCP_DESC)->s, &sig, 1); \ + DEBUGF(("%s(%ld): s=%d sent %s\r\n",__FUNCTION__, \ + INETP(TCP_DESC)->port,INETP(TCP_DESC)->s,signo_to_string(EVENT))); \ + } while(0) + +static void tcp_inet_ose_dispatch_signals(tcp_descriptor *desc, + int prev_select_state, + union SIGNAL *sig) { + if (sig) { + DEBUGF(("tcp_inet_ose_dispatch_signals(%ld) {s=%d resend\r\n", + (long)INETP(desc)->port,INETP(desc)->s)); + /* We are reacting to a signal, which means that if + the select_state for that signal is still activated + we should send a new signal */ + switch (sig->signo) { + case SO_EVENT_READ_REPLY: { + if (INETP(desc)->select_state & FD_READ) + OSE_EVENT_REQ(desc,SO_EVENT_READ_REQUEST); + break; + } + case SO_EVENT_WRITE_REPLY: { + if (INETP(desc)->select_state & FD_WRITE) + OSE_EVENT_REQ(desc,SO_EVENT_WRITE_REQUEST); + break; + } + case SO_EVENT_CONNECT_REPLY: { + if (INETP(desc)->select_state & FD_CONNECT) + OSE_EVENT_REQ(desc,SO_EVENT_CONNECT_REQUEST); + break; + } + case SO_EVENT_ACCEPT_REPLY: { + if (INETP(desc)->select_state & FD_ACCEPT) + OSE_EVENT_REQ(desc,SO_EVENT_ACCEPT_REQUEST); + break; + } + case SO_EVENT_ERROR_REPLY: { + if (INETP(desc)->select_state & SOCK_FD_ERROR) + OSE_EVENT_REQ(desc,SO_EVENT_ERROR_REQUEST); + break; + } + + } + DEBUGF(("tcp_inet_ose_dispatch_signals(%ld) }\r\n", + (long)INETP(desc)->port)); + } + + if (INETP(desc)->select_state != prev_select_state) { + /* If the select state has changed we have to issue signals for + the state parts that have changed. */ + int xor_select_state = INETP(desc)->select_state ^ prev_select_state; + DEBUGF(("tcp_inet_ose_dispatch_signals(%ld) {s=%d select change\r\n", + (long)INETP(desc)->port,INETP(desc)->s)); + if ((xor_select_state & FD_READ) && + (INETP(desc)->select_state & FD_READ)) { + OSE_EVENT_REQ(desc,SO_EVENT_READ_REQUEST); + } + if ((xor_select_state & FD_WRITE) && + (INETP(desc)->select_state & FD_WRITE)) { + OSE_EVENT_REQ(desc,SO_EVENT_WRITE_REQUEST); + } + if ((xor_select_state & FD_CONNECT) && + (INETP(desc)->select_state & FD_CONNECT)) { + OSE_EVENT_REQ(desc,SO_EVENT_CONNECT_REQUEST); + } + if ((xor_select_state & FD_ACCEPT) && + (INETP(desc)->select_state & FD_ACCEPT)) { + OSE_EVENT_REQ(desc,SO_EVENT_ACCEPT_REQUEST); + } + if ((xor_select_state & SOCK_FD_ERROR) && + (INETP(desc)->select_state & SOCK_FD_ERROR)) { + OSE_EVENT_REQ(desc,SO_EVENT_ERROR_REQUEST); + } + + DEBUGF(("tcp_inet_ose_dispatch_signals(%ld) }\r\n", + (long)INETP(desc)->port)); + } +} + +#endif /* __OSE__ */ /* socket has input: @@ -9753,7 +10291,7 @@ static int tcp_inet_input(tcp_descriptor* desc, HANDLE event) unsigned int len; inet_address remote; inet_async_op *this_op = desc->inet.opt; - + len = sizeof(desc->inet.remote); s = sock_accept(desc->inet.s, (struct sockaddr*) &remote, &len); if (s == INVALID_SOCKET && sock_errno() == ERRNO_BLOCK) { @@ -9822,7 +10360,6 @@ static int tcp_inet_input(tcp_descriptor* desc, HANDLE event) while (desc->inet.state == INET_STATE_MULTI_ACCEPTING) { len = sizeof(desc->inet.remote); s = sock_accept(desc->inet.s, (struct sockaddr*) &remote, &len); - if (s == INVALID_SOCKET && sock_errno() == ERRNO_BLOCK) { /* Just try again, no real error, keep the last return code */ goto done; @@ -10148,6 +10685,49 @@ static int tcp_send(tcp_descriptor* desc, char* ptr, ErlDrvSizeT len) return 0; } +#ifdef __OSE__ + +static void tcp_inet_drv_output_ose(ErlDrvData data, ErlDrvEvent event) +{ + union SIGNAL *event_sig = erl_drv_ose_get_signal(event); + + while (event_sig) { + int prev_select_state = INETP((tcp_descriptor*)data)->select_state; + int res = tcp_inet_output((tcp_descriptor*)data, (HANDLE)event_sig); + if (res != -1) { + tcp_inet_ose_dispatch_signals((tcp_descriptor*)data, + prev_select_state,event_sig); + free_buf(&event_sig); + event_sig = erl_drv_ose_get_signal(event); + } else { + /* NOTE: here the event object could have been deallocated!!!! + inet_stop_select is called when doing driver_select(ERL_DRV_USE,0) + */ + free_buf(&event_sig); + return; + } + } +} + +static void tcp_inet_drv_input_ose(ErlDrvData data, ErlDrvEvent event) +{ + union SIGNAL *event_sig = erl_drv_ose_get_signal(event); + + while (event_sig) { + int prev_select_state = INETP((tcp_descriptor*)data)->select_state; + int res = tcp_inet_input((tcp_descriptor*)data, (HANDLE)event); + if (res != -1) { + tcp_inet_ose_dispatch_signals((tcp_descriptor*)data, prev_select_state, + event_sig); + free_buf(&event_sig); + event_sig = erl_drv_ose_get_signal(event); + } else { + free_buf(&event_sig); + return; + } + } +} +#else static void tcp_inet_drv_output(ErlDrvData data, ErlDrvEvent event) { (void)tcp_inet_output((tcp_descriptor*)data, (HANDLE)event); @@ -10157,6 +10737,7 @@ static void tcp_inet_drv_input(ErlDrvData data, ErlDrvEvent event) { (void)tcp_inet_input((tcp_descriptor*)data, (HANDLE)event); } +#endif /* socket ready for ouput: ** 1. INET_STATE_CONNECTING => non block connect ? @@ -10222,6 +10803,13 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event) ssize_t n; SysIOVec* iov; +#ifdef __OSE__ + /* For large size buffers case the amount of data that the stack is + able to send out (received in the .extra field) should be passed + down to writev_fallback */ + n = event ? ((union SIGNAL*)event)->async.event.extra : 0; +#endif + if ((iov = driver_peekq(ix, &vsize)) == NULL) { sock_select(INETP(desc), FD_WRITE, 0); send_empty_out_q_msgs(INETP(desc)); @@ -10233,8 +10821,8 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event) if (IS_SOCKET_ERROR(sock_sendv(desc->inet.s, iov, vsize, &n, 0))) { write_error: if ((sock_errno() != ERRNO_BLOCK) && (sock_errno() != EINTR)) { - DEBUGF(("tcp_inet_output(%ld): sock_sendv(%d) errno = %d\r\n", - (long)desc->inet.port, vsize, sock_errno())); + DEBUGF(("tcp_inet_output(%ld): sock_sendv(%d) errno = %d (errno %d)\r\n", + (long)desc->inet.port, vsize, sock_errno(), errno)); ret = tcp_send_error(desc, sock_errno()); goto done; } @@ -10247,6 +10835,12 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event) sizes > (max 32 bit signed int) */ size_t howmuch = 0x7FFFFFFF; /* max signed 32 bit */ int x; +#ifdef __OSE__ + /* For EWOULDBLOCK sock_sendv returns 0 so we have to be sure it + wasn't the case */ + if(sock_errno() == ERRNO_BLOCK) + goto done; +#endif for(x = 0; x < vsize && iov[x].iov_len == 0; ++x) ; if (x < vsize) { @@ -10391,6 +10985,7 @@ static udp_descriptor* sctp_inet_copy(udp_descriptor* desc, SOCKET s, int* err) +#ifdef HAVE_UDP static int packet_inet_init() { return 0; @@ -10421,6 +11016,7 @@ static ErlDrvData udp_inet_start(ErlDrvPort port, char *args) set_default_msgq_limits(port); return data; } +#endif #ifdef HAVE_SCTP static ErlDrvData sctp_inet_start(ErlDrvPort port, char *args) @@ -10431,6 +11027,7 @@ static ErlDrvData sctp_inet_start(ErlDrvPort port, char *args) } #endif +#ifdef HAVE_UDP static void packet_inet_stop(ErlDrvData e) { /* There should *never* be any "empty out q" subscribers on @@ -10941,7 +11538,7 @@ static void packet_inet_command(ErlDrvData e, char* buf, ErlDrvSizeT len) else inet_reply_ok(desc); } - +#endif #ifdef __WIN32__ static void packet_inet_event(ErlDrvData e, ErlDrvEvent event) @@ -10963,6 +11560,7 @@ static void packet_inet_event(ErlDrvData e, ErlDrvEvent event) #endif +#ifdef HAVE_UDP static void packet_inet_drv_input(ErlDrvData e, ErlDrvEvent event) { (void) packet_inet_input((udp_descriptor*)e, (HANDLE)event); @@ -11219,6 +11817,7 @@ static int packet_inet_output(udp_descriptor* udesc, HANDLE event) DEBUGF(("packet_inet_output(%ld) }\r\n", (long)desc->port)); return ret; } +#endif /*---------------------------------------------------------------------------*/ diff --git a/erts/emulator/drivers/common/zlib_drv.c b/erts/emulator/drivers/common/zlib_drv.c index 3fe5d282dc..3143e4511d 100644 --- a/erts/emulator/drivers/common/zlib_drv.c +++ b/erts/emulator/drivers/common/zlib_drv.c @@ -21,6 +21,9 @@ * ZLib interface for erlang * */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif #include <stdio.h> #include <zlib.h> #include <errno.h> diff --git a/erts/emulator/drivers/ose/ose_efile.c b/erts/emulator/drivers/ose/ose_efile.c new file mode 100644 index 0000000000..035ff81a9b --- /dev/null +++ b/erts/emulator/drivers/ose/ose_efile.c @@ -0,0 +1,1124 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2012. 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% + */ +/* + * Purpose: Provides file and directory operations for OSE. + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#if defined(HAVE_POSIX_FALLOCATE) && !defined(__sun) && !defined(__sun__) +#define _XOPEN_SOURCE 600 +#endif +#if !defined(_GNU_SOURCE) && defined(HAVE_LINUX_FALLOC_H) +#define _GNU_SOURCE +#endif +#include "sys.h" +#include "erl_driver.h" +#include "erl_efile.h" +#if defined(DARWIN) || defined(HAVE_LINUX_FALLOC_H) || defined(HAVE_POSIX_FALLOCATE) +#include "fcntl.h" +#endif +#include "ose.h" +#include "unistd.h" +#include "sys/stat.h" +#include "dirent.h" +#include "sys/time.h" +#include "time.h" +#include "assert.h" + +/* Find a definition of MAXIOV, that is used in the code later. */ +#if defined IOV_MAX +#define MAXIOV IOV_MAX +#elif defined UIO_MAXIOV +#define MAXIOV UIO_MAXIOV +#else +#define MAXIOV 16 +#endif + +/* + * Macros for testing file types. + */ + +#define ISDIR(st) (((st).st_mode & S_IFMT) == S_IFDIR) +#define ISREG(st) (((st).st_mode & S_IFMT) == S_IFREG) +#define ISDEV(st) \ + (((st).st_mode&S_IFMT) == S_IFCHR || ((st).st_mode&S_IFMT) == S_IFBLK) +#define ISLNK(st) (((st).st_mode & S_IFLNK) == S_IFLNK) +#ifdef NO_UMASK +#define FILE_MODE 0644 +#define DIR_MODE 0755 +#else +#define FILE_MODE 0666 +#define DIR_MODE 0777 +#endif + +#define IS_DOT_OR_DOTDOT(s) \ + (s[0] == '.' && (s[1] == '\0' || (s[1] == '.' && s[2] == '\0'))) + +/* + * Macros for handling local file descriptors + * and mutexes. + * + * Handling of files like this is necessary because OSE + * does not allow seeking after the end of a file. So + * what we do it emulate this by keeping track of the size + * of the file and where the file's positions is. If a + * write happens after eof then we pad it. + * + * Given time this should be rewritten to get rid of the + * mutex and use the port lock to protect the data. This + * could be done be done by adapting the efile api for some + * calls to allow some meta-data to be associated with the + * open file. + */ + +#define L_FD_IS_VALID(fd_data) ((fd_data)->beyond_eof > 0) +#define L_FD_INVALIDATE(fd_data) (fd_data)->beyond_eof = 0 +#define L_FD_CUR(fd_data) (fd_data)->pos +#define L_FD_OFFS_BEYOND_EOF(fd_data, offs) \ + (((fd_data)->size > offs) ? 0 : 1) + +#define L_FD_FAIL -1 +#define L_FD_SUCCESS 1 +#define L_FD_PAD_SIZE 255 + +struct fd_meta { + ErlDrvMutex *meta_mtx; + struct fd_data *fd_data_list; +}; + +struct fd_data { + int fd; + struct fd_data *next; + struct fd_data *prev; + int pos; + int beyond_eof; + size_t size; +#ifdef DEBUG + PROCESS owner; +#endif +}; + +static int l_invalidate_local_fd(int fd); +static int l_pad_file(struct fd_data *fd_data, off_t offset); +static int check_error(int result, Efile_error* errInfo); +static struct fd_data* l_new_fd(void); +static int l_remove_local_fd(int fd); +static struct fd_data* l_find_local_fd(int fd); +static int l_update_local_fd(int fd, int pos, int size); + +static struct fd_meta* fdm = NULL; + + +/***************************************************************************/ + +static int +l_remove_local_fd(int fd) +{ + struct fd_data *fd_data; + fd_data = l_find_local_fd(fd); + + if (fd_data == NULL) { + return L_FD_FAIL; + } +#ifdef DEBUG + assert(fd_data->owner == current_process()); +#endif + erl_drv_mutex_lock(fdm->meta_mtx); + /* head ? */ + if (fd_data == fdm->fd_data_list) { + if (fd_data->next != NULL) { + /* remove link to head */ + fd_data->next->prev = NULL; + /* set new head */ + fdm->fd_data_list = fd_data->next; + } + else { + /* head is lonely */ + fdm->fd_data_list = NULL; + } + } + else { /* not head */ + if (fd_data->prev == NULL) { + erl_drv_mutex_unlock(fdm->meta_mtx); + return L_FD_FAIL; + } + else { + if (fd_data->next != NULL) { + fd_data->next->prev = fd_data->prev; + fd_data->prev->next = fd_data->next; + } + else { + fd_data->prev->next = NULL; + } + } + } + + /* scramble values */ + fd_data->beyond_eof = -1; + fd_data->next = NULL; + fd_data->prev = NULL; + fd_data->fd = -1; + + /* unlock and clean */ + driver_free(fd_data); + erl_drv_mutex_unlock(fdm->meta_mtx); + + return L_FD_SUCCESS; +} + +/***************************************************************************/ + +static int +l_invalidate_local_fd(int fd) { + struct fd_data *fd_data; + + if ((fd_data = l_find_local_fd(fd)) == NULL) { + return L_FD_FAIL; + } + + fd_data->beyond_eof = 0; + return L_FD_SUCCESS; +} + +/****************************************************************************/ + +static struct fd_data* +l_find_local_fd(int fd) { + struct fd_data *fd_data; + + fd_data = NULL; + erl_drv_mutex_lock(fdm->meta_mtx); + for (fd_data = fdm->fd_data_list; fd_data != NULL; ) { + if (fd_data->fd == fd) { +#ifdef DEBUG + assert(fd_data->owner == current_process()); +#endif + break; + } + fd_data = fd_data->next; + } + erl_drv_mutex_unlock(fdm->meta_mtx); + return fd_data; +} + +/***************************************************************************/ + +static struct fd_data* +l_new_fd(void) { + struct fd_data *fd_data; + + fd_data = driver_alloc(sizeof(struct fd_data)); + if (fd_data == NULL) { + return NULL; + } + erl_drv_mutex_lock(fdm->meta_mtx); + if (fdm->fd_data_list == NULL) { + fdm->fd_data_list = fd_data; + fdm->fd_data_list->prev = NULL; + fdm->fd_data_list->next = NULL; + } + else { + fd_data->next = fdm->fd_data_list; + fdm->fd_data_list = fd_data; + fdm->fd_data_list->prev = NULL; + } +#ifdef DEBUG + fd_data->owner = current_process(); +#endif + erl_drv_mutex_unlock(fdm->meta_mtx); + return fd_data; +} + +/***************************************************************************/ + +static int +l_update_local_fd(int fd, int pos, int size) { + struct fd_data *fd_data = NULL; + + fd_data = l_find_local_fd(fd); + /* new fd to handle? */ + if (fd_data == NULL) { + fd_data = l_new_fd(); + if (fd_data == NULL) { + /* out of memory */ + return L_FD_FAIL; + } + } + fd_data->size = size; + fd_data->pos = pos; + fd_data->fd = fd; + fd_data->beyond_eof = 1; + + return L_FD_SUCCESS; +} + +/***************************************************************************/ + +static int +l_pad_file(struct fd_data *fd_data, off_t offset) { + int size_dif; + int written = 0; + int ret_val = L_FD_SUCCESS; + char padding[L_FD_PAD_SIZE]; + + size_dif = (offset - fd_data->size); + memset(&padding, '\0', L_FD_PAD_SIZE); + + while (size_dif > 0) { + written = write(fd_data->fd, padding, + (size_dif < L_FD_PAD_SIZE) ? + size_dif : L_FD_PAD_SIZE); + if (written < 0 && errno != EINTR && errno != EAGAIN) { + ret_val = -1; + break; + } + size_dif -= written; + } + L_FD_INVALIDATE(fd_data); + return ret_val; +} + +/***************************************************************************/ + +static int +check_error(int result, Efile_error *errInfo) { + if (result < 0) { + errInfo->posix_errno = errInfo->os_errno = errno; + return 0; + } + return 1; +} + +/***************************************************************************/ + +int +efile_init() { + fdm = driver_alloc(sizeof(struct fd_meta)); + if (fdm == NULL) { + return L_FD_FAIL; + } + fdm->meta_mtx = erl_drv_mutex_create("ose_efile local fd mutex\n"); + erl_drv_mutex_lock(fdm->meta_mtx); + fdm->fd_data_list = NULL; + erl_drv_mutex_unlock(fdm->meta_mtx); + return L_FD_SUCCESS; +} + +/***************************************************************************/ + +int +efile_mkdir(Efile_error* errInfo, /* Where to return error codes. */ + char* name) /* Name of directory to create. */ +{ +#ifdef NO_MKDIR_MODE + return check_error(mkdir(name), errInfo); +#else + int res = mkdir(name, DIR_MODE); + if (res < 0 && errno == EINVAL) { + errno = ENOENT; + } + return check_error(res, errInfo); +#endif +} + +/***************************************************************************/ + +int +efile_rmdir(Efile_error* errInfo, /* Where to return error codes. */ + char* name) /* Name of directory to delete. */ +{ + if (rmdir(name) == 0) { + return 1; + } + if (errno == ENOTEMPTY) { + errno = EEXIST; + } + if (errno == EEXIST || errno == EINVAL) { + int saved_errno = errno; + struct stat file_stat; + struct stat cwd_stat; + + if(stat(name, &file_stat) != 0) { + errno = ENOENT; + return check_error(-1, errInfo); + } + /* + * The error code might be wrong if this is the current directory. + */ + if (stat(name, &file_stat) == 0 && stat(".", &cwd_stat) == 0 && + file_stat.st_ino == cwd_stat.st_ino && + file_stat.st_dev == cwd_stat.st_dev) { + saved_errno = EACCES; + } + errno = saved_errno; + } + return check_error(-1, errInfo); +} + +/***************************************************************************/ + +int +efile_delete_file(Efile_error* errInfo, /* Where to return error codes. */ + char* name) /* Name of file to delete. */ +{ + struct stat statbuf; + + if (stat(name, &statbuf) >= 0) { + /* Do not let unlink() remove directories */ + if (ISDIR(statbuf)) { + errno = EPERM; + return check_error(-1, errInfo); + } + + if (unlink(name) == 0) { + return 1; + } + + if (errno == EISDIR) { + errno = EPERM; + return check_error(-1, errInfo); + } + } + else { + if (errno == EINVAL) { + errno = ENOENT; + return check_error(-1, errInfo); + } + } + return check_error(-1, errInfo); +} + +/* + *--------------------------------------------------------------------------- + * + * Changes the name of an existing file or directory, from src to dst. + * If src and dst refer to the same file or directory, does nothing + * and returns success. Otherwise if dst already exists, it will be + * deleted and replaced by src subject to the following conditions: + * If src is a directory, dst may be an empty directory. + * If src is a file, dst may be a file. + * In any other situation where dst already exists, the rename will + * fail. + * + * Results: + * If the directory was successfully created, returns 1. + * Otherwise the return value is 0 and errno is set to + * indicate the error. Some possible values for errno are: + * + * EACCES: src or dst parent directory can't be read and/or written. + * EEXIST: dst is a non-empty directory. + * EINVAL: src is a root directory or dst is a subdirectory of src. + * EISDIR: dst is a directory, but src is not. + * ENOENT: src doesn't exist, or src or dst is "". + * ENOTDIR: src is a directory, but dst is not. + * EXDEV: src and dst are on different filesystems. + * + * Side effects: + * The implementation of rename may allow cross-filesystem renames, + * but the caller should be prepared to emulate it with copy and + * delete if errno is EXDEV. + * + *--------------------------------------------------------------------------- + */ + +int +efile_rename(Efile_error* errInfo, /* Where to return error codes. */ + char* src, /* Original name. */ + char* dst) /* New name. */ +{ + + /* temporary fix AFM does not recognize ./<file name> + * in destination remove pending on adaption of AFM fix + */ + + char *dot_str; + if (dst != NULL) { + dot_str = strchr(dst, '.'); + if (dot_str && dot_str == dst && dot_str[1] == '/') { + dst = dst+2; + } + } + + if (rename(src, dst) == 0) { + return 1; + } + if (errno == ENOTEMPTY) { + errno = EEXIST; + } + if (errno == EINVAL) { + struct stat file_stat; + + if (stat(dst, &file_stat)== 0) { + if (ISDIR(file_stat)) { + errno = EISDIR; + } + else if (ISREG(file_stat)) { + errno = ENOTDIR; + } + else { + errno = EINVAL; + } + } + else { + errno = EINVAL; + } + } + + if (strcmp(src, "/") == 0) { + errno = EINVAL; + } + return check_error(-1, errInfo); +} + +/***************************************************************************/ + +int +efile_chdir(Efile_error* errInfo, /* Where to return error codes. */ + char* name) /* Name of directory to make current. */ +{ + return check_error(chdir(name), errInfo); +} + +/***************************************************************************/ + +int +efile_getdcwd(Efile_error* errInfo, /* Where to return error codes. */ + int drive, /* 0 - current, 1 - A, 2 - B etc. */ + char* buffer, /* Where to return the current + directory. */ + size_t size) /* Size of buffer. */ +{ + if (drive == 0) { + if (getcwd(buffer, size) == NULL) + return check_error(-1, errInfo); + + return 1; + } + + /* + * Drives other than 0 is not supported on Unix. + */ + + errno = ENOTSUP; + return check_error(-1, errInfo); +} + +/***************************************************************************/ + +int +efile_readdir(Efile_error* errInfo, /* Where to return error codes. */ + char* name, /* Name of directory to open. */ + EFILE_DIR_HANDLE* p_dir_handle, /* Pointer to directory + handle of + open directory.*/ + char* buffer, /* Pointer to buffer for + one filename. */ + size_t *size) /* in-out Size of buffer, length + of name. */ +{ + DIR *dp; /* Pointer to directory structure. */ + struct dirent* dirp; /* Pointer to directory entry. */ + + /* + * If this is the first call, we must open the directory. + */ + + if (*p_dir_handle == NULL) { + dp = opendir(name); + if (dp == NULL) + return check_error(-1, errInfo); + *p_dir_handle = (EFILE_DIR_HANDLE) dp; + } + + /* + * Retrieve the name of the next file using the directory handle. + */ + + dp = *((DIR **)((void *)p_dir_handle)); + for (;;) { + dirp = readdir(dp); + if (dirp == NULL) { + closedir(dp); + return 0; + } + if (IS_DOT_OR_DOTDOT(dirp->d_name)) + continue; + buffer[0] = '\0'; + strncat(buffer, dirp->d_name, (*size)-1); + *size = strlen(dirp->d_name); + return 1; + } +} + +/***************************************************************************/ + +int +efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ + char* name, /* Name of directory to open. */ + int flags, /* Flags to user for opening. */ + int* pfd, /* Where to store the file + descriptor. */ + Sint64 *pSize) /* Where to store the size of the + file. */ +{ + struct stat statbuf; + int fd; + int mode; /* Open mode. */ + + if (stat(name, &statbuf) >= 0 && !ISREG(statbuf)) { + errno = EISDIR; + return check_error(-1, errInfo); + } + + switch (flags & (EFILE_MODE_READ|EFILE_MODE_WRITE)) { + case EFILE_MODE_READ: + mode = O_RDONLY; + break; + case EFILE_MODE_WRITE: + if (flags & EFILE_NO_TRUNCATE) + mode = O_WRONLY | O_CREAT; + else + mode = O_WRONLY | O_CREAT | O_TRUNC; + break; + case EFILE_MODE_READ_WRITE: + mode = O_RDWR | O_CREAT; + break; + default: + errno = EINVAL; + return check_error(-1, errInfo); + } + + + if (flags & EFILE_MODE_APPEND) { + mode &= ~O_TRUNC; + mode |= O_APPEND; + } + + if (flags & EFILE_MODE_EXCL) { + mode |= O_EXCL; + } + + fd = open(name, mode, FILE_MODE); + + if (!check_error(fd, errInfo)) + return 0; + + *pfd = fd; + if (pSize) { + *pSize = statbuf.st_size; + } + return 1; +} + +/***************************************************************************/ + +int +efile_may_openfile(Efile_error* errInfo, char *name) { + struct stat statbuf; /* Information about the file */ + int result; + + result = stat(name, &statbuf); + if (!check_error(result, errInfo)) + return 0; + if (!ISREG(statbuf)) { + errno = EISDIR; + return check_error(-1, errInfo); + } + return 1; +} + +/***************************************************************************/ + +void +efile_closefile(int fd) +{ + if (l_find_local_fd(fd) != NULL) { + l_remove_local_fd(fd); + } + close(fd); +} + +/***************************************************************************/ + +int +efile_fdatasync(Efile_error *errInfo, /* Where to return error codes. */ + int fd) /* File descriptor for file to sync data. */ +{ + return efile_fsync(errInfo, fd); +} + +/***************************************************************************/ + +int +efile_fsync(Efile_error *errInfo, /* Where to return error codes. */ + int fd) /* File descriptor for file to sync. */ +{ + return check_error(fsync(fd), errInfo); +} + +/***************************************************************************/ + +int +efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo, + char* name, int info_for_link) +{ + struct stat statbuf; /* Information about the file */ + int result; + + result = stat(name, &statbuf); + if (!check_error(result, errInfo)) { + return 0; + } + +#if SIZEOF_OFF_T == 4 + pInfo->size_high = 0; +#else + pInfo->size_high = (Uint32)(statbuf.st_size >> 32); +#endif + pInfo->size_low = (Uint32)statbuf.st_size; + +#ifdef NO_ACCESS + /* Just look at read/write access for owner. */ + + pInfo->access = ((statbuf.st_mode >> 6) & 07) >> 1; + +#else + pInfo->access = FA_NONE; + if (access(name, R_OK) == 0) + pInfo->access |= FA_READ; + if (access(name, W_OK) == 0) + pInfo->access |= FA_WRITE; + +#endif + + if (ISDEV(statbuf)) + pInfo->type = FT_DEVICE; + else if (ISDIR(statbuf)) + pInfo->type = FT_DIRECTORY; + else if (ISREG(statbuf)) + pInfo->type = FT_REGULAR; + else if (ISLNK(statbuf)) + pInfo->type = FT_SYMLINK; + else + pInfo->type = FT_OTHER; + + pInfo->accessTime = statbuf.st_atime; + pInfo->modifyTime = statbuf.st_mtime; + pInfo->cTime = statbuf.st_ctime; + + pInfo->mode = statbuf.st_mode; + pInfo->links = statbuf.st_nlink; + pInfo->major_device = statbuf.st_dev; + pInfo->inode = statbuf.st_ino; + pInfo->uid = statbuf.st_uid; + pInfo->gid = statbuf.st_gid; + + return 1; +} + +/***************************************************************************/ + +int +efile_write_info(Efile_error *errInfo, Efile_info *pInfo, char *name) +{ + /* + * On some systems chown will always fail for a non-root user unless + * POSIX_CHOWN_RESTRICTED is not set. Others will succeed as long as + * you don't try to chown a file to someone besides youself. + */ + if (pInfo->mode != -1) { + mode_t newMode = pInfo->mode & (S_ISUID | S_ISGID | + S_IRWXU | S_IRWXG | S_IRWXO); + if (chmod(name, newMode)) { + newMode &= ~(S_ISUID | S_ISGID); + if (chmod(name, newMode)) { + return check_error(-1, errInfo); + } + } + } + + return 1; +} + +/***************************************************************************/ + +int +efile_write(Efile_error* errInfo, /* Where to return error codes. */ + int flags, /* Flags given when file was + opened. */ + int fd, /* File descriptor to write to. */ + char* buf, /* Buffer to write. */ + size_t count) /* Number of bytes to write. */ +{ + ssize_t written; /* Bytes written in last operation. */ + struct fd_data *fd_data; + + if ((fd_data = l_find_local_fd(fd)) != NULL) { + if (L_FD_IS_VALID(fd_data)) { + /* we are beyond eof and need to pad*/ + if (l_pad_file(fd_data, L_FD_CUR(fd_data)) < 0) { + return check_error(-1, errInfo); + } + } + } + + while (count > 0) { + if ((written = write(fd, buf, count)) < 0) { + if (errno != EINTR) { + return check_error(-1, errInfo); + } + else { + written = 0; + } + } + ASSERT(written <= count); + buf += written; + count -= written; + } + return 1; +} + +/***************************************************************************/ + +int +efile_writev(Efile_error* errInfo, /* Where to return error codes */ + int flags, /* Flags given when file was + * opened */ + int fd, /* File descriptor to write to */ + SysIOVec* iov, /* Vector of buffer structs. + * The structs may be changed i.e. + * due to incomplete writes */ + int iovcnt) /* Number of structs in vector */ +{ + struct fd_data *fd_data; + int cnt = 0; /* Buffers so far written */ + + ASSERT(iovcnt >= 0); + if ((fd_data = l_find_local_fd(fd)) != NULL) { + if (L_FD_IS_VALID(fd_data)) { + /* we are beyond eof and need to pad*/ + if (l_pad_file(fd_data, L_FD_CUR(fd_data)) < 0) { + return check_error(-1, errInfo); + } + } + } + while (cnt < iovcnt) { + if ((! iov[cnt].iov_base) || (iov[cnt].iov_len <= 0)) { + /* Empty buffer - skip */ + cnt++; + } + else { /* Non-empty buffer */ + ssize_t w; /* Bytes written in this call */ + do { + w = write(fd, iov[cnt].iov_base, iov[cnt].iov_len); + } while (w < 0 && errno == EINTR); + + ASSERT(w <= iov[cnt].iov_len || w == -1); + + if (w < 0) { + return check_error(-1, errInfo); + } + /* Move forward to next buffer to write */ + for (; cnt < iovcnt && w > 0; cnt++) { + if (iov[cnt].iov_base && iov[cnt].iov_len > 0) { + if (w < iov[cnt].iov_len) { + /* Adjust the buffer for next write */ + iov[cnt].iov_len -= w; + iov[cnt].iov_base += w; + w = 0; + break; + } + else { + w -= iov[cnt].iov_len; + } + } + } + ASSERT(w == 0); + } /* else Non-empty buffer */ + } /* while (cnt< iovcnt) */ + return 1; +} + +/***************************************************************************/ + +int +efile_read(Efile_error* errInfo, /* Where to return error codes. */ + int flags, /* Flags given when file was opened. */ + int fd, /* File descriptor to read from. */ + char* buf, /* Buffer to read into. */ + size_t count, /* Number of bytes to read. */ + size_t *pBytesRead) /* Where to return number of + bytes read. */ +{ + ssize_t n; + struct fd_data *fd_data; + + if ((fd_data = l_find_local_fd(fd)) != NULL) { + if (L_FD_IS_VALID(fd_data)) { + *pBytesRead = 0; + return 1; + } + } + for (;;) { + if ((n = read(fd, buf, count)) >= 0) { + break; + } + else if (errno != EINTR) { + return check_error(-1, errInfo); + } + } + if (fd_data != NULL && L_FD_IS_VALID(fd_data)) { + L_FD_INVALIDATE(fd_data); + } + *pBytesRead = (size_t) n; + return 1; +} + +/* pread() and pwrite() */ +/* Some unix systems, notably Solaris has these syscalls */ +/* It is especially nice for i.e. the dets module to have support */ +/* for this, even if the underlying OS dosn't support it, it is */ +/* reasonably easy to work around by first calling seek, and then */ +/* calling read(). */ +/* This later strategy however changes the file pointer, which pread() */ +/* does not do. We choose to ignore this and say that the location */ +/* of the file pointer is undefined after a call to any of the p functions*/ + + +int +efile_pread(Efile_error* errInfo, /* Where to return error codes. */ + int fd, /* File descriptor to read from. */ + Sint64 offset, /* Offset in bytes from BOF. */ + char* buf, /* Buffer to read into. */ + size_t count, /* Number of bytes to read. */ + size_t *pBytesRead) /* Where to return + number of bytes read. */ +{ + int res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL); + if (res) { + return efile_read(errInfo, 0, fd, buf, count, pBytesRead); + } else { + return res; + } +} + + +/***************************************************************************/ + +int +efile_pwrite(Efile_error* errInfo, /* Where to return error codes. */ + int fd, /* File descriptor to write to. */ + char* buf, /* Buffer to write. */ + size_t count, /* Number of bytes to write. */ + Sint64 offset) /* where to write it */ +{ + int res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL); + + if (res) { + return efile_write(errInfo, 0, fd, buf, count); + } else { + return res; + } +} + +/***************************************************************************/ + +int +efile_seek(Efile_error* errInfo, /* Where to return error codes. */ + int fd, /* File descriptor to do the seek on. */ + Sint64 offset, /* Offset in bytes from the given + origin. */ + int origin, /* Origin of seek (SEEK_SET, SEEK_CUR, + SEEK_END). */ + Sint64 *new_location) /* Resulting new location in file. */ +{ + off_t off, result; + off = (off_t) offset; + + switch (origin) { + case EFILE_SEEK_SET: + origin = SEEK_SET; + break; + case EFILE_SEEK_CUR: + origin = SEEK_CUR; + break; + case EFILE_SEEK_END: + origin = SEEK_END; + break; + default: + errno = EINVAL; + return check_error(-1, errInfo); + } + + if (off != offset) { + errno = EINVAL; + return check_error(-1, errInfo); + } + + errno = 0; + result = lseek(fd, off, origin); + + if (result >= 0) { + l_invalidate_local_fd(fd); + } + + if (result < 0) + { + if (errno == ENOSYS) { + int size, cur_pos; + + if (off < 0) { + errno = EINVAL; + return check_error(-1, errInfo); + } + + cur_pos = lseek(fd, 0, SEEK_CUR); + size = lseek(fd, 0, SEEK_END); + + if (origin == SEEK_SET) { + result = offset; + } + else if (origin == SEEK_CUR) { + result = offset + cur_pos; + } + else if (origin == SEEK_END) { + result = size + offset; + } + + /* sanity check our result */ + if (size > result) { + return check_error(-1, errInfo); + } + + /* store the data localy */ + l_update_local_fd(fd, result, size); + + /* reset the original file position */ + if (origin != SEEK_END) { + lseek(fd, cur_pos, SEEK_SET); + } + } + else if (errno == 0) { + errno = EINVAL; + } + } + + if (new_location) { + *new_location = result; + } + + return 1; +} + +/***************************************************************************/ + +int +efile_truncate_file(Efile_error* errInfo, int *fd, int flags) +{ + off_t offset; + struct fd_data *fd_data; + + if ((fd_data = l_find_local_fd(*fd)) != NULL && L_FD_IS_VALID(fd_data)) { + offset = L_FD_CUR(fd_data); + } + else { + offset = lseek(*fd, 0, SEEK_CUR); + } + + return check_error(((offset >= 0) && + (ftruncate(*fd, offset) == 0)) ? 1 : -1, errInfo); +} + +/***************************************************************************/ + +int +efile_readlink(Efile_error* errInfo, char* name, char* buffer, size_t size) +{ + errno = ENOTSUP; + return check_error(-1, errInfo); +} + +/***************************************************************************/ + +int +efile_altname(Efile_error* errInfo, char* name, char* buffer, size_t size) +{ + errno = ENOTSUP; + return check_error(-1, errInfo); +} + +/***************************************************************************/ + +int +efile_link(Efile_error* errInfo, char* old, char* new) +{ + errno = ENOTSUP; + return check_error(-1, errInfo); +} + +/***************************************************************************/ + +int +efile_symlink(Efile_error* errInfo, char* old, char* new) +{ + errno = ENOTSUP; + return check_error(-1, errInfo); +} + +/***************************************************************************/ + +int +efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset, + Sint64 length, int advise) +{ + return check_error(posix_fadvise(fd, offset, length, advise), errInfo); +} + +/***************************************************************************/ + +static int +call_posix_fallocate(int fd, Sint64 offset, Sint64 length) +{ + int ret; + + /* + * On Linux and Solaris for example, posix_fallocate() returns + * a positive error number on error and it does not set errno. + * On FreeBSD however (9.0 at least), it returns -1 on error + * and it sets errno. + */ + do { + ret = posix_fallocate(fd, (off_t) offset, (off_t) length); + if (ret > 0) { + errno = ret; + ret = -1; + } + } while (ret != 0 && errno == EINTR); + + return ret; +} + +/***************************************************************************/ + +int +efile_fallocate(Efile_error* errInfo, int fd, Sint64 offset, Sint64 length) +{ + return check_error(call_posix_fallocate(fd, offset, length), errInfo); +} diff --git a/erts/emulator/drivers/ose/ose_signal_drv.c b/erts/emulator/drivers/ose/ose_signal_drv.c new file mode 100644 index 0000000000..4929b53856 --- /dev/null +++ b/erts/emulator/drivers/ose/ose_signal_drv.c @@ -0,0 +1,896 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2013-2013. 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% + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "errno.h" +#include "stdio.h" +#include "string.h" +#include "stddef.h" + +#include "sys.h" +#include "erl_driver.h" +#include "ose.h" + + +#ifdef HAVE_OSE_SPI_H +#include "ose_spi/ose_spi.h" +#endif + +#define DEBUG_ATTACH 0 +#define DEBUG_HUNT 0 +#define DEBUG_SEND 0 +#define DEBUG_LISTEN 0 + +#if 0 +#define DEBUGP(FMT,...) printf(FMT, __VA_ARGS__) +#else +#define DEBUGP(FMT,...) +#endif + +#if DEBUG_ATTACH +#define DEBUGP_ATTACH(...) DEBUGP( __VA_ARGS__) +#else +#define DEBUGP_ATTACH(...) +#endif + +#if DEBUG_HUNT +#define DEBUGP_HUNT(...) DEBUGP( __VA_ARGS__) +#else +#define DEBUGP_HUNT(...) +#endif + +#if DEBUG_LISTEN +#define DEBUGP_LISTEN(...) DEBUGP( __VA_ARGS__) +#else +#define DEBUGP_LISTEN(...) +#endif + +#if DEBUG_SEND +#define DEBUGP_SEND(...) DEBUGP( __VA_ARGS__) +#else +#define DEBUGP_SEND(...) +#endif + + +#define DRIVER_NAME "ose_signal_drv" +#define GET_SPID 1 +#define GET_NAME 2 +#define HUNT 100 +#define DEHUNT 101 +#define ATTACH 102 +#define DETACH 103 +#define SEND 104 +#define SEND_W_S 105 +#define LISTEN 106 +#define OPEN 200 + +#define REF_SEGMENT_SIZE 8 + +struct async { + SIGSELECT signo; + ErlDrvTermData port; + ErlDrvTermData proc; + PROCESS spid; + PROCESS target; + Uint32 ref; +}; + +/** + * OSE signals + **/ +union SIGNAL { + SIGSELECT signo; + struct async async; +}; + +/** + * The driver's context + **/ +typedef struct _driver_context { + ErlDrvPort port; + PROCESS spid; + ErlDrvEvent perm_events[2]; + ErlDrvEvent *events; + Uint32 event_cnt; + Uint32 ref; + Uint32 *outstanding_refs; + Uint32 outstanding_refs_max; + Uint32 outstanding_refs_cnt; +} driver_context_t; + +/** + * Global variables + **/ +static ErlDrvTermData a_ok; +static ErlDrvTermData a_error; +static ErlDrvTermData a_enomem; +static ErlDrvTermData a_enoent; +static ErlDrvTermData a_badarg; +static ErlDrvTermData a_mailbox_up; +static ErlDrvTermData a_mailbox_down; +static ErlDrvTermData a_ose_drv_reply; +static ErlDrvTermData a_message; +static PROCESS proxy_proc; + + +/** + * Serialize/unserialize unsigned 32-bit values + **/ +static char *put_u32(unsigned int value, char *ptr) { + *ptr++ = (value & 0xff000000) >> 24; + *ptr++ = (value & 0x00ff0000) >> 16; + *ptr++ = (value & 0x0000ff00) >> 8; + *ptr++ = (value & 0xff); + + return ptr; +} + +static unsigned int get_u32(char *ptr) { + unsigned int result = 0; + result += (ptr[0] & 0xff) << 24; + result += (ptr[1] & 0xff) << 16; + result += (ptr[2] & 0xff) << 8; + result += (ptr[3] & 0xff); + + return result; +} + + +/* Stolen from efile_drv.c */ + +/* char EV_CHAR_P(ErlIOVec *ev, int p, int q) */ +#define EV_CHAR_P(ev, p, q) \ + (((char *)(ev)->iov[(q)].iov_base) + (p)) + +/* int EV_GET_CHAR(ErlIOVec *ev, char *p, int *pp, int *qp) */ +#define EV_GET_CHAR(ev, p, pp, qp) ev_get_char(ev, p ,pp, qp) +static int +ev_get_char(ErlIOVec *ev, char *p, int *pp, int *qp) { + if (*(pp)+1 <= (ev)->iov[*(qp)].iov_len) { + *(p) = *EV_CHAR_P(ev, *(pp), *(qp)); + if (*(pp)+1 < (ev)->iov[*(qp)].iov_len) + *(pp) = *(pp)+1; + else { + (*(qp))++; + *pp = 0; + } + return !0; + } + return 0; +} + +/* Uint32 EV_UINT32(ErlIOVec *ev, int p, int q)*/ +#define EV_UINT32(ev, p, q) \ + ((Uint32) *(((unsigned char *)(ev)->iov[(q)].iov_base) + (p))) + +/* int EV_GET_UINT32(ErlIOVec *ev, Uint32 *p, int *pp, int *qp) */ +#define EV_GET_UINT32(ev, p, pp, qp) ev_get_uint32(ev,(Uint32*)(p),pp,qp) +static int +ev_get_uint32(ErlIOVec *ev, Uint32 *p, int *pp, int *qp) { + if (*(pp)+4 <= (ev)->iov[*(qp)].iov_len) { + *(p) = (EV_UINT32(ev, *(pp), *(qp)) << 24) + | (EV_UINT32(ev, *(pp)+1, *(qp)) << 16) + | (EV_UINT32(ev, *(pp)+2, *(qp)) << 8) + | (EV_UINT32(ev, *(pp)+3, *(qp))); + if (*(pp)+4 < (ev)->iov[*(qp)].iov_len) + *(pp) = *(pp)+4; + else { + (*(qp))++; + *pp = 0; + } + return !0; + } + return 0; +} + +/** + * Convinience macros + **/ +#define send_response(port,output) erl_drv_send_term(driver_mk_port(port),\ + driver_caller(port), output, sizeof(output) / sizeof(output[0])); + +void iov_memcpy(void *dest,ErlIOVec *ev,int ind,int off); +void iov_memcpy(void *dest,ErlIOVec *ev,int ind,int off) { + int i; + memcpy(dest,ev->iov[ind].iov_base+off,ev->iov[ind].iov_len-off); + for (i = ind+1; i < ev->vsize; i++) + memcpy(dest,ev->iov[i].iov_base,ev->iov[i].iov_len); +} + +/** + * Reference handling + **/ + +static int add_reference(driver_context_t *ctxt, Uint32 ref) { + + /* + * Premature optimizations may be evil, but they sure are fun. + */ + + if (ctxt->outstanding_refs == NULL) { + /* First ref to be ignored */ + ctxt->outstanding_refs = driver_alloc(REF_SEGMENT_SIZE*sizeof(Uint32)); + if (!ctxt->outstanding_refs) + return 1; + + memset(ctxt->outstanding_refs,0,REF_SEGMENT_SIZE*sizeof(Uint32)); + ctxt->outstanding_refs_max += REF_SEGMENT_SIZE; + ctxt->outstanding_refs[ctxt->outstanding_refs_cnt++] = ref; + } else if (ctxt->outstanding_refs_cnt == ctxt->outstanding_refs_max) { + /* Expand ref array */ + Uint32 *new_array; + ctxt->outstanding_refs_max += REF_SEGMENT_SIZE; + new_array = driver_realloc(ctxt->outstanding_refs, + ctxt->outstanding_refs_max*sizeof(Uint32)); + + if (!new_array) { + ctxt->outstanding_refs_max -= REF_SEGMENT_SIZE; + return 1; + } + + ctxt->outstanding_refs = new_array; + + memset(ctxt->outstanding_refs+ctxt->outstanding_refs_cnt,0, + REF_SEGMENT_SIZE*sizeof(Uint32)); + ctxt->outstanding_refs[ctxt->outstanding_refs_cnt++] = ref; + + } else { + /* Find an empty slot: + * First we try current index, + * then we scan for a slot. + */ + if (!ctxt->outstanding_refs[ctxt->outstanding_refs_cnt]) { + ctxt->outstanding_refs[ctxt->outstanding_refs_cnt++] = ref; + } else { + int i; + ASSERT(ctxt->outstanding_refs_cnt < ctxt->outstanding_refs_max); + for (i = 0; i < ctxt->outstanding_refs_max; i++) + if (!ctxt->outstanding_refs[i]) + break; + ASSERT(ctxt->outstanding_refs[i] == 0); + ctxt->outstanding_refs[i] = ref; + ctxt->outstanding_refs_cnt++; + } + } + return 0; +} + +/* Return 0 if removed, 1 if does not exist, */ +static int remove_reference(driver_context_t *ctxt, Uint32 ref) { + int i,j; + + if (ctxt->outstanding_refs_max == 0 && ctxt->outstanding_refs_cnt == 0) { + ASSERT(ctxt->outstanding_refs == NULL); + return 1; + } + + for (i = 0; i < ctxt->outstanding_refs_max; i++) { + if (ctxt->outstanding_refs[i] == ref) { + ctxt->outstanding_refs[i] = 0; + ctxt->outstanding_refs_cnt--; + i = -1; + break; + } + } + + if (i != -1) + return 1; + + if (ctxt->outstanding_refs_cnt == 0) { + driver_free(ctxt->outstanding_refs); + ctxt->outstanding_refs = NULL; + ctxt->outstanding_refs_max = 0; + } else if (ctxt->outstanding_refs_cnt == (ctxt->outstanding_refs_max - REF_SEGMENT_SIZE)) { + Uint32 *new_array; + for (i = 0, j = 0; i < ctxt->outstanding_refs_cnt; i++) { + if (ctxt->outstanding_refs[i] == 0) { + for (j = i+1; j < ctxt->outstanding_refs_max; j++) + if (ctxt->outstanding_refs[j]) { + ctxt->outstanding_refs[i] = ctxt->outstanding_refs[j]; + ctxt->outstanding_refs[j] = 0; + break; + } + } + } + ctxt->outstanding_refs_max -= REF_SEGMENT_SIZE; + new_array = driver_realloc(ctxt->outstanding_refs, + ctxt->outstanding_refs_max*sizeof(Uint32)); + if (!new_array) { + ctxt->outstanding_refs_max += REF_SEGMENT_SIZE; + return 2; + } + + ctxt->outstanding_refs = new_array; + + } + + return 0; +} + +/** + * The OSE proxy process. This only handles ERTS_SIGNAL_OSE_DRV_ATTACH. + * The process is needed because signals triggered by attach ignore + * redir tables. + * + * We have one global proxy process to save memory. An attempt to make each + * port phantom into a proxy was made, but that used way to much memory. + */ +static OS_PROCESS(driver_proxy_process) { + SIGSELECT sigs[] = {1,ERTS_SIGNAL_OSE_DRV_ATTACH}; + PROCESS master = 0; + + while (1) { + union SIGNAL *sig = receive(sigs); + + if (sig->signo == ERTS_SIGNAL_OSE_DRV_ATTACH) { + + /* The first message is used to determine who to send messages to. */ + if (master == 0) + master = sender(&sig); + + if (sig->async.target == 0) { + PROCESS from = sender(&sig); + restore(sig); + DEBUGP_ATTACH("0x%x: got attach 0x%x, sending to 0x%x\n", + current_process(),from,master); + sig->async.target = from; + send(&sig,master); + } else { + PROCESS target = sig->async.target; + restore(sig); + sig->async.target = 0; + DEBUGP_ATTACH("0x%x: doing attach on 0x%x\n",current_process(),target); + attach(&sig,target); + } + } + } +} + + +/** + * Init routine for the driver + **/ +static int drv_init(void) { + + a_ok = driver_mk_atom("ok"); + a_error = driver_mk_atom("error"); + a_enomem = driver_mk_atom("enomem"); + a_enoent = driver_mk_atom("enoent"); + a_badarg = driver_mk_atom("badarg"); + a_mailbox_up = driver_mk_atom("mailbox_up"); + a_mailbox_down = driver_mk_atom("mailbox_down"); + a_ose_drv_reply = driver_mk_atom("ose_drv_reply"); + a_message = driver_mk_atom("message"); + + proxy_proc = create_process(get_ptype(current_process()), + "ose_signal_driver_proxy", + driver_proxy_process, 10000, + get_pri(current_process()), + 0, 0, NULL, 0, 0); + +#ifdef DEBUG + efs_clone(proxy_proc); +#endif + start(proxy_proc); + + return 0; +} + +/* Signal resolution callback */ +static ErlDrvOseEventId resolve_signal(union SIGNAL* osig) { + union SIGNAL *sig = osig; + if (sig->signo == ERTS_SIGNAL_OSE_DRV_HUNT || + sig->signo == ERTS_SIGNAL_OSE_DRV_ATTACH) { + return sig->async.spid; + } + DEBUGP("%p: Got signal %d sent to %p from 0x%p\n", + current_process(),sig->signo,addressee(&sig),sender(&sig)); + return addressee(&sig); +} + + +/** + * Start routine for the driver + **/ +static ErlDrvData drv_start(ErlDrvPort port, char *command) +{ + driver_context_t *ctxt = driver_alloc(sizeof(driver_context_t)); + + ctxt->perm_events[0] = NULL; + ctxt->perm_events[1] = NULL; + + ctxt->spid = 0; + ctxt->port = port; + ctxt->event_cnt = 0; + ctxt->events = NULL; + ctxt->ref = 0; + ctxt->outstanding_refs = NULL; + ctxt->outstanding_refs_max = 0; + ctxt->outstanding_refs_cnt = 0; + + + /* Set the communication protocol to Erlang to be binary */ + set_port_control_flags(port, PORT_CONTROL_FLAG_BINARY); + + /* Everything ok */ + return (ErlDrvData)ctxt; +} + +/** + * Stop routine for the driver + **/ +static void drv_stop(ErlDrvData driver_data) +{ + driver_context_t *ctxt = (driver_context_t *)driver_data; + int i; + + /* HUNT + ATTACH */ + if (ctxt->perm_events[0]) + driver_select(ctxt->port, ctxt->perm_events[0], + ERL_DRV_USE|ERL_DRV_READ, 0); + if (ctxt->perm_events[1]) + driver_select(ctxt->port, ctxt->perm_events[1], + ERL_DRV_USE|ERL_DRV_READ, 0); + + for (i = 0; i < ctxt->event_cnt; i++) { + driver_select(ctxt->port, ctxt->events[i], ERL_DRV_USE|ERL_DRV_READ, 0); + } + + if (ctxt->spid != 0) + kill_proc(ctxt->spid); + DEBUGP("0x%x: stopped\n",ctxt->spid); + if (ctxt->events) + driver_free(ctxt->events); + if (ctxt->outstanding_refs) + driver_free(ctxt->outstanding_refs); + + driver_free(ctxt); +} + +/** + * Output from Erlang + **/ +static void outputv(ErlDrvData driver_data, ErlIOVec *ev) +{ + driver_context_t *ctxt = (driver_context_t *)driver_data; + int p = 0, q = 1; + char cmd; + + if (! EV_GET_CHAR(ev,&cmd,&p,&q)) { + ErlDrvTermData output[] = { + ERL_DRV_ATOM, a_ose_drv_reply, + ERL_DRV_PORT, driver_mk_port(ctxt->port), + ERL_DRV_ATOM, a_badarg, + ERL_DRV_TUPLE, 3}; + send_response(ctxt->port, output); + return; + } + + /* Command is in the buffer's first byte */ + switch(cmd) { + + case OPEN: { + char *name = driver_alloc(ev->size - 1+1); + struct OS_redir_entry redir[2]; + + redir[0].sig = 1; + redir[0].pid = current_process(); + + iov_memcpy(name,ev,q,p); + name[ev->size-1] = '\0'; + + ctxt->spid = create_process(OS_PHANTOM, name, NULL, 0, + 0, 0, 0, redir, 0, 0); + + DEBUGP("0x%x: open\n",ctxt->spid); + + ctxt->perm_events[1] = + erl_drv_ose_event_alloc(ERTS_SIGNAL_OSE_DRV_ATTACH,(int)ctxt->spid, + resolve_signal, NULL); + driver_select(ctxt->port,ctxt->perm_events[1],ERL_DRV_READ|ERL_DRV_USE,1); + + ctxt->perm_events[0] = + erl_drv_ose_event_alloc(ERTS_SIGNAL_OSE_DRV_HUNT,(int)ctxt->spid, + resolve_signal, NULL); + driver_select(ctxt->port,ctxt->perm_events[0],ERL_DRV_READ|ERL_DRV_USE,1); + + start(ctxt->spid); + + { + ErlDrvTermData output[] = { + ERL_DRV_ATOM, a_ose_drv_reply, + ERL_DRV_PORT, driver_mk_port(ctxt->port), + ERL_DRV_ATOM, a_ok, + ERL_DRV_TUPLE, 3}; + + send_response(ctxt->port, output); + } + + break; + + } + + case ATTACH: + case HUNT: + { + union SIGNAL *sig = alloc(sizeof(union SIGNAL), + cmd == HUNT ? ERTS_SIGNAL_OSE_DRV_HUNT:ERTS_SIGNAL_OSE_DRV_ATTACH); + + sig->async.port = driver_mk_port(ctxt->port); + sig->async.proc = driver_caller(ctxt->port); + sig->async.spid = ctxt->spid; + sig->async.ref = ++ctxt->ref; + + if (add_reference(ctxt,ctxt->ref)) { + ErlDrvTermData output[] = { + ERL_DRV_ATOM, a_ose_drv_reply, + ERL_DRV_PORT, driver_mk_port(ctxt->port), + ERL_DRV_ATOM, a_enomem, + ERL_DRV_TUPLE, 3}; + send_response(ctxt->port, output); + free_buf(&sig); + } else { + ErlDrvTermData output[] = { + ERL_DRV_ATOM, a_ose_drv_reply, + ERL_DRV_PORT, driver_mk_port(ctxt->port), + ERL_DRV_PORT, driver_mk_port(ctxt->port), + ERL_DRV_INT, (ErlDrvUInt)ctxt->ref, + ERL_DRV_TUPLE, 2, + ERL_DRV_TUPLE, 3}; + send_response(ctxt->port, output); + + if (cmd == HUNT) { + char *huntname = driver_alloc(sizeof(char)*((ev->size-1)+1)); + + iov_memcpy(huntname,ev,q,p); + huntname[ev->size-1] = '\0'; + + DEBUGP_HUNT("0x%x: hunt %s -> %u (%u,%u)\n", + ctxt->spid,huntname,ctxt->ref, + ctxt->outstanding_refs_cnt, + ctxt->outstanding_refs_max); + + hunt(huntname, 0, NULL, &sig); + + driver_free(huntname); + } else { + EV_GET_UINT32(ev,&sig->async.target,&p,&q); + DEBUGP_ATTACH("0x%x: attach %u -> %u (%u,%u)\n", + ctxt->spid,sig->async.target, + ctxt->ref, + ctxt->outstanding_refs_cnt, + ctxt->outstanding_refs_max); + + send(&sig,proxy_proc); + } + + } + + break; + } + + case DETACH: + case DEHUNT: + { + + Uint32 ref; + + EV_GET_UINT32(ev,&ref,&p,&q); + if (cmd == DETACH) { + DEBUGP_ATTACH("0x%x: detach %u (%u,%u)\n",ctxt->spid,ref, + ctxt->outstanding_refs_cnt, + ctxt->outstanding_refs_max); + } else { + DEBUGP_HUNT("0x%x: dehunt %u (%u,%u)\n",ctxt->spid,ref, + ctxt->outstanding_refs_cnt, + ctxt->outstanding_refs_max); + } + + if (remove_reference(ctxt,ref)) { + ErlDrvTermData output[] = { + ERL_DRV_ATOM, a_ose_drv_reply, + ERL_DRV_PORT, driver_mk_port(ctxt->port), + ERL_DRV_ATOM, a_error, + ERL_DRV_ATOM, a_enoent, + ERL_DRV_TUPLE, 2, + ERL_DRV_TUPLE, 3}; + + send_response(ctxt->port, output); + } else { + ErlDrvTermData output[] = { + ERL_DRV_ATOM, a_ose_drv_reply, + ERL_DRV_PORT, driver_mk_port(ctxt->port), + ERL_DRV_ATOM, a_ok, + ERL_DRV_TUPLE, 3}; + + send_response(ctxt->port, output); + } + + break; + } + + case SEND: + case SEND_W_S: + { + PROCESS spid; + PROCESS sender; + SIGSELECT signo; + OSBUFSIZE size = ev->size-9; + union SIGNAL *sig; + + EV_GET_UINT32(ev,&spid,&p,&q); + + if (cmd == SEND_W_S) { + EV_GET_UINT32(ev,&sender,&p,&q); + size -= 4; + } else { + sender = ctxt->spid; + } + + EV_GET_UINT32(ev,&signo,&p,&q); + + sig = alloc(size + sizeof(SIGSELECT),signo); + + if (cmd == SEND_W_S) { + DEBUGP_SEND("0x%x: send_w_s(%u,%u,%u)\n",ctxt->spid,spid,signo,sender); + } else { + DEBUGP_SEND("0x%x: send(%u,%u)\n",ctxt->spid,spid,signo); + } + + iov_memcpy(((char *)&sig->signo) + sizeof(SIGSELECT),ev,q,p); + + send_w_s(&sig, sender, spid); + + break; + } + + case LISTEN: + { + int i,j,event_cnt = (ev->size - 1)/4; + ErlDrvEvent *events = NULL; + SIGSELECT signo,tmp_signo; + + if (event_cnt == 0) { + for (i = 0; i < ctxt->event_cnt; i++) + driver_select(ctxt->port,ctxt->events[i],ERL_DRV_READ|ERL_DRV_USE,0); + if (ctxt->events) + driver_free(ctxt->events); + } else { + events = driver_alloc(sizeof(ErlDrvEvent)*event_cnt); + EV_GET_UINT32(ev,&signo,&p,&q); + for (i = 0, j = 0; i < event_cnt || j < ctxt->event_cnt; ) { + + if (ctxt->events) + erl_drv_ose_event_fetch(ctxt->events[j],&tmp_signo,NULL,NULL); + + if (signo == tmp_signo) { + events[i++] = ctxt->events[j++]; + EV_GET_UINT32(ev,&signo,&p,&q); + } else if (signo < tmp_signo || !ctxt->events) { + /* New signal to select on */ + events[i] = erl_drv_ose_event_alloc(signo,(int)ctxt->spid, + resolve_signal, NULL); + driver_select(ctxt->port,events[i++],ERL_DRV_READ|ERL_DRV_USE,1); + EV_GET_UINT32(ev,&signo,&p,&q); + } else { + /* Remove old signal to select on */ + driver_select(ctxt->port,ctxt->events[j++],ERL_DRV_READ|ERL_DRV_USE,0); + } + } + if (ctxt->events) + driver_free(ctxt->events); + } + ctxt->events = events; + ctxt->event_cnt = event_cnt; + + { + ErlDrvTermData output[] = { + ERL_DRV_ATOM, a_ose_drv_reply, + ERL_DRV_PORT, driver_mk_port(ctxt->port), + ERL_DRV_ATOM, a_ok, + ERL_DRV_TUPLE, 3}; + send_response(ctxt->port, output); + } + break; + } + + default: + { + DEBUGP("Warning: 'ose_signal_drv' unknown command '%d'\n", cmd); + break; + } + } +} + +/** + * Handler for when OSE signal arrives + **/ +static void ready_input(ErlDrvData driver_data, ErlDrvEvent event) +{ + driver_context_t *ctxt = (driver_context_t *)driver_data; + union SIGNAL *sig = erl_drv_ose_get_signal(event); + + while (sig != NULL) { + + switch(sig->signo) + { + /* Remote process is available */ + case ERTS_SIGNAL_OSE_DRV_HUNT: + { + const PROCESS spid = sender(&sig); + + if (remove_reference(ctxt,sig->async.ref)) { + DEBUGP_HUNT("0x%x: Got hunt from 0x%x -> %u (CANCELLED) (%u,%u)\n", + ctxt->spid,spid,sig->async.ref, + ctxt->outstanding_refs_cnt, + ctxt->outstanding_refs_max); + /* Already removed by dehunt */ + } else { + ErlDrvTermData reply[] = { + ERL_DRV_ATOM, a_mailbox_up, + ERL_DRV_PORT, sig->async.port, + ERL_DRV_PORT, sig->async.port, + ERL_DRV_UINT, (ErlDrvUInt)sig->async.ref, + ERL_DRV_TUPLE, 2, + ERL_DRV_UINT, (ErlDrvUInt)spid, + ERL_DRV_TUPLE, 4}; + DEBUGP_HUNT("0x%x: Got hunt from 0x%x -> %u (%u,%u)\n", + ctxt->spid,spid,sig->async.ref, + ctxt->outstanding_refs_cnt, + ctxt->outstanding_refs_max); + erl_drv_send_term(sig->async.port, sig->async.proc, reply, + sizeof(reply) / sizeof(reply[0])); + } + break; + } + + /* Remote process is down */ + case ERTS_SIGNAL_OSE_DRV_ATTACH: + { + PROCESS spid = sig->async.target; + + if (remove_reference(ctxt,sig->async.ref)) { + DEBUGP_ATTACH("0x%x: Got attach from 0x%x -> %u (CANCELLED) (%u,%u)\n", + ctxt->spid,spid,sig->async.ref, + ctxt->outstanding_refs_cnt, + ctxt->outstanding_refs_max); + /* Already removed by detach */ + } else { + ErlDrvTermData reply[] = { + ERL_DRV_ATOM, a_mailbox_down, + ERL_DRV_PORT, sig->async.port, + ERL_DRV_PORT, sig->async.port, + ERL_DRV_UINT, sig->async.ref, + ERL_DRV_TUPLE, 2, + ERL_DRV_UINT, (ErlDrvUInt)spid, + ERL_DRV_TUPLE, 4}; + DEBUGP_ATTACH("0x%x: Got attach from 0x%x -> %u (%u,%u)\n", + ctxt->spid,spid,sig->async.ref, + ctxt->outstanding_refs_cnt, + ctxt->outstanding_refs_max); + erl_drv_send_term(sig->async.port, sig->async.proc, reply, + sizeof(reply) / sizeof(reply[0])); + } + break; + } + + /* Received user defined signal */ + default: + { + const PROCESS spid = sender(&sig); + const OSBUFSIZE size = sigsize(&sig) - sizeof(SIGSELECT); + const char *sig_data = ((char *)&sig->signo) + sizeof(SIGSELECT); + + ErlDrvTermData reply[] = { + ERL_DRV_ATOM, a_message, + ERL_DRV_PORT, driver_mk_port(ctxt->port), + ERL_DRV_UINT, (ErlDrvUInt)spid, + ERL_DRV_UINT, (ErlDrvUInt)ctxt->spid, + ERL_DRV_UINT, (ErlDrvUInt)sig->signo, + ERL_DRV_BUF2BINARY, (ErlDrvTermData)sig_data, (ErlDrvUInt)size, + ERL_DRV_TUPLE, 4, + ERL_DRV_TUPLE, 3}; + + DEBUGP_SEND("0x%x: Got 0x%u\r\n", spid, sig->signo); + + erl_drv_output_term(driver_mk_port(ctxt->port), reply, + sizeof(reply) / sizeof(reply[0])); + break; + } + } + + free_buf(&sig); + sig = erl_drv_ose_get_signal(event); + } +} + +/** + * Handler for 'port_control' + **/ +static ErlDrvSSizeT control(ErlDrvData driver_data, unsigned int cmd, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen) +{ + driver_context_t *ctxt = (driver_context_t *)driver_data; + + switch(cmd) + { + case GET_SPID: + { + const PROCESS spid = ctxt->spid; + put_u32(spid, *rbuf); + return sizeof(PROCESS); + } + +#ifdef HAVE_OSE_SPI_H + case GET_NAME: + { + const PROCESS spid = get_u32(buf); + char *name = (char*)get_pid_info(spid,OSE_PI_NAME); + int n; + if (!name) { + *rbuf = NULL; + return 0; + } + + if (rlen < (n = strlen(name))) { + ErlDrvBinary *bin = driver_alloc_binary(n); + strncpy(bin->orig_bytes,name,n); + *rbuf = (char*)bin; + } else + strncpy(*rbuf,name,n); + free_buf((union SIGNAL**)&name); + + return n; + } +#endif + default: + { + /* Unknown command */ + return (ErlDrvSSizeT)ERL_DRV_ERROR_GENERAL; + break; + } + } +} + +static void stop_select(ErlDrvEvent event, void *reserved) +{ + erl_drv_ose_event_free(event); +} + +/** + * Setup the driver entry for the Erlang runtime + **/ +ErlDrvEntry ose_signal_driver_entry = { + .init = drv_init, + .start = drv_start, + .stop = drv_stop, + .outputv = outputv, + .ready_input = ready_input, + .driver_name = DRIVER_NAME, + .control = control, + .extended_marker = ERL_DRV_EXTENDED_MARKER, + .major_version = ERL_DRV_EXTENDED_MAJOR_VERSION, + .minor_version = ERL_DRV_EXTENDED_MINOR_VERSION, + .driver_flags = ERL_DRV_FLAG_USE_PORT_LOCKING, + .stop_select = stop_select +}; + diff --git a/erts/emulator/drivers/ose/ttsl_drv.c b/erts/emulator/drivers/ose/ttsl_drv.c new file mode 100644 index 0000000000..8af2ce6af3 --- /dev/null +++ b/erts/emulator/drivers/ose/ttsl_drv.c @@ -0,0 +1,68 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2013. 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% + */ +/* + * Stub tty driver because group/user depend on this. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "erl_driver.h" + +static int ttysl_init(void); +static ErlDrvData ttysl_start(ErlDrvPort, char*); + +/* Define the driver table entry. */ +struct erl_drv_entry ttsl_driver_entry = { + ttysl_init, + ttysl_start, + NULL, + NULL, + NULL, + NULL, + "tty_sl", + NULL, + NULL, + NULL, + NULL, /* timeout */ + NULL, /* outputv */ + NULL, /* ready_async */ + NULL, /* flush */ + NULL, /* call */ + NULL, /* event */ + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, /* ERL_DRV_FLAGs */ + NULL, + NULL, /* process_exit */ + NULL +}; + + +static int ttysl_init(void) +{ + return 0; +} + +static ErlDrvData ttysl_start(ErlDrvPort port, char* buf) +{ + return ERL_DRV_ERROR_GENERAL; +} diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c index 8ffc05da99..42f41c5f3d 100644 --- a/erts/emulator/drivers/unix/unix_efile.c +++ b/erts/emulator/drivers/unix/unix_efile.c @@ -102,6 +102,11 @@ check_error(int result, Efile_error *errInfo) } int +efile_init() { + return 1; +} + +int efile_mkdir(Efile_error* errInfo, /* Where to return error codes. */ char* name) /* Name of directory to create. */ { @@ -629,7 +634,8 @@ efile_writev(Efile_error* errInfo, /* Where to return error codes */ do { w = write(fd, iov[cnt].iov_base, iov[cnt].iov_len); } while (w < 0 && errno == EINTR); - ASSERT(w <= iov[cnt].iov_len); + ASSERT(w <= iov[cnt].iov_len || + (w == -1 && errno != EINTR)); } if (w < 0) return check_error(-1, errInfo); /* Move forward to next buffer to write */ diff --git a/erts/emulator/drivers/win32/win_efile.c b/erts/emulator/drivers/win32/win_efile.c index d693d7d593..a321bb9641 100644 --- a/erts/emulator/drivers/win32/win_efile.c +++ b/erts/emulator/drivers/win32/win_efile.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2013. All Rights Reserved. + * Copyright Ericsson AB 1997-2014. 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 @@ -29,12 +29,27 @@ #include <wchar.h> #include "erl_efile.h" +#define DBG_TRACE_MASK 0 +/* 1 = file name ops + * 2 = file descr ops + * 4 = errors + * 8 = path name conversion + */ +#if !DBG_TRACE_MASK +# define DBG_TRACE(M,S) +# define DBG_TRACE1(M,FMT,A) +# define DBG_TRACE2(M,FMT,A,B) +#else +# define DBG_TRACE(M,S) do { if ((M)&DBG_TRACE_MASK) fwprintf(stderr, L"DBG_TRACE %d: %s\r\n", __LINE__, (WCHAR*)(S)); }while(0) +# define DBG_TRACE1(M,FMT,A) do { if ((M)&DBG_TRACE_MASK) fwprintf(stderr, L"DBG_TRACE %d: " L##FMT L"\r\n", __LINE__, (A)); }while(0) +# define DBG_TRACE2(M,FMT,A,B) do { if ((M)&DBG_TRACE_MASK) fwprintf(stderr, L"DBG_TRACE %d: " L##FMT L"\r\n", __LINE__, (A), (B)); }while(0) +#endif + /* * Microsoft-specific function to map a WIN32 error code to a Posix errno. */ #define ISSLASH(a) ((a) == L'\\' || (a) == L'/') - #define ISDIR(st) (((st).st_mode&S_IFMT) == S_IFDIR) #define ISREG(st) (((st).st_mode&S_IFMT) == S_IFREG) @@ -69,10 +84,92 @@ static int check_error(int result, Efile_error* errInfo); static int set_error(Efile_error* errInfo); +static int set_os_errno(Efile_error* errInfo, DWORD os_errno); static int is_root_unc_name(const WCHAR *path); static int extract_root(WCHAR *name); static unsigned short dos_to_posix_mode(int attr, const WCHAR *name); + +struct wpath_tmp_buffer { + struct wpath_tmp_buffer* next; + WCHAR buffer[1]; +}; + +typedef struct { + Efile_error* errInfo; + struct wpath_tmp_buffer* buf_list; +}Efile_call_state; + +static void call_state_init(Efile_call_state* state, Efile_error* errInfo) +{ + state->errInfo = errInfo; + state->buf_list = NULL; +} +static WCHAR* wpath_tmp_alloc(Efile_call_state* state, size_t len) +{ + size_t sz = offsetof(struct wpath_tmp_buffer, buffer) + + (len+1)*sizeof(WCHAR); + struct wpath_tmp_buffer* p = driver_alloc(sz); + p->next = state->buf_list; + state->buf_list = p; + return p->buffer; +} +static void call_state_free(Efile_call_state* state) +{ + while(state->buf_list) { + struct wpath_tmp_buffer* next = state->buf_list->next; + driver_free(state->buf_list); + state->buf_list = next; + } +} +static WCHAR* get_cwd_wpath_tmp(Efile_call_state* state) +{ + WCHAR dummy; + DWORD size = GetCurrentDirectoryW(0, &dummy); + WCHAR* ret = NULL; + + if (size) { + ret = wpath_tmp_alloc(state, size); + if (!GetCurrentDirectoryW(size, ret)) { + ret = NULL; + } + } + return ret; +} +static WCHAR* get_full_wpath_tmp(Efile_call_state* state, + const WCHAR* file, + WCHAR** file_part, + DWORD extra) +{ + WCHAR dummy; + DWORD size = GetFullPathNameW(file, 0, &dummy, NULL); + WCHAR* ret = NULL; + + if (size) { + int ok; + ret = wpath_tmp_alloc(state, size + extra); + if (file_part) { + ok = (GetFullPathNameW(file, size, ret, file_part) != 0); + } + else { + ok = (_wfullpath(ret, file, size) != NULL); + } + if (!ok) { + ret = NULL; + } + } + return ret; +} + +static void ensure_wpath_max(Efile_call_state* state, WCHAR** pathp, size_t max); +static int do_rmdir(Efile_call_state*, char* name); +static int do_rename(Efile_call_state*, char* src, char* dst); +static int do_readdir(Efile_call_state*, char* name, EFILE_DIR_HANDLE*, char* buffer, size_t *size); +static int do_fileinfo(Efile_call_state*, Efile_info*, char* orig_name, int info_for_link); +static char* do_readlink(Efile_call_state*, char* name, char* buffer, size_t size); +static int do_altname(Efile_call_state*, char* orig_name, char* buffer, size_t size); + + static int errno_map(DWORD last_error) { switch (last_error) { @@ -154,6 +251,8 @@ static int errno_map(DWORD last_error) { return EAGAIN; case ERROR_CANT_RESOLVE_FILENAME: return EMLINK; + case ERROR_PRIVILEGE_NOT_HELD: + return EPERM; case ERROR_ARENA_TRASHED: case ERROR_INVALID_BLOCK: case ERROR_BAD_ENVIRONMENT: @@ -176,11 +275,23 @@ check_error(int result, Efile_error* errInfo) if (result < 0) { errInfo->posix_errno = errno; errInfo->os_errno = GetLastError(); + DBG_TRACE2(4, "ERROR os_error=%d errno=%d @@@@@@@@@@@@@@@@@@@@@@@@@@@@", + errInfo->os_errno, errInfo->posix_errno); return 0; } return 1; } +static void +save_last_error(Efile_error* errInfo) +{ + errInfo->posix_errno = errno; + errInfo->os_errno = GetLastError(); + DBG_TRACE2(4, "ERROR os_error=%d errno=%d $$$$$$$$$$$$$$$$$$$$$$$$$$$$$", + errInfo->os_errno, errInfo->posix_errno); +} + + /* * Fills the provided error information structure with information * with the error code given by GetLastError() and its corresponding @@ -192,10 +303,26 @@ check_error(int result, Efile_error* errInfo) static int set_error(Efile_error* errInfo) { - errInfo->posix_errno = errno_map(errInfo->os_errno = GetLastError()); + set_os_errno(errInfo, GetLastError()); return 0; } + +static int +set_os_errno(Efile_error* errInfo, DWORD os_errno) +{ + errInfo->os_errno = os_errno; + errInfo->posix_errno = errno_map(os_errno); + DBG_TRACE2(4, "ERROR os_error=%d errno=%d ############################", + errInfo->os_errno, errInfo->posix_errno); + return 0; +} + +int +efile_init() { + return 1; +} + /* * A writev with Unix semantics, but with Windows arguments */ @@ -221,21 +348,151 @@ win_writev(Efile_error* errInfo, } +/* Check '*pathp' and convert it if needed to something that windows will accept. + * Typically use UNC path with \\?\ prefix if absolute path is longer than 260. + */ +static void ensure_wpath(Efile_call_state* state, WCHAR** pathp) +{ + ensure_wpath_max(state, pathp, MAX_PATH); +} + +static void ensure_wpath_max(Efile_call_state* state, WCHAR** pathp, size_t max) +{ + WCHAR* path = *pathp; + WCHAR* p; + size_t len = wcslen(path); + int unc_fixup = 0; + + if (path[0] == 0) { + DBG_TRACE(8, L"Let empty path pass through"); + return; + } + + DBG_TRACE1(8,"IN: %s", path); + + if (path[1] == L':' && ISSLASH(path[2])) { /* absolute path */ + if (len >= max) { + WCHAR *src, *dst; + + *pathp = wpath_tmp_alloc(state, 4+len+1); + dst = *pathp; + wcscpy(dst, L"\\\\?\\"); + for (src=path,dst+=4; *src; src++) { + if (*src == L'/') { + if (dst[-1] != L'\\') { + *dst++ = L'\\'; + } + /*else ignore redundant slashes */ + } + else + *dst++ = *src; + } + *dst = 0; + unc_fixup = 1; + } + } + else if (!(ISSLASH(path[0]) && ISSLASH(path[1]))) { /* relative path */ + DWORD cwdLen = GetCurrentDirectoryW(0, NULL); + DWORD absLen = cwdLen + 1 + len; + if (absLen >= max) { + WCHAR *fullPath = wpath_tmp_alloc(state, 4+4+absLen); + DWORD fullLen; + + fullLen = GetFullPathNameW(path, 4 + absLen, fullPath+4, NULL); + if (fullLen >= 4+absLen) { + *pathp = path; + DBG_TRACE2(8,"ensure_wpath FAILED absLen=%u %s", (int)absLen, path); + return; + } + /* GetFullPathNameW can return paths longer than MAX_PATH without the \\?\ prefix. + * At least seen on Windows 7. Go figure... + */ + if (fullLen >= max && wcsncmp(fullPath+4, L"\\\\?\\", 4) != 0) { + wcsncpy(fullPath, L"\\\\?\\", 4); + *pathp = fullPath; + } + else { + *pathp = fullPath + 4; + } + } + } + + if (unc_fixup) { + WCHAR* endp; + + p = *pathp; + len = wcslen(p); + endp = p + len; + if (len > 4) { + p += 4; + while (*p) { + if (p[0] == L'\\' && p[1] == L'.') { + if (p[2] == L'\\' || !p[2]) { /* single dot */ + wmemmove(p, p+2, (&endp[1] - &p[2])); + endp -= 2; + } + else if (p[2] == L'.' && (p[3] == L'\\' || !p[3])) { /* double dot */ + WCHAR* r; + for (r=p-1; *r == L'\\'; --r) + /*skip redundant slashes*/; + for (; *r != L'\\'; --r) + /*find start of prev directory*/; + if (r < *pathp + 6) + break; + wmemmove(r, p+3, (&endp[1] - &p[3])); + p = r; + } + else p += 3; + } + else ++p; + } + } + } + DBG_TRACE1(8,"OUT: %s", *pathp); +} int efile_mkdir(Efile_error* errInfo, /* Where to return error codes. */ char* name) /* Name of directory to create. */ { - return check_error(_wmkdir((WCHAR *) name), errInfo); + Efile_call_state state; + WCHAR* wname = (WCHAR*)name; + int ret; + + DBG_TRACE(1, name); + call_state_init(&state, errInfo); + ensure_wpath_max(&state, &wname, 248); /* Yes, 248 limit for normal paths */ + + ret = (int) CreateDirectoryW(wname, NULL); + if (!ret) + set_error(errInfo); + + call_state_free(&state); + return ret; } int efile_rmdir(Efile_error* errInfo, /* Where to return error codes. */ char* name) /* Name of directory to delete. */ { + Efile_call_state state; + int ret; + + DBG_TRACE(1, name); + call_state_init(&state, errInfo); + ret = do_rmdir(&state, name); + call_state_free(&state); + return ret; +} + +static int do_rmdir(Efile_call_state* state, char* name) +{ OSVERSIONINFO os; DWORD attr; WCHAR *wname = (WCHAR *) name; + WCHAR *buffer = NULL; + + ensure_wpath(state, &wname); if (RemoveDirectoryW(wname) != FALSE) { return 1; @@ -265,10 +522,9 @@ efile_rmdir(Efile_error* errInfo, /* Where to return error codes. */ if (os.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS) { HANDLE handle; WIN32_FIND_DATAW data; - WCHAR buffer[2*MAX_PATH]; - int len; + int len = wcslen(wname); - len = wcslen(wname); + buffer = wpath_tmp_alloc(state, len + 4); wcscpy(buffer, wname); if (buffer[0] && buffer[len-1] != L'\\' && buffer[len-1] != L'/') { wcscat(buffer, L"\\"); @@ -306,16 +562,30 @@ efile_rmdir(Efile_error* errInfo, /* Where to return error codes. */ } end: - return check_error(-1, errInfo); + save_last_error(state->errInfo); + return 0; } int efile_delete_file(Efile_error* errInfo, /* Where to return error codes. */ char* name) /* Name of file to delete. */ { + Efile_call_state state; + int ret; + DBG_TRACE(1, name); + call_state_init(&state, errInfo); + ret = do_delete_file(&state, name); + call_state_free(&state); + return ret; +} + +static int do_delete_file(Efile_call_state* state, char* name) +{ DWORD attr; WCHAR *wname = (WCHAR *) name; + ensure_wpath(state, &wname); + if (DeleteFileW(wname) != FALSE) { return 1; } @@ -354,7 +624,7 @@ efile_delete_file(Efile_error* errInfo, /* Where to return error codes. */ errno = EACCES; } - return check_error(-1, errInfo); + return check_error(-1, state->errInfo); } /* @@ -388,14 +658,29 @@ efile_delete_file(Efile_error* errInfo, /* Where to return error codes. */ */ int -efile_rename(Efile_error* errInfo, /* Where to return error codes. */ - char* src, /* Original name. */ - char* dst) /* New name. */ +efile_rename(Efile_error* errInfo, char* src, char* dst) +{ + Efile_call_state state; + int ret; + DBG_TRACE(1, src); + call_state_init(&state, errInfo); + ret = do_rename(&state, src, dst); + call_state_free(&state); + return ret; +} + +static int +do_rename(Efile_call_state* state, + char* src, /* Original name. */ + char* dst) /* New name. */ { DWORD srcAttr, dstAttr; WCHAR *wsrc = (WCHAR *) src; WCHAR *wdst = (WCHAR *) dst; - + + ensure_wpath(state, &wsrc); + ensure_wpath(state, &wdst); + if (MoveFileW(wsrc, wdst) != FALSE) { return 1; } @@ -412,23 +697,27 @@ efile_rename(Efile_error* errInfo, /* Where to return error codes. */ if (errno == EBADF) { errno = EACCES; - return check_error(-1, errInfo); + return check_error(-1, state->errInfo); } if (errno == EACCES) { decode: if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) { - WCHAR srcPath[MAX_PATH], dstPath[MAX_PATH]; + WCHAR *srcPath, *dstPath; WCHAR *srcRest, *dstRest; int size; - size = GetFullPathNameW(wsrc, MAX_PATH, srcPath, &srcRest); - if ((size == 0) || (size > MAX_PATH)) { - return check_error(-1, errInfo); + srcPath = get_full_wpath_tmp(state, wsrc, &srcRest, 0); + if (!srcPath) { + save_last_error(state->errInfo); + return 0; } - size = GetFullPathNameW(wdst, MAX_PATH, dstPath, &dstRest); - if ((size == 0) || (size > MAX_PATH)) { - return check_error(-1, errInfo); + + dstPath = get_full_wpath_tmp(state, wdst, &dstRest, 0); + if (!dstPath) { + save_last_error(state->errInfo); + return 0; } + if (srcRest == NULL) { srcRest = srcPath + wcslen(srcPath); } @@ -533,14 +822,16 @@ efile_rename(Efile_error* errInfo, /* Where to return error codes. */ * put temp file back to old name. */ - WCHAR tempName[MAX_PATH]; - int result, size; + WCHAR *tempName; + int result; WCHAR *rest; - size = GetFullPathNameW(wdst, MAX_PATH, tempName, &rest); - if ((size == 0) || (size > MAX_PATH) || (rest == NULL)) { - return check_error(-1, errInfo); + tempName = get_full_wpath_tmp(state, wdst, &rest, 14); + if (!tempName || !rest) { + save_last_error(state->errInfo); + return 0; } + *rest = L'\0'; result = -1; if (GetTempFileNameW(tempName, L"erlr", 0, tempName) != 0) { @@ -573,7 +864,6 @@ efile_rename(Efile_error* errInfo, /* Where to return error codes. */ /* * Decode the EACCES to a more meaningful error. */ - goto decode; } } @@ -581,16 +871,20 @@ efile_rename(Efile_error* errInfo, /* Where to return error codes. */ } } } - return check_error(-1, errInfo); + return check_error(-1, state->errInfo); } int efile_chdir(Efile_error* errInfo, /* Where to return error codes. */ char* name) /* Name of directory to make current. */ -{ - int success = check_error(_wchdir((WCHAR *) name), errInfo); - if (!success && errInfo->posix_errno == EINVAL) - /* POSIXification of errno */ +{
+ /* We don't even try to handle long paths here
+ * as current working directory is always limited to MAX_PATH
+ * even if we use UNC paths and SetCurrentDirectoryW()
+ */
+ int success = check_error(_wchdir((WCHAR *) name), errInfo);
+ if (!success && errInfo->posix_errno == EINVAL)
+ /* POSIXification of errno */
errInfo->posix_errno = ENOENT; return success; } @@ -603,28 +897,45 @@ efile_getdcwd(Efile_error* errInfo, /* Where to return error codes. */ { WCHAR *wbuffer = (WCHAR *) buffer; size_t wbuffer_size = size / 2; - if (_wgetdcwd(drive, wbuffer, wbuffer_size) == NULL) + DBG_TRACE(1, L"#getdcwd#"); + if (_wgetdcwd(drive, wbuffer, wbuffer_size) == NULL) { return check_error(-1, errInfo); + } + DBG_TRACE1(8, "getdcwd OS=%s", wbuffer); + if (wcsncmp(wbuffer, L"\\\\?\\", 4) == 0) { + wmemmove(wbuffer, wbuffer+4, wcslen(wbuffer+4)+1); + } for ( ; *wbuffer; wbuffer++) if (*wbuffer == L'\\') *wbuffer = L'/'; + DBG_TRACE1(8, "getdcwd ERLANG=%s", (WCHAR*)buffer); return 1; } int -efile_readdir(Efile_error* errInfo, /* Where to return error codes. */ - char* name, /* Name of directory to list */ - EFILE_DIR_HANDLE* dir_handle, /* Handle of opened directory or NULL */ - char* buffer, /* Buffer to put one filename in */ - size_t *size) /* in-out size of buffer/size of filename excluding zero - termination in bytes*/ +efile_readdir(Efile_error* errInfo, char* name, EFILE_DIR_HANDLE* dir_handle, + char* buffer, size_t *size) +{ + Efile_call_state state; + int ret; + DBG_TRACE(dir_handle?2:1, name); + call_state_init(&state, errInfo); + ret = do_readdir(&state, name, dir_handle, buffer, size); + call_state_free(&state); + return ret; +} + +static int do_readdir(Efile_call_state* state, + char* name, /* Name of directory to list */ + EFILE_DIR_HANDLE* dir_handle, /* Handle of opened directory or NULL */ + char* buffer, /* Buffer to put one filename in */ + size_t *size) /* in-out size of buffer/size of filename excluding zero + termination in bytes*/ { HANDLE dir; /* Handle to directory. */ - WCHAR wildcard[MAX_PATH]; /* Wildcard to search for. */ WIN32_FIND_DATAW findData; /* Data found by FindFirstFile() or FindNext(). */ /* Alignment is not honored, this works on x86 because of alignment fixup by processor. Not perfect, but faster than alinging by hand (really) */ - WCHAR *wname = (WCHAR *) name; WCHAR *wbuffer = (WCHAR *) buffer; /* @@ -632,13 +943,15 @@ efile_readdir(Efile_error* errInfo, /* Where to return error codes. */ */ if (*dir_handle == NULL) { - int length = wcslen(wname); + WCHAR *wname = (WCHAR *) name; + WCHAR* wildcard; + int length; WCHAR* s; - if (length+3 >= MAX_PATH) { - errno = ENAMETOOLONG; - return check_error(-1, errInfo); - } + ensure_wpath_max(state, &wname, MAX_PATH-2); + length = wcslen(wname); + + wildcard = wpath_tmp_alloc(state, length+3); wcscpy(wildcard, wname); s = wildcard+length-1; @@ -648,8 +961,10 @@ efile_readdir(Efile_error* errInfo, /* Where to return error codes. */ *++s = L'\0'; DEBUGF(("Reading %ws\n", wildcard)); dir = FindFirstFileW(wildcard, &findData); - if (dir == INVALID_HANDLE_VALUE) - return set_error(errInfo); + if (dir == INVALID_HANDLE_VALUE) { + set_error(state->errInfo); + return 0; + } *dir_handle = (EFILE_DIR_HANDLE) dir; if (!IS_DOT_OR_DOTDOT(findData.cFileName)) { @@ -659,7 +974,6 @@ efile_readdir(Efile_error* errInfo, /* Where to return error codes. */ } } - /* * Retrieve the name of the next file using the directory handle. */ @@ -676,24 +990,36 @@ efile_readdir(Efile_error* errInfo, /* Where to return error codes. */ } if (GetLastError() == ERROR_NO_MORE_FILES) { - FindClose(dir); - errInfo->posix_errno = errInfo->os_errno = 0; - return 0; + state->errInfo->posix_errno = state->errInfo->os_errno = 0; + } + else { + set_error(state->errInfo); } - - set_error(errInfo); FindClose(dir); return 0; } } int -efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ - char* name, /* Name of directory to open. */ - int flags, /* Flags to use for opening. */ - int* pfd, /* Where to store the file descriptor. */ - Sint64* pSize) /* Where to store the size of the file. */ +efile_openfile(Efile_error* errInfo, char* name, int flags, int* pfd, Sint64* pSize) +{ + Efile_call_state state; + int ret; + DBG_TRACE1(1, "openfile(%s)", name); + call_state_init(&state, errInfo); + ret = do_openfile(&state, name, flags, pfd, pSize); + call_state_free(&state); + return ret; +} + +static +int do_openfile(Efile_call_state* state, /* Where to return error codes. */ + char* name, /* Name of directory to open. */ + int flags, /* Flags to use for opening. */ + int* pfd, /* Where to store the file descriptor. */ + Sint64* pSize) /* Where to store the size of the file. */ { + Efile_error* errInfo = state->errInfo; BY_HANDLE_FILE_INFORMATION fileInfo; /* File information from a handle. */ HANDLE fd; /* Handle to open file. */ DWORD access; /* Access mode: GENERIC_READ, GENERIC_WRITE. */ @@ -730,6 +1056,7 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ if (flags & EFILE_MODE_EXCL) { crFlags = CREATE_NEW; } + ensure_wpath(state, &wname); fd = CreateFileW(wname, access, FILE_SHARE_FLAGS, NULL, crFlags, flagsAndAttrs, NULL); @@ -772,34 +1099,56 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ } int -efile_may_openfile(Efile_error* errInfo, char *name) { +efile_may_openfile(Efile_error* errInfo, char *name) +{ + Efile_call_state state; WCHAR *wname = (WCHAR *) name; DWORD attr; + int ret; + DBG_TRACE(1, name); + call_state_init(&state, errInfo); + ensure_wpath(&state, &wname); if ((attr = GetFileAttributesW(wname)) == INVALID_FILE_ATTRIBUTES) { errno = ENOENT; - return check_error(-1, errInfo); + ret = check_error(-1, errInfo); } - - if (attr & FILE_ATTRIBUTE_DIRECTORY) { + else if (attr & FILE_ATTRIBUTE_DIRECTORY) { errno = EISDIR; - return check_error(-1, errInfo); + ret = check_error(-1, errInfo); } - return 1; + else ret = 1; + + call_state_free(&state); + return ret; } void efile_closefile(fd) int fd; /* File descriptor for file to close. */ { + DBG_TRACE(2, L""); CloseHandle((HANDLE) fd); } +FILE* efile_wfopen(const WCHAR* name, const WCHAR* mode) +{ + Efile_call_state state; + Efile_error dummy; + FILE* f; + call_state_init(&state, &dummy); + ensure_wpath(&state, (WCHAR**)&name); + f = _wfopen(name, mode); + call_state_free(&state); + return f; +} + int efile_fdatasync(errInfo, fd) Efile_error* errInfo; /* Where to return error codes. */ int fd; /* File descriptor for file to sync. */ { + DBG_TRACE(2, L""); /* Not available in Windows, just call regular fsync */ return efile_fsync(errInfo, fd); } @@ -809,6 +1158,7 @@ efile_fsync(errInfo, fd) Efile_error* errInfo; /* Where to return error codes. */ int fd; /* File descriptor for file to sync. */ { + DBG_TRACE(2, L""); if (!FlushFileBuffers((HANDLE) fd)) { return check_error(-1, errInfo); } @@ -819,64 +1169,87 @@ int efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo, char* orig_name, int info_for_link) { + Efile_call_state state; + int ret; + DBG_TRACE(1, L""); + call_state_init(&state, errInfo); + ret = do_fileinfo(&state, pInfo, orig_name, info_for_link); + call_state_free(&state); + return ret; +} + +static int +do_fileinfo(Efile_call_state* state, Efile_info* pInfo, + char* orig_name, int info_for_link) +{ + Efile_error* errInfo = state->errInfo; HANDLE findhandle; /* Handle returned by FindFirstFile(). */ WIN32_FIND_DATAW findbuf; /* Data return by FindFirstFile(). */ - WCHAR name[_MAX_PATH]; + WCHAR* name = NULL; + WCHAR* win_path; int name_len; - WCHAR *path; - WCHAR pathbuf[_MAX_PATH]; int drive; /* Drive for filename (1 = A:, 2 = B: etc). */ - WCHAR *worig_name = (WCHAR *) orig_name; + WCHAR *worig_name = (WCHAR *) orig_name; + ensure_wpath(state, &worig_name); /* Don't allow wildcards to be interpreted by system */ - if (wcspbrk(worig_name, L"?*")) { - enoent: - errInfo->posix_errno = ENOENT; - errInfo->os_errno = ERROR_FILE_NOT_FOUND; - return 0; - } /* * Move the name to a buffer and make sure to remove a trailing * slash, because it causes FindFirstFile() to fail on Win95. */ - if ((name_len = wcslen(worig_name)) >= _MAX_PATH) { - goto enoent; - } else { - wcscpy(name, worig_name); - if (name_len > 2 && ISSLASH(name[name_len-1]) && - name[name_len-2] != L':') { - name[name_len-1] = L'\0'; - } + name_len = wcslen(worig_name); + + name = wpath_tmp_alloc(state, name_len+1); + wcscpy(name, worig_name); + if (name_len > 2 && ISSLASH(name[name_len-1]) && + name[name_len-2] != L':') { + name[name_len-1] = L'\0'; } - + + win_path = name; + if (wcsncmp(name, L"\\\\?\\", 4) == 0) { + win_path += 4; + } + + if (wcspbrk(win_path, L"?*")) { + enoent: + errInfo->posix_errno = ENOENT; + errInfo->os_errno = ERROR_FILE_NOT_FOUND; + return 0; + } + /* Try to get disk from name. If none, get current disk. */ - if (name[1] != L':') { + if (win_path[1] != L':') { + WCHAR* cwd_path = get_cwd_wpath_tmp(state); drive = 0; - if (GetCurrentDirectoryW(_MAX_PATH, pathbuf) && - pathbuf[1] == L':') { - drive = towlower(pathbuf[0]) - L'a' + 1; + if (cwd_path[1] == L':') { + drive = towlower(cwd_path[0]) - L'a' + 1; } - } else if (*name && name[2] == L'\0') { + } else if (*win_path && win_path[2] == L'\0') { /* * X: and nothing more is an error. */ errInfo->posix_errno = ENOENT; errInfo->os_errno = ERROR_FILE_NOT_FOUND; return 0; - } else - drive = towlower(*name) - L'a' + 1; + } else { + drive = towlower(*win_path) - L'a' + 1; + } findhandle = FindFirstFileW(name, &findbuf); if (findhandle == INVALID_HANDLE_VALUE) { + WCHAR* path = NULL; + if (!(wcspbrk(name, L"./\\") && - (path = _wfullpath(pathbuf, name, _MAX_PATH)) && + (path = get_full_wpath_tmp(state, name, NULL, 0)) && /* root dir. ('C:\') or UNC root dir. ('\\server\share\') */ ((wcslen(path) == 3) || is_root_unc_name(path)) && (GetDriveTypeW(path) > 1) ) ) { + errInfo->posix_errno = ENOENT; errInfo->os_errno = ERROR_FILE_NOT_FOUND; return 0; @@ -903,13 +1276,11 @@ efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo, /* * given that we know this is a symlink, we should be able to find its target */ - WCHAR target_name[_MAX_PATH]; - if (efile_readlink(errInfo, (char *) name, - (char *) target_name, - _MAX_PATH * sizeof(WCHAR)) == 1) { + WCHAR* target_name = (WCHAR*) do_readlink(state, (char *) name, NULL, 0); + if (target_name) { FindClose(findhandle); - return efile_fileinfo(errInfo, pInfo, - (char *) target_name, info_for_link); + return do_fileinfo(state, pInfo, + (char *) target_name, info_for_link); } } @@ -976,6 +1347,20 @@ efile_write_info(Efile_error* errInfo, Efile_info* pInfo, char* name) { + Efile_call_state state; + int ret; + call_state_init(&state, errInfo); + ret = do_write_info(&state, pInfo, name); + call_state_free(&state); + return ret; +} + +static int +do_write_info(Efile_call_state* state, + Efile_info* pInfo, + char* name) +{ + Efile_error* errInfo = state->errInfo; SYSTEMTIME timebuf; FILETIME ModifyFileTime; FILETIME AccessFileTime; @@ -985,6 +1370,10 @@ efile_write_info(Efile_error* errInfo, DWORD tempAttr; WCHAR *wname = (WCHAR *) name; + DBG_TRACE(1, name); + + ensure_wpath(state, &wname); + /* * Get the attributes for the file. */ @@ -1061,7 +1450,9 @@ char* buf; /* Buffer to write. */ size_t count; /* Number of bytes to write. */ Sint64 offset; /* where to write it */ { - int res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL); + int res; + DBG_TRACE(2, L""); + res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL); if (res) { return efile_write(errInfo, EFILE_MODE_WRITE, fd, buf, count); } else { @@ -1079,7 +1470,9 @@ char* buf; /* Buffer to read into. */ size_t count; /* Number of bytes to read. */ size_t* pBytesRead; /* Where to return number of bytes read. */ { - int res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL); + int res; + DBG_TRACE(2, L""); + res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL); if (res) { return efile_read(errInfo, EFILE_MODE_READ, fd, buf, count, pBytesRead); } else { @@ -1101,6 +1494,7 @@ size_t count; /* Number of bytes to write. */ OVERLAPPED overlapped; OVERLAPPED* pOverlapped = NULL; + DBG_TRACE(2, L""); if (flags & EFILE_MODE_APPEND) { memset(&overlapped, 0, sizeof(overlapped)); overlapped.Offset = 0xffffffff; @@ -1130,6 +1524,7 @@ efile_writev(Efile_error* errInfo, /* Where to return error codes */ OVERLAPPED overlapped; OVERLAPPED* pOverlapped = NULL; + DBG_TRACE(2, L""); ASSERT(iovcnt >= 0); if (flags & EFILE_MODE_APPEND) { @@ -1166,6 +1561,8 @@ size_t count; /* Number of bytes to read. */ size_t* pBytesRead; /* Where to return number of bytes read. */ { DWORD nbytes = 0; + + DBG_TRACE(2, L""); if (!ReadFile((HANDLE) fd, buf, count, &nbytes, NULL)) return set_error(errInfo); @@ -1185,6 +1582,7 @@ Sint64* new_location; /* Resulting new location in file. */ { LARGE_INTEGER off, new_loc; + DBG_TRACE(2, L""); switch (origin) { case EFILE_SEEK_SET: origin = FILE_BEGIN; break; case EFILE_SEEK_CUR: origin = FILE_CURRENT; break; @@ -1216,6 +1614,7 @@ Efile_error* errInfo; /* Where to return error codes. */ int *fd; /* File descriptor for file to truncate. */ int flags; { + DBG_TRACE(2, L""); if (!SetEndOfFile((HANDLE) (*fd))) return set_error(errInfo); return 1; @@ -1368,9 +1767,24 @@ dos_to_posix_mode(int attr, const WCHAR *name) return uxmode; } + int efile_readlink(Efile_error* errInfo, char* name, char* buffer, size_t size) { + Efile_call_state state; + int ret; + DBG_TRACE(1, name); + call_state_init(&state, errInfo); + ret = !!do_readlink(&state, name, buffer, size); + call_state_free(&state); + return ret; +} + +/* If buffer==0, return buffer allocated by wpath_tmp_allocate +*/ +static char* +do_readlink(Efile_call_state* state, char* name, char* buffer, size_t size) +{ /* * load dll and see if we have CreateSymbolicLink at runtime: * (Vista only) @@ -1378,6 +1792,9 @@ efile_readlink(Efile_error* errInfo, char* name, char* buffer, size_t size) HINSTANCE hModule = NULL; WCHAR *wname = (WCHAR *) name; WCHAR *wbuffer = (WCHAR *) buffer; + DWORD wsize = size / sizeof(WCHAR); + char* ret = NULL; + if ((hModule = LoadLibrary("kernel32.dll")) != NULL) { typedef DWORD (WINAPI * GETFINALPATHNAMEBYHANDLEPTR)( HANDLE hFile, @@ -1388,58 +1805,84 @@ efile_readlink(Efile_error* errInfo, char* name, char* buffer, size_t size) GETFINALPATHNAMEBYHANDLEPTR pGetFinalPathNameByHandle = (GETFINALPATHNAMEBYHANDLEPTR)GetProcAddress(hModule, "GetFinalPathNameByHandleW"); - if (pGetFinalPathNameByHandle == NULL) { - FreeLibrary(hModule); - } else { + if (pGetFinalPathNameByHandle != NULL) { + DWORD fileAttributes; + ensure_wpath(state, &wname); /* first check if file is a symlink; {error, einval} otherwise */ - DWORD fileAttributes = GetFileAttributesW(wname); + fileAttributes = GetFileAttributesW(wname); if ((fileAttributes & FILE_ATTRIBUTE_REPARSE_POINT)) { - BOOLEAN success = 0; + DWORD success = 0; HANDLE h = CreateFileW(wname, GENERIC_READ, FILE_SHARE_FLAGS, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); int len; if(h != INVALID_HANDLE_VALUE) { - success = pGetFinalPathNameByHandle(h, wbuffer, size / sizeof(WCHAR),0); - /* GetFinalPathNameByHandle prepends path with "\\?\": */ - len = wcslen(wbuffer); - wmemmove(wbuffer,wbuffer+4,len-3); - if (len - 4 >= 2 && wbuffer[1] == L':' && wbuffer[0] >= L'A' && - wbuffer[0] <= L'Z') { - wbuffer[0] = wbuffer[0] + L'a' - L'A'; + if (!wbuffer) { /* dynamic allocation */ + WCHAR dummy; + wsize = pGetFinalPathNameByHandle(h, &dummy, 0, 0); + if (wsize) { + wbuffer = wpath_tmp_alloc(state, wsize); + } } + if (wbuffer + && (success = pGetFinalPathNameByHandle(h, wbuffer, wsize, 0)) + && success < wsize) { + WCHAR* wp; + + /* GetFinalPathNameByHandle prepends path with "\\?\": */ + len = wcslen(wbuffer); + wmemmove(wbuffer,wbuffer+4,len-3); + if (len - 4 >= 2 && wbuffer[1] == L':' && wbuffer[0] >= L'A' && + wbuffer[0] <= L'Z') { + wbuffer[0] = wbuffer[0] + L'a' - L'A'; + } - for ( ; *wbuffer; wbuffer++) - if (*wbuffer == L'\\') - *wbuffer = L'/'; + for (wp=wbuffer ; *wp; wp++) + if (*wp == L'\\') + *wp = L'/'; + } CloseHandle(h); - } - FreeLibrary(hModule); + } if (success) { - return 1; + ret = (char*) wbuffer; } else { - return set_error(errInfo); + set_error(state->errInfo); } } else { - FreeLibrary(hModule); errno = EINVAL; - return check_error(-1, errInfo); + save_last_error(state->errInfo); } + goto done; } } errno = ENOTSUP; - return check_error(-1, errInfo); + save_last_error(state->errInfo); + +done: + if (hModule) + FreeLibrary(hModule); + return ret; } int efile_altname(Efile_error* errInfo, char* orig_name, char* buffer, size_t size) { + Efile_call_state state; + int ret; + DBG_TRACE(1, orig_name); + call_state_init(&state, errInfo); + ret = do_altname(&state, orig_name, buffer, size); + call_state_free(&state); + return ret; +} + +static int +do_altname(Efile_call_state* state, char* orig_name, char* buffer, size_t size) +{ WIN32_FIND_DATAW wfd; HANDLE fh; - WCHAR name[_MAX_PATH+1]; + WCHAR* name; int name_len; - WCHAR* path; - WCHAR pathbuf[_MAX_PATH+1]; /* Unclear weather GetCurrentDirectory will access one char after - _MAX_PATH */ + WCHAR* full_path = NULL; WCHAR *worig_name = (WCHAR *) orig_name; WCHAR *wbuffer = (WCHAR *) buffer; int drive; /* Drive for filename (1 = A:, 2 = B: etc). */ @@ -1448,8 +1891,8 @@ efile_altname(Efile_error* errInfo, char* orig_name, char* buffer, size_t size) if (wcspbrk(worig_name, L"?*")) { enoent: - errInfo->posix_errno = ENOENT; - errInfo->os_errno = ERROR_FILE_NOT_FOUND; + state->errInfo->posix_errno = ENOENT; + state->errInfo->os_errno = ERROR_FILE_NOT_FOUND; return 0; } @@ -1457,24 +1900,23 @@ efile_altname(Efile_error* errInfo, char* orig_name, char* buffer, size_t size) * Move the name to a buffer and make sure to remove a trailing * slash, because it causes FindFirstFile() to fail on Win95. */ - - if ((name_len = wcslen(worig_name)) >= _MAX_PATH) { - goto enoent; - } else { - wcscpy(name, worig_name); - if (name_len > 2 && ISSLASH(name[name_len-1]) && - name[name_len-2] != L':') { - name[name_len-1] = L'\0'; - } + ensure_wpath(state, &worig_name); + name_len = wcslen(worig_name); + + name = wpath_tmp_alloc(state, name_len + 1); + wcscpy(name, worig_name); + if (name_len > 2 && ISSLASH(name[name_len-1]) && + name[name_len-2] != L':') { + name[name_len-1] = L'\0'; } /* Try to get disk from name. If none, get current disk. */ if (name[1] != L':') { + WCHAR* cwd_path = get_cwd_wpath_tmp(state); drive = 0; - if (GetCurrentDirectoryW(_MAX_PATH, pathbuf) && - pathbuf[1] == L':') { - drive = towlower(pathbuf[0]) - L'a' + 1; + if (cwd_path[1] == L':') { + drive = towlower(cwd_path[0]) - L'a' + 1; } } else if (*name && name[2] == L'\0') { /* @@ -1486,13 +1928,15 @@ efile_altname(Efile_error* errInfo, char* orig_name, char* buffer, size_t size) } fh = FindFirstFileW(name,&wfd); if (fh == INVALID_HANDLE_VALUE) { + DWORD fff_error = GetLastError(); if (!(wcspbrk(name, L"./\\") && - (path = _wfullpath(pathbuf, name, _MAX_PATH)) && + (full_path = get_full_wpath_tmp(state, name, NULL, 0)) && /* root dir. ('C:\') or UNC root dir. ('\\server\share\') */ - ((wcslen(path) == 3) || is_root_unc_name(path)) && - (GetDriveTypeW(path) > 1) ) ) { - errno = errno_map(GetLastError()); - return check_error(-1, errInfo); + ((wcslen(full_path) == 3) || is_root_unc_name(full_path)) && + (GetDriveTypeW(full_path) > 1) ) ) { + + set_os_errno(state->errInfo, fff_error); + return 0; } /* * Root directories (such as C:\ or \\server\share\ are fabricated. @@ -1513,17 +1957,37 @@ efile_altname(Efile_error* errInfo, char* orig_name, char* buffer, size_t size) int efile_link(Efile_error* errInfo, char* old, char* new) { + Efile_call_state state; WCHAR *wold = (WCHAR *) old; WCHAR *wnew = (WCHAR *) new; + int ret; + DBG_TRACE(1, old); + call_state_init(&state, errInfo); + ensure_wpath(&state, &wold); + ensure_wpath(&state, &wnew); if(!CreateHardLinkW(wnew, wold, NULL)) { - return set_error(errInfo); + ret = set_error(errInfo); } - return 1; + else ret =1; + call_state_free(&state); + return ret; } int efile_symlink(Efile_error* errInfo, char* old, char* new) { + Efile_call_state state; + int ret; + DBG_TRACE2(1, "symlink(%s <- %s)", old, new); + call_state_init(&state, errInfo); + ret = do_symlink(&state, old, new); + call_state_free(&state); + return ret; +} + +static int +do_symlink(Efile_call_state* state, char* old, char* new) +{ /* * Load dll and see if we have CreateSymbolicLink at runtime: * (Vista only) @@ -1531,6 +1995,8 @@ efile_symlink(Efile_error* errInfo, char* old, char* new) HINSTANCE hModule = NULL; WCHAR *wold = (WCHAR *) old; WCHAR *wnew = (WCHAR *) new; + + DBG_TRACE(1, old); if ((hModule = LoadLibrary("kernel32.dll")) != NULL) { typedef BOOLEAN (WINAPI * CREATESYMBOLICLINKFUNCPTR) ( LPCWSTR lpSymlinkFileName, @@ -1542,6 +2008,9 @@ efile_symlink(Efile_error* errInfo, char* old, char* new) "CreateSymbolicLinkW"); /* A for MBCS, W for UNICODE... char* above implies 'W'! */ if (pCreateSymbolicLink != NULL) { + ensure_wpath(state, &wold); + ensure_wpath(state, &wnew); + { DWORD attr = GetFileAttributesW(wold); int flag = (attr != INVALID_FILE_ATTRIBUTES && attr & FILE_ATTRIBUTE_DIRECTORY) ? 1 : 0; @@ -1552,19 +2021,21 @@ efile_symlink(Efile_error* errInfo, char* old, char* new) if (success) { return 1; } else { - return set_error(errInfo); + return set_error(state->errInfo); } + } } else FreeLibrary(hModule); } errno = ENOTSUP; - return check_error(-1, errInfo); + return check_error(-1, state->errInfo); } int efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset, Sint64 length, int advise) { + DBG_TRACE(2, L""); /* posix_fadvise is not available on Windows, do nothing */ errno = ERROR_SUCCESS; return check_error(0, errInfo); @@ -1573,6 +2044,7 @@ efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset, int efile_fallocate(Efile_error* errInfo, int fd, Sint64 offset, Sint64 length) { + DBG_TRACE(2, L""); /* No file preallocation method available in Windows. */ errno = errno_map(ERROR_NOT_SUPPORTED); SetLastError(ERROR_NOT_SUPPORTED); diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c index fa99c817f0..2497d51df1 100644 --- a/erts/emulator/hipe/hipe_bif0.c +++ b/erts/emulator/hipe/hipe_bif0.c @@ -1101,9 +1101,9 @@ BIF_RETTYPE hipe_bifs_make_fun_3(BIF_ALIST_3) #endif /* - * args: Nativecodeaddress, Module, {Uniq, Index, BeamAddress} + * args: Module, {Uniq, Index, BeamAddress} */ -BIF_RETTYPE hipe_bifs_make_fe_3(BIF_ALIST_3) +BIF_RETTYPE hipe_bifs_get_fe_2(BIF_ALIST_2) { Eterm mod; Uint index; @@ -1111,20 +1111,15 @@ BIF_RETTYPE hipe_bifs_make_fe_3(BIF_ALIST_3) void *beam_address; ErlFunEntry *fe; Eterm *tp; - void *native_address; - - native_address = term_to_address(BIF_ARG_1); - if (!native_address) - BIF_ERROR(BIF_P, BADARG); - if (is_not_atom(BIF_ARG_2)) + if (is_not_atom(BIF_ARG_1)) BIF_ERROR(BIF_P, BADARG); - mod = BIF_ARG_2; + mod = BIF_ARG_1; - if (is_not_tuple(BIF_ARG_3) || - (arityval(*tuple_val(BIF_ARG_3)) != 3)) + if (is_not_tuple(BIF_ARG_2) || + (arityval(*tuple_val(BIF_ARG_2)) != 3)) BIF_ERROR(BIF_P, BADARG); - tp = tuple_val(BIF_ARG_3); + tp = tuple_val(BIF_ARG_2); if (term_to_Uint(tp[1], &uniq) == 0) BIF_ERROR(BIF_P, BADARG); if (term_to_Uint(tp[2], &index) == 0) @@ -1144,10 +1139,28 @@ BIF_RETTYPE hipe_bifs_make_fe_3(BIF_ALIST_3) printf("no fun entry for %s %ld:%ld\n", atom_buf, uniq, index); BIF_ERROR(BIF_P, BADARG); } + BIF_RET(address_to_term((void *)fe, BIF_P)); +} + +/* + * args: FE, Nativecodeaddress + */ +BIF_RETTYPE hipe_bifs_set_native_address_in_fe_2(BIF_ALIST_2) +{ + ErlFunEntry *fe; + void *native_address; + + fe = (ErlFunEntry *)term_to_address(BIF_ARG_1); + if (!fe) + BIF_ERROR(BIF_P, BADARG); + native_address = term_to_address(BIF_ARG_2); + if (!native_address) + BIF_ERROR(BIF_P, BADARG); + fe->native_address = native_address; if (erts_refc_dectest(&fe->refc, 0) == 0) erts_erase_fun_entry(fe); - BIF_RET(address_to_term((void *)fe, BIF_P)); + BIF_RET(am_true); } #if 0 /* XXX: unused */ diff --git a/erts/emulator/hipe/hipe_bif0.tab b/erts/emulator/hipe/hipe_bif0.tab index ce641365e9..2514b1c3a5 100644 --- a/erts/emulator/hipe/hipe_bif0.tab +++ b/erts/emulator/hipe/hipe_bif0.tab @@ -69,7 +69,8 @@ bif hipe_bifs:atom_to_word/1 bif hipe_bifs:term_to_word/1 #bif hipe_bifs:make_fun/3 -bif hipe_bifs:make_fe/3 +bif hipe_bifs:get_fe/2 +bif hipe_bifs:set_native_address_in_fe/2 #bif hipe_bifs:make_native_stub/2 bif hipe_bifs:find_na_or_make_stub/2 diff --git a/erts/emulator/hipe/hipe_bif2.c b/erts/emulator/hipe/hipe_bif2.c index c3687681cf..054911e822 100644 --- a/erts/emulator/hipe/hipe_bif2.c +++ b/erts/emulator/hipe/hipe_bif2.c @@ -157,7 +157,8 @@ BIF_RETTYPE hipe_bifs_modeswitch_debug_off_0(BIF_ALIST_0) 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) + if ((P)) erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN,\ + __FILE__, __LINE__) # define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) \ if ((P)) erts_proc_lc_unrequire_lock((P), ERTS_PROC_LOCK_MAIN) @@ -181,3 +182,10 @@ BIF_RETTYPE hipe_bifs_debug_native_called_2(BIF_ALIST_2) BIF_RET(am_ok); } +/* Stub-BIF for LLVM: + * Reloads BP, SP (in llvm unwind label) */ + +BIF_RETTYPE hipe_bifs_llvm_fix_pinned_regs_0(BIF_ALIST_0) +{ + BIF_RET(am_ok); +} diff --git a/erts/emulator/hipe/hipe_bif2.tab b/erts/emulator/hipe/hipe_bif2.tab index 45a395bf57..1b659cfa90 100644 --- a/erts/emulator/hipe/hipe_bif2.tab +++ b/erts/emulator/hipe/hipe_bif2.tab @@ -30,3 +30,4 @@ bif hipe_bifs:in_native/0 bif hipe_bifs:modeswitch_debug_on/0 bif hipe_bifs:modeswitch_debug_off/0 bif hipe_bifs:debug_native_called/2 +bif hipe_bifs:llvm_fix_pinned_regs/0 diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4 index b1fedf4838..0997d81b2f 100644 --- a/erts/emulator/hipe/hipe_bif_list.m4 +++ b/erts/emulator/hipe/hipe_bif_list.m4 @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2012. All Rights Reserved. + * Copyright Ericsson AB 2004-2014. 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 @@ -262,7 +262,17 @@ noproc_primop_interface_1(nbif_atomic_inc, hipe_atomic_inc) * Standard BIFs. * BIF_LIST(ModuleAtom,FunctionAtom,Arity,CFun,Index) */ -define(BIF_LIST,`standard_bif_interface_$3(nbif_$4, $4)') + +/* BIFs that disable GC while trapping are called via a wrapper + * to reserve stack space for the "trap frame". + */ +define(CFUN,`ifelse($1,term_to_binary_1,hipe_wrapper_term_to_binary_1, +ifelse($1,term_to_binary_2,hipe_wrapper_term_to_binary_2, +ifelse($1,erts_internal_binary_to_term_1,hipe_wrapper_erts_internal_binary_to_term_1, +ifelse($1,erts_internal_binary_to_term_2,hipe_wrapper_erts_internal_binary_to_term_2, +$1))))') + +define(BIF_LIST,`standard_bif_interface_$3(nbif_$4, CFUN($4))') include(TARGET/`erl_bif_list.h') /* diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c index adc8793469..4ddc2790b1 100644 --- a/erts/emulator/hipe/hipe_mode_switch.c +++ b/erts/emulator/hipe/hipe_mode_switch.c @@ -37,7 +37,8 @@ #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) + if ((P)) erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN, \ + __FILE__, __LINE__) # define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) \ if ((P)) erts_proc_lc_unrequire_lock((P), ERTS_PROC_LOCK_MAIN) #else @@ -184,21 +185,46 @@ void hipe_set_call_trap(Uint *bfun, void *nfun, int is_closure) bfun[-4] = (Uint)nfun; } -static __inline__ void -hipe_push_beam_trap_frame(Process *p, Eterm reg[], unsigned arity) +void hipe_reserve_beam_trap_frame(Process *p, Eterm reg[], unsigned arity) { /* ensure that at least 2 words are available on the BEAM stack */ if ((p->stop - 2) < p->htop) { - DPRINTF("calling gc to increase BEAM stack size"); + DPRINTF("calling gc to reserve BEAM stack size"); p->fcalls -= erts_garbage_collect(p, 2, reg, arity); + ASSERT(!((p->stop - 2) < p->htop)); } p->stop -= 2; + p->stop[0] = NIL; + p->stop[1] = NIL; +} + +static __inline__ void +hipe_push_beam_trap_frame(Process *p, Eterm reg[], unsigned arity) +{ + if (p->flags & F_DISABLE_GC) { + /* Trap frame already reserved */ + ASSERT(p->stop[0] == NIL && p->stop[1] == NIL); + } + else { + if ((p->stop - 2) < p->htop) { + DPRINTF("calling gc to increase BEAM stack size"); + p->fcalls -= erts_garbage_collect(p, 2, reg, arity); + ASSERT(!((p->stop - 2) < p->htop)); + } + p->stop -= 2; + } p->stop[1] = hipe_beam_catch_throw; p->stop[0] = make_cp(p->cp); ++p->catches; p->cp = hipe_beam_pc_return; } +void hipe_unreserve_beam_trap_frame(Process *p) +{ + ASSERT(p->stop[0] == NIL && p->stop[1] == NIL); + p->stop += 2; +} + static __inline__ void hipe_pop_beam_trap_frame(Process *p) { p->cp = cp_val(p->stop[0]); diff --git a/erts/emulator/hipe/hipe_mode_switch.h b/erts/emulator/hipe/hipe_mode_switch.h index a3e908a3b3..06721e3c04 100644 --- a/erts/emulator/hipe/hipe_mode_switch.h +++ b/erts/emulator/hipe/hipe_mode_switch.h @@ -59,6 +59,9 @@ void hipe_empty_nstack(Process *p); void hipe_set_closure_stub(ErlFunEntry *fe, unsigned num_free); Eterm hipe_build_stacktrace(Process *p, struct StackTrace *s); +void hipe_reserve_beam_trap_frame(Process*, Eterm reg[], unsigned arity); +void hipe_unreserve_beam_trap_frame(Process*); + extern Uint hipe_beam_pc_return[]; extern Uint hipe_beam_pc_throw[]; extern Uint hipe_beam_pc_resume[]; diff --git a/erts/emulator/hipe/hipe_x86_signal.c b/erts/emulator/hipe/hipe_x86_signal.c index 8f997aafab..f5668013e2 100644 --- a/erts/emulator/hipe/hipe_x86_signal.c +++ b/erts/emulator/hipe/hipe_x86_signal.c @@ -2,7 +2,7 @@ * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2013. All Rights Reserved. + * Copyright Ericsson AB 2001-2014. 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 @@ -304,7 +304,9 @@ static void hipe_sigaltstack(void *ss_sp) */ void hipe_thread_signal_init(void) { - hipe_sigaltstack(erts_alloc(ERTS_ALC_T_HIPE, SIGSTKSZ)); + /* Stack don't really need to be cache aligned. + We use it to suppress false leak report from valgrind */ + hipe_sigaltstack(erts_alloc_permanent_cache_aligned(ERTS_ALC_T_HIPE, SIGSTKSZ)); } #endif diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c index 7035dc77df..1db673e7f3 100644 --- a/erts/emulator/sys/common/erl_check_io.c +++ b/erts/emulator/sys/common/erl_check_io.c @@ -34,6 +34,7 @@ #endif #include "sys.h" #include "global.h" +#include "erl_port.h" #include "erl_check_io.h" #include "erl_thr_progress.h" #include "dtrace-wrapper.h" @@ -78,6 +79,8 @@ typedef char EventStateFlags; #define ERTS_CIO_POLL_INIT ERTS_POLL_EXPORT(erts_poll_init) #define ERTS_CIO_POLL_INFO ERTS_POLL_EXPORT(erts_poll_info) +#define GET_FD(fd) fd + static struct pollset_info { ErtsPollSet ps; @@ -524,7 +527,8 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix, /* fast track to stop_select callback */ stop_select_fn = prt->drv_ptr->stop_select; #ifdef USE_VM_PROBES - strncpy(name, prt->drv_ptr->name, sizeof(name)-1); + strncpy(name, prt->drv_ptr->name, + sizeof(DTRACE_CHARBUF_NAME(name))-1); name[sizeof(name)-1] = '\0'; #endif ret = 0; @@ -894,7 +898,7 @@ print_driver_name(erts_dsprintf_buf_t *dsbufp, Eterm id) static void steal(erts_dsprintf_buf_t *dsbufp, ErtsDrvEventState *state, int mode) { - erts_dsprintf(dsbufp, "stealing control of fd=%d from ", (int) state->fd); + erts_dsprintf(dsbufp, "stealing control of fd=%d from ", (int) GET_FD(state->fd)); switch (state->type) { case ERTS_EV_TYPE_DRV_SEL: { int deselect_mode = 0; @@ -918,7 +922,7 @@ steal(erts_dsprintf_buf_t *dsbufp, ErtsDrvEventState *state, int mode) if (deselect_mode) deselect(state, deselect_mode); else { - erts_dsprintf(dsbufp, "no one", (int) state->fd); + erts_dsprintf(dsbufp, "no one", (int) GET_FD(state->fd)); ASSERT(0); } erts_dsprintf(dsbufp, "\n"); @@ -946,7 +950,7 @@ steal(erts_dsprintf_buf_t *dsbufp, ErtsDrvEventState *state, int mode) break; } default: - erts_dsprintf(dsbufp, "no one\n", (int) state->fd); + erts_dsprintf(dsbufp, "no one\n", (int) GET_FD(state->fd)); ASSERT(0); } } @@ -957,10 +961,14 @@ print_select_op(erts_dsprintf_buf_t *dsbufp, { Port *pp = erts_drvport2port(ix); erts_dsprintf(dsbufp, +#ifdef __OSE__ + "driver_select(%p, %d,%s%s%s%s | %d, %d) " +#else "driver_select(%p, %d,%s%s%s%s, %d) " +#endif "by ", ix, - (int) fd, + (int) GET_FD(fd), mode & ERL_DRV_READ ? " ERL_DRV_READ" : "", mode & ERL_DRV_WRITE ? " ERL_DRV_WRITE" : "", mode & ERL_DRV_USE ? " ERL_DRV_USE" : "", @@ -1010,7 +1018,7 @@ steal_pending_stop_select(erts_dsprintf_buf_t *dsbufp, ErlDrvPort ix, ASSERT(state->type == ERTS_EV_TYPE_STOP_USE); erts_dsprintf(dsbufp, "failed: fd=%d (re)selected before stop_select " "was called for driver %s\n", - (int) state->fd, state->driver.drv_ptr->name); + (int) GET_FD(state->fd), state->driver.drv_ptr->name); erts_send_error_to_logger_nogl(dsbufp); if (on) { @@ -1395,6 +1403,26 @@ stale_drv_select(Eterm id, ErtsDrvEventState *state, int mode) } #ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS + +#ifdef __OSE__ +static SafeHashValue drv_ev_state_hash(void *des) +{ + ErtsSysFdType fd = ((ErtsDrvEventState *) des)->fd; + /* We use hash on signo ^ id in order for steal to happen when the + same signo + fd is selected on by two different ports */ + SafeHashValue val = (SafeHashValue)(fd->signo ^ fd->id); + return val ^ (val >> 8); +} + +static int drv_ev_state_cmp(void *des1, void *des2) +{ + ErtsSysFdType fd1 = ((ErtsDrvEventState *) des1)->fd; + ErtsSysFdType fd2 = ((ErtsDrvEventState *) des2)->fd; + if (fd1->signo == fd2->signo && fd1->id == fd2->id) + return 0; + return 1; +} +#else /* !__OSE__ && !ERTS_SYS_CONTINOUS_FD_NUMBERS i.e. probably windows */ static SafeHashValue drv_ev_state_hash(void *des) { SafeHashValue val = (SafeHashValue) ((ErtsDrvEventState *) des)->fd; @@ -1406,6 +1434,7 @@ static int drv_ev_state_cmp(void *des1, void *des2) return ( ((ErtsDrvEventState *) des1)->fd == ((ErtsDrvEventState *) des2)->fd ? 0 : 1); } +#endif static void *drv_ev_state_alloc(void *des_tmpl) { @@ -1882,12 +1911,14 @@ ERTS_CIO_EXPORT(erts_check_io_debug)(void) int fd, len; #endif IterDebugCounters counters; +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS ErtsDrvEventState null_des; null_des.driver.select = NULL; null_des.events = 0; null_des.remove_cnt = 0; null_des.type = ERTS_EV_TYPE_NONE; +#endif erts_printf("--- fds in pollset --------------------------------------\n"); diff --git a/erts/emulator/sys/common/erl_poll.h b/erts/emulator/sys/common/erl_poll.h index 09ed9f41af..2f1c05f401 100644 --- a/erts/emulator/sys/common/erl_poll.h +++ b/erts/emulator/sys/common/erl_poll.h @@ -90,7 +90,7 @@ # if defined(ERTS_USE_POLL) # undef ERTS_POLL_USE_POLL # define ERTS_POLL_USE_POLL 1 -# elif !defined(__WIN32__) +# elif !defined(__WIN32__) && !defined(__OSE__) # undef ERTS_POLL_USE_SELECT # define ERTS_POLL_USE_SELECT 1 # endif @@ -99,13 +99,31 @@ typedef Uint32 ErtsPollEvents; #undef ERTS_POLL_EV_E2N -#if defined(__WIN32__) /* --- win32 ------------------------------- */ +#if defined(__WIN32__) || defined(__OSE__) /* --- win32 or ose -------- */ #define ERTS_POLL_EV_IN 1 #define ERTS_POLL_EV_OUT 2 #define ERTS_POLL_EV_ERR 4 #define ERTS_POLL_EV_NVAL 8 +#ifdef __OSE__ + +typedef struct ErtsPollOseMsgList_ { + struct ErtsPollOseMsgList_ *next; + union SIGNAL *data; +} ErtsPollOseMsgList; + +struct erts_sys_fd_type { + SIGSELECT signo; + ErlDrvOseEventId id; + ErtsPollOseMsgList *msgs; + ErlDrvOseEventId (*resolve_signal)(union SIGNAL *sig); + ethr_mutex mtx; + void *extra; +}; + +#endif + #elif ERTS_POLL_USE_EPOLL /* --- epoll ------------------------------- */ #include <sys/epoll.h> @@ -228,7 +246,8 @@ ErtsPollEvents ERTS_POLL_EXPORT(erts_poll_control)(ErtsPollSet, ErtsSysFdType, ErtsPollEvents, int on, - int* wake_poller); + int* wake_poller + ); void ERTS_POLL_EXPORT(erts_poll_controlv)(ErtsPollSet, ErtsPollControlEntry [], int on); diff --git a/erts/emulator/sys/ose/beam.lmconf b/erts/emulator/sys/ose/beam.lmconf new file mode 100644 index 0000000000..4ad46b01d9 --- /dev/null +++ b/erts/emulator/sys/ose/beam.lmconf @@ -0,0 +1,26 @@ +OSE_LM_STACK_SIZES=256,512,1024,2048,4096,8192,16384,65536 +OSE_LM_SIGNAL_SIZES=31,63,127,255,1023,4095,16383,65535 +OSE_LM_POOL_SIZE=0x200000 +OSE_LM_MAIN_NAME=main +OSE_LM_MAIN_STACK_SIZE=0xF000 +OSE_LM_MAIN_PRIORITY=20 +## Has to be of a type that allows MAM +OSE_LM_PROGRAM_TYPE=APP_RAM +OSE_LM_DATA_INIT=YES +OSE_LM_BSS_INIT=YES +OSE_LM_EXEC_MODEL=SHARED +HEAP_MAX_SIZE=1000000000 +HEAP_SMALL_BUF_INIT_SIZE=20971520 +HEAP_LARGE_BUF_THRESHOLD=16000000 +HEAP_LOCK_TYPE=2 + +ERTS_DEFAULT_PRIO=24 +ERTS_SCHEDULER_PRIO=24 +ERTS_ASYNC_PRIO=22 +ERTS_AUX_PRIO=24 +ERTS_SYS_MSG_DISPATCHER_PRIO=21 + +# Setting the environment variable EFS_RESOLVE_TMO on the block to 0. +# This will eliminiate delays when trying to open files on not mounted +# volumes. +EFS_RESOLVE_TMO=0 diff --git a/erts/emulator/sys/ose/driver_int.h b/erts/emulator/sys/ose/driver_int.h new file mode 100644 index 0000000000..2c9ac955d8 --- /dev/null +++ b/erts/emulator/sys/ose/driver_int.h @@ -0,0 +1,41 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-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% + */ +/* + * System dependant driver declarations + */ + +#ifndef __DRIVER_INT_H__ +#define __DRIVER_INT_H__ + +#ifdef HAVE_SYS_UIO_H +#include <sys/types.h> +#include <sys/uio.h> + +typedef struct iovec SysIOVec; + +#else + +typedef struct { + char* iov_base; + int iov_len; +} SysIOVec; + +#endif + +#endif diff --git a/erts/emulator/sys/ose/erl_main.c b/erts/emulator/sys/ose/erl_main.c new file mode 100644 index 0000000000..23a9bc93a4 --- /dev/null +++ b/erts/emulator/sys/ose/erl_main.c @@ -0,0 +1,53 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2000-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% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include <stdlib.h> + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "ose.h" + +int +main(int argc, char **argv) { + + (void)stdin;(void)stdout;(void)stderr; + + /* When starting using pm_create -c ARGV="-- -root ..", argv[0] is the first + part of ARGV and not the name of the executable. So we shuffle some + pointers here to make erl_start happy. */ + if (argv[0][0] == '-') { + int i; + char **tmp_argv = malloc(sizeof(char*)*(argc+1)); + for (i = 0; i < argc; i++) + tmp_argv[i+1] = argv[i]; + tmp_argv[0] = "beam"; + erl_start(argc+1,tmp_argv); + free(tmp_argv); + } else { + erl_start(argc,argv); + } + + stop(current_process()); + + return 0; +} diff --git a/erts/emulator/sys/ose/erl_ose_sys.h b/erts/emulator/sys/ose/erl_ose_sys.h new file mode 100644 index 0000000000..cd66d95c26 --- /dev/null +++ b/erts/emulator/sys/ose/erl_ose_sys.h @@ -0,0 +1,353 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-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% + * + * This file handles differences between different Unix systems. + * This should be the only place with conditional compilation + * depending on the type of OS. + */ + +#ifndef _ERL_OSE_SYS_H +#define _ERL_OSE_SYS_H + +#include "ose.h" +#undef NIL +#include "ramlog.h" +#include "erts.sig" + +#include "fcntl.h" +#include "math.h" +#include "stdio.h" +#include "stdlib.h" +#include "string.h" +#include "sys/param.h" +#include "sys/time.h" +#include "time.h" +#include "dirent.h" +#include "ethread.h" + +/* FIXME: configuration options */ +#define ERTS_SCHED_MIN_SPIN 1 +#define ERTS_SCHED_ONLY_POLL_SCHED_1 1 +#define ERTS_SCHED_FAIR 1 +#define NO_SYSCONF 1 +#define OPEN_MAX FOPEN_MAX + +#define MAP_ANON MAP_ANONYMOUS + +#ifndef HAVE_MMAP +# define HAVE_MMAP 0 +#endif + +#if HAVE_MMAP +# include "sys/mman.h" +#endif + +/* + * Min number of async threads + */ +#define ERTS_MIN_NO_OF_ASYNC_THREADS 1 + +/* + * Our own type of "FD's" + */ +#define ERTS_SYS_FD_TYPE struct erts_sys_fd_type* +#define NO_FSTAT_ON_SYS_FD_TYPE 1 /* They are signals, not files */ + +#include "sys/stat.h" + +/* FIXME mremap is not defined in OSE - POSIX issue */ +extern void *mremap (void *__addr, size_t __old_len, size_t __new_len, + int __flags, ...); + +/* FIXME: mremap constants */ +#define MREMAP_MAYMOVE 1 +#define MREMAP_FIXED 2 + +typedef void *GETENV_STATE; + +/* +** For the erl_timer_sup module. +*/ +#define HAVE_GETHRTIME + +typedef long long SysHrTime; +extern SysHrTime sys_gethrtime(void); + +void sys_init_hrtime(void); + +typedef time_t erts_time_t; + +typedef struct timeval SysTimeval; + +#define sys_gettimeofday(Arg) ((void) gettimeofday((Arg), NULL)) + +typedef struct { + clock_t tms_utime; + clock_t tms_stime; + clock_t tms_cutime; + clock_t tms_cstime; +} SysTimes; + +extern int erts_ticks_per_sec; + +#define SYS_CLK_TCK (erts_ticks_per_sec) + +extern clock_t sys_times(SysTimes *buffer); + +/* No use in having other resolutions than 1 Ms. */ +#define SYS_CLOCK_RESOLUTION 1 + +#ifdef NO_FPE_SIGNALS + +#define erts_get_current_fp_exception() NULL +#ifdef ERTS_SMP +#define erts_thread_init_fp_exception() do{}while(0) +#endif +# define __ERTS_FP_CHECK_INIT(fpexnp) do {} while (0) +# define __ERTS_FP_ERROR(fpexnp, f, Action) if (!finite(f)) { Action; } else {} +# define __ERTS_FP_ERROR_THOROUGH(fpexnp, f, Action) __ERTS_FP_ERROR(fpexnp, f, Action) +# define __ERTS_SAVE_FP_EXCEPTION(fpexnp) +# define __ERTS_RESTORE_FP_EXCEPTION(fpexnp) + +#define erts_sys_block_fpe() 0 +#define erts_sys_unblock_fpe(x) do{}while(0) + +#else /* !NO_FPE_SIGNALS */ + +extern volatile unsigned long *erts_get_current_fp_exception(void); +#ifdef ERTS_SMP +extern void erts_thread_init_fp_exception(void); +#endif +# if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__) +# define erts_fwait(fpexnp,f) \ + __asm__ __volatile__("fwait" : "=m"(*(fpexnp)) : "m"(f)) +# elif (defined(__powerpc__) || defined(__ppc__)) && defined(__GNUC__) +# define erts_fwait(fpexnp,f) \ + __asm__ __volatile__("" : "=m"(*(fpexnp)) : "fm"(f)) +# elif defined(__sparc__) && defined(__linux__) && defined(__GNUC__) +# define erts_fwait(fpexnp,f) \ + __asm__ __volatile__("" : "=m"(*(fpexnp)) : "em"(f)) +# else +# define erts_fwait(fpexnp,f) \ + __asm__ __volatile__("" : "=m"(*(fpexnp)) : "g"(f)) +# endif +# if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__) + extern void erts_restore_fpu(void); +# else +# define erts_restore_fpu() /*empty*/ +# endif +# if (!defined(__GNUC__) || \ + (__GNUC__ < 2) || \ + (__GNUC__ == 2 && __GNUC_MINOR < 96)) && \ + !defined(__builtin_expect) +# define __builtin_expect(x, expected_value) (x) +# endif +static __inline__ int erts_check_fpe(volatile unsigned long *fp_exception, double f) +{ + erts_fwait(fp_exception, f); + if (__builtin_expect(*fp_exception == 0, 1)) + return 0; + *fp_exception = 0; + erts_restore_fpu(); + return 1; +} +# undef erts_fwait +# undef erts_restore_fpu +extern void erts_fp_check_init_error(volatile unsigned long *fp_exception); +static __inline__ void __ERTS_FP_CHECK_INIT(volatile unsigned long *fp_exception) +{ + if (__builtin_expect(*fp_exception == 0, 1)) + return; + erts_fp_check_init_error(fp_exception); +} +# define __ERTS_FP_ERROR(fpexnp, f, Action) do { if (erts_check_fpe((fpexnp),(f))) { Action; } } while (0) +# define __ERTS_SAVE_FP_EXCEPTION(fpexnp) unsigned long old_erl_fp_exception = *(fpexnp) +# define __ERTS_RESTORE_FP_EXCEPTION(fpexnp) \ + do { *(fpexnp) = old_erl_fp_exception; } while (0) + /* This is for library calls where we don't trust the external + code to always throw floating-point exceptions on errors. */ +static __inline__ int erts_check_fpe_thorough(volatile unsigned long *fp_exception, double f) +{ + return erts_check_fpe(fp_exception, f) || !finite(f); +} +# define __ERTS_FP_ERROR_THOROUGH(fpexnp, f, Action) \ + do { if (erts_check_fpe_thorough((fpexnp),(f))) { Action; } } while (0) + +int erts_sys_block_fpe(void); +void erts_sys_unblock_fpe(int); + +#endif /* !NO_FPE_SIGNALS */ + +#define ERTS_FP_CHECK_INIT(p) __ERTS_FP_CHECK_INIT(&(p)->fp_exception) +#define ERTS_FP_ERROR(p, f, A) __ERTS_FP_ERROR(&(p)->fp_exception, f, A) +#define ERTS_FP_ERROR_THOROUGH(p, f, A) __ERTS_FP_ERROR_THOROUGH(&(p)->fp_exception, f, A) + +/* FIXME: force HAVE_GETPAGESIZE and stub getpagesize */ +#ifndef HAVE_GETPAGESIZE +#define HAVE_GETPAGESIZE 1 +#endif + +extern int getpagesize(void); + +#ifndef HZ +#define HZ 60 +#endif + +/* OSE5 doesn't provide limits.h so a number of macros should be + * added manually */ + +#ifndef CHAR_BIT +#define CHAR_BIT 8 +#endif + +/* Minimum and maximum values a `signed int' can hold. */ +#ifndef INT_MAX +#define INT_MAX 2147483647 +#endif + +#ifndef INT_MIN +#define INT_MIN (-INT_MAX - 1) +#endif + +#ifndef UINT_MAX +# define UINT_MAX 4294967295U +#endif + +/* +static void erts_ose_sys_send(union SIGNAL **signal,PROCESS dst, + char* file,int line) { + SIGSELECT **ziggy = (SIGSELECT**)signal; + printf("%s:%d 0x%x Send signal 0x%x(0x%x) to 0x%x\r\n", + file,line,current_process(),ziggy[0][0],*ziggy,dst); + send(signal,dst); +} +#define send(signal,dst) erts_ose_sys_send(signal,dst,__FILE__,__LINE__) + +static void erts_ose_sys_send_w_sender(union SIGNAL **signal, + PROCESS sender,PROCESS dst, + char* file,int line) { + SIGSELECT **ziggy = (SIGSELECT**)signal; + printf("%s:%d 0x%x Send signal 0x%x(0x%x) to 0x%x as 0x%x\r\n", + file,line,current_process(),ziggy[0][0],*ziggy,dst,sender); + send_w_sender(signal,sender,dst); +} +#define send_w_sender(signal,sender,dst) \ + erts_ose_sys_send_w_sender(signal,sender,dst,__FILE__,__LINE__) + + +static union SIGNAL *erts_ose_sys_receive(SIGSELECT *sigsel, + char *file, + int line) { + SIGSELECT *sig; + int i; + + printf("%s:%d 0x%x receive({%d,",file,line,current_process(),sigsel[0]); + for (i = 1; i < sigsel[0]; i++) + printf("0x%x, ",sigsel[i]); + if (sigsel[0] != 0) + printf("0x%x",sigsel[i]); + printf("})\n"); + sig = (SIGSELECT*)receive(sigsel); + printf("%s:%d 0x%x got 0x%x from 0x%x\n",file,line,current_process(), + *sig,sender((union SIGNAL**)(&sig))); + return (union SIGNAL*)sig; +} +#define receive(SIGSEL) erts_ose_sys_receive(SIGSEL,__FILE__,__LINE__) + +static union SIGNAL *erts_ose_sys_receive_w_tmo(OSTIME tmo,SIGSELECT *sigsel, + char *file,int line) { + SIGSELECT *sig; + int i; + if (tmo == 0) { + sig = (SIGSELECT*)receive_w_tmo(tmo,sigsel); + if (sig != NULL) { + printf("%s:%d 0x%x receive_w_tmo(0,{%d,",file,line,current_process(), + sigsel[0]); + for (i = 1; i < sigsel[0]; i++) + printf("0x%x, ",sigsel[i]); + if (sigsel[0] != 0) + printf("0x%x",sigsel[i]); + printf("})\n"); + printf("%s:%d 0x%x got 0x%x from 0x%x\n",file,line,current_process(), + *sig,sender((union SIGNAL**)(&sig))); + } + } else { + printf("%s:%d 0x%x receive_w_tmo(%u,{%d,",file,line,current_process(),tmo, + sigsel[0]); + for (i = 1; i < sigsel[0]; i++) + printf("0x%x, ",sigsel[i]); + if (sigsel[0] != 0) + printf("0x%x",sigsel[i]); + printf("})\n"); + sig = (SIGSELECT*)receive_w_tmo(tmo,sigsel); + printf("%s:%d 0x%x got ",file,line,current_process()); + if (sig == NULL) + printf("TIMEOUT\n"); + else + printf("0x%x from 0x%x\n",*sig,sender((union SIGNAL**)(&sig))); + } + + return (union SIGNAL*)sig; +} + +#define receive_w_tmo(tmo,sigsel) erts_ose_sys_receive_w_tmo(tmo,sigsel, \ + __FILE__,__LINE__) + +static union SIGNAL *erts_ose_sys_receive_fsem(OSTIME tmo,SIGSELECT *sigsel, + OSFSEMVAL fsem, + char *file,int line) { + SIGSELECT *sig; + int i; + if (tmo == 0) { + sig = (SIGSELECT*)receive_fsem(tmo,sigsel,fsem); + if (sig != NULL && sig != OS_RCV_FSEM) { + printf("%s:%d 0x%x receive_fsem(0,{%d,",file,line,current_process(), + sigsel[0]); + for (i = 1; i < sigsel[0]; i++) + printf("0x%x, ",sigsel[i]); + if (sigsel[0] != 0) + printf("0x%x",sigsel[i]); + printf("},%d)\n",fsem); + printf("%s:%d 0x%x got 0x%x from 0x%x\n",file,line,current_process(), + *sig,sender((union SIGNAL**)(&sig))); + } + } else { + printf("%s:%d 0x%x receive_fsem(%u,{%d,",file,line,current_process(),tmo, + sigsel[0]); + for (i = 1; i < sigsel[0]; i++) + printf("0x%x, ",sigsel[i]); + if (sigsel[0] != 0) + printf("0x%x",sigsel[i]); + printf("},%d)\n",fsem); + sig = (SIGSELECT*)receive_fsem(tmo,sigsel,fsem); + printf("%s:%d 0x%x got ",file,line,current_process()); + if (sig == NULL) + printf("TIMEOUT\n"); + else if (sig == OS_RCV_FSEM) + printf("FSEM\n"); + else + printf("0x%x from 0x%x\n",*sig,sender((union SIGNAL**)(&sig))); + } + + return (union SIGNAL*)sig; +} + +#define receive_fsem(tmo,sigsel,fsem) \ + erts_ose_sys_receive_fsem(tmo,sigsel,fsem,__FILE__,__LINE__) +*/ +#endif /* _ERL_OSE_SYS_H */ diff --git a/erts/emulator/sys/ose/erl_ose_sys_ddll.c b/erts/emulator/sys/ose/erl_ose_sys_ddll.c new file mode 100644 index 0000000000..ebd80deeaf --- /dev/null +++ b/erts/emulator/sys/ose/erl_ose_sys_ddll.c @@ -0,0 +1,126 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2013. 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% + */ + +/* + * Interface functions to the dynamic linker using dl* functions. + * (No support in OSE, we use static linkage instead) + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" + + +void erl_sys_ddll_init(void) { +} + +/* + * Open a shared object + */ +int erts_sys_ddll_open(const char *full_name, void **handle, ErtsSysDdllError* err) +{ + return ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY; +} + +int erts_sys_ddll_open_noext(char *dlname, void **handle, ErtsSysDdllError* err) +{ + return ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY; +} + +/* + * Find a symbol in the shared object + */ +int erts_sys_ddll_sym2(void *handle, const char *func_name, void **function, + ErtsSysDdllError* err) +{ + return ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY; +} + +/* XXX:PaN These two will be changed with new driver interface! */ + +/* + * Load the driver init function, might appear under different names depending on object arch... + */ + +int erts_sys_ddll_load_driver_init(void *handle, void **function) +{ + void *fn; + int res; + if ((res = erts_sys_ddll_sym2(handle, "driver_init", &fn, NULL)) != ERL_DE_NO_ERROR) { + res = erts_sys_ddll_sym2(handle, "_driver_init", &fn, NULL); + } + if (res == ERL_DE_NO_ERROR) { + *function = fn; + } + return res; +} + +int erts_sys_ddll_load_nif_init(void *handle, void **function, ErtsSysDdllError* err) +{ + void *fn; + int res; + if ((res = erts_sys_ddll_sym2(handle, "nif_init", &fn, err)) != ERL_DE_NO_ERROR) { + res = erts_sys_ddll_sym2(handle, "_nif_init", &fn, err); + } + if (res == ERL_DE_NO_ERROR) { + *function = fn; + } + return res; +} + +/* + * Call the driver_init function, whatever it's really called, simple on unix... +*/ +void *erts_sys_ddll_call_init(void *function) { + void *(*initfn)(void) = function; + return (*initfn)(); +} +void *erts_sys_ddll_call_nif_init(void *function) { + return erts_sys_ddll_call_init(function); +} + + + +/* + * Close a chared object + */ +int erts_sys_ddll_close2(void *handle, ErtsSysDdllError* err) +{ + return ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY; +} + + +/* + * Return string that describes the (current) error + */ +char *erts_sys_ddll_error(int code) +{ + return "Unspecified error"; +} + +void erts_sys_ddll_free_error(ErtsSysDdllError* err) +{ + if (err->str != NULL) { + erts_free(ERTS_ALC_T_DDLL_TMP_BUF, err->str); + } +} diff --git a/erts/emulator/sys/ose/erl_poll.c b/erts/emulator/sys/ose/erl_poll.c new file mode 100644 index 0000000000..7d2a3d1e0b --- /dev/null +++ b/erts/emulator/sys/ose/erl_poll.c @@ -0,0 +1,780 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2012. 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% + */ + +/* + * Description: Poll interface suitable for ERTS on OSE with or without + * SMP support. + * + * The interface is currently implemented using: + * - receive + receive_fsem + * + * Author: Lukas Larsson + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "erl_thr_progress.h" +#include "erl_driver.h" +#include "erl_alloc.h" +#include "erl_poll.h" + +#define NOFILE 4096 + +/* + * Some debug macros + */ + +/* #define HARDDEBUG +#define HARDTRACE*/ +#ifdef HARDDEBUG +#ifdef HARDTRACE +#define HARDTRACEF(X, ...) { fprintf(stderr, X, __VA_ARGS__); fprintf(stderr,"\r\n"); } +#else +#define HARDTRACEF(...) +#endif + +#else +#define HARDTRACEF(X,...) +#define HARDDEBUGF(...) +#endif + +#if 0 +#define ERTS_POLL_DEBUG_PRINT +#endif + +#if defined(DEBUG) && 0 +#define HARD_DEBUG +#endif + +# define SEL_ALLOC erts_alloc +# define SEL_REALLOC realloc_wrap +# define SEL_FREE erts_free + +#ifdef ERTS_SMP + +#define ERTS_POLLSET_LOCK(PS) \ + erts_smp_mtx_lock(&(PS)->mtx) +#define ERTS_POLLSET_UNLOCK(PS) \ + erts_smp_mtx_unlock(&(PS)->mtx) + +#else + +#define ERTS_POLLSET_LOCK(PS) +#define ERTS_POLLSET_UNLOCK(PS) + +#endif + +/* + * --- Data types ------------------------------------------------------------ + */ + +union SIGNAL { + SIGSELECT sig_no; +}; + +typedef struct erts_sigsel_item_ ErtsSigSelItem; + +struct erts_sigsel_item_ { + ErtsSigSelItem *next; + ErtsSysFdType fd; + ErtsPollEvents events; +}; + +typedef struct erts_sigsel_info_ ErtsSigSelInfo; + +struct erts_sigsel_info_ { + ErtsSigSelInfo *next; + SIGSELECT signo; + ErlDrvOseEventId (*decode)(union SIGNAL* sig); + ErtsSigSelItem *fds; +}; + +struct ErtsPollSet_ { + SIGSELECT *sigs; + ErtsSigSelInfo *info; + Uint sig_count; + Uint item_count; + PROCESS interrupt; + erts_atomic32_t wakeup_state; + erts_smp_atomic32_t timeout; +#ifdef ERTS_SMP + erts_smp_mtx_t mtx; +#endif +}; + +static int max_fds = -1; + +#define ERTS_POLL_NOT_WOKEN ((erts_aint32_t) (1 << 0)) +#define ERTS_POLL_WOKEN_INTR ((erts_aint32_t) (1 << 1)) +#define ERTS_POLL_WOKEN_TIMEDOUT ((erts_aint32_t) (1 << 2)) +#define ERTS_POLL_WOKEN_IO_READY ((erts_aint32_t) (1 << 3)) +#define ERTS_POLL_SLEEPING ((erts_aint32_t) (1 << 4)) + +/* signal list prototypes */ +static ErtsSigSelInfo *get_sigsel_info(ErtsPollSet ps, SIGSELECT signo); +static ErtsSigSelItem *get_sigsel_item(ErtsPollSet ps, ErtsSysFdType fd); +static ErtsSigSelInfo *add_sigsel_info(ErtsPollSet ps, ErtsSysFdType fd, + ErlDrvOseEventId (*decode)(union SIGNAL* sig)); +static ErtsSigSelItem *add_sigsel_item(ErtsPollSet ps, ErtsSysFdType fd, + ErlDrvOseEventId (*decode)(union SIGNAL* sig)); +static int del_sigsel_info(ErtsPollSet ps, ErtsSigSelInfo *info); +static int del_sigsel_item(ErtsPollSet ps, ErtsSigSelItem *item); +static int update_sigsel(ErtsPollSet ps); + +static ErtsSigSelInfo * +get_sigsel_info(ErtsPollSet ps, SIGSELECT signo) { + ErtsSigSelInfo *curr = ps->info; + while (curr != NULL) { + if (curr->signo == signo) + return curr; + curr = curr->next; + } + return NULL; +} + +static ErtsSigSelItem * +get_sigsel_item(ErtsPollSet ps, ErtsSysFdType fd) { + ErtsSigSelInfo *info = get_sigsel_info(ps,fd->signo); + ErtsSigSelItem *curr; + + if (info == NULL) + return NULL; + + curr = info->fds; + + while (curr != NULL) { + if (curr->fd->id == fd->id) { + ASSERT(curr->fd->signo == fd->signo); + return curr; + } + curr = curr->next; + } + return NULL; +} + +static ErtsSigSelInfo * +add_sigsel_info(ErtsPollSet ps, ErtsSysFdType fd, + ErlDrvOseEventId (*decode)(union SIGNAL* sig)) { + ErtsSigSelInfo *info = SEL_ALLOC(ERTS_ALC_T_POLLSET, + sizeof(ErtsSigSelInfo)); + info->next = ps->info; + info->fds = NULL; + info->signo = fd->signo; + info->decode = decode; + ps->info = info; + ps->sig_count++; + return info; +} + +static ErtsSigSelItem * +add_sigsel_item(ErtsPollSet ps, ErtsSysFdType fd, + ErlDrvOseEventId (*decode)(union SIGNAL* sig)) { + ErtsSigSelInfo *info = get_sigsel_info(ps,fd->signo); + ErtsSigSelItem *item = SEL_ALLOC(ERTS_ALC_T_POLLSET, + sizeof(ErtsSigSelItem)); + if (info == NULL) + info = add_sigsel_info(ps, fd, decode); + if (info->decode != decode) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, "erts_poll_control() inconsistency: multiple resolve_signal functions for same signal (%d)\n", + fd->signo); + erts_send_error_to_logger_nogl(dsbufp); + } + ASSERT(info->decode == decode); + item->next = info->fds; + item->fd = fd; + item->events = 0; + info->fds = item; + ps->item_count++; + return item; +} + +static int del_sigsel_info(ErtsPollSet ps, ErtsSigSelInfo *info) { + ErtsSigSelInfo *curr, *prev; + + if (ps->info == info) { + ps->info = ps->info->next; + } else { + curr = ps->info->next; + prev = ps->info; + + while (curr != info) { + if (curr == NULL) + return 1; + prev = curr; + curr = curr->next; + } + prev->next = curr->next; + } + + ps->sig_count--; + SEL_FREE(ERTS_ALC_T_POLLSET, info); + return 0; +} + +static int del_sigsel_item(ErtsPollSet ps, ErtsSigSelItem *item) { + ErtsSigSelInfo *info = get_sigsel_info(ps,item->fd->signo); + ErtsSigSelItem *curr, *prev; + + ps->item_count--; + ASSERT(ps->item_count >= 0); + + if (info->fds == item) { + info->fds = info->fds->next; + SEL_FREE(ERTS_ALC_T_POLLSET,item); + if (info->fds == NULL) + return del_sigsel_info(ps,info); + return 0; + } + + curr = info->fds->next; + prev = info->fds; + + while (curr != item) { + if (curr == NULL) { + /* We did not find an item to delete so we have to + * increment item count again. + */ + ps->item_count++; + return 1; + } + prev = curr; + curr = curr->next; + } + prev->next = curr->next; + SEL_FREE(ERTS_ALC_T_POLLSET,item); + return 0; +} + +#ifdef ERTS_SMP + +static void update_redir_tables(ErtsPollSet ps) { + struct OS_redir_entry *redir_table; + PROCESS sched_1 = ERTS_SCHEDULER_IX(0)->tid.id; + int i; + redir_table = SEL_ALLOC(ERTS_ALC_T_POLLSET, + sizeof(struct OS_redir_entry)*(ps->sig_count+1)); + + redir_table[0].sig = ps->sig_count+1; + redir_table[0].pid = 0; + + for (i = 1; i < ps->sig_count+1; i++) { + redir_table[i].sig = ps->sigs[i]; + redir_table[i].pid = sched_1; + } + + for (i = 1; i < erts_no_schedulers; i++) { + ErtsSchedulerData *esdp = ERTS_SCHEDULER_IX(i); + set_redirection(esdp->tid.id,redir_table); + } + + SEL_FREE(ERTS_ALC_T_POLLSET,redir_table); +} + +#endif + +static int update_sigsel(ErtsPollSet ps) { + ErtsSigSelInfo *info = ps->info; + + int i; + + if (ps->sigs != NULL) + SEL_FREE(ERTS_ALC_T_POLLSET,ps->sigs); + + if (ps->sig_count == 0) { + /* If there are no signals we place a non-valid signal to make sure that + * we do not trigger on a any unrelated signals which are sent to the + * process. + */ + ps->sigs = SEL_ALLOC(ERTS_ALC_T_POLLSET,sizeof(SIGSELECT)*(2)); + ps->sigs[0] = 1; + ps->sigs[1] = ERTS_SIGNAL_INVALID; + return 0; + } + + ps->sigs = SEL_ALLOC(ERTS_ALC_T_POLLSET,sizeof(SIGSELECT)*(ps->sig_count+1)); + ps->sigs[0] = ps->sig_count; + + for (i = 1; info != NULL; i++, info = info->next) + ps->sigs[i] = info->signo; + +#ifdef ERTS_SMP + update_redir_tables(ps); +#endif + + return 0; +} + +static ERTS_INLINE void +wake_poller(ErtsPollSet ps) +{ + erts_aint32_t wakeup_state; + + ERTS_THR_MEMORY_BARRIER; + wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state); + while (wakeup_state != ERTS_POLL_WOKEN_IO_READY + && wakeup_state != ERTS_POLL_WOKEN_INTR) { + erts_aint32_t act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state, + ERTS_POLL_WOKEN_INTR, + wakeup_state); + if (act == wakeup_state) { + wakeup_state = act; + break; + } + wakeup_state = act; + } + if (wakeup_state == ERTS_POLL_SLEEPING) { + /* + * Since we don't know the internals of signal_fsem() we issue + * a memory barrier as a safety precaution ensuring that + * the store we just made to wakeup_state wont be reordered + * with loads in signal_fsem(). + */ + ERTS_THR_MEMORY_BARRIER; + signal_fsem(ps->interrupt); + } +} + +static ERTS_INLINE void +reset_interrupt(ErtsPollSet ps) +{ + /* We need to keep io-ready if set */ + erts_aint32_t wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state); + while (wakeup_state != ERTS_POLL_NOT_WOKEN && + wakeup_state != ERTS_POLL_SLEEPING) { + erts_aint32_t act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state, + ERTS_POLL_NOT_WOKEN, + wakeup_state); + if (wakeup_state == act) + break; + wakeup_state = act; + } + ERTS_THR_MEMORY_BARRIER; +} + +static ERTS_INLINE void +set_interrupt(ErtsPollSet ps) +{ + wake_poller(ps); +} + +void erts_poll_interrupt(ErtsPollSet ps,int set) { + HARDTRACEF("erts_poll_interrupt called!\n"); + + if (!set) + reset_interrupt(ps); + else + set_interrupt(ps); + +} + +void erts_poll_interrupt_timed(ErtsPollSet ps,int set,erts_short_time_t msec) { + HARDTRACEF("erts_poll_interrupt_timed called!\n"); + + if (!set) + reset_interrupt(ps); + else if (erts_smp_atomic32_read_acqb(&ps->timeout) > (erts_aint32_t) msec) + set_interrupt(ps); +} + +ErtsPollEvents erts_poll_control(ErtsPollSet ps, ErtsSysFdType fd, + ErtsPollEvents pe, int on, int* do_wake) { + ErtsSigSelItem *curr; + ErtsPollEvents new_events; + int old_sig_count; + + HARDTRACEF( + "%ux: In erts_poll_control, fd = %d, pe = %d, on = %d, *do_wake = %d, curr = 0x%xu", + ps, fd, pe, on, do_wake, curr); + + ERTS_POLLSET_LOCK(ps); + + if (on && (pe & ERTS_POLL_EV_IN) && (pe & ERTS_POLL_EV_OUT)) { + /* Check to make sure both in and out are not used at the same time */ + new_events = ERTS_POLL_EV_NVAL; + goto done; + } + + curr = get_sigsel_item(ps, fd); + old_sig_count = ps->sig_count; + + if (curr == NULL && on) { + curr = add_sigsel_item(ps, fd, fd->resolve_signal); + } else if (curr == NULL && !on) { + new_events = ERTS_POLL_EV_NVAL; + goto done; + } + + new_events = curr->events; + + if (pe == 0) { + *do_wake = 0; + goto done; + } + + if (on) { + new_events |= pe; + curr->events = new_events; + } else { + new_events &= ~pe; + curr->events = new_events; + if (new_events == 0 && del_sigsel_item(ps, curr)) { + new_events = ERTS_POLL_EV_NVAL; + goto done; + } + } + + if (ps->sig_count != old_sig_count) { + if (update_sigsel(ps)) + new_events = ERTS_POLL_EV_NVAL; + } +done: + ERTS_POLLSET_UNLOCK(ps); + HARDTRACEF("%ux: Out erts_poll_control", ps); + return new_events; +} + +int erts_poll_wait(ErtsPollSet ps, + ErtsPollResFd pr[], + int *len, + SysTimeval *utvp) { + int res = ETIMEDOUT, no_fds, currid = 0; + OSTIME timeout; + union SIGNAL *sig; + // HARDTRACEF("%ux: In erts_poll_wait",ps); + if (ps->interrupt == (PROCESS)0) + ps->interrupt = current_process(); + + ASSERT(current_process() == ps->interrupt); + ASSERT(get_fsem(current_process()) == 0); + ASSERT(erts_atomic32_read_nob(&ps->wakeup_state) & + (ERTS_POLL_NOT_WOKEN | ERTS_POLL_WOKEN_INTR)); + /* Max no of spots avable in pr */ + no_fds = *len; + + *len = 0; + + ASSERT(utvp); + + /* erts_printf("Entering erts_poll_wait(), timeout=%d\n", + (int) utvp->tv_sec*1000 + utvp->tv_usec/1000); */ + + timeout = utvp->tv_sec*1000 + utvp->tv_usec/1000; + + if (timeout > ((time_t) ERTS_AINT32_T_MAX)) + timeout = ERTS_AINT32_T_MAX; + erts_smp_atomic32_set_relb(&ps->timeout, (erts_aint32_t) timeout); + + while (currid < no_fds) { + if (timeout > 0) { + erts_aint32_t act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state, + ERTS_POLL_SLEEPING, + ERTS_POLL_NOT_WOKEN); + if (act == ERTS_POLL_NOT_WOKEN) { +#ifdef ERTS_SMP + erts_thr_progress_prepare_wait(NULL); +#endif + sig = receive_fsem(timeout, ps->sigs, 1); +#ifdef ERTS_SMP + erts_thr_progress_finalize_wait(NULL); +#endif + } else { + ASSERT(act == ERTS_POLL_WOKEN_INTR); + sig = OS_RCV_FSEM; + } + } else + sig = receive_w_tmo(0, ps->sigs); + + if (sig == NULL) { + if (timeout > 0) { + erts_aint32_t act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state, + ERTS_POLL_WOKEN_TIMEDOUT, + ERTS_POLL_SLEEPING); + if (act == ERTS_POLL_WOKEN_INTR) + /* Restore fsem as it was signaled but we got a timeout */ + wait_fsem(1); + } else + erts_atomic32_cmpxchg_nob(&ps->wakeup_state, + ERTS_POLL_WOKEN_TIMEDOUT, + ERTS_POLL_NOT_WOKEN); + break; + } else if (sig == OS_RCV_FSEM) { + ASSERT(erts_atomic32_read_nob(&ps->wakeup_state) == ERTS_POLL_WOKEN_INTR); + break; + } + { + ErtsSigSelInfo *info = get_sigsel_info(ps, sig->sig_no); + struct erts_sys_fd_type fd = { sig->sig_no, info->decode(sig) }; + ErtsSigSelItem *item = get_sigsel_item(ps, &fd); + + ASSERT(sig); + if (currid == 0 && timeout > 0) { + erts_aint32_t act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state, + ERTS_POLL_WOKEN_IO_READY, + ERTS_POLL_SLEEPING); + if (act == ERTS_POLL_WOKEN_INTR) { + /* Restore fsem as it was signaled but we got a msg */ + wait_fsem(1); + act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state, + ERTS_POLL_WOKEN_IO_READY, + ERTS_POLL_WOKEN_INTR); + } + } else if (currid == 0) { + erts_atomic32_set_nob(&ps->wakeup_state, + ERTS_POLL_WOKEN_IO_READY); + } + + if (item == NULL) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf( + dsbufp, + "erts_poll_wait() failed: found unkown signal id %d (signo %u) " + "(curr_proc 0x%x)\n", + fd.id, fd.signo, current_process()); + erts_send_error_to_logger_nogl(dsbufp); + timeout = 0; + /* Under normal circumstances the signal is deallocated by the + * driver that issued the select operation. But in this case + * there's no driver waiting for such signal so we have to + * deallocate it here */ + if (sig) + free_buf(&sig); + } else { + int i; + struct erts_sys_fd_type *fd = NULL; + ErtsPollOseMsgList *tl,*new; + + /* Check if this fd has already been triggered by a previous signal */ + for (i = 0; i < currid;i++) { + if (pr[i].fd == item->fd) { + fd = pr[i].fd; + pr[i].events |= item->events; + break; + } + } + + /* First time this fd is triggered */ + if (fd == NULL) { + pr[currid].fd = item->fd; + pr[currid].events = item->events; + fd = item->fd; + timeout = 0; + currid++; + } + + /* Insert new signal in approriate list */ + new = erts_alloc(ERTS_ALC_T_FD_SIG_LIST,sizeof(ErtsPollOseMsgList)); + new->next = NULL; + new->data = sig; + + ethr_mutex_lock(&fd->mtx); + tl = fd->msgs; + + if (tl == NULL) { + fd->msgs = new; + } else { + while (tl->next != NULL) + tl = tl->next; + tl->next = new; + } + ethr_mutex_unlock(&fd->mtx); + } + + } + } + + { + erts_aint32_t wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state); + + switch (wakeup_state) { + case ERTS_POLL_WOKEN_IO_READY: + res = 0; + break; + case ERTS_POLL_WOKEN_INTR: + res = EINTR; + break; + case ERTS_POLL_WOKEN_TIMEDOUT: + res = ETIMEDOUT; + break; + case ERTS_POLL_NOT_WOKEN: + /* This happens when we get an invalid signal only */ + res = EINVAL; + break; + default: + res = 0; + erl_exit(ERTS_ABORT_EXIT, + "%s:%d: Internal error: Invalid wakeup_state=%d\n", + __FILE__, __LINE__, (int) wakeup_state); + } + } + + erts_atomic32_set_nob(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN); + erts_smp_atomic32_set_nob(&ps->timeout, ERTS_AINT32_T_MAX); + + *len = currid; + + // HARDTRACEF("%ux: Out erts_poll_wait",ps); + return res; +} + +int erts_poll_max_fds(void) +{ + + HARDTRACEF("In/Out erts_poll_max_fds -> %d",max_fds); + return max_fds; +} + +void erts_poll_info(ErtsPollSet ps, + ErtsPollInfo *pip) +{ + Uint size = 0; + Uint num_events = 0; + + size += sizeof(struct ErtsPollSet_); + size += sizeof(ErtsSigSelInfo)*ps->sig_count; + size += sizeof(ErtsSigSelItem)*ps->item_count; + size += sizeof(SIGSELECT)*(ps->sig_count+1); + + pip->primary = "receive_fsem"; + + pip->fallback = NULL; + + pip->kernel_poll = NULL; + + pip->memory_size = size; + + pip->poll_set_size = num_events; + + pip->fallback_poll_set_size = 0; + + pip->lazy_updates = 0; + + pip->pending_updates = 0; + + pip->batch_updates = 0; + + pip->concurrent_updates = 0; + + + pip->max_fds = erts_poll_max_fds(); + HARDTRACEF("%ux: Out erts_poll_info",ps); + +} + +ErtsPollSet erts_poll_create_pollset(void) +{ + ErtsPollSet ps = SEL_ALLOC(ERTS_ALC_T_POLLSET, + sizeof(struct ErtsPollSet_)); + + ps->sigs = NULL; + ps->sig_count = 0; + ps->item_count = 0; + ps->info = NULL; + ps->interrupt = (PROCESS)0; + erts_atomic32_init_nob(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN); + erts_smp_atomic32_init_nob(&ps->timeout, ERTS_AINT32_T_MAX); +#ifdef ERTS_SMP + erts_smp_mtx_init(&ps->mtx, "pollset"); +#endif + update_sigsel(ps); + HARDTRACEF("%ux: Out erts_poll_create_pollset",ps); + return ps; +} + +void erts_poll_destroy_pollset(ErtsPollSet ps) +{ + ErtsSigSelInfo *info; + for (info = ps->info; ps->info != NULL; info = ps->info, ps->info = ps->info->next) { + ErtsSigSelItem *item; + for (item = info->fds; info->fds != NULL; item = info->fds, info->fds = info->fds->next) + SEL_FREE(ERTS_ALC_T_POLLSET, item); + SEL_FREE(ERTS_ALC_T_POLLSET, info); + } + + SEL_FREE(ERTS_ALC_T_POLLSET,ps->sigs); + +#ifdef ERTS_SMP + erts_smp_mtx_destroy(&ps->mtx); +#endif + + SEL_FREE(ERTS_ALC_T_POLLSET,ps); +} + +void erts_poll_init(void) +{ + HARDTRACEF("In %s", __FUNCTION__); + max_fds = 256; + + HARDTRACEF("Out %s", __FUNCTION__); +} + + +/* OSE driver functions */ + +union SIGNAL *erl_drv_ose_get_signal(ErlDrvEvent drv_ev) { + struct erts_sys_fd_type *ev = (struct erts_sys_fd_type *)drv_ev; + ethr_mutex_lock(&ev->mtx); + if (ev->msgs == NULL) { + ethr_mutex_unlock(&ev->mtx); + return NULL; + } else { + ErtsPollOseMsgList *msg = ev->msgs; + union SIGNAL *sig = (union SIGNAL*)msg->data; + ASSERT(msg->data); + ev->msgs = msg->next; + ethr_mutex_unlock(&ev->mtx); + erts_free(ERTS_ALC_T_FD_SIG_LIST,msg); + restore(sig); + return sig; + } +} + +ErlDrvEvent +erl_drv_ose_event_alloc(SIGSELECT signo, ErlDrvOseEventId id, + ErlDrvOseEventId (*resolve_signal)(union SIGNAL *sig), void *extra) { + struct erts_sys_fd_type *ev = erts_alloc(ERTS_ALC_T_DRV_EV, + sizeof(struct erts_sys_fd_type)); + ev->signo = signo; + ev->extra = extra; + ev->id = id; + ev->msgs = NULL; + ev->resolve_signal = resolve_signal; + ethr_mutex_init(&ev->mtx); + return (ErlDrvEvent)ev; +} + +void erl_drv_ose_event_free(ErlDrvEvent drv_ev) { + struct erts_sys_fd_type *ev = (struct erts_sys_fd_type *)drv_ev; + ASSERT(ev->msgs == NULL); + ethr_mutex_destroy(&ev->mtx); + erts_free(ERTS_ALC_T_DRV_EV,ev); +} + +void erl_drv_ose_event_fetch(ErlDrvEvent drv_ev, SIGSELECT *signo, + ErlDrvOseEventId *id, void **extra) { + struct erts_sys_fd_type *ev = (struct erts_sys_fd_type *)drv_ev; + if (signo) + *signo = ev->signo; + if (extra) + *extra = ev->extra; + if (id) + *id = ev->id; +} diff --git a/erts/emulator/sys/ose/erts.sig b/erts/emulator/sys/ose/erts.sig new file mode 100644 index 0000000000..78b883ee6c --- /dev/null +++ b/erts/emulator/sys/ose/erts.sig @@ -0,0 +1,17 @@ +#ifndef ERTS_OSE_SIGNALS +#define ERTS_OSE_SIGNALS + +#ifndef ERTS_OSE_SIGNAL_BASE +#define ERTS_OSE_SIGNAL_BASE 0x01900280 +#endif + +#define ERTS_SIGNAL_INVALID ERTS_OSE_SIGNAL_BASE +#define ERTS_SIGNAL_FD_DRV_CONFIG ERTS_OSE_SIGNAL_BASE+1 +#define ERTS_SIGNAL_FD_DRV_ASYNC ERTS_OSE_SIGNAL_BASE+2 +#define ERTS_SIGNAL_OSE_DRV_ATTACH ERTS_OSE_SIGNAL_BASE+3 +#define ERTS_SIGNAL_OSE_DRV_HUNT ERTS_OSE_SIGNAL_BASE+4 + +#define ERTS_SIGNAL_RUN_ERL_SETUP ERTS_OSE_SIGNAL_BASE+100 +#define ERTS_SIGNAL_RUN_ERL_DAEMON ERTS_OSE_SIGNAL_BASE+101 + +#endif diff --git a/erts/emulator/sys/ose/gcc_4.4.3_lm_ppc.lcf b/erts/emulator/sys/ose/gcc_4.4.3_lm_ppc.lcf new file mode 100644 index 0000000000..a19d23facf --- /dev/null +++ b/erts/emulator/sys/ose/gcc_4.4.3_lm_ppc.lcf @@ -0,0 +1,182 @@ +/******************************************************************************* + * Copyright (C) 2013-2014 by Enea Software AB, + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * + * 3. Neither the name of the copyright holder nor the names of its contributors + * may be used to endorse or promote products derived from this software + * without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. + ******************************************************************************/ + +OUTPUT_FORMAT("elf32-powerpc", "elf32-powerpc", "elf32-powerpc") +OUTPUT_ARCH("powerpc") +ENTRY("crt0_lm") +MEMORY +{ + rom : ORIGIN = 0x01000000, LENGTH = 0x01000000 + ram : ORIGIN = 0x02000000, LENGTH = 0x01000000 +} +PHDRS +{ + ph_conf PT_LOAD ; + ph_rom PT_LOAD ; + ph_ram PT_LOAD ; +} +SECTIONS +{ + .text : + { + *(.text_first) + *(.text) + *(.text.*) + *(.stub) + *(oscode) + *(.init*) + *(.fini*) + *(.gnu.warning) + *(.gnu.linkonce.t.*) + *(.glue_7t) + *(.glue_7) + } > rom :ph_rom = 0 + .ose_sfk_biosentry : + { + *(.ose_sfk_biosentry) + } > rom :ph_rom + .ctors : + { + __CTOR_LIST__ = .; + *(.ctors) + *(SORT(.ctors.*)) + __CTOR_END__ = .; + } > rom :ph_rom + .dtors : + { + __DTOR_LIST__ = .; + *(.dtors) + *(SORT(.dtors.*)) + __DTOR_END__ = .; + } > rom :ph_rom + OSESYMS : + { + *(.osesyms) + } > rom :ph_rom + .rodata : + { + *(.rodata) + *(.rodata.*) + *(.gnu.linkonce.r.*) + } > rom :ph_rom + .eh_frame_hdr : + { + *(.eh_frame_hdr) + } > rom :ph_rom + .eh_frame : + { + __EH_FRAME_BEGIN__ = .; + *(.eh_frame) + LONG(0) + __EH_FRAME_END__ = .; + } > rom :ph_rom + .gcc_except_table : + { + *(.gcc_except_table .gcc_except_table.*) + } > rom :ph_rom + .sdata2 : + { + PROVIDE (_SDA2_BASE_ = .); + *(.sdata2) + *(.sdata2.*) + *(.gnu.linkonce.s2.*) + } > rom :ph_rom + .sbss2 : + { + *(.sbss2) + *(.sbss2.*) + *(.gnu.linkonce.sb2.*) + } > rom :ph_rom + LMCONF : + { + obj/?*?/ose_confd.o(.rodata) + *(LMCONF) + } > rom :ph_conf + .data : + { + LONG(0xDEADBABE) + *(.data) + *(.data.*) + *(.gnu.linkonce.d.*) + SORT(CONSTRUCTORS) + . = ALIGN(0x10); + } > ram :ph_ram = 0 + .sdata2 : + { + _SDA2_BASE_ = .; + *(.sdata2 .sdata2.* .gnu.linkonce.s2.*) + }> ram :ph_ram + .sdata : + { + PROVIDE (_SDA_BASE_ = .); + *(.sdata) + *(.sdata.*) + *(.gnu.linkonce.s.*) + } > ram :ph_ram + .sbss : + { + *(.sbss) + *(.sbss.*) + *(.scommon) + *(.gnu.linkonce.sb.*) + } > ram :ph_ram + .bss (NOLOAD) : + { + *(.bss) + *(.bss.*) + *(COMMON) + *(.gnu.linkonce.b.*) + *(.osvars) + } > ram :ph_ram + .ignore (NOLOAD) : + { + *(.rel.dyn) + } > ram :ph_ram + .debug 0 : { *(.debug) } + .line 0 : { *(.line) } + .debug_srcinfo 0 : { *(.debug_srcinfo) } + .debug_sfnames 0 : { *(.debug_sfnames) } + .debug_aranges 0 : { *(.debug_aranges) } + .debug_pubnames 0 : { *(.debug_pubnames) } + .debug_info 0 : { *(.debug_info) *(.gnu.linkonce.wi.*) } + .debug_abbrev 0 : { *(.debug_abbrev) } + .debug_line 0 : { *(.debug_line) } + .debug_frame 0 : { *(.debug_frame) } + .debug_str 0 : { *(.debug_str) } + .debug_loc 0 : { *(.debug_loc) } + .debug_macinfo 0 : { *(.debug_macinfo) } + .debug_weaknames 0 : { *(.debug_weaknames) } + .debug_funcnames 0 : { *(.debug_funcnames) } + .debug_typenames 0 : { *(.debug_typenames) } + .debug_varnames 0 : { *(.debug_varnames) } +} +__OSESYMS_START = ADDR(OSESYMS); +__OSESYMS_END = ADDR(OSESYMS) + SIZEOF(OSESYMS); diff --git a/erts/emulator/sys/ose/gcc_4.6.3_lm_ppc.lcf b/erts/emulator/sys/ose/gcc_4.6.3_lm_ppc.lcf new file mode 100644 index 0000000000..3440c2961b --- /dev/null +++ b/erts/emulator/sys/ose/gcc_4.6.3_lm_ppc.lcf @@ -0,0 +1,242 @@ +/******************************************************************************* + * Copyright (C) 2013-2014 by Enea Software AB, + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * + * 3. Neither the name of the copyright holder nor the names of its contributors + * may be used to endorse or promote products derived from this software + * without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. + ******************************************************************************/ + +OUTPUT_FORMAT("elf32-powerpc", "elf32-powerpc", "elf32-powerpc") +OUTPUT_ARCH("powerpc") + +ENTRY("crt0_lm") + +/* Note: + * You may have to increase the length of the "rom" memory region and the + * origin and length of the "ram" memory region below depending on the size + * of the code and data in your load module. + */ + +MEMORY +{ + conf : ORIGIN = 0x00100000, LENGTH = 0x00030000 + rom : ORIGIN = 0x01000000, LENGTH = 0x01000000 + ram : ORIGIN = 0x03000000, LENGTH = 0x01000000 +} + +PHDRS +{ + ph_conf PT_LOAD ; + ph_rom PT_LOAD ; + ph_ram PT_LOAD ; +} + +SECTIONS +{ +/*--------------------------------------------------------------------------- + * Load module configuration area + *-------------------------------------------------------------------------*/ + + /* Load module configuration section. */ + LMCONF : + { + obj/?*?/ose_confd.o(.rodata) + *(LMCONF) + } > conf :ph_conf + +/*--------------------------------------------------------------------------- + * Read-only area + *-------------------------------------------------------------------------*/ + + /* Code section. */ + .text : + { + *(.text) + *(.text.*) + *(.stub) + *(oscode) + *(.init*) + *(.fini*) + *(.gnu.warning) + *(.gnu.linkonce.t.*) + } > rom :ph_rom = 0 + + /* OSE symbols section. */ + OSESYMS : + { + *(.osesyms) + } > rom :ph_rom + + /* Read-only data section. */ + .rodata : + { + *(.rodata) + *(.rodata.*) + *(.gnu.linkonce.r.*) + } > rom :ph_rom + + /* C++ exception handling section. */ + .eh_frame : + { + __EH_FRAME_BEGIN__ = .; + *(.eh_frame) + LONG(0) + __EH_FRAME_END__ = .; + } > rom :ph_rom + + /* C++ exception handling section. */ + .gcc_except_table : + { + *(.gcc_except_table .gcc_except_table.*) + } > rom :ph_rom + + /* PowerPC EABI initialized read-only data section. */ + .sdata2 : + { + PROVIDE (_SDA2_BASE_ = .); + *(.sdata2) + *(.sdata2.*) + *(.gnu.linkonce.s2.*) + } > rom :ph_rom + + /* PowerPC EABI uninitialized read-only data section. */ + .sbss2 : + { + *(.sbss2) + *(.sbss2.*) + *(.gnu.linkonce.sb2.*) + } > rom :ph_rom + +/*--------------------------------------------------------------------------- + * Read-write area + *-------------------------------------------------------------------------*/ + + /*------------------------------------------------------------------- + * Initialized data (copied by PM) + *-----------------------------------------------------------------*/ + + /* Data section. */ + .data : + { + *(.data) + *(.data.*) + *(.gnu.linkonce.d.*) + SORT(CONSTRUCTORS) + } > ram :ph_ram + + /* C++ constructor section. */ + .ctors : + { + __CTOR_LIST__ = .; + *(.ctors) + *(SORT(.ctors.*)) + __CTOR_END__ = .; + } > ram :ph_ram + + /* C++ destructor section. */ + .dtors : + { + __DTOR_LIST__ = .; + *(.dtors) + *(SORT(.dtors.*)) + __DTOR_END__ = .; + } > ram :ph_ram + + + /* Small data section. */ + .sdata ALIGN(0x10) : + { + PROVIDE (_SDA_BASE_ = .); + *(.sdata) + *(.sdata.*) + *(.gnu.linkonce.s.*) + } > ram :ph_ram + + /*------------------------------------------------------------------- + * Uninitialized data (cleared by PM) + *-----------------------------------------------------------------*/ + + /* Small bss section. */ + .sbss : + { + *(.sbss) + *(.sbss.*) + *(.scommon) + *(.gnu.linkonce.sb.*) + } > ram :ph_ram + + /* Bss section. */ + .bss : + { + *(.bss) + *(.bss.*) + *(COMMON) + *(.gnu.linkonce.b.*) + } > ram :ph_ram + +/*--------------------------------------------------------------------------- + * Debug information + *-------------------------------------------------------------------------*/ + + /* + * Stabs debug sections. + */ + + .stab 0 : { *(.stab) } + .stabstr 0 : { *(.stabstr) } + .stab.excl 0 : { *(.stab.excl) } + .stab.exclstr 0 : { *(.stab.exclstr) } + .stab.index 0 : { *(.stab.index) } + .stab.indexstr 0 : { *(.stab.indexstr) } + .comment 0 : { *(.comment) } + + /* + * DWARF debug sections. + */ + + /* DWARF 1 */ + .debug 0 : { *(.debug) } + .line 0 : { *(.line) } + /* GNU DWARF 1 extensions */ + .debug_srcinfo 0 : { *(.debug_srcinfo) } + .debug_sfnames 0 : { *(.debug_sfnames) } + /* DWARF 1.1 and DWARF 2 */ + .debug_aranges 0 : { *(.debug_aranges) } + .debug_pubnames 0 : { *(.debug_pubnames) } + /* DWARF 2 */ + .debug_info 0 : { *(.debug_info) *(.gnu.linkonce.wi.*) } + .debug_abbrev 0 : { *(.debug_abbrev) } + .debug_line 0 : { *(.debug_line) } + .debug_frame 0 : { *(.debug_frame) } + .debug_str 0 : { *(.debug_str) } + .debug_loc 0 : { *(.debug_loc) } + .debug_macinfo 0 : { *(.debug_macinfo) } + /* SGI/MIPS DWARF 2 extensions */ + .debug_weaknames 0 : { *(.debug_weaknames) } + .debug_funcnames 0 : { *(.debug_funcnames) } + .debug_typenames 0 : { *(.debug_typenames) } + .debug_varnames 0 : { *(.debug_varnames) } +} diff --git a/erts/emulator/sys/ose/sys.c b/erts/emulator/sys/ose/sys.c new file mode 100644 index 0000000000..5b950a7dae --- /dev/null +++ b/erts/emulator/sys/ose/sys.c @@ -0,0 +1,1846 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2013. 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% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "sys/time.h" +#include "time.h" +#include "sys/uio.h" +#include "termios.h" +#include "ctype.h" +#include "termios.h" + +#ifdef HAVE_FCNTL_H +#include "fcntl.h" +#endif + +#ifdef HAVE_SYS_IOCTL_H +#include "sys/ioctl.h" +#endif + +#define ERTS_WANT_BREAK_HANDLING +#define WANT_NONBLOCKING +#include "sys.h" +#include "erl_thr_progress.h" + +#ifdef USE_THREADS +#include "erl_threads.h" +#endif + +#include "erl_mseg.h" + +#include "unistd.h" +#include "efs.h" +#include "erl_printf.h" +#include "aio.h" +#include "pm.h" +#include "fcntl.h" + +/* Set the define to 1 to get some logging */ +#if 0 +#include "ramlog.h" +#define LOG(output) ramlog_printf output +#else +#define LOG(output) +#endif + +extern char **environ; +static erts_smp_rwmtx_t environ_rwmtx; +static PROCESS sig_proxy_pid = 0; + +#define MAX_VSIZE 16 /* Max number of entries allowed in an I/O + * vector sock_sendv(). + */ +/* + * Don't need global.h, but bif_table.h (included by bif.h), + * won't compile otherwise + */ +#include "global.h" +#include "bif.h" + +#include "erl_sys_driver.h" +#include "erl_check_io.h" +#include "erl_cpu_topology.h" + +/* The priority for reader/writer processes */ +#define FD_PROC_PRI get_pri(current_process()) + +typedef struct ErtsSysReportExit_ ErtsSysReportExit; +struct ErtsSysReportExit_ { + ErtsSysReportExit *next; + Eterm port; + int pid; + int ifd; + int ofd; + ErlDrvEvent attach_event; + ErlDrvEvent input_event; + ErlDrvEvent output_event; +}; + +/* This data is shared by these drivers - initialized by spawn_init() */ +static struct driver_data { + ErlDrvPort port_num; + int ofd; + int ifd; + int packet_bytes; + ErtsSysReportExit *report_exit; + int pid; + int alive; + int status; + ErlDrvEvent input_event; + ErlDrvEvent output_event; + struct aiocb aiocb; + FmHandle handle; + char *install_handle; +} *driver_data; /* indexed by fd */ + +struct async { + SIGSELECT signo; + ErlDrvTermData port; + ErlDrvTermData proc; + PROCESS spid; + PROCESS target; + Uint32 ref; +}; + +static ErtsSysReportExit *report_exit_list; +static ERTS_INLINE void report_exit_status(ErtsSysReportExit *rep, int status); + +extern int driver_interrupt(int, int); +extern void do_break(void); + +extern void erl_sys_args(int*, char**); + +/* The following two defs should probably be moved somewhere else */ + +extern void erts_sys_init_float(void); + +extern void erl_crash_dump(char* file, int line, char* fmt, ...); + +#define DIR_SEPARATOR_CHAR '/' + +#if defined(DEBUG) +#define ERL_BUILD_TYPE_MARKER ".debug" +#else /* opt */ +#define ERL_BUILD_TYPE_MARKER +#endif + +#define CHILD_SETUP_PROG_NAME "child_setup" ERL_BUILD_TYPE_MARKER + +#ifdef DEBUG +static int debug_log = 0; +#endif + +#ifdef ERTS_SMP +static erts_smp_atomic32_t have_prepared_crash_dump; +#define ERTS_PREPARED_CRASH_DUMP \ + ((int) erts_smp_atomic32_xchg_nob(&have_prepared_crash_dump, 1)) +#else +static volatile int have_prepared_crash_dump; +#define ERTS_PREPARED_CRASH_DUMP \ + (have_prepared_crash_dump++) +#endif + +static erts_smp_atomic_t sys_misc_mem_sz; + +#if defined(ERTS_SMP) +erts_mtx_t chld_stat_mtx; +#endif + +#if defined(ERTS_SMP) /* ------------------------------------------------- */ +#define CHLD_STAT_LOCK erts_mtx_lock(&chld_stat_mtx) +#define CHLD_STAT_UNLOCK erts_mtx_unlock(&chld_stat_mtx) + +#else /* ------------------------------------------------------------------- */ +#define CHLD_STAT_LOCK +#define CHLD_STAT_UNLOCK +static volatile int children_died; +#endif + +#define SET_AIO(REQ,FD,SIZE,BUFF) \ + memset(&(REQ),0,sizeof(REQ)); \ + (REQ).aio_fildes = FD; \ + (REQ).aio_offset = FM_POSITION_CURRENT; \ + (REQ).aio_nbytes = SIZE; \ + (REQ).aio_buf = BUFF; \ + (REQ).aio_sigevent.sigev_notify = SIGEV_NONE + +/* the first sizeof(struct aiocb *) bytes of the write buffer + * will contain the pointer to the aiocb struct, this needs + * to be freed between asynchronous writes. + * A write of 0 bytes is ignored. */ +#define WRITE_AIO(FD,SIZE,BUFF) do { \ + if (SIZE > 0) { \ + struct aiocb *write_req = driver_alloc(sizeof(struct aiocb)); \ + char *write_buff = driver_alloc((sizeof(char)*SIZE)+1+ \ + (sizeof(struct aiocb *))); \ + *(struct aiocb **)write_buff = (struct aiocb *)write_req; \ + write_buff += sizeof(struct aiocb *); \ + memcpy(write_buff,BUFF,SIZE+1); \ + SET_AIO(*write_req,FD,SIZE,write_buff); \ + if (aio_write(write_req)) \ + ramlog_printf("%s:%d: write failed with %d\n", \ + __FILE__,__LINE__,errno); \ + } \ +} while(0) + +/* free the write_buffer and write_req + * created in the WRITE_AIO() request macro */ +#define FREE_AIO(ptr) do { \ + struct aiocb *aiocb_ptr; \ + char *buffer_ptr; \ + aiocb_ptr = *(struct aiocb **)((ptr)-sizeof(struct aiocb *)); \ + buffer_ptr = (((char*)ptr)-sizeof(struct aiocb *)); \ + driver_free(aiocb_ptr); \ + driver_free(buffer_ptr); \ +} while(0) + +#define DISPATCH_AIO(sig) do { \ + if (aio_dispatch(sig)) \ + ramlog_printf("%s:%d: dispatch failed with %d\n", \ + __FILE__,__LINE__,errno); \ + } while(0) + +#define AIO_PIPE_SIZE 1024 + +/* debug print macros */ +#define DEBUG_RES 0 + +#ifdef DEBUG_RES +#define DEBUG_CHECK_RES(actual, expected) \ + do { \ + if (actual != expected ) { \ + ramlog_printf("Result check failed" \ + " got: 0x%08x expected:0x%08x\nat: %s:%d\n", \ + actual, expected, __FILE__, __LINE__); \ + abort(); /* This might perhaps be too harsh? */ \ + } \ + } while(0) +#else +#define DEBUG_CHECK_RES +#endif + +static struct fd_data { + char pbuf[4]; /* hold partial packet bytes */ + int psz; /* size of pbuf */ + char *buf; + char *cpos; + int sz; + int remain; /* for input on fd */ +} *fd_data; /* indexed by fd */ + +/********************* General functions ****************************/ + +/* This is used by both the drivers and general I/O, must be set early */ +static int max_files = -1; + +/* + * a few variables used by the break handler + */ +#ifdef ERTS_SMP +erts_smp_atomic32_t erts_break_requested; +#define ERTS_SET_BREAK_REQUESTED \ + erts_smp_atomic32_set_nob(&erts_break_requested, (erts_aint32_t) 1) +#define ERTS_UNSET_BREAK_REQUESTED \ + erts_smp_atomic32_set_nob(&erts_break_requested, (erts_aint32_t) 0) +#else +volatile int erts_break_requested = 0; +#define ERTS_SET_BREAK_REQUESTED (erts_break_requested = 1) +#define ERTS_UNSET_BREAK_REQUESTED (erts_break_requested = 0) +#endif +/* set early so the break handler has access to initial mode */ +static struct termios initial_tty_mode; +static int replace_intr = 0; +/* assume yes initially, ttsl_init will clear it */ +int using_oldshell = 1; +static PROCESS get_signal_proxy_pid(void); + +static void +init_check_io(void) +{ + erts_init_check_io(); + max_files = erts_check_io_max_files(); +} + +#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT +#define ERTS_CHK_IO_AS_INTR() erts_check_io_async_sig_interrupt() +#else +#define ERTS_CHK_IO_AS_INTR() erts_check_io_interrupt(1) +#endif +#define ERTS_CHK_IO_INTR erts_check_io_interrupt +#define ERTS_CHK_IO_INTR_TMD erts_check_io_interrupt_timed +#define ERTS_CHK_IO erts_check_io +#define ERTS_CHK_IO_SZ erts_check_io_size + + +void +erts_sys_schedule_interrupt(int set) +{ + ERTS_CHK_IO_INTR(set); +} + +#ifdef ERTS_SMP +void +erts_sys_schedule_interrupt_timed(int set, erts_short_time_t msec) +{ + ERTS_CHK_IO_INTR_TMD(set, msec); +} +#endif + +Uint +erts_sys_misc_mem_sz(void) +{ + Uint res = ERTS_CHK_IO_SZ(); + res += erts_smp_atomic_read_mb(&sys_misc_mem_sz); + return res; +} + +/* + * reset the terminal to the original settings on exit + */ +void sys_tty_reset(int exit_code) +{ + if (using_oldshell && !replace_intr) { + SET_BLOCKING(0); + } + else if (isatty(0)) { + tcsetattr(0,TCSANOW,&initial_tty_mode); + } +} + +#ifdef USE_THREADS + +typedef struct { + int sched_bind_data; +} erts_thr_create_data_t; + +/* + * thr_create_prepare() is called in parent thread before thread creation. + * Returned value is passed as argument to thr_create_cleanup(). + */ +static void * +thr_create_prepare(void) +{ + erts_thr_create_data_t *tcdp; + + tcdp = erts_alloc(ERTS_ALC_T_TMP, sizeof(erts_thr_create_data_t)); + + tcdp->sched_bind_data = erts_sched_bind_atthrcreate_prepare(); + + return (void *) tcdp; +} + + +/* thr_create_cleanup() is called in parent thread after thread creation. */ +static void +thr_create_cleanup(void *vtcdp) +{ + erts_thr_create_data_t *tcdp = (erts_thr_create_data_t *) vtcdp; + + erts_sched_bind_atthrcreate_parent(tcdp->sched_bind_data); + + erts_free(ERTS_ALC_T_TMP, tcdp); +} + +static void +thr_create_prepare_child(void *vtcdp) +{ + erts_thr_create_data_t *tcdp = (erts_thr_create_data_t *) vtcdp; + +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_thread_setup(); +#endif + + erts_sched_bind_atthrcreate_child(tcdp->sched_bind_data); +} + +#endif /* #ifdef USE_THREADS */ + +/* The two functions below are stolen from win_con.c + They have to use malloc/free/realloc directly becasue + we want to do able to do erts_printf very early on. + */ +#define VPRINTF_BUF_INC_SIZE 128 +static erts_dsprintf_buf_t * +grow_vprintf_buf(erts_dsprintf_buf_t *dsbufp, size_t need) +{ + char *buf; + size_t size; + + ASSERT(dsbufp); + + if (!dsbufp->str) { + size = (((need + VPRINTF_BUF_INC_SIZE - 1) + / VPRINTF_BUF_INC_SIZE) + * VPRINTF_BUF_INC_SIZE); + buf = (char *) malloc(size * sizeof(char)); + } + else { + size_t free_size = dsbufp->size - dsbufp->str_len; + + if (need <= free_size) + return dsbufp; + + size = need - free_size + VPRINTF_BUF_INC_SIZE; + size = (((size + VPRINTF_BUF_INC_SIZE - 1) + / VPRINTF_BUF_INC_SIZE) + * VPRINTF_BUF_INC_SIZE); + size += dsbufp->size; + buf = (char *) realloc((void *) dsbufp->str, + size * sizeof(char)); + } + if (!buf) + return NULL; + if (buf != dsbufp->str) + dsbufp->str = buf; + dsbufp->size = size; + return dsbufp; +} + +static int erts_sys_ramlog_printf(char *format, va_list arg_list) +{ + int res,i; + erts_dsprintf_buf_t dsbuf = ERTS_DSPRINTF_BUF_INITER(grow_vprintf_buf); + res = erts_vdsprintf(&dsbuf, format, arg_list); + if (res >= 0) { + for (i = 0; i < dsbuf.str_len; i+= 50) + /* We print 50 characters at a time because otherwise + the ramlog looks broken */ + ramlog_printf("%.*s",dsbuf.str_len-50 < 0?dsbuf.str_len:50,dsbuf.str+i); + } + if (dsbuf.str) + free((void *) dsbuf.str); + return res; +} + +void +erts_sys_pre_init(void) +{ + erts_printf_add_cr_to_stdout = 1; + erts_printf_add_cr_to_stderr = 1; +#ifdef USE_THREADS + { + erts_thr_init_data_t eid = ERTS_THR_INIT_DATA_DEF_INITER; + + eid.thread_create_child_func = thr_create_prepare_child; + /* Before creation in parent */ + eid.thread_create_prepare_func = thr_create_prepare; + /* After creation in parent */ + eid.thread_create_parent_func = thr_create_cleanup, + + erts_thr_init(&eid); + + report_exit_list = NULL; + +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_init(); +#endif + +#if defined(ERTS_SMP) + erts_mtx_init(&chld_stat_mtx, "child_status"); +#endif + } +#ifdef ERTS_SMP + erts_smp_atomic32_init_nob(&erts_break_requested, 0); + erts_smp_atomic32_init_nob(&have_prepared_crash_dump, 0); +#else + erts_break_requested = 0; + have_prepared_crash_dump = 0; +#endif +#if !defined(ERTS_SMP) + children_died = 0; +#endif +#endif /* USE_THREADS */ + + erts_printf_stdout_func = erts_sys_ramlog_printf; + + erts_smp_atomic_init_nob(&sys_misc_mem_sz, 0); +} + +void +erl_sys_init(void) +{ + +#ifdef USE_SETLINEBUF + setlinebuf(stdout); +#else + setvbuf(stdout, (char *)NULL, _IOLBF, BUFSIZ); +#endif + + erts_sys_init_float(); + + /* we save this so the break handler can set and reset it properly */ + /* also so that we can reset on exit (break handler or not) */ + if (isatty(0)) { + tcgetattr(0,&initial_tty_mode); + } + tzset(); /* Required at least for NetBSD with localtime_r() */ +} + +static ERTS_INLINE int +prepare_crash_dump(int secs) +{ +#define NUFBUF (3) + int i, max; + char env[21]; /* enough to hold any 64-bit integer */ + size_t envsz; + /*DeclareTmpHeapNoproc(heap,NUFBUF);*/ + /*Eterm *hp = heap;*/ + /*Eterm list = NIL;*/ + int has_heart = 0; + + UseTmpHeapNoproc(NUFBUF); + + if (ERTS_PREPARED_CRASH_DUMP) + return 0; /* We have already been called */ + + + /* Positive secs means an alarm must be set + * 0 or negative means no alarm + * + * Set alarm before we try to write to a port + * we don't want to hang on a port write with + * no alarm. + * + */ + +#if 0 /*ose TBD!!!*/ + if (secs >= 0) { + alarm((unsigned int)secs); + } +#endif + + /* Make sure we unregister at epmd (unknown fd) and get at least + one free filedescriptor (for erl_crash.dump) */ + + max = max_files; + if (max < 1024) + max = 1024; + for (i = 3; i < max; i++) { + close(i); + } + + envsz = sizeof(env); + i = erts_sys_getenv__("ERL_CRASH_DUMP_NICE", env, &envsz); + if (i >= 0) { + int nice_val; + nice_val = i != 0 ? 0 : atoi(env); + if (nice_val > 39) { + nice_val = 39; + } + set_pri(nice_val); + } + + UnUseTmpHeapNoproc(NUFBUF); +#undef NUFBUF + return has_heart; +} + +int erts_sys_prepare_crash_dump(int secs) +{ + return prepare_crash_dump(secs); +} + +static ERTS_INLINE void +break_requested(void) +{ + /* + * just set a flag - checked for and handled by + * scheduler threads erts_check_io() (not signal handler). + */ +#ifdef DEBUG + fprintf(stderr,"break!\n"); +#endif + if (ERTS_BREAK_REQUESTED) + erl_exit(ERTS_INTR_EXIT, ""); + + ERTS_SET_BREAK_REQUESTED; + ERTS_CHK_IO_AS_INTR(); /* Make sure we don't sleep in poll */ +} + +/* Disable break */ +void erts_set_ignore_break(void) { + +} + +/* Don't use ctrl-c for break handler but let it be + used by the shell instead (see user_drv.erl) */ +void erts_replace_intr(void) { + struct termios mode; + + if (isatty(0)) { + tcgetattr(0, &mode); + + /* here's an example of how to replace ctrl-c with ctrl-u */ + /* mode.c_cc[VKILL] = 0; + mode.c_cc[VINTR] = CKILL; */ + + mode.c_cc[VINTR] = 0; /* disable ctrl-c */ + tcsetattr(0, TCSANOW, &mode); + replace_intr = 1; + } +} + +void init_break_handler(void) +{ + +} + +int sys_max_files(void) +{ + return(max_files); +} + + +/************************** OS info *******************************/ + +/* Used by erlang:info/1. */ +/* (This code was formerly in drv.XXX/XXX_os_drv.c) */ + +char os_type[] = "ose"; + +void +os_flavor(char* namebuf, /* Where to return the name. */ + unsigned size) /* Size of name buffer. */ +{ +#if 0 + struct utsname uts; /* Information about the system. */ + char* s; + + (void) uname(&uts); + for (s = uts.sysname; *s; s++) { + if (isupper((int) *s)) { + *s = tolower((int) *s); + } + } + strcpy(namebuf, uts.sysname); +#else + strncpy(namebuf, "release", size); +#endif +} + +void +os_version(pMajor, pMinor, pBuild) +int* pMajor; /* Pointer to major version. */ +int* pMinor; /* Pointer to minor version. */ +int* pBuild; /* Pointer to build number. */ +{ + *pMajor = 5; + *pMinor = 7; + *pBuild = 0; +} + +void init_getenv_state(GETENV_STATE *state) +{ + erts_smp_rwmtx_rlock(&environ_rwmtx); + *state = NULL; +} + +char **environ; /*ose - needs replacement*/ + +char *getenv_string(GETENV_STATE *state0) +{ + char **state = (char **) *state0; + char *cp; + + ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rlocked(&environ_rwmtx)); + + if (state == NULL) + state = environ; + + cp = *state++; + *state0 = (GETENV_STATE) state; + + return cp; +} + +void fini_getenv_state(GETENV_STATE *state) +{ + *state = NULL; + erts_smp_rwmtx_runlock(&environ_rwmtx); +} + + +/************************** Port I/O *******************************/ + +/* I. Common stuff */ + +union SIGNAL { + SIGSELECT sig_no; + struct FmReadPtr fm_read_reply; + struct FmWritePtr fm_write_reply; + struct async async; +}; + +/* II. The spawn/fd drivers */ + +/* + * Decreasing the size of it below 16384 is not allowed. + */ +#define ERTS_SYS_READ_BUF_SZ (64*1024) + +/* Driver interfaces */ +static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*); +static ErlDrvData fd_start(ErlDrvPort, char*, SysDriverOpts*); +static ErlDrvSSizeT fd_control(ErlDrvData, unsigned int, char *, ErlDrvSizeT, + char **, ErlDrvSizeT); +static int spawn_init(void); +static void fd_stop(ErlDrvData); +static void erl_stop(ErlDrvData); +static void ready_input(ErlDrvData, ErlDrvEvent); +static void ready_output(ErlDrvData, ErlDrvEvent); +static void output(ErlDrvData, char*, ErlDrvSizeT); +static void stop_select(ErlDrvEvent, void*); + +static PROCESS +get_signal_proxy_pid(void) { + union SIGNAL *sig; + SIGSELECT any_sig[] = {1,ERTS_SIGNAL_OSE_DRV_ATTACH}; + + if (!sig_proxy_pid) { + sig = alloc(sizeof(union SIGNAL), ERTS_SIGNAL_OSE_DRV_ATTACH); + hunt("ose_signal_driver_proxy", 0, NULL, &sig); + sig = receive(any_sig); + sig_proxy_pid = sender(&sig); + free_buf(&sig); + } + ASSERT(sig_proxy_pid); + return sig_proxy_pid; +} + +static ErlDrvOseEventId +resolve_signal(union SIGNAL* sig) { + switch(sig->sig_no) { + + case FM_READ_PTR_REPLY: + return (ErlDrvOseEventId)sig->fm_read_reply.handle; + + case FM_WRITE_PTR_REPLY: + return (ErlDrvOseEventId)sig->fm_write_reply.handle; + + case ERTS_SIGNAL_OSE_DRV_ATTACH: + return (ErlDrvOseEventId)sig->async.target; + + default: + break; + } + return (ErlDrvOseEventId)-1; +} + +struct erl_drv_entry spawn_driver_entry = { + spawn_init, + spawn_start, + NULL, /* erl_stop, */ + output, + ready_input, + ready_output, + "spawn", + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL, NULL, + stop_select +}; +struct erl_drv_entry fd_driver_entry = { + NULL, + fd_start, + fd_stop, + output, + ready_input, + ready_output, + "fd", + NULL, + NULL, + fd_control, + NULL, + NULL, + NULL, /* ready_async */ + NULL, /* flush */ + NULL, /* call */ + NULL, /* event */ + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, /* ERL_DRV_FLAGs */ + NULL, /* handle2 */ + NULL, /* process_exit */ + stop_select +}; + +static void +set_spawn_fd(int local_fd, int remote_fd, PROCESS remote_pid) { + PROCESS vm_pid; + FmHandle handle; + char env_val[55]; + char env_name[10]; + EfsStatus efs_res; + + /* get pid of pipevm and handle of chosen fd */ + efs_res = efs_examine_fd(local_fd, FLIB_FD_VMPID, &vm_pid, 0); + DEBUG_CHECK_RES(efs_res, EFS_SUCCESS); + + /* setup the file descriptor to buffer per line */ + efs_res = efs_config_fd(local_fd, FLIB_FD_BUFMODE, FM_BUFF_LINE, + FLIB_FD_BUFSIZE, 80, 0); + DEBUG_CHECK_RES(efs_res, EFS_SUCCESS); + + /* duplicate handle and set spawn pid owner */ + efs_res = efs_dup_to(local_fd, remote_pid, &handle); + DEBUG_CHECK_RES(efs_res, EFS_SUCCESS); + + sprintf(env_name, "FD%d", remote_fd); + + /* Syntax of the environment variable: + * "FD#" "<pid of pipevm>,<handle>,<buffer mode>,<buff size>,<omode>" */ + sprintf(env_val, "0x%lx,0x%lx,%lu,%lu,0x%x", + vm_pid, handle, + FM_BUFF_LINE, 80, + O_APPEND); + + set_env(remote_pid, env_name, env_val); +} + +static ErlDrvData +set_driver_data(ErlDrvPort port_num, + int ifd, + int ofd, + int packet_bytes, + int read_write, + int exit_status, + PROCESS pid) +{ + Port *prt; + ErtsSysReportExit *report_exit; + + prt = erts_drvport2port(port_num); + if (prt != ERTS_INVALID_ERL_DRV_PORT) { + prt->os_pid = pid; + } + + /* READ */ + if (read_write & DO_READ) { + EfsStatus res = efs_examine_fd(ifd, FLIB_FD_HANDLE, + &driver_data[ifd].handle, 0); + if (res != EFS_SUCCESS) + ramlog_printf("%s:%d: efs_examine_fd(%d) failed with %d\n", + __FILE__,__LINE__,ifd,errno); + driver_data[ifd].ifd = ifd; + driver_data[ifd].packet_bytes = packet_bytes; + driver_data[ifd].port_num = port_num; + driver_data[ifd].pid = pid; + + /* async read struct */ + memset(&driver_data[ifd].aiocb, 0, sizeof(struct aiocb)); + driver_data[ifd].aiocb.aio_buf = driver_alloc(AIO_PIPE_SIZE); + driver_data[ifd].aiocb.aio_fildes = ifd; + driver_data[ifd].aiocb.aio_nbytes = (packet_bytes?packet_bytes:AIO_PIPE_SIZE); + driver_data[ifd].alive = 1; + driver_data[ifd].status = 0; + driver_data[ifd].input_event = + erl_drv_ose_event_alloc(FM_READ_PTR_REPLY, + driver_data[ifd].handle, resolve_signal, + &driver_data[ifd].ifd); + + /* READ & WRITE */ + if (read_write & DO_WRITE) { + driver_data[ifd].ofd = ofd; + efs_examine_fd(ofd, FLIB_FD_HANDLE, &driver_data[ofd].handle, 0); + + driver_data[ifd].output_event = + erl_drv_ose_event_alloc(FM_WRITE_PTR_REPLY, + driver_data[ofd].handle, resolve_signal, + &driver_data[ofd].ofd); + driver_data[ofd].pid = pid; + if (ifd != ofd) { + driver_data[ofd] = driver_data[ifd]; + driver_data[ofd].aiocb.aio_buf = NULL; + } + } + else { /* READ ONLY */ + driver_data[ifd].ofd = -1; + } + + /* enable input event */ + (void) driver_select(port_num, driver_data[ifd].input_event, + (ERL_DRV_READ | ERL_DRV_USE), 1); + + if (aio_read(&driver_data[ifd].aiocb)) + ramlog_printf("%s:%d: aio_read(%d) failed with %d\n", + __FILE__,__LINE__,ifd,errno); + } + else { /* WRITE ONLY */ + efs_examine_fd(ofd, FLIB_FD_HANDLE, &driver_data[ofd].handle, 0); + driver_data[ofd].packet_bytes = packet_bytes; + driver_data[ofd].port_num = port_num; + driver_data[ofd].ofd = ofd; + driver_data[ofd].pid = pid; + driver_data[ofd].alive = 1; + driver_data[ofd].status = 0; + driver_data[ofd].output_event = + erl_drv_ose_event_alloc(FM_WRITE_PTR_REPLY, driver_data[ofd].handle, + resolve_signal, &driver_data[ofd].ofd); + driver_data[ofd].input_event = driver_data[ofd].output_event; + } + + /* this is used for spawned load modules, and is needed + * to properly uninstall them */ + if (exit_status) { + struct PmProgramInfo *info; + int install_handle_size; + union SIGNAL *sig; + PmStatus pm_status; + report_exit = erts_alloc(ERTS_ALC_T_PRT_REP_EXIT, + sizeof(ErtsSysReportExit)); + report_exit->next = report_exit_list; + report_exit->port = erts_drvport2id(port_num); + report_exit->pid = pid; + report_exit->ifd = (read_write & DO_READ) ? ifd : -1; + report_exit->ofd = (read_write & DO_WRITE) ? ofd : -1; + report_exit_list = report_exit; + report_exit->attach_event = + erl_drv_ose_event_alloc(ERTS_SIGNAL_OSE_DRV_ATTACH, pid, + resolve_signal, &driver_data[ifd].ifd); + + /* setup ifd and ofd report exit */ + driver_data[ifd].report_exit = report_exit; + driver_data[ofd].report_exit = report_exit; + + pm_status = ose_pm_program_info(pid, &info); + DEBUG_CHECK_RES(pm_status, PM_SUCCESS); + + install_handle_size = strlen(info->install_handle)+1; + driver_data[ifd].install_handle = driver_alloc(install_handle_size); + strcpy(driver_data[ifd].install_handle, + info->install_handle); + + free_buf((union SIGNAL **)&info); + + sig = alloc(sizeof(struct async), ERTS_SIGNAL_OSE_DRV_ATTACH); + sig->async.target = pid; + send(&sig, get_signal_proxy_pid()); + + /* this event will trigger when we receive an attach signal + * from the recently dead load module */ + (void)driver_select(port_num,report_exit->attach_event, DO_READ, 1); + } + else { + report_exit = NULL; + } + + /* the return value is the pointer to the driver_data struct we created + * in this function, it will be used in the drivers input + * and output functions */ + return (ErlDrvData)((!(read_write & DO_READ) && read_write & DO_WRITE) + ? &driver_data[ofd] + : &driver_data[ifd]); +} + +static int spawn_init() +{ + int i; + + driver_data = (struct driver_data *) + erts_alloc(ERTS_ALC_T_DRV_TAB, max_files * sizeof(struct driver_data)); + erts_smp_atomic_add_nob(&sys_misc_mem_sz, + max_files * sizeof(struct driver_data)); + + for (i = 0; i < max_files; i++) + driver_data[i].pid = -1; + + return 1; +} + +static void +init_fd_data(int fd, ErlDrvPort port_num) +{ + fd_data[fd].buf = NULL; + fd_data[fd].cpos = NULL; + fd_data[fd].remain = 0; + fd_data[fd].sz = 0; + fd_data[fd].psz = 0; +} + +/* FIXME write a decent text on pipes on ose */ +static ErlDrvData +spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) +{ + int ifd[2]; + int ofd[2]; + static uint32_t ticker = 1; + PmStatus pm_status; + OSDOMAIN domain = PM_NEW_DOMAIN; + PROCESS progpid, mainbid, mainpid; + char *handle = NULL; + struct PmProgramInfo *info; + char *args = NULL; + char *tmp_handle; + ErlDrvData res = (ErlDrvData)-1; + int handle_size; + char *ptr; + + + args = driver_alloc(strlen(name)+1); + strcpy(args, name); + /* We need to handle name in three parts + * - install handle (must be unique) + * - install binary (needed for ose_pm_install_load_module()) + * - full path (as argument to the spawned applications env.var + */ + + /* full path including arguments */ + args = driver_alloc(strlen(name)+1); + strcpy(args, name); + + /* handle path */ + tmp_handle = strrchr(name, '/'); + if (tmp_handle == NULL) { + tmp_handle = name; + } + else { + tmp_handle++; + } + + /* handle args */ + ptr = strchr(tmp_handle, ' '); + if (ptr != NULL) { + *ptr = '\0'; + handle_size = ptr - tmp_handle; + } + else { + handle_size = strlen(name)+1; + } + + /* make room for ticker */ + handle_size += (ticker<10)?3:((ticker<100)?4:5); + handle = driver_alloc(handle_size); + + do { + snprintf(handle, handle_size, "%s_%d", tmp_handle, ticker); + pm_status = ose_pm_install_load_module(0, "ELF", name, handle, + 0, 0, NULL); + ticker++; + } while (pm_status == PM_EINSTALL_HANDLE_ALREADY_INSTALLED); + + if (pm_status != PM_SUCCESS) { + errno = ENOSYS; /* FIXME add comment */ + return ERL_DRV_ERROR_ERRNO; + } + + /* Create Program */ + pm_status = ose_pm_create_program(&domain, handle, 0, 0, + NULL, &progpid, &mainbid); + DEBUG_CHECK_RES(pm_status, PM_SUCCESS); + + /* Get the mainpid from the newly created program */ + pm_status = ose_pm_program_info(progpid, &info); + DEBUG_CHECK_RES(pm_status, PM_SUCCESS); + + mainpid = info->main_process; + free_buf ((union SIGNAL **)&info); + + /* pipevm needs to be started + * pipe will return 0 if success, -1 if not, + * errno will be set */ + if (pipe(ifd) != 0 || pipe(ofd) != 0) { + DEBUG_CHECK_RES(0, -1); + ASSERT(0); + } + + /* setup driver data */ + res = set_driver_data(port_num, ofd[0], ifd[1], opts->packet_bytes, + opts->read_write, 1 /* opts->exit_status */, progpid); + + /* init the fd_data array for read/write */ + init_fd_data(ofd[0], port_num); + init_fd_data(ifd[1], port_num); + + /* setup additional configurations + * for the spawned applications environment */ + if (args != NULL) { + set_env(progpid, "ARGV", args); + } + set_env(mainbid, "EFS_RESOLVE_TMO", 0); + set_spawn_fd(ifd[0], 0, mainpid); + set_spawn_fd(ofd[1], 1, mainpid); + set_spawn_fd(ofd[1], 2, mainpid); + + /* start the spawned program */ + pm_status = ose_pm_start_program(mainbid); + DEBUG_CHECK_RES(pm_status, PM_SUCCESS); + + /* close unused fd's */ + close(ifd[0]); + close(ofd[1]); + + if (handle) { + driver_free(handle); + } + + return (ErlDrvData)res; +} + +#define FD_DEF_HEIGHT 24 +#define FD_DEF_WIDTH 80 +/* Control op */ +#define FD_CTRL_OP_GET_WINSIZE 100 + +static int fd_get_window_size(int fd, Uint32 *width, Uint32 *height) +{ +#ifdef TIOCGWINSZ + struct winsize ws; + if (ioctl(fd,TIOCGWINSZ,&ws) == 0) { + *width = (Uint32) ws.ws_col; + *height = (Uint32) ws.ws_row; + return 0; + } +#endif + return -1; +} + +static ErlDrvSSizeT fd_control(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen) +{ + struct driver_data *data = (struct driver_data *)drv_data; + char resbuff[2*sizeof(Uint32)]; + switch (command) { + case FD_CTRL_OP_GET_WINSIZE: + { + Uint32 w,h; + if (fd_get_window_size(data->ifd,&w,&h)) + return 0; + memcpy(resbuff,&w,sizeof(Uint32)); + memcpy(resbuff+sizeof(Uint32),&h,sizeof(Uint32)); + } + break; + default: + return 0; + } + if (rlen < 2*sizeof(Uint32)) { + *rbuf = driver_alloc(2*sizeof(Uint32)); + } + memcpy(*rbuf,resbuff,2*sizeof(Uint32)); + return 2*sizeof(Uint32); +} + +static ErlDrvData fd_start(ErlDrvPort port_num, char* name, + SysDriverOpts* opts) +{ + ErlDrvData res; + + CHLD_STAT_LOCK; + if (opts->read_write & DO_READ) { + init_fd_data(opts->ifd, port_num); + } + if (opts->read_write & DO_WRITE) { + init_fd_data(opts->ofd, port_num); + } + res = set_driver_data(port_num, opts->ifd, opts->ofd, + opts->packet_bytes, + opts->read_write, 0, -1); + CHLD_STAT_UNLOCK; + return res; +} + +static void clear_fd_data(int fd) +{ + if (fd_data[fd].sz > 0) { + erts_free(ERTS_ALC_T_FD_ENTRY_BUF, (void *) fd_data[fd].buf); + ASSERT(erts_smp_atomic_read_nob(&sys_misc_mem_sz) >= fd_data[fd].sz); + erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*fd_data[fd].sz); + } + fd_data[fd].buf = NULL; + fd_data[fd].sz = 0; + fd_data[fd].remain = 0; + fd_data[fd].cpos = NULL; + fd_data[fd].psz = 0; +} + +static void nbio_stop_fd(ErlDrvPort prt, ErlDrvEvent ev) +{ + int *fd; + driver_select(prt,ev,DO_READ|DO_WRITE,0); + erl_drv_ose_event_fetch(ev, NULL, NULL, (void **)&fd); + clear_fd_data(*fd); + SET_BLOCKING(*fd); +} + +static void fd_stop(ErlDrvData drv_data) /* Does not close the fds */ +{ + struct driver_data *data = (struct driver_data *)drv_data; + + if (data->ofd != -1) { + if (data->ifd != data->ofd) { /* read and write */ + nbio_stop_fd(data->port_num, data->input_event); + nbio_stop_fd(data->port_num, data->output_event); + } + else { /* write only */ + nbio_stop_fd(data->port_num, data->output_event); + } + } + else { /* read only */ + nbio_stop_fd(data->port_num, data->input_event); + } +} + + +static void erl_stop(ErlDrvData drv_data) +{ + struct driver_data *data = (struct driver_data *)drv_data; + + CHLD_STAT_LOCK; + data->pid = -1; + CHLD_STAT_UNLOCK; + + if (data->ofd != -1) { + if (data->ifd != data->ofd) { /* read and write */ + nbio_stop_fd(data->port_num, data->input_event); + nbio_stop_fd(data->port_num, data->output_event); + } + else { /* write only */ + nbio_stop_fd(data->port_num, data->output_event); + } + } + else { /* read only */ + nbio_stop_fd(data->port_num, data->input_event); + } + close(data->ifd); + close(data->ofd); +} + +/* The parameter e is a pointer to the driver_data structure + * related to the fd to be used as output */ +static void output(ErlDrvData drv_data, char* buf, ErlDrvSizeT len) +{ + ErlDrvSizeT sz; + char lb[4]; + char* lbp; + struct driver_data *data = (struct driver_data *)drv_data; + + if (((data->packet_bytes == 2) && + (len > 0xffff)) || (data->packet_bytes == 1 && len > 0xff)) { + driver_failure_posix(data->port_num, EINVAL); + return; /* -1; */ + } + put_int32(len, lb); + lbp = lb + (4-(data->packet_bytes)); + + if ((sz = driver_sizeq(data->port_num)) > 0) { + if (data->packet_bytes != 0) { + driver_enq(data->port_num, lbp, data->packet_bytes); + } + driver_enq(data->port_num, buf, len); + + if (sz + len + data->packet_bytes >= (1 << 13)) + set_busy_port(data->port_num, 1); + } + else { + char *pbbuf; + if (data->packet_bytes != 0) { + pbbuf = malloc(len + data->packet_bytes); + int i; + for (i = 0; i < data->packet_bytes; i++) { + *pbbuf++ = *lbp++; + } + strncpy(pbbuf, buf, len); + pbbuf -= data->packet_bytes; + } + driver_select(data->port_num, data->output_event, + ERL_DRV_WRITE|ERL_DRV_USE, 1); + WRITE_AIO(data->ofd, + (data->packet_bytes ? len+data->packet_bytes : len), + (data->packet_bytes ? pbbuf : buf)); + if (data->packet_bytes != 0) free(pbbuf); + } + return; /* 0; */ +} + +/* This function is being run when we in recieve + * either a read of 0 bytes, or the attach signal from a dying + * spawned load module */ +static int port_inp_failure(ErlDrvPort port_num, ErlDrvEvent ready_fd, int res) + /* Result: 0 (eof) or -1 (error) */ +{ + int *fd; + SIGSELECT sig_no; + ASSERT(res <= 0); + + erl_drv_ose_event_fetch(ready_fd,&sig_no, NULL, (void **)&fd); + /* As we need to handle two signals, we do this in two steps */ + if (driver_data[*fd].alive) { + report_exit_status(driver_data[*fd].report_exit, 0); /* status? */ + } + else { + driver_select(port_num,ready_fd,DO_READ|DO_WRITE,0); + clear_fd_data(*fd); + driver_report_exit(driver_data[*fd].port_num, driver_data[*fd].status); + /* As we do not really know if the spawn has crashed or exited nicely + * we do not check the result status of the following call.. FIXME + * can we handle this in a better way? */ + ose_pm_uninstall_load_module(driver_data[*fd].install_handle); + driver_free(driver_data[*fd].install_handle); + driver_free((void *)driver_data[*fd].aiocb.aio_buf); + + close(*fd); + } + + return 0; +} + +/* The parameter e is a pointer to the driver_data structure + * related to the fd to be used as output. + * ready_fd is the event that triggered this call to ready_input */ +static void ready_input(ErlDrvData drv_data, ErlDrvEvent ready_fd) +{ + int res; + Uint h; + char *buf; + union SIGNAL *sig; + struct driver_data *data = (struct driver_data *)drv_data; + + sig = erl_drv_ose_get_signal(ready_fd); + ASSERT(sig); + + + while (sig) { + /* If we've recieved an attach signal, we need to handle + * it in port_inp_failure */ + if (sig->sig_no == ERTS_SIGNAL_OSE_DRV_ATTACH) { + port_inp_failure(data->port_num, ready_fd, 0); + } + else { + res = sig->fm_read_reply.actual; + if (res == 0) { + port_inp_failure(data->port_num, ready_fd, res); + break; + } + + if (data->packet_bytes == 0) { + if (res < 0) { + if ((errno != EINTR) && (errno != ERRNO_BLOCK)) { + port_inp_failure(data->port_num, ready_fd, res); + } + } + else if (res == 0) { + /* read of 0 bytes, eof, otherside of pipe is assumed dead */ + port_inp_failure(data->port_num, ready_fd, res); + break; + } + else { + buf = driver_alloc(res); + memcpy(buf, (void *)data->aiocb.aio_buf, res); + driver_select(data->port_num, data->output_event, + ERL_DRV_WRITE|ERL_DRV_USE, 1); + driver_output(data->port_num, (char*) buf, res); + driver_free(buf); + } + /* clear the previous read */ + memset(data->aiocb.aio_buf, 0, res); + + /* issue a new read */ + DISPATCH_AIO(sig); + aio_read(&data->aiocb); + } + else if (data->packet_bytes && fd_data[data->ifd].remain > 0) { + /* we've read a partial package, or a header */ + + if (res == fd_data[data->ifd].remain) { /* we are done! */ + char *buf = data->aiocb.aio_buf; + int i; + + /* do we have anything buffered? */ + if (fd_data[data->ifd].buf != NULL) { + memcpy(fd_data[data->ifd].buf + fd_data[data->ifd].sz, + buf, res); + buf = fd_data[data->ifd].buf; + } + + fd_data[data->ifd].sz += res; + driver_output(data->port_num, buf, (fd_data[data->ifd].sz>0?fd_data[data->ifd].sz:res)); + clear_fd_data(data->ifd); + + /* clear the previous read */ + memset(data->aiocb.aio_buf, 0, res); + + /* issue a new read */ + DISPATCH_AIO(sig); + data->aiocb.aio_nbytes = data->packet_bytes; + + if (data->aiocb.aio_buf == NULL) { + port_inp_failure(data->port_num, ready_fd, -1); + } + aio_read(&data->aiocb); + } + else if(res < fd_data[data->ifd].remain) { /* received part of a package */ + if (fd_data[data->ifd].sz == 0) { + + fd_data[data->ifd].sz += res; + memcpy(fd_data[data->ifd].buf, data->aiocb.aio_buf, res); + fd_data[data->ifd].remain -= res; + } + else { + memcpy(fd_data[data->ifd].buf + fd_data[data->ifd].sz, + data->aiocb.aio_buf, res); + fd_data[data->ifd].sz += res; + fd_data[data->ifd].remain -= res; + } + /* clear the previous read */ + memset(data->aiocb.aio_buf, 0, res); + + /* issue a new read */ + DISPATCH_AIO(sig); + data->aiocb.aio_nbytes = fd_data[data->ifd].remain; + + if (data->aiocb.aio_buf == NULL) { + port_inp_failure(data->port_num, ready_fd, -1); + } + aio_read(&data->aiocb); + } + } + else if (data->packet_bytes && fd_data[data->ifd].remain == 0) { /* we've recieved a header */ + + /* analyze the header FIXME */ + switch (data->packet_bytes) { + case 1: h = get_int8(data->aiocb.aio_buf); break; + case 2: h = get_int16(data->aiocb.aio_buf); break; + case 4: h = get_int32(data->aiocb.aio_buf); break; + } + + fd_data[data->ifd].buf = erts_alloc_fnf(ERTS_ALC_T_FD_ENTRY_BUF, h + data->packet_bytes); + fd_data[data->ifd].remain = ((h + data->packet_bytes) - res); + + /* clear the previous read */ + memset(data->aiocb.aio_buf, 0, data->packet_bytes); + + /* issue a new read */ + DISPATCH_AIO(sig); + data->aiocb.aio_nbytes = h; + + if (data->aiocb.aio_buf == NULL) { + port_inp_failure(data->port_num, ready_fd, -1); + } + aio_read(&data->aiocb); + } + } + sig = erl_drv_ose_get_signal(ready_fd); + } +} + + +/* The parameter e is a pointer to the driver_data structure + * related to the fd to be used as output. + * ready_fd is the event that triggered this call to ready_input */ +static void ready_output(ErlDrvData drv_data, ErlDrvEvent ready_fd) +{ + SysIOVec *iov; + int vlen; + int res; + union SIGNAL *sig; + struct driver_data *data = (struct driver_data *)drv_data; + + sig = erl_drv_ose_get_signal(ready_fd); + ASSERT(sig); + + while (sig != NULL) { + if (sig->fm_write_reply.actual <= 0) { + int status; + + status = efs_status_to_errno(sig->fm_write_reply.status); + driver_select(data->port_num, ready_fd, ERL_DRV_WRITE, 0); + DISPATCH_AIO(sig); + FREE_AIO(sig->fm_write_reply.buffer); + + driver_failure_posix(data->port_num, status); + } + else { /* written bytes > 0 */ + iov = driver_peekq(data->port_num, &vlen); + if (vlen > 0) { + DISPATCH_AIO(sig); + FREE_AIO(sig->fm_write_reply.buffer); + res = driver_deq(data->port_num, iov[0].iov_len); + if (res > 0) { + iov = driver_peekq(data->port_num, &vlen); + WRITE_AIO(data->ofd, iov[0].iov_len, iov[0].iov_base); + } + } + else if (vlen == 0) { + DISPATCH_AIO(sig); + FREE_AIO(sig->fm_write_reply.buffer); + } + + } + sig = erl_drv_ose_get_signal(ready_fd); + } +} + +static void stop_select(ErlDrvEvent ready_fd, void* _) +{ + int *fd; + erl_drv_ose_event_fetch(ready_fd, NULL, NULL, (void **)&fd); + erl_drv_ose_event_free(ready_fd); + close(*fd); +} + + +void erts_do_break_handling(void) +{ + struct termios temp_mode; + int saved = 0; + + /* + * Most functions that do_break() calls are intentionally not thread safe; + * therefore, make sure that all threads but this one are blocked before + * proceeding! + */ + erts_smp_thr_progress_block(); + + /* during break we revert to initial settings */ + /* this is done differently for oldshell */ + if (using_oldshell && !replace_intr) { + SET_BLOCKING(1); + } + else if (isatty(0)) { + tcgetattr(0,&temp_mode); + tcsetattr(0,TCSANOW,&initial_tty_mode); + saved = 1; + } + + /* call the break handling function, reset the flag */ + do_break(); + + fflush(stdout); + + /* after break we go back to saved settings */ + if (using_oldshell && !replace_intr) { + SET_NONBLOCKING(1); + } + else if (saved) { + tcsetattr(0,TCSANOW,&temp_mode); + } + + erts_smp_thr_progress_unblock(); +} + +static pid_t +getpid(void) +{ + return get_bid(current_process()); +} + +int getpagesize(void) +{ + return 1024; +} + + +/* Fills in the systems representation of the jam/beam process identifier. +** The Pid is put in STRING representation in the supplied buffer, +** no interpretatione of this should be done by the rest of the +** emulator. The buffer should be at least 21 bytes long. +*/ +void sys_get_pid(char *buffer, size_t buffer_size){ + pid_t p = getpid(); + /* Assume the pid is scalar and can rest in an unsigned long... */ + erts_snprintf(buffer, buffer_size, "%lu",(unsigned long) p); +} + +int +erts_sys_putenv_raw(char *key, char *value) { + return erts_sys_putenv(key, value); +} +int +erts_sys_putenv(char *key, char *value) +{ + int res; + + erts_smp_rwmtx_rwlock(&environ_rwmtx); + res = set_env(get_bid(current_process()), key, + value); + erts_smp_rwmtx_rwunlock(&environ_rwmtx); + return res; +} + + +int +erts_sys_unsetenv(char *key) +{ + int res; + + erts_smp_rwmtx_rwlock(&environ_rwmtx); + res = set_env(get_bid(current_process()),key,NULL); + erts_smp_rwmtx_rwunlock(&environ_rwmtx); + + return res; +} + +int +erts_sys_getenv__(char *key, char *value, size_t *size) +{ + int res; + char *orig_value = get_env(get_bid(current_process()), key); + if (!orig_value) + res = -1; + else { + size_t len = sys_strlen(orig_value); + if (len >= *size) { + *size = len + 1; + res = 1; + } + else { + *size = len; + sys_memcpy((void *) value, (void *) orig_value, len+1); + res = 0; + } + free_buf((union SIGNAL **)&orig_value); + } + return res; +} + +int +erts_sys_getenv_raw(char *key, char *value, size_t *size) { + return erts_sys_getenv(key, value, size); +} + +/* + * erts_sys_getenv + * returns: + * -1, if environment key is not set with a value + * 0, if environment key is set and value fits into buffer res + * 1, if environment key is set but does not fit into buffer res + * res is set with the needed buffer res value + */ + +int +erts_sys_getenv(char *key, char *value, size_t *size) +{ + int res; + erts_smp_rwmtx_rlock(&environ_rwmtx); + res = erts_sys_getenv__(key, value, size); + erts_smp_rwmtx_runlock(&environ_rwmtx); + return res; +} + +void +sys_init_io(void) +{ + fd_data = (struct fd_data *) + erts_alloc(ERTS_ALC_T_FD_TAB, max_files * sizeof(struct fd_data)); + erts_smp_atomic_add_nob(&sys_misc_mem_sz, + max_files * sizeof(struct fd_data)); +} + +extern const char pre_loaded_code[]; +extern Preload pre_loaded[]; + +void erts_sys_alloc_init(void) +{ +} + +void *erts_sys_alloc(ErtsAlcType_t t, void *x, Uint sz) +{ + void *res = malloc((size_t) sz); +#if HAVE_ERTS_MSEG + if (!res) { + erts_mseg_clear_cache(); + return malloc((size_t) sz); + } +#endif + return res; +} + +void *erts_sys_realloc(ErtsAlcType_t t, void *x, void *p, Uint sz) +{ + void *res = realloc(p, (size_t) sz); +#if HAVE_ERTS_MSEG + if (!res) { + erts_mseg_clear_cache(); + return realloc(p, (size_t) sz); + } +#endif + return res; +} + +void erts_sys_free(ErtsAlcType_t t, void *x, void *p) +{ + free(p); +} + +/* Return a pointer to a vector of names of preloaded modules */ + +Preload* +sys_preloaded(void) +{ + return pre_loaded; +} + +/* Return a pointer to preloaded code for module "module" */ +unsigned char* +sys_preload_begin(Preload* p) +{ + return p->code; +} + +/* Clean up if allocated */ +void sys_preload_end(Preload* p) +{ + /* Nothing */ +} + +/* Read a key from console (?) */ + +int sys_get_key(fd) +int fd; +{ + int c; + unsigned char rbuf[64]; + + fflush(stdout); /* Flush query ??? */ + + if ((c = read(fd,rbuf,64)) <= 0) { + return c; + } + + return rbuf[0]; +} + + +#ifdef DEBUG + +extern int erts_initialized; +void +erl_assert_error(const char* expr, const char* func, + const char* file, int line) +{ + fflush(stdout); + fprintf(stderr, "%s:%d:%s() Assertion failed: %s\n", + file, line, func, expr); + fflush(stderr); + ramlog_printf("%s:%d:%s() Assertion failed: %s\n", + file, line, func, expr); + + abort(); +} + +void +erl_debug(char* fmt, ...) +{ + char sbuf[1024]; /* Temporary buffer. */ + va_list va; + + if (debug_log) { + va_start(va, fmt); + vsprintf(sbuf, fmt, va); + va_end(va); + fprintf(stderr, "%s", sbuf); + } +} + +#endif /* DEBUG */ + +static ERTS_INLINE void +report_exit_status(ErtsSysReportExit *rep, int status) +{ + if (rep->ifd >= 0) { + driver_data[rep->ifd].alive = 0; + driver_data[rep->ifd].status = status; + } + if (rep->ofd >= 0) { + driver_data[rep->ofd].alive = 0; + driver_data[rep->ofd].status = status; + } + + erts_free(ERTS_ALC_T_PRT_REP_EXIT, rep); +} + +#define ERTS_REPORT_EXIT_STATUS report_exit_status + +/* + * Called from schedule() when it runs out of runnable processes, + * or when Erlang code has performed INPUT_REDUCTIONS reduction + * steps. runnable == 0 iff there are no runnable Erlang processes. + */ +void +erl_sys_schedule(int runnable) +{ + ASSERT(get_fsem(current_process()) == 0); +#ifdef ERTS_SMP + ASSERT(erts_get_scheduler_data()->no == 1); + ERTS_CHK_IO(!runnable); +#else + ERTS_CHK_IO( 1 ); +#endif + ASSERT(get_fsem(current_process()) == 0); + ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); +} + + +#ifdef ERTS_SMP + +void +erts_sys_main_thread(void) +{ + erts_thread_disable_fpe(); + + /* Become signal receiver thread... */ +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_set_thread_name("signal_receiver"); +#endif + + while (1) { + static const SIGSELECT sigsel[] = {0}; + union SIGNAL *msg = receive(sigsel); + + fprintf(stderr,"Main thread got message %d from 0x%x!!\r\n", + msg->sig_no, sender(&msg)); + free_buf(&msg); + } +} + +#endif /* ERTS_SMP */ + +void +erl_sys_args(int* argc, char** argv) +{ + int i, j; + + erts_smp_rwmtx_init(&environ_rwmtx, "environ"); + + init_check_io(); + + /* Handled arguments have been marked with NULL. Slide arguments + not handled towards the beginning of argv. */ + for (i = 0, j = 0; i < *argc; i++) { + if (argv[i]) + argv[j++] = argv[i]; + } + *argc = j; + +} diff --git a/erts/emulator/sys/ose/sys_float.c b/erts/emulator/sys/ose/sys_float.c new file mode 100644 index 0000000000..d9d6bb7c04 --- /dev/null +++ b/erts/emulator/sys/ose/sys_float.c @@ -0,0 +1,844 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2013. 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% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "global.h" +#include "erl_process.h" + + +#ifdef NO_FPE_SIGNALS + +void +erts_sys_init_float(void) +{ +# ifdef SIGFPE + sys_sigset(SIGFPE, SIG_IGN); /* Ignore so we can test for NaN and Inf */ +# endif +} + +#else /* !NO_FPE_SIGNALS */ + +#ifdef ERTS_SMP +static erts_tsd_key_t fpe_key; + +/* once-only initialisation early in the main thread (via erts_sys_init_float()) */ +static void erts_init_fp_exception(void) +{ + /* XXX: the wrappers prevent using a pthread destructor to + deallocate the key's value; so when/where do we do that? */ + erts_tsd_key_create(&fpe_key); +} + +void erts_thread_init_fp_exception(void) +{ + unsigned long *fpe = erts_alloc(ERTS_ALC_T_FP_EXCEPTION, sizeof(*fpe)); + *fpe = 0L; + erts_tsd_set(fpe_key, fpe); +} + +static ERTS_INLINE volatile unsigned long *erts_thread_get_fp_exception(void) +{ + return (volatile unsigned long*)erts_tsd_get(fpe_key); +} +#else /* !SMP */ +#define erts_init_fp_exception() /*empty*/ +static volatile unsigned long fp_exception; +#define erts_thread_get_fp_exception() (&fp_exception) +#endif /* SMP */ + +volatile unsigned long *erts_get_current_fp_exception(void) +{ + Process *c_p; + + c_p = erts_get_current_process(); + if (c_p) + return &c_p->fp_exception; + return erts_thread_get_fp_exception(); +} + +static void set_current_fp_exception(unsigned long pc) +{ + volatile unsigned long *fpexnp = erts_get_current_fp_exception(); + ASSERT(fpexnp != NULL); + *fpexnp = pc; +} + +void erts_fp_check_init_error(volatile unsigned long *fpexnp) +{ + char buf[64]; + snprintf(buf, sizeof buf, "ERTS_FP_CHECK_INIT at %p: detected unhandled FPE at %p\r\n", + __builtin_return_address(0), (void*)*fpexnp); + if (write(2, buf, strlen(buf)) <= 0) + erl_exit(ERTS_ABORT_EXIT, "%s", buf); + *fpexnp = 0; +#if defined(__i386__) || defined(__x86_64__) + erts_restore_fpu(); +#endif +} + +/* Is there no standard identifier for Darwin/MacOSX ? */ +#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__) +#define __DARWIN__ 1 +#endif + +#if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__) + +static void unmask_x87(void) +{ + unsigned short cw; + + __asm__ __volatile__("fstcw %0" : "=m"(cw)); + cw &= ~(0x01|0x04|0x08); /* unmask IM, ZM, OM */ + __asm__ __volatile__("fldcw %0" : : "m"(cw)); +} + +/* mask x87 FPE, return true if the previous state was unmasked */ +static int mask_x87(void) +{ + unsigned short cw; + int unmasked; + + __asm__ __volatile__("fstcw %0" : "=m"(cw)); + unmasked = (cw & (0x01|0x04|0x08)) == 0; + /* or just set cw = 0x37f */ + cw |= (0x01|0x04|0x08); /* mask IM, ZM, OM */ + __asm__ __volatile__("fldcw %0" : : "m"(cw)); + return unmasked; +} + +static void unmask_sse2(void) +{ + unsigned int mxcsr; + + __asm__ __volatile__("stmxcsr %0" : "=m"(mxcsr)); + mxcsr &= ~(0x003F|0x0680); /* clear exn flags, unmask OM, ZM, IM (not PM, UM, DM) */ + __asm__ __volatile__("ldmxcsr %0" : : "m"(mxcsr)); +} + +/* mask SSE2 FPE, return true if the previous state was unmasked */ +static int mask_sse2(void) +{ + unsigned int mxcsr; + int unmasked; + + __asm__ __volatile__("stmxcsr %0" : "=m"(mxcsr)); + unmasked = (mxcsr & 0x0680) == 0; + /* or just set mxcsr = 0x1f80 */ + mxcsr &= ~0x003F; /* clear exn flags */ + mxcsr |= 0x0680; /* mask OM, ZM, IM (not PM, UM, DM) */ + __asm__ __volatile__("ldmxcsr %0" : : "m"(mxcsr)); + return unmasked; +} + +#if defined(__x86_64__) + +static inline int cpu_has_sse2(void) { return 1; } + +#else /* !__x86_64__ */ + +/* + * Check if an x86-32 processor has SSE2. + */ +static unsigned int xor_eflags(unsigned int mask) +{ + unsigned int eax, edx; + + eax = mask; /* eax = mask */ + __asm__("pushfl\n\t" + "popl %0\n\t" /* edx = original EFLAGS */ + "xorl %0, %1\n\t" /* eax = mask ^ EFLAGS */ + "pushl %1\n\t" + "popfl\n\t" /* new EFLAGS = mask ^ original EFLAGS */ + "pushfl\n\t" + "popl %1\n\t" /* eax = new EFLAGS */ + "xorl %0, %1\n\t" /* eax = new EFLAGS ^ old EFLAGS */ + "pushl %0\n\t" + "popfl" /* restore original EFLAGS */ + : "=d"(edx), "=a"(eax) + : "1"(eax)); + return eax; +} + +static __inline__ unsigned int cpuid_eax(unsigned int op) +{ + unsigned int eax, save_ebx; + + /* In PIC mode i386 reserves EBX. So we must save + and restore it ourselves to not upset gcc. */ + __asm__( + "movl %%ebx, %1\n\t" + "cpuid\n\t" + "movl %1, %%ebx" + : "=a"(eax), "=m"(save_ebx) + : "0"(op) + : "cx", "dx"); + return eax; +} + +static __inline__ unsigned int cpuid_edx(unsigned int op) +{ + unsigned int eax, edx, save_ebx; + + /* In PIC mode i386 reserves EBX. So we must save + and restore it ourselves to not upset gcc. */ + __asm__( + "movl %%ebx, %2\n\t" + "cpuid\n\t" + "movl %2, %%ebx" + : "=a"(eax), "=d"(edx), "=m"(save_ebx) + : "0"(op) + : "cx"); + return edx; +} + +/* The AC bit, bit #18, is a new bit introduced in the EFLAGS + * register on the Intel486 processor to generate alignment + * faults. This bit cannot be set on the Intel386 processor. + */ +static __inline__ int is_386(void) +{ + return ((xor_eflags(1<<18) >> 18) & 1) == 0; +} + +/* Newer x86 processors have a CPUID instruction, as indicated by + * the ID bit (#21) in EFLAGS being modifiable. + */ +static __inline__ int has_CPUID(void) +{ + return (xor_eflags(1<<21) >> 21) & 1; +} + +static int cpu_has_sse2(void) +{ + unsigned int maxlev, features; + static int has_sse2 = -1; + + if (has_sse2 >= 0) + return has_sse2; + has_sse2 = 0; + + if (is_386()) + return 0; + if (!has_CPUID()) + return 0; + maxlev = cpuid_eax(0); + /* Intel A-step Pentium had a preliminary version of CPUID. + It also didn't have SSE2. */ + if ((maxlev & 0xFFFFFF00) == 0x0500) + return 0; + /* If max level is zero then CPUID cannot report any features. */ + if (maxlev == 0) + return 0; + features = cpuid_edx(1); + has_sse2 = (features & (1 << 26)) != 0; + + return has_sse2; +} +#endif /* !__x86_64__ */ + +static void unmask_fpe(void) +{ + __asm__ __volatile__("fnclex"); + unmask_x87(); + if (cpu_has_sse2()) + unmask_sse2(); +} + +static void unmask_fpe_conditional(int unmasked) +{ + if (unmasked) + unmask_fpe(); +} + +/* mask x86 FPE, return true if the previous state was unmasked */ +static int mask_fpe(void) +{ + int unmasked; + + unmasked = mask_x87(); + if (cpu_has_sse2()) + unmasked |= mask_sse2(); + return unmasked; +} + +void erts_restore_fpu(void) +{ + __asm__ __volatile__("fninit"); + unmask_x87(); + if (cpu_has_sse2()) + unmask_sse2(); +} + +#elif defined(__sparc__) && defined(__linux__) + +#if defined(__arch64__) +#define LDX "ldx" +#define STX "stx" +#else +#define LDX "ld" +#define STX "st" +#endif + +static void unmask_fpe(void) +{ + unsigned long fsr; + + __asm__(STX " %%fsr, %0" : "=m"(fsr)); + fsr &= ~(0x1FUL << 23); /* clear FSR[TEM] field */ + fsr |= (0x1AUL << 23); /* enable NV, OF, DZ exceptions */ + __asm__ __volatile__(LDX " %0, %%fsr" : : "m"(fsr)); +} + +static void unmask_fpe_conditional(int unmasked) +{ + if (unmasked) + unmask_fpe(); +} + +/* mask SPARC FPE, return true if the previous state was unmasked */ +static int mask_fpe(void) +{ + unsigned long fsr; + int unmasked; + + __asm__(STX " %%fsr, %0" : "=m"(fsr)); + unmasked = ((fsr >> 23) & 0x1A) == 0x1A; + fsr &= ~(0x1FUL << 23); /* clear FSR[TEM] field */ + __asm__ __volatile__(LDX " %0, %%fsr" : : "m"(fsr)); + return unmasked; +} + +#elif (defined(__powerpc__) && defined(__linux__)) || (defined(__ppc__) && defined(__DARWIN__)) + +#if defined(__linux__) +#include <sys/prctl.h> + +static void set_fpexc_precise(void) +{ + if (prctl(PR_SET_FPEXC, PR_FP_EXC_PRECISE) < 0) { + perror("PR_SET_FPEXC"); + exit(1); + } +} + +#elif defined(__DARWIN__) + +#include <mach/mach.h> +#include <pthread.h> + +/* + * FE0 FE1 MSR bits + * 0 0 floating-point exceptions disabled + * 0 1 floating-point imprecise nonrecoverable + * 1 0 floating-point imprecise recoverable + * 1 1 floating-point precise mode + * + * Apparently: + * - Darwin 5.5 (MacOS X <= 10.1) starts with FE0 == FE1 == 0, + * and resets FE0 and FE1 to 0 after each SIGFPE. + * - Darwin 6.0 (MacOS X 10.2) starts with FE0 == FE1 == 1, + * and does not reset FE0 or FE1 after a SIGFPE. + */ +#define FE0_MASK (1<<11) +#define FE1_MASK (1<<8) + +/* a thread cannot get or set its own MSR bits */ +static void *fpu_fpe_enable(void *arg) +{ + thread_t t = *(thread_t*)arg; + struct ppc_thread_state state; + unsigned int state_size = PPC_THREAD_STATE_COUNT; + + if (thread_get_state(t, PPC_THREAD_STATE, (natural_t*)&state, &state_size) != KERN_SUCCESS) { + perror("thread_get_state"); + exit(1); + } + if ((state.srr1 & (FE1_MASK|FE0_MASK)) != (FE1_MASK|FE0_MASK)) { +#if 1 + /* This would also have to be performed in the SIGFPE handler + to work around the MSR reset older Darwin releases do. */ + state.srr1 |= (FE1_MASK|FE0_MASK); + thread_set_state(t, PPC_THREAD_STATE, (natural_t*)&state, state_size); +#else + fprintf(stderr, "srr1 == 0x%08x, your Darwin is too old\n", state.srr1); + exit(1); +#endif + } + return NULL; /* Ok, we appear to be on Darwin 6.0 or later */ +} + +static void set_fpexc_precise(void) +{ + thread_t self = mach_thread_self(); + pthread_t enabler; + + if (pthread_create(&enabler, NULL, fpu_fpe_enable, &self)) { + perror("pthread_create"); + } else if (pthread_join(enabler, NULL)) { + perror("pthread_join"); + } +} + +#endif + +static void set_fpscr(unsigned int fpscr) +{ + union { + double d; + unsigned int fpscr[2]; + } u; + + u.fpscr[0] = 0xFFF80000; + u.fpscr[1] = fpscr; + __asm__ __volatile__("mtfsf 255,%0" : : "f"(u.d)); +} + +static unsigned int get_fpscr(void) +{ + union { + double d; + unsigned int fpscr[2]; + } u; + + __asm__("mffs %0" : "=f"(u.d)); + return u.fpscr[1]; +} + +static void unmask_fpe(void) +{ + set_fpexc_precise(); + set_fpscr(0x80|0x40|0x10); /* VE, OE, ZE; not UE or XE */ +} + +static void unmask_fpe_conditional(int unmasked) +{ + if (unmasked) + unmask_fpe(); +} + +/* mask PowerPC FPE, return true if the previous state was unmasked */ +static int mask_fpe(void) +{ + int unmasked; + + unmasked = (get_fpscr() & (0x80|0x40|0x10)) == (0x80|0x40|0x10); + set_fpscr(0x00); + return unmasked; +} + +#else + +static void unmask_fpe(void) +{ + fpsetmask(FP_X_INV | FP_X_OFL | FP_X_DZ); +} + +static void unmask_fpe_conditional(int unmasked) +{ + if (unmasked) + unmask_fpe(); +} + +/* mask IEEE FPE, return true if previous state was unmasked */ +static int mask_fpe(void) +{ + const fp_except unmasked_mask = FP_X_INV | FP_X_OFL | FP_X_DZ; + fp_except old_mask; + + old_mask = fpsetmask(0); + return (old_mask & unmasked_mask) == unmasked_mask; +} + +#endif + +#if (defined(__linux__) && (defined(__i386__) || defined(__x86_64__) || defined(__sparc__) || defined(__powerpc__))) || (defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__) || defined(__ppc__))) || (defined(__FreeBSD__) && (defined(__x86_64__) || defined(__i386__))) || ((defined(__NetBSD__) || defined(__OpenBSD__)) && defined(__x86_64__)) || (defined(__sun__) && defined(__x86_64__)) + +#if defined(__linux__) && defined(__i386__) +#if !defined(X86_FXSR_MAGIC) +#define X86_FXSR_MAGIC 0x0000 +#endif +#elif defined(__FreeBSD__) && defined(__x86_64__) +#include <sys/types.h> +#include <machine/fpu.h> +#elif defined(__FreeBSD__) && defined(__i386__) +#include <sys/types.h> +#include <machine/npx.h> +#elif defined(__DARWIN__) +#include <machine/signal.h> +#elif defined(__OpenBSD__) && defined(__x86_64__) +#include <sys/types.h> +#include <machine/fpu.h> +#endif +#if !(defined(__OpenBSD__) && defined(__x86_64__)) +#include <ucontext.h> +#endif +#include <string.h> + +#if defined(__linux__) && defined(__x86_64__) +#define mc_pc(mc) ((mc)->gregs[REG_RIP]) +#elif defined(__linux__) && defined(__i386__) +#define mc_pc(mc) ((mc)->gregs[REG_EIP]) +#elif defined(__DARWIN__) && defined(__i386__) +#ifdef DARWIN_MODERN_MCONTEXT +#define mc_pc(mc) ((mc)->__ss.__eip) +#else +#define mc_pc(mc) ((mc)->ss.eip) +#endif +#elif defined(__DARWIN__) && defined(__x86_64__) +#ifdef DARWIN_MODERN_MCONTEXT +#define mc_pc(mc) ((mc)->__ss.__rip) +#else +#define mc_pc(mc) ((mc)->ss.rip) +#endif +#elif defined(__FreeBSD__) && defined(__x86_64__) +#define mc_pc(mc) ((mc)->mc_rip) +#elif defined(__FreeBSD__) && defined(__i386__) +#define mc_pc(mc) ((mc)->mc_eip) +#elif defined(__NetBSD__) && defined(__x86_64__) +#define mc_pc(mc) ((mc)->__gregs[_REG_RIP]) +#elif defined(__NetBSD__) && defined(__i386__) +#define mc_pc(mc) ((mc)->__gregs[_REG_EIP]) +#elif defined(__OpenBSD__) && defined(__x86_64__) +#define mc_pc(mc) ((mc)->sc_rip) +#elif defined(__sun__) && defined(__x86_64__) +#define mc_pc(mc) ((mc)->gregs[REG_RIP]) +#endif + +static void fpe_sig_action(int sig, siginfo_t *si, void *puc) +{ + ucontext_t *uc = puc; + unsigned long pc; + +#if defined(__linux__) +#if defined(__x86_64__) + mcontext_t *mc = &uc->uc_mcontext; + fpregset_t fpstate = mc->fpregs; + pc = mc_pc(mc); + /* A failed SSE2 instruction will restart. To avoid + looping we mask SSE2 exceptions now and unmask them + again later in erts_check_fpe()/erts_restore_fpu(). + On RISCs we update PC to skip the failed instruction, + but the ever increasing complexity of the x86 instruction + set encoding makes that a poor solution here. */ + fpstate->mxcsr = 0x1F80; + fpstate->swd &= ~0xFF; +#elif defined(__i386__) + mcontext_t *mc = &uc->uc_mcontext; + fpregset_t fpstate = mc->fpregs; + pc = mc_pc(mc); + if ((fpstate->status >> 16) == X86_FXSR_MAGIC) + ((struct _fpstate*)fpstate)->mxcsr = 0x1F80; + fpstate->sw &= ~0xFF; +#elif defined(__sparc__) && defined(__arch64__) + /* on SPARC the 3rd parameter points to a sigcontext not a ucontext */ + struct sigcontext *sc = (struct sigcontext*)puc; + pc = sc->sigc_regs.tpc; + sc->sigc_regs.tpc = sc->sigc_regs.tnpc; + sc->sigc_regs.tnpc += 4; +#elif defined(__sparc__) + /* on SPARC the 3rd parameter points to a sigcontext not a ucontext */ + struct sigcontext *sc = (struct sigcontext*)puc; + pc = sc->si_regs.pc; + sc->si_regs.pc = sc->si_regs.npc; + sc->si_regs.npc = (unsigned long)sc->si_regs.npc + 4; +#elif defined(__powerpc__) +#if defined(__powerpc64__) + mcontext_t *mc = &uc->uc_mcontext; + unsigned long *regs = &mc->gp_regs[0]; +#else + mcontext_t *mc = uc->uc_mcontext.uc_regs; + unsigned long *regs = &mc->gregs[0]; +#endif + pc = regs[PT_NIP]; + regs[PT_NIP] += 4; + regs[PT_FPSCR] = 0x80|0x40|0x10; /* VE, OE, ZE; not UE or XE */ +#endif +#elif defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__)) +#ifdef DARWIN_MODERN_MCONTEXT + mcontext_t mc = uc->uc_mcontext; + pc = mc_pc(mc); + mc->__fs.__fpu_mxcsr = 0x1F80; + *(unsigned short *)&mc->__fs.__fpu_fsw &= ~0xFF; +#else + mcontext_t mc = uc->uc_mcontext; + pc = mc_pc(mc); + mc->fs.fpu_mxcsr = 0x1F80; + *(unsigned short *)&mc->fs.fpu_fsw &= ~0xFF; +#endif /* DARWIN_MODERN_MCONTEXT */ +#elif defined(__DARWIN__) && defined(__ppc__) + mcontext_t mc = uc->uc_mcontext; + pc = mc->ss.srr0; + mc->ss.srr0 += 4; + mc->fs.fpscr = 0x80|0x40|0x10; +#elif defined(__FreeBSD__) && defined(__x86_64__) + mcontext_t *mc = &uc->uc_mcontext; + struct savefpu *savefpu = (struct savefpu*)&mc->mc_fpstate; + struct envxmm *envxmm = &savefpu->sv_env; + pc = mc_pc(mc); + envxmm->en_mxcsr = 0x1F80; + envxmm->en_sw &= ~0xFF; +#elif defined(__FreeBSD__) && defined(__i386__) + mcontext_t *mc = &uc->uc_mcontext; + union savefpu *savefpu = (union savefpu*)&mc->mc_fpstate; + pc = mc_pc(mc); + if (mc->mc_fpformat == _MC_FPFMT_XMM) { + struct envxmm *envxmm = &savefpu->sv_xmm.sv_env; + envxmm->en_mxcsr = 0x1F80; + envxmm->en_sw &= ~0xFF; + } else { + struct env87 *env87 = &savefpu->sv_87.sv_env; + env87->en_sw &= ~0xFF; + } +#elif defined(__NetBSD__) && defined(__x86_64__) + mcontext_t *mc = &uc->uc_mcontext; + struct fxsave64 *fxsave = (struct fxsave64 *)&mc->__fpregs; + pc = mc_pc(mc); + fxsave->fx_mxcsr = 0x1F80; + fxsave->fx_fsw &= ~0xFF; +#elif defined(__NetBSD__) && defined(__i386__) + mcontext_t *mc = &uc->uc_mcontext; + pc = mc_pc(mc); + if (uc->uc_flags & _UC_FXSAVE) { + struct envxmm *envxmm = (struct envxmm *)&mc->__fpregs; + envxmm->en_mxcsr = 0x1F80; + envxmm->en_sw &= ~0xFF; + } else { + struct env87 *env87 = (struct env87 *)&mc->__fpregs; + env87->en_sw &= ~0xFF; + } +#elif defined(__OpenBSD__) && defined(__x86_64__) + struct fxsave64 *fxsave = uc->sc_fpstate; + pc = mc_pc(uc); + fxsave->fx_mxcsr = 0x1F80; + fxsave->fx_fsw &= ~0xFF; +#elif defined(__sun__) && defined(__x86_64__) + mcontext_t *mc = &uc->uc_mcontext; + struct fpchip_state *fpstate = &mc->fpregs.fp_reg_set.fpchip_state; + pc = mc_pc(mc); + fpstate->mxcsr = 0x1F80; + fpstate->sw &= ~0xFF; +#endif +#if 0 + { + char buf[64]; + snprintf(buf, sizeof buf, "%s: FPE at %p\r\n", __FUNCTION__, (void*)pc); + write(2, buf, strlen(buf)); + } +#endif + set_current_fp_exception(pc); +} + +static void erts_thread_catch_fp_exceptions(void) +{ + struct sigaction act; + memset(&act, 0, sizeof act); + act.sa_sigaction = fpe_sig_action; + act.sa_flags = SA_SIGINFO; + sigaction(SIGFPE, &act, NULL); + unmask_fpe(); +} + +#else /* !((__linux__ && (__i386__ || __x86_64__ || __powerpc__)) || (__DARWIN__ && (__i386__ || __x86_64__ || __ppc__))) */ + +static void fpe_sig_handler(int sig) +{ + set_current_fp_exception(1); /* XXX: convert to sigaction so we can get the trap PC */ +} + +static void erts_thread_catch_fp_exceptions(void) +{ + sys_sigset(SIGFPE, fpe_sig_handler); + unmask_fpe(); +} + +#endif /* (__linux__ && (__i386__ || __x86_64__ || __powerpc__)) || (__DARWIN__ && (__i386__ || __x86_64__ || __ppc__))) */ + +/* once-only initialisation early in the main thread */ +void erts_sys_init_float(void) +{ + erts_init_fp_exception(); + erts_thread_catch_fp_exceptions(); + erts_printf_block_fpe = erts_sys_block_fpe; + erts_printf_unblock_fpe = erts_sys_unblock_fpe; +} + +#endif /* NO_FPE_SIGNALS */ + +void erts_thread_init_float(void) +{ +#ifdef ERTS_SMP + /* This allows Erlang schedulers to leave Erlang-process context + and still have working FP exceptions. XXX: is this needed? */ + erts_thread_init_fp_exception(); +#endif + +#ifndef NO_FPE_SIGNALS + /* NOTE: + * erts_thread_disable_fpe() is called in all threads at + * creation. We at least need to call unmask_fpe() + */ +#if defined(__DARWIN__) || defined(__FreeBSD__) + /* Darwin (7.9.0) does not appear to propagate FP exception settings + to a new thread from its parent. So if we want FP exceptions, we + must manually re-enable them in each new thread. + FreeBSD 6.1 appears to suffer from a similar issue. */ + erts_thread_catch_fp_exceptions(); +#else + unmask_fpe(); +#endif + +#endif +} + +void erts_thread_disable_fpe(void) +{ +#if !defined(NO_FPE_SIGNALS) + (void)mask_fpe(); +#endif +} + +#if !defined(NO_FPE_SIGNALS) +int erts_sys_block_fpe(void) +{ + return mask_fpe(); +} + +void erts_sys_unblock_fpe(int unmasked) +{ + unmask_fpe_conditional(unmasked); +} +#endif + +/* The following check is incorporated from the Vee machine */ + +#define ISDIGIT(d) ((d) >= '0' && (d) <= '9') + +/* + ** Convert a double to ascii format 0.dddde[+|-]ddd + ** return number of characters converted or -1 if error. + ** + ** These two functions should maybe use localeconv() to pick up + ** the current radix character, but since it is uncertain how + ** expensive such a system call is, and since no-one has heard + ** of other radix characters than '.' and ',' an ad-hoc + ** low execution time solution is used instead. + */ + +int +sys_double_to_chars_ext(double fp, char *buffer, size_t buffer_size, size_t decimals) +{ + char *s = buffer; + + if (erts_snprintf(buffer, buffer_size, "%.*e", decimals, fp) >= buffer_size) + return -1; + /* Search upto decimal point */ + if (*s == '+' || *s == '-') s++; + while (ISDIGIT(*s)) s++; + if (*s == ',') *s++ = '.'; /* Replace ',' with '.' */ + /* Scan to end of string */ + while (*s) s++; + return s-buffer; /* i.e strlen(buffer) */ +} + +/* Float conversion */ + +int +sys_chars_to_double(char* buf, double* fp) +{ +#ifndef NO_FPE_SIGNALS + volatile unsigned long *fpexnp = erts_get_current_fp_exception(); +#endif + char *s = buf, *t, *dp; + + /* Robert says that something like this is what he really wanted: + * (The [.,] radix test is NOT what Robert wanted - it was added later) + * + * 7 == sscanf(Tbuf, "%[+-]%[0-9][.,]%[0-9]%[eE]%[+-]%[0-9]%s", ....); + * if (*s2 == 0 || *s3 == 0 || *s4 == 0 || *s6 == 0 || *s7) + * break; + */ + + /* Scan string to check syntax. */ + if (*s == '+' || *s == '-') s++; + if (!ISDIGIT(*s)) /* Leading digits. */ + return -1; + while (ISDIGIT(*s)) s++; + if (*s != '.' && *s != ',') /* Decimal part. */ + return -1; + dp = s++; /* Remember decimal point pos just in case */ + if (!ISDIGIT(*s)) + return -1; + while (ISDIGIT(*s)) s++; + if (*s == 'e' || *s == 'E') { + /* There is an exponent. */ + s++; + if (*s == '+' || *s == '-') s++; + if (!ISDIGIT(*s)) + return -1; + while (ISDIGIT(*s)) s++; + } + if (*s) /* That should be it */ + return -1; + +#ifdef NO_FPE_SIGNALS + errno = 0; +#endif + __ERTS_FP_CHECK_INIT(fpexnp); + *fp = strtod(buf, &t); + __ERTS_FP_ERROR_THOROUGH(fpexnp, *fp, return -1); + if (t != s) { /* Whole string not scanned */ + /* Try again with other radix char */ + *dp = (*dp == '.') ? ',' : '.'; + errno = 0; + __ERTS_FP_CHECK_INIT(fpexnp); + *fp = strtod(buf, &t); + __ERTS_FP_ERROR_THOROUGH(fpexnp, *fp, return -1); + } + +#ifdef NO_FPE_SIGNALS + if (errno == ERANGE) { + if (*fp == HUGE_VAL || *fp == -HUGE_VAL) { + /* overflow, should give error */ + return -1; + } else if (t == s && *fp == 0.0) { + /* This should give 0.0 - OTP-7178 */ + errno = 0; + + } else if (*fp == 0.0) { + return -1; + } + } +#endif + return 0; +} + +int +matherr(struct exception *exc) +{ +#if !defined(NO_FPE_SIGNALS) + volatile unsigned long *fpexnp = erts_get_current_fp_exception(); + if (fpexnp != NULL) + *fpexnp = (unsigned long)__builtin_return_address(0); +#endif + return 1; +} diff --git a/erts/emulator/sys/ose/sys_time.c b/erts/emulator/sys/ose/sys_time.c new file mode 100644 index 0000000000..7e96f68424 --- /dev/null +++ b/erts/emulator/sys/ose/sys_time.c @@ -0,0 +1,56 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-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% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "global.h" + +/******************* Routines for time measurement *********************/ + +int erts_ticks_per_sec = 0; /* Will be SYS_CLK_TCK in erl_unix_sys.h */ + +int sys_init_time(void) +{ + return SYS_CLOCK_RESOLUTION; +} + +clock_t sys_times(SysTimes *now) { + now->tms_utime = now->tms_stime = now->tms_cutime = now->tms_cstime = 0; + return 0; +} + +static OSTICK last_tick_count = 0; +static SysHrTime wrap = 0; +static OSTICK us_per_tick; + +void sys_init_hrtime() { + us_per_tick = system_tick(); +} + +SysHrTime sys_gethrtime() { + OSTICK ticks = get_ticks(); + if (ticks < (SysHrTime) last_tick_count) { + wrap += 1ULL << 32; + } + last_tick_count = ticks; + return ((((SysHrTime) ticks) + wrap) * 1000*us_per_tick); +} diff --git a/erts/emulator/sys/unix/erl_child_setup.c b/erts/emulator/sys/unix/erl_child_setup.c index 7c6e4a2f37..94eb6b1547 100644 --- a/erts/emulator/sys/unix/erl_child_setup.c +++ b/erts/emulator/sys/unix/erl_child_setup.c @@ -54,6 +54,17 @@ void sys_sigrelease(int sig) #endif /* !SIG_SIGNAL */ #endif /* !SIG_SIGSET */ +#if defined(__ANDROID__) +int __system_properties_fd(void); +#endif /* __ANDROID__ */ + +#if defined(__ANDROID__) +#define SHELL "/system/bin/sh" +#else +#define SHELL "/bin/sh" +#endif /* __ANDROID__ */ + + int main(int argc, char *argv[]) { @@ -89,8 +100,23 @@ main(int argc, char *argv[]) if (sscanf(argv[CS_ARGV_FD_CR_IX], "%d:%d", &from, &to) != 2) return 1; + +#if defined(__ANDROID__) + for (i = from; i <= to; i++) { + if (i!=__system_properties_fd) + (void) close(i); + } +#else for (i = from; i <= to; i++) (void) close(i); +#endif /* __ANDROID__ */ + +#if defined(HAVE_CLOSEFROM) + closefrom(from); +#else + for (i = from; i <= to; i++) + (void) close(i); +#endif if (!(argv[CS_ARGV_WD_IX][0] == '.' && argv[CS_ARGV_WD_IX][1] == '\0') && chdir(argv[CS_ARGV_WD_IX]) < 0) @@ -116,7 +142,25 @@ main(int argc, char *argv[]) execv(argv[CS_ARGV_NO_OF_ARGS],&(argv[CS_ARGV_NO_OF_ARGS + 1])); } } else { - execl("/bin/sh", "sh", "-c", argv[CS_ARGV_CMD_IX], (char *) NULL); + execl(SHELL, "sh", "-c", argv[CS_ARGV_CMD_IX], (char *) NULL); } return 1; } + + + +#if defined(__ANDROID__) +int __system_properties_fd(void) +{ + int s, fd; + char *env; + + env = getenv("ANDROID_PROPERTY_WORKSPACE"); + if (!env) { + return -1; + } + fd = atoi(env); + return fd; +} +#endif /* __ANDROID__ */ + diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h index 2c47aa06c2..176fc049a7 100644 --- a/erts/emulator/sys/unix/erl_unix_sys.h +++ b/erts/emulator/sys/unix/erl_unix_sys.h @@ -127,6 +127,11 @@ # endif #endif +/* + * Min number of async threads + */ +#define ERTS_MIN_NO_OF_ASYNC_THREADS 0 + /* File descriptors are numbers anc consecutively allocated on Unix */ #define ERTS_SYS_CONTINOUS_FD_NUMBERS diff --git a/erts/emulator/sys/unix/erl_unix_sys_ddll.c b/erts/emulator/sys/unix/erl_unix_sys_ddll.c index 8760b58839..2659d623c7 100644 --- a/erts/emulator/sys/unix/erl_unix_sys_ddll.c +++ b/erts/emulator/sys/unix/erl_unix_sys_ddll.c @@ -123,6 +123,7 @@ int erts_sys_ddll_open(const char *full_name, void **handle, ErtsSysDdllError* e int erts_sys_ddll_open_noext(char *dlname, void **handle, ErtsSysDdllError* err) { +#if defined(HAVE_DLOPEN) int ret = ERL_DE_NO_ERROR; char *str; dlerror(); @@ -148,6 +149,9 @@ int erts_sys_ddll_open_noext(char *dlname, void **handle, ErtsSysDdllError* err) ret = ERL_DE_DYNAMIC_ERROR_OFFSET - find_errcode(str, err); } return ret; +#else + return ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY; +#endif } /* diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 865cb50a56..c3d7440409 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -149,6 +149,13 @@ extern void erl_crash_dump(char* file, int line, char* fmt, ...); #define DIR_SEPARATOR_CHAR '/' +#if defined(__ANDROID__) +#define SHELL "/system/bin/sh" +#else +#define SHELL "/bin/sh" +#endif /* __ANDROID__ */ + + #if defined(DEBUG) #define ERL_BUILD_TYPE_MARKER ".debug" #elif defined(PURIFY) @@ -1596,7 +1603,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* op } } } else { - execle("/bin/sh", "sh", "-c", cmd_line, (char *) NULL, new_environ); + execle(SHELL, "sh", "-c", cmd_line, (char *) NULL, new_environ); } child_error: _exit(1); @@ -1717,7 +1724,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* op fcntl(i, F_SETFD, 1); qnx_spawn_options.flags = _SPAWN_SETSID; - if ((pid = spawnl(P_NOWAIT, "/bin/sh", "/bin/sh", "-c", cmd_line, + if ((pid = spawnl(P_NOWAIT, SHELL, SHELL, "-c", cmd_line, (char *) 0)) < 0) { erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); reset_qnx_spawn(); diff --git a/erts/emulator/sys/unix/sys_float.c b/erts/emulator/sys/unix/sys_float.c index 689be98969..cafeab547e 100644 --- a/erts/emulator/sys/unix/sys_float.c +++ b/erts/emulator/sys/unix/sys_float.c @@ -46,7 +46,7 @@ static void erts_init_fp_exception(void) { /* XXX: the wrappers prevent using a pthread destructor to deallocate the key's value; so when/where do we do that? */ - erts_tsd_key_create(&fpe_key); + erts_tsd_key_create(&fpe_key,"fp_exception"); } void erts_thread_init_fp_exception(void) diff --git a/erts/emulator/sys/win32/erl_win_sys.h b/erts/emulator/sys/win32/erl_win_sys.h index 0deb097b1a..a78dbf64af 100644 --- a/erts/emulator/sys/win32/erl_win_sys.h +++ b/erts/emulator/sys/win32/erl_win_sys.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2012. All Rights Reserved. + * Copyright Ericsson AB 1997-2014. 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 @@ -60,16 +60,18 @@ #include <windows.h> #undef WIN32_LEAN_AND_MEAN -/* - * Define MAXPATHLEN in terms of MAXPATH if available. - */ - -#ifndef MAXPATH -#define MAXPATH MAX_PATH -#endif /* MAXPATH */ #ifndef MAXPATHLEN -#define MAXPATHLEN MAXPATH +#define MAXPATHLEN 4096 +/* + erts-6.0 (OTP 17.0): + We now accept windows paths longer than 260 (MAX_PATH) by conversion to + UNC path format. In order to also return long paths from the driver we + increased MAXPATHLEN from 260 to larger (but arbitrary) value 4096. + It would of course be nicer to instead dynamically allocate large enough + tmp buffers when efile_drv needs to return really long paths, and do that + for unix as well. + */ #endif /* MAXPATHLEN */ /* @@ -103,6 +105,10 @@ #define CreateAutoEvent(state) CreateEvent(NULL, FALSE, state, NULL) #define CreateManualEvent(state) CreateEvent(NULL, TRUE, state, NULL) +/* + * Min number of async threads + */ +#define ERTS_MIN_NO_OF_ASYNC_THREADS 0 /* * Our own type of "FD's" diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index a11ac73ebc..0ded6b274e 100755 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -3197,7 +3197,7 @@ void erl_sys_init(void) noinherit_std_handle(STD_ERROR_HANDLE); #ifdef ERTS_SMP - erts_smp_tsd_key_create(&win32_errstr_key); + erts_smp_tsd_key_create(&win32_errstr_key,"win32_errstr_key"); InitializeCriticalSection(&htbc_lock); #endif erts_smp_atomic_init_nob(&pipe_creation_counter,0); diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index a390c536bb..938aac6a0e 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -474,16 +474,16 @@ terms_compression_levels(_, _, _) -> ok. terms_float(Config) when is_list(Config) -> ?line test_floats(fun(Term) -> - Bin0 = term_to_binary(Term), Bin0 = term_to_binary(Term, [{minor_version,0}]), Term = binary_to_term_stress(Bin0), + Bin1 = term_to_binary(Term), Bin1 = term_to_binary(Term, [{minor_version,1}]), Term = binary_to_term_stress(Bin1), true = size(Bin1) < size(Bin0), - Size0 = erlang:external_size(Term), - Size00 = erlang:external_size(Term, [{minor_version, 0}]), - Size1 = erlang:external_size(Term, [{minor_version, 1}]), - true = (Size0 =:= Size00), + Size0 = erlang:external_size(Term, [{minor_version, 0}]), + Size1 = erlang:external_size(Term), + Size11 = erlang:external_size(Term, [{minor_version, 1}]), + true = (Size1 =:= Size11), true = Size1 < Size0 end). diff --git a/erts/emulator/test/driver_SUITE_data/smaller_major_vsn_drv.c b/erts/emulator/test/driver_SUITE_data/smaller_major_vsn_drv.c index a1299fe807..6b9d4745ba 100644 --- a/erts/emulator/test/driver_SUITE_data/smaller_major_vsn_drv.c +++ b/erts/emulator/test/driver_SUITE_data/smaller_major_vsn_drv.c @@ -20,12 +20,12 @@ * Author: Rickard Green * * Description: Implementation of a driver with a smaller major - * driver version than the current system. + * driver version than allowed on load. */ #define VSN_MISMATCH_DRV_NAME_STR "smaller_major_vsn_drv" #define VSN_MISMATCH_DRV_NAME smaller_major_vsn_drv -#define VSN_MISMATCH_DRV_MAJOR_VSN_DIFF (-1) +#define VSN_MISMATCH_DRV_MAJOR_VSN_DIFF (ERL_DRV_MIN_REQUIRED_MAJOR_VERSION_ON_LOAD - ERL_DRV_EXTENDED_MAJOR_VERSION - 1) #define VSN_MISMATCH_DRV_MINOR_VSN_DIFF 0 #include "vsn_mismatch_drv_impl.c" diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl index 8cc5621181..888ed8e272 100644 --- a/erts/emulator/test/map_SUITE.erl +++ b/erts/emulator/test/map_SUITE.erl @@ -29,6 +29,7 @@ t_guard_receive/1, t_guard_fun/1, t_list_comprehension/1, t_map_sort_literals/1, + t_map_equal/1, %t_size/1, t_map_size/1, @@ -74,6 +75,7 @@ all() -> [ t_update_assoc,t_update_exact, t_guard_bifs, t_guard_sequence, t_guard_update, t_guard_receive,t_guard_fun, t_list_comprehension, + t_map_equal, t_map_sort_literals, %% Specific Map BIFs @@ -450,6 +452,23 @@ t_map_sort_literals(Config) when is_list(Config) -> ok. +t_map_equal(Config) when is_list(Config) -> + true = id(#{}) =:= id(#{}), + false = id(#{}) =:= id(#{a=>1}), + false = id(#{a=>1}) =:= id(#{}), + true = id(#{ "a" => "hi", b => 134 }) =:= id(#{ b => 134,"a" => "hi"}), + + false = id(#{ a => 1 }) =:= id(#{ a => 2}), + false = id(#{ a => 2 }) =:= id(#{ a => 1}), + false = id(#{ a => 2, b => 1 }) =:= id(#{ a => 1, b => 3}), + false = id(#{ a => 1, b => 1 }) =:= id(#{ a => 1, b => 3}), + + true = id(#{ a => 1 }) =:= id(#{ a => 1}), + true = id(#{ "a" => 2 }) =:= id(#{ "a" => 2}), + true = id(#{ "a" => 2, b => 3 }) =:= id(#{ "a" => 2, b => 3}), + true = id(#{ a => 1, b => 3, c => <<"wat">> }) =:= id(#{ a => 1, b => 3, c=><<"wat">>}), + ok. + %% BIFs t_bif_map_get(Config) when is_list(Config) -> @@ -794,16 +813,16 @@ t_map_encode_decode(Config) when is_list(Config) -> %% literally #{ b=>2, a=>1 } in the internal order #{ a:=1, b:=2 } = - erlang:binary_to_term(<<131,116,0,0,0,2,100,0,1,98,100,0,1,97,97,2,97,1>>), + erlang:binary_to_term(<<131,116,0,0,0,2,100,0,1,98,97,2,100,0,1,97,97,1>>), %% literally #{ "hi" => "value", a=>33, b=>55 } in the internal order #{ a:=33, b:=55, "hi" := "value"} = erlang:binary_to_term(<<131,116,0,0,0,3, 107,0,2,104,105, % "hi" :: list() - 100,0,1,97, % a :: atom() - 100,0,1,98, % b :: atom() 107,0,5,118,97,108,117,101, % "value" :: list() + 100,0,1,97, % a :: atom() 97,33, % 33 :: integer() + 100,0,1,98, % b :: atom() 97,55 % 55 :: integer() >>), @@ -815,11 +834,17 @@ t_map_encode_decode(Config) when is_list(Config) -> %% uniqueness violation %% literally #{ a=>1, "hi"=>"value", a=>2 } {'EXIT',{badarg,[{_,_,_,_}|_]}} = (catch - erlang:binary_to_term(<<131,116,0,0,0,3,100,0,1,97,107,0,2,104,105,100,0,1,97,97,1,107,0,5,118,97,108,117,101,97,2>>)), + erlang:binary_to_term(<<131,116,0,0,0,3, + 100,0,1,97, + 97,1, + 107,0,2,104,105, + 107,0,5,118,97,108,117,101, + 100,0,1,97, + 97,2>>)), %% bad size (too large) {'EXIT',{badarg,[{_,_,_,_}|_]}} = (catch - erlang:binary_to_term(<<131,116,0,0,0,12,100,0,1,97,100,0,1,98,97,1,97,1>>)), + erlang:binary_to_term(<<131,116,0,0,0,12,100,0,1,97,97,1,100,0,1,98,97,1>>)), %% bad size (too small) .. should fail just truncate it .. weird. %% possibly change external format so truncated will be #{a:=1} @@ -833,7 +858,8 @@ map_encode_decode_and_match([{K,V}|Pairs], EncodedPairs, M0) -> B0 = erlang:term_to_binary(M1), Ls = lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, [{K, erlang:term_to_binary(K), erlang:term_to_binary(V)}|EncodedPairs]), %% sort Ks and Vs according to term spec, then match it - ok = match_encoded_map(B0, length(Ls), [Kbin||{_,Kbin,_}<-Ls] ++ [Vbin||{_,_,Vbin}<-Ls]), + KVbins = lists:foldr(fun({_,Kbin,Vbin}, Acc) -> [Kbin,Vbin | Acc] end, [], Ls), + ok = match_encoded_map(B0, length(Ls), KVbins), %% decode and match it M1 = erlang:binary_to_term(B0), map_encode_decode_and_match(Pairs,Ls,M1); diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index a854d3f05b..b2da6f58af 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -37,7 +37,7 @@ 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, reverse_list_test/1, - otp_9668/1, consume_timeslice/1, dirty_nif/1 + otp_9668/1, consume_timeslice/1, dirty_nif/1, dirty_nif_send/1 ]). -export([many_args_100/100]). @@ -64,7 +64,7 @@ all() -> resource_takeover, threading, send, send2, send3, send_threaded, neg, is_checks, get_length, make_atom, make_string,reverse_list_test, - otp_9668, consume_timeslice, dirty_nif + otp_9668, consume_timeslice, dirty_nif, dirty_nif_send ]. groups() -> @@ -1538,6 +1538,24 @@ dirty_nif(Config) when is_list(Config) -> {skipped,"No dirty scheduler support"} end. +dirty_nif_send(Config) when is_list(Config) -> + try erlang:system_info(dirty_cpu_schedulers) of + N when is_integer(N) -> + ensure_lib_loaded(Config), + Parent = self(), + Pid = spawn_link(fun() -> + Self = self(), + {ok, Self} = receive_any(), + Parent ! {ok, Self} + end), + {ok, Pid} = send_from_dirty_nif(Pid), + {ok, Pid} = receive_any(), + ok + catch + error:badarg -> + {skipped,"No dirty scheduler support"} + end. + next_msg(_Pid) -> receive M -> M @@ -1668,6 +1686,7 @@ type_sizes() -> ?nif_stub. otp_9668_nif(_) -> ?nif_stub. consume_timeslice_nif(_,_) -> ?nif_stub. call_dirty_nif(_,_,_) -> ?nif_stub. +send_from_dirty_nif(_) -> ?nif_stub. %% maps is_map_nif(_) -> ?nif_stub. diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 160f4843ad..955dc64189 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -1533,6 +1533,37 @@ static ERL_NIF_TERM call_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM return dirty_nif(env, argc, argv); } } + +static ERL_NIF_TERM dirty_sender(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM result; + ErlNifPid pid; + ErlNifEnv* menv; + int res; + + enif_get_local_pid(env, argv[0], &pid); + result = enif_make_tuple2(env, enif_make_atom(env, "ok"), enif_make_pid(env, &pid)); + menv = enif_alloc_env(); + res = enif_send(env, &pid, menv, result); + enif_free_env(menv); + if (!res) + /* Note the next line will crash, since dirty nifs can't return exceptions. + * This is intentional, since enif_send should not fail if the test succeeds. + */ + return enif_schedule_dirty_nif_finalizer(env, enif_make_badarg(env), enif_dirty_nif_finalizer); + else + return enif_schedule_dirty_nif_finalizer(env, result, enif_dirty_nif_finalizer); +} + +static ERL_NIF_TERM send_from_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM result; + ErlNifPid pid; + + if (!enif_get_local_pid(env, argv[0], &pid)) + return enif_make_badarg(env); + return enif_schedule_dirty_nif(env, ERL_NIF_DIRTY_JOB_CPU_BOUND, dirty_sender, argc, argv); +} #endif static ERL_NIF_TERM is_map_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -1713,6 +1744,7 @@ static ErlNifFunc nif_funcs[] = {"consume_timeslice_nif", 2, consume_timeslice_nif}, #ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT {"call_dirty_nif", 3, call_dirty_nif}, + {"send_from_dirty_nif", 1, send_from_dirty_nif}, #endif {"is_map_nif", 1, is_map_nif}, {"get_map_size_nif", 1, get_map_size_nif}, diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.c b/erts/emulator/test/nif_SUITE_data/nif_mod.c index 55a0d2ac4f..11b5d0cc35 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_mod.c +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.c @@ -217,7 +217,8 @@ static int upgrade(ErlNifEnv* env, void** priv, void** old_priv_data, ERL_NIF_TE *priv = *old_priv_data; do_load_info(env, load_info, &retval); - + if (retval) + NifModPrivData_release(data); return retval; } diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index 6a43e2b0e7..3906471f87 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -54,6 +54,7 @@ sbt_cmd/1, scheduler_threads/1, scheduler_suspend/1, + dirty_scheduler_threads/1, reader_groups/1]). -define(DEFAULT_TIMEOUT, ?t:minutes(15)). @@ -68,6 +69,7 @@ all() -> equal_and_high_with_part_time_max, equal_with_high, equal_with_high_max, bound_process, {group, scheduler_bind}, scheduler_threads, scheduler_suspend, + dirty_scheduler_threads, reader_groups]. groups() -> @@ -1092,6 +1094,55 @@ scheduler_threads(Config) when is_list(Config) -> end, ok. +dirty_scheduler_threads(Config) when is_list(Config) -> + SmpSupport = erlang:system_info(smp_support), + try + erlang:system_info(dirty_cpu_schedulers), + dirty_scheduler_threads_test(Config, SmpSupport) + catch + error:badarg -> + {skipped, "No dirty scheduler support"} + end. + +dirty_scheduler_threads_test(Config, SmpSupport) -> + {Sched, SchedOnln, _} = get_dsstate(Config, ""), + {HalfSched, HalfSchedOnln} = case SmpSupport of + false -> {1,1}; + true -> + {Sched div 2, + SchedOnln div 2} + end, + Cmd1 = "+SDcpu "++integer_to_list(HalfSched)++":"++ + integer_to_list(HalfSchedOnln), + {HalfSched, HalfSchedOnln, _} = get_dsstate(Config, Cmd1), + {HalfSched, HalfSchedOnln, _} = get_dsstate(Config, "+SDPcpu 50:50"), + IOSched = 20, + {_, _, IOSched} = get_dsstate(Config, "+SDio "++integer_to_list(IOSched)), + {ok, Node} = start_node(Config, ""), + [ok] = mcall(Node, [fun() -> dirty_schedulers_online_test() end]), + ok. + +dirty_schedulers_online_test() -> + dirty_schedulers_online_test(erlang:system_info(smp_support)). +dirty_schedulers_online_test(false) -> ok; +dirty_schedulers_online_test(true) -> + dirty_schedulers_online_smp_test(erlang:system_info(schedulers_online)). +dirty_schedulers_online_smp_test(SchedOnln) when SchedOnln < 4 -> ok; +dirty_schedulers_online_smp_test(SchedOnln) -> + DirtyCPUSchedOnln = erlang:system_info(dirty_cpu_schedulers_online), + SchedOnln = DirtyCPUSchedOnln, + HalfSchedOnln = SchedOnln div 2, + SchedOnln = erlang:system_flag(schedulers_online, HalfSchedOnln), + HalfDirtyCPUSchedOnln = DirtyCPUSchedOnln div 2, + HalfDirtyCPUSchedOnln = erlang:system_flag(schedulers_online, SchedOnln), + DirtyCPUSchedOnln = erlang:system_flag(dirty_cpu_schedulers_online, + HalfDirtyCPUSchedOnln), + HalfDirtyCPUSchedOnln = erlang:system_info(dirty_cpu_schedulers_online), + QrtrDirtyCPUSchedOnln = HalfDirtyCPUSchedOnln div 2, + SchedOnln = erlang:system_flag(schedulers_online, HalfSchedOnln), + QrtrDirtyCPUSchedOnln = erlang:system_info(dirty_cpu_schedulers_online), + ok. + get_sstate(Config, Cmd) -> {ok, Node} = start_node(Config, Cmd), [SState] = mcall(Node, [fun () -> @@ -1100,6 +1151,20 @@ get_sstate(Config, Cmd) -> stop_node(Node), SState. +get_dsstate(Config, Cmd) -> + {ok, Node} = start_node(Config, Cmd), + [DSCPU] = mcall(Node, [fun () -> + erlang:system_info(dirty_cpu_schedulers) + end]), + [DSCPUOnln] = mcall(Node, [fun () -> + erlang:system_info(dirty_cpu_schedulers_online) + end]), + [DSIO] = mcall(Node, [fun () -> + erlang:system_info(dirty_io_schedulers) + end]), + stop_node(Node), + {DSCPU, DSCPUOnln, DSIO}. + scheduler_suspend(Config) when is_list(Config) -> ?line Dog = ?t:timetrap(?t:minutes(5)), ?line lists:foreach(fun (S) -> scheduler_suspend_test(Config, S) end, @@ -1171,16 +1236,40 @@ sst2_loop(N) -> erlang:system_flag(multi_scheduling, unblock), sst2_loop(N-1). -sst3_loop(_S, 0) -> - ok; sst3_loop(S, N) -> + try erlang:system_info(dirty_cpu_schedulers) of + DS -> + sst3_loop_with_dirty_schedulers(S, DS, N) + catch + error:badarg -> + sst3_loop_normal_schedulers_only(S, N) + end. + +sst3_loop_normal_schedulers_only(_S, 0) -> + ok; +sst3_loop_normal_schedulers_only(S, N) -> + erlang:system_flag(schedulers_online, (S div 2)+1), + erlang:system_flag(schedulers_online, 1), + erlang:system_flag(schedulers_online, (S div 2)+1), + erlang:system_flag(schedulers_online, S), + erlang:system_flag(schedulers_online, 1), + erlang:system_flag(schedulers_online, S), + sst3_loop_normal_schedulers_only(S, N-1). + +sst3_loop_with_dirty_schedulers(_S, _DS, 0) -> + ok; +sst3_loop_with_dirty_schedulers(S, DS, N) -> erlang:system_flag(schedulers_online, (S div 2)+1), + erlang:system_flag(dirty_cpu_schedulers_online, (DS div 2)+1), erlang:system_flag(schedulers_online, 1), erlang:system_flag(schedulers_online, (S div 2)+1), + erlang:system_flag(dirty_cpu_schedulers_online, 1), erlang:system_flag(schedulers_online, S), + erlang:system_flag(dirty_cpu_schedulers_online, DS), erlang:system_flag(schedulers_online, 1), erlang:system_flag(schedulers_online, S), - sst3_loop(S, N-1). + erlang:system_flag(dirty_cpu_schedulers_online, DS), + sst3_loop_with_dirty_schedulers(S, DS, N-1). reader_groups(Config) when is_list(Config) -> %% White box testing. These results are correct, but other results diff --git a/erts/emulator/test/trace_call_time_SUITE.erl b/erts/emulator/test/trace_call_time_SUITE.erl index 5dfa87bbee..3036d2957b 100644 --- a/erts/emulator/test/trace_call_time_SUITE.erl +++ b/erts/emulator/test/trace_call_time_SUITE.erl @@ -33,7 +33,7 @@ %% Exported end user tests -export([seq/3, seq_r/3]). --export([loaded/1, a_function/1, a_called_function/1, dec/1, nif_dec/1]). +-export([loaded/1, a_function/1, a_called_function/1, dec/1, nif_dec/1, dead_tracer/1]). -define(US_ERROR, 10000). -define(R_ERROR, 0.8). @@ -89,7 +89,7 @@ all() -> true -> [not_run]; false -> [basic, on_and_off, info, pause_and_restart, scheduling, - combo, bif, nif, called_function] + combo, bif, nif, called_function, dead_tracer] end. groups() -> @@ -470,6 +470,92 @@ called_function(Config) when is_list(Config) -> ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), ok. +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +dead_tracer(Config) when is_list(Config) -> + Self = self(), + FirstTracer = tracer(), + StartTracing = fun() -> turn_on_tracing(Self) end, + tell_tracer(FirstTracer, StartTracing), + [1,2,3,4,5,6,7,8] = seq(1, 8, fun(I) -> I + 1 end), + Ref = erlang:monitor(process, FirstTracer), + FirstTracer ! quit, + receive + {'DOWN',Ref,process,FirstTracer,normal} -> + ok + end, + erlang:yield(), + + %% Collect and check that we only get call_time info for the current process. + Info1 = collect_all_info(), + [] = other_than_self(Info1), + io:format("~p\n", [Info1]), + + %% Note that we have not turned off tracing for the current process, + %% but that the tracer has terminated. No more call_time information should be recorded. + [1,2,3] = seq(1, 3, fun(I) -> I + 1 end), + [] = collect_all_info(), + + %% When we start a second tracer process, that tracer process must + %% not inherit the tracing flags and the dead tracer (even though + %% we used set_on_spawn). + SecondTracer = tracer(), + tell_tracer(SecondTracer, StartTracing), + Seq20 = lists:seq(1, 20), + Seq20 = seq(1, 20, fun(I) -> I + 1 end), + Info2 = collect_all_info(), + io:format("~p\n", [Info2]), + [] = other_than_self(Info2), + SecondTracer ! quit, + + ok. + +other_than_self(Info) -> + [{Pid,MFA} || {MFA,[{Pid,_,_,_}]} <- Info, + Pid =/= self()]. + +tell_tracer(Tracer, Fun) -> + Tracer ! {execute,self(),Fun}, + receive + {Tracer,executed} -> + ok + end. + +tracer() -> + spawn_link(fun Loop() -> + receive + quit -> + ok; + {execute,From,Fun} -> + Fun(), + From ! {self(),executed}, + Loop() + end + end). + +turn_on_tracing(Pid) -> + _ = erlang:trace(Pid, true, [call,set_on_spawn]), + _ = erlang:trace_pattern({?MODULE,'_','_'}, true, [call_time]), + _ = now(), + ok. + +collect_all_info() -> + collect_all_info([{?MODULE,F,A} || {F,A} <- module_info(functions)] ++ + erlang:system_info(snifs)). + +collect_all_info([MFA|T]) -> + CallTime = erlang:trace_info(MFA, call_time), + erlang:trace_pattern(MFA, restart, [call_time]), + case CallTime of + {call_time,false} -> + collect_all_info(T); + {call_time,[]} -> + collect_all_info(T); + {call_time,[_|_]=List} -> + [{MFA,List}|collect_all_info(T)] + end; +collect_all_info([]) -> []. + %%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% The Tests %%% @@ -478,7 +564,6 @@ called_function(Config) when is_list(Config) -> %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Local helpers - load_nif(Config) -> ?line Path = ?config(data_dir, Config), ?line ok = erlang:load_nif(filename:join(Path,"trace_nif"), 0). @@ -602,8 +687,11 @@ collect(A, Ref) -> end. setup() -> + setup([]). + +setup(Opts) -> Pid = spawn_link(fun() -> loop() end), - ?line 1 = erlang:trace(Pid, true, [call]), + 1 = erlang:trace(Pid, true, [call|Opts]), Pid. execute(Pids, Mfa) when is_list(Pids) -> diff --git a/erts/epmd/src/Makefile.in b/erts/epmd/src/Makefile.in index e94674e6f4..8dc8dae5f6 100644 --- a/erts/epmd/src/Makefile.in +++ b/erts/epmd/src/Makefile.in @@ -18,6 +18,9 @@ # include $(ERL_TOP)/make/target.mk +ifeq ($(findstring ose,$(TARGET)),ose) +include $(ERL_TOP)/make/$(TARGET)/ose_lm.mk +endif ifeq ($(TYPE),debug) PURIFY = @@ -64,9 +67,13 @@ else ifeq ($(findstring vxworks,$(TARGET)),vxworks) ERTS_INTERNAL_LIBS=-L../../lib/internal/$(TARGET) -lerts_internal$(ERTS_LIB_TYPEMARKER) @ERTS_INTERNAL_X_LIBS@ else +ifeq ($(findstring ose,$(TARGET)),ose) +ERTS_INTERNAL_LIBS=-L../../lib/internal/$(TARGET) -lerts_internal$(ERTS_LIB_TYPEMARKER) @ERTS_INTERNAL_X_LIBS@ +else ERTS_INTERNAL_LIBS=-L../../lib/internal/$(TARGET) -lerts_internal$(ERTS_LIB_TYPEMARKER) @ERTS_INTERNAL_X_LIBS@ -lm endif endif +endif ERTS_LIB = $(ERL_TOP)/erts/lib_src/obj/$(TARGET)/$(TYPE)/MADE @@ -74,7 +81,11 @@ CC = @CC@ WFLAGS = @WFLAGS@ CFLAGS = @CFLAGS@ @DEFS@ $(TYPE_FLAGS) $(WFLAGS) $(ERTS_INCL) LD = @LD@ +ifeq ($(findstring ose,$(TARGET)),ose) +LIBS = $(ERTS_INTERNAL_LIBS) @LIBS@ +else LIBS = @LIBS@ $(ERTS_INTERNAL_LIBS) +endif LDFLAGS = @LDFLAGS@ @@ -123,12 +134,25 @@ clean: rm -f *.o rm -f *~ core +ifeq ($(findstring ose,$(TARGET)),ose) +$(OBJDIR)/ose_confd.o: $(OSE_CONFD) + $(V_CC) $(CFLAGS) -o $@ -c $< +$(OBJDIR)/crt0_lm.o: $(CRT0_LM) + $(V_CC) $(CFLAGS) -o $@ -c $< +OSE_LM_OBJS += $(OBJDIR)/ose_confd.o $(OBJDIR)/crt0_lm.o +endif + # # Objects & executables # +ifeq ($(findstring ose,$(TARGET)),ose) +$(BINDIR)/$(EPMD): $(EPMD_OBJS) $(ERTS_LIB) $(OSE_LM_OBJS) + $(call build-ose-load-module, $@, $(EPMD_OBJS) $(OSE_LM_OBJS), $(LIBS), $(EPMD_LMCONF)) +else $(BINDIR)/$(EPMD): $(EPMD_OBJS) $(ERTS_LIB) $(ld_verbose)$(PURIFY) $(LD) $(LDFLAGS) -o $@ $(EPMD_OBJS) $(LIBS) +endif $(OBJDIR)/%.o: %.c epmd.h epmd_int.h $(V_CC) $(CFLAGS) $(EPMD_FLAGS) -o $@ -c $< diff --git a/erts/epmd/src/epmd.c b/erts/epmd/src/epmd.c index 2d55b37ff3..3cfa7a782f 100644 --- a/erts/epmd/src/epmd.c +++ b/erts/epmd/src/epmd.c @@ -52,7 +52,7 @@ static int epmd_main(int, char **, int); int epmd_dbg(int level,int port) /* Utility to debug epmd... */ { - char* argv[MAX_DEBUG+2]; + char* argv[MAX_DEBUG+4]; char ibuff[100]; int argc = 0; @@ -175,6 +175,9 @@ int main(int argc, char** argv) g->nodes.reg = g->nodes.unreg = g->nodes.unreg_tail = NULL; g->nodes.unreg_count = 0; g->active_conn = 0; +#ifdef HAVE_SYSTEMD_SD_DAEMON_H + g->is_systemd = 0; +#endif for (i = 0; i < MAX_LISTEN_SOCKETS; i++) g->listenfd[i] = -1; @@ -248,8 +251,12 @@ int main(int argc, char** argv) else usage(g); epmd_cleanup_exit(g,0); - } - else +#ifdef HAVE_SYSTEMD_SD_DAEMON_H + } else if (strcmp(argv[0], "-systemd") == 0) { + g->is_systemd = 1; + argv++; argc--; +#endif + } else usage(g); } dbg_printf(g,1,"epmd running - daemon = %d",g->is_daemon); @@ -389,7 +396,7 @@ static void run_daemon(EpmdVars *g) } #endif -#if defined(VXWORKS) +#if defined(VXWORKS) || defined(__OSE__) static void run_daemon(EpmdVars *g) { run(g); @@ -454,6 +461,11 @@ static void usage(EpmdVars *g) fprintf(stderr, " Forcibly unregisters a name with epmd\n"); fprintf(stderr, " (only allowed if -relaxed_command_check was given when \n"); fprintf(stderr, " epmd was started).\n"); +#ifdef HAVE_SYSTEMD_SD_DAEMON_H + fprintf(stderr, " -systemd\n"); + fprintf(stderr, " Wait for socket from systemd. The option makes sense\n"); + fprintf(stderr, " when started from .socket unit.\n"); +#endif epmd_cleanup_exit(g,1); } diff --git a/erts/epmd/src/epmd_int.h b/erts/epmd/src/epmd_int.h index 656dbd1f45..c8f2192f7f 100644 --- a/erts/epmd/src/epmd_int.h +++ b/erts/epmd/src/epmd_int.h @@ -36,6 +36,13 @@ #define DONT_USE_MAIN #endif +#ifdef __OSE__ +# define NO_DAEMON +# define NO_SYSLOG +# define NO_SYSCONF +# define NO_FCNTL +#endif + /* ************************************************************************ */ /* Standard includes */ @@ -92,7 +99,11 @@ #endif /* ! WIN32 */ #include <ctype.h> -#include <signal.h> + +#if !defined(__OSE__) +# include <signal.h> +#endif + #include <errno.h> @@ -110,6 +121,14 @@ #include <stdarg.h> +#ifdef __OSE__ +# include "sys/select.h" +#endif + +#ifdef HAVE_SYSTEMD_SD_DAEMON_H +# include <systemd/sd-daemon.h> +#endif + /* ************************************************************************ */ /* Replace some functions by others by making the function name a macro */ @@ -321,6 +340,9 @@ typedef struct { int listenfd[MAX_LISTEN_SOCKETS]; char *addresses; char **argv; +#ifdef HAVE_SYSTEMD_SD_DAEMON_H + int is_systemd; +#endif } EpmdVars; void dbg_printf(EpmdVars*,int,const char*,...); diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c index 90df7cc25a..93982c2f60 100644 --- a/erts/epmd/src/epmd_srv.c +++ b/erts/epmd/src/epmd_srv.c @@ -29,6 +29,11 @@ # define INADDR_NONE 0xffffffff #endif +#if defined(__OSE__) +# include "sys/ioctl.h" +# define sleep(x) delay(x*1000) +#endif + /* * * This server is a local name server for Erlang nodes. Erlang nodes can @@ -208,6 +213,39 @@ void run(EpmdVars *g) node_init(g); g->conn = conn_init(g); +#ifdef HAVE_SYSTEMD_SD_DAEMON_H + if (g->is_systemd) + { + int n; + + dbg_printf(g,2,"try to obtain sockets from systemd"); + + n = sd_listen_fds(0); + if (n < 0) + { + dbg_perror(g,"cannot obtain sockets from systemd"); + epmd_cleanup_exit(g,1); + } + else if (n == 0) + { + dbg_tty_printf(g,0,"systemd provides no sockets"); + epmd_cleanup_exit(g,1); + } + else if (n > MAX_LISTEN_SOCKETS) + { + dbg_tty_printf(g,0,"cannot listen on more than %d IP addresses", MAX_LISTEN_SOCKETS); + epmd_cleanup_exit(g,1); + } + num_sockets = n; + for (i = 0; i < num_sockets; i++) + { + g->listenfd[i] = listensock[i] = SD_LISTEN_FDS_START + i; + } + } + else + { +#endif + dbg_printf(g,2,"try to initiate listening port %d", g->port); if (g->addresses != NULL && /* String contains non-separator characters if: */ @@ -272,8 +310,11 @@ void run(EpmdVars *g) SET_ADDR(iserv_addr[0],EPMD_ADDR_ANY,sport); num_sockets = 1; } +#ifdef HAVE_SYSTEMD_SD_DAEMON_H + } +#endif -#if !defined(__WIN32__) +#if !defined(__WIN32__) && !defined(__OSE__) /* We ignore the SIGPIPE signal that is raised when we call write twice on a socket closed by the other end. */ signal(SIGPIPE, SIG_IGN); @@ -289,6 +330,13 @@ void run(EpmdVars *g) FD_ZERO(&g->orig_read_mask); g->select_fd_top = 0; +#ifdef HAVE_SYSTEMD_SD_DAEMON_H + if (g->is_systemd) + for (i = 0; i < num_sockets; i++) + select_fd_set(g, listensock[i]); + else + { +#endif for (i = 0; i < num_sockets; i++) { if ((listensock[i] = socket(FAMILY,SOCK_STREAM,0)) < 0) @@ -351,6 +399,9 @@ void run(EpmdVars *g) } select_fd_set(g, listensock[i]); } +#ifdef HAVE_SYSTEMD_SD_DAEMON_H + } +#endif dbg_tty_printf(g,2,"entering the main select() loop"); diff --git a/erts/etc/common/Makefile.in b/erts/etc/common/Makefile.in index 83560735bc..0cf965f915 100644 --- a/erts/etc/common/Makefile.in +++ b/erts/etc/common/Makefile.in @@ -20,6 +20,10 @@ include $(ERL_TOP)/make/output.mk include $(ERL_TOP)/make/target.mk +ifeq ($(findstring ose,$(TARGET)),ose) +include $(ERL_TOP)/make/$(TARGET)/ose_lm.mk +endif + ERTS_LIB_TYPEMARKER=.$(TYPE) USING_MINGW=@MIXED_CYGWIN_MINGW@ @@ -62,7 +66,9 @@ LIBS = @LIBS@ LDFLAGS = @LDFLAGS@ # For clock_gettime in heart +ifneq ($(TARGET),arm-unknown-linux-androideabi) RTLIBS = @LIBRT@ +endif ifeq ($(TARGET),win32) ifeq ($(TYPE),debug) @@ -82,6 +88,16 @@ OSEETC = ../ose WINETC = ../win32 ifeq ($(TARGET), win32) +ETC = $(WINETC) +else +ifeq ($(findstring ose,$(TARGET)),ose) +ETC = $(OSEETC) +else +ETC = $(UXETC) +endif +endif + +ifeq ($(TARGET), win32) ERLEXEC = erlexec.dll else ERLEXEC = erlexec @@ -147,7 +163,8 @@ INSTALL_TOP_BIN = $(BINDIR)/Install.exe INSTALL_PROGS = \ $(INET_GETHOST) \ $(BINDIR)/heart.exe $(BINDIR)/erlsrv.exe \ - $(BINDIR)/erl.exe $(BINDIR)/werl.exe \ + $(BINDIR)/erl.exe $(BINDIR)/erl_log.exe \ + $(BINDIR)/werl.exe \ $(BINDIR)/$(ERLEXEC) \ $(INSTALL_EMBEDDED_PROGS) @@ -161,7 +178,26 @@ endif PORT_ENTRY_POINT=erl_port_entry ENTRY_LDFLAGS=-entry:$(PORT_ENTRY_POINT) -else # UNIX (!win32) +else +ifeq ($(findstring ose,$(TARGET)),ose) +ENTRY_LDFLAGS= +ENTRY_OBJ= +ERLSRV_OBJECTS= +MC_OUTPUTS= +INET_GETHOST = +INSTALL_EMBEDDED_PROGS = $(BINDIR)/run_erl_lm +INSTALL_EMBEDDED_DATA = +INSTALL_TOP = Install +INSTALL_TOP_BIN = +INSTALL_MISC = +INSTALL_SRC = +ERLEXECDIR = . +INSTALL_LIBS = +INSTALL_OBJS = +INSTALL_INCLUDES = +TEXTFILES = Install erl.src +INSTALL_PROGS = $(INSTALL_EMBEDDED_PROGS) +else # UNIX (!win32 && !ose) ENTRY_LDFLAGS= ENTRY_OBJ= ERLSRV_OBJECTS= @@ -170,11 +206,11 @@ INET_GETHOST = $(BINDIR)/inet_gethost@EXEEXT@ INSTALL_EMBEDDED_PROGS += $(BINDIR)/typer@EXEEXT@ $(BINDIR)/dialyzer@EXEEXT@ \ $(BINDIR)/erlc@EXEEXT@ $(BINDIR)/escript@EXEEXT@ $(BINDIR)/ct_run@EXEEXT@ \ $(BINDIR)/run_erl $(BINDIR)/to_erl $(BINDIR)/dyn_erl -INSTALL_EMBEDDED_DATA = ../unix/start.src ../unix/start_erl.src +INSTALL_EMBEDDED_DATA = $(UXETC)/start.src $(UXETC)/start_erl.src INSTALL_TOP = Install INSTALL_TOP_BIN = -INSTALL_MISC = ../unix/format_man_pages ../unix/makewhatis -INSTALL_SRC = ../unix/setuid_socket_wrap.c #delivered as an example +INSTALL_MISC = $(UXETC)/format_man_pages $(UXETC)/makewhatis +INSTALL_SRC = $(UXETC)/setuid_socket_wrap.c #delivered as an example ERLEXECDIR = . INSTALL_LIBS = INSTALL_OBJS = @@ -186,6 +222,7 @@ INSTALL_PROGS = \ $(BINDIR)/$(ERLEXEC) \ $(INSTALL_EMBEDDED_PROGS) endif +endif .PHONY: etc etc: $(ENTRY_OBJ) $(INSTALL_PROGS) $(INSTALL_LIBS) $(TEXTFILES) $(INSTALL_TOP_BIN) @@ -230,11 +267,14 @@ endif rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/run_erl.o rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/to_erl.o rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/dyn_erl.o - rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/safe_string.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/safe_string.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/run_erl_common.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/to_erl_common.o rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/typer.o rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/ct_run.o rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/vxcall.o rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/erl.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/erl_log.o rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/werl.o rm -f $(TEXTFILES) rm -f *~ core @@ -258,6 +298,9 @@ $(BINDIR)/erl@EXEEXT@: $(OBJDIR)/erl.o $(OBJDIR)/init_file.o $(OBJDIR)/$(ERLRES_ $(BINDIR)/werl@EXEEXT@: $(OBJDIR)/werl.o $(OBJDIR)/init_file.o $(OBJDIR)/$(ERLRES_OBJ) $(V_LD) $(LDFLAGS) -o $@ $(OBJDIR)/werl.o $(OBJDIR)/init_file.o $(OBJDIR)/$(ERLRES_OBJ) +$(BINDIR)/erl_log@EXEEXT@: $(OBJDIR)/erl_log.o + $(V_LD) $(LDFLAGS) -o $@ $(OBJDIR)/erl_log.o + $(BINDIR)/start_erl@EXEEXT@: $(OBJDIR)/start_erl.o $(V_LD) $(LDFLAGS) -o $@ $(OBJDIR)/start_erl.o @@ -311,6 +354,10 @@ $(OBJDIR)/werl.o: $(WINETC)/erl.c $(WINETC)/init_file.h $(RC_GENERATED) $(V_CC) $(CFLAGS) -DBUILD_TYPE=\"-$(TYPE)\" -DERL_RUN_SHARED_LIB=1 \ -DWIN32_WERL -o $@ -c $(WINETC)/erl.c +$(OBJDIR)/erl_log.o: $(WINETC)/erl_log.c $(RC_GENERATED) + $(V_CC) $(CFLAGS) -DBUILD_TYPE=\"-$(TYPE)\" -DERL_RUN_SHARED_LIB=1 \ + -o $@ -c $(WINETC)/erl_log.c + $(OBJDIR)/erl.o: $(WINETC)/erl.c $(WINETC)/init_file.h $(RC_GENERATED) $(V_CC) $(CFLAGS) -DBUILD_TYPE=\"-$(TYPE)\" -DERL_RUN_SHARED_LIB=1 \ -o $@ -c $(WINETC)/erl.c @@ -370,29 +417,33 @@ $(OBJDIR)/heart.o: heart.c $(RC_GENERATED) $(OBJDIR)/inet_gethost.o: inet_gethost.c $(RC_GENERATED) $(V_CC) $(CFLAGS) -o $@ -c inet_gethost.c +# inet_gethost $(BINDIR)/inet_gethost@EXEEXT@: $(OBJDIR)/inet_gethost.o $(ENTRY_OBJ) $(ERTS_LIB) $(ld_verbose)$(PURIFY) $(LD) $(LDFLAGS) $(ENTRY_LDFLAGS) -o $@ $(OBJDIR)/inet_gethost.o $(ENTRY_OBJ) $(LIBS) $(ERTS_INTERNAL_LIBS) -$(BINDIR)/run_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o - $(V_LD) $(LDFLAGS) -o $@ $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o $(LIBS) - -$(OBJDIR)/run_erl.o: ../unix/run_erl.c $(RC_GENERATED) - $(V_CC) $(CFLAGS) -o $@ -c ../unix/run_erl.c - -$(BINDIR)/to_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/to_erl.o - $(V_LD) $(LDFLAGS) -o $@ $(OBJDIR)/safe_string.o $(OBJDIR)/to_erl.o - -$(OBJDIR)/to_erl.o: ../unix/to_erl.c $(RC_GENERATED) - $(V_CC) $(CFLAGS) -o $@ -c ../unix/to_erl.c - +# run_erl +$(BINDIR)/run_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o $(OBJDIR)/run_erl_common.o + $(V_LD) $(LDFLAGS) -o $@ $^ $(LIBS) +$(OBJDIR)/run_erl.o: $(ETC)/run_erl.c ../common/run_erl_common.h $(RC_GENERATED) + $(V_CC) $(CFLAGS) -I ../common/ -o $@ -c $(ETC)/run_erl.c +$(OBJDIR)/run_erl_common.o: ../common/run_erl_common.c ../common/run_erl_common.h $(RC_GENERATED) + $(V_CC) $(CFLAGS) -o $@ -c $< + +# to_erl +$(BINDIR)/to_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/to_erl.o $(OBJDIR)/to_erl_common.o + $(V_LD) $(LDFLAGS) -o $@ $^ +$(OBJDIR)/to_erl.o: $(ETC)/to_erl.c ../common/safe_string.h $(RC_GENERATED) + $(V_CC) $(CFLAGS) -I ../common/ -o $@ -c $(ETC)/to_erl.c +$(OBJDIR)/to_erl_common.o: ../common/to_erl_common.c ../common/to_erl_common.h $(RC_GENERATED) + $(V_CC) $(CFLAGS) -o $@ -c $< + +# dyn_erl $(BINDIR)/dyn_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/dyn_erl.o $(V_LD) $(LDFLAGS) -o $@ $(OBJDIR)/safe_string.o $(OBJDIR)/dyn_erl.o - -$(OBJDIR)/dyn_erl.o: ../unix/dyn_erl.c $(RC_GENERATED) - $(V_CC) $(CFLAGS) -o $@ -c ../unix/dyn_erl.c - -$(OBJDIR)/safe_string.o: ../unix/safe_string.c $(RC_GENERATED) - $(V_CC) $(CFLAGS) -o $@ -c ../unix/safe_string.c +$(OBJDIR)/dyn_erl.o: $(UXETC)/dyn_erl.c $(RC_GENERATED) + $(V_CC) $(CFLAGS) -o $@ -c $(UXETC)/dyn_erl.c +$(OBJDIR)/safe_string.o: ../common/safe_string.c $(RC_GENERATED) + $(V_CC) $(CFLAGS) -o $@ -c ../common/safe_string.c ifneq ($(TARGET),win32) $(BINDIR)/$(ERLEXEC): $(OBJDIR)/$(ERLEXEC).o $(ERTS_LIB) @@ -401,6 +452,7 @@ $(BINDIR)/$(ERLEXEC): $(OBJDIR)/$(ERLEXEC).o $(ERTS_LIB) $(OBJDIR)/$(ERLEXEC).o: $(ERLEXECDIR)/$(ERLEXEC).c $(RC_GENERATED) $(V_CC) -I$(EMUDIR) $(CFLAGS) -o $@ -c $(ERLEXECDIR)/$(ERLEXEC).c endif + $(BINDIR)/erlc@EXEEXT@: $(OBJDIR)/erlc.o $(ERTS_LIB) $(ld_verbose)$(PURIFY) $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/erlc.o -L$(OBJDIR) $(LIBS) $(ERTS_INTERNAL_LIBS) @@ -433,18 +485,42 @@ $(OBJDIR)/ct_run.o: ct_run.c $(RC_GENERATED) -Install: ../unix/Install.src ../../vsn.mk $(TARGET)/Makefile +Install: $(UXETC)/Install.src ../../vsn.mk $(TARGET)/Makefile $(vsn_verbose)sed -e 's;%I_VSN%;$(VSN);' \ -e 's;%EMULATOR%;$(EMULATOR);' \ -e 's;%EMULATOR_NUMBER%;$(EMULATOR_NUMBER);' \ -e 's;%I_SYSTEM_VSN%;$(SYSTEM_VSN);' \ - ../unix/Install.src > Install + $(UXETC)/Install.src > Install -erl.src: ../unix/erl.src.src ../../vsn.mk $(TARGET)/Makefile +erl.src: $(UXETC)/erl.src.src ../../vsn.mk $(TARGET)/Makefile $(vsn_verbose)sed -e 's;%EMULATOR%;$(EMULATOR);' \ -e 's;%EMULATOR_NUMBER%;$(EMULATOR_NUMBER);' \ -e 's;%VSN%;$(VSN);' \ - ../unix/erl.src.src > erl.src + $(UXETC)/erl.src.src > erl.src + +#--------------------------------------------------------- +# OSE specific targets +#--------------------------------------------------------- +ifeq ($(findstring ose,$(TARGET)),ose) +$(OBJDIR)/ose_confd.o: $(OSE_CONFD) + $(V_CC) $(CFLAGS) -o $@ -c $< +$(OBJDIR)/crt0_lm.o: $(CRT0_LM) + $(V_CC) $(CFLAGS) -o $@ -c $< +OSE_LM_OBJS += $(OBJDIR)/ose_confd.o $(OBJDIR)/crt0_lm.o + +$(BINDIR)/run_erl_lm: $(OBJDIR)/run_erl_main.o $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o $(OBJDIR)/run_erl_common.o $(OBJDIR)/to_erl_common.o $(OSE_LM_OBJS) + $(call build-ose-load-module, $@, $^, $(LIBS), $(RUN_ERL_LMCONF)) + + +$(OBJDIR)/run_erl_main.o: $(OSEETC)/run_erl_main.c $(OSEETC)/run_erl.h ../common/to_erl_common.h $(RC_GENERATED) + $(V_CC) $(CFLAGS) -I ../common/ -o $@ -c $(OSEETC)/run_erl_main.c + +endif + +#--------------------------------------------------------- +# End of ose specific targets. +#--------------------------------------------------------- + # ---------------------------------------------------- # Release Target @@ -478,11 +554,6 @@ ifneq ($(INSTALL_MISC),) $(INSTALL_DIR) "$(RELEASE_PATH)/misc" $(INSTALL_SCRIPT) $(INSTALL_MISC) "$(RELEASE_PATH)/misc" endif -ifneq ($(INSTALL_ERL_OSE),) - $(INSTALL_DIR) "$(RELEASE_PATH)/build_erl_ose" - cd $(OSEETC) && $(TAR) erl_ose_$(SYSTEM_VSN).tar $(INSTALL_ERL_OSE) - cd $(OSEETC) && $(INSTALL_SCRIPT) erl_ose_$(SYSTEM_VSN).tar "$(RELEASE_PATH)/build_erl_ose" -endif ifneq ($(INSTALL_SRC),) $(INSTALL_DIR) "$(RELEASE_PATH)/erts-$(VSN)/src" $(INSTALL_DATA) $(INSTALL_SRC) "$(RELEASE_PATH)/erts-$(VSN)/src" diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index 2cf7280ebc..709c6f02d1 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -833,9 +833,13 @@ int main(int argc, char **argv) #ifdef ERTS_DIRTY_SCHEDULERS else if (argv[i][2] == 'D') { char* type = argv[i]+3; - if (strcmp(type, "cpu") != 0 && - strcmp(type, "Pcpu") != 0 && - strcmp(type, "io") != 0) + if (strncmp(type, "cpu", 3) != 0 && + strncmp(type, "Pcpu", 4) != 0 && + strncmp(type, "io", 2) != 0) + usage(argv[i]); + if ((argv[i][3] == 'c' && argv[i][6] != '\0') || + (argv[i][3] == 'P' && argv[i][7] != '\0') || + (argv[i][3] == 'i' && argv[i][5] != '\0')) goto the_default; } #endif diff --git a/erts/etc/common/inet_gethost.c b/erts/etc/common/inet_gethost.c index bef97862a3..9ec4192667 100644 --- a/erts/etc/common/inet_gethost.c +++ b/erts/etc/common/inet_gethost.c @@ -1209,7 +1209,7 @@ static void start_que_request(Worker *w) #endif } -#ifndef WIN32 +#ifndef WIN32 /* Signal utilities */ static RETSIGTYPE (*sys_sigset(int sig, RETSIGTYPE (*func)(int)))(int) { diff --git a/erts/etc/common/run_erl_common.c b/erts/etc/common/run_erl_common.c new file mode 100644 index 0000000000..dc55c2bea4 --- /dev/null +++ b/erts/etc/common/run_erl_common.c @@ -0,0 +1,686 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2014. 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% + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include <dirent.h> +#include <errno.h> +#include <fcntl.h> +#include <stdarg.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <sys/stat.h> +#include <sys/types.h> +#include <time.h> +#include <unistd.h> + +#ifdef HAVE_SYSLOG_H +# include <syslog.h> +#endif + +#ifdef __OSE__ +# include "ramlog.h" +#endif + +#include "run_erl_common.h" +#include "safe_string.h" + +#define DEFAULT_LOG_GENERATIONS 5 +#define LOG_MAX_GENERATIONS 1000 /* No more than 1000 log files */ +#define LOG_MIN_GENERATIONS 2 /* At least two to switch between */ +#define DEFAULT_LOG_MAXSIZE 100000 +#define LOG_MIN_MAXSIZE 1000 /* Smallast value for changing log file */ +#define LOG_STUBNAME "erlang.log." +#define LOG_PERM 0664 +#define DEFAULT_LOG_ACTIVITY_MINUTES 5 +#define DEFAULT_LOG_ALIVE_MINUTES 15 +#define DEFAULT_LOG_ALIVE_FORMAT "%a %b %e %T %Z %Y" +#define ALIVE_BUFFSIZ 1024 + +#define STATUSFILENAME "/run_erl.log" + +#define PIPE_STUBNAME "erlang.pipe" +#define PIPE_STUBLEN strlen(PIPE_STUBNAME) +#define PERM (S_IWUSR | S_IRUSR | S_IWOTH | S_IROTH | S_IWGRP | S_IRGRP) + +/* OSE has defined O_SYNC but it is not recognized by open */ +#if !defined(O_SYNC) || defined(__OSE__) +#undef O_SYNC +#define O_SYNC 0 +#define USE_FSYNC 1 +#endif + +/* Global variable definitions + * We need this complex way of handling global variables because of how + * OSE works here. We want to make it possible to run the shell command + * run_erl multiple times with different global variables without them + * effecting eachother. + */ +typedef struct run_erl_ run_erl; + +#ifdef __OSE__ +static OSPPDKEY run_erl_pp_key; +#define RE_DATA (*(run_erl**)ose_get_ppdata(run_erl_pp_key)) +#else +static run_erl re; +#define RE_DATA (&re) +#endif + +#define STATUSFILE (RE_DATA->statusfile) +#define LOG_DIR (RE_DATA->log_dir) +#define STDSTATUS (RE_DATA->stdstatus) +#define LOG_GENERATIONS (RE_DATA->log_generations) +#define LOG_MAXSIZE (RE_DATA->log_maxsize) +#define LOG_ACTIVITY_MINUTES (RE_DATA->log_activity_minutes) +#define LOG_ALIVE_IN_GMT (RE_DATA->log_alive_in_gmt) +#define LOG_ALIVE_FORMAT (RE_DATA->log_alive_format) +#define RUN_DAEMON (RE_DATA->run_daemon) +#define LOG_ALIVE_MINUTES (RE_DATA->log_alive_minutes) +#define LOG_NUM (RE_DATA->log_num) +#define LFD (RE_DATA->lfd) +#define PROTOCOL_VER (RE_DATA->protocol_ver) + +struct run_erl_ { + /* constant config data */ + char statusfile[FILENAME_BUFSIZ]; + char log_dir[FILENAME_BUFSIZ]; + FILE *stdstatus; + int log_generations; + int log_maxsize; + int log_activity_minutes; + int log_alive_in_gmt; + char log_alive_format[ALIVE_BUFFSIZ+1]; + int run_daemon; + int log_alive_minutes; + /* Current log number and log fd */ + int log_num; + int lfd; + unsigned protocol_ver; +}; + +/* prototypes */ + +static int next_log(int log_num); +static int prev_log(int log_num); +static int find_next_log_num(void); +static int open_log(int log_num, int flags); + +/* + * getenv_int: + */ +static char *getenv_int(const char *name) { +#ifdef __OSE__ + return get_env(get_bid(current_process()),name); +#else + return getenv(name); +#endif +} + +/* + * next_log: + * Returns the index number that follows the given index number. + * (Wrapping after log_generations) + */ +static int next_log(int log_num) { + return log_num>=LOG_GENERATIONS?1:log_num+1; +} + +/* + * prev_log: + * Returns the index number that precedes the given index number. + * (Wrapping after log_generations) + */ +static int prev_log(int log_num) { + return log_num<=1?LOG_GENERATIONS:log_num-1; +} + +/* + * find_next_log_num() + * Searches through the log directory to check which logs that already + * exist. It finds the "hole" in the sequence, and returns the index + * number for the last log in the log sequence. If there is no hole, index + * 1 is returned. + */ +static int find_next_log_num(void) { + int i, next_gen, log_gen; + DIR *dirp; + struct dirent *direntp; + int log_exists[LOG_MAX_GENERATIONS+1]; + int stub_len = strlen(LOG_STUBNAME); + + /* Initialize exiting log table */ + + for(i=LOG_GENERATIONS; i>=0; i--) + log_exists[i] = 0; + dirp = opendir(LOG_DIR); + if(!dirp) { + ERRNO_ERR1(LOG_ERR,"Can't access log directory '%s'", LOG_DIR); + exit(1); + } + + /* Check the directory for existing logs */ + + while((direntp=readdir(dirp)) != NULL) { + if(strncmp(direntp->d_name,LOG_STUBNAME,stub_len)==0) { + int num = atoi(direntp->d_name+stub_len); + if(num < 1 || num > LOG_GENERATIONS) + continue; + log_exists[num] = 1; + } + } + closedir(dirp); + + /* Find out the next available log file number */ + + next_gen = 0; + for(i=LOG_GENERATIONS; i>=0; i--) { + if(log_exists[i]) + if(next_gen) + break; + else + ; + else + next_gen = i; + } + + /* Find out the current log file number */ + + if(next_gen) + log_gen = prev_log(next_gen); + else + log_gen = 1; + + return log_gen; +} /* find_next_log_num() */ + +static int open_log(int log_num, int flags) +{ + char buf[FILENAME_MAX]; + time_t now; + struct tm *tmptr; + char log_buffer[ALIVE_BUFFSIZ+1]; + + /* Remove the next log (to keep a "hole" in the log sequence) */ + sn_printf(buf, sizeof(buf), "%s/%s%d", + LOG_DIR, LOG_STUBNAME, next_log(log_num)); + unlink(buf); + + /* Create or continue on the current log file */ + sn_printf(buf, sizeof(buf), "%s/%s%d", LOG_DIR, LOG_STUBNAME, log_num); + + LFD = sf_open(buf, flags, LOG_PERM); + + if(LFD <0){ + ERRNO_ERR1(LOG_ERR,"Can't open log file '%s'.", buf); + exit(1); + } + + /* Write a LOGGING STARTED and time stamp into the log file */ + time(&now); + if (LOG_ALIVE_IN_GMT) { + tmptr = gmtime(&now); + } else { + tmptr = localtime(&now); + } + if (!strftime(log_buffer, ALIVE_BUFFSIZ, LOG_ALIVE_FORMAT, + tmptr)) { + strn_cpy(log_buffer, sizeof(log_buffer), + "(could not format time in 256 positions " + "with current format string.)"); + } + log_buffer[ALIVE_BUFFSIZ] = '\0'; + + sn_printf(buf, sizeof(buf), "\n=====\n===== LOGGING STARTED %s\n=====\n", + log_buffer); + if (erts_run_erl_write_all(LFD, buf, strlen(buf)) < 0) + erts_run_erl_log_status("Error in writing to log.\n"); + +#if USE_FSYNC + fsync(LFD); +#endif + + return LFD; +} + +/* Instead of making sure basename exists, we do our own */ +char *simple_basename(char *path) +{ + char *ptr; + for (ptr = path; *ptr != '\0'; ++ptr) { + if (*ptr == '/') { + path = ptr + 1; + } + } + return path; +} + +ssize_t sf_read(int fd, void *buffer, size_t len) { + ssize_t n = 0; + + do { n = read(fd, buffer, len); } while (n < 0 && errno == EINTR); + + return n; +} + +ssize_t sf_write(int fd, const void *buffer, size_t len) { + ssize_t n = 0; + + do { n = write(fd, buffer, len); } while (n < 0 && errno == EINTR); + + return n; +} + +int sf_open(const char *path, int type, mode_t mode) { + int fd = 0; + + do { fd = open(path, type, mode); } while(fd < 0 && errno == EINTR); + + return fd; +} + +int sf_close(int fd) { + int res = 0; + + do { res = close(fd); } while(res < 0 && errno == EINTR); + + return res; +} + +/* Call write() until entire buffer has been written or error. + * Return len or -1. + */ +int erts_run_erl_write_all(int fd, const char* buf, int len) +{ + int left = len; + int written; + for (;;) { + do { + written = write(fd,buf,left); + } while (written < 0 && errno == EINTR); + if (written == left) { + return len; + } + if (written < 0) { + return -1; + } + left -= written; + buf += written; + } + return written; +} + +/* erts_run_erl_log_status() + * Prints the arguments to a status file + * Works like printf (see vfrpintf) + */ +void erts_run_erl_log_status(const char *format,...) +{ + va_list args; + time_t now; + + if (STDSTATUS == NULL) + STDSTATUS = fopen(STATUSFILE, "w"); + if (STDSTATUS == NULL) + return; + now = time(NULL); + fprintf(STDSTATUS, "run_erl [%d] %s", +#ifdef __OSE__ + (int)current_process(), +#else + (int)getpid(), +#endif + ctime(&now)); + va_start(args, format); + vfprintf(STDSTATUS, format, args); + va_end(args); + fflush(STDSTATUS); + return; +} + +/* Fetch the current log alive minutes */ +int erts_run_erl_log_alive_minutes() { + return LOG_ALIVE_MINUTES; +} + +/* error_logf() + * Prints the arguments to stderr or syslog + * Works like printf (see vfprintf) + */ +void erts_run_erl_log_error(int priority, int line, const char *format, ...) +{ + va_list args; + va_start(args, format); + +#ifdef HAVE_SYSLOG_H + if (RUN_DAEMON) { + vsyslog(priority,format,args); + } + else +#endif +#ifdef __OSE__ + if (RUN_DAEMON) { + char *buff = malloc(sizeof(char)*1024); + vsnprintf(buff,1024,format, args); + ramlog_printf(buff); + } + else +#endif + { + time_t now = time(NULL); + fprintf(stderr, "run_erl:%d [%d] %s", line, +#ifdef __OSE__ + (int)current_process(), +#else + (int)getpid(), +#endif + ctime(&now)); + vfprintf(stderr, format, args); + } + va_end(args); +} + +/* erts_run_erl_log_write() + * Writes a message to lfd. If the current log file is full, + * a new log file is opened. + */ +int erts_run_erl_log_write(char* buf, size_t len) +{ + int size; + ssize_t res; + /* Decide if new logfile needed, and open if so */ + + size = lseek(LFD,0,SEEK_END); + if(size+len > LOG_MAXSIZE) { + int res; + do { + res = close(LFD); + } while (res < 0 && errno == EINTR); + LOG_NUM = next_log(LOG_NUM); + LFD = open_log(LOG_NUM, O_RDWR|O_CREAT|O_TRUNC|O_SYNC); + } + + /* Write to log file */ + + if ((res = erts_run_erl_write_all(LFD, buf, len)) < 0) { + erts_run_erl_log_status("Error in writing to log.\n"); + } + +#if USE_FSYNC + fsync(LFD); +#endif + return res; +} + +int erts_run_erl_log_activity(int timeout,time_t now,time_t last_activity) { + char log_alive_buffer[ALIVE_BUFFSIZ+1]; + char buf[BUFSIZ]; + + if (timeout || now - last_activity > LOG_ACTIVITY_MINUTES*60) { + /* Either a time out: 15 minutes without action, */ + /* or something is coming in right now, but it's a long time */ + /* since last time, so let's write a time stamp this message */ + struct tm *tmptr; + if (LOG_ALIVE_IN_GMT) { + tmptr = gmtime(&now); + } else { + tmptr = localtime(&now); + } + if (!strftime(log_alive_buffer, ALIVE_BUFFSIZ, LOG_ALIVE_FORMAT, + tmptr)) { + strn_cpy(log_alive_buffer, sizeof(log_alive_buffer), + "(could not format time in 256 positions " + "with current format string.)"); + } + log_alive_buffer[ALIVE_BUFFSIZ] = '\0'; + + sn_printf(buf, sizeof(buf), "\n===== %s%s\n", + timeout?"ALIVE ":"", log_alive_buffer); + return erts_run_erl_log_write(buf, strlen(buf)); + } + return 0; +} + +int erts_run_erl_log_open() { + + LOG_NUM = find_next_log_num(); + LFD = open_log(LOG_NUM, O_RDWR|O_APPEND|O_CREAT|O_SYNC); + return 0; +} + +int erts_run_erl_log_init(int daemon, char* logdir) { + char *p; + +#ifdef __OSE__ + run_erl **re_pp; + if (!run_erl_pp_key) + ose_create_ppdata("run_erl_ppdata",&run_erl_pp_key); + re_pp = (run_erl **)ose_get_ppdata(run_erl_pp_key); + *re_pp = malloc(sizeof(run_erl)); +#endif + + STDSTATUS = NULL; + LOG_GENERATIONS = DEFAULT_LOG_GENERATIONS; + LOG_MAXSIZE = DEFAULT_LOG_MAXSIZE; + LOG_ACTIVITY_MINUTES = DEFAULT_LOG_ACTIVITY_MINUTES; + LOG_ALIVE_IN_GMT = 0; + RUN_DAEMON = 0; + LOG_ALIVE_MINUTES = DEFAULT_LOG_ALIVE_MINUTES; + LFD = 0; + PROTOCOL_VER = RUN_ERL_LO_VER; /* assume lowest to begin with */ + + /* Get values for LOG file handling from the environment */ + if ((p = getenv_int("RUN_ERL_LOG_ALIVE_MINUTES"))) { + LOG_ALIVE_MINUTES = atoi(p); + if (!LOG_ALIVE_MINUTES) { + ERROR1(LOG_ERR,"Minimum value for RUN_ERL_LOG_ALIVE_MINUTES is 1 " + "(current value is %s)",p); + } + LOG_ACTIVITY_MINUTES = LOG_ALIVE_MINUTES / 3; + if (!LOG_ACTIVITY_MINUTES) { + ++LOG_ACTIVITY_MINUTES; + } + } + if ((p = getenv_int( + "RUN_ERL_LOG_ACTIVITY_MINUTES"))) { + LOG_ACTIVITY_MINUTES = atoi(p); + if (!LOG_ACTIVITY_MINUTES) { + ERROR1(LOG_ERR,"Minimum value for RUN_ERL_LOG_ACTIVITY_MINUTES is 1 " + "(current value is %s)",p); + } + } + if ((p = getenv_int("RUN_ERL_LOG_ALIVE_FORMAT"))) { + if (strlen(p) > ALIVE_BUFFSIZ) { + ERROR1(LOG_ERR, "RUN_ERL_LOG_ALIVE_FORMAT can contain a maximum of " + "%d characters", ALIVE_BUFFSIZ); + } + strn_cpy(LOG_ALIVE_FORMAT, sizeof(LOG_ALIVE_FORMAT), p); + } else { + strn_cpy(LOG_ALIVE_FORMAT, sizeof(LOG_ALIVE_FORMAT), + DEFAULT_LOG_ALIVE_FORMAT); + } + if ((p = getenv_int("RUN_ERL_LOG_ALIVE_IN_UTC")) + && strcmp(p,"0")) { + ++LOG_ALIVE_IN_GMT; + } + if ((p = getenv_int("RUN_ERL_LOG_GENERATIONS"))) { + LOG_GENERATIONS = atoi(p); + if (LOG_GENERATIONS < LOG_MIN_GENERATIONS) + ERROR1(LOG_ERR,"Minimum RUN_ERL_LOG_GENERATIONS is %d", + LOG_MIN_GENERATIONS); + if (LOG_GENERATIONS > LOG_MAX_GENERATIONS) + ERROR1(LOG_ERR,"Maximum RUN_ERL_LOG_GENERATIONS is %d", + LOG_MAX_GENERATIONS); + } + + if ((p = getenv_int("RUN_ERL_LOG_MAXSIZE"))) { + LOG_MAXSIZE = atoi(p); + if (LOG_MAXSIZE < LOG_MIN_MAXSIZE) + ERROR1(LOG_ERR,"Minimum RUN_ERL_LOG_MAXSIZE is %d", LOG_MIN_MAXSIZE); + } + + RUN_DAEMON = daemon; + + strn_cpy(LOG_DIR, sizeof(LOG_DIR), logdir); + strn_cpy(STATUSFILE, sizeof(STATUSFILE), LOG_DIR); + strn_cat(STATUSFILE, sizeof(STATUSFILE), STATUSFILENAME); + + return 0; +} + +/* create_fifo() + * Creates a new fifo with the given name and permission. + */ +static int create_fifo(char *name, int perm) +{ + if ((mkfifo(name, perm) < 0) && (errno != EEXIST)) + return -1; + return 0; +} + +/* + * w- and r_pipename have to be pre-allocated of atleast FILENAME_MAX size + */ +int erts_run_erl_open_fifo(char *pipename,char *w_pipename,char *r_pipename) { + int calculated_pipename = 0; + int highest_pipe_num = 0; + int fd; + + /* + * Create FIFOs and open them + */ + + if(*pipename && pipename[strlen(pipename)-1] == '/') { + /* The user wishes us to find a unique pipe name in the specified */ + /* directory */ + DIR *dirp; + struct dirent *direntp; + + calculated_pipename = 1; + dirp = opendir(pipename); + if(!dirp) { + ERRNO_ERR1(LOG_ERR,"Can't access pipe directory '%s'.", pipename); + return 1; + } + + /* Check the directory for existing pipes */ + + while((direntp=readdir(dirp)) != NULL) { + if(strncmp(direntp->d_name,PIPE_STUBNAME,PIPE_STUBLEN)==0) { + int num = atoi(direntp->d_name+PIPE_STUBLEN+1); + if(num > highest_pipe_num) + highest_pipe_num = num; + } + } + closedir(dirp); + strn_catf(pipename, BUFSIZ, "%s.%d", + PIPE_STUBNAME, highest_pipe_num+1); + } /* if */ + + for(;;) { + /* write FIFO - is read FIFO for `to_erl' program */ + strn_cpy(w_pipename, BUFSIZ, pipename); + strn_cat(w_pipename, BUFSIZ, ".r"); + if (create_fifo(w_pipename, PERM) < 0) { + ERRNO_ERR1(LOG_ERR,"Cannot create FIFO %s for writing.", + w_pipename); + return 1; + } + + /* read FIFO - is write FIFO for `to_erl' program */ + strn_cpy(r_pipename, BUFSIZ, pipename); + strn_cat(r_pipename, BUFSIZ, ".w"); + + /* Check that nobody is running run_erl already */ + if ((fd = sf_open(r_pipename, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) { + /* Open as client succeeded -- run_erl is already running! */ + sf_close(fd); + if (calculated_pipename) { + ++highest_pipe_num; + strn_catf(pipename, BUFSIZ, "%s.%d", + PIPE_STUBNAME, highest_pipe_num+1); + continue; + } + ERROR1(LOG_ERR, "Erlang already running on pipe %s.\n", pipename); + unlink(w_pipename); + return 1; + } + if (create_fifo(r_pipename, PERM) < 0) { + unlink(w_pipename); + ERRNO_ERR1(LOG_ERR,"Cannot create FIFO %s for reading.", + r_pipename); + return 1; + } + break; + } + return 0; +} + +/* Extract any control sequences that are ment only for run_erl + * and should not be forwarded to the pty. + */ +int erts_run_erl_extract_ctrl_seq(char* buf, int len) +{ + static const char prefix[] = "\033_"; + static const char suffix[] = "\033\\"; + char* bufend = buf + len; + char* start = buf; + char* command; + char* end; + + for (;;) { + start = find_str(start, bufend-start, prefix); + if (!start) break; + + command = start + strlen(prefix); + end = find_str(command, bufend-command, suffix); + if (end) { + unsigned col, row; + if (sscanf(command,"version=%u", &PROTOCOL_VER)==1) { + /*fprintf(stderr,"to_erl v%u\n", protocol_ver);*/ + } + else if (sscanf(command,"winsize=%u,%u", &col, &row)==2) { +#ifdef TIOCSWINSZ + struct winsize ws; + ws.ws_col = col; + ws.ws_row = row; + if (ioctl(MFD, TIOCSWINSZ, &ws) < 0) { + ERRNO_ERR0(LOG_ERR,"Failed to set window size"); + } +#endif + } + else { + ERROR2(LOG_ERR, "Ignoring unknown ctrl command '%.*s'\n", + (int)(end-command), command); + } + + /* Remove ctrl sequence from buf */ + end += strlen(suffix); + memmove(start, end, bufend-end); + bufend -= end - start; + } + else { + ERROR2(LOG_ERR, "Missing suffix in ctrl sequence '%.*s'\n", + (int)(bufend-start), start); + break; + } + } + return bufend - buf; +} diff --git a/erts/etc/common/run_erl_common.h b/erts/etc/common/run_erl_common.h new file mode 100644 index 0000000000..c47a0db054 --- /dev/null +++ b/erts/etc/common/run_erl_common.h @@ -0,0 +1,96 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2013. 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% + */ +/* + * Functions that are common to both OSE and unix implementations of run_erl + */ +#ifndef ERL_RUN_ERL_LOG_H +#define ERL_RUN_ERL_LOG_H + +#include <stdio.h> +#include <time.h> +#include <unistd.h> + +#include "run_erl_vsn.h" + +/* Log handling */ +int erts_run_erl_log_init(int run_daemon, char* logdir); +int erts_run_erl_log_open(void); +int erts_run_erl_log_close(void); +int erts_run_erl_log_write(char *buff, size_t len); +int erts_run_erl_log_activity(int timeout, time_t now, time_t last_activity); + +void erts_run_erl_log_status(const char *format,...); +void erts_run_erl_log_error(int priority, int line, const char *format,...); + +int erts_run_erl_open_fifo(char *pipename,char *w_pipename,char *r_pipename); +int erts_run_erl_log_alive_minutes(void); +int erts_run_erl_extract_ctrl_seq(char* buf, int len); + +/* File operations */ +ssize_t sf_read(int fd, void *buffer, size_t len); +ssize_t sf_write(int fd, const void *buffer, size_t len); +int sf_open(const char *path, int type, mode_t mode); +int sf_close(int fd); +int erts_run_erl_write_all(int fd, const char* buf, int len); +char *simple_basename(char *path); + +#ifndef LOG_ERR +#ifdef __OSE__ +#define LOG_ERR 0 +#else +#define LOG_ERR NULL +#endif +#endif + +#define ERROR0(Prio,Format) erts_run_erl_log_error(Prio,__LINE__,Format"\n") +#define ERROR1(Prio,Format,A1) erts_run_erl_log_error(Prio,__LINE__,Format"\n",A1) +#define ERROR2(Prio,Format,A1,A2) erts_run_erl_log_error(Prio,__LINE__,Format"\n",A1,A2) + +#ifdef HAVE_STRERROR +# define ADD_ERRNO(Format) "errno=%d '%s'\n"Format"\n",errno,strerror(errno) +#else +# define ADD_ERRNO(Format) "errno=%d\n"Format"\n",errno +#endif +#define ERRNO_ERR0(Prio,Format) erts_run_erl_log_error(Prio,__LINE__,ADD_ERRNO(Format)) +#define ERRNO_ERR1(Prio,Format,A1) erts_run_erl_log_error(Prio,__LINE__,ADD_ERRNO(Format),A1) +#define ERRNO_ERR2(Prio,Format,A1,A2) erts_run_erl_log_error(Prio,__LINE__,ADD_ERRNO(Format),A1,A2) + +#define RUN_ERL_USAGE \ + "%s (pipe_name|pipe_dir/) log_dir \"command [parameters ...]\"" \ + "\n\nDESCRIPTION:\n" \ + "You may also set the environment variables RUN_ERL_LOG_GENERATIONS\n" \ + "and RUN_ERL_LOG_MAXSIZE to the number of log files to use and the\n" \ + "size of the log file when to switch to the next log file\n" + +#ifndef FILENAME_MAX +#define FILENAME_MAX 250 +#endif + +#define FILENAME_BUFSIZ FILENAME_MAX + +#ifdef O_NONBLOCK +# define DONT_BLOCK_PLEASE O_NONBLOCK +#else +# define DONT_BLOCK_PLEASE O_NDELAY +# ifndef EAGAIN +# define EAGAIN -3898734 +# endif +#endif + +#endif diff --git a/erts/etc/unix/run_erl.h b/erts/etc/common/run_erl_vsn.h index 843cda680c..f6ac753bde 100644 --- a/erts/etc/unix/run_erl.h +++ b/erts/etc/common/run_erl_vsn.h @@ -1,19 +1,19 @@ /* * %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% */ @@ -27,4 +27,3 @@ * 0: Older, without version handshake * 1: R12B-3, version handshake + window size ctrl */ - diff --git a/erts/etc/unix/safe_string.c b/erts/etc/common/safe_string.c index a77d9c5456..b2f8814408 100644 --- a/erts/etc/unix/safe_string.c +++ b/erts/etc/common/safe_string.c @@ -1,24 +1,24 @@ /* * %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% */ -/* +/* * Module: safe_string.c - * + * * This is a bunch of generic string operation * that are safe regarding buffer overflow. * @@ -120,4 +120,3 @@ void* memmove(void *dest, const void *src, size_t n) return dest; } #endif /* HAVE_MEMMOVE */ - diff --git a/erts/etc/unix/safe_string.h b/erts/etc/common/safe_string.h index c70e528814..ff063fe641 100644 --- a/erts/etc/unix/safe_string.h +++ b/erts/etc/common/safe_string.h @@ -1,24 +1,24 @@ /* * %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% */ -/* +/* * Module: safe_string.h - * + * * This is an interface to a bunch of generic string operation * that are safe regarding buffer overflow. * @@ -62,4 +62,3 @@ char* find_str(const char* haystack, int size, const char* needle); #ifndef HAVE_MEMMOVE void* memmove(void *dest, const void *src, size_t n); #endif - diff --git a/erts/etc/common/to_erl_common.c b/erts/etc/common/to_erl_common.c new file mode 100644 index 0000000000..ab706fffe0 --- /dev/null +++ b/erts/etc/common/to_erl_common.c @@ -0,0 +1,716 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2013. 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: to_erl.c + * + * This module implements a process that opens two specified FIFOs, one + * for reading and one for writing; reads from its stdin, and writes what + * it has read to the write FIF0; reads from the read FIFO, and writes to + * its stdout. + * + ________ _________ + | |--<-- pipe.r (fifo1) --<--| | + | to_erl | | run_erl | (parent) + |________|-->-- pipe.w (fifo2) -->--|_________| + ^ master pty + | + | slave pty + ____V____ + | | + | "erl" | (child) + |_________| + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include <sys/types.h> +#include <sys/stat.h> +#include <sys/time.h> +#include <sys/types.h> +#include <fcntl.h> +#include <unistd.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <dirent.h> +#include <errno.h> + +#ifdef __OSE__ +#include <aio.h> +#include "ose.h" +#include "efs.h" +#include "ose_spi/fm.sig" +#else /* __UNIX__ */ +#include <termios.h> +#include <signal.h> +#endif + +#ifdef HAVE_SYS_IOCTL_H +# include <sys/ioctl.h> +#endif + +#include "to_erl_common.h" +#include "run_erl_vsn.h" +#include "safe_string.h" /* strn_cpy, strn_catf, sn_printf, etc. */ + +#if defined(O_NONBLOCK) +# define DONT_BLOCK_PLEASE O_NONBLOCK +#else +# define DONT_BLOCK_PLEASE O_NDELAY +# if !defined(EAGAIN) +# define EAGAIN -3898734 +# endif +#endif + +#ifdef HAVE_STRERROR +# define STRERROR(x) strerror(x) +#else +# define STRERROR(x) "" +#endif + +#define noDEBUG + +#ifdef __OSE__ +#define PIPE_DIR "/pipe/" +#else +#define PIPE_DIR "/tmp/" +#endif +#define PIPE_STUBNAME "erlang.pipe" +#define PIPE_STUBLEN strlen(PIPE_STUBNAME) + +#ifdef DEBUG +#define STATUS(s) { fprintf(stderr, (s)); fflush(stderr); } +#else +#define STATUS(s) +#endif + +#ifndef FILENAME_MAX +#define FILENAME_MAX 250 +#endif + +static int tty_eof = 0; +static int protocol_ver = RUN_ERL_LO_VER; /* assume lowest to begin with */ + +static int write_all(int fd, const char* buf, int len); +static int version_handshake(char* buf, int len, int wfd); + + +#ifdef __OSE__ + +#define SET_AIO(REQ,FD,SIZE,BUFF) \ + /* Make sure to clean data structure of previous request */ \ + memset(&(REQ),0,sizeof(REQ)); \ + (REQ).aio_fildes = FD; \ + (REQ).aio_offset = FM_POSITION_CURRENT; \ + (REQ).aio_nbytes = SIZE; \ + (REQ).aio_buf = BUFF; \ + (REQ).aio_sigevent.sigev_notify = SIGEV_NONE + +#define READ_AIO(REQ,FD,SIZE,BUFF) \ + SET_AIO(REQ,FD,SIZE,BUFF); \ + if (aio_read(&(REQ)) != 0) \ + fprintf(stderr,"aio_read of child_read_req(%d) failed" \ + "with error %d\n",FD,errno) + +union SIGNAL { + SIGSELECT signo; + struct FmReadPtr fm_read_ptr; +}; + +#else /* __UNIX__ */ +static int recv_sig = 0; +static struct termios tty_smode, tty_rmode; +static int window_size_seq(char* buf, size_t bufsz); +#ifdef DEBUG +static void show_terminal_settings(struct termios *); +#endif + +static void handle_ctrlc(int sig) +{ + /* Reinstall the handler, and signal break flag */ + signal(SIGINT,handle_ctrlc); + recv_sig = SIGINT; +} + +static void handle_sigwinch(int sig) +{ + recv_sig = SIGWINCH; +} +#endif + +static void usage(char *pname) +{ + fprintf(stderr, "Usage: "); + fprintf(stderr,TO_ERL_USAGE,pname); +} + +int to_erl(int argc, char **argv) +{ + char FIFO1[FILENAME_MAX], FIFO2[FILENAME_MAX]; + int i, len, wfd, rfd; + char pipename[FILENAME_MAX]; + int pipeIx = 1; + int force_lock = 0; + int got_some = 0; + +#ifdef __OSE__ + struct aiocb stdin_read_req, pipe_read_req; + FmHandle stdin_fh, pipe_fh; + char *stdin_buf, *pipe_buf; + char *buf; + union SIGNAL *sig; +#else /* __UNIX__ */ + char buf[BUFSIZ]; + fd_set readfds; +#endif + + if (argc >= 2 && argv[1][0]=='-') { + switch (argv[1][1]) { + case 'h': + usage(argv[0]); + exit(1); + case 'F': + force_lock = 1; + break; + default: + fprintf(stderr,"Invalid option '%s'\n",argv[1]); + exit(1); + } + pipeIx = 2; + } + +#ifdef DEBUG + fprintf(stderr, "%s: pid is : %d\n", argv[0],(int) +#ifdef __OSE__ + current_process() +#else /* __UNIX__ */ + getpid() +#endif + ); +#endif + + strn_cpy(pipename, sizeof(pipename), + (argv[pipeIx] ? argv[pipeIx] : PIPE_DIR)); + + if(*pipename && pipename[strlen(pipename)-1] == '/') { + /* The user wishes us to find a pipe name in the specified */ + /* directory */ + int highest_pipe_num = 0; + DIR *dirp; + struct dirent *direntp; + + dirp = opendir(pipename); + if(!dirp) { + fprintf(stderr, "Can't access pipe directory %s: %s\n", pipename, strerror(errno)); + exit(1); + } + + /* Check the directory for existing pipes */ + + while((direntp=readdir(dirp)) != NULL) { + if(strncmp(direntp->d_name,PIPE_STUBNAME,PIPE_STUBLEN)==0) { + int num = atoi(direntp->d_name+PIPE_STUBLEN+1); + if(num > highest_pipe_num) + highest_pipe_num = num; + } + } + closedir(dirp); + strn_catf(pipename, sizeof(pipename), (highest_pipe_num?"%s.%d":"%s"), + PIPE_STUBNAME, highest_pipe_num); + } /* if */ + + /* read FIFO */ + sn_printf(FIFO1,sizeof(FIFO1),"%s.r",pipename); + /* write FIFO */ + sn_printf(FIFO2,sizeof(FIFO2),"%s.w",pipename); + +#ifndef __OSE__ + /* Check that nobody is running to_erl on this pipe already */ + if ((wfd = open (FIFO1, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) { + /* Open as server succeeded -- to_erl is already running! */ + close(wfd); + fprintf(stderr, "Another to_erl process already attached to pipe " + "%s.\n", pipename); + if (force_lock) { + fprintf(stderr, "But we proceed anyway by force (-F).\n"); + } + else { + exit(1); + } + } +#endif + + if ((rfd = open (FIFO1, O_RDONLY|DONT_BLOCK_PLEASE, 0)) < 0) { +#ifdef DEBUG + fprintf(stderr, "Could not open FIFO %s for reading.\n", FIFO1); +#endif + fprintf(stderr, "No running Erlang on pipe %s: %s\n", pipename, strerror(errno)); + exit(1); + } +#ifdef DEBUG + fprintf(stderr, "to_erl: %s opened for reading\n", FIFO1); +#endif + + if ((wfd = open (FIFO2, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) { +#ifdef DEBUG + fprintf(stderr, "Could not open FIFO %s for writing.\n", FIFO2); +#endif + fprintf(stderr, "No running Erlang on pipe %s: %s\n", pipename, strerror(errno)); + close(rfd); + exit(1); + } +#ifdef DEBUG + fprintf(stderr, "to_erl: %s opened for writing\n", FIFO2); +#endif + +#ifndef __OSE__ + fprintf(stderr, "Attaching to %s (^D to exit)\n\n", pipename); +#else + fprintf(stderr, "Attaching to %s (^C to exit)\n\n", pipename); +#endif + +#ifndef __OSE__ + /* Set break handler to our handler */ + signal(SIGINT,handle_ctrlc); + + /* + * Save the current state of the terminal, and set raw mode. + */ + if (tcgetattr(0, &tty_rmode) , 0) { + fprintf(stderr, "Cannot get terminals current mode\n"); + exit(-1); + } + tty_smode = tty_rmode; + tty_eof = '\004'; /* Ctrl+D to exit */ +#ifdef DEBUG + show_terminal_settings(&tty_rmode); +#endif + tty_smode.c_iflag = + 1*BRKINT |/*Signal interrupt on break.*/ + 1*IGNPAR |/*Ignore characters with parity errors.*/ + 1*ISTRIP |/*Strip character.*/ + 0; + +#if 0 +0*IGNBRK |/*Ignore break condition.*/ +0*PARMRK |/*Mark parity errors.*/ +0*INPCK |/*Enable input parity check.*/ +0*INLCR |/*Map NL to CR on input.*/ +0*IGNCR |/*Ignore CR.*/ +0*ICRNL |/*Map CR to NL on input.*/ +0*IUCLC |/*Map upper-case to lower-case on input.*/ +0*IXON |/*Enable start/stop output control.*/ +0*IXANY |/*Enable any character to restart output.*/ +0*IXOFF |/*Enable start/stop input control.*/ +0*IMAXBEL|/*Echo BEL on input line too long.*/ +#endif + + tty_smode.c_oflag = + 1*OPOST |/*Post-process output.*/ + 1*ONLCR |/*Map NL to CR-NL on output.*/ +#ifdef XTABS + 1*XTABS |/*Expand tabs to spaces. (Linux)*/ +#endif +#ifdef OXTABS + 1*OXTABS |/*Expand tabs to spaces. (FreeBSD)*/ +#endif +#ifdef NL0 + 1*NL0 |/*Select newline delays*/ +#endif +#ifdef CR0 + 1*CR0 |/*Select carriage-return delays*/ +#endif +#ifdef TAB0 + 1*TAB0 |/*Select horizontal tab delays*/ +#endif +#ifdef BS0 + 1*BS0 |/*Select backspace delays*/ +#endif +#ifdef VT0 + 1*VT0 |/*Select vertical tab delays*/ +#endif +#ifdef FF0 + 1*FF0 |/*Select form feed delays*/ +#endif + 0; + +#if 0 +0*OLCUC |/*Map lower case to upper on output.*/ +0*OCRNL |/*Map CR to NL on output.*/ +0*ONOCR |/*No CR output at column 0.*/ +0*ONLRET |/*NL performs CR function.*/ +0*OFILL |/*Use fill characters for delay.*/ +0*OFDEL |/*Fill is DEL, else NULL.*/ +0*NL1 | +0*CR1 | +0*CR2 | +0*CR3 | +0*TAB1 | +0*TAB2 | +0*TAB3 |/*Expand tabs to spaces.*/ +0*BS1 | +0*VT1 | +0*FF1 | +#endif + + /* JALI: removed setting the tty_smode.c_cflag flags, since this is not */ + /* advisable if this is a *real* terminal, such as the console. In fact */ + /* this may hang the entire machine, deep, deep down (signalling break */ + /* or toggling the abort switch doesn't help) */ + + tty_smode.c_lflag = + 0; + +#if 0 +0*ISIG |/*Enable signals.*/ +0*ICANON |/*Canonical input (erase and kill processing).*/ +0*XCASE |/*Canonical upper/lower presentation.*/ +0*ECHO |/*Enable echo.*/ +0*ECHOE |/*Echo erase character as BS-SP-BS.*/ +0*ECHOK |/*Echo NL after kill character.*/ +0*ECHONL |/*Echo NL.*/ +0*NOFLSH |/*Disable flush after interrupt or quit.*/ +0*TOSTOP |/*Send SIGTTOU for background output.*/ +0*ECHOCTL|/*Echo control characters as ^char, delete as ^?.*/ +0*ECHOPRT|/*Echo erase character as character erased.*/ +0*ECHOKE |/*BS-SP-BS erase entire line on line kill.*/ +0*FLUSHO |/*Output is being flushed.*/ +0*PENDIN |/*Retype pending input at next read or input character.*/ +0*IEXTEN |/*Enable extended (implementation-defined) functions.*/ +#endif + + tty_smode.c_cc[VMIN] =0;/* Note that VMIN is the same as VEOF! */ + tty_smode.c_cc[VTIME] =0;/* Note that VTIME is the same as VEOL! */ + tty_smode.c_cc[VINTR] =3; + + tcsetattr(0, TCSADRAIN, &tty_smode); + +#ifdef DEBUG + show_terminal_settings(&tty_smode); +#endif + +#endif /* !__OSE__ */ + /* + * "Write a ^L to the FIFO which causes the other end to redisplay + * the input line." + * This does not seem to work as was intended in old comment above. + * However, this control character is now (R12B-3) used by run_erl + * to trigger the version handshaking between to_erl and run_erl + * at the start of every new to_erl-session. + */ + + if (write(wfd, "\014", 1) < 0) { + fprintf(stderr, "Error in writing ^L to FIFO.\n"); + } + +#ifdef __OSE__ + /* we have a tiny stack so we malloc the buffers */ + stdin_buf = malloc(sizeof(char) * BUFSIZ); + pipe_buf = malloc(sizeof(char) * BUFSIZ); + + efs_examine_fd(rfd,FLIB_FD_HANDLE,&pipe_fh); + efs_examine_fd(0,FLIB_FD_HANDLE,&stdin_fh); + READ_AIO(stdin_read_req,0,BUFSIZ,stdin_buf); + READ_AIO(pipe_read_req,rfd,BUFSIZ,pipe_buf); +#endif + + /* + * read and write + */ + while (1) { +#ifndef __OSE__ + FD_ZERO(&readfds); + FD_SET(0, &readfds); + FD_SET(rfd, &readfds); + if (select(rfd + 1, &readfds, NULL, NULL, NULL) < 0) { + if (recv_sig) { + FD_ZERO(&readfds); + } + else { + fprintf(stderr, "Error in select.\n"); + break; + } + } + len = 0; + + /* + * Read from terminal and write to FIFO + */ + if (recv_sig) { + switch (recv_sig) { + case SIGINT: + fprintf(stderr, "[Break]\n\r"); + buf[0] = '\003'; + len = 1; + break; + case SIGWINCH: + len = window_size_seq(buf,sizeof(buf)); + break; + default: + fprintf(stderr,"Unexpected signal: %u\n",recv_sig); + } + recv_sig = 0; + } + else +#else /* __OSE__ */ + SIGSELECT sigsel[] = {0}; + sig = receive(sigsel); + len = 0; +#endif +#ifndef __OSE__ + if (FD_ISSET(0,&readfds)) { + len = read(0, buf, sizeof(buf)); +#else /* __OSE__ */ + if (sig->signo == FM_READ_PTR_REPLY && + sig->fm_read_ptr.handle == stdin_fh) { + len = sig->fm_read_ptr.status == EFS_SUCCESS ? sig->fm_read_ptr.actual : -1; + buf = sig->fm_read_ptr.buffer; +#endif + if (len <= 0) { + close(rfd); + close(wfd); + if (len < 0) { + fprintf(stderr, "Error in reading from stdin.\n"); + } else { + fprintf(stderr, "[EOF]\n\r"); + } + break; + } + /* check if there is an eof character in input */ + for (i = 0; i < len-1 && buf[i] != tty_eof; i++); + if (buf[i] == tty_eof) { + fprintf(stderr, "[Quit]\n\r"); + break; + } + } + + if (len) { +#ifdef DEBUG + if(write(1, buf, len)); +#endif + if (write_all(wfd, buf, len) != len) { + fprintf(stderr, "Error in writing to FIFO.\n"); + close(rfd); + close(wfd); + break; + } + STATUS("\" OK\r\n"); +#ifdef __OSE__ + aio_dispatch(sig); + READ_AIO(stdin_read_req, 0, BUFSIZ, stdin_buf); +#endif + } + + /* + * Read from FIFO, write to terminal. + */ +#ifndef __OSE__ + if (FD_ISSET(rfd, &readfds)) { + STATUS("FIFO read: "); + len = read(rfd, buf, BUFSIZ); +#else /* __OSE__ */ + if (sig->signo == FM_READ_PTR_REPLY && + sig->fm_read_ptr.handle == pipe_fh) { + len = sig->fm_read_ptr.status == EFS_SUCCESS ? sig->fm_read_ptr.actual : -1; + buf = sig->fm_read_ptr.buffer; +#endif + if (len < 0 && errno == EAGAIN) { + /* + * No data this time, but the writing end of the FIFO is still open. + * Do nothing. + */ + ; + } else if (len <= 0) { + /* + * Either an error or end of file. In either case, break out + * of the loop. + */ + close(rfd); + close(wfd); + if (len < 0) { + fprintf(stderr, "Error in reading from FIFO.\n"); + } else + fprintf(stderr, "[End]\n\r"); + break; + } else { + if (!got_some) { + if ((len=version_handshake(buf,len,wfd)) < 0) { + close(rfd); + close(wfd); + break; + } +#ifndef __OSE__ + if (protocol_ver >= 1) { + /* Tell run_erl size of terminal window */ + signal(SIGWINCH, handle_sigwinch); + raise(SIGWINCH); + } +#endif + got_some = 1; + } + + /* + * We successfully read at least one character. Write what we got. + */ + STATUS("Terminal write: \""); + if (write_all(1, buf, len) != len) { + fprintf(stderr, "Error in writing to terminal.\n"); + close(rfd); + close(wfd); + break; + } + STATUS("\" OK\r\n"); +#ifdef __OSE__ + aio_dispatch(sig); + READ_AIO(pipe_read_req, rfd, BUFSIZ, pipe_buf); +#endif + } + } + } + +#ifndef __OSE__ + /* + * Reset terminal characterstics + * XXX + */ + tcsetattr(0, TCSADRAIN, &tty_rmode); +#endif + return 0; +} + +/* Call write() until entire buffer has been written or error. + * Return len or -1. + */ +static int write_all(int fd, const char* buf, int len) +{ + int left = len; + int written; + while (left) { + written = write(fd,buf,left); + if (written < 0) { + return -1; + } + left -= written; + buf += written; + } + return len; +} + +#ifndef __OSE__ +static int window_size_seq(char* buf, size_t bufsz) +{ +#ifdef TIOCGWINSZ + struct winsize ws; + static const char prefix[] = "\033_"; + static const char suffix[] = "\033\\"; + /* This Esc sequence is called "Application Program Command" + and seems suitable to use for our own customized stuff. */ + + if (ioctl(STDIN_FILENO, TIOCGWINSZ, &ws) == 0) { + int len = sn_printf(buf, bufsz, "%swinsize=%u,%u%s", + prefix, ws.ws_col, ws.ws_row, suffix); + return len; + } +#endif /* TIOCGWINSZ */ + return 0; +} +#endif /* !__OSE__ */ + +/* to_erl run_erl + * | | + * |---------- '\014' -------->| (session start) + * | | + * |<---- "[run_erl v1-0]" ----| (version interval) + * | | + * |--- Esc_"version=1"Esc\ -->| (common version) + * | | + */ +static int version_handshake(char* buf, int len, int wfd) +{ + unsigned re_high=0, re_low; + char *end = find_str(buf,len,"]\n"); + + if (end && sscanf(buf,"[run_erl v%u-%u",&re_high,&re_low)==2) { + char wbuf[30]; + int wlen; + + if (re_low > RUN_ERL_HI_VER || re_high < RUN_ERL_LO_VER) { + fprintf(stderr,"Incompatible versions: to_erl=v%u-%u run_erl=v%u-%u\n", + RUN_ERL_HI_VER, RUN_ERL_LO_VER, re_high, re_low); + return -1; + } + /* Choose highest common version */ + protocol_ver = re_high < RUN_ERL_HI_VER ? re_high : RUN_ERL_HI_VER; + + wlen = sn_printf(wbuf, sizeof(wbuf), "\033_version=%u\033\\", + protocol_ver); + if (write_all(wfd, wbuf, wlen) < 0) { + fprintf(stderr,"Failed to send version handshake\n"); + return -1; + } + end += 2; + len -= (end-buf); + memmove(buf,end,len); + + } + else { /* we assume old run_erl without version handshake */ + protocol_ver = 0; + } + + if (re_high != RUN_ERL_HI_VER) { + fprintf(stderr,"run_erl has different version, " + "using common protocol level %u\n", protocol_ver); + } + + return len; +} + + +#if defined(DEBUG) && !defined(__OSE__) +#define S(x) ((x) > 0 ? 1 : 0) + +static void show_terminal_settings(struct termios *t) +{ + fprintf(stderr,"c_iflag:\n"); + fprintf(stderr,"Signal interrupt on break: BRKINT %d\n", S(t->c_iflag & BRKINT)); + fprintf(stderr,"Map CR to NL on input: ICRNL %d\n", S(t->c_iflag & ICRNL)); + fprintf(stderr,"Ignore break condition: IGNBRK %d\n", S(t->c_iflag & IGNBRK)); + fprintf(stderr,"Ignore CR: IGNCR %d\n", S(t->c_iflag & IGNCR)); + fprintf(stderr,"Ignore char with par. err's: IGNPAR %d\n", S(t->c_iflag & IGNPAR)); + fprintf(stderr,"Map NL to CR on input: INLCR %d\n", S(t->c_iflag & INLCR)); + fprintf(stderr,"Enable input parity check: INPCK %d\n", S(t->c_iflag & INPCK)); + fprintf(stderr,"Strip character ISTRIP %d\n", S(t->c_iflag & ISTRIP)); + fprintf(stderr,"Enable start/stop input ctrl IXOFF %d\n", S(t->c_iflag & IXOFF)); + fprintf(stderr,"ditto output ctrl IXON %d\n", S(t->c_iflag & IXON)); + fprintf(stderr,"Mark parity errors PARMRK %d\n", S(t->c_iflag & PARMRK)); + fprintf(stderr,"\n"); + fprintf(stderr,"c_oflag:\n"); + fprintf(stderr,"Perform output processing OPOST %d\n", S(t->c_oflag & OPOST)); + fprintf(stderr,"\n"); + fprintf(stderr,"c_cflag:\n"); + fprintf(stderr,"Ignore modem status lines CLOCAL %d\n", S(t->c_cflag & CLOCAL)); + fprintf(stderr,"\n"); + fprintf(stderr,"c_local:\n"); + fprintf(stderr,"Enable echo ECHO %d\n", S(t->c_lflag & ECHO)); + fprintf(stderr,"\n"); + fprintf(stderr,"c_cc:\n"); + fprintf(stderr,"c_cc[VEOF] %d\n", t->c_cc[VEOF]); +} +#endif /* DEBUG && !__OSE__ */ diff --git a/erts/etc/common/to_erl_common.h b/erts/etc/common/to_erl_common.h new file mode 100644 index 0000000000..9967db94b8 --- /dev/null +++ b/erts/etc/common/to_erl_common.h @@ -0,0 +1,28 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2013. 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% + */ +#ifndef ERL_TO_ERL_H +#define ERL_TO_ERL_H + +#define TO_ERL_USAGE "to_erl [-h|-F] %s\n" \ + "\t-h\tThis help text.\n" \ + "\t-f\tForce connection even though pipe is locked by other to_erl process." + +int to_erl(int argc, char **argv); + +#endif diff --git a/erts/etc/ose/etc.lmconf b/erts/etc/ose/etc.lmconf new file mode 100644 index 0000000000..b402b325b1 --- /dev/null +++ b/erts/etc/ose/etc.lmconf @@ -0,0 +1,20 @@ +OSE_LM_STACK_SIZES=256,512,1024,2048,4096,8192,16384,65536 +OSE_LM_SIGNAL_SIZES=31,63,127,255,1023,4095,16383,65535 +OSE_LM_POOL_SIZE=0x200000 +OSE_LM_MAIN_NAME=main +OSE_LM_MAIN_STACK_SIZE=0xF000 +OSE_LM_MAIN_PRIORITY=20 +## Has to be of a type that allows MAM +OSE_LM_PROGRAM_TYPE=APP_RAM +OSE_LM_DATA_INIT=YES +OSE_LM_BSS_INIT=YES +OSE_LM_EXEC_MODEL=SHARED +HEAP_MAX_SIZE=1000000000 +HEAP_SMALL_BUF_INIT_SIZE=64000000 +HEAP_LARGE_BUF_THRESHOLD=16000000 +HEAP_LOCK_TYPE=2 + +# Setting the environment variable EFS_RESOLVE_TMO on the block to 0. +# This will eliminiate delays when trying to open files on not mounted +# volumes. +EFS_RESOLVE_TMO=0 diff --git a/erts/etc/ose/run_erl.c b/erts/etc/ose/run_erl.c new file mode 100644 index 0000000000..6bb59b7f7e --- /dev/null +++ b/erts/etc/ose/run_erl.c @@ -0,0 +1,663 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2013. 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: run_erl.c + * + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +/* System includes */ +#include <aio.h> +#include <errno.h> +#include <dirent.h> +#include <stdlib.h> +#include <string.h> +#include <stdio.h> +#include <sys/stat.h> +#include <unistd.h> + +/* OSE includes */ +#include "ose.h" +#include "ose_spi/ose_spi.h" +#include "efs.h" +#include "pm.h" +#include "ose_spi/fm.sig" + +/* erts includes */ +#include "run_erl.h" +#include "run_erl_common.h" +#include "safe_string.h" /* sn_printf, strn_cpy, strn_cat, etc */ + +typedef struct RunErlSetup_ { + SIGSELECT signo; + int run_daemon; + char *logdir; + char *command; + char *pipename; + char *blockname; +} RunErlSetup; + +typedef struct ProgramState_ { + /* child process */ + int ifd, ofd; + OSDOMAIN domain; + PROCESS progpid, mainbid; + struct PmProgramInfo *info; + /* to_erl */ + char w_pipe[FILENAME_BUFSIZ], + r_pipe[FILENAME_BUFSIZ]; +} ProgramState; + +union SIGNAL { + SIGSELECT signo; + RunErlSetup setup; + struct FmReadPtr fm_read_ptr; + struct FmWritePtr fm_write_ptr; +}; + +static OSBOOLEAN hunt_in_block(char *block_name, + char *process_name, + PROCESS *pid); +static int create_child_process(char *command_string, char *blockname, + ProgramState *state); + + +static OSBOOLEAN hunt_in_block(char *block_name, + char *process_name, + PROCESS *pid) { + struct OS_pid_list *list; + PROCESS block_id = OSE_ILLEGAL_PROCESS; + int i; + char *name; + + *pid = OSE_ILLEGAL_PROCESS; + + list = get_bid_list(0); + + if (!list) + return 0; + + for (i = 0; i < list->count; i++) { + + if (list->list[i] == get_bid(current_process())) + continue; + + name = (char*)get_pid_info(list->list[i], OSE_PI_NAME); + if (name) { + if (strcmp(name,block_name) == 0) { + block_id = list->list[i]; + free_buf((union SIGNAL**)&name); + break; + } + free_buf((union SIGNAL**)&name); + } + } + + free_buf((union SIGNAL**)&list); + + if (block_id == OSE_ILLEGAL_PROCESS) + return 0; + + list = get_pid_list(block_id); + + if (!list) + return 0; + + for (i = 0; i < list->count; i++) { + name = (char*)get_pid_info(list->list[i], OSE_PI_NAME); + if (name) { + if (strcmp(name,process_name) == 0) { + *pid = list->list[i]; + free_buf((union SIGNAL**)&name); + break; + } + free_buf((union SIGNAL**)&name); + } + } + + free_buf((union SIGNAL**)&list); + + if (*pid == OSE_ILLEGAL_PROCESS) + return 0; + + return 1; + +} + + +static int create_child_process(char *command_string, char *blockname, + ProgramState *state) { + char *command = command_string; + char *argv; + int i = 0; + int ret_status; + PmStatus pm_status; + int tmp_io[2]; + int fd_arr[3]; + int ifd[2], ofd[2]; + char *handle; + struct PmLoadModuleInfoReply *mod_info; + + /* Parse out cmd and argv from the command string */ + while (1) { + if (command[i] == ' ' || command[i] == '\0') { + if (command[i] == '\0') + argv = NULL; + else { + command[i] = '\0'; + argv = command_string + i + 1; + } + break; + } + i++; + } + + if (blockname) + handle = blockname; + else + handle = simple_basename(command); + + if (ose_pm_load_module_info(handle,&mod_info) == PM_SUCCESS) { + /* Already installed */ + free_buf((union SIGNAL**)&mod_info); + } else if ((pm_status = ose_pm_install_load_module(0,"ELF",command,handle,0,0,NULL)) + != PM_SUCCESS) { + ERROR1(LOG_ERR,"ose_pm_install_load_module failed - pmstatus: 0x%08x\n", + pm_status); + return 0; + } + + state->domain = PM_NEW_DOMAIN; + + pm_status = ose_pm_create_program(&state->domain, handle, 0, 0 , NULL, + &state->progpid, &state->mainbid); + + if (pm_status != PM_SUCCESS) { + if (pm_status == PM_EINSTALL_HANDLE_IN_USE) + ERROR1(LOG_ERR,"ose_pm_create_program failed - " + "install handle \"%s\" is in use. You can specify another " + "install handle by using the -block option to run_erl.\n",handle); + else + ERROR1(LOG_ERR,"ose_pm_create_program failed - pmstatus: 0x%08x\n", + pm_status); + return 0; + } + + pm_status = ose_pm_program_info(state->progpid, &state->info); + /* FIXME don't forget to free this ((union SIGNAL **)&info) */ + if (pm_status != PM_SUCCESS) { + ERROR1(LOG_ERR,"ose_pm_program_info failed - pmstatus: 0x%08x\n", + pm_status); + return 0; + } + + /* We only clone stdin+stdout, what about stderr? */ + + /* create pipes */ + if (pipe(ifd) < 0) { + if (errno == ENOENT) + ERRNO_ERR0(LOG_ERR,"The /pipe file system is not available\n"); + else + ERRNO_ERR0(LOG_ERR,"pipe ifd failed\n"); + return 0; + } + + if (pipe(ofd) < 0) { + ERRNO_ERR0(LOG_ERR,"pipe ofd failed\n"); + return 0; + } + + /* FIXME Lock? */ + + /* backup our stdin stdout */ + if ((tmp_io[0] = dup(0)) < 0) { + ERRNO_ERR0(LOG_ERR,"dup 0 failed\n"); + return 0; + } + + if ((tmp_io[1] = dup(1)) < 0) { + ERRNO_ERR0(LOG_ERR,"dup 1 failed\n"); + return 0; + } + + /* set new pipe to fd 0,1 */ + if (dup2(ifd[1], 1) < 0) { + ERRNO_ERR0(LOG_ERR,"dup2 1 failed\n"); + return 0; + } + + if (dup2(ofd[0], 0) < 0) { + ERRNO_ERR0(LOG_ERR,"dup2 0 failed\n"); + return 0; + } + + /* clone array to newly created */ + fd_arr[0] = 2; /* Number of fd's */ + fd_arr[1] = 0; + fd_arr[2] = 1; + + if ((ret_status = efs_clone_array(state->info->main_process, fd_arr)) + != EFS_SUCCESS) { + ERROR1(LOG_ERR,"efs_close_array filed, errcode: %d\n", ret_status); + return 0; + } + + if (dup2(tmp_io[1], 1) < 0) { + ERRNO_ERR0(LOG_ERR,"restoring dup2 1 failed\n"); + return 0; + } + + if (dup2(tmp_io[0], 0) < 0) { + ERRNO_ERR0(LOG_ERR,"restoring dup2 1 failed\n"); + return 0; + } + + /* close loose-ends */ + sf_close(tmp_io[0]); + sf_close(tmp_io[1]); + sf_close(ifd[1]); + sf_close(ofd[0]); + state->ifd = ifd[0]; + state->ofd = ofd[1]; + + if (argv && set_env(state->progpid, "ARGV", argv)) { + ERRNO_ERR0(LOG_ERR,"something went wrong with set_env\n"); + } + + /* + * Start the program. + */ + pm_status = ose_pm_start_program(state->progpid); + if (pm_status != PM_SUCCESS) { + ERROR1(LOG_ERR,"ose_pm_install_load_module failed - pmstatus: 0x%08x\n", + pm_status); + return 0; + } + + return 1; +} + +#define SET_AIO(REQ,FD,SIZE,BUFF) \ + /* Make sure to clean data structure of previous request */ \ + memset(&(REQ),0,sizeof(REQ)); \ + (REQ).aio_fildes = FD; \ + (REQ).aio_offset = FM_POSITION_CURRENT; \ + (REQ).aio_nbytes = SIZE; \ + (REQ).aio_buf = BUFF; \ + (REQ).aio_sigevent.sigev_notify = SIGEV_NONE + +#define READ_AIO(REQ,FD,SIZE,BUFF) do { \ + SET_AIO(REQ,FD,SIZE,BUFF); \ + if (aio_read(&(REQ)) != 0) \ + ERRNO_ERR1(LOG_ERR,"aio_read of child_read_req(%d) failed\n",FD); \ + } while (0) + +#define WRITE_AIO(FD,SIZE,BUFF) do { \ + struct aiocb *write_req = malloc(sizeof(struct aiocb)); \ + char *write_buff = malloc(sizeof(char)*SIZE); \ + memcpy(write_buff,BUFF,SIZE); \ + SET_AIO(*write_req,FD,SIZE,write_buff); \ + if (aio_write(write_req) != 0) \ + ERRNO_ERR1(LOG_ERR,"aio_write of write_req(%d) failed\n",FD); \ + } while(0) + +int pass_on(ProgramState *state); +int pass_on(ProgramState *s) { + SIGSELECT sigsel[] = {0,FM_READ_PTR_REPLY}; + union SIGNAL *sig; + char child_read_buff[BUFSIZ], pipe_read_buff[BUFSIZ]; + struct aiocb child_read_req, pipe_read_req; + int rfd, wfd = 0; + FmHandle rfh, child_rfh; + int outstanding_writes = 0, got_some = 0, child_done = 0; + + if ((rfd = sf_open(s->r_pipe, O_RDONLY, 0)) < 0) { + ERRNO_ERR1(LOG_ERR,"Could not open FIFO '%s' for reading.\n", s->r_pipe); + rfd = 0; + return 1; + } + + attach(NULL,s->progpid); + + /* Open the log file */ + erts_run_erl_log_open(); + + efs_examine_fd(rfd,FLIB_FD_HANDLE,&rfh); + efs_examine_fd(s->ifd,FLIB_FD_HANDLE,&child_rfh); + + READ_AIO(child_read_req,s->ifd,BUFSIZ,child_read_buff); + READ_AIO(pipe_read_req,rfd,BUFSIZ,pipe_read_buff); + + while (1) { + time_t now,last_activity; + + time(&last_activity); + sig = receive_w_tmo(erts_run_erl_log_alive_minutes()*60000,sigsel); + + time(&now); + + if (sig) { + erts_run_erl_log_activity(0,now,last_activity); + } else { + /* timeout */ + erts_run_erl_log_activity(1,now,last_activity); + continue; + } + + switch (sig->signo) { + case OS_ATTACH_SIG: { + if (rfd) { sf_close(rfd); rfd = 0; } + free_buf(&sig); + child_done = 1; + /* Make sure to to let all outstanding write request finish */ + if (outstanding_writes) + break; + if (wfd) sf_close(wfd); + return 0; + } + case FM_WRITE_PTR_REPLY: { + if (sig->fm_write_ptr.status == EFS_SUCCESS) { + if (sig->fm_write_ptr.actual < sig->fm_write_ptr.requested) { + WRITE_AIO(wfd, sig->fm_write_ptr.requested-sig->fm_write_ptr.actual, + sig->fm_write_ptr.buffer+sig->fm_write_ptr.actual); + } + } else { + /* Assume to_erl has terminated. */ + sf_close(wfd); + wfd = 0; + } + free((char*)sig->fm_write_ptr.buffer); + aio_dispatch(sig); + if ((--outstanding_writes == 0) && child_done) { + if (wfd) sf_close(wfd); + return 0; + } + break; + } + case FM_READ_PTR_REPLY: { + /* Child fd */ + if (sig->fm_read_ptr.handle == child_rfh) { + + /* Child terminated */ + if (sig->fm_read_ptr.status != EFS_SUCCESS || + sig->fm_read_ptr.actual == 0) { + + if (rfd) { sf_close(rfd); rfd = 0; } + + if (sig->fm_read_ptr.status != EFS_SUCCESS) { + ERROR0(LOG_ERR,"Erlang closed the connection."); + aio_dispatch(sig); + return 1; + } + + /* child closed connection gracefully */ + aio_dispatch(sig); + if (outstanding_writes) { + child_done = 1; + break; + } + + if (wfd) sf_close(wfd); + + return 0; + } else { + erts_run_erl_log_write(sig->fm_read_ptr.buffer, + sig->fm_read_ptr.actual); + if (wfd) { + WRITE_AIO(wfd, sig->fm_read_ptr.actual, sig->fm_read_ptr.buffer); + outstanding_writes++; + } + aio_dispatch(sig); + READ_AIO(child_read_req, s->ifd,BUFSIZ, child_read_buff); + } + /* pipe fd */ + } else if (sig->fm_read_ptr.handle == rfh) { + if (sig->fm_read_ptr.status != EFS_SUCCESS) { + if(rfd) sf_close(rfd); + if(wfd) sf_close(wfd); + aio_dispatch(sig); + ERRNO_ERR0(LOG_ERR,"Error in reading from FIFO."); + return 1; + } + if (sig->fm_read_ptr.actual == 0) { + /* to_erl closed its end of the pipe */ + aio_dispatch(sig); + sf_close(rfd); + rfd = sf_open(s->r_pipe,O_RDONLY|DONT_BLOCK_PLEASE, 0); + if (rfd < 0) { + ERRNO_ERR1(LOG_ERR,"Could not open FIFO '%s' for reading.", + s->r_pipe); + rfd = 0; + } else { + READ_AIO(pipe_read_req,rfd,BUFSIZ,pipe_read_buff); + } + got_some = 0; /* reset for next session */ + } else { + int len = sig->fm_read_ptr.actual; + char *buffer = sig->fm_read_ptr.buffer; + if (!wfd) { + /* Try to open the write pipe to to_erl. Now that we got some data + * from to_erl, to_erl should already be reading this pipe - open + * should succeed. But in case of error, we just ignore it. + */ + if ((wfd = sf_open(s->w_pipe, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) { + erts_run_erl_log_status("Client expected on FIFO %s, " + "but can't open (len=%d)\n", + s->w_pipe, sig->fm_read_ptr.actual); + sf_close(rfd); + rfd = sf_open(s->r_pipe, O_RDONLY|DONT_BLOCK_PLEASE, 0); + if (rfd < 0) { + ERRNO_ERR1(LOG_ERR,"Could not open FIFO '%s' for reading.", + s->r_pipe); + return 1; + } + wfd = 0; + } else { +#ifdef DEBUG + erts_run_erl_log_status("run_erl: %s opened for writing\n", + s->w_pipe); +#endif + } + } + + if (!got_some && wfd && buffer[0] == '\014') { + char wbuf[30]; + int wlen = sn_printf(wbuf,sizeof(wbuf),"[run_erl v%u-%u]\n", + RUN_ERL_HI_VER, RUN_ERL_LO_VER); + /* For some reason this, the first write aio seems to + not get an FM_WRITE_PTR_REPLY, so we do not do: + outstanding_writes++; + */ + WRITE_AIO(wfd, wlen, wbuf); + } + got_some = 1; + + /* Write the message */ +#ifdef DEBUG + erts_run_erl_log_status("Pty master write; "); +#endif + len = erts_run_erl_extract_ctrl_seq(buffer,len); + + if (len > 0) { + int wlen = erts_run_erl_write_all(s->ofd, buffer, len); + if (wlen != len) { + aio_dispatch(sig); + ERRNO_ERR0(LOG_ERR,"Error in writing to terminal."); + if(rfd) sf_close(rfd); + if(wfd) sf_close(wfd); + return 1; + } + } +#ifdef DEBUG + erts_run_erl_log_status("OK\n"); +#endif + aio_dispatch(sig); + READ_AIO(pipe_read_req,rfd,BUFSIZ,pipe_read_buff); + } + } + break; + } + default: { + free_buf(&sig); + break; + } + } + } +} + +OS_PROCESS(run_erl_process) { + char *logdir, *command, *blockname; + SIGSELECT sigsel[] = {1,ERTS_SIGNAL_RUN_ERL_SETUP}; + union SIGNAL *sig = receive(sigsel); + ProgramState state; + char pipename[FILENAME_BUFSIZ]; + + state.info = NULL; + + logdir = strdup(sig->setup.logdir); + command = strdup(sig->setup.command); + strn_cpy(pipename,sizeof(pipename),sig->setup.pipename); + + if (sig->setup.blockname) + blockname = strdup(sig->setup.blockname); + else + blockname = NULL; + + erts_run_erl_log_init(sig->setup.run_daemon, logdir); + + free_buf(&sig); + + if (erts_run_erl_open_fifo(pipename,state.w_pipe,state.r_pipe)) + kill_proc(current_process()); + + if (create_child_process(command,blockname,&state)) + pass_on(&state); + + free(logdir); + free(command); + if (blockname) + free(blockname); + + if (state.info) + free_buf(((union SIGNAL**)&state.info)); + + sf_close(state.ifd); + sf_close(state.ofd); + + unlink(state.w_pipe); + unlink(state.r_pipe); + + kill_proc(current_process()); +} + +int run_erl(int argc,char **argv) { + char *pipename, *logdir, *command, *blockname = NULL; + int pipename_len, logdir_len, command_len, blockname_len = 0; + int i = 1, run_daemon = 0; + PROCESS pid; + SIGSELECT sigsel[] = {0}; + union SIGNAL *sig; + + if(argc < 4) { + fprintf(stderr,RUN_ERL_USAGE,"run_erl"); + return 1; + } + + while (1) { + if (argv[i][0] != '-') + break; + if (!strcmp(argv[i],"-daemon")) { + run_daemon = 1; + i++; + continue; + } + if (!strcmp(argv[i],"-block")) { + blockname = argv[i+1]; + blockname_len = strlen(argv[i+1]) + 1; + i+=2; + continue; + } + fprintf(stderr,RUN_ERL_USAGE,"run_erl"); + return 1; + } + + pipename = argv[i++]; + logdir = argv[i++]; + command = argv[i++]; + + /* + 1 to include NULL at end */ + logdir_len = strlen(logdir) + 1; + command_len = strlen(command) + 1; + pipename_len = strlen(pipename) + 1; + + if (run_daemon) { + /* We request that the run_erl_process should be started from the + main process so that it does not die when the shell command + returns */ + PROCESS main_pid; + hunt_in_block("run_erl","main",&main_pid); + sig = alloc(sizeof(sig),ERTS_SIGNAL_RUN_ERL_DAEMON); + send(&sig,main_pid); + sig = receive(sigsel); + pid = sender(&sig); + free_buf(&sig); + } else { + pid = create_process(OS_BG_PROC,"run_erl_process", + run_erl_process, 0x800, + 0, 0, 0, NULL, 0, 0); + } + + sig = alloc(sizeof(RunErlSetup)+ + logdir_len+command_len+pipename_len+blockname_len, + ERTS_SIGNAL_RUN_ERL_SETUP); + sig->setup.run_daemon = run_daemon; + sig->setup.logdir = ((char*)sig)+sizeof(RunErlSetup); + sig->setup.command = ((char*)sig)+sizeof(RunErlSetup)+logdir_len; + sig->setup.pipename = ((char*)sig)+sizeof(RunErlSetup)+logdir_len+command_len; + if (blockname) + sig->setup.blockname = ((char*)sig)+sizeof(RunErlSetup)+ + logdir_len+command_len+pipename_len; + else + sig->setup.blockname = NULL; + + strcpy(sig->setup.logdir,logdir); + strcpy(sig->setup.command,command); + strcpy(sig->setup.pipename,pipename); + if (blockname) strcpy(sig->setup.blockname,blockname); + + send(&sig,pid); + + if (run_daemon) { + /* We are a daemon, error msgs will be sent to ramlog */ + start(pid); + return 1; + } + + /* We are not daemon, error msgs will be sent to stderr and we block here */ + efs_clone(pid); + start(pid); + + attach(NULL,pid); + sig = receive(sigsel); + + return 1; +} diff --git a/erts/etc/ose/run_erl.h b/erts/etc/ose/run_erl.h new file mode 100644 index 0000000000..128f551670 --- /dev/null +++ b/erts/etc/ose/run_erl.h @@ -0,0 +1,29 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2013. 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% + */ +#ifndef ERL_RUN_ERL_H +#define ERL_RUN_ERL_H + +#include "ose.h" + +#include "erts.sig" + +int run_erl(int argc, char **argv); +OS_PROCESS(run_erl_process); + +#endif diff --git a/erts/etc/ose/run_erl_main.c b/erts/etc/ose/run_erl_main.c new file mode 100644 index 0000000000..2d92924ff2 --- /dev/null +++ b/erts/etc/ose/run_erl_main.c @@ -0,0 +1,79 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2013. 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: run_erl_main.c + * + * Container for load module that installs both run_erl and to_erl command. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include <stdio.h> + +#include "ose.h" +#include "shell.h" + +#include "run_erl_common.h" +#include "run_erl.h" +#include "to_erl_common.h" + +union SIGNAL { + SIGSELECT signo; +}; + +int main(int argc, char **argv) +{ + + char run_erl_usage[320], + to_erl_usage[120]; + + (void)stdin;(void)stdout;(void)stderr; + + sprintf(run_erl_usage,RUN_ERL_USAGE,"run_erl [-daemon] [-block blockname]"); + sprintf(to_erl_usage,TO_ERL_USAGE,"pipename"); + + shell_add_cmd_attrs( + "run_erl",run_erl_usage, + "Redirect Erlang input and output streams", + run_erl,DEFAULT_PROC_TYPE,DEFAULT_PRIORITY,DEFAULT_STACK_SIZE); + + shell_add_cmd_attrs( + "to_erl",to_erl_usage, + "Attach to redirected Erlang input and output streams", + to_erl,DEFAULT_PROC_TYPE,DEFAULT_PRIORITY,DEFAULT_STACK_SIZE); + + while (1) { + static const SIGSELECT sigsel[] = {0}; + union SIGNAL *sig = receive(sigsel); + + if (sig->signo == ERTS_SIGNAL_RUN_ERL_DAEMON) { + PROCESS pid = create_process(OS_BG_PROC,"run_erl_daemon", + run_erl_process, 0x800, + 0, 0, 0, NULL, 0, 0); + send_w_s(&sig,pid,sender(&sig)); + } else { + printf("Got unexpected signal!"); + free_buf(&sig); + } + } + + return 1; +} diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in index 8520d58f47..9e39764195 100644 --- a/erts/etc/unix/etp-commands.in +++ b/erts/etc/unix/etp-commands.in @@ -3133,6 +3133,24 @@ document etp-ets-tabledump %--------------------------------------------------------------------------- end + +############################################################################ +# OSE support +# +define etp-ose-attach + target ose $arg0:21768 + attach block start_beam start_beam +end + +document etp-ose-attach +%--------------------------------------------------------------------------- +% etp-ose-attach Host +% +% Connect and attach to erlang vm at Host. +%--------------------------------------------------------------------------- +end + + ############################################################################ # Erlang support module handling # diff --git a/erts/etc/unix/run_erl.c b/erts/etc/unix/run_erl.c index 2018bc007c..a6fc4c2bf5 100644 --- a/erts/etc/unix/run_erl.c +++ b/erts/etc/unix/run_erl.c @@ -79,81 +79,25 @@ # include <stropts.h> #endif -#include "run_erl.h" +#include "run_erl_common.h" #include "safe_string.h" /* sn_printf, strn_cpy, strn_cat, etc */ -#ifdef O_NONBLOCK -# define DONT_BLOCK_PLEASE O_NONBLOCK -#else -# define DONT_BLOCK_PLEASE O_NDELAY -# ifndef EAGAIN -# define EAGAIN -3898734 -# endif -#endif - -#define noDEBUG - -#define DEFAULT_LOG_GENERATIONS 5 -#define LOG_MAX_GENERATIONS 1000 /* No more than 1000 log files */ -#define LOG_MIN_GENERATIONS 2 /* At least two to switch between */ -#define DEFAULT_LOG_MAXSIZE 100000 -#define LOG_MIN_MAXSIZE 1000 /* Smallast value for changing log file */ -#define LOG_STUBNAME "erlang.log." -#define LOG_PERM 0664 -#define DEFAULT_LOG_ACTIVITY_MINUTES 5 -#define DEFAULT_LOG_ALIVE_MINUTES 15 -#define DEFAULT_LOG_ALIVE_FORMAT "%a %b %e %T %Z %Y" -#define ALIVE_BUFFSIZ 256 - -#define PERM 0600 -#define STATUSFILENAME "/run_erl.log" -#define PIPE_STUBNAME "erlang.pipe" -#define PIPE_STUBLEN strlen(PIPE_STUBNAME) - -#ifndef FILENAME_MAX -#define FILENAME_MAX 250 -#endif - -#ifndef O_SYNC -#define O_SYNC 0 -#define USE_FSYNC 1 -#endif - #define MAX(x,y) ((x) > (y) ? (x) : (y)) -#define FILENAME_BUFSIZ FILENAME_MAX - /* prototypes */ static void usage(char *); -static int create_fifo(char *name, int perm); static int open_pty_master(char **name, int *sfd); static int open_pty_slave(char *name); static void pass_on(pid_t); static void exec_shell(char **); -static void status(const char *format,...); -static void error_logf(int priority, int line, const char *format,...); static void catch_sigchild(int); -static int next_log(int log_num); -static int prev_log(int log_num); -static int find_next_log_num(void); -static int open_log(int log_num, int flags); -static void write_to_log(int* lfd, int* log_num, char* buf, int len); static void daemon_init(void); -static char *simple_basename(char *path); static void init_outbuf(void); static int outbuf_size(void); static void clear_outbuf(void); static char* outbuf_first(void); static void outbuf_delete(int bytes); static void outbuf_append(const char* bytes, int n); -static int write_all(int fd, const char* buf, int len); -static int extract_ctrl_seq(char* buf, int len); -static void set_window_size(unsigned col, unsigned row); - -static ssize_t sf_write(int fd, const void *buffer, size_t len); -static ssize_t sf_read(int fd, void *buffer, size_t len); -static int sf_open(const char *path, int flags, mode_t mode); -static int sf_close(int fd); #ifdef DEBUG static void show_terminal_settings(struct termios *t); @@ -161,20 +105,11 @@ static void show_terminal_settings(struct termios *t); /* static data */ static char fifo1[FILENAME_BUFSIZ], fifo2[FILENAME_BUFSIZ]; -static char statusfile[FILENAME_BUFSIZ]; -static char log_dir[FILENAME_BUFSIZ]; static char pipename[FILENAME_BUFSIZ]; static FILE *stdstatus = NULL; -static int log_generations = DEFAULT_LOG_GENERATIONS; -static int log_maxsize = DEFAULT_LOG_MAXSIZE; -static int log_alive_minutes = DEFAULT_LOG_ALIVE_MINUTES; -static int log_activity_minutes = DEFAULT_LOG_ACTIVITY_MINUTES; -static int log_alive_in_gmt = 0; -static char log_alive_format[ALIVE_BUFFSIZ+1]; static int run_daemon = 0; static char *program_name; static int mfd; /* master pty fd */ -static unsigned protocol_ver = RUN_ERL_LO_VER; /* assume lowest to begin with */ /* * Output buffer. @@ -205,29 +140,13 @@ static char* outbuf_in; LOG_PID|LOG_CONS|LOG_NOWAIT,LOG_USER) #endif -#define ERROR0(Prio,Format) error_logf(Prio,__LINE__,Format"\n") -#define ERROR1(Prio,Format,A1) error_logf(Prio,__LINE__,Format"\n",A1) -#define ERROR2(Prio,Format,A1,A2) error_logf(Prio,__LINE__,Format"\n",A1,A2) - -#ifdef HAVE_STRERROR -# define ADD_ERRNO(Format) "errno=%d '%s'\n"Format"\n",errno,strerror(errno) -#else -# define ADD_ERRNO(Format) "errno=%d\n"Format"\n",errno -#endif -#define ERRNO_ERR0(Prio,Format) error_logf(Prio,__LINE__,ADD_ERRNO(Format)) -#define ERRNO_ERR1(Prio,Format,A1) error_logf(Prio,__LINE__,ADD_ERRNO(Format),A1) - - int main(int argc, char **argv) { int childpid; int sfd = -1; - int fd; - char *p, *ptyslave=NULL; + char *ptyslave=NULL; int i = 1; int off_argv; - int calculated_pipename = 0; - int highest_pipe_num = 0; program_name = argv[0]; @@ -245,122 +164,16 @@ int main(int argc, char **argv) off_argv = i; strn_cpy(pipename, sizeof(pipename), argv[i++]); - strn_cpy(log_dir, sizeof(log_dir), argv[i]); - strn_cpy(statusfile, sizeof(statusfile), log_dir); - strn_cat(statusfile, sizeof(statusfile), STATUSFILENAME); + + erts_run_erl_log_init(run_daemon,argv[i]); #ifdef DEBUG - status("%s: pid is : %d\n", argv[0], getpid()); + erts_run_erl_log_status("%s: pid is : %d\n", argv[0], getpid()); #endif - /* Get values for LOG file handling from the environment */ - if ((p = getenv("RUN_ERL_LOG_ALIVE_MINUTES"))) { - log_alive_minutes = atoi(p); - if (!log_alive_minutes) { - ERROR1(LOG_ERR,"Minimum value for RUN_ERL_LOG_ALIVE_MINUTES is 1 " - "(current value is %s)",p); - } - log_activity_minutes = log_alive_minutes / 3; - if (!log_activity_minutes) { - ++log_activity_minutes; - } - } - if ((p = getenv("RUN_ERL_LOG_ACTIVITY_MINUTES"))) { - log_activity_minutes = atoi(p); - if (!log_activity_minutes) { - ERROR1(LOG_ERR,"Minimum value for RUN_ERL_LOG_ACTIVITY_MINUTES is 1 " - "(current value is %s)",p); - } - } - if ((p = getenv("RUN_ERL_LOG_ALIVE_FORMAT"))) { - if (strlen(p) > ALIVE_BUFFSIZ) { - ERROR1(LOG_ERR, "RUN_ERL_LOG_ALIVE_FORMAT can contain a maximum of " - "%d characters", ALIVE_BUFFSIZ); - } - strn_cpy(log_alive_format, sizeof(log_alive_format), p); - } else { - strn_cpy(log_alive_format, sizeof(log_alive_format), DEFAULT_LOG_ALIVE_FORMAT); - } - if ((p = getenv("RUN_ERL_LOG_ALIVE_IN_UTC")) && strcmp(p,"0")) { - ++log_alive_in_gmt; - } - if ((p = getenv("RUN_ERL_LOG_GENERATIONS"))) { - log_generations = atoi(p); - if (log_generations < LOG_MIN_GENERATIONS) - ERROR1(LOG_ERR,"Minimum RUN_ERL_LOG_GENERATIONS is %d", LOG_MIN_GENERATIONS); - if (log_generations > LOG_MAX_GENERATIONS) - ERROR1(LOG_ERR,"Maximum RUN_ERL_LOG_GENERATIONS is %d", LOG_MAX_GENERATIONS); - } - - if ((p = getenv("RUN_ERL_LOG_MAXSIZE"))) { - log_maxsize = atoi(p); - if (log_maxsize < LOG_MIN_MAXSIZE) - ERROR1(LOG_ERR,"Minimum RUN_ERL_LOG_MAXSIZE is %d", LOG_MIN_MAXSIZE); - } - - /* - * Create FIFOs and open them - */ - - if(*pipename && pipename[strlen(pipename)-1] == '/') { - /* The user wishes us to find a unique pipe name in the specified */ - /* directory */ - DIR *dirp; - struct dirent *direntp; - - calculated_pipename = 1; - dirp = opendir(pipename); - if(!dirp) { - ERRNO_ERR1(LOG_ERR,"Can't access pipe directory '%s'.", pipename); - exit(1); - } - - /* Check the directory for existing pipes */ - - while((direntp=readdir(dirp)) != NULL) { - if(strncmp(direntp->d_name,PIPE_STUBNAME,PIPE_STUBLEN)==0) { - int num = atoi(direntp->d_name+PIPE_STUBLEN+1); - if(num > highest_pipe_num) - highest_pipe_num = num; - } - } - closedir(dirp); - strn_catf(pipename, sizeof(pipename), "%s.%d", - PIPE_STUBNAME, highest_pipe_num+1); - } /* if */ - - for(;;) { - /* write FIFO - is read FIFO for `to_erl' program */ - strn_cpy(fifo1, sizeof(fifo1), pipename); - strn_cat(fifo1, sizeof(fifo1), ".r"); - if (create_fifo(fifo1, PERM) < 0) { - ERRNO_ERR1(LOG_ERR,"Cannot create FIFO %s for writing.", fifo1); - exit(1); - } - - /* read FIFO - is write FIFO for `to_erl' program */ - strn_cpy(fifo2, sizeof(fifo2), pipename); - strn_cat(fifo2, sizeof(fifo2), ".w"); - - /* Check that nobody is running run_erl already */ - if ((fd = sf_open(fifo2, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) { - /* Open as client succeeded -- run_erl is already running! */ - sf_close(fd); - if (calculated_pipename) { - ++highest_pipe_num; - strn_catf(pipename, sizeof(pipename), "%s.%d", - PIPE_STUBNAME, highest_pipe_num+1); - continue; - } - fprintf(stderr, "Erlang already running on pipe %s.\n", pipename); - exit(1); - } - if (create_fifo(fifo2, PERM) < 0) { - ERRNO_ERR1(LOG_ERR,"Cannot create FIFO %s for reading.", fifo2); - exit(1); - } - break; - } + /* Open read and write fifo */ + if (erts_run_erl_open_fifo(pipename,fifo1,fifo2)) + exit(1); /* * Open master pseudo-terminal @@ -432,7 +245,7 @@ int main(int argc, char **argv) sf_close(2); if (dup(sfd) != 0 || dup(sfd) != 1 || dup(sfd) != 2) { - status("Cannot dup\n"); + erts_run_erl_log_status("Cannot dup\n"); } sf_close(sfd); exec_shell(argv+off_argv); /* exec_shell expects argv[2] to be */ @@ -475,9 +288,7 @@ static void pass_on(pid_t childpid) struct timeval timeout; time_t last_activity; char buf[BUFSIZ]; - char log_alive_buffer[ALIVE_BUFFSIZ+1]; - int lognum; - int rfd, wfd=0, lfd=0; + int rfd, wfd=0; int maxfd; int ready; int got_some = 0; /* from to_erl */ @@ -492,13 +303,12 @@ static void pass_on(pid_t childpid) } #ifdef DEBUG - status("run_erl: %s opened for reading\n", fifo2); + erts_run_erl_log_status("run_erl: %s opened for reading\n", fifo2); #endif /* Open the log file */ - lognum = find_next_log_num(); - lfd = open_log(lognum, O_RDWR|O_APPEND|O_CREAT|O_SYNC); + erts_run_erl_log_open(); /* Enter the work loop */ @@ -517,7 +327,8 @@ static void pass_on(pid_t childpid) writefds_ptr = &writefds; } time(&last_activity); - timeout.tv_sec = log_alive_minutes*60; /* don't assume old BSD bug */ + /* don't assume old BSD bug */ + timeout.tv_sec = erts_run_erl_log_alive_minutes()*60; timeout.tv_usec = 0; ready = select(maxfd + 1, &readfds, writefds_ptr, NULL, &timeout); if (ready < 0) { @@ -547,28 +358,7 @@ static void pass_on(pid_t childpid) /* Check how long time we've been inactive */ time(&now); - if(!ready || now - last_activity > log_activity_minutes*60) { - /* Either a time out: 15 minutes without action, */ - /* or something is coming in right now, but it's a long time */ - /* since last time, so let's write a time stamp this message */ - struct tm *tmptr; - if (log_alive_in_gmt) { - tmptr = gmtime(&now); - } else { - tmptr = localtime(&now); - } - if (!strftime(log_alive_buffer, ALIVE_BUFFSIZ, log_alive_format, - tmptr)) { - strn_cpy(log_alive_buffer, sizeof(log_alive_buffer), - "(could not format time in 256 positions " - "with current format string.)"); - } - log_alive_buffer[ALIVE_BUFFSIZ] = '\0'; - - sn_printf(buf, sizeof(buf), "\n===== %s%s\n", - ready?"":"ALIVE ", log_alive_buffer); - write_to_log(&lfd, &lognum, buf, strlen(buf)); - } + erts_run_erl_log_activity(!ready,now,last_activity); } /* @@ -603,7 +393,7 @@ static void pass_on(pid_t childpid) */ if (FD_ISSET(mfd, &readfds)) { #ifdef DEBUG - status("Pty master read; "); + erts_run_erl_log_status("Pty master read; "); #endif if ((len = sf_read(mfd, buf, BUFSIZ)) <= 0) { sf_close(rfd); @@ -621,7 +411,7 @@ static void pass_on(pid_t childpid) exit(0); } - write_to_log(&lfd, &lognum, buf, len); + erts_run_erl_log_write(buf, len); /* * Save in the output queue. @@ -637,7 +427,7 @@ static void pass_on(pid_t childpid) */ if (FD_ISSET(rfd, &readfds)) { #ifdef DEBUG - status("FIFO read; "); + erts_run_erl_log_status("FIFO read; "); #endif if ((len = sf_read(rfd, buf, BUFSIZ)) < 0) { sf_close(rfd); @@ -666,7 +456,7 @@ static void pass_on(pid_t childpid) * should succeed. But in case of error, we just ignore it. */ if ((wfd = sf_open(fifo1, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) { - status("Client expected on FIFO %s, but can't open (len=%d)\n", + erts_run_erl_log_status("Client expected on FIFO %s, but can't open (len=%d)\n", fifo1, len); sf_close(rfd); rfd = sf_open(fifo2, O_RDONLY|DONT_BLOCK_PLEASE, 0); @@ -678,7 +468,7 @@ static void pass_on(pid_t childpid) } else { #ifdef DEBUG - status("run_erl: %s opened for writing\n", fifo1); + erts_run_erl_log_status("run_erl: %s opened for writing\n", fifo1); #endif } } @@ -694,14 +484,15 @@ static void pass_on(pid_t childpid) /* Write the message */ #ifdef DEBUG - status("Pty master write; "); + erts_run_erl_log_status("Pty master write; "); #endif - len = extract_ctrl_seq(buf, len); + len = erts_run_erl_extract_ctrl_seq(buf, len); if(len==1 && buf[0] == '\003') { kill(childpid,SIGINT); - } - else if (len>0 && write_all(mfd, buf, len) != len) { + } + else if (len>0 && erts_run_erl_write_all(mfd, buf, len) != len) + { ERRNO_ERR0(LOG_ERR,"Error in writing to terminal."); sf_close(rfd); if(wfd) sf_close(wfd); @@ -710,7 +501,7 @@ static void pass_on(pid_t childpid) } } #ifdef DEBUG - status("OK\n"); + erts_run_erl_log_status("OK\n"); #endif } } @@ -720,173 +511,6 @@ static void catch_sigchild(int sig) { } -/* - * next_log: - * Returns the index number that follows the given index number. - * (Wrapping after log_generations) - */ -static int next_log(int log_num) { - return log_num>=log_generations?1:log_num+1; -} - -/* - * prev_log: - * Returns the index number that precedes the given index number. - * (Wrapping after log_generations) - */ -static int prev_log(int log_num) { - return log_num<=1?log_generations:log_num-1; -} - -/* - * find_next_log_num() - * Searches through the log directory to check which logs that already - * exist. It finds the "hole" in the sequence, and returns the index - * number for the last log in the log sequence. If there is no hole, index - * 1 is returned. - */ -static int find_next_log_num(void) { - int i, next_gen, log_gen; - DIR *dirp; - struct dirent *direntp; - int log_exists[LOG_MAX_GENERATIONS+1]; - int stub_len = strlen(LOG_STUBNAME); - - /* Initialize exiting log table */ - - for(i=log_generations; i>=0; i--) - log_exists[i] = 0; - dirp = opendir(log_dir); - if(!dirp) { - ERRNO_ERR1(LOG_ERR,"Can't access log directory '%s'", log_dir); - exit(1); - } - - /* Check the directory for existing logs */ - - while((direntp=readdir(dirp)) != NULL) { - if(strncmp(direntp->d_name,LOG_STUBNAME,stub_len)==0) { - int num = atoi(direntp->d_name+stub_len); - if(num < 1 || num > log_generations) - continue; - log_exists[num] = 1; - } - } - closedir(dirp); - - /* Find out the next available log file number */ - - next_gen = 0; - for(i=log_generations; i>=0; i--) { - if(log_exists[i]) - if(next_gen) - break; - else - ; - else - next_gen = i; - } - - /* Find out the current log file number */ - - if(next_gen) - log_gen = prev_log(next_gen); - else - log_gen = 1; - - return log_gen; -} /* find_next_log_num() */ - -/* open_log() - * Opens a log file (with given index) for writing. Writing may be - * at the end or a trucnating write, according to flags. - * A LOGGING STARTED and time stamp message is inserted into the log file - */ -static int open_log(int log_num, int flags) -{ - char buf[FILENAME_MAX]; - time_t now; - struct tm *tmptr; - char log_buffer[ALIVE_BUFFSIZ+1]; - int lfd; - - /* Remove the next log (to keep a "hole" in the log sequence) */ - sn_printf(buf, sizeof(buf), "%s/%s%d", - log_dir, LOG_STUBNAME, next_log(log_num)); - unlink(buf); - - /* Create or continue on the current log file */ - sn_printf(buf, sizeof(buf), "%s/%s%d", log_dir, LOG_STUBNAME, log_num); - if((lfd = sf_open(buf, flags, LOG_PERM))<0){ - ERRNO_ERR1(LOG_ERR,"Can't open log file '%s'.", buf); - exit(1); - } - - /* Write a LOGGING STARTED and time stamp into the log file */ - time(&now); - if (log_alive_in_gmt) { - tmptr = gmtime(&now); - } else { - tmptr = localtime(&now); - } - if (!strftime(log_buffer, ALIVE_BUFFSIZ, log_alive_format, - tmptr)) { - strn_cpy(log_buffer, sizeof(log_buffer), - "(could not format time in 256 positions " - "with current format string.)"); - } - log_buffer[ALIVE_BUFFSIZ] = '\0'; - - sn_printf(buf, sizeof(buf), "\n=====\n===== LOGGING STARTED %s\n=====\n", - log_buffer); - if (write_all(lfd, buf, strlen(buf)) < 0) - status("Error in writing to log.\n"); - -#if USE_FSYNC - fsync(lfd); -#endif - - return lfd; -} - -/* write_to_log() - * Writes a message to a log file. If the current log file is full, - * a new log file is opened. - */ -static void write_to_log(int* lfd, int* log_num, char* buf, int len) -{ - int size; - - /* Decide if new logfile needed, and open if so */ - - size = lseek(*lfd,0,SEEK_END); - if(size+len > log_maxsize) { - sf_close(*lfd); - *log_num = next_log(*log_num); - *lfd = open_log(*log_num, O_RDWR|O_CREAT|O_TRUNC|O_SYNC); - } - - /* Write to log file */ - - if (write_all(*lfd, buf, len) < 0) { - status("Error in writing to log.\n"); - } - -#if USE_FSYNC - fsync(*lfd); -#endif -} - -/* create_fifo() - * Creates a new fifo with the given name and permission. - */ -static int create_fifo(char *name, int perm) -{ - if ((mkfifo(name, perm) < 0) && (errno != EEXIST)) - return -1; - return 0; -} - /* open_pty_master() * Find a master device, open and return fd and slave device name. @@ -1083,9 +707,9 @@ static void exec_shell(char **argv) else argv[0] = sh; argv[1] = "-c"; - status("Args before exec of shell:\n"); + erts_run_erl_log_status("Args before exec of shell:\n"); for (vp = argv, i = 0; *vp; vp++, i++) - status("argv[%d] = %s\n", i, *vp); + erts_run_erl_log_status("argv[%d] = %s\n", i, *vp); if (stdstatus) { fclose(stdstatus); } @@ -1096,26 +720,6 @@ static void exec_shell(char **argv) ERRNO_ERR0(LOG_ERR,"Could not execv"); } -/* status() - * Prints the arguments to a status file - * Works like printf (see vfrpintf) - */ -static void status(const char *format,...) -{ - va_list args; - time_t now; - - if (stdstatus == NULL) - stdstatus = fopen(statusfile, "w"); - if (stdstatus == NULL) - return; - now = time(NULL); - fprintf(stdstatus, "run_erl [%d] %s", (int)getpid(), ctime(&now)); - va_start(args, format); - vfprintf(stdstatus, format, args); - va_end(args); - fflush(stdstatus); -} static void daemon_init(void) /* As R Stevens wants it, to a certain extent anyway... */ @@ -1155,47 +759,10 @@ static void daemon_init(void) run_daemon = 1; } -/* error_logf() - * Prints the arguments to stderr or syslog - * Works like printf (see vfprintf) - */ -static void error_logf(int priority, int line, const char *format, ...) -{ - va_list args; - va_start(args, format); - -#ifdef HAVE_SYSLOG_H - if (run_daemon) { - vsyslog(priority,format,args); - } - else -#endif - { - time_t now = time(NULL); - fprintf(stderr, "run_erl:%d [%d] %s", line, (int)getpid(), ctime(&now)); - vfprintf(stderr, format, args); - } - va_end(args); -} - static void usage(char *pname) { - fprintf(stderr, "Usage: %s (pipe_name|pipe_dir/) log_dir \"command [parameters ...]\"\n", pname); - fprintf(stderr, "\nYou may also set the environment variables RUN_ERL_LOG_GENERATIONS\n"); - fprintf(stderr, "and RUN_ERL_LOG_MAXSIZE to the number of log files to use and the\n"); - fprintf(stderr, "size of the log file when to switch to the next log file\n"); -} - -/* Instead of making sure basename exists, we do our own */ -static char *simple_basename(char *path) -{ - char *ptr; - for (ptr = path; *ptr != '\0'; ++ptr) { - if (*ptr == '/') { - path = ptr + 1; - } - } - return path; + fprintf(stderr, "Usage: "); + fprintf(stderr, RUN_ERL_USAGE, pname); } static void init_outbuf(void) @@ -1266,114 +833,6 @@ static void outbuf_append(const char* buf, int n) outbuf_in += n; } -/* Call write() until entire buffer has been written or error. - * Return len or -1. - */ -static int write_all(int fd, const char* buf, int len) -{ - int left = len; - int written; - for (;;) { - written = sf_write(fd,buf,left); - if (written == left) { - return len; - } - if (written < 0) { - return -1; - } - left -= written; - buf += written; - } -} - -static ssize_t sf_read(int fd, void *buffer, size_t len) { - ssize_t n = 0; - - do { n = read(fd, buffer, len); } while (n < 0 && errno == EINTR); - - return n; -} - -static ssize_t sf_write(int fd, const void *buffer, size_t len) { - ssize_t n = 0; - - do { n = write(fd, buffer, len); } while (n < 0 && errno == EINTR); - - return n; -} - -static int sf_open(const char *path, int type, mode_t mode) { - int fd = 0; - - do { fd = open(path, type, mode); } while(fd < 0 && errno == EINTR); - - return fd; -} -static int sf_close(int fd) { - int res = 0; - - do { res = close(fd); } while(fd < 0 && errno == EINTR); - - return res; -} -/* Extract any control sequences that are ment only for run_erl - * and should not be forwarded to the pty. - */ -static int extract_ctrl_seq(char* buf, int len) -{ - static const char prefix[] = "\033_"; - static const char suffix[] = "\033\\"; - char* bufend = buf + len; - char* start = buf; - char* command; - char* end; - - for (;;) { - start = find_str(start, bufend-start, prefix); - if (!start) break; - - command = start + strlen(prefix); - end = find_str(command, bufend-command, suffix); - if (end) { - unsigned col, row; - if (sscanf(command,"version=%u", &protocol_ver)==1) { - /*fprintf(stderr,"to_erl v%u\n", protocol_ver);*/ - } - else if (sscanf(command,"winsize=%u,%u", &col, &row)==2) { - set_window_size(col,row); - } - else { - ERROR2(LOG_ERR, "Ignoring unknown ctrl command '%.*s'\n", - (int)(end-command), command); - } - - /* Remove ctrl sequence from buf */ - end += strlen(suffix); - memmove(start, end, bufend-end); - bufend -= end - start; - } - else { - ERROR2(LOG_ERR, "Missing suffix in ctrl sequence '%.*s'\n", - (int)(bufend-start), start); - break; - } - } - return bufend - buf; -} - -static void set_window_size(unsigned col, unsigned row) -{ -#ifdef TIOCSWINSZ - struct winsize ws; - ws.ws_col = col; - ws.ws_row = row; - if (ioctl(mfd, TIOCSWINSZ, &ws) < 0) { - ERRNO_ERR0(LOG_ERR,"Failed to set window size"); - } -#endif -} - - #ifdef DEBUG #define S(x) ((x) > 0 ? 1 : 0) diff --git a/erts/etc/unix/to_erl.c b/erts/etc/unix/to_erl.c index b9e397cbf2..38a94ed9c3 100644 --- a/erts/etc/unix/to_erl.c +++ b/erts/etc/unix/to_erl.c @@ -16,592 +16,9 @@ * * %CopyrightEnd% */ -/* - * Module: to_erl.c - * - * This module implements a process that opens two specified FIFOs, one - * for reading and one for writing; reads from its stdin, and writes what - * it has read to the write FIF0; reads from the read FIFO, and writes to - * its stdout. - * - ________ _________ - | |--<-- pipe.r (fifo1) --<--| | - | to_erl | | run_erl | (parent) - |________|-->-- pipe.w (fifo2) -->--|_________| - ^ master pty - | - | slave pty - ____V____ - | | - | "erl" | (child) - |_________| - */ -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif - -#include <sys/types.h> -#include <sys/stat.h> -#include <sys/time.h> -#include <sys/types.h> -#include <fcntl.h> -#include <unistd.h> -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include <termios.h> -#include <dirent.h> -#include <signal.h> -#include <errno.h> -#ifdef HAVE_SYS_IOCTL_H -# include <sys/ioctl.h> -#endif - -#include "run_erl.h" -#include "safe_string.h" /* strn_cpy, strn_catf, sn_printf, etc. */ - -#if defined(O_NONBLOCK) -# define DONT_BLOCK_PLEASE O_NONBLOCK -#else -# define DONT_BLOCK_PLEASE O_NDELAY -# if !defined(EAGAIN) -# define EAGAIN -3898734 -# endif -#endif - -#ifdef HAVE_STRERROR -# define STRERROR(x) strerror(x) -#else -# define STRERROR(x) "" -#endif - -#define noDEBUG - -#define PIPE_DIR "/tmp/" -#define PIPE_STUBNAME "erlang.pipe" -#define PIPE_STUBLEN strlen(PIPE_STUBNAME) - -#ifdef DEBUG -#define STATUS(s) { fprintf(stderr, (s)); fflush(stderr); } -#else -#define STATUS(s) -#endif - -#ifndef FILENAME_MAX -#define FILENAME_MAX 250 -#endif - -static struct termios tty_smode, tty_rmode; -static int tty_eof = 0; -static int recv_sig = 0; -static int protocol_ver = RUN_ERL_LO_VER; /* assume lowest to begin with */ - -static int write_all(int fd, const char* buf, int len); -static int window_size_seq(char* buf, size_t bufsz); -static int version_handshake(char* buf, int len, int wfd); -#ifdef DEBUG -static void show_terminal_settings(struct termios *); -#endif - -static void handle_ctrlc(int sig) -{ - /* Reinstall the handler, and signal break flag */ - signal(SIGINT,handle_ctrlc); - recv_sig = SIGINT; -} - -static void handle_sigwinch(int sig) -{ - recv_sig = SIGWINCH; -} - -static void usage(char *pname) -{ - fprintf(stderr, "Usage: %s [-h|-F] [pipe_name|pipe_dir/]\n", pname); - fprintf(stderr, "\t-h\tThis help text.\n"); - fprintf(stderr, "\t-F\tForce connection even though pipe is locked by other to_erl process.\n"); -} - -int main(int argc, char **argv) -{ - char FIFO1[FILENAME_MAX], FIFO2[FILENAME_MAX]; - int i, len, wfd, rfd; - fd_set readfds; - char buf[BUFSIZ]; - char pipename[FILENAME_MAX]; - int pipeIx = 1; - int force_lock = 0; - int got_some = 0; - - if (argc >= 2 && argv[1][0]=='-') { - switch (argv[1][1]) { - case 'h': - usage(argv[0]); - exit(1); - case 'F': - force_lock = 1; - break; - default: - fprintf(stderr,"Invalid option '%s'\n",argv[1]); - exit(1); - } - pipeIx = 2; - } - -#ifdef DEBUG - fprintf(stderr, "%s: pid is : %d\n", argv[0], (int)getpid()); -#endif - - strn_cpy(pipename, sizeof(pipename), - (argv[pipeIx] ? argv[pipeIx] : PIPE_DIR)); - - if(*pipename && pipename[strlen(pipename)-1] == '/') { - /* The user wishes us to find a pipe name in the specified */ - /* directory */ - int highest_pipe_num = 0; - DIR *dirp; - struct dirent *direntp; - - dirp = opendir(pipename); - if(!dirp) { - fprintf(stderr, "Can't access pipe directory %s: %s\n", pipename, strerror(errno)); - exit(1); - } - - /* Check the directory for existing pipes */ - - while((direntp=readdir(dirp)) != NULL) { - if(strncmp(direntp->d_name,PIPE_STUBNAME,PIPE_STUBLEN)==0) { - int num = atoi(direntp->d_name+PIPE_STUBLEN+1); - if(num > highest_pipe_num) - highest_pipe_num = num; - } - } - closedir(dirp); - strn_catf(pipename, sizeof(pipename), (highest_pipe_num?"%s.%d":"%s"), - PIPE_STUBNAME, highest_pipe_num); - } /* if */ - - /* read FIFO */ - sn_printf(FIFO1,sizeof(FIFO1),"%s.r",pipename); - /* write FIFO */ - sn_printf(FIFO2,sizeof(FIFO2),"%s.w",pipename); - - /* Check that nobody is running to_erl on this pipe already */ - if ((wfd = open (FIFO1, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) { - /* Open as server succeeded -- to_erl is already running! */ - close(wfd); - fprintf(stderr, "Another to_erl process already attached to pipe " - "%s.\n", pipename); - if (force_lock) { - fprintf(stderr, "But we proceed anyway by force (-F).\n"); - } - else { - exit(1); - } - } - - if ((rfd = open (FIFO1, O_RDONLY|DONT_BLOCK_PLEASE, 0)) < 0) { -#ifdef DEBUG - fprintf(stderr, "Could not open FIFO %s for reading.\n", FIFO1); -#endif - fprintf(stderr, "No running Erlang on pipe %s: %s\n", pipename, strerror(errno)); - exit(1); - } -#ifdef DEBUG - fprintf(stderr, "to_erl: %s opened for reading\n", FIFO1); -#endif - - if ((wfd = open (FIFO2, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) { -#ifdef DEBUG - fprintf(stderr, "Could not open FIFO %s for writing.\n", FIFO2); -#endif - fprintf(stderr, "No running Erlang on pipe %s: %s\n", pipename, strerror(errno)); - close(rfd); - exit(1); - } -#ifdef DEBUG - fprintf(stderr, "to_erl: %s opened for writing\n", FIFO2); -#endif - - fprintf(stderr, "Attaching to %s (^D to exit)\n\n", pipename); - - /* Set break handler to our handler */ - signal(SIGINT,handle_ctrlc); - - /* - * Save the current state of the terminal, and set raw mode. - */ - if (tcgetattr(0, &tty_rmode) , 0) { - fprintf(stderr, "Cannot get terminals current mode\n"); - exit(-1); - } - tty_smode = tty_rmode; - tty_eof = '\004'; /* Ctrl+D to exit */ -#ifdef DEBUG - show_terminal_settings(&tty_rmode); -#endif - tty_smode.c_iflag = - 1*BRKINT |/*Signal interrupt on break.*/ - 1*IGNPAR |/*Ignore characters with parity errors.*/ - 1*ISTRIP |/*Strip character.*/ - 0; - -#if 0 -0*IGNBRK |/*Ignore break condition.*/ -0*PARMRK |/*Mark parity errors.*/ -0*INPCK |/*Enable input parity check.*/ -0*INLCR |/*Map NL to CR on input.*/ -0*IGNCR |/*Ignore CR.*/ -0*ICRNL |/*Map CR to NL on input.*/ -0*IUCLC |/*Map upper-case to lower-case on input.*/ -0*IXON |/*Enable start/stop output control.*/ -0*IXANY |/*Enable any character to restart output.*/ -0*IXOFF |/*Enable start/stop input control.*/ -0*IMAXBEL|/*Echo BEL on input line too long.*/ -#endif - - tty_smode.c_oflag = - 1*OPOST |/*Post-process output.*/ - 1*ONLCR |/*Map NL to CR-NL on output.*/ -#ifdef XTABS - 1*XTABS |/*Expand tabs to spaces. (Linux)*/ -#endif -#ifdef OXTABS - 1*OXTABS |/*Expand tabs to spaces. (FreeBSD)*/ -#endif -#ifdef NL0 - 1*NL0 |/*Select newline delays*/ -#endif -#ifdef CR0 - 1*CR0 |/*Select carriage-return delays*/ -#endif -#ifdef TAB0 - 1*TAB0 |/*Select horizontal tab delays*/ -#endif -#ifdef BS0 - 1*BS0 |/*Select backspace delays*/ -#endif -#ifdef VT0 - 1*VT0 |/*Select vertical tab delays*/ -#endif -#ifdef FF0 - 1*FF0 |/*Select form feed delays*/ -#endif - 0; - -#if 0 -0*OLCUC |/*Map lower case to upper on output.*/ -0*OCRNL |/*Map CR to NL on output.*/ -0*ONOCR |/*No CR output at column 0.*/ -0*ONLRET |/*NL performs CR function.*/ -0*OFILL |/*Use fill characters for delay.*/ -0*OFDEL |/*Fill is DEL, else NULL.*/ -0*NL1 | -0*CR1 | -0*CR2 | -0*CR3 | -0*TAB1 | -0*TAB2 | -0*TAB3 |/*Expand tabs to spaces.*/ -0*BS1 | -0*VT1 | -0*FF1 | -#endif - - /* JALI: removed setting the tty_smode.c_cflag flags, since this is not */ - /* advisable if this is a *real* terminal, such as the console. In fact */ - /* this may hang the entire machine, deep, deep down (signalling break */ - /* or toggling the abort switch doesn't help) */ - - tty_smode.c_lflag = - 0; - -#if 0 -0*ISIG |/*Enable signals.*/ -0*ICANON |/*Canonical input (erase and kill processing).*/ -0*XCASE |/*Canonical upper/lower presentation.*/ -0*ECHO |/*Enable echo.*/ -0*ECHOE |/*Echo erase character as BS-SP-BS.*/ -0*ECHOK |/*Echo NL after kill character.*/ -0*ECHONL |/*Echo NL.*/ -0*NOFLSH |/*Disable flush after interrupt or quit.*/ -0*TOSTOP |/*Send SIGTTOU for background output.*/ -0*ECHOCTL|/*Echo control characters as ^char, delete as ^?.*/ -0*ECHOPRT|/*Echo erase character as character erased.*/ -0*ECHOKE |/*BS-SP-BS erase entire line on line kill.*/ -0*FLUSHO |/*Output is being flushed.*/ -0*PENDIN |/*Retype pending input at next read or input character.*/ -0*IEXTEN |/*Enable extended (implementation-defined) functions.*/ -#endif - - tty_smode.c_cc[VMIN] =0;/* Note that VMIN is the same as VEOF! */ - tty_smode.c_cc[VTIME] =0;/* Note that VTIME is the same as VEOL! */ - tty_smode.c_cc[VINTR] =3; - - tcsetattr(0, TCSADRAIN, &tty_smode); - -#ifdef DEBUG - show_terminal_settings(&tty_smode); -#endif - /* - * "Write a ^R to the FIFO which causes the other end to redisplay - * the input line." - * This does not seem to work as was intended in old comment above. - * However, this control character is now (R12B-3) used by run_erl - * to trigger the version handshaking between to_erl and run_erl - * at the start of every new to_erl-session. - */ - - if (write(wfd, "\014", 1) < 0) { - fprintf(stderr, "Error in writing ^R to FIFO.\n"); - } - - /* - * read and write - */ - while (1) { - FD_ZERO(&readfds); - FD_SET(0, &readfds); - FD_SET(rfd, &readfds); - if (select(rfd + 1, &readfds, NULL, NULL, NULL) < 0) { - if (recv_sig) { - FD_ZERO(&readfds); - } - else { - fprintf(stderr, "Error in select.\n"); - break; - } - } - len = 0; - - /* - * Read from terminal and write to FIFO - */ - if (recv_sig) { - switch (recv_sig) { - case SIGINT: - fprintf(stderr, "[Break]\n\r"); - buf[0] = '\003'; - len = 1; - break; - case SIGWINCH: - len = window_size_seq(buf,sizeof(buf)); - break; - default: - fprintf(stderr,"Unexpected signal: %u\n",recv_sig); - } - recv_sig = 0; - } - else if (FD_ISSET(0, &readfds)) { - len = read(0, buf, sizeof(buf)); - if (len <= 0) { - close(rfd); - close(wfd); - if (len < 0) { - fprintf(stderr, "Error in reading from stdin.\n"); - } else { - fprintf(stderr, "[EOF]\n\r"); - } - break; - } - /* check if there is an eof character in input */ - for (i = 0; i < len && buf[i] != tty_eof; i++); - if (buf[i] == tty_eof) { - fprintf(stderr, "[Quit]\n\r"); - break; - } - } - - if (len) { -#ifdef DEBUG - if(write(1, buf, len)); -#endif - if (write_all(wfd, buf, len) != len) { - fprintf(stderr, "Error in writing to FIFO.\n"); - close(rfd); - close(wfd); - break; - } - STATUS("\" OK\r\n"); - } - - /* - * Read from FIFO, write to terminal. - */ - if (FD_ISSET(rfd, &readfds)) { - STATUS("FIFO read: "); - len = read(rfd, buf, BUFSIZ); - if (len < 0 && errno == EAGAIN) { - /* - * No data this time, but the writing end of the FIFO is still open. - * Do nothing. - */ - ; - } else if (len <= 0) { - /* - * Either an error or end of file. In either case, break out - * of the loop. - */ - close(rfd); - close(wfd); - if (len < 0) { - fprintf(stderr, "Error in reading from FIFO.\n"); - } else - fprintf(stderr, "[End]\n\r"); - break; - } else { - if (!got_some) { - if ((len=version_handshake(buf,len,wfd)) < 0) { - close(rfd); - close(wfd); - break; - } - if (protocol_ver >= 1) { - /* Tell run_erl size of terminal window */ - signal(SIGWINCH, handle_sigwinch); - raise(SIGWINCH); - } - got_some = 1; - } - - /* - * We successfully read at least one character. Write what we got. - */ - STATUS("Terminal write: \""); - if (write_all(1, buf, len) != len) { - fprintf(stderr, "Error in writing to terminal.\n"); - close(rfd); - close(wfd); - break; - } - STATUS("\" OK\r\n"); - } - } - } - - /* - * Reset terminal characterstics - * XXX - */ - tcsetattr(0, TCSADRAIN, &tty_rmode); - return 0; -} - -/* Call write() until entire buffer has been written or error. - * Return len or -1. - */ -static int write_all(int fd, const char* buf, int len) -{ - int left = len; - int written; - while (left) { - written = write(fd,buf,left); - if (written < 0) { - return -1; - } - left -= written; - buf += written; - } - return len; -} - -static int window_size_seq(char* buf, size_t bufsz) -{ -#ifdef TIOCGWINSZ - struct winsize ws; - static const char prefix[] = "\033_"; - static const char suffix[] = "\033\\"; - /* This Esc sequence is called "Application Program Command" - and seems suitable to use for our own customized stuff. */ - - if (ioctl(STDIN_FILENO, TIOCGWINSZ, &ws) == 0) { - int len = sn_printf(buf, bufsz, "%swinsize=%u,%u%s", - prefix, ws.ws_col, ws.ws_row, suffix); - return len; - } -#endif /* TIOCGWINSZ */ - return 0; -} - -/* to_erl run_erl - * | | - * |---------- '\022' -------->| (session start) - * | | - * |<---- "[run_erl v1-0]" ----| (version interval) - * | | - * |--- Esc_"version=1"Esc\ -->| (common version) - * | | - */ -static int version_handshake(char* buf, int len, int wfd) -{ - unsigned re_high=0, re_low; - char *end = find_str(buf,len,"]\n"); - - if (end && sscanf(buf,"[run_erl v%u-%u",&re_high,&re_low)==2) { - char wbuf[30]; - int wlen; - - if (re_low > RUN_ERL_HI_VER || re_high < RUN_ERL_LO_VER) { - fprintf(stderr,"Incompatible versions: to_erl=v%u-%u run_erl=v%u-%u\n", - RUN_ERL_HI_VER, RUN_ERL_LO_VER, re_high, re_low); - return -1; - } - /* Choose highest common version */ - protocol_ver = re_high < RUN_ERL_HI_VER ? re_high : RUN_ERL_HI_VER; - - wlen = sn_printf(wbuf, sizeof(wbuf), "\033_version=%u\033\\", - protocol_ver); - if (write_all(wfd, wbuf, wlen) < 0) { - fprintf(stderr,"Failed to send version handshake\n"); - return -1; - } - end += 2; - len -= (end-buf); - memmove(buf,end,len); - - } - else { /* we assume old run_erl without version handshake */ - protocol_ver = 0; - } - - if (re_high != RUN_ERL_HI_VER) { - fprintf(stderr,"run_erl has different version, " - "using common protocol level %u\n", protocol_ver); - } - - return len; -} - -#ifdef DEBUG -#define S(x) ((x) > 0 ? 1 : 0) +#include "to_erl_common.h" -static void show_terminal_settings(struct termios *t) -{ - fprintf(stderr,"c_iflag:\n"); - fprintf(stderr,"Signal interrupt on break: BRKINT %d\n", S(t->c_iflag & BRKINT)); - fprintf(stderr,"Map CR to NL on input: ICRNL %d\n", S(t->c_iflag & ICRNL)); - fprintf(stderr,"Ignore break condition: IGNBRK %d\n", S(t->c_iflag & IGNBRK)); - fprintf(stderr,"Ignore CR: IGNCR %d\n", S(t->c_iflag & IGNCR)); - fprintf(stderr,"Ignore char with par. err's: IGNPAR %d\n", S(t->c_iflag & IGNPAR)); - fprintf(stderr,"Map NL to CR on input: INLCR %d\n", S(t->c_iflag & INLCR)); - fprintf(stderr,"Enable input parity check: INPCK %d\n", S(t->c_iflag & INPCK)); - fprintf(stderr,"Strip character ISTRIP %d\n", S(t->c_iflag & ISTRIP)); - fprintf(stderr,"Enable start/stop input ctrl IXOFF %d\n", S(t->c_iflag & IXOFF)); - fprintf(stderr,"ditto output ctrl IXON %d\n", S(t->c_iflag & IXON)); - fprintf(stderr,"Mark parity errors PARMRK %d\n", S(t->c_iflag & PARMRK)); - fprintf(stderr,"\n"); - fprintf(stderr,"c_oflag:\n"); - fprintf(stderr,"Perform output processing OPOST %d\n", S(t->c_oflag & OPOST)); - fprintf(stderr,"\n"); - fprintf(stderr,"c_cflag:\n"); - fprintf(stderr,"Ignore modem status lines CLOCAL %d\n", S(t->c_cflag & CLOCAL)); - fprintf(stderr,"\n"); - fprintf(stderr,"c_local:\n"); - fprintf(stderr,"Enable echo ECHO %d\n", S(t->c_lflag & ECHO)); - fprintf(stderr,"\n"); - fprintf(stderr,"c_cc:\n"); - fprintf(stderr,"c_cc[VEOF] %d\n", t->c_cc[VEOF]); +int main(int argc,char **argv) { + return to_erl(argc,argv); } -#endif diff --git a/erts/etc/win32/nsis/erlang.nsi b/erts/etc/win32/nsis/erlang.nsi index 162e634148..f4fd2b4cdb 100644 --- a/erts/etc/win32/nsis/erlang.nsi +++ b/erts/etc/win32/nsis/erlang.nsi @@ -93,7 +93,6 @@ SectionIn 1 RO skip_silent_mode: SetOutPath "$INSTDIR" - File "${TESTROOT}\OTP_VERSION" File "${TESTROOT}\Install.ini" File "${TESTROOT}\Install.exe" File /r "${TESTROOT}\releases" diff --git a/erts/etc/win32/nsis/erlang20.nsi b/erts/etc/win32/nsis/erlang20.nsi index 3ee33e8121..3333c4a9aa 100644 --- a/erts/etc/win32/nsis/erlang20.nsi +++ b/erts/etc/win32/nsis/erlang20.nsi @@ -144,7 +144,6 @@ Section "Development" SecErlangDev SectionIn 1 RO
SetOutPath "$INSTDIR"
- File "${TESTROOT}\OTP_VERSION"
File "${TESTROOT}\Install.ini"
File "${TESTROOT}\Install.exe"
SetOutPath "$INSTDIR\releases"
diff --git a/erts/include/internal/ethr_mutex.h b/erts/include/internal/ethr_mutex.h index 86a1e9fbdf..6c931e0cd4 100644 --- a/erts/include/internal/ethr_mutex.h +++ b/erts/include/internal/ethr_mutex.h @@ -97,7 +97,7 @@ void LeaveCriticalSection(CRITICAL_SECTION *); #if 0 # define ETHR_MTX_Q_LOCK_SPINLOCK__ # define ETHR_MTX_QLOCK_TYPE__ ethr_spinlock_t -#elif defined(ETHR_PTHREADS) +#elif defined(ETHR_PTHREADS) || defined(ETHR_OSE_THREADS) # define ETHR_MTX_Q_LOCK_PTHREAD_MUTEX__ # define ETHR_MTX_QLOCK_TYPE__ pthread_mutex_t #elif defined(ETHR_WIN32_THREADS) @@ -210,7 +210,7 @@ struct ethr_cond_ { #endif }; -#elif defined(ETHR_PTHREADS) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) +#elif (defined(ETHR_PTHREADS) || defined(ETHR_OSE_THREADS)) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) typedef struct ethr_mutex_ ethr_mutex; struct ethr_mutex_ { @@ -354,7 +354,7 @@ void ethr_rwmutex_rwunlock(ethr_rwmutex *); #ifdef ETHR_MTX_HARD_DEBUG #define ETHR_MTX_HARD_ASSERT(A) \ - ((void) ((A) ? 1 : ethr_assert_failed(__FILE__, __LINE__, #A))) + ((void) ((A) ? 1 : ethr_assert_failed(__FILE__, __LINE__, __func__,#A))) #else #define ETHR_MTX_HARD_ASSERT(A) ((void) 1) #endif @@ -633,7 +633,7 @@ ETHR_INLINE_MTX_FUNC_NAME_(ethr_mutex_unlock)(ethr_mutex *mtx) #endif /* ETHR_TRY_INLINE_FUNCS */ -#elif defined(ETHR_PTHREADS) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) +#elif (defined(ETHR_PTHREADS) || defined(ETHR_OSE_THREADS)) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) #if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_MUTEX_IMPL__) diff --git a/erts/include/internal/ethread.h b/erts/include/internal/ethread.h index 38b8e9e9b6..54acd1295a 100644 --- a/erts/include/internal/ethread.h +++ b/erts/include/internal/ethread.h @@ -37,6 +37,11 @@ # define ETHR_DEBUG #endif +#if defined(__PPC__) || defined (__POWERPC) +/* OSE compiler should be fixed! */ +#define __ppc__ +#endif + #if defined(ETHR_DEBUG) # undef ETHR_XCHK # define ETHR_XCHK 1 @@ -60,7 +65,7 @@ #endif /* Assume 64-byte cache line size */ -#define ETHR_CACHE_LINE_SIZE 64 +#define ETHR_CACHE_LINE_SIZE ASSUMED_CACHE_LINE_SIZE #define ETHR_CACHE_LINE_MASK (ETHR_CACHE_LINE_SIZE - 1) #define ETHR_CACHE_LINE_ALIGN_SIZE(SZ) \ @@ -190,6 +195,30 @@ typedef DWORD ethr_tsd_key; #define ETHR_YIELD() (Sleep(0), 0) +#elif defined(ETHR_OSE_THREADS) + +#include "ose.h" +#undef NIL + +#if defined(ETHR_HAVE_PTHREAD_H) +#include <pthread.h> +#endif + +typedef struct { + PROCESS id; + unsigned int tsd_key_index; + void *res; +} ethr_tid; + +typedef OSPPDKEY ethr_tsd_key; + +#undef ETHR_HAVE_ETHR_SIG_FUNCS + +/* Out own RW mutexes are probably faster, but use OSEs mutexes */ +#define ETHR_USE_OWN_RWMTX_IMPL__ + +#define ETHR_HAVE_THREAD_NAMES + #else /* No supported thread lib found */ #ifdef ETHR_NO_SUPP_THR_LIB_NOT_FATAL @@ -367,7 +396,19 @@ extern ethr_runtime_t ethr_runtime__; #include "ethr_atomics.h" /* The atomics API */ -#if defined(__GNUC__) +#if defined (ETHR_OSE_THREADS) +static ETHR_INLINE void +ose_yield(void) +{ + if (get_ptype(current_process()) == OS_PRI_PROC) { + set_pri(get_pri(current_process())); + } else { + delay(1); + } +} +#endif + +#if defined(__GNUC__) && !defined(ETHR_OSE_THREADS) # ifndef ETHR_SPIN_BODY # if defined(__i386__) || defined(__x86_64__) # define ETHR_SPIN_BODY __asm__ __volatile__("rep;nop" : : : "memory") @@ -383,9 +424,20 @@ extern ethr_runtime_t ethr_runtime__; # ifndef ETHR_SPIN_BODY # define ETHR_SPIN_BODY do {YieldProcessor();ETHR_COMPILER_BARRIER;} while(0) # endif +#elif defined(ETHR_OSE_THREADS) +# ifndef ETHR_SPIN_BODY +# define ETHR_SPIN_BODY ose_yield() +# else +# error "OSE should use ose_yield()" +# endif #endif +#ifndef ETHR_OSE_THREADS #define ETHR_YIELD_AFTER_BUSY_LOOPS 50 +#else +#define ETHR_YIELD_AFTER_BUSY_LOOPS 0 +#endif + #ifndef ETHR_SPIN_BODY # define ETHR_SPIN_BODY ETHR_COMPILER_BARRIER @@ -408,12 +460,18 @@ extern ethr_runtime_t ethr_runtime__; # else # define ETHR_YIELD() (pthread_yield(), 0) # endif +# elif defined(ETHR_OSE_THREADS) +# define ETHR_YIELD() (ose_yield(), 0) # else # define ETHR_YIELD() (ethr_compiler_barrier(), 0) # endif #endif -#ifdef VALGRIND /* mutex as fallback for spinlock for VALGRIND */ +#if defined(VALGRIND) || defined(ETHR_OSE_THREADS) +/* mutex as fallback for spinlock for VALGRIND and OSE. + OSE cannot use spinlocks as processes working on the + same execution unit have a tendency to deadlock. + */ # undef ETHR_HAVE_NATIVE_SPINLOCKS # undef ETHR_HAVE_NATIVE_RWSPINLOCKS #else @@ -459,9 +517,19 @@ typedef struct { typedef struct { int detached; /* boolean (default false) */ int suggested_stack_size; /* kilo words (default sys dependent) */ +#ifdef ETHR_OSE_THREADS + char *name; + U32 coreNo; +#endif } ethr_thr_opts; +#if defined(ETHR_OSE_THREADS) +/* Default ethr name is big as we want to be able to sprint stuff in there */ +#define ETHR_THR_OPTS_DEFAULT_INITER \ + {0, -1, "ethread", 0} +#else #define ETHR_THR_OPTS_DEFAULT_INITER {0, -1} +#endif #if !defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_AUX_IMPL__) @@ -479,7 +547,7 @@ void ethr_thr_exit(void *); ethr_tid ethr_self(void); int ethr_equal_tids(ethr_tid, ethr_tid); -int ethr_tsd_key_create(ethr_tsd_key *); +int ethr_tsd_key_create(ethr_tsd_key *,char *); int ethr_tsd_key_delete(ethr_tsd_key); int ethr_tsd_set(ethr_tsd_key, void *); void *ethr_tsd_get(ethr_tsd_key); @@ -571,8 +639,10 @@ typedef struct ethr_ts_event_ ethr_ts_event; /* Needed by ethr_mutex.h */ #if defined(ETHR_WIN32_THREADS) # include "win/ethr_event.h" -#else +#elif defined(ETHR_PTHREADS) # include "pthread/ethr_event.h" +#elif defined(ETHR_OSE_THREADS) +# include "ose/ethr_event.h" #endif int ethr_set_main_thr_status(int, int); @@ -662,6 +732,37 @@ ETHR_INLINE_FUNC_NAME_(ethr_leave_ts_event)(ethr_ts_event *tsep) #endif +#elif defined (ETHR_OSE_THREADS) + +#if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHREAD_IMPL__) + +extern ethr_tsd_key ethr_ts_event_key__; + +static ETHR_INLINE ethr_ts_event * +ETHR_INLINE_FUNC_NAME_(ethr_get_ts_event)(void) +{ + ethr_ts_event *tsep = *(ethr_ts_event**)ose_get_ppdata(ethr_ts_event_key__); + if (!tsep) { + int res = ethr_get_tmp_ts_event__(&tsep); + if (res != 0) + ETHR_FATAL_ERROR__(res); + ETHR_ASSERT(tsep); + } + return tsep; +} + +static ETHR_INLINE void +ETHR_INLINE_FUNC_NAME_(ethr_leave_ts_event)(ethr_ts_event *tsep) +{ + if (tsep->iflgs & ETHR_TS_EV_TMP) { + int res = ethr_free_ts_event__(tsep); + if (res != 0) + ETHR_FATAL_ERROR__(res); + } +} + +#endif + #endif #include "ethr_mutex.h" /* Need atomic declarations and tse */ diff --git a/erts/include/internal/ethread_header_config.h.in b/erts/include/internal/ethread_header_config.h.in index dd3599f86d..b36322490a 100644 --- a/erts/include/internal/ethread_header_config.h.in +++ b/erts/include/internal/ethread_header_config.h.in @@ -235,3 +235,5 @@ /* Define if you want to turn on extra sanity checking in the ethread library */ #undef ETHR_XCHK +/* Assumed cache-line size (in bytes) */ +#undef ASSUMED_CACHE_LINE_SIZE diff --git a/erts/include/internal/ose/ethr_event.h b/erts/include/internal/ose/ethr_event.h new file mode 100644 index 0000000000..000a600813 --- /dev/null +++ b/erts/include/internal/ose/ethr_event.h @@ -0,0 +1,113 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009-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% + */ + +/* + * Author: Rickard Green + */ + +//#define USE_PTHREAD_API + +#define ETHR_EVENT_OFF_WAITER__ -1L +#define ETHR_EVENT_OFF__ 1L +#define ETHR_EVENT_ON__ 0L + +#ifdef USE_PTHREAD_API + +typedef struct { + ethr_atomic32_t state; + pthread_mutex_t mtx; + pthread_cond_t cnd; +} ethr_event; + +#if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_EVENT_IMPL__) + +static void ETHR_INLINE +ETHR_INLINE_FUNC_NAME_(ethr_event_set)(ethr_event *e) +{ + ethr_sint32_t val; + val = ethr_atomic32_xchg_mb(&e->state, ETHR_EVENT_ON__); + if (val == ETHR_EVENT_OFF_WAITER__) { + int res = pthread_mutex_lock(&e->mtx); + if (res != 0) + ETHR_FATAL_ERROR__(res); + res = pthread_cond_signal(&e->cnd); + if (res != 0) + ETHR_FATAL_ERROR__(res); + res = pthread_mutex_unlock(&e->mtx); + if (res != 0) + ETHR_FATAL_ERROR__(res); + } +} + +static void ETHR_INLINE +ETHR_INLINE_FUNC_NAME_(ethr_event_reset)(ethr_event *e) +{ + ethr_atomic32_set(&e->state, ETHR_EVENT_OFF__); + ETHR_MEMORY_BARRIER; +} + +#endif + +#else + +typedef struct { + ethr_atomic32_t state; + PROCESS proc; +} ethr_event; + +#if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_EVENT_IMPL__) + +static void ETHR_INLINE +ETHR_INLINE_FUNC_NAME_(ethr_event_set)(ethr_event *e) +{ + ethr_sint32_t val = ethr_atomic32_xchg_mb(&e->state, ETHR_EVENT_ON__); + if (val == ETHR_EVENT_OFF_WAITER__) { +#ifdef DEBUG + OSFSEMVAL fsem_val = get_fsem(e->proc); + + /* There is a race in this assert. + This is because the state is set before the wait call in wait__. + We hope that a delay of 10 ms is enough */ + if (fsem_val == 0) + delay(10); + ETHR_ASSERT(get_fsem(e->proc) == -1); +#endif + signal_fsem(e->proc); + } +} + +static void ETHR_INLINE +ETHR_INLINE_FUNC_NAME_(ethr_event_reset)(ethr_event *e) +{ + ethr_atomic32_set(&e->state, ETHR_EVENT_OFF__); + ETHR_MEMORY_BARRIER; +} + +#endif + +#endif + +int ethr_event_init(ethr_event *e); +int ethr_event_destroy(ethr_event *e); +int ethr_event_wait(ethr_event *e); +int ethr_event_swait(ethr_event *e, int spincount); +#if !defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_EVENT_IMPL__) +void ethr_event_set(ethr_event *e); +void ethr_event_reset(ethr_event *e); +#endif diff --git a/erts/lib_src/common/erl_misc_utils.c b/erts/lib_src/common/erl_misc_utils.c index b32681f40e..5a271c5268 100644 --- a/erts/lib_src/common/erl_misc_utils.c +++ b/erts/lib_src/common/erl_misc_utils.c @@ -158,6 +158,8 @@ erts_milli_sleep(long ms) if (ms > 0) { #ifdef __WIN32__ Sleep((DWORD) ms); +#elif defined(__OSE__) + delay(ms); #else struct timeval tv; tv.tv_sec = ms / 1000; @@ -316,6 +318,10 @@ erts_cpu_info_update(erts_cpu_info_t *cpuinfo) online = 0; #endif } +#elif defined(__OSE__) + online = ose_num_cpus(); + configured = ose_num_cpus(); + available = ose_num_cpus(); #endif if (online > configured) diff --git a/erts/lib_src/common/ethr_aux.c b/erts/lib_src/common/ethr_aux.c index f4ff08d368..ceecdcef64 100644 --- a/erts/lib_src/common/ethr_aux.c +++ b/erts/lib_src/common/ethr_aux.c @@ -204,7 +204,18 @@ ethr_init_common__(ethr_init_data *id) ethr_min_stack_size__ = ETHR_B2KW(ethr_min_stack_size__); +#ifdef __OSE__ + /* For supervisor processes, OSE adds a number of bytes to the requested stack. With this + * addition, the resulting size must not exceed the largest available stack size. The number + * of bytes that will be added is configured in the monolith and can therefore not be + * specified here. We simply assume that it is less than 0x1000. The available stack sizes + * are configured in the .lmconf file and the largest one is usually 65536 bytes. + * Consequently, the requested stack size is limited to 0xF000. + */ + ethr_max_stack_size__ = 0xF000; +#else ethr_max_stack_size__ = 32*1024*1024; +#endif #if SIZEOF_VOID_P == 8 ethr_max_stack_size__ *= 2; #endif @@ -650,6 +661,10 @@ ETHR_IMPL_NORETURN__ ethr_fatal_error__(const char *file, int ethr_assert_failed(const char *file, int line, const char *func, char *a) { fprintf(stderr, "%s:%d: %s(): Assertion failed: %s\n", file, line, func, a); +#ifdef __OSE__ + ramlog_printf("%d: %s:%d: %s(): Assertion failed: %s\n", + current_process(),file, line, func, a); +#endif ethr_abort__(); return 0; } diff --git a/erts/lib_src/common/ethr_mutex.c b/erts/lib_src/common/ethr_mutex.c index 036914af7b..72b44033ad 100644 --- a/erts/lib_src/common/ethr_mutex.c +++ b/erts/lib_src/common/ethr_mutex.c @@ -1249,7 +1249,7 @@ ethr_cond_wait(ethr_cond *cnd, ethr_mutex *mtx) return 0; } -#elif defined(ETHR_PTHREADS) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) +#elif (defined(ETHR_PTHREADS) || defined(ETHR_OSE_THREADS)) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) /* -- pthread mutex and condition variables -------------------------------- */ int @@ -1752,6 +1752,8 @@ ethr_cond_destroy(ethr_cond *cnd) return 0; } +#else +#error "No mutex implementation found" #endif /* -- Exported symbols of inline functions --------------------------------- */ diff --git a/erts/lib_src/ose/ethr_event.c b/erts/lib_src/ose/ethr_event.c new file mode 100644 index 0000000000..87294c98ea --- /dev/null +++ b/erts/lib_src/ose/ethr_event.c @@ -0,0 +1,219 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009-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 + * 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% + */ + +/* + * Author: Rickard Green + */ + +#define ETHR_INLINE_FUNC_NAME_(X) X ## __ +#define ETHR_EVENT_IMPL__ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include "ethread.h" + +#ifdef USE_PTHREAD_API + +int +ethr_event_init(ethr_event *e) +{ + int res; + ethr_atomic32_init(&e->state, ETHR_EVENT_OFF__); + res = pthread_mutex_init(&e->mtx, NULL); + if (res != 0) + return res; + res = pthread_cond_init(&e->cnd, NULL); + if (res != 0) { + pthread_mutex_destroy(&e->mtx); + return res; + } + return 0; +} + +int +ethr_event_destroy(ethr_event *e) +{ + int res; + res = pthread_mutex_destroy(&e->mtx); + if (res != 0) + return res; + res = pthread_cond_destroy(&e->cnd); + if (res != 0) + return res; + return 0; +} + +static ETHR_INLINE int +wait__(ethr_event *e, int spincount) +{ + int sc = spincount; + ethr_sint32_t val; + int res, ulres; + int until_yield = ETHR_YIELD_AFTER_BUSY_LOOPS; + + if (spincount < 0) + ETHR_FATAL_ERROR__(EINVAL); + + while (1) { + val = ethr_atomic32_read(&e->state); + if (val == ETHR_EVENT_ON__) + return 0; + if (sc == 0) + break; + sc--; + ETHR_SPIN_BODY; + if (--until_yield == 0) { + until_yield = ETHR_YIELD_AFTER_BUSY_LOOPS; + res = ETHR_YIELD(); + if (res != 0) + ETHR_FATAL_ERROR__(res); + } + } + + if (val != ETHR_EVENT_OFF_WAITER__) { + val = ethr_atomic32_cmpxchg(&e->state, + ETHR_EVENT_OFF_WAITER__, + ETHR_EVENT_OFF__); + if (val == ETHR_EVENT_ON__) + return 0; + ETHR_ASSERT(val == ETHR_EVENT_OFF__); + } + + ETHR_ASSERT(val == ETHR_EVENT_OFF_WAITER__ + || val == ETHR_EVENT_OFF__); + + res = pthread_mutex_lock(&e->mtx); + if (res != 0) + ETHR_FATAL_ERROR__(res); + + while (1) { + + val = ethr_atomic32_read(&e->state); + if (val == ETHR_EVENT_ON__) + break; + + res = pthread_cond_wait(&e->cnd, &e->mtx); + if (res == EINTR) + break; + if (res != 0) + ETHR_FATAL_ERROR__(res); + } + + ulres = pthread_mutex_unlock(&e->mtx); + if (ulres != 0) + ETHR_FATAL_ERROR__(ulres); + + return res; /* 0 || EINTR */ +} + +#else +/* --- OSE implementation of events ---------------------------- */ + +#ifdef DEBUG +union SIGNAL { + SIGSELECT signo; +}; +#endif + +int +ethr_event_init(ethr_event *e) +{ + ethr_atomic32_init(&e->state, ETHR_EVENT_OFF__); + e->proc = current_process(); + return 0; +} + +int +ethr_event_destroy(ethr_event *e) +{ + return 0; +} + +static ETHR_INLINE int +wait__(ethr_event *e, int spincount) +{ + int sc = spincount; + int res; + int until_yield = ETHR_YIELD_AFTER_BUSY_LOOPS; + + if (spincount < 0) + ETHR_FATAL_ERROR__(EINVAL); + + ETHR_ASSERT(e->proc == current_process()); + ETHR_ASSERT(get_fsem(current_process()) == 0); + + while (1) { + ethr_sint32_t val; + while (1) { + val = ethr_atomic32_read(&e->state); + if (val == ETHR_EVENT_ON__) + return 0; + if (sc == 0) + break; + sc--; + ETHR_SPIN_BODY; + if (--until_yield == 0) { + until_yield = ETHR_YIELD_AFTER_BUSY_LOOPS; + res = ETHR_YIELD(); + if (res != 0) + ETHR_FATAL_ERROR__(res); + } + } + if (val != ETHR_EVENT_OFF_WAITER__) { + val = ethr_atomic32_cmpxchg(&e->state, + ETHR_EVENT_OFF_WAITER__, + ETHR_EVENT_OFF__); + if (val == ETHR_EVENT_ON__) + return 0; + ETHR_ASSERT(val == ETHR_EVENT_OFF__); + } + + wait_fsem(1); + + ETHR_ASSERT(get_fsem(current_process()) == 0); + } +} + +#endif + +void +ethr_event_reset(ethr_event *e) +{ + ethr_event_reset__(e); +} + +void +ethr_event_set(ethr_event *e) +{ + ethr_event_set__(e); +} + +int +ethr_event_wait(ethr_event *e) +{ + return wait__(e, 0); +} + +int +ethr_event_swait(ethr_event *e, int spincount) +{ + return wait__(e, spincount); +} diff --git a/erts/lib_src/ose/ethread.c b/erts/lib_src/ose/ethread.c new file mode 100644 index 0000000000..53628382b1 --- /dev/null +++ b/erts/lib_src/ose/ethread.c @@ -0,0 +1,832 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2010-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% + */ + +/* + * Description: OSE implementation of the ethread library + * Author: Lukas Larsson + */ + + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include "stdio.h" +#ifdef ETHR_TIME_WITH_SYS_TIME +# include "time.h" +# include "sys/time.h" +#else +# ifdef ETHR_HAVE_SYS_TIME_H +# include "sys/time.h" +# else +# include "time.h" +# endif +#endif +#include "sys/types.h" +#include "unistd.h" + +#include "limits.h" + +#define ETHR_INLINE_FUNC_NAME_(X) X ## __ +#define ETHREAD_IMPL__ + +#include "ethread.h" +#include "ethr_internal.h" + +#include "erl_printf.h" +#include "efs.h" +#include "ose.h" + +#include "ose_spi.h" + +#include "string.h" +#include "ctype.h" +#include "stdlib.h" + +#ifndef ETHR_HAVE_ETHREAD_DEFINES +#error Missing configure defines +#endif + +#define ETHR_INVALID_TID_ID -1 + +#define DEFAULT_PRIO_NAME "ERTS_ETHR_DEFAULT_PRIO" + +/* Set the define to 1 to get some logging */ +#if 0 +#include "ramlog.h" +#define LOG(output) ramlog_printf output +#else +#define LOG(output) +#endif + +static ethr_tid main_thr_tid; +static const char* own_tid_key = "ethread_own_tid"; +ethr_tsd_key ethr_ts_event_key__; + +#define ETHREADWRAPDATASIG 1 + +/* Init data sent to thr_wrapper() */ +typedef struct { + SIGSELECT sig_no; + ethr_ts_event *tse; + ethr_tid *tid; + ethr_sint32_t result; + void *(*thr_func)(void *); + void *arg; + void *prep_func_res; + const char *name; +} ethr_thr_wrap_data__; + +union SIGNAL { + SIGSELECT sig_no; + ethr_thr_wrap_data__ data; +}; + +#define ETHR_GET_OWN_TID__ ((ethr_tid *) get_envp(current_process(),\ + own_tid_key)) + +/* + * -------------------------------------------------------------------------- + * Static functions + * -------------------------------------------------------------------------- + */ + +/* Will retrive the instrinsic name by removing the 'prefix' and the + * suffix from 'name'. + * The 'prefix' is given as an inparameter. If NULL or an empty string no + * prefix will be removed. + * If 'strip_suffix' is 1 suffixes in the form of '_123' will be removed. + * Will return a pointer to a newly allocated buffer containing the intrinsic + * name in uppercase characters. + * The caller must remember to free this buffer when no lnger needed. + */ +static char * +ethr_intrinsic_name(const char *name, const char *prefix, int strip_suffix) +{ + const char *start = name; + const char *end = name + strlen(name); + char *intrinsic_name = NULL; + int i; + + if (name == NULL) { + LOG(("ERTS - ethr_intrinsic_namNo input name.\n")); + return NULL; + } + + /* take care of the prefix */ + if ((prefix != NULL) && (*prefix != '\0')) { + const char *found = strstr(name, prefix); + + if (found == name) { + /* found the prefix at the beginning */ + start += strlen(prefix); + } + } + + /* take care of the suffix */ + if (strip_suffix) { + const char *suffix_start = strrchr(start, '_'); + + if (suffix_start != NULL) { + const char *ch; + int only_numbers = 1; + + for (ch = suffix_start + 1; *ch != '\0'; ch++) { + if (strchr("0123456789", *ch) == NULL) { + only_numbers = 0; + break; + } + } + + if (only_numbers) { + end = suffix_start; + } + } + } + + intrinsic_name = malloc(end - start + 1); + for (i = 0; (start + i) < end; i++) { + intrinsic_name[i] = toupper(start[i]); + } + intrinsic_name[i] = '\0'; + + return intrinsic_name; +} + +static char * +ethr_get_amended_env(const char *name, const char *prefix, const char *suffix) +{ + unsigned len; + char *env_name = NULL; + char *env_value = NULL; + + if (name == NULL) { + return NULL; + } + + len = strlen(name); + + if (prefix != NULL) { + len += strlen(prefix); + } + + if (suffix != NULL) { + len += strlen(suffix); + } + + env_name = malloc(len + 1); + sprintf(env_name, "%s%s%s", (prefix != NULL) ? prefix : "", + name, + (suffix != NULL) ? suffix : ""); + env_value = get_env(get_bid(current_process()), env_name); + + if (env_value == NULL) { + LOG(("ERTS - ethr_get_amended_env(): %s environment variable not present\n", env_name)); + } else { + LOG(("ERTS - ethr_get_amended_env(): Found %s environment variable: %s.\n", env_name, env_value)); + } + free(env_name); + + return env_value; +} + +/* Reads the environment variable derived from 'name' and interprets it as as an + * OSE priority. If successfull it will update 'out_prio'. + * Returns: 0 if successfull + * -1 orherwise. + */ +static int +ethr_get_prio(const char *name, OSPRIORITY *out_prio) +{ + int rc = -1; + char *intrinsic_name = NULL; + char *prio_env = NULL; + long prio; + char *endptr = NULL; + + LOG(("ERTS - ethr_get_prio(): name: %s.\n", name)); + + intrinsic_name = ethr_intrinsic_name(name, NULL, 1); + LOG(("ERTS - ethr_get_prio(): Intrinsic name: %s.\n", intrinsic_name)); + + prio_env = ethr_get_amended_env(intrinsic_name, "ERTS_", "_PRIO"); + if (prio_env == NULL) { + goto fini; + } + + prio = efs_str_to_long(prio_env, (const char **)&endptr); + if (endptr != NULL) { + LOG(("ERTS - ethr_get_prio(): Environment varible for '%s' includes " + "non-numerical characters: '%s'.\n", intrinsic_name, prio_env)); + goto fini; + } + + if ((prio < 0) || (prio > 32)) { + LOG(("ERTS - ethr_get_prio(): prio for '%s' (%d) is out of bounds (0-32).\n", + intrinsic_name, prio)); + goto fini; + } + + /* Success */ + *out_prio = (OSPRIORITY)prio; + rc = 0; + +fini: + if (intrinsic_name != NULL) { + free(intrinsic_name); + } + if (prio_env != NULL) { + free_buf((union SIGNAL **) &prio_env); + } + + return rc; +} + +static PROCESS blockId(void) { + static PROCESS bid = (PROCESS)0; + + /* For now we only use the same block. */ + /* if (bid == 0) { + bid = create_block("Erlang-VM", 0, 0, 0, 0); + } + return bid; */ + return 0; +} + +static void thr_exit_cleanup(ethr_tid *tid, void *res) +{ + + ETHR_ASSERT(tid == ETHR_GET_OWN_TID__); + + tid->res = res; + + ethr_run_exit_handlers__(); + ethr_ts_event_destructor__((void *) ethr_get_tse__()); +} + +//static OS_PROCESS(thr_wrapper); +static OS_PROCESS(thr_wrapper) +{ + ethr_tid my_tid; + ethr_sint32_t result; + void *res; + void *(*thr_func)(void *); + void *arg; + ethr_ts_event *tsep = NULL; + +#ifdef DEBUG + { + PROCESS pid = current_process(); + + const char *execMode; + + PROCESS bid = get_bid(pid); + + /* In the call below, 16 is a secret number provided by frbr that makes + * the function return current domain. */ + OSADDRESS domain = get_pid_info(current_process(), 16); + +#ifdef HAVE_OSE_SPI_H + execMode = get_pid_info(pid, OSE_PI_SUPERVISOR) + ? "Supervisor" + : "User"; +#else + execMode = "unknown"; +#endif + + fprintf(stderr,"[0x%x] New process. Bid:0x%x, domain:%d, exec mode:%s\n", + current_process(), bid, domain, execMode); + } +#endif + + { + SIGSELECT sigsel[] = {1,ETHREADWRAPDATASIG}; + union SIGNAL *init_msg = receive(sigsel); + + thr_func = init_msg->data.thr_func; + arg = init_msg->data.arg; + + result = (ethr_sint32_t) ethr_make_ts_event__(&tsep); + + if (result == 0) { + tsep->iflgs |= ETHR_TS_EV_ETHREAD; + my_tid = *init_msg->data.tid; + set_envp(current_process(), own_tid_key, (OSADDRESS)&my_tid); + if (ethr_thr_child_func__) + ethr_thr_child_func__(init_msg->data.prep_func_res); + } + + init_msg->data.result = result; + + send(&init_msg,sender(&init_msg)); + } + + /* pthread mutex api says we have to do this */ + signal_fsem(current_process()); + ETHR_ASSERT(get_fsem(current_process()) == 0); + + res = result == 0 ? (*thr_func)(arg) : NULL; + + ethr_thr_exit(&res); +} + +/* internal exports */ + +int ethr_set_tse__(ethr_ts_event *tsep) +{ + return ethr_tsd_set(ethr_ts_event_key__,(void *) tsep); +} + +ethr_ts_event *ethr_get_tse__(void) +{ + return (ethr_ts_event *) ethr_tsd_get(ethr_ts_event_key__); +} + +#if defined(ETHR_PPC_RUNTIME_CONF__) + +static int +ppc_init__(void) +{ + int pid; + + + ethr_runtime__.conf.have_lwsync = 0; + + return 0; +} + +#endif + +#if defined(ETHR_X86_RUNTIME_CONF__) + +void +ethr_x86_cpuid__(int *eax, int *ebx, int *ecx, int *edx) +{ +#if ETHR_SIZEOF_PTR == 4 + int have_cpuid; + /* + * If it is possible to toggle eflags bit 21, + * we have the cpuid instruction. + */ + __asm__ ("pushf\n\t" + "popl %%eax\n\t" + "movl %%eax, %%ecx\n\t" + "xorl $0x200000, %%eax\n\t" + "pushl %%eax\n\t" + "popf\n\t" + "pushf\n\t" + "popl %%eax\n\t" + "movl $0x0, %0\n\t" + "xorl %%ecx, %%eax\n\t" + "jz no_cpuid\n\t" + "movl $0x1, %0\n\t" + "no_cpuid:\n\t" + : "=r"(have_cpuid) + : + : "%eax", "%ecx", "cc"); + if (!have_cpuid) { + *eax = *ebx = *ecx = *edx = 0; + return; + } +#endif +#if ETHR_SIZEOF_PTR == 4 && defined(__PIC__) && __PIC__ + /* + * When position independet code is used in 32-bit mode, the B register + * is used for storage of global offset table address, and we may not + * use it as input or output in an asm. We need to save and restore the + * B register explicitly (for some reason gcc doesn't provide this + * service to us). + */ + __asm__ ("pushl %%ebx\n\t" + "cpuid\n\t" + "movl %%ebx, %1\n\t" + "popl %%ebx\n\t" + : "=a"(*eax), "=r"(*ebx), "=c"(*ecx), "=d"(*edx) + : "0"(*eax) + : "cc"); +#else + __asm__ ("cpuid\n\t" + : "=a"(*eax), "=b"(*ebx), "=c"(*ecx), "=d"(*edx) + : "0"(*eax) + : "cc"); +#endif +} + +#endif /* ETHR_X86_RUNTIME_CONF__ */ + +/* + * -------------------------------------------------------------------------- + * Exported functions + * -------------------------------------------------------------------------- + */ + +int +ethr_init(ethr_init_data *id) +{ + int res; + + if (!ethr_not_inited__) + return EINVAL; + + +#if defined(ETHR_PPC_RUNTIME_CONF__) + res = ppc_init__(); + if (res != 0) + goto error; +#endif + + res = ethr_init_common__(id); + if (res != 0) + goto error; + + main_thr_tid.id = current_process(); + main_thr_tid.tsd_key_index = 0; + + set_envp(current_process(),own_tid_key,(OSADDRESS)&main_thr_tid); + signal_fsem(current_process()); + + + ETHR_ASSERT(&main_thr_tid == ETHR_GET_OWN_TID__); + + ethr_not_inited__ = 0; + + ethr_tsd_key_create(ðr_ts_event_key__,"ethread_tse"); + + return 0; + error: + ethr_not_inited__ = 1; + return res; + +} + +int +ethr_late_init(ethr_late_init_data *id) +{ + int res = ethr_late_init_common__(id); + if (res != 0) + return res; + ethr_not_completely_inited__ = 0; + return res; +} + +int +ethr_thr_create(ethr_tid *tid, void * (*func)(void *), void *arg, + ethr_thr_opts *opts) +{ + int res; + int use_stack_size = (opts && opts->suggested_stack_size >= 0 + ? opts->suggested_stack_size + : 0x200 /* Use system default */); + OSPRIORITY use_prio; + char *use_name; + char default_thr_name[20]; + static int no_of_thr = 0; + cpuid_t use_core; + + union SIGNAL *init_msg; + SIGSELECT sigsel[] = {1,ETHREADWRAPDATASIG}; + void *prep_func_res; + + + if (opts != NULL) { + LOG(("ERTS - ethr_thr_create(): opts supplied: name: %s, coreNo: %u.\n", + opts->name, opts->coreNo)); + use_name = opts->name; + use_core = opts->coreNo; + if (0 != ethr_get_prio(use_name, &use_prio)) { + if (0 != ethr_get_prio("DEFAULT", &use_prio)) { + use_prio = get_pri(current_process()); + LOG(("ERTS - ethr_thr_create(): Using current process' prio: %d.\n", use_prio)); + } else { + LOG(("ERTS - ethr_thr_create(): Using default prio: %d.\n", use_prio)); + } + } else { + LOG(("ERTS - ethr_thr_create(): Using configured prio: %d.\n", use_prio)); + } + } else { + LOG(("ERTS - ethr_thr_create(): opts not supplied. Using defaults.\n")); + no_of_thr++; + sprintf(default_thr_name, "ethread_%d", no_of_thr); + use_name = default_thr_name; + use_core = ose_cpu_id(); + + if (0 != ethr_get_prio("DEFAULT", &use_prio)) { + use_prio = get_pri(current_process()); + LOG(("ERTS - ethr_thr_create(): Using current process' prio: %d.\n", use_prio)); + } + } + +#ifdef ETHR_MODIFIED_DEFAULT_STACK_SIZE + if (use_stack_size < 0) + use_stack_size = ETHR_MODIFIED_DEFAULT_STACK_SIZE; +#endif + +#if ETHR_XCHK + if (ethr_not_completely_inited__) { + ETHR_ASSERT(0); + return EACCES; + } + if (!tid || !func) { + ETHR_ASSERT(0); + return EINVAL; + } +#endif + + if (use_stack_size >= 0) { + size_t suggested_stack_size = (size_t) use_stack_size; + size_t stack_size; +#ifdef ETHR_DEBUG + suggested_stack_size /= 2; /* Make sure we got margin */ +#endif +#ifdef ETHR_STACK_GUARD_SIZE + /* The guard is at least on some platforms included in the stack size + passed when creating threads */ + suggested_stack_size += ETHR_B2KW(ETHR_STACK_GUARD_SIZE); +#endif + + if (suggested_stack_size < ethr_min_stack_size__) + stack_size = ETHR_KW2B(ethr_min_stack_size__); + else if (suggested_stack_size > ethr_max_stack_size__) + stack_size = ETHR_KW2B(ethr_max_stack_size__); + else + stack_size = ETHR_PAGE_ALIGN(ETHR_KW2B(suggested_stack_size)); + use_stack_size = stack_size; + } + + init_msg = alloc(sizeof(ethr_thr_wrap_data__), ETHREADWRAPDATASIG); + + /* Call prepare func if it exist */ + if (ethr_thr_prepare_func__) + init_msg->data.prep_func_res = ethr_thr_prepare_func__(); + else + init_msg->data.prep_func_res = NULL; + + LOG(("ERTS - ethr_thr_create(): Process [0x%x] is creating '%s', coreNo = %u, prio:%u\n", + current_process(), use_name, use_core, use_prio)); + + tid->id = create_process(OS_PRI_PROC, use_name, thr_wrapper, + use_stack_size, use_prio, 0, + get_bid(current_process()), NULL, 0, 0); + if (ose_bind_process(tid->id, use_core)) { + LOG(("ERTS - ethr_thr_create(): Bound pid 0x%x (%s) to core no %u.\n", + tid->id, use_name, use_core)); + } else { + LOG(("ERTS - ethr_thr_create(): Failed binding pid 0x%x (%s) to core no %u.\n", + tid->id, use_name, use_core)); + } + + /*FIXME!!! Normally this shouldn't be used in shared mode. Still there is + * a problem with stdin fd in fd_ processes which should be further + * investigated */ + efs_clone(tid->id); + + tid->tsd_key_index = 0; + tid->res = NULL; + + init_msg->data.tse = ethr_get_ts_event(); + init_msg->data.thr_func = func; + init_msg->data.arg = arg; + init_msg->data.tid = tid; + init_msg->data.name = opts->name; + + send(&init_msg, tid->id); + + start(tid->id); + init_msg = receive(sigsel); + + res = init_msg->data.result; + prep_func_res = init_msg->data.prep_func_res; + + free_buf(&init_msg); + /* Cleanup... */ + + if (ethr_thr_parent_func__) + ethr_thr_parent_func__(prep_func_res); + + LOG(("ERTS - ethr_thr_create(): Exiting.\n")); + return res; +} + +int +ethr_thr_join(ethr_tid tid, void **res) +{ + SIGSELECT sigsel[] = {1,OS_ATTACH_SIG}; +#if ETHR_XCHK + if (ethr_not_inited__) { + ETHR_ASSERT(0); + return EACCES; + } +#endif + + if (tid.id == ETHR_INVALID_TID_ID) + return EINVAL; + + attach(NULL,tid.id); + receive(sigsel); + + if (res) + *res = tid.res; + + return 0; +} + +int +ethr_thr_detach(ethr_tid tid) +{ +#if ETHR_XCHK + if (ethr_not_inited__) { + ETHR_ASSERT(0); + return EACCES; + } +#endif + return 0; +} + +void +ethr_thr_exit(void *res) +{ + ethr_tid *tid; +#if ETHR_XCHK + if (ethr_not_inited__) { + ETHR_ASSERT(0); + return; + } +#endif + tid = ETHR_GET_OWN_TID__; + if (!tid) { + ETHR_ASSERT(0); + kill_proc(current_process()); + } + thr_exit_cleanup(tid, res); + /* Harakiri possible? */ + kill_proc(current_process()); +} + +ethr_tid +ethr_self(void) +{ + ethr_tid *tid; +#if ETHR_XCHK + if (ethr_not_inited__) { + ethr_tid dummy_tid = {ETHR_INVALID_TID_ID, 0, NULL}; + ETHR_ASSERT(0); + return dummy_tid; + } +#endif + tid = ETHR_GET_OWN_TID__; + if (!tid) { + ethr_tid dummy_tid = {ETHR_INVALID_TID_ID, 0, NULL}; + return dummy_tid; + } + return *tid; +} + +int +ethr_equal_tids(ethr_tid tid1, ethr_tid tid2) +{ + return tid1.id == tid2.id && tid1.id != ETHR_INVALID_TID_ID; +} + + +/* + * Thread specific events + */ + +ethr_ts_event * +ethr_get_ts_event(void) +{ + return ethr_get_ts_event__(); +} + +void +ethr_leave_ts_event(ethr_ts_event *tsep) +{ + ethr_leave_ts_event__(tsep); +} + +/* + * Thread specific data + */ + +int +ethr_tsd_key_create(ethr_tsd_key *keyp, char *keyname) +{ + +#if ETHR_XCHK + if (ethr_not_inited__) { + ETHR_ASSERT(0); + return EACCES; + } + if (!keyp) { + ETHR_ASSERT(0); + return EINVAL; + } +#endif + + ose_create_ppdata(keyname,keyp); + + return 0; +} + +int +ethr_tsd_key_delete(ethr_tsd_key key) +{ +#if ETHR_XCHK + if (ethr_not_inited__) { + ETHR_ASSERT(0); + return EACCES; + } +#endif + /* Not possible to delete ppdata */ + + return 0; +} + +int +ethr_tsd_set(ethr_tsd_key key, void *value) +{ + void **ppdp; +#if ETHR_XCHK + if (ethr_not_inited__) { + ETHR_ASSERT(0); + return EACCES; + } +#endif + ppdp = (void **)ose_get_ppdata(key); + *ppdp = value; + return 0; +} + +void * +ethr_tsd_get(ethr_tsd_key key) +{ +#if ETHR_XCHK + if (ethr_not_inited__) { + ETHR_ASSERT(0); + return NULL; + } +#endif + return *(void**)ose_get_ppdata(key); +} + +/* + * Signal functions + */ + +#if ETHR_HAVE_ETHR_SIG_FUNCS + +int ethr_sigmask(int how, const sigset_t *set, sigset_t *oset) +{ +#if ETHR_XCHK + if (ethr_not_inited__) { + ETHR_ASSERT(0); + return EACCES; + } + if (!set && !oset) { + ETHR_ASSERT(0); + return EINVAL; + } +#endif + return pthread_sigmask(how, set, oset); +} + +int ethr_sigwait(const sigset_t *set, int *sig) +{ +#if ETHR_XCHK + if (ethr_not_inited__) { + ETHR_ASSERT(0); + return EACCES; + } + if (!set || !sig) { + ETHR_ASSERT(0); + return EINVAL; + } +#endif + if (sigwait(set, sig) < 0) + return errno; + return 0; +} + +#endif /* #if ETHR_HAVE_ETHR_SIG_FUNCS */ + +ETHR_IMPL_NORETURN__ +ethr_abort__(void) +{ + abort(); +} diff --git a/erts/lib_src/pthread/ethread.c b/erts/lib_src/pthread/ethread.c index fb7d135418..79784c5b84 100644 --- a/erts/lib_src/pthread/ethread.c +++ b/erts/lib_src/pthread/ethread.c @@ -472,7 +472,7 @@ ethr_leave_ts_event(ethr_ts_event *tsep) */ int -ethr_tsd_key_create(ethr_tsd_key *keyp) +ethr_tsd_key_create(ethr_tsd_key *keyp, char *keyname) { #if ETHR_XCHK if (ethr_not_inited__) { @@ -541,7 +541,11 @@ int ethr_sigmask(int how, const sigset_t *set, sigset_t *oset) return EINVAL; } #endif - return pthread_sigmask(how, set, oset); +#if defined(__ANDROID__) + return sigprocmask(how, set, oset); +#else + return pthread_sigmask(how, set, oset); +#endif } int ethr_sigwait(const sigset_t *set, int *sig) diff --git a/erts/lib_src/win/ethread.c b/erts/lib_src/win/ethread.c index 3abda6de4c..14d0b6deff 100644 --- a/erts/lib_src/win/ethread.c +++ b/erts/lib_src/win/ethread.c @@ -520,7 +520,7 @@ ethr_equal_tids(ethr_tid tid1, ethr_tid tid2) */ int -ethr_tsd_key_create(ethr_tsd_key *keyp) +ethr_tsd_key_create(ethr_tsd_key *keyp, char *keyname) { DWORD key; #if ETHR_XCHK diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex 6b132dc38b..26f851fd7a 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 eb696bb32f..344176b71b 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex 4a84b3945a..bd402f9a98 100644 --- a/erts/preloaded/ebin/erts_internal.beam +++ b/erts/preloaded/ebin/erts_internal.beam diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam Binary files differindex 758fe2cc23..5d49eed469 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 3fede5f0d9..2607739d12 100644 --- a/erts/preloaded/ebin/otp_ring0.beam +++ b/erts/preloaded/ebin/otp_ring0.beam diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam Binary files differindex 42c15f681f..d665d35ab1 100644 --- a/erts/preloaded/ebin/prim_eval.beam +++ b/erts/preloaded/ebin/prim_eval.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex e40e33b332..201252de34 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 90395a7564..ff8265414e 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 e1aaa0f451..f80d4a96e5 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 ffd80f51ba..dba3ec9546 100644 --- a/erts/preloaded/ebin/zlib.beam +++ b/erts/preloaded/ebin/zlib.beam diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl index 4b9e901c6d..578913b633 100644 --- a/erts/preloaded/src/erl_prim_loader.erl +++ b/erts/preloaded/src/erl_prim_loader.erl @@ -262,6 +262,8 @@ check_file_result(_, _, {error,enoent}) -> error; check_file_result(_, _, {error,enotdir}) -> error; +check_file_result(_, _, {error,einval}) -> + error; check_file_result(Func, Target, {error,Reason}) -> case (catch atom_to_list(Reason)) of {'EXIT',_} -> % exit trapped @@ -1392,6 +1394,8 @@ absname_vr([Drive, $\: | NameRest], _) -> %% Assumes normalized name pathtype(Name) when is_list(Name) -> case erlang:system_info(os_type) of + {ose, _} -> + unix_pathtype(Name); {unix, _} -> unix_pathtype(Name); {win32, _} -> diff --git a/erts/preloaded/src/erts.app.src b/erts/preloaded/src/erts.app.src index fd3e8cb692..a15da3a421 100644 --- a/erts/preloaded/src/erts.app.src +++ b/erts/preloaded/src/erts.app.src @@ -35,7 +35,8 @@ {registered, []}, {applications, []}, {env, []}, - {mod, {erts, []}} + {mod, {erts, []}}, + {runtime_dependencies, ["stdlib-2.0", "kernel-3.0", "sasl-2.4"]} ]}. %% vim: ft=erlang diff --git a/erts/start_scripts/no_dot_erlang.rel.src b/erts/start_scripts/no_dot_erlang.rel.src index 03b64ebf1a..6208572c00 100644 --- a/erts/start_scripts/no_dot_erlang.rel.src +++ b/erts/start_scripts/no_dot_erlang.rel.src @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2014. 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 @@ -16,6 +16,6 @@ %% %% %CopyrightEnd% %% -{release, {"OTP APN 181 01","%SYS_VSN%"}, {erts, "%ERTS_VSN%"}, +{release, {"Erlang/OTP","%SYS_VSN%"}, {erts, "%ERTS_VSN%"}, [{kernel,"%KERNEL_VSN%"}, {stdlib,"%STDLIB_VSN%"}]}. diff --git a/erts/start_scripts/start_all_example.rel.src b/erts/start_scripts/start_all_example.rel.src index 581eb2eb0b..2a1cabe7bb 100644 --- a/erts/start_scripts/start_all_example.rel.src +++ b/erts/start_scripts/start_all_example.rel.src @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -16,7 +16,7 @@ %% %% %CopyrightEnd% %% -{release, {"OTP APN 181 01","%SYS_VSN%"}, {erts, "%ERTS_VSN%"}, +{release, {"Erlang/OTP","%SYS_VSN%"}, {erts, "%ERTS_VSN%"}, [{kernel,"%KERNEL_VSN%"}, {stdlib,"%STDLIB_VSN%"}, {sasl, "%SASL_VSN%"}, diff --git a/erts/start_scripts/start_clean.rel.src b/erts/start_scripts/start_clean.rel.src index d2df422c51..e229721e36 100644 --- a/erts/start_scripts/start_clean.rel.src +++ b/erts/start_scripts/start_clean.rel.src @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -16,6 +16,6 @@ %% %% %CopyrightEnd% %% -{release, {"OTP APN 181 01","%SYS_VSN%"}, {erts, "%ERTS_VSN%"}, +{release, {"Erlang/OTP","%SYS_VSN%"}, {erts, "%ERTS_VSN%"}, [{kernel,"%KERNEL_VSN%"}, {stdlib,"%STDLIB_VSN%"}]}. diff --git a/erts/start_scripts/start_sasl.rel.src b/erts/start_scripts/start_sasl.rel.src index e521e8df91..e68a34af76 100644 --- a/erts/start_scripts/start_sasl.rel.src +++ b/erts/start_scripts/start_sasl.rel.src @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -16,7 +16,7 @@ %% %% %CopyrightEnd% %% -{release, {"OTP APN 181 01","%SYS_VSN%"}, {erts, "%ERTS_VSN%"}, +{release, {"Erlang/OTP","%SYS_VSN%"}, {erts, "%ERTS_VSN%"}, [{kernel,"%KERNEL_VSN%"}, {stdlib,"%STDLIB_VSN%"}, {sasl, "%SASL_VSN%"}]}. diff --git a/erts/test/ethread_SUITE_data/ethread_tests.c b/erts/test/ethread_SUITE_data/ethread_tests.c index ed96ecdbd2..1d8083ef1f 100644 --- a/erts/test/ethread_SUITE_data/ethread_tests.c +++ b/erts/test/ethread_SUITE_data/ethread_tests.c @@ -976,7 +976,7 @@ tsd_test(void) ethr_tid tid[TT_THREADS]; int values[TT_THREADS]; - res = ethr_tsd_key_create(&tt_key); + res = ethr_tsd_key_create(&tt_key,"tsd_test"); ASSERT(res == 0); for (i = 1; i < TT_THREADS; i++) { diff --git a/erts/test/otp_SUITE.erl b/erts/test/otp_SUITE.erl index 8e4a1a4b1c..1fb452501f 100644 --- a/erts/test/otp_SUITE.erl +++ b/erts/test/otp_SUITE.erl @@ -24,7 +24,7 @@ -export([undefined_functions/1,deprecated_not_in_obsolete/1, obsolete_but_not_deprecated/1,call_to_deprecated/1, call_to_size_1/1,strong_components/1, - erl_file_encoding/1,xml_file_encoding/1]). + erl_file_encoding/1,xml_file_encoding/1,runtime_dependencies/1]). -include_lib("test_server/include/test_server.hrl"). @@ -36,7 +36,8 @@ all() -> [undefined_functions, deprecated_not_in_obsolete, obsolete_but_not_deprecated, call_to_deprecated, call_to_size_1, strong_components, - erl_file_encoding, xml_file_encoding]. + erl_file_encoding, xml_file_encoding, + runtime_dependencies]. groups() -> []. @@ -380,6 +381,63 @@ is_bad_encoding(File) -> true end. +runtime_dependencies(Config) -> + %% Verify that (at least) OTP application runtime dependencies found + %% by xref are listed in the runtime_dependencies field of the .app file + %% of each application. + Server = ?config(xref_server, Config), + {ok, AE} = xref:q(Server, "AE"), + SAE = lists:keysort(1, AE), + {AppDep, AppDeps} = lists:foldl(fun ({App, App}, Acc) -> + Acc; + ({App, Dep}, {undefined, []}) -> + {{App, [Dep]}, []}; + ({App, Dep}, {{App, Deps}, AppDeps}) -> + {{App, [Dep|Deps]}, AppDeps}; + ({App, Dep}, {AppDep, AppDeps}) -> + {{App, [Dep]}, [AppDep | AppDeps]} + end, + {undefined, []}, + SAE), + [] = check_apps_deps([AppDep|AppDeps]), + ok. + +have_rdep(_App, [], _Dep) -> + false; +have_rdep(App, [RDep | RDeps], Dep) -> + [AppStr, _VsnStr] = string:tokens(RDep, "-"), + case Dep == list_to_atom(AppStr) of + true -> + io:format("~p -> ~s~n", [App, RDep]), + true; + false -> + have_rdep(App, RDeps, Dep) + end. + +check_app_deps(_App, _AppFile, _AFDeps, []) -> + []; +check_app_deps(App, AppFile, AFDeps, [XRDep | XRDeps]) -> + ResOtherDeps = check_app_deps(App, AppFile, AFDeps, XRDeps), + case have_rdep(App, AFDeps, XRDep) of + true -> + ResOtherDeps; + false -> + [{missing_runtime_dependency, AppFile, XRDep} | ResOtherDeps] + end. + +check_apps_deps([]) -> + []; +check_apps_deps([{App, Deps}|AppDeps]) -> + ResOtherApps = check_apps_deps(AppDeps), + AppFile = code:where_is_file(atom_to_list(App) ++ ".app"), + {ok,[{application, App, Info}]} = file:consult(AppFile), + case lists:keyfind(runtime_dependencies, 1, Info) of + {runtime_dependencies, RDeps} -> + check_app_deps(App, AppFile, RDeps, Deps) ++ ResOtherApps; + false -> + [{missing_runtime_dependencies_key, AppFile} | ResOtherApps] + end. + %%% %%% Common help functions. %%% diff --git a/lib/Makefile b/lib/Makefile index 4b979fc28a..95170d8a56 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -35,7 +35,7 @@ ALL_ERLANG_APPLICATIONS = xmerl edoc erl_docgen snmp otp_mibs erl_interface \ public_key ssl observer odbc diameter \ cosTransactions cosEvent cosTime cosNotification \ cosProperty cosFileTransfer cosEventDomain et megaco webtool \ - eunit ssh typer percept eldap dialyzer hipe + eunit ssh typer percept eldap dialyzer hipe ose ifdef BUILD_ALL ERLANG_APPLICATIONS += $(ALL_ERLANG_APPLICATIONS) diff --git a/lib/asn1/Makefile b/lib/asn1/Makefile index 1bc303b73c..18e95a2471 100644 --- a/lib/asn1/Makefile +++ b/lib/asn1/Makefile @@ -25,6 +25,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk # SUB_DIRECTORIES = src doc/src c_src + static_lib: SUB_DIRECTORIES = c_src @@ -62,7 +63,6 @@ info: version: @echo "$(VSN)" - # ---------------------------------------------------- # Application (source) release targets # ---------------------------------------------------- diff --git a/lib/asn1/c_src/Makefile b/lib/asn1/c_src/Makefile index ded4b73d1b..a7cd03f516 100644 --- a/lib/asn1/c_src/Makefile +++ b/lib/asn1/c_src/Makefile @@ -96,7 +96,12 @@ endif _create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) +ifneq ($(findstring ose,$(TARGET)),ose) opt: $(NIF_SHARED_OBJ_FILE) +else +# Do not build dynamic files on OSE +opt: +endif debug: opt @@ -134,7 +139,9 @@ include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt $(INSTALL_DIR) "$(RELSYSDIR)/priv/lib" +ifneq ($(findstring ose,$(TARGET)),ose) $(INSTALL_PROGRAM) $(NIF_SHARED_OBJ_FILE) "$(RELSYSDIR)/priv/lib" +endif $(INSTALL_DIR) "$(RELSYSDIR)/c_src" $(INSTALL_DATA) *.c "$(RELSYSDIR)/c_src" diff --git a/lib/asn1/c_src/asn1_erl_nif.c b/lib/asn1/c_src/asn1_erl_nif.c index 0930010fda..8a0e4b1cf0 100644 --- a/lib/asn1/c_src/asn1_erl_nif.c +++ b/lib/asn1/c_src/asn1_erl_nif.c @@ -1320,6 +1320,7 @@ static void unload(ErlNifEnv* env, void* priv_data) { } + static ErlNifFunc nif_funcs[] = { { "encode_per_complete", 1, encode_per_complete }, { "decode_ber_tlv_raw", 1, decode_ber_tlv_raw }, diff --git a/lib/asn1/src/asn1.app.src b/lib/asn1/src/asn1.app.src index f2ee8deb75..02cbba0f10 100644 --- a/lib/asn1/src/asn1.app.src +++ b/lib/asn1/src/asn1.app.src @@ -10,5 +10,6 @@ asn1db ]}, {env, []}, - {applications, [kernel, stdlib]} + {applications, [kernel, stdlib]}, + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0"]} ]}. diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index 9ec43197bf..8470e5a1b4 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -566,6 +566,8 @@ get_pos_of_def(#pobjectdef{pos=Pos}) -> Pos; get_pos_of_def(#pobjectsetdef{pos=Pos}) -> Pos; +get_pos_of_def(#'Externaltypereference'{pos=Pos}) -> + Pos; get_pos_of_def(#'Externalvaluereference'{pos=Pos}) -> Pos; get_pos_of_def(_) -> diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index b9f2cb876a..e788aa5c6c 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -270,46 +270,30 @@ check_exports(S,Module = #module{}) -> end end. -check_imports(S,Module = #module{ }) -> - case Module#module.imports of - {imports,[]} -> - []; - {imports,ImportList} when is_list(ImportList) -> - check_imports2(S,ImportList,[]); - _ -> - [] - end. -check_imports2(_S,[],Acc) -> +check_imports(S, #module{imports={imports,Imports}}) -> + check_imports_1(S, Imports, []). + +check_imports_1(_S, [], Acc) -> Acc; -check_imports2(S,[#'SymbolsFromModule'{symbols=Imports,module=ModuleRef}|SFMs],Acc) -> - NameOfDef = - fun(#'Externaltypereference'{type=N}) -> N; - (#'Externalvaluereference'{value=N}) -> N - end, - Module = NameOfDef(ModuleRef), - Refs = [{M,R}||{{M,_},R} <- [{catch get_referenced_type(S,Ref),Ref}||Ref <- Imports]], - {Illegal,Other} = lists:splitwith(fun({error,_}) -> true;(_) -> false end, - Refs), - ChainedRefs = [R||{M,R} <- Other, M =/= Module], - IllegalRefs = [R||{error,R} <- Illegal] ++ - [R||{M,R} <- ChainedRefs, - ok =/= chained_import(S,Module,M,NameOfDef(R))], - ReportError = - fun(Ref) -> - NewS=S#state{type=Ref,tname=NameOfDef(Ref)}, - error({import,"imported undefined entity",NewS}) - end, - check_imports2(S,SFMs,[ReportError(Err)||Err <- IllegalRefs]++Acc). +check_imports_1(S, [#'SymbolsFromModule'{symbols=Imports,module=ModuleRef}|SFMs], Acc0) -> + Module = name_of_def(ModuleRef), + Refs0 = [{catch get_referenced_type(S, Ref),Ref} || Ref <- Imports], + Refs = [{M,R} || {{M,_},R} <- Refs0], + {Illegal,Other} = lists:splitwith(fun({error,_}) -> true; + (_) -> false + end, Refs), + ChainedRefs = [R || {M,R} <- Other, M =/= Module], + IllegalRefs = [R || {error,R} <- Illegal] ++ + [R || {M,R} <- ChainedRefs, + ok =/= chained_import(S, Module, M, name_of_def(R))], + Acc = [return_asn1_error(S, Ref, {undefined_import,name_of_def(Ref),Module}) || + Ref <- IllegalRefs] ++ Acc0, + check_imports_1(S, SFMs, Acc). chained_import(S,ImpMod,DefMod,Name) -> %% Name is a referenced structure that is not defined in ImpMod, %% but must be present in the Imports list of ImpMod. The chain of %% imports of Name must end in DefMod. - NameOfDef = - fun(#'Externaltypereference'{type=N}) -> N; - (#'Externalvaluereference'{value=N}) -> N; - (Other) -> Other - end, GetImports = fun(_M_) -> case asn1_db:dbget(_M_,'MODULE') of @@ -321,9 +305,9 @@ chained_import(S,ImpMod,DefMod,Name) -> FindNameInImports = fun([],N,_) -> {no_mod,N}; ([#'SymbolsFromModule'{symbols=Imports,module=ModuleRef}|SFMs],N,F) -> - case [NameOfDef(X)||X <- Imports, NameOfDef(X) =:= N] of + case [name_of_def(X) || X <- Imports, name_of_def(X) =:= N] of [] -> F(SFMs,N,F); - [N] -> {NameOfDef(ModuleRef),N} + [N] -> {name_of_def(ModuleRef),N} end end, case GetImports(ImpMod) of @@ -1567,13 +1551,13 @@ check_defaultfields(S, Fields, ClassFields) -> [] -> ok; [_|_]=Invalid -> - throw(asn1_error(S, T, {invalid_fields,Invalid,Obj})) + asn1_error(S, T, {invalid_fields,Invalid,Obj}) end, case ordsets:subtract(Mandatory, Present) of [] -> check_defaultfields_1(S, Fields, ClassFields, []); [_|_]=Missing -> - throw(asn1_error(S, T, {missing_mandatory_fields,Missing,Obj})) + asn1_error(S, T, {missing_mandatory_fields,Missing,Obj}) end. check_defaultfields_1(_S, [], _ClassFields, Acc) -> @@ -2614,7 +2598,7 @@ normalize_octetstring(S,Value,CType) -> normalize_octetstring(S,String,CType); _ -> Item = S#state.value, - throw(asn1_error(S, Item, illegal_octet_string_value)) + asn1_error(S, Item, illegal_octet_string_value) end. normalize_objectidentifier(S, Value) -> @@ -2645,7 +2629,7 @@ lookup_enum_value(S, Id, NNL) when is_atom(Id) -> {_,_}=Ret -> Ret; false -> - throw(asn1_error(S, S#state.value, {undefined,Id})) + asn1_error(S, S#state.value, {undefined,Id}) end. normalize_choice(S,{'CHOICE',{C,V}},CType,NameList) when is_atom(C) -> @@ -3084,7 +3068,7 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))}; {'INTEGER',NamedNumberList} -> - TempNewDef#newt{type={'INTEGER',check_integer(S,NamedNumberList,Constr)}, + TempNewDef#newt{type={'INTEGER',check_integer(S,NamedNumberList)}, tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))}; 'REAL' -> @@ -3092,8 +3076,7 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> TempNewDef#newt{tag=merge_tags(Tag,?TAG_PRIMITIVE(?N_REAL))}; {'BIT STRING',NamedNumberList} -> - NewL = check_bitstring(S,NamedNumberList,Constr), -%% erlang:display({asn1ct_check,NamedNumberList,NewL}), + NewL = check_bitstring(S, NamedNumberList), TempNewDef#newt{type={'BIT STRING',NewL}, tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_BIT_STRING))}; @@ -4910,73 +4893,46 @@ imported1(Name, end; imported1(_Name,[]) -> false. - -check_integer(_S,[],_C) -> +%% Check the named number list for an INTEGER or a BIT STRING. +check_named_number_list(_S, []) -> []; -check_integer(S,NamedNumberList,_C) -> - case [X || X <- NamedNumberList, tuple_size(X) =:= 2] of - NamedNumberList -> - %% An already checked integer with NamedNumberList - NamedNumberList; - _ -> - case check_unique(NamedNumberList,2) of - [] -> - check_int(S,NamedNumberList,[]); - L when is_list(L) -> - error({type,{duplicates,L},S}), - unchanged - end +check_named_number_list(_S, [{_,_}|_]=NNL) -> + %% The named number list has already been checked. + NNL; +check_named_number_list(S, NNL0) -> + %% Check that the names are unique. + T = S#state.type, + case check_unique(NNL0, 2) of + [] -> + NNL1 = [{Id,resolve_valueref(S, Val)} || {'NamedNumber',Id,Val} <- NNL0], + NNL = lists:keysort(2, NNL1), + case check_unique(NNL, 2) of + [] -> + NNL; + [Val|_] -> + asn1_error(S, T, {value_reused,Val}) + end; + [H|_] -> + asn1_error(S, T, {namelist_redefinition,H}) end. - -check_int(S,[{'NamedNumber',Id,Num}|T],Acc) when is_integer(Num) -> - check_int(S,T,[{Id,Num}|Acc]); -check_int(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc) -> - Val = dbget_ex(S,S#state.mname,Name), - check_int(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc); -check_int(S,[{'NamedNumber',Id,{'Externalvaluereference',_,Mod,Name}}|T],Acc) -> - Val = dbget_ex(S,Mod,Name), - check_int(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc); -check_int(_S,[],Acc) -> - lists:keysort(2,Acc). +resolve_valueref(S, #'Externalvaluereference'{module=Mod,value=Name}) -> + dbget_ex(S, Mod, Name); +resolve_valueref(_, Val) when is_integer(Val) -> + Val. -check_real(_S,_Constr) -> - ok. +check_integer(S, NNL) -> + check_named_number_list(S, NNL). -check_bitstring(_S,[],_Constr) -> - []; -check_bitstring(S,NamedNumberList,_Constr) -> - case check_unique(NamedNumberList,2) of - [] -> - check_bitstr(S,NamedNumberList,[]); - L when is_list(L) -> - error({type,{duplicates,L},S}), - unchanged - end. +check_bitstring(S, NNL0) -> + NNL = check_named_number_list(S, NNL0), + _ = [asn1_error(S, S#state.type, {invalid_bit_number,Bit}) || + {_,Bit} <- NNL, Bit < 0], + NNL. -check_bitstr(S,[{'NamedNumber',Id,Num}|T],Acc)when is_integer(Num) -> - check_bitstr(S,T,[{Id,Num}|Acc]); -check_bitstr(S,[{'NamedNumber',Id,Name}|T],Acc) when is_atom(Name) -> -%%check_bitstr(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc) -> -%% io:format("asn1ct_check:check_bitstr/3 hej hop ~w~n",[Name]), - Val = dbget_ex(S,S#state.mname,Name), -%% io:format("asn1ct_check:check_bitstr/3: ~w~n",[Val]), - check_bitstr(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc); -check_bitstr(S,[],Acc) -> - case check_unique(Acc,2) of - [] -> - lists:keysort(2,Acc); - L when is_list(L) -> - error({type,{duplicate_values,L},S}), - unchanged - end; -%% When a BIT STRING already is checked, for instance a COMPONENTS OF S -%% where S is a sequence that has a component that is a checked BS, the -%% NamedNumber list is a list of {atom(),integer()} elements. -check_bitstr(S,[El={Id,Num}|Rest],Acc) when is_atom(Id),is_integer(Num) -> - check_bitstr(S,Rest,[El|Acc]). - +check_real(_S,_Constr) -> + ok. %% Check INSTANCE OF %% check that DefinedObjectClass is of TYPE-IDENTIFIER class @@ -4987,20 +4943,16 @@ check_instance_of(S,DefinedObjectClass,Constraint) -> check_type_identifier(S,DefinedObjectClass), iof_associated_type(S,Constraint). - -check_type_identifier(_S,'TYPE-IDENTIFIER') -> - ok; -check_type_identifier(S,Eref=#'Externaltypereference'{}) -> - case get_referenced_type(S,Eref) of - {_,#classdef{name='TYPE-IDENTIFIER'}} -> ok; - {_,#classdef{typespec=NextEref}} - when is_record(NextEref,'Externaltypereference') -> - check_type_identifier(S,NextEref); +check_type_identifier(S, Eref=#'Externaltypereference'{type=Class}) -> + case get_referenced_type(S, Eref) of + {_,#classdef{name='TYPE-IDENTIFIER'}} -> + ok; + {_,#classdef{typespec=#'Externaltypereference'{}=NextEref}} -> + check_type_identifier(S, NextEref); {_,TD=#typedef{typespec=#type{def=#'Externaltypereference'{}}}} -> - check_type_identifier(S,(TD#typedef.typespec)#type.def); - Err -> - error({type,{"object set in type INSTANCE OF " - "not of class TYPE-IDENTIFIER",Eref,Err},S}) + check_type_identifier(S, (TD#typedef.typespec)#type.def); + _ -> + asn1_error(S, S#state.type, {illegal_instance_of,Class}) end. iof_associated_type(S,[]) -> @@ -5130,9 +5082,6 @@ check_enumerated(S,NamedNumberList,_Constr) -> %% the latter is returned if the ENUMERATION contains EXTENSIONMARK check_enum(S,[{'NamedNumber',Id,Num}|T],Acc1,Acc2,Root) when is_integer(Num) -> check_enum(S,T,[{Id,Num}|Acc1],Acc2,Root); -check_enum(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc1,Acc2,Root) -> - Val = dbget_ex(S,S#state.mname,Name), - check_enum(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc1,Acc2,Root); check_enum(S,['EXTENSIONMARK'|T],Acc1,Acc2,_Root) -> NewAcc2 = lists:keysort(2,Acc1), NewList = enum_number(lists:reverse(Acc2),NewAcc2,0,[],[]), @@ -6748,7 +6697,7 @@ storeindb(#state{mname=Module}=S, [H|T], Errors) -> storeindb(S, T, Errors); Prev -> PrevLine = asn1ct:get_pos_of_def(Prev), - {error,Error} = asn1_error(S, H, {already_defined,Name,PrevLine}), + Error = return_asn1_error(S, H, {already_defined,Name,PrevLine}), storeindb(S, T, [Error|Errors]) end; storeindb(_, [], []) -> @@ -6795,22 +6744,37 @@ findtypes_and_values([],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) -> {lists:reverse(Tacc),lists:reverse(Vacc),lists:reverse(Pacc), lists:reverse(Cacc),lists:reverse(Oacc),lists:reverse(OSacc)}. -asn1_error(#state{mname=Where}, Item, Error) -> +return_asn1_error(#state{mname=Where}, Item, Error) -> Pos = asn1ct:get_pos_of_def(Item), - {error,{structured_error,{Where,Pos},?MODULE,Error}}. + {structured_error,{Where,Pos},?MODULE,Error}. + +asn1_error(S, Item, Error) -> + throw({error,return_asn1_error(S, Item, Error)}). format_error({already_defined,Name,PrevLine}) -> io_lib:format("the name ~p has already been defined at line ~p", [Name,PrevLine]); +format_error({illegal_instance_of,Class}) -> + io_lib:format("using INSTANCE OF on class '~s' is illegal, " + "because INSTANCE OF may only be used on the class TYPE-IDENTFIER", + [Class]); format_error(illegal_octet_string_value) -> "expecting a bstring or an hstring as value for an OCTET STRING"; format_error({invalid_fields,Fields,Obj}) -> io_lib:format("invalid ~s in ~p", [format_fields(Fields),Obj]); +format_error({invalid_bit_number,Bit}) -> + io_lib:format("the bit number '~p' is invalid", [Bit]); format_error({missing_mandatory_fields,Fields,Obj}) -> io_lib:format("missing mandatory ~s in ~p", [format_fields(Fields),Obj]); +format_error({namelist_redefinition,Name}) -> + io_lib:format("the name '~s' can not be redefined", [Name]); format_error({undefined,Name}) -> io_lib:format("'~s' is referenced, but is not defined", [Name]); +format_error({undefined_import,Ref,Module}) -> + io_lib:format("'~s' is not exported from ~s", [Ref,Module]); +format_error({value_reused,Val}) -> + io_lib:format("the value '~p' is used more than once", [Val]); format_error(Other) -> io_lib:format("~p", [Other]). @@ -6826,14 +6790,6 @@ error({export,Msg,#state{mname=Mname,type=Ref,tname=Typename}}) -> Pos = Ref#'Externaltypereference'.pos, io:format("asn1error:~p:~p:~p~n~p~n",[Pos,Mname,Typename,Msg]), {error,{export,Pos,Mname,Typename,Msg}}; -error({import,Msg,#state{mname=Mname,type=Ref,tname=Typename}}) -> - PosOfDef = - fun(#'Externaltypereference'{pos=P}) -> P; - (#'Externalvaluereference'{pos=P}) -> P - end, - Pos = PosOfDef(Ref), - io:format("asn1error:~p:~p:~p~n~p~n",[Pos,Mname,Typename,Msg]), - {error,{import,Pos,Mname,Typename,Msg}}; % error({type,{Msg1,Msg2},#state{mname=Mname,type=Type,tname=Typename}}) % when is_record(Type,typedef) -> % io:format("asn1error:~p:~p:~p ~p~n", @@ -7134,3 +7090,6 @@ check_fold(S, [H|T], Check) -> [Error|check_fold(S, T, Check)] end; check_fold(_, [], Check) when is_function(Check, 3) -> []. + +name_of_def(#'Externaltypereference'{type=N}) -> N; +name_of_def(#'Externalvaluereference'{value=N}) -> N. diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 4707e517b4..44b050e59d 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -1125,7 +1125,22 @@ pgen_info() -> open_hrl(OutFile,Module) -> File = lists:concat([OutFile,".hrl"]), _ = open_output_file(File), - gen_hrlhead(Module). + gen_hrlhead(Module), + Protector = hrl_protector(OutFile), + emit(["-ifndef(",Protector,").\n", + "-define(",Protector,", true).\n" + "\n"]). + +hrl_protector(OutFile) -> + BaseName = filename:basename(OutFile), + P = "_" ++ string:to_upper(BaseName) ++ "_HRL_", + [if + $A =< C, C =< $Z -> C; + $a =< C, C =< $a -> C; + $0 =< C, C =< $9 -> C; + true -> $_ + end || C <- P]. + %% EMIT functions ************************ %% *************************************** @@ -1232,6 +1247,8 @@ pgen_hrl(Erules,Module,TypeOrVal,Options,_Indent) -> 0 -> 0; Y -> + Protector = hrl_protector(get(outfile)), + emit(["-endif. %% ",Protector,"\n"]), close_output_file(), asn1ct:verbose("--~p--~n", [{generated,lists:concat([get(outfile),".hrl"])}], diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index 3b34feb5a3..782217ed2d 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -813,10 +813,10 @@ testExport(Config) -> testImport(Config) -> test(Config, fun testImport/3). testImport(Config, Rule, Opts) -> - {error, _} = asn1ct:compile(filename:join(?config(data_dir, Config), - "ImportsFrom"), - [Rule, {outdir, ?config(priv_dir, Config)} - |Opts]). + Files = ["ImportsFrom","ImportsFrom2","ImportsFrom3"], + asn1_test_lib:compile_all(Files, Config, [Rule|Opts]), + 42 = 'ImportsFrom':i(), + ok. testMegaco(Config) -> test(Config, fun testMegaco/3). testMegaco(Config, Rule, Opts) -> @@ -860,7 +860,7 @@ duplicate_tags(Config) -> rtUI(Config) -> test(Config, fun rtUI/3). rtUI(Config, Rule, Opts) -> asn1_test_lib:compile("Prim", Config, [Rule|Opts]), - {ok, _} = asn1rt:info('Prim'), + _ = 'Prim':info(), Rule = 'Prim':encoding_rule(), io:format("Default BIT STRING format: ~p\n", ['Prim':bit_string_format()]). diff --git a/lib/asn1/test/asn1_SUITE_data/INSTANCEOF.asn1 b/lib/asn1/test/asn1_SUITE_data/INSTANCEOF.asn1 index 8c4f3a8f7e..b4ea943040 100644 --- a/lib/asn1/test/asn1_SUITE_data/INSTANCEOF.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/INSTANCEOF.asn1 @@ -16,7 +16,9 @@ Names ::= SEQUENCE { thirdName [2] INSTANCE OF OTHER-NAME ({TI}) } -OTHER-NAME ::= TYPE-IDENTIFIER +OTHER-NAME ::= YET-ANOTHER-NAME + +YET-ANOTHER-NAME ::= TYPE-IDENTIFIER TI OTHER-NAME ::= {{INTEGER IDENTIFIED BY {2 4}} | {Seq IDENTIFIED BY {2 3 4}} | diff --git a/lib/asn1/test/asn1_SUITE_data/ImportsFrom.asn1 b/lib/asn1/test/asn1_SUITE_data/ImportsFrom.asn1 index 896a35d627..32b8f75dde 100644 --- a/lib/asn1/test/asn1_SUITE_data/ImportsFrom.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/ImportsFrom.asn1 @@ -1,16 +1,8 @@ -ImportsFrom DEFINITIONS ::= - +ImportsFrom DEFINITIONS AUTOMATIC TAGS ::= BEGIN -IMPORTS -Type1, Type2, Type3 -FROM RemoteFile1 objid -val1, val2, val3 -FROM RemoteFile2; - -objid OBJECT IDENTIFIER ::= {joint-iso-ccitt(2) remote-operations(4) notation(0)} - -LocalType ::= INTEGER +IMPORTS Int FROM ImportsFrom2; +i Int ::= 42 END diff --git a/lib/asn1/test/asn1_SUITE_data/ImportsFrom2.asn1 b/lib/asn1/test/asn1_SUITE_data/ImportsFrom2.asn1 new file mode 100644 index 0000000000..b0c29d24ae --- /dev/null +++ b/lib/asn1/test/asn1_SUITE_data/ImportsFrom2.asn1 @@ -0,0 +1,7 @@ +ImportsFrom2 DEFINITIONS AUTOMATIC TAGS ::= +BEGIN +IMPORTS Int FROM ImportsFrom3; + +LocalDef ::= OCTET STRING + +END diff --git a/lib/asn1/test/asn1_SUITE_data/ImportsFrom3.asn1 b/lib/asn1/test/asn1_SUITE_data/ImportsFrom3.asn1 new file mode 100644 index 0000000000..ca27b20697 --- /dev/null +++ b/lib/asn1/test/asn1_SUITE_data/ImportsFrom3.asn1 @@ -0,0 +1,4 @@ +ImportsFrom3 DEFINITIONS AUTOMATIC TAGS ::= +BEGIN + Int ::= INTEGER (0..63) +END diff --git a/lib/asn1/test/error_SUITE.erl b/lib/asn1/test/error_SUITE.erl index 930b44cea6..8a0414708d 100644 --- a/lib/asn1/test/error_SUITE.erl +++ b/lib/asn1/test/error_SUITE.erl @@ -19,7 +19,8 @@ -module(error_SUITE). -export([suite/0,all/0,groups/0, - already_defined/1,enumerated/1,objects/1,values/1]). + already_defined/1,bitstrings/1,enumerated/1, + imports/1,instance_of/1,integers/1,objects/1,values/1]). -include_lib("test_server/include/test_server.hrl"). @@ -31,7 +32,11 @@ all() -> groups() -> [{p,parallel(), [already_defined, + bitstrings, enumerated, + imports, + instance_of, + integers, objects, values]}]. @@ -70,6 +75,23 @@ already_defined(Config) -> } = run(P, Config), ok. +bitstrings(Config) -> + M = 'Bitstrings', + P = {M, + <<"Bitstrings DEFINITIONS AUTOMATIC TAGS ::= BEGIN\n" + " Bs1 ::= BIT STRING {a(1), a(1)}\n" + " Bs2 ::= BIT STRING {a(1), b(2), a(3)}\n" + " Bs3 ::= BIT STRING {x(1), y(1)}\n" + " Bs4 ::= BIT STRING {x(-1), y(0)}\n" + "END\n">>}, + {error, + [{structured_error,{M,2},asn1ct_check,{namelist_redefinition,a}}, + {structured_error,{M,3},asn1ct_check,{namelist_redefinition,a}}, + {structured_error,{M,4},asn1ct_check,{value_reused,1}}, + {structured_error,{M,5},asn1ct_check,{invalid_bit_number,-1}} + ]} = run(P, Config), + ok. + enumerated(Config) -> M = 'Enumerated', P = {M, @@ -98,6 +120,63 @@ enumerated(Config) -> } = run(P, Config), ok. +imports(Config) -> + Ext = 'ExternalModule', + ExtP = {Ext, + <<"ExternalModule DEFINITIONS AUTOMATIC TAGS ::= BEGIN\n" + "END\n">>}, + ok = run(ExtP, Config), + + M = 'Imports', + P = {M, + <<"Imports DEFINITIONS AUTOMATIC TAGS ::= BEGIN\n" + "IMPORTS NotDefined FROM ExternalModule\n" + "X FROM UndefinedModule objid\n" + "Y, Z FROM UndefinedModule2;\n" + "objid OBJECT IDENTIFIER ::= {joint-iso-ccitt(2) remote-operations(4)\n" + " notation(0)}\n" + "END\n">>}, + {error,[{structured_error,{M,2},asn1ct_check, + {undefined_import,'NotDefined','ExternalModule'}}, + {structured_error,{M,3},asn1ct_check,{undefined_import,'X','UndefinedModule'}}, + {structured_error,{M,4},asn1ct_check,{undefined_import,'Y','UndefinedModule2'}}, + {structured_error,{M,4},asn1ct_check,{undefined_import,'Z','UndefinedModule2'}} + ]} = run(P, Config), + ok. + +instance_of(Config) -> + M = 'InstanceOf', + P = {M, + <<"InstanceOf DEFINITIONS AUTOMATIC TAGS ::= BEGIN\n" + "XX ::= INSTANCE OF CL ({TI})\n" + "CL ::= CLASS {\n" + "&id INTEGER,\n" + "&Type\n" + "}\n" + "o1 CL ::= {&id 1, &Type OCTET STRING}\n" + "TI CL ::= { o1 }\n" + "END\n">>}, + {error, + [{structured_error,{M,2},asn1ct_check,{illegal_instance_of,'CL'}} + ]} = run(P, Config), + ok. + +integers(Config) -> + M = 'Integers', + P = {M, + <<"Integers DEFINITIONS AUTOMATIC TAGS ::= BEGIN\n" + " Int1 ::= INTEGER {a(1), a(1)}\n" + " Int2 ::= INTEGER {a(1), b(2), a(3)}\n" + " Int3 ::= INTEGER {x(1), y(1)}\n" + "END\n">>}, + {error, + [{structured_error,{M,2},asn1ct_check,{namelist_redefinition,a}}, + {structured_error,{M,3},asn1ct_check,{namelist_redefinition,a}}, + {structured_error,{M,4},asn1ct_check,{value_reused,1}} + ]} = run(P, Config), + ok. + + objects(Config) -> M = 'Objects', P = {M, diff --git a/lib/asn1/test/testPrimStrings.erl b/lib/asn1/test/testPrimStrings.erl index 3262d61a4d..155d6f6ff5 100644 --- a/lib/asn1/test/testPrimStrings.erl +++ b/lib/asn1/test/testPrimStrings.erl @@ -18,6 +18,8 @@ %% %% -module(testPrimStrings). +-compile([{nowarn_deprecated_function,{asn1rt,utf8_list_to_binary,1}}, + {nowarn_deprecated_function,{asn1rt,utf8_binary_to_list,1}}]). -export([bit_string/2]). -export([octet_string/1]). diff --git a/lib/asn1/vsn.mk b/lib/asn1/vsn.mk index 153c64ebdd..1f16f31f6b 100644 --- a/lib/asn1/vsn.mk +++ b/lib/asn1/vsn.mk @@ -1,2 +1,2 @@ #next version number to use is 2.0 -ASN1_VSN = 2.0.4 +ASN1_VSN = 3.0 diff --git a/lib/common_test/src/common_test.app.src b/lib/common_test/src/common_test.app.src index 18c1dec784..e28751fb59 100644 --- a/lib/common_test/src/common_test.app.src +++ b/lib/common_test/src/common_test.app.src @@ -62,5 +62,10 @@ ct_master, ct_master_logs]}, {applications, [kernel,stdlib]}, - {env, []}]}. + {env, []}, + {runtime_dependencies,["xmerl-1.3.7","webtool-0.8.10","tools-2.6.14", + "test_server-3.7","stdlib-2.0","ssh-3.0.1", + "snmp-4.25.1","sasl-2.4","runtime_tools-1.8.14", + "kernel-3.0","inets-5.10","erts-6.0", + "debugger-4.0","crypto-3.3","compiler-5.0"]}]}. diff --git a/lib/common_test/src/ct_conn_log_h.erl b/lib/common_test/src/ct_conn_log_h.erl index d733df27dc..cff02a46d9 100644 --- a/lib/common_test/src/ct_conn_log_h.erl +++ b/lib/common_test/src/ct_conn_log_h.erl @@ -204,13 +204,8 @@ pretty_head({{{Y,Mo,D},{H,Mi,S}},MicroS},ConnMod,Text0) -> micro2milli(MicroS)]). pretty_title(#conn_log{client=Client}=Info) -> - case actionstr(Info) of - {no_server,Action} -> - io_lib:format("= Client ~w ~s ",[Client,Action]); - Action -> - io_lib:format("= Client ~w ~s ~ts ",[Client,Action, - serverstr(Info)]) - end. + io_lib:format("= Client ~w ~s ~ts ", + [Client,actionstr(Info),serverstr(Info)]). actionstr(#conn_log{action=send}) -> "----->"; actionstr(#conn_log{action=cmd}) -> "----->"; diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index 54510a657a..7d577462b0 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -249,8 +249,8 @@ init_tc2(Mod,Suite,Func,SuiteInfo,MergeResult,Config) -> end end. -ct_suite_init(Suite, Func, PostInitHook, Config) when is_list(Config) -> - case ct_hooks:init_tc(Suite, Func, Config) of +ct_suite_init(Suite, FuncSpec, PostInitHook, Config) when is_list(Config) -> + case ct_hooks:init_tc(Suite, FuncSpec, Config) of NewConfig when is_list(NewConfig) -> PostInitHookResult = do_post_init_hook(PostInitHook, NewConfig), {ok, [PostInitHookResult ++ NewConfig]}; @@ -660,10 +660,7 @@ end_tc(Mod,Func,TCPid,Result,Args,Return) -> ct_util:delete_testdata(comment), ct_util:delete_suite_data(last_saved_config), - FuncSpec = case group_or_func(Func,Args) of - {_,_GroupName,_} = Group -> Group; - _ -> Func - end, + FuncSpec = group_or_func(Func,Args), {Result1,FinalNotify} = case ct_hooks:end_tc( @@ -1277,28 +1274,35 @@ report(What,Data) -> ct_util:set_testdata({What,Data}), ok; tc_start -> - %% Data = {{Suite,Func},LogFileName} + %% Data = {Suite,{Func,GroupName}},LogFileName} + Data1 = case Data of + {{Suite,{Func,undefined}},LFN} -> {{Suite,Func},LFN}; + _ -> Data + end, ct_event:sync_notify(#event{name=tc_logfile, node=node(), - data=Data}), + data=Data1}), ok; tc_done -> - {_Suite,Case,Result} = Data, + {Suite,{Func,GrName},Result} = Data, + Data1 = if GrName == undefined -> {Suite,Func,Result}; + true -> Data + end, case Result of {failed, _} -> - ct_hooks:on_tc_fail(What, Data); + ct_hooks:on_tc_fail(What, Data1); {skipped,{failed,{_,init_per_testcase,_}}} -> - ct_hooks:on_tc_skip(tc_auto_skip, Data); + ct_hooks:on_tc_skip(tc_auto_skip, Data1); {skipped,{require_failed,_}} -> - ct_hooks:on_tc_skip(tc_auto_skip, Data); + ct_hooks:on_tc_skip(tc_auto_skip, Data1); {skipped,_} -> - ct_hooks:on_tc_skip(tc_user_skip, Data); + ct_hooks:on_tc_skip(tc_user_skip, Data1); {auto_skipped,_} -> - ct_hooks:on_tc_skip(tc_auto_skip, Data); + ct_hooks:on_tc_skip(tc_auto_skip, Data1); _Else -> ok end, - case {Case,Result} of + case {Func,Result} of {init_per_suite,_} -> ok; {end_per_suite,_} -> @@ -1327,20 +1331,17 @@ report(What,Data) -> tc_user_skip -> %% test case or config function specified as skipped in testspec, %% or init config func for suite/group has returned {skip,Reason} - %% Data = {Suite,Case,Comment} | - %% {Suite,{GroupConfigFunc,GroupName},Comment} + %% Data = {Suite,{Func,GroupName},Comment} {Func,Data1} = case Data of - {Suite,{ConfigFunc,undefined},Cmt} -> - {ConfigFunc,{Suite,ConfigFunc,Cmt}}; - {_,{ConfigFunc,_},_} -> {ConfigFunc,Data}; - {_,Case,_} -> {Case,Data} + {Suite,{F,undefined},Comment} -> + {F,{Suite,F,Comment}}; + D = {_,{F,_},_} -> + {F,D} end, - ct_event:sync_notify(#event{name=tc_user_skip, node=node(), data=Data1}), ct_hooks:on_tc_skip(What, Data1), - if Func /= init_per_suite, Func /= init_per_group, Func /= end_per_suite, Func /= end_per_group -> add_to_stats(user_skipped); @@ -1350,13 +1351,12 @@ report(What,Data) -> tc_auto_skip -> %% test case skipped because of error in config function, or %% config function skipped because of error in info function - %% Data = {Suite,Case,Comment} | - %% {Suite,{GroupConfigFunc,GroupName},Comment} + %% Data = {Suite,{Func,GroupName},Comment} {Func,Data1} = case Data of - {Suite,{ConfigFunc,undefined},Cmt} -> - {ConfigFunc,{Suite,ConfigFunc,Cmt}}; - {_,{ConfigFunc,_},_} -> {ConfigFunc,Data}; - {_,Case,_} -> {Case,Data} + {Suite,{F,undefined},Comment} -> + {F,{Suite,F,Comment}}; + D = {_,{F,_},_} -> + {F,D} end, %% this test case does not have a log, so printouts %% from event handlers should end up in the main log @@ -1364,7 +1364,6 @@ report(What,Data) -> node=node(), data=Data1}), ct_hooks:on_tc_skip(What, Data1), - if Func /= end_per_suite, Func /= end_per_group -> add_to_stats(auto_skipped); @@ -1417,7 +1416,7 @@ warn(_What) -> true. %%%----------------------------------------------------------------- -%%% @spec add_data_dir(File0) -> File1 +%%% @spec add_data_dir(File0, Config) -> File1 add_data_dir(File,Config) when is_atom(File) -> add_data_dir(atom_to_list(File),Config); diff --git a/lib/common_test/src/ct_gen_conn.erl b/lib/common_test/src/ct_gen_conn.erl index 078d6b1a44..56082086f6 100644 --- a/lib/common_test/src/ct_gen_conn.erl +++ b/lib/common_test/src/ct_gen_conn.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2013. All Rights Reserved. +%% Copyright Ericsson AB 2003-2014. 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 @@ -307,7 +307,8 @@ call(Pid, Msg, Timeout) -> end. return({To,Ref},Result) -> - To ! {Ref, Result}. + To ! {Ref, Result}, + ok. init_gen(Parent,Opts) -> process_flag(trap_exit,true), @@ -344,7 +345,7 @@ loop(Opts) -> link(NewPid), put(conn_pid,NewPid), loop(Opts#gen_opts{conn_pid=NewPid, - cb_state=NewState}); + cb_state=NewState}); Error -> ct_util:unregister_connection(self()), log("Reconnect failed. Giving up!", diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl index e845e9e908..df4c98d9d1 100644 --- a/lib/common_test/src/ct_hooks.erl +++ b/lib/common_test/src/ct_hooks.erl @@ -64,11 +64,16 @@ terminate(Hooks) -> %% @doc Called as each test case is started. This includes all configuration %% tests. --spec init_tc(Mod :: atom(), Func :: atom(), Args :: list()) -> +-spec init_tc(Mod :: atom(), + FuncSpec :: atom() | + {ConfigFunc :: init_per_group | end_per_group, + GroupName :: atom(), + Properties :: list()}, + Args :: list()) -> NewConfig :: proplists:proplist() | - {skip, Reason :: term()} | - {auto_skip, Reason :: term()} | - {fail, Reason :: term()}. + {skip, Reason :: term()} | + {auto_skip, Reason :: term()} | + {fail, Reason :: term()}. init_tc(Mod, init_per_suite, Config) -> Info = try proplists:get_value(ct_hooks, Mod:suite(),[]) of @@ -82,8 +87,8 @@ init_tc(Mod, init_per_suite, Config) -> call(fun call_generic/3, Config ++ Info, [pre_init_per_suite, Mod]); init_tc(Mod, end_per_suite, Config) -> call(fun call_generic/3, Config, [pre_end_per_suite, Mod]); -init_tc(Mod, {init_per_group, GroupName, Opts}, Config) -> - maybe_start_locker(Mod, GroupName, Opts), +init_tc(Mod, {init_per_group, GroupName, Properties}, Config) -> + maybe_start_locker(Mod, GroupName, Properties), call(fun call_generic/3, Config, [pre_init_per_group, GroupName]); init_tc(_Mod, {end_per_group, GroupName, _}, Config) -> call(fun call_generic/3, Config, [pre_end_per_group, GroupName]); @@ -93,15 +98,18 @@ init_tc(_Mod, TC, Config) -> %% @doc Called as each test case is completed. This includes all configuration %% tests. -spec end_tc(Mod :: atom(), - Func :: atom(), + FuncSpec :: atom() | + {ConfigFunc :: init_per_group | end_per_group, + GroupName :: atom(), + Properties :: list()}, Args :: list(), Result :: term(), - Resturn :: term()) -> + Return :: term()) -> NewConfig :: proplists:proplist() | - {skip, Reason :: term()} | - {auto_skip, Reason :: term()} | - {fail, Reason :: term()} | - ok | '$ct_no_change'. + {skip, Reason :: term()} | + {auto_skip, Reason :: term()} | + {fail, Reason :: term()} | + ok | '$ct_no_change'. end_tc(Mod, init_per_suite, Config, _Result, Return) -> call(fun call_generic/3, Return, [post_init_per_suite, Mod, Config], @@ -112,18 +120,20 @@ end_tc(Mod, end_per_suite, Config, Result, _Return) -> end_tc(_Mod, {init_per_group, GroupName, _}, Config, _Result, Return) -> call(fun call_generic/3, Return, [post_init_per_group, GroupName, Config], '$ct_no_change'); -end_tc(Mod, {end_per_group, GroupName, Opts}, Config, Result, _Return) -> +end_tc(Mod, {end_per_group, GroupName, Properties}, Config, Result, _Return) -> Res = call(fun call_generic/3, Result, [post_end_per_group, GroupName, Config], '$ct_no_change'), - maybe_stop_locker(Mod, GroupName,Opts), + maybe_stop_locker(Mod, GroupName, Properties), Res; end_tc(_Mod, TC, Config, Result, _Return) -> call(fun call_generic/3, Result, [post_end_per_testcase, TC, Config], '$ct_no_change'). +%% Case = TestCase | {TestCase,GroupName} on_tc_skip(How, {Suite, Case, Reason}) -> call(fun call_cleanup/3, {How, Reason}, [on_tc_skip, Suite, Case]). +%% Case = TestCase | {TestCase,GroupName} on_tc_fail(_How, {Suite, Case, Reason}) -> call(fun call_cleanup/3, Reason, [on_tc_fail, Suite, Case]). diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index a7fb45a4e4..a4ad65c0a4 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -76,7 +76,7 @@ tests = []}). %%%----------------------------------------------------------------- -%%% @spec init(Mode) -> Result +%%% @spec init(Mode, Verbosity) -> Result %%% Mode = normal | interactive %%% Result = {StartTime,LogDir} %%% StartTime = term() diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl index 35920ec1dc..6fc840745d 100644 --- a/lib/common_test/src/ct_netconfc.erl +++ b/lib/common_test/src/ct_netconfc.erl @@ -1,7 +1,7 @@ %%---------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012-2013. All Rights Reserved. +%% Copyright Ericsson AB 2012-2014. 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 @@ -1334,7 +1334,7 @@ handle_data(NewData,#state{connection=Connection,buff=Buff} = State) -> %% first answer P=#pending{tref=TRef,caller=Caller} = lists:last(Pending), - timer:cancel(TRef), + _ = timer:cancel(TRef), Reason1 = {failed_to_parse_received_data,Reason}, ct_gen_conn:return(Caller,{error,Reason1}), lists:delete(P,Pending) @@ -1454,7 +1454,7 @@ decode({Tag,Attrs,_}=E, #state{connection=Connection,pending=Pending}=State) -> {noreply,State#state{hello_status = {error,Reason}}} end; #pending{tref=TRef,caller=Caller} -> - timer:cancel(TRef), + _ = timer:cancel(TRef), case decode_hello(E) of {ok,SessionId,Capabilities} -> ct_gen_conn:return(Caller,ok), @@ -1482,7 +1482,7 @@ decode({Tag,Attrs,_}=E, #state{connection=Connection,pending=Pending}=State) -> case [P || P = #pending{msg_id=undefined,op=undefined} <- Pending] of [#pending{tref=TRef, caller=Caller}] -> - timer:cancel(TRef), + _ = timer:cancel(TRef), ct_gen_conn:return(Caller,E), {noreply,State#state{pending=[]}}; _ -> @@ -1504,7 +1504,7 @@ get_msg_id(Attrs) -> decode_rpc_reply(MsgId,{_,Attrs,Content0}=E,#state{pending=Pending} = State) -> case lists:keytake(MsgId,#pending.msg_id,Pending) of {value, #pending{tref=TRef,op=Op,caller=Caller}, Pending1} -> - timer:cancel(TRef), + _ = timer:cancel(TRef), Content = forward_xmlns_attr(Attrs,Content0), {CallerReply,{ServerReply,State2}} = do_decode_rpc_reply(Op,Content,State#state{pending=Pending1}), @@ -1519,7 +1519,7 @@ decode_rpc_reply(MsgId,{_,Attrs,Content0}=E,#state{pending=Pending} = State) -> msg_id=undefined, op=undefined, caller=Caller}] -> - timer:cancel(TRef), + _ = timer:cancel(TRef), ct_gen_conn:return(Caller,E), {noreply,State#state{pending=[]}}; _ -> @@ -1862,10 +1862,7 @@ ssh_open(#options{host=Host,timeout=Timeout,port=Port,ssh=SshOpts,name=Name}) -> end; {error, Reason} -> ssh:close(CM), - {error,{ssh,could_not_open_channel,Reason}}; - Other -> - %% Bug in ssh?? got {closed,0} here once... - {error,{ssh,unexpected_from_session_channel,Other}} + {error,{ssh,could_not_open_channel,Reason}} end; {error,Reason} -> {error,{ssh,could_not_connect_to_server,Reason}} diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index 7c797be03e..03cf06abed 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -71,6 +71,7 @@ enable_builtin_hooks, include = [], auto_compile, + abort_if_missing_suites, silent_connections = [], stylesheet, multiply_timetraps = 1, @@ -246,9 +247,11 @@ script_start1(Parent, Args) -> Vts = get_start_opt(vts, true, Args), Shell = get_start_opt(shell, true, Args), Cover = get_start_opt(cover, fun([CoverFile]) -> ?abs(CoverFile) end, Args), - CoverStop = get_start_opt(cover_stop, fun([CS]) -> list_to_atom(CS) end, Args), + CoverStop = get_start_opt(cover_stop, + fun([CS]) -> list_to_atom(CS) end, Args), LogDir = get_start_opt(logdir, fun([LogD]) -> LogD end, Args), - LogOpts = get_start_opt(logopts, fun(Os) -> [list_to_atom(O) || O <- Os] end, + LogOpts = get_start_opt(logopts, + fun(Os) -> [list_to_atom(O) || O <- Os] end, [], Args), Verbosity = verbosity_args2opts(Args), MultTT = get_start_opt(multiply_timetraps, @@ -311,6 +314,12 @@ script_start1(Parent, Args) -> application:set_env(common_test, auto_compile, false), {false,[]} end, + + %% abort test run if some suites can't be compiled + AbortIfMissing = get_start_opt(abort_if_missing_suites, + fun([]) -> true; + ([Bool]) -> list_to_atom(Bool) + end, false, Args), %% silent connections SilentConns = get_start_opt(silent_connections, @@ -347,6 +356,7 @@ script_start1(Parent, Args) -> ct_hooks = CTHooks, enable_builtin_hooks = EnableBuiltinHooks, auto_compile = AutoCompile, + abort_if_missing_suites = AbortIfMissing, include = IncludeDirs, silent_connections = SilentConns, stylesheet = Stylesheet, @@ -551,6 +561,9 @@ combine_test_opts(TS, Specs, Opts) -> ACBool end, + AbortIfMissing = choose_val(Opts#opts.abort_if_missing_suites, + TSOpts#opts.abort_if_missing_suites), + BasicHtml = case choose_val(Opts#opts.basic_html, TSOpts#opts.basic_html) of @@ -578,6 +591,7 @@ combine_test_opts(TS, Specs, Opts) -> enable_builtin_hooks = EnableBuiltinHooks, stylesheet = Stylesheet, auto_compile = AutoCompile, + abort_if_missing_suites = AbortIfMissing, include = AllInclude, multiply_timetraps = MultTT, scale_timetraps = ScaleTT, @@ -753,6 +767,7 @@ script_usage() -> "\n\t[-verbosity GenVLvl | [CategoryVLvl1 .. CategoryVLvlN]]" "\n\t[-include InclDir1 InclDir2 .. InclDirN]" "\n\t[-no_auto_compile]" + "\n\t[-abort_if_missing_suites]" "\n\t[-multiply_timetraps N]" "\n\t[-scale_timetraps]" "\n\t[-create_priv_dir auto_per_run | auto_per_tc | manual_per_tc]" @@ -775,6 +790,7 @@ script_usage() -> "\n\t[-ct_hooks CTHook1 CTHook2 .. CTHookN]" "\n\t[-include InclDir1 InclDir2 .. InclDirN]" "\n\t[-no_auto_compile]" + "\n\t[-abort_if_missing_suites]" "\n\t[-multiply_timetraps N]" "\n\t[-scale_timetraps]" "\n\t[-create_priv_dir auto_per_run | auto_per_tc | manual_per_tc]" @@ -799,6 +815,7 @@ script_usage() -> "\n\t[-ct_hooks CTHook1 CTHook2 .. CTHookN]" "\n\t[-include InclDir1 InclDir2 .. InclDirN]" "\n\t[-no_auto_compile]" + "\n\t[-abort_if_missing_suites]" "\n\t[-multiply_timetraps N]" "\n\t[-scale_timetraps]" "\n\t[-create_priv_dir auto_per_run | auto_per_tc | manual_per_tc]" @@ -1026,6 +1043,10 @@ run_test2(StartOpts) -> {ACBool,[]} end, + %% abort test run if some suites can't be compiled + AbortIfMissing = get_start_opt(abort_if_missing_suites, value, false, + StartOpts), + %% decrypt config file case proplists:get_value(decrypt, StartOpts) of undefined -> @@ -1067,6 +1088,7 @@ run_test2(StartOpts) -> ct_hooks = CTHooks, enable_builtin_hooks = EnableBuiltinHooks, auto_compile = AutoCompile, + abort_if_missing_suites = AbortIfMissing, include = Include, silent_connections = SilentConns, stylesheet = Stylesheet, @@ -1401,6 +1423,7 @@ get_data_for_node(#testspec{label = Labels, ct_hooks = CTHooks, enable_builtin_hooks = EnableBuiltinHooks, auto_compile = ACs, + abort_if_missing_suites = AiMSs, include = Incl, multiply_timetraps = MTs, scale_timetraps = STs, @@ -1435,6 +1458,7 @@ get_data_for_node(#testspec{label = Labels, EvHandlers = [{H,A} || {N,H,A} <- EvHs, N==Node], FiltCTHooks = [Hook || {N,Hook} <- CTHooks, N==Node], AutoCompile = proplists:get_value(Node, ACs), + AbortIfMissing = proplists:get_value(Node, AiMSs), Include = [I || {N,I} <- Incl, N==Node], #opts{label = Label, profile = Profile, @@ -1451,6 +1475,7 @@ get_data_for_node(#testspec{label = Labels, ct_hooks = FiltCTHooks, enable_builtin_hooks = EnableBuiltinHooks, auto_compile = AutoCompile, + abort_if_missing_suites = AbortIfMissing, include = Include, multiply_timetraps = MT, scale_timetraps = ST, @@ -1722,8 +1747,8 @@ compile_and_run(Tests, Skip, Opts, Args) -> {SuiteErrs,HelpErrs} = auto_compile(TestSuites), {TestSuites,SuiteErrs,SuiteErrs++HelpErrs} end, - - case continue(AllMakeErrors) of + + case continue(AllMakeErrors, Opts#opts.abort_if_missing_suites) of true -> SavedErrors = save_make_errors(SuiteMakeErrors), ct_repeat:log_loop_info(Args), @@ -2047,9 +2072,9 @@ final_skip([Skip|Skips], Final) -> final_skip([], Final) -> lists:reverse(Final). -continue([]) -> +continue([], _) -> true; -continue(_MakeErrors) -> +continue(_MakeErrors, AbortIfMissingSuites) -> io:nl(), OldGl = group_leader(), case set_group_leader_same_as_shell() of @@ -2077,26 +2102,26 @@ continue(_MakeErrors) -> true end; false -> % no shell process to use - true + not AbortIfMissingSuites end. set_group_leader_same_as_shell() -> %%! Locate the shell process... UGLY!!! GS2or3 = fun(P) -> - case process_info(P,initial_call) of - {initial_call,{group,server,X}} when X == 2 ; X == 3 -> - true; - _ -> - false - end - end, + case process_info(P,initial_call) of + {initial_call,{group,server,X}} when X == 2 ; X == 3 -> + true; + _ -> + false + end + end, case [P || P <- processes(), GS2or3(P), - true == lists:keymember(shell,1, - element(2,process_info(P,dictionary)))] of - [GL|_] -> - group_leader(GL, self()); - [] -> - false + true == lists:keymember(shell,1, + element(2,process_info(P,dictionary)))] of + [GL|_] -> + group_leader(GL, self()); + [] -> + false end. check_and_add([{TestDir0,M,_} | Tests], Added, PA) -> diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl index b4d82a53cf..0a067b3a08 100644 --- a/lib/common_test/src/ct_telnet.erl +++ b/lib/common_test/src/ct_telnet.erl @@ -281,8 +281,16 @@ open(KeyOrName,ConnType,TargetMod,Extra) -> end, log(undefined,open,"Connecting to ~p(~p)", [KeyOrName,Addr1]), - ct_gen_conn:start(KeyOrName,full_addr(Addr1,ConnType), - {TargetMod,KeepAlive,Extra},?MODULE) + Reconnect = + case ct:get_config({telnet_settings,reconnection_attempts}) of + 0 -> false; + _ -> true + end, + ct_gen_conn:start(full_addr(Addr1,ConnType), + {TargetMod,KeepAlive,Extra}, + ?MODULE, [{name,KeyOrName}, + {reconnect,Reconnect}, + {old,true}]) end. %%%----------------------------------------------------------------- @@ -405,9 +413,11 @@ expect(Connection,Patterns) -> %%% Prompt = string() %%% Tag = term() %%% Opts = [Opt] -%%% Opt = {timeout,Timeout} | repeat | {repeat,N} | sequence | -%%% {halt,HaltPatterns} | ignore_prompt | no_prompt_check -%%% Timeout = integer() +%%% Opt = {idle_timeout,IdleTimeout} | {total_timeout,TotalTimeout} | +%%% repeat | {repeat,N} | sequence | {halt,HaltPatterns} | +%%% ignore_prompt | no_prompt_check +%%% IdleTimeout = infinity | integer() +%%% TotalTimeout = infinity | integer() %%% N = integer() %%% HaltPatterns = Patterns %%% MatchList = [Match] @@ -433,11 +443,16 @@ expect(Connection,Patterns) -> %%% will also include the matched <code>Tag</code>. Else, only %%% <code>RxMatch</code> is returned.</p> %%% -%%% <p>The <code>timeout</code> option indicates that the function +%%% <p>The <code>idle_timeout</code> option indicates that the function %%% shall return if the telnet client is idle (i.e. if no data is -%%% received) for more than <code>Timeout</code> milliseconds. Default +%%% received) for more than <code>IdleTimeout</code> milliseconds. Default %%% timeout is 10 seconds.</p> %%% +%%% <p>The <code>total_timeout</code> option sets a time limit for +%%% the complete expect operation. After <code>TotalTimeout</code> +%%% milliseconds, <code>{error,timeout}</code> is returned. The default +%%% value is <code>infinity</code> (i.e. no time limit).</p> +%%% %%% <p>The function will always return when a prompt is found, unless %%% any of the <code>ignore_prompt</code> or %%% <code>no_prompt_check</code> options are used, in which case it @@ -570,14 +585,14 @@ handle_msg({cmd,Cmd,Timeout},State) -> State#state.buffer, prompt, State#state.prx, - [{timeout,2000}]); + [{idle_timeout,2000}]); {ip,false} -> silent_teln_expect(State#state.name, State#state.teln_pid, State#state.buffer, prompt, State#state.prx, - [{timeout,200}]); + [{idle_timeout,200}]); {ip,true} -> ok end, @@ -601,11 +616,9 @@ handle_msg({cmd,Cmd,Timeout},State) -> end_gen_log(), {Return,State#state{buffer=NewBuffer,prompt=Prompt}}; handle_msg({send,Cmd},State) -> - log(State,send,"Cmd: ~p",[Cmd]), - + log(State,send,"Sending: ~p",[Cmd]), debug_cont_gen_log("Throwing Buffer:",[]), debug_log_lines(State#state.buffer), - case {State#state.type,State#state.prompt} of {ts,_} -> silent_teln_expect(State#state.name, @@ -613,14 +626,14 @@ handle_msg({send,Cmd},State) -> State#state.buffer, prompt, State#state.prx, - [{timeout,2000}]); + [{idle_timeout,2000}]); {ip,false} -> silent_teln_expect(State#state.name, State#state.teln_pid, State#state.buffer, prompt, State#state.prx, - [{timeout,200}]); + [{idle_timeout,200}]); {ip,true} -> ok end, @@ -783,66 +796,61 @@ log(#state{name=Name,teln_pid=TelnPid,host=Host,port=Port}, true -> Name end, Silent = get(silent), - case ct_util:get_testdata({cth_conn_log,?MODULE}) of - Result when Result /= undefined, Result /= silent, Silent /= true -> - {PrintHeader,PreBR} = if Action==undefined -> - {false,""}; - true -> - {true,"\n"} - end, - error_logger:info_report(#conn_log{header=PrintHeader, - client=self(), - conn_pid=TelnPid, - address={Host,Port}, - name=Name1, - action=Action, - module=?MODULE}, - {PreBR++String,Args}); - Result when Result /= undefined -> - ok; - _ when Action == open; Action == close; Action == reconnect; - Action == info; Action == error -> - ct_gen_conn:log(heading(Action,Name1),String,Args); - _ when ForcePrint == false -> - case ct_util:is_silenced(telnet) of - true -> - ok; - false -> - ct_gen_conn:cont_log(String,Args) + + if Action == general_io -> + case ct_util:get_testdata({cth_conn_log,?MODULE}) of + HookMode when HookMode /= undefined, HookMode /= silent, + Silent /= true -> + error_logger:info_report(#conn_log{header=false, + client=self(), + conn_pid=TelnPid, + address={Host,Port}, + name=Name1, + action=Action, + module=?MODULE}, + {String,Args}); + _ -> %% hook inactive or silence requested + ok end; - _ when ForcePrint == true -> - case ct_util:is_silenced(telnet) of - true -> - %% call log/3 now instead of cont_log/2 since - %% start_gen_log/1 will not have been previously called + + true -> + if Action == open; Action == close; Action == reconnect; + Action == info; Action == error -> ct_gen_conn:log(heading(Action,Name1),String,Args); - false -> - ct_gen_conn:cont_log(String,Args) + + ForcePrint == false -> + case ct_util:is_silenced(telnet) of + true -> + ok; + false -> + ct_gen_conn:cont_log(String,Args) + end; + + ForcePrint == true -> + case ct_util:is_silenced(telnet) of + true -> + %% call log/3 now instead of cont_log/2 since + %% start_gen_log/1 will not have been previously + %% called + ct_gen_conn:log(heading(Action,Name1),String,Args); + false -> + ct_gen_conn:cont_log(String,Args) + end end end. start_gen_log(Heading) -> - case ct_util:get_testdata({cth_conn_log,?MODULE}) of - undefined -> - %% check if output is suppressed - case ct_util:is_silenced(telnet) of - true -> ok; - false -> ct_gen_conn:start_log(Heading) - end; - _ -> - ok + %% check if output is suppressed + case ct_util:is_silenced(telnet) of + true -> ok; + false -> ct_gen_conn:start_log(Heading) end. end_gen_log() -> - case ct_util:get_testdata({cth_conn_log,?MODULE}) of - undefined -> - %% check if output is suppressed - case ct_util:is_silenced(telnet) of - true -> ok; - false -> ct_gen_conn:end_log() - end; - _ -> - ok + %% check if output is suppressed + case ct_util:is_silenced(telnet) of + true -> ok; + false -> ct_gen_conn:end_log() end. %%% @hidden @@ -879,7 +887,8 @@ teln_get_all_data(Pid,Prx,Data,Acc,LastLine) -> %% Expect options record -record(eo,{teln_pid, prx, - timeout, + idle_timeout, + total_timeout, haltpatterns=[], seq=false, repeat=false, @@ -921,11 +930,12 @@ teln_expect(Name,Pid,Data,Pattern0,Prx,Opts) -> Seq = get_seq(Opts), Pattern = convert_pattern(Pattern0,Seq), - Timeout = get_timeout(Opts), + {IdleTimeout,TotalTimeout} = get_timeouts(Opts), EO = #eo{teln_pid=Pid, prx=Prx, - timeout=Timeout, + idle_timeout=IdleTimeout, + total_timeout=TotalTimeout, seq=Seq, haltpatterns=HaltPatterns, prompt_check=PromptCheck}, @@ -964,11 +974,22 @@ rm_dupl([P|Ps],Acc) -> rm_dupl([],Acc) -> lists:reverse(Acc). -get_timeout(Opts) -> - case lists:keysearch(timeout,1,Opts) of - {value,{timeout,T}} -> T; - false -> ?DEFAULT_TIMEOUT - end. +get_timeouts(Opts) -> + {case lists:keysearch(idle_timeout,1,Opts) of + {value,{_,T}} -> + T; + false -> + %% this check is for backwards compatibility (pre CT v1.8) + case lists:keysearch(timeout,1,Opts) of + {value,{_,T}} -> T; + false -> ?DEFAULT_TIMEOUT + end + end, + case lists:keysearch(total_timeout,1,Opts) of + {value,{_,T}} -> T; + false -> infinity + end}. + get_repeat(Opts) -> case lists:keysearch(repeat,1,Opts) of {value,{repeat,N}} when is_integer(N) -> @@ -1010,7 +1031,8 @@ repeat_expect(Name,Pid,Data,Pattern,Acc,EO) -> {error,Reason} end. -teln_expect1(Name,Pid,Data,Pattern,Acc,EO) -> +teln_expect1(Name,Pid,Data,Pattern,Acc,EO=#eo{idle_timeout=IdleTO, + total_timeout=TotalTO}) -> ExpectFun = case EO#eo.seq of true -> fun() -> seq_expect(Name,Pid,Data,Pattern,Acc,EO) @@ -1027,12 +1049,12 @@ teln_expect1(Name,Pid,Data,Pattern,Acc,EO) -> NotFinished -> %% Get more data Fun = fun() -> get_data1(EO#eo.teln_pid) end, - case ct_gen_conn:do_within_time(Fun, EO#eo.timeout) of - {error,Reason} -> + case timer:tc(ct_gen_conn, do_within_time, [Fun, IdleTO]) of + {_,{error,Reason}} -> %% A timeout will occur when the telnet connection - %% is idle for EO#eo.timeout milliseconds. + %% is idle for EO#eo.idle_timeout milliseconds. {error,Reason}; - {ok,Data1} -> + {_,{ok,Data1}} when TotalTO == infinity -> case NotFinished of {nomatch,Rest} -> %% One expect @@ -1040,6 +1062,21 @@ teln_expect1(Name,Pid,Data,Pattern,Acc,EO) -> {continue,Patterns1,Acc1,Rest} -> %% Sequence teln_expect1(Name,Pid,Rest++Data1,Patterns1,Acc1,EO) + end; + {Elapsed,{ok,Data1}} -> + TVal = trunc(TotalTO - (Elapsed/1000)), + if TVal =< 0 -> + {error,timeout}; + true -> + EO1 = EO#eo{total_timeout = TVal}, + case NotFinished of + {nomatch,Rest} -> + %% One expect + teln_expect1(Name,Pid,Rest++Data1,Pattern,[],EO1); + {continue,Patterns1,Acc1,Rest} -> + %% Sequence + teln_expect1(Name,Pid,Rest++Data1,Patterns1,Acc1,EO1) + end end end end. diff --git a/lib/common_test/src/ct_telnet_client.erl b/lib/common_test/src/ct_telnet_client.erl index 2cbcba9c77..ce30dcb74b 100644 --- a/lib/common_test/src/ct_telnet_client.erl +++ b/lib/common_test/src/ct_telnet_client.erl @@ -32,7 +32,9 @@ -module(ct_telnet_client). --export([open/1, open/2, open/3, open/4, close/1]). +%% -define(debug, true). + +-export([open/2, open/3, open/4, open/5, close/1]). -export([send_data/2, get_data/1]). -define(TELNET_PORT, 23). @@ -64,20 +66,23 @@ -define(TERMINAL_TYPE, 24). -define(WINDOW_SIZE, 31). --record(state,{get_data, keep_alive=true}). +-record(state,{conn_name, get_data, keep_alive=true, log_pos=1}). -open(Server) -> - open(Server, ?TELNET_PORT, ?OPEN_TIMEOUT, true). +open(Server, ConnName) -> + open(Server, ?TELNET_PORT, ?OPEN_TIMEOUT, true, ConnName). -open(Server, Port) -> - open(Server, Port, ?OPEN_TIMEOUT, true). +open(Server, Port, ConnName) -> + open(Server, Port, ?OPEN_TIMEOUT, true, ConnName). -open(Server, Port, Timeout) -> - open(Server, Port, Timeout, true). +open(Server, Port, Timeout, ConnName) -> + open(Server, Port, Timeout, true, ConnName). -open(Server, Port, Timeout, KeepAlive) -> +open(Server, Port, Timeout, KeepAlive, ConnName) -> Self = self(), - Pid = spawn(fun() -> init(Self, Server, Port, Timeout, KeepAlive) end), + Pid = spawn(fun() -> + init(Self, Server, Port, Timeout, + KeepAlive, ConnName) + end), receive {open,Pid} -> {ok,Pid}; @@ -86,29 +91,34 @@ open(Server, Port, Timeout, KeepAlive) -> end. close(Pid) -> - Pid ! close. + Pid ! {close,self()}, + receive closed -> ok + after 5000 -> ok + end. send_data(Pid, Data) -> Pid ! {send_data, Data++"\n"}, ok. get_data(Pid) -> - Pid ! {get_data, self()}, + Pid ! {get_data,self()}, receive {data,Data} -> - {ok, Data} + {ok,Data} end. %%%----------------------------------------------------------------- %%% Internal functions -init(Parent, Server, Port, Timeout, KeepAlive) -> +init(Parent, Server, Port, Timeout, KeepAlive, ConnName) -> case gen_tcp:connect(Server, Port, [list,{packet,0}], Timeout) of {ok,Sock} -> - dbg("Connected to: ~p (port: ~w, keep_alive: ~w)\n", [Server,Port,KeepAlive]), - send([?IAC,?DO,?SUPPRESS_GO_AHEAD], Sock), + dbg("~p connected to: ~p (port: ~w, keep_alive: ~w)\n", + [ConnName,Server,Port,KeepAlive]), + send([?IAC,?DO,?SUPPRESS_GO_AHEAD], Sock, ConnName), Parent ! {open,self()}, - loop(#state{get_data=10, keep_alive=KeepAlive}, Sock, []), + loop(#state{conn_name=ConnName, get_data=10, keep_alive=KeepAlive}, + Sock, []), gen_tcp:close(Sock); Error -> Parent ! {Error,self()} @@ -118,6 +128,13 @@ loop(State, Sock, Acc) -> receive {tcp_closed,_} -> dbg("Connection closed\n", []), + Data = lists:reverse(lists:append(Acc)), + dbg("Printing queued messages: ~tp",[Data]), + ct_telnet:log(State#state.conn_name, + general_io, "~ts", + [lists:sublist(Data, + State#state.log_pos, + length(Data))]), receive {get_data,Pid} -> Pid ! closed @@ -125,11 +142,11 @@ loop(State, Sock, Acc) -> ok end; {tcp,_,Msg0} -> - dbg("tcp msg: ~p~n",[Msg0]), + dbg("tcp msg: ~tp~n",[Msg0]), Msg = check_msg(Sock,Msg0,[]), loop(State, Sock, [Msg | Acc]); {send_data,Data} -> - send(Data, Sock), + send(Data, Sock, State#state.conn_name), loop(State, Sock, Acc); {get_data,Pid} -> NewState = @@ -144,54 +161,100 @@ loop(State, Sock, Acc) -> end; _ -> Data = lists:reverse(lists:append(Acc)), - dbg("get_data ~p\n",[Data]), + Len = length(Data), + dbg("get_data ~tp\n",[Data]), + ct_telnet:log(State#state.conn_name, + general_io, "~ts", + [lists:sublist(Data, + State#state.log_pos, + Len)]), Pid ! {data,Data}, - State + State#state{log_pos = 1} end, loop(NewState, Sock, []); {get_data_delayed,Pid} -> NewState = case State of #state{keep_alive = true, get_data = 0} -> - if Acc == [] -> send([?IAC,?NOP], Sock); + if Acc == [] -> send([?IAC,?NOP], Sock, + State#state.conn_name); true -> ok end, State#state{get_data=10}; _ -> State end, - NewAcc = + {NewAcc,Pos} = case erlang:is_process_alive(Pid) of - true -> + true when Acc /= [] -> Data = lists:reverse(lists:append(Acc)), - dbg("get_data_delayed ~p\n",[Data]), + Len = length(Data), + dbg("get_data_delayed ~tp\n",[Data]), + ct_telnet:log(State#state.conn_name, + general_io, "~ts", + [lists:sublist(Data, + State#state.log_pos, + Len)]), Pid ! {data,Data}, - []; + {[],1}; + true when Acc == [] -> + dbg("get_data_delayed nodata\n",[]), + Pid ! {data,[]}, + {[],1}; false -> - Acc + {Acc,NewState#state.log_pos} end, - loop(NewState, Sock, NewAcc); - close -> + loop(NewState#state{log_pos=Pos}, Sock, NewAcc); + {close,Pid} -> dbg("Closing connection\n", []), + if Acc == [] -> + ok; + true -> + Data = lists:reverse(lists:append(Acc)), + dbg("Printing queued messages: ~tp",[Data]), + ct_telnet:log(State#state.conn_name, + general_io, "~ts", + [lists:sublist(Data, + State#state.log_pos, + length(Data))]) + end, gen_tcp:close(Sock), - ok + Pid ! closed after wait(State#state.keep_alive,?IDLE_TIMEOUT) -> - if - Acc == [] -> send([?IAC,?NOP], Sock); - true -> ok - end, - loop(State, Sock, Acc) + Data = lists:reverse(lists:append(Acc)), + case Data of + [] -> + send([?IAC,?NOP], Sock, State#state.conn_name), + loop(State, Sock, Acc); + _ when State#state.log_pos == length(Data)+1 -> + loop(State, Sock, Acc); + _ -> + dbg("Idle timeout, printing ~tp\n",[Data]), + Len = length(Data), + ct_telnet:log(State#state.conn_name, + general_io, "~ts", + [lists:sublist(Data, + State#state.log_pos, + Len)]), + loop(State#state{log_pos = Len+1}, Sock, Acc) + end end. wait(true, Time) -> Time; wait(false, _) -> infinity. -send(Data, Sock) -> +send(Data, Sock, ConnName) -> case Data of [?IAC|_] = Cmd -> cmd_dbg(Cmd); _ -> - dbg("Sending: ~p\n", [Data]) + dbg("Sending: ~tp\n", [Data]), + try io_lib:format("[~w] ~ts", [?MODULE,Data]) of + Str -> + ct_telnet:log(ConnName, general_io, Str, []) + catch + _:_ -> ok + end end, gen_tcp:send(Sock, Data), ok. diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index c07ea323e6..10a9bdac67 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -1120,8 +1120,9 @@ should_be_added(Tag,Node,_Data,Spec) -> %% list terms *without* possible duplicates here Tag == logdir; Tag == logopts; Tag == basic_html; Tag == label; - Tag == auto_compile; Tag == stylesheet; - Tag == verbosity; Tag == silent_connections -> + Tag == auto_compile; Tag == abort_if_missing_suites; + Tag == stylesheet; Tag == verbosity; + Tag == silent_connections -> lists:keymember(ref2node(Node,Spec#testspec.nodes),1, read_field(Spec,Tag)) == false; %% for terms *with* possible duplicates @@ -1496,6 +1497,8 @@ valid_terms() -> {include,3}, {auto_compile,2}, {auto_compile,3}, + {abort_if_missing_suites,2}, + {abort_if_missing_suites,3}, {stylesheet,2}, {stylesheet,3}, {suites,3}, diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index ac9857487d..f5eb3a72f0 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -77,6 +77,8 @@ -record(suite_data, {key,name,value}). %%%----------------------------------------------------------------- +start() -> + start(normal, ".", ?default_verbosity). %%% @spec start(Mode) -> Pid | exit(Error) %%% Mode = normal | interactive %%% Pid = pid() @@ -91,9 +93,6 @@ %%% <code>ct_util_server</code>.</p> %%% %%% @see ct -start() -> - start(normal, ".", ?default_verbosity). - start(LogDir) when is_list(LogDir) -> start(normal, LogDir, ?default_verbosity); start(Mode) -> diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl index a82d58cc42..845bb55486 100644 --- a/lib/common_test/src/ct_util.hrl +++ b/lib/common_test/src/ct_util.hrl @@ -48,6 +48,7 @@ release_shell=false, include=[], auto_compile=[], + abort_if_missing_suites=[], stylesheet=[], multiply_timetraps=[], scale_timetraps=[], diff --git a/lib/common_test/src/cth_conn_log.erl b/lib/common_test/src/cth_conn_log.erl index a731c8054c..0e6c877c5d 100644 --- a/lib/common_test/src/cth_conn_log.erl +++ b/lib/common_test/src/cth_conn_log.erl @@ -100,7 +100,6 @@ get_log_opts(Opts) -> Hosts = proplists:get_value(hosts,Opts,[]), {LogType,Hosts}. - pre_init_per_testcase(TestCase,Config,CthState) -> Logs = lists:map( diff --git a/lib/common_test/src/cth_surefire.erl b/lib/common_test/src/cth_surefire.erl index 7ed2018bdf..bb12171ea7 100644 --- a/lib/common_test/src/cth_surefire.erl +++ b/lib/common_test/src/cth_surefire.erl @@ -79,6 +79,10 @@ init(Path, Opts) -> url_base = proplists:get_value(url_base,Opts), timer = now() }. +pre_init_per_suite(Suite,SkipOrFail,State) when is_tuple(SkipOrFail) -> + {SkipOrFail, init_tc(State#state{curr_suite = Suite, + curr_suite_ts = now()}, + SkipOrFail) }; pre_init_per_suite(Suite,Config,#state{ test_cases = [] } = State) -> TcLog = proplists:get_value(tc_logfile,Config), CurrLogDir = filename:dirname(TcLog), diff --git a/lib/common_test/src/unix_telnet.erl b/lib/common_test/src/unix_telnet.erl index e049c3bf39..b05386a5ab 100644 --- a/lib/common_test/src/unix_telnet.erl +++ b/lib/common_test/src/unix_telnet.erl @@ -109,7 +109,7 @@ connect(ConnName,Ip,Port,Timeout,KeepAlive,Extra) -> connect1(Name,Ip,Port,Timeout,KeepAlive,Username,Password) -> start_gen_log("unix_telnet connect"), Result = - case ct_telnet_client:open(Ip,Port,Timeout,KeepAlive) of + case ct_telnet_client:open(Ip,Port,Timeout,KeepAlive,Name) of {ok,Pid} -> case ct_telnet:silent_teln_expect(Name,Pid,[], [prompt],?prx,[]) of @@ -143,13 +143,13 @@ connect1(Name,Ip,Port,Timeout,KeepAlive,Username,Password) -> {ok,[{prompt,_OtherPrompt1},{prompt,_OtherPrompt2}],_} -> {ok,Pid}; Error -> - log(Name,error, + log(Name,conn_error, "Did not get expected prompt from ~p:~p\n~p\n", [Ip,Port,Error]), {error,Error} end; Error -> - log(Name,error, + log(Name,conn_error, "Could not open telnet connection to ~p:~p\n~p\n", [Ip,Port,Error]), Error diff --git a/lib/common_test/test/ct_config_info_SUITE.erl b/lib/common_test/test/ct_config_info_SUITE.erl index 8f2f0eb75f..9c242a41df 100644 --- a/lib/common_test/test/ct_config_info_SUITE.erl +++ b/lib/common_test/test/ct_config_info_SUITE.erl @@ -125,7 +125,7 @@ test_events(config_info) -> [{?eh,tc_start,{config_info_1_SUITE,{init_per_group,g1,[]}}}, {?eh,tc_done,{config_info_1_SUITE,{init_per_group,g1,[]}, {failed,{timetrap_timeout,350}}}}, - {?eh,tc_auto_skip,{config_info_1_SUITE,t11, + {?eh,tc_auto_skip,{config_info_1_SUITE,{t11,g1}, {failed,{config_info_1_SUITE,init_per_group,{timetrap_timeout,350}}}}}, {?eh,tc_auto_skip,{config_info_1_SUITE,{end_per_group,g1}, {failed,{config_info_1_SUITE,init_per_group, @@ -142,7 +142,7 @@ test_events(config_info) -> [{?eh,tc_start,{config_info_1_SUITE,{init_per_group,g4,[]}}}, {?eh,tc_done,{config_info_1_SUITE,{init_per_group,g4,[]}, {failed,{timetrap_timeout,400}}}}, - {?eh,tc_auto_skip,{config_info_1_SUITE,t41, + {?eh,tc_auto_skip,{config_info_1_SUITE,{t41,g4}, {failed,{config_info_1_SUITE,init_per_group, {timetrap_timeout,400}}}}}, {?eh,tc_auto_skip,{config_info_1_SUITE,{end_per_group,g4}, diff --git a/lib/common_test/test/ct_error_SUITE.erl b/lib/common_test/test/ct_error_SUITE.erl index 194e7d42ae..ecf231529a 100644 --- a/lib/common_test/test/ct_error_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE.erl @@ -369,8 +369,8 @@ test_events(cfg_error) -> {'EXIT',init_per_suite_fails}}}}}, {?eh,test_stats,{0,0,{0,1}}}, {?eh,tc_auto_skip, - {cfg_error_1_SUITE,tc2,{failed,{cfg_error_1_SUITE,init_per_suite, - {'EXIT',init_per_suite_fails}}}}}, + {cfg_error_1_SUITE,{tc2,g1},{failed,{cfg_error_1_SUITE,init_per_suite, + {'EXIT',init_per_suite_fails}}}}}, {?eh,test_stats,{0,0,{0,2}}}, {?eh,tc_auto_skip, {cfg_error_1_SUITE,end_per_suite,{failed,{cfg_error_1_SUITE,init_per_suite, @@ -386,7 +386,7 @@ test_events(cfg_error) -> {'EXIT',{{badmatch,[1,2]},'_'}}}}}}, {?eh,test_stats,{0,0,{0,3}}}, {?eh,tc_auto_skip, - {cfg_error_2_SUITE,tc2, + {cfg_error_2_SUITE,{tc2,g1}, {failed,{cfg_error_2_SUITE,init_per_suite, {'EXIT',{{badmatch,[1,2]},'_'}}}}}}, {?eh,test_stats,{0,0,{0,4}}}, @@ -403,7 +403,7 @@ test_events(cfg_error) -> {failed,{cfg_error_3_SUITE,init_per_suite,{timetrap_timeout,2000}}}}}, {?eh,test_stats,{0,0,{0,5}}}, {?eh,tc_auto_skip, - {cfg_error_3_SUITE,tc2, + {cfg_error_3_SUITE,{tc2,g1}, {failed,{cfg_error_3_SUITE,init_per_suite,{timetrap_timeout,2000}}}}}, {?eh,test_stats,{0,0,{0,6}}}, {?eh,tc_auto_skip, @@ -417,7 +417,7 @@ test_events(cfg_error) -> {failed,{cfg_error_4_SUITE,init_per_suite,bad_return}}}}, {?eh,test_stats,{0,0,{0,7}}}, {?eh,tc_auto_skip, - {cfg_error_4_SUITE,tc2, + {cfg_error_4_SUITE,{tc2,g1}, {failed,{cfg_error_4_SUITE,init_per_suite,bad_return}}}}, {?eh,test_stats,{0,0,{0,8}}}, {?eh,tc_auto_skip, @@ -431,7 +431,7 @@ test_events(cfg_error) -> {failed,{cfg_error_5_SUITE,init_per_suite,bad_return}}}}, {?eh,test_stats,{0,0,{0,9}}}, {?eh,tc_auto_skip, - {cfg_error_5_SUITE,tc2, + {cfg_error_5_SUITE,{tc2,g1}, {failed,{cfg_error_5_SUITE,init_per_suite,bad_return}}}}, {?eh,test_stats,{0,0,{0,10}}}, {?eh,tc_auto_skip, @@ -477,7 +477,7 @@ test_events(cfg_error) -> {cfg_error_8_SUITE,{init_per_group,g1,[]}, {failed,{error,{init_per_group_fails,g1}}}}}, {?eh,tc_auto_skip, - {cfg_error_8_SUITE,tc1, + {cfg_error_8_SUITE,{tc1,g1}, {failed,{cfg_error_8_SUITE,init_per_group, {'EXIT',{init_per_group_fails,g1}}}}}}, {?eh,test_stats,{4,0,{0,11}}}, @@ -489,7 +489,7 @@ test_events(cfg_error) -> [{?eh,tc_start,{cfg_error_8_SUITE,{init_per_group,g2,[]}}}, {?eh,tc_done,{cfg_error_8_SUITE,{init_per_group,g2,[]}, {failed,{timetrap_timeout,2000}}}}, - {?eh,tc_auto_skip,{cfg_error_8_SUITE,tc1, + {?eh,tc_auto_skip,{cfg_error_8_SUITE,{tc1,g2}, {failed,{cfg_error_8_SUITE,init_per_group, {timetrap_timeout,2000}}}}}, {?eh,test_stats,{4,0,{0,12}}}, @@ -502,7 +502,7 @@ test_events(cfg_error) -> {cfg_error_8_SUITE,{init_per_group,g3,[]}, {failed,{error,{{badmatch,42},'_'}}}}}, {?eh,tc_auto_skip, - {cfg_error_8_SUITE,tc1, + {cfg_error_8_SUITE,{tc1,g3}, {failed,{cfg_error_8_SUITE,init_per_group, {'EXIT',{{badmatch,42},'_'}}}}}}, {?eh,test_stats,{4,0,{0,13}}}, @@ -528,7 +528,7 @@ test_events(cfg_error) -> {?eh,tc_done,{cfg_error_8_SUITE,{init_per_group,g6,[]}, {failed,{error,{sub_group_failed,g6}}}}}, {?eh,tc_auto_skip, - {cfg_error_8_SUITE,tc2, + {cfg_error_8_SUITE,{tc2,g6}, {failed,{cfg_error_8_SUITE,init_per_group, {'EXIT',{sub_group_failed,g6}}}}}}, {?eh,test_stats,{6,0,{0,14}}}, @@ -1111,11 +1111,11 @@ test_events(timetrap_fun_group) -> [{?eh,tc_start,{timetrap_8_SUITE,{init_per_group,g4,[]}}}, {?eh,tc_done,{timetrap_8_SUITE,{init_per_group,g4,[]}, {user_timetrap_error,{kaboom,'_'}}}}, - {?eh,tc_auto_skip,{timetrap_8_SUITE,tc0, + {?eh,tc_auto_skip,{timetrap_8_SUITE,{tc0,g4}, {failed,{timetrap_8_SUITE,init_per_group, {user_timetrap_error,{kaboom,'_'}}}}}}, {?eh,test_stats,{0,11,{0,1}}}, - {?eh,tc_auto_skip,{timetrap_8_SUITE,tc2, + {?eh,tc_auto_skip,{timetrap_8_SUITE,{tc2,g4}, {failed,{timetrap_8_SUITE,init_per_group, {user_timetrap_error,{kaboom,'_'}}}}}}, {?eh,test_stats,{0,11,{0,2}}}, @@ -1126,11 +1126,11 @@ test_events(timetrap_fun_group) -> [{?eh,tc_start,{timetrap_8_SUITE,{init_per_group,g5,[]}}}, {?eh,tc_done,{timetrap_8_SUITE,{init_per_group,g5,[]}, {user_timetrap_error,{kaboom,'_'}}}}, - {?eh,tc_auto_skip,{timetrap_8_SUITE,tc0, + {?eh,tc_auto_skip,{timetrap_8_SUITE,{tc0,g5}, {failed,{timetrap_8_SUITE,init_per_group, {user_timetrap_error,{kaboom,'_'}}}}}}, {?eh,test_stats,{0,11,{0,3}}}, - {?eh,tc_auto_skip,{timetrap_8_SUITE,tc2, + {?eh,tc_auto_skip,{timetrap_8_SUITE,{tc2,g5}, {failed,{timetrap_8_SUITE,init_per_group, {user_timetrap_error,{kaboom,'_'}}}}}}, {?eh,test_stats,{0,11,{0,4}}}, @@ -1141,11 +1141,11 @@ test_events(timetrap_fun_group) -> [{?eh,tc_start,{timetrap_8_SUITE,{init_per_group,g6,[]}}}, {?eh,tc_done,{timetrap_8_SUITE,{init_per_group,g6,[]}, {failed,{timetrap_timeout,{'$approx',500}}}}}, - {?eh,tc_auto_skip,{timetrap_8_SUITE,tc0, + {?eh,tc_auto_skip,{timetrap_8_SUITE,{tc0,g6}, {failed,{timetrap_8_SUITE,init_per_group, {timetrap_timeout,'_'}}}}}, {?eh,test_stats,{0,11,{0,5}}}, - {?eh,tc_auto_skip,{timetrap_8_SUITE,tc2, + {?eh,tc_auto_skip,{timetrap_8_SUITE,{tc2,g6}, {failed,{timetrap_8_SUITE,init_per_group, {timetrap_timeout,'_'}}}}}, {?eh,test_stats,{0,11,{0,6}}}, @@ -1294,11 +1294,11 @@ test_events(timetrap_fun_group) -> [{?eh,tc_start,{timetrap_8_SUITE,{init_per_group,pg4,[parallel]}}}, {?eh,tc_done,{timetrap_8_SUITE,{init_per_group,pg4,[parallel]}, {user_timetrap_error,{kaboom,'_'}}}}, - {?eh,tc_auto_skip,{timetrap_8_SUITE,tc0, + {?eh,tc_auto_skip,{timetrap_8_SUITE,{tc0,pg4}, {failed,{timetrap_8_SUITE,init_per_group, {user_timetrap_error,{kaboom,'_'}}}}}}, {?eh,test_stats,{4,26,{0,7}}}, - {?eh,tc_auto_skip,{timetrap_8_SUITE,tc2, + {?eh,tc_auto_skip,{timetrap_8_SUITE,{tc2,pg4}, {failed,{timetrap_8_SUITE,init_per_group, {user_timetrap_error,{kaboom,'_'}}}}}}, {?eh,test_stats,{4,26,{0,8}}}, @@ -1310,11 +1310,11 @@ test_events(timetrap_fun_group) -> [{?eh,tc_start,{timetrap_8_SUITE,{init_per_group,pg5,[parallel]}}}, {?eh,tc_done,{timetrap_8_SUITE,{init_per_group,pg5,[parallel]}, {user_timetrap_error,{kaboom,'_'}}}}, - {?eh,tc_auto_skip,{timetrap_8_SUITE,tc0, + {?eh,tc_auto_skip,{timetrap_8_SUITE,{tc0,pg5}, {failed,{timetrap_8_SUITE,init_per_group, {user_timetrap_error,{kaboom,'_'}}}}}}, {?eh,test_stats,{4,26,{0,9}}}, - {?eh,tc_auto_skip,{timetrap_8_SUITE,tc2, + {?eh,tc_auto_skip,{timetrap_8_SUITE,{tc2,pg5}, {failed,{timetrap_8_SUITE,init_per_group, {user_timetrap_error,{kaboom,'_'}}}}}}, {?eh,test_stats,{4,26,{0,10}}}, @@ -1326,11 +1326,11 @@ test_events(timetrap_fun_group) -> [{?eh,tc_start,{timetrap_8_SUITE,{init_per_group,pg6,[parallel]}}}, {?eh,tc_done,{timetrap_8_SUITE,{init_per_group,pg6,[parallel]}, {failed,{timetrap_timeout,{'$approx',500}}}}}, - {?eh,tc_auto_skip,{timetrap_8_SUITE,tc0, + {?eh,tc_auto_skip,{timetrap_8_SUITE,{tc0,pg6}, {failed,{timetrap_8_SUITE,init_per_group, {timetrap_timeout,'_'}}}}}, {?eh,test_stats,{4,26,{0,11}}}, - {?eh,tc_auto_skip,{timetrap_8_SUITE,tc2, + {?eh,tc_auto_skip,{timetrap_8_SUITE,{tc2,pg6}, {failed,{timetrap_8_SUITE,init_per_group, {timetrap_timeout,'_'}}}}}, {?eh,test_stats,{4,26,{0,12}}}, @@ -1407,10 +1407,10 @@ test_events(timetrap_fun_group) -> {?eh,tc_done,{timetrap_8_SUITE,tc0, {user_timetrap_error,{kaboom,'_'}}}}, {?eh,test_stats,{9,31,{0,12}}}, - {?eh,tc_auto_skip,{timetrap_8_SUITE,tc1, + {?eh,tc_auto_skip,{timetrap_8_SUITE,{tc1,sg1}, {failed,{timetrap_8_SUITE,tc0}}}}, {?eh,test_stats,{9,31,{0,13}}}, - {?eh,tc_auto_skip,{timetrap_8_SUITE,tc2, + {?eh,tc_auto_skip,{timetrap_8_SUITE,{tc2,sg1}, {failed,{timetrap_8_SUITE,tc0}}}}, {?eh,test_stats,{9,31,{0,14}}}, {?eh,tc_start,{timetrap_8_SUITE,{end_per_group,sg1,[sequence]}}}, @@ -1425,10 +1425,10 @@ test_events(timetrap_fun_group) -> {?eh,tc_done,{timetrap_8_SUITE,tc0, {failed,{timetrap_timeout,{'$approx',1000}}}}}, {?eh,test_stats,{10,32,{0,14}}}, - {?eh,tc_auto_skip,{timetrap_8_SUITE,tc1, + {?eh,tc_auto_skip,{timetrap_8_SUITE,{tc1,sg2}, {failed,{timetrap_8_SUITE,tc0}}}}, {?eh,test_stats,{10,32,{0,15}}}, - {?eh,tc_auto_skip,{timetrap_8_SUITE,tc2, + {?eh,tc_auto_skip,{timetrap_8_SUITE,{tc2,sg2}, {failed,{timetrap_8_SUITE,tc0}}}}, {?eh,test_stats,{10,32,{0,16}}}, {?eh,tc_start,{timetrap_8_SUITE,{end_per_group,sg2,[sequence]}}}, diff --git a/lib/common_test/test/ct_group_info_SUITE.erl b/lib/common_test/test/ct_group_info_SUITE.erl index e7bc5baaa1..83ac7dbbcf 100644 --- a/lib/common_test/test/ct_group_info_SUITE.erl +++ b/lib/common_test/test/ct_group_info_SUITE.erl @@ -273,7 +273,7 @@ test_events(timetrap_all) -> {init_per_group,g11,[]}, {auto_skipped,{group0_failed,bad_return_value}}}}, {?eh,tc_auto_skip, - {group_timetrap_1_SUITE,t111,{group0_failed,bad_return_value}}}, + {group_timetrap_1_SUITE,{t111,g11},{group0_failed,bad_return_value}}}, {?eh,test_stats,{0,13,{0,1}}}, {?eh,tc_auto_skip,{group_timetrap_1_SUITE, {end_per_group,g11}, @@ -431,7 +431,7 @@ test_events(timetrap_all_no_ips) -> {?eh,tc_done,{group_timetrap_2_SUITE, {init_per_group,g11,[]}, {auto_skipped,{group0_failed,bad_return_value}}}}, - {?eh,tc_auto_skip,{group_timetrap_2_SUITE,t111, + {?eh,tc_auto_skip,{group_timetrap_2_SUITE,{t111,g11}, {group0_failed,bad_return_value}}}, {?eh,test_stats,{0,13,{0,1}}}, {?eh,tc_auto_skip,{group_timetrap_2_SUITE, @@ -512,7 +512,7 @@ test_events(timetrap_all_no_ipg) -> {?eh,tc_done,{ct_framework, {init_per_group,g11,[{suite,group_timetrap_3_SUITE}]}, {auto_skipped,{group0_failed,bad_return_value}}}}, - {?eh,tc_auto_skip,{group_timetrap_3_SUITE,t111,{group0_failed,bad_return_value}}}, + {?eh,tc_auto_skip,{group_timetrap_3_SUITE,{t111,g11},{group0_failed,bad_return_value}}}, {?eh,test_stats,{0,13,{0,1}}}, {?eh,tc_auto_skip,{ct_framework,{end_per_group,g11}, {group0_failed,bad_return_value}}}], @@ -551,7 +551,7 @@ test_events(require) -> {?eh,tc_done,{group_require_1_SUITE,{init_per_group,g4,[]}, {auto_skipped,{require_failed, {name_in_use,common2_alias,common2}}}}}, - {?eh,tc_auto_skip,{group_require_1_SUITE,t41, + {?eh,tc_auto_skip,{group_require_1_SUITE,{t41,g4}, {require_failed, {name_in_use,common2_alias,common2}}}}, {?eh,test_stats,{4,0,{0,1}}}, @@ -580,7 +580,7 @@ test_events(require) -> {init_per_group,g8,[]}, {auto_skipped,{require_failed, {not_available,non_existing}}}}}, - {?eh,tc_auto_skip,{group_require_1_SUITE,t81, + {?eh,tc_auto_skip,{group_require_1_SUITE,{t81,g8}, {require_failed,{not_available,non_existing}}}}, {?eh,test_stats,{8,0,{0,2}}}, {?eh,tc_auto_skip,{group_require_1_SUITE,{end_per_group,g8}, @@ -604,7 +604,7 @@ test_events(require) -> {?eh,tc_done,{group_require_1_SUITE, {init_per_group,g11,[]}, {auto_skipped,{group0_failed,bad_return_value}}}}, - {?eh,tc_auto_skip,{group_require_1_SUITE,t111, + {?eh,tc_auto_skip,{group_require_1_SUITE,{t111,g11}, {group0_failed,bad_return_value}}}, {?eh,test_stats,{9,0,{0,4}}}, {?eh,tc_auto_skip,{group_require_1_SUITE, @@ -646,7 +646,7 @@ test_events(require_default) -> {?eh,tc_done,{group_require_1_SUITE, {init_per_group,g4,[]}, {auto_skipped,{require_failed,{not_available,common3}}}}}, - {?eh,tc_auto_skip,{group_require_1_SUITE,t41, + {?eh,tc_auto_skip,{group_require_1_SUITE,{t41,g4}, {require_failed,{not_available,common3}}}}, {?eh,test_stats,{4,0,{0,1}}}, {?eh,tc_auto_skip,{group_require_1_SUITE,{end_per_group,g4}, @@ -674,7 +674,7 @@ test_events(require_default) -> {init_per_group,g8,[]}, {auto_skipped,{require_failed, {not_available,non_existing}}}}}, - {?eh,tc_auto_skip,{group_require_1_SUITE,t81, + {?eh,tc_auto_skip,{group_require_1_SUITE,{t81,g8}, {require_failed,{not_available,non_existing}}}}, {?eh,test_stats,{8,0,{0,2}}}, {?eh,tc_auto_skip,{group_require_1_SUITE,{end_per_group,g8}, @@ -699,7 +699,7 @@ test_events(require_default) -> {?eh,tc_done,{group_require_1_SUITE, {init_per_group,g11,[]}, {auto_skipped,{group0_failed,bad_return_value}}}}, - {?eh,tc_auto_skip,{group_require_1_SUITE,t111, + {?eh,tc_auto_skip,{group_require_1_SUITE,{t111,g11}, {group0_failed,bad_return_value}}}, {?eh,test_stats,{9,0,{0,4}}}, {?eh,tc_auto_skip,{group_require_1_SUITE, @@ -740,7 +740,7 @@ test_events(require_no_ips) -> {?eh,tc_done,{group_require_2_SUITE,{init_per_group,g4,[]}, {auto_skipped,{require_failed, {name_in_use,common2_alias,common2}}}}}, - {?eh,tc_auto_skip,{group_require_2_SUITE,t41, + {?eh,tc_auto_skip,{group_require_2_SUITE,{t41,g4}, {require_failed,{name_in_use,common2_alias,common2}}}}, {?eh,test_stats,{4,0,{0,1}}}, {?eh,tc_auto_skip,{group_require_2_SUITE,{end_per_group,g4}, @@ -768,7 +768,7 @@ test_events(require_no_ips) -> {init_per_group,g8,[]}, {auto_skipped,{require_failed, {not_available,non_existing}}}}}, - {?eh,tc_auto_skip,{group_require_2_SUITE,t81, + {?eh,tc_auto_skip,{group_require_2_SUITE,{t81,g8}, {require_failed,{not_available,non_existing}}}}, {?eh,test_stats,{8,0,{0,2}}}, {?eh,tc_auto_skip,{group_require_2_SUITE,{end_per_group,g8}, @@ -792,7 +792,7 @@ test_events(require_no_ips) -> {?eh,tc_done,{group_require_2_SUITE, {init_per_group,g11,[]}, {auto_skipped,{group0_failed,bad_return_value}}}}, - {?eh,tc_auto_skip,{group_require_2_SUITE,t111, + {?eh,tc_auto_skip,{group_require_2_SUITE,{t111,g11}, {group0_failed,bad_return_value}}}, {?eh,test_stats,{9,0,{0,4}}}, {?eh,tc_auto_skip,{group_require_2_SUITE, @@ -831,7 +831,7 @@ test_events(require_no_ipg) -> [{?eh,tc_start,{ct_framework,{init_per_group,g4,[{suite,group_require_3_SUITE}]}}}, {?eh,tc_done,{ct_framework,{init_per_group,g4,[{suite,group_require_3_SUITE}]}, {auto_skipped,{require_failed,{name_in_use,common2_alias,common2}}}}}, - {?eh,tc_auto_skip,{group_require_3_SUITE,t41, + {?eh,tc_auto_skip,{group_require_3_SUITE,{t41,g4}, {require_failed,{name_in_use,common2_alias,common2}}}}, {?eh,test_stats,{4,0,{0,1}}}, {?eh,tc_auto_skip,{ct_framework,{end_per_group,g4}, @@ -857,7 +857,7 @@ test_events(require_no_ipg) -> [{?eh,tc_start,{ct_framework,{init_per_group,g8,[{suite,group_require_3_SUITE}]}}}, {?eh,tc_done,{ct_framework,{init_per_group,g8,[{suite,group_require_3_SUITE}]}, {auto_skipped,{require_failed,{not_available,non_existing}}}}}, - {?eh,tc_auto_skip,{group_require_3_SUITE,t81, + {?eh,tc_auto_skip,{group_require_3_SUITE,{t81,g8}, {require_failed,{not_available,non_existing}}}}, {?eh,test_stats,{8,0,{0,2}}}, {?eh,tc_auto_skip,{ct_framework,{end_per_group,g8}, @@ -879,7 +879,7 @@ test_events(require_no_ipg) -> [{?eh,tc_start,{ct_framework,{init_per_group,g11,[{suite,group_require_3_SUITE}]}}}, {?eh,tc_done,{ct_framework,{init_per_group,g11,[{suite,group_require_3_SUITE}]}, {auto_skipped,{group0_failed,bad_return_value}}}}, - {?eh,tc_auto_skip,{group_require_3_SUITE,t111,{group0_failed,bad_return_value}}}, + {?eh,tc_auto_skip,{group_require_3_SUITE,{t111,g11},{group0_failed,bad_return_value}}}, {?eh,test_stats,{9,0,{0,4}}}, {?eh,tc_auto_skip,{ct_framework,{end_per_group,g11}, {group0_failed,bad_return_value}}}], diff --git a/lib/common_test/test/ct_groups_spec_SUITE.erl b/lib/common_test/test/ct_groups_spec_SUITE.erl index 5a6d5ac0ac..de4ab77229 100644 --- a/lib/common_test/test/ct_groups_spec_SUITE.erl +++ b/lib/common_test/test/ct_groups_spec_SUITE.erl @@ -246,7 +246,8 @@ test_events(override_with_all) -> {?eh,tc_done,{groups_spec_1_SUITE,{init_per_group,g1,[sequence]},ok}}, {?eh,tc_done,{groups_spec_1_SUITE,t11,ok}}, {?eh,tc_done,{groups_spec_1_SUITE,t12,{failed,{error,crashes}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t13,{failed,{groups_spec_1_SUITE,t12}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t13,g1}, + {failed,{groups_spec_1_SUITE,t12}}}}, {?eh,test_stats,{3,2,{0,1}}}, {?eh,tc_start,{groups_spec_1_SUITE,{end_per_group,g1,[sequence]}}}, {?eh,tc_done,{groups_spec_1_SUITE,{end_per_group,g1,[sequence]},ok}}], @@ -327,19 +328,27 @@ test_events(override_with_all) -> {?eh,tc_done,{groups_spec_1_SUITE,{init_per_group,g3,[sequence]},ok}}, {?eh,tc_done,{groups_spec_1_SUITE,t31,ok}}, {?eh,tc_done,{groups_spec_1_SUITE,t32,{failed,{error,crashes}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t33,{failed,{groups_spec_1_SUITE,t32}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t33,g3}, + {failed,{groups_spec_1_SUITE,t32}}}}, {?eh,test_stats,{14,9,{0,2}}}, {?eh,tc_start,{groups_spec_1_SUITE,{end_per_group,g3,[sequence]}}}, {?eh,tc_done,{groups_spec_1_SUITE,{end_per_group,g3,[sequence]},ok}}], {?eh,tc_done,{groups_spec_1_SUITE,t22,{failed,{error,crashes}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t41,{failed,{groups_spec_1_SUITE,t22}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t51,{failed,{groups_spec_1_SUITE,t22}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t52,{failed,{groups_spec_1_SUITE,t22}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t53,{failed,{groups_spec_1_SUITE,t22}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t54,{failed,{groups_spec_1_SUITE,t22}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t42,{failed,{groups_spec_1_SUITE,t22}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t23,{failed,{groups_spec_1_SUITE,t22}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t41,g4}, + {failed,{groups_spec_1_SUITE,t22}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t51,g5}, + {failed,{groups_spec_1_SUITE,t22}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t52,g5}, + {failed,{groups_spec_1_SUITE,t22}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t53,g5}, + {failed,{groups_spec_1_SUITE,t22}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t54,g5}, + {failed,{groups_spec_1_SUITE,t22}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t42,g4}, + {failed,{groups_spec_1_SUITE,t22}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t23,g2}, + {failed,{groups_spec_1_SUITE,t22}}}}, {?eh,test_stats,{14,10,{0,9}}}, {?eh,tc_start,{groups_spec_1_SUITE,{end_per_group,g2,[sequence]}}}, @@ -355,7 +364,8 @@ test_events(override_with_all) -> {?eh,tc_done,{groups_spec_1_SUITE,{init_per_group,g3,[sequence]},ok}}, {?eh,tc_done,{groups_spec_1_SUITE,t31,ok}}, {?eh,tc_done,{groups_spec_1_SUITE,t32,{failed,{error,crashes}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t33,{failed,{groups_spec_1_SUITE,t32}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t33,g3}, + {failed,{groups_spec_1_SUITE,t32}}}}, {?eh,test_stats,{16,11,{0,10}}}, {?eh,tc_start,{groups_spec_1_SUITE,{end_per_group,g3,[sequence]}}}, {?eh,tc_done,{groups_spec_1_SUITE,{end_per_group,g3,[sequence]},ok}}], @@ -372,8 +382,10 @@ test_events(override_with_all) -> {?eh,tc_done,{groups_spec_1_SUITE,{init_per_group,g5,[sequence]},ok}}, {?eh,tc_done,{groups_spec_1_SUITE,t51,ok}}, {?eh,tc_done,{groups_spec_1_SUITE,t52,{failed,{timetrap_timeout,2000}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t53,{failed,{groups_spec_1_SUITE,t52}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t54,{failed,{groups_spec_1_SUITE,t52}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t53,g5}, + {failed,{groups_spec_1_SUITE,t52}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t54,g5}, + {failed,{groups_spec_1_SUITE,t52}}}}, {?eh,test_stats,{18,13,{0,12}}}, {?eh,tc_start,{groups_spec_1_SUITE,{end_per_group,g5,[sequence]}}}, {?eh,tc_done,{groups_spec_1_SUITE,{end_per_group,g5,[sequence]},ok}}], @@ -417,7 +429,8 @@ test_events(override_with_spec) -> {?eh,tc_done,{groups_spec_1_SUITE,{init_per_group,g1,[sequence]},ok}}, {?eh,tc_done,{groups_spec_1_SUITE,t11,ok}}, {?eh,tc_done,{groups_spec_1_SUITE,t12,{failed,{error,crashes}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t13,{failed,{groups_spec_1_SUITE,t12}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t13,g1}, + {failed,{groups_spec_1_SUITE,t12}}}}, {?eh,test_stats,{3,2,{0,1}}}, {?eh,tc_start,{groups_spec_1_SUITE,{end_per_group,g1,[sequence]}}}, {?eh,tc_done,{groups_spec_1_SUITE,{end_per_group,g1,[sequence]},ok}}], @@ -493,18 +506,26 @@ test_events(override_with_spec) -> {?eh,tc_done,{groups_spec_1_SUITE,{init_per_group,g3,[sequence]},ok}}, {?eh,tc_done,{groups_spec_1_SUITE,t31,ok}}, {?eh,tc_done,{groups_spec_1_SUITE,t32,{failed,{error,crashes}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t33,{failed,{groups_spec_1_SUITE,t32}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t33,g3}, + {failed,{groups_spec_1_SUITE,t32}}}}, {?eh,test_stats,{14,9,{0,2}}}, {?eh,tc_start,{groups_spec_1_SUITE,{end_per_group,g3,[sequence]}}}, {?eh,tc_done,{groups_spec_1_SUITE,{end_per_group,g3,[sequence]},ok}}], {?eh,tc_done,{groups_spec_1_SUITE,t22,{failed,{error,crashes}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t41,{failed,{groups_spec_1_SUITE,t22}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t51,{failed,{groups_spec_1_SUITE,t22}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t52,{failed,{groups_spec_1_SUITE,t22}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t53,{failed,{groups_spec_1_SUITE,t22}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t54,{failed,{groups_spec_1_SUITE,t22}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t42,{failed,{groups_spec_1_SUITE,t22}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t23,{failed,{groups_spec_1_SUITE,t22}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t41,g4}, + {failed,{groups_spec_1_SUITE,t22}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t51,g5}, + {failed,{groups_spec_1_SUITE,t22}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t52,g5}, + {failed,{groups_spec_1_SUITE,t22}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t53,g5}, + {failed,{groups_spec_1_SUITE,t22}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t54,g5}, + {failed,{groups_spec_1_SUITE,t22}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t42,g4}, + {failed,{groups_spec_1_SUITE,t22}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t23,g2}, + {failed,{groups_spec_1_SUITE,t22}}}}, {?eh,test_stats,{14,10,{0,9}}}, {?eh,tc_start,{groups_spec_1_SUITE,{end_per_group,g2,[sequence]}}}, {?eh,tc_done,{groups_spec_1_SUITE,{end_per_group,g2,[sequence]},ok}}], @@ -521,7 +542,8 @@ test_events(override_with_spec) -> {?eh,tc_done,{groups_spec_1_SUITE,{init_per_group,g3,[sequence]},ok}}, {?eh,tc_done,{groups_spec_1_SUITE,t31,ok}}, {?eh,tc_done,{groups_spec_1_SUITE,t32,{failed,{error,crashes}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t33,{failed,{groups_spec_1_SUITE,t32}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t33,g3}, + {failed,{groups_spec_1_SUITE,t32}}}}, {?eh,test_stats,{16,11,{0,10}}}, {?eh,tc_start,{groups_spec_1_SUITE,{end_per_group,g3,[sequence]}}}, {?eh,tc_done,{groups_spec_1_SUITE,{end_per_group,g3,[sequence]},ok}}], @@ -535,8 +557,10 @@ test_events(override_with_spec) -> {?eh,tc_done,{groups_spec_1_SUITE,{init_per_group,g5,[sequence]},ok}}, {?eh,tc_done,{groups_spec_1_SUITE,t51,ok}}, {?eh,tc_done,{groups_spec_1_SUITE,t52,{failed,{timetrap_timeout,2000}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t53,{failed,{groups_spec_1_SUITE,t52}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t54,{failed,{groups_spec_1_SUITE,t52}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t53,g5}, + {failed,{groups_spec_1_SUITE,t52}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t54,g5}, + {failed,{groups_spec_1_SUITE,t52}}}}, {?eh,test_stats,{18,13,{0,12}}}, {?eh,tc_start,{groups_spec_1_SUITE,{end_per_group,g5,[sequence]}}}, {?eh,tc_done,{groups_spec_1_SUITE,{end_per_group,g5,[sequence]},ok}}], @@ -555,7 +579,8 @@ test_events(override_with_spec) -> [{?eh,tc_start,{groups_spec_1_SUITE,{init_per_group,g1,[sequence]}}}, {?eh,tc_done,{groups_spec_1_SUITE,{init_per_group,g1,[sequence]},ok}}, {?eh,tc_done,{groups_spec_1_SUITE,t12,{failed,{error,crashes}}}}, - {?eh,tc_auto_skip,{groups_spec_1_SUITE,t13,{failed,{groups_spec_1_SUITE,t12}}}}, + {?eh,tc_auto_skip,{groups_spec_1_SUITE,{t13,g1}, + {failed,{groups_spec_1_SUITE,t12}}}}, {?eh,test_stats,{19,15,{0,13}}}, {?eh,tc_start,{groups_spec_1_SUITE,{end_per_group,g1,[sequence]}}}, {?eh,tc_done,{groups_spec_1_SUITE,{end_per_group,g1,[sequence]},ok}}], diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl index b5855da9df..c8fc4bd59b 100644 --- a/lib/common_test/test/ct_hooks_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE.erl @@ -786,7 +786,7 @@ test_events(skip_pre_end_cth) -> {?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]}, {skipped,"Test skip"}}}], - {?eh,cth,{'_',on_tc_skip,[end_per_group, + {?eh,cth,{'_',on_tc_skip,[{end_per_group,group1}, {tc_user_skip,{skipped,"Test skip"}}, []]}}, {?eh,tc_start,{ct_scope_per_group_cth_SUITE,end_per_suite}}, diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl index 9ee2a90896..6caac7e447 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl @@ -229,9 +229,9 @@ post_end_per_testcase(TC,Config,Return,State) -> %% This function should be used for extra cleanup which might be needed. %% It is not possible to modify the config or the status of the test run. -spec on_tc_fail(TC :: init_per_suite | end_per_suite | - init_per_group | end_per_group | atom(), - Reason :: term(), State :: #state{}) -> - NewState :: #state{}. + init_per_group | end_per_group | atom() | + {Function :: atom(), GroupName :: atom()}, + Reason :: term(), State :: #state{}) -> NewState :: #state{}. on_tc_fail(TC, Reason, State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), @@ -243,11 +243,11 @@ on_tc_fail(TC, Reason, State) -> %% or due to an init function failing. Test case can be %% end_per_suite, init_per_group, end_per_group and the actual test cases. -spec on_tc_skip(TC :: end_per_suite | - init_per_group | end_per_group | atom(), + init_per_group | end_per_group | atom() | + {Function :: atom(), GroupName :: atom()}, {tc_auto_skip, {failed, {Mod :: atom(), Function :: atom(), Reason :: term()}}} | - {tc_user_skip, {skipped, Reason :: term()}}, - State :: #state{}) -> - NewState :: #state{}. + {tc_user_skip, {skipped, Reason :: term()}}, + State :: #state{}) -> NewState :: #state{}. on_tc_skip(TC, Reason, State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), diff --git a/lib/common_test/test/ct_master_SUITE.erl b/lib/common_test/test/ct_master_SUITE.erl index 7408cbe376..e90513f888 100644 --- a/lib/common_test/test/ct_master_SUITE.erl +++ b/lib/common_test/test/ct_master_SUITE.erl @@ -81,7 +81,8 @@ end_per_testcase(TestCase, Config) -> ct_test_support:end_per_testcase(TestCase, Config). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> [{timetrap,{seconds,60}}, + {ct_hooks,[ts_install_cth]}]. all() -> [ct_master_test]. diff --git a/lib/common_test/test/ct_repeat_1_SUITE.erl b/lib/common_test/test/ct_repeat_1_SUITE.erl index 98eaa28763..e37aeb196c 100644 --- a/lib/common_test/test/ct_repeat_1_SUITE.erl +++ b/lib/common_test/test/ct_repeat_1_SUITE.erl @@ -225,7 +225,7 @@ test_events(repeat_cs_and_grs) -> {?eh,test_stats,{3,1,{0,0}}}, [{?eh,tc_done,{repeat_1_SUITE,{init_per_group,gr_fail_init,[]}, {failed,{error,fails_on_purpose}}}}, - {?eh,tc_auto_skip,{repeat_1_SUITE,tc_ok_1, + {?eh,tc_auto_skip,{repeat_1_SUITE,{tc_ok_1,gr_fail_init}, {failed,{repeat_1_SUITE,init_per_group, {'EXIT',fails_on_purpose}}}}}, {?eh,test_stats,{3,1,{0,1}}}, @@ -247,7 +247,7 @@ test_events(repeat_cs_and_grs) -> {?eh,test_stats,{7,2,{0,1}}}, [{?eh,tc_done,{repeat_1_SUITE,{init_per_group,gr_fail_init,[]}, {failed,{error,fails_on_purpose}}}}, - {?eh,tc_auto_skip,{repeat_1_SUITE,tc_ok_1, + {?eh,tc_auto_skip,{repeat_1_SUITE,{tc_ok_1,gr_fail_init}, {failed,{repeat_1_SUITE,init_per_group, {'EXIT',fails_on_purpose}}}}}, {?eh,test_stats,{7,2,{0,2}}}, @@ -269,7 +269,7 @@ test_events(repeat_seq) -> ok}}, {?eh,test_stats,{1,0,{0,0}}}, {?eh,test_stats,{1,1,{0,0}}}, - {?eh,tc_auto_skip,{repeat_1_SUITE,tc_ok_2, + {?eh,tc_auto_skip,{repeat_1_SUITE,{tc_ok_2,repeat_seq_1}, {failed,{repeat_1_SUITE,tc_fail_1}}}}, {?eh,test_stats,{1,1,{0,1}}}, {?eh,tc_done,{repeat_1_SUITE, @@ -291,7 +291,7 @@ test_events(repeat_seq) -> {?eh,tc_done,{repeat_1_SUITE, {end_per_group,gr_fail_result,[]}, {return_group_result,failed}}}], - {?eh,tc_auto_skip,{repeat_1_SUITE,tc_ok_2, + {?eh,tc_auto_skip,{repeat_1_SUITE,{tc_ok_2,repeat_seq_2}, {group_result,gr_fail_result,failed}}}, {?eh,test_stats,{4,2,{0,3}}}, {?eh,tc_done,{repeat_1_SUITE, @@ -315,7 +315,7 @@ test_events(repeat_seq) -> {failed, {repeat_1_SUITE,init_per_group, {'EXIT',fails_on_purpose}}}}}], - {?eh,tc_auto_skip,{repeat_1_SUITE,tc_ok_2, + {?eh,tc_auto_skip,{repeat_1_SUITE,{tc_ok_2,repeat_seq_3}, {group_result,gr_fail_init,failed}}}, {?eh,test_stats,{7,2,{0,6}}}, {?eh,tc_done,{repeat_1_SUITE, @@ -329,12 +329,13 @@ test_events(repeat_seq) -> [{?eh,tc_done,{repeat_1_SUITE, {init_per_group,repeat_seq_4,[sequence,{repeat,2}]}, ok}}, + {?eh,tc_done,{repeat_1_SUITE,tc_fail_1,'_'}}, {?eh,test_stats,{8,3,{0,8}}}, - {?eh,tc_auto_skip,{repeat_1_SUITE, - tc_ok_1,{failed,{repeat_1_SUITE,tc_fail_1}}}}, + {?eh,tc_auto_skip,{repeat_1_SUITE,{tc_ok_1,gr_ok_1}, + {failed,{repeat_1_SUITE,tc_fail_1}}}}, {?eh,test_stats,{8,3,{0,9}}}, - {?eh,tc_auto_skip,{repeat_1_SUITE, - tc_ok_1,{failed,{repeat_1_SUITE,tc_fail_1}}}}, + {?eh,tc_auto_skip,{repeat_1_SUITE,{tc_ok_1,repeat_seq_4}, + {failed,{repeat_1_SUITE,tc_fail_1}}}}, {?eh,test_stats,{8,3,{0,10}}}, {?eh,tc_done,{repeat_1_SUITE, {end_per_group,repeat_seq_4,[sequence,{repeat,2}]}, @@ -764,7 +765,7 @@ test_events(repeat_gr_until_any_fail) -> {init_per_group,gr_ok_then_fail_init,[]}, {failed,{error,failing_this_time}}}}, {?eh,tc_auto_skip, - {repeat_1_SUITE,tc_ok_1, + {repeat_1_SUITE,{tc_ok_1,gr_ok_then_fail_init}, {failed, {repeat_1_SUITE,init_per_group, {'EXIT',failing_this_time}}}}}, @@ -963,7 +964,7 @@ test_events(repeat_gr_until_all_ok) -> [{?eh,tc_done,{repeat_1_SUITE, {init_per_group,gr_fail_init_then_ok,[]}, {failed,{error,failing_this_time}}}}, - {?eh,tc_auto_skip,{repeat_1_SUITE,tc_ok_1, + {?eh,tc_auto_skip,{repeat_1_SUITE,{tc_ok_1,gr_fail_init_then_ok}, {failed,{repeat_1_SUITE,init_per_group, {'EXIT',failing_this_time}}}}}, {?eh,test_stats,{7,1,{0,1}}}, @@ -1237,10 +1238,10 @@ test_events(repeat_seq_until_any_fail) -> {?eh,tc_done,{repeat_1_SUITE,tc_ok_then_fail_1, {failed,{error,failing_this_time}}}}, {?eh,test_stats,{15,1,{0,0}}}, - {?eh,tc_auto_skip,{repeat_1_SUITE,tc_ok_2, + {?eh,tc_auto_skip,{repeat_1_SUITE,{tc_ok_2,repeat_seq_until_any_fail_3}, {failed,{repeat_1_SUITE,tc_ok_then_fail_1}}}}, {?eh,test_stats,{15,1,{0,1}}}, - {?eh,tc_auto_skip,{repeat_1_SUITE,tc_ok_1, + {?eh,tc_auto_skip,{repeat_1_SUITE,{tc_ok_1,gr_ok_1}, {failed,{repeat_1_SUITE,tc_ok_then_fail_1}}}}, {?eh,test_stats,{15,1,{0,2}}}, {?eh,tc_done,{repeat_1_SUITE, @@ -1264,10 +1265,10 @@ test_events(repeat_seq_until_any_fail) -> [{?eh,tc_done,{repeat_1_SUITE, {end_per_group,gr_ok_then_fail_result,[]}, {return_group_result,failed}}}], - {?eh,tc_auto_skip,{repeat_1_SUITE,tc_ok_1, + {?eh,tc_auto_skip,{repeat_1_SUITE,{tc_ok_1,gr_ok_1}, {group_result,gr_ok_then_fail_result,failed}}}, {?eh,test_stats,{19,1,{0,3}}}, - {?eh,tc_auto_skip,{repeat_1_SUITE,tc_ok_1, + {?eh,tc_auto_skip,{repeat_1_SUITE,{tc_ok_1,repeat_seq_until_any_fail_4}, {group_result,gr_ok_then_fail_result,failed}}}, {?eh,test_stats,{19,1,{0,4}}}, {?eh,tc_done,{repeat_1_SUITE, @@ -1296,10 +1297,10 @@ test_events(repeat_seq_until_any_fail) -> {?eh,tc_auto_skip,{repeat_1_SUITE,{end_per_group,gr_ok_then_fail_init}, {failed,{repeat_1_SUITE,init_per_group, {'EXIT',failing_this_time}}}}}], - {?eh,tc_auto_skip,{repeat_1_SUITE,tc_ok_1, + {?eh,tc_auto_skip,{repeat_1_SUITE,{tc_ok_1,gr_ok_2}, {group_result,gr_ok_then_fail_init,failed}}}, {?eh,test_stats,{24,1,{0,6}}}, - {?eh,tc_auto_skip,{repeat_1_SUITE,tc_ok_1, + {?eh,tc_auto_skip,{repeat_1_SUITE,{tc_ok_1,repeat_seq_until_any_fail_5}, {group_result,gr_ok_then_fail_init,failed}}}, {?eh,test_stats,{24,1,{0,7}}}, {?eh,tc_done,{repeat_1_SUITE, diff --git a/lib/common_test/test/ct_repeat_testrun_SUITE.erl b/lib/common_test/test/ct_repeat_testrun_SUITE.erl index bb2aba2c5a..b6f285322d 100644 --- a/lib/common_test/test/ct_repeat_testrun_SUITE.erl +++ b/lib/common_test/test/ct_repeat_testrun_SUITE.erl @@ -343,9 +343,9 @@ skip_first_tc1(Suite) -> {?eh,tc_done,{Suite,tc2,?skipped}}, {?eh,test_stats,{'_',0,{0,1}}}, {?eh,tc_done,{Suite,{init_per_group,g,[]},?skipped}}, - {?eh,tc_auto_skip,{Suite,tc1,?skip_reason}}, + {?eh,tc_auto_skip,{Suite,{tc1,g},?skip_reason}}, {?eh,test_stats,{'_',0,{0,2}}}, - {?eh,tc_auto_skip,{Suite,tc2,?skip_reason}}, + {?eh,tc_auto_skip,{Suite,{tc2,g},?skip_reason}}, {?eh,test_stats,{'_',0,{0,3}}}, {?eh,tc_auto_skip,{Suite,{end_per_group,g},?skip_reason}}, {?eh,tc_done,{Suite,tc2,?skipped}}, diff --git a/lib/common_test/test/ct_sequence_1_SUITE.erl b/lib/common_test/test/ct_sequence_1_SUITE.erl index 8c87236838..5a775a1117 100644 --- a/lib/common_test/test/ct_sequence_1_SUITE.erl +++ b/lib/common_test/test/ct_sequence_1_SUITE.erl @@ -185,7 +185,8 @@ test_events(subgroup_return_fail) -> {?eh,tc_done,{subgroups_1_SUITE,{end_per_group,return_fail,[]}, {return_group_result,failed}}}], {?eh,tc_auto_skip, - {subgroups_1_SUITE,ok_tc,{group_result,return_fail,failed}}}, + {subgroups_1_SUITE,{ok_tc,ok_group}, + {group_result,return_fail,failed}}}, {?eh,test_stats,{0,1,{0,1}}}, {?eh,tc_start, {subgroups_1_SUITE,{end_per_group,subgroup_return_fail,[sequence]}}}, @@ -208,14 +209,15 @@ test_events(subgroup_init_fail) -> [{?eh,tc_start,{subgroups_1_SUITE,{init_per_group,fail_init,[]}}}, {?eh,tc_done,{subgroups_1_SUITE,{init_per_group,fail_init,[]}, {failed,{error,init_per_group_fails_on_purpose}}}}, - {?eh,tc_auto_skip,{subgroups_1_SUITE,ok_tc, + {?eh,tc_auto_skip,{subgroups_1_SUITE,{ok_tc,fail_init}, {failed,{subgroups_1_SUITE,init_per_group, {'EXIT',init_per_group_fails_on_purpose}}}}}, {?eh,test_stats,{0,0,{0,1}}}, {?eh,tc_auto_skip,{subgroups_1_SUITE,{end_per_group,fail_init}, {failed,{subgroups_1_SUITE,init_per_group, {'EXIT',init_per_group_fails_on_purpose}}}}}], - {?eh,tc_auto_skip,{subgroups_1_SUITE,ok_tc,{group_result,fail_init,failed}}}, + {?eh,tc_auto_skip,{subgroups_1_SUITE,{ok_tc,ok_group}, + {group_result,fail_init,failed}}}, {?eh,test_stats,{0,0,{0,2}}}, {?eh,tc_start,{subgroups_1_SUITE,{end_per_group,subgroup_init_fail,[sequence]}}}, {?eh,tc_done,{subgroups_1_SUITE, @@ -237,7 +239,8 @@ test_events(subgroup_after_failed_case) -> {?eh,tc_start,{subgroups_1_SUITE,failing_tc}}, {?eh,tc_done,{subgroups_1_SUITE,failing_tc,{failed,{error,{{badmatch,3},'_'}}}}}, {?eh,test_stats,{0,1,{0,0}}}, - {?eh,tc_auto_skip,{subgroups_1_SUITE,ok_tc,{failed,{subgroups_1_SUITE,failing_tc}}}}, + {?eh,tc_auto_skip,{subgroups_1_SUITE,{ok_tc,ok_group}, + {failed,{subgroups_1_SUITE,failing_tc}}}}, {?eh,test_stats,{0,1,{0,1}}}, {?eh,tc_start,{subgroups_1_SUITE, {end_per_group,subgroup_after_failed_case,[sequence]}}}, @@ -265,7 +268,8 @@ test_events(case_after_subgroup_return_fail) -> {?eh,tc_start,{subgroups_1_SUITE,{end_per_group,return_fail,[]}}}, {?eh,tc_done,{subgroups_1_SUITE,{end_per_group,return_fail,[]}, {return_group_result,failed}}}], - {?eh,tc_auto_skip,{subgroups_1_SUITE,ok_tc,{group_result,return_fail,failed}}}, + {?eh,tc_auto_skip,{subgroups_1_SUITE,{ok_tc,case_after_subgroup_return_fail}, + {group_result,return_fail,failed}}}, {?eh,test_stats,{0,1,{0,1}}}, {?eh,tc_start,{subgroups_1_SUITE, {end_per_group,case_after_subgroup_return_fail,[sequence]}}}, @@ -289,7 +293,7 @@ test_events(case_after_subgroup_fail_init) -> {?eh,tc_done,{subgroups_1_SUITE, {init_per_group,fail_init,[]}, {failed,{error,init_per_group_fails_on_purpose}}}}, - {?eh,tc_auto_skip,{subgroups_1_SUITE,ok_tc, + {?eh,tc_auto_skip,{subgroups_1_SUITE,{ok_tc,fail_init}, {failed, {subgroups_1_SUITE,init_per_group, {'EXIT',init_per_group_fails_on_purpose}}}}}, @@ -300,7 +304,8 @@ test_events(case_after_subgroup_fail_init) -> {'EXIT',init_per_group_fails_on_purpose}}}}}], {?eh,tc_auto_skip, - {subgroups_1_SUITE,ok_tc,{group_result,fail_init,failed}}}, + {subgroups_1_SUITE,{ok_tc,case_after_subgroup_fail_init}, + {group_result,fail_init,failed}}}, {?eh,test_stats,{0,0,{0,2}}}, {?eh,tc_start,{subgroups_1_SUITE, {end_per_group,case_after_subgroup_fail_init,[sequence]}}}, diff --git a/lib/common_test/test/ct_skip_SUITE.erl b/lib/common_test/test/ct_skip_SUITE.erl index b0a6c839a2..6fb803b928 100644 --- a/lib/common_test/test/ct_skip_SUITE.erl +++ b/lib/common_test/test/ct_skip_SUITE.erl @@ -153,10 +153,10 @@ testspec_skip(Config) when is_list(Config) -> {skip_groups, TestDir, user_skip_6_SUITE, psub1, "SKIPPED"}], {Opts,ERPid} = setup_testspec([{ts1,TestSpec1}, - {ts2,TestSpec2}, - {ts3,TestSpec3}, - {ts4,TestSpec4}, - {ts5,TestSpec5}], Config), + {ts2,TestSpec2}, + {ts3,TestSpec3}, + {ts4,TestSpec4}, + {ts5,TestSpec5}], Config), ok = ct_test_support:run(Opts, Config), @@ -234,8 +234,8 @@ test_events(auto_skip) -> {?eh,tc_done, {auto_skip_2_SUITE,init_per_suite,{failed,{error,init_per_suite_failed}}}}, {?eh,tc_auto_skip, - {auto_skip_2_SUITE,tc1,{failed,{auto_skip_2_SUITE,init_per_suite, - {'EXIT',init_per_suite_failed}}}}}, + {auto_skip_2_SUITE,{tc1,g1},{failed,{auto_skip_2_SUITE,init_per_suite, + {'EXIT',init_per_suite_failed}}}}}, {?eh,test_stats,{0,0,{0,3}}}, {?eh,tc_auto_skip, {auto_skip_2_SUITE,end_per_suite,{failed,{auto_skip_2_SUITE,init_per_suite, @@ -274,12 +274,12 @@ test_events(auto_skip) -> {?eh,tc_done, {auto_skip_5_SUITE,{init_per_group,g1,[]},{failed,{error,{group,g1,failed}}}}}, {?eh,tc_auto_skip, - {auto_skip_5_SUITE,tc1,{failed,{auto_skip_5_SUITE,init_per_group, - {'EXIT',{group,g1,failed}}}}}}, + {auto_skip_5_SUITE,{tc1,g1},{failed,{auto_skip_5_SUITE,init_per_group, + {'EXIT',{group,g1,failed}}}}}}, {?eh,test_stats,{2,0,{0,6}}}, {?eh,tc_auto_skip, - {auto_skip_5_SUITE,tc2,{failed,{auto_skip_5_SUITE,init_per_group, - {'EXIT',{group,g1,failed}}}}}}, + {auto_skip_5_SUITE,{tc2,g1},{failed,{auto_skip_5_SUITE,init_per_group, + {'EXIT',{group,g1,failed}}}}}}, {?eh,test_stats,{2,0,{0,7}}}, {?eh,tc_auto_skip, {auto_skip_5_SUITE,{end_per_group,g1}, @@ -295,20 +295,20 @@ test_events(auto_skip) -> {?eh,tc_done, {auto_skip_6_SUITE,{init_per_group,g1,[]},{failed,{error,{group,g1,failed}}}}}, {?eh,tc_auto_skip, - {auto_skip_6_SUITE,tc1,{failed,{auto_skip_6_SUITE,init_per_group, - {'EXIT',{group,g1,failed}}}}}}, + {auto_skip_6_SUITE,{tc1,g1},{failed,{auto_skip_6_SUITE,init_per_group, + {'EXIT',{group,g1,failed}}}}}}, {?eh,test_stats,{2,0,{0,8}}}, {?eh,tc_auto_skip, - {auto_skip_6_SUITE,tc3,{failed,{auto_skip_6_SUITE,init_per_group, - {'EXIT',{group,g1,failed}}}}}}, + {auto_skip_6_SUITE,{tc3,g2},{failed,{auto_skip_6_SUITE,init_per_group, + {'EXIT',{group,g1,failed}}}}}}, {?eh,test_stats,{2,0,{0,9}}}, {?eh,tc_auto_skip, - {auto_skip_6_SUITE,tc4,{failed,{auto_skip_6_SUITE,init_per_group, - {'EXIT',{group,g1,failed}}}}}}, + {auto_skip_6_SUITE,{tc4,g2},{failed,{auto_skip_6_SUITE,init_per_group, + {'EXIT',{group,g1,failed}}}}}}, {?eh,test_stats,{2,0,{0,10}}}, {?eh,tc_auto_skip, - {auto_skip_6_SUITE,tc2,{failed,{auto_skip_6_SUITE,init_per_group, - {'EXIT',{group,g1,failed}}}}}}, + {auto_skip_6_SUITE,{tc2,g1},{failed,{auto_skip_6_SUITE,init_per_group, + {'EXIT',{group,g1,failed}}}}}}, {?eh,test_stats,{2,0,{0,11}}}, {?eh,tc_auto_skip, {auto_skip_6_SUITE,{end_per_group,g1}, @@ -324,12 +324,12 @@ test_events(auto_skip) -> {?eh,tc_done,{auto_skip_6_SUITE,{init_per_group,g4,[]}, {failed,{error,{group,g4,failed}}}}}, {?eh,tc_auto_skip, - {auto_skip_6_SUITE,tc3,{failed,{auto_skip_6_SUITE,init_per_group, - {'EXIT',{group,g4,failed}}}}}}, + {auto_skip_6_SUITE,{tc3,g4},{failed,{auto_skip_6_SUITE,init_per_group, + {'EXIT',{group,g4,failed}}}}}}, {?eh,test_stats,{3,0,{0,12}}}, {?eh,tc_auto_skip, - {auto_skip_6_SUITE,tc4,{failed,{auto_skip_6_SUITE,init_per_group, - {'EXIT',{group,g4,failed}}}}}}, + {auto_skip_6_SUITE,{tc4,g4},{failed,{auto_skip_6_SUITE,init_per_group, + {'EXIT',{group,g4,failed}}}}}}, {?eh,test_stats,{3,0,{0,13}}}, {?eh,tc_auto_skip, {auto_skip_6_SUITE,{end_per_group,g4}, @@ -498,13 +498,13 @@ test_events(auto_skip) -> [{suite,auto_skip_12_SUITE}]}, {auto_skipped, {require_failed,{not_available,unknown_variable_g1}}}}}, - {?eh,tc_auto_skip,{auto_skip_12_SUITE,tc1, + {?eh,tc_auto_skip,{auto_skip_12_SUITE,{tc1,g1}, {require_failed,{not_available,unknown_variable_g1}}}}, {?eh,test_stats,{10,0,{0,25}}}, - {?eh,tc_auto_skip,{auto_skip_12_SUITE,tc2, + {?eh,tc_auto_skip,{auto_skip_12_SUITE,{tc2,g1}, {require_failed,{not_available,unknown_variable_g1}}}}, {?eh,test_stats,{10,0,{0,26}}}, - {?eh,tc_auto_skip,{auto_skip_12_SUITE,tc3, + {?eh,tc_auto_skip,{auto_skip_12_SUITE,{tc3,g2}, {require_failed,{not_available,unknown_variable_g1}}}}, {?eh,test_stats,{10,0,{0,27}}}, {?eh,tc_auto_skip,{ct_framework,{end_per_group,g1}, @@ -516,13 +516,13 @@ test_events(auto_skip) -> [{suite,auto_skip_12_SUITE}]}, {auto_skipped, {require_failed,{not_available,unknown_variable_g1}}}}}, - {?eh,tc_auto_skip,{auto_skip_12_SUITE,tc1, + {?eh,tc_auto_skip,{auto_skip_12_SUITE,{tc1,g1}, {require_failed,{not_available,unknown_variable_g1}}}}, {?eh,test_stats,{10,0,{0,28}}}, - {?eh,tc_auto_skip,{auto_skip_12_SUITE,tc2, + {?eh,tc_auto_skip,{auto_skip_12_SUITE,{tc2,g1}, {require_failed,{not_available,unknown_variable_g1}}}}, {?eh,test_stats,{10,0,{0,29}}}, - {?eh,tc_auto_skip,{auto_skip_12_SUITE,tc3, + {?eh,tc_auto_skip,{auto_skip_12_SUITE,{tc3,g2}, {require_failed,{not_available,unknown_variable_g1}}}}, {?eh,test_stats,{10,0,{0,30}}}, {?eh,tc_auto_skip,{ct_framework,{end_per_group,g1}, @@ -544,7 +544,7 @@ test_events(auto_skip) -> [{suite,auto_skip_12_SUITE}]}, {auto_skipped, {require_failed,{not_available,unknown_variable_g4}}}}}, - {?eh,tc_auto_skip,{auto_skip_12_SUITE,tc3, + {?eh,tc_auto_skip,{auto_skip_12_SUITE,{tc3,g4}, {require_failed,{not_available,unknown_variable_g4}}}}, {?eh,test_stats,{12,0,{0,31}}}, {?eh,tc_auto_skip,{ct_framework,{end_per_group,g4}, @@ -574,10 +574,10 @@ test_events(user_skip) -> {user_skip_1_SUITE,tc1,"Whole suite skipped"}}, {?eh,test_stats,{0,0,{1,0}}}, {?eh,tc_user_skip, - {user_skip_1_SUITE,tc2,"Whole suite skipped"}}, + {user_skip_1_SUITE,{tc2,g1},"Whole suite skipped"}}, {?eh,test_stats,{0,0,{2,0}}}, {?eh,tc_user_skip, - {user_skip_1_SUITE,tc3,"Whole suite skipped"}}, + {user_skip_1_SUITE,{tc3,g1},"Whole suite skipped"}}, {?eh,test_stats,{0,0,{3,0}}}, {?eh,tc_user_skip, {user_skip_1_SUITE,tc4,"Whole suite skipped"}}, @@ -638,9 +638,9 @@ test_events(user_skip) -> [{?eh,tc_start,{user_skip_4_SUITE,{init_per_group,g1,[]}}}, {?eh,tc_done,{user_skip_4_SUITE,{init_per_group,g1,[]},{skipped,"Group skipped"}}}, - {?eh,tc_user_skip,{user_skip_4_SUITE,tc1,"Group skipped"}}, + {?eh,tc_user_skip,{user_skip_4_SUITE,{tc1,g1},"Group skipped"}}, {?eh,test_stats,{3,0,{10,0}}}, - {?eh,tc_user_skip,{user_skip_4_SUITE,tc2,"Group skipped"}}, + {?eh,tc_user_skip,{user_skip_4_SUITE,{tc2,g1},"Group skipped"}}, {?eh,test_stats,{3,0,{11,0}}}, {?eh,tc_user_skip,{user_skip_4_SUITE,{end_per_group,g1},"Group skipped"}}], @@ -657,10 +657,10 @@ test_events(user_skip) -> [{?eh,tc_start,{user_skip_4_SUITE,{init_per_group,g3,[]}}}, {?eh,tc_done,{user_skip_4_SUITE,{init_per_group,g3,[]},{skipped,"Group skipped"}}}, - {?eh,tc_user_skip,{user_skip_4_SUITE,tc5,"Group skipped"}}, - {?eh,tc_user_skip,{user_skip_4_SUITE,tc6,"Group skipped"}}, - {?eh,tc_user_skip,{user_skip_4_SUITE,tc7,"Group skipped"}}, - {?eh,tc_user_skip,{user_skip_4_SUITE,tc8,"Group skipped"}}, + {?eh,tc_user_skip,{user_skip_4_SUITE,{tc5,g3},"Group skipped"}}, + {?eh,tc_user_skip,{user_skip_4_SUITE,{tc6,g4},"Group skipped"}}, + {?eh,tc_user_skip,{user_skip_4_SUITE,{tc7,g4},"Group skipped"}}, + {?eh,tc_user_skip,{user_skip_4_SUITE,{tc8,g3},"Group skipped"}}, {?eh,test_stats,{5,0,{15,0}}}, {?eh,tc_user_skip,{user_skip_4_SUITE,{end_per_group,g3},"Group skipped"}}], @@ -671,9 +671,9 @@ test_events(user_skip) -> {?eh,test_stats,{6,0,{15,0}}}, [{?eh,tc_start,{user_skip_4_SUITE,{init_per_group,g6,[]}}}, {?eh,tc_done,{user_skip_4_SUITE,{init_per_group,g6,[]},{skipped,"Group skipped"}}}, - {?eh,tc_user_skip,{user_skip_4_SUITE,tc10,"Group skipped"}}, + {?eh,tc_user_skip,{user_skip_4_SUITE,{tc10,g6},"Group skipped"}}, {?eh,test_stats,{6,0,{16,0}}}, - {?eh,tc_user_skip,{user_skip_4_SUITE,tc11,"Group skipped"}}, + {?eh,tc_user_skip,{user_skip_4_SUITE,{tc11,g6},"Group skipped"}}, {?eh,test_stats,{6,0,{17,0}}}, {?eh,tc_user_skip,{user_skip_4_SUITE,{end_per_group,g6},"Group skipped"}}], {?eh,tc_start,{user_skip_4_SUITE,{end_per_group,g5,[]}}}, @@ -687,9 +687,9 @@ test_events(user_skip) -> {skipped,{bad,'Whole suite skipped'}}}}, {?eh,tc_user_skip,{user_skip_5_SUITE,tc1,{bad,'Whole suite skipped'}}}, {?eh,test_stats,{6,0,{18,0}}}, - {?eh,tc_user_skip,{user_skip_5_SUITE,tc2,{bad,'Whole suite skipped'}}}, + {?eh,tc_user_skip,{user_skip_5_SUITE,{tc2,g1},{bad,'Whole suite skipped'}}}, {?eh,test_stats,{6,0,{19,0}}}, - {?eh,tc_user_skip,{user_skip_5_SUITE,tc3,{bad,'Whole suite skipped'}}}, + {?eh,tc_user_skip,{user_skip_5_SUITE,{tc3,g1},{bad,'Whole suite skipped'}}}, {?eh,test_stats,{6,0,{20,0}}}, {?eh,tc_user_skip,{user_skip_5_SUITE,tc4,{bad,'Whole suite skipped'}}}, {?eh,test_stats,{6,0,{21,0}}}, @@ -700,10 +700,10 @@ test_events(user_skip) -> {?eh,tc_done,{user_skip_6_SUITE, {init_per_group,ptop1,[parallel]}, {skipped,"Top group skipped"}}}, - {?eh,tc_user_skip,{user_skip_6_SUITE,tc1,"Top group skipped"}}, - {?eh,tc_user_skip,{user_skip_6_SUITE,tc3,"Top group skipped"}}, - {?eh,tc_user_skip,{user_skip_6_SUITE,tc4,"Top group skipped"}}, - {?eh,tc_user_skip,{user_skip_6_SUITE,tc2,"Top group skipped"}}, + {?eh,tc_user_skip,{user_skip_6_SUITE,{tc1,ptop1},"Top group skipped"}}, + {?eh,tc_user_skip,{user_skip_6_SUITE,{tc3,psub1},"Top group skipped"}}, + {?eh,tc_user_skip,{user_skip_6_SUITE,{tc4,psub1},"Top group skipped"}}, + {?eh,tc_user_skip,{user_skip_6_SUITE,{tc2,ptop1},"Top group skipped"}}, {?eh,tc_user_skip,{user_skip_6_SUITE,{end_per_group,ptop1}, "Top group skipped"}}]}, @@ -718,8 +718,8 @@ test_events(user_skip) -> {?eh,tc_done,{user_skip_6_SUITE, {init_per_group,psub2,[parallel]}, {skipped,"Sub group skipped"}}}, - {?eh,tc_user_skip,{user_skip_6_SUITE,tc3,"Sub group skipped"}}, - {?eh,tc_user_skip,{user_skip_6_SUITE,tc4,"Sub group skipped"}}, + {?eh,tc_user_skip,{user_skip_6_SUITE,{tc3,psub2},"Sub group skipped"}}, + {?eh,tc_user_skip,{user_skip_6_SUITE,{tc4,psub2},"Sub group skipped"}}, {?eh,tc_user_skip,{user_skip_6_SUITE,{end_per_group,psub2}, "Sub group skipped"}}]}, @@ -745,14 +745,14 @@ test_events(testspec_skip) -> {user_skip_7_SUITE,{init_per_group,ptop1,[parallel]}}}, {?eh,tc_done, {user_skip_7_SUITE,{init_per_group,ptop1,[parallel]},ok}}, - {?eh,tc_user_skip,{user_skip_7_SUITE,tc1,"SKIPPED"}}, + {?eh,tc_user_skip,{user_skip_7_SUITE,{tc1,ptop1},"SKIPPED"}}, {?eh,test_stats,{0,0,{1,0}}}, {parallel, [{?eh,tc_start, {user_skip_7_SUITE,{init_per_group,psub1,[parallel]}}}, {?eh,tc_done, {user_skip_7_SUITE,{init_per_group,psub1,[parallel]},ok}}, - {?eh,tc_user_skip,{user_skip_7_SUITE,tc3,"SKIPPED"}}, + {?eh,tc_user_skip,{user_skip_7_SUITE,{tc3,psub1},"SKIPPED"}}, {?eh,tc_start,{user_skip_7_SUITE,tc4}}, {?eh,tc_done,{user_skip_7_SUITE,tc4,ok}}, {?eh,test_stats,{1,0,{2,0}}}, @@ -778,13 +778,13 @@ test_events(testspec_skip) -> {?eh,tc_start,{ct_framework,init_per_suite}}, {?eh,tc_done,{ct_framework,init_per_suite,ok}}, {?eh,tc_user_skip,{user_skip_7_SUITE,{init_per_group,ptop1},"SKIPPED"}}, - {?eh,tc_user_skip,{user_skip_7_SUITE,tc1,"SKIPPED"}}, + {?eh,tc_user_skip,{user_skip_7_SUITE,{tc1,ptop1},"SKIPPED"}}, {?eh,test_stats,{0,0,{1,0}}}, - {?eh,tc_user_skip,{user_skip_7_SUITE,tc3,"SKIPPED"}}, + {?eh,tc_user_skip,{user_skip_7_SUITE,{tc3,psub1},"SKIPPED"}}, {?eh,test_stats,{0,0,{2,0}}}, - {?eh,tc_user_skip,{user_skip_7_SUITE,tc4,"SKIPPED"}}, + {?eh,tc_user_skip,{user_skip_7_SUITE,{tc4,psub1},"SKIPPED"}}, {?eh,test_stats,{0,0,{3,0}}}, - {?eh,tc_user_skip,{user_skip_7_SUITE,tc2,"SKIPPED"}}, + {?eh,tc_user_skip,{user_skip_7_SUITE,{tc2,ptop1},"SKIPPED"}}, {?eh,test_stats,{0,0,{4,0}}}, {?eh,tc_user_skip,{user_skip_7_SUITE,{end_per_group,ptop1},"SKIPPED"}}, {?eh,tc_start,{ct_framework,end_per_suite}}, @@ -804,8 +804,8 @@ test_events(testspec_skip) -> {user_skip_7_SUITE,{init_per_group,ptop1,[parallel]},ok}}, {?eh,tc_user_skip, {user_skip_7_SUITE,{init_per_group,psub1},"SKIPPED"}}, - {?eh,tc_user_skip,{user_skip_7_SUITE,tc3,"SKIPPED"}}, - {?eh,tc_user_skip,{user_skip_7_SUITE,tc4,"SKIPPED"}}, + {?eh,tc_user_skip,{user_skip_7_SUITE,{tc3,psub1},"SKIPPED"}}, + {?eh,tc_user_skip,{user_skip_7_SUITE,{tc4,psub1},"SKIPPED"}}, {?eh,test_stats,{0,0,{2,0}}}, {?eh,tc_user_skip,{user_skip_7_SUITE,{end_per_group,psub1},"SKIPPED"}}, {?eh,tc_start,{user_skip_7_SUITE,tc1}}, @@ -837,13 +837,13 @@ test_events(testspec_skip) -> {?eh,tc_done,{user_skip_6_SUITE, {init_per_group,ptop1,[parallel]}, {skipped,"Top group skipped"}}}, - {?eh,tc_user_skip,{user_skip_6_SUITE,tc1,"Top group skipped"}}, + {?eh,tc_user_skip,{user_skip_6_SUITE,{tc1,ptop1},"Top group skipped"}}, {?eh,test_stats,{0,0,{1,0}}}, - {?eh,tc_user_skip,{user_skip_6_SUITE,tc3,"SKIPPED"}}, + {?eh,tc_user_skip,{user_skip_6_SUITE,{tc3,psub1},"SKIPPED"}}, {?eh,test_stats,{0,0,{2,0}}}, - {?eh,tc_user_skip,{user_skip_6_SUITE,tc4,"SKIPPED"}}, + {?eh,tc_user_skip,{user_skip_6_SUITE,{tc4,psub1},"SKIPPED"}}, {?eh,test_stats,{0,0,{3,0}}}, - {?eh,tc_user_skip,{user_skip_6_SUITE,tc2,"Top group skipped"}}, + {?eh,tc_user_skip,{user_skip_6_SUITE,{tc2,ptop1},"Top group skipped"}}, {?eh,test_stats,{0,0,{4,0}}}, {?eh,tc_user_skip, {user_skip_6_SUITE,{end_per_group,ptop1},"Top group skipped"}}]}, diff --git a/lib/common_test/test/ct_surefire_SUITE.erl b/lib/common_test/test/ct_surefire_SUITE.erl index c5e44682b0..db7a0be915 100644 --- a/lib/common_test/test/ct_surefire_SUITE.erl +++ b/lib/common_test/test/ct_surefire_SUITE.erl @@ -205,7 +205,7 @@ test_events(_) -> [{?eh,tc_start,{surefire_SUITE,{init_per_group,g_fail,[]}}}, {?eh,tc_done,{surefire_SUITE,{init_per_group,g_fail,[]}, {failed,{error,all_cases_should_be_skipped}}}}, - {?eh,tc_auto_skip,{surefire_SUITE,tc_ok, + {?eh,tc_auto_skip,{surefire_SUITE,{tc_ok,g_fail}, {failed, {surefire_SUITE,init_per_group, {'EXIT',all_cases_should_be_skipped}}}}}, diff --git a/lib/common_test/test/ct_telnet_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE.erl index acce4eca14..f5cff76fd1 100644 --- a/lib/common_test/test/ct_telnet_SUITE.erl +++ b/lib/common_test/test/ct_telnet_SUITE.erl @@ -72,19 +72,32 @@ init_per_suite(Config) -> end_per_suite(Config) -> ct_test_support:end_per_suite(Config). -init_per_testcase(TestCase, Config) when TestCase=/=unix_telnet-> +init_per_testcase(TestCase, Config) when TestCase /= unix_telnet -> + ct:pal("Testcase ~p starting!", [TestCase]), TS = telnet_server:start([{port,?erl_telnet_server_port}, {users,[{?erl_telnet_server_user, ?erl_telnet_server_pwd}]}]), ct_test_support:init_per_testcase(TestCase, [{telnet_server,TS}|Config]); init_per_testcase(TestCase, Config) -> - ct_test_support:init_per_testcase(TestCase, Config). - + ct:pal("Testcase ~p starting. Checking connection to telnet server...", + [TestCase]), + ct:require(testconn, {unix,[telnet]}), + case {os:type(),ct_telnet:open(testconn)} of + {_,{ok,Handle}} -> + ok = ct_telnet:close(Handle), + ct:pal("Connection ok, starting tests!", []), + ct_test_support:init_per_testcase(TestCase, Config); + {{unix,_},{error,Reason}} -> + ct:fail("No connection to telnet server! Reason: ~tp", [Reason]); + {_,{error,Reason}} -> + {skip,{no_access_to_telnet_server,Reason}} + end. + +end_per_testcase(TestCase, Config) when TestCase /= unix_telnet -> + ct:pal("Stopping the telnet_server now!", []), + telnet_server:stop(?config(telnet_server,Config)), + ct_test_support:end_per_testcase(TestCase, Config); end_per_testcase(TestCase, Config) -> - case ?config(telnet_server,Config) of - undefined -> ok; - TS -> telnet_server:stop(TS) - end, ct_test_support:end_per_testcase(TestCase, Config). @@ -179,7 +192,12 @@ telnet_config(_, LogType) -> {port, ?erl_telnet_server_port}, {username,?erl_telnet_server_user}, {password,?erl_telnet_server_pwd}, - {keep_alive,true}]} | + {keep_alive,true}]}, + {telnet_settings, [{connect_timeout,10000}, + {command_timeout,10000}, + {reconnection_attempts,0}, + {reconnection_interval,0}, + {keep_alive,true}]} | if LogType == legacy -> [{ct_conn_log,[]}]; true -> diff --git a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl index 8d142e85a8..0ee0525216 100644 --- a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl +++ b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl @@ -20,7 +20,9 @@ all() -> expect_repeat, expect_sequence, expect_error_prompt, - expect_error_timeout, + expect_error_timeout1, + expect_error_timeout2, + expect_error_timeout3, no_prompt_check, no_prompt_check_repeat, no_prompt_check_sequence, @@ -28,7 +30,9 @@ all() -> ignore_prompt, ignore_prompt_repeat, ignore_prompt_sequence, - ignore_prompt_timeout]. + ignore_prompt_timeout, + server_speaks, + server_disconnects]. groups() -> []. @@ -85,13 +89,34 @@ expect_error_prompt(_) -> %% Check that expect returns after idle timeout, and even if the %% expected pattern is received - as long as not newline or prompt is %% received it will not match. -expect_error_timeout(_) -> +expect_error_timeout1(_) -> {ok, Handle} = ct_telnet:open(telnet_server_conn1), ok = ct_telnet:send(Handle, "echo_no_prompt xxx"), {error,timeout} = ct_telnet:expect(Handle, ["xxx"], [{timeout,1000}]), ok = ct_telnet:close(Handle), ok. +expect_error_timeout2(_) -> + {ok, Handle} = ct_telnet:open(telnet_server_conn1), + ok = ct_telnet:send(Handle, "echo_no_prompt xxx"), + {error,timeout} = ct_telnet:expect(Handle, ["xxx"], [{idle_timeout,1000}, + {total_timeout,infinity}]), + ok = ct_telnet:close(Handle), + ok. + +%% Check that if server loops and pattern not matching, the operation +%% can be aborted +expect_error_timeout3(_) -> + {ok, Handle} = ct_telnet:open(telnet_server_conn1), + ok = ct_telnet:send(Handle, "echo_loop 5000 xxx"), + {error,timeout} = ct_telnet:expect(Handle, ["yyy"], + [{idle_timeout,infinity}, + {total_timeout,3000}]), + ok = ct_telnet:send(Handle, "echo ayt"), + {ok,["ayt"]} = ct_telnet:expect(Handle, ["ayt"]), + ok = ct_telnet:close(Handle), + ok. + %% expect with ignore_prompt option should not return even if a prompt %% is found. The pattern after the prompt (here "> ") can be matched. ignore_prompt(_) -> @@ -188,3 +213,37 @@ no_prompt_check_timeout(_) -> {timeout,1000}]), ok = ct_telnet:close(Handle), ok. + +%% The server says things. Manually check that it gets printed correctly +%% in the general IO log. +server_speaks(_) -> + {ok, Handle} = ct_telnet:open(telnet_server_conn1), + ok = ct_telnet:send(Handle, "echo_no_prompt This is the first message\r\n"), + ok = ct_telnet:send(Handle, "echo_no_prompt This is the second message\r\n"), + %% let ct_telnet_client get an idle timeout + timer:sleep(15000), + ok = ct_telnet:send(Handle, "echo_no_prompt This is the third message\r\n"), + {ok,_} = ct_telnet:expect(Handle, ["the"], [no_prompt_check]), + {error,timeout} = ct_telnet:expect(Handle, ["the"], [no_prompt_check, + {timeout,1000}]), + ok = ct_telnet:send(Handle, "echo_no_prompt This is the fourth message\r\n"), + %% give the server time to respond + timer:sleep(2000), + %% closing the connection should print last message in log + ok = ct_telnet:close(Handle), + ok. + +%% Let the server close the connection. Make sure buffered data gets printed +%% to the general IO log. +server_disconnects(_) -> + {ok, Handle} = ct_telnet:open(telnet_server_conn1), + ok = ct_telnet:send(Handle, "disconnect_after 1500"), + %% wait until the get_data operation (triggered by send/2) times out + %% before sending the msg + timer:sleep(500), + ok = ct_telnet:send(Handle, "echo_no_prompt This is the message\r\n"), + %% when the server closes the connection, the last message should be + %% printed in the log + timer:sleep(3000), + _ = ct_telnet:close(Handle), + ok. diff --git a/lib/common_test/test/ct_test_server_if_1_SUITE.erl b/lib/common_test/test/ct_test_server_if_1_SUITE.erl index 9882fa980c..b6ef3062d4 100644 --- a/lib/common_test/test/ct_test_server_if_1_SUITE.erl +++ b/lib/common_test/test/ct_test_server_if_1_SUITE.erl @@ -168,7 +168,7 @@ test_events(ts_if_1) -> {?eh,tc_start,{ts_if_1_SUITE,tc4}}, {?eh,tc_done,{ts_if_1_SUITE,tc4,{failed,{error,failed_on_purpose}}}}, {?eh,test_stats,{1,3,{0,2}}}, - {?eh,tc_auto_skip,{ts_if_1_SUITE,tc5,{failed,{ts_if_1_SUITE,tc4}}}}, + {?eh,tc_auto_skip,{ts_if_1_SUITE,{tc5,seq2},{failed,{ts_if_1_SUITE,tc4}}}}, {?eh,test_stats,{1,3,{0,3}}}, {?eh,tc_start,{ts_if_1_SUITE,{end_per_group,seq2,[sequence]}}}, {?eh,tc_done,{ts_if_1_SUITE,{end_per_group,seq2,[sequence]},ok}}], @@ -199,7 +199,7 @@ test_events(ts_if_1) -> [{?eh,tc_start,{ts_if_1_SUITE,{init_per_group,g1,[]}}}, {?eh,tc_done,{ts_if_1_SUITE,{init_per_group,g1,[]}, {skipped,g1_got_skipped}}}, - {?eh,tc_user_skip,{ts_if_1_SUITE,gtc1,g1_got_skipped}}, + {?eh,tc_user_skip,{ts_if_1_SUITE,{gtc1,g1},g1_got_skipped}}, {?eh,test_stats,{1,4,{3,6}}}, {?eh,tc_user_skip,{ts_if_1_SUITE,{end_per_group,g1},g1_got_skipped}}], @@ -208,7 +208,7 @@ test_events(ts_if_1) -> {?eh,tc_done,{ts_if_1_SUITE,{init_per_group,g2,[parallel]},ok}}, [{?eh,tc_start,{ts_if_1_SUITE,{init_per_group,g3,[]}}}, {?eh,tc_done,{ts_if_1_SUITE,{init_per_group,g3,[]},{skipped,g3_got_skipped}}}, - {?eh,tc_user_skip,{ts_if_1_SUITE,gtc2,g3_got_skipped}}, + {?eh,tc_user_skip,{ts_if_1_SUITE,{gtc2,g3},g3_got_skipped}}, {?eh,test_stats,{1,4,{4,6}}}, {?eh,tc_user_skip,{ts_if_1_SUITE,{end_per_group,g3},g3_got_skipped}}], {?eh,tc_start,{ts_if_1_SUITE,{end_per_group,g2,[parallel]}}}, @@ -279,7 +279,7 @@ test_events(ts_if_1) -> {init_per_group,g1,[]}, {auto_skipped,{group0_failed,bad_return_value}}}}, {?eh,tc_auto_skip, - {ts_if_7_SUITE,tc2,{group0_failed,bad_return_value}}}, + {ts_if_7_SUITE,{tc2,g1},{group0_failed,bad_return_value}}}, {?eh,test_stats,{2,7,{4,11}}}, {?eh,tc_auto_skip, {ts_if_7_SUITE,{end_per_group,g1},{group0_failed,bad_return_value}}}, diff --git a/lib/common_test/test/ct_testspec_1_SUITE.erl b/lib/common_test/test/ct_testspec_1_SUITE.erl index 187b5e6d3a..c2670316b6 100644 --- a/lib/common_test/test/ct_testspec_1_SUITE.erl +++ b/lib/common_test/test/ct_testspec_1_SUITE.erl @@ -763,35 +763,35 @@ test_events(skip_all_groups) -> {?eh,start_info,{1,1,12}}, {?eh,tc_start,{groups_11_SUITE,init_per_suite}}, {?eh,tc_user_skip,{groups_11_SUITE,{init_per_group,test_group_1a},"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_1a,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_1a,test_group_1a},"SKIPPED!"}}, {?eh,test_stats,{0,0,{1,0}}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_1b,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_1b,test_group_1a},"SKIPPED!"}}, {?eh,test_stats,{0,0,{2,0}}}, {?eh,tc_user_skip,{groups_11_SUITE,{end_per_group,test_group_1a},"SKIPPED!"}}, {?eh,tc_user_skip,{groups_11_SUITE,{init_per_group,test_group_1b},"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_1a,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_1a,test_group_1b},"SKIPPED!"}}, {?eh,test_stats,{0,0,{3,0}}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_1b,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_1b,test_group_1b},"SKIPPED!"}}, {?eh,test_stats,{0,0,{4,0}}}, {?eh,tc_user_skip,{groups_11_SUITE,{end_per_group,test_group_1b},"SKIPPED!"}}, {?eh,tc_user_skip,{groups_11_SUITE,{init_per_group,test_group_2},"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_2a,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_2a,test_group_2},"SKIPPED!"}}, {?eh,test_stats,{0,0,{5,0}}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_3a,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_3a,test_group_3},"SKIPPED!"}}, {?eh,test_stats,{0,0,{6,0}}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_3b,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_3b,test_group_3},"SKIPPED!"}}, {?eh,test_stats,{0,0,{7,0}}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_2b,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_2b,test_group_2},"SKIPPED!"}}, {?eh,test_stats,{0,0,{8,0}}}, {?eh,tc_user_skip,{groups_11_SUITE,{end_per_group,test_group_2},"SKIPPED!"}}, {?eh,tc_user_skip,{groups_11_SUITE,{init_per_group,test_group_4},"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_5a,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_5a,test_group_5},"SKIPPED!"}}, {?eh,test_stats,{0,0,{9,0}}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_7a,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_7a,test_group_7},"SKIPPED!"}}, {?eh,test_stats,{0,0,{10,0}}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_7b,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_7b,test_group_7},"SKIPPED!"}}, {?eh,test_stats,{0,0,{11,0}}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_5b,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_5b,test_group_5},"SKIPPED!"}}, {?eh,test_stats,{0,0,{12,0}}}, {?eh,tc_user_skip,{groups_11_SUITE,{end_per_group,test_group_4},"SKIPPED!"}}, {?eh,tc_start,{groups_11_SUITE,end_per_suite}}, @@ -826,17 +826,17 @@ test_events(skip_group) -> {?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_1a,[]},ok}}], {?eh,tc_user_skip,{groups_11_SUITE,{init_per_group,test_group_1b}, "SKIPPED!"}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_1a,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_1b,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_1a,test_group_1b},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_1b,test_group_1b},"SKIPPED!"}}, {?eh,test_stats,{2,0,{2,0}}}, {?eh,tc_user_skip,{groups_11_SUITE,{end_per_group,test_group_1b}, "SKIPPED!"}}, {?eh,tc_user_skip,{groups_11_SUITE,{init_per_group,test_group_2}, "SKIPPED!"}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_2a,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_3a,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_3b,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_2b,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_2a,test_group_2},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_3a,test_group_3},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_3b,test_group_3},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_2b,test_group_2},"SKIPPED!"}}, {?eh,test_stats,{2,0,{6,0}}}, {?eh,tc_user_skip,{groups_11_SUITE,{end_per_group,test_group_2}, "SKIPPED!"}}, @@ -864,15 +864,15 @@ test_events(skip_group_all_testcases) -> {?eh,tc_start,{groups_11_SUITE,init_per_suite}}, {?eh,tc_user_skip,{groups_11_SUITE,{init_per_group,test_group_1a}, "SKIPPED!"}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_1a,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_1b,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_1a,test_group_1a},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_1b,test_group_1a},"SKIPPED!"}}, {?eh,test_stats,{0,0,{2,0}}}, {?eh,tc_user_skip,{groups_11_SUITE,{end_per_group,test_group_1a}, "SKIPPED!"}}, {?eh,tc_user_skip,{groups_11_SUITE,{init_per_group,test_group_1b}, "SKIPPED!"}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_1a,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_1b,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_1a,test_group_1b},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_1b,test_group_1b},"SKIPPED!"}}, {?eh,test_stats,{0,0,{4,0}}}, {?eh,tc_user_skip,{groups_11_SUITE,{end_per_group,test_group_1b}, "SKIPPED!"}}, @@ -901,13 +901,13 @@ test_events(skip_group_testcase) -> {?eh,tc_start,{groups_11_SUITE,{init_per_group,test_group_1a,[]}}}, {?eh,tc_start,{groups_11_SUITE,testcase_1a}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_1b,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_1b,test_group_1a},"SKIPPED!"}}, {?eh,test_stats,{1,0,{1,0}}}, {?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_1a,[]},'_'}}, {?eh,tc_start,{groups_11_SUITE,{init_per_group,test_group_1b,[]}}}, {?eh,tc_start,{groups_11_SUITE,testcase_1b}}, - {?eh,tc_user_skip,{groups_11_SUITE,testcase_1a,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_11_SUITE,{testcase_1a,test_group_1b},"SKIPPED!"}}, {?eh,test_stats,{2,0,{2,0}}}, {?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_1b,[]},'_'}}, @@ -1045,8 +1045,8 @@ test_events(skip_subgroup) -> {?eh,tc_user_skip,{groups_12_SUITE, {init_per_group,test_group_8},"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_12_SUITE,testcase_8a,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_12_SUITE,testcase_8b,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{testcase_8a,test_group_8},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{testcase_8b,test_group_8},"SKIPPED!"}}, {?eh,tc_user_skip,{groups_12_SUITE, {end_per_group,test_group_8},"SKIPPED!"}}, @@ -1146,12 +1146,12 @@ test_events(skip_subgroup_all_testcases) -> {?eh,tc_done,{groups_12_SUITE,{init_per_group,test_group_4,[]},ok}}, {?eh,tc_user_skip,{groups_12_SUITE, {init_per_group,test_group_5},"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_12_SUITE,testcase_5a,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_12_SUITE,testcase_7a,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_12_SUITE,testcase_7b,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_12_SUITE,testcase_8a,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_12_SUITE,testcase_8b,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_12_SUITE,testcase_5b,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{testcase_5a,test_group_5},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{testcase_7a,test_group_7},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{testcase_7b,test_group_7},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{testcase_8a,test_group_8},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{testcase_8b,test_group_8},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{testcase_5b,test_group_5},"SKIPPED!"}}, {?eh,test_stats,{0,0,{6,0}}}, {?eh,tc_user_skip,{groups_12_SUITE, {end_per_group,test_group_5},"SKIPPED!"}}, @@ -1240,9 +1240,9 @@ test_events(skip_subgroup_testcase) -> {?eh,tc_done, {groups_12_SUITE,{init_per_group,test_group_6,[parallel]},ok}}, [{?eh,tc_start,{groups_12_SUITE,{init_per_group,test_group_7,'_'}}}, - {?eh,tc_user_skip, {groups_12_SUITE,testcase_7a,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{testcase_7a,test_group_7},"SKIPPED!"}}, {?eh,test_stats,{1,0,{1,0}}}, - {?eh,tc_user_skip, {groups_12_SUITE,testcase_7b,"SKIPPED!"}}, + {?eh,tc_user_skip, {groups_12_SUITE,{testcase_7b,test_group_7},"SKIPPED!"}}, {?eh,test_stats,{1,0,{2,0}}}, {?eh,tc_start,{groups_12_SUITE,{end_per_group,test_group_7,'_'}}}], {shuffle, @@ -1281,22 +1281,22 @@ test_events(sub_skipped_by_top) -> {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, {?eh,tc_user_skip,{groups_12_SUITE,{init_per_group,test_group_4}, "SKIPPED!"}}, - {?eh,tc_user_skip,{groups_12_SUITE,testcase_5a,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_12_SUITE,testcase_7a,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_12_SUITE,testcase_7b,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_12_SUITE,testcase_8a,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_12_SUITE,testcase_8b,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_12_SUITE,testcase_5b,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{testcase_5a,test_group_5},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{testcase_7a,test_group_7},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{testcase_7b,test_group_7},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{testcase_8a,test_group_8},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{testcase_8b,test_group_8},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{testcase_5b,test_group_5},"SKIPPED!"}}, {?eh,tc_user_skip,{groups_12_SUITE, {end_per_group,test_group_4},"SKIPPED!"}}, {?eh,tc_user_skip,{groups_12_SUITE, {init_per_group,test_group_4},"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_12_SUITE,testcase_5a,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_12_SUITE,testcase_7a,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_12_SUITE,testcase_7b,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_12_SUITE,testcase_8a,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_12_SUITE,testcase_8b,"SKIPPED!"}}, - {?eh,tc_user_skip,{groups_12_SUITE,testcase_5b,"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{testcase_5a,test_group_5},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{testcase_7a,test_group_7},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{testcase_7b,test_group_7},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{testcase_8a,test_group_8},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{testcase_8b,test_group_8},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{testcase_5b,test_group_5},"SKIPPED!"}}, {?eh,test_stats,{0,0,{12,0}}}, {?eh,tc_user_skip,{groups_12_SUITE, {end_per_group,test_group_4},"SKIPPED!"}}, diff --git a/lib/common_test/test/telnet_server.erl b/lib/common_test/test/telnet_server.erl index 1760100d8e..ae56787819 100644 --- a/lib/common_test/test/telnet_server.erl +++ b/lib/common_test/test/telnet_server.erl @@ -51,32 +51,51 @@ stop(Pid) -> init(Opts) -> Port = proplists:get_value(port,Opts), Users = proplists:get_value(users,Opts,[]), - {ok, LSock} = gen_tcp:listen(Port, [list, {packet, 0}, - {active, true}]), + {ok, LSock} = listen(5, Port, [list, {packet, 0}, + {active, true}, + {reuseaddr,true}]), State = #state{listen=LSock,users=Users}, accept(State), - ok = gen_tcp:close(LSock). + ok = gen_tcp:close(LSock), + dbg("telnet_server closed the listen socket ~p\n", [LSock]), + timer:sleep(1000), + ok. + +listen(0, _Port, _Opts) -> + {error,eaddrinuse}; +listen(Retries, Port, Opts) -> + case gen_tcp:listen(Port, Opts) of + {error,eaddrinuse} -> + dbg("Listen port not released, trying again..."), + timer:sleep(5000), + listen(Retries-1, Port, Opts); + Ok = {ok,_LSock} -> + Ok; + Error -> + exit(Error) + end. accept(#state{listen=LSock}=State) -> Server = self(), Acceptor = spawn_link(fun() -> do_accept(LSock,Server) end), receive {Acceptor,Sock} when is_port(Sock) -> + dbg("Connected to client on socket ~p\n", [Sock]), case init_client(State#state{client=Sock}) of stopped -> - io:format("[telnet_server] telnet_server stopped\n"), + dbg("telnet_server stopped\n"), ok; R -> - io:format("[telnet_server] connection to client" - "closed with reason ~p~n",[R]), + dbg("Connection to client " + "closed with reason ~p~n",[R]), accept(State) end; {Acceptor,closed} -> - io:format("[telnet_server] listen socket closed unexpectedly, " - "terminating telnet_server\n"), + dbg("Listen socket closed unexpectedly, " + "terminating telnet_server\n"), ok; stop -> - io:format("[telnet_server] telnet_server stopped\n"), + dbg("telnet_server stopped\n"), ok end. @@ -97,19 +116,21 @@ init_client(#state{client=Sock}=State) -> dbg("Server sending: ~p~n",["login: "]), R = case gen_tcp:send(Sock,"login: ") of ok -> - loop(State); + loop(State, 1); Error -> Error end, _ = gen_tcp:close(Sock), R. -loop(State) -> +loop(State, N) -> receive {tcp,_,Data} -> try handle_data(Data,State) of {ok,State1} -> - loop(State1) + loop(State1, N); + closed -> + closed catch throw:Error -> Error @@ -118,6 +139,11 @@ loop(State) -> closed; {tcp_error,_,Error} -> {error,tcp,Error}; + disconnect -> + Sock = State#state.client, + dbg("Server closing connection on socket ~p~n", [Sock]), + ok = gen_tcp:close(Sock), + closed; stop -> stopped end. @@ -130,10 +156,16 @@ handle_data(Data,State) -> case get_line(Data,[]) of {Line,Rest} -> WholeLine = lists:flatten(lists:reverse(State#state.buffer,Line)), - {ok,State1} = do_handle_data(WholeLine,State), - case Rest of - [] -> {ok,State1}; - _ -> handle_data(Rest,State1) + case do_handle_data(WholeLine,State) of + {ok,State1} -> + case Rest of + [] -> {ok,State1}; + _ -> handle_data(Rest,State1) + end; + {close,State1} -> + dbg("Server closing connection~n",[]), + gen_tcp:close(State1#state.client), + closed end; false -> {ok,State#state{buffer=[Data|State#state.buffer]}} @@ -163,22 +195,34 @@ do_handle_data(Data,#state{authorized=false}=State) -> check_user(Data,State); do_handle_data(Data,#state{authorized={user,_}}=State) -> check_pwd(Data,State); -do_handle_data("echo "++ Data,State) -> +do_handle_data("echo " ++ Data,State) -> send(Data++"\r\n> ",State), {ok,State}; -do_handle_data("echo_no_prompt "++ Data,State) -> +do_handle_data("echo_no_prompt " ++ Data,State) -> send(Data,State), {ok,State}; -do_handle_data("echo_ml "++ Data,State) -> +do_handle_data("echo_ml " ++ Data,State) -> Lines = string:tokens(Data," "), ReturnData = string:join(Lines,"\n"), send(ReturnData++"\r\n> ",State), {ok,State}; -do_handle_data("echo_ml_no_prompt "++ Data,State) -> +do_handle_data("echo_ml_no_prompt " ++ Data,State) -> Lines = string:tokens(Data," "), ReturnData = string:join(Lines,"\n"), send(ReturnData,State), {ok,State}; +do_handle_data("echo_loop " ++ Data,State) -> + [TStr|Lines] = string:tokens(Data," "), + ReturnData = string:join(Lines,"\n"), + send_loop(list_to_integer(TStr),ReturnData,State), + {ok,State}; +do_handle_data("disconnect_after " ++WaitStr,State) -> + Wait = list_to_integer(string:strip(WaitStr,right,$\n)), + dbg("Server will close connection in ~w ms...", [Wait]), + erlang:send_after(Wait,self(),disconnect), + {ok,State}; +do_handle_data("disconnect" ++_,State) -> + {close,State}; do_handle_data([],State) -> send("> ",State), {ok,State}; @@ -212,6 +256,20 @@ send(Data,State) -> throw({error,send,Error}) end. +send_loop(T,Data,State) -> + dbg("Server sending ~p in loop for ~w ms...~n",[Data,T]), + send_loop(now(),T,Data,State). + +send_loop(T0,T,Data,State) -> + ElapsedMS = trunc(timer:now_diff(now(),T0)/1000), + if ElapsedMS >= T -> + ok; + true -> + send(Data,State), + timer:sleep(500), + send_loop(T0,T,Data,State) + end. + get_line([$\r,$\n|Rest],Acc) -> {lists:reverse(Acc),Rest}; get_line([$\r,0|Rest],Acc) -> @@ -226,4 +284,4 @@ get_line([],_) -> dbg(_F) -> dbg(_F,[]). dbg(_F,_A) -> - io:format("[telnet_server] "++_F,_A). + io:format("[telnet_server] " ++ _F,_A). diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk index 568405b110..f8a5aab686 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1 +1 @@ -COMMON_TEST_VSN = 1.7.4 +COMMON_TEST_VSN = 1.8 diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml index c66c8ea4bf..5fccdcdcb5 100644 --- a/lib/compiler/doc/src/compile.xml +++ b/lib/compiler/doc/src/compile.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -551,6 +551,14 @@ module.beam: module.erl \ <c>{Module,Name,Arity}</c> or a list of such tuples.</p> </item> + <tag><c>nowarn_deprecated_type</c></tag> + <item> + <p>Turns off warnings for uses of deprecated types. By + default (<c>warn_deprecated_type</c>), warnings are + emitted for every use of a type known by the compiler + to be deprecated.</p> + </item> + <tag><c>warn_obsolete_guard</c></tag> <item> <p>Causes warnings to be emitted for calls to old type diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index 124abd13c1..5a4621dc37 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -318,6 +318,8 @@ split_block_label_used([{set,[_],_,{bif,_,{f,Fail}}}|_], Fail) -> true; split_block_label_used([{set,[_],_,{alloc,_,{gc_bif,_,{f,Fail}}}}|_], Fail) -> true; +split_block_label_used([{set,[_],_,{alloc,_,{put_map,_,{f,Fail}}}}|_], Fail) -> + true; split_block_label_used([_|Is], Fail) -> split_block_label_used(Is, Fail); split_block_label_used([], _) -> false. @@ -391,10 +393,14 @@ bopt_tree([{set,_,_,{bif,'xor',_}}|_], _, _) -> throw('xor'); bopt_tree([{protected,[Dst],Code,_}|Is], Forest0, Pre) -> ProtForest0 = gb_trees:from_orddict([P || {_,any}=P <- gb_trees:to_list(Forest0)]), - {ProtPre,[{_,ProtTree}]} = bopt_tree(Code, ProtForest0, []), - Prot = {prot,ProtPre,ProtTree}, - Forest = gb_trees:enter(Dst, Prot, Forest0), - bopt_tree(Is, Forest, Pre); + case bopt_tree(Code, ProtForest0, []) of + {ProtPre,[{_,ProtTree}]} -> + Prot = {prot,ProtPre,ProtTree}, + Forest = gb_trees:enter(Dst, Prot, Forest0), + bopt_tree(Is, Forest, Pre); + _Res -> + throw(not_boolean_expr) + end; bopt_tree([{set,[Dst],[Src],move}=Move|Is], Forest, Pre) -> case {Src,Dst} of {{tmp,_},_} -> throw(move); @@ -432,9 +438,10 @@ bopt_bool_args(As, Forest) -> mapfoldl(fun bopt_bool_arg/2, Forest, As). bopt_bool_arg({T,_}=R, Forest) when T =:= x; T =:= y; T =:= tmp -> - Val = case gb_trees:get(R, Forest) of - any -> {test,is_eq_exact,fail,[R,{atom,true}]}; - Val0 -> Val0 + Val = case gb_trees:lookup(R, Forest) of + {value,any} -> {test,is_eq_exact,fail,[R,{atom,true}]}; + {value,Val0} -> Val0; + none -> throw(mixed) end, {Val,gb_trees:delete(R, Forest)}; bopt_bool_arg(Term, Forest) -> @@ -525,7 +532,9 @@ bopt_cg({prot,Pre0,Tree}, Fail, Rs0, Acc, St0) -> bopt_cg({atom,true}, _Fail, _Rs, Acc, St) -> {Acc,St}; bopt_cg({atom,false}, Fail, _Rs, Acc, St) -> - {[{jump,{f,Fail}}|Acc],St}. + {[{jump,{f,Fail}}|Acc],St}; +bopt_cg(_, _, _, _, _) -> + throw(not_boolean_expr). bopt_cg_not({'and',As0}) -> As = [bopt_cg_not(A) || A <- As0], @@ -538,7 +547,9 @@ bopt_cg_not({'not',Arg}) -> bopt_cg_not({test,Test,Fail,As}) -> {inverted_test,Test,Fail,As}; bopt_cg_not({atom,Bool}) when is_boolean(Bool) -> - {atom,not Bool}. + {atom,not Bool}; +bopt_cg_not(_) -> + throw(not_boolean_expr). bopt_cg_not_not({'and',As}) -> {'and',[bopt_cg_not_not(A) || A <- As]}; diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 0fc8d45c80..b952139f2c 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -446,11 +446,13 @@ is_label_used_in_2({set,_,_,Info}, Lbl) -> case Info of {bif,_,{f,F}} -> F =:= Lbl; {alloc,_,{gc_bif,_,{f,F}}} -> F =:= Lbl; + {alloc,_,{put_map,_,{f,F}}} -> F =:= Lbl; {'catch',{f,F}} -> F =:= Lbl; {alloc,_,_} -> false; {put_tuple,_} -> false; {get_tuple_element,_} -> false; {set_tuple_element,_} -> false; + {get_map_elements,{f,F}} -> F =:= Lbl; {line,_} -> false; _ when is_atom(Info) -> false end. diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 27034aecce..8ca368c167 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -748,6 +748,8 @@ live_opt([{try_end,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{loop_rec_end,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); +live_opt([{wait_timeout,_,nil}=I|Is], Regs, D, Acc) -> + live_opt(Is, Regs, D, [I|Acc]); live_opt([{wait_timeout,_,{Tag,_}}=I|Is], Regs, D, Acc) when Tag =/= x -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{line,_}=I|Is], Regs, D, Acc) -> diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 60a8559950..e400e4f185 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -124,20 +124,21 @@ %% keep map exports here for now map_es/1, - update_c_map/2, - ann_c_map/2, + map_arg/1, + update_c_map/3, + ann_c_map/2, ann_c_map/3, map_pair_op/1,map_pair_key/1,map_pair_val/1, update_c_map_pair/4, ann_c_map_pair/4 ]). --export_type([c_binary/0, c_call/0, c_clause/0, c_cons/0, c_fun/0, c_literal/0, - c_module/0, c_tuple/0, c_values/0, c_var/0, cerl/0, var_name/0]). +-export_type([c_binary/0, c_bitstr/0, c_call/0, c_clause/0, c_cons/0, c_fun/0, + c_literal/0, c_map_pair/0, c_module/0, c_tuple/0, + c_values/0, c_var/0, cerl/0, var_name/0]). -%% -%% needed by the include file below -- do not move -%% --type var_name() :: integer() | atom() | {atom(), integer()}. +%% HiPE does not understand Maps +%% (guard functions is_map/1 and map_size/1 in ann_c_map/3) +-compile(no_native). -include("core_parse.hrl"). @@ -172,6 +173,8 @@ | c_module() | c_primop() | c_receive() | c_seq() | c_try() | c_tuple() | c_values() | c_var(). +-type var_name() :: integer() | atom() | {atom(), integer()}. + %% ===================================================================== %% Representation (general) %% @@ -203,13 +206,15 @@ %% <td>call</td> %% <td>case</td> %% <td>catch</td> -%% </tr><tr> %% <td>clause</td> +%% </tr><tr> %% <td>cons</td> %% <td>fun</td> %% <td>let</td> %% <td>letrec</td> %% <td>literal</td> +%% <td>map</td> +%% <td>map_pair</td> %% <td>module</td> %% </tr><tr> %% <td>primop</td> @@ -260,10 +265,10 @@ %% @see subtrees/1 %% @see meta/1 --type ctype() :: 'alias' | 'apply' | 'binary' | 'bitrst' | 'call' | 'case' - | 'catch' | 'clause' | 'cons' | 'fun' | 'let' | 'letrec' - | 'literal' | 'map' | 'module' | 'primop' | 'receive' | 'seq' - | 'try' | 'tuple' | 'values' | 'var'. +-type ctype() :: 'alias' | 'apply' | 'binary' | 'bitrst' | 'call' | 'case' + | 'catch' | 'clause' | 'cons' | 'fun' | 'let' | 'letrec' + | 'literal' | 'map' | 'map_pair' | 'module' | 'primop' + | 'receive' | 'seq' | 'try' | 'tuple' | 'values' | 'var'. -spec type(cerl()) -> ctype(). @@ -1574,16 +1579,70 @@ ann_make_list(_, [], Node) -> %% --------------------------------------------------------------------- %% maps --spec map_es(c_map()) -> [cerl()]. +-spec map_es(c_map()) -> [c_map_pair()]. map_es(#c_map{es = Es}) -> Es. -ann_c_map(As, Es) -> - #c_map{es = Es, anno = As }. +-spec map_arg(c_map()) -> c_map() | c_literal(). + +map_arg(#c_map{arg = M}) -> + M. + +-spec ann_c_map([term()], [cerl()]) -> c_map() | c_literal(). + +ann_c_map(As,Es) -> + ann_c_map(As, #c_literal{val=#{}}, Es). + +-spec ann_c_map([term()], c_map() | c_literal(), [c_map_pair()]) -> c_map() | c_literal(). + +ann_c_map(As,#c_literal{val=Mval}=M,Es) when is_map(Mval), map_size(Mval) =:= 0 -> + Pairs = [[Ck,Cv]||#c_map_pair{key=Ck,val=Cv}<-Es], + IsLit = lists:foldl(fun(Pair,Res) -> + Res andalso is_lit_list(Pair) + end, true, Pairs), + Fun = fun(Pair) -> [K,V] = lit_list_vals(Pair), {K,V} end, + case IsLit of + false -> + #c_map{arg=M, es=Es, anno=As }; + true -> + #c_literal{anno=As, val=maps:from_list(lists:map(Fun, Pairs))} + end; +ann_c_map(As,#c_literal{val=M},Es) when is_map(M) -> + fold_map_pairs(As,Es,M); +ann_c_map(As,M,Es) -> + #c_map{arg=M, es=Es, anno=As }. + +fold_map_pairs(As,[],M) -> #c_literal{anno=As,val=M}; +%% M#{ K => V} +fold_map_pairs(As,[#c_map_pair{op=#c_literal{val=assoc},key=Ck,val=Cv}=E|Es],M) -> + case is_lit_list([Ck,Cv]) of + true -> + [K,V] = lit_list_vals([Ck,Cv]), + fold_map_pairs(As,Es,maps:put(K,V,M)); + false -> + #c_map{arg=#c_literal{val=M,anno=As}, es=[E|Es], anno=As } + end; +%% M#{ K := V} +fold_map_pairs(As,[#c_map_pair{op=#c_literal{val=exact},key=Ck,val=Cv}=E|Es],M) -> + case is_lit_list([Ck,Cv]) of + true -> + [K,V] = lit_list_vals([Ck,Cv]), + case maps:is_key(K,M) of + true -> fold_map_pairs(As,Es,maps:put(K,V,M)); + false -> + #c_map{arg=#c_literal{val=M,anno=As}, es=[E|Es], anno=As } + end; + false -> + #c_map{arg=#c_literal{val=M,anno=As}, es=[E|Es], anno=As } + end; +fold_map_pairs(As,Es,M) -> + #c_map{arg=#c_literal{val=M,anno=As}, es=Es, anno=As }. + +%-spec update_c_map(c_map() | c_literal(), [c_map_pair()]) -> c_map() | c_literal(). -update_c_map(Old, Es) -> - #c_map{es = Es, anno = get_ann(Old)}. +update_c_map(Old,M,Es) -> + #c_map{arg=M, es = Es, anno = get_ann(Old)}. map_pair_key(#c_map_pair{key=K}) -> K. map_pair_val(#c_map_pair{val=V}) -> V. @@ -4319,12 +4378,8 @@ meta_1(cons, Node) -> %% we get exactly one element, we generate a 'c_cons' call %% instead of 'make_list' to reconstruct the node. case split_list(Node) of - {[H], none} -> - meta_call(c_cons, [meta(H), meta(c_nil())]); {[H], Node1} -> meta_call(c_cons, [meta(H), meta(Node1)]); - {L, none} -> - meta_call(make_list, [make_list(meta_list(L))]); {L, Node1} -> meta_call(make_list, [make_list(meta_list(L)), meta(Node1)]) @@ -4411,8 +4466,6 @@ split_list(Node, L) -> case type(Node) of cons when A =:= [] -> split_list(cons_tl(Node), [cons_hd(Node) | L]); - nil when A =:= [] -> - {lists:reverse(L), none}; _ -> {lists:reverse(L), Node} end. diff --git a/lib/compiler/src/cerl_clauses.erl b/lib/compiler/src/cerl_clauses.erl index 99fa8dd9d5..87bd47c08b 100644 --- a/lib/compiler/src/cerl_clauses.erl +++ b/lib/compiler/src/cerl_clauses.erl @@ -354,6 +354,29 @@ match(P, E, Bs) -> {false, Bs} end end; + map -> + %% The most we can do is to say "definitely no match" if a + %% map pattern is matched against non-map data. + case E of + any -> + {false, Bs}; + _ -> + case type(E) of + literal -> + case is_map(concrete(E)) of + false -> + none; + true -> + {false, Bs} + end; + cons -> + none; + tuple -> + none; + _ -> + {false, Bs} + end + end; _ -> match_1(P, E, Bs) end. diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl index 3837b57750..75740e8b9d 100644 --- a/lib/compiler/src/cerl_inline.erl +++ b/lib/compiler/src/cerl_inline.erl @@ -42,7 +42,7 @@ bitstr_flags/1, binary_segments/1, update_c_alias/3, update_c_apply/3, update_c_binary/2, update_c_bitstr/6, update_c_call/4, update_c_case/3, update_c_catch/2, - update_c_clause/4, c_fun/2, c_int/1, c_let/3, + update_c_clause/4, c_fun/2, c_int/1, c_let/3, ann_c_let/4, update_c_let/4, update_c_letrec/3, update_c_module/5, update_c_primop/3, update_c_receive/4, update_c_seq/3, c_seq/2, update_c_try/6, c_tuple/1, update_c_values/2, @@ -51,7 +51,7 @@ catch_body/1, clause_body/1, clause_guard/1, clause_pats/1, clause_vars/1, concrete/1, cons_hd/1, cons_tl/1, data_arity/1, data_es/1, data_type/1, - fun_body/1, fun_vars/1, get_ann/1, int_val/1, + fname_arity/1, fun_body/1, fun_vars/1, get_ann/1, int_val/1, is_c_atom/1, is_c_cons/1, is_c_fname/1, is_c_int/1, is_c_list/1, is_c_seq/1, is_c_tuple/1, is_c_var/1, is_data/1, is_literal/1, is_literal_term/1, let_arg/1, @@ -64,7 +64,7 @@ seq_body/1, set_ann/2, try_arg/1, try_body/1, try_vars/1, try_evars/1, try_handler/1, tuple_es/1, tuple_arity/1, type/1, values_es/1, var_name/1, - map_es/1, update_c_map/2, + map_arg/1, map_es/1, update_c_map/3, update_c_map_pair/4, map_pair_op/1, map_pair_key/1, map_pair_val/1 ]). @@ -1030,8 +1030,17 @@ i_apply(E, Ctxt, Ren, Env, S) -> visit_and_count_size(Opnd, S) end, S3, Opnds), - N = apply_size(length(Es)), - {update_c_apply(E, E1, Es), count_size(N, S4)} + Arity = length(Es), + E2 = case is_c_fname(E1) andalso length(Es) =/= fname_arity(E1) of + true -> + V = new_var(Env), + ann_c_let(get_ann(E), [V], E1, + update_c_apply(E, V, Es)); + false -> + update_c_apply(E, E1, Es) + end, + N = apply_size(Arity), + {E2, count_size(N, S4)} end. apply_size(A) -> @@ -1334,12 +1343,12 @@ i_bitstr(E, Ren, Env, S) -> i_map(E, Ctx, Ren, Env, S) -> %% Visit the segments for value. - {Es, S1} = mapfoldl(fun (E, S) -> - i_map_pair(E, Ctx, Ren, Env, S) - end, - S, map_es(E)), - S2 = count_size(weight(map), S1), - {update_c_map(E, Es), S2}. + {M1, S1} = i(map_arg(E), value, Ren, Env, S), + {Es, S2} = mapfoldl(fun (E, S) -> + i_map_pair(E, Ctx, Ren, Env, S) + end, S1, map_es(E)), + S3 = count_size(weight(map), S2), + {update_c_map(E, M1,Es), S3}. i_map_pair(E, Ctx, Ren, Env, S) -> %% It is not necessary to visit the Op and Key fields, @@ -1411,13 +1420,15 @@ i_pattern(E, Ren, Env, Ren0, Env0, S) -> S2 = count_size(weight(binary), S1), {update_c_binary(E, Es), S2}; map -> + %% map patterns should not have args + M = map_arg(E), + {Es, S1} = mapfoldl(fun (E, S) -> - i_map_pair_pattern(E, Ren, Env, - Ren0, Env0, S) - end, - S, map_es(E)), + i_map_pair_pattern(E, Ren, Env, Ren0, Env0, S) + end, + S, map_es(E)), S2 = count_size(weight(map), S1), - {update_c_map(E, Es), S2}; + {update_c_map(E, M, Es), S2}; _ -> case is_literal(E) of true -> diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl index 2542841eef..e53bdd4efb 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -57,9 +57,9 @@ update_c_try/6, update_c_tuple/2, update_c_tuple_skel/2, update_c_values/2, values_es/1, var_name/1, - map_es/1, - ann_c_map/2, - update_c_map/2, + map_arg/1, map_es/1, + ann_c_map/3, + update_c_map/3, map_pair_key/1,map_pair_val/1,map_pair_op/1, ann_c_map_pair/4, update_c_map_pair/4 @@ -138,7 +138,7 @@ map_1(F, T) -> tuple -> update_c_tuple_skel(T, map_list(F, tuple_es(T))); map -> - update_c_map(T, map_list(F, map_es(T))); + update_c_map(T, map(F, map_arg(T)), map_list(F, map_es(T))); map_pair -> update_c_map_pair(T, map(F, map_pair_op(T)), map(F, map_pair_key(T)), @@ -372,8 +372,9 @@ mapfold(F, S0, T) -> {Ts, S1} = mapfold_list(F, S0, tuple_es(T)), F(update_c_tuple_skel(T, Ts), S1); map -> - {Ts, S1} = mapfold_list(F, S0, map_es(T)), - F(update_c_map(T, Ts), S1); + {M , S1} = mapfold(F, S0, map_arg(T)), + {Ts, S2} = mapfold_list(F, S1, map_es(T)), + F(update_c_map(T, M, Ts), S2); map_pair -> {Op, S1} = mapfold(F, S0, map_pair_op(T)), {Key, S2} = mapfold(F, S1, map_pair_key(T)), @@ -723,9 +724,10 @@ label(T, N, Env) -> {As, N2} = label_ann(T, N1), {ann_c_tuple_skel(As, Ts), N2}; map -> - {Ts, N1} = label_list(map_es(T), N, Env), - {As, N2} = label_ann(T, N1), - {ann_c_map(As, Ts), N2}; + {M, N1} = label(map_arg(T), N, Env), + {Ts, N2} = label_list(map_es(T), N1, Env), + {As, N3} = label_ann(T, N2), + {ann_c_map(As, M, Ts), N3}; map_pair -> {Op, N1} = label(map_pair_op(T), N, Env), {Val, N2} = label(map_pair_key(T), N1, Env), diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index e79fe41f9b..c7d91070f6 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -234,7 +234,9 @@ format_error({crash,Pass,Reason}) -> format_error({bad_return,Pass,Reason}) -> io_lib:format("internal error in ~p;\nbad return value: ~ts", [Pass,format_error_reason(Reason)]); format_error({module_name,Mod,Filename}) -> - io_lib:format("Module name '~s' does not match file name '~ts'", [Mod,Filename]). + io_lib:format("Module name '~s' does not match file name '~ts'", [Mod,Filename]); +format_error(reparsing_invalid_unicode) -> + "Non-UTF-8 character(s) detected, but no encoding declared. Encode the file in UTF-8 or add \"%% coding: latin-1\" at the beginning of the file. Retrying with latin-1 encoding.". format_error_reason({Reason, Stack}) when is_list(Stack) -> StackFun = fun @@ -246,7 +248,7 @@ format_error_reason({Reason, Stack}) when is_list(Stack) -> end, FormatFun = fun (Term, _) -> io_lib:format("~tp", [Term]) end, [io_lib:format("~tp", [Reason]),"\n\n", - lib:format_stacktrace(1, erlang:get_stacktrace(), StackFun, FormatFun)]; + lib:format_stacktrace(1, Stack, StackFun, FormatFun)]; format_error_reason(Reason) -> io_lib:format("~tp", [Reason]). @@ -430,10 +432,9 @@ pass(from_core) -> pass(from_asm) -> {".S",[?pass(beam_consult_asm)|asm_passes()]}; pass(asm) -> - %% TODO: remove 'asm' in R18 - io:format("compile:file/2 option 'asm' has been deprecated and will be " - "removed in R18.~n" - "Use 'from_asm' instead.~n"), + %% TODO: remove 'asm' in 18.0 + io:format("compile:file/2 option 'asm' has been deprecated and will be~n" + "removed in the 18.0 release. Use 'from_asm' instead.~n"), pass(from_asm); pass(from_beam) -> {".beam",[?pass(read_beam_file)|binary_passes()]}; @@ -793,20 +794,59 @@ no_native_compilation(BeamFile, #compile{options=Opts0}) -> _ -> false end. -parse_module(St) -> - Opts = St#compile.options, - Cwd = ".", - IncludePath = [Cwd, St#compile.dir|inc_paths(Opts)], - R = epp:parse_file(St#compile.ifile, IncludePath, pre_defs(Opts)), +parse_module(St0) -> + case do_parse_module(utf8, St0) of + {ok,_}=Ret -> + Ret; + {error,_}=Ret -> + Ret; + {invalid_unicode,File,Line} -> + case do_parse_module(latin1, St0) of + {ok,St} -> + Es = [{File,[{Line,?MODULE,reparsing_invalid_unicode}]}], + {ok,St#compile{warnings=Es++St#compile.warnings}}; + {error,St} -> + Es = [{File,[{Line,?MODULE,reparsing_invalid_unicode}]}], + {error,St#compile{errors=Es++St#compile.errors}} + end + end. + +do_parse_module(DefEncoding, #compile{ifile=File,options=Opts,dir=Dir}=St) -> + R = epp:parse_file(File, + [{includes,[".",Dir|inc_paths(Opts)]}, + {macros,pre_defs(Opts)}, + {default_encoding,DefEncoding}, + extra]), case R of - {ok,Forms} -> - Encoding = epp:read_encoding(St#compile.ifile), - {ok,St#compile{code=Forms,encoding=Encoding}}; + {ok,Forms,Extra} -> + Encoding = proplists:get_value(encoding, Extra), + case find_invalid_unicode(Forms, File) of + none -> + {ok,St#compile{code=Forms,encoding=Encoding}}; + {invalid_unicode,_,_}=Ret -> + case Encoding of + none -> + Ret; + _ -> + {ok,St#compile{code=Forms,encoding=Encoding}} + end + end; {error,E} -> Es = [{St#compile.ifile,[{none,?MODULE,{epp,E}}]}], {error,St#compile{errors=St#compile.errors ++ Es}} end. +find_invalid_unicode([H|T], File0) -> + case H of + {attribute,_,file,{File,_}} -> + find_invalid_unicode(T, File); + {error,{Line,file_io_server,invalid_unicode}} -> + {invalid_unicode,File0,Line}; + _Other -> + find_invalid_unicode(T, File0) + end; +find_invalid_unicode([], _) -> none. + parse_core(St) -> case file:read_file(St#compile.ifile) of {ok,Bin} -> diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index 8775c84698..8f68915f8e 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -67,4 +67,6 @@ ]}, {registered, []}, {applications, [kernel, stdlib]}, - {env, []}]}. + {env, []}, + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","hipe-3.10.3","erts-6.0", + "crypto-3.3"]}]}. diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl index ed181e3baa..93ec3bbad5 100644 --- a/lib/compiler/src/core_lib.erl +++ b/lib/compiler/src/core_lib.erl @@ -105,7 +105,7 @@ vu_expr(V, #c_cons{hd=H,tl=T}) -> vu_expr(V, H) orelse vu_expr(V, T); vu_expr(V, #c_tuple{es=Es}) -> vu_expr_list(V, Es); -vu_expr(V, #c_map{var=M,es=Es}) -> +vu_expr(V, #c_map{arg=M,es=Es}) -> vu_expr(V, M) orelse vu_expr_list(V, Es); vu_expr(V, #c_map_pair{key=Key,val=Val}) -> vu_expr_list(V, [Key,Val]); diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl index 36165245a6..25df33a287 100644 --- a/lib/compiler/src/core_lint.erl +++ b/lib/compiler/src/core_lint.erl @@ -267,10 +267,21 @@ gexpr(#c_let{vars=Vs,arg=Arg,body=B}, Def, Rt, St0) -> St1 = gbody(Arg, Def, let_varcount(Vs), St0), %This is a guard body {Lvs,St2} = variable_list(Vs, St1), gbody(B, union(Lvs, Def), Rt, St2); -gexpr(#c_call{module=#c_literal{val=erlang}, - name=#c_literal{}, - args=As}, Def, 1, St) -> - gexpr_list(As, Def, St); +gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=is_record}, + args=[Arg,#c_literal{val=Tag},#c_literal{val=Size}]}, + Def, 1, St) when is_atom(Tag), is_integer(Size) -> + gexpr(Arg, Def, 1, St); +gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=is_record}}, + _Def, 1, St) -> + add_error({illegal_guard,St#lint.func}, St); +gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=Name},args=As}, + Def, 1, St) when is_atom(Name) -> + case is_guard_bif(Name, length(As)) of + true -> + gexpr_list(As, Def, St); + false -> + add_error({illegal_guard,St#lint.func}, St) + end; gexpr(#c_primop{name=#c_literal{val=A},args=As}, Def, _Rt, St0) when is_atom(A) -> gexpr_list(As, Def, St0); gexpr(#c_try{arg=E,vars=[#c_var{name=X}],body=#c_var{name=X}, @@ -298,6 +309,14 @@ gbitstr_list(Es, Def, St0) -> gbitstr(#c_bitstr{val=V,size=S}, Def, St) -> gexpr_list([V,S], Def, St). +%% is_guard_bif(Name, Arity) -> Boolean. + +is_guard_bif(Name, Arity) -> + erl_internal:guard_bif(Name, Arity) + orelse erl_internal:arith_op(Name, Arity) + orelse erl_internal:bool_op(Name, Arity) + orelse erl_internal:comp_op(Name, Arity). + %% expr(Expr, Defined, RetCount, State) -> State. expr(#c_var{name={_,_}=FA}, Def, _Rt, St) -> diff --git a/lib/compiler/src/core_parse.hrl b/lib/compiler/src/core_parse.hrl index d54715ef59..4a00535360 100644 --- a/lib/compiler/src/core_parse.hrl +++ b/lib/compiler/src/core_parse.hrl @@ -34,7 +34,7 @@ -record(c_apply, {anno=[], op, % op :: Tree, args}). % args :: [Tree] --record(c_binary, {anno=[], segments}). % segments :: [#c_bitstr{}] +-record(c_binary, {anno=[], segments :: [cerl:c_bitstr()]}). -record(c_bitstr, {anno=[], val, % val :: Tree, size, % size :: Tree, @@ -70,6 +70,15 @@ -record(c_literal, {anno=[], val}). % val :: literal() +-record(c_map, {anno=[], + arg=#c_literal{val=#{}} :: cerl:c_var() | cerl:c_literal(), + es :: [cerl:c_map_pair()]}). + +-record(c_map_pair, {anno=[], + op :: #c_literal{val::'assoc'} | #c_literal{val::'exact'}, + key, + val}). + -record(c_module, {anno=[], name, % name :: Tree, exports, % exports :: [Tree], attrs, % attrs :: [#c_def{}], @@ -96,12 +105,3 @@ -record(c_values, {anno=[], es}). % es :: [Tree] -record(c_var, {anno=[], name :: cerl:var_name()}). - --record(c_map_pair, {anno=[], - op :: #c_literal{val::'assoc'} | #c_literal{val::'exact'}, - key, - val}). - --record(c_map, {anno=[], - var=#c_literal{val=[]} :: #c_var{} | #c_literal{}, - es :: [#c_map_pair{}]}). diff --git a/lib/compiler/src/core_parse.yrl b/lib/compiler/src/core_parse.yrl index b8db0f683a..a66ad4235f 100644 --- a/lib/compiler/src/core_parse.yrl +++ b/lib/compiler/src/core_parse.yrl @@ -21,7 +21,7 @@ %% Have explicit productions for annotated phrases named anno_XXX. %% This just does an XXX and adds the annotation. -Expect 1. +Expect 0. Nonterminals @@ -285,9 +285,9 @@ tuple -> '{' '}' : c_tuple([]). tuple -> '{' anno_expressions '}' : c_tuple('$2'). map_expr -> '~' '{' '}' '~' : #c_map{es=[]}. -map_expr -> '~' '{' map_pairs '}' '~' : #c_map{es='$3'}. -map_expr -> variable '~' '{' '}' '~' : #c_map{var='$1',es=[]}. -map_expr -> variable '~' '{' map_pairs '}' '~' : #c_map{var='$1',es='$4'}. +map_expr -> '~' '{' map_pairs '}' '~' : #c_map{es='$3'}. +map_expr -> '~' '{' map_pairs '|' variable '}' '~' : #c_map{arg='$5',es='$3'}. +map_expr -> '~' '{' map_pairs '|' map_expr '}' '~' : #c_map{arg='$5',es='$3'}. map_pairs -> map_pair : ['$1']. map_pairs -> map_pair ',' map_pairs : ['$1' | '$3']. diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl index faa26ec6df..a76327457d 100644 --- a/lib/compiler/src/core_pp.erl +++ b/lib/compiler/src/core_pp.erl @@ -118,6 +118,12 @@ format_1(#c_literal{val=Tuple}, Ctxt) when is_tuple(Tuple) -> format_1(#c_literal{anno=A,val=Bitstring}, Ctxt) when is_bitstring(Bitstring) -> Segs = segs_from_bitstring(Bitstring), format_1(#c_binary{anno=A,segments=Segs}, Ctxt); +format_1(#c_literal{anno=A,val=M},Ctxt) when is_map(M) -> + Pairs = maps:to_list(M), + Cpairs = [#c_map_pair{op=#c_literal{val=assoc}, + key=#c_literal{val=V}, + val=#c_literal{val=K}} || {K,V} <- Pairs], + format_1(#c_map{anno=A,arg=#c_literal{val=#{}},es=Cpairs},Ctxt); format_1(#c_var{name={I,A}}, _) -> [core_atom(I),$/,integer_to_list(A)]; format_1(#c_var{name=V}, _) -> @@ -161,15 +167,15 @@ format_1(#c_tuple{es=Es}, Ctxt) -> format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2), $} ]; -format_1(#c_map{var=#c_var{}=Var,es=Es}, Ctxt) -> - [format_1(Var, Ctxt), - "~{", +format_1(#c_map{arg=#c_literal{val=M},es=Es}, Ctxt) when is_map(M),map_size(M)=:=0 -> + ["~{", format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2), "}~" ]; -format_1(#c_map{es=Es}, Ctxt) -> +format_1(#c_map{arg=Var,es=Es}, Ctxt) -> ["~{", format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2), + "|",format(Var, add_indent(Ctxt, 1)), "}~" ]; format_1(#c_map_pair{op=#c_literal{val=assoc},key=K,val=V}, Ctxt) -> diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index 3ad3c8c690..6c75538194 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -91,6 +91,7 @@ is_pure(erlang, is_float, 1) -> true; is_pure(erlang, is_function, 1) -> true; is_pure(erlang, is_integer, 1) -> true; is_pure(erlang, is_list, 1) -> true; +is_pure(erlang, is_map, 1) -> true; is_pure(erlang, is_number, 1) -> true; is_pure(erlang, is_pid, 1) -> true; is_pure(erlang, is_port, 1) -> true; diff --git a/lib/compiler/src/rec_env.erl b/lib/compiler/src/rec_env.erl index ddcd461bc0..555a331bd7 100644 --- a/lib/compiler/src/rec_env.erl +++ b/lib/compiler/src/rec_env.erl @@ -72,6 +72,7 @@ test_1({custom, F} = Type, N, Env) when is_integer(N), N > 0 -> test_1(_,0, Env) -> Env. -endif. +%%@clear %% Representation: diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index eb9c302334..b7422318b2 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -72,7 +72,7 @@ -import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,all/2,any/2, reverse/1,reverse/2,member/2,nth/2,flatten/1,unzip/1]). --import(cerl, [ann_c_cons/3,ann_c_tuple/2]). +-import(cerl, [ann_c_cons/3,ann_c_map/3,ann_c_tuple/2]). -include("core_parse.hrl"). @@ -246,7 +246,7 @@ expr(#c_tuple{anno=Anno,es=Es0}=Tuple, Ctxt, Sub) -> value -> ann_c_tuple(Anno, Es) end; -expr(#c_map{var=V0,es=Es0}=Map, Ctxt, Sub) -> +expr(#c_map{anno=Anno,arg=V0,es=Es0}=Map, Ctxt, Sub) -> Es = pair_list(Es0, Ctxt, Sub), case Ctxt of effect -> @@ -254,7 +254,7 @@ expr(#c_map{var=V0,es=Es0}=Map, Ctxt, Sub) -> expr(make_effect_seq(Es, Sub), Ctxt, Sub); value -> V = expr(V0, Ctxt, Sub), - Map#c_map{var=V,es=Es} + ann_c_map(Anno,V,Es) end; expr(#c_binary{segments=Ss}=Bin0, Ctxt, Sub) -> %% Warn for useless building, but always build the binary @@ -1378,6 +1378,7 @@ eval_is_record(Call, _, _, _, _) -> Call. is_not_integer(#c_literal{val=Val}) when not is_integer(Val) -> true; is_not_integer(#c_tuple{}) -> true; is_not_integer(#c_cons{}) -> true; +is_not_integer(#c_map{}) -> true; is_not_integer(_) -> false. %% is_not_tuple(Core) -> true | false. @@ -1385,6 +1386,7 @@ is_not_integer(_) -> false. is_not_tuple(#c_literal{val=Val}) when not is_tuple(Val) -> true; is_not_tuple(#c_cons{}) -> true; +is_not_tuple(#c_map{}) -> true; is_not_tuple(_) -> false. %% eval_setelement(Call, Pos, Tuple, NewVal) -> Core. @@ -1810,9 +1812,14 @@ opt_bool_clauses([#c_clause{pats=[#c_literal{val=Lit}], true -> %% This clause will match. C = C0#c_clause{body=opt_bool_case(B)}, - case Lit of - false -> [C|opt_bool_clauses(Cs, SeenT, true)]; - true -> [C|opt_bool_clauses(Cs, true, SeenF)] + case {Lit,SeenT,SeenF} of + {false,_,false} -> + [C|opt_bool_clauses(Cs, SeenT, true)]; + {true,false,_} -> + [C|opt_bool_clauses(Cs, true, SeenF)]; + _ -> + add_warning(C, nomatch_shadow), + opt_bool_clauses(Cs, SeenT, SeenF) end end; opt_bool_clauses([#c_clause{pats=Ps,guard=#c_literal{val=true}}=C|Cs], SeenT, SeenF) -> @@ -2024,9 +2031,9 @@ case_opt(Arg, Cs0, Sub) -> case_opt_args([A0|As0], Cs0, Sub, LitExpr, Acc) -> case case_opt_arg(A0, Sub, Cs0, LitExpr) of - error -> + {error,Cs1} -> %% Nothing to be done. Move on to the next argument. - Cs = [{Ps,C,[P|PsAcc],Bs} || {[P|Ps],C,PsAcc,Bs} <- Cs0], + Cs = [{Ps,C,[P|PsAcc],Bs} || {[P|Ps],C,PsAcc,Bs} <- Cs1], case_opt_args(As0, Cs, Sub, LitExpr, [A0|Acc]); {ok,As1,Cs} -> %% The argument was either expanded (from tuple/list) or @@ -2045,7 +2052,7 @@ case_opt_arg(E0, Sub, Cs, LitExpr) -> E = maybe_replace_var(E0, Sub), case cerl:is_data(E) of false -> - error; + {error,Cs}; true -> case cerl:data_type(E) of {atomic,_} -> @@ -2095,35 +2102,44 @@ maybe_replace_var_1(E, #sub{t=Tdb}) -> %% pattern matching is tricky, so we will give up in that case. case_opt_lit(Lit, Cs0, LitExpr) -> - try case_opt_lit_1(Cs0, Lit, LitExpr) of + Cs1 = case_opt_lit_1(Lit, Cs0, LitExpr), + try case_opt_lit_2(Lit, Cs1) of Cs -> {ok,[],Cs} catch throw:impossible -> - error + {error,Cs1} end. -case_opt_lit_1([{[P|Ps],C,PsAcc,Bs0}|Cs], E, LitExpr) -> +case_opt_lit_1(E, [{[P|_],C,_,_}=Current|Cs], LitExpr) -> + case cerl_clauses:match(P, E) of + none -> + %% The pattern will not match the literal. Remove the clause. + %% Unless the entire case expression is a literal, also + %% emit a warning. + case LitExpr of + false -> add_warning(C, nomatch_clause_type); + true -> ok + end, + case_opt_lit_1(E, Cs, LitExpr); + _ -> + [Current|case_opt_lit_1(E, Cs, LitExpr)] + end; +case_opt_lit_1(_, [], _) -> []. + +case_opt_lit_2(E, [{[P|Ps],C,PsAcc,Bs0}|Cs]) -> + %% Non-matching clauses have already been removed in case_opt_lit_1/3. case cerl_clauses:match(P, E) of - none -> - %% The pattern will not match the literal. Remove the clause. - %% Unless the entire case expression is a literal, also - %% emit a warning. - case LitExpr of - false -> add_warning(C, nomatch_clause_type); - true -> ok - end, - case_opt_lit_1(Cs, E, LitExpr); {true,Bs} -> %% The pattern matches the literal. Remove the pattern %% and update the bindings. - [{Ps,C,PsAcc,Bs++Bs0}|case_opt_lit_1(Cs, E, LitExpr)]; + [{Ps,C,PsAcc,Bs++Bs0}|case_opt_lit_2(E, Cs)]; {false,_} -> %% Binary literal and pattern. We are not sure whether %% the pattern will match. throw(impossible) end; -case_opt_lit_1([], _, _) -> []. +case_opt_lit_2(_, []) -> []. %% case_opt_data(Expr, Clauses0, LitExpr) -> {ok,Exprs,Clauses} @@ -2346,16 +2362,31 @@ is_safe_bool_expr(Core, Sub) -> is_safe_bool_expr_1(Core, Sub, gb_sets:empty()). is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_record}, - args=[_,_]}, - _Sub, _BoolVars) -> + name=#c_literal{val=is_record}, + args=[A,#c_literal{val=Tag},#c_literal{val=Size}]}, + Sub, _BoolVars) when is_atom(Tag), is_integer(Size) -> + is_safe_simple(A, Sub); +is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_record}}, + _Sub, _BoolVars) -> %% The is_record/2 BIF is NOT allowed in guards. + %% The is_record/3 BIF where its second argument is not an atom or its third + %% is not an integer is NOT allowed in guards. %% %% NOTE: Calls like is_record(Expr, LiteralTag), where LiteralTag %% is a literal atom referring to a defined record, have already %% been rewritten to is_record(Expr, LiteralTag, TupleSize). false; is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[A,#c_literal{val=Arity}]}, + Sub, _BoolVars) when is_integer(Arity), Arity >= 0 -> + is_safe_simple(A, Sub); +is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}}, + _Sub, _BoolVars) -> + false; +is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=Name},args=Args}, Sub, BoolVars) -> NumArgs = length(Args), diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index 9998043013..91a46a20fe 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -331,9 +331,10 @@ expr({tuple,Line,Es0}, St0) -> expr({map,Line,Es0}, St0) -> {Es1,St1} = expr_list(Es0, St0), {{map,Line,Es1},St1}; -expr({map,Line,Var,Es0}, St0) -> - {Es1,St1} = expr_list(Es0, St0), - {{map,Line,Var,Es1},St1}; +expr({map,Line,E0,Es0}, St0) -> + {E1,St1} = expr(E0, St0), + {Es1,St2} = expr_list(Es0, St1), + {{map,Line,E1,Es1},St2}; expr({map_field_assoc,Line,K0,V0}, St0) -> {K,St1} = expr(K0, St0), {V,St2} = expr(V0, St1), diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index e00ee1f3ad..47a357c23d 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -960,7 +960,6 @@ select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) -> end, {{[],[]},Bef}, Vs), Code = case {HasKs,GetVs} of - {[],[]} -> {[],Aft,St}; {HasKs,[]} -> [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}}]; {[],GetVs} -> @@ -1551,7 +1550,10 @@ map_pair_strip_and_termsort(Es) -> %% [{map_pair,K,V}] %% where K is for example {integer, 1} and we want to sort on 1. Ls = [{K,V}||{_,K,V}<-Es], - lists:sort(fun({{_,A},_},{{_,B},_}) -> erts_internal:cmp_term(A,B) < 0 end, Ls). + lists:sort(fun ({{_,A},_}, {{_,B},_}) -> erts_internal:cmp_term(A,B) =< 0; + ({nil,_}, {{_,B},_}) -> [] =< B; + ({{_,A},_}, {nil,_}) -> A =< [] + end, Ls). %%% %%% Code generation for constructing binaries. diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index a50b46bd7b..a548ba2f7c 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -77,7 +77,8 @@ splitwith/2,keyfind/3,sort/1,foreach/2,droplast/1,last/1]). -import(ordsets, [add_element/2,del_element/2,is_element/2, union/1,union/2,intersection/2,subtract/2]). --import(cerl, [ann_c_cons/3,ann_c_cons_skel/3,ann_c_tuple/2,c_tuple/1]). +-import(cerl, [ann_c_cons/3,ann_c_cons_skel/3,ann_c_tuple/2,c_tuple/1, + ann_c_map/2, ann_c_map/3]). -include("core_parse.hrl"). @@ -274,51 +275,67 @@ gexpr({op,L,'orelse',E1,E2}, Bools, St0) -> True = {atom,L,true}, E = make_bool_switch_guard(L, E1, V, True, E2), gexpr(E, Bools, St); -gexpr({op,Line,Op,L,R}=Call, Bools0, St0) -> +gexpr({op,Line,Op,L,R}=E, Bools, St) -> case erl_internal:bool_op(Op, 2) of - true -> - {Le,Lps,Bools1,St1} = gexpr(L, Bools0, St0), - {Ll,Llps,St2} = force_safe(Le, St1), - {Re,Rps,Bools,St3} = gexpr(R, Bools1, St2), - {Rl,Rlps,St4} = force_safe(Re, St3), - Anno = lineno_anno(Line, St4), - {#icall{anno=#a{anno=Anno}, %Must have an #a{} - module=#c_literal{anno=Anno,val=erlang}, - name=#c_literal{anno=Anno,val=Op}, - args=[Ll,Rl]},Lps ++ Llps ++ Rps ++ Rlps,Bools,St4}; - false -> - gexpr_test(Call, Bools0, St0) + true -> + gexpr_bool(Op, L, R, Bools, St, Line); + false -> + gexpr_test(E, Bools, St) end; -gexpr({op,Line,Op,A}=Call, Bools0, St0) -> - case Op of - 'not' -> - {Ae0,Aps,Bools,St1} = gexpr(A, Bools0, St0), - case Ae0 of - #icall{module=#c_literal{val=erlang}, - name=#c_literal{val='=:='}, - args=[E,#c_literal{val=true}]}=EqCall -> - %% - %% Doing the following transformation - %% not(Expr =:= true) ==> Expr =:= false - %% will help eliminating redundant is_boolean/1 tests. - %% - Ae = EqCall#icall{args=[E,#c_literal{val=false}]}, - {Al,Alps,St2} = force_safe(Ae, St1), - {Al,Aps ++ Alps,Bools,St2}; - Ae -> - {Al,Alps,St2} = force_safe(Ae, St1), - Anno = lineno_anno(Line, St2), - {#icall{anno=#a{anno=Anno}, %Must have an #a{} - module=#c_literal{anno=Anno,val=erlang}, - name=#c_literal{anno=Anno,val=Op}, - args=[Al]},Aps ++ Alps,Bools,St2} - end; - _ -> - gexpr_test(Call, Bools0, St0) +gexpr({call,Line,{remote,_,{atom,_,erlang},{atom,_,Op}},[L,R]}=E, Bools, St) -> + case erl_internal:bool_op(Op, 2) of + true -> + gexpr_bool(Op, L, R, Bools, St, Line); + false -> + gexpr_test(E, Bools, St) end; +gexpr({op,Line,'not',A}, Bools, St) -> + gexpr_not(A, Bools, St, Line); +gexpr({call,Line,{remote,_,{atom,_,erlang},{atom,_,'not'}},[A]}, Bools, St) -> + gexpr_not(A, Bools, St, Line); gexpr(E0, Bools, St0) -> gexpr_test(E0, Bools, St0). +%% gexpr_not(L, R, Bools, State) -> {Cexpr,[PreExp],Bools,State}. +%% Generate a guard for boolean operators + +gexpr_bool(Op, L, R, Bools0, St0, Line) -> + {Le,Lps,Bools1,St1} = gexpr(L, Bools0, St0), + {Ll,Llps,St2} = force_safe(Le, St1), + {Re,Rps,Bools,St3} = gexpr(R, Bools1, St2), + {Rl,Rlps,St4} = force_safe(Re, St3), + Anno = lineno_anno(Line, St4), + {#icall{anno=#a{anno=Anno}, %Must have an #a{} + module=#c_literal{anno=Anno,val=erlang}, + name=#c_literal{anno=Anno,val=Op}, + args=[Ll,Rl]},Lps ++ Llps ++ Rps ++ Rlps,Bools,St4}. + +%% gexpr_not(Expr, Bools, State) -> {Cexpr,[PreExp],Bools,State}. +%% Generate an erlang:'not'/1 guard test. + +gexpr_not(A, Bools0, St0, Line) -> + {Ae0,Aps,Bools,St1} = gexpr(A, Bools0, St0), + case Ae0 of + #icall{module=#c_literal{val=erlang}, + name=#c_literal{val='=:='}, + args=[E,#c_literal{val=true}]}=EqCall -> + %% + %% Doing the following transformation + %% not(Expr =:= true) ==> Expr =:= false + %% will help eliminating redundant is_boolean/1 tests. + %% + Ae = EqCall#icall{args=[E,#c_literal{val=false}]}, + {Al,Alps,St2} = force_safe(Ae, St1), + {Al,Aps ++ Alps,Bools,St2}; + Ae -> + {Al,Alps,St2} = force_safe(Ae, St1), + Anno = lineno_anno(Line, St2), + {#icall{anno=#a{anno=Anno}, %Must have an #a{} + module=#c_literal{anno=Anno,val=erlang}, + name=#c_literal{anno=Anno,val='not'}, + args=[Al]},Aps ++ Alps,Bools,St2} + end. + %% gexpr_test(Expr, Bools, State) -> {Cexpr,[PreExp],Bools,State}. %% Generate a guard test. At this stage we must be sure that we have %% a proper boolean value here so wrap things with an true test if we @@ -335,7 +352,8 @@ gexpr_test(E0, Bools0, St0) -> #icall{anno=Anno,module=#c_literal{val=erlang},name=#c_literal{val=N},args=As} -> Ar = length(As), case erl_internal:type_test(N, Ar) orelse - erl_internal:comp_op(N, Ar) of + erl_internal:comp_op(N, Ar) orelse + erl_internal:bool_op(N, Ar) of true -> {E1,Eps0,Bools0,St1}; false -> Lanno = Anno#a.anno, @@ -496,14 +514,33 @@ expr({tuple,L,Es0}, St0) -> expr({map,L,Es0}, St0) -> % erl_lint should make sure only #{ K => V } are allowed % in map construction. - {Es1,Eps,St1} = map_pair_list(Es0, St0), - A = lineno_anno(L, St1), - {#c_map{anno=A,es=Es1},Eps,St1}; + try map_pair_list(Es0, St0) of + {Es1,Eps,St1} -> + A = lineno_anno(L, St1), + {ann_c_map(A,Es1),Eps,St1} + catch + throw:{bad_map,Warning} -> + St = add_warning(L, Warning, St0), + LineAnno = lineno_anno(L, St), + As = [#c_literal{anno=LineAnno,val=badarg}], + {#icall{anno=#a{anno=LineAnno}, %Must have an #a{} + module=#c_literal{anno=LineAnno,val=erlang}, + name=#c_literal{anno=LineAnno,val=error}, + args=As},[],St} + end; expr({map,L,M0,Es0}, St0) -> - {M1,Mps,St1} = safe(M0, St0), - {Es1,Eps,St2} = map_pair_list(Es0, St1), - A = lineno_anno(L, St2), - {#c_map{anno=A,var=M1,es=Es1},Mps++Eps,St2}; + try expr_map(M0,Es0,lineno_anno(L, St0),St0) of + {_,_,_}=Res -> Res + catch + throw:{bad_map,Warning} -> + St = add_warning(L, Warning, St0), + LineAnno = lineno_anno(L, St), + As = [#c_literal{anno=LineAnno,val=badarg}], + {#icall{anno=#a{anno=LineAnno}, %Must have an #a{} + module=#c_literal{anno=LineAnno,val=erlang}, + name=#c_literal{anno=LineAnno,val=error}, + args=As},[],St} + end; expr({bin,L,Es0}, St0) -> try expr_bin(Es0, lineno_anno(L, St0), St0) of {_,_,_}=Res -> Res @@ -623,7 +660,7 @@ expr({call,Lc,{atom,Lf,F},As0}, St0) -> Op = #c_var{anno=lineno_anno(Lf, St1),name={F,length(As1)}}, {#iapply{anno=#a{anno=lineno_anno(Lc, St1)},op=Op,args=As1},Aps,St1}; expr({call,L,FunExp,As0}, St0) -> - {Fun,Fps,St1} = safe(FunExp, St0), + {Fun,Fps,St1} = safe_fun(length(As0), FunExp, St0), {As1,Aps,St2} = safe_list(As0, St1), Lanno = lineno_anno(L, St2), {#iapply{anno=#a{anno=Lanno},op=Fun,args=As1},Fps ++ Aps,St2}; @@ -713,22 +750,58 @@ make_bool_switch_guard(L, E, V, T, F) -> {clause,NegL,[V],[],[V]} ]}. +expr_map(M0,Es0,A,St0) -> + {M1,Mps,St1} = safe(M0, St0), + case is_valid_map_src(M1) of + true -> + case {M1,Es0} of + {#c_var{}, []} -> + %% transform M#{} to is_map(M) + {Vpat,St2} = new_var(St1), + {Fpat,St3} = new_var(St2), + Cs = [#iclause{ + anno=A, + pats=[Vpat], + guard=[#icall{anno=#a{anno=A}, + module=#c_literal{anno=A,val=erlang}, + name=#c_literal{anno=A,val=is_map}, + args=[Vpat]}], + body=[Vpat]}], + Fc = fail_clause([Fpat], A, #c_literal{val=badarg}), + {#icase{anno=#a{anno=A},args=[M1],clauses=Cs,fc=Fc},Mps,St3}; + {_,_} -> + {Es1,Eps,St2} = map_pair_list(Es0, St1), + {ann_c_map(A,M1,Es1),Mps++Eps,St2} + end; + false -> throw({bad_map,bad_map}) + end. + +is_valid_map_src(#c_literal{val = M}) when is_map(M) -> true; +is_valid_map_src(#c_map{}) -> true; +is_valid_map_src(#c_var{}) -> true; +is_valid_map_src(_) -> false. + map_pair_list(Es, St) -> foldr(fun ({map_field_assoc,L,K0,V0}, {Ces,Esp,St0}) -> {K,Ep0,St1} = safe(K0, St0), + ok = ensure_valid_map_key(K), {V,Ep1,St2} = safe(V0, St1), A = lineno_anno(L, St2), Pair = #c_map_pair{op=#c_literal{val=assoc},anno=A,key=K,val=V}, {[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2}; ({map_field_exact,L,K0,V0}, {Ces,Esp,St0}) -> {K,Ep0,St1} = safe(K0, St0), + ok = ensure_valid_map_key(K), {V,Ep1,St2} = safe(V0, St1), A = lineno_anno(L, St2), Pair = #c_map_pair{op=#c_literal{val=exact},anno=A,key=K,val=V}, {[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2} end, {[],[],St}, Es). +ensure_valid_map_key(#c_literal{}) -> ok; +ensure_valid_map_key(_) -> throw({bad_map,bad_map_key}). + %% try_exception([ExcpClause], St) -> {[ExcpVar],Handler,St}. try_exception(Ecs0, St0) -> @@ -1408,6 +1481,15 @@ safe(E0, St0) -> {Se,Sps,St2} = force_safe(E1, St1), {Se,Eps ++ Sps,St2}. +safe_fun(A0, E0, St0) -> + case safe(E0, St0) of + {#c_var{name={_,A1}}=E1,Eps,St1} when A1 =/= A0 -> + {V,St2} = new_var(St1), + {V,Eps ++ [#iset{var=V,arg=E1}],St2}; + Result -> + Result + end. + safe_list(Es, St) -> foldr(fun (E, {Ces,Esp,St0}) -> {Ce,Ep,St1} = safe(E, St0), @@ -1529,7 +1611,9 @@ pattern_map_pair({map_field_exact,L,K,V}, St) -> {bin,L,Es0} -> case constant_bin(Es0) of error -> - throw(badmatch); + %% this will throw a cryptic error message + %% but it is better than nothing + throw(nomatch); Bin -> #c_literal{anno=lineno_anno(L,St),val=Bin} end; @@ -1756,13 +1840,16 @@ uexpr(#iletrec{anno=A,defs=Fs0,body=B0}, Ks, St0) -> {B1,St2} = uexprs(B0, Ks, St1), Used = used_in_any(map(fun ({_,F}) -> F end, Fs1) ++ B1), {#iletrec{anno=A#a{us=Used,ns=[]},defs=Fs1,body=B1},St2}; -uexpr(#icase{anno=A,args=As0,clauses=Cs0,fc=Fc0}, Ks, St0) -> +uexpr(#icase{anno=#a{anno=Anno}=A,args=As0,clauses=Cs0,fc=Fc0}, Ks, St0) -> %% As0 will never generate new variables. {As1,St1} = uexpr_list(As0, Ks, St0), {Cs1,St2} = uclauses(Cs0, Ks, St1), {Fc1,St3} = uclause(Fc0, Ks, St2), Used = union(used_in_any(As1), used_in_any(Cs1)), - New = new_in_all(Cs1), + New = case member(list_comprehension, Anno) of + true -> []; + false -> new_in_all(Cs1) + end, {#icase{anno=A#a{us=Used,ns=New},args=As1,clauses=Cs1,fc=Fc1},St3}; uexpr(#ifun{anno=A0,id=Id,vars=As,clauses=Cs0,fc=Fc0,name=Name}, Ks0, St0) -> Avs = lit_list_vars(As), @@ -2137,6 +2224,8 @@ lit_vars(Lit) -> lit_vars(Lit, []). lit_vars(#c_cons{hd=H,tl=T}, Vs) -> lit_vars(H, lit_vars(T, Vs)); lit_vars(#c_tuple{es=Es}, Vs) -> lit_list_vars(Es, Vs); +lit_vars(#c_map{arg=V,es=Es}, Vs) -> lit_vars(V, lit_list_vars(Es, Vs)); +lit_vars(#c_map_pair{key=K,val=V}, Vs) -> lit_vars(K, lit_vars(V, Vs)); lit_vars(#c_var{name=V}, Vs) -> add_element(V, Vs); lit_vars(_, Vs) -> Vs. %These are atomic @@ -2227,7 +2316,11 @@ is_simple_list(Es) -> lists:all(fun is_simple/1, Es). format_error(nomatch) -> "pattern cannot possibly match"; format_error(bad_binary) -> - "binary construction will fail because of a type mismatch". + "binary construction will fail because of a type mismatch"; +format_error(bad_map_key) -> + "map construction will fail because of none literal key (large binaries are not literals)"; +format_error(bad_map) -> + "map construction will fail because of a type mismatch". add_warning(Line, Term, #core{ws=Ws,file=[{file,File}]}=St) when Line >= 0 -> St#core{ws=[{File,[{location(Line),?MODULE,Term}]}|Ws]}; diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 5675572092..40d2f72b4c 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -272,9 +272,18 @@ expr(#c_cons{anno=A,hd=Ch,tl=Ct}, Sub, St0) -> expr(#c_tuple{anno=A,es=Ces}, Sub, St0) -> {Kes,Ep,St1} = atomic_list(Ces, Sub, St0), {#k_tuple{anno=A,es=Kes},Ep,St1}; -expr(#c_map{anno=A,var=Var0,es=Ces}, Sub, St0) -> - {Var,[],St1} = expr(Var0, Sub, St0), - map_split_pairs(A, Var, Ces, Sub, St1); +expr(#c_map{anno=A,arg=Var,es=Ces}, Sub, St0) -> + try expr_map(A,Var,Ces,Sub,St0) of + {_,_,_}=Res -> Res + catch + throw:bad_map -> + St1 = add_warning(get_line(A), bad_map, A, St0), + Erl = #c_literal{val=erlang}, + Name = #c_literal{val=error}, + Args = [#c_literal{val=badarg}], + Error = #c_call{anno=A,module=Erl,name=Name,args=Args}, + expr(Error, Sub, St1) + end; expr(#c_binary{anno=A,segments=Cv}, Sub, St0) -> try atomic_bin(Cv, Sub, St0) of {Kv,Ep,St1} -> @@ -496,6 +505,21 @@ translate_match_fail_1(Anno, As, Sub, #kern{ff=FF}) -> translate_fc(Args) -> [#c_literal{val=function_clause},make_list(Args)]. +expr_map(A,Var0,Ces,Sub,St0) -> + %% An extra pass of validation of Map src because of inlining + {Var,Mps,St1} = expr(Var0, Sub, St0), + case is_valid_map_src(Var) of + true -> + {Km,Eps,St2} = map_split_pairs(A, Var, Ces, Sub, St1), + {Km,Eps++Mps,St2}; + false -> throw(bad_map) + end. + +is_valid_map_src(#k_map{}) -> true; +is_valid_map_src(#k_literal{val=M}) when is_map(M) -> true; +is_valid_map_src(#k_var{}) -> true; +is_valid_map_src(_) -> false. + map_split_pairs(A, Var, Ces, Sub, St0) -> %% two steps %% 1. force variables @@ -519,7 +543,7 @@ map_split_pairs(A, Var, Ces, Sub, St0) -> Kes1 = [#k_map_pair{key=K,val=V}||{_,{assoc,K,V}} <- Assoc], {Mvar,Em,St2} = force_atomic(#k_map{anno=A,op=assoc,var=Var,es=Kes1},St1), Kes2 = [#k_map_pair{key=K,val=V}||{_,{exact,K,V}} <- Exact], - {#k_map{anno=A,op=exact,var=Mvar,es=Kes2},Em ++ Esp,St2} + {#k_map{anno=A,op=exact,var=Mvar,es=Kes2},Esp ++ Em,St2} end. @@ -557,8 +581,7 @@ map_key_clean(#k_literal{val=V}) -> {k_literal,V}; map_key_clean(#k_int{val=V}) -> {k_int,V}; map_key_clean(#k_float{val=V}) -> {k_float,V}; map_key_clean(#k_atom{val=V}) -> {k_atom,V}; -map_key_clean(#k_nil{}) -> k_nil; -map_key_clean(#k_var{name=V}) -> {k_var,V}. +map_key_clean(#k_nil{}) -> k_nil. %% call_type(Module, Function, Arity) -> call | bif | apply | error. @@ -1986,7 +2009,9 @@ format_error(nomatch_shadow) -> format_error(bad_call) -> "invalid module and/or function name; this call will always fail"; format_error(bad_segment_size) -> - "binary construction will fail because of a type mismatch". + "binary construction will fail because of a type mismatch"; +format_error(bad_map) -> + "map construction will fail because of a type mismatch". add_warning(none, Term, Anno, #kern{ws=Ws}=St) -> File = get_file(Anno), diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl index b4e486f97c..b33eba50eb 100644 --- a/lib/compiler/src/v3_kernel_pp.erl +++ b/lib/compiler/src/v3_kernel_pp.erl @@ -104,20 +104,26 @@ format_1(#k_tuple{es=Es}, Ctxt) -> format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), $} ]; -format_1(#k_map{var=#k_var{}=Var,es=Es}, Ctxt) -> - [$~,${, +format_1(#k_map{var=#k_literal{val=M},op=assoc,es=Es}, Ctxt) when is_map(M), map_size(M) =:= 0 -> + ["~{", format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), - " | ",format_1(Var, Ctxt), - $},$~ + "}~" ]; -format_1(#k_map{op=assoc,es=Es}, Ctxt) -> +format_1(#k_map{var=#k_literal{val=M},op=exact,es=Es}, Ctxt) when is_map(M), map_size(M) =:= 0 -> + ["::{", + format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), + "}::" + ]; +format_1(#k_map{var=Var,op=assoc,es=Es}, Ctxt) -> ["~{", format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), + " | ",format_1(Var, Ctxt), "}~" ]; -format_1(#k_map{es=Es}, Ctxt) -> +format_1(#k_map{var=Var,op=exact,es=Es}, Ctxt) -> ["::{", format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), + " | ",format_1(Var, Ctxt), "}::" ]; format_1(#k_map_pair{key=K,val=V}, Ctxt) -> diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index c4f54a7970..cd4b5fd674 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -324,8 +324,7 @@ type(k_binary) -> binary; type(k_bin_seg) -> bin_seg; type(k_bin_int) -> bin_int; type(k_bin_end) -> bin_end; -type(k_map) -> map; -type(k_map_pair) -> map_pair. +type(k_map) -> map. %% variable(Klit) -> Lit. %% var_list([Klit]) -> [Lit]. diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 39c9fea5d9..0b56a49cd6 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -69,6 +69,7 @@ INLINE= \ fun \ guard \ lc \ + map \ match \ misc \ num_bif \ diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl index 7bef0aa27c..b5408ecd8f 100644 --- a/lib/compiler/test/andor_SUITE.erl +++ b/lib/compiler/test/andor_SUITE.erl @@ -129,6 +129,10 @@ t_case_y(X, Y, Z) -> Y =:= 100 end. +-define(GUARD(E), if E -> true; + true -> false + end). + t_and_or(Config) when is_list(Config) -> ?line true = true and true, ?line false = true and false, @@ -160,11 +164,16 @@ t_and_or(Config) when is_list(Config) -> ?line true = false or id(true), ?line false = false or id(false), - ok. + True = id(true), --define(GUARD(E), if E -> true; - true -> false - end). + false = ?GUARD(erlang:'and'(bar, True)), + false = ?GUARD(erlang:'or'(bar, True)), + false = ?GUARD(erlang:'not'(erlang:'and'(bar, True))), + false = ?GUARD(erlang:'not'(erlang:'not'(erlang:'and'(bar, True)))), + + true = (fun (X = true) when X or true or X -> true end)(True), + + ok. t_andalso(Config) when is_list(Config) -> Bs = [true,false], diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl index aa222c48de..428ad65364 100644 --- a/lib/compiler/test/core_SUITE.erl +++ b/lib/compiler/test/core_SUITE.erl @@ -24,7 +24,7 @@ dehydrated_itracer/1,nested_tries/1, seq_in_guard/1,make_effect_seq/1,eval_is_boolean/1, unsafe_case/1,nomatch_shadow/1,reversed_annos/1, - map_core_test/1,eval_case/1]). + map_core_test/1,eval_case/1,bad_boolean_guard/1]). -include_lib("test_server/include/test_server.hrl"). @@ -50,7 +50,7 @@ groups() -> [{p,test_lib:parallel(), [dehydrated_itracer,nested_tries,seq_in_guard,make_effect_seq, eval_is_boolean,unsafe_case,nomatch_shadow,reversed_annos, - map_core_test,eval_case + map_core_test,eval_case,bad_boolean_guard ]}]. @@ -77,6 +77,7 @@ end_per_group(_GroupName, Config) -> ?comp(reversed_annos). ?comp(map_core_test). ?comp(eval_case). +?comp(bad_boolean_guard). try_it(Mod, Conf) -> Src = filename:join(?config(data_dir, Conf), atom_to_list(Mod)), diff --git a/lib/compiler/test/core_SUITE_data/bad_boolean_guard.core b/lib/compiler/test/core_SUITE_data/bad_boolean_guard.core new file mode 100644 index 0000000000..318f8e3dc7 --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/bad_boolean_guard.core @@ -0,0 +1,32 @@ +module 'bad_boolean_guard' ['bad_boolean_guard'/0, + 'module_info'/0, + 'module_info'/1] + attributes [] +'bad_boolean_guard'/0 = + fun () -> + apply 'f'/1 + ('true') +'f'/1 = + fun (_X_cor0) -> + case _X_cor0 of + <X> + when try + call 'erlang':'and' + ('bad', _X_cor0) + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'not_ok' + <_X_cor3> when 'true' -> + 'ok' + end +'module_info'/0 = + fun () -> + call 'erlang':'get_module_info' + ('bad_boolean_guard') +'module_info'/1 = + fun (_X_cor0) -> + call 'erlang':'get_module_info' + ('bad_boolean_guard', _X_cor0) +end
\ No newline at end of file diff --git a/lib/compiler/test/core_SUITE_data/map_core_test.core b/lib/compiler/test/core_SUITE_data/map_core_test.core index 7ece8a8bbd..2aa853d450 100644 --- a/lib/compiler/test/core_SUITE_data/map_core_test.core +++ b/lib/compiler/test/core_SUITE_data/map_core_test.core @@ -67,7 +67,7 @@ module 'map_core_test' ['map_core_test'/0, (Val, V) in let <_cor5> = %% Line 21 - M~{~<1337,_cor4>,~<'val',_cor2>}~ + ~{~<1337,_cor4>,~<'val',_cor2>|M}~ in %% Line 21 apply 'call'/2 (_cor5, Vs) @@ -92,4 +92,4 @@ module 'map_core_test' ['map_core_test'/0, fun (_cor0) -> call 'erlang':'get_module_info' ('map_core_test', _cor0) -end
\ No newline at end of file +end diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 8151dc1b16..6a7036d728 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -23,7 +23,7 @@ t_element/1,setelement/1,t_length/1,append/1,t_apply/1,bifs/1, eq/1,nested_call_in_case/1,guard_try_catch/1,coverage/1, unused_multiple_values_error/1,unused_multiple_values/1, - multiple_aliases/1]). + multiple_aliases/1,redundant_boolean_clauses/1,mixed_matching_clauses/1]). -export([foo/0,foo/1,foo/2,foo/3]). @@ -40,7 +40,7 @@ groups() -> [t_element,setelement,t_length,append,t_apply,bifs, eq,nested_call_in_case,guard_try_catch,coverage, unused_multiple_values_error,unused_multiple_values, - multiple_aliases]}]. + multiple_aliases,redundant_boolean_clauses,mixed_matching_clauses]}]. init_per_suite(Config) -> @@ -365,4 +365,23 @@ run_once() -> ok. +redundant_boolean_clauses(Config) when is_list(Config) -> + X = id(0), + yes = case X == 0 of + false -> no; + false -> no; + true -> yes + end. + +mixed_matching_clauses(Config) when is_list(Config) -> + 0 = case #{} of + #{} -> 0; + a -> 1 + end, + 0 = case <<>> of + <<>> -> 0; + a -> 1 + end, + ok. + id(I) -> I. diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl index 5cdf429a5f..bd877bb528 100644 --- a/lib/compiler/test/error_SUITE.erl +++ b/lib/compiler/test/error_SUITE.erl @@ -23,7 +23,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, head_mismatch_line/1,warnings_as_errors/1, bif_clashes/1, - transforms/1,forbidden_maps/1]). + transforms/1,forbidden_maps/1,bad_utf8/1]). %% Used by transforms/1 test case. -export([parse_transform/2]). @@ -36,7 +36,8 @@ all() -> groups() -> [{p,test_lib:parallel(), - [head_mismatch_line,warnings_as_errors,bif_clashes,transforms,forbidden_maps]}]. + [head_mismatch_line,warnings_as_errors,bif_clashes, + transforms,forbidden_maps,bad_utf8]}]. init_per_suite(Config) -> Config. @@ -254,6 +255,23 @@ forbidden_maps(Config) when is_list(Config) -> [] = run2(Config, Ts1), ok. +bad_utf8(Config) -> + Ts = [{bad_utf8, + %% If coding is specified explicitly as utf-8, there should be + %% a compilation error; we must not fallback to parsing the + %% file in latin-1 mode. + <<"%% coding: utf-8 + %% Bj",246,"rn + t() -> \"",246,"\". + ">>, + [], + {error,[{2,epp,cannot_parse}, + {2,file_io_server,invalid_unicode}], + []} + }], + [] = run2(Config, Ts), + ok. + run(Config, Tests) -> ?line File = test_filename(Config), @@ -318,6 +336,7 @@ run_test(Test0, File, Warnings, WriteBeam) -> ?line compile:file(File, [binary,report|Warnings]), %% Test result of compilation. + io:format("~p\n", [Opts]), ?line Res = case compile:file(File, Opts) of {ok,Mod,_,[{_File,Ws}]} -> %io:format("compile:file(~s,~p) ->~n~p~n", @@ -335,6 +354,11 @@ run_test(Test0, File, Warnings, WriteBeam) -> %io:format("compile:file(~s,~p) ->~n~p~n", % [File,Opts,_ZZ]), {error,Es,Ws}; + {error,[{XFile,Es1},{XFile,Es2}],Ws} = _ZZ + when is_list(XFile) -> + %io:format("compile:file(~s,~p) ->~n~p~n", + % [File,Opts,_ZZ]), + {error,Es1++Es2,Ws}; {error,Es,[{_File,Ws}]} = _ZZ-> %io:format("compile:file(~s,~p) ->~n~p~n", % [File,Opts,_ZZ]), diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl index e35692efd1..25b7f677b5 100644 --- a/lib/compiler/test/fun_SUITE.erl +++ b/lib/compiler/test/fun_SUITE.erl @@ -21,7 +21,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, test1/1,overwritten_fun/1,otp_7202/1,bif_fun/1, - external/1,eep37/1]). + external/1,eep37/1,badarity/1]). %% Internal export. -export([call_me/1]). @@ -32,7 +32,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [test1,overwritten_fun,otp_7202,bif_fun,external,eep37]. + [test1,overwritten_fun,otp_7202,bif_fun,external,eep37,badarity]. groups() -> []. @@ -206,5 +206,9 @@ eep37(Config) when is_list(Config) -> 50 = UnusedName(8), ok. +badarity(Config) when is_list(Config) -> + {'EXIT',{{badarity,{_,[]}},_}} = (catch (fun badarity/1)()), + ok. + id(I) -> I. diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index a0a9bb7ddd..eb205d09a7 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -33,7 +33,7 @@ tricky/1,rel_ops/1,literal_type_tests/1, basic_andalso_orelse/1,traverse_dcd/1, check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1, - bad_constants/1]). + bad_constants/1,bad_guards/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -50,7 +50,7 @@ groups() -> t_is_boolean,is_function_2,tricky,rel_ops, literal_type_tests,basic_andalso_orelse,traverse_dcd, check_qlc_hrl,andalso_semi,t_tuple_size,binary_part, - bad_constants]}]. + bad_constants,bad_guards]}]. init_per_suite(Config) -> Config. @@ -1023,6 +1023,10 @@ is_function_2(Config) when is_list(Config) -> true = is_function(id(fun() -> ok end), 0), false = is_function(id(fun ?MODULE:all/1), 0), false = is_function(id(fun() -> ok end), 1), + {'EXIT',{badarg,_}} = + (catch is_function(id(fun() -> ok end), -1) orelse error), + {'EXIT',{badarg,_}} = + (catch is_function(id(fun() -> ok end), '') orelse error), F = fun(_) -> ok end, if @@ -1550,6 +1554,10 @@ bad_constants(Config) when is_list(Config) -> ?line ?FAILING(3.14), ok. +bad_guards(Config) when is_list(Config) -> + if erlang:float(self()); true -> ok end, + ok. + %% Call this function to turn off constant propagation. id(I) -> I. diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl index f5948504b3..398398a397 100644 --- a/lib/compiler/test/lc_SUITE.erl +++ b/lib/compiler/test/lc_SUITE.erl @@ -23,7 +23,7 @@ init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, basic/1,deeply_nested/1,no_generator/1, - empty_generator/1]). + empty_generator/1,no_export/1]). -include_lib("test_server/include/test_server.hrl"). @@ -31,7 +31,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [basic, deeply_nested, no_generator, empty_generator]. + [basic, deeply_nested, no_generator, empty_generator, no_export]. groups() -> []. @@ -177,6 +177,10 @@ empty_generator(Config) when is_list(Config) -> ?line [] = [X || {X} <- [], (false or (X/0 > 3))], ok. +no_export(Config) when is_list(Config) -> + [] = [ _X = a || false ] ++ [ _X = a || false ], + ok. + id(I) -> I. fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Args,_}|_]}}) -> ok; diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index 7d35ffc8d5..cc018e4305 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -40,9 +40,13 @@ t_build_and_match_over_alloc/1, t_build_and_match_empty_val/1, t_build_and_match_val/1, + t_build_and_match_nil/1, + t_build_and_match_structure/1, %% errors in 17.0-rc1 - t_update_values/1 + t_update_values/1, + t_expand_map_update/1, + t_export/1 ]). suite() -> []. @@ -66,9 +70,13 @@ all() -> [ t_build_and_match_over_alloc, t_build_and_match_empty_val, t_build_and_match_val, + t_build_and_match_nil, + t_build_and_match_structure, %% errors in 17.0-rc1 - t_update_values + t_update_values, + t_expand_map_update, + t_export ]. groups() -> []. @@ -105,12 +113,16 @@ t_build_and_match_literals(Config) when is_list(Config) -> M = #{ map_1:=#{ map_2:=#{value_3 := third}, value_2:= second}, value_1:=first} = id(#{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}), + %% nil key + #{[]:=ok,1:=2} = id(#{[]=>ok,1=>2}), + %% error case {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3,x:=2} = id(#{x=>3}))), {'EXIT',{{badmatch,_},_}} = (catch (#{x:=2} = id(#{x=>3}))), {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id({a,b,c}))), {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{y=>3}))), {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))), + {'EXIT',{badarg,_}} = (catch id(#{<<0:258>> =>"three"})), ok. t_build_and_match_aliasing(Config) when is_list(Config) -> @@ -187,7 +199,9 @@ loop_match_and_update_literals_x_q(#{q:=Q0,x:=X0} = Map, [{X,Q}|Vs]) -> t_update_map_expressions(Config) when is_list(Config) -> M = maps:new(), - #{ a := 1 } = M#{a => 1}, + X = id(fondue), + M1 = #{ a := 1 } = M#{a => 1}, + #{ b := {X} } = M1#{ a := 1, b => {X} }, #{ b := 2 } = (maps:new())#{ b => 2 }, @@ -225,7 +239,8 @@ t_update_assoc(Config) when is_list(Config) -> %% Errors cases. BadMap = id(badmap), {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}), - + {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting=>val}), + {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> => val}), %% limitation ok. t_update_exact(Config) when is_list(Config) -> @@ -253,6 +268,8 @@ t_update_exact(Config) when is_list(Config) -> {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}), {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}), {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting:=val}), + {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> := val}), %% limitation ok. t_update_values(Config) when is_list(Config) -> @@ -273,20 +290,39 @@ t_update_values(Config) when is_list(Config) -> end, {none, none, #{val1=>none,val2=>none}},List), ok. +t_expand_map_update(Config) when is_list(Config) -> + M = #{<<"hello">> => <<"world">>}#{<<"hello">> := <<"les gens">>}, + #{<<"hello">> := <<"les gens">>} = M, + ok. + +t_export(Config) when is_list(Config) -> + Raclette = id(#{}), + case brie of brie -> Fromage = Raclette end, + Raclette = Fromage#{}, + ok. + check_val(#{val1:=V1, val2:=V2},V1,V2) -> ok. get_val(#{ "wazzup" := _, val := V}) -> V; get_val(#{ val := V }) -> {some_val, V}. t_guard_bifs(Config) when is_list(Config) -> + true = map_guard_empty(), + true = map_guard_empty_2(), true = map_guard_head(#{a=>1}), false = map_guard_head([]), true = map_guard_body(#{a=>1}), false = map_guard_body({}), true = map_guard_pattern(#{a=>1, <<"hi">> => "hi" }), false = map_guard_pattern("list"), + true = map_guard_tautology(), + true = map_guard_ill_map_size(), ok. +map_guard_empty() when is_map(#{}); false -> true. + +map_guard_empty_2() when true; #{} andalso false -> true. + map_guard_head(M) when is_map(M) -> true; map_guard_head(_) -> false. @@ -295,6 +331,10 @@ map_guard_body(M) -> is_map(M). map_guard_pattern(#{}) -> true; map_guard_pattern(_) -> false. +map_guard_tautology() when #{} =:= #{}; true -> true. + +map_guard_ill_map_size() when true; map_size(0) -> true. + t_guard_sequence(Config) when is_list(Config) -> {1, "a"} = map_guard_sequence_1(#{seq=>1,val=>id("a")}), {2, "b"} = map_guard_sequence_1(#{seq=>2,val=>id("b")}), @@ -418,8 +458,12 @@ t_guard_fun(Config) when is_list(Config) -> {l,V} = F2(#{s=>l,v=>[V,V]}), %% error case - {'EXIT', {function_clause,[{?MODULE,_,[#{s:=none,v:=none}],_}|_]}} = (catch F1(#{s=>none,v=>none})), - ok. + case (catch F1(#{s=>none,v=>none})) of + {'EXIT', {function_clause,[{?MODULE,_,[#{s:=none,v:=none}],_}|_]}} -> ok; + {'EXIT', {{case_clause,_},_}} -> {comment,inlined}; + Other -> + test_server:fail({no_match, Other}) + end. t_map_sort_literals(Config) when is_list(Config) -> @@ -500,8 +544,12 @@ t_build_and_match_empty_val(Config) when is_list(Config) -> ok = F(id(#{"hi"=>ok,{1,2}=>ok,1337=>ok})), %% error case - {'EXIT',{function_clause,_}} = (catch (F(id(#{"hi"=>ok})))), - ok. + case (catch (F(id(#{"hi"=>ok})))) of + {'EXIT',{function_clause,_}} -> ok; + {'EXIT', {{case_clause,_},_}} -> {comment,inlined}; + Other -> + test_server:fail({no_match, Other}) + end. t_build_and_match_val(Config) when is_list(Config) -> F = fun @@ -514,9 +562,39 @@ t_build_and_match_val(Config) when is_list(Config) -> {2,"second"} = F(id(#{"hi"=>second,v=>"second"})), %% error case - {'EXIT',{function_clause,_}} = (catch (F(id(#{"hi"=>ok})))), + case (catch (F(id(#{"hi"=>ok})))) of + {'EXIT',{function_clause,_}} -> ok; + {'EXIT', {{case_clause,_},_}} -> {comment,inlined}; + Other -> + test_server:fail({no_match, Other}) + end. + +t_build_and_match_nil(Config) when is_list(Config) -> + %% literals removed the coverage + V1 = id(cookie), + V2 = id(cake), + V3 = id(crisps), + + #{ [] := V1, "treat" := V2, {your,treat} := V3 } = id(#{ + {your,treat} => V3, + "treat" => V2, + [] => V1 }), + #{ [] := V3, [] := V3 } = id(#{ [] => V1, [] => V3 }), ok. +t_build_and_match_structure(Config) when is_list(Config) -> + V2 = id("it"), + S = id([42,{"hi", "=)", #{ "a" => 42, any => any, val => "get_" ++ V2}}]), + + %% match deep map values + V2 = case S of + [42,{"hi",_, #{ "a" := 42, val := "get_" ++ V1, any := _ }}] -> V1 + end, + %% match deep map + ok = case S of + [42,{"hi",_, #{ }}] -> ok + end, + ok. %% Use this function to avoid compile-time evaluation of an expression. id(I) -> I. diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index ec49267ded..00a6e900d4 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -257,6 +257,7 @@ wait(Config) when is_list(Config) -> self() ! <<42>>, <<42>> = wait_1(r, 1, 2), {1,2,3} = wait_1(1, 2, 3), + {'EXIT',{timeout_value,_}} = (catch receive after [] -> timeout end), ok. wait_1(r, _, _) -> diff --git a/lib/compiler/test/record_SUITE.erl b/lib/compiler/test/record_SUITE.erl index c9f5a2053e..f736e14bf6 100644 --- a/lib/compiler/test/record_SUITE.erl +++ b/lib/compiler/test/record_SUITE.erl @@ -369,6 +369,14 @@ record_test_3(Config) when is_list(Config) -> ?line false = is_record(id(#barf{}), id(barf), id(42)), ?line false = is_record(id(#barf{}), id(foo), id(6)), + Rec = id(#barf{}), + Good = id(barf), + Bad = id(foo), + Size = id(6), + + true = is_record(Rec, Good, Size) orelse error, + error = is_record(Rec, Bad, Size) orelse error, + ok. record_access_in_guards(Config) when is_list(Config) -> diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index 16d15a59e5..ad4ad91f74 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -37,7 +37,9 @@ -export([pattern/1,pattern2/1,pattern3/1,pattern4/1, guard/1,bad_arith/1,bool_cases/1,bad_apply/1, - files/1,effect/1,bin_opt_info/1,bin_construction/1, comprehensions/1]). + files/1,effect/1,bin_opt_info/1,bin_construction/1, + comprehensions/1,maps/1,redundant_boolean_clauses/1, + latin1_fallback/1]). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(2)). @@ -61,7 +63,8 @@ groups() -> [{p,test_lib:parallel(), [pattern,pattern2,pattern3,pattern4,guard, bad_arith,bool_cases,bad_apply,files,effect, - bin_opt_info,bin_construction,comprehensions]}]. + bin_opt_info,bin_construction,comprehensions,maps, + redundant_boolean_clauses,latin1_fallback]}]. init_per_suite(Config) -> Config. @@ -200,6 +203,8 @@ pattern4(Config) when is_list(Config) -> [nowarn_unused_vars], {warnings, [{9,sys_core_fold,no_clause_match}, + {11,sys_core_fold,nomatch_shadow}, + {15,sys_core_fold,nomatch_shadow}, {18,sys_core_fold,no_clause_match}, {23,sys_core_fold,no_clause_match}, {33,sys_core_fold,no_clause_match} @@ -552,6 +557,113 @@ comprehensions(Config) when is_list(Config) -> run(Config, Ts), ok. +maps(Config) when is_list(Config) -> + Ts = [{bad_map, + <<" + t() -> + case maybe_map of + #{} -> ok; + not_map -> error + end. + x() -> + case true of + #{} -> error; + true -> ok + end. + ">>, + [], + {warnings,[{3,sys_core_fold,no_clause_match}, + {9,sys_core_fold,nomatch_clause_type}]}}, + {bad_map_src1, + <<" + t() -> + M = {a,[]}, + {'EXIT',{badarg,_}} = (catch(M#{ a => 1})), + ok. + ">>, + [], + {warnings,[{4,v3_kernel,bad_map}]}}, + {bad_map_src2, + <<" + t() -> + M = id({a,[]}), + {'EXIT',{badarg,_}} = (catch(M#{ a => 1})), + ok. + id(I) -> I. + ">>, + [inline], + {warnings,[{4,v3_kernel,bad_map}]}}, + {bad_map_src3, + <<" + t() -> + {'EXIT',{badarg,_}} = (catch <<>>#{ a := 1}), + ok. + ">>, + [], + {warnings,[{3,v3_core,bad_map}]}}, + {bad_map_literal_key, + <<" + t() -> + V = id(1), + M = id(#{ <<$h,$i>> => V }), + V = case M of + #{ <<0:257>> := Val } -> Val; + #{ <<$h,$i>> := Val } -> Val + end, + ok. + id(I) -> I. + ">>, + [], + {warnings,[{6,v3_core,nomatch}]}}], + run(Config, Ts), + ok. + +redundant_boolean_clauses(Config) when is_list(Config) -> + Ts = [{redundant_boolean_clauses, + <<" + t(X) -> + case X == 0 of + false -> no; + false -> no; + true -> yes + end. + ">>, + [], + {warnings,[{5,sys_core_fold,nomatch_shadow}]}}], + run(Config, Ts), + ok. + +latin1_fallback(Conf) when is_list(Conf) -> + DataDir = ?privdir, + IncFile = filename:join(DataDir, "include_me.hrl"), + file:write_file(IncFile, <<"%% ",246," in include file\n">>), + Ts1 = [{latin1_fallback1, + %% Test that the compiler fall backs to latin-1 with + %% a warning if a file has no encoding and does not + %% contain correct UTF-8 sequences. + <<"%% Bj",246,"rn + t(_) -> \"",246,"\"; + t(x) -> ok. + ">>, + [], + {warnings,[{1,compile,reparsing_invalid_unicode}, + {3,sys_core_fold,{nomatch_shadow,2}}]}}], + [] = run(Conf, Ts1), + + Ts2 = [{latin1_fallback2, + %% Test that the compiler fall backs to latin-1 with + %% a warning if a file has no encoding and does not + %% contain correct UTF-8 sequences. + <<" + + -include(\"include_me.hrl\"). + ">>, + [], + {warnings,[{1,compile,reparsing_invalid_unicode}]} + }], + [] = run(Conf, Ts2), + ok. + %%% %%% End of test cases. %%% diff --git a/lib/compiler/vsn.mk b/lib/compiler/vsn.mk index cbdf57f177..c0c3d56472 100644 --- a/lib/compiler/vsn.mk +++ b/lib/compiler/vsn.mk @@ -1 +1 @@ -COMPILER_VSN = 4.9.4 +COMPILER_VSN = 5.0 diff --git a/lib/cosEvent/src/cosEvent.app.src b/lib/cosEvent/src/cosEvent.app.src index c1cb9e0cc9..66b0d2e168 100644 --- a/lib/cosEvent/src/cosEvent.app.src +++ b/lib/cosEvent/src/cosEvent.app.src @@ -38,7 +38,8 @@ {registered, []}, {applications, [orber, stdlib, kernel]}, {env, []}, - {mod, {cosEventApp, []}} + {mod, {cosEventApp, []}}, + {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-6.0"]} ]}. diff --git a/lib/cosEvent/vsn.mk b/lib/cosEvent/vsn.mk index 6745bee079..40bf1ba49d 100644 --- a/lib/cosEvent/vsn.mk +++ b/lib/cosEvent/vsn.mk @@ -1,3 +1,3 @@ -COSEVENT_VSN = 2.1.14 +COSEVENT_VSN = 2.1.15 diff --git a/lib/cosEventDomain/src/cosEventDomain.app.src b/lib/cosEventDomain/src/cosEventDomain.app.src index e4307e1f99..60114b6a91 100644 --- a/lib/cosEventDomain/src/cosEventDomain.app.src +++ b/lib/cosEventDomain/src/cosEventDomain.app.src @@ -27,5 +27,7 @@ {registered, []}, {applications, [orber, stdlib, kernel]}, {env, []}, - {mod, {cosEventDomainApp, []}} + {mod, {cosEventDomainApp, []}}, + {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-6.0", + "cosNotification-1.1.21"]} ]}. diff --git a/lib/cosEventDomain/vsn.mk b/lib/cosEventDomain/vsn.mk index e9cf92395a..6317ed3c22 100644 --- a/lib/cosEventDomain/vsn.mk +++ b/lib/cosEventDomain/vsn.mk @@ -1,3 +1,3 @@ -COSEVENTDOMAIN_VSN = 1.1.13 +COSEVENTDOMAIN_VSN = 1.1.14 diff --git a/lib/cosFileTransfer/src/cosFileTransfer.app.src b/lib/cosFileTransfer/src/cosFileTransfer.app.src index 31d94b6f0d..21226b0c6b 100644 --- a/lib/cosFileTransfer/src/cosFileTransfer.app.src +++ b/lib/cosFileTransfer/src/cosFileTransfer.app.src @@ -36,6 +36,8 @@ {registered, []}, {applications, [orber, stdlib, kernel]}, {env, []}, - {mod, {cosFileTransferApp, []}} + {mod, {cosFileTransferApp, []}}, + {runtime_dependencies, ["stdlib-2.0","ssl-5.3.4","orber-3.6.27","kernel-3.0", + "inets-5.10","erts-6.0","cosProperty-1.1.17"]} ]}. diff --git a/lib/cosFileTransfer/vsn.mk b/lib/cosFileTransfer/vsn.mk index cf33926334..f52a1bd800 100644 --- a/lib/cosFileTransfer/vsn.mk +++ b/lib/cosFileTransfer/vsn.mk @@ -1 +1 @@ -COSFILETRANSFER_VSN = 1.1.15 +COSFILETRANSFER_VSN = 1.1.16 diff --git a/lib/cosNotification/src/cosNotification.app.src b/lib/cosNotification/src/cosNotification.app.src index 04beac36e8..ad02eb4421 100644 --- a/lib/cosNotification/src/cosNotification.app.src +++ b/lib/cosNotification/src/cosNotification.app.src @@ -116,5 +116,7 @@ {registered, [cosNotificationSup, oe_cosNotificationFactory]}, {applications, [orber, stdlib, kernel]}, {env, []}, - {mod, {cosNotificationApp, []}} + {mod, {cosNotificationApp, []}}, + {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-6.0", + "cosTime-1.1.14","cosEvent-2.1.15"]} ]}. diff --git a/lib/cosNotification/vsn.mk b/lib/cosNotification/vsn.mk index ea59800164..28d6ec71bf 100644 --- a/lib/cosNotification/vsn.mk +++ b/lib/cosNotification/vsn.mk @@ -1,2 +1,2 @@ -COSNOTIFICATION_VSN = 1.1.20 +COSNOTIFICATION_VSN = 1.1.21 diff --git a/lib/cosProperty/src/cosProperty.app.src b/lib/cosProperty/src/cosProperty.app.src index 3099e904f7..b977bb5984 100644 --- a/lib/cosProperty/src/cosProperty.app.src +++ b/lib/cosProperty/src/cosProperty.app.src @@ -41,5 +41,7 @@ {registered, [oe_cosPropertySup]}, {applications, [orber, stdlib, kernel]}, {env, []}, - {mod, {cosProperty, []}} + {mod, {cosProperty, []}}, + {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","mnesia-4.12", + "kernel-3.0","erts-6.0"]} ]}. diff --git a/lib/cosProperty/vsn.mk b/lib/cosProperty/vsn.mk index ac7820216e..0f546a2da8 100644 --- a/lib/cosProperty/vsn.mk +++ b/lib/cosProperty/vsn.mk @@ -1,2 +1,2 @@ -COSPROPERTY_VSN = 1.1.16 +COSPROPERTY_VSN = 1.1.17 diff --git a/lib/cosTime/src/cosTime.app.src b/lib/cosTime/src/cosTime.app.src index 191ee5f3db..cd01de35cb 100644 --- a/lib/cosTime/src/cosTime.app.src +++ b/lib/cosTime/src/cosTime.app.src @@ -26,5 +26,7 @@ {registered, [oe_cosTimeSup, oe_cosTimerEventService]}, {applications, [orber, stdlib, kernel]}, {env, []}, - {mod, {cosTime, []}} + {mod, {cosTime, []}}, + {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-6.0", + "cosEvent-2.1.15"]} ]}. diff --git a/lib/cosTime/vsn.mk b/lib/cosTime/vsn.mk index 02cd669222..9e9e5c0250 100644 --- a/lib/cosTime/vsn.mk +++ b/lib/cosTime/vsn.mk @@ -1,2 +1,3 @@ -COSTIME_VSN = 1.1.13 +COSTIME_VSN = 1.1.14 + diff --git a/lib/cosTransactions/src/cosTransactions.app.src b/lib/cosTransactions/src/cosTransactions.app.src index 52769b1711..6b99915ad6 100644 --- a/lib/cosTransactions/src/cosTransactions.app.src +++ b/lib/cosTransactions/src/cosTransactions.app.src @@ -39,5 +39,6 @@ {registered, [cosTransactions_sup, oe_cosTransactionsFactory]}, {applications, [orber, stdlib, kernel]}, {env, []}, - {mod, {cosTransactions, []}} + {mod, {cosTransactions, []}}, + {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-6.0"]} ]}. diff --git a/lib/cosTransactions/vsn.mk b/lib/cosTransactions/vsn.mk index 5414270a3d..7aed212523 100644 --- a/lib/cosTransactions/vsn.mk +++ b/lib/cosTransactions/vsn.mk @@ -1 +1 @@ -COSTRANSACTIONS_VSN = 1.2.13 +COSTRANSACTIONS_VSN = 1.2.14 diff --git a/lib/crypto/Makefile b/lib/crypto/Makefile index 2adcfd7f31..e893c914e6 100644 --- a/lib/crypto/Makefile +++ b/lib/crypto/Makefile @@ -23,7 +23,11 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk # Macros # +ifneq ($(findstring ose,$(TARGET)),ose) SUB_DIRECTORIES = src c_src doc/src +else +SUB_DIRECTORIES = src doc/src +endif static_lib: SUB_DIRECTORIES = c_src include vsn.mk diff --git a/lib/crypto/c_src/Makefile.in b/lib/crypto/c_src/Makefile.in index 124d088056..8c92b5ba1b 100644 --- a/lib/crypto/c_src/Makefile.in +++ b/lib/crypto/c_src/Makefile.in @@ -126,7 +126,12 @@ ALL_STATIC_CFLAGS = $(DED_STATIC_CFLAGS) $(INCLUDES) _create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) +ifneq ($(findstring ose,$(TARGET)),ose) debug opt valgrind: $(NIF_LIB) $(CALLBACK_LIB) +else +# Do not build dynamic files on OSE +debug opt valgrind: +endif static_lib: $(NIF_ARCHIVE) @@ -197,12 +202,14 @@ release_spec: opt $(INSTALL_DIR) "$(RELSYSDIR)/priv/obj" $(INSTALL_DIR) "$(RELSYSDIR)/priv/lib" $(INSTALL_DATA) $(NIF_MAKEFILE) "$(RELSYSDIR)/priv/obj" +ifneq ($(findstring ose,$(TARGET)),ose) $(INSTALL_PROGRAM) $(CRYPTO_OBJS) "$(RELSYSDIR)/priv/obj" $(INSTALL_PROGRAM) $(NIF_LIB) "$(RELSYSDIR)/priv/lib" ifeq ($(DYNAMIC_CRYPTO_LIB),yes) $(INSTALL_PROGRAM) $(CALLBACK_OBJS) "$(RELSYSDIR)/priv/obj" $(INSTALL_PROGRAM) $(CALLBACK_LIB) "$(RELSYSDIR)/priv/lib" endif +endif release_docs_spec: diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 2e1a21178f..fca08c4eed 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -254,6 +254,8 @@ static ERL_NIF_TERM ecdsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM static ERL_NIF_TERM ecdsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM ecdh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM rand_seed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + /* helpers */ static void init_algorithms_types(ErlNifEnv*); @@ -381,7 +383,9 @@ static ErlNifFunc nif_funcs[] = { {"ec_key_generate", 1, ec_key_generate}, {"ecdsa_sign_nif", 4, ecdsa_sign_nif}, {"ecdsa_verify_nif", 5, ecdsa_verify_nif}, - {"ecdh_compute_key_nif", 3, ecdh_compute_key_nif} + {"ecdh_compute_key_nif", 3, ecdh_compute_key_nif}, + + {"rand_seed_nif", 1, rand_seed_nif} }; ERL_NIF_INIT(crypto,nif_funcs,load,NULL,upgrade,unload) @@ -460,6 +464,46 @@ static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context*); #define PRINTF_ERR0(FMT) #define PRINTF_ERR1(FMT,A1) +#ifdef __OSE__ + +/* For crypto on OSE we have to initialize the crypto library on each + process that uses it. So since we do not know which scheduler is going + to execute the nif we have to check before each nif call that we have + initialized crypto in that process. */ + +#include "ose.h" +#include "openssl/osessl.h" + +static ErlNifTSDKey crypto_init_key; +static int check_ose_crypto(void); +static int init_ose_crypto(void); + +static int check_ose_crypto() { + int key = (int)enif_tsd_get(crypto_init_key); + if (!key) { + if (!CRYPTO_OSE5_init()) { + PRINTF_ERR0("CRYPTO: Call to CRYPTO_OSE5_init failed"); + return 0; + } + enif_tsd_set(crypto_init_key,1); + } + return 1; +} + +static int init_ose_crypto() { + /* Crypto nif upgrade does not work on OSE so no need to + destroy this key */ + enif_tsd_key_create("crypto_init_key", &crypto_init_key); + return check_ose_crypto(); +} + +#define INIT_OSE_CRYPTO() init_ose_crypto() +#define CHECK_OSE_CRYPTO() check_ose_crypto() +#else +#define INIT_OSE_CRYPTO() 1 +#define CHECK_OSE_CRYPTO() +#endif + #ifdef HAVE_DYNAMIC_CRYPTO_LIB static int change_basename(ErlNifBinary* bin, char* buf, int bufsz, const char* newfile) { @@ -496,6 +540,9 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) ErlNifBinary lib_bin; char lib_buf[1000]; + if (!INIT_OSE_CRYPTO()) + return 0; + /* load_info: {301, <<"/full/path/of/this/library">>} */ if (!enif_get_tuple(env, load_info, &tpl_arity, &tpl_array) || tpl_arity != 2 @@ -728,7 +775,7 @@ static ERL_NIF_TERM md5(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Data) */ ErlNifBinary ibin; ERL_NIF_TERM ret; - + CHECK_OSE_CRYPTO(); if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { return enif_make_badarg(env); } @@ -740,6 +787,7 @@ static ERL_NIF_TERM md5(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) static ERL_NIF_TERM md5_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* () */ ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); MD5_Init((MD5_CTX *) enif_make_new_binary(env, MD5_CTX_LEN, &ret)); return ret; } @@ -748,6 +796,7 @@ static ERL_NIF_TERM md5_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv MD5_CTX* new_ctx; ErlNifBinary ctx_bin, data_bin; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != MD5_CTX_LEN || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { @@ -764,6 +813,7 @@ static ERL_NIF_TERM md5_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ ErlNifBinary ctx_bin; MD5_CTX ctx_clone; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != MD5_CTX_LEN) { return enif_make_badarg(env); } @@ -776,7 +826,7 @@ static ERL_NIF_TERM ripemd160(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ {/* (Data) */ ErlNifBinary ibin; ERL_NIF_TERM ret; - + CHECK_OSE_CRYPTO(); if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { return enif_make_badarg(env); } @@ -788,6 +838,7 @@ static ERL_NIF_TERM ripemd160(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ static ERL_NIF_TERM ripemd160_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* () */ ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); RIPEMD160_Init((RIPEMD160_CTX *) enif_make_new_binary(env, RIPEMD160_CTX_LEN, &ret)); return ret; } @@ -796,6 +847,7 @@ static ERL_NIF_TERM ripemd160_update(ErlNifEnv* env, int argc, const ERL_NIF_TER RIPEMD160_CTX* new_ctx; ErlNifBinary ctx_bin, data_bin; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != RIPEMD160_CTX_LEN || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { @@ -812,6 +864,7 @@ static ERL_NIF_TERM ripemd160_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM ErlNifBinary ctx_bin; RIPEMD160_CTX ctx_clone; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != RIPEMD160_CTX_LEN) { return enif_make_badarg(env); } @@ -825,7 +878,7 @@ static ERL_NIF_TERM sha(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Data) */ ErlNifBinary ibin; ERL_NIF_TERM ret; - + CHECK_OSE_CRYPTO(); if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { return enif_make_badarg(env); } @@ -837,6 +890,7 @@ static ERL_NIF_TERM sha(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) static ERL_NIF_TERM sha_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* () */ ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); SHA1_Init((SHA_CTX *) enif_make_new_binary(env, SHA_CTX_LEN, &ret)); return ret; } @@ -845,6 +899,7 @@ static ERL_NIF_TERM sha_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv SHA_CTX* new_ctx; ErlNifBinary ctx_bin, data_bin; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != SHA_CTX_LEN || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { return enif_make_badarg(env); @@ -860,6 +915,7 @@ static ERL_NIF_TERM sha_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ ErlNifBinary ctx_bin; SHA_CTX ctx_clone; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != SHA_CTX_LEN) { return enif_make_badarg(env); } @@ -873,7 +929,7 @@ static ERL_NIF_TERM sha224_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv #ifdef HAVE_SHA224 ErlNifBinary ibin; ERL_NIF_TERM ret; - + CHECK_OSE_CRYPTO(); if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { return enif_make_badarg(env); } @@ -889,6 +945,7 @@ static ERL_NIF_TERM sha224_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM {/* () */ #ifdef HAVE_SHA224 ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); SHA224_Init((SHA256_CTX *) enif_make_new_binary(env, sizeof(SHA256_CTX), &ret)); return ret; #else @@ -901,6 +958,7 @@ static ERL_NIF_TERM sha224_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TE SHA256_CTX* new_ctx; ErlNifBinary ctx_bin, data_bin; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA256_CTX) || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { return enif_make_badarg(env); @@ -920,6 +978,7 @@ static ERL_NIF_TERM sha224_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER ErlNifBinary ctx_bin; SHA256_CTX ctx_clone; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA256_CTX)) { return enif_make_badarg(env); } @@ -936,7 +995,7 @@ static ERL_NIF_TERM sha256_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv #ifdef HAVE_SHA256 ErlNifBinary ibin; ERL_NIF_TERM ret; - + CHECK_OSE_CRYPTO(); if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { return enif_make_badarg(env); } @@ -952,6 +1011,7 @@ static ERL_NIF_TERM sha256_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM {/* () */ #ifdef HAVE_SHA256 ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); SHA256_Init((SHA256_CTX *) enif_make_new_binary(env, sizeof(SHA256_CTX), &ret)); return ret; #else @@ -964,6 +1024,7 @@ static ERL_NIF_TERM sha256_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TE SHA256_CTX* new_ctx; ErlNifBinary ctx_bin, data_bin; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA256_CTX) || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { return enif_make_badarg(env); @@ -983,6 +1044,7 @@ static ERL_NIF_TERM sha256_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER ErlNifBinary ctx_bin; SHA256_CTX ctx_clone; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA256_CTX)) { return enif_make_badarg(env); } @@ -999,7 +1061,7 @@ static ERL_NIF_TERM sha384_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv #ifdef HAVE_SHA384 ErlNifBinary ibin; ERL_NIF_TERM ret; - + CHECK_OSE_CRYPTO(); if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { return enif_make_badarg(env); } @@ -1015,6 +1077,7 @@ static ERL_NIF_TERM sha384_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM {/* () */ #ifdef HAVE_SHA384 ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); SHA384_Init((SHA512_CTX *) enif_make_new_binary(env, sizeof(SHA512_CTX), &ret)); return ret; #else @@ -1027,6 +1090,7 @@ static ERL_NIF_TERM sha384_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TE SHA512_CTX* new_ctx; ErlNifBinary ctx_bin, data_bin; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA512_CTX) || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { return enif_make_badarg(env); @@ -1046,6 +1110,7 @@ static ERL_NIF_TERM sha384_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER ErlNifBinary ctx_bin; SHA512_CTX ctx_clone; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA512_CTX)) { return enif_make_badarg(env); } @@ -1062,7 +1127,7 @@ static ERL_NIF_TERM sha512_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv #ifdef HAVE_SHA512 ErlNifBinary ibin; ERL_NIF_TERM ret; - + CHECK_OSE_CRYPTO(); if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { return enif_make_badarg(env); } @@ -1090,6 +1155,7 @@ static ERL_NIF_TERM sha512_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TE SHA512_CTX* new_ctx; ErlNifBinary ctx_bin, data_bin; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA512_CTX) || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { return enif_make_badarg(env); @@ -1109,6 +1175,7 @@ static ERL_NIF_TERM sha512_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER ErlNifBinary ctx_bin; SHA512_CTX ctx_clone; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA512_CTX)) { return enif_make_badarg(env); } @@ -1125,7 +1192,7 @@ static ERL_NIF_TERM md4(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Data) */ ErlNifBinary ibin; ERL_NIF_TERM ret; - + CHECK_OSE_CRYPTO(); if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { return enif_make_badarg(env); } @@ -1137,6 +1204,7 @@ static ERL_NIF_TERM md4(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) static ERL_NIF_TERM md4_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* () */ ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); MD4_Init((MD4_CTX *) enif_make_new_binary(env, MD4_CTX_LEN, &ret)); return ret; } @@ -1145,6 +1213,7 @@ static ERL_NIF_TERM md4_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv MD4_CTX* new_ctx; ErlNifBinary ctx_bin, data_bin; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != MD4_CTX_LEN || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { return enif_make_badarg(env); @@ -1160,6 +1229,7 @@ static ERL_NIF_TERM md4_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ ErlNifBinary ctx_bin; MD4_CTX ctx_clone; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != MD4_CTX_LEN) { return enif_make_badarg(env); } @@ -1174,7 +1244,7 @@ static ERL_NIF_TERM md5_mac_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ ErlNifBinary key, data; unsigned mac_sz; ERL_NIF_TERM ret; - + CHECK_OSE_CRYPTO(); if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || !enif_inspect_iolist_as_binary(env, argv[1], &data) || !enif_get_uint(env,argv[2],&mac_sz) || mac_sz > MD5_LEN) { @@ -1192,7 +1262,7 @@ static ERL_NIF_TERM sha_mac_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ ErlNifBinary key, data; unsigned mac_sz; ERL_NIF_TERM ret; - + CHECK_OSE_CRYPTO(); if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || !enif_inspect_iolist_as_binary(env, argv[1], &data) || !enif_get_uint(env,argv[2],&mac_sz) || mac_sz > SHA_LEN) { @@ -1212,7 +1282,7 @@ static ERL_NIF_TERM sha224_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ErlNifBinary key, data; unsigned mac_sz; ERL_NIF_TERM ret; - + CHECK_OSE_CRYPTO(); if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || !enif_inspect_iolist_as_binary(env, argv[1], &data) || !enif_get_uint(env,argv[2],&mac_sz) || mac_sz > SHA224_DIGEST_LENGTH) { @@ -1235,7 +1305,7 @@ static ERL_NIF_TERM sha256_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ErlNifBinary key, data; unsigned mac_sz; ERL_NIF_TERM ret; - + CHECK_OSE_CRYPTO(); if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || !enif_inspect_iolist_as_binary(env, argv[1], &data) || !enif_get_uint(env,argv[2],&mac_sz) || mac_sz > SHA256_DIGEST_LENGTH) { @@ -1258,7 +1328,7 @@ static ERL_NIF_TERM sha384_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ErlNifBinary key, data; unsigned mac_sz; ERL_NIF_TERM ret; - + CHECK_OSE_CRYPTO(); if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || !enif_inspect_iolist_as_binary(env, argv[1], &data) || !enif_get_uint(env,argv[2],&mac_sz) || mac_sz > SHA384_DIGEST_LENGTH) { @@ -1282,7 +1352,7 @@ static ERL_NIF_TERM sha512_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ErlNifBinary key, data; unsigned mac_sz; ERL_NIF_TERM ret; - + CHECK_OSE_CRYPTO(); if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || !enif_inspect_iolist_as_binary(env, argv[1], &data) || !enif_get_uint(env,argv[2],&mac_sz) || mac_sz > SHA512_DIGEST_LENGTH) { @@ -1313,6 +1383,8 @@ static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ struct hmac_context* obj; const EVP_MD *md; + CHECK_OSE_CRYPTO(); + if (argv[0] == atom_sha) md = EVP_sha1(); #ifdef HAVE_SHA224 else if (argv[0] == atom_sha224) md = EVP_sha224(); @@ -1349,6 +1421,8 @@ static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg ErlNifBinary data; struct hmac_context* obj; + CHECK_OSE_CRYPTO(); + if (!enif_get_resource(env, argv[0], hmac_context_rtype, (void**)&obj) || !enif_inspect_iolist_as_binary(env, argv[1], &data)) { return enif_make_badarg(env); @@ -1373,6 +1447,8 @@ static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv unsigned char * mac_bin; unsigned int req_len = 0; unsigned int mac_len; + + CHECK_OSE_CRYPTO(); if (!enif_get_resource(env,argv[0],hmac_context_rtype, (void**)&obj) || (argc == 2 && !enif_get_uint(env, argv[1], &req_len))) { @@ -1407,6 +1483,8 @@ static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a DES_cblock ivec_clone; /* writable copy */ ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 8 || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 8 || !enif_inspect_iolist_as_binary(env, argv[2], &text) @@ -1428,6 +1506,8 @@ static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a DES_cblock ivec_clone; /* writable copy */ ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 8 || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 8 || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { @@ -1446,6 +1526,7 @@ static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a ErlNifBinary key, text; DES_key_schedule schedule; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 8 || !enif_inspect_iolist_as_binary(env, argv[1], &text) || text.size != 8) { return enif_make_badarg(env); @@ -1465,6 +1546,8 @@ static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_T DES_cblock ivec_clone; /* writable copy */ ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); + if (!enif_inspect_iolist_as_binary(env, argv[0], &key1) || key1.size != 8 || !enif_inspect_iolist_as_binary(env, argv[1], &key2) || key2.size != 8 || !enif_inspect_iolist_as_binary(env, argv[2], &key3) || key3.size != 8 @@ -1493,6 +1576,8 @@ static ERL_NIF_TERM des_ede3_cfb_crypt_nif(ErlNifEnv* env, int argc, const ERL_N DES_cblock ivec_clone; /* writable copy */ ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); + if (!enif_inspect_iolist_as_binary(env, argv[0], &key1) || key1.size != 8 || !enif_inspect_iolist_as_binary(env, argv[1], &key2) || key2.size != 8 || !enif_inspect_iolist_as_binary(env, argv[2], &key3) || key3.size != 8 @@ -1523,6 +1608,8 @@ static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TE int new_ivlen = 0; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 16 || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { @@ -1550,6 +1637,8 @@ static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM unsigned int num = 0; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0 || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 @@ -1581,6 +1670,8 @@ static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_N unsigned char * ivec2_buf; unsigned char * ecount2_buf; + CHECK_OSE_CRYPTO(); + if (!enif_get_tuple(env, argv[0], &state_arity, &state_term) || state_arity != 4 || !enif_inspect_iolist_as_binary(env, state_term[0], &key_bin) @@ -1614,6 +1705,7 @@ static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar unsigned bytes; unsigned char* data; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); if (!enif_get_uint(env, argv[0], &bytes)) { return enif_make_badarg(env); } @@ -1627,6 +1719,7 @@ static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NI unsigned bytes; unsigned char* data; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); if (!enif_get_uint(env, argv[0], &bytes)) { return enif_make_badarg(env); } @@ -1644,6 +1737,7 @@ static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar unsigned char* data; unsigned top_mask, bot_mask; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); if (!enif_get_uint(env, argv[0], &bytes) || !enif_get_uint(env, argv[1], &top_mask) || !enif_get_uint(env, argv[2], &bot_mask)) { @@ -1666,6 +1760,9 @@ static ERL_NIF_TERM strong_rand_mpint_nif(ErlNifEnv* env, int argc, const ERL_NI unsigned char* data; unsigned dlen; ERL_NIF_TERM ret; + + CHECK_OSE_CRYPTO(); + if (!enif_get_uint(env, argv[0], &bits) || !enif_get_int(env, argv[1], &top) || !enif_get_int(env, argv[2], &bottom)) { @@ -1733,6 +1830,9 @@ static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER unsigned char* data; unsigned dlen; ERL_NIF_TERM ret; + + CHECK_OSE_CRYPTO(); + if (!get_bn_from_mpint(env, argv[0], &bn_from) || !get_bn_from_mpint(env, argv[1], &bn_rand)) { if (bn_from) BN_free(bn_from); @@ -1764,6 +1864,8 @@ static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg unsigned extra_byte; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); + if (!get_bn_from_bin(env, argv[0], &bn_base) || !get_bn_from_bin(env, argv[1], &bn_exponent) || !get_bn_from_bin(env, argv[2], &bn_modulo) @@ -1806,6 +1908,8 @@ static ERL_NIF_TERM dss_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM DSA *dsa; int i; + CHECK_OSE_CRYPTO(); + if (argv[0] == atom_sha) { if (enif_get_tuple(env, argv[1], &tpl_arity, &tpl_terms)) { if (tpl_arity != 2 || tpl_terms[0] != atom_digest @@ -1973,6 +2077,8 @@ static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM struct digest_type_t* digp = NULL; unsigned char* digest = NULL; + CHECK_OSE_CRYPTO(); + digp = get_digest_type(type); if (!digp) { return enif_make_badarg(env); @@ -2032,6 +2138,8 @@ static ERL_NIF_TERM aes_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a unsigned char* ret_ptr; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) || (key_bin.size != 16 && key_bin.size != 32) || !enif_inspect_binary(env, argv[1], &ivec_bin) @@ -2068,6 +2176,8 @@ static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TE unsigned char* ret_ptr; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) || (key_bin.size != 16 && key_bin.size != 32) || !enif_inspect_binary(env, argv[1], &ivec_bin) @@ -2104,6 +2214,8 @@ static ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) int i; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); + if (!enif_inspect_iolist_as_binary(env,argv[0], &d1) || !enif_inspect_iolist_as_binary(env,argv[1], &d2) || d1.size != d2.size) { @@ -2124,6 +2236,8 @@ static ERL_NIF_TERM rc4_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg RC4_KEY rc4_key; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); + if (!enif_inspect_iolist_as_binary(env,argv[0], &key) || !enif_inspect_iolist_as_binary(env,argv[1], &data)) { return enif_make_badarg(env); @@ -2140,6 +2254,8 @@ static ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg ErlNifBinary key; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); + if (!enif_inspect_iolist_as_binary(env,argv[0], &key)) { return enif_make_badarg(env); } @@ -2155,6 +2271,8 @@ static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_N RC4_KEY* rc4_key; ERL_NIF_TERM new_state, new_data; + CHECK_OSE_CRYPTO(); + if (!enif_inspect_iolist_as_binary(env,argv[0], &state) || state.size != sizeof(RC4_KEY) || !enif_inspect_iolist_as_binary(env,argv[1], &data)) { @@ -2174,6 +2292,8 @@ static ERL_NIF_TERM rc2_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a RC2_KEY rc2_key; ERL_NIF_TERM ret; unsigned char iv_copy[8]; + + CHECK_OSE_CRYPTO(); if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) || (key_bin.size != 5 && key_bin.size != 8 && key_bin.size != 16) @@ -2235,6 +2355,8 @@ static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar struct digest_type_t *digp; unsigned char* digest; + CHECK_OSE_CRYPTO(); + digp = get_digest_type(argv[0]); if (!digp) { return enif_make_badarg(env); @@ -2301,6 +2423,8 @@ static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar DSA* dsa; int i; + CHECK_OSE_CRYPTO(); + if (argv[0] == atom_sha) { if (enif_get_tuple(env, argv[1], &tpl_arity, &tpl_terms)) { if (tpl_arity != 2 || tpl_terms[0] != atom_digest @@ -2383,7 +2507,11 @@ static ERL_NIF_TERM rsa_public_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TER ErlNifBinary data_bin, ret_bin; ERL_NIF_TERM head, tail; int padding, i; - RSA* rsa = RSA_new(); + RSA* rsa; + + CHECK_OSE_CRYPTO(); + + rsa = RSA_new(); if (!enif_inspect_binary(env, argv[0], &data_bin) || !enif_get_list_cell(env, argv[1], &head, &tail) @@ -2429,7 +2557,11 @@ static ERL_NIF_TERM rsa_private_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TE {/* (Data, Key=[E,N,D]|[E,N,D,P1,P2,E1,E2,C], Padding, IsEncrypt) */ ErlNifBinary data_bin, ret_bin; int padding, i; - RSA* rsa = RSA_new(); + RSA* rsa; + + CHECK_OSE_CRYPTO(); + + rsa = RSA_new(); if (!enif_inspect_binary(env, argv[0], &data_bin) || !get_rsa_private_key(env, argv[1], rsa) @@ -2475,6 +2607,8 @@ static ERL_NIF_TERM dh_generate_parameters_nif(ErlNifEnv* env, int argc, const E unsigned char *p_ptr, *g_ptr; ERL_NIF_TERM ret_p, ret_g; + CHECK_OSE_CRYPTO(); + if (!enif_get_int(env, argv[0], &prime_len) || !enif_get_int(env, argv[1], &generator)) { @@ -2498,10 +2632,14 @@ static ERL_NIF_TERM dh_generate_parameters_nif(ErlNifEnv* env, int argc, const E static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* ([PrimeLen, Generator]) */ - DH* dh_params = DH_new(); + DH* dh_params; int i; ERL_NIF_TERM ret, head, tail; + CHECK_OSE_CRYPTO(); + + dh_params = DH_new(); + if (!enif_get_list_cell(env, argv[0], &head, &tail) || !get_bn_from_bin(env, head, &dh_params->p) || !enif_get_list_cell(env, tail, &head, &tail) @@ -2528,12 +2666,16 @@ static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (PrivKey, DHParams=[P,G], Mpint) */ - DH* dh_params = DH_new(); + DH* dh_params; int pub_len, prv_len; unsigned char *pub_ptr, *prv_ptr; ERL_NIF_TERM ret, ret_pub, ret_prv, head, tail; int mpint; /* 0 or 4 */ + CHECK_OSE_CRYPTO(); + + dh_params = DH_new(); + if (!(get_bn_from_bin(env, argv[0], &dh_params->priv_key) || argv[0] == atom_undefined) || !enif_get_list_cell(env, argv[1], &head, &tail) @@ -2570,12 +2712,16 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (OthersPublicKey, MyPrivateKey, DHParams=[P,G]) */ - DH* dh_params = DH_new(); + DH* dh_params; BIGNUM* pubkey = NULL; int i; ErlNifBinary ret_bin; ERL_NIF_TERM ret, head, tail; + CHECK_OSE_CRYPTO(); + + dh_params = DH_new(); + if (!get_bn_from_bin(env, argv[0], &pubkey) || !get_bn_from_bin(env, argv[1], &dh_params->priv_key) || !enif_get_list_cell(env, argv[2], &head, &tail) @@ -2613,6 +2759,8 @@ static ERL_NIF_TERM srp_value_B_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM unsigned dlen; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); + if (!get_bn_from_bin(env, argv[0], &bn_multiplier) || !get_bn_from_bin(env, argv[1], &bn_verifier) || !get_bn_from_bin(env, argv[2], &bn_generator) @@ -2673,6 +2821,8 @@ static ERL_NIF_TERM srp_user_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_ unsigned dlen; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); + if (!get_bn_from_bin(env, argv[0], &bn_a) || !get_bn_from_bin(env, argv[1], &bn_u) || !get_bn_from_bin(env, argv[2], &bn_B) @@ -2752,6 +2902,8 @@ static ERL_NIF_TERM srp_host_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_ unsigned dlen; ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); + if (!get_bn_from_bin(env, argv[0], &bn_verifier) || !get_bn_from_bin(env, argv[1], &bn_b) || !get_bn_from_bin(env, argv[2], &bn_u) @@ -2812,6 +2964,8 @@ static ERL_NIF_TERM bf_cfb64_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM int bf_n = 0; /* blowfish ivec pos */ ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) || !enif_inspect_binary(env, argv[1], &ivec_bin) || ivec_bin.size != 8 @@ -2835,6 +2989,8 @@ static ERL_NIF_TERM bf_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar unsigned char bf_tkey[8]; /* blowfish ivec */ ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) || !enif_inspect_binary(env, argv[1], &ivec_bin) || ivec_bin.size != 8 @@ -2858,6 +3014,8 @@ static ERL_NIF_TERM bf_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar BF_KEY bf_key; /* blowfish key 8 */ ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin) || data_bin.size < 8) { @@ -2878,6 +3036,8 @@ static ERL_NIF_TERM blowfish_ofb64_encrypt(ErlNifEnv* env, int argc, const ERL_N int bf_n = 0; /* blowfish ivec pos */ ERL_NIF_TERM ret; + CHECK_OSE_CRYPTO(); + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) || !enif_inspect_binary(env, argv[1], &ivec_bin) || ivec_bin.size != 8 @@ -3196,6 +3356,8 @@ static ERL_NIF_TERM ec_key_generate(ErlNifEnv* env, int argc, const ERL_NIF_TERM #if defined(HAVE_EC) EC_KEY *key = ec_key_new(env, argv[0]); + CHECK_OSE_CRYPTO(); + if (key && EC_KEY_generate_key(key)) { const EC_GROUP *group; const EC_POINT *public_key; @@ -3233,6 +3395,8 @@ static ERL_NIF_TERM ecdsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM struct digest_type_t *digp; unsigned char* digest; + CHECK_OSE_CRYPTO(); + digp = get_digest_type(argv[0]); if (!digp) { return enif_make_badarg(env); @@ -3300,6 +3464,8 @@ static ERL_NIF_TERM ecdsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER struct digest_type_t* digp = NULL; unsigned char* digest = NULL; + CHECK_OSE_CRYPTO(); + digp = get_digest_type(type); if (!digp) { return enif_make_badarg(env); @@ -3363,6 +3529,8 @@ static ERL_NIF_TERM ecdh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF EC_POINT *my_ecpoint; EC_KEY *other_ecdh = NULL; + CHECK_OSE_CRYPTO(); + if (!get_ec_key(env, argv[1], argv[2], atom_undefined, &key)) return enif_make_badarg(env); @@ -3403,6 +3571,16 @@ out_err: #endif } +static ERL_NIF_TERM rand_seed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifBinary seed_bin; + CHECK_OSE_CRYPTO(); + if (!enif_inspect_binary(env, argv[0], &seed_bin)) + return enif_make_badarg(env); + RAND_seed(seed_bin.data,seed_bin.size); + return atom_ok; +} + /* HMAC */ diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index c95827c371..e88bf01491 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -556,6 +556,21 @@ </desc> </func> + <func> + <name>rand_seed(Seed) -> ok</name> + <fsummary>Set the seed for random bytes generation</fsummary> + <type> + <v>Seed = binary()</v> + </type> + <desc> + <p>Set the seed for PRNG to the given binary. This calls the + RAND_seed function from openssl. Only use this if the system + you are running on does not have enough "randomness" built in. + Normally this is when <seealso marker="#strong_rand_bytes/1"> + stong_rand_bytes/1</seealso> returns <c>low_entropy</c></p> + </desc> + </func> + <func> <name>rand_uniform(Lo, Hi) -> N</name> <fsummary>Generate a random number</fsummary> diff --git a/lib/crypto/doc/src/crypto_app.xml b/lib/crypto/doc/src/crypto_app.xml index 6d26076c04..1d10773401 100644 --- a/lib/crypto/doc/src/crypto_app.xml +++ b/lib/crypto/doc/src/crypto_app.xml @@ -1,11 +1,11 @@ -<?xml version="1.0" encoding="iso-8859-1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE appref SYSTEM "appref.dtd"> <appref> <header> <copyright> <year>1999</year> - <year>2013</year> + <year>2014</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> diff --git a/lib/crypto/src/crypto.app.src b/lib/crypto/src/crypto.app.src index d3084ff336..823a27ee39 100644 --- a/lib/crypto/src/crypto.app.src +++ b/lib/crypto/src/crypto.app.src @@ -23,6 +23,7 @@ crypto_ec_curves]}, {registered, []}, {applications, [kernel, stdlib]}, - {env, []}]}. + {env, []}, + {runtime_dependencies, ["erts-6.0","stdlib-2.0","kernel-3.0"]}]}. diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index d953bd3bca..5bf52fc8a4 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -35,6 +35,7 @@ -export([private_encrypt/4, public_decrypt/4]). -export([dh_generate_parameters/2, dh_check/1]). %% Testing see -export([ec_curve/1, ec_curves/0]). +-export([rand_seed/1]). %% DEPRECATED %% Replaced by hash_* @@ -437,6 +438,11 @@ rand_uniform_pos(_,_) -> rand_uniform_nif(_From,_To) -> ?nif_stub. +-spec rand_seed(binary()) -> ok. +rand_seed(Seed) -> + rand_seed_nif(Seed). + +rand_seed_nif(_Seed) -> ?nif_stub. -spec mod_pow(binary()|integer(), binary()|integer(), binary()|integer()) -> binary() | error. mod_pow(Base, Exponent, Prime) -> @@ -1774,6 +1780,7 @@ mod_exp_nif(_Base,_Exp,_Mod,_bin_hdr) -> ?nif_stub. rand_bytes, strong_rand_bytes, rand_uniform, + rand_seed, mod_pow, exor, %% deprecated diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 8efd962283..63552d2e70 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -105,7 +105,21 @@ groups() -> init_per_suite(Config) -> try crypto:start() of ok -> - Config + try crypto:strong_rand_bytes(1) of + _ -> + Config + catch error:low_entropy -> + %% Make sure we are on OSE, otherwise we want to crash + {ose,_} = os:type(), + + %% This is NOT how you want to seed this, it is just here + %% to make the tests pass. Check your OS manual for how you + %% really want to seed. + {H,M,L} = erlang:now(), + Bin = <<H:24,M:20,L:20>>, + crypto:rand_seed(<< <<Bin/binary>> || _ <- lists:seq(1,16) >>), + Config + end catch _:_ -> {skip, "Crypto did not start"} end. diff --git a/lib/crypto/vsn.mk b/lib/crypto/vsn.mk index 98c071cf87..a2bd6f851a 100644 --- a/lib/crypto/vsn.mk +++ b/lib/crypto/vsn.mk @@ -1 +1 @@ -CRYPTO_VSN = 3.2 +CRYPTO_VSN = 3.3 diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index 1d36aae8ee..0653ce4c00 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -663,12 +663,16 @@ expr({map,Line,Fs0}, Bs0, Ieval) -> expr({map,Line,E0,Fs0}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line,top=false}, {value,E,Bs1} = expr(E0, Bs0, Ieval), - {Fs,Bs2} = eval_map_fields(Fs0, Bs1, Ieval), - Value = lists:foldl(fun ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi); - ({map_exact,K,V}, Mi) -> maps:update(K,V,Mi) end, - E, Fs), - {value,Value,Bs2}; - + case E of + #{} -> + {Fs,Bs2} = eval_map_fields(Fs0, Bs1, Ieval), + Value = lists:foldl(fun ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi); + ({map_exact,K,V}, Mi) -> maps:update(K,V,Mi) + end, E, Fs), + {value,Value,Bs2}; + _ -> + exception(error, {badarg,E}, Bs1, Ieval) + end; %% A block of statements expr({block,Line,Es},Bs,Ieval) -> seq(Es, Bs, Ieval#ieval{line=Line}); diff --git a/lib/debugger/src/dbg_iload.erl b/lib/debugger/src/dbg_iload.erl index 266cf239dd..ad05a7c529 100644 --- a/lib/debugger/src/dbg_iload.erl +++ b/lib/debugger/src/dbg_iload.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% Copyright Ericsson AB 1998-2014. 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 @@ -42,18 +42,21 @@ load_mod(Mod, File, Binary, Db) -> Flag = process_flag(trap_exit, true), - Pid = spawn_link(fun () -> load_mod1(Mod, File, Binary, Db) end), + Pid = spawn_link(load_mod1(Mod, File, Binary, Db)), receive {'EXIT', Pid, What} -> process_flag(trap_exit, Flag), What end. --spec load_mod1(atom(), file:filename(), binary(), ets:tid()) -> no_return(). +-spec load_mod1(atom(), file:filename(), binary(), ets:tid()) -> + fun(() -> no_return()). load_mod1(Mod, File, Binary, Db) -> - store_module(Mod, File, Binary, Db), - exit({ok, Mod}). + fun() -> + store_module(Mod, File, Binary, Db), + exit({ok, Mod}) + end. %%==================================================================== %% Internal functions diff --git a/lib/debugger/src/debugger.app.src b/lib/debugger/src/debugger.app.src index 84fb98c94e..f102385d39 100644 --- a/lib/debugger/src/debugger.app.src +++ b/lib/debugger/src/debugger.app.src @@ -46,4 +46,6 @@ int ]}, {registered, [dbg_iserver, dbg_wx_mon, dbg_wx_winman]}, - {applications, [kernel, stdlib]}]}. + {applications, [kernel, stdlib]}, + {runtime_dependencies, ["wx-1.2","stdlib-2.0","kernel-3.0","erts-6.0", + "compiler-5.0"]}]}. diff --git a/lib/debugger/src/debugger.erl b/lib/debugger/src/debugger.erl index 8a2ac28df5..77fd0acb70 100644 --- a/lib/debugger/src/debugger.erl +++ b/lib/debugger/src/debugger.erl @@ -51,12 +51,6 @@ %% ------------------------------ %% Help window for creating new breakpoints. %% -%% dbg_wx_edit, dbg_wx_edit_win -%% -------------------------------------- -%% Help window for editing terms, used for setting backtrace size -%% (i.e. how many stack frames to display in the attach process window) -%% and changing variable values. -%% %% dbg_wx_interpret, dbg_wx_filedialog_win %% -------------------------------------- %% Help window for selecting modules to interpret. diff --git a/lib/debugger/test/int_eval_SUITE.erl b/lib/debugger/test/int_eval_SUITE.erl index 4ffcf7888e..ecbd68ab40 100644 --- a/lib/debugger/test/int_eval_SUITE.erl +++ b/lib/debugger/test/int_eval_SUITE.erl @@ -28,7 +28,7 @@ bifs_outside_erlang/1, spawning/1, applying/1, catch_and_throw/1, external_call/1, test_module_info/1, apply_interpreted_fun/1, apply_uninterpreted_fun/1, - interpreted_exit/1, otp_8310/1, stacktrace/1]). + interpreted_exit/1, otp_8310/1, stacktrace/1, maps/1]). %% Helpers. -export([applier/3]). @@ -44,7 +44,7 @@ all() -> [bifs_outside_erlang, spawning, applying, catch_and_throw, external_call, test_module_info, apply_interpreted_fun, apply_uninterpreted_fun, - interpreted_exit, otp_8310, stacktrace]. + interpreted_exit, otp_8310, stacktrace, maps]. groups() -> []. @@ -291,6 +291,11 @@ stacktrace(Config) when is_list(Config) -> end, ok. +maps(Config) when is_list(Config) -> + Fun = fun () -> ?IM:empty_map_update([camembert]) end, + {'EXIT',{{badarg,[camembert]},_}} = spawn_eval(Fun), + ok. + do_eval(Config, Mod) -> ?line DataDir = ?config(data_dir, Config), diff --git a/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl b/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl index ab485fd350..e047a33d8c 100644 --- a/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl +++ b/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl @@ -29,6 +29,7 @@ -export([more_catch/1,more_nocatch/1,exit_me/0]). -export([f/1, f_try/1, f_catch/1]). -export([otp_5837/1, otp_8310/0]). +-export([empty_map_update/1]). %% Internal exports. -export([echo/2,my_subtract/2,catch_a_ball/0,throw_a_ball/0]). @@ -241,3 +242,5 @@ otp_8310() -> true = begin (X3 = true) orelse X3, X3 end, false = begin (X4 = false) orelse X4, X4 end, ok. + +empty_map_update(Map) -> Map#{}. diff --git a/lib/debugger/test/map_SUITE.erl b/lib/debugger/test/map_SUITE.erl index e9f4ea1fad..0076193725 100644 --- a/lib/debugger/test/map_SUITE.erl +++ b/lib/debugger/test/map_SUITE.erl @@ -226,8 +226,8 @@ t_update_map_expressions(Config) when is_list(Config) -> #{ "a" :=1, "b":=42, "c":=42 } = (maps:from_list([{"a",1},{"b",2}]))#{ "b" := 42, "c" => 42 }, %% Error cases, FIXME: should be 'badmap'? - {'EXIT',{badarg,_}} = (catch (id(<<>>))#{ a := 42, b => 2 }), - {'EXIT',{badarg,_}} = (catch (id([]))#{ a := 42, b => 2 }), + {'EXIT',{{badarg,<<>>},_}} = (catch (id(<<>>))#{ a := 42, b => 2 }), + {'EXIT',{{badarg,[]},_}} = (catch (id([]))#{ a := 42, b => 2 }), ok. @@ -244,7 +244,7 @@ t_update_assoc(Config) when is_list(Config) -> %% Errors cases. BadMap = id(badmap), - {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}), + {'EXIT',{{badarg,BadMap},_}} = (catch BadMap#{nonexisting=>val}), ok. @@ -790,16 +790,16 @@ t_map_encode_decode(Config) when is_list(Config) -> %% literally #{ b=>2, a=>1 } in the internal order #{ a:=1, b:=2 } = - erlang:binary_to_term(<<131,116,0,0,0,2,100,0,1,98,100,0,1,97,97,2,97,1>>), + erlang:binary_to_term(<<131,116,0,0,0,2,100,0,1,98,97,2,100,0,1,97,97,1>>), %% literally #{ "hi" => "value", a=>33, b=>55 } in the internal order #{ a:=33, b:=55, "hi" := "value"} = erlang:binary_to_term(<<131,116,0,0,0,3, 107,0,2,104,105, % "hi" :: list() - 100,0,1,97, % a :: atom() - 100,0,1,98, % b :: atom() 107,0,5,118,97,108,117,101, % "value" :: list() + 100,0,1,97, % a :: atom() 97,33, % 33 :: integer() + 100,0,1,98, % b :: atom() 97,55 % 55 :: integer() >>), @@ -829,7 +829,8 @@ map_encode_decode_and_match([{K,V}|Pairs], EncodedPairs, M0) -> B0 = erlang:term_to_binary(M1), Ls = lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, [{K, erlang:term_to_binary(K), erlang:term_to_binary(V)}|EncodedPairs]), %% sort Ks and Vs according to term spec, then match it - ok = match_encoded_map(B0, length(Ls), [Kbin||{_,Kbin,_}<-Ls] ++ [Vbin||{_,_,Vbin}<-Ls]), + KVbins = lists:foldr(fun({_,Kbin,Vbin}, Acc) -> [Kbin,Vbin | Acc] end, [], Ls), + ok = match_encoded_map(B0, length(Ls), KVbins), %% decode and match it M1 = erlang:binary_to_term(B0), map_encode_decode_and_match(Pairs,Ls,M1); diff --git a/lib/debugger/vsn.mk b/lib/debugger/vsn.mk index a245e26a55..cd107599e9 100644 --- a/lib/debugger/vsn.mk +++ b/lib/debugger/vsn.mk @@ -1 +1 @@ -DEBUGGER_VSN = 3.2.12 +DEBUGGER_VSN = 4.0 diff --git a/lib/dialyzer/src/dialyzer.app.src b/lib/dialyzer/src/dialyzer.app.src index 0d048b607e..1756800c4f 100644 --- a/lib/dialyzer/src/dialyzer.app.src +++ b/lib/dialyzer/src/dialyzer.app.src @@ -44,4 +44,7 @@ dialyzer_worker]}, {registered, []}, {applications, [compiler, gs, hipe, kernel, stdlib, wx]}, - {env, []}]}. + {env, []}, + {runtime_dependencies, ["wx-1.2","syntax_tools-1.6.14","stdlib-2.0", + "kernel-3.0","hipe-3.10.3","erts-6.0", + "compiler-5.0"]}]}. diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl index bb7e39dfda..cec94a49fd 100644 --- a/lib/dialyzer/src/dialyzer.erl +++ b/lib/dialyzer/src/dialyzer.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2013. All Rights Reserved. +%% Copyright Ericsson AB 2006-2014. 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 @@ -172,7 +172,7 @@ run(Opts) -> end, case dialyzer_cl:start(OptsRecord) of {?RET_DISCREPANCIES, Warnings} -> Warnings; - {?RET_NOTHING_SUSPICIOUS, []} -> [] + {?RET_NOTHING_SUSPICIOUS, _} -> [] end catch throw:{dialyzer_error, ErrorMsg} -> @@ -447,7 +447,6 @@ message_to_string({opaque_size, [SizeType, Size]}) -> message_to_string({opaque_call, [M, F, Args, Culprit, OpaqueType]}) -> io_lib:format("The call ~s:~s~s breaks the opaqueness of the term ~s :: ~s\n", [M, F, Args, Culprit, OpaqueType]); - %%----- Warnings for concurrency errors -------------------- message_to_string({race_condition, [M, F, Args, Reason]}) -> io_lib:format("The call ~w:~w~s ~s\n", [M, F, Args, Reason]); @@ -474,7 +473,14 @@ message_to_string({callback_missing, [B, F, A]}) -> io_lib:format("Undefined callback function ~w/~w (behaviour '~w')\n", [F, A, B]); message_to_string({callback_info_missing, [B]}) -> - io_lib:format("Callback info about the ~w behaviour is not available\n", [B]). + io_lib:format("Callback info about the ~w behaviour is not available\n", [B]); +%%----- Warnings for unknown functions, types, and behaviours ------------- +message_to_string({unknown_type, {M, F, A}}) -> + io_lib:format("Unknown type ~w:~w/~w", [M, F, A]); +message_to_string({unknown_function, {M, F, A}}) -> + io_lib:format("Unknown function ~w:~w/~w", [M, F, A]); +message_to_string({unknown_behaviour, B}) -> + io_lib:format("Unknown behaviour ~w", [B]). %%----------------------------------------------------------------------------- %% Auxiliary functions below @@ -557,4 +563,4 @@ form_position_string(ArgNs) -> ordinal(1) -> "1st"; ordinal(2) -> "2nd"; ordinal(3) -> "3rd"; -ordinal(N) when is_integer(N) -> io_lib:format("~wth",[N]). +ordinal(N) when is_integer(N) -> io_lib:format("~wth", [N]). diff --git a/lib/dialyzer/src/dialyzer.hrl b/lib/dialyzer/src/dialyzer.hrl index 105a174e31..9a25f86512 100644 --- a/lib/dialyzer/src/dialyzer.hrl +++ b/lib/dialyzer/src/dialyzer.hrl @@ -2,7 +2,7 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2006-2012. All Rights Reserved. +%%% Copyright Ericsson AB 2006-2014. 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 @@ -58,6 +58,7 @@ -define(WARN_RACE_CONDITION, warn_race_condition). -define(WARN_BEHAVIOUR, warn_behaviour). -define(WARN_UNDEFINED_CALLBACK, warn_undefined_callbacks). +-define(WARN_UNKNOWN, warn_unknown). %% %% The following type has double role: @@ -73,7 +74,7 @@ | ?WARN_CONTRACT_SUPERTYPE | ?WARN_CALLGRAPH | ?WARN_UNMATCHED_RETURN | ?WARN_RACE_CONDITION | ?WARN_BEHAVIOUR | ?WARN_CONTRACT_RANGE - | ?WARN_UNDEFINED_CALLBACK. + | ?WARN_UNDEFINED_CALLBACK | ?WARN_UNKNOWN. %% %% This is the representation of each warning as they will be returned @@ -88,12 +89,6 @@ -type dial_error() :: any(). %% XXX: underspecified %%-------------------------------------------------------------------- -%% THIS TYPE SHOULD ONE DAY DISAPPEAR -- IT DOES NOT BELONG HERE -%%-------------------------------------------------------------------- - --type ordset(T) :: [T] . %% XXX: temporarily - -%%-------------------------------------------------------------------- %% Basic types used either in the record definitions below or in other %% parts of the application %%-------------------------------------------------------------------- @@ -143,7 +138,7 @@ init_plts = [] :: [file:filename()], include_dirs = [] :: [file:filename()], output_plt = none :: 'none' | file:filename(), - legal_warnings = ordsets:new() :: ordset(dial_warn_tag()), + legal_warnings = ordsets:new() :: ordsets:ordset(dial_warn_tag()), report_mode = normal :: rep_mode(), erlang_mode = false :: boolean(), use_contracts = true :: boolean(), @@ -167,4 +162,4 @@ dialyzer_timing:end_stamp(Server), Var end). --define(timing(Server, Msg, Expr),?timing(Server, Msg, _T, Expr)). +-define(timing(Server, Msg, Expr), ?timing(Server, Msg, _T, Expr)). diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index 3e68d64d53..e013d39a0e 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -504,7 +504,9 @@ hipe_compile(Files, #options{erlang_mode = ErlangMode} = Options) -> _ -> Mods = [lists, dict, digraph, digraph_utils, ets, gb_sets, gb_trees, ordsets, sets, sofs, - cerl, cerl_trees, erl_types, erl_bif_types, + %cerl, % uses maps instructions + %erl_types, % uses maps instructions + cerl_trees, erl_bif_types, dialyzer_analysis_callgraph, dialyzer, dialyzer_behaviours, dialyzer_codeserver, dialyzer_contracts, dialyzer_coordinator, dialyzer_dataflow, dialyzer_dep, @@ -533,7 +535,7 @@ hc(Mod) -> case code:is_module_native(Mod) of true -> ok; false -> - %% io:format(" ~s", [Mod]), + %% io:format(" ~w", [Mod]), {ok, Mod} = hipe:c(Mod), ok end. @@ -656,7 +658,8 @@ return_value(State = #cl_state{erlang_mode = ErlangMode, mod_deps = ModDeps, output_plt = OutputPlt, plt_info = PltInfo, - stored_warnings = StoredWarnings}, + stored_warnings = StoredWarnings, + legal_warnings = LegalWarnings}, Plt) -> case OutputPlt =:= none of true -> ok; @@ -676,16 +679,33 @@ return_value(State = #cl_state{erlang_mode = ErlangMode, maybe_close_output_file(State), {RetValue, []}; true -> - {RetValue, process_warnings(StoredWarnings)} + Unknown = + case ordsets:is_element(?WARN_UNKNOWN, LegalWarnings) of + true -> + unknown_functions(State) ++ + unknown_types(State) ++ + unknown_behaviours(State); + false -> [] + end, + UnknownWarnings = + [{?WARN_UNKNOWN, {_Filename = "", _Line = 0}, W} || W <- Unknown], + AllWarnings = + UnknownWarnings ++ process_warnings(StoredWarnings), + {RetValue, AllWarnings} end. +unknown_functions(#cl_state{external_calls = Calls}) -> + [{unknown_function, MFA} || MFA <- Calls]. + print_ext_calls(#cl_state{report_mode = quiet}) -> ok; print_ext_calls(#cl_state{output = Output, external_calls = Calls, stored_warnings = Warnings, - output_format = Format}) -> - case Calls =:= [] of + output_format = Format, + legal_warnings = LegalWarnings}) -> + case not ordsets:is_element(?WARN_UNKNOWN, LegalWarnings) + orelse Calls =:= [] of true -> ok; false -> case Warnings =:= [] of @@ -708,14 +728,19 @@ do_print_ext_calls(Output, [{M,F,A}|T], Before) -> do_print_ext_calls(_, [], _) -> ok. +unknown_types(#cl_state{external_types = Types}) -> + [{unknown_type, MFA} || MFA <- Types]. + print_ext_types(#cl_state{report_mode = quiet}) -> ok; print_ext_types(#cl_state{output = Output, external_calls = Calls, external_types = Types, stored_warnings = Warnings, - output_format = Format}) -> - case Types =:= [] of + output_format = Format, + legal_warnings = LegalWarnings}) -> + case not ordsets:is_element(?WARN_UNKNOWN, LegalWarnings) + orelse Types =:= [] of true -> ok; false -> case Warnings =:= [] andalso Calls =:= [] of @@ -738,6 +763,15 @@ do_print_ext_types(Output, [{M,F,A}|T], Before) -> do_print_ext_types(_, [], _) -> ok. +unknown_behaviours(#cl_state{unknown_behaviours = DupBehaviours, + legal_warnings = LegalWarnings}) -> + case ordsets:is_element(?WARN_BEHAVIOUR, LegalWarnings) of + false -> []; + true -> + Behaviours = lists:usort(DupBehaviours), + [{unknown_behaviour, B} || B <- Behaviours] + end. + %%print_unknown_behaviours(#cl_state{report_mode = quiet}) -> %% ok; print_unknown_behaviours(#cl_state{output = Output, diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 46eaeaa303..283031eb9a 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -20,6 +20,8 @@ -module(dialyzer_contracts). +-compile(export_all). + -export([check_contract/2, check_contracts/4, contracts_without_fun/3, @@ -439,7 +441,8 @@ contract_from_form([], _RecDict, _FileLine, TypeAcc, FormAcc) -> {lists:reverse(TypeAcc), lists:reverse(FormAcc)}. process_constraints(Constrs, RecDict, ExpTypes, AllRecords) -> - Init = initialize_constraints(Constrs, RecDict, ExpTypes, AllRecords), + Init0 = initialize_constraints(Constrs, RecDict, ExpTypes, AllRecords), + Init = remove_cycles(Init0), constraints_fixpoint(Init, RecDict, ExpTypes, AllRecords). initialize_constraints(Constrs, RecDict, ExpTypes, AllRecords) -> @@ -479,12 +482,9 @@ constraints_fixpoint(OldVarDict, Constrs, RecDict, ExpTypes, AllRecords) -> constraints_fixpoint(NewVarDict, Constrs, RecDict, ExpTypes, AllRecords) end. --define(TYPE_LIMIT, 4). - final_form(Form, RecDict, ExpTypes, AllRecords, VarDict) -> T1 = erl_types:t_from_form(Form, RecDict, VarDict), - T2 = erl_types:t_solve_remote(T1, ExpTypes, AllRecords), - erl_types:t_limit(T2, ?TYPE_LIMIT). + erl_types:t_solve_remote(T1, ExpTypes, AllRecords). constraints_to_dict(Constrs, RecDict, ExpTypes, AllRecords, VarDict) -> Subtypes = @@ -499,6 +499,74 @@ constraints_to_subs([C|Rest], RecDict, ExpTypes, AllRecords, VarDict, Acc) -> NewAcc = [{subtype, T1, T2}|Acc], constraints_to_subs(Rest, RecDict, ExpTypes, AllRecords, VarDict, NewAcc). +%% Replaces variables with '_' when necessary to break up cycles among +%% the constraints. + +remove_cycles(Constrs0) -> + Uses = find_uses(Constrs0), + G = digraph:new(), + Vs0 = [V || {V, _} <- Uses] ++ [V || {_, V} <- Uses], + Vs = lists:usort(Vs0), + lists:foreach(fun(V) -> _ = digraph:add_vertex(G, V) end, Vs), + lists:foreach(fun({From, To}) -> + _ = digraph:add_edge(G, {From, To}, From, To, []) + end, Uses), + ok = remove_cycles(G, Vs), + ToRemove = ordsets:subtract(ordsets:from_list(Uses), + ordsets:from_list(digraph:edges(G))), + Constrs = remove_uses(ToRemove, Constrs0), + digraph:delete(G), + Constrs. + +find_uses([{Var, Form}|Constrs]) -> + UsedVars = form_vars(Form, []), + VarName = erl_types:t_var_name(Var), + [{VarName, UsedVar} || UsedVar <- UsedVars] ++ find_uses(Constrs); +find_uses([]) -> + []. + +form_vars({var, _, '_'}, Vs) -> Vs; +form_vars({var, _, V}, Vs) -> [V|Vs]; +form_vars(T, Vs) when is_tuple(T) -> + form_vars(tuple_to_list(T), Vs); +form_vars([E|Es], Vs) -> + form_vars(Es, form_vars(E, Vs)); +form_vars(_, Vs) -> Vs. + +remove_cycles(G, Vs) -> + NumberOfEdges = digraph:no_edges(G), + lists:foreach(fun(V) -> + case digraph:get_cycle(G, V) of + false -> true; + [V] -> digraph:del_edge(G, {V, V}); + [V, V1|_] -> digraph:del_edge(G, {V, V1}) + end + end, Vs), + case digraph:no_edges(G) =:= NumberOfEdges of + true -> ok; + false -> remove_cycles(G, Vs) + end. + +remove_uses([], Constrs) -> Constrs; +remove_uses([{Var, Use}|ToRemove], Constrs0) -> + Constrs = remove_uses(Var, Use, Constrs0), + remove_uses(ToRemove, Constrs). + +remove_uses(_Var, _Use, []) -> []; +remove_uses(Var, Use, [Constr|Constrs]) -> + {V, Form} = Constr, + case erl_types:t_var_name(V) =:= Var of + true -> [{V, remove_use(Form, Use)}|Constrs]; + false -> [Constr|remove_uses(Var, Use, Constrs)] + end. + +remove_use({var, L, V}, V) -> {var, L, '_'}; +remove_use(T, V) when is_tuple(T) -> + list_to_tuple(remove_use(tuple_to_list(T), V)); +remove_use([E|Es], V) -> + [remove_use(E, V)|remove_use(Es, V)]; +remove_use(T, _V) -> T. + %% Gets the most general domain of a list of domains of all %% the overloaded contracts diff --git a/lib/dialyzer/src/dialyzer_dep.erl b/lib/dialyzer/src/dialyzer_dep.erl index f1ac41ff04..e3ece144c9 100644 --- a/lib/dialyzer/src/dialyzer_dep.erl +++ b/lib/dialyzer/src/dialyzer_dep.erl @@ -55,11 +55,11 @@ %% %% Letrecs = a dict mapping var labels to their recursive definition. %% top-level letrecs are not included as they are handled -%% separatedly. +%% separately. %% -spec analyze(cerl:c_module()) -> - {dict:dict(), ordset('external' | label()), dict:dict(), dict:dict()}. + {dict:dict(), ordsets:ordset('external' | label()), dict:dict(), dict:dict()}. analyze(Tree) -> %% io:format("Handling ~w\n", [cerl:atom_val(cerl:module_name(Tree))]), diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl index 08f31c1e13..7070fa240d 100644 --- a/lib/dialyzer/src/dialyzer_gui_wx.erl +++ b/lib/dialyzer/src/dialyzer_gui_wx.erl @@ -61,7 +61,7 @@ init_plt :: dialyzer_plt:plt(), dir_entry :: wx:wx_object(), file_box :: wx:wx_object(), - files_to_analyze :: ordset(string()), + files_to_analyze :: ordsets:ordset(string()), gui :: wx:wx_object(), log :: wx:wx_object(), menu :: menu(), diff --git a/lib/dialyzer/src/dialyzer_options.erl b/lib/dialyzer/src/dialyzer_options.erl index 06672e595f..a92b8b1958 100644 --- a/lib/dialyzer/src/dialyzer_options.erl +++ b/lib/dialyzer/src/dialyzer_options.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2012. All Rights Reserved. +%% Copyright Ericsson AB 2006-2014. 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 @@ -51,7 +51,8 @@ build(Opts) -> ?WARN_CONTRACT_TYPES, ?WARN_CONTRACT_SYNTAX, ?WARN_BEHAVIOUR, - ?WARN_UNDEFINED_CALLBACK], + ?WARN_UNDEFINED_CALLBACK, + ?WARN_UNKNOWN], DefaultWarns1 = ordsets:from_list(DefaultWarns), InitPlt = dialyzer_plt:get_default_plt(), DefaultOpts = #options{}, @@ -310,6 +311,8 @@ build_warnings([Opt|Opts], Warnings) -> ordsets:add_element(?WARN_CONTRACT_SUBTYPE, Warnings); underspecs -> ordsets:add_element(?WARN_CONTRACT_SUPERTYPE, Warnings); + no_unknown -> + ordsets:del_element(?WARN_UNKNOWN, Warnings); OtherAtom -> bad_option("Unknown dialyzer warning option", OtherAtom) end, diff --git a/lib/dialyzer/src/dialyzer_races.erl b/lib/dialyzer/src/dialyzer_races.erl index 48fcde8014..b1f849b16f 100644 --- a/lib/dialyzer/src/dialyzer_races.erl +++ b/lib/dialyzer/src/dialyzer_races.erl @@ -85,6 +85,12 @@ -type race_tag() :: 'whereis_register' | 'whereis_unregister' | 'ets_lookup_insert' | 'mnesia_dirty_read_write'. +%% The following type is similar to the dial_warning() type but has a +%% tag which is local to this module and is not propagated to outside +-type dial_race_warning() :: {race_warn_tag(), file_line(), {atom(), [term()]}}. +-type race_warn_tag() :: ?WARN_WHEREIS_REGISTER | ?WARN_WHEREIS_UNREGISTER + | ?WARN_ETS_LOOKUP_INSERT | ?WARN_MNESIA_DIRTY_READ_WRITE. + -record(beg_clause, {arg :: var_to_map1(), pats :: var_to_map1(), guard :: cerl:cerl()}). @@ -103,7 +109,7 @@ args :: args(), arg_types :: [erl_types:erl_type()], vars :: [core_vars()], - state :: _, %% XXX: recursive + state :: dialyzer_dataflow:state(), file_line :: file_line(), var_map :: dict:dict()}). -record(fun_call, {caller :: dialyzer_callgraph:mfa_or_funlbl(), @@ -141,7 +147,7 @@ race_tags = [] :: [#race_fun{}], %% true for fun types and warning mode race_analysis = false :: boolean(), - race_warnings = [] :: [dial_warning()]}). + race_warnings = [] :: [dial_race_warning()]}). %%% =========================================================================== %%% @@ -1763,7 +1769,7 @@ ets_list_args(MaybeList) -> catch _:_ -> [?no_label] end; false -> [ets_tuple_args(MaybeList)] - end. + end. ets_list_argtypes(ListStr) -> ListStr1 = string:strip(ListStr, left, $[), diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 95a138dd73..21183e3459 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -450,11 +450,10 @@ flat_format(Fmt, Lst) -> %% Created : 5 March 2007 %%------------------------------------------------------------------- +-spec pp_hook() -> fun((cerl:cerl(), _, _) -> term()). pp_hook() -> fun pp_hook/3. --spec pp_hook() -> fun((cerl:cerl(), _, _) -> term()). - pp_hook(Node, Ctxt, Cont) -> case cerl:type(Node) of binary -> diff --git a/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options b/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options index 3ff26b87db..44a65f6e90 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options @@ -1 +1 @@ -{dialyzer_options, [{warnings, [no_unused, no_return]}]}. +{dialyzer_options, [{warnings, [no_unused, no_return, no_unknown]}]}. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/modules/opaque_erl_scan.erl b/lib/dialyzer/test/opaque_SUITE_data/src/modules/opaque_erl_scan.erl index 9ecd4f92a1..24d0793a7c 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/src/modules/opaque_erl_scan.erl +++ b/lib/dialyzer/test/opaque_SUITE_data/src/modules/opaque_erl_scan.erl @@ -1,4 +1,4 @@ -%% -*- coding: utf-8 -*- +%% %% %% %CopyrightBegin% %% diff --git a/lib/dialyzer/test/options1_SUITE_data/dialyzer_options b/lib/dialyzer/test/options1_SUITE_data/dialyzer_options index c612e77d3e..65d233ac0d 100644 --- a/lib/dialyzer/test/options1_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/options1_SUITE_data/dialyzer_options @@ -1,2 +1,2 @@ -{dialyzer_options, [{include_dirs, ["my_include"]}, {defines, [{'COMPILER_VSN', 42}]}, {warnings, [no_improper_lists]}]}. +{dialyzer_options, [{include_dirs, ["my_include"]}, {defines, [{'COMPILER_VSN', 42}]}, {warnings, [no_improper_lists, no_unknown]}]}. {time_limit, 30}. diff --git a/lib/dialyzer/test/r9c_SUITE_data/dialyzer_options b/lib/dialyzer/test/r9c_SUITE_data/dialyzer_options index e00e23bb66..ba0e6b1ad7 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/r9c_SUITE_data/dialyzer_options @@ -1,2 +1,2 @@ -{dialyzer_options, [{defines, [{vsn, 42}]}]}. +{dialyzer_options, [{defines, [{vsn, 42}]}, {warnings, [no_unknown]}]}. {time_limit, 20}. diff --git a/lib/dialyzer/test/race_SUITE_data/dialyzer_options b/lib/dialyzer/test/race_SUITE_data/dialyzer_options index 44e1720715..6992fc6c40 100644 --- a/lib/dialyzer/test/race_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/race_SUITE_data/dialyzer_options @@ -1 +1 @@ -{dialyzer_options, [{warnings, [race_conditions]}]}. +{dialyzer_options, [{warnings, [race_conditions, no_unknown]}]}. diff --git a/lib/dialyzer/test/small_SUITE_data/dialyzer_options b/lib/dialyzer/test/small_SUITE_data/dialyzer_options index 50991c9bc5..0d91699e4d 100644 --- a/lib/dialyzer/test/small_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/small_SUITE_data/dialyzer_options @@ -1 +1 @@ -{dialyzer_options, []}. +{dialyzer_options, [{warnings, [no_unknown]}]}. diff --git a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes index bfa33cd296..fbdd182358 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes +++ b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes @@ -1,27 +1,28 @@ contracts_with_subtypes.erl:106: The call contracts_with_subtypes:rec_arg({'a','b'}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) contracts_with_subtypes.erl:107: The call contracts_with_subtypes:rec_arg({'b','a'}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) -contracts_with_subtypes.erl:108: The call contracts_with_subtypes:rec_arg({'a',{'b','a'}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) contracts_with_subtypes.erl:109: The call contracts_with_subtypes:rec_arg({'b',{'a','b'}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) -contracts_with_subtypes.erl:110: The call contracts_with_subtypes:rec_arg({'a',{'b',{'a','b'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) -contracts_with_subtypes.erl:111: The call contracts_with_subtypes:rec_arg({'b',{'a',{'b','a'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) -contracts_with_subtypes.erl:142: The pattern 1 can never match the type string() -contracts_with_subtypes.erl:145: The pattern 'alpha' can never match the type {'ok',_} | {'ok',_,string()} -contracts_with_subtypes.erl:147: The pattern 42 can never match the type {'ok',_} | {'ok',_,string()} -contracts_with_subtypes.erl:163: The pattern 'alpha' can never match the type {'ok',_} -contracts_with_subtypes.erl:165: The pattern 42 can never match the type {'ok',_} -contracts_with_subtypes.erl:183: The pattern 'alpha' can never match the type {'ok',_} -contracts_with_subtypes.erl:185: The pattern 42 can never match the type {'ok',_} -contracts_with_subtypes.erl:202: The pattern 1 can never match the type string() -contracts_with_subtypes.erl:205: The pattern {'ok', _} can never match the type {'ok',_,string()} -contracts_with_subtypes.erl:206: The pattern 'alpha' can never match the type {'ok',_,string()} -contracts_with_subtypes.erl:207: The pattern {'ok', 42} can never match the type {'ok',_,string()} -contracts_with_subtypes.erl:208: The pattern 42 can never match the type {'ok',_,string()} -contracts_with_subtypes.erl:234: Function flat_ets_new_t/0 has no local return -contracts_with_subtypes.erl:235: The call contracts_with_subtypes:flat_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when is_subtype(Name,atom()), is_subtype(Options,[Option]), is_subtype(Option,'set' | 'ordered_set' | 'bag' | 'duplicate_bag' | 'public' | 'protected' | 'private' | 'named_table' | {'keypos',integer()} | {'heir',pid(),term()} | {'heir','none'} | {'write_concurrency',boolean()} | {'read_concurrency',boolean()} | 'compressed') +contracts_with_subtypes.erl:135: The call contracts_with_subtypes:rec2({'a','b'}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) +contracts_with_subtypes.erl:136: The call contracts_with_subtypes:rec2({'b','a'}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) +contracts_with_subtypes.erl:137: The call contracts_with_subtypes:rec2({'a',{'b','a'}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) +contracts_with_subtypes.erl:138: The call contracts_with_subtypes:rec2({'b',{'a','b'}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) +contracts_with_subtypes.erl:171: The pattern 1 can never match the type string() +contracts_with_subtypes.erl:174: The pattern 'alpha' can never match the type {'ok',_} | {'ok',_,string()} +contracts_with_subtypes.erl:176: The pattern 42 can never match the type {'ok',_} | {'ok',_,string()} +contracts_with_subtypes.erl:192: The pattern 'alpha' can never match the type {'ok',_} +contracts_with_subtypes.erl:194: The pattern 42 can never match the type {'ok',_} +contracts_with_subtypes.erl:212: The pattern 'alpha' can never match the type {'ok',_} +contracts_with_subtypes.erl:214: The pattern 42 can never match the type {'ok',_} +contracts_with_subtypes.erl:231: The pattern 1 can never match the type string() +contracts_with_subtypes.erl:234: The pattern {'ok', _} can never match the type {'ok',_,string()} +contracts_with_subtypes.erl:235: The pattern 'alpha' can never match the type {'ok',_,string()} +contracts_with_subtypes.erl:236: The pattern {'ok', 42} can never match the type {'ok',_,string()} +contracts_with_subtypes.erl:237: The pattern 42 can never match the type {'ok',_,string()} contracts_with_subtypes.erl:23: Invalid type specification for function contracts_with_subtypes:extract2/0. The success typing is () -> 'something' -contracts_with_subtypes.erl:261: Function factored_ets_new_t/0 has no local return -contracts_with_subtypes.erl:262: The call contracts_with_subtypes:factored_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when is_subtype(Name,atom()), is_subtype(Options,[Option]), is_subtype(Option,Type | Access | 'named_table' | {'keypos',Pos} | {'heir',Pid::pid(),HeirData} | {'heir','none'} | Tweaks), is_subtype(Type,type()), is_subtype(Access,access()), is_subtype(Tweaks,{'write_concurrency',boolean()} | {'read_concurrency',boolean()} | 'compressed'), is_subtype(Pos,pos_integer()), is_subtype(HeirData,term()) +contracts_with_subtypes.erl:263: Function flat_ets_new_t/0 has no local return +contracts_with_subtypes.erl:264: The call contracts_with_subtypes:flat_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when is_subtype(Name,atom()), is_subtype(Options,[Option]), is_subtype(Option,'set' | 'ordered_set' | 'bag' | 'duplicate_bag' | 'public' | 'protected' | 'private' | 'named_table' | {'keypos',integer()} | {'heir',pid(),term()} | {'heir','none'} | {'write_concurrency',boolean()} | {'read_concurrency',boolean()} | 'compressed') +contracts_with_subtypes.erl:290: Function factored_ets_new_t/0 has no local return +contracts_with_subtypes.erl:291: The call contracts_with_subtypes:factored_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when is_subtype(Name,atom()), is_subtype(Options,[Option]), is_subtype(Option,Type | Access | 'named_table' | {'keypos',Pos} | {'heir',Pid::pid(),HeirData} | {'heir','none'} | Tweaks), is_subtype(Type,type()), is_subtype(Access,access()), is_subtype(Tweaks,{'write_concurrency',boolean()} | {'read_concurrency',boolean()} | 'compressed'), is_subtype(Pos,pos_integer()), is_subtype(HeirData,term()) contracts_with_subtypes.erl:77: The call contracts_with_subtypes:foo1(5) breaks the contract (Arg1) -> Res when is_subtype(Arg1,atom()), is_subtype(Res,atom()) contracts_with_subtypes.erl:78: The call contracts_with_subtypes:foo2(5) breaks the contract (Arg1) -> Res when is_subtype(Arg1,Arg2), is_subtype(Arg2,atom()), is_subtype(Res,atom()) contracts_with_subtypes.erl:79: The call contracts_with_subtypes:foo3(5) breaks the contract (Arg1) -> Res when is_subtype(Arg2,atom()), is_subtype(Arg1,Arg2), is_subtype(Res,atom()) diff --git a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes2 b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes2 new file mode 100644 index 0000000000..9f5433a13d --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes2 @@ -0,0 +1,3 @@ + +contracts_with_subtypes2.erl:18: Function t/0 has no local return +contracts_with_subtypes2.erl:19: The call contracts_with_subtypes2:t({'a',{'b',{'c',{'d',{'e',{'g',3}}}}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A}), is_subtype(A,{'b',B}), is_subtype(B,{'c',C}), is_subtype(C,{'d',D}), is_subtype(D,{'e',E}), is_subtype(E,{'f',_}) diff --git a/lib/dialyzer/test/small_SUITE_data/results/invalid_spec_2 b/lib/dialyzer/test/small_SUITE_data/results/invalid_spec_2 new file mode 100644 index 0000000000..4565112ea0 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/invalid_spec_2 @@ -0,0 +1,2 @@ + +scala_user.erl:5: Invalid type specification for function scala_user:is_list/2. The success typing is (maybe_improper_list() | tuple(),_) -> boolean() diff --git a/lib/dialyzer/test/small_SUITE_data/src/contracts_with_subtypes.erl b/lib/dialyzer/test/small_SUITE_data/src/contracts_with_subtypes.erl index d72138d509..d7dfd9752e 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/contracts_with_subtypes.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/contracts_with_subtypes.erl @@ -103,15 +103,44 @@ c(babb) -> rec_arg({b, {a, {b, b}}}); c(ababb) -> rec_arg({a, {b, {a, {b, b}}}}); c(babaa) -> rec_arg({b, {a, {b, {a, a}}}}). -w(ab) -> rec_arg({a, b}); -w(ba) -> rec_arg({b, a}); -w(aba) -> rec_arg({a, {b, a}}); -w(bab) -> rec_arg({b, {a, b}}); -w(abab) -> rec_arg({a, {b, {a, b}}}); -w(baba) -> rec_arg({b, {a, {b, a}}}); +w(ab) -> rec_arg({a, b}); % breaks the contract +w(ba) -> rec_arg({b, a}); % breaks the contract +w(aba) -> rec_arg({a, {b, a}}); % no longer breaks the contract +w(bab) -> rec_arg({b, {a, b}}); % breaks the contract +w(abab) -> rec_arg({a, {b, {a, b}}}); % no longer breaks the contract +w(baba) -> rec_arg({b, {a, {b, a}}}); % no longer breaks the contract w(ababa) -> rec_arg({a, {b, {a, {b, a}}}}); w(babab) -> rec_arg({b, {a, {b, {a, b}}}}). +%% For comparison: the same thing with types + +-type ab() :: {a, a()} | {b, b()}. +-type a() :: a | {b, b()}. +-type b() :: b | {a, a()}. + +-spec rec2(Arg) -> ok when + Arg :: ab(). + +rec2(X) -> get(X). + +d(aa) -> rec2({a, a}); +d(bb) -> rec2({b, b}); +d(abb) -> rec2({a, {b, b}}); +d(baa) -> rec2({b, {a, a}}); +d(abaa) -> rec2({a, {b, {a, a}}}); +d(babb) -> rec2({b, {a, {b, b}}}); +d(ababb) -> rec2({a, {b, {a, {b, b}}}}); +d(babaa) -> rec2({b, {a, {b, {a, a}}}}). + +q(ab) -> rec2({a, b}); % breaks the contract +q(ba) -> rec2({b, a}); % breaks the contract +q(aba) -> rec2({a, {b, a}}); % breaks the contract +q(bab) -> rec2({b, {a, b}}); % breaks the contract +q(abab) -> rec2({a, {b, {a, b}}}); +q(baba) -> rec2({b, {a, {b, a}}}); +q(ababa) -> rec2({a, {b, {a, {b, a}}}}); +q(babab) -> rec2({b, {a, {b, {a, b}}}}). + %=============================================================================== -type dublo(X) :: {X, X}. @@ -143,7 +172,7 @@ st(X) when is_atom(X) -> _Other -> ok end; alpha -> bad; - {ok, 42} -> bad; + {ok, 42} -> ok; 42 -> bad end. @@ -161,7 +190,7 @@ dt(X) when is_atom(X) -> err2 -> ok; {ok, X} -> ok; alpha -> bad; - {ok, 42} -> bad; + {ok, 42} -> ok; 42 -> bad end. @@ -181,7 +210,7 @@ dt2(X) when is_atom(X) -> err2 -> ok; {ok, X} -> ok; alpha -> bad; - {ok, 42} -> bad; + {ok, 42} -> ok; 42 -> bad end. diff --git a/lib/dialyzer/test/small_SUITE_data/src/contracts_with_subtypes2.erl b/lib/dialyzer/test/small_SUITE_data/src/contracts_with_subtypes2.erl new file mode 100644 index 0000000000..d2f945b284 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/contracts_with_subtypes2.erl @@ -0,0 +1,40 @@ +-module(contracts_with_subtypes2). + +-compile(export_all). + +-behaviour(supervisor). + +-spec t(Arg) -> ok when + Arg :: {a, A}, + A :: {b, B}, + B :: {c, C}, + C :: {d, D}, + D :: {e, E}, + E :: {f, _}. + +t(X) -> + get(X). + +t() -> + t({a, {b, {c, {d, {e, {g, 3}}}}}}). % breaks the contract + +%% This one should possibly result in warnings about unused variables. +-spec l() -> ok when + X :: Y, + Y :: X. + +l() -> + ok. + +%% This is the example from seq12547 (ticket OTP-11798). +%% There used to be a warning. + +-spec init(term()) -> Result when + Result :: {ok, {{supervisor:strategy(), + non_neg_integer(), + pos_integer()}, + [supervisor:child_spec()]}} + | ignore. + +init(_) -> + foo:bar(). diff --git a/lib/dialyzer/test/small_SUITE_data/src/invalid_spec_2/scala_data.erl b/lib/dialyzer/test/small_SUITE_data/src/invalid_spec_2/scala_data.erl new file mode 100644 index 0000000000..c26787fe24 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/invalid_spec_2/scala_data.erl @@ -0,0 +1,5 @@ +-module(scala_data). + +-export_type([data/0]). + +-opaque data() :: {'data', term()}. diff --git a/lib/dialyzer/test/small_SUITE_data/src/invalid_spec_2/scala_user.erl b/lib/dialyzer/test/small_SUITE_data/src/invalid_spec_2/scala_user.erl new file mode 100644 index 0000000000..4e981f3b74 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/invalid_spec_2/scala_user.erl @@ -0,0 +1,8 @@ +-module(scala_user). + +-export([is_list/2]). + +-spec is_list(atom(), scala_data:data()) -> boolean(). + +is_list( List,Data) when is_list(List) -> true; +is_list(Tuple,Data) when is_tuple(Tuple) -> false. diff --git a/lib/dialyzer/test/small_SUITE_data/src/maps_redef.erl b/lib/dialyzer/test/small_SUITE_data/src/maps_redef.erl new file mode 100644 index 0000000000..70059f73b6 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/maps_redef.erl @@ -0,0 +1,12 @@ +-module(maps_redef). + +-export([t/0]). + +%% OK in Erlang/OTP 17, at least. + +-type map() :: atom(). % redefine built-in type + +-spec t() -> map(). + +t() -> + a. % OK diff --git a/lib/dialyzer/test/small_SUITE_data/src/predef.erl b/lib/dialyzer/test/small_SUITE_data/src/predef.erl index c2364fd1c2..ee9073aa67 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/predef.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/predef.erl @@ -5,8 +5,8 @@ -export_type([array/0, digraph/0, gb_set/0]). -%% Before R17B local re-definitions of pre-defined opaque types were -%% ignored but did not generate any warning. +%% Before Erlang/OTP 17.0 local re-definitions of pre-defined opaque +%% types were ignored but did not generate any warning. -opaque array() :: atom(). -opaque digraph() :: atom(). -opaque gb_set() :: atom(). diff --git a/lib/dialyzer/test/underspecs_SUITE_data/dialyzer_options b/lib/dialyzer/test/underspecs_SUITE_data/dialyzer_options index f7197ac30f..6843119b9d 100644 --- a/lib/dialyzer/test/underspecs_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/underspecs_SUITE_data/dialyzer_options @@ -1 +1 @@ -{dialyzer_options, [{warnings, [underspecs]}]}. +{dialyzer_options, [{warnings, [underspecs, no_unknown]}]}. diff --git a/lib/dialyzer/test/user_SUITE_data/dialyzer_options b/lib/dialyzer/test/user_SUITE_data/dialyzer_options index 513ed7752b..d20ecd389f 100644 --- a/lib/dialyzer/test/user_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/user_SUITE_data/dialyzer_options @@ -1,2 +1,2 @@ -{dialyzer_options, []}. +{dialyzer_options, [{warnings, [no_unknown]}]}. {time_limit, 3}.
\ No newline at end of file diff --git a/lib/diameter/include/diameter_gen.hrl b/lib/diameter/include/diameter_gen.hrl index 55aae3a243..c8f706dc3e 100644 --- a/lib/diameter/include/diameter_gen.hrl +++ b/lib/diameter/include/diameter_gen.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2014. 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 @@ -25,6 +25,11 @@ -define(THROW(T), throw({?MODULE, T})). +%% Key to a value in the process dictionary that determines whether or +%% not an unrecognized AVP setting the M-bit should be regarded as an +%% error or not. See is_strict/0. +-define(STRICT_KEY, strict). + -type parent_name() :: atom(). %% parent = Message or AVP -type parent_record() :: tuple(). %% -type avp_name() :: atom(). @@ -35,6 +40,18 @@ -type grouped_avp() :: nonempty_improper_list(#diameter_avp{}, [avp()]). -type avp() :: non_grouped_avp() | grouped_avp(). +%% Use a (hopefully) unique key when manipulating the process +%% dictionary. + +putr(K,V) -> + put({?MODULE, K}, V). + +getr(K) -> + get({?MODULE, K}). + +eraser(K) -> + erase({?MODULE, K}). + %% --------------------------------------------------------------------------- %% # encode_avps/2 %% --------------------------------------------------------------------------- @@ -212,12 +229,61 @@ decode(Name, #diameter_avp{code = Code, vendor_id = Vid} = Avp, Acc) -> %% decode/4 +%% AVP is defined in the dictionary ... decode(Name, {AvpName, Type}, Avp, Acc) -> d(Name, Avp#diameter_avp{name = AvpName, type = Type}, Acc); +%% ... or not. decode(Name, 'AVP', Avp, Acc) -> decode_AVP(Name, Avp, Acc). +%% 6733, 4.4: +%% +%% Receivers of a Grouped AVP that does not have the 'M' (mandatory) +%% bit set and one or more of the encapsulated AVPs within the group +%% has the 'M' (mandatory) bit set MAY simply be ignored if the +%% Grouped AVP itself is unrecognized. The rule applies even if the +%% encapsulated AVP with its 'M' (mandatory) bit set is further +%% encapsulated within other sub-groups, i.e., other Grouped AVPs +%% embedded within the Grouped AVP. +%% +%% The first sentence is slightly mangled, but take it to mean this: +%% +%% An unrecognized AVP of type Grouped that does not set the 'M' bit +%% MAY be ignored even if one of its encapsulated AVPs sets the 'M' +%% bit. +%% +%% The text above is a change from RFC 3588, which instead says this: +%% +%% Further, if any of the AVPs encapsulated within a Grouped AVP has +%% the 'M' (mandatory) bit set, the Grouped AVP itself MUST also +%% include the 'M' bit set. +%% +%% Both of these texts have problems. If the AVP is unknown then its +%% type is unknown since the type isn't sent over the wire, so the +%% 6733 text becomes a non-statement: don't know that the AVP not +%% setting the M-bit is of type Grouped, therefore can't know that its +%% data consists of encapsulated AVPs, therefore can't but ignore that +%% one of these might set the M-bit. It should be no worse if we know +%% the AVP to have type Grouped. +%% +%% Similarly, for the 3588 text: if we receive an AVP that doesn't set +%% the M-bit and don't know that the AVP has type Grouped then we +%% can't realize that its data contains an AVP that sets the M-bit, so +%% can't regard the AVP as erroneous on this account. Again, it should +%% be no worse if the type is known to be Grouped, but in this case +%% the RFC forces us to regard the AVP as erroneous. This is +%% inconsistent, and the 3588 text has never been enforced. +%% +%% So, if an AVP doesn't set the M-bit then we're free to ignore it, +%% regardless of the AVP's type. If we know the type to be Grouped +%% then we must ignore the M-bit on an encapsulated AVP. That means +%% packing such an encapsulated AVP into an 'AVP' field if need be, +%% not regarding the lack of a specific field as an error as is +%% otherwise the case. (The lack of an AVP-specific field being how we +%% defined the RFC's "unrecognized", which is slightly stronger than +%% "not defined".) + %% d/3 %% Don't try to decode the value of a Failed-AVP component since it @@ -230,9 +296,19 @@ d('Failed-AVP' = Name, Avp, Acc) -> %% Or try to decode. d(Name, Avp, {Avps, Acc}) -> #diameter_avp{name = AvpName, - data = Data} + data = Data, + type = Type, + is_mandatory = M} = Avp, + %% Use the process dictionary is to keep track of whether or not + %% to ignore an M-bit on an encapsulated AVP. Not ideal, but the + %% alternative requires widespread changes to be able to pass the + %% value around through the entire decode. The solution here is + %% simple in comparison, both to implement and to understand. + + Reset = relax(Type, M), + try avp(decode, Data, AvpName) of V -> {H, A} = ungroup(V, Avp), @@ -250,8 +326,32 @@ d(Name, Avp, {Avps, Acc}) -> {Reason, Avp, erlang:get_stacktrace()}), {Rec, Failed} = Acc, {[Avp|Avps], {Rec, [rc(Reason, Avp) | Failed]}} + after + relax(Reset) end. +%% Set false in the process dictionary as soon as we see a Grouped AVP +%% that doesn't set the M-bit, so that is_strict() can say whether or +%% not to ignore the M-bit on an encapsulated AVP. +relax('Grouped', M) -> + V = getr(?STRICT_KEY), + if V == undefined andalso not M -> + putr(?STRICT_KEY, M); + true -> + false + end; +relax(_, _) -> + false. + +%% Reset strictness. +relax(undefined) -> + eraser(?STRICT_KEY); +relax(false) -> + ok. + +is_strict() -> + false /= getr(?STRICT_KEY). + %% decode_AVP/3 %% %% Don't know this AVP: see if it can be packed in an 'AVP' field @@ -310,15 +410,8 @@ pack_avp(_, Arity, Avp, Acc) -> %% pack_AVP/3 -%% Give Failed-AVP special treatment since it'll contain any -%% unrecognized mandatory AVP's. -pack_AVP(Name, #diameter_avp{is_mandatory = true} = Avp, Acc) - when Name /= 'Failed-AVP' -> - {Rec, Failed} = Acc, - {Rec, [{5001, Avp} | Failed]}; - pack_AVP(Name, #diameter_avp{is_mandatory = M} = Avp, Acc) -> - case avp_arity(Name, 'AVP') of + case pack_arity(Name, M) of 0 -> {Rec, Failed} = Acc, {Rec, [{if M -> 5001; true -> 5008 end, Avp} | Failed]}; @@ -326,6 +419,16 @@ pack_AVP(Name, #diameter_avp{is_mandatory = M} = Avp, Acc) -> pack(Arity, 'AVP', Avp, Acc) end. +%% Give Failed-AVP special treatment since it'll contain any +%% unrecognized mandatory AVP's. +pack_arity(Name, M) -> + case Name /= 'Failed-AVP' andalso M andalso is_strict() of + true -> + 0; + false -> + avp_arity(Name, 'AVP') + end. + %% 3588: %% %% DIAMETER_AVP_UNSUPPORTED 5001 diff --git a/lib/diameter/src/diameter.app.src b/lib/diameter/src/diameter.app.src index ceefb9b398..509de9e595 100644 --- a/lib/diameter/src/diameter.app.src +++ b/lib/diameter/src/diameter.app.src @@ -24,5 +24,7 @@ {registered, [%REGISTERED%]}, {applications, [stdlib, kernel]}, {env, []}, - {mod, {diameter_app, []}} + {mod, {diameter_app, []}}, + {runtime_dependencies, ["syntax_tools-1.6.14","stdlib-2.0","ssl-5.3.4", + "runtime_tools-1.8.14","kernel-3.0","erts-6.0"]} ]}. diff --git a/lib/diameter/test/diameter_codec_test.erl b/lib/diameter/test/diameter_codec_test.erl index 0b4568a9e5..90536dcf2b 100644 --- a/lib/diameter/test/diameter_codec_test.erl +++ b/lib/diameter/test/diameter_codec_test.erl @@ -1,8 +1,7 @@ -%% coding: utf-8 %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2014. 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 diff --git a/lib/edoc/src/edoc.app.src b/lib/edoc/src/edoc.app.src index 0c8d5b85f8..9e1155d3e8 100644 --- a/lib/edoc/src/edoc.app.src +++ b/lib/edoc/src/edoc.app.src @@ -22,4 +22,6 @@ otpsgml_layout]}, {registered,[]}, {applications, [compiler,kernel,stdlib,syntax_tools]}, - {env, []}]}. + {env, []}, + {runtime_dependencies, ["xmerl-1.3.7","syntax_tools-1.6.14","stdlib-2.0", + "kernel-3.0","inets-5.10","erts-6.0"]}]}. diff --git a/lib/edoc/vsn.mk b/lib/edoc/vsn.mk index 2fcc97e406..0172aac48b 100644 --- a/lib/edoc/vsn.mk +++ b/lib/edoc/vsn.mk @@ -1 +1 @@ -EDOC_VSN = 0.7.12.1 +EDOC_VSN = 0.7.13 diff --git a/lib/eldap/doc/src/eldap.xml b/lib/eldap/doc/src/eldap.xml index 228d3b34c3..8009a8d6a3 100644 --- a/lib/eldap/doc/src/eldap.xml +++ b/lib/eldap/doc/src/eldap.xml @@ -69,12 +69,13 @@ filter() See present/1, substrings/2, <fsummary>Open a connection to an LDAP server.</fsummary> <type> <v>Handle = handle()</v> - <v>Option = {port, integer()} | {log, function()} | {timeout, integer()} | {ssl, boolean()} | {sslopts, list()}</v> + <v>Option = {port, integer()} | {log, function()} | {timeout, integer()} | {ssl, boolean()} | {sslopts, list()} | {tcpopts, list()}</v> </type> <desc> <p>Setup a connection to an LDAP server, the <c>HOST</c>'s are tried in order.</p> <p>The log function takes three arguments, <c>fun(Level, FormatString, [FormatArg]) end</c>.</p> <p>Timeout set the maximum time in milliseconds that each server request may take.</p> + <p>Currently, the only TCP socket option accepted is <c>inet6</c>. Default is <c>inet</c>.</p> </desc> </func> <func> diff --git a/lib/eldap/src/Makefile b/lib/eldap/src/Makefile index ebb7967e11..2e1110ec2c 100644 --- a/lib/eldap/src/Makefile +++ b/lib/eldap/src/Makefile @@ -88,7 +88,7 @@ $(TARGET_FILES): $(HRL_FILES) # Special Build Targets # ---------------------------------------------------- $(ASN1_HRL): ../asn1/$(ASN1_FILES) - $(asn_verbose)$(ERLC) -o $(EBIN) -bber $(ERL_COMPILE_FLAGS) ../asn1/ELDAPv3.asn1 + $(asn_verbose)$(ERLC) -o $(EBIN) +legacy_erlang_types -bber $(ERL_COMPILE_FLAGS) ../asn1/ELDAPv3.asn1 # ---------------------------------------------------- # Release Target diff --git a/lib/eldap/src/eldap.app.src b/lib/eldap/src/eldap.app.src index 8215328910..03a7d7c562 100644 --- a/lib/eldap/src/eldap.app.src +++ b/lib/eldap/src/eldap.app.src @@ -4,5 +4,7 @@ {modules, [eldap, 'ELDAPv3']}, {registered, []}, {applications, [kernel, stdlib]}, - {env, []} + {env, []}, + {runtime_dependencies, ["stdlib-2.0","ssl-5.3.4","kernel-3.0","erts-6.0", + "asn1-3.0"]} ]}. diff --git a/lib/eldap/src/eldap.appup.src b/lib/eldap/src/eldap.appup.src index 7a9a5ef548..9d77faf740 100644 --- a/lib/eldap/src/eldap.appup.src +++ b/lib/eldap/src/eldap.appup.src @@ -16,6 +16,10 @@ %% %% %CopyrightEnd% {"%VSN%", - [{<<".*">>,[{restart_application, eldap}]}], - [{<<".*">>,[{restart_application, eldap}]}] + [ + {<<".*">>,[{restart_application, eldap}]} + ], + [ + {<<".*">>,[{restart_application, eldap}]} + ] }. diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl index a86fd39adb..1cd328cde3 100644 --- a/lib/eldap/src/eldap.erl +++ b/lib/eldap/src/eldap.erl @@ -45,9 +45,10 @@ log, % User provided log function timeout = infinity, % Request timeout anon_auth = false, % Allow anonymous authentication - ldaps = false, % LDAP/LDAPS + ldaps = false, % LDAP/LDAPS using_tls = false, % true if LDAPS or START_TLS executed - tls_opts = [] % ssl:ssloption() + tls_opts = [], % ssl:ssloption() + tcp_opts = [] % inet6 support }). %%% For debug purposes @@ -372,6 +373,8 @@ parse_args([{sslopts, Opts}|T], Cpid, Data) when is_list(Opts) -> parse_args(T, Cpid, Data#eldap{ldaps = true, using_tls=true, tls_opts = Opts ++ Data#eldap.tls_opts}); parse_args([{sslopts, _}|T], Cpid, Data) -> parse_args(T, Cpid, Data); +parse_args([{tcpopts, Opts}|T], Cpid, Data) when is_list(Opts) -> + parse_args(T, Cpid, Data#eldap{tcp_opts = inet6_opt(Opts) ++ Data#eldap.tcp_opts}); parse_args([{log, F}|T], Cpid, Data) when is_function(F) -> parse_args(T, Cpid, Data#eldap{log = F}); parse_args([{log, _}|T], Cpid, Data) -> @@ -382,6 +385,14 @@ parse_args([H|_], Cpid, _) -> parse_args([], _, Data) -> Data. +inet6_opt(Opts) -> + case proplists:get_value(inet6, Opts) of + true -> + [inet6]; + _ -> + [] + end. + %%% Try to connect to the hosts in the listed order, %%% and stop with the first one to which a successful %%% connection is made. @@ -401,9 +412,11 @@ try_connect([],_) -> {error,"connect failed"}. do_connect(Host, Data, Opts) when Data#eldap.ldaps == false -> - gen_tcp:connect(Host, Data#eldap.port, Opts, Data#eldap.timeout); + gen_tcp:connect(Host, Data#eldap.port, Opts ++ Data#eldap.tcp_opts, + Data#eldap.timeout); do_connect(Host, Data, Opts) when Data#eldap.ldaps == true -> - ssl:connect(Host, Data#eldap.port, Opts++Data#eldap.tls_opts). + ssl:connect(Host, Data#eldap.port, + Opts ++ Data#eldap.tls_opts ++ Data#eldap.tcp_opts). loop(Cpid, Data) -> receive diff --git a/lib/eldap/test/eldap_misc_SUITE.erl b/lib/eldap/test/eldap_misc_SUITE.erl new file mode 100644 index 0000000000..ca810ee33c --- /dev/null +++ b/lib/eldap/test/eldap_misc_SUITE.erl @@ -0,0 +1,51 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012-2014. 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(eldap_misc_SUITE). + +-compile(export_all). %% Use this only in test suites... + +-include_lib("common_test/include/ct.hrl"). +-include_lib("eldap/include/eldap.hrl"). +-include_lib("eldap/ebin/ELDAPv3.hrl"). + +all() -> + [ + encode, + decode + ]. + + +encode(_Config) -> + {ok,Bin} = 'ELDAPv3':encode('AddRequest', #'AddRequest'{entry="hejHopp" ,attributes=[]} ), + Expected = <<104,11,4,7,104,101,106,72,111,112,112,48,0>>, + Expected = Bin. + +decode(_Config) -> + {ok,Res} = 'ELDAPv3':decode('AddRequest', <<104,11,4,7,104,101,106,72,111,112,112,48,0>>), + ct:log("Res = ~p", [Res]), + Expected = #'AddRequest'{entry = "hejHopp",attributes = []}, + case Res of + Expected -> ok; + #'AddRequest'{entry= <<"hejHopp">>, attributes=[]} -> + {fail, "decoded to (correct) binary!!"}; + _ -> + {fail, "Bad decode"} + end. + diff --git a/lib/eldap/vsn.mk b/lib/eldap/vsn.mk index dd1f50653c..efdc30b476 100644 --- a/lib/eldap/vsn.mk +++ b/lib/eldap/vsn.mk @@ -1 +1,2 @@ -ELDAP_VSN = 1.0.2 +ELDAP_VSN = 1.0.3 + diff --git a/lib/erl_docgen/src/docgen_edoc_xml_cb.erl b/lib/erl_docgen/src/docgen_edoc_xml_cb.erl index e3cc354206..e6bf9ce20e 100644 --- a/lib/erl_docgen/src/docgen_edoc_xml_cb.erl +++ b/lib/erl_docgen/src/docgen_edoc_xml_cb.erl @@ -1014,6 +1014,8 @@ t_type([#xmlElement{name = nil}]) -> t_nil(); t_type([#xmlElement{name = list, content = Es}]) -> t_list(Es); +t_type([#xmlElement{name = nonempty_list, content = Es}]) -> + t_nonempty_list(Es); t_type([#xmlElement{name = tuple, content = Es}]) -> t_tuple(Es); t_type([#xmlElement{name = 'fun', content = Es}]) -> @@ -1023,7 +1025,11 @@ t_type([#xmlElement{name = abstype, content = Es}]) -> t_type([#xmlElement{name = union, content = Es}]) -> t_union(Es); t_type([#xmlElement{name = record, content = Es}]) -> - t_record(Es). + t_record(Es); +t_type([#xmlElement{name = map, content = Es}]) -> + t_map(Es); +t_type([#xmlElement{name = map_field, content = Es}]) -> + t_map_field(Es). t_var(E) -> [get_attrval(name, E)]. @@ -1046,6 +1052,9 @@ t_nil() -> t_list(Es) -> ["["] ++ t_utype(get_elem(type, Es)) ++ ["]"]. +t_nonempty_list(Es) -> + ["["] ++ t_utype(get_elem(type, Es)) ++ [", ...]"]. + t_tuple(Es) -> ["{"] ++ seq(fun t_utype_elem/1, Es, ["}"]). @@ -1058,6 +1067,12 @@ t_record([E|Es]) -> t_field(#xmlElement{name=field, content=[Atom,Type]}) -> [get_attrval(value, Atom), "="] ++ t_utype_elem(Type). +t_map(Es) -> + ["#{"] ++ seq(fun t_utype_elem/1, Es, ["}"]). + +t_map_field([K,V]) -> + [t_utype_elem(K) ++ " => " ++ t_utype_elem(V)]. + t_abstype(Es) -> case split_at_colon(t_name(get_elem(erlangName, Es)),[]) of {Mod,Type} -> diff --git a/lib/erl_docgen/src/docgen_otp_specs.erl b/lib/erl_docgen/src/docgen_otp_specs.erl index 3240edd68e..886194598f 100644 --- a/lib/erl_docgen/src/docgen_otp_specs.erl +++ b/lib/erl_docgen/src/docgen_otp_specs.erl @@ -433,7 +433,7 @@ t_tuple(Es) -> ["{"] ++ seq(fun t_utype_elem/1, Es, ["}"]). t_map() -> - ["#{}"]. + ["map()"]. t_fun(Es) -> ["("] ++ seq(fun t_utype_elem/1, get_content(argtypes, Es), diff --git a/lib/erl_docgen/src/erl_docgen.app.src b/lib/erl_docgen/src/erl_docgen.app.src index daad172106..e2830b2692 100644 --- a/lib/erl_docgen/src/erl_docgen.app.src +++ b/lib/erl_docgen/src/erl_docgen.app.src @@ -8,7 +8,7 @@ }, {registered,[]}, {applications, [kernel,stdlib]}, - {env, [] - } + {env, []}, + {runtime_dependencies, ["xmerl-1.3.7","stdlib-2.0","edoc-0.7.13","erts-6.0"]} ] }. diff --git a/lib/erl_docgen/vsn.mk b/lib/erl_docgen/vsn.mk index cda8671cfd..0f89922275 100644 --- a/lib/erl_docgen/vsn.mk +++ b/lib/erl_docgen/vsn.mk @@ -1 +1 @@ -ERL_DOCGEN_VSN = 0.3.4.1 +ERL_DOCGEN_VSN = 0.3.5 diff --git a/lib/erl_interface/aclocal.m4 b/lib/erl_interface/aclocal.m4 index 46b30a16b3..2b47f7c4bc 100644 --- a/lib/erl_interface/aclocal.m4 +++ b/lib/erl_interface/aclocal.m4 @@ -74,6 +74,21 @@ AC_ARG_VAR(erl_xcomp_clock_gettime_cpu_time, [clock_gettime() can be used for re AC_ARG_VAR(erl_xcomp_after_morecore_hook, [__after_morecore_hook can track malloc()s core memory usage: yes|no (only used when cross compiling)]) AC_ARG_VAR(erl_xcomp_dlsym_brk_wrappers, [dlsym(RTLD_NEXT, _) brk wrappers can track malloc()s core memory usage: yes|no (only used when cross compiling)]) +dnl Cross compilation variables for OSE +AC_ARG_VAR(erl_xcomp_ose_ldflags_pass1, [Linker flags for the OSE module (pass 1) (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_ldflags_pass2, [Linker flags for the OSE module (pass 2) (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_OSEROOT, [OSE installation root directory (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_STRIP, [Strip utility shipped with the OSE distribution(only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_POST_LINK, [OSE postlink tool (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_SET_CONF, [Sets the configuration for an OSE load module (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_ELF_SIZE, [Prints the section size information for an OSE load module (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_LCF, [OSE load module linker configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_BEAM_LM_CONF, [BEAM OSE load module default configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_EPMD_LM_CONF, [EPMD OSE load module default configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_RUN_ERL_LM_CONF, [run_erl_lm OSE load module default configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_CONFD, [OSE confd source file]) +AC_ARG_VAR(erl_xcomp_ose_CRT0_LM, [OSE crt0 lm source file]) + ]) AC_DEFUN(ERL_XCOMP_SYSROOT_INIT, @@ -488,6 +503,8 @@ AC_CACHE_VAL(ac_cv_sys_ipv6_support, #ifdef __WIN32__ #include <winsock2.h> #include <ws2tcpip.h> +#elif __OSE__ +#error "no ipv6" #else #include <netinet/in.h> #endif], @@ -500,6 +517,8 @@ else #ifdef __WIN32__ #include <winsock2.h> #include <ws2tcpip.h> +#elif __OSE__ +#error "no ipv6" #else #include <netinet/in.h> #endif], @@ -728,6 +747,12 @@ if test "X$host_os" = "Xwin32"; then THR_LIBS= THR_LIB_NAME=win32_threads THR_LIB_TYPE=win32_threads +elif test "X$host_os" = "Xose"; then + AC_MSG_RESULT(yes) + THR_DEFS="-DOSE_THREADS" + THR_LIBS= + THR_LIB_NAME=ose_threads + THR_LIB_TYPE=ose_threads else AC_MSG_RESULT(no) THR_DEFS= @@ -1078,9 +1103,22 @@ case "$THR_LIB_NAME" in test "$ethr_have_native_atomics" = "yes" && ethr_have_native_spinlock=yes ;; - pthread) - ETHR_THR_LIB_BASE_DIR=pthread - AC_DEFINE(ETHR_PTHREADS, 1, [Define if you have pthreads]) + pthread|ose_threads) + case "$THR_LIB_NAME" in + pthread) + ETHR_THR_LIB_BASE_DIR=pthread + AC_DEFINE(ETHR_PTHREADS, 1, [Define if you have pthreads]) + ;; + ose_threads) + AC_DEFINE(ETHR_OSE_THREADS, 1, + [Define if you have OSE style threads]) + ETHR_THR_LIB_BASE_DIR=ose + AC_CHECK_HEADER(ose_spi/ose_spi.h, + AC_DEFINE(HAVE_OSE_SPI_H, 1, + [Define if you have the "ose_spi/ose_spi.h" header file.])) + ;; + esac + if test "x$THR_LIB_NAME" == "xpthread"; then case $host_os in openbsd*) # The default stack size is insufficient for our needs @@ -1139,6 +1177,7 @@ case "$THR_LIB_NAME" in *) ;; esac + fi dnl We sometimes need ETHR_DEFS in order to find certain headers dnl (at least for pthread.h on osf1). saved_cppflags="$CPPFLAGS" @@ -1151,7 +1190,6 @@ case "$THR_LIB_NAME" in dnl dnl Check for headers dnl - AC_CHECK_HEADER(pthread.h, \ AC_DEFINE(ETHR_HAVE_PTHREAD_H, 1, \ [Define if you have the <pthread.h> header file.])) @@ -1184,7 +1222,7 @@ case "$THR_LIB_NAME" in dnl dnl Check for functions dnl - + if test "x$THR_LIB_NAME" == "xpthread"; then AC_CHECK_FUNC(pthread_spin_lock, \ [ethr_have_native_spinlock=yes \ AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \ @@ -1311,6 +1349,8 @@ case "$THR_LIB_NAME" in AC_MSG_RESULT([$linux_futex]) test $linux_futex = yes && AC_DEFINE(ETHR_HAVE_LINUX_FUTEX, 1, [Define if you have a linux futex implementation.]) + fi + AC_CHECK_SIZEOF(int) AC_CHECK_SIZEOF(long) AC_CHECK_SIZEOF(long long) diff --git a/lib/erl_interface/doc/src/ei.xml b/lib/erl_interface/doc/src/ei.xml index ab185c9179..90495eebd6 100644 --- a/lib/erl_interface/doc/src/ei.xml +++ b/lib/erl_interface/doc/src/ei.xml @@ -4,7 +4,7 @@ <cref> <header> <copyright> - <year>2001</year><year>2013</year> + <year>2001</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -417,6 +417,26 @@ ei_x_encode_empty_list(&x); </desc> </func> <func> + <name><ret>int</ret><nametext>ei_encode_map_header(char *buf, int *index, int arity)</nametext></name> + <name><ret>int</ret><nametext>ei_x_encode_map_header(ei_x_buff* x, int arity)</nametext></name> + <fsummary>Encode a map</fsummary> + <desc> + <p>This function encodes a map header, with a specified arity. The next + <c>arity*2</c> terms encoded will be the keys and values of the map + encoded in the following order: <c>K1, V1, K2, V2, ..., Kn, Vn</c>. + </p> + <p>E.g. to encode the map <c>#{a => "Apple", b => "Banana"}</c>:</p> + <pre> +ei_x_encode_map_header(&x, 2); +ei_x_encode_atom(&x, "a"); +ei_x_encode_string(&x, "Apple"); +ei_x_encode_atom(&x, "b"); +ei_x_encode_string(&x, "Banana"); + </pre> + <p>A correctly encoded map can not have duplicate keys.</p> + </desc> + </func> + <func> <name><ret>int</ret><nametext>ei_get_type(const char *buf, const int *index, int *type, int *size)</nametext></name> <fsummary>Fetch the type and size of an encoded term</fsummary> <desc> @@ -638,6 +658,18 @@ ei_x_encode_empty_list(&x); </desc> </func> <func> + <name><ret>int</ret><nametext>ei_decode_map_header(const char *buf, int *index, int *arity)</nametext></name> + <fsummary>Decode a map</fsummary> + <desc> + <p>This function decodes a map header from the binary + format. The number of key-value pairs is returned in + <c>*arity</c>. Keys and values follow in the following order: + <c>K1, V1, K2, V2, ..., Kn, Vn</c>. This makes a total of + <c>arity*2</c> terms. If <c>arity</c> is zero, it's an empty map. + A correctly encoded map does not have duplicate keys.</p> + </desc> + </func> + <func> <name><ret>int</ret><nametext>ei_decode_ei_term(const char* buf, int* index, ei_term* term)</nametext></name> <fsummary>Decode a term, without prior knowledge of type</fsummary> <desc> diff --git a/lib/erl_interface/include/ei.h b/lib/erl_interface/include/ei.h index 9b83385a46..a3eb437f88 100644 --- a/lib/erl_interface/include/ei.h +++ b/lib/erl_interface/include/ei.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2013. All Rights Reserved. + * Copyright Ericsson AB 1998-2014. 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 @@ -131,6 +131,7 @@ #define ERL_SMALL_BIG_EXT 'n' #define ERL_LARGE_BIG_EXT 'o' #define ERL_NEW_FUN_EXT 'p' +#define ERL_MAP_EXT 't' #define ERL_FUN_EXT 'u' #define ERL_NEW_CACHE 'N' /* c nodes don't know these two */ @@ -467,6 +468,8 @@ int ei_encode_list_header(char *buf, int *index, int arity); int ei_x_encode_list_header(ei_x_buff* x, long n); #define ei_encode_empty_list(buf,i) ei_encode_list_header(buf,i,0) int ei_x_encode_empty_list(ei_x_buff* x); +int ei_encode_map_header(char *buf, int *index, int arity); +int ei_x_encode_map_header(ei_x_buff* x, long n); /* * ei_get_type() returns the type and "size" of the item at @@ -507,6 +510,7 @@ int ei_decode_term(const char *buf, int *index, void *t); /* ETERM** actually */ int ei_decode_trace(const char *buf, int *index, erlang_trace *p); int ei_decode_tuple_header(const char *buf, int *index, int *arity); int ei_decode_list_header(const char *buf, int *index, int *arity); +int ei_decode_map_header(const char *buf, int *index, int *arity); /* * ei_decode_ei_term() returns 1 if term is decoded, 0 if term is OK, diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c index c9aa28812c..2e8418d61e 100644 --- a/lib/erl_interface/src/connect/ei_connect.c +++ b/lib/erl_interface/src/connect/ei_connect.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2013. All Rights Reserved. + * Copyright Ericsson AB 2000-2014. 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 @@ -1166,7 +1166,11 @@ static unsigned int gen_challenge(void) uname(&s.name); s.cpu = clock(); s.pid = getpid(); +#ifndef __ANDROID__ s.hid = gethostid(); +#else + s.hid = 0; +#endif s.uid = getuid(); s.gid = getgid(); @@ -1336,7 +1340,8 @@ static int send_name_or_challenge(int fd, char *nodename, | DFLAG_NEW_FUN_TAGS | DFLAG_NEW_FLOATS | DFLAG_SMALL_ATOM_TAGS - | DFLAG_UTF8_ATOMS)); + | DFLAG_UTF8_ATOMS + | DFLAG_MAP_TAG)); if (f_chall) put32be(s, challenge); memcpy(s, nodename, strlen(nodename)); diff --git a/lib/erl_interface/src/connect/ei_connect_int.h b/lib/erl_interface/src/connect/ei_connect_int.h index 42ab9b58d7..8fab47a787 100644 --- a/lib/erl_interface/src/connect/ei_connect_int.h +++ b/lib/erl_interface/src/connect/ei_connect_int.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2013. All Rights Reserved. + * Copyright Ericsson AB 2001-2014. 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 @@ -104,6 +104,7 @@ extern int h_errno; #define DFLAG_NEW_FLOATS 0x800 #define DFLAG_SMALL_ATOM_TAGS 0x4000 #define DFLAG_UTF8_ATOMS 0x10000 +#define DFLAG_MAP_TAG 0x20000 ei_cnode *ei_fd_to_cnode(int fd); int ei_distversion(int fd); diff --git a/lib/erl_interface/src/connect/ei_resolve.c b/lib/erl_interface/src/connect/ei_resolve.c index 74dcba61a7..cffcac801c 100644 --- a/lib/erl_interface/src/connect/ei_resolve.c +++ b/lib/erl_interface/src/connect/ei_resolve.c @@ -642,7 +642,7 @@ struct hostent *ei_gethostbyname_r(const char *name, #ifndef HAVE_GETHOSTBYNAME_R return my_gethostbyname_r(name,hostp,buffer,buflen,h_errnop); #else -#if (defined(__GLIBC__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__)) +#if (defined(__GLIBC__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__) || defined(__ANDROID__)) struct hostent *result; gethostbyname_r(name, hostp, buffer, buflen, &result, h_errnop); diff --git a/lib/erl_interface/src/decode/decode_skip.c b/lib/erl_interface/src/decode/decode_skip.c index 553266471c..2260394da1 100644 --- a/lib/erl_interface/src/decode/decode_skip.c +++ b/lib/erl_interface/src/decode/decode_skip.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2013. All Rights Reserved. + * Copyright Ericsson AB 2002-2014. 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 @@ -61,7 +61,13 @@ int ei_skip_term(const char* buf, int* index) break; case ERL_SMALL_TUPLE_EXT: case ERL_LARGE_TUPLE_EXT: - if (ei_decode_tuple_header(buf, index, &n) < 0) return -1; + if (ei_decode_tuple_header(buf, index, &n) < 0) return -1; + for (i = 0; i < n; ++i) + ei_skip_term(buf, index); + break; + case ERL_MAP_EXT: + if (ei_decode_map_header(buf, index, &n) < 0) return -1; + n *= 2; for (i = 0; i < n; ++i) ei_skip_term(buf, index); break; diff --git a/lib/erl_interface/src/decode/decode_tuple_header.c b/lib/erl_interface/src/decode/decode_tuple_header.c index c0ba14ea47..698be1b97a 100644 --- a/lib/erl_interface/src/decode/decode_tuple_header.c +++ b/lib/erl_interface/src/decode/decode_tuple_header.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * Copyright Ericsson AB 1998-2014. 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 @@ -45,3 +45,24 @@ int ei_decode_tuple_header(const char *buf, int *index, int *arity) return 0; } + +int ei_decode_map_header(const char *buf, int *index, int *arity) +{ + const char *s = buf + *index; + const char *s0 = s; + int i; + + switch ((i=get8(s))) { + case ERL_MAP_EXT: + if (arity) *arity = get32be(s); + else s += 4; + break; + + default: + return -1; + } + + *index += s-s0; + + return 0; +} diff --git a/lib/erl_interface/src/encode/encode_tuple_header.c b/lib/erl_interface/src/encode/encode_tuple_header.c index 97a3d1f808..5b11e60447 100644 --- a/lib/erl_interface/src/encode/encode_tuple_header.c +++ b/lib/erl_interface/src/encode/encode_tuple_header.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * Copyright Ericsson AB 1998-2014. 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 @@ -47,3 +47,20 @@ int ei_encode_tuple_header(char *buf, int *index, int arity) return 0; } +int ei_encode_map_header(char *buf, int *index, int arity) +{ + char *s = buf + *index; + char *s0 = s; + + if (arity < 0) return -1; + + if (!buf) s += 5; + else { + put8(s,ERL_MAP_EXT); + put32be(s,arity); + } + + *index += s-s0; + + return 0; +} diff --git a/lib/erl_interface/src/misc/ei_decode_term.c b/lib/erl_interface/src/misc/ei_decode_term.c index ce5ae5b19d..2e7317f781 100644 --- a/lib/erl_interface/src/misc/ei_decode_term.c +++ b/lib/erl_interface/src/misc/ei_decode_term.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2013. All Rights Reserved. + * Copyright Ericsson AB 2001-2014. 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 @@ -100,6 +100,7 @@ int ei_decode_ei_term(const char* buf, int* index, ei_term* term) term->size = get16be(s); return 0; case ERL_LIST_EXT: + case ERL_MAP_EXT: term->arity = get32be(s); break; case ERL_BINARY_EXT: diff --git a/lib/erl_interface/src/misc/ei_x_encode.c b/lib/erl_interface/src/misc/ei_x_encode.c index 14d0b56b8f..10542c88a5 100644 --- a/lib/erl_interface/src/misc/ei_x_encode.c +++ b/lib/erl_interface/src/misc/ei_x_encode.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2013. All Rights Reserved. + * Copyright Ericsson AB 2001-2014. 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 @@ -206,6 +206,16 @@ int ei_x_encode_tuple_header(ei_x_buff* x, long n) return ei_encode_tuple_header(x->buff, &x->index, n); } +int ei_x_encode_map_header(ei_x_buff* x, long n) +{ + int i = x->index; + if (ei_encode_map_header(NULL, &i, n) == -1) + return -1; + if (!x_fix_buff(x, i)) + return -1; + return ei_encode_map_header(x->buff, &x->index, n); +} + int ei_x_encode_atom(ei_x_buff* x, const char* s) { return ei_x_encode_atom_len_as(x, s, strlen(s), ERLANG_LATIN1, ERLANG_LATIN1); diff --git a/lib/erl_interface/test/all_SUITE_data/ei_runner.c b/lib/erl_interface/test/all_SUITE_data/ei_runner.c index cdf32b48c4..196a77dce5 100644 --- a/lib/erl_interface/test/all_SUITE_data/ei_runner.c +++ b/lib/erl_interface/test/all_SUITE_data/ei_runner.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * Copyright Ericsson AB 2001-2014. 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 @@ -182,6 +182,10 @@ char *read_packet(int *len) return io_buf; } +void free_packet(char* packet) +{ + free(packet); +} /*********************************************************************** * S e n d i n g r e p l i e s diff --git a/lib/erl_interface/test/all_SUITE_data/ei_runner.h b/lib/erl_interface/test/all_SUITE_data/ei_runner.h index 96d6a1cbf7..a037341d57 100644 --- a/lib/erl_interface/test/all_SUITE_data/ei_runner.h +++ b/lib/erl_interface/test/all_SUITE_data/ei_runner.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * Copyright Ericsson AB 2001-2014. 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 @@ -44,6 +44,7 @@ void run_tests(char* argv0, TestCase cases[], unsigned number); int get_bin_term(ei_x_buff* x, ei_term* term); char *read_packet(int *len); +void free_packet(char*); /* * Sending replies. diff --git a/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c b/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c index a676e59470..3f6cbbe186 100644 --- a/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c +++ b/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c @@ -603,9 +603,9 @@ TESTCASE(test_ei_decode_misc) /* EI_DECODE_0(decode_version); */ - EI_DECODE_2(decode_double, 32, double, 0.0); - EI_DECODE_2(decode_double, 32, double, -1.0); - EI_DECODE_2(decode_double, 32, double, 1.0); + EI_DECODE_2(decode_double, 9, double, 0.0); + EI_DECODE_2(decode_double, 9, double, -1.0); + EI_DECODE_2(decode_double, 9, double, 1.0); EI_DECODE_2(decode_boolean, 8, int, 0); EI_DECODE_2(decode_boolean, 7, int, 1); diff --git a/lib/erl_interface/test/ei_decode_encode_SUITE.erl b/lib/erl_interface/test/ei_decode_encode_SUITE.erl index c7830f58f2..7caec6ac04 100644 --- a/lib/erl_interface/test/ei_decode_encode_SUITE.erl +++ b/lib/erl_interface/test/ei_decode_encode_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2014. 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 @@ -127,6 +127,15 @@ test_ei_decode_encode(Config) when is_list(Config) -> send_rec(P, mk_ref({Atom,1}, [262143, 8723648, 24097245])), void end || Atom <- unicode_atom_data()], + + send_rec(P, {}), + send_rec(P, {atom, Pid, Port, Ref}), + send_rec(P, [atom, Pid, Port, Ref]), + send_rec(P, [atom | Fun]), + send_rec(P, #{}), + send_rec(P, #{key => value}), + send_rec(P, maps:put(Port, Ref, #{key => value, key2 => Pid})), + ?line runner:recv_eot(P), ok. diff --git a/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c b/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c index 317e5edecd..fcf546105b 100644 --- a/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c +++ b/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2013. All Rights Reserved. + * Copyright Ericsson AB 2004-2014. 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 @@ -32,9 +32,33 @@ /*#define MESSAGE(FMT,A1,A2) message(FMT,A1,A2)*/ #define MESSAGE(FMT,A1,A2) -typedef int decodeFT(const char *buf, int *index, void*); -typedef int encodeFT(char *buf, int *index, void*); -typedef int x_encodeFT(ei_x_buff*, void*); + +typedef struct +{ + char name[MAXATOMLEN_UTF8]; + erlang_char_encoding enc; +}my_atom; + +struct my_obj { + union { + erlang_fun fun; + erlang_pid pid; + erlang_port port; + erlang_ref ref; + erlang_trace trace; + erlang_big big; + my_atom atom; + + int arity; + }u; + + int nterms; /* 0 for non-containers */ + char* startp; /* container start position in decode buffer */ +}; + +typedef int decodeFT(const char *buf, int *index, struct my_obj*); +typedef int encodeFT(char *buf, int *index, struct my_obj*); +typedef int x_encodeFT(ei_x_buff*, struct my_obj*); struct Type { char* name; @@ -44,11 +68,36 @@ struct Type { x_encodeFT* ei_x_encode_fp; }; -typedef struct -{ - char name[MAXATOMLEN_UTF8]; - erlang_char_encoding enc; -}my_atom; + +struct Type fun_type = { + "fun", "erlang_fun", (decodeFT*)ei_decode_fun, + (encodeFT*)ei_encode_fun, (x_encodeFT*)ei_x_encode_fun +}; + +struct Type pid_type = { + "pid", "erlang_pid", (decodeFT*)ei_decode_pid, + (encodeFT*)ei_encode_pid, (x_encodeFT*)ei_x_encode_pid +}; + +struct Type port_type = { + "port", "erlang_port", (decodeFT*)ei_decode_port, + (encodeFT*)ei_encode_port, (x_encodeFT*)ei_x_encode_port +}; + +struct Type ref_type = { + "ref", "erlang_ref", (decodeFT*)ei_decode_ref, + (encodeFT*)ei_encode_ref, (x_encodeFT*)ei_x_encode_ref +}; + +struct Type trace_type = { + "trace", "erlang_trace", (decodeFT*)ei_decode_trace, + (encodeFT*)ei_encode_trace, (x_encodeFT*)ei_x_encode_trace +}; + +struct Type big_type = { + "big", "erlang_big", (decodeFT*)ei_decode_big, + (encodeFT*)ei_encode_big, (x_encodeFT*)ei_x_encode_big +}; int ei_decode_my_atom(const char *buf, int *index, my_atom* a) { @@ -64,130 +113,274 @@ int ei_x_encode_my_atom(ei_x_buff* x, my_atom* a) return ei_x_encode_atom_as(x, a->name, ERLANG_UTF8, a->enc); } +struct Type my_atom_type = { + "atom", "my_atom", (decodeFT*)ei_decode_my_atom, + (encodeFT*)ei_encode_my_atom, (x_encodeFT*)ei_x_encode_my_atom +}; + + +int my_decode_tuple_header(const char *buf, int *index, struct my_obj* obj) +{ + int ret = ei_decode_tuple_header(buf, index, &obj->u.arity); + if (ret == 0 && obj) + obj->nterms = obj->u.arity; + return ret; +} + +int my_encode_tuple_header(char *buf, int *index, struct my_obj* obj) +{ + return ei_encode_tuple_header(buf, index, obj->u.arity); +} +int my_x_encode_tuple_header(ei_x_buff* x, struct my_obj* obj) +{ + return ei_x_encode_tuple_header(x, (long)obj->u.arity); +} + +struct Type tuple_type = { + "tuple_header", "arity", my_decode_tuple_header, + my_encode_tuple_header, my_x_encode_tuple_header +}; + + +int my_decode_list_header(const char *buf, int *index, struct my_obj* obj) +{ + int ret = ei_decode_list_header(buf, index, &obj->u.arity); + if (ret == 0 && obj) { + obj->nterms = obj->u.arity + 1; + } + return ret; +} +int my_encode_list_header(char *buf, int *index, struct my_obj* obj) +{ + return ei_encode_list_header(buf, index, obj->u.arity); +} +int my_x_encode_list_header(ei_x_buff* x, struct my_obj* obj) +{ + return ei_x_encode_list_header(x, (long)obj->u.arity); +} + +struct Type list_type = { + "list_header", "arity", my_decode_list_header, + my_encode_list_header, my_x_encode_list_header +}; + + +int my_decode_nil(const char *buf, int *index, struct my_obj* dummy) +{ + int type, size, ret; + ret = ei_get_type(buf, index, &type, &size); + (*index)++; + return ret ? ret : !(type == ERL_NIL_EXT); + +} +int my_encode_nil(char *buf, int *index, struct my_obj* dummy) +{ + return ei_encode_empty_list(buf, index); +} + +int my_x_encode_nil(ei_x_buff* x, struct my_obj* dummy) +{ + return ei_x_encode_empty_list(x); +} + +struct Type nil_type = { + "empty_list", "nil", my_decode_nil, + my_encode_nil, my_x_encode_nil +}; + +int my_decode_map_header(const char *buf, int *index, struct my_obj* obj) +{ + int ret = ei_decode_map_header(buf, index, &obj->u.arity); + if (ret == 0 && obj) + obj->nterms = obj->u.arity * 2; + return ret; +} +int my_encode_map_header(char *buf, int *index, struct my_obj* obj) +{ + return ei_encode_map_header(buf, index, obj->u.arity); +} +int my_x_encode_map_header(ei_x_buff* x, struct my_obj* obj) +{ + return ei_x_encode_map_header(x, (long)obj->u.arity); +} + +struct Type map_type = { + "map_header", "arity", my_decode_map_header, + my_encode_map_header, my_x_encode_map_header +}; + + #define BUFSZ 2000 -void decode_encode(struct Type* t, void* obj) +void decode_encode(struct Type** tv, int nobj) { - char *buf; - char buf2[BUFSZ]; - int size1 = 0; - int size2 = 0; - int size3 = 0; - int err; + struct my_obj objv[10]; + int oix = 0; + char* packet; + char* inp; + char* outp; + char out_buf[BUFSZ]; + int size1, size2, size3; + int err, i; ei_x_buff arg; - MESSAGE("ei_decode_%s, arg is type %s", t->name, t->type); - buf = read_packet(NULL); - err = t->ei_decode_fp(buf+1, &size1, NULL); - if (err != 0) { - if (err != -1) { - fail("decode returned non zero but not -1"); - } else { - fail("decode returned non zero"); + packet = read_packet(NULL); + inp = packet+1; + outp = out_buf; + ei_x_new(&arg); + for (i=0; i<nobj; i++) { + struct Type* t = tv[i]; + + MESSAGE("ei_decode_%s, arg is type %s", t->name, t->type); + + size1 = 0; + err = t->ei_decode_fp(inp, &size1, NULL); + if (err != 0) { + if (err != -1) { + fail("decode returned non zero but not -1"); + } else { + fail("decode returned non zero"); + } + return; + } + if (size1 < 1) { + fail("size is < 1"); + return; } - return; - } - if (size1 < 1) { - fail("size is < 1"); - return; - } - if (size1 > BUFSZ) { - fail("size is > BUFSZ"); - return; - } + if (size1 > BUFSZ) { + fail("size is > BUFSZ"); + return; + } - err = t->ei_decode_fp(buf+1, &size2, obj); - if (err != 0) { - if (err != -1) { - fail("decode returned non zero but not -1"); - } else { - fail("decode returned non zero"); + size2 = 0; + objv[oix].nterms = 0; + objv[oix].startp = inp; + err = t->ei_decode_fp(inp, &size2, &objv[oix]); + if (err != 0) { + if (err != -1) { + fail("decode returned non zero but not -1"); + } else { + fail("decode returned non zero"); + } + return; + } + if (size1 != size2) { + MESSAGE("size1 = %d, size2 = %d\n",size1,size2); + fail("decode sizes differs"); + return; } - return; - } - if (size1 != size2) { - MESSAGE("size1 = %d, size2 = %d\n",size1,size2); - fail("decode sizes differs"); - return; - } - size2 = 0; - err = ei_skip_term(buf+1, &size2); - if (err != 0) { - fail("ei_skip_term returned non zero"); - return; - } - if (size1 != size2) { - MESSAGE("size1 = %d, size2 = %d\n",size1,size2); - fail("skip size differs"); - return; - } + if (!objv[oix].nterms) { + size2 = 0; + err = ei_skip_term(inp, &size2); + if (err != 0) { + fail("ei_skip_term returned non zero"); + return; + } + if (size1 != size2) { + MESSAGE("size1 = %d, size2 = %d\n",size1,size2); + fail("skip size differs"); + return; + } + } - MESSAGE("ei_encode_%s buf is NULL, arg is type %s", t->name, t->type); - size2 = 0; - err = t->ei_encode_fp(NULL, &size2, obj); - if (err != 0) { - if (err != -1) { - fail("size calculation returned non zero but not -1"); + MESSAGE("ei_encode_%s buf is NULL, arg is type %s", t->name, t->type); + size2 = 0; + err = t->ei_encode_fp(NULL, &size2, &objv[oix]); + if (err != 0) { + if (err != -1) { + fail("size calculation returned non zero but not -1"); + return; + } else { + fail("size calculation returned non zero"); + return; + } + } + if (size1 != size2) { + MESSAGE("size1 = %d, size2 = %d\n",size1,size2); + fail("decode and encode size differs when buf is NULL"); return; - } else { - fail("size calculation returned non zero"); + } + MESSAGE("ei_encode_%s, arg is type %s", t->name, t->type); + size3 = 0; + err = t->ei_encode_fp(outp, &size3, &objv[oix]); + if (err != 0) { + if (err != -1) { + fail("returned non zero but not -1"); + } else { + fail("returned non zero"); + } return; } - } - if (size1 != size2) { - MESSAGE("size1 = %d, size2 = %d\n",size1,size2); - fail("decode and encode size differs when buf is NULL"); - return; - } - MESSAGE("ei_encode_%s, arg is type %s", t->name, t->type); - err = t->ei_encode_fp(buf2, &size3, obj); - if (err != 0) { - if (err != -1) { - fail("returned non zero but not -1"); - } else { - fail("returned non zero"); + if (size1 != size3) { + MESSAGE("size1 = %d, size2 = %d\n",size1,size3); + fail("decode and encode size differs"); + return; } - return; - } - if (size1 != size3) { - MESSAGE("size1 = %d, size2 = %d\n",size1,size3); - fail("decode and encode size differs"); - return; - } - send_buffer(buf2, size1); - MESSAGE("ei_x_encode_%s, arg is type %s", t->name, t->type); - ei_x_new(&arg); - err = t->ei_x_encode_fp(&arg, obj); - if (err != 0) { - if (err != -1) { - fail("returned non zero but not -1"); - } else { - fail("returned non zero"); + MESSAGE("ei_x_encode_%s, arg is type %s", t->name, t->type); + err = t->ei_x_encode_fp(&arg, &objv[oix]); + if (err != 0) { + if (err != -1) { + fail("returned non zero but not -1"); + } else { + fail("returned non zero"); + } + ei_x_free(&arg); + return; } - ei_x_free(&arg); - return; + if (arg.index < 1) { + fail("size is < 1"); + ei_x_free(&arg); + return; + } + + inp += size1; + outp += size1; + + if (objv[oix].nterms) { /* container term */ + if (++oix >= sizeof(objv)/sizeof(*objv)) + fail("Term too deep"); + } + else { /* "leaf" term */ + while (oix > 0) { + if (--(objv[oix - 1].nterms) == 0) { + /* last element in container */ + --oix; + + size2 = 0; + err = ei_skip_term(objv[oix].startp, &size2); + if (err != 0) { + fail("ei_skip_term returned non zero"); + return; + } + if (objv[oix].startp + size2 != inp) { + MESSAGE("size1 = %d, size2 = %d\n", size1, size2); + fail("container skip size differs"); + return; + } + } + else + break; /* more elements in container */ + } + } + } - if (arg.index < 1) { - fail("size is < 1"); - ei_x_free(&arg); - return; + if (oix > 0) { + fail("Container not complete"); } + send_buffer(out_buf, outp - out_buf); send_buffer(arg.buff, arg.index); ei_x_free(&arg); + free_packet(packet); } +void decode_encode_one(struct Type* t) +{ + decode_encode(&t, 1); +} -#define EI_DECODE_ENCODE(TYPE, ERLANG_TYPE) { \ - struct Type type_struct = {#TYPE, #ERLANG_TYPE, \ - (decodeFT*)ei_decode_##TYPE, \ - (encodeFT*)ei_encode_##TYPE, \ - (x_encodeFT*)ei_x_encode_##TYPE }; \ - ERLANG_TYPE type_obj; \ - decode_encode(&type_struct, &type_obj); \ - } void decode_encode_big(struct Type* t) @@ -274,14 +467,6 @@ void decode_encode_big(struct Type* t) ei_free_big(p); } -#define EI_DECODE_ENCODE_BIG(TYPE, ERLANG_TYPE) { \ - struct Type type_struct = {#TYPE, #ERLANG_TYPE, \ - (decodeFT*)ei_decode_##TYPE, \ - (encodeFT*)ei_encode_##TYPE, \ - (x_encodeFT*)ei_x_encode_##TYPE }; \ - decode_encode_big(&type_struct); \ - } - /* ******************************************************************** */ @@ -290,34 +475,63 @@ TESTCASE(test_ei_decode_encode) { int i; - EI_DECODE_ENCODE(fun , erlang_fun); - EI_DECODE_ENCODE(pid , erlang_pid); - EI_DECODE_ENCODE(port , erlang_port); - EI_DECODE_ENCODE(ref , erlang_ref); - EI_DECODE_ENCODE(trace, erlang_trace); + decode_encode_one(&fun_type); + decode_encode_one(&pid_type); + decode_encode_one(&port_type); + decode_encode_one(&ref_type); + decode_encode_one(&trace_type); - EI_DECODE_ENCODE_BIG(big , erlang_big); - EI_DECODE_ENCODE_BIG(big , erlang_big); - EI_DECODE_ENCODE_BIG(big , erlang_big); + decode_encode_big(&big_type); + decode_encode_big(&big_type); + decode_encode_big(&big_type); - EI_DECODE_ENCODE_BIG(big , erlang_big); - EI_DECODE_ENCODE_BIG(big , erlang_big); - EI_DECODE_ENCODE_BIG(big , erlang_big); + decode_encode_big(&big_type); + decode_encode_big(&big_type); + decode_encode_big(&big_type); /* Test large node containers... */ - EI_DECODE_ENCODE(pid , erlang_pid); - EI_DECODE_ENCODE(port , erlang_port); - EI_DECODE_ENCODE(ref , erlang_ref); - EI_DECODE_ENCODE(pid , erlang_pid); - EI_DECODE_ENCODE(port , erlang_port); - EI_DECODE_ENCODE(ref , erlang_ref); + decode_encode_one(&pid_type); + decode_encode_one(&port_type); + decode_encode_one(&ref_type); + decode_encode_one(&pid_type); + decode_encode_one(&port_type); + decode_encode_one(&ref_type); /* Unicode atoms */ for (i=0; i<24; i++) { - EI_DECODE_ENCODE(my_atom, my_atom); - EI_DECODE_ENCODE(pid, erlang_pid); - EI_DECODE_ENCODE(port, erlang_port); - EI_DECODE_ENCODE(ref, erlang_ref); + decode_encode_one(&my_atom_type); + decode_encode_one(&pid_type); + decode_encode_one(&port_type); + decode_encode_one(&ref_type); + } + + decode_encode_one(&tuple_type); /* {} */ + { + struct Type* tpl[] = { &tuple_type, &my_atom_type, &pid_type, &port_type, &ref_type }; + decode_encode(tpl, 5); + } + + { + struct Type* list[] = { &list_type, &my_atom_type, &pid_type, &port_type, &ref_type, &nil_type }; + decode_encode(list, 6); + } + { + struct Type* list[] = { &list_type, &my_atom_type, &fun_type }; + decode_encode(list, 3); + } + decode_encode_one(&map_type); /* #{} */ + { /* #{atom => atom}*/ + struct Type* map[] = { &map_type, &my_atom_type, &my_atom_type }; + decode_encode(map, 3); + } + + { /* #{atom => atom, atom => pid, port => ref }*/ + struct Type* map[] = { &map_type, + &my_atom_type, &my_atom_type, + &my_atom_type, &pid_type, + &port_type, &ref_type + }; + decode_encode(map, 7); } report(1); diff --git a/lib/erl_interface/vsn.mk b/lib/erl_interface/vsn.mk index f386ce09a8..8731283265 100644 --- a/lib/erl_interface/vsn.mk +++ b/lib/erl_interface/vsn.mk @@ -1 +1,2 @@ -EI_VSN = 3.7.15 +EI_VSN = 3.7.16 +ERL_INTERFACE_VSN = $(EI_VSN) diff --git a/lib/et/src/et.app.src b/lib/et/src/et.app.src index f7189a4197..c26d9320d8 100644 --- a/lib/et/src/et.app.src +++ b/lib/et/src/et.app.src @@ -31,5 +31,7 @@ ]}, {registered, [et_collector]}, {applications, [stdlib, kernel]}, - {env, []} + {env, []}, + {runtime_dependencies, ["wx-1.2","stdlib-2.0","runtime_tools-1.8.14", + "kernel-3.0","erts-6.0"]} ]}. diff --git a/lib/et/vsn.mk b/lib/et/vsn.mk index 282991aa49..a47be678ca 100644 --- a/lib/et/vsn.mk +++ b/lib/et/vsn.mk @@ -1 +1 @@ -ET_VSN = 1.4.4.5 +ET_VSN = 1.5 diff --git a/lib/eunit/src/eunit.app.src b/lib/eunit/src/eunit.app.src index 5e16dfa2ce..7a3978e200 100644 --- a/lib/eunit/src/eunit.app.src +++ b/lib/eunit/src/eunit.app.src @@ -18,4 +18,5 @@ eunit_tty]}, {registered,[]}, {applications, [kernel,stdlib]}, - {env, []}]}. + {env, []}, + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0"]}]}. diff --git a/lib/eunit/vsn.mk b/lib/eunit/vsn.mk index 8f816b3b94..f04c0536fe 100644 --- a/lib/eunit/vsn.mk +++ b/lib/eunit/vsn.mk @@ -1 +1 @@ -EUNIT_VSN = 2.2.6 +EUNIT_VSN = 2.2.7 diff --git a/lib/gs/src/Makefile b/lib/gs/src/Makefile index 0a63d5466e..f0200caf01 100644 --- a/lib/gs/src/Makefile +++ b/lib/gs/src/Makefile @@ -72,7 +72,7 @@ IMAGES=../priv/bitmap/fup.bm # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -ERL_COMPILE_FLAGS += +warn_obsolete_guard +ERL_COMPILE_FLAGS += +warn_obsolete_guard -Werror # ---------------------------------------------------- # Targets diff --git a/lib/gs/src/gs.app.src b/lib/gs/src/gs.app.src index c83c9b54d7..c6f88e5144 100644 --- a/lib/gs/src/gs.app.src +++ b/lib/gs/src/gs.app.src @@ -10,4 +10,5 @@ gstk_window,tcl2erl,tool_file_dialog,tool_utils, gs_packer,gse]}, {registered, [gs_frontend]}, - {applications, [kernel, stdlib]}]}. + {applications, [kernel, stdlib]}, + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0"]}]}. diff --git a/lib/gs/src/gstk_generic.erl b/lib/gs/src/gstk_generic.erl index 9b0efd07c1..573b4e05bb 100644 --- a/lib/gs/src/gstk_generic.erl +++ b/lib/gs/src/gstk_generic.erl @@ -323,11 +323,11 @@ handle_external_opt_call([Opt|Options],Gstkid,TkW,DB,ExtraArg,ExtRes,S,P,C) -> end. handle_external_read(Res) -> - _ = case Res of - {bad_result,{Objtype,Reason,Option}} -> - {error,{Objtype,Reason,Option}}; - _ -> ok - end, + %% We have removed dead code here that attempted to translate + %% a bad return value from {bad_result,{A,B,C}} to {error,{A,B,C}}. + %% Since the gs application is deprecated, we don't want to introduce + %% a potential incompatibility; thus we have removed the dead code + %% instead of correcting it. Res. %%---------------------------------------------------------------------- diff --git a/lib/gs/vsn.mk b/lib/gs/vsn.mk index 5c18153c34..96786b300c 100644 --- a/lib/gs/vsn.mk +++ b/lib/gs/vsn.mk @@ -1,2 +1,2 @@ -GS_VSN = 1.5.15.2 +GS_VSN = 1.5.16 diff --git a/lib/hipe/Makefile b/lib/hipe/Makefile index a9e24f4d17..46cbc33ae2 100644 --- a/lib/hipe/Makefile +++ b/lib/hipe/Makefile @@ -22,7 +22,7 @@ include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk ifdef HIPE_ENABLED -HIPE_SUBDIRS = regalloc sparc ppc x86 amd64 arm opt tools +HIPE_SUBDIRS = regalloc sparc ppc x86 amd64 arm opt tools llvm else HIPE_SUBDIRS = endif diff --git a/lib/hipe/arm/hipe_arm_assemble.erl b/lib/hipe/arm/hipe_arm_assemble.erl index 2af786994e..e9de96a927 100644 --- a/lib/hipe/arm/hipe_arm_assemble.erl +++ b/lib/hipe/arm/hipe_arm_assemble.erl @@ -44,8 +44,8 @@ assemble(CompiledCode, Closures, Exports, Options) -> print("Total num bytes=~w\n", [CodeSize], Options), %% SC = hipe_pack_constants:slim_constmap(ConstMap), - DataRelocs = mk_data_relocs(RefsFromConsts, LabelMap), - SSE = slim_sorted_exportmap(ExportMap,Closures,Exports), + DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), + SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap,Closures,Exports), SlimRefs = hipe_pack_constants:slim_refs(AccRefs), Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, ConstAlign, ConstSize, @@ -320,7 +320,7 @@ do_pseudo_li(I, MFA, ConstMap, Address, PrevImms, PendImms) -> Atom when is_atom(Atom) -> {load_atom, Atom}; {Label,constant} -> - ConstNo = find_const({MFA,Label}, ConstMap), + ConstNo = hipe_pack_constants:find_const({MFA,Label}, ConstMap), {load_address, {constant,ConstNo}}; {Label,closure} -> {load_address, {closure,Label}}; @@ -518,37 +518,6 @@ fix_pc_refs(I, InsnAddress, FunAddress, LabelMap) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -mk_data_relocs(RefsFromConsts, LabelMap) -> - lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])). - -mk_data_relocs([{MFA,Labels} | Rest], LabelMap, Acc) -> - Map = [case Label of - {L,Pos} -> - Offset = find({MFA,L}, LabelMap), - {Pos,Offset}; - {sorted,Base,OrderedLabels} -> - {sorted, Base, [begin - Offset = find({MFA,L}, LabelMap), - {Order, Offset} - end - || {L,Order} <- OrderedLabels]} - end - || Label <- Labels], - %% msg("Map: ~w Map\n",[Map]), - mk_data_relocs(Rest, LabelMap, [Map,Acc]); -mk_data_relocs([],_,Acc) -> Acc. - -find({_MFA,_L} = MFAL, LabelMap) -> - gb_trees:get(MFAL, LabelMap). - -slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) -> - IsClosure = lists:member({M,F,A}, Closures), - IsExported = is_exported(F, A, Exports), - [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)]; -slim_sorted_exportmap([],_,_) -> []. - -is_exported(F, A, Exports) -> lists:member({F,A}, Exports). - %%% %%% Assembly listing support (pp_asm option). %%% @@ -594,17 +563,6 @@ fill_spaces(N) when N > 0 -> fill_spaces(0) -> []. -%%% -%%% Lookup a constant in a ConstMap. -%%% - -find_const({MFA,Label},[{pcm_entry,MFA,Label,ConstNo,_,_,_}|_]) -> - ConstNo; -find_const(N,[_|R]) -> - find_const(N,R); -find_const(C,[]) -> - ?EXIT({constant_not_found,C}). - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% diff --git a/lib/hipe/cerl/Makefile b/lib/hipe/cerl/Makefile index 506e993ff4..d13dfb33c2 100644 --- a/lib/hipe/cerl/Makefile +++ b/lib/hipe/cerl/Makefile @@ -42,8 +42,8 @@ RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN) # ---------------------------------------------------- # Target Specs # ---------------------------------------------------- -MODULES = cerl_cconv cerl_closurean cerl_hipeify \ - cerl_lib cerl_messagean cerl_pmatch cerl_prettypr cerl_to_icode \ +MODULES = cerl_cconv cerl_closurean cerl_hipeify cerl_lib \ + cerl_messagean cerl_pmatch cerl_prettypr cerl_to_icode \ cerl_typean erl_bif_types erl_types HRL_FILES= cerl_hipe_primops.hrl @@ -65,7 +65,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +inline +warn_exported_vars +warn_unused_import +warn_missing_spec# +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +inline +warn_exported_vars +warn_unused_import +warn_missing_spec #+warn_untyped_record # ---------------------------------------------------- # Targets @@ -107,7 +107,6 @@ release_spec: opt release_docs_spec: -$(EBIN)/cerl_to_icode.beam: cerl_hipe_primops.hrl ../icode/hipe_icode_primops.hrl +$(EBIN)/cerl_cconv.beam: cerl_hipe_primops.hrl $(EBIN)/cerl_hipeify.beam: cerl_hipe_primops.hrl -$(EBIN)/cerl_lambdalift.beam: cerl_hipe_primops.hrl -$(EBIN)/erl_bif_types.beam: ../icode/hipe_icode_primops.hrl +$(EBIN)/cerl_to_icode.beam: cerl_hipe_primops.hrl ../icode/hipe_icode_primops.hrl diff --git a/lib/hipe/cerl/cerl_to_icode.erl b/lib/hipe/cerl/cerl_to_icode.erl index 1c1c10d9b0..2645056be1 100644 --- a/lib/hipe/cerl/cerl_to_icode.erl +++ b/lib/hipe/cerl/cerl_to_icode.erl @@ -29,9 +29,9 @@ -define(NO_UNUSED, true). --export([module/2]). +-export([module/1, module/2]). -ifndef(NO_UNUSED). --export([function/3, function/4, module/1]). +-export([function/3, function/4]). -endif. %% Added in an attempt to suppress message by Dialyzer, but I run into @@ -102,36 +102,32 @@ %% Record definitions --record(ctxt, {final = false :: boolean(), - effect = false, - fail = [], % [] or fail-to label - class = expr, % expr | guard - line = 0, % current line number - 'receive' % undefined | #receive{} - }). - -record('receive', {loop}). -record(cerl_to_icode__var, {name}). -record('fun', {label, vars}). +-record(ctxt, {final = false :: boolean(), + effect = false :: boolean(), + fail = [], % [] or fail-to label + class = expr :: 'expr' | 'guard', + line = 0 :: erl_scan:line(), % current line number + 'receive' :: 'undefined' | #'receive'{} + }). %% --------------------------------------------------------------------- %% Code - -%% @spec module(Module::cerl()) -> [icode()] +%% @spec module(Module::cerl()) -> [{mfa(), icode()}] %% @equiv module(Module, []) --ifndef(NO_UNUSED). +-spec module(cerl:c_module()) -> [{mfa(), hipe_icode:icode()}]. + module(E) -> module(E, []). --endif. -%% @clear - -%% @spec module(Module::cerl(), Options::[term()]) -> [icode()] +%% @spec module(Module::cerl(), Options::[term()]) -> [{mfa(), icode()}] %% -%% cerl() = cerl:cerl() +%% cerl() = cerl:c_module() %% icode() = hipe_icode:icode() %% %% @doc Transforms a Core Erlang module to linear HiPE Icode. The result @@ -149,7 +145,7 @@ module(E) -> %% @see function/4 %% @see cerl_hipeify:transform/1 -%% -spec module(cerl:c_module(), [term()]) -> [{mfa(), hipe_icode:icode()}]. +-spec module(cerl:c_module(), [term()]) -> [{mfa(), hipe_icode:icode()}]. module(E, Options) -> module_1(cerl_hipeify:transform(E, Options), Options). @@ -163,8 +159,8 @@ module_1(E, Options) -> throw(error) end, S0 = init(M), - S1 = s__set_pmatch(proplists:get_value(pmatch, Options), S0), - S2 = s__set_bitlevel_binaries(proplists:get_value( + S1 = s__set_pmatch(proplists:get_value(pmatch, Options), S0), + S2 = s__set_bitlevel_binaries(proplists:get_value( bitlevel_binaries, Options), S1), {Icode, _} = lists:mapfoldl(fun function_definition/2, S2, cerl:module_defs(E)), diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 8b610ac893..a460f16272 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -912,7 +912,8 @@ type(erlang, system_info, 1, Xs, Opaques) -> t_list(t_pid()); ['os_type'] -> t_tuple([t_sup([t_atom('unix'), - t_atom('win32')]), + t_atom('win32'), + t_atom('ose')]), t_atom()]); ['os_version'] -> t_sup(t_tuple([t_non_neg_fixnum(), @@ -1072,14 +1073,14 @@ type(hipe_bifs, fun_to_address, 1, Xs, Opaques) -> %% type(hipe_bifs, get_emu_address, 1, Xs, Opaques) -> %% strict(hipe_bifs, get_emu_address, 1, Xs, %% fun (_) -> t_integer() end, Opaques); % address +type(hipe_bifs, get_fe, 2, Xs, Opaques) -> + strict(hipe_bifs, get_fe, 2, Xs, fun (_) -> t_integer() end, Opaques); type(hipe_bifs, get_rts_param, 1, Xs, Opaques) -> strict(hipe_bifs, get_rts_param, 1, Xs, fun (_) -> t_sup(t_integer(), t_nil()) end, Opaques); type(hipe_bifs, invalidate_funinfo_native_addresses, 1, Xs, Opaques) -> strict(hipe_bifs, invalidate_funinfo_native_addresses, 1, Xs, fun (_) -> t_nil() end, Opaques); -type(hipe_bifs, make_fe, 3, Xs, Opaques) -> - strict(hipe_bifs, make_fe, 3, Xs, fun (_) -> t_integer() end, Opaques); %% type(hipe_bifs, make_native_stub, 2, Xs, Opaques) -> %% strict(hipe_bifs, make_native_stub, 2, Xs, %% fun (_) -> t_integer() end, Opaques); % address @@ -1115,6 +1116,9 @@ type(hipe_bifs, set_funinfo_native_address, 3, Xs, Opaques) -> type(hipe_bifs, set_native_address, 3, Xs, Opaques) -> strict(hipe_bifs, set_native_address, 3, Xs, fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, set_native_address_in_fe, 2, Xs, Opaques) -> + strict(hipe_bifs, set_native_address_in_fe, 2, Xs, + fun (_) -> t_atom('true') end, Opaques); type(hipe_bifs, system_crc, 1, Xs, Opaques) -> strict(hipe_bifs, system_crc, 1, Xs, fun (_) -> t_crc32() end, Opaques); type(hipe_bifs, term_to_word, 1, Xs, Opaques) -> @@ -2450,12 +2454,12 @@ arg_types(hipe_bifs, fun_to_address, 1) -> [t_mfa()]; %% arg_types(hipe_bifs, get_emu_address, 1) -> %% [t_mfa()]; +arg_types(hipe_bifs, get_fe, 2) -> + [t_atom(), t_tuple([t_integer(), t_integer(), t_integer()])]; arg_types(hipe_bifs, get_rts_param, 1) -> [t_fixnum()]; arg_types(hipe_bifs, invalidate_funinfo_native_addresses, 1) -> [t_list(t_mfa())]; -arg_types(hipe_bifs, make_fe, 3) -> - [t_integer(), t_atom(), t_tuple([t_integer(), t_integer(), t_integer()])]; %% arg_types(hipe_bifs, make_native_stub, 2) -> %% [t_integer(), t_arity()]; arg_types(hipe_bifs, mark_referred_from, 1) -> @@ -2484,6 +2488,8 @@ arg_types(hipe_bifs, set_funinfo_native_address, 3) -> arg_types(hipe_bifs, set_native_address, 3); arg_types(hipe_bifs, set_native_address, 3) -> [t_mfa(), t_integer(), t_boolean()]; +arg_types(hipe_bifs, set_native_address_in_fe, 2) -> + [t_integer(), t_integer()]; arg_types(hipe_bifs, system_crc, 1) -> [t_crc32()]; arg_types(hipe_bifs, term_to_word, 1) -> diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 32390045e3..28281a2fac 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -218,6 +218,10 @@ %%-define(DO_ERL_TYPES_TEST, true). -compile({no_auto_import,[min/2,max/2]}). +%% HiPE does not understand Maps +%% (guard function is_map/1 in t_from_term/1) +-compile(no_native). + -ifdef(DO_ERL_TYPES_TEST). -export([test/0]). -else. @@ -498,9 +502,9 @@ t_contains_opaque(?int_range(_From, _To), _Opaques) -> false; t_contains_opaque(?int_set(_Set), _Opaques) -> false; t_contains_opaque(?list(Type, Tail, _), Opaques) -> t_contains_opaque(Type, Opaques) orelse t_contains_opaque(Tail, Opaques); -t_contains_opaque(?map(Pairs), Opaques) -> - list_contains_opaque([V||{_,V}<-Pairs], Opaques) orelse - list_contains_opaque([K||{K,_}<-Pairs], Opaques); +t_contains_opaque(?map(_) = Map, Opaques) -> + list_contains_opaque(map_values(Map), Opaques) orelse + list_contains_opaque(map_keys(Map), Opaques); t_contains_opaque(?matchstate(_P, _Slots), _Opaques) -> false; t_contains_opaque(?nil, _Opaques) -> false; t_contains_opaque(?number(_Set, _Tag), _Opaques) -> false; @@ -614,7 +618,7 @@ t_decorate_with_opaque(T1, T2, Opaques) -> end end. -decorate(?none=Type, _, _Opaques) -> Type; +decorate(Type, ?none, _Opaques) -> Type; decorate(?function(Domain, Range), ?function(D, R), Opaques) -> ?function(decorate(Domain, D, Opaques), decorate(Range, R, Opaques)); decorate(?list(Types, Tail, Size), ?list(Ts, Tl, _Sz), Opaques) -> @@ -680,6 +684,7 @@ union_decorate(U1, U2, Opaques) -> List = [A,B,F,I,L,N,T,M,Map], DecList = [Dec || E <- List, + not t_is_none(E), not t_is_none(Dec = decorate(E, Opaque, Opaques))], t_sup([Union|DecList]). @@ -2089,6 +2094,8 @@ t_has_var(?tuple(Elements, _, _)) -> t_has_var_list(Elements); t_has_var(?tuple_set(_) = T) -> t_has_var_list(t_tuple_subtypes(T)); +t_has_var(?map(_)= Map) -> + t_has_var_list(map_keys(Map)) orelse t_has_var_list(map_values(Map)); t_has_var(?opaque(Set)) -> %% Assume variables in 'args' are also present i 'struct' t_has_var_list([O#opaque.struct || O <- set_to_list(Set)]); @@ -2116,21 +2123,28 @@ t_collect_vars(?function(Domain, Range), Acc) -> t_collect_vars(?list(Contents, Termination, _), Acc) -> ordsets:union(t_collect_vars(Contents, Acc), t_collect_vars(Termination, [])); t_collect_vars(?product(Types), Acc) -> - lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc, Types); + t_collect_vars_list(Types, Acc); t_collect_vars(?tuple(?any, ?any, ?any), Acc) -> Acc; t_collect_vars(?tuple(Types, _, _), Acc) -> - lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc, Types); + t_collect_vars_list(Types, Acc); t_collect_vars(?tuple_set(_) = TS, Acc) -> - lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc, - t_tuple_subtypes(TS)); + t_collect_vars_list(t_tuple_subtypes(TS), Acc); +t_collect_vars(?map(_) = Map, Acc0) -> + Acc = t_collect_vars_list(map_keys(Map), Acc0), + t_collect_vars_list(map_values(Map), Acc); t_collect_vars(?opaque(Set), Acc) -> %% Assume variables in 'args' are also present i 'struct' - lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc, - [O#opaque.struct || O <- set_to_list(Set)]); + t_collect_vars_list([O#opaque.struct || O <- set_to_list(Set)], Acc); +t_collect_vars(?union(List), Acc) -> + t_collect_vars_list(List, Acc); t_collect_vars(_, Acc) -> Acc. +t_collect_vars_list([T|Ts], Acc0) -> + Acc = t_collect_vars(T, Acc0), + t_collect_vars_list(Ts, Acc); +t_collect_vars_list([], Acc) -> Acc. %%============================================================================= %% @@ -2156,6 +2170,7 @@ t_from_term(T) when is_integer(T) -> t_integer(T); t_from_term(T) when is_pid(T) -> t_pid(); t_from_term(T) when is_port(T) -> t_port(); t_from_term(T) when is_reference(T) -> t_reference(); +t_from_term(T) when is_map(T) -> t_map(); t_from_term(T) when is_tuple(T) -> t_tuple([t_from_term(E) || E <- tuple_to_list(T)]). @@ -3076,6 +3091,9 @@ t_subst_dict(?tuple(Elements, _Arity, _Tag), Dict) -> t_tuple([t_subst_dict(E, Dict) || E <- Elements]); t_subst_dict(?tuple_set(_) = TS, Dict) -> t_sup([t_subst_dict(T, Dict) || T <- t_tuple_subtypes(TS)]); +t_subst_dict(?map(Pairs), Dict) -> + ?map([{t_subst_dict(K, Dict), t_subst_dict(V, Dict)} || + {K, V} <- Pairs]); t_subst_dict(?opaque(Es), Dict) -> List = [Opaque#opaque{args = [t_subst_dict(Arg, Dict) || Arg <- Args], struct = t_subst_dict(S, Dict)} || @@ -3125,6 +3143,9 @@ t_subst_aux(?tuple(Elements, _Arity, _Tag), VarMap) -> t_tuple([t_subst_aux(E, VarMap) || E <- Elements]); t_subst_aux(?tuple_set(_) = TS, VarMap) -> t_sup([t_subst_aux(T, VarMap) || T <- t_tuple_subtypes(TS)]); +t_subst_aux(?map(Pairs), VarMap) -> + ?map([{t_subst_aux(K, VarMap), t_subst_aux(V, VarMap)} || + {K, V} <- Pairs]); t_subst_aux(?opaque(Es), VarMap) -> List = [Opaque#opaque{args = [t_subst_aux(Arg, VarMap) || Arg <- Args], struct = t_subst_aux(S, VarMap)} || @@ -3700,7 +3721,7 @@ t_unopaque(T) -> t_unopaque(?opaque(_) = T, Opaques) -> case Opaques =:= 'universe' orelse is_opaque_type(T, Opaques) of true -> t_unopaque(t_opaque_structure(T), Opaques); - false -> T % XXX: needs revision for parametric opaque data types + false -> T end; t_unopaque(?list(ElemT, Termination, Sz), Opaques) -> ?list(t_unopaque(ElemT, Opaques), t_unopaque(Termination, Opaques), Sz); @@ -3720,11 +3741,12 @@ t_unopaque(?union([A,B,F,I,L,N,T,M,O,R,Map]), Opaques) -> UL = t_unopaque(L, Opaques), UT = t_unopaque(T, Opaques), UF = t_unopaque(F, Opaques), + UMap = t_unopaque(Map, Opaques), {OF,UO} = case t_unopaque(O, Opaques) of ?opaque(_) = O1 -> {O1, []}; Type -> {?none, [Type]} end, - t_sup([?union([A,B,UF,I,UL,N,UT,M,OF,R,Map])|UO]); + t_sup([?union([A,B,UF,I,UL,N,UT,M,OF,R,UMap])|UO]); t_unopaque(T, _) -> T. @@ -4231,8 +4253,8 @@ t_from_form({type, _L, list, []}, _TypeNames, _RecDict, _VarDict) -> t_from_form({type, _L, list, [Type]}, TypeNames, RecDict, VarDict) -> {T, R} = t_from_form(Type, TypeNames, RecDict, VarDict), {t_list(T), R}; -t_from_form({type, _L, map, _}, _TypeNames, _RecDict, _VarDict) -> - {t_map([]), []}; +t_from_form({type, _L, map, _}, TypeNames, RecDict, VarDict) -> + builtin_type(map, t_map([]), TypeNames, RecDict, VarDict); t_from_form({type, _L, mfa, []}, _TypeNames, _RecDict, _VarDict) -> {t_mfa(), []}; t_from_form({type, _L, module, []}, _TypeNames, _RecDict, _VarDict) -> @@ -4695,6 +4717,12 @@ is_same_type_name2(gb_trees, gb_tree, [], gb_trees, tree, [_, _]) -> true; is_same_type_name2(gb_trees, tree, [_, _], gb_trees, gb_tree, []) -> true; is_same_type_name2(_, _, _, _, _, _) -> false. +map_keys(?map(Pairs)) -> + [K || {K, _} <- Pairs]. + +map_values(?map(Pairs)) -> + [V || {_, V} <- Pairs]. + %% ----------------------------------- %% Set %% diff --git a/lib/hipe/icode/hipe_icode.erl b/lib/hipe/icode/hipe_icode.erl index 0e651a351c..7b3d087e2d 100644 --- a/lib/hipe/icode/hipe_icode.erl +++ b/lib/hipe/icode/hipe_icode.erl @@ -503,7 +503,6 @@ enter_args_update/2, enter_type/1, is_enter/1, - mk_return/1, %% mk_return(Vars) %% mk_fail/1, %% mk_fail(Args) class = exit @@ -606,6 +605,12 @@ -export([highest_var/1, highest_label/1]). +%% +%% Exported types +%% + +-export_type([icode/0]). + %%--------------------------------------------------------------------- %% %% Icode @@ -614,7 +619,7 @@ -spec mk_icode(mfa(), [icode_var()], boolean(), boolean(), [icode_instr()], {non_neg_integer(),non_neg_integer()}, - {icode_lbl(),icode_lbl()}) -> #icode{}. + {icode_lbl(),icode_lbl()}) -> icode(). mk_icode(Fun, Params, IsClosure, IsLeaf, Code, VarRange, LabelRange) -> #icode{'fun'=Fun, params=Params, code=Code, is_closure=IsClosure, @@ -1434,8 +1439,8 @@ subst1([_|Pairs], I) -> subst1(Pairs, I). %% %% @doc Returns the successors of an Icode instruction. %% In CFG form only branch instructions have successors, -%% but in linear form other instructions like e.g. moves and -%% others might be the last instruction of some basic block. +%% but in linear form other instructions like e.g. moves +%% might be the last instruction of some basic block. %% -spec successors(icode_instr()) -> [icode_lbl()]. diff --git a/lib/hipe/icode/hipe_icode.hrl b/lib/hipe/icode/hipe_icode.hrl index 060493e61e..25deac5152 100644 --- a/lib/hipe/icode/hipe_icode.hrl +++ b/lib/hipe/icode/hipe_icode.hrl @@ -178,5 +178,6 @@ var_range :: {non_neg_integer(), non_neg_integer()}, label_range :: {icode_lbl(), icode_lbl()}, info = [] :: icode_info()}). +-type icode() :: #icode{}. %%--------------------------------------------------------------------- diff --git a/lib/hipe/icode/hipe_icode_fp.erl b/lib/hipe/icode/hipe_icode_fp.erl index c0cd9bd2d1..38b3881a77 100644 --- a/lib/hipe/icode/hipe_icode_fp.erl +++ b/lib/hipe/icode/hipe_icode_fp.erl @@ -424,7 +424,7 @@ redirect_phis([I|Is] = Code, OldFrom, NewFrom, Acc) -> NewI = hipe_icode:phi_redirect_pred(I, OldFrom, NewFrom), redirect_phis(Is, OldFrom, NewFrom, [NewI|Acc]); _ -> - lists:reverse(Acc) ++ Code + lists:reverse(Acc, Code) end; redirect_phis([], _OldFrom, _NewFrom, Acc) -> lists:reverse(Acc). diff --git a/lib/hipe/icode/hipe_icode_mulret.erl b/lib/hipe/icode/hipe_icode_mulret.erl index 2402bad42c..99522f6430 100644 --- a/lib/hipe/icode/hipe_icode_mulret.erl +++ b/lib/hipe/icode/hipe_icode_mulret.erl @@ -1166,9 +1166,9 @@ printCallList([]) -> io:format("~n"). %% removeUnElems([#icode_call{'fun'={unsafe_element,_}, args=Var}|List], Var, Res) -> %% removeUnElems(List, Var, Res); %% removeUnElems([I=#icode_move{dst=Var}|List], [Var], Res) -> -%% lists:reverse(Res) ++ [I|List]; +%% lists:reverse(Res, [I|List]); %% removeUnElems([I=#icode_call{dstlist=Var}|List], Var, Res) -> -%% lists:reverse(Res) ++ [I|List]; +%% lists:reverse(Res, [I|List]); %% removeUnElems([I|List], Var, Res) -> %% removeUnElems(List, Var, [I|Res]); %% removeUnElems([], _, Res) -> lists:reverse(Res). @@ -1187,7 +1187,7 @@ printCallList([]) -> io:format("~n"). %% false -> %% case lists:member(Var, Defs) of %% true -> -%% lists:reverse(Res) ++ [I|List]; +%% lists:reverse(Res, [I|List]); %% false -> %% removeUnElems(List, Var, [I|Res]) %% end @@ -1195,7 +1195,7 @@ printCallList([]) -> io:format("~n"). %% false -> %% case lists:member(Var, Defs) of %% true -> -%% lists:reverse(Res) ++ [I|List]; +%% lists:reverse(Res, [I|List]); %% false -> %% removeUnElems(List, Var, [I|Res]) %% end @@ -1203,7 +1203,7 @@ printCallList([]) -> io:format("~n"). %% false -> %% case lists:member(Var, Defs) of %% true -> -%% lists:reverse(Res) ++ [I|List]; +%% lists:reverse(Res, [I|List]); %% false -> %% removeUnElems(List, Var, [I|Res]) %% end @@ -1248,16 +1248,16 @@ printCallList([]) -> io:format("~n"). %% modifyCode([I|Code], Var, Res) -> %% case scanInstr(I, Var) of %% {move, Arity, VarLst} -> -%% Code2 = [#icode_return{vars=VarLst}, I |lists:reverse(Res) ++ Code], +%% Code2 = [#icode_return{vars=VarLst}, I |lists:reverse(Res, Code)], %% {Arity, lists:reverse(Code2)}; %% {mktuple, Arity, VarLst} -> -%% Code2 = [#icode_return{vars=VarLst}|lists:reverse(Res) ++ Code], +%% Code2 = [#icode_return{vars=VarLst}|lists:reverse(Res, Code)], %% {Arity, lists:reverse(Code2)}; %% other -> %% modifyCode(Code, Var, [I|Res]) %% end; %% modifyCode([], Var, Res) -> -%% {1, lists:reverse(Res) ++ [#icode_return{vars=Var}]}. +%% {1, lists:reverse(Res, [#icode_return{vars=Var}]}. %% scanInstr(#icode_call{dstlist=Var, 'fun'=mktuple, args=Lst}, Var) -> %% {mktuple, length(Lst), Lst}; diff --git a/lib/hipe/llvm/Makefile b/lib/hipe/llvm/Makefile new file mode 100644 index 0000000000..92f378924a --- /dev/null +++ b/lib/hipe/llvm/Makefile @@ -0,0 +1,109 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2001-2014. 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% +# + +ifndef EBIN +EBIN = ../ebin +endif + +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../vsn.mk +VSN=$(HIPE_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- +ifdef HIPE_ENABLED +HIPE_MODULES = hipe_rtl_to_llvm \ + hipe_llvm \ + elf_format \ + hipe_llvm_main \ + hipe_llvm_merge \ + hipe_llvm_liveness +else +HIPE_MODULES = +endif + +MODULES = $(HIPE_MODULES) + +HRL_FILES= elf_format.hrl elf32_format.hrl elf64_format.hrl \ + hipe_llvm_arch.hrl +ERL_FILES= $(MODULES:%=%.erl) +TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) + +# APP_FILE= +# App_SRC= $(APP_FILE).src +# APP_TARGET= $(EBIN)/$(APP_FILE) +# +# APPUP_FILE= +# APPUP_SRC= $(APPUP_FILE).src +# APPUP_TARGET= $(EBIN)/$(APPUP_FILE) + +# ---------------------------------------------------- +# FLAGS: Please keep +inline below +# ---------------------------------------------------- + +include ../native.mk + +ERL_COMPILE_FLAGS += +inline #+warn_missing_spec + +# if in 32 bit backend define BIT32 symbol +ARCH = $(shell echo $(TARGET) | sed 's/^\(x86_64\)-.*/64bit/') +ifneq ($(ARCH), 64bit) +ERL_COMPILE_FLAGS += -DBIT32 +endif + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt: $(TARGET_FILES) + +docs: + +clean: + rm -f $(TARGET_FILES) + rm -f core erl_crash.dump + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/llvm + $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/llvm + $(INSTALL_DIR) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin + +release_docs_spec: diff --git a/lib/hipe/llvm/elf32_format.hrl b/lib/hipe/llvm/elf32_format.hrl new file mode 100644 index 0000000000..af1d95bf5b --- /dev/null +++ b/lib/hipe/llvm/elf32_format.hrl @@ -0,0 +1,59 @@ +%% -*- erlang-indent-level: 2 -*- + +%%% @copyright 2011-2014 Yiannis Tsiouris <[email protected]>, +%%% Chris Stavrakakis <[email protected]> +%%% @author Yiannis Tsiouris <[email protected]> +%%% [http://www.softlab.ntua.gr/~gtsiour/] + +%%% @doc This header file contains very very useful macros for handling +%%% various segments of an ELF-32 formated object file, such as sizes, +%%% offsets and predefined constants. For further information about +%%% each field take a quick look at +%%% "[http://www.sco.com/developers/gabi/latest/contents.html]" +%%% that contain the current HP/Intel definition of the ELF object +%%% file format. + +%%------------------------------------------------------------------------------ +%% ELF-32 Data Types (in bytes) +%%------------------------------------------------------------------------------ +-define(ELF_ADDR_SIZE, 4). +-define(ELF_OFF_SIZE, 4). +-define(ELF_HALF_SIZE, 2). +-define(ELF_WORD_SIZE, 4). +-define(ELF_SWORD_SIZE, 4). +-define(ELF_XWORD_SIZE, ?ELF_WORD_SIZE). % for compatibility +-define(ELF_SXWORD_SIZE, ?ELF_WORD_SIZE). +-define(ELF_UNSIGNED_CHAR_SIZE, 1). + +%%------------------------------------------------------------------------------ +%% ELF-32 Symbol Table Entries +%%------------------------------------------------------------------------------ +%% Precomputed offset for Symbol Table entries in SymTab binary (needed because +%% of the different offsets in 32 and 64 bit formats). +-define(ST_NAME_OFFSET, 0). +-define(ST_VALUE_OFFSET, (?ST_NAME_OFFSET + ?ST_NAME_SIZE) ). +-define(ST_SIZE_OFFSET, (?ST_VALUE_OFFSET + ?ST_VALUE_SIZE) ). +-define(ST_INFO_OFFSET, (?ST_SIZE_OFFSET + ?ST_SIZE_SIZE) ). +-define(ST_OTHER_OFFSET, (?ST_INFO_OFFSET + ?ST_INFO_SIZE) ). +-define(ST_SHNDX_OFFSET, (?ST_OTHER_OFFSET + ?ST_OTHER_SIZE) ). + +%%------------------------------------------------------------------------------ +%% ELF-64 Relocation Entries +%%------------------------------------------------------------------------------ +%% Useful macros to extract information from r_info field +-define(ELF_R_SYM(I), (I bsr 8) ). +-define(ELF_R_TYPE(I), (I band 16#ff) ). +-define(ELF_R_INFO(S, T), ((S bsl 8) + (T band 16#ff)) ). + +%%------------------------------------------------------------------------------ +%% ELF-64 Program Header Table +%%------------------------------------------------------------------------------ +%% Offsets of various fields in a Program Header Table entry binary. +-define(P_TYPE_OFFSET, 0). +-define(P_OFFSET_OFFSET, (?P_FLAGS_OFFSET + ?P_FLAGS_SIZE) ). +-define(P_VADDR_OFFSET, (?P_OFFSET_OFFSET + ?P_OFFSET_SIZE) ). +-define(P_PADDR_OFFSET, (?P_VADDR_OFFSET + ?P_VADDR_SIZE) ). +-define(P_FILESZ_OFFSET, (?P_PVADDR_OFFSET + ?P_PVADDR_SIZE) ). +-define(P_MEMSZ_OFFSET, (?P_FILESZ_OFFSET + ?P_FILESZ_SIZE) ). +-define(P_FLAGS_OFFSET, (?P_TYPE_OFFSET + ?P_TYPE_SIZE) ). +-define(P_ALIGN_OFFSET, (?P_MEMSZ_OFFSET + ?P_MEMSZ_SIZE) ). diff --git a/lib/hipe/llvm/elf64_format.hrl b/lib/hipe/llvm/elf64_format.hrl new file mode 100644 index 0000000000..794746ffdc --- /dev/null +++ b/lib/hipe/llvm/elf64_format.hrl @@ -0,0 +1,58 @@ +%% -*- erlang-indent-level: 2 -*- + +%%% @copyright 2011-2014 Yiannis Tsiouris <[email protected]>, +%%% Chris Stavrakakis <[email protected]> +%%% @author Yiannis Tsiouris <[email protected]> +%%% [http://www.softlab.ntua.gr/~gtsiour/] + +%%% @doc This header file contains very very useful macros for handling +%%% various segments of an ELF-64 formated object file, such as sizes, +%%% offsets and predefined constants. For further information about +%%% each field take a quick look at +%%% "[http://downloads.openwatcom.org/ftp/devel/docs/elf-64-gen.pdf]" +%%% that contain the current HP/Intel definition of the ELF object +%%% file format. + +%%------------------------------------------------------------------------------ +%% ELF-64 Data Types (in bytes) +%%------------------------------------------------------------------------------ +-define(ELF_ADDR_SIZE, 8). +-define(ELF_OFF_SIZE, 8). +-define(ELF_HALF_SIZE, 2). +-define(ELF_WORD_SIZE, 4). +-define(ELF_SWORD_SIZE, 4). +-define(ELF_XWORD_SIZE, 8). +-define(ELF_SXWORD_SIZE, 8). +-define(ELF_UNSIGNED_CHAR_SIZE, 1). + +%%------------------------------------------------------------------------------ +%% ELF-64 Symbol Table Entries +%%------------------------------------------------------------------------------ +%% Precomputed offset for Symbol Table entries in SymTab binary +-define(ST_NAME_OFFSET, 0). +-define(ST_INFO_OFFSET, (?ST_NAME_OFFSET + ?ST_NAME_SIZE) ). +-define(ST_OTHER_OFFSET, (?ST_INFO_OFFSET + ?ST_INFO_SIZE) ). +-define(ST_SHNDX_OFFSET, (?ST_OTHER_OFFSET + ?ST_OTHER_SIZE) ). +-define(ST_VALUE_OFFSET, (?ST_SHNDX_OFFSET + ?ST_SHNDX_SIZE) ). +-define(ST_SIZE_OFFSET, (?ST_VALUE_OFFSET + ?ST_VALUE_SIZE) ). + +%%------------------------------------------------------------------------------ +%% ELF-64 Relocation Entries +%%------------------------------------------------------------------------------ +%% Useful macros to extract information from r_info field +-define(ELF_R_SYM(I), (I bsr 32) ). +-define(ELF_R_TYPE(I), (I band 16#ffffffff) ). +-define(ELF_R_INFO(S, T), ((S bsl 32) + (T band 16#ffffffff)) ). + +%%------------------------------------------------------------------------------ +%% ELF-64 Program Header Table +%%------------------------------------------------------------------------------ +%% Offsets of various fields in a Program Header Table entry binary. +-define(P_TYPE_OFFSET, 0). +-define(P_FLAGS_OFFSET, (?P_TYPE_OFFSET + ?P_TYPE_SIZE) ). +-define(P_OFFSET_OFFSET, (?P_FLAGS_OFFSET + ?P_FLAGS_SIZE) ). +-define(P_VADDR_OFFSET, (?P_OFFSET_OFFSET + ?P_OFFSET_SIZE) ). +-define(P_PADDR_OFFSET, (?P_VADDR_OFFSET + ?P_VADDR_SIZE) ). +-define(P_FILESZ_OFFSET, (?P_PVADDR_OFFSET + ?P_PVADDR_SIZE) ). +-define(P_MEMSZ_OFFSET, (?P_FILESZ_OFFSET + ?P_FILESZ_SIZE) ). +-define(P_ALIGN_OFFSET, (?P_MEMSZ_OFFSET + ?P_MEMSZ_SIZE) ). diff --git a/lib/hipe/llvm/elf_format.erl b/lib/hipe/llvm/elf_format.erl new file mode 100644 index 0000000000..260da9b5e6 --- /dev/null +++ b/lib/hipe/llvm/elf_format.erl @@ -0,0 +1,790 @@ +%% -*- erlang-indent-level: 2 -*- + +%%% @copyright 2011-2014 Yiannis Tsiouris <[email protected]>, +%%% Chris Stavrakakis <[email protected]>, +%%% Kostis Sagonas <[email protected]> +%%% @author Yiannis Tsiouris <[email protected]> +%%% [http://www.softlab.ntua.gr/~gtsiour/] + +%%% @doc This module contains functions for extracting various pieces of +%%% information from an ELF formated Object file. To fully understand +%%% the ELF format and the use of these functions please read +%%% "[http://www.linuxjournal.com/article/1060?page=0,0]" carefully. + +-module(elf_format). + +-export([get_tab_entries/1, + %% Relocations + get_rodata_relocs/1, + get_text_relocs/1, + extract_rela/2, + get_rela_addends/1, + %% Note + extract_note/2, + %% Executable code + extract_text/1, + %% GCC Exception Table + get_exn_handlers/1, + %% Misc. + set_architecture_flag/1, + is64bit/0 + ]). + +-include("elf_format.hrl"). + +%%------------------------------------------------------------------------------ +%% Types +%%------------------------------------------------------------------------------ + +-type elf() :: binary(). + +-type lp() :: non_neg_integer(). % landing pad +-type num() :: non_neg_integer(). +-type index() :: non_neg_integer(). +-type offset() :: non_neg_integer(). +-type size() :: non_neg_integer(). +-type start() :: non_neg_integer(). + +-type info() :: index(). +-type nameoff() :: offset(). +-type valueoff() :: offset(). + +-type name() :: string(). +-type name_size() :: {name(), size()}. +-type name_sizes() :: [name_size()]. + +%%------------------------------------------------------------------------------ +%% Abstract Data Types and Accessors for ELF Structures. +%%------------------------------------------------------------------------------ + +%% File header +-record(elf_ehdr, {ident, % ELF identification + type, % Object file type + machine, % Machine Type + version, % Object file version + entry, % Entry point address + phoff, % Program header offset + shoff :: offset(), % Section header offset + flags, % Processor-specific flags + ehsize :: size(), % ELF header size + phentsize :: size(), % Size of program header entry + phnum :: num(), % Number of program header entries + shentsize :: size(), % Size of section header entry + shnum :: num(), % Number of section header entries + shstrndx :: index() % Section name string table index + }). +-type elf_ehdr() :: #elf_ehdr{}. + +-record(elf_ehdr_ident, {class, % File class + data, % Data encoding + version, % File version + osabi, % OS/ABI identification + abiversion, % ABI version + pad, % Start of padding bytes + nident % Size of e_ident[] + }). +%% -type elf_ehdr_ident() :: #elf_ehdr_ident{}. + +%% Section header entries +-record(elf_shdr, {name, % Section name + type, % Section type + flags, % Section attributes + addr, % Virtual address in memory + offset :: offset(), % Offset in file + size :: size(), % Size of section + link, % Link to other section + info, % Miscellaneous information + addralign, % Address align boundary + entsize % Size of entries, if section has table + }). +%% -type elf_shdr() :: #elf_shdr{}. + +%% Symbol table entries +-record(elf_sym, {name :: nameoff(), % Symbol name + info, % Type and Binding attributes + other, % Reserved + shndx, % Section table index + value :: valueoff(), % Symbol value + size :: size() % Size of object + }). +-type elf_sym() :: #elf_sym{}. + +%% Relocations +-record(elf_rel, {r_offset :: offset(), % Address of reference + r_info :: info() % Symbol index and type of relocation + }). +-type elf_rel() :: #elf_rel{}. + +-record(elf_rela, {r_offset :: offset(), % Address of reference + r_info :: info(), % Symbol index and type of relocation + r_addend :: offset() % Constant part of expression + }). +-type elf_rela() :: #elf_rela{}. + +%% %% Program header table +%% -record(elf_phdr, {type, % Type of segment +%% flags, % Segment attributes +%% offset, % Offset in file +%% vaddr, % Virtual address in memory +%% paddr, % Reserved +%% filesz, % Size of segment in file +%% memsz, % Size of segment in memory +%% align % Alignment of segment +%% }). + +%% %% GCC exception table +%% -record(elf_gccexntab, {lpbenc, % Landing pad base encoding +%% lpbase, % Landing pad base +%% ttenc, % Type table encoding +%% ttoff, % Type table offset +%% csenc, % Call-site table encoding +%% cstabsize, % Call-site table size +%% cstab :: cstab() % Call-site table +%% }). +%% -type elf_gccexntab() :: #elf_gccexntab{}. + +-record(elf_gccexntab_callsite, {start :: start(), % Call-site start + size :: size(), % Call-site size + lp :: lp(), % Call-site landing pad + % (exception handler) + onaction % On action (e.g. cleanup) + }). +%% -type elf_gccexntab_callsite() :: #elf_gccexntab_callsite{}. + +%%------------------------------------------------------------------------------ +%% Accessor Functions +%%------------------------------------------------------------------------------ + +%% File header +%% -spec mk_ehdr(...) -> elf_ehrd(). +mk_ehdr(Ident, Type, Machine, Version, Entry, Phoff, Shoff, Flags, Ehsize, + Phentsize, Phnum, Shentsize, Shnum, Shstrndx) -> + #elf_ehdr{ident = Ident, type = Type, machine = Machine, version = Version, + entry = Entry, phoff = Phoff, shoff = Shoff, flags = Flags, + ehsize = Ehsize, phentsize = Phentsize, phnum = Phnum, + shentsize = Shentsize, shnum = Shnum, shstrndx = Shstrndx}. + +%% -spec ehdr_shoff(elf_ehdr()) -> offset(). +%% ehdr_shoff(#elf_ehdr{shoff = Offset}) -> Offset. +%% +%% -spec ehdr_shentsize(elf_ehdr()) -> size(). +%% ehdr_shentsize(#elf_ehdr{shentsize = Size}) -> Size. +%% +%% -spec ehdr_shnum(elf_ehdr()) -> num(). +%% ehdr_shnum(#elf_ehdr{shnum = Num}) -> Num. +%% +%% -spec ehdr_shstrndx(elf_ehdr()) -> index(). +%% ehdr_shstrndx(#elf_ehdr{shstrndx = Index}) -> Index. + + +%%-spec mk_ehdr_ident(...) -> elf_ehdr_ident(). +mk_ehdr_ident(Class, Data, Version, OsABI, AbiVersion, Pad, Nident) -> + #elf_ehdr_ident{class = Class, data = Data, version = Version, osabi = OsABI, + abiversion = AbiVersion, pad = Pad, nident = Nident}. + +%%%------------------------- +%%% Section header entries +%%%------------------------- +mk_shdr(Name, Type, Flags, Addr, Offset, Size, Link, Info, AddrAlign, EntSize) -> + #elf_shdr{name = Name, type = Type, flags = Flags, addr = Addr, + offset = Offset, size = Size, link = Link, info = Info, + addralign = AddrAlign, entsize = EntSize}. + +%% -spec shdr_offset(elf_shdr()) -> offset(). +%% shdr_offset(#elf_shdr{offset = Offset}) -> Offset. +%% +%% -spec shdr_size(elf_shdr()) -> size(). +%% shdr_size(#elf_shdr{size = Size}) -> Size. + +%%%------------------------- +%%% Symbol Table Entries +%%%------------------------- +mk_sym(Name, Info, Other, Shndx, Value, Size) -> + #elf_sym{name = Name, info = Info, other = Other, + shndx = Shndx, value = Value, size = Size}. + +-spec sym_name(elf_sym()) -> nameoff(). +sym_name(#elf_sym{name = Name}) -> Name. + +%% -spec sym_value(elf_sym()) -> valueoff(). +%% sym_value(#elf_sym{value = Value}) -> Value. +%% +%% -spec sym_size(elf_sym()) -> size(). +%% sym_size(#elf_sym{size = Size}) -> Size. + +%%%------------------------- +%%% Relocations +%%%------------------------- +-spec mk_rel(offset(), info()) -> elf_rel(). +mk_rel(Offset, Info) -> + #elf_rel{r_offset = Offset, r_info = Info}. + +%% The following two functions capitalize on the fact that the two kinds of +%% relocation records (for 32- and 64-bit architectures have similar structure. + +-spec r_offset(elf_rel() | elf_rela()) -> offset(). +r_offset(#elf_rel{r_offset = Offset}) -> Offset; +r_offset(#elf_rela{r_offset = Offset}) -> Offset. + +-spec r_info(elf_rel() | elf_rela()) -> info(). +r_info(#elf_rel{r_info = Info}) -> Info; +r_info(#elf_rela{r_info = Info}) -> Info. + +-spec mk_rela(offset(), info(), offset()) -> elf_rela(). +mk_rela(Offset, Info, Addend) -> + #elf_rela{r_offset = Offset, r_info = Info, r_addend = Addend}. + +-spec rela_addend(elf_rela()) -> offset(). +rela_addend(#elf_rela{r_addend = Addend}) -> Addend. + +%% %%%------------------------- +%% %%% GCC exception table +%% %%%------------------------- +%% -type cstab() :: [elf_gccexntab_callsite()]. +%% +%% mk_gccexntab(LPbenc, LPbase, TTenc, TToff, CSenc, CStabsize, CStab) -> +%% #elf_gccexntab{lpbenc = LPbenc, lpbase = LPbase, ttenc = TTenc, +%% ttoff = TToff, csenc = CSenc, cstabsize = CStabsize, +%% cstab = CStab}. +%% +%% -spec gccexntab_cstab(elf_gccexntab()) -> cstab(). +%% gccexntab_cstab(#elf_gccexntab{cstab = CSTab}) -> CSTab. + +mk_gccexntab_callsite(Start, Size, LP, Action) -> + #elf_gccexntab_callsite{start = Start, size=Size, lp=LP, onaction=Action}. + +%% -spec gccexntab_callsite_start(elf_gccexntab_callsite()) -> start(). +%% gccexntab_callsite_start(#elf_gccexntab_callsite{start = Start}) -> Start. +%% +%% -spec gccexntab_callsite_size(elf_gccexntab_callsite()) -> size(). +%% gccexntab_callsite_size(#elf_gccexntab_callsite{size = Size}) -> Size. +%% +%% -spec gccexntab_callsite_lp(elf_gccexntab_callsite()) -> lp(). +%% gccexntab_callsite_lp(#elf_gccexntab_callsite{lp = LP}) -> LP. + +%%------------------------------------------------------------------------------ +%% Functions to manipulate the ELF File Header +%%------------------------------------------------------------------------------ + +%% @doc Extracts the File Header from an ELF formatted object file. Also sets +%% the ELF class variable in the process dictionary (used by many functions +%% in this and hipe_llvm_main modules). +-spec extract_header(elf()) -> elf_ehdr(). +extract_header(Elf) -> + Ehdr_bin = get_binary_segment(Elf, 0, ?ELF_EHDR_SIZE), + << %% Structural pattern matching on fields. + Ident_bin:?E_IDENT_SIZE/binary, + Type:?bits(?E_TYPE_SIZE)/integer-little, + Machine:?bits(?E_MACHINE_SIZE)/integer-little, + Version:?bits(?E_VERSION_SIZE)/integer-little, + Entry:?bits(?E_ENTRY_SIZE)/integer-little, + Phoff:?bits(?E_PHOFF_SIZE)/integer-little, + Shoff:?bits(?E_SHOFF_SIZE)/integer-little, + Flags:?bits(?E_FLAGS_SIZE)/integer-little, + Ehsize:?bits(?E_EHSIZE_SIZE)/integer-little, + Phentsize:?bits(?E_PHENTSIZE_SIZE)/integer-little, + Phnum:?bits(?E_PHNUM_SIZE)/integer-little, + Shentsize:?bits(?E_SHENTSIZE_SIZE)/integer-little, + Shnum:?bits(?E_SHENTSIZE_SIZE)/integer-little, + Shstrndx:?bits(?E_SHSTRNDX_SIZE)/integer-little + >> = Ehdr_bin, + <<16#7f, $E, $L, $F, Class, Data, Version, Osabi, Abiversion, + Pad:6/binary, Nident + >> = Ident_bin, + Ident = mk_ehdr_ident(Class, Data, Version, Osabi, + Abiversion, Pad, Nident), + mk_ehdr(Ident, Type, Machine, Version, Entry, Phoff, Shoff, Flags, + Ehsize, Phentsize, Phnum, Shentsize, Shnum, Shstrndx). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Section Header Entries +%%------------------------------------------------------------------------------ + +%% @doc Extracts the Section Header Table from an ELF formated Object File. +extract_shdrtab(Elf) -> + %% Extract File Header to get info about Section Header Offset (in bytes), + %% Entry Size (in bytes) and Number of entries + #elf_ehdr{shoff = ShOff, shentsize = ShEntsize, shnum = ShNum} = + extract_header(Elf), + %% Get actual Section header table (binary) + ShdrBin = get_binary_segment(Elf, ShOff, ShNum * ShEntsize), + get_shdrtab_entries(ShdrBin, []). + +get_shdrtab_entries(<<>>, Acc) -> + lists:reverse(Acc); +get_shdrtab_entries(ShdrBin, Acc) -> + <<%% Structural pattern matching on fields. + Name:?bits(?SH_NAME_SIZE)/integer-little, + Type:?bits(?SH_TYPE_SIZE)/integer-little, + Flags:?bits(?SH_FLAGS_SIZE)/integer-little, + Addr:?bits(?SH_ADDR_SIZE)/integer-little, + Offset:?bits(?SH_OFFSET_SIZE)/integer-little, + Size:?bits(?SH_SIZE_SIZE)/integer-little, + Link:?bits(?SH_LINK_SIZE)/integer-little, + Info:?bits(?SH_INFO_SIZE)/integer-little, + Addralign:?bits(?SH_ADDRALIGN_SIZE)/integer-little, + Entsize:?bits(?SH_ENTSIZE_SIZE)/integer-little, + MoreShdrE/binary + >> = ShdrBin, + ShdrE = mk_shdr(Name, Type, Flags, Addr, Offset, + Size, Link, Info, Addralign, Entsize), + get_shdrtab_entries(MoreShdrE, [ShdrE | Acc]). + +%% @doc Extracts a specific Entry of a Section Header Table. This function +%% takes as argument the Section Header Table (`SHdrTab') and the entry's +%% serial number (`EntryNum') and returns the entry (`shdr'). +get_shdrtab_entry(SHdrTab, EntryNum) -> + lists:nth(EntryNum + 1, SHdrTab). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Section Header String Table +%%------------------------------------------------------------------------------ + +%% @doc Extracts the Section Header String Table. This section is not a known +%% ELF Object File section. It is just a "hidden" table storing the +%% names of all sections that exist in current object file. +-spec extract_shstrtab(elf()) -> [name()]. +extract_shstrtab(Elf) -> + %% Extract Section Name String Table Index + #elf_ehdr{shstrndx = ShStrNdx} = extract_header(Elf), + ShHdrTab = extract_shdrtab(Elf), + %% Extract Section header entry and get actual Section-header String Table + #elf_shdr{offset = ShStrOffset, size = ShStrSize} = + get_shdrtab_entry(ShHdrTab, ShStrNdx), + case get_binary_segment(Elf, ShStrOffset, ShStrSize) of + <<>> -> %% Segment empty + []; + ShStrTab -> %% Convert to string table + [Name || {Name, _Size} <- get_names(ShStrTab)] + end. + +%%------------------------------------------------------------------------------ + +-spec get_tab_entries(elf()) -> [{name(), valueoff(), size()}]. +get_tab_entries(Elf) -> + SymTab = extract_symtab(Elf), + Ts = [{Name, Value, Size div ?ELF_XWORD_SIZE} + || #elf_sym{name = Name, value = Value, size = Size} <- SymTab, + Name =/= 0], + {NameIndices, ValueOffs, Sizes} = lists:unzip3(Ts), + %% Find the names of the symbols. + %% Get string table entries ([{Name, Offset in strtab section}]). Keep only + %% relevant entries: + StrTab = extract_strtab(Elf), + Relevant = [get_strtab_entry(StrTab, Off) || Off <- NameIndices], + %% Zip back to {Name, ValueOff, Size} + lists:zip3(Relevant, ValueOffs, Sizes). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Symbol Table +%%------------------------------------------------------------------------------ + +%% @doc Function that extracts Symbol Table from an ELF Object file. +extract_symtab(Elf) -> + Symtab_bin = extract_segment_by_name(Elf, ?SYMTAB), + get_symtab_entries(Symtab_bin, []). + +get_symtab_entries(<<>>, Acc) -> + lists:reverse(Acc); +get_symtab_entries(Symtab_bin, Acc) -> + <<SymE_bin:?ELF_SYM_SIZE/binary, MoreSymE/binary>> = Symtab_bin, + case is64bit() of + true -> + <<%% Structural pattern matching on fields. + Name:?bits(?ST_NAME_SIZE)/integer-little, + Info:?bits(?ST_INFO_SIZE)/integer-little, + Other:?bits(?ST_OTHER_SIZE)/integer-little, + Shndx:?bits(?ST_SHNDX_SIZE)/integer-little, + Value:?bits(?ST_VALUE_SIZE)/integer-little, + Size:?bits(?ST_SIZE_SIZE)/integer-little + >> = SymE_bin; + false -> + << %% Same fields in different order: + Name:?bits(?ST_NAME_SIZE)/integer-little, + Value:?bits(?ST_VALUE_SIZE)/integer-little, + Size:?bits(?ST_SIZE_SIZE)/integer-little, + Info:?bits(?ST_INFO_SIZE)/integer-little, + Other:?bits(?ST_OTHER_SIZE)/integer-little, + Shndx:?bits(?ST_SHNDX_SIZE)/integer-little + >> = SymE_bin + end, + SymE = mk_sym(Name, Info, Other, Shndx, Value, Size), + get_symtab_entries(MoreSymE, [SymE | Acc]). + +%% @doc Extracts a specific entry from the Symbol Table (as binary). +%% This function takes as arguments the Symbol Table (`SymTab') +%% and the entry's serial number and returns that entry (`sym'). +get_symtab_entry(SymTab, EntryNum) -> + lists:nth(EntryNum + 1, SymTab). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate String Table +%%------------------------------------------------------------------------------ + +%% @doc Extracts String Table from an ELF formated Object File. +-spec extract_strtab(elf()) -> [{string(), offset()}]. +extract_strtab(Elf) -> + Strtab_bin = extract_segment_by_name(Elf, ?STRTAB), + NamesSizes = get_names(Strtab_bin), + make_offsets(NamesSizes). + +%% @doc Returns the name of the symbol at the given offset. The string table +%% contains entries of the form {Name, Offset}. If no such offset exists +%% returns the empty string (`""'). +%% XXX: There might be a bug here because of the "compact" saving the ELF +%% format uses: e.g. only stores ".rela.text" for ".rela.text" and ".text". +get_strtab_entry(Strtab, Offset) -> + case lists:keyfind(Offset, 2, Strtab) of + {Name, Offset} -> Name; + false -> "" + end. + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Relocations +%%------------------------------------------------------------------------------ + +%% @doc This function gets as argument an ELF binary file and returns a list +%% with all .rela.rodata labels (i.e. constants and literals in code) +%% or an empty list if no ".rela.rodata" section exists in code. +-spec get_rodata_relocs(elf()) -> [offset()]. +get_rodata_relocs(Elf) -> + case is64bit() of + true -> + %% Only care about the addends (== offsets): + get_rela_addends(extract_rela(Elf, ?RODATA)); + false -> + %% Find offsets hardcoded in ".rodata" entry + %%XXX: Treat all 0s as padding and skip them! + [SkipPadding || SkipPadding <- extract_rodata(Elf), SkipPadding =/= 0] + end. + +-spec get_rela_addends([elf_rela()]) -> [offset()]. +get_rela_addends(RelaEntries) -> + [rela_addend(E) || E <- RelaEntries]. + +%% @doc Extract a list of the form `[{SymbolName, Offset}]' with all relocatable +%% symbols and their offsets in the code from the ".text" section. +-spec get_text_relocs(elf()) -> [{name(), offset()}]. +get_text_relocs(Elf) -> + %% Only care about the symbol table index and the offset: + NameOffsetTemp = [{?ELF_R_SYM(r_info(E)), r_offset(E)} + || E <- extract_rela(Elf, ?TEXT)], + {NameIndices, ActualOffsets} = lists:unzip(NameOffsetTemp), + %% Find the names of the symbols: + %% + %% Get those symbol table entries that are related to Text relocs: + Symtab = extract_symtab(Elf), + SymtabEs = [get_symtab_entry(Symtab, Index) || Index <- NameIndices], + %XXX: not zero-indexed! + %% Symbol table entries contain the offset of the name of the symbol in + %% String Table: + SymtabEs2 = [sym_name(E) || E <- SymtabEs], %XXX: Do we need to sort SymtabE? + %% Get string table entries ([{Name, Offset in strtab section}]). Keep only + %% relevant entries: + Strtab = extract_strtab(Elf), + Relevant = [get_strtab_entry(Strtab, Off) || Off <- SymtabEs2], + %% Zip back with actual offsets: + lists:zip(Relevant, ActualOffsets). + +%% @doc Extract the Relocations segment for section `Name' (that is passed +%% as second argument) from an ELF formated Object file binary. +-spec extract_rela(elf(), name()) -> [elf_rel() | elf_rela()]. +extract_rela(Elf, Name) -> + SegName = + case is64bit() of + true -> ?RELA(Name); % ELF-64 uses ".rela" + false -> ?REL(Name) % ...while ELF-32 uses ".rel" + end, + Rela_bin = extract_segment_by_name(Elf, SegName), + get_rela_entries(Rela_bin, []). + +get_rela_entries(<<>>, Acc) -> + lists:reverse(Acc); +get_rela_entries(Bin, Acc) -> + E = case is64bit() of + true -> + <<%% Structural pattern matching on fields of a Rela Entry. + Offset:?bits(?R_OFFSET_SIZE)/integer-little, + Info:?bits(?R_INFO_SIZE)/integer-little, + Addend:?bits(?R_ADDEND_SIZE)/integer-little, + Rest/binary + >> = Bin, + mk_rela(Offset, Info, Addend); + false -> + <<%% Structural pattern matching on fields of a Rel Entry. + Offset:?bits(?R_OFFSET_SIZE)/integer-little, + Info:?bits(?R_INFO_SIZE)/integer-little, + Rest/binary + >> = Bin, + mk_rel(Offset, Info) + end, + get_rela_entries(Rest, [E | Acc]). + +%% %% @doc Extract the `EntryNum' (serial number) Relocation Entry. +%% get_rela_entry(Rela, EntryNum) -> +%% lists:nth(EntryNum + 1, Rela). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Executable Code segment +%%------------------------------------------------------------------------------ + +%% @doc This function gets as arguments an ELF formated binary file and +%% returns the Executable Code (".text" segment) or an empty binary if it +%% is not found. +-spec extract_text(elf()) -> binary(). +extract_text(Elf) -> + extract_segment_by_name(Elf, ?TEXT). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Note Section +%%------------------------------------------------------------------------------ + +%% @doc Extract specific Note Section from an ELF Object file. The function +%% takes as first argument the object file (`Elf') and the `Name' of the +%% wanted Note Section (<b>without</b> the ".note" prefix!). It returns +%% the specified binary segment or an empty binary if no such section +%% exists. +-spec extract_note(elf(), string()) -> binary(). +extract_note(Elf, Name) -> + extract_segment_by_name(Elf, ?NOTE(Name)). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate GCC Exception Table segment +%%------------------------------------------------------------------------------ + +%% A description for the C++ exception table formats can be found at Exception +%% Handling Tables (http://www.codesourcery.com/cxx-abi/exceptions.pdf). + +%% A list with `{Start, End, HandlerOffset}' for all call sites in the code +-spec get_exn_handlers(elf()) -> [{start(), start(), lp()}]. +get_exn_handlers(Elf) -> + CallSites = extract_gccexntab_callsites(Elf), + [{Start, Start + Size, LP} + || #elf_gccexntab_callsite{start = Start, size = Size, lp = LP} <- CallSites]. + +%% @doc This function gets as argument an ELF binary file and returns +%% the table (list) of call sites which is stored in GCC +%% Exception Table (".gcc_except_table") section. +%% It returns an empty list if the Exception Table is not found. +%% XXX: Assumes there is *no* Action Record Table. +extract_gccexntab_callsites(Elf) -> + case extract_segment_by_name(Elf, ?GCC_EXN_TAB) of + <<>> -> + []; + ExnTab -> + %% First byte of LSDA is Landing Pad base encoding. + <<LBenc:8, More/binary>> = ExnTab, + %% Second byte is the Landing Pad base (if its encoding is not + %% DW_EH_PE_omit) (optional). + {_LPBase, LSDACont} = + case LBenc =:= ?DW_EH_PE_omit of + true -> % No landing pad base byte. (-1 denotes that) + {-1, More}; + false -> % Landing pad base. + <<Base:8, More2/binary>> = More, + {Base, More2} + end, + %% Next byte of LSDA is the encoding of the Type Table. + <<TTenc:8, More3/binary>> = LSDACont, + %% Next byte is the Types Table offset encoded in U-LEB128 (optional). + {_TTOff, LSDACont2} = + case TTenc =:= ?DW_EH_PE_omit of + true -> % There is no Types Table pointer. (-1 denotes that) + {-1, More3}; + false -> % The byte offset from this field to the start of the Types + % Table used for exception matching. + leb128_decode(More3) + end, + %% Next byte of LSDA is the encoding of the fields in the Call-site Table. + <<_CSenc:8, More4/binary>> = LSDACont2, + %% Sixth byte is the size (in bytes) of the Call-site Table encoded in + %% U-LEB128. + {_CSTabSize, CSTab} = leb128_decode(More4), + %% Extract all call site information + get_gccexntab_callsites(CSTab, []) + end. + +get_gccexntab_callsites(<<>>, Acc) -> + lists:reverse(Acc); +get_gccexntab_callsites(CSTab, Acc) -> + %% We are only interested in the Landing Pad of every entry. + <<Start:32/integer-little, Size:32/integer-little, + LP:32/integer-little, OnAction:8, More/binary + >> = CSTab, + GccCS = mk_gccexntab_callsite(Start, Size, LP, OnAction), + get_gccexntab_callsites(More, [GccCS | Acc]). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Read-only Data (.rodata) +%%------------------------------------------------------------------------------ +extract_rodata(Elf) -> + Rodata_bin = extract_segment_by_name(Elf, ?RODATA), + get_rodata_entries(Rodata_bin, []). + +get_rodata_entries(<<>>, Acc) -> + lists:reverse(Acc); +get_rodata_entries(Rodata_bin, Acc) -> + <<Num:?bits(?ELF_ADDR_SIZE)/integer-little, More/binary>> = Rodata_bin, + get_rodata_entries(More, [Num | Acc]). + +%%------------------------------------------------------------------------------ +%% Helper functions +%%------------------------------------------------------------------------------ + +%% @doc Returns the binary segment starting at `Offset' with length `Size' +%% (bytes) from a binary file. If `Offset' is bigger than the byte size of +%% the binary, an empty binary (`<<>>') is returned. +-spec get_binary_segment(binary(), offset(), size()) -> binary(). +get_binary_segment(Bin, Offset, _Size) when Offset > byte_size(Bin) -> + <<>>; +get_binary_segment(Bin, Offset, Size) -> + <<_Hdr:Offset/binary, BinSeg:Size/binary, _More/binary>> = Bin, + BinSeg. + +%% @doc This function gets as arguments an ELF formated binary object and +%% a string with the segments' name and returns the specified segment or +%% an empty binary (`<<>>') if there exists no segment with that name. +%% There are handy macros defined in elf_format.hrl for all Standard +%% Section Names. +-spec extract_segment_by_name(elf(), string()) -> binary(). +extract_segment_by_name(Elf, SectionName) -> + %% Extract Section Header Table and Section Header String Table from binary + SHdrTable = extract_shdrtab(Elf), + Names = extract_shstrtab(Elf), + %% Zip to a list of (Name,ShdrE) + [_Zero | ShdrEs] = lists:keysort(2, SHdrTable), % Skip first entry (zeros). + L = lists:zip(Names, ShdrEs), + %% Find Section Header Table entry by name + case lists:keyfind(SectionName, 1, L) of + {SectionName, ShdrE} -> %% Note: Same name. + #elf_shdr{offset = Offset, size = Size} = ShdrE, + get_binary_segment(Elf, Offset, Size); + false -> %% Not found. + <<>> + end. + +%% @doc Extracts a list of strings with (zero-separated) names from a binary. +%% Returns tuples of `{Name, Size}'. +%% XXX: Skip trailing 0. +-spec get_names(<<_:8,_:_*8>>) -> name_sizes(). +get_names(<<0, Bin/binary>>) -> + NamesSizes = get_names(Bin, []), + fix_names(NamesSizes, []). + +get_names(<<>>, Acc) -> + lists:reverse(Acc); +get_names(Bin, Acc) -> + {Name, MoreNames} = bin_get_string(Bin), + get_names(MoreNames, [{Name, length(Name)} | Acc]). + +%% @doc Fix names: +%% e.g. If ".rela.text" exists, ".text" does not. Same goes for +%% ".rel.text". In that way, the Section Header String Table is more +%% compact. Add ".text" just *before* the corresponding rela-field, +%% etc. +-spec fix_names(name_sizes(), name_sizes()) -> name_sizes(). +fix_names([], Acc) -> + lists:reverse(Acc); +fix_names([{Name, Size}=T | Names], Acc) -> + case is64bit() of + true -> + case string:str(Name, ".rela") =:= 1 of + true -> %% Name starts with ".rela": + Section = string:substr(Name, 6), + fix_names(Names, [{Section, Size - 5} + | [T | Acc]]); % XXX: Is order ok? (".text" + % always before ".rela.text") + false -> %% Name does not start with ".rela": + fix_names(Names, [T | Acc]) + end; + false -> + case string:str(Name, ".rel") =:= 1 of + true -> %% Name starts with ".rel": + Section = string:substr(Name, 5), + fix_names(Names, [{Section, Size - 4} + | [T | Acc]]); % XXX: Is order ok? (".text" + % always before ".rela.text") + false -> %% Name does not start with ".rel": + fix_names(Names, [T | Acc]) + end + end. + + +%% @doc A function that byte-reverses a binary. This might be needed because of +%% little (fucking!) endianess. +-spec bin_reverse(binary()) -> binary(). +bin_reverse(Bin) when is_binary(Bin) -> + bin_reverse(Bin, <<>>). + +-spec bin_reverse(binary(), binary()) -> binary(). +bin_reverse(<<>>, Acc) -> + Acc; +bin_reverse(<<Head, More/binary>>, Acc) -> + bin_reverse(More, <<Head, Acc/binary>>). + +%% @doc A function that extracts a null-terminated string from a binary. It +%% returns the found string along with the rest of the binary. +-spec bin_get_string(binary()) -> {string(), binary()}. +bin_get_string(Bin) -> + bin_get_string(Bin, <<>>). + +bin_get_string(<<>>, BinAcc) -> + Bin = bin_reverse(BinAcc), % little endian! + {binary_to_list(Bin), <<>>}; +bin_get_string(<<0, MoreBin/binary>>, BinAcc) -> + Bin = bin_reverse(BinAcc), % little endian! + {binary_to_list(Bin), MoreBin}; +bin_get_string(<<Letter, Tail/binary>>, BinAcc) -> + bin_get_string(Tail, <<Letter, BinAcc/binary>>). + +%% @doc +make_offsets(NamesSizes) -> + {Names, Sizes} = lists:unzip(NamesSizes), + Offsets = make_offsets_from_sizes(Sizes, 1, []), + lists:zip(Names, Offsets). + +make_offsets_from_sizes([], _, Acc) -> + lists:reverse(Acc); +make_offsets_from_sizes([Size | Sizes], Cur, Acc) -> + make_offsets_from_sizes(Sizes, Size+Cur+1, [Cur | Acc]). % For the "."! + +%% @doc Little-Endian Base 128 (LEB128) Decoder +%% This function extracts the <b>first</b> LEB128-encoded integer in a +%% binary and returns that integer along with the remaining binary. This is +%% done because a LEB128 number has variable bit-size and that is a way of +%% extracting only one number in a binary and continuing parsing the binary +%% for other kind of data (e.g. different encoding). +%% FIXME: Only decodes unsigned data! +-spec leb128_decode(binary()) -> {integer(), binary()}. +leb128_decode(LebNum) -> + leb128_decode(LebNum, 0, <<>>). + +-spec leb128_decode(binary(), integer(), binary()) -> {integer(), binary()}. +leb128_decode(LebNum, NoOfBits, Acc) -> + <<Sentinel:1/bits, NextBundle:7/bits, MoreLebNums/bits>> = LebNum, + case Sentinel of + <<1:1>> -> % more bytes to follow + leb128_decode(MoreLebNums, NoOfBits+7, <<NextBundle:7/bits, Acc/bits>>); + <<0:1>> -> % byte bundle stop + Size = NoOfBits+7, + <<Num:Size/integer>> = <<NextBundle:7/bits, Acc/bits>>, + {Num, MoreLebNums} + end. + +%% @doc Extract ELF Class from ELF header and export symbol to process +%% dictionary. +-spec set_architecture_flag(elf()) -> 'ok'. +set_architecture_flag(Elf) -> + %% Extract information about ELF Class from ELF Header + <<16#7f, $E, $L, $F, EI_Class, _MoreHeader/binary>> + = get_binary_segment(Elf, 0, ?ELF_EHDR_SIZE), + put(elf_class, EI_Class), + ok. + +%% @doc Read from object file header if the file class is ELF32 or ELF64. +-spec is64bit() -> boolean(). +is64bit() -> + case get(elf_class) of + ?ELFCLASS64 -> true; + ?ELFCLASS32 -> false + end. diff --git a/lib/hipe/llvm/elf_format.hrl b/lib/hipe/llvm/elf_format.hrl new file mode 100644 index 0000000000..78592e6e2a --- /dev/null +++ b/lib/hipe/llvm/elf_format.hrl @@ -0,0 +1,488 @@ +%% -*- erlang-indent-level: 2 -*- + +%%% @copyright 2011-2014 Yiannis Tsiouris <[email protected]>, +%%% Chris Stavrakakis <[email protected]> +%%% @author Yiannis Tsiouris <[email protected]> +%%% [http://www.softlab.ntua.gr/~gtsiour/] + +%%------------------------------------------------------------------------------ +%% +%% ELF Header File +%% +%%------------------------------------------------------------------------------ + +-ifdef(BIT32). +-include("elf32_format.hrl"). % ELF32-specific definitions. +-else. +-include("elf64_format.hrl"). % ELF64-specific definitions. +-endif. + +%%------------------------------------------------------------------------------ +%% ELF Data Types (in bytes) +%%------------------------------------------------------------------------------ +%%XXX: Included in either elf32_format or elf64_format. + +%%------------------------------------------------------------------------------ +%% ELF File Header +%%------------------------------------------------------------------------------ +-define(ELF_EHDR_SIZE, (?E_IDENT_SIZE + ?E_TYPE_SIZE + ?E_MACHINE_SIZE + +?E_VERSION_SIZE + ?E_ENTRY_SIZE + ?E_PHOFF_SIZE + +?E_SHOFF_SIZE + ?E_FLAGS_SIZE + ?E_EHSIZE_SIZE + +?E_PHENTSIZE_SIZE + ?E_PHNUM_SIZE + ?E_SHENTSIZE_SIZE + +?E_SHNUM_SIZE + ?E_SHSTRNDX_SIZE) ). + +-define(E_IDENT_SIZE, (16 * ?ELF_UNSIGNED_CHAR_SIZE) ). +-define(E_TYPE_SIZE, ?ELF_HALF_SIZE). +-define(E_MACHINE_SIZE, ?ELF_HALF_SIZE). +-define(E_VERSION_SIZE, ?ELF_WORD_SIZE). +-define(E_ENTRY_SIZE, ?ELF_ADDR_SIZE). +-define(E_PHOFF_SIZE, ?ELF_OFF_SIZE). +-define(E_SHOFF_SIZE, ?ELF_OFF_SIZE). +-define(E_FLAGS_SIZE, ?ELF_WORD_SIZE). +-define(E_EHSIZE_SIZE, ?ELF_HALF_SIZE). +-define(E_PHENTSIZE_SIZE, ?ELF_HALF_SIZE). +-define(E_PHNUM_SIZE, ?ELF_HALF_SIZE). +-define(E_SHENTSIZE_SIZE, ?ELF_HALF_SIZE). +-define(E_SHNUM_SIZE, ?ELF_HALF_SIZE). +-define(E_SHSTRNDX_SIZE, ?ELF_HALF_SIZE). + +%% Useful arithmetics for computing byte offsets for various File Header +%% entries from a File Header (erlang) binary +-define(E_IDENT_OFFSET, 0). +-define(E_TYPE_OFFSET, (?E_IDENT_OFFSET + ?E_IDENT_SIZE) ). +-define(E_MACHINE_OFFSET, (?E_TYPE_OFFSET + ?E_TYPE_SIZE) ). +-define(E_VERSION_OFFSET, (?E_MACHINE_OFFSET + ?E_MACHINE_SIZE) ). +-define(E_ENTRY_OFFSET, (?E_VERSION_OFFSET + ?E_VERSION_SIZE) ). +-define(E_PHOFF_OFFSET, (?E_ENTRY_OFFSET + ?E_ENTRY_SIZE) ). +-define(E_SHOFF_OFFSET, (?E_PHOFF_OFFSET + ?E_PHOFF_SIZE) ). +-define(E_FLAGS_OFFSET, (?E_SHOFF_OFFSET + ?E_SHOFF_SIZE) ). +-define(E_EHSIZE_OFFSET, (?E_FLAGS_OFFSET + ?E_FLAGS_SIZE) ). +-define(E_PHENTSIZE_OFFSET, (?E_EHSIZE_OFFSET + ?E_EHSIZE_SIZE) ). +-define(E_PHNUM_OFFSET, (?E_PHENTSIZE_OFFSET + ?E_PHENTSIZE_SIZE) ). +-define(E_SHENTSIZE_OFFSET, (?E_PHNUM_OFFSET + ?E_PHNUM_SIZE) ). +-define(E_SHNUM_OFFSET, (?E_SHENTSIZE_OFFSET + ?E_SHENTSIZE_SIZE) ). +-define(E_SHSTRNDX_OFFSET, (?E_SHNUM_OFFSET + ?E_SHNUM_SIZE) ). + +%% Name aliases of File Header fields information used in get_header_field +%% function of elf64_format module. +-define(E_IDENT, {?E_IDENT_OFFSET, ?E_IDENT_SIZE}). +-define(E_TYPE, {?E_TYPE_OFFSET, ?E_TYPE_SIZE}). +-define(E_MACHINE, {?E_MACHINE_OFFSET, ?E_MACHINE_SIZE}). +-define(E_VERSION, {?E_VERSION_OFFSET, ?E_VERSION_SIZE}) +-define(E_ENTRY, {?E_ENTRY_OFFSET, ?E_ENTRY_SIZE}). +-define(E_PHOFF, {?E_PHOFF_OFFSET, ?E_PHOFF_SIZE}). +-define(E_SHOFF, {?E_SHOFF_OFFSET, ?E_SHOFF_SIZE}). +-define(E_FLAGS, {?E_FLAGS_OFFSET, ?E_FLAGS_SIZE}). +-define(E_EHSIZE, {?E_EHSIZE_OFFSET, ?E_EHSIZE_SIZE}). +-define(E_PHENTSIZE, {?E_PHENTSIZE_OFFSET, ?E_PHENTSIZE_SIZE}). +-define(E_PHNUM, {?E_PHNUM_OFFSET, ?E_PHNUM_SIZE}). +-define(E_SHENTSIZE, {?E_SHENTSIZE_OFFSET, ?E_SHENTSIZE_SIZE}). +-define(E_SHNUM, {?E_SHNUM_OFFSET, ?E_SHNUM_SIZE}). +-define(E_SHSTRNDX, {?E_SHSTRNDX_OFFSET, ?E_SHSTRNDX_SIZE}). + +%% ELF Identification (e_ident) +-define(EI_MAG0, 0). +-define(EI_MAG1, 1). +-define(EI_MAG2, 2). +-define(EI_MAG3, 3). +-define(EI_CLASS, 4). +-define(EI_DATA, 5). +-define(EI_VERSION, 6). +-define(EI_OSABI, 7). +-define(EI_ABIVERSION, 8). +-define(EI_PAD, 9). +-define(EI_NIDENT, 16). + +%% Object File Classes (e_ident[EI_CLASS]) +-define(ELFCLASSNONE, 0). +-define(ELFCLASS32, 1). +-define(ELFCLASS64, 2). + +%% Data Encodings (e_ident[EI_DATA]) +-define(ELFDATA2LSB, 1). +-define(ELFDATA2MSB, 2). + +%% Operating System and ABI Identifiers (e_ident[EI_OSABI]) +-define(ELFOSABI_SYSV, 0). +-define(ELFOSABI_HPUX, 1). +-define(ELFOSABI_STANDALONE, 255). + +%% Object File Types (e_type) +-define(ET_NONE, 0). +-define(ET_REL, 1). +-define(ET_EXEC, 2). +-define(ET_DYN, 3). +-define(ET_CORE, 4). +-define(ET_LOOS, 16#FE00). +-define(ET_HIOS, 16#FEFF). +-define(ET_LOPROC, 16#FF00). +-define(ET_HIPROC, 16#FFFF). + +%%------------------------------------------------------------------------------ +%% ELF Section Header +%%------------------------------------------------------------------------------ +-define(ELF_SHDRENTRY_SIZE, (?SH_NAME_SIZE + ?SH_TYPE_SIZE + ?SH_FLAGS_SIZE + +?SH_ADDR_SIZE + ?SH_OFFSET_SIZE + ?SH_SIZE_SIZE + +?SH_LINK_SIZE + ?SH_INFO_SIZE + +?SH_ADDRALIGN_SIZE + ?SH_ENTSIZE_SIZE) ). + +-define(SH_NAME_SIZE, ?ELF_WORD_SIZE). +-define(SH_TYPE_SIZE, ?ELF_WORD_SIZE). +-define(SH_FLAGS_SIZE, ?ELF_XWORD_SIZE). +-define(SH_ADDR_SIZE, ?ELF_ADDR_SIZE). +-define(SH_OFFSET_SIZE, ?ELF_OFF_SIZE). +-define(SH_SIZE_SIZE, ?ELF_XWORD_SIZE). +-define(SH_LINK_SIZE, ?ELF_WORD_SIZE). +-define(SH_INFO_SIZE, ?ELF_WORD_SIZE). +-define(SH_ADDRALIGN_SIZE, ?ELF_XWORD_SIZE). +-define(SH_ENTSIZE_SIZE, ?ELF_XWORD_SIZE). + +%% Useful arithmetics for computing byte offsets for various fields from a +%% Section Header Entry (erlang) binary +-define(SH_NAME_OFFSET, 0). +-define(SH_TYPE_OFFSET, (?SH_NAME_OFFSET + ?SH_NAME_SIZE) ). +-define(SH_FLAGS_OFFSET, (?SH_TYPE_OFFSET + ?SH_TYPE_SIZE) ). +-define(SH_ADDR_OFFSET, (?SH_FLAGS_OFFSET + ?SH_FLAGS_SIZE) ). +-define(SH_OFFSET_OFFSET, (?SH_ADDR_OFFSET + ?SH_ADDR_SIZE) ). +-define(SH_SIZE_OFFSET, (?SH_OFFSET_OFFSET + ?SH_OFFSET_SIZE) ). +-define(SH_LINK_OFFSET, (?SH_SIZE_OFFSET + ?SH_SIZE_SIZE) ). +-define(SH_INFO_OFFSET, (?SH_LINK_OFFSET + ?SH_LINK_SIZE) ). +-define(SH_ADDRALIGN_OFFSET, (?SH_INFO_OFFSET + ?SH_INFO_SIZE) ). +-define(SH_ENTSIZE_OFFSET, (?SH_ADDRALIGN_OFFSET + ?SH_ADDRALIGN_SIZE) ). + +%% Name aliases of Section Header Table entry information used in +%% get_shdrtab_entry function of elf64_format module. +-define(SH_NAME, {?SH_NAME_OFFSET, ?SH_NAME_SIZE}). +-define(SH_TYPE, {?SH_TYPE_OFFSET, ?SH_TYPE_SIZE}). +-define(SH_FLAGS, {?SH_FLAGS_OFFSET, ?SH_FLAGS_SIZE}). +-define(SH_ADDR, {?SH_ADDR_OFFSET, ?SH_ADDR_SIZE}). +-define(SH_OFFSET, {?SH_OFFSET_OFFSET, ?SH_OFFSET_SIZE}). +-define(SH_SIZE, {?SH_SIZE_OFFSET, ?SH_SIZE_SIZE}). +-define(SH_LINK, {?SH_LINK_OFFSET, ?SH_LINK_SIZE}). +-define(SH_INFO, {?SH_INFO_OFFSET, ?SH_INFO_SIZE}). +-define(SH_ADDRALIGN, {?SH_ADDRALIGN_OFFSET, ?SH_ADDRALIGN_SIZE}). +-define(SH_ENTSIZE, {?SH_ENTSIZE_OFFSET, ?SH_ENTSIZE_SIZE}). + +%% Section Indices +-define(SHN_UNDEF, 0). +-define(SHN_LOPROC, 16#FF00). +-define(SHN_HIPROC, 16#FF1F). +-define(SHN_LOOS, 16#FF20). +-define(SHN_HIOS, 16#FF3F). +-define(SHN_ABS, 16#FFF1). +-define(SHN_COMMON, 16#FFF2). + +%% Section Types (sh_type) +-define(SHT_NULL, 0). +-define(SHT_PROGBITS, 1). +-define(SHT_SYMTAB, 2). +-define(SHT_STRTAB, 3). +-define(SHT_RELA, 4). +-define(SHT_HASH, 5). +-define(SHT_DYNAMIC, 6). +-define(SHT_NOTE, 7). +-define(SHT_NOBITS, 8). +-define(SHT_REL, 9). +-define(SHT_SHLIB, 10). +-define(SHT_DYNSYM, 11). +-define(SHT_LOOS, 16#60000000). +-define(SHT_HIOS, 16#6FFFFFFF). +-define(SHT_LOPROC, 16#70000000). +-define(SHT_HIPROC, 16#7FFFFFFF). + +%% Section Attributes (sh_flags) +-define(SHF_WRITE, 16#1). +-define(SHF_ALLOC, 16#2). +-define(SHF_EXECINSTR, 16#4). +-define(SHF_MASKOS, 16#0F000000). +-define(SHF_MASKPROC, 16#F0000000). + +%% +%% Standard Section names for Code and Data +%% +-define(BSS, ".bss"). +-define(DATA, ".data"). +-define(INTERP, ".interp"). +-define(RODATA, ".rodata"). +-define(TEXT, ".text"). +%% Other Standard Section names +-define(COMMENT, ".comment"). +-define(DYNAMIC, ".dynamic"). +-define(DYNSTR, ".dynstr"). +-define(GOT, ".got"). +-define(HASH, ".hash"). +-define(NOTE(Name), (".note" ++ Name)). +-define(PLT, ".plt"). +-define(REL(Name), (".rel" ++ Name) ). +-define(RELA(Name), (".rela" ++ Name) ). +-define(SHSTRTAB, ".shstrtab"). +-define(STRTAB, ".strtab"). +-define(SYMTAB, ".symtab"). +-define(GCC_EXN_TAB, ".gcc_except_table"). + +%%------------------------------------------------------------------------------ +%% ELF Symbol Table Entries +%%------------------------------------------------------------------------------ +-define(ELF_SYM_SIZE, (?ST_NAME_SIZE + ?ST_INFO_SIZE + ?ST_OTHER_SIZE + +?ST_SHNDX_SIZE + ?ST_VALUE_SIZE + ?ST_SIZE_SIZE) ). + +-define(ST_NAME_SIZE, ?ELF_WORD_SIZE). +-define(ST_INFO_SIZE, ?ELF_UNSIGNED_CHAR_SIZE). +-define(ST_OTHER_SIZE, ?ELF_UNSIGNED_CHAR_SIZE). +-define(ST_SHNDX_SIZE, ?ELF_HALF_SIZE). +-define(ST_VALUE_SIZE, ?ELF_ADDR_SIZE). +-define(ST_SIZE_SIZE, ?ELF_XWORD_SIZE). + +%% Precomputed offset for Symbol Table entries in SymTab binary +%%XXX: Included in either elf32_format or elf64_format. + +%% Name aliases for Symbol Table entry information +-define(ST_NAME, {?ST_NAME_OFFSET, ?ST_NAME_SIZE}). +-define(ST_INFO, {?ST_INFO_OFFSET, ?ST_INFO_SIZE}). +-define(ST_OTHER, {?ST_OTHER_OFFSET, ?ST_OTHER_SIZE}). +-define(ST_SHNDX, {?ST_SHNDX_OFFSET, ?ST_SHNDX_SIZE}). +-define(ST_VALUE, {?ST_VALUE_OFFSET, ?ST_VALUE_SIZE}). +-define(ST_SIZE, {?ST_SIZE_OFFSET, ?ST_SIZE_SIZE}). + +%% Macros to extract information from st_type +-define(ELF_ST_BIND(I), (I bsr 4) ). +-define(ELF_ST_TYPE(I), (I band 16#f) ). +-define(ELF_ST_INFO(B,T), (B bsl 4 + T band 16#f) ). + +%% Symbol Bindings +-define(STB_LOCAL, 0). +-define(STB_GLOBAL, 1). +-define(STB_WEAK, 2). +-define(STB_LOOS, 10). +-define(STB_HIOS, 12). +-define(STB_LOPROC, 13). +-define(STB_HIPROC, 15). + +%% Symbol Types +-define(STT_NOTYPE, 0). +-define(STT_OBJECT, 1). +-define(STT_FUNC, 2). +-define(STT_SECTION, 3). +-define(STT_FILE, 4). +-define(STT_LOOS, 10). +-define(STT_HIOS, 12). +-define(STT_LOPROC, 13). +-define(STT_HIPROC, 15). + +%%------------------------------------------------------------------------------ +%% ELF Relocation Entries +%%------------------------------------------------------------------------------ +-define(ELF_REL_SIZE, (?R_OFFSET_SIZE + ?R_INFO_SIZE) ). +-define(ELF_RELA_SIZE, (?R_OFFSET_SIZE + ?R_INFO_SIZE + ?R_ADDEND_SIZE) ). + +-define(R_OFFSET_SIZE, ?ELF_ADDR_SIZE). +-define(R_INFO_SIZE, ?ELF_XWORD_SIZE). +-define(R_ADDEND_SIZE, ?ELF_SXWORD_SIZE). + +%% Arithmetics for computing byte offsets in a Relocation entry binary +-define(R_OFFSET_OFFSET, 0). +-define(R_INFO_OFFSET, (?R_OFFSET_OFFSET + ?R_OFFSET_SIZE) ). +-define(R_ADDEND_OFFSET, (?R_INFO_OFFSET + ?R_INFO_SIZE) ). + +%% Name aliases for Relocation field information +-define(R_OFFSET, {?R_OFFSET_OFFSET, ?R_OFFSET_SIZE}). +-define(R_INFO, {?R_INFO_OFFSET, ?R_INFO_SIZE}). +-define(R_ADDEND, {?R_ADDEND_OFFSET, ?R_ADDEND_SIZE}). + +%% Useful macros to extract information from r_info field +%%XXX: Included in either elf32_format or elf64_format. + +%%------------------------------------------------------------------------------ +%% ELF Program Header Table +%%------------------------------------------------------------------------------ +-define(ELF_PHDR_SIZE, (?P_TYPE_SIZE + ?P_FLAGS_SIZE + ?P_OFFSET_SIZE + +?P_VADDR_SIZE + ?P_PADDR_SIZE + ?P_FILESZ_SIZE + +?P_MEMSZ_SIZE + ?P_ALIGN_SIZE) ). + +-define(P_TYPE_SIZE, ?ELF_WORD_SIZE). +-define(P_FLAGS_SIZE, ?ELF_WORD_SIZE). +-define(P_OFFSET_SIZE, ?ELF_OFF_SIZE). +-define(P_VADDR_SIZE, ?ELF_ADDR_SIZE). +-define(P_PADDR_SIZE, ?ELF_ADDR_SIZE). +-define(P_FILESZ_SIZE, ?ELF_XWORD_SIZE). +-define(P_MEMSZ_SIZE, ?ELF_XWORD_SIZE). +-define(P_ALIGN_SIZE, ?ELF_XWORD_SIZE). + +%% Offsets of various fields in a Program Header Table entry binary. +%%XXX: Included in either elf32_format or elf64_format. + +%% Name aliases for each Program Header Table entry field information. +-define(P_TYPE, {?P_TYPE_OFFSET, ?P_TYPE_SIZE} ). +-define(P_FLAGS, {?P_FLAGS_OFFSET, ?P_FLAGS_SIZE} ). +-define(P_OFFSET, {?P_OFFSET_OFFSET, ?P_OFFSET_SIZE} ). +-define(P_VADDR, {?P_VADDR_OFFSET, ?P_VADDR_SIZE} ). +-define(P_PADDR, {?P_PADDR_OFFSET, ?P_PADDR_SIZE} ). +-define(P_FILESZ, {?P_FILESZ_OFFSET, ?P_FILESZ_SIZE} ). +-define(P_MEMSZ, {?P_MEMSZ_OFFSET, ?P_MEMSZ_SIZE} ). +-define(P_ALIGN, {?P_ALIGN_OFFSET, ?P_ALIGN_SIZE} ). + +%% Segment Types (p_type) +-define(PT_NULL, 0). +-define(PT_LOAD, 1). +-define(PT_DYNAMIC, 2). +-define(PT_INTERP, 3). +-define(PT_NOTE, 4). +-define(PT_SHLIB, 5). +-define(PT_PHDR, 6). +-define(PT_LOOS, 16#60000000). +-define(PT_HIOS, 16#6FFFFFFF). +-define(PT_LOPROC, 16#70000000). +-define(PT_HIPROC, 16#7FFFFFFF). + +%% Segment Attributes (p_flags) +-define(PF_X, 16#1). +-define(PF_W, 16#2). +-define(PF_R, 16#4). +-define(PF_MASKOS, 16#00FF0000). +-define(PF_MASKPROC, 16#FF000000). + +%%------------------------------------------------------------------------------ +%% ELF Dynamic Table +%%------------------------------------------------------------------------------ +-define(ELF_DYN_SIZE, (?D_TAG_SIZE + ?D_VAL_PTR_SIZE) ). + +-define(D_TAG_SIZE, ?ELF_SXWORD_SIZE). +-define(D_VAL_PTR_SIZE, ?ELF_ADDR_SIZE). + +%% Offsets of each field in Dynamic Table entry in binary +-define(D_TAG_OFFSET, 0). +-define(D_VAL_PTR_OFFSET, (?D_TAG_OFFSET + ?D_TAG_SIZE)). + +%% Name aliases for each field of a Dynamic Table entry information +-define(D_TAG, {?D_TAG_OFFSET, ?D_TAG_SIZE} ). +-define(D_VAL_PTR, {?D_VAL_PTR_OFFSET, ?D_VAL_PTR_SIZE} ). + +%% Dynamic Table Entries +-define(DT_NULL, 0). +-define(DT_NEEDED, 1). +-define(DT_PLTRELSZ, 2). +-define(DT_PLTGOT, 3). +-define(DT_HASH, 4). +-define(DT_STRTAB, 5). +-define(DT_SYMTAB, 6). +-define(DT_RELA, 7). +-define(DT_RELASZ, 8). +-define(DT_RELAENT, 9). +-define(DT_STRSZ, 10). +-define(DT_SYMENT, 11). +-define(DT_INIT, 12). +-define(DT_FINI, 13). +-define(DT_SONAME, 14). +-define(DT_RPATH, 15). +-define(DT_SYMBOLIC, 16). +-define(DT_REL, 17). +-define(DT_RELSZ, 18). +-define(DT_RELENT, 19). +-define(DT_PLTREL, 20). +-define(DT_DEBUG, 21). +-define(DT_TEXTREL, 22). +-define(DT_JMPREL, 23). +-define(DT_BIND_NOW, 24). +-define(DT_INIT_ARRAY, 25). +-define(DT_FINI_ARRAY, 26). +-define(DT_INIT_ARRAYSZ, 27). +-define(DT_FINI_ARRAYSZ, 28). +-define(DT_LOOS, 16#60000000). +-define(DT_HIOS, 16#6FFFFFFF). +-define(DT_LOPROC, 16#700000000). +-define(DT_HIPROC, 16#7FFFFFFFF). + +%%------------------------------------------------------------------------------ +%% ELF GCC Exception Table +%%------------------------------------------------------------------------------ + +%% The DWARF Exception Header Encoding is used to describe the type of data used +%% in the .eh_frame_hdr (and .gcc_except_table) section. The upper 4 bits +%% indicate how the value is to be applied. The lower 4 bits indicate the format +%% of the data. + +%% DWARF Exception Header value format +-define(DW_EH_PE_omit, 16#ff). % No value is present. +-define(DW_EH_PE_uleb128, 16#01). % Unsigned value encoded using LEB128. +-define(DW_EH_PE_udata2, 16#02). % A 2 bytes unsigned value. +-define(DW_EH_PE_udata4, 16#03). % A 4 bytes unsigned value. +-define(DW_EH_PE_udata8, 16#04). % An 8 bytes unsigned value. +-define(DW_EH_PE_sleb128, 16#09). % Signed value encoded using LEB128. +-define(DW_EH_PE_sdata2, 16#0a). % A 2 bytes signed value. +-define(DW_EH_PE_sdata4, 16#0b). % A 4 bytes signed value. +-define(DW_EH_PE_sdata8, 16#0c). % An 8 bytes signed value. + +%% DWARF Exception Header application +-define(DW_EH_PE_absptr, 16#00). % Value is used with no modification. +-define(DW_EH_PE_pcrel, 16#10). % Value is relative to the current PC. +-define(DW_EH_PE_datarel, 16#30). % Value is relative to the beginning of the + % section. + +%%------------------------------------------------------------------------------ +%% ELF Read-only data (constants, literlas etc.) +%%------------------------------------------------------------------------------ +-define(RO_ENTRY_SIZE, 8). + +%%------------------------------------------------------------------------------ +%% Custom Note section: ".note.gc" for Erlang GC +%%------------------------------------------------------------------------------ + +%% The structure of this section is the following: +%% +%% .short <n> # number of safe points in code +%% +%% .long .L<label1> # safe point address | +%% .long .L<label2> # safe point address |-> safe point addrs +%% ..... | +%% .long .L<label3> # safe point address | +%% +%% .short <n> # stack frame size (in words) |-> fixed-size part +%% .short <n> # stack arity | +%% .short <n> # number of live roots that follow | +%% +%% .short <n> # live root's stack index | +%% ..... |-> live root indices +%% .short <n> # >> | + +%% The name of the custom Note Section +-define(NOTE_ERLGC_NAME, ".gc"). + +%% The first word of a Note Section for Erlang GC (".note.gc") is always the +%% number of safepoints in code. +-define(SP_COUNT, {?SP_COUNT_OFFSET, ?SP_COUNT_SIZE}). +-define(SP_COUNT_SIZE, ?ELF_HALF_SIZE). +-define(SP_COUNT_OFFSET, 0). %(always the first entry in sdesc) + +%% The fixed-size part of a safe point (SP) entry consists of 4 words: the SP +%% address (offset in code), the stack frame size of the function (where the SP +%% is located), the stack arity of the function (the registered values are *not* +%% counted), the number of live roots in the specific SP. +-define(SP_FIXED, {?SP_FIXED_OFF, ?SP_FIXED_SIZE}). +-define(SP_FIXED_OFF, 0). +%%XXX: Exclude SP_ADDR_SIZE from SP_FIXED_SIZE in lew of new GC layout +-define(SP_FIXED_SIZE, (?SP_STKFRAME_SIZE + ?SP_STKARITY_SIZE + + ?SP_LIVEROOTCNT_SIZE)). + +-define(SP_ADDR_SIZE, ?ELF_WORD_SIZE). +-define(SP_STKFRAME_SIZE, ?ELF_HALF_SIZE). +-define(SP_STKARITY_SIZE, ?ELF_HALF_SIZE). +-define(SP_LIVEROOTCNT_SIZE, ?ELF_HALF_SIZE). + +%%XXX: SP_STKFRAME is the first piece of information in the new GC layout +-define(SP_STKFRAME_OFFSET, 0). +-define(SP_STKARITY_OFFSET, (?SP_STKFRAME_OFFSET + ?SP_STKFRAME_SIZE) ). +-define(SP_LIVEROOTCNT_OFFSET, (?SP_STKARITY_OFFSET + ?SP_STKARITY_SIZE) ). + +%% Name aliases for safepoint fields. +-define(SP_STKFRAME, {?SP_STKFRAME_OFFSET, ?SP_STKFRAME_SIZE}). +-define(SP_STKARITY, {?SP_STKARITY_OFFSET, ?SP_STKARITY_SIZE}). +-define(SP_LIVEROOTCNT, {?SP_LIVEROOTCNT_OFFSET, ?SP_LIVEROOTCNT_SIZE}). + +%% After the fixed-size part a variable-size part exists. This part holds the +%% stack frame index of every live root in the specific SP. +-define(LR_STKINDEX_SIZE, ?ELF_HALF_SIZE). + +%%------------------------------------------------------------------------------ +%% Misc. +%%------------------------------------------------------------------------------ +-define(bits(Bytes), ((Bytes) bsl 3)). diff --git a/lib/hipe/llvm/hipe_llvm.erl b/lib/hipe/llvm/hipe_llvm.erl new file mode 100644 index 0000000000..5e33731a2b --- /dev/null +++ b/lib/hipe/llvm/hipe_llvm.erl @@ -0,0 +1,1131 @@ +%% -*- erlang-indent-level: 2 -*- + +-module(hipe_llvm). + +-export([ + mk_ret/1, + ret_ret_list/1, + + mk_br/1, + br_dst/1, + + mk_br_cond/3, + mk_br_cond/4, + br_cond_cond/1, + br_cond_true_label/1, + br_cond_false_label/1, + br_cond_meta/1, + + mk_indirectbr/3, + indirectbr_type/1, + indirectbr_address/1, + indirectbr_label_list/1, + + mk_switch/4, + switch_type/1, + switch_value/1, + switch_default_label/1, + switch_value_label_list/1, + + mk_invoke/9, + invoke_dst/1, + invoke_cconv/1, + invoke_ret_attrs/1, + invoke_type/1, + invoke_fnptrval/1, + invoke_arglist/1, + invoke_fn_attrs/1, + invoke_to_label/1, + invoke_unwind_label/1, + + mk_operation/6, + operation_dst/1, + operation_op/1, + operation_type/1, + operation_src1/1, + operation_src2/1, + operation_options/1, + + mk_extractvalue/5, + extractvalue_dst/1, + extractvalue_type/1, + extractvalue_val/1, + extractvalue_idx/1, + extractvalue_idxs/1, + + mk_insertvalue/7, + insertvalue_dst/1, + insertvalue_val_type/1, + insertvalue_val/1, + insertvalue_elem_type/1, + insertvalue_elem/1, + insertvalue_idx/1, + insertvalue_idxs/1, + + mk_alloca/4, + alloca_dst/1, + alloca_type/1, + alloca_num/1, + alloca_align/1, + + mk_load/6, + load_dst/1, + load_p_type/1, + load_pointer/1, + load_alignment/1, + load_nontemporal/1, + load_volatile/1, + + mk_store/7, + store_type/1, + store_value/1, + store_p_type/1, + store_pointer/1, + store_alignment/1, + store_nontemporal/1, + store_volatile/1, + + mk_getelementptr/5, + getelementptr_dst/1, + getelementptr_p_type/1, + getelementptr_value/1, + getelementptr_typed_idxs/1, + getelementptr_inbounds/1, + + mk_conversion/5, + conversion_dst/1, + conversion_op/1, + conversion_src_type/1, + conversion_src/1, + conversion_dst_type/1, + + mk_sitofp/4, + sitofp_dst/1, + sitofp_src_type/1, + sitofp_src/1, + sitofp_dst_type/1, + + mk_ptrtoint/4, + ptrtoint_dst/1, + ptrtoint_src_type/1, + ptrtoint_src/1, + ptrtoint_dst_type/1, + + mk_inttoptr/4, + inttoptr_dst/1, + inttoptr_src_type/1, + inttoptr_src/1, + inttoptr_dst_type/1, + + mk_icmp/5, + icmp_dst/1, + icmp_cond/1, + icmp_type/1, + icmp_src1/1, + icmp_src2/1, + + mk_fcmp/5, + fcmp_dst/1, + fcmp_cond/1, + fcmp_type/1, + fcmp_src1/1, + fcmp_src2/1, + + mk_phi/3, + phi_dst/1, + phi_type/1, + phi_value_label_list/1, + + mk_select/6, + select_dst/1, + select_cond/1, + select_typ1/1, + select_val1/1, + select_typ2/1, + select_val2/1, + + mk_call/8, + call_dst/1, + call_is_tail/1, + call_cconv/1, + call_ret_attrs/1, + call_type/1, + call_fnptrval/1, + call_arglist/1, + call_fn_attrs/1, + + mk_fun_def/10, + fun_def_linkage/1, + fun_def_visibility/1, + fun_def_cconv/1, + fun_def_ret_attrs/1, + fun_def_type/1, + fun_def_name/1, + fun_def_arglist/1, + fun_def_fn_attrs/1, + fun_def_align/1, + fun_def_body/1, + + mk_fun_decl/8, + fun_decl_linkage/1, + fun_decl_visibility/1, + fun_decl_cconv/1, + fun_decl_ret_attrs/1, + fun_decl_type/1, + fun_decl_name/1, + fun_decl_arglist/1, + fun_decl_align/1, + + mk_landingpad/0, + + mk_comment/1, + comment_text/1, + + mk_label/1, + label_label/1, + is_label/1, + + mk_const_decl/4, + const_decl_dst/1, + const_decl_decl_type/1, + const_decl_type/1, + const_decl_value/1, + + mk_asm/1, + asm_instruction/1, + + mk_adj_stack/3, + adj_stack_offset/1, + adj_stack_register/1, + adj_stack_type/1, + + mk_branch_meta/3, + branch_meta_id/1, + branch_meta_true_weight/1, + branch_meta_false_weight/1 + ]). + +-export([ + mk_void/0, + + mk_label_type/0, + + mk_int/1, + int_width/1, + + mk_double/0, + + mk_pointer/1, + pointer_type/1, + + mk_array/2, + array_size/1, + array_type/1, + + mk_vector/2, + vector_size/1, + vector_type/1, + + mk_struct/1, + struct_type_list/1, + + mk_fun/2, + function_ret_type/1, + function_arg_type_list/1 + ]). + +-export([pp_ins_list/2, pp_ins/2]). + + +%%----------------------------------------------------------------------------- +%% Abstract Data Types for LLVM Assembly. +%%----------------------------------------------------------------------------- + +%% Terminator Instructions +-record(llvm_ret, {ret_list=[]}). +-type llvm_ret() :: #llvm_ret{}. + +-record(llvm_br, {dst}). +-type llvm_br() :: #llvm_br{}. + +-record(llvm_br_cond, {'cond', true_label, false_label, meta=[]}). +-type llvm_br_cond() :: #llvm_br_cond{}. + +-record(llvm_indirectbr, {type, address, label_list}). +-type llvm_indirectbr() :: #llvm_indirectbr{}. + +-record(llvm_switch, {type, value, default_label, value_label_list=[]}). +-type llvm_switch() :: #llvm_switch{}. + +-record(llvm_invoke, {dst, cconv=[], ret_attrs=[], type, fnptrval, arglist=[], + fn_attrs=[], to_label, unwind_label}). +-type llvm_invoke() :: #llvm_invoke{}. + +%% Binary Operations +-record(llvm_operation, {dst, op, type, src1, src2, options=[]}). +-type llvm_operation() :: #llvm_operation{}. + +%% Aggregate Operations +-record(llvm_extractvalue, {dst, type, val, idx, idxs=[]}). +-type llvm_extractvalue() :: #llvm_extractvalue{}. + +-record(llvm_insertvalue, {dst, val_type, val, elem_type, elem, idx, idxs=[]}). +-type llvm_insertvalue() :: #llvm_insertvalue{}. + +%% Memory Access and Addressing Operations +-record(llvm_alloca, {dst, type, num=[], align=[]}). +-type llvm_alloca() :: #llvm_alloca{}. + +-record(llvm_load, {dst, p_type, pointer, alignment=[], nontemporal=[], + volatile=false}). +-type llvm_load() :: #llvm_load{}. + +-record(llvm_store, {type, value, p_type, pointer, alignment=[], + nontemporal=[], volatile=false}). +-type llvm_store() :: #llvm_store{}. + +-record(llvm_getelementptr, {dst, p_type, value, typed_idxs, inbounds}). +-type llvm_getelementptr() :: #llvm_getelementptr{}. + +%% Conversion Operations +-record(llvm_conversion, {dst, op, src_type, src, dst_type}). +-type llvm_conversion() :: #llvm_conversion{}. + +-record(llvm_sitofp, {dst, src_type, src, dst_type}). +-type llvm_sitofp() :: #llvm_sitofp{}. + +-record(llvm_ptrtoint, {dst, src_type, src, dst_type}). +-type llvm_ptrtoint() :: #llvm_ptrtoint{}. + +-record(llvm_inttoptr, {dst, src_type, src, dst_type}). +-type llvm_inttoptr() :: #llvm_inttoptr{}. + +%% Other Operations +-record(llvm_icmp, {dst, 'cond', type, src1, src2}). +-type llvm_icmp() :: #llvm_icmp{}. + +-record(llvm_fcmp, {dst, 'cond', type, src1, src2}). +-type llvm_fcmp() :: #llvm_fcmp{}. + +-record(llvm_phi, {dst, type, value_label_list}). +-type llvm_phi() :: #llvm_phi{}. + +-record(llvm_select, {dst, 'cond', typ1, val1, typ2, val2}). +-type llvm_select() :: #llvm_select{}. + +-record(llvm_call, {dst=[], is_tail = false, cconv = [], ret_attrs = [], type, + fnptrval, arglist = [], fn_attrs = []}). +-type llvm_call() :: #llvm_call{}. + +-record(llvm_fun_def, {linkage=[], visibility=[], cconv=[], ret_attrs=[], + type, 'name', arglist=[], fn_attrs=[], align=[], body=[]}). +-type llvm_fun_def() :: #llvm_fun_def{}. + +-record(llvm_fun_decl, {linkage=[], visibility=[], cconv=[], ret_attrs=[], + type, 'name', arglist=[], align=[]}). +-type llvm_fun_decl() :: #llvm_fun_decl{}. + +-record(llvm_landingpad, {}). +-type llvm_landingpad() :: #llvm_landingpad{}. + +-record(llvm_comment, {text}). +-type llvm_comment() :: #llvm_comment{}. + +-record(llvm_label, {label}). +-type llvm_label() :: #llvm_label{}. + +-record(llvm_const_decl, {dst, decl_type, type, value}). +-type llvm_const_decl() :: #llvm_const_decl{}. + +-record(llvm_asm, {instruction}). +-type llvm_asm() :: #llvm_asm{}. + +-record(llvm_adj_stack, {offset, 'register', type}). +-type llvm_adj_stack() :: #llvm_adj_stack{}. + +-record(llvm_branch_meta, {id, true_weight, false_weight}). +-type llvm_branch_meta() :: #llvm_branch_meta{}. + +%% A type for any LLVM instruction +-type llvm_instr() :: llvm_ret() | llvm_br() | llvm_br_cond() + | llvm_indirectbr() | llvm_switch() | llvm_invoke() + | llvm_operation() | llvm_extractvalue() + | llvm_insertvalue() | llvm_alloca() | llvm_load() + | llvm_store() | llvm_getelementptr() | llvm_conversion() + | llvm_sitofp() | llvm_ptrtoint() | llvm_inttoptr() + | llvm_icmp() | llvm_fcmp() | llvm_phi() | llvm_select() + | llvm_call() | llvm_fun_def() | llvm_fun_decl() + | llvm_landingpad() | llvm_comment() | llvm_label() + | llvm_const_decl() | llvm_asm() | llvm_adj_stack() + | llvm_branch_meta(). + +%% Types +-record(llvm_void, {}). +%-type llvm_void() :: #llvm_void{}. + +-record(llvm_label_type, {}). +%-type llvm_label_type() :: #llvm_label_type{}. + +-record(llvm_int, {width}). +%-type llvm_int() :: #llvm_int{}. + +-record(llvm_float, {}). +%-type llvm_float() :: #llvm_float{}. + +-record(llvm_double, {}). +%-type llvm_double() :: #llvm_double{}. + +-record(llvm_fp80, {}). +%-type llvm_fp80() :: #llvm_fp80{}. + +-record(llvm_fp128, {}). +%-type llvm_fp128() :: #llvm_fp128{}. + +-record(llvm_ppc_fp128, {}). +%-type llvm_ppc_fp128() :: #llvm_ppc_fp128{}. + +-record(llvm_pointer, {type}). +%-type llvm_pointer() :: #llvm_pointer{}. + +-record(llvm_vector, {'size', type}). +%-type llvm_vector() :: #llvm_vector{}. + +-record(llvm_struct, {type_list}). +%-type llvm_struct() :: #llvm_struct{}. + +-record(llvm_array, {'size', type}). +%-type llvm_array() :: #llvm_array{}. + +-record(llvm_fun, {ret_type, arg_type_list}). +%-type llvm_fun() :: #llvm_fun{}. + +%%----------------------------------------------------------------------------- +%% Accessor Functions +%%----------------------------------------------------------------------------- + +%% ret +mk_ret(Ret_list) -> #llvm_ret{ret_list=Ret_list}. +ret_ret_list(#llvm_ret{ret_list=Ret_list}) -> Ret_list. + +%% br +mk_br(Dst) -> #llvm_br{dst=Dst}. +br_dst(#llvm_br{dst=Dst}) -> Dst. + +%% br_cond +mk_br_cond(Cond, True_label, False_label) -> + #llvm_br_cond{'cond'=Cond, true_label=True_label, false_label=False_label}. +mk_br_cond(Cond, True_label, False_label, Metadata) -> + #llvm_br_cond{'cond'=Cond, true_label=True_label, false_label=False_label, + meta=Metadata}. +br_cond_cond(#llvm_br_cond{'cond'=Cond}) -> Cond. +br_cond_true_label(#llvm_br_cond{true_label=True_label}) -> True_label. +br_cond_false_label(#llvm_br_cond{false_label=False_label}) -> + False_label. +br_cond_meta(#llvm_br_cond{meta=Metadata}) -> Metadata. + +%% indirectbr +mk_indirectbr(Type, Address, Label_list) -> #llvm_indirectbr{type=Type, address=Address, label_list=Label_list}. +indirectbr_type(#llvm_indirectbr{type=Type}) -> Type. +indirectbr_address(#llvm_indirectbr{address=Address}) -> Address. +indirectbr_label_list(#llvm_indirectbr{label_list=Label_list}) -> Label_list. + +%% invoke +mk_invoke(Dst, Cconv, Ret_attrs, Type, Fnptrval, Arglist, Fn_attrs, To_label, Unwind_label) -> + #llvm_invoke{dst=Dst, cconv=Cconv, ret_attrs=Ret_attrs, type=Type, + fnptrval=Fnptrval, arglist=Arglist, fn_attrs=Fn_attrs, to_label=To_label, + unwind_label=Unwind_label}. +invoke_dst(#llvm_invoke{dst=Dst}) -> Dst. +invoke_cconv(#llvm_invoke{cconv=Cconv}) -> Cconv. +invoke_ret_attrs(#llvm_invoke{ret_attrs=Ret_attrs}) -> Ret_attrs. +invoke_type(#llvm_invoke{type=Type}) -> Type. +invoke_fnptrval(#llvm_invoke{fnptrval=Fnptrval}) -> Fnptrval. +invoke_arglist(#llvm_invoke{arglist=Arglist}) -> Arglist. +invoke_fn_attrs(#llvm_invoke{fn_attrs=Fn_attrs}) -> Fn_attrs. +invoke_to_label(#llvm_invoke{to_label=To_label}) -> To_label. +invoke_unwind_label(#llvm_invoke{unwind_label=Unwind_label}) -> Unwind_label. + +%% switch +mk_switch(Type, Value, Default_label, Value_label_list) -> + #llvm_switch{type=Type, value=Value, default_label=Default_label, + value_label_list=Value_label_list}. +switch_type(#llvm_switch{type=Type}) -> Type. +switch_value(#llvm_switch{value=Value}) -> Value. +switch_default_label(#llvm_switch{default_label=Default_label}) -> + Default_label. +switch_value_label_list(#llvm_switch{value_label_list=Value_label_list}) -> + Value_label_list. + +%% operation +mk_operation(Dst, Op, Type, Src1, Src2, Options) -> + #llvm_operation{dst=Dst, op=Op, type=Type, src1=Src1, src2=Src2, + options=Options}. +operation_dst(#llvm_operation{dst=Dst}) -> Dst. +operation_op(#llvm_operation{op=Op}) -> Op. +operation_type(#llvm_operation{type=Type}) -> Type. +operation_src1(#llvm_operation{src1=Src1}) -> Src1. +operation_src2(#llvm_operation{src2=Src2}) -> Src2. +operation_options(#llvm_operation{options=Options}) -> Options. + +%% extractvalue +mk_extractvalue(Dst, Type, Val, Idx, Idxs) -> + #llvm_extractvalue{dst=Dst,type=Type,val=Val,idx=Idx,idxs=Idxs}. +extractvalue_dst(#llvm_extractvalue{dst=Dst}) -> Dst. +extractvalue_type(#llvm_extractvalue{type=Type}) -> Type. +extractvalue_val(#llvm_extractvalue{val=Val}) -> Val. +extractvalue_idx(#llvm_extractvalue{idx=Idx}) -> Idx. +extractvalue_idxs(#llvm_extractvalue{idxs=Idxs}) -> Idxs. + +%% insertvalue +mk_insertvalue(Dst, Val_type, Val, Elem_type, Elem, Idx, Idxs) -> + #llvm_insertvalue{dst=Dst, val_type=Val_type, val=Val, elem_type=Elem_type, + elem=Elem, idx=Idx, idxs=Idxs}. +insertvalue_dst(#llvm_insertvalue{dst=Dst}) -> Dst. +insertvalue_val_type(#llvm_insertvalue{val_type=Val_type}) -> Val_type. +insertvalue_val(#llvm_insertvalue{val=Val}) -> Val. +insertvalue_elem_type(#llvm_insertvalue{elem_type=Elem_type}) -> Elem_type. +insertvalue_elem(#llvm_insertvalue{elem=Elem}) -> Elem. +insertvalue_idx(#llvm_insertvalue{idx=Idx}) -> Idx. +insertvalue_idxs(#llvm_insertvalue{idxs=Idxs}) -> Idxs. + +%% alloca +mk_alloca(Dst, Type, Num, Align) -> + #llvm_alloca{dst=Dst, type=Type, num=Num, align=Align}. +alloca_dst(#llvm_alloca{dst=Dst}) -> Dst. +alloca_type(#llvm_alloca{type=Type}) -> Type. +alloca_num(#llvm_alloca{num=Num}) -> Num. +alloca_align(#llvm_alloca{align=Align}) -> Align. + +%% load +mk_load(Dst, Type, Pointer, Alignment, Nontemporal, Volatile) -> + #llvm_load{dst=Dst, p_type=Type, pointer=Pointer, alignment=Alignment, + nontemporal=Nontemporal, volatile=Volatile}. +load_dst(#llvm_load{dst=Dst}) -> Dst. +load_p_type(#llvm_load{p_type=Type}) -> Type. +load_pointer(#llvm_load{pointer=Pointer}) -> Pointer. +load_alignment(#llvm_load{alignment=Alignment}) -> Alignment. +load_nontemporal(#llvm_load{nontemporal=Nontemporal}) -> Nontemporal. +load_volatile(#llvm_load{volatile=Volatile}) -> Volatile. + +%% store +mk_store(Type, Value, P_Type, Pointer, Alignment, Nontemporal, Volatile) -> + #llvm_store{type=Type, value=Value, p_type=P_Type, pointer=Pointer, alignment=Alignment, + nontemporal=Nontemporal, volatile=Volatile}. +store_type(#llvm_store{type=Type}) -> Type. +store_value(#llvm_store{value=Value}) -> Value. +store_p_type(#llvm_store{p_type=P_Type}) -> P_Type. +store_pointer(#llvm_store{pointer=Pointer}) -> Pointer. +store_alignment(#llvm_store{alignment=Alignment}) -> Alignment. +store_nontemporal(#llvm_store{nontemporal=Nontemporal}) -> Nontemporal. +store_volatile(#llvm_store{volatile=Volatile}) -> Volatile. + +%% getelementptr +mk_getelementptr(Dst, P_Type, Value, Typed_Idxs, Inbounds) -> + #llvm_getelementptr{dst=Dst,p_type=P_Type, value=Value, + typed_idxs=Typed_Idxs, inbounds=Inbounds}. +getelementptr_dst(#llvm_getelementptr{dst=Dst}) -> Dst. +getelementptr_p_type(#llvm_getelementptr{p_type=P_Type}) -> P_Type. +getelementptr_value(#llvm_getelementptr{value=Value}) -> Value. +getelementptr_typed_idxs(#llvm_getelementptr{typed_idxs=Typed_Idxs}) -> Typed_Idxs. +getelementptr_inbounds(#llvm_getelementptr{inbounds=Inbounds}) -> Inbounds. + +%% conversion +mk_conversion(Dst, Op, Src_type, Src, Dst_type) -> + #llvm_conversion{dst=Dst, op=Op, src_type=Src_type, src=Src, dst_type=Dst_type}. +conversion_dst(#llvm_conversion{dst=Dst}) -> Dst. +conversion_op(#llvm_conversion{op=Op}) -> Op. +conversion_src_type(#llvm_conversion{src_type=Src_type}) -> Src_type. +conversion_src(#llvm_conversion{src=Src}) -> Src. +conversion_dst_type(#llvm_conversion{dst_type=Dst_type}) -> Dst_type. + +%% sitofp +mk_sitofp(Dst, Src_type, Src, Dst_type) -> + #llvm_sitofp{dst=Dst, src_type=Src_type, src=Src, dst_type=Dst_type}. +sitofp_dst(#llvm_sitofp{dst=Dst}) -> Dst. +sitofp_src_type(#llvm_sitofp{src_type=Src_type}) -> Src_type. +sitofp_src(#llvm_sitofp{src=Src}) -> Src. +sitofp_dst_type(#llvm_sitofp{dst_type=Dst_type}) -> Dst_type. + +%% ptrtoint +mk_ptrtoint(Dst, Src_Type, Src, Dst_Type) -> + #llvm_ptrtoint{dst=Dst, src_type=Src_Type, src=Src, dst_type=Dst_Type}. +ptrtoint_dst(#llvm_ptrtoint{dst=Dst}) -> Dst. +ptrtoint_src_type(#llvm_ptrtoint{src_type=Src_Type}) -> Src_Type. +ptrtoint_src(#llvm_ptrtoint{src=Src}) -> Src. +ptrtoint_dst_type(#llvm_ptrtoint{dst_type=Dst_Type}) -> Dst_Type . + +%% inttoptr +mk_inttoptr(Dst, Src_Type, Src, Dst_Type) -> + #llvm_inttoptr{dst=Dst, src_type=Src_Type, src=Src, dst_type=Dst_Type}. +inttoptr_dst(#llvm_inttoptr{dst=Dst}) -> Dst. +inttoptr_src_type(#llvm_inttoptr{src_type=Src_Type}) -> Src_Type. +inttoptr_src(#llvm_inttoptr{src=Src}) -> Src. +inttoptr_dst_type(#llvm_inttoptr{dst_type=Dst_Type}) -> Dst_Type . + +%% icmp +mk_icmp(Dst, Cond, Type, Src1, Src2) -> + #llvm_icmp{dst=Dst,'cond'=Cond,type=Type,src1=Src1,src2=Src2}. +icmp_dst(#llvm_icmp{dst=Dst}) -> Dst. +icmp_cond(#llvm_icmp{'cond'=Cond}) -> Cond. +icmp_type(#llvm_icmp{type=Type}) -> Type. +icmp_src1(#llvm_icmp{src1=Src1}) -> Src1. +icmp_src2(#llvm_icmp{src2=Src2}) -> Src2. + +%% fcmp +mk_fcmp(Dst, Cond, Type, Src1, Src2) -> + #llvm_fcmp{dst=Dst,'cond'=Cond,type=Type,src1=Src1,src2=Src2}. +fcmp_dst(#llvm_fcmp{dst=Dst}) -> Dst. +fcmp_cond(#llvm_fcmp{'cond'=Cond}) -> Cond. +fcmp_type(#llvm_fcmp{type=Type}) -> Type. +fcmp_src1(#llvm_fcmp{src1=Src1}) -> Src1. +fcmp_src2(#llvm_fcmp{src2=Src2}) -> Src2. + +%% phi +mk_phi(Dst, Type, Value_label_list) -> + #llvm_phi{dst=Dst, type=Type,value_label_list=Value_label_list}. +phi_dst(#llvm_phi{dst=Dst}) -> Dst. +phi_type(#llvm_phi{type=Type}) -> Type. +phi_value_label_list(#llvm_phi{value_label_list=Value_label_list}) -> + Value_label_list. + +%% select +mk_select(Dst, Cond, Typ1, Val1, Typ2, Val2) -> + #llvm_select{dst=Dst, 'cond'=Cond, typ1=Typ1, val1=Val1, typ2=Typ2, val2=Val2}. +select_dst(#llvm_select{dst=Dst}) -> Dst. +select_cond(#llvm_select{'cond'=Cond}) -> Cond. +select_typ1(#llvm_select{typ1=Typ1}) -> Typ1. +select_val1(#llvm_select{val1=Val1}) -> Val1. +select_typ2(#llvm_select{typ2=Typ2}) -> Typ2. +select_val2(#llvm_select{val2=Val2}) -> Val2. + +%% call +mk_call(Dst, Is_tail, Cconv, Ret_attrs, Type, Fnptrval, Arglist, Fn_attrs) -> + #llvm_call{dst=Dst, is_tail=Is_tail, cconv=Cconv, ret_attrs=Ret_attrs, + type=Type, fnptrval=Fnptrval, arglist=Arglist, fn_attrs=Fn_attrs}. +call_dst(#llvm_call{dst=Dst}) -> Dst. +call_is_tail(#llvm_call{is_tail=Is_tail}) -> Is_tail. +call_cconv(#llvm_call{cconv=Cconv}) -> Cconv. +call_ret_attrs(#llvm_call{ret_attrs=Ret_attrs}) -> Ret_attrs. +call_type(#llvm_call{type=Type}) -> Type. +call_fnptrval(#llvm_call{fnptrval=Fnptrval}) -> Fnptrval. +call_arglist(#llvm_call{arglist=Arglist}) -> Arglist. +call_fn_attrs(#llvm_call{fn_attrs=Fn_attrs}) -> Fn_attrs. + +%% fun_def +mk_fun_def(Linkage, Visibility, Cconv, Ret_attrs, Type, Name, Arglist, + Fn_attrs, Align, Body) -> + #llvm_fun_def{ + linkage=Linkage, + visibility=Visibility, + cconv=Cconv, + ret_attrs=Ret_attrs, + type=Type, + 'name'=Name, + arglist=Arglist, + fn_attrs=Fn_attrs, + align=Align, + body=Body + }. + +fun_def_linkage(#llvm_fun_def{linkage=Linkage}) -> Linkage. +fun_def_visibility(#llvm_fun_def{visibility=Visibility}) -> Visibility. +fun_def_cconv(#llvm_fun_def{cconv=Cconv}) -> Cconv . +fun_def_ret_attrs(#llvm_fun_def{ret_attrs=Ret_attrs}) -> Ret_attrs. +fun_def_type(#llvm_fun_def{type=Type}) -> Type. +fun_def_name(#llvm_fun_def{'name'=Name}) -> Name. +fun_def_arglist(#llvm_fun_def{arglist=Arglist}) -> Arglist. +fun_def_fn_attrs(#llvm_fun_def{fn_attrs=Fn_attrs}) -> Fn_attrs. +fun_def_align(#llvm_fun_def{align=Align}) -> Align. +fun_def_body(#llvm_fun_def{body=Body}) -> Body. + +%% fun_decl +mk_fun_decl(Linkage, Visibility, Cconv, Ret_attrs, Type, Name, Arglist, Align)-> + #llvm_fun_decl{ + linkage=Linkage, + visibility=Visibility, + cconv=Cconv, + ret_attrs=Ret_attrs, + type=Type, + 'name'=Name, + arglist=Arglist, + align=Align + }. + +fun_decl_linkage(#llvm_fun_decl{linkage=Linkage}) -> Linkage. +fun_decl_visibility(#llvm_fun_decl{visibility=Visibility}) -> Visibility. +fun_decl_cconv(#llvm_fun_decl{cconv=Cconv}) -> Cconv . +fun_decl_ret_attrs(#llvm_fun_decl{ret_attrs=Ret_attrs}) -> Ret_attrs. +fun_decl_type(#llvm_fun_decl{type=Type}) -> Type. +fun_decl_name(#llvm_fun_decl{'name'=Name}) -> Name. +fun_decl_arglist(#llvm_fun_decl{arglist=Arglist}) -> Arglist. +fun_decl_align(#llvm_fun_decl{align=Align}) -> Align. + +%% landingpad +mk_landingpad() -> #llvm_landingpad{}. + +%% comment +mk_comment(Text) -> #llvm_comment{text=Text}. +comment_text(#llvm_comment{text=Text}) -> Text. + +%% label +mk_label(Label) -> #llvm_label{label=Label}. +label_label(#llvm_label{label=Label}) -> Label. + +-spec is_label(llvm_instr()) -> boolean(). +is_label(#llvm_label{}) -> true; +is_label(#llvm_ret{}) -> false; +is_label(#llvm_br{}) -> false; +is_label(#llvm_br_cond{}) -> false; +is_label(#llvm_indirectbr{}) -> false; +is_label(#llvm_switch{}) -> false; +is_label(#llvm_invoke{}) -> false; +is_label(#llvm_operation{}) -> false; +is_label(#llvm_extractvalue{}) -> false; +is_label(#llvm_insertvalue{}) -> false; +is_label(#llvm_alloca{}) -> false; +is_label(#llvm_load{}) -> false; +is_label(#llvm_store{}) -> false; +is_label(#llvm_getelementptr{}) -> false; +is_label(#llvm_conversion{}) -> false; +is_label(#llvm_sitofp{}) -> false; +is_label(#llvm_ptrtoint{}) -> false; +is_label(#llvm_inttoptr{}) -> false; +is_label(#llvm_icmp{}) -> false; +is_label(#llvm_fcmp{}) -> false; +is_label(#llvm_phi{}) -> false; +is_label(#llvm_select{}) -> false; +is_label(#llvm_call{}) -> false; +is_label(#llvm_fun_def{}) -> false; +is_label(#llvm_fun_decl{}) -> false; +is_label(#llvm_landingpad{}) -> false; +is_label(#llvm_comment{}) -> false; +is_label(#llvm_const_decl{}) -> false; +is_label(#llvm_asm{}) -> false; +is_label(#llvm_adj_stack{}) -> false; +is_label(#llvm_branch_meta{}) -> false. + +%% const_decl +mk_const_decl(Dst, Decl_type, Type, Value) -> + #llvm_const_decl{dst=Dst, decl_type=Decl_type, type=Type, value=Value}. +const_decl_dst(#llvm_const_decl{dst=Dst}) -> Dst. +const_decl_decl_type(#llvm_const_decl{decl_type=Decl_type}) -> Decl_type. +const_decl_type(#llvm_const_decl{type=Type}) -> Type. +const_decl_value(#llvm_const_decl{value=Value}) -> Value. + +%% asm +mk_asm(Instruction) -> #llvm_asm{instruction=Instruction}. +asm_instruction(#llvm_asm{instruction=Instruction}) -> Instruction. + +%% adj_stack +mk_adj_stack(Offset, Register, Type) -> + #llvm_adj_stack{offset=Offset, 'register'=Register, type=Type}. +adj_stack_offset(#llvm_adj_stack{offset=Offset}) -> Offset. +adj_stack_register(#llvm_adj_stack{'register'=Register}) -> Register. +adj_stack_type(#llvm_adj_stack{type=Type}) -> Type. + +%% branch meta-data +mk_branch_meta(Id, True_weight, False_weight) -> + #llvm_branch_meta{id=Id, true_weight=True_weight, false_weight=False_weight}. +branch_meta_id(#llvm_branch_meta{id=Id}) -> Id. +branch_meta_true_weight(#llvm_branch_meta{true_weight=True_weight}) -> + True_weight. +branch_meta_false_weight(#llvm_branch_meta{false_weight=False_weight}) -> + False_weight. + +%% types +mk_void() -> #llvm_void{}. + +mk_label_type() -> #llvm_label_type{}. + +mk_int(Width) -> #llvm_int{width=Width}. +int_width(#llvm_int{width=Width}) -> Width. + +mk_double() -> #llvm_double{}. + +mk_pointer(Type) -> #llvm_pointer{type=Type}. +pointer_type(#llvm_pointer{type=Type}) -> Type. + +mk_array(Size, Type) -> #llvm_array{'size'=Size, type=Type}. +array_size(#llvm_array{'size'=Size}) -> Size. +array_type(#llvm_array{type=Type}) -> Type. + +mk_vector(Size, Type) -> #llvm_vector{'size'=Size, type=Type}. +vector_size(#llvm_vector{'size'=Size}) -> Size. +vector_type(#llvm_vector{type=Type}) -> Type. + +mk_struct(Type_list) -> #llvm_struct{type_list=Type_list}. +struct_type_list(#llvm_struct{type_list=Type_list}) -> Type_list. + +mk_fun(Ret_type, Arg_type_list) -> + #llvm_fun{ret_type=Ret_type, arg_type_list=Arg_type_list}. +function_ret_type(#llvm_fun{ret_type=Ret_type}) -> Ret_type. +function_arg_type_list(#llvm_fun{arg_type_list=Arg_type_list}) -> + Arg_type_list. + +%%---------------------------------------------------------------------------- +%% Pretty-printer Functions +%%---------------------------------------------------------------------------- + +%% @doc Pretty-print a list of LLVM instructions to a Device. +pp_ins_list(_Dev, []) -> ok; +pp_ins_list(Dev, [I|Is]) -> + pp_ins(Dev, I), + pp_ins_list(Dev, Is). + +pp_ins(Dev, I) -> + case indent(I) of + true -> write(Dev, " "); + false -> ok + end, + case I of + #llvm_ret{} -> + write(Dev, "ret "), + case ret_ret_list(I) of + [] -> write(Dev, "void"); + List -> pp_args(Dev, List) + end, + write(Dev, "\n"); + #llvm_br{} -> + write(Dev, ["br label ", br_dst(I), "\n"]); + #llvm_switch{} -> + write(Dev, "switch "), + pp_type(Dev, switch_type(I)), + write(Dev, [" ", switch_value(I), ", label ", switch_default_label(I), + " \n [\n"]), + pp_switch_value_label_list(Dev, switch_type(I), + switch_value_label_list(I)), + write(Dev, " ]\n"); + #llvm_invoke{} -> + write(Dev, [invoke_dst(I), " = invoke ", invoke_cconv(I), " "]), + pp_options(Dev, invoke_ret_attrs(I)), + pp_type(Dev, invoke_type(I)), + write(Dev, [" ", invoke_fnptrval(I), "("]), + pp_args(Dev, invoke_arglist(I)), + write(Dev, ") "), + pp_options(Dev, invoke_fn_attrs(I)), + write(Dev, [" to label ", invoke_to_label(I)," unwind label ", + invoke_unwind_label(I), " \n"]); + #llvm_br_cond{} -> + write(Dev, ["br i1 ", br_cond_cond(I), ", label ", br_cond_true_label(I), + ", label ", br_cond_false_label(I)]), + case br_cond_meta(I) of + [] -> ok; + Metadata -> + write(Dev, [", !prof !", Metadata]) + end, + write(Dev, "\n"); + #llvm_indirectbr{} -> + write(Dev, "indirectbr "), + pp_type(Dev, indirectbr_type(I)), + write(Dev, [" ", indirectbr_address(I), ", [ "]), + pp_args(Dev, indirectbr_label_list(I)), + write(Dev, " ]\n"); + #llvm_operation{} -> + write(Dev, [operation_dst(I), " = ", atom_to_list(operation_op(I)), " "]), + case op_has_options(operation_op(I)) of + true -> pp_options(Dev, operation_options(I)); + false -> ok + end, + pp_type(Dev, operation_type(I)), + write(Dev, [" ", operation_src1(I), ", ", operation_src2(I), "\n"]); + #llvm_extractvalue{} -> + write(Dev, [extractvalue_dst(I), " = extractvalue "]), + pp_type(Dev, extractvalue_type(I)), + %% TODO Print idxs + write(Dev, [" ", extractvalue_val(I), ", ", extractvalue_idx(I), "\n"]); + #llvm_insertvalue{} -> + write(Dev, [insertvalue_dst(I), " = insertvalue "]), + pp_type(Dev, insertvalue_val_type(I)), + write(Dev, [" ", insertvalue_val(I), ", "]), + pp_type(Dev, insertvalue_elem_type(I)), + %%TODO Print idxs + write(Dev, [" ", insertvalue_elem(I), ", ", insertvalue_idx(I), "\n"]); + #llvm_alloca{} -> + write(Dev, [alloca_dst(I), " = alloca "]), + pp_type(Dev, alloca_type(I)), + case alloca_num(I) of + [] -> ok; + Num -> + write(Dev, ", "), + pp_type(Dev, alloca_type(I)), + write(Dev, [" ", Num, " "]) + end, + case alloca_align(I) of + [] -> ok; + Align -> write(Dev, [",align ", Align]) + end, + write(Dev, "\n"); + #llvm_load{} -> + write(Dev, [load_dst(I), " = "]), + write(Dev, "load "), + case load_volatile(I) of + true -> write(Dev, "volatile "); + false -> ok + end, + pp_type(Dev, load_p_type(I)), + write(Dev, [" ", load_pointer(I), " "]), + case load_alignment(I) of + [] -> ok; + Al -> write(Dev, [", align ", Al, " "]) + end, + case load_nontemporal(I) of + [] -> ok; + In -> write(Dev, [", !nontemporal !", In]) + end, + write(Dev, "\n"); + #llvm_store{} -> + write(Dev, "store "), + case store_volatile(I) of + true -> write(Dev, "volatile "); + false -> ok + end, + pp_type(Dev, store_type(I)), + write(Dev, [" ", store_value(I), ", "]), + pp_type(Dev, store_p_type(I)), + write(Dev, [" ", store_pointer(I), " "]), + case store_alignment(I) of + [] -> ok; + Al -> write(Dev, [", align ", Al, " "]) + end, + case store_nontemporal(I) of + [] -> ok; + In -> write(Dev, [", !nontemporal !", In]) + end, + write(Dev, "\n"); + #llvm_getelementptr{} -> + write(Dev, [getelementptr_dst(I), " = getelementptr "]), + case getelementptr_inbounds(I) of + true -> write(Dev, "inbounds "); + false -> ok + end, + pp_type(Dev, getelementptr_p_type(I)), + write(Dev, [" ", getelementptr_value(I)]), + pp_typed_idxs(Dev, getelementptr_typed_idxs(I)), + write(Dev, "\n"); + #llvm_conversion{} -> + write(Dev, [conversion_dst(I), " = ", atom_to_list(conversion_op(I)), " "]), + pp_type(Dev, conversion_src_type(I)), + write(Dev, [" ", conversion_src(I), " to "]), + pp_type(Dev, conversion_dst_type(I)), + write(Dev, "\n"); + #llvm_icmp{} -> + write(Dev, [icmp_dst(I), " = icmp ", atom_to_list(icmp_cond(I)), " "]), + pp_type(Dev, icmp_type(I)), + write(Dev, [" ", icmp_src1(I), ", ", icmp_src2(I), "\n"]); + #llvm_fcmp{} -> + write(Dev, [fcmp_dst(I), " = fcmp ", atom_to_list(fcmp_cond(I)), " "]), + pp_type(Dev, fcmp_type(I)), + write(Dev, [" ", fcmp_src1(I), ", ", fcmp_src2(I), "\n"]); + #llvm_phi{} -> + write(Dev, [phi_dst(I), " = phi "]), + pp_type(Dev, phi_type(I)), + pp_phi_value_labels(Dev, phi_value_label_list(I)), + write(Dev, "\n"); + #llvm_select{} -> + write(Dev, [select_dst(I), " = select i1 ", select_cond(I), ", "]), + pp_type(Dev, select_typ1(I)), + write(Dev, [" ", select_val1(I), ", "]), + pp_type(Dev, select_typ2(I)), + write(Dev, [" ", select_val2(I), "\n"]); + #llvm_call{} -> + case call_dst(I) of + [] -> ok; + Dst -> write(Dev, [Dst, " = "]) + end, + case call_is_tail(I) of + true -> write(Dev, "tail "); + false -> ok + end, + write(Dev, ["call ", call_cconv(I), " "]), + pp_options(Dev, call_ret_attrs(I)), + pp_type(Dev, call_type(I)), + write(Dev, [" ", call_fnptrval(I), "("]), + pp_args(Dev, call_arglist(I)), + write(Dev, ") "), + pp_options(Dev, call_fn_attrs(I)), + write(Dev, "\n"); + #llvm_fun_def{} -> + write(Dev, "define "), + pp_options(Dev, fun_def_linkage(I)), + pp_options(Dev, fun_def_visibility(I)), + case fun_def_cconv(I) of + [] -> ok; + Cc -> write(Dev, [Cc, " "]) + end, + pp_options(Dev, fun_def_ret_attrs(I)), + write(Dev, " "), + pp_type(Dev, fun_def_type(I)), + write(Dev, [" @", fun_def_name(I), "("]), + pp_args(Dev, fun_def_arglist(I)), + write(Dev, ") "), + pp_options(Dev, fun_def_fn_attrs(I)), + case fun_def_align(I) of + [] -> ok; + N -> write(Dev, ["align ", N]) + end, + write(Dev, "{\n"), + pp_ins_list(Dev, fun_def_body(I)), + write(Dev, "}\n"); + #llvm_fun_decl{} -> + write(Dev, "declare "), + pp_options(Dev, fun_decl_linkage(I)), + pp_options(Dev, fun_decl_visibility(I)), + case fun_decl_cconv(I) of + [] -> ok; + Cc -> write(Dev, [Cc, " "]) + end, + pp_options(Dev, fun_decl_ret_attrs(I)), + pp_type(Dev, fun_decl_type(I)), + write(Dev, [" ", fun_decl_name(I), "("]), + pp_type_list(Dev, fun_decl_arglist(I)), + write(Dev, ") "), + case fun_decl_align(I) of + [] -> ok; + N -> write(Dev, ["align ", N]) + end, + write(Dev, "\n"); + #llvm_comment{} -> + write(Dev, ["; ", atom_to_list(comment_text(I)), "\n"]); + #llvm_label{} -> + write(Dev, [label_label(I), ":\n"]); + #llvm_const_decl{} -> + write(Dev, [const_decl_dst(I), " = ", const_decl_decl_type(I), " "]), + pp_type(Dev, const_decl_type(I)), + write(Dev, [" ", const_decl_value(I), "\n"]); + #llvm_landingpad{} -> + write(Dev, "landingpad { i8*, i32 } personality i32 (i32, i64, i8*,i8*)* + @__gcc_personality_v0 cleanup\n"); + #llvm_asm{} -> + write(Dev, [asm_instruction(I), "\n"]); + #llvm_adj_stack{} -> + write(Dev, ["call void asm sideeffect \"sub $0, ", + adj_stack_register(I), "\", \"r\"("]), + pp_type(Dev, adj_stack_type(I)), + write(Dev, [" ", adj_stack_offset(I),")\n"]); + #llvm_branch_meta{} -> + write(Dev, ["!", branch_meta_id(I), " = metadata !{metadata !\"branch_weights\", + i32 ", branch_meta_true_weight(I), ", i32 ", + branch_meta_false_weight(I), "}\n"]); + Other -> + exit({?MODULE, pp_ins, {"Unknown LLVM instruction", Other}}) + end. + +%% @doc Pretty-print a list of types +pp_type_list(_Dev, []) -> ok; +pp_type_list(Dev, [T]) -> + pp_type(Dev, T); +pp_type_list(Dev, [T|Ts]) -> + pp_type(Dev, T), + write(Dev, ", "), + pp_type_list(Dev, Ts). + +pp_type(Dev, Type) -> + case Type of + #llvm_void{} -> + write(Dev, "void"); + #llvm_label_type{} -> + write(Dev, "label"); + %% Integer + #llvm_int{} -> + write(Dev, ["i", integer_to_list(int_width(Type))]); + %% Float + #llvm_float{} -> + write(Dev, "float"); + #llvm_double{} -> + write(Dev, "double"); + #llvm_fp80{} -> + write(Dev, "x86_fp80"); + #llvm_fp128{} -> + write(Dev, "fp128"); + #llvm_ppc_fp128{} -> + write(Dev, "ppc_fp128"); + %% Pointer + #llvm_pointer{} -> + pp_type(Dev, pointer_type(Type)), + write(Dev, "*"); + %% Function + #llvm_fun{} -> + pp_type(Dev, function_ret_type(Type)), + write(Dev, " ("), + pp_type_list(Dev, function_arg_type_list(Type)), + write(Dev, ")"); + %% Aggregate + #llvm_array{} -> + write(Dev, ["[", integer_to_list(array_size(Type)), " x "]), + pp_type(Dev, array_type(Type)), + write(Dev, "]"); + #llvm_struct{} -> + write(Dev, "{"), + pp_type_list(Dev, struct_type_list(Type)), + write(Dev, "}"); + #llvm_vector{} -> + write(Dev, ["{", integer_to_list(vector_size(Type)), " x "]), + pp_type(Dev, vector_type(Type)), + write(Dev, "}") + end. + +%% @doc Pretty-print a list of typed arguments +pp_args(_Dev, []) -> ok; +pp_args(Dev, [{Type, Arg} | []]) -> + pp_type(Dev, Type), + write(Dev, [" ", Arg]); +pp_args(Dev, [{Type, Arg} | Args]) -> + pp_type(Dev, Type), + write(Dev, [" ", Arg, ", "]), + pp_args(Dev, Args). + +%% @doc Pretty-print a list of options +pp_options(_Dev, []) -> ok; +pp_options(Dev, [O|Os]) -> + write(Dev, [atom_to_list(O), " "]), + pp_options(Dev, Os). + +%% @doc Pretty-print a list of phi value-labels +pp_phi_value_labels(_Dev, []) -> ok; +pp_phi_value_labels(Dev, [{Value, Label}|[]]) -> + write(Dev, ["[ ", Value, ", ", Label, " ]"]); +pp_phi_value_labels(Dev,[{Value, Label}|VL]) -> + write(Dev, ["[ ", Value, ", ", Label, " ], "]), + pp_phi_value_labels(Dev, VL). + +%% @doc Pretty-print a list of typed indexes +pp_typed_idxs(_Dev, []) -> ok; +pp_typed_idxs(Dev, [{Type, Id} | Tids]) -> + write(Dev, ", "), + pp_type(Dev, Type), + write(Dev, [" ", Id]), + pp_typed_idxs(Dev, Tids). + +%% @doc Pretty-print a switch label list +pp_switch_value_label_list(_Dev, _Type, []) -> ok; +pp_switch_value_label_list(Dev, Type, [{Value, Label} | VLs]) -> + write(Dev, " "), + pp_type(Dev, Type), + write(Dev, [" ", Value, ", label ", Label, "\n"]), + pp_switch_value_label_list(Dev, Type, VLs). + +%%---------------------------------------------------------------------------- +%% Auxiliary Functions +%%---------------------------------------------------------------------------- + +%% @doc Returns if an instruction needs to be intended +indent(I) -> + case I of + #llvm_label{} -> false; + #llvm_fun_def{} -> false; + #llvm_fun_decl{} -> false; + #llvm_const_decl{} -> false; + #llvm_branch_meta{} -> false; + _ -> true + end. + +op_has_options(Op) -> + case Op of + 'and' -> false; + 'or' -> false; + 'xor' -> false; + _ -> true + end. + +%% @doc Abstracts actual writing to file operations +write(Dev, Msg) -> + ok = file:write(Dev, Msg). diff --git a/lib/hipe/llvm/hipe_llvm_arch.hrl b/lib/hipe/llvm/hipe_llvm_arch.hrl new file mode 100644 index 0000000000..689a5a52ea --- /dev/null +++ b/lib/hipe/llvm/hipe_llvm_arch.hrl @@ -0,0 +1,11 @@ +-ifdef(BIT32). +-define(NR_PINNED_REGS, 2). +-define(NR_ARG_REGS, 3). +-define(ARCH_REGISTERS, hipe_x86_registers). +-define(FLOAT_OFFSET, 2). +-else. +-define(NR_PINNED_REGS, 2). +-define(NR_ARG_REGS, 4). +-define(ARCH_REGISTERS, hipe_amd64_registers). +-define(FLOAT_OFFSET, 6). +-endif. diff --git a/lib/hipe/llvm/hipe_llvm_liveness.erl b/lib/hipe/llvm/hipe_llvm_liveness.erl new file mode 100644 index 0000000000..d1c90ed4c9 --- /dev/null +++ b/lib/hipe/llvm/hipe_llvm_liveness.erl @@ -0,0 +1,112 @@ +-module(hipe_llvm_liveness). + +-export([analyze/1]). + +%% @doc Find gc roots and explicitly mark when they go out of scope, based +%% on the liveness analyzis performed by the hipe_rtl_liveness:analyze/1. +analyze(RtlCfg) -> + Liveness = hipe_rtl_liveness:analyze(RtlCfg), + Roots = find_roots(RtlCfg, Liveness), + %% erlang:display(Roots), + NewRtlCfg = mark_dead_roots(RtlCfg, Liveness, Roots), + {NewRtlCfg, Roots}. + +%% @doc Determine which are the GC Roots.Possible roots are all +%% RTL variables (rtl_var). However, since safe points are function calls, we +%% consider as possible GC roots only RTL variables that are live around +%% function calls. +find_roots(Cfg, Liveness) -> + Labels = hipe_rtl_cfg:postorder(Cfg), + Roots = find_roots_bb(Labels, Cfg, Liveness, []), + lists:usort(lists:flatten(Roots)). + +find_roots_bb([], _Cfg, _Liveness, RootAcc) -> + RootAcc; +find_roots_bb([L|Ls], Cfg, Liveness, RootAcc) -> + Block = hipe_rtl_cfg:bb(Cfg, L), + BlockCode = hipe_bb:code(Block), + LiveIn = ordsets:from_list(strip(hipe_rtl_liveness:livein(Liveness, L))), + LiveOut = ordsets:from_list(strip(hipe_rtl_liveness:liveout(Liveness, L))), + Roots = do_find_roots_bb(BlockCode, L, LiveOut, LiveIn, []), + find_roots_bb(Ls, Cfg, Liveness, Roots++RootAcc). + +%% For each call inside a BB the GC roots are those RTL variables that +%% are live before and after the call. +%% --> Live Before Call: These are the RTL variables that belong to the +%% LiveIn list or are initialized inside the BB before the call +%% --> Live After Call: These are the RTL variables that belong to the +%% LiveOut list or are used after the call inside the BB (they die +%% inside the BB and so do not belong to the LiveOut list) +do_find_roots_bb([], _Label, _LiveOut, _LiveBefore, RootAcc) -> + RootAcc; +do_find_roots_bb([I|Is], L, LiveOut, LiveBefore, RootAcc) -> + case hipe_rtl:is_call(I) of + true -> + %% Used inside the BB after the call + UsedAfterCall_ = strip(lists:flatten([hipe_rtl:uses(V) || V <- Is])), + UsedAfterCall = ordsets:from_list(UsedAfterCall_), + LiveAfter = ordsets:union(UsedAfterCall, LiveOut), + %% The Actual Roots + Roots = ordsets:intersection(LiveBefore, LiveAfter), + %% The result of the instruction + Defines = ordsets:from_list(strip(hipe_rtl:defines(I))), + LiveBefore1 = ordsets:union(LiveBefore, Defines), + do_find_roots_bb(Is, L, LiveOut, LiveBefore1, [Roots|RootAcc]); + false -> + %% The result of the instruction + Defines = ordsets:from_list(strip(hipe_rtl:defines(I))), + LiveBefore1 = ordsets:union(LiveBefore, Defines), + do_find_roots_bb(Is, L, LiveOut, LiveBefore1, RootAcc) + end. + +%% @doc This function is responsible for marking when GC Roots, which can be +%% only RTL variables go out of scope (dead). This pass is needed for the LLVM +%% back end because the LLVM framework forces us to explicit mark when gc roots +%% are no longer live. +mark_dead_roots(CFG, Liveness, Roots) -> + Labels = hipe_rtl_cfg:postorder(CFG), + mark_dead_bb(Labels, CFG, Liveness, Roots). + +mark_dead_bb([], Cfg, _Liveness, _Roots) -> + Cfg; +mark_dead_bb([L|Ls], Cfg, Liveness, Roots) -> + Block = hipe_rtl_cfg:bb(Cfg, L), + BlockCode = hipe_bb:code(Block), + LiveOut = ordsets:from_list(strip(hipe_rtl_liveness:liveout(Liveness, L))), + NewBlockCode = do_mark_dead_bb(BlockCode, LiveOut, Roots, []), + %% Update the CFG + NewBB = hipe_bb:code_update(Block, NewBlockCode), + NewCFG = hipe_rtl_cfg:bb_add(Cfg, L, NewBB), + mark_dead_bb(Ls, NewCFG, Liveness, Roots). + +do_mark_dead_bb([], _LiveOut, _Roots, NewBlockCode) -> + lists:reverse(NewBlockCode); +do_mark_dead_bb([I|Is], LiveOut ,Roots, NewBlockCode) -> + Uses = ordsets:from_list(strip(hipe_rtl:uses(I))), + %% GC roots that are used in this instruction + RootsUsed = ordsets:intersection(Roots, Uses), + UsedAfter_ = strip(lists:flatten([hipe_rtl:uses(V) || V <- Is])), + UsedAfter = ordsets:from_list(UsedAfter_), + %% GC roots that are live after this instruction + LiveAfter = ordsets:union(LiveOut, UsedAfter), + %% GC roots that their last use is in this instruction + DeadRoots = ordsets:subtract(RootsUsed, LiveAfter), + %% Recreate the RTL variable from the corresponding Index + OldVars = [hipe_rtl:mk_var(V1) || V1 <- DeadRoots], + %% Mark the RTL variable as DEAD (last use) + NewVars = [kill_var(V2) || V2 <- OldVars], + %% Create a list with the substitution of the old vars with the new + %% ones which are marked with the dead keyword + Subtitution = lists:zip(OldVars, NewVars), + NewI = case Subtitution of + [] -> I; + _ -> hipe_rtl:subst_uses_llvm(Subtitution, I) + end, + do_mark_dead_bb(Is, LiveOut, Roots, [NewI|NewBlockCode]). + +%% Update the liveness of a var,in order to mark that this is the last use. +kill_var(Var) -> hipe_rtl:var_liveness_update(Var, dead). + +%% We are only interested for rtl_vars, since only rtl_vars are possible gc +%% roots. +strip(L) -> [Y || {rtl_var, Y, _} <- L]. diff --git a/lib/hipe/llvm/hipe_llvm_main.erl b/lib/hipe/llvm/hipe_llvm_main.erl new file mode 100644 index 0000000000..e911fb89c9 --- /dev/null +++ b/lib/hipe/llvm/hipe_llvm_main.erl @@ -0,0 +1,514 @@ +%% -*- erlang-indent-level: 2 -*- +-module(hipe_llvm_main). + +-export([rtl_to_native/4]). + +-include("../../kernel/src/hipe_ext_format.hrl"). +-include("hipe_llvm_arch.hrl"). +-include("elf_format.hrl"). + +%% @doc Translation of RTL to a loadable object. This function takes the RTL +%% code and calls hipe_rtl_to_llvm:translate/2 to translate the RTL code to +%% LLVM code. After this, LLVM asm is printed to a file and the LLVM tool +%% chain is invoked in order to produce an object file. +rtl_to_native(MFA, RTL, Roots, Options) -> + %% Compile to LLVM and get Instruction List (along with infos) + {LLVMCode, RelocsDict, ConstTab} = + hipe_rtl_to_llvm:translate(RTL, Roots), + %% Fix function name to an acceptable LLVM identifier (needed for closures) + {_Module, Fun, Arity} = hipe_rtl_to_llvm:fix_mfa_name(MFA), + %% Write LLVM Assembly to intermediate file (on disk) + {ok, Dir, ObjectFile} = + compile_with_llvm(Fun, Arity, LLVMCode, Options, false), + %% + %% Extract information from object file + %% + ObjBin = open_object_file(ObjectFile), + %% Read and set the ELF class + elf_format:set_architecture_flag(ObjBin), + %% Get labels info (for switches and jump tables) + Labels = elf_format:get_rodata_relocs(ObjBin), + {Switches, Closures} = get_tables(ObjBin), + %% Associate Labels with Switches and Closures with stack args + {SwitchInfos, ExposedClosures} = + correlate_labels(Switches ++ Closures, Labels), + %% SwitchInfos: [{"table_50", [Labels]}] + %% ExposedClosures: [{"table_closures", [Labels]}] + + %% Labelmap contains the offsets of the labels in the code that are + %% used for switch's jump tables + LabelMap = create_labelmap(MFA, SwitchInfos, RelocsDict), + %% Get relocation info + TextRelocs = elf_format:get_text_relocs(ObjBin), + %% AccRefs contains the offsets of all references to relocatable symbols in + %% the code: + AccRefs = fix_relocations(TextRelocs, RelocsDict, MFA), + %% Get stack descriptors + SDescs = get_sdescs(ObjBin), + %% FixedSDescs are the stack descriptors after correcting calls that have + %% arguments in the stack + FixedSDescs = + fix_stack_descriptors(RelocsDict, AccRefs, SDescs, ExposedClosures), + Refs = AccRefs ++ FixedSDescs, + %% Get binary code from object file + BinCode = elf_format:extract_text(ObjBin), + %% Remove temp files (if needed) + ok = remove_temp_folder(Dir, Options), + %% Return the code together with information that will be used in the + %% hipe_llvm_merge module to produce the final binary that will be loaded + %% by the hipe unified loader. + {MFA, BinCode, byte_size(BinCode), ConstTab, Refs, LabelMap}. + +%%------------------------------------------------------------------------------ +%% LLVM tool chain +%%------------------------------------------------------------------------------ + +%% @doc Compile function FunName/Arity to LLVM. Return Dir (in order to remove +%% it if we do not want to store temporary files) and ObjectFile name that +%% is created by the LLVM tools. +compile_with_llvm(FunName, Arity, LLVMCode, Options, UseBuffer) -> + Filename = atom_to_list(FunName) ++ "_" ++ integer_to_list(Arity), + %% Save temp files in a unique folder + Dir = unique_folder(FunName, Arity, Options), + ok = file:make_dir(Dir), + %% Print LLVM assembly to file + OpenOpts = [append, raw] ++ + case UseBuffer of + %% true -> [delayed_write]; % Use delayed_write! + false -> [] + end, + {ok, File_llvm} = file:open(Dir ++ Filename ++ ".ll", OpenOpts), + hipe_llvm:pp_ins_list(File_llvm, LLVMCode), + %% delayed_write can cause file:close not to do a close, hence the two calls + ok = file:close(File_llvm), + __ = file:close(File_llvm), + %% Invoke LLVM compiler tools to produce an object file + llvm_opt(Dir, Filename, Options), + llvm_llc(Dir, Filename, Options), + compile(Dir, Filename, "gcc"), %%FIXME: use llc -filetype=obj and skip this! + {ok, Dir, Dir ++ Filename ++ ".o"}. + +%% @doc Invoke opt tool to optimize the bitcode (_name.ll -> _name.bc). +llvm_opt(Dir, Filename, Options) -> + Source = Dir ++ Filename ++ ".ll", + Dest = Dir ++ Filename ++ ".bc", + OptLevel = trans_optlev_flag(opt, Options), + OptFlags = [OptLevel, "-mem2reg", "-strip"], + Command = "opt " ++ fix_opts(OptFlags) ++ " " ++ Source ++ " -o " ++ Dest, + %% io:format("OPT: ~s~n", [Command]), + case os:cmd(Command) of + "" -> ok; + Error -> exit({?MODULE, opt, Error}) + end. + +%% @doc Invoke llc tool to compile the bitcode to object file +%% (_name.bc -> _name.o). +llvm_llc(Dir, Filename, Options) -> + Source = Dir ++ Filename ++ ".bc", + OptLevel = trans_optlev_flag(llc, Options), + Align = find_stack_alignment(), + LlcFlags = [OptLevel, "-code-model=medium", "-stack-alignment=" ++ Align + , "-tailcallopt", "-filetype=asm"], %%FIXME + Command = "llc " ++ fix_opts(LlcFlags) ++ " " ++ Source, + %% io:format("LLC: ~s~n", [Command]), + case os:cmd(Command) of + "" -> ok; + Error -> exit({?MODULE, llc, Error}) + end. + +%% @doc Invoke the compiler tool ("gcc", "llvmc", etc.) to generate an object +%% file from native assembly. +compile(Dir, Fun_Name, Compiler) -> + Source = Dir ++ Fun_Name ++ ".s", + Dest = Dir ++ Fun_Name ++ ".o", + Command = Compiler ++ " -c " ++ Source ++ " -o " ++ Dest, + %% io:format("~s: ~s~n", [Compiler, Command]), + case os:cmd(Command) of + "" -> ok; + Error -> exit({?MODULE, cc, Error}) + end. + +find_stack_alignment() -> + case get(hipe_target_arch) of + x86 -> "4"; + amd64 -> "8"; + _ -> exit({?MODULE, find_stack_alignment, "Unimplemented architecture"}) + end. + +%% @doc Join options. +fix_opts(Opts) -> + string:join(Opts, " "). + +%% @doc Translate optimization-level flag (default is "O2"). +trans_optlev_flag(Tool, Options) -> + Flag = case Tool of + opt -> llvm_opt; + llc -> llvm_llc + end, + case proplists:get_value(Flag, Options) of + o0 -> ""; % "-O0" does not exist in opt tool + o1 -> "-O1"; + o2 -> "-O2"; + o3 -> "-O3"; + undefined -> "-O2" + end. + +%%------------------------------------------------------------------------------ +%% Functions to manage Relocations +%%------------------------------------------------------------------------------ + +%% @doc Get switch table and closure table. +get_tables(Elf) -> + %% Search Symbol Table for an entry with name prefixed with "table_": + Triples = elf_format:get_tab_entries(Elf), + Switches = [T || T={"table_" ++ _, _, _} <- Triples], + Closures = [T || T={"table_closures" ++ _, _, _} <- Switches], + {Switches, Closures}. + +%% @doc This function associates symbols who point to some table of labels with +%% the corresponding offsets of the labels in the code. These tables can +%% either be jump tables for switches or a table which contains the labels +%% of blocks that contain closure calls with more than ?NR_ARG_REGS. +correlate_labels([], _L) -> {[], []}; +correlate_labels(Tables, Labels) -> + %% Sort "Tables" based on "ValueOffsets" + OffsetSortedTb = lists:ukeysort(2, Tables), + %% Unzip offset-sorted list of "Switches" + {Names, _Offsets, TablesSizeList} = lists:unzip3(OffsetSortedTb), + %% Associate switch names with labels + L = split_list(Labels, TablesSizeList), + %% Zip back! (to [{SwitchName, Values}]) + NamesValues = lists:zip(Names, L), + case lists:keytake("table_closures", 1, NamesValues) of + false -> %% No closures in the code, no closure table + {NamesValues, []}; + {value, ClosureTableNV, SwitchesNV} -> + {SwitchesNV, ClosureTableNV} + end. + +%% @doc Create a gb_tree which contains information about the labels that used +%% for switch's jump tables. The keys of the gb_tree are of the form +%% {MFA, Label} and the values are the actual Offsets. +create_labelmap(MFA, SwitchInfos, RelocsDict) -> + create_labelmap(MFA, SwitchInfos, RelocsDict, gb_trees:empty()). + +create_labelmap(_, [], _, LabelMap) -> LabelMap; +create_labelmap(MFA, [{Name, Offsets} | Rest], RelocsDict, LabelMap) -> + case dict:fetch(Name, RelocsDict) of + {switch, {_TableType, LabelList, _NrLabels, _SortOrder}, _JTabLab} -> + KVDict = lists:ukeysort(1, lists:zip(LabelList, Offsets)), + NewLabelMap = insert_to_labelmap(KVDict, LabelMap), + create_labelmap(MFA, Rest, RelocsDict, NewLabelMap); + _ -> + exit({?MODULE, create_labelmap, "Not a jump table!"}) + end. + +%% @doc Insert a list of [{Key,Value}] to a LabelMap (gb_tree). +insert_to_labelmap([], LabelMap) -> LabelMap; +insert_to_labelmap([{Key, Value}|Rest], LabelMap) -> + case gb_trees:lookup(Key, LabelMap) of + none -> + insert_to_labelmap(Rest, gb_trees:insert(Key, Value, LabelMap)); + {value, Value} -> %% Exists with the *exact* same Value. + insert_to_labelmap(Rest, LabelMap) + end. + +%% @doc Correlate object file relocation symbols with info from translation to +%% llvm code. +fix_relocations(Relocs, RelocsDict, MFA) -> + fix_relocs(Relocs, RelocsDict, MFA, []). + +fix_relocs([], _, _, RelocAcc) -> RelocAcc; +fix_relocs([{Name, Offset}|Rs], RelocsDict, {ModName,_,_}=MFA, RelocAcc) -> + case dict:fetch(Name, RelocsDict) of + {atom, AtomName} -> + fix_relocs(Rs, RelocsDict, MFA, + [{?LOAD_ATOM, Offset, AtomName}|RelocAcc]); + {constant, Label} -> + fix_relocs(Rs, RelocsDict, MFA, + [{?LOAD_ADDRESS, Offset, {constant, Label}}|RelocAcc]); + {switch, _, JTabLab} -> %% Treat switch exactly as constant + fix_relocs(Rs, RelocsDict, MFA, + [{?LOAD_ADDRESS, Offset, {constant, JTabLab}}|RelocAcc]); + {closure, _}=Closure -> + fix_relocs(Rs, RelocsDict, MFA, + [{?LOAD_ADDRESS, Offset, Closure}|RelocAcc]); + {call, {bif, BifName, _}} -> + fix_relocs(Rs, RelocsDict, MFA, + [{?CALL_LOCAL, Offset, BifName}|RelocAcc]); + %% MFA calls to functions in the same module are of type 3, while all + %% other MFA calls are of type 2. + {call, {ModName,_F,_A}=CallMFA} -> + fix_relocs(Rs, RelocsDict, MFA, + [{?CALL_LOCAL, Offset, CallMFA}|RelocAcc]); + {call, CallMFA} -> + fix_relocs(Rs, RelocsDict, MFA, + [{?CALL_REMOTE, Offset, CallMFA}|RelocAcc]); + Other -> + exit({?MODULE, fix_relocs, + {"Relocation not in relocation dictionary", Other}}) + end. + +%%------------------------------------------------------------------------------ +%% Functions to manage Stack Descriptors +%%------------------------------------------------------------------------------ + +%% @doc This function takes an ELF Object File binary and returns a proper sdesc +%% list for Erlang/OTP System's loader. The return value should be of the +%% form: +%% { +%% 4, Safepoint Address, +%% {ExnLabel OR [], FrameSize, StackArity, {Liveroot stack frame indexes}}, +%% } +get_sdescs(Elf) -> + case elf_format:extract_note(Elf, ?NOTE_ERLGC_NAME) of + <<>> -> % Object file has no ".note.gc" section! + []; + NoteGC_bin -> + %% Get safe point addresses (stored in ".rela.note.gc" section): + RelaNoteGC = elf_format:extract_rela(Elf, ?NOTE(?NOTE_ERLGC_NAME)), + SPCount = length(RelaNoteGC), + T = SPCount * ?SP_ADDR_SIZE, + %% Pattern match fields of ".note.gc": + <<SPCount:(?bits(?SP_COUNT_SIZE))/integer-little, % Sanity check! + SPAddrs:T/binary, % NOTE: In 64bit they are relocs! + StkFrameSize:(?bits(?SP_STKFRAME_SIZE))/integer-little, + StkArity:(?bits(?SP_STKARITY_SIZE))/integer-little, + _LiveRootCount:(?bits(?SP_LIVEROOTCNT_SIZE))/integer-little, % Skip + Roots/binary>> = NoteGC_bin, + LiveRoots = get_liveroots(Roots, []), + %% Extract information about the safe point addresses: + SPOffs = + case elf_format:is64bit() of + true -> %% Find offsets in ".rela.note.gc": + elf_format:get_rela_addends(RelaNoteGC); + false -> %% Find offsets in SPAddrs (in ".note.gc"): + get_spoffs(SPAddrs, []) + end, + %% Extract Exception Handler labels: + ExnHandlers = elf_format:get_exn_handlers(Elf), + %% Combine ExnHandlers and Safe point addresses (return addresses): + ExnAndSPOffs = combine_ras_and_exns(ExnHandlers, SPOffs, []), + create_sdesc_list(ExnAndSPOffs, StkFrameSize, StkArity, LiveRoots, []) + end. + +%% @doc Extracts a bunch of integers (live roots) from a binary. Returns a tuple +%% as need for stack descriptors. +get_liveroots(<<>>, Acc) -> + list_to_tuple(Acc); +get_liveroots(<<Root:?bits(?LR_STKINDEX_SIZE)/integer-little, + MoreRoots/binary>>, Acc) -> + get_liveroots(MoreRoots, [Root | Acc]). + +%% @doc Extracts a bunch of integers (safepoint offsets) from a binary. Returns +%% a tuple as need for stack descriptors. +get_spoffs(<<>>, Acc) -> + lists:reverse(Acc); +get_spoffs(<<SPOff:?bits(?SP_ADDR_SIZE)/integer-little, More/binary>>, Acc) -> + get_spoffs(More, [SPOff | Acc]). + +combine_ras_and_exns(_, [], Acc) -> + lists:reverse(Acc); +combine_ras_and_exns(ExnHandlers, [RA | MoreRAs], Acc) -> + %% FIXME: do something better than O(n^2) by taking advantage of the property + %% ||ExnHandlers|| <= ||RAs|| + Handler = find_exn_handler(RA, ExnHandlers), + combine_ras_and_exns(ExnHandlers, MoreRAs, [{Handler, RA} | Acc]). + +find_exn_handler(_, []) -> + []; +find_exn_handler(RA, [{Start, End, Handler} | MoreExnHandlers]) -> + case (RA >= Start andalso RA =< End) of + true -> + Handler; + false -> + find_exn_handler(RA, MoreExnHandlers) + end. + +create_sdesc_list([], _, _, _, Acc) -> + lists:reverse(Acc); +create_sdesc_list([{ExnLbl, SPOff} | MoreExnAndSPOffs], + StkFrameSize, StkArity, LiveRoots, Acc) -> + Hdlr = case ExnLbl of + 0 -> []; + N -> N + end, + create_sdesc_list(MoreExnAndSPOffs, StkFrameSize, StkArity, LiveRoots, + [{?SDESC, SPOff, {Hdlr, StkFrameSize, StkArity, LiveRoots}} + | Acc]). + +%% @doc This function is responsible for correcting the stack descriptors of +%% the calls that are found in the code and have more than NR_ARG_REGS +%% (thus, some of their arguments are passed to the stack). Because of the +%% Reserved Call Frame feature that the LLVM uses, the stack descriptors +%% are not correct since at the point of call the frame size is reduced +%% proportionally to the number of arguments that are passed on the stack. +%% Also the offsets of the roots need to be re-adjusted. +fix_stack_descriptors(_, _, [], _) -> + []; +fix_stack_descriptors(RelocsDict, Relocs, SDescs, ExposedClosures) -> + %% NamedCalls are MFA and BIF calls that need fix + NamedCalls = calls_with_stack_args(RelocsDict), + NamedCallsOffs = calls_offsets_arity(Relocs, NamedCalls), + ExposedClosures1 = + case dict:is_key("table_closures", RelocsDict) of + true -> %% A Table with closures exists + {table_closures, ArityList} = dict:fetch("table_closures", RelocsDict), + case ExposedClosures of + {_, Offsets} -> + lists:zip(Offsets, ArityList); + _ -> + exit({?MODULE, fix_stack_descriptors, + {"Wrong exposed closures", ExposedClosures}}) + end; + false -> + [] + end, + ClosuresOffs = closures_offsets_arity(ExposedClosures1, SDescs), + fix_sdescs(NamedCallsOffs ++ ClosuresOffs, SDescs). + +%% @doc This function takes as argument the relocation dictionary as produced by +%% the translation of RTL code to LLVM and finds the names of the calls +%% (MFA and BIF calls) that have more than NR_ARG_REGS. +calls_with_stack_args(Dict) -> + calls_with_stack_args(dict:to_list(Dict), []). + +calls_with_stack_args([], Calls) -> Calls; +calls_with_stack_args([ {_Name, {call, {M, F, A}}} | Rest], Calls) + when A > ?NR_ARG_REGS -> + Call = + case M of + bif -> {F,A}; + _ -> {M,F,A} + end, + calls_with_stack_args(Rest, [Call|Calls]); +calls_with_stack_args([_|Rest], Calls) -> + calls_with_stack_args(Rest, Calls). + +%% @doc This function extracts the stack arity and the offset in the code of +%% the named calls (MFAs, BIFs) that have stack arguments. +calls_offsets_arity(AccRefs, CallsWithStackArgs) -> + calls_offsets_arity(AccRefs, CallsWithStackArgs, []). + +calls_offsets_arity([], _, Acc) -> Acc; +calls_offsets_arity([{Type, Offset, Term} | Rest], CallsWithStackArgs, Acc) + when Type =:= ?CALL_REMOTE orelse Type =:= ?CALL_LOCAL -> + case lists:member(Term, CallsWithStackArgs) of + true -> + Arity = + case Term of + {_M, _F, A} -> A; + {_F, A} -> A + end, + calls_offsets_arity(Rest, CallsWithStackArgs, + [{Offset + 4, Arity - ?NR_ARG_REGS} | Acc]); + false -> + calls_offsets_arity(Rest, CallsWithStackArgs, Acc) + end; +calls_offsets_arity([_|Rest], CallsWithStackArgs, Acc) -> + calls_offsets_arity(Rest, CallsWithStackArgs, Acc). + +%% @doc This function extracts the stack arity and the offsets of closures that +%% have stack arity. The Closures argument represents the +%% hipe_bifs:llvm_exposure_closure/0 calls in the code. The actual closure +%% is the next call in the code, so the offset of the next call must be +%% calculated from the stack descriptors. +closures_offsets_arity([], _) -> + []; +closures_offsets_arity(ExposedClosures, SDescs) -> + Offsets = [Offset || {_, Offset, _} <- SDescs], + %% Offsets and closures must be sorted in order for find_offsets/3 to work + SortedOffsets = lists:sort(Offsets), + SortedExposedClosures = lists:keysort(1, ExposedClosures), + find_offsets(SortedExposedClosures, SortedOffsets, []). + +find_offsets([], _, Acc) -> Acc; +find_offsets([{Off,Arity}|Rest], Offsets, Acc) -> + [I | RestOffsets] = lists:dropwhile(fun (Y) -> Y<Off end, Offsets), + find_offsets(Rest, RestOffsets, [{I, Arity}|Acc]). + +%% The functions below correct the arity of calls, that are identified +%% by offset, in the stack descriptors. +fix_sdescs([], SDescs) -> SDescs; +fix_sdescs([{Offset, Arity} | Rest], SDescs) -> + case lists:keyfind(Offset, 2, SDescs) of + false -> + fix_sdescs(Rest, SDescs); + {?SDESC, Offset, SDesc} -> + {ExnHandler, FrameSize, StkArity, Roots} = SDesc, + DecRoot = fun(X) -> X-Arity end, + NewRootsList = lists:map(DecRoot, tuple_to_list(Roots)), + NewSDesc = + case length(NewRootsList) > 0 andalso hd(NewRootsList) >= 0 of + true -> + {?SDESC, Offset, {ExnHandler, FrameSize-Arity, StkArity, + list_to_tuple(NewRootsList)}}; + false -> + {?SDESC, Offset, {ExnHandler, FrameSize, StkArity, Roots}} + end, + RestSDescs = lists:keydelete(Offset, 2, SDescs), + fix_sdescs(Rest, [NewSDesc | RestSDescs]) + end. + + +%%------------------------------------------------------------------------------ +%% Miscellaneous functions +%%------------------------------------------------------------------------------ + +%% @doc A function that opens a file as binary. The function takes as argument +%% the name of the file and returns an Erlang binary. +-spec open_object_file(string()) -> binary(). +open_object_file(ObjFile) -> + case file:read_file(ObjFile) of + {ok, Binary} -> + Binary; + {error, Reason} -> + exit({?MODULE, open_file, Reason}) + end. + +remove_temp_folder(Dir, Options) -> + case proplists:get_bool(llvm_save_temps, Options) of + true -> ok; + false -> spawn(fun () -> "" = os:cmd("rm -rf " ++ Dir) end), ok + end. + +unique_id(FunName, Arity) -> + integer_to_list(erlang:phash2({FunName, Arity, now()})). + +unique_folder(FunName, Arity, Options) -> + DirName = "llvm_" ++ unique_id(FunName, Arity) ++ "/", + Dir = + case proplists:get_bool(llvm_save_temps, Options) of + true -> %% Store folder in current directory + DirName; + false -> %% Temporarily store folder in tempfs (/dev/shm/) + "/dev/shm/" ++ DirName + end, + %% Make sure it does not exist + case dir_exists(Dir) of + true -> %% Dir already exists! Generate again. + unique_folder(FunName, Arity, Options); + false -> + Dir + end. + +%% @doc Function that checks that a given Filename is an existing Directory +%% Name (from http://rosettacode.org/wiki/Ensure_that_a_file_exists#Erlang) +dir_exists(Filename) -> + {Flag, Info} = file:read_file_info(Filename), + (Flag =:= ok) andalso (element(3, Info) =:= directory). + +%% @doc Function that takes as arguments a list of integers and a list with +%% numbers indicating how many items should each tuple have and splits +%% the original list to a list of lists of integers (with the specified +%% number of elements), i.e. [ [...], [...] ]. +-spec split_list([integer()], [integer()]) -> [ [integer()] ]. +split_list(List, ElemsPerTuple) -> + split_list(List, ElemsPerTuple, []). + +-spec split_list([integer()], [integer()], [ [integer()] ]) -> [ [integer()] ]. +split_list([], [], Acc) -> + lists:reverse(Acc); +split_list(List, [NumOfElems | MoreNums], Acc) -> + {L1, L2} = lists:split(NumOfElems, List), + split_list(L2, MoreNums, [ L1 | Acc]). diff --git a/lib/hipe/llvm/hipe_llvm_merge.erl b/lib/hipe/llvm/hipe_llvm_merge.erl new file mode 100644 index 0000000000..3ababfc21a --- /dev/null +++ b/lib/hipe/llvm/hipe_llvm_merge.erl @@ -0,0 +1,114 @@ +%%% -*- erlang-indent-level: 2 -*- +-module(hipe_llvm_merge). + +-export([finalize/3]). + +-include("hipe_llvm_arch.hrl"). +-include("../../kernel/src/hipe_ext_format.hrl"). +-include("../rtl/hipe_literals.hrl"). +-include("../main/hipe.hrl"). + +finalize(CompiledCode, Closures, Exports) -> + CompiledCode1 = [CodePack || {_, CodePack} <- CompiledCode], + Code = [{MFA, [], ConstTab} + || {MFA, _, _ , ConstTab, _, _} <- CompiledCode1], + {ConstAlign, ConstSize, ConstMap, RefsFromConsts} = + hipe_pack_constants:pack_constants(Code, ?ARCH_REGISTERS:alignment()), + %% Compute total code size separately as a sanity check for alignment + CodeSize = compute_code_size(CompiledCode1, 0), + %% io:format("Code Size (pre-computed): ~w~n", [CodeSize]), + {CodeBinary, ExportMap} = merge_mfas(CompiledCode1, 0, <<>>, []), + %% io:format("Code Size (post-computed): ~w~n", [byte_size(CodeBinary)]), + ?VERBOSE_ASSERT(CodeSize =:= byte_size(CodeBinary)), + AccRefs = merge_refs(CompiledCode1, ConstMap, 0, []), + %% Bring CompiledCode to a combine_label_maps-acceptable form. + LabelMap = combine_label_maps(CompiledCode1, 0, gb_trees:empty()), + SC = hipe_pack_constants:slim_constmap(ConstMap), + DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), + SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap, Closures, Exports), + SlimRefs = hipe_pack_constants:slim_refs(AccRefs), + term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, + ConstAlign, ConstSize, + SC, % ConstMap + DataRelocs, % LabelMap + SSE, % ExportMap + CodeSize, CodeBinary, SlimRefs, + 0,[] % ColdCodeSize, SlimColdRefs + ]). + +%% Copied from hipe_x86_assemble.erl +nr_pad_bytes(Address) -> + (4 - (Address rem 4)) rem 4. % XXX: 16 or 32 instead? + +align_entry(Address) -> + Address + nr_pad_bytes(Address). + +compute_code_size([{_MFA, _BinaryCode, CodeSize, _, _, _}|Code], Size) -> + compute_code_size(Code, align_entry(Size+CodeSize)); +compute_code_size([], Size) -> Size. + +combine_label_maps([{MFA, _, CodeSize, _, _, LabelMap}|Code], Address, CLM) -> + NewCLM = merge_label_map(gb_trees:to_list(LabelMap), MFA, Address, CLM), + combine_label_maps(Code, align_entry(Address+CodeSize), NewCLM); +combine_label_maps([], _Address, CLM) -> CLM. + +merge_label_map([{Label,Offset}|Rest], MFA, Address, CLM) -> + NewCLM = gb_trees:insert({MFA,Label}, Address+Offset, CLM), + merge_label_map(Rest, MFA, Address, NewCLM); +merge_label_map([], _MFA, _Address, CLM) -> CLM. + +%% @doc Merge the MFAs' binary code to one continuous binary and compute the +%% size of this binary. At the same time create an exportmap in a form +%% of {Address, M, F, A}. +%% XXX: Is alignment correct/optimal for X86/AMD64? +merge_mfas([{{M,F,A}, CodeBinary, CodeSize, _, _, _}|Code], + Address, AccCode, AccExportMap) -> + ?VERBOSE_ASSERT(CodeSize =:= byte_size(CodeBinary)), + {Address1, Code1} = + case nr_pad_bytes(Address + CodeSize) of + 0 -> %% Retains alignment: + {Address + CodeSize, CodeBinary}; + NrPadBytes -> %% Needs padding! + Padding = list_to_binary(lists:duplicate(NrPadBytes, 0)), + {Address + CodeSize + NrPadBytes, % =:= align_entry(Address+CodeSize) + <<CodeBinary/binary, Padding/binary>>} + end, + ?VERBOSE_ASSERT(Address1 =:= + align_entry(Address + CodeSize)), %XXX: Should address be aligned? + AccCode1 = <<AccCode/binary, Code1/binary>>, + merge_mfas(Code, Address1, AccCode1, [{Address, M, F, A}|AccExportMap]); +merge_mfas([], _Address, AccCode, AccExportMap) -> + {AccCode, AccExportMap}. + +%% @doc Merge the references of relocatable symbols in the binary code. The +%% offsets must be updated because of the merging of the code binaries! +merge_refs([], _ConstMap, _Addr, AccRefs) -> AccRefs; +merge_refs([{MFA, _, CodeSize, _, Refs, _}|Rest], ConstMap, Address, AccRefs) -> + %% Important!: The hipe_pack_constants:pack_constants/2 function assignes + %% unique numbers to constants (ConstNo). This numbers are used from now on, + %% instead of labels that were used before. So, in order to be compatible, we + %% must change all the constant labels in the Refs to the corresponding + %% ConstNo, that can be found in the ConstMap (#pcm_entry{}). + UpdatedRefs = [update_ref(label_to_constno(Ref, MFA, ConstMap), Address) + || Ref <- Refs], + merge_refs(Rest, ConstMap, align_entry(Address+CodeSize), + UpdatedRefs++AccRefs). + +label_to_constno({Type, Offset, {constant, Label}}, MFA, ConstMap) -> + ConstNo = hipe_pack_constants:find_const({MFA, Label}, ConstMap), + {Type, Offset, {constant, ConstNo}}; +label_to_constno(Other, _MFA, _ConstMap) -> + Other. + +%% @doc Update offset to a reference. In case of stack descriptors we must check +%% if there exists an exception handler, because it must also be updated. +update_ref({?SDESC, Offset, SDesc}, CodeAddr) -> + NewRefAddr = Offset+CodeAddr, + case SDesc of + {[], _, _, _} -> % No handler; only update offset + {?SDESC, NewRefAddr, SDesc}; + {ExnHandler, FrameSize, StackArity, Roots} -> % Update exception handler + {?SDESC, NewRefAddr, {ExnHandler+CodeAddr, FrameSize, StackArity, Roots}} + end; +update_ref({Type, Offset, Term}, CodeAddr) -> + {Type, Offset+CodeAddr, Term}. diff --git a/lib/hipe/llvm/hipe_rtl_to_llvm.erl b/lib/hipe/llvm/hipe_rtl_to_llvm.erl new file mode 100644 index 0000000000..ba76e1d815 --- /dev/null +++ b/lib/hipe/llvm/hipe_rtl_to_llvm.erl @@ -0,0 +1,1612 @@ +%% -*- erlang-indent-level: 2 -*- + +-module(hipe_rtl_to_llvm). +-author("Chris Stavrakakis, Yiannis Tsiouris"). + +-export([translate/2]). % the main function of this module +-export([fix_mfa_name/1]). % a help function used in hipe_llvm_main + +-include("../rtl/hipe_rtl.hrl"). +-include("../rtl/hipe_literals.hrl"). +-include("hipe_llvm_arch.hrl"). + +-define(WORD_WIDTH, (?bytes_to_bits(hipe_rtl_arch:word_size()))). +-define(BRANCH_META_TAKEN, "0"). +-define(BRANCH_META_NOT_TAKEN, "1"). + +%%------------------------------------------------------------------------------ +%% @doc Main function for translating an RTL function to LLVM Assembly. Takes as +%% input the RTL code and the variable indexes of possible garbage +%% collection roots and returns the corresponing LLVM, a dictionary with +%% all the relocations in the code and a hipe_consttab() with informaton +%% about data. +%%------------------------------------------------------------------------------ +translate(RTL, Roots) -> + Fun = hipe_rtl:rtl_fun(RTL), + Params = hipe_rtl:rtl_params(RTL), + Data = hipe_rtl:rtl_data(RTL), + Code = hipe_rtl:rtl_code(RTL), + %% Init unique symbol generator and initialize the label counter to the last + %% RTL label. + hipe_gensym:init(llvm), + {_, MaxLabel} = hipe_rtl:rtl_label_range(RTL), + put({llvm,label_count}, MaxLabel + 1), + %% Put first label of RTL code in process dictionary + find_code_entry_label(Code), + %% Initialize relocations symbol dictionary + Relocs = dict:new(), + %% Print RTL to file + %% {ok, File_rtl} = file:open("rtl_" ++integer_to_list(random:uniform(2000)) + %% ++ ".rtl", [write]), + %% hipe_rtl:pp(File_rtl, RTL), + %% file:close(File_rtl), + + %% Pass on RTL code to handle exception handling and identify labels of Fail + %% Blocks + {Code1, FailLabels} = fix_code(Code), + %% Allocate stack slots for each virtual register and declare gc roots + AllocaStackCode = alloca_stack(Code1, Params, Roots), + %% Translate Code + {LLVM_Code1, Relocs1, NewData} = + translate_instr_list(Code1, [], Relocs, Data), + %% Create LLVM code to declare relocation symbols as external symbols along + %% with local variables in order to use them as just any other variable + {FinalRelocs, ExternalDecl, LocalVars} = + handle_relocations(Relocs1, Data, Fun), + %% Pass on LLVM code in order to create Fail blocks and a landingpad + %% instruction to each one + LLVM_Code2 = add_landingpads(LLVM_Code1, FailLabels), + %% Create LLVM Code for the compiled function + LLVM_Code3 = create_function_definition(Fun, Params, LLVM_Code2, + AllocaStackCode ++ LocalVars), + %% Final Code = CompiledFunction + External Declarations + FinalLLVMCode = [LLVM_Code3 | ExternalDecl], + {FinalLLVMCode, FinalRelocs, NewData}. + +find_code_entry_label([]) -> + exit({?MODULE, find_code_entry_label, "Empty code"}); +find_code_entry_label([I|_]) -> + case hipe_rtl:is_label(I) of + true -> + put(first_label, hipe_rtl:label_name(I)); + false -> + exit({?MODULE, find_code_entry_label, "First instruction is not a label"}) + end. + +%% @doc Create a stack slot for each virtual register. The stack slots +%% that correspond to possible garbage collection roots must be +%% marked as such. +alloca_stack(Code, Params, Roots) -> + %% Find all assigned virtual registers + Destinations = collect_destinations(Code), + %% Declare virtual registers, and declare garbage collection roots + do_alloca_stack(Destinations++Params, Params, Roots). + +collect_destinations(Code) -> + lists:usort(lists:flatmap(fun insn_dst/1, Code)). + +do_alloca_stack(Destinations, Params, Roots) -> + do_alloca_stack(Destinations, Params, Roots, []). + +do_alloca_stack([], _, _, Acc) -> + Acc; +do_alloca_stack([D|Ds], Params, Roots, Acc) -> + {Name, _I} = trans_dst(D), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + case hipe_rtl:is_var(D) of + true -> + Num = hipe_rtl:var_index(D), + I1 = hipe_llvm:mk_alloca(Name, WordTy, [], []), + case lists:member(Num, Roots) of + true -> %% Variable is a possible Root + T1 = mk_temp(), + BYTE_TYPE_PP = hipe_llvm:mk_pointer(ByteTyPtr), + I2 = + hipe_llvm:mk_conversion(T1, bitcast, WordTyPtr, Name, BYTE_TYPE_PP), + GcRootArgs = [{BYTE_TYPE_PP, T1}, {ByteTyPtr, "@gc_metadata"}], + I3 = hipe_llvm:mk_call([], false, [], [], hipe_llvm:mk_void(), + "@llvm.gcroot", GcRootArgs, []), + I4 = case lists:member(D, Params) of + false -> + hipe_llvm:mk_store(WordTy, "-5", WordTyPtr, Name, + [], [], false); + true -> [] + end, + do_alloca_stack(Ds, Params, Roots, [I1, I2, I3, I4 | Acc]); + false -> + do_alloca_stack(Ds, Params, Roots, [I1|Acc]) + end; + false -> + case hipe_rtl:is_reg(D) andalso isPrecoloured(D) of + true -> %% Precoloured registers are mapped to "special" stack slots + do_alloca_stack(Ds, Params, Roots, Acc); + false -> + I1 = case hipe_rtl:is_fpreg(D) of + true -> + FloatTy = hipe_llvm:mk_double(), + hipe_llvm:mk_alloca(Name, FloatTy, [], []); + false -> hipe_llvm:mk_alloca(Name, WordTy, [], []) + end, + do_alloca_stack(Ds, Params, Roots, [I1|Acc]) + end + end. + +%%------------------------------------------------------------------------------ +%% @doc Translation of the linearized RTL Code. Each RTL instruction is +%% translated to a list of LLVM Assembly instructions. The relocation +%% dictionary is updated when needed. +%%------------------------------------------------------------------------------ +translate_instr_list([], Acc, Relocs, Data) -> + {lists:reverse(lists:flatten(Acc)), Relocs, Data}; +translate_instr_list([I | Is], Acc, Relocs, Data) -> + {Acc1, NewRelocs, NewData} = translate_instr(I, Relocs, Data), + translate_instr_list(Is, [Acc1 | Acc], NewRelocs, NewData). + +translate_instr(I, Relocs, Data) -> + case I of + #alu{} -> + {I2, Relocs2} = trans_alu(I, Relocs), + {I2, Relocs2, Data}; + #alub{} -> + {I2, Relocs2} = trans_alub(I, Relocs), + {I2, Relocs2, Data}; + #branch{} -> + {I2, Relocs2} = trans_branch(I, Relocs), + {I2, Relocs2, Data}; + #call{} -> + {I2, Relocs2} = + case hipe_rtl:call_fun(I) of + %% In AMD64 this instruction does nothing! + %% TODO: chech use of fwait in other architectures! + fwait -> + {[], Relocs}; + _ -> + trans_call(I, Relocs) + end, + {I2, Relocs2, Data}; + #comment{} -> + {I2, Relocs2} = trans_comment(I, Relocs), + {I2, Relocs2, Data}; + #enter{} -> + {I2, Relocs2} = trans_enter(I, Relocs), + {I2, Relocs2, Data}; + #fconv{} -> + {I2, Relocs2} = trans_fconv(I, Relocs), + {I2, Relocs2, Data}; + #fload{} -> + {I2, Relocs2} = trans_fload(I, Relocs), + {I2, Relocs2, Data}; + #fmove{} -> + {I2, Relocs2} = trans_fmove(I, Relocs), + {I2, Relocs2, Data}; + #fp{} -> + {I2, Relocs2} = trans_fp(I, Relocs), + {I2, Relocs2, Data}; + #fp_unop{} -> + {I2, Relocs2} = trans_fp_unop(I, Relocs), + {I2, Relocs2, Data}; + #fstore{} -> + {I2, Relocs2} = trans_fstore(I, Relocs), + {I2, Relocs2, Data}; + #goto{} -> + {I2, Relocs2} = trans_goto(I, Relocs), + {I2, Relocs2, Data}; + #label{} -> + {I2, Relocs2} = trans_label(I, Relocs), + {I2, Relocs2, Data}; + #load{} -> + {I2, Relocs2} = trans_load(I, Relocs), + {I2, Relocs2, Data}; + #load_address{} -> + {I2, Relocs2} = trans_load_address(I, Relocs), + {I2, Relocs2, Data}; + #load_atom{} -> + {I2, Relocs2} = trans_load_atom(I, Relocs), + {I2, Relocs2, Data}; + #move{} -> + {I2, Relocs2} = trans_move(I, Relocs), + {I2, Relocs2, Data}; + #return{} -> + {I2, Relocs2} = trans_return(I, Relocs), + {I2, Relocs2, Data}; + #store{} -> + {I2, Relocs2} = trans_store(I, Relocs), + {I2, Relocs2, Data}; + #switch{} -> %% Only switch instruction updates Data + {I2, Relocs2, NewData} = trans_switch(I, Relocs, Data), + {I2, Relocs2, NewData}; + Other -> + exit({?MODULE, translate_instr, {"Unknown RTL instruction", Other}}) + end. + +%% +%% alu +%% +trans_alu(I, Relocs) -> + RtlDst = hipe_rtl:alu_dst(I), + TmpDst = mk_temp(), + {Src1, I1} = trans_src(hipe_rtl:alu_src1(I)), + {Src2, I2} = trans_src(hipe_rtl:alu_src2(I)), + Op = trans_op(hipe_rtl:alu_op(I)), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I3 = hipe_llvm:mk_operation(TmpDst, Op, WordTy, Src1, Src2, []), + I4 = store_stack_dst(TmpDst, RtlDst), + {[I4, I3, I2, I1], Relocs}. + +%% +%% alub +%% +trans_alub(I, Relocs) -> + case hipe_rtl:alub_cond(I) of + Op when Op =:= overflow orelse Op =:= not_overflow -> + trans_alub_overflow(I, signed, Relocs); + ltu -> %% ltu means unsigned overflow + trans_alub_overflow(I, unsigned, Relocs); + _ -> + trans_alub_no_overflow(I, Relocs) + end. + +trans_alub_overflow(I, Sign, Relocs) -> + {Src1, I1} = trans_src(hipe_rtl:alub_src1(I)), + {Src2, I2} = trans_src(hipe_rtl:alub_src2(I)), + RtlDst = hipe_rtl:alub_dst(I), + TmpDst = mk_temp(), + Name = trans_alub_op(I, Sign), + NewRelocs = relocs_store(Name, {call, {llvm, Name, 2}}, Relocs), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + ReturnType = hipe_llvm:mk_struct([WordTy, hipe_llvm:mk_int(1)]), + T1 = mk_temp(), + I3 = hipe_llvm:mk_call(T1, false, [], [], ReturnType, "@" ++ Name, + [{WordTy, Src1}, {WordTy, Src2}], []), + %% T1{0}: result of the operation + I4 = hipe_llvm:mk_extractvalue(TmpDst, ReturnType, T1 , "0", []), + I5 = store_stack_dst(TmpDst, RtlDst), + T2 = mk_temp(), + %% T1{1}: Boolean variable indicating overflow + I6 = hipe_llvm:mk_extractvalue(T2, ReturnType, T1, "1", []), + case hipe_rtl:alub_cond(I) of + Op when Op =:= overflow orelse Op =:= ltu -> + True_label = mk_jump_label(hipe_rtl:alub_true_label(I)), + False_label = mk_jump_label(hipe_rtl:alub_false_label(I)), + MetaData = branch_metadata(hipe_rtl:alub_pred(I)); + not_overflow -> + True_label = mk_jump_label(hipe_rtl:alub_false_label(I)), + False_label = mk_jump_label(hipe_rtl:alub_true_label(I)), + MetaData = branch_metadata(1 - hipe_rtl:alub_pred(I)) + end, + I7 = hipe_llvm:mk_br_cond(T2, True_label, False_label, MetaData), + {[I7, I6, I5, I4, I3, I2, I1], NewRelocs}. + +trans_alub_op(I, Sign) -> + Name = + case Sign of + signed -> + case hipe_rtl:alub_op(I) of + add -> "llvm.sadd.with.overflow."; + mul -> "llvm.smul.with.overflow."; + sub -> "llvm.ssub.with.overflow."; + Op -> exit({?MODULE, trans_alub_op, {"Unknown alub operator", Op}}) + end; + unsigned -> + case hipe_rtl:alub_op(I) of + add -> "llvm.uadd.with.overflow."; + mul -> "llvm.umul.with.overflow."; + sub -> "llvm.usub.with.overflow."; + Op -> exit({?MODULE, trans_alub_op, {"Unknown alub operator", Op}}) + end + end, + Type = + case hipe_rtl_arch:word_size() of + 4 -> "i32"; + 8 -> "i64" + %% Other -> exit({?MODULE, trans_alub_op, {"Unknown type", Other}}) + end, + Name ++ Type. + +trans_alub_no_overflow(I, Relocs) -> + %% alu + T = hipe_rtl:mk_alu(hipe_rtl:alub_dst(I), hipe_rtl:alub_src1(I), + hipe_rtl:alub_op(I), hipe_rtl:alub_src2(I)), + %% A trans_alu instruction cannot change relocations + {I1, _} = trans_alu(T, Relocs), + %% icmp + %% Translate destination as src, to match with the semantics of instruction + {Dst, I2} = trans_src(hipe_rtl:alub_dst(I)), + Cond = trans_rel_op(hipe_rtl:alub_cond(I)), + T3 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I5 = hipe_llvm:mk_icmp(T3, Cond, WordTy, Dst, "0"), + %% br + Metadata = branch_metadata(hipe_rtl:alub_pred(I)), + True_label = mk_jump_label(hipe_rtl:alub_true_label(I)), + False_label = mk_jump_label(hipe_rtl:alub_false_label(I)), + I6 = hipe_llvm:mk_br_cond(T3, True_label, False_label, Metadata), + {[I6, I5, I2, I1], Relocs}. + +%% +%% branch +%% +trans_branch(I, Relocs) -> + {Src1, I1} = trans_src(hipe_rtl:branch_src1(I)), + {Src2, I2} = trans_src(hipe_rtl:branch_src2(I)), + Cond = trans_rel_op(hipe_rtl:branch_cond(I)), + %% icmp + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I3 = hipe_llvm:mk_icmp(T1, Cond, WordTy, Src1, Src2), + %% br + True_label = mk_jump_label(hipe_rtl:branch_true_label(I)), + False_label = mk_jump_label(hipe_rtl:branch_false_label(I)), + Metadata = branch_metadata(hipe_rtl:branch_pred(I)), + I4 = hipe_llvm:mk_br_cond(T1, True_label, False_label, Metadata), + {[I4, I3, I2, I1], Relocs}. + +branch_metadata(X) when X =:= 0.5 -> []; +branch_metadata(X) when X > 0.5 -> ?BRANCH_META_TAKEN; +branch_metadata(X) when X < 0.5 -> ?BRANCH_META_NOT_TAKEN. + +%% +%% call +%% +trans_call(I, Relocs) -> + RtlCallArgList= hipe_rtl:call_arglist(I), + RtlCallName = hipe_rtl:call_fun(I), + {I0, Relocs1} = expose_closure(RtlCallName, RtlCallArgList, Relocs), + TmpDst = mk_temp(), + {CallArgs, I1} = trans_call_args(RtlCallArgList), + FixedRegs = fixed_registers(), + {LoadedFixedRegs, I2} = load_fixed_regs(FixedRegs), + FinalArgs = fix_reg_args(LoadedFixedRegs) ++ CallArgs, + {Name, I3, Relocs2} = + trans_call_name(RtlCallName, Relocs1, CallArgs, FinalArgs), + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + I4 = + case hipe_rtl:call_fail(I) of + %% Normal Call + [] -> + hipe_llvm:mk_call(T1, false, "cc 11", [], FunRetTy, Name, FinalArgs, + []); + %% Call With Exception + FailLabelNum -> + TrueLabel = "L" ++ integer_to_list(hipe_rtl:call_normal(I)), + FailLabel = "%FL" ++ integer_to_list(FailLabelNum), + II1 = + hipe_llvm:mk_invoke(T1, "cc 11", [], FunRetTy, Name, FinalArgs, [], + "%" ++ TrueLabel, FailLabel), + II2 = hipe_llvm:mk_label(TrueLabel), + [II2, II1] + end, + I5 = store_fixed_regs(FixedRegs, T1), + I6 = + case hipe_rtl:call_dstlist(I) of + [] -> []; %% No return value + [Destination] -> + II3 = + hipe_llvm:mk_extractvalue(TmpDst, FunRetTy, T1, + integer_to_list(?NR_PINNED_REGS), []), + II4 = store_stack_dst(TmpDst, Destination), + [II4, II3] + end, + I7 = + case hipe_rtl:call_continuation(I) of + [] -> []; %% No continuation + CC -> + {II5, _} = trans_goto(hipe_rtl:mk_goto(CC), Relocs2), + II5 + end, + {[I7, I6, I5, I4, I3, I2, I1, I0], Relocs2}. + +%% In case of call to a register (closure call) with more than ?NR_ARG_REGS +%% arguments we must track the offset this call in the code, in order to +%% to correct the stack descriptor. So, we insert a new Label and add this label +%% to the "table_closures" +%% --------------------------------|-------------------------------------------- +%% Old Code | New Code +%% --------------------------------|-------------------------------------------- +%% | br %ClosureLabel +%% call %reg(Args) | ClosureLabel: +%% | call %reg(Args) +expose_closure(CallName, CallArgs, Relocs) -> + CallArgsNr = length(CallArgs), + case hipe_rtl:is_reg(CallName) andalso CallArgsNr > ?NR_ARG_REGS of + true -> + LabelNum = hipe_gensym:new_label(llvm), + ClosureLabel = hipe_llvm:mk_label(mk_label(LabelNum)), + JumpIns = hipe_llvm:mk_br(mk_jump_label(LabelNum)), + Relocs1 = + relocs_store({CallName, LabelNum}, + {closure_label, LabelNum, CallArgsNr - ?NR_ARG_REGS}, + Relocs), + {[ClosureLabel, JumpIns], Relocs1}; + false -> + {[], Relocs} + end. + +trans_call_name(RtlCallName, Relocs, CallArgs, FinalArgs) -> + case RtlCallName of + PrimOp when is_atom(PrimOp) -> + LlvmName = trans_prim_op(PrimOp), + Relocs1 = relocs_store(LlvmName, {call, {bif, PrimOp, length(CallArgs)}}, + Relocs), + {"@" ++ LlvmName, [], Relocs1}; + {M, F, A} when is_atom(M), is_atom(F), is_integer(A) -> + LlvmName = trans_mfa_name({M,F,A}), + Relocs1 = relocs_store(LlvmName, {call, {M,F,A}}, Relocs), + {"@" ++ LlvmName, [], Relocs1}; + Reg -> + case hipe_rtl:is_reg(Reg) of + true -> + %% In case of a closure call, the register holding the address + %% of the closure must be converted to function type in + %% order to make the call + TT1 = mk_temp(), + {RegName, II1} = trans_src(Reg), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + II2 = + hipe_llvm:mk_conversion(TT1, inttoptr, WordTy, RegName, WordTyPtr), + TT2 = mk_temp(), + ArgsTypeList = lists:duplicate(length(FinalArgs), WordTy), + FunRetTy = + hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + FunType = hipe_llvm:mk_fun(FunRetTy, ArgsTypeList), + FunTypeP = hipe_llvm:mk_pointer(FunType), + II3 = hipe_llvm:mk_conversion(TT2, bitcast, WordTyPtr, TT1, FunTypeP), + {TT2, [II3, II2, II1], Relocs}; + false -> + exit({?MODULE, trans_call, {"Unimplemented call to", RtlCallName}}) + end + end. + +%% +trans_call_args(ArgList) -> + {Args, I} = lists:unzip(trans_args(ArgList)), + %% Reverse arguments that are passed to stack to match with the Erlang + %% calling convention. (Propably not needed in prim calls.) + ReversedArgs = + case erlang:length(Args) > ?NR_ARG_REGS of + false -> + Args; + true -> + {ArgsInRegs, ArgsInStack} = lists:split(?NR_ARG_REGS, Args), + ArgsInRegs ++ lists:reverse(ArgsInStack) + end, + %% Reverse I, because some of the arguments may go out of scope and + %% should be killed(store -5). When two or more arguments are they + %% same, then order matters! + {ReversedArgs, lists:reverse(I)}. + +%% +%% trans_comment +%% +trans_comment(I, Relocs) -> + I1 = hipe_llvm:mk_comment(hipe_rtl:comment_text(I)), + {I1, Relocs}. + +%% +%% enter +%% +trans_enter(I, Relocs) -> + {CallArgs, I0} = trans_call_args(hipe_rtl:enter_arglist(I)), + FixedRegs = fixed_registers(), + {LoadedFixedRegs, I1} = load_fixed_regs(FixedRegs), + FinalArgs = fix_reg_args(LoadedFixedRegs) ++ CallArgs, + {Name, I2, NewRelocs} = + trans_call_name(hipe_rtl:enter_fun(I), Relocs, CallArgs, FinalArgs), + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + I3 = hipe_llvm:mk_call(T1, true, "cc 11", [], FunRetTy, Name, FinalArgs, []), + I4 = hipe_llvm:mk_ret([{FunRetTy, T1}]), + {[I4, I3, I2, I1, I0], NewRelocs}. + +%% +%% fconv +%% +trans_fconv(I, Relocs) -> + %% XXX: Can a fconv destination be a precoloured reg? + RtlDst = hipe_rtl:fconv_dst(I), + TmpDst = mk_temp(), + {Src, I1} = trans_float_src(hipe_rtl:fconv_src(I)), + FloatTy = hipe_llvm:mk_double(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I2 = hipe_llvm:mk_conversion(TmpDst, sitofp, WordTy, Src, FloatTy), + I3 = store_float_stack(TmpDst, RtlDst), + {[I3, I2, I1], Relocs}. + + +%% TODO: fload, fstore, fmove, and fp are almost the same with load, store, move +%% and alu. Maybe we should join them. + +%% +%% fload +%% +trans_fload(I, Relocs) -> + RtlDst = hipe_rtl:fload_dst(I), + RtlSrc = hipe_rtl:fload_src(I), + _Offset = hipe_rtl:fload_offset(I), + TmpDst = mk_temp(), + {Src, I1} = trans_float_src(RtlSrc), + {Offset, I2} = trans_float_src(_Offset), + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FloatTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_double()), + I3 = hipe_llvm:mk_operation(T1, add, WordTy, Src, Offset, []), + T2 = mk_temp(), + I4 = hipe_llvm:mk_conversion(T2, inttoptr, WordTy, T1, FloatTyPtr), + I5 = hipe_llvm:mk_load(TmpDst, FloatTyPtr, T2, [], [], false), + I6 = store_float_stack(TmpDst, RtlDst), + {[I6, I5, I4, I3, I2, I1], Relocs}. + +%% +%% fmove +%% +trans_fmove(I, Relocs) -> + RtlDst = hipe_rtl:fmove_dst(I), + RtlSrc = hipe_rtl:fmove_src(I), + {Src, I1} = trans_float_src(RtlSrc), + I2 = store_float_stack(Src, RtlDst), + {[I2, I1], Relocs}. + +%% +%% fp +%% +trans_fp(I, Relocs) -> + %% XXX: Just copied trans_alu...think again.. + RtlDst = hipe_rtl:fp_dst(I), + RtlSrc1 = hipe_rtl:fp_src1(I), + RtlSrc2 = hipe_rtl:fp_src2(I), + %% Destination cannot be a precoloured register + FloatTy = hipe_llvm:mk_double(), + FloatTyPtr = hipe_llvm:mk_pointer(FloatTy), + TmpDst = mk_temp(), + {Src1, I1} = trans_float_src(RtlSrc1), + {Src2, I2} = trans_float_src(RtlSrc2), + Op = trans_fp_op(hipe_rtl:fp_op(I)), + I3 = hipe_llvm:mk_operation(TmpDst, Op, FloatTy, Src1, Src2, []), + I4 = store_float_stack(TmpDst, RtlDst), + %% Synchronization for floating point exceptions + I5 = hipe_llvm:mk_store(FloatTy, TmpDst, FloatTyPtr, "%exception_sync", [], + [], true), + T1 = mk_temp(), + I6 = hipe_llvm:mk_load(T1, FloatTyPtr, "%exception_sync", [], [], true), + {[I6, I5, I4, I3, I2, I1], Relocs}. + +%% +%% fp_unop +%% +trans_fp_unop(I, Relocs) -> + RtlDst = hipe_rtl:fp_unop_dst(I), + RtlSrc = hipe_rtl:fp_unop_src(I), + %% Destination cannot be a precoloured register + TmpDst = mk_temp(), + {Src, I1} = trans_float_src(RtlSrc), + Op = trans_fp_op(hipe_rtl:fp_unop_op(I)), + FloatTy = hipe_llvm:mk_double(), + I2 = hipe_llvm:mk_operation(TmpDst, Op, FloatTy, "0.0", Src, []), + I3 = store_float_stack(TmpDst, RtlDst), + {[I3, I2, I1], Relocs}. +%% TODO: Fix fp_unop in a way like the following. You must change trans_dest, +%% in order to call float_to_list in a case of float constant. Maybe the type +%% check is expensive... +%% Dst = hipe_rtl:fp_unop_dst(I), +%% Src = hipe_rtl:fp_unop_src(I), +%% Op = hipe_rtl:fp_unop_op(I), +%% Zero = hipe_rtl:mk_imm(0.0), +%% I1 = hipe_rtl:mk_fp(Dst, Zero, Op, Src), +%% trans_fp(I, Relocs1). + +%% +%% fstore +%% +trans_fstore(I, Relocs) -> + Base = hipe_rtl:fstore_base(I), + case isPrecoloured(Base) of + true -> + trans_fstore_reg(I, Relocs); + false -> + exit({?MODULE, trans_fstore ,{"Not implemented yet", false}}) + end. + +trans_fstore_reg(I, Relocs) -> + {Base, I0} = trans_reg(hipe_rtl:fstore_base(I), dst), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + FloatTy = hipe_llvm:mk_double(), + FloatTyPtr = hipe_llvm:mk_pointer(FloatTy), + T1 = mk_temp(), + I1 = hipe_llvm:mk_load(T1, WordTyPtr, Base, [], [], false), + {Offset, I2} = trans_src(hipe_rtl:fstore_offset(I)), + T2 = mk_temp(), + I3 = hipe_llvm:mk_operation(T2, add, WordTy, T1, Offset, []), + T3 = mk_temp(), + I4 = hipe_llvm:mk_conversion(T3, inttoptr, WordTy, T2, FloatTyPtr), + {Value, I5} = trans_src(hipe_rtl:fstore_src(I)), + I6 = hipe_llvm:mk_store(FloatTy, Value, FloatTyPtr, T3, [], [], false), + {[I6, I5, I4, I3, I2, I1, I0], Relocs}. + +%% +%% goto +%% +trans_goto(I, Relocs) -> + I1 = hipe_llvm:mk_br(mk_jump_label(hipe_rtl:goto_label(I))), + {I1, Relocs}. + +%% +%% label +%% +trans_label(I, Relocs) -> + Label = mk_label(hipe_rtl:label_name(I)), + I1 = hipe_llvm:mk_label(Label), + {I1, Relocs}. + +%% +%% load +%% +trans_load(I, Relocs) -> + RtlDst = hipe_rtl:load_dst(I), + TmpDst = mk_temp(), + %% XXX: Why translate them independently? ------------------------ + {Src, I1} = trans_src(hipe_rtl:load_src(I)), + {Offset, I2} = trans_src(hipe_rtl:load_offset(I)), + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + I3 = hipe_llvm:mk_operation(T1, add, WordTy, Src, Offset, []), + %%---------------------------------------------------------------- + I4 = case hipe_rtl:load_size(I) of + word -> + T2 = mk_temp(), + II1 = hipe_llvm:mk_conversion(T2, inttoptr, WordTy, T1, WordTyPtr), + II2 = hipe_llvm:mk_load(TmpDst, WordTyPtr, T2, [], [], false), + [II2, II1]; + Size -> + LoadType = llvm_type_from_size(Size), + LoadTypeP = hipe_llvm:mk_pointer(LoadType), + T2 = mk_temp(), + II1 = hipe_llvm:mk_conversion(T2, inttoptr, WordTy, T1, LoadTypeP), + T3 = mk_temp(), + LoadTypePointer = hipe_llvm:mk_pointer(LoadType), + II2 = hipe_llvm:mk_load(T3, LoadTypePointer, T2, [], [], false), + Conversion = + case hipe_rtl:load_sign(I) of + signed -> sext; + unsigned -> zext + end, + II3 = + hipe_llvm:mk_conversion(TmpDst, Conversion, LoadType, T3, WordTy), + [II3, II2, II1] + end, + I5 = store_stack_dst(TmpDst, RtlDst), + {[I5, I4, I3, I2, I1], Relocs}. + +%% +%% load_address +%% +trans_load_address(I, Relocs) -> + RtlDst = hipe_rtl:load_address_dst(I), + RtlAddr = hipe_rtl:load_address_addr(I), + {Addr, NewRelocs} = + case hipe_rtl:load_address_type(I) of + constant -> + {"%DL" ++ integer_to_list(RtlAddr) ++ "_var", Relocs}; + closure -> + {{_, ClosureName, _}, _, _} = RtlAddr, + FixedClosureName = fix_closure_name(ClosureName), + Relocs1 = relocs_store(FixedClosureName, {closure, RtlAddr}, Relocs), + {"%" ++ FixedClosureName ++ "_var", Relocs1}; + type -> + exit({?MODULE, trans_load_address, + {"Type not implemented in load_address", RtlAddr}}) + end, + I1 = store_stack_dst(Addr, RtlDst), + {[I1], NewRelocs}. + +%% +%% load_atom +%% +trans_load_atom(I, Relocs) -> + RtlDst = hipe_rtl:load_atom_dst(I), + RtlAtom = hipe_rtl:load_atom_atom(I), + AtomName = "atom_" ++ make_llvm_id(atom_to_list(RtlAtom)), + AtomVar = "%" ++ AtomName ++ "_var", + NewRelocs = relocs_store(AtomName, {atom, RtlAtom}, Relocs), + I1 = store_stack_dst(AtomVar, RtlDst), + {[I1], NewRelocs}. + +%% +%% move +%% +trans_move(I, Relocs) -> + RtlDst = hipe_rtl:move_dst(I), + RtlSrc = hipe_rtl:move_src(I), + {Src, I1} = trans_src(RtlSrc), + I2 = store_stack_dst(Src, RtlDst), + {[I2, I1], Relocs}. + +%% +%% return +%% +trans_return(I, Relocs) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + {VarRet, I1} = + case hipe_rtl:return_varlist(I) of + [] -> + {[], []}; + [A] -> + {Name, II1} = trans_src(A), + {[{WordTy, Name}], II1} + end, + FixedRegs = fixed_registers(), + {LoadedFixedRegs, I2} = load_fixed_regs(FixedRegs), + FixedRet = [{WordTy, X} || X <- LoadedFixedRegs], + Ret = FixedRet ++ VarRet, + {RetTypes, _RetNames} = lists:unzip(Ret), + Type = hipe_llvm:mk_struct(RetTypes), + {RetStruct, I3} = mk_return_struct(Ret, Type), + I4 = hipe_llvm:mk_ret([{Type, RetStruct}]), + {[I4, I3, I2, I1], Relocs}. + +%% @doc Create a structure to hold the return value and the precoloured +%% registers. +mk_return_struct(RetValues, Type) -> + mk_return_struct(RetValues, Type, [], "undef", 0). + +mk_return_struct([], _, Acc, StructName, _) -> + {StructName, Acc}; +mk_return_struct([{ElemType, ElemName}|Rest], Type, Acc, StructName, Index) -> + T1 = mk_temp(), + I1 = hipe_llvm:mk_insertvalue(T1, Type, StructName, ElemType, ElemName, + integer_to_list(Index), []), + mk_return_struct(Rest, Type, [I1 | Acc], T1, Index+1). + +%% +%% store +%% +trans_store(I, Relocs) -> + {Base, I1} = trans_src(hipe_rtl:store_base(I)), + {Offset, I2} = trans_src(hipe_rtl:store_offset(I)), + {Value, I3} = trans_src(hipe_rtl:store_src(I)), + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + I4 = hipe_llvm:mk_operation(T1, add, WordTy, Base, Offset, []), + I5 = + case hipe_rtl:store_size(I) of + word -> + T2 = mk_temp(), + II1 = hipe_llvm:mk_conversion(T2, inttoptr, WordTy, T1, WordTyPtr), + II2 = hipe_llvm:mk_store(WordTy, Value, WordTyPtr, T2, [], [], + false), + [II2, II1]; + Size -> + %% XXX: Is always trunc correct ? + LoadType = llvm_type_from_size(Size), + LoadTypePointer = hipe_llvm:mk_pointer(LoadType), + T2 = mk_temp(), + II1 = hipe_llvm:mk_conversion(T2, inttoptr, WordTy, T1, LoadTypePointer), + T3 = mk_temp(), + II2 = hipe_llvm:mk_conversion(T3, 'trunc', WordTy, Value, LoadType), + II3 = hipe_llvm:mk_store(LoadType, T3, LoadTypePointer, T2, [], [], false), + [II3, II2, II1] + end, + {[I5, I4, I3, I2, I1], Relocs}. + +%% +%% switch +%% +trans_switch(I, Relocs, Data) -> + RtlSrc = hipe_rtl:switch_src(I), + {Src, I1} = trans_src(RtlSrc), + Labels = hipe_rtl:switch_labels(I), + JumpLabels = [mk_jump_label(L) || L <- Labels], + SortOrder = hipe_rtl:switch_sort_order(I), + NrLabels = length(Labels), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + TableType = hipe_llvm:mk_array(NrLabels, ByteTyPtr), + TableTypeP = hipe_llvm:mk_pointer(TableType), + TypedJumpLabels = [{hipe_llvm:mk_label_type(), X} || X <- JumpLabels], + T1 = mk_temp(), + {Src2, []} = trans_dst(RtlSrc), + TableName = "table_" ++ tl(Src2), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I2 = hipe_llvm:mk_getelementptr(T1, TableTypeP, "@"++TableName, + [{WordTy, "0"}, {WordTy, Src}], false), + T2 = mk_temp(), + BYTE_TYPE_PP = hipe_llvm:mk_pointer(ByteTyPtr), + I3 = hipe_llvm:mk_load(T2, BYTE_TYPE_PP, T1, [], [], false), + I4 = hipe_llvm:mk_indirectbr(ByteTyPtr, T2, TypedJumpLabels), + LMap = [{label, L} || L <- Labels], + %% Update data with the info for the jump table + {NewData, JTabLab} = + case hipe_rtl:switch_sort_order(I) of + [] -> + hipe_consttab:insert_block(Data, word, LMap); + SortOrder -> + hipe_consttab:insert_sorted_block(Data, word, LMap, SortOrder) + end, + Relocs2 = relocs_store(TableName, {switch, {TableType, Labels, NrLabels, + SortOrder}, JTabLab}, Relocs), + {[I4, I3, I2, I1], Relocs2, NewData}. + +%% @doc Pass on RTL code in order to fix invoke and closure calls. +fix_code(Code) -> + fix_calls(Code). + +%% @doc Fix invoke calls and closure calls with more than ?NR_ARG_REGS +%% arguments. +fix_calls(Code) -> + fix_calls(Code, [], []). + +fix_calls([], Acc, FailLabels) -> + {lists:reverse(Acc), FailLabels}; +fix_calls([I | Is], Acc, FailLabels) -> + case hipe_rtl:is_call(I) of + true -> + {NewCall, NewFailLabels} = + case hipe_rtl:call_fail(I) of + [] -> + {I, FailLabels}; + FailLabel -> + fix_invoke_call(I, FailLabel, FailLabels) + end, + fix_calls(Is, [NewCall|Acc], NewFailLabels); + false -> + fix_calls(Is, [I|Acc], FailLabels) + end. + +%% @doc When a call has a fail continuation label it must be extended with a +%% normal continuation label to go with the LLVM's invoke instruction. +%% FailLabels is the list of labels of all fail blocks, which are needed to +%% be declared as landing pads. Furtermore, we must add to fail labels a +%% call to hipe_bifs:llvm_fix_pinned_regs/0 in order to avoid reloading old +%% values of pinned registers. This may happen because the result of an +%% invoke instruction is not available at fail-labels, and, thus, we cannot +%% get the correct values of pinned registers. Finally, the stack needs to +%% be re-adjusted when there are stack arguments. +fix_invoke_call(I, FailLabel, FailLabels) -> + NewLabel = hipe_gensym:new_label(llvm), + NewCall1 = hipe_rtl:call_normal_update(I, NewLabel), + SpAdj = find_sp_adj(hipe_rtl:call_arglist(I)), + case lists:keyfind(FailLabel, 1, FailLabels) of + %% Same fail label with same Stack Pointer adjustment + {FailLabel, NewFailLabel, SpAdj} -> + NewCall2 = hipe_rtl:call_fail_update(NewCall1, NewFailLabel), + {NewCall2, FailLabels}; + %% Same fail label but with different Stack Pointer adjustment + {_, _, _} -> + NewFailLabel = hipe_gensym:new_label(llvm), + NewCall2 = hipe_rtl:call_fail_update(NewCall1, NewFailLabel), + {NewCall2, [{FailLabel, NewFailLabel, SpAdj} | FailLabels]}; + %% New Fail label + false -> + NewFailLabel = hipe_gensym:new_label(llvm), + NewCall2 = hipe_rtl:call_fail_update(NewCall1, NewFailLabel), + {NewCall2, [{FailLabel, NewFailLabel, SpAdj} | FailLabels]} + end. + +find_sp_adj(ArgList) -> + NrArgs = length(ArgList), + case NrArgs > ?NR_ARG_REGS of + true -> + (NrArgs - ?NR_ARG_REGS) * hipe_rtl_arch:word_size(); + false -> + 0 + end. + +%% @doc Add landingpad instruction in Fail Blocks. +add_landingpads(LLVM_Code, FailLabels) -> + FailLabels2 = [convert_label(T) || T <- FailLabels], + add_landingpads(LLVM_Code, FailLabels2, []). + +add_landingpads([], _, Acc) -> + lists:reverse(Acc); +add_landingpads([I | Is], FailLabels, Acc) -> + case hipe_llvm:is_label(I) of + true -> + Label = hipe_llvm:label_label(I), + Ins = create_fail_blocks(Label, FailLabels), + add_landingpads(Is, FailLabels, [I | Ins] ++ Acc); + false -> + add_landingpads(Is, FailLabels, [I | Acc]) + end. + +convert_label({X,Y,Z}) -> + {"L" ++ integer_to_list(X), "FL" ++ integer_to_list(Y), Z}. + +%% @doc Create a fail block wich. +create_fail_blocks(_, []) -> []; +create_fail_blocks(Label, FailLabels) -> + create_fail_blocks(Label, FailLabels, []). + +create_fail_blocks(Label, FailLabels, Acc) -> + case lists:keytake(Label, 1, FailLabels) of + false -> + Acc; + {value, {Label, FailLabel, SpAdj}, RestFailLabels} -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I1 = hipe_llvm:mk_label(FailLabel), + LP = hipe_llvm:mk_landingpad(), + I2 = + case SpAdj > 0 of + true -> + StackPointer = ?ARCH_REGISTERS:reg_name(?ARCH_REGISTERS:sp()), + hipe_llvm:mk_adj_stack(integer_to_list(SpAdj), StackPointer, + WordTy); + false -> [] + end, + T1 = mk_temp(), + FixedRegs = fixed_registers(), + FunRetTy = + hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + I3 = hipe_llvm:mk_call(T1, false, "cc 11", [], FunRetTy, + "@hipe_bifs.llvm_fix_pinned_regs.0", [], []), + I4 = store_fixed_regs(FixedRegs, T1), + I5 = hipe_llvm:mk_br("%" ++ Label), + Ins = lists:flatten([I5, I4, I3, I2, LP,I1]), + create_fail_blocks(Label, RestFailLabels, Ins ++ Acc) + end. + +%%------------------------------------------------------------------------------ +%% Miscellaneous Functions +%%------------------------------------------------------------------------------ + +%% @doc Convert RTL argument list to LLVM argument list. +trans_args(ArgList) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + MakeArg = + fun(A) -> + {Name, I1} = trans_src(A), + {{WordTy, Name}, I1} + end, + [MakeArg(A) || A <- ArgList]. + +%% @doc Convert a list of Precoloured registers to LLVM argument list. +fix_reg_args(ArgList) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + [{WordTy, A} || A <- ArgList]. + +%% @doc Load Precoloured registers. +load_fixed_regs(RegList) -> + Names = [mk_temp_reg(R) || R <- RegList], + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + Fun1 = + fun (X, Y) -> + hipe_llvm:mk_load(X, WordTyPtr, "%" ++ Y ++ "_reg_var", [], [], false) + end, + Ins = lists:zipwith(Fun1, Names, RegList), + {Names, Ins}. + +%% @doc Store Precoloured registers. +store_fixed_regs(RegList, Name) -> + Names = [mk_temp_reg(R) || R <- RegList], + Indexes = lists:seq(0, erlang:length(RegList) - 1), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + Fun1 = + fun(X,Y) -> + hipe_llvm:mk_extractvalue(X, FunRetTy, Name, integer_to_list(Y), []) + end, + I1 = lists:zipwith(Fun1, Names, Indexes), + Fun2 = + fun (X, Y) -> + hipe_llvm:mk_store(WordTy, X, WordTyPtr, "%" ++ Y ++ "_reg_var", [], [], + false) + end, + I2 = lists:zipwith(Fun2, Names, RegList), + [I2, I1]. + +%%------------------------------------------------------------------------------ +%% Translation of Names +%%------------------------------------------------------------------------------ + +%% @doc Fix F in MFA tuple to acceptable LLVM identifier (case of closure). +-spec fix_mfa_name(mfa()) -> mfa(). +fix_mfa_name({Mod_Name, Closure_Name, Arity}) -> + Fun_Name = list_to_atom(fix_closure_name(Closure_Name)), + {Mod_Name, Fun_Name, Arity}. + +%% @doc Make an acceptable LLVM identifier for a closure name. +fix_closure_name(ClosureName) -> + make_llvm_id(atom_to_list(ClosureName)). + +%% @doc Create an acceptable LLVM identifier. +make_llvm_id(Name) -> + case Name of + "" -> "Empty"; + Other -> lists:flatten([llvm_id(C) || C <- Other]) + end. + +llvm_id(C) when C=:=46; C>47 andalso C<58; C>64 andalso C<91; C=:=95; + C>96 andalso C<123 -> + C; +llvm_id(C) -> + io_lib:format("_~2.16.0B_",[C]). + +%% @doc Create an acceptable LLVM identifier for an MFA. +trans_mfa_name({M,F,A}) -> + N = atom_to_list(M) ++ "." ++ atom_to_list(F) ++ "." ++ integer_to_list(A), + make_llvm_id(N). + +%%------------------------------------------------------------------------------ +%% Creation of Labels and Temporaries +%%------------------------------------------------------------------------------ +mk_label(N) -> + "L" ++ integer_to_list(N). + +mk_jump_label(N) -> + "%L" ++ integer_to_list(N). + +mk_temp() -> + "%t" ++ integer_to_list(hipe_gensym:new_var(llvm)). + +mk_temp_reg(Name) -> + "%" ++ Name ++ integer_to_list(hipe_gensym:new_var(llvm)). + +%%---------------------------------------------------------------------------- +%% Translation of Operands +%%---------------------------------------------------------------------------- + +store_stack_dst(TempDst, Dst) -> + {Dst2, II1} = trans_dst(Dst), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + II2 = hipe_llvm:mk_store(WordTy, TempDst, WordTyPtr, Dst2, [], [], false), + [II2, II1]. + +store_float_stack(TempDst, Dst) -> + {Dst2, II1} = trans_dst(Dst), + FloatTy = hipe_llvm:mk_double(), + FloatTyPtr = hipe_llvm:mk_pointer(FloatTy), + II2 = hipe_llvm:mk_store(FloatTy, TempDst, FloatTyPtr, Dst2, [], [], false), + [II2, II1]. + +trans_float_src(Src) -> + case hipe_rtl:is_const_label(Src) of + true -> + Name = "@DL" ++ integer_to_list(hipe_rtl:const_label_label(Src)), + T1 = mk_temp(), + %% XXX: Hardcoded offset + ByteTy = hipe_llvm:mk_int(8), + ByteTyPtr = hipe_llvm:mk_pointer(ByteTy), + I1 = hipe_llvm:mk_getelementptr(T1, ByteTyPtr, Name, + [{ByteTy, integer_to_list(?FLOAT_OFFSET)}], true), + T2 = mk_temp(), + FloatTy = hipe_llvm:mk_double(), + FloatTyPtr = hipe_llvm:mk_pointer(FloatTy), + I2 = hipe_llvm:mk_conversion(T2, bitcast, ByteTyPtr, T1, FloatTyPtr), + T3 = mk_temp(), + I3 = hipe_llvm:mk_load(T3, FloatTyPtr, T2, [], [], false), + {T3, [I3, I2, I1]}; + false -> + trans_src(Src) + end. + +trans_src(A) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + case hipe_rtl:is_imm(A) of + true -> + Value = integer_to_list(hipe_rtl:imm_value(A)), + {Value, []}; + false -> + case hipe_rtl:is_reg(A) of + true -> + case isPrecoloured(A) of + true -> trans_reg(A, src); + false -> + {Name, []} = trans_reg(A, src), + T1 = mk_temp(), + I1 = hipe_llvm:mk_load(T1, WordTyPtr, Name, [], [], false), + {T1, [I1]} + end; + false -> + case hipe_rtl:is_var(A) of + true -> + RootName = "%vr" ++ integer_to_list(hipe_rtl:var_index(A)), + T1 = mk_temp(), + I1 = hipe_llvm:mk_load(T1, WordTyPtr, RootName, [], [], false), + I2 = + case hipe_rtl:var_liveness(A) of + live -> + []; + dead -> + NilValue = hipe_tagscheme:mk_nil(), + hipe_llvm:mk_store(WordTy, integer_to_list(NilValue), WordTyPtr, RootName, + [], [], false) + end, + {T1, [I2, I1]}; + false -> + case hipe_rtl:is_fpreg(A) of + true -> + {Name, []} = trans_dst(A), + T1 = mk_temp(), + FloatTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_double()), + I1 = hipe_llvm:mk_load(T1, FloatTyPtr, Name, [], [], false), + {T1, [I1]}; + false -> trans_dst(A) + end + end + end + end. + +trans_dst(A) -> + case hipe_rtl:is_reg(A) of + true -> + trans_reg(A, dst); + false -> + Name = case hipe_rtl:is_var(A) of + true -> + "%vr" ++ integer_to_list(hipe_rtl:var_index(A)); + false -> + case hipe_rtl:is_fpreg(A) of + true -> "%fr" ++ integer_to_list(hipe_rtl:fpreg_index(A)); + false -> + case hipe_rtl:is_const_label(A) of + true -> + "%DL" ++ integer_to_list(hipe_rtl:const_label_label(A)) ++ "_var"; + false -> + exit({?MODULE, trans_dst, {"Bad RTL argument",A}}) + end + end + end, + {Name, []} + end. + +%% @doc Translate a register. If it is precoloured it must be mapped to the +%% correct stack slot that holds the precoloured register value. +trans_reg(Arg, Position) -> + Index = hipe_rtl:reg_index(Arg), + case isPrecoloured(Arg) of + true -> + Name = map_precoloured_reg(Index), + case Position of + src -> fix_reg_src(Name); + dst -> fix_reg_dst(Name) + end; + false -> + {hipe_rtl_arch:reg_name(Index), []} + end. + +map_precoloured_reg(Index) -> + case hipe_rtl_arch:reg_name(Index) of + "%r15" -> "%hp_reg_var"; + "%rbp" -> "%p_reg_var"; + "%esi" -> "%hp_reg_var"; + "%ebp" -> "%p_reg_var"; + "%fcalls" -> + {"%p_reg_var", ?ARCH_REGISTERS:proc_offset(?ARCH_REGISTERS:fcalls())}; + "%hplim" -> + {"%p_reg_var", ?ARCH_REGISTERS:proc_offset(?ARCH_REGISTERS:heap_limit())}; + _ -> + exit({?MODULE, map_precoloured_reg, {"Register not mapped yet", Index}}) + end. + +%% @doc Load precoloured dst register. +fix_reg_dst(Register) -> + case Register of + {Name, Offset} -> %% Case of %fcalls, %hplim + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + pointer_from_reg(Name, WordTy, Offset); + Name -> %% Case of %p and %hp + {Name, []} + end. + +%% @doc Load precoloured src register. +fix_reg_src(Register) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + case Register of + {Name, Offset} -> %% Case of %fcalls, %hplim + {T1, I1} = pointer_from_reg(Name, WordTy, Offset), + T2 = mk_temp(), + I2 = hipe_llvm:mk_load(T2, WordTyPtr, T1, [], [] , false), + {T2, [I2, I1]}; + Name -> %% Case of %p and %hp + T1 = mk_temp(), + {T1, hipe_llvm:mk_load(T1, WordTyPtr, Name, [], [], false)} + end. + +%% @doc Load %fcalls and %hplim. +pointer_from_reg(RegName, Type, Offset) -> + PointerType = hipe_llvm:mk_pointer(Type), + T1 = mk_temp(), + I1 = hipe_llvm:mk_load(T1, PointerType, RegName, [], [] ,false), + T2 = mk_temp(), + I2 = hipe_llvm:mk_conversion(T2, inttoptr, Type, T1, PointerType), + T3 = mk_temp(), + %% XXX: Offsets should be a power of 2. + I3 = hipe_llvm:mk_getelementptr(T3, PointerType, T2, + [{Type, integer_to_list(Offset div hipe_rtl_arch:word_size())}], true), + {T3, [I3, I2, I1]}. + +isPrecoloured(X) -> + hipe_rtl_arch:is_precoloured(X). + +%%------------------------------------------------------------------------------ +%% Translation of operators +%%------------------------------------------------------------------------------ + +trans_op(Op) -> + case Op of + add -> add; + sub -> sub; + 'or' -> 'or'; + 'and' -> 'and'; + 'xor' -> 'xor'; + sll -> shl; + srl -> lshr; + sra -> ashr; + mul -> mul; + 'fdiv' -> fdiv; + 'sdiv' -> sdiv; + 'srem' -> srem; + Other -> exit({?MODULE, trans_op, {"Unknown RTL operator", Other}}) + end. + +trans_rel_op(Op) -> + case Op of + eq -> eq; + ne -> ne; + gtu -> ugt; + geu -> uge; + ltu -> ult; + leu -> ule; + gt -> sgt; + ge -> sge; + lt -> slt; + le -> sle + end. + +trans_prim_op(Op) -> + case Op of + '+' -> "bif_add"; + '-' -> "bif_sub"; + '*' -> "bif_mul"; + 'div' -> "bif_div"; + '/' -> "bif_div"; + Other -> atom_to_list(Other) + end. + +trans_fp_op(Op) -> + case Op of + fadd -> fadd; + fsub -> fsub; + fdiv -> fdiv; + fmul -> fmul; + fchs -> fsub; + Other -> exit({?MODULE, trans_fp_op, {"Unknown RTL float operator",Other}}) + end. + +%% Misc. +insn_dst(I) -> + case I of + #alu{} -> + [hipe_rtl:alu_dst(I)]; + #alub{} -> + [hipe_rtl:alub_dst(I)]; + #call{} -> + case hipe_rtl:call_dstlist(I) of + [] -> []; + [Dst] -> [Dst] + end; + #load{} -> + [hipe_rtl:load_dst(I)]; + #load_address{} -> + [hipe_rtl:load_address_dst(I)]; + #load_atom{} -> + [hipe_rtl:load_atom_dst(I)]; + #move{} -> + [hipe_rtl:move_dst(I)]; + #phi{} -> + [hipe_rtl:phi_dst(I)]; + #fconv{} -> + [hipe_rtl:fconv_dst(I)]; + #fload{} -> + [hipe_rtl:fload_dst(I)]; + #fmove{} -> + [hipe_rtl:fmove_dst(I)]; + #fp{} -> + [hipe_rtl:fp_dst(I)]; + #fp_unop{} -> + [hipe_rtl:fp_unop_dst(I)]; + _ -> + [] + end. + +llvm_type_from_size(Size) -> + case Size of + byte -> hipe_llvm:mk_int(8); + int16 -> hipe_llvm:mk_int(16); + int32 -> hipe_llvm:mk_int(32); + word -> hipe_llvm:mk_int(64) + end. + +%% @doc Create definition for the compiled function. The parameters that are +%% passed to the stack must be reversed to match with the CC. Also +%% precoloured registers that are passed as arguments must be stored to +%% the corresonding stack slots. +create_function_definition(Fun, Params, Code, LocalVars) -> + FunctionName = trans_mfa_name(Fun), + FixedRegs = fixed_registers(), + %% Reverse parameters to match with the Erlang calling convention + ReversedParams = + case erlang:length(Params) > ?NR_ARG_REGS of + false -> + Params; + true -> + {ParamsInRegs, ParamsInStack} = lists:split(?NR_ARG_REGS, Params), + ParamsInRegs ++ lists:reverse(ParamsInStack) + end, + Args = header_regs(FixedRegs) ++ header_params(ReversedParams), + EntryLabel = hipe_llvm:mk_label("Entry"), + FloatTy = hipe_llvm:mk_double(), + ExceptionSync = hipe_llvm:mk_alloca("%exception_sync", FloatTy, [], []), + I2 = load_regs(FixedRegs), + I3 = hipe_llvm:mk_br(mk_jump_label(get(first_label))), + StoredParams = store_params(Params), + EntryBlock = + lists:flatten([EntryLabel, ExceptionSync, I2, LocalVars, StoredParams, I3]), + Final_Code = EntryBlock ++ Code, + FunctionOptions = [nounwind, noredzone, list_to_atom("gc \"erlang\"")], + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + hipe_llvm:mk_fun_def([], [], "cc 11", [], FunRetTy, FunctionName, Args, + FunctionOptions, [], Final_Code). + +header_params(Params) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + [{WordTy, "%v" ++ integer_to_list(hipe_rtl:var_index(P))} || P <- Params]. + +store_params(Params) -> + Fun1 = + fun(X) -> + Index = hipe_rtl:var_index(X), + {Name, _} = trans_dst(X), + ParamName = "%v" ++ integer_to_list(Index), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + hipe_llvm:mk_store(WordTy, ParamName, WordTyPtr, Name, [], [], false) + end, + lists:map(Fun1, Params). + +fixed_registers() -> + case get(hipe_target_arch) of + x86 -> + ["hp", "p"]; + amd64 -> + ["hp", "p"]; + Other -> + exit({?MODULE, map_registers, {"Unknown architecture", Other}}) + end. + +header_regs(Registers) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + [{WordTy, "%" ++ X ++ "_in"} || X <- Registers]. + +load_regs(Registers) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + Fun1 = + fun(X) -> + I1 = hipe_llvm:mk_alloca("%" ++ X ++ "_reg_var", WordTy, [], []), + I2 = hipe_llvm:mk_store(WordTy, "%" ++ X ++ "_in", WordTyPtr, + "%" ++ X ++ "_reg_var", [], [], false), + [I1, I2] + end, + lists:map(Fun1, Registers). + +%%------------------------------------------------------------------------------ +%% Relocation-specific Stuff +%%------------------------------------------------------------------------------ + +relocs_store(Key, Value, Relocs) -> + dict:store(Key, Value, Relocs). + +relocs_to_list(Relocs) -> + dict:to_list(Relocs). + +%% @doc This function is responsible for the actions needed to handle +%% relocations: +%% 1) Updates relocations with constants and switch jump tables. +%% 2) Creates LLVM code to declare relocations as external +%% functions/constants. +%% 3) Creates LLVM code in order to create local variables for the external +%% constants/labels. +handle_relocations(Relocs, Data, Fun) -> + RelocsList = relocs_to_list(Relocs), + %% Seperate Relocations according to their type + {CallList, AtomList, ClosureList, ClosureLabels, SwitchList} = + seperate_relocs(RelocsList), + %% Create code to declare atoms + AtomDecl = [declare_atom(A) || A <- AtomList], + %% Create code to create local name for atoms + AtomLoad = [load_atom(A) || A <- AtomList], + %% Create code to declare closures + ClosureDecl = [declare_closure(C) || C <- ClosureList], + %% Create code to create local name for closures + ClosureLoad = [load_closure(C) || C <- ClosureList], + %% Find function calls + IsExternalCall = fun (X) -> is_external_call(X, Fun) end, + ExternalCallList = lists:filter(IsExternalCall, CallList), + %% Create code to declare external function + FunDecl = fixed_fun_decl() ++ [call_to_decl(C) || C <- ExternalCallList], + %% Extract constant labels from Constant Map (remove duplicates) + ConstLabels = hipe_consttab:labels(Data), + %% Create code to declare constants + ConstDecl = [declare_constant(C) || C <- ConstLabels], + %% Create code to create local name for constants + ConstLoad = [load_constant(C) || C <- ConstLabels], + %% Create code to create jump tables + SwitchDecl = declare_switches(SwitchList, Fun), + %% Create code to create a table with the labels of all closure calls + {ClosureLabelDecl, Relocs1} = + declare_closure_labels(ClosureLabels, Relocs, Fun), + %% Enter constants to relocations + Relocs2 = lists:foldl(fun const_to_dict/2, Relocs1, ConstLabels), + %% Temporary Store inc_stack and llvm_fix_pinned_regs to Dictionary + %% TODO: Remove this + Relocs3 = dict:store("inc_stack_0", {call, {bif, inc_stack_0, 0}}, Relocs2), + Relocs4 = dict:store("hipe_bifs.llvm_fix_pinned_regs.0", + {call, {hipe_bifs, llvm_fix_pinned_regs, 0}}, Relocs3), + BranchMetaData = [ + hipe_llvm:mk_branch_meta(?BRANCH_META_TAKEN, "99", "1") + , hipe_llvm:mk_branch_meta(?BRANCH_META_NOT_TAKEN, "1", "99") + ], + ExternalDeclarations = AtomDecl ++ ClosureDecl ++ ConstDecl ++ FunDecl ++ + ClosureLabelDecl ++ SwitchDecl ++ BranchMetaData, + LocalVariables = AtomLoad ++ ClosureLoad ++ ConstLoad, + {Relocs4, ExternalDeclarations, LocalVariables}. + +%% @doc Seperate relocations according to their type. +seperate_relocs(Relocs) -> + seperate_relocs(Relocs, [], [], [], [], []). + +seperate_relocs([], CallAcc, AtomAcc, ClosureAcc, LabelAcc, JmpTableAcc) -> + {CallAcc, AtomAcc, ClosureAcc, LabelAcc, JmpTableAcc}; +seperate_relocs([R|Rs], CallAcc, AtomAcc, ClosureAcc, LabelAcc, JmpTableAcc) -> + case R of + {_, {call, _}} -> + seperate_relocs(Rs, [R | CallAcc], AtomAcc, ClosureAcc, LabelAcc, + JmpTableAcc); + {_, {atom, _}} -> + seperate_relocs(Rs, CallAcc, [R | AtomAcc], ClosureAcc, LabelAcc, + JmpTableAcc); + {_, {closure, _}} -> + seperate_relocs(Rs, CallAcc, AtomAcc, [R | ClosureAcc], LabelAcc, + JmpTableAcc); + {_, {switch, _, _}} -> + seperate_relocs(Rs, CallAcc, AtomAcc, ClosureAcc, LabelAcc, + [R | JmpTableAcc]); + {_, {closure_label, _, _}} -> + seperate_relocs(Rs, CallAcc, AtomAcc, ClosureAcc, [R | LabelAcc], + JmpTableAcc) + end. + +%% @doc External declaration of an atom. +declare_atom({AtomName, _}) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + hipe_llvm:mk_const_decl("@" ++ AtomName, "external constant", WordTy, ""). + +%% @doc Creation of local variable for an atom. +load_atom({AtomName, _}) -> + Dst = "%" ++ AtomName ++ "_var", + Name = "@" ++ AtomName, + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + hipe_llvm:mk_conversion(Dst, ptrtoint, WordTyPtr, Name, WordTy). + +%% @doc External declaration of a closure. +declare_closure({ClosureName, _})-> + ByteTy = hipe_llvm:mk_int(8), + hipe_llvm:mk_const_decl("@" ++ ClosureName, "external constant", ByteTy, ""). + +%% @doc Creation of local variable for a closure. +load_closure({ClosureName, _})-> + Dst = "%" ++ ClosureName ++ "_var", + Name = "@" ++ ClosureName, + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + hipe_llvm:mk_conversion(Dst, ptrtoint, ByteTyPtr, Name, WordTy). + +%% @doc Declaration of a local variable for a switch jump table. +declare_switches(JumpTableList, Fun) -> + FunName = trans_mfa_name(Fun), + [declare_switch_table(X, FunName) || X <- JumpTableList]. + +declare_switch_table({Name, {switch, {TableType, Labels, _, _}, _}}, FunName) -> + LabelList = [mk_jump_label(L) || L <- Labels], + Fun1 = fun(X) -> "i8* blockaddress(@" ++ FunName ++ ", " ++ X ++ ")" end, + List2 = lists:map(Fun1, LabelList), + List3 = string:join(List2, ",\n"), + List4 = "[\n" ++ List3 ++ "\n]\n", + hipe_llvm:mk_const_decl("@" ++ Name, "constant", TableType, List4). + +%% @doc Declaration of a variable for a table with the labels of all closure +%% calls in the code. +declare_closure_labels([], Relocs, _Fun) -> + {[], Relocs}; +declare_closure_labels(ClosureLabels, Relocs, Fun) -> + FunName = trans_mfa_name(Fun), + {LabelList, ArityList} = + lists:unzip([{mk_jump_label(Label), A} || + {_, {closure_label, Label, A}} <- ClosureLabels]), + Relocs1 = relocs_store("table_closures", {table_closures, ArityList}, Relocs), + List2 = + ["i8* blockaddress(@" ++ FunName ++ ", " ++ L ++ ")" || L <- LabelList], + List3 = string:join(List2, ",\n"), + List4 = "[\n" ++ List3 ++ "\n]\n", + NrLabels = length(LabelList), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + TableType = hipe_llvm:mk_array(NrLabels, ByteTyPtr), + ConstDecl = + hipe_llvm:mk_const_decl("@table_closures", "constant", TableType, List4), + {[ConstDecl], Relocs1}. + +%% @doc A call is treated as non external only in a case of a recursive +%% function. +is_external_call({_, {call, Fun}}, Fun) -> false; +is_external_call(_, _) -> true. + +%% @doc External declaration of a function. +call_to_decl({Name, {call, MFA}}) -> + {M, _F, A} = MFA, + CConv = "cc 11", + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + {Type, Args} = + case M of + llvm -> + {hipe_llvm:mk_struct([WordTy, hipe_llvm:mk_int(1)]), [1, 2]}; + %% +precoloured regs + _ -> + {FunRetTy, lists:seq(1, A + ?NR_PINNED_REGS)} + end, + ArgsTypes = lists:duplicate(length(Args), WordTy), + hipe_llvm:mk_fun_decl([], [], CConv, [], Type, "@" ++ Name, ArgsTypes, []). + +%% @doc These functions are always declared, even if not used. +fixed_fun_decl() -> + ByteTy = hipe_llvm:mk_int(8), + ByteTyPtr = hipe_llvm:mk_pointer(ByteTy), + LandPad = hipe_llvm:mk_fun_decl([], [], [], [], hipe_llvm:mk_int(32), + "@__gcc_personality_v0", [hipe_llvm:mk_int(32), hipe_llvm:mk_int(64), + ByteTyPtr, ByteTyPtr], []), + GCROOTDecl = hipe_llvm:mk_fun_decl([], [], [], [], hipe_llvm:mk_void(), + "@llvm.gcroot", [hipe_llvm:mk_pointer(ByteTyPtr), ByteTyPtr], []), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + FixPinnedRegs = hipe_llvm:mk_fun_decl([], [], [], [], FunRetTy, + "@hipe_bifs.llvm_fix_pinned_regs.0", [], []), + GcMetadata = hipe_llvm:mk_const_decl("@gc_metadata", "external constant", + ByteTy, ""), + [LandPad, GCROOTDecl, FixPinnedRegs, GcMetadata]. + +%% @doc Declare an External Consant. We declare all constants as i8 in order to +%% be able to calcucate pointers of the form DL+6, with the getelementptr +%% instruction. Otherwise we have to convert constants form pointers to +%% values, add the offset and convert them again to pointers. +declare_constant(Label) -> + Name = "@DL" ++ integer_to_list(Label), + ByteTy = hipe_llvm:mk_int(8), + hipe_llvm:mk_const_decl(Name, "external constant", ByteTy, ""). + +%% @doc Load a constant is achieved by converting a pointer to an integer of +%% the correct width. +load_constant(Label) -> + Dst = "%DL" ++ integer_to_list(Label) ++ "_var", + Name = "@DL" ++ integer_to_list(Label), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + hipe_llvm:mk_conversion(Dst, ptrtoint, ByteTyPtr, Name, WordTy). + +%% @doc Store external constants and calls to dictionary. +const_to_dict(Elem, Dict) -> + Name = "DL" ++ integer_to_list(Elem), + dict:store(Name, {'constant', Elem}, Dict). diff --git a/lib/hipe/main/hipe.app.src b/lib/hipe/main/hipe.app.src index bcdfcb0e03..e81212d4dc 100644 --- a/lib/hipe/main/hipe.app.src +++ b/lib/hipe/main/hipe.app.src @@ -30,6 +30,7 @@ cerl_prettypr, cerl_to_icode, cerl_typean, + elf_format, erl_bif_types, erl_types, hipe, @@ -108,6 +109,10 @@ hipe_ig, hipe_ig_moves, hipe_jit, + hipe_llvm, + hipe_llvm_liveness, + hipe_llvm_main, + hipe_llvm_merge, hipe_ls_regalloc, hipe_main, hipe_moves, @@ -159,6 +164,7 @@ hipe_rtl_symbolic, hipe_rtl_to_amd64, hipe_rtl_to_arm, + hipe_rtl_to_llvm, hipe_rtl_to_ppc, hipe_rtl_to_sparc, hipe_rtl_to_x86, @@ -216,4 +222,6 @@ hipe_x86_x87]}, {registered,[]}, {applications, [kernel,stdlib]}, - {env, []}]}. + {env, []}, + {runtime_dependencies, ["syntax_tools-1.6.14","stdlib-2.0","kernel-3.0", + "erts-6.0","compiler-5.0"]}]}. diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl index 434d5c3061..d47eced6d8 100644 --- a/lib/hipe/main/hipe.erl +++ b/lib/hipe/main/hipe.erl @@ -821,7 +821,9 @@ finalize_fun_sequential({MFA, Icode}, Opts, Servers) -> ?debug_msg("Compiled ~w in ~.2f s\n", [MFA,(T2-T1)/1000])), {MFA, Code}; {rtl, LinearRtl} -> - {MFA, LinearRtl} + {MFA, LinearRtl}; + {llvm_binary, Binary} -> + {MFA, Binary} catch error:Error -> ?when_option(verbose, Opts, ?debug_untagged_msg("\n", [])), @@ -890,21 +892,27 @@ do_load(Mod, Bin, BeamBinOrPath) when is_binary(BeamBinOrPath); end. assemble(CompiledCode, Closures, Exports, Options) -> - case get(hipe_target_arch) of - ultrasparc -> - hipe_sparc_assemble:assemble(CompiledCode, Closures, Exports, Options); - powerpc -> - hipe_ppc_assemble:assemble(CompiledCode, Closures, Exports, Options); - ppc64 -> - hipe_ppc_assemble:assemble(CompiledCode, Closures, Exports, Options); - arm -> - hipe_arm_assemble:assemble(CompiledCode, Closures, Exports, Options); - x86 -> - hipe_x86_assemble:assemble(CompiledCode, Closures, Exports, Options); - amd64 -> - hipe_amd64_assemble:assemble(CompiledCode, Closures, Exports, Options); - Arch -> - ?EXIT({executing_on_an_unsupported_architecture, Arch}) + case proplists:get_bool(to_llvm, Options) of + false -> + case get(hipe_target_arch) of + ultrasparc -> + hipe_sparc_assemble:assemble(CompiledCode, Closures, Exports, Options); + powerpc -> + hipe_ppc_assemble:assemble(CompiledCode, Closures, Exports, Options); + ppc64 -> + hipe_ppc_assemble:assemble(CompiledCode, Closures, Exports, Options); + arm -> + hipe_arm_assemble:assemble(CompiledCode, Closures, Exports, Options); + x86 -> + hipe_x86_assemble:assemble(CompiledCode, Closures, Exports, Options); + amd64 -> + hipe_amd64_assemble:assemble(CompiledCode, Closures, Exports, Options); + Arch -> + ?EXIT({executing_on_an_unsupported_architecture, Arch}) + end; + true -> + %% Merge already compiled code (per MFA) to a single binary. + hipe_llvm_merge:finalize(CompiledCode, Closures, Exports) end. %% -------------------------------------------------------------------- @@ -1330,6 +1338,11 @@ opt_keys() -> timeregalloc, timers, to_rtl, + to_llvm, % Use the LLVM backend for compilation. + llvm_save_temps, % Save the LLVM intermediate files in the current + % directory; useful for debugging. + llvm_llc, % Specify llc optimization-level: o1, o2, o3, undefined. + llvm_opt, % Specify opt optimization-level: o1, o2, o3, undefined. use_indexing, use_inline_atom_search, use_callgraph, @@ -1468,11 +1481,19 @@ opt_expansions() -> [{o1, o1_opts()}, {o2, o2_opts()}, {o3, o3_opts()}, + {to_llvm, llvm_opts(o3)}, + {{to_llvm, o0}, llvm_opts(o0)}, + {{to_llvm, o1}, llvm_opts(o1)}, + {{to_llvm, o2}, llvm_opts(o2)}, + {{to_llvm, o3}, llvm_opts(o3)}, {x87, [x87, inline_fp]}, {inline_fp, case get(hipe_target_arch) of %% XXX: Temporary until x86 x86 -> [x87, inline_fp]; %% has sse2 _ -> [inline_fp] end}]. +llvm_opts(O) -> + [to_llvm, {llvm_opt, O}, {llvm_llc, O}]. + %% This expands "basic" options, which may be tested early and cannot be %% in conflict with options found in the source code. diff --git a/lib/hipe/main/hipe_main.erl b/lib/hipe/main/hipe_main.erl index 99028cc3c1..89b79998be 100644 --- a/lib/hipe/main/hipe_main.erl +++ b/lib/hipe/main/hipe_main.erl @@ -49,7 +49,7 @@ %%===================================================================== -type comp_icode_ret() :: {'native',hipe_architecture(),{'unprofiled',_}} - | {'rtl',tuple()}. + | {'rtl',tuple()} | {'llvm_binary',term()}. %%===================================================================== @@ -115,11 +115,18 @@ compile_icode(MFA, LinearIcode0, Options, Servers, DebugState) -> pp(IcodeCfg7, MFA, icode_liveness, pp_icode_liveness, Options, Servers), FinalIcode = hipe_icode_cfg:cfg_to_linear(IcodeCfg7), ?opt_stop_timer("Icode"), - LinearRTL = ?option_time(icode_to_rtl(MFA,FinalIcode,Options, Servers), - "RTL", Options), + {LinearRTL, Roots} = ?option_time(icode_to_rtl(MFA, FinalIcode, Options, Servers), + "RTL", Options), case proplists:get_bool(to_rtl, Options) of false -> - rtl_to_native(MFA, LinearRTL, Options, DebugState); + case proplists:get_bool(to_llvm, Options) of + false -> + rtl_to_native(MFA, LinearRTL, Options, DebugState); + true -> + %% The LLVM backend returns binary code, unlike the rest of the HiPE + %% backends which return native assembly. + rtl_to_llvm_to_binary(MFA, LinearRTL, Roots, Options, DebugState) + end; true -> put(hipe_debug, DebugState), {rtl, LinearRTL} @@ -385,11 +392,21 @@ icode_to_rtl(MFA, Icode, Options, Servers) -> %% hipe_rtl_cfg:pp(RtlCfg3), pp(RtlCfg3, MFA, rtl_liveness, pp_rtl_liveness, Options, Servers), RtlCfg4 = rtl_lcm(RtlCfg3, Options), - pp(RtlCfg4, MFA, rtl, pp_rtl, Options, Servers), - LinearRTL1 = hipe_rtl_cfg:linearize(RtlCfg4), + %% LLVM: A liveness analysis on RTL must be performed in order to find the GC + %% roots and explicitly mark them (in RTL) when they go out of scope (only + %% when the LLVM backend is used). + {RtlCfg5, Roots} = + case proplists:get_bool(to_llvm, Options) of + false -> + {RtlCfg4, []}; + true -> + hipe_llvm_liveness:analyze(RtlCfg4) + end, + pp(RtlCfg5, MFA, rtl, pp_rtl, Options, Servers), + LinearRTL1 = hipe_rtl_cfg:linearize(RtlCfg5), LinearRTL2 = hipe_rtl_cleanup_const:cleanup(LinearRTL1), %% hipe_rtl:pp(standard_io, LinearRTL2), - LinearRTL2. + {LinearRTL2, Roots}. translate_to_rtl(Icode, Options) -> %% GC tests should have been added in the conversion to Icode. @@ -540,6 +557,17 @@ rtl_to_native(MFA, LinearRTL, Options, DebugState) -> put(hipe_debug, DebugState), LinearNativeCode. +%% Translate Linear RTL to binary code using LLVM. +rtl_to_llvm_to_binary(MFA, LinearRTL, Roots, Options, DebugState) -> + ?opt_start_timer("LLVM native code"), + %% BinaryCode is a tuple, as defined in llvm/hipe_llvm_main module, which + %% contains the binary code together with info needed by the loader, e.g. + %% ConstTab, Refs, LabelMap, etc. + BinaryCode = hipe_llvm_main:rtl_to_native(MFA, LinearRTL, Roots, Options), + ?opt_stop_timer("LLVM native code"), + put(hipe_debug, DebugState), + {llvm_binary, BinaryCode}. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Debugging stuff ... %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/hipe/misc/hipe_gensym.erl b/lib/hipe/misc/hipe_gensym.erl index 84fc8fa7e8..4d2a237188 100644 --- a/lib/hipe/misc/hipe_gensym.erl +++ b/lib/hipe/misc/hipe_gensym.erl @@ -44,7 +44,7 @@ %% Types of allowable entities to set global variables for %%----------------------------------------------------------------------- --type gvarname() :: 'icode' | 'rtl' | 'arm' | 'ppc' | 'sparc' | 'x86'. +-type gvarname() :: 'icode' | 'rtl' | 'arm' | 'ppc' | 'sparc' | 'x86' | 'llvm'. %%----------------------------------------------------------------------- diff --git a/lib/hipe/misc/hipe_pack_constants.erl b/lib/hipe/misc/hipe_pack_constants.erl index ca8a9e6bf7..300f9ae43a 100644 --- a/lib/hipe/misc/hipe_pack_constants.erl +++ b/lib/hipe/misc/hipe_pack_constants.erl @@ -20,30 +20,48 @@ %% -module(hipe_pack_constants). --export([pack_constants/2, slim_refs/1, slim_constmap/1]). +-export([pack_constants/2, slim_refs/1, slim_constmap/1, + find_const/2, mk_data_relocs/2, slim_sorted_exportmap/3]). -include("hipe_consttab.hrl"). -include("../../kernel/src/hipe_ext_format.hrl"). +-include("../main/hipe.hrl"). % Needed for the EXIT macro in find_const/2. %%----------------------------------------------------------------------------- --type raw_data() :: binary() | number() | list() | tuple(). --type tbl_ref() :: {hipe_constlbl(), non_neg_integer()}. +-type const_num() :: non_neg_integer(). +-type raw_data() :: binary() | number() | list() | tuple(). + +-type addr() :: non_neg_integer(). +-type ref_p() :: {DataPos :: hipe_constlbl(), CodeOffset :: addr()}. +-type ref() :: ref_p() | {'sorted', Base :: addr(), [ref_p()]}. + +-type mfa_refs() :: {mfa(), [ref()]}. + +%% XXX: these types may not belong here: FIX! +-type fa() :: {atom(), arity()}. +-type export_map() :: [{addr(), module(), atom(), arity()}]. -record(pcm_entry, {mfa :: mfa(), label :: hipe_constlbl(), - const_num :: non_neg_integer(), - start :: non_neg_integer(), + const_num :: const_num(), + start :: addr(), type :: 0 | 1 | 2, raw_data :: raw_data()}). +-type pcm_entry() :: #pcm_entry{}. + +-type label_map() :: gb_trees:tree({mfa(), hipe_constlbl()}, addr()). + +%% Some of the following types may possibly need to be exported +-type data_relocs() :: [ref()]. +-type packed_const_map() :: [pcm_entry()]. +-type mfa_refs_map() :: [mfa_refs()]. +-type slim_export_map() :: [addr() | module() | atom() | arity() | boolean()]. %%----------------------------------------------------------------------------- -spec pack_constants([{mfa(),[_],hipe_consttab()}], ct_alignment()) -> - {ct_alignment(), - non_neg_integer(), - [#pcm_entry{}], - [{mfa(),[tbl_ref() | {'sorted',non_neg_integer(),[tbl_ref()]}]}]}. + {ct_alignment(), non_neg_integer(), packed_const_map(), mfa_refs_map()}. pack_constants(Data, Align) -> pack_constants(Data, 0, Align, 0, [], []). @@ -194,13 +212,12 @@ compact_dests([], Dest, AccofDest, Acc) -> %% to the slimmed and flattened format ConstMap which is put in object %% files. %% --spec slim_constmap([#pcm_entry{}]) -> [raw_data()]. +-spec slim_constmap(packed_const_map()) -> [raw_data()]. slim_constmap(Map) -> slim_constmap(Map, gb_sets:new(), []). --spec slim_constmap([#pcm_entry{}], gb_sets:set(), [raw_data()]) -> [raw_data()]. -slim_constmap([#pcm_entry{const_num=ConstNo, start=Offset, - type=Type, raw_data=Term}|Rest], Inserted, Acc) -> +slim_constmap([#pcm_entry{const_num = ConstNo, start = Offset, + type = Type, raw_data = Term}|Rest], Inserted, Acc) -> case gb_sets:is_member(ConstNo, Inserted) of true -> slim_constmap(Rest, Inserted, Acc); @@ -209,3 +226,60 @@ slim_constmap([#pcm_entry{const_num=ConstNo, start=Offset, slim_constmap(Rest, NewInserted, [ConstNo, Offset, Type, Term|Acc]) end; slim_constmap([], _Inserted, Acc) -> Acc. + +%% +%% Lookup a constant in a ConstMap. +%% +-spec find_const({mfa(), hipe_constlbl()}, packed_const_map()) -> const_num(). + +find_const({MFA, Label}, [E = #pcm_entry{mfa = MFA, label = Label}|_]) -> + E#pcm_entry.const_num; +find_const(N, [_|R]) -> + find_const(N, R); +find_const(C, []) -> + ?EXIT({constant_not_found, C}). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% +%% Functions to build and handle Refs, ExportMap and LabelMap. +%% Note: Moved here because they are used by all backends in +%% hipe_{arm,sparc,ppc,x86}_assemble.erl +%% XXX: Is this the right place for them? +%% + +-spec mk_data_relocs(mfa_refs_map(), label_map()) -> data_relocs(). + +mk_data_relocs(RefsFromConsts, LabelMap) -> + lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])). + +mk_data_relocs([{MFA, Labels} | Rest], LabelMap, Acc) -> + Map = [case Label of + {L,Pos} -> + Offset = find({MFA,L}, LabelMap), + {Pos,Offset}; + {sorted,Base,OrderedLabels} -> + {sorted, Base, [begin + Offset = find({MFA,L}, LabelMap), + {Order, Offset} + end + || {L,Order} <- OrderedLabels]} + end + || Label <- Labels], + %% msg("Map: ~w Map\n", [Map]), + mk_data_relocs(Rest, LabelMap, [Map,Acc]); +mk_data_relocs([], _, Acc) -> Acc. + +find({MFA,L}, LabelMap) -> + gb_trees:get({MFA,L}, LabelMap). + +-spec slim_sorted_exportmap(export_map(), [mfa()], [fa()]) -> slim_export_map(). + +slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) -> + IsClosure = lists:member({M,F,A}, Closures), + IsExported = is_exported(F, A, Exports), + [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)]; +slim_sorted_exportmap([], _, _) -> []. + +is_exported(F, A, Exports) -> + lists:member({F,A}, Exports). diff --git a/lib/hipe/ppc/hipe_ppc_assemble.erl b/lib/hipe/ppc/hipe_ppc_assemble.erl index b2fd50517b..3ad91f4051 100644 --- a/lib/hipe/ppc/hipe_ppc_assemble.erl +++ b/lib/hipe/ppc/hipe_ppc_assemble.erl @@ -46,8 +46,8 @@ assemble(CompiledCode, Closures, Exports, Options) -> print("Total num bytes=~w\n", [CodeSize], Options), %% SC = hipe_pack_constants:slim_constmap(ConstMap), - DataRelocs = mk_data_relocs(RefsFromConsts, LabelMap), - SSE = slim_sorted_exportmap(ExportMap,Closures,Exports), + DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), + SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap,Closures,Exports), SlimRefs = hipe_pack_constants:slim_refs(AccRefs), Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, ConstAlign, ConstSize, @@ -288,7 +288,7 @@ do_pseudo_li(I, MFA, ConstMap) -> %%% end, %%% {load_address, {Tag,untag_mfa_or_prim(MFAorPrim)}}; {Label,constant} -> - ConstNo = find_const({MFA,Label}, ConstMap), + ConstNo = hipe_pack_constants:find_const({MFA,Label}, ConstMap), {load_address, {constant,ConstNo}}; {Label,closure} -> {load_address, {closure,Label}}; @@ -574,37 +574,6 @@ mk_y(Pred, BD) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -mk_data_relocs(RefsFromConsts, LabelMap) -> - lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])). - -mk_data_relocs([{MFA,Labels} | Rest], LabelMap, Acc) -> - Map = [case Label of - {L,Pos} -> - Offset = find({MFA,L}, LabelMap), - {Pos,Offset}; - {sorted,Base,OrderedLabels} -> - {sorted, Base, [begin - Offset = find({MFA,L}, LabelMap), - {Order, Offset} - end - || {L,Order} <- OrderedLabels]} - end - || Label <- Labels], - %% msg("Map: ~w Map\n",[Map]), - mk_data_relocs(Rest, LabelMap, [Map,Acc]); -mk_data_relocs([],_,Acc) -> Acc. - -find({_MFA,_L} = MFAL,LabelMap) -> - gb_trees:get(MFAL, LabelMap). - -slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) -> - IsClosure = lists:member({M,F,A}, Closures), - IsExported = is_exported(F, A, Exports), - [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)]; -slim_sorted_exportmap([],_,_) -> []. - -is_exported(F, A, Exports) -> lists:member({F,A}, Exports). - %%% %%% Assembly listing support (pp_asm option). %%% @@ -642,14 +611,3 @@ fill_spaces(N) when N > 0 -> fill_spaces(N-1); fill_spaces(0) -> []. - -%%% -%%% Lookup a constant in a ConstMap. -%%% - -find_const({MFA,Label}, [{pcm_entry,MFA,Label,ConstNo,_,_,_}|_]) -> - ConstNo; -find_const(N, [_|R]) -> - find_const(N, R); -find_const(C, []) -> - ?EXIT({constant_not_found,C}). diff --git a/lib/hipe/regalloc/hipe_ls_regalloc.erl b/lib/hipe/regalloc/hipe_ls_regalloc.erl index 4276b8f968..7a00a0534a 100644 --- a/lib/hipe/regalloc/hipe_ls_regalloc.erl +++ b/lib/hipe/regalloc/hipe_ls_regalloc.erl @@ -722,7 +722,7 @@ is_free(R, Free) -> is_free(R, Free, []). is_free(R, [{R,_}|Rest], Acc) -> - {true,lists:reverse(Acc)++Rest}; + {true, lists:reverse(Acc, Rest)}; is_free(R, [X|Rs],Acc) -> is_free(R, Rs, [X|Acc]); is_free(_, [], _) -> @@ -733,7 +733,7 @@ exists_free_register(Start, Regs) -> exists_free_register(Start, [{Phys, Start0}|Rest], Acc) when Start > Start0 -> - {true, Phys, lists:reverse(Acc)++Rest}; + {true, Phys, lists:reverse(Acc, Rest)}; exists_free_register(Start, [Free|Rest], Acc) -> exists_free_register(Start, Rest, [Free|Acc]); exists_free_register(_, [], _) -> diff --git a/lib/hipe/regalloc/hipe_optimistic_regalloc.erl b/lib/hipe/regalloc/hipe_optimistic_regalloc.erl index 5bad31ade9..0278a896d2 100644 --- a/lib/hipe/regalloc/hipe_optimistic_regalloc.erl +++ b/lib/hipe/regalloc/hipe_optimistic_regalloc.erl @@ -958,9 +958,9 @@ splits_2({Cols, NonCols, OldSpillCost}, L, SpillCost) -> %% Merge two ordered sub-splits into one. spillCostOrderedMerge(Spl1, [], Spl) -> - lists:reverse(Spl) ++ Spl1; + lists:reverse(Spl, Spl1); spillCostOrderedMerge([], Spl2, Spl) -> - lists:reverse(Spl) ++ Spl2; + lists:reverse(Spl, Spl2); spillCostOrderedMerge(Spl1, Spl2, Spl) -> {_, _, SpillCost1} = hd(Spl1), {_, _, SpillCost2} = hd(Spl2), diff --git a/lib/hipe/rtl/hipe_icode2rtl.erl b/lib/hipe/rtl/hipe_icode2rtl.erl index 034153a3cb..6ab40adcc8 100644 --- a/lib/hipe/rtl/hipe_icode2rtl.erl +++ b/lib/hipe/rtl/hipe_icode2rtl.erl @@ -427,8 +427,6 @@ gen_type_test([X], Type, TrueLbl, FalseLbl, Pred, ConstTab) -> hipe_rtl:mk_branch(X, eq, TmpF, TrueLbl, FalseLbl, Pred)], ConstTab}; cons -> {hipe_tagscheme:test_cons(X, TrueLbl, FalseLbl, Pred), ConstTab}; - constant -> - {hipe_tagscheme:test_constant(X, TrueLbl, FalseLbl, Pred), ConstTab}; fixnum -> {hipe_tagscheme:test_fixnum(X, TrueLbl, FalseLbl, Pred), ConstTab}; float -> diff --git a/lib/hipe/rtl/hipe_rtl.erl b/lib/hipe/rtl/hipe_rtl.erl index 4bf4eb6bd7..bc61bec0bd 100644 --- a/lib/hipe/rtl/hipe_rtl.erl +++ b/lib/hipe/rtl/hipe_rtl.erl @@ -29,7 +29,7 @@ %% <li> {alu, Dst, Src1, Op, Src2} </li> %% <li> {alub, Dst, Src1, Op, Src2, RelOp, TrueLabel, FalseLabel, P} </li> %% <li> {branch, Src1, Src2, RelOp, TrueLabel, FalseLabel, P} </li> -%% <li> {call, DsListt, Fun, ArgList, Type, Continuation, FailContinuation} +%% <li> {call, DsListt, Fun, ArgList, Type, Continuation, FailContinuation, NormalContinuation} %% Type is one of {local, remote, primop, closure} </li> %% <li> {comment, Text} </li> %% <li> {enter, Fun, ArgList, Type} @@ -106,7 +106,7 @@ %% rtl_data_update/2, %% rtl_var_range/1, %% rtl_var_range_update/2, - %% rtl_label_range/1, + rtl_label_range/1, %% rtl_label_range_update/2, rtl_info/1, rtl_info_update/2]). @@ -226,6 +226,7 @@ %% goto_label_update/2, mk_call/6, + mk_call/7, call_fun/1, call_dstlist/1, call_dstlist_update/2, @@ -233,8 +234,10 @@ call_continuation/1, call_fail/1, call_type/1, + call_normal/1, + call_normal_update/2, %% call_continuation_update/2, - %% call_fail_update/2, + call_fail_update/2, is_call/1, mk_enter/3, @@ -290,10 +293,13 @@ %% fconv_src_update/2, %% is_fconv/1, - %% mk_var/1, + mk_var/1, + mk_var/2, mk_new_var/0, is_var/1, var_index/1, + var_liveness/1, + var_liveness_update/2, %% change_vars_to_regs/1, @@ -350,10 +356,15 @@ %% move_dst_update/2, fixnumop_dst_update/2, pp_instr/2, - %% pp_arg/2, + %% Uber hack! + pp_var/2, + pp_reg/2, + pp_arg/2, phi_arglist_update/2, phi_redirect_pred/3]). +-export([subst_uses_llvm/2]). + -export_type([alub_cond/0]). %% @@ -387,7 +398,7 @@ rtl_data(#rtl{data=Data}) -> Data. %% rtl_data_update(Rtl, Data) -> Rtl#rtl{data=Data}. %% rtl_var_range(#rtl{var_range=VarRange}) -> VarRange. %% rtl_var_range_update(Rtl, VarRange) -> Rtl#rtl{var_range=VarRange}. -%% rtl_label_range(#rtl{label_range=LabelRange}) -> LabelRange. +rtl_label_range(#rtl{label_range=LabelRange}) -> LabelRange. %% rtl_label_range_update(Rtl, LabelRange) -> Rtl#rtl{label_range=LabelRange}. rtl_info(#rtl{info=Info}) -> Info. rtl_info_update(Rtl, Info) -> Rtl#rtl{info=Info}. @@ -643,6 +654,17 @@ is_goto(_) -> false. %% call %% +%% LLVM: Call with normal continuation +mk_call(DstList, Fun, ArgList, Continuation, FailContinuation, + NormalContinuation, Type) -> + case Type of + remote -> ok; + not_remote -> ok + end, + #call{dstlist=DstList, 'fun'=Fun, arglist=ArgList, type=Type, + continuation=Continuation, failcontinuation=FailContinuation, + normalcontinuation=NormalContinuation}. + mk_call(DstList, Fun, ArgList, Continuation, FailContinuation, Type) -> case Type of remote -> ok; @@ -651,6 +673,10 @@ mk_call(DstList, Fun, ArgList, Continuation, FailContinuation, Type) -> #call{dstlist=DstList, 'fun'=Fun, arglist=ArgList, type=Type, continuation=Continuation, failcontinuation=FailContinuation}. + +call_normal(#call{normalcontinuation=NormalContinuation}) -> NormalContinuation. +call_normal_update(C, NewNormalContinuation) -> + C#call{normalcontinuation=NewNormalContinuation}. call_dstlist(#call{dstlist=DstList}) -> DstList. call_dstlist_update(C, NewDstList) -> C#call{dstlist=NewDstList}. call_fun(#call{'fun'=Fun}) -> Fun. @@ -853,11 +879,14 @@ reg_is_gcsafe(#rtl_reg{is_gc_safe=IsGcSafe}) -> IsGcSafe. is_reg(#rtl_reg{}) -> true; is_reg(_) -> false. --record(rtl_var, {index :: non_neg_integer()}). +-record(rtl_var, {index :: non_neg_integer(), liveness=live :: dead | live}). mk_var(Num) when is_integer(Num), Num >= 0 -> #rtl_var{index=Num}. +mk_var(Num, Liveness) when is_integer(Num), Num>=0 -> #rtl_var{index=Num, liveness=Liveness}. mk_new_var() -> mk_var(hipe_gensym:get_next_var(rtl)). var_index(#rtl_var{index=Index}) -> Index. +var_liveness(#rtl_var{liveness=Liveness}) -> Liveness. +var_liveness_update(RtlVar, Liveness) -> RtlVar#rtl_var{liveness=Liveness}. is_var(#rtl_var{}) -> true; is_var(_) -> false. @@ -1077,6 +1106,131 @@ subst_uses(Subst, I) -> switch_src_update(I, subst1(Subst, switch_src(I))) end. +subst_uses_llvm(Subst, I) -> + case I of + #alu{} -> + {NewSrc2, Subst1} = subst1_llvm(Subst, alu_src2(I)), + {NewSrc1, _ } = subst1_llvm(Subst1, alu_src1(I)), + I0 = alu_src1_update(I, NewSrc1), + alu_src2_update(I0, NewSrc2); + #alub{} -> + {NewSrc2, Subst1} = subst1_llvm(Subst, alub_src2(I)), + {NewSrc1, _ } = subst1_llvm(Subst1, alub_src1(I)), + I0 = alub_src1_update(I, NewSrc1), + alub_src2_update(I0, NewSrc2); + #branch{} -> + {NewSrc2, Subst1} = subst1_llvm(Subst, branch_src2(I)), + {NewSrc1, _ } = subst1_llvm(Subst1, branch_src1(I)), + I0 = branch_src1_update(I, NewSrc1), + branch_src2_update(I0, NewSrc2); + #call{} -> + case call_is_known(I) of + false -> + {NewFun, Subst1} = subst1_llvm(Subst, call_fun(I)), + {NewArgList, _} = subst_list_llvm(Subst1, call_arglist(I)), + I0 = call_fun_update(I, NewFun), + call_arglist_update(I0, NewArgList); + true -> + {NewArgList, _} = subst_list_llvm(Subst, call_arglist(I)), + call_arglist_update(I, NewArgList) + end; + #comment{} -> + I; + #enter{} -> + case enter_is_known(I) of + false -> + {NewFun, Subst1} = subst1_llvm(Subst, enter_fun(I)), + {NewArgList, _} = subst_list_llvm(Subst1, enter_arglist(I)), + I0 = enter_fun_update(I, NewFun), + enter_arglist_update(I0, NewArgList); + true -> + {NewArgList, _} = subst_list_llvm(Subst, enter_arglist(I)), + enter_arglist_update(I, NewArgList) + end; + #fconv{} -> + {NewSrc, _ } = subst1_llvm(Subst, fconv_src(I)), + fconv_src_update(I, NewSrc); + #fixnumop{} -> + {NewSrc, _ } = subst1_llvm(Subst, fixnumop_src(I)), + fixnumop_src_update(I, NewSrc); + #fload{} -> + {NewSrc, Subst1} = subst1_llvm(Subst, fload_src(I)), + {NewOffset, _ } = subst1_llvm(Subst1, fload_offset(I)), + I0 = fload_src_update(I, NewSrc), + fload_offset_update(I0, NewOffset); + #fmove{} -> + {NewSrc, _ } = subst1_llvm(Subst, fmove_src(I)), + fmove_src_update(I, NewSrc); + #fp{} -> + {NewSrc2, Subst1} = subst1_llvm(Subst, fp_src2(I)), + {NewSrc1, _ } = subst1_llvm(Subst1, fp_src1(I)), + I0 = fp_src1_update(I, NewSrc1), + fp_src2_update(I0, NewSrc2); + #fp_unop{} -> + {NewSrc, _ } = subst1_llvm(Subst, fp_unop_src(I)), + fp_unop_src_update(I, NewSrc); + #fstore{} -> + {NewSrc, Subst1} = subst1_llvm(Subst, fstore_src(I)), + {NewBase, Subst2} = subst1_llvm(Subst1, fstore_base(I)), + {NewOffset, _ } = subst1_llvm(Subst2, fstore_offset(I)), + I0 = fstore_src_update(I, NewSrc), + I1 = fstore_base_update(I0, NewBase), + fstore_offset_update(I1, NewOffset); + #goto{} -> + I; + #goto_index{} -> + I; + #gctest{} -> + {NewWords, _ } = subst1_llvm(Subst, gctest_words(I)), + gctest_words_update(I, NewWords); + #label{} -> + I; + #load{} -> + {NewSrc, Subst1} = subst1_llvm(Subst, load_src(I)), + {NewOffset, _ } = subst1_llvm(Subst1, load_offset(I)), + I0 = load_src_update(I, NewSrc), + load_offset_update(I0, NewOffset); + #load_address{} -> + I; + #load_atom{} -> + I; + #load_word_index{} -> + I; + #move{} -> + {NewSrc, _ } = subst1_llvm(Subst, move_src(I)), + move_src_update(I, NewSrc); + #multimove{} -> + {NewSrcList, _} = subst_list_llvm(Subst, multimove_srclist(I)), + multimove_srclist_update(I, NewSrcList); + #phi{} -> + phi_argvar_subst(I, Subst); + #return{} -> + {NewVarList, _} = subst_list_llvm(Subst, return_varlist(I)), + return_varlist_update(I, NewVarList); + #store{} -> + {NewSrc, Subst1} = subst1_llvm(Subst, store_src(I)), + {NewBase, Subst2} = subst1_llvm(Subst1, store_base(I)), + {NewOffset, _ } = subst1_llvm(Subst2, store_offset(I)), + I0 = store_src_update(I, NewSrc), + I1 = store_base_update(I0, NewBase), + store_offset_update(I1, NewOffset); + #switch{} -> + {NewSrc, _ } = subst1_llvm(Subst, switch_src(I)), + switch_src_update(I, NewSrc) + end. + +subst_list_llvm(S,X) -> subst_list_llvm(S, lists:reverse(X), []). +subst_list_llvm(S, [], Acc) -> {Acc, S}; +subst_list_llvm(S, [X|Xs], Acc) -> + {NewX, RestS} = subst1_llvm(S, X), + subst_list_llvm(RestS, Xs, [NewX|Acc]). + +subst1_llvm(A,B) -> subst1_llvm(A,B,[]). + +subst1_llvm([], X, Acc) -> {X, Acc}; +subst1_llvm([{X,Y}|Rs], X, Acc) -> {Y, Acc++Rs}; +subst1_llvm([R|Xs], X, Acc) -> subst1_llvm(Xs,X,[R|Acc]). + subst_defines(Subst, I)-> case I of #alu{} -> @@ -1614,7 +1768,11 @@ pp_var(Dev, Arg) -> true -> pp_hard_reg(Dev, var_index(Arg)); false -> - io:format(Dev, "v~w", [var_index(Arg)]) + io:format(Dev, "v~w", [var_index(Arg)]), + case var_liveness(Arg) of + dead -> io:format(Dev, "(dead)", []); + _ -> ok + end end. pp_arg(Dev, A) -> diff --git a/lib/hipe/rtl/hipe_rtl.hrl b/lib/hipe/rtl/hipe_rtl.hrl index 974e40f830..fbdf9ac524 100644 --- a/lib/hipe/rtl/hipe_rtl.hrl +++ b/lib/hipe/rtl/hipe_rtl.hrl @@ -28,7 +28,8 @@ -record(alu, {dst, src1, op, src2}). -record(alub, {dst, src1, op, src2, 'cond', true_label, false_label, p}). -record(branch, {src1, src2, 'cond', true_label, false_label, p}). --record(call, {dstlist, 'fun', arglist, type, continuation, failcontinuation}). +-record(call, {dstlist, 'fun', arglist, type, continuation, + failcontinuation, normalcontinuation = []}). -record(comment, {text}). -record(enter, {'fun', arglist, type}). -record(fconv, {dst, src}). diff --git a/lib/hipe/rtl/hipe_rtl_liveness.erl b/lib/hipe/rtl/hipe_rtl_liveness.erl index 3cfada9d6c..0c4b6b2e11 100644 --- a/lib/hipe/rtl/hipe_rtl_liveness.erl +++ b/lib/hipe/rtl/hipe_rtl_liveness.erl @@ -34,7 +34,8 @@ -module(hipe_rtl_liveness). -%% -define(LIVEOUT_NEEDED,true). % needed for liveness.inc below. +%% -define(DEBUG_LIVENESS,true). +-define(LIVEOUT_NEEDED,true). % needed for liveness.inc below. -define(PRETTY_PRINT,false). -include("hipe_rtl.hrl"). diff --git a/lib/hipe/rtl/hipe_tagscheme.erl b/lib/hipe/rtl/hipe_tagscheme.erl index f1e8d1ef41..4725889d8d 100644 --- a/lib/hipe/rtl/hipe_tagscheme.erl +++ b/lib/hipe/rtl/hipe_tagscheme.erl @@ -40,13 +40,12 @@ test_any_pid/4, test_any_port/4, test_ref/4, test_fun/4, test_fun2/5, test_matchstate/4, test_binary/4, test_bitstr/4, test_list/4, - test_integer/4, test_number/4, test_constant/4, test_tuple_N/5]). + test_integer/4, test_number/4, test_tuple_N/5]). -export([realtag_fixnum/2, tag_fixnum/2, realuntag_fixnum/2, untag_fixnum/2]). -export([test_two_fixnums/3, test_fixnums/4, unsafe_fixnum_add/3, unsafe_fixnum_sub/3, fixnum_gt/5, fixnum_lt/5, fixnum_ge/5, fixnum_le/5, fixnum_val/1, - fixnum_mul/4, - fixnum_addsub/5, fixnum_andorxor/4, fixnum_not/2, + fixnum_mul/4, fixnum_addsub/5, fixnum_andorxor/4, fixnum_not/2, fixnum_bsr/3, fixnum_bsl/3]). -export([unsafe_car/2, unsafe_cdr/2, unsafe_constant_element/3, unsafe_update_element/3, element/6]). @@ -405,17 +404,6 @@ test_number(X, TrueLab, FalseLab, Pred) -> hipe_rtl:mk_branch(Tmp, 'eq', hipe_rtl:mk_imm(HeaderFlonum), TrueLab, FalseLab, Pred)]. -%% CONS, NIL, and TUPLE are not constants, everything else is -test_constant(X, TrueLab, FalseLab, Pred) -> - Lab1 = hipe_rtl:mk_new_label(), - Lab2 = hipe_rtl:mk_new_label(), - Pred1 = 1-Pred, - [test_cons(X, FalseLab, hipe_rtl:label_name(Lab1), Pred1), - Lab1, - test_nil(X, FalseLab, hipe_rtl:label_name(Lab2), Pred1), - Lab2, - test_tuple(X, FalseLab, TrueLab, Pred1)]. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% tag_fixnum(DestVar, SrcReg) -> diff --git a/lib/hipe/sparc/hipe_sparc_assemble.erl b/lib/hipe/sparc/hipe_sparc_assemble.erl index b534fe20ec..68a4e1b349 100644 --- a/lib/hipe/sparc/hipe_sparc_assemble.erl +++ b/lib/hipe/sparc/hipe_sparc_assemble.erl @@ -45,8 +45,8 @@ assemble(CompiledCode, Closures, Exports, Options) -> print("Total num bytes=~w\n", [CodeSize], Options), %% SC = hipe_pack_constants:slim_constmap(ConstMap), - DataRelocs = mk_data_relocs(RefsFromConsts, LabelMap), - SSE = slim_sorted_exportmap(ExportMap,Closures,Exports), + DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), + SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap,Closures,Exports), SlimRefs = hipe_pack_constants:slim_refs(AccRefs), Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, ConstAlign, ConstSize, @@ -222,7 +222,7 @@ do_pseudo_set(I, MFA, ConstMap) -> %%% end, %%% {load_address, {Tag,untag_mfa_or_prim(MFAorPrim)}}; {Label,constant} -> - ConstNo = find_const({MFA,Label}, ConstMap), + ConstNo = hipe_pack_constants:find_const({MFA,Label}, ConstMap), {load_address, {constant,ConstNo}}; {Label,closure} -> {load_address, {closure,Label}}; @@ -507,37 +507,6 @@ px({pred,Pred}) -> % XXX: use pt/pn throughout entire backend %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -mk_data_relocs(RefsFromConsts, LabelMap) -> - lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])). - -mk_data_relocs([{MFA,Labels} | Rest], LabelMap, Acc) -> - Map = [case Label of - {L,Pos} -> - Offset = find({MFA,L}, LabelMap), - {Pos,Offset}; - {sorted,Base,OrderedLabels} -> - {sorted, Base, [begin - Offset = find({MFA,L}, LabelMap), - {Order, Offset} - end - || {L,Order} <- OrderedLabels]} - end - || Label <- Labels], - %% msg("Map: ~w Map\n",[Map]), - mk_data_relocs(Rest, LabelMap, [Map,Acc]); -mk_data_relocs([],_,Acc) -> Acc. - -find({_MFA,_L} = MFAL, LabelMap) -> - gb_trees:get(MFAL, LabelMap). - -slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) -> - IsClosure = lists:member({M,F,A}, Closures), - IsExported = is_exported(F, A, Exports), - [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)]; -slim_sorted_exportmap([],_,_) -> []. - -is_exported(F, A, Exports) -> lists:member({F,A}, Exports). - %%% %%% Assembly listing support (pp_asm option). %%% @@ -575,14 +544,3 @@ fill_spaces(N) when N > 0 -> fill_spaces(N-1); fill_spaces(0) -> []. - -%%% -%%% Lookup a constant in a ConstMap. -%%% - -find_const({MFA,Label},[{pcm_entry,MFA,Label,ConstNo,_,_,_}|_]) -> - ConstNo; -find_const(N,[_|R]) -> - find_const(N,R); -find_const(C,[]) -> - ?EXIT({constant_not_found,C}). diff --git a/lib/hipe/test/Makefile b/lib/hipe/test/Makefile index 19fa227912..cedb150b5d 100644 --- a/lib/hipe/test/Makefile +++ b/lib/hipe/test/Makefile @@ -13,7 +13,11 @@ ERL_FILES= $(MODULES:%=%.erl) TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) INSTALL_PROGS= $(TARGET_FILES) -EMAKEFILE=Emakefile +# ---------------------------------------------------- +# Files +# ---------------------------------------------------- +EMAKEFILE = Emakefile +AUXILIARY_FILES = hipe.spec hipe_testsuite_driver.erl $(EMAKEFILE) # ---------------------------------------------------- # Release directory specification @@ -56,10 +60,14 @@ include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt +release_docs_spec: + release_tests_spec: make_emakefile $(INSTALL_DIR) "$(RELSYSDIR)" - $(INSTALL_DATA) $(EMAKEFILE) $(ERL_FILES) "$(RELSYSDIR)" - $(INSTALL_DATA) hipe.spec "$(RELSYSDIR)" chmod -R u+w "$(RELSYSDIR)" - -release_docs_spec: + $(INSTALL_DATA) $(AUXILIARY_FILES) "$(RELSYSDIR)" + $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)" + @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) + cd "$(RELSYSDIR)";\ + erlc hipe_testsuite_driver.erl;\ + erl -noshell -run hipe_testsuite_driver create_all_suites -s erlang halt diff --git a/lib/hipe/test/bs_SUITE_data/bs_add.erl b/lib/hipe/test/bs_SUITE_data/bs_add.erl new file mode 100644 index 0000000000..af5a3b2f23 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_add.erl @@ -0,0 +1,18 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------- +%% The guard in f/3 revealed a problem in the translation of the 'bs_add' +%% BEAM instruction to Icode. The fail label was not properly translated. +%% Fixed 3/2/2011. +%%------------------------------------------------------------------------- +-module(bs_add). + +-export([test/0]). + +test() -> + 42 = f(<<12345:16>>, 4711, <<42>>), + ok. + +f(Bin, A, B) when <<A:9, B:7/binary>> == Bin -> + gazonk; +f(Bin, _, _) when is_binary(Bin) -> + 42. diff --git a/lib/hipe/test/bs_SUITE_data/bs_bincomp.erl b/lib/hipe/test/bs_SUITE_data/bs_bincomp.erl new file mode 100644 index 0000000000..082b83bab9 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_bincomp.erl @@ -0,0 +1,79 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_bincomp.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : Test bit comprehensions +%%% Created : 13 Sep 2006 +%%%------------------------------------------------------------------- +-module(bs_bincomp). + +-export([test/0]). + +test() -> + ok = byte_aligned(), + ok = bit_aligned(), + ok = extended_byte_aligned(), + ok = extended_bit_aligned(), + ok = mixed(), + ok. + +byte_aligned() -> + <<"abcdefg">> = << <<(X+32)>> || <<X>> <= <<"ABCDEFG">> >>, + <<1:32/little,2:32/little,3:32/little,4:32/little>> = + << <<X:32/little>> || <<X:32>> <= <<1:32,2:32,3:32,4:32>> >>, + <<1:32/little,2:32/little,3:32/little,4:32/little>> = + << <<X:32/little>> || <<X:16>> <= <<1:16,2:16,3:16,4:16>> >>, + ok. + +bit_aligned() -> + <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + << <<(X+32):7>> || <<X>> <= <<"ABCDEFG">> >>, + <<"ABCDEFG">> = + << <<(X-32)>> || <<X:7>> <= <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> >>, + <<1:31/little,2:31/little,3:31/little,4:31/little>> = + << <<X:31/little>> || <<X:31>> <= <<1:31,2:31,3:31,4:31>> >>, + <<1:31/little,2:31/little,3:31/little,4:31/little>> = + << <<X:31/little>> || <<X:15>> <= <<1:15,2:15,3:15,4:15>> >>, + ok. + +extended_byte_aligned() -> + <<"abcdefg">> = << <<(X+32)>> || X <- "ABCDEFG" >>, + "abcdefg" = [(X+32) || <<X>> <= <<"ABCDEFG">>], + <<1:32/little,2:32/little,3:32/little,4:32/little>> = + << <<X:32/little>> || X <- [1,2,3,4] >>, + [256,512,768,1024] = + [X || <<X:16/little>> <= <<1:16,2:16,3:16,4:16>>], + ok. + +extended_bit_aligned() -> + <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + << <<(X+32):7>> || X <- "ABCDEFG" >>, + "ABCDEFG" = [(X-32) || <<X:7>> <= <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>>], + <<1:31/little,2:31/little,3:31/little,4:31/little>> = + << <<X:31/little>> || X <- [1,2,3,4] >>, + [256,512,768,1024] = + [X || <<X:15/little>> <= <<1:15,2:15,3:15,4:15>>], + ok. + +mixed() -> + <<2,3,3,4,4,5,5,6>> = + << <<(X+Y)>> || <<X>> <= <<1,2,3,4>>, <<Y>> <= <<1,2>> >>, + <<2,3,3,4,4,5,5,6>> = + << <<(X+Y)>> || <<X>> <= <<1,2,3,4>>, Y <- [1,2] >>, + <<2,3,3,4,4,5,5,6>> = + << <<(X+Y)>> || X <- [1,2,3,4], Y <- [1,2] >>, + [2,3,3,4,4,5,5,6] = + [(X+Y) || <<X>> <= <<1,2,3,4>>, <<Y>> <= <<1,2>>], + [2,3,3,4,4,5,5,6] = + [(X+Y) || <<X>> <= <<1,2,3,4>>, Y <- [1,2]], + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + << <<(X+Y):3>> || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, <<Y:3>> <= <<1:3,2:3>> >>, + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + << <<(X+Y):3>> || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, Y <- [1,2] >>, + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + << <<(X+Y):3>> || X <- [1,2,3,4], Y <- [1,2] >>, + [2,3,3,4,4,5,5,6] = + [(X+Y) || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, <<Y:3>> <= <<1:3,2:3>>], + [2,3,3,4,4,5,5,6] = + [(X+Y) || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, Y <- [1,2]], + ok. diff --git a/lib/hipe/test/bs_SUITE_data/bs_bits.erl b/lib/hipe/test/bs_SUITE_data/bs_bits.erl new file mode 100644 index 0000000000..ef9a6bb137 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_bits.erl @@ -0,0 +1,150 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_bits.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : Tests for bit stream operations including matching, +%%% construction, binary_to_list and list_to_binary +%%% Created : 6 Sep 2006 +%%%------------------------------------------------------------------- +-module(bs_bits). + +-export([test/0]). + +test() -> + <<1:100>> = <<1:100>>, + ok = match(7), + ok = match(9), + ok = match1(15), + ok = match1(31), + ok = horrid_match(), + ok = test_bitstr(), + ok = test_is_bitstr(<<1:1>>,<<8>>), + ok = test_is_binary(<<1:1>>,<<8>>), + ok = test_bitsize(), + ok = asymmetric_tests(), + ok = big_asymmetric_tests(), + ok = bitstr_to_and_from_list(), + ok = big_bitstr_to_and_from_list(), + ok = send_and_receive(), + ok = send_and_receive_alot(), + ok. + +match(N) -> + <<0:N>> = <<0:N>>, + ok. + +match1(N) -> + <<42:N/little>> = <<42:N/little>>, + ok. + +test_is_bitstr(Bitstr, Binary) -> + true = is_bitstring(Bitstr), + true = is_bitstring(Binary), + ok = if is_bitstring(Bitstr) -> ok end, + ok = if is_bitstring(Binary) -> ok end. + +test_is_binary(Bitstr, Binary) -> + false = is_binary(Bitstr), + true = is_binary(Binary), + ok = if is_binary(Bitstr) -> not_ok; true -> ok end, + ok = if is_binary(Binary) -> ok end. + +test_bitsize() -> + 101 = erlang:bit_size(<<1:101>>), + 1001 = erlang:bit_size(<<1:1001>>), + 80 = erlang:bit_size(<<1:80>>), + 800 = erlang:bit_size(<<1:800>>), + Bin = <<0:16#1000000>>, + BigBin = list_to_bitstring([Bin||_ <- lists:seq(1,16#10)]++[<<1:1>>]), + 16#10000001 = bit_size(BigBin), + %% Only run these on computers with lots of memory + %% HugeBin = list_to_bitstring([BigBin||_ <- lists:seq(1,16#10)]++[<<1:1>>]), + %% 16#100000011 = bit_size(HugeBin), + 0 = erlang:bit_size(<<>>), + ok. + +horrid_match() -> + <<1:4,B:24/bitstring>> = <<1:4,42:24/little>>, + <<42:24/little>> = B, + ok. + +test_bitstr() -> + <<1:7,B/bitstring>> = <<1:7,<<1:1,6>>/bitstring>>, + <<1:1,6>> = B, + B = <<1:1,6>>, + ok. + +asymmetric_tests() -> + <<1:12>> = <<0,1:4>>, + <<0,1:4>> = <<1:12>>, + <<1:1,X/bitstring>> = <<128,255,0,0:2>>, + <<1,254,0,0:1>> = X, + X = <<1,254,0,0:1>>, + <<1:1,X1:25/bitstring>> = <<128,255,0,0:2>>, + <<1,254,0,0:1>> = X1, + X1 = <<1,254,0,0:1>>, + ok. + +big_asymmetric_tests() -> + <<1:875,1:12>> = <<1:875,0,1:4>>, + <<1:875,0,1:4>> = <<1:875,1:12>>, + <<1:1,X/bitstring>> = <<128,255,0,0:2,1:875>>, + <<1,254,0,0:1,1:875>> = X, + X = <<1,254,0,0:1,1:875>>, + <<1:1,X1:900/bitstring>> = <<128,255,0,0:2,1:875>>, + <<1,254,0,0:1,1:875>> = X1, + X1 = <<1,254,0,0:1,1:875>>, + ok. + +bitstr_to_and_from_list() -> + <<1:7>> = list_to_bitstring(bitstring_to_list(<<1:7>>)), + <<1,2,3,4,1:1>> = list_to_bitstring(bitstring_to_list(<<1,2,3,4,1:1>>)), + [1,2,3,4,<<1:1>>] = bitstring_to_list(<<1,2,3,4,1:1>>), + <<1:1,1,2,3,4>> = list_to_bitstring([<<1:1>>,1,2,3,4]), + [128,129,1,130,<<0:1>>] = bitstring_to_list(<<1:1,1,2,3,4>>), + ok. + +big_bitstr_to_and_from_list() -> + <<1:800,2,3,4,1:1>> = list_to_bitstring(bitstring_to_list(<<1:800,2,3,4,1:1>>)), + [1,2,3,4|_Rest1] = bitstring_to_list(<<1,2,3,4,1:800,1:1>>), + <<1:801,1,2,3,4>> = list_to_bitstring([<<1:801>>,1,2,3,4]), + ok. + +send_and_receive() -> + Bin = <<1,2:7>>, + Pid = spawn(fun() -> receiver(Bin) end), + Pid ! {self(),<<1:7,8:5,Bin/bitstring>>}, + receive + ok -> + ok + end. + +receiver(Bin) -> + receive + {Pid,<<1:7,8:5,Bin/bitstring>>} -> + Pid ! ok + end. + +send_and_receive_alot() -> + Bin = <<1:1000001>>, + Pid = spawn(fun() -> receiver_alot(Bin) end), + send_alot(100,Bin,Pid). + +send_alot(N,Bin,Pid) when N > 0 -> + Pid ! {self(),<<1:7,8:5,Bin/bitstring>>}, + receive + ok -> + ok + end, + send_alot(N-1,Bin,Pid); +send_alot(0,_Bin,Pid) -> + Pid ! no_more, + ok. + +receiver_alot(Bin) -> + receive + {Pid,<<1:7,8:5,Bin/bitstring>>} -> + Pid ! ok; + no_more -> ok + end, + receiver_alot(Bin). diff --git a/lib/hipe/test/bs_SUITE_data/bs_bitsize.erl b/lib/hipe/test/bs_SUITE_data/bs_bitsize.erl new file mode 100644 index 0000000000..c0774e7279 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_bitsize.erl @@ -0,0 +1,23 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------- +-module(bs_bitsize). + +-export([test/0]). + +test() -> + true = bitsize_in_body(<<1:42>>), + true = bitsize_in_guard(<<1:7>>), + 8 = constant_binary(42), + ok. + +bitsize_in_body(Bin) -> + 42 =:= erlang:bit_size(Bin). + +bitsize_in_guard(Bin) when erlang:bit_size(Bin) rem 7 =:= 0 -> + true; +bitsize_in_guard(Bin) when is_bitstring(Bin) -> + false. + +%% Tests that binary constants can properly be treated in Icode +constant_binary(N) when N > 0 -> + bit_size(<<42>>). diff --git a/lib/hipe/test/bs_SUITE_data/bs_bugs_R08.erl b/lib/hipe/test/bs_SUITE_data/bs_bugs_R08.erl new file mode 100644 index 0000000000..7b62a17cfb --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_bugs_R08.erl @@ -0,0 +1,32 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------- +%% When executing this in R8 (and compiled with R8) the result was +%% {ok,[148,129,0,0]} but should be {ok,[145,148,113,129,0,0,0,0]} +%% Thanks to Kenneth Lundin for sending this to us. +%%------------------------------------------------------------------- + +-module(bs_bugs_R08). + +-export([test/0]). + +test() -> + List = [145,148,113,129,0,0,0,0], + {ok, List} = msisdn_internal_storage(<<145,148,113,129,0,0,0,0>>, []), + ok. + +%% msisdn_internal_storage/3 +%% Convert MSISDN binary to internal datatype (TBCD-octet list) + +msisdn_internal_storage(<<>>, MSISDN) -> + {ok, lists:reverse(MSISDN)}; +msisdn_internal_storage(<<2#11111111:8,_Rest/binary>>, MSISDN) -> + {ok, lists:reverse(MSISDN)}; +msisdn_internal_storage(<<2#1111:4,DigitN:4,_Rest/binary>>, MSISDN) when + DigitN < 10 -> + {ok, lists:reverse([(DigitN bor 2#11110000)|MSISDN])}; +msisdn_internal_storage(<<DigitNplus1:4,DigitN:4,Rest/binary>>, MSISDN) when + DigitNplus1 < 10, DigitN < 10 -> + NewMSISDN = [((DigitNplus1 bsl 4) bor DigitN)|MSISDN], + msisdn_internal_storage(Rest, NewMSISDN); +msisdn_internal_storage(_Rest, _MSISDN) -> + {fault}. %% Mandatory IE incorrect diff --git a/lib/hipe/test/bs_SUITE_data/bs_bugs_R09.erl b/lib/hipe/test/bs_SUITE_data/bs_bugs_R09.erl new file mode 100644 index 0000000000..670f2a08bb --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_bugs_R09.erl @@ -0,0 +1,35 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +%% Date: Mon, 7 Jun 2004 13:07:39 +0300 +%% From: Einar Karttunen +%% To: Erlang ML <[email protected]> +%% Subject: Apparent binary matching bug with native compilation +%% +%% It seems that there is a problem with binary matching when +%% compiling native code. A length prefixed field matches one +%% byte too short in the native case. +%% +%% The test module works when compiled with no options, but +%% crashes with case_clause when compiled with [native]. +%% This has been confirmed with R9C-0 and hipe snapshot 5/4/2004. +%%-------------------------------------------------------------------- + +-module(bs_bugs_R09). + +-export([test/0]). + +test() -> + ["rei",".",[]] = pp(<<3,$r,$e,$i,0>>), + ok. + +pp(Bin) -> + %% io:format("PP with ~p~n", [Bin]), + case Bin of + <<>> -> + ["."]; + <<_:2, Len:6, Part:Len/binary>> -> + [binary_to_list(Part)]; + <<_:2, Len:6, Part:Len/binary, Rest/binary>> -> + %% io:format("Len ~p Part ~p Rest ~p~n", [Len,Part,Rest]), + [binary_to_list(Part), "." | pp(Rest)] + end. diff --git a/lib/hipe/test/bs_SUITE_data/bs_bugs_R12.erl b/lib/hipe/test/bs_SUITE_data/bs_bugs_R12.erl new file mode 100644 index 0000000000..43ee9eb85b --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_bugs_R12.erl @@ -0,0 +1,133 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +%% Contains three cases of bugs that were reported for R12B +%%-------------------------------------------------------------------- +-module(bs_bugs_R12). + +-export([test/0]). + +test() -> + ok = test_beam_bug(), + ok = test_v3_codegen(), + ok = test_hipe_bug(), + ok. + +%%-------------------------------- +%% First test case: a bug in BEAM +%%-------------------------------- +test_beam_bug() -> + lists:foreach(fun (_) -> ok = run(100) end, [1,2,3,4]). + +%% For testing - runs scanner N number of times with same input +run(N) -> + lists:foreach(fun(_) -> scan(<<"region:whatever">>, []) end, lists:seq(1, N)). + +scan(<<>>, TokAcc) -> + lists:reverse(['$thats_all_folks$' | TokAcc]); +scan(<<D, Z, Rest/binary>>, TokAcc) + when (D =:= $D orelse D =:= $d) and + ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) -> + scan(<<Z, Rest/binary>>, ['AND' | TokAcc]); +scan(<<D>>, TokAcc) when (D =:= $D) or (D =:= $d) -> + scan(<<>>, ['AND' | TokAcc]); +scan(<<N, Z, Rest/binary>>, TokAcc) + when (N =:= $N orelse N =:= $n) and + ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) -> + scan(<<Z, Rest/binary>>, ['NOT' | TokAcc]); +scan(<<C, Rest/binary>>, TokAcc) when (C >= $A) and (C =< $Z); + (C >= $a) and (C =< $z); + (C >= $0) and (C =< $9) -> + case Rest of + <<$:, R/binary>> -> + scan(R, [{'FIELD', C} | TokAcc]); + _ -> + scan(Rest, [{'KEYWORD', C} | TokAcc]) + end. + +%%--------------------------------------------------- +%% Second test case: an internal error in v3_codegen +%% Reported by Mateusz Berezecki on 19/1/2008 +%%--------------------------------------------------- +-define(S, {42, 4242, 4711}). +-define(R, <<90,164,116>>). + +test_v3_codegen() -> + _ = random:seed(?S), + B0 = gen_bit(120, <<>>), + B1 = set_bit(B0, 5), + B2 = clr_bit(B1, 5), + ?R = set_bit(B2, 5), + ok. + +gen_bit(0, Acc) -> Acc; +gen_bit(N, Acc) when is_integer(N), N > 0 -> + gen_bit(N-1, <<Acc/bits, (random:uniform(2)-1):1>>). + +%% sets bit K in the Bitmap +set_bit(<<_Start:32/unsigned-little-integer, Bitmap/bits>>, K) + when is_integer(K), 0 < K, K =< bit_size(Bitmap) -> + Before = K-1, + After = bit_size(Bitmap) - K, + <<BeforeBits:Before/bits, _:1, AfterBits:After/bits>> = Bitmap, + <<BeforeBits/bits, 1:1, AfterBits/bits>>. + +%% clears bit K in the Bitmap +clr_bit(<<_Start:32/unsigned-little-integer, Bitmap/bits>>, K) + when is_integer(K), 0 < K, K =< bit_size(Bitmap) -> + Before = K-1, + After = bit_size(Bitmap) - K, + <<BeforeBits:Before/bits, _:1, AfterBits:After/bits>> = Bitmap, + <<BeforeBits/bits, 0:1, AfterBits/bits>>. + +%%-------------------------------------------------------------------- +%% Third test case: a bug in HiPE +%% Reported by Steve Vinoski on 1/3/2008 +%% +%% Below find the results of compiling and running the example code at +%% the bottom of this message. Using "c" to compile gives the right +%% answer; using "hipe:c" gives the wrong answer. This is with R12B-1. +%% +%% Within the code, on the second instance of function check/2 you'll +%% find a commented-out guard. If you uncomment the guard, then the +%% code works correctly with both "c" and "hipe:c". +%%--------------------------------------------------------------------- + +test_hipe_bug() -> + String = "2006/10/02/Linux-Journal", + Binary = list_to_binary(String), + StringToMatch = "200x/" ++ String ++ " ", + BinaryToMatch = list_to_binary(StringToMatch), + {ok, Binary} = match(BinaryToMatch), + ok. + +match(<<>>) -> + nomatch; +match(Bin) -> + <<Front:16/binary, Tail/binary>> = Bin, + case Front of + <<_:3/binary,"x/",Y:4/binary,$/,M:2/binary,$/,D:2/binary,$/>> -> + case check(Tail) of + {ok, Match} -> + {ok, <<Y/binary,$/,M/binary,$/,D/binary,$/,Match/binary>>}; + {nomatch, Skip} -> + {skip, Skip+size(Front)}; + _ -> + wrong_answer + end; + _ -> + nomatch + end. + +check(Bin) -> + check(Bin, 0). +check(<<$ , _/binary>>, 0) -> + {nomatch, 0}; +check(Bin, Len) -> %when Len < size(Bin) -> + case Bin of + <<Front:Len/binary, $ , _/binary>> -> + {ok, Front}; + <<_:Len/binary, $., _/binary>> -> + {nomatch, Len}; + _ -> + check(Bin, Len+1) + end. diff --git a/lib/hipe/test/bs_SUITE_data/bs_build.erl b/lib/hipe/test/bs_SUITE_data/bs_build.erl new file mode 100644 index 0000000000..256cea9403 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_build.erl @@ -0,0 +1,41 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_build.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : +%%% +%%% Created : 12 Sep 2007 +%%%------------------------------------------------------------------- +-module(bs_build). + +-export([test/0]). + +test() -> + <<0,1,2,3,4,5,6>> = Bin = << <<X>> || X <- lists:seq(0, 6)>>, + test(Bin). + +test(Bin) -> + <<0,1,2,3,4,5,6,0,1,2,3,4,5,6>> = RealBin = multiply(Bin, 2), + <<6,5,4,3,2,1,0,6,5,4,3,2,1,0>> = reverse(RealBin), + RealBin = copy(RealBin), + RealBin = bc(RealBin), + ok. + +multiply(Bin, 1) -> + Bin; +multiply(Bin, N) when N > 0 -> + <<(multiply(Bin, N-1))/binary, Bin/binary>>. + +bc(Bin) -> + << <<X>> || <<X>> <= Bin >>. + +reverse(<<X, Rest/binary>>) -> + <<(reverse(Rest))/binary, X>>; +reverse(<<>>) -> <<>>. + +copy(Bin) -> + copy(Bin, <<>>). + +copy(<<X, Rest/binary>>, Bin) -> + copy(Rest, <<Bin/binary, X>>); +copy(<<>>, Bin) -> Bin. diff --git a/lib/hipe/test/bs_SUITE_data/bs_catch_bug.erl b/lib/hipe/test/bs_SUITE_data/bs_catch_bug.erl new file mode 100644 index 0000000000..6125f8f87f --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_catch_bug.erl @@ -0,0 +1,25 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_catch_bug.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : Tests a catch-related bug which might destroy properties +%%% of ICode CFGs which are assumed by the subsequent ICode +%%% binary pass. +%%% Created : 22 Jan 2004 +%%% ------------------------------------------------------------------- +-module(bs_catch_bug). + +-export([test/0]). + +test() -> + test(foo, <<>>). + +%% Introduced auxiliary test/2 function so that constant propagation +%% does not destroy the properties of the test. - Kostis 26/1/2004 +test(X, Bin) -> + catch (<<_/binary>> = X), + X = case Bin of + <<42,_/binary>> -> weird_bs_match; + _ -> X + end, + ok. diff --git a/lib/hipe/test/bs_SUITE_data/bs_checksum.erl b/lib/hipe/test/bs_SUITE_data/bs_checksum.erl new file mode 100644 index 0000000000..ca4f254f12 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_checksum.erl @@ -0,0 +1,35 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +%% Code from Zoltan Toth that crashed the HiPE compiler (in R11B-3). +%% The problem was that the binary matching produces a pretty large +%% integer and we tried to find the range for this integer in a bad way. +%% Fixed on the same day -- 6th March 2007. +%%-------------------------------------------------------------------- + +-module(bs_checksum). + +-export([test/0]). + +test() -> + "3389DAE361AF79B04C9C8E7057F60CC6" = checksum(<<42>>), + ok. + +checksum(Bin) -> + Context = erlang:md5_init(), + checksum(Context, Bin). + +checksum(Context, <<>>) -> + bin_to_hex(erlang:md5_final(Context)); +checksum(Context, <<Bin:20480/binary,Rest/binary>>) -> + checksum(erlang:md5_update(Context, Bin), Rest); +checksum(Context,Bin) -> + checksum(erlang:md5_update(Context, Bin), <<>>). + +bin_to_hex(Bin) -> + lists:flatten([byte_to_hex(X) || X <- binary_to_list(Bin)]). + +byte_to_hex(Byte) -> + [int_to_hex(Byte div 16), int_to_hex(Byte rem 16)]. + +int_to_hex(Int) when Int < 10 -> $0 + Int; +int_to_hex(Int) when Int > 9 -> $A + Int - 10. diff --git a/lib/hipe/test/bs_SUITE_data/bs_construct.erl b/lib/hipe/test/bs_SUITE_data/bs_construct.erl new file mode 100644 index 0000000000..9cc9ac848c --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_construct.erl @@ -0,0 +1,128 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +%% Tests that basic cases of binary construction work +%%-------------------------------------------------------------------- +-module(bs_construct). + +-export([test/0]). + +test() -> + <<42>> = sz(8), + <<42:8/little>> = sz_little(8), + <<55>> = take_five(1, 3, 1, 7, 4), + ok = bs5(), + 16#10000008 = bit_size(large_bin(1, 2, 3, 4)), + ok = bad_ones(), + ok. + +%%-------------------------------------------------------------------- +%% Taken from a bug report submitted by Dan Wallin (24 Oct 2003), the +%% following cases test construction of binaries whose segments have +%% sizes that are statically unknown. + +sz(S) -> + <<42:S>>. + +sz_little(S) -> + <<42:S/little>>. + +take_five(A, Head, FB, C, Tail) -> + <<A:Head, FB:1, C:Tail>>. + +%%-------------------------------------------------------------------- + +bs5() -> + Const = mk_constant(), + Pairs = mk_pairs(), + true = are_same(Const, Pairs), + true = lists:all(fun ({B, L}) -> binary_to_list(B) =:= L end, Pairs), + ok. + +are_same(C, L) -> + C =:= L. + +mk_constant() -> + [{<<213>>,[213]}, + {<<56>>,[56]}, + {<<1,2>>,[1,2]}, + {<<71>>,[71]}, + {<<8,1>>,[8,1]}, + {<<3,9>>,[3,9]}, + {<<9,3>>,[9,3]}, + {<<0,0,0,0>>,[0,0,0,0]}, + {<<62,0,0,0>>,[62,0,0,0]}, + {<<0,0,0,62>>,[0,0,0,62]}, + {<<138,99,0,147>>,[138,99,0,147]}, + {<<138,99,0,148>>,[138,99,0,148]}, + {<<147,0,99,138>>,[147,0,99,138]}, + {<<255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255>>, + [255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255]}, + {<<13>>,[13]}, + {<<0,4,0,5>>,[0,4,0,5]}, + {<<129>>,[129]}, + {<<129>>,[129]}, + {<<1,2>>,[1,2]}, + {<<1>>,[1]}, + {<<4,3,1>>,[4,3,1]}, + {<<47>>,[47]}, + {<<>>,[]}, + {<<97,112,97>>,[97,112,97]}, + {<<46,110,142,77,45,204,233>>,[46,110,142,77,45,204,233]}, + {<<>>,[]}]. + +mk_pairs() -> + L4 = [138,99,0,147], + [{<<-43>>,[256-43]}, + {<<56>>,[56]}, + {<<1,2>>,[1,2]}, + {<<4:4,7:4>>,[4*16+7]}, + {<<1:5,1:11>>,[1*8,1]}, + {<<777:16/big>>,[3,9]}, + {<<777:16/little>>,[9,3]}, + {<<0.0:32/float>>,[0,0,0,0]}, + {<<0.125:32/float>>,[62,0,0,0]}, + {<<0.125:32/little-float>>,[0,0,0,62]}, + {<<57285702734876389752897683:32>>,L4}, + {<<57285702734876389752897684:32>>,[138,99,0,148]}, + {<<57285702734876389752897683:32/little>>,lists:reverse(L4)}, + {<<-1:17/unit:8>>,lists:duplicate(17,255)}, + {<<13>>,[13]}, + {<<4:8/unit:2,5:2/unit:8>>,[0,4,0,5]}, + {<<1:1,0:6,1:1>>,[129]}, + {<<1:1/little,0:6/little,1:1/little>>,[129]}, + {<<<<1,2>>/binary>>,[1,2]}, + {<<<<1,2>>:1/binary>>,[1]}, + {<<4,3,<<1,2>>:1/binary>>,[4,3,1]}, + {<<(256*45+47)>>,[47]}, + {<<57:0>>,[]}, + {<<"apa">>,"apa"}, + {<<1:3,"string",9:5>>,[46,110,142,77,45,204,233]}, + {<<>>,[]}]. + +%%-------------------------------------------------------------------- +%% Constructs a big enough binary to have a bit size that needs a +%% bignum on 32-bit architectures + +large_bin(X1, X2, X3, X4) -> + Sz = 16#4000000, + <<1, <<X1:Sz, X2:Sz, X3:Sz, X4:Sz>>/bits>>. + +%%-------------------------------------------------------------------- +%% Test construction of "bad" binaries + +-define(FAIL(Expr), {'EXIT', {badarg, _}} = (catch Expr)). + +bad_ones() -> + PI = math:pi(), + ?FAIL(<<PI>>), + Bin12 = <<1,2>>, + ?FAIL(<<Bin12>>), + E = 2.71, + ?FAIL(<<E/binary>>), + Int = 24334, + ?FAIL(<<Int/binary>>), + BigInt = 24334344294788947129487129487219847, + ?FAIL(<<BigInt/binary>>), + Bin123 = <<1,2,3>>, + ?FAIL(<<Bin123/float>>), + ok. diff --git a/lib/hipe/test/bs_SUITE_data/bs_decode.erl b/lib/hipe/test/bs_SUITE_data/bs_decode.erl new file mode 100644 index 0000000000..d12654a1e3 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_decode.erl @@ -0,0 +1,980 @@ +%% -*- erlang-indent-level: 2 -*- + +-module(bs_decode). + +-export([test/0]). + +-include("bs_decode_extract.hrl"). + +-define(PDU, <<30,16,0,90,0,1,0,0,255,255,255,255,81,67,101,7,0,0,0,96, + 6,12,146,18,14,0,15,252,16,0,0,17,0,0,128,0,2,241,33,131, + 0,20,7,97,112,110,48,49,51,97,8,101,114,105,99,115,115, + 111,110,2,115,101,132,0,20,128,192,35,16,1,5,0,16,5,117, + 115,101,114,53,5,112,97,115,115,53,133,0,4,172,28,12,1, + 133,0,4,172,28,12,3,134,0,8,145,148,113,129,0,0,0,0>>). + +-define(RES, {ok,{sesT_createReqV0, + {mvsgT_tid,{mvsgT_imsi,<<81,67,101,7,0,0,0,240>>},6}, + [81,67,101,7,0,0,0,96], + {sesT_qualityOfServiceV0,1,4,9,2,18}, + 0,subscribed,0,0, + {mvsgT_pdpAddressType,ietf_ipv4,[]}, + [<<"apn013a">>,<<"ericsson">>,<<"se">>], + {masT_protocolConfigOptions,[], + {masT_pap,true,1,5,"user5","pass5"}, + []}, + {mvsgT_ipAddress,ipv4,172,28,12,1,0,0,0,0}, + {mvsgT_ipAddress,ipv4,172,28,12,3,0,0,0,0}, + {mvsT_msisdn,<<145,148,113,129,0,0,0,0>>}}, + 1}). + +test() -> + ?RES = decode_v0_opt(42, ?PDU), + ok. + +decode_v0_opt(0, Pdu) -> + decode_gtpc_msg(Pdu); +decode_v0_opt(N, Pdu) -> + decode_gtpc_msg(Pdu), + decode_v0_opt(N-1, Pdu). + +%%% -------------------------------------------------------------- +%%% #3.1.2 DECODE GTP-C MESSAGE +%%% -------------------------------------------------------------- + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% Function : decode_gtpc_msg(GTP_C_Message)-> +%%% {ok,Request,ControlDataUs} | +%%% {fault,Cause,Request,ControlDataUs} +%%% +%%% Types : GTP_C_Message = binary(), GTP-C message from SGSN +%%% Request = record(), Containing decoded request +%%% ControlDataUS = record(), Containing header info +%%% Cause = integer(), Error code +%%% +%%% Description: This function decodes a binary GTP-C message and +%%% stores it in a record. Different records are used +%%% for different message types. +%%% +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +%%% Create PDP Context Request +%%% GTP97, SNN=0 +%%% (No SNDCP N-PDU number) +decode_gtpc_msg(<<0:3,_:4,0:1,16:8,_Length:16,SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + TID:8/binary-unit:8,InformationElements/binary>>) -> + Errors = #protocolErrors{}, + {ok,TID2} = tid_internal_storage(TID,[]), + EmptyCreateReq = #sesT_createReqV0{tid = TID2, + tidRaw = binary_to_list(TID)}, + case catch decode_ie_create(InformationElements,0,Errors,EmptyCreateReq) of + {ok,CreateReq} -> + {ok,CreateReq,SequenceNumber}; + {fault,Cause,CreateReq} -> + {fault,Cause,CreateReq,SequenceNumber}; + {'EXIT',_Reason} -> + {fault,193,EmptyCreateReq,SequenceNumber} + end; + +%%% Update PDP Context Request +%%% GTP97, SNN=0 +%%% (No SNDCP N-PDU number) +decode_gtpc_msg(<<0:3,_:4,0:1,18:8,_Length:16,SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + TID:8/binary-unit:8,InformationElements/binary>>) -> + io:format("hej", []), + Errors = #protocolErrors{}, + {ok,TID2}=tid_internal_storage(TID,[]), + EmptyUpdateReq=#sesT_updateReqV0{tid=TID2, + tidRaw=binary_to_list(TID)}, + case catch decode_ie_update(InformationElements,0,Errors, + EmptyUpdateReq) of + {ok,UpdateReq} -> + {ok,UpdateReq,SequenceNumber}; + {fault,Cause,UpdateReq} -> + {fault,Cause,UpdateReq,SequenceNumber}; + {'EXIT',Reason} -> + io:format("hej", []), + {fault,193,EmptyUpdateReq,SequenceNumber, Reason} + end; + +%%% Delete PDP Context Request +%%% GTP97, SNN=0 +%%% (No SNDCP N-PDU number) +decode_gtpc_msg(<<0:3,_:4,0:1,20:8,_Length:16,SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + TID:8/binary-unit:8,_InformationElements/binary>>) -> + {ok,TID2} = tid_internal_storage(TID,[]), + DeleteReq = #sesT_deleteReqV0{tid=TID2}, + {ok,DeleteReq,SequenceNumber}; + +%%% Delete PDP Context Response +%%% GTP97, SNN=0 +%%% (No SNDCP N-PDU number) +decode_gtpc_msg(<<0:3,_:4,0:1,21:8,_Length:16,SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + TID:8/binary-unit:8,InformationElements/binary>>) -> + {ok,TID2} = tid_internal_storage(TID,[]), + EmptyDeleteRes = #sesT_deleteResV0{tid=TID2}, + case catch decode_ie_delete_res(InformationElements,0,EmptyDeleteRes) of + {ok, DeleteRes} -> + {ok,DeleteRes,SequenceNumber}; + {fault,Cause,DeleteRes} -> + {fault,Cause,DeleteRes,SequenceNumber}; + {'EXIT',_Reason} -> + {fault,193,EmptyDeleteRes,SequenceNumber} + end; + +%%% Error handling +decode_gtpc_msg(_GTP_C_Message) -> + {fault}. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% decode_ie_create/4 +%%% Decode information elements for Create PDP Context Request + +%%% All elements decoded +decode_ie_create(<<>>,PresentIEs,Errors,CreateReq) -> + %% Check mandatory IE's + if + (PresentIEs band 16#77D) =/= 16#77D -> + {fault,202,CreateReq}; %Mandatory IE missing + true -> %OK + %% Check errors during decoding + case Errors of + #protocolErrors{invalidManIE=true} -> %Invalid mandatory IE + {fault,201,CreateReq}; %Mandatory IE incorrect + #protocolErrors{outOfSequence=true} -> %Out of sequence + {fault,193,CreateReq}; %Invalid message format + #protocolErrors{incorrectOptIE=true} -> %Incorrect optional IE + {fault,203,CreateReq}; %Optional IE incorrect + _ -> %OK + {ok,CreateReq} + end + end; + +%%% Quality of Service Profile, Mandatory +decode_ie_create(<<6:8,QoSElement:3/binary-unit:8,Rest/binary>>,PresentIEs, + Errors,CreateReq) -> + if + (PresentIEs band 16#00000001) =:= 16#00000001 -> %Repeated IE's, ignore + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000001 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + <<_:2,DelayClass:3,ReliabilityClass:3, + PeakThroughput:4,_:1,PrecedenceClass:3, + _:3,MeanThroughput:5>> = QoSElement, + QoS=#sesT_qualityOfServiceV0{delayClass=DelayClass, + reliabilityClass=ReliabilityClass, + peakThroughput=PeakThroughput, + precedenceClass=PrecedenceClass, + meanThroughput=MeanThroughput}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{qos=QoS}, + decode_ie_create(Rest,(PresentIEs bor 16#00000001), + UpdatedErrors,UpdatedCreateReq); + true -> %OK + <<_:2,DelayClass:3,ReliabilityClass:3, + PeakThroughput:4,_:1,PrecedenceClass:3, + _:3,MeanThroughput:5>> = QoSElement, + QoS=#sesT_qualityOfServiceV0{delayClass=DelayClass, + reliabilityClass=ReliabilityClass, + peakThroughput=PeakThroughput, + precedenceClass=PrecedenceClass, + meanThroughput=MeanThroughput}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{qos=QoS}, + decode_ie_create(Rest,(PresentIEs bor 16#00000001), + Errors,UpdatedCreateReq) + end; + +%%% Recovery, Optional +decode_ie_create(<<14:8,Recovery:8,Rest/binary>>, + PresentIEs,Errors,CreateReq) -> + if + (PresentIEs band 16#00000002) =:= 16#00000002 -> %Repeated IE, ignored + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000002 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{recovery=Recovery}, + decode_ie_create(Rest,(PresentIEs bor 16#00000002), + UpdatedErrors,UpdatedCreateReq); + true -> %OK + UpdatedCreateReq=CreateReq#sesT_createReqV0{recovery=Recovery}, + decode_ie_create(Rest,(PresentIEs bor 16#00000002),Errors, + UpdatedCreateReq) + end; + +%%% Selection mode, Mandatory +decode_ie_create(<<15:8,_:6,SelectionMode:2,Rest/binary>>,PresentIEs, + Errors,CreateReq) -> + if + (PresentIEs band 16#00000004) =:= 16#00000004 -> %Repeated IE, ignored + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000004 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{ + selMode=selection_mode_internal_storage(SelectionMode)}, + decode_ie_create(Rest,(PresentIEs bor 16#00000004), + UpdatedErrors,UpdatedCreateReq); + true -> %OK + UpdatedCreateReq=CreateReq#sesT_createReqV0{ + selMode=selection_mode_internal_storage(SelectionMode)}, + decode_ie_create(Rest,(PresentIEs bor 16#00000004),Errors, + UpdatedCreateReq) + end; + +%%% Flow Label Data I, Mandatory +decode_ie_create(<<16:8,FlowLabel:16,Rest/binary>>,PresentIEs,Errors,CreateReq) -> + if + (PresentIEs band 16#00000008) =:= 16#00000008 -> %Repeated IE, ignored + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000008 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{flowLblData=FlowLabel}, + decode_ie_create(Rest,(PresentIEs bor 16#00000008), + UpdatedErrors,UpdatedCreateReq); + true -> %OK + UpdatedCreateReq=CreateReq#sesT_createReqV0{flowLblData=FlowLabel}, + decode_ie_create(Rest,(PresentIEs bor 16#00000008),Errors, + UpdatedCreateReq) + end; + +%%% Flow Label Signalling, Mandatory +decode_ie_create(<<17:8,FlowLabel:16,Rest/binary>>,PresentIEs,Errors,CreateReq) -> + if + (PresentIEs band 16#00000010) =:= 16#00000010 -> %Repeated IE, ignored + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000010 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{flowLblSig=FlowLabel}, + decode_ie_create(Rest,(PresentIEs bor 16#00000010), + UpdatedErrors,UpdatedCreateReq); + true -> %OK + UpdatedCreateReq=CreateReq#sesT_createReqV0{flowLblSig=FlowLabel}, + decode_ie_create(Rest,(PresentIEs bor 16#00000010),Errors, + UpdatedCreateReq) + end; + +%%% End User Address, Mandatory +decode_ie_create(<<128:8,Length:16,More/binary>>,PresentIEs, + Errors,CreateReq) -> + <<PDPElement:Length/binary-unit:8,Rest/binary>> = More, + if + (PresentIEs band 16#00000020) =:= 16#00000020 -> %Repeated IE, ignore + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000020 -> %Out of sequence + case pdp_addr_internal_storage(PDPElement) of + {ok,PDPAddress} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{endUserAdd=PDPAddress}, + decode_ie_create(Rest,(PresentIEs bor 16#00000020), + UpdatedErrors,UpdatedCreateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true, + outOfSequence=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000020), + UpdatedErrors,CreateReq) + end; + true -> %OK + case pdp_addr_internal_storage(PDPElement) of + {ok,PDPAddress} -> + UpdatedCreateReq=CreateReq#sesT_createReqV0{endUserAdd=PDPAddress}, + decode_ie_create(Rest,(PresentIEs bor 16#00000020), + Errors,UpdatedCreateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000020), + UpdatedErrors,CreateReq) + end + end; + +%%% Access Point Name, Mandatory +decode_ie_create(<<131:8,Length:16,More/binary>>,PresentIEs, + Errors,CreateReq) -> + <<APNElement:Length/binary-unit:8,Rest/binary>> = More, + if + (PresentIEs band 16#00000040) =:= 16#00000040 -> %Repeated IE, ignore + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000040 -> %Out of sequence + case catch apn_internal_storage(APNElement,[]) of + {ok,APN} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{accPointName=APN}, + decode_ie_create(Rest,(PresentIEs bor 16#00000040), + UpdatedErrors,UpdatedCreateReq); + _ -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true, + invalidManIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000040), + UpdatedErrors,CreateReq) + end; + true -> %OK + case catch apn_internal_storage(APNElement,[]) of + {ok,APN} -> + UpdatedCreateReq=CreateReq#sesT_createReqV0{accPointName=APN}, + decode_ie_create(Rest,(PresentIEs bor 16#00000040), + Errors,UpdatedCreateReq); + _ -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000040), + UpdatedErrors,CreateReq) + end + end; + +%%% Protocol Configuration Options, Optional +decode_ie_create(<<132:8,Length:16,More/binary>>,PresentIEs,Errors,CreateReq) -> + <<ConfigurationElement:Length/binary-unit:8,Rest/binary>> = More, + if + (PresentIEs band 16#00000080) =:= 16#00000080 -> %Repeated IE, ignore + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000080 -> %Out of sequence + case catch pco_internal_storage(ConfigurationElement) of + {ok,PCO} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{protConOpt=PCO}, + decode_ie_create(Rest,(PresentIEs bor 16#00000080), + UpdatedErrors,UpdatedCreateReq); + _ -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true, + incorrectOptIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000080), + UpdatedErrors,CreateReq) + end; + true -> %OK + case catch pco_internal_storage(ConfigurationElement) of + {ok,PCO} -> + UpdatedCreateReq=CreateReq#sesT_createReqV0{protConOpt=PCO}, + decode_ie_create(Rest,(PresentIEs bor 16#00000080), + Errors,UpdatedCreateReq); + _ -> + UpdatedErrors=Errors#protocolErrors{incorrectOptIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000080), + UpdatedErrors,CreateReq) + end + end; + +%%% SGSN Address for signalling, Mandatory OR SGSN Address for user traffic, Mandatory +decode_ie_create(<<133:8,Length:16,More/binary>>,PresentIEs, + Errors,CreateReq) -> + <<AddressElement:Length/binary-unit:8,Rest/binary>> = More, + if + (PresentIEs band 16#00000300) =:= 16#00000300 -> %Repeated IE, ignore + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000200 -> %Out of sequence + if + (PresentIEs band 16#00000100) =:= 16#00000000 -> %Signalling + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{sgsnAddSig=GSNAddr}, + decode_ie_create(Rest,(PresentIEs bor 16#00000100), + UpdatedErrors,UpdatedCreateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true, + outOfSequence=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000100), + UpdatedErrors,CreateReq) + end; + true -> % User traffic + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{sgsnAddUser=GSNAddr}, + decode_ie_create(Rest,(PresentIEs bor 16#00000200), + UpdatedErrors,UpdatedCreateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true, + outOfSequence=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000200), + UpdatedErrors,CreateReq) + end + end; + PresentIEs < 16#00000100 -> %OK, SGSN Address for signalling + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedCreateReq=CreateReq#sesT_createReqV0{sgsnAddSig=GSNAddr}, + decode_ie_create(Rest,(PresentIEs bor 16#00000100), + Errors,UpdatedCreateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000100), + UpdatedErrors,CreateReq) + end; + true -> %OK, SGSN Address for user traffic + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedCreateReq=CreateReq#sesT_createReqV0{sgsnAddUser=GSNAddr}, + decode_ie_create(Rest,(PresentIEs bor 16#00000200), + Errors,UpdatedCreateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000200), + UpdatedErrors,CreateReq) + end + end; + +%%% MSISDN, Mandatory +decode_ie_create(<<134:8,Length:16,More/binary>>,PresentIEs, + Errors,CreateReq) -> + <<MSISDNElement:Length/binary-unit:8,Rest/binary>> = More, + if + (PresentIEs band 16#00000400) =:= 16#00000400 -> %Repeated IE, ignore + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000400 -> %Out of sequence + case msisdn_internal_storage(MSISDNElement,[]) of + {ok,MSISDN} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{msisdn=MSISDN}, + decode_ie_create(Rest,(PresentIEs bor 16#00000400), + UpdatedErrors,UpdatedCreateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true,invalidManIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000400), + UpdatedErrors,CreateReq) + end; + true -> %OK + UpdatedCreateReq=CreateReq#sesT_createReqV0{msisdn=#mvsT_msisdn{value=MSISDNElement}}, + decode_ie_create(Rest,(PresentIEs bor 16#00000400), + Errors,UpdatedCreateReq) + + end; + +%%% Private Extension, Optional +%%% Not implemented + +%%% Error handling, Unexpected or unknown IE +decode_ie_create(UnexpectedIE,PresentIEs,Errors,CreateReq) -> + case check_ie(UnexpectedIE) of + {defined_ie,Rest} -> %OK, ignored + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + {handled_ie,Rest} -> %OK, ignored + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + {unhandled_ie} -> %Error, abort decoding + {fault,193,CreateReq} %Invalid message format + end. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% decode_ie_update/4 +%%% Decode information elements for Update PDP Context Request + +%%% All elements decoded +decode_ie_update(<<>>,PresentIEs,Errors,UpdateReq) -> + %% Check mandatory IE's + if + (PresentIEs band 16#3D) =/= 16#3D -> + {fault,202,UpdateReq}; %Mandatory IE missing + true -> %OK + %% Check errors during decoding + case Errors of + #protocolErrors{invalidManIE=true} -> %Invalid mandatory IE + {fault,201,UpdateReq}; %Mandatory IE incorrect + #protocolErrors{outOfSequence=true} -> %Out of sequence + {fault,193,UpdateReq}; %Invalid message format + _ -> %OK + {ok,UpdateReq} + end + end; + +%%% Quality of Service Profile, Mandatory +decode_ie_update(<<6:8,QoSElement:3/binary-unit:8,Rest/binary>>,PresentIEs, + Errors,UpdateReq) -> + if + (PresentIEs band 16#00000001) =:= 16#00000001 -> %Repeated IE's, ignore + decode_ie_update(Rest,PresentIEs,Errors,UpdateReq); + PresentIEs > 16#00000001 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + <<_:2,DelayClass:3,ReliabilityClass:3, + PeakThroughput:4,_:1,PrecedenceClass:3, + _:3,MeanThroughput:5>> = QoSElement, + QoS=#sesT_qualityOfServiceV0{delayClass=DelayClass, + reliabilityClass=ReliabilityClass, + peakThroughput=PeakThroughput, + precedenceClass=PrecedenceClass, + meanThroughput=MeanThroughput}, + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{qos=QoS}, + decode_ie_update(Rest,(PresentIEs bor 16#00000001), + UpdatedErrors,UpdatedUpdateReq); + true -> %OK + <<_:2,DelayClass:3,ReliabilityClass:3, + PeakThroughput:4,_:1,PrecedenceClass:3, + _:3,MeanThroughput:5>> = QoSElement, + QoS=#sesT_qualityOfServiceV0{delayClass=DelayClass, + reliabilityClass=ReliabilityClass, + peakThroughput=PeakThroughput, + precedenceClass=PrecedenceClass, + meanThroughput=MeanThroughput}, + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{qos=QoS}, + decode_ie_update(Rest,(PresentIEs bor 16#00000001), + Errors,UpdatedUpdateReq) + end; + +%%% Recovery, Optional +decode_ie_update(<<14:8,Recovery:8,Rest/binary>>,PresentIEs,Errors,UpdateReq) -> + if + (PresentIEs band 16#00000002) =:= 16#00000002 -> %Repeated IE, ignored + decode_ie_update(Rest,PresentIEs,Errors,UpdateReq); + PresentIEs > 16#00000002 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{recovery=Recovery}, + decode_ie_update(Rest,(PresentIEs bor 16#00000002), + UpdatedErrors,UpdatedUpdateReq); + true -> %OK + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{recovery=Recovery}, + decode_ie_update(Rest,(PresentIEs bor 16#00000002),Errors, + UpdatedUpdateReq) + end; + +%%% Flow Label Data I, Mandatory +decode_ie_update(<<16:8,FlowLabel:16,Rest/binary>>,PresentIEs,Errors,UpdateReq) -> + if + (PresentIEs band 16#00000004) =:= 16#00000004 -> %Repeated IE, ignored + decode_ie_update(Rest,PresentIEs,Errors,UpdateReq); + PresentIEs > 16#00000004 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{flowLblData=FlowLabel}, + decode_ie_update(Rest,(PresentIEs bor 16#00000004), + UpdatedErrors,UpdatedUpdateReq); + true -> %OK + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{flowLblData=FlowLabel}, + decode_ie_update(Rest,(PresentIEs bor 16#00000004),Errors, + UpdatedUpdateReq) + end; + +%%% Flow Label Signalling, Mandatory +decode_ie_update(<<17:8,FlowLabel:16,Rest/binary>>,PresentIEs,Errors,UpdateReq) -> + if + (PresentIEs band 16#00000008) =:= 16#00000008 -> %Repeated IE, ignored + decode_ie_update(Rest,PresentIEs,Errors,UpdateReq); + PresentIEs > 16#00000008 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{flowLblSig=FlowLabel}, + decode_ie_update(Rest,(PresentIEs bor 16#00000008), + UpdatedErrors,UpdatedUpdateReq); + true -> %OK + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{flowLblSig=FlowLabel}, + decode_ie_update(Rest,(PresentIEs bor 16#00000008),Errors, + UpdatedUpdateReq) + end; + +%%% SGSN Address for signalling, Mandatory OR SGSN Address for user traffic, Mandatory +decode_ie_update(<<133:8,Length:16,More/binary>>,PresentIEs, + Errors,UpdateReq) -> + <<AddressElement:Length/binary-unit:8,Rest/binary>> = More, + if + (PresentIEs band 16#00000030) =:= 16#00000030 -> %Repeated IE, ignore + decode_ie_update(Rest,PresentIEs,Errors,UpdateReq); + PresentIEs > 16#00000020 -> %Out of sequence + if + (PresentIEs band 16#00000010) =:= 16#00000000 -> %Signalling + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{sgsnAddSig=GSNAddr}, + decode_ie_update(Rest,(PresentIEs bor 16#00000010), + UpdatedErrors,UpdatedUpdateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true, + outOfSequence=true}, + decode_ie_update(Rest,(PresentIEs bor 16#00000010), + UpdatedErrors,UpdateReq) + end; + true -> % User traffic + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{sgsnAddUser=GSNAddr}, + decode_ie_update(Rest,(PresentIEs bor 16#00000020), + UpdatedErrors,UpdatedUpdateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true, + outOfSequence=true}, + decode_ie_update(Rest,(PresentIEs bor 16#00000020), + UpdatedErrors,UpdateReq) + end + end; + PresentIEs < 16#00000010 -> %OK, SGSN Address for signalling + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{sgsnAddSig=GSNAddr}, + decode_ie_update(Rest,(PresentIEs bor 16#00000010), + Errors,UpdatedUpdateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true}, + decode_ie_update(Rest,(PresentIEs bor 16#00000010), + UpdatedErrors,UpdateReq) + end; + true -> %OK, SGSN Address for user traffic + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{sgsnAddUser=GSNAddr}, + decode_ie_update(Rest,(PresentIEs bor 16#00000020), + Errors,UpdatedUpdateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true}, + decode_ie_update(Rest,(PresentIEs bor 16#00000020), + UpdatedErrors,UpdateReq) + end + end; + +%%% Private Extension, Optional +%%% Not implemented + +%%% Error handling, Unexpected or unknown IE +decode_ie_update(UnexpectedIE,PresentIEs,Errors,UpdateReq) -> + case check_ie(UnexpectedIE) of + {defined_ie,Rest} -> %OK, ignored + decode_ie_update(Rest,PresentIEs,Errors,UpdateReq); + {handled_ie,Rest} -> %OK, ignored + decode_ie_update(Rest,PresentIEs,Errors,UpdateReq); + {unhandled_ie} -> %Error, abort decoding + {fault,193,UpdateReq} %Invalid message format + end. + + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% decode_ie_delete_req/4 +%%% Decode information elements for Delete PDP Context Request + +%%% Private Extension, Optional +%%% Not implemented + + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% decode_ie_delete_res/4 +%%% Decode information elements for Delete PDP Context Response + +%%% All elements decoded +decode_ie_delete_res(<<>>,PresentIEs,DeleteRes) -> + %% Check mandatory IE's + if + (PresentIEs band 16#0001) =/= 16#0001 -> + {fault,202,DeleteRes}; %Mandatory IE missing + true -> %OK + {ok,DeleteRes} + end; + +%%% Cause, Mandatory +decode_ie_delete_res(<<1:8,Cause:8,Rest/binary>>,PresentIEs,DeleteRes) -> + if + (PresentIEs band 16#00000001) =:= 16#00000001 -> %Repeated IE, ignored + decode_ie_delete_res(Rest,PresentIEs,DeleteRes); + true -> %OK + UpdatedDeleteRes=DeleteRes#sesT_deleteResV0{cause=Cause}, + decode_ie_delete_res(Rest,(PresentIEs bor 16#00000001), + UpdatedDeleteRes) + end; + +%%% Private Extension, Optional +%%% Not implemented + +%%% Error handling, Unexpected or unknown IE +decode_ie_delete_res(UnexpectedIE,PresentIEs,DeleteRes) -> + case check_ie(UnexpectedIE) of + {defined_ie,Rest} -> %OK, ignored + decode_ie_delete_res(Rest,PresentIEs,DeleteRes); + {handled_ie,Rest} -> %OK, ignored + decode_ie_delete_res(Rest,PresentIEs,DeleteRes); + {unhandled_ie} -> %Error, abort decoding + {fault,193,DeleteRes} %Invalid message format + end. + +%%% -------------------------------------------------------------- +%%% #3.2 COMMON INTERNAL FUNCTIONS +%%% -------------------------------------------------------------- + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% check_ie/1 +%%% Check Information Element, Unexpected or Unknown +check_ie(<<1:8,_:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% IMSI +check_ie(<<2:8,_:8/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% RAI +check_ie(<<3:8,_:6/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% TTLI +check_ie(<<4:8,_:4/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% P-TMSI +check_ie(<<5:8,_:4/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Quality of Service Profile +check_ie(<<6:8,_:3/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Reordering Required +check_ie(<<8:8,_:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Authentication Triplet +check_ie(<<9:8,_:28/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% MAP Cause +check_ie(<<11:8,_:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% P-TMSI Signature +check_ie(<<12:8,_:3/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% MS Validated +check_ie(<<13:8,_:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Recovery +check_ie(<<14:8,_:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Selection Mode +check_ie(<<15:8,_:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Flow Label Data I +check_ie(<<16:8,_:16,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Flow Label Signalling +check_ie(<<17:8,_:16,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Flow Label Data II +check_ie(<<18:8,_:32,Rest/binary>>) -> + {defined_ie,Rest}; +%%% MS Not Reachable Reason +check_ie(<<19:8,_:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Charging ID +check_ie(<<127:8,_:4/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% TLV element, skipped using Length +check_ie(<<1:1,_:7,Length:16,More/binary>>) -> + if + Length > byte_size(More) -> + {unhandled_ie}; + true -> + <<_:Length/binary-unit:8,Rest/binary>> = More, + {handled_ie,Rest} + end; +%%% TV element, unknown size. Can not be handled. +check_ie(_UnhandledIE) -> + {unhandled_ie}. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% tid_internal_storage/3 +%%% Convert TID binary to internal datatype +tid_internal_storage(Bin,_) -> + Size = byte_size(Bin) - 1, + <<Front:Size/binary,NSAPI:4,DigitN:4>> = Bin, + Result = + case DigitN of + 2#1111 -> + #mvsgT_tid{imsi = #mvsgT_imsi{value = Front}, nsapi = NSAPI}; + _ -> + Value = <<Front/binary,2#1111:4,DigitN:4>>, + #mvsgT_tid{imsi = #mvsgT_imsi{value = Value}, nsapi = NSAPI} + end, + {ok,Result}. +%% tid_internal_storage(<<NSAPI:4,2#1111:4>>,IMSI) -> +%% {ok,#mvsgT_tid{imsi=#mvsgT_imsi{value=lists:reverse(IMSI)}, +%% nsapi=NSAPI}}; +%% tid_internal_storage(<<NSAPI:4,DigitN:4>>,IMSI) when +%% DigitN < 10 -> +%% {ok,#mvsgT_tid{imsi=#mvsgT_imsi{value=lists:reverse([(DigitN bor 2#11110000)|IMSI])}, +%% nsapi=NSAPI}}; +%% tid_internal_storage(<<2#11111111:8,Rest/binary>>,IMSI) -> +%% tid_internal_storage(Rest,IMSI); +%% tid_internal_storage(<<2#1111:4,DigitN:4,Rest/binary>>,IMSI) when +%% DigitN < 10 -> +%% tid_internal_storage(Rest,[(DigitN bor 2#11110000)|IMSI]); +%% tid_internal_storage(<<DigitNplus1:4,DigitN:4,Rest/binary>>,IMSI) when +%% DigitNplus1 < 10, +%% DigitN < 10 -> +%% tid_internal_storage(Rest,[((DigitNplus1 bsl 4) bor DigitN)|IMSI]); +%% tid_internal_storage(_Rest,_IMSI) -> +%% {fault}. %% Mandatory IE incorrect + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% selection_mode_internal_storage/1 +%%% Convert Selection Mode integer to internal datatype (enum) +selection_mode_internal_storage(0) -> + subscribed; +selection_mode_internal_storage(1) -> + msRequested; +selection_mode_internal_storage(2) -> + sgsnSelected; +selection_mode_internal_storage(3) -> + sgsnSelected. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% pdp_addr_internal_storage/1 +%%% Convert PDP address to internal datatype (record containing +%%% addresstype and value) +pdp_addr_internal_storage(<<_:4,0:4,1:8>>) -> + {ok,#mvsgT_pdpAddressType{pdpTypeNbr=etsi_ppp,address=[]}}; +pdp_addr_internal_storage(<<_:4,0:4,2:8>>) -> + {ok,#mvsgT_pdpAddressType{pdpTypeNbr=etsi_osp_ihoss,address=[]}}; +pdp_addr_internal_storage(<<_:4,1:4,16#21:8>>) -> + {ok,#mvsgT_pdpAddressType{pdpTypeNbr=ietf_ipv4,address=[]}}; +pdp_addr_internal_storage(<<_:4,1:4,16#21:8,IP_A:8,IP_B:8,IP_C:8,IP_D:8>>) -> + {ok,#mvsgT_pdpAddressType{pdpTypeNbr=ietf_ipv4, + address=[IP_A,IP_B,IP_C,IP_D]}}; +pdp_addr_internal_storage(<<_:4,1:4,16#57:8,IP_A:16,IP_B:16,IP_C:16,IP_D:16, + IP_E:16,IP_F:16,IP_G:16,IP_H:16>>) -> + {ok,#mvsgT_pdpAddressType{pdpTypeNbr=ietf_ipv6, + address=[IP_A,IP_B,IP_C,IP_D,IP_E,IP_F,IP_G,IP_H]}}; +pdp_addr_internal_storage(_PDP_ADDR) -> + {fault}. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% apn_internal_storage/2 +%%% Convert APN to internal datatype (List containing APN labels) +apn_internal_storage(<<>>,APN) -> + {ok,lists:reverse(APN)}; +apn_internal_storage(<<Length:8,Rest/binary>>,APN) -> + <<Label:Length/binary-unit:8,MoreAPNLabels/binary>> = Rest, + apn_internal_storage(MoreAPNLabels,[Label|APN]). + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% pco_internal_storage/1 +%%% Convert Protocol Configuration Options to internal datatype. +%%% Implemented configuration options: +%%% For PPP: +%%% LCP - Not implemented +%%% PAP - Authenticate request +%%% CHAP - Challenge +%%% - Response +%%% IPCP - IP-Address +%%% For OSP:IHOSS +%%% Nothing implemented +pco_internal_storage(<<1:1,_:4,0:3,PPPConfigurationOptions/binary>>) -> + case ppp_configuration_options(PPPConfigurationOptions, + #masT_pap{exists=false},[],[]) of + {ok,PAP,CHAP,IPCP} -> + {ok,#masT_protocolConfigOptions{pap=PAP,chap=CHAP,ipcp=IPCP}}; + {fault} -> + {fault} + end; +pco_internal_storage(<<1:1,_:4,1:3,_OSP_IHOSSConfigurationOptions/binary>>) -> + {ok,osp_ihoss}; +pco_internal_storage(_UnknownConfigurationOptions) -> + {fault}. %% Optional IE incorrect + +ppp_configuration_options(<<>>,PAP,CHAP,IPCP) -> + {ok,PAP,CHAP,IPCP}; +ppp_configuration_options(<<16#C021:16,Length:8,More/binary>>,PAP,CHAP,IPCP) -> + %% LCP - Not implemented + <<_LCP:Length/binary-unit:8,Rest/binary>> = More, + ppp_configuration_options(Rest,PAP,CHAP,IPCP); +ppp_configuration_options(<<16#C023:16,_Length:8,1:8,Identifier:8,DataLength:16, + More/binary>>,_PAP,CHAP,IPCP) -> + %% PAP - Authenticate request + ActualDataLength=DataLength-4, %% DataLength includes Code, Identifier and itself + <<Data:ActualDataLength/binary-unit:8,Rest/binary>> = More, + <<PeerIDLength:8,PeerData/binary>> = Data, + <<PeerID:PeerIDLength/binary-unit:8,PasswdLength:8,PasswordData/binary>> = PeerData, + <<Password:PasswdLength/binary,_Padding/binary>> = PasswordData, + ppp_configuration_options(Rest,#masT_pap{exists=true,code=1,id=Identifier, + username=binary_to_list(PeerID), + password=binary_to_list(Password)},CHAP,IPCP); + +ppp_configuration_options(<<16#C023:16,Length:8,More/binary>>,PAP,CHAP,IPCP) -> + %% PAP - Other, not implemented + <<_PAP:Length/binary-unit:8,Rest/binary>> = More, + ppp_configuration_options(Rest,PAP,CHAP,IPCP); +ppp_configuration_options(<<16#C223:16,_Length:8,1:8,Identifier:8,DataLength:16, + More/binary>>,PAP,CHAP,IPCP) -> + %% CHAP - Challenge + ActualDataLength=DataLength-4, %% DataLength includes Code, Identifier and itself + <<Data:ActualDataLength/binary-unit:8,Rest/binary>> = More, + <<ValueSize:8,ValueAndName/binary>> = Data, + <<Value:ValueSize/binary-unit:8,Name/binary>> = ValueAndName, + ppp_configuration_options(Rest,PAP,[#masT_chap{code=1,id=Identifier, + value=binary_to_list(Value), + name=binary_to_list(Name)}|CHAP], + IPCP); +ppp_configuration_options(<<16#C223:16,_Length:8,2:8,Identifier:8,DataLength:16, + More/binary>>,PAP,CHAP,IPCP) -> + %% CHAP - Response + ActualDataLength=DataLength-4, %% DataLength includes Code, Identifier and itself + <<Data:ActualDataLength/binary-unit:8,Rest/binary>> = More, + <<ValueSize:8,ValueAndName/binary>> = Data, + <<Value:ValueSize/binary-unit:8,Name/binary>> = ValueAndName, + ppp_configuration_options(Rest,PAP,[#masT_chap{code=2,id=Identifier, + value=binary_to_list(Value), + name=binary_to_list(Name)}|CHAP], + IPCP); +ppp_configuration_options(<<16#C223:16,Length:8,More/binary>>,PAP,CHAP,IPCP) -> + %% CHAP - Other, not implemented + <<_CHAP:Length/binary-unit:8,Rest/binary>> = More, + ppp_configuration_options(Rest,PAP,CHAP,IPCP); +ppp_configuration_options(<<16#8021:16,_Length:8,1:8,Identifier:8,OptionsLength:16, + More/binary>>,PAP,CHAP,IPCP) -> + %% IPCP - Configure request + ActualOptionsLength=OptionsLength-4, %% OptionsLength includes Code, Identifier and itself + <<Options:ActualOptionsLength/binary-unit:8,Rest/binary>> = More, + case Options of + <<3:8,6:8,A1:8,A2:8,A3:8,A4:8>> -> + %% IP Address, version 4 + ppp_configuration_options(Rest,PAP,CHAP, + [#masT_ipcp{exists=true,code=1, + id=Identifier, + ipcpList=[#masT_ipcpData{type=3,ipAddress= + #mvsgT_ipAddress{version=ipv4, + a1=A1,a2=A2, + a3=A3,a4=A4, + a5=0,a6=0, + a7=0,a8=0}, + rawMessage=binary_to_list(Options)}]}|IPCP]); + <<129:8,6:8,B1:8,B2:8,B3:8,B4:8>> -> + %% IP Address, version 4 + ppp_configuration_options(Rest,PAP,CHAP, + [#masT_ipcp{exists=true,code=1, + id=Identifier, + ipcpList=[#masT_ipcpData{type=129,ipAddress= + #mvsgT_ipAddress{version=ipv4, + a1=B1,a2=B2, + a3=B3,a4=B4}, + rawMessage=binary_to_list(Options)}]}|IPCP]); + + <<131:8,6:8,C1:8,C2:8,C3:8,C4:8>> -> + %% IP Address, version 4 + ppp_configuration_options(Rest,PAP,CHAP, + [#masT_ipcp{exists=true,code=1, + id=Identifier, + ipcpList=[#masT_ipcpData{type=131,ipAddress= + #mvsgT_ipAddress{version=ipv4, + a1=C1,a2=C2, + a3=C3,a4=C4}, + rawMessage=binary_to_list(Options)}]}|IPCP]); + _ -> + ppp_configuration_options(Rest,PAP,CHAP,IPCP) + end; +ppp_configuration_options(<<_UnknownProtocolID:16,Length:8,More/binary>>, + PAP,CHAP,IPCP) -> + <<_Skipped:Length/binary-unit:8,Rest/binary>> = More, + ppp_configuration_options(Rest,PAP,CHAP,IPCP); +ppp_configuration_options(_Unhandled,_PAP,_CHAP,_IPCP) -> + {fault}. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% gsn_addr_internal_storage/1 +%%% Convert GSN Address to internal datatype +gsn_addr_internal_storage(<<IP_A:8,IP_B:8,IP_C:8,IP_D:8>>) -> + {ok,#mvsgT_ipAddress{version=ipv4,a1=IP_A,a2=IP_B,a3=IP_C,a4=IP_D,a5=0,a6=0,a7=0,a8=0}}; +gsn_addr_internal_storage(<<IP_A:16,IP_B:16,IP_C:16,IP_D:16, + IP_E:16,IP_F:16,IP_G:16,IP_H:16>>) -> + {ok,#mvsgT_ipAddress{version=ipv6,a1=IP_A,a2=IP_B,a3=IP_C,a4=IP_D, + a5=IP_E,a6=IP_F,a7=IP_G,a8=IP_H}}; +gsn_addr_internal_storage(_GSN_ADDR) -> + {fault}. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% msisdn_internal_storage/3 +%%% Convert MSISDN binary to internal datatype (TBCD-octet list) + +msisdn_internal_storage(<<>>,MSISDN) -> + {ok,#mvsT_msisdn{value=lists:reverse(MSISDN)}}; +msisdn_internal_storage(<<2#11111111:8,_Rest/binary>>,MSISDN) -> + {ok,#mvsT_msisdn{value=lists:reverse(MSISDN)}}; +msisdn_internal_storage(<<2#1111:4,DigitN:4,_Rest/binary>>,MSISDN) when + DigitN < 10 -> + {ok,#mvsT_msisdn{value=lists:reverse([(DigitN bor 2#11110000)|MSISDN])}}; +msisdn_internal_storage(<<DigitNplus1:4,DigitN:4,Rest/binary>>,MSISDN) when + DigitNplus1 < 10, + DigitN < 10 -> + NewMSISDN=[((DigitNplus1 bsl 4) bor DigitN)|MSISDN], + msisdn_internal_storage(Rest,NewMSISDN); +msisdn_internal_storage(_Rest,_MSISDN) -> + {fault}. %% Mandatory IE incorrect diff --git a/lib/hipe/test/bs_SUITE_data/bs_decode_extract.hrl b/lib/hipe/test/bs_SUITE_data/bs_decode_extract.hrl new file mode 100644 index 0000000000..80add514a0 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_decode_extract.hrl @@ -0,0 +1,91 @@ +-ifndef(EXTDEC_HRL). +-define(EXTDEC_HRL, true). + +-record(protocolErrors,{ + invalidManIE=false, + outOfSequence=false, + incorrectOptIE=false}). +-record(mvsT_msisdn, {value}). +-record(mvsT_isdnAddress, {value}). +-record(mvsT_hlrAddress, {value}). +-record(mvsT_authenticationTriplet, {rand, sres, kc}). +-record(mvsT_authenticationQuintuplet, {rand, xres, ck, ik, autn}). +-record(mvsT_resynchInfo, {rand, auts}). +-record(mvsT_resynch, {label, value}). +-record(mvsT_storeImsiFault, {label, value}). +-record(mvsT_additionalImsisResults, {roamingStatus, defaultApnOperatorId, misc1, misc2, misc3}). +-record(mvsT_pdpActiveRecord, {contextId, nsapi, pdpTypeReq, pdpAddrReq, apnReq, qosReq, pdpTypeInUse, pdpAddressNature, pdpAddressInUse, apnInUse, ggsnAddrInUse, qosNegotiated}). +-record(mvsgT_rai, {mcc, mnc, lac, rac}). +-record(mvsgT_lai, {mcc, mnc, lac}). +-record(mvsgT_errorInd, {dummyElement}). +-record(mvsgT_deleteRes, {cause}). +-record(mvsgT_deleteReq, {dummyElement}). +-record(mvsgT_ptmsi, {value}). +-record(mvsgT_ddRef, {cid, extId, validity}). +-record(mvsgT_dpRef, {cid, devId}). +-record(mvsgT_qualityOfService, {delayClass, relClass, peakThrput, precClass, meanThrput}). +-record(mvsgT_pdpAddressType, {pdpTypeNbr, address}). +-record(mvsgT_msNetworkCapability, {gea1, smCapDediccatedChannel, smCapGprsChannel, ucs2Support, ssScreenInd}). +-record(mvsgT_cellId, {mcc, mnc, lac, rac, ci}). +-record(mvsgT_ipAddress, {version, a1, a2, a3, a4, a5, a6, a7, a8}). +-record(mvsgT_restartContextData, {gsn_address, restart_counter}). +-record(mvsgT_updateRes, {cause, qos, ggsnAddSig, ggsnAddUser, recovery, flowLabDataI, flowLabSig, chargId, optFlags}). +-record(mvsgT_updateReq, {qos, sgsnAddSig, sgsnAddUser, recovery, flowLabDataI, flowLabSig, otpFlags}). +-record(mvsgT_imsi, {value}). +-record(mvsgT_tid, {imsi, nsapi}). +-record(mvsgT_extQualityOfService, {allocRetention, trfClass, delOrder, delOfErrSDU, maxSDUSize, maxBRUp, maxBRDown, residualBER, sduErrorRatio, transferDelay, traffHandlPrio, guarBRUp, guarBRDown}). +-record(mvsgT_qualServ, {label, value}). +-record(sesT_gnDevContextData, {numberOfContext, recoveryInfoArray}). +-record(sesT_tid, {imsi, nsapi}). +-record(sesT_gnDevContextDataInfo, {dummy}). +-record(sesT_teid, {value}). +-record(sesT_qualityOfServiceV1, {allocRetPriority, delayClass, reliabilityClass, peakThroughput, precedenceClass, meanThroughput, trafficClass, deliveryOrder, delivOfErrSDU, maxSDUsize, maxBrUp, maxBrDown, residualBER, sduErrorRatio, transferDelay, trafficHandlPrio, guaranteedBrUp, guaranteedBrDown}). +-record(sesT_flowLbl, {value}). +-record(sesT_qualityOfServiceV0, {delayClass, reliabilityClass, peakThroughput, precedenceClass, meanThroughput}). +-record(sesT_createReq, {dummy}). +-record(sesT_createRes, {dummy}). +-record(sesT_deleteReq, {dummy}). +-record(sesT_deleteRes, {dummy}). +-record(sesT_gtid, {imsi, nsapi}). +-record(sesT_updateReq, {dummy}). +-record(sesT_updateRes, {dummy}). +-record(sesT_gcontrolDataUs, {gtpSeqNr, gsnAddress, gtunnelId, gsnPort}). +-record(sesT_gcontrolDataDs, {gtpSeqNr, gsnAddress, protocol, gtunnelId, flowLabSig, gsnPort}). +-record(sesT_createResV1, {cause, teidSignalling, teidData, ggsnAddSig, ggsnAddUser, reorderingReq, recovery, chargId, endUserAdd, optFlags, protConOpt, qos}). +-record(sesT_createReqV1, {qos, sgsnAddSig, sgsnAddUser, selMode, recovery, msisdn, endUserAdd, accPointName, optFlags, protConOpt, imsi, teidData, teidSignalling, nsapi}). +-record(sesT_deleteReqV1, {teardownInd, nsapi}). +-record(sesT_deleteResV1, {cause}). +-record(sesT_updateReqV1, {imsi, recovery, teidData, teidSignalling, nsapi, sgsnAddSig, sgsnAddUser, qos}). +-record(sesT_updateResV1, {cause, recovery, teidData, teidSignalling, chargId, ggsnAddSig, ggsnAddUser, qos}). +-record(sesT_deleteReqV0, {tid}). +-record(sesT_deleteResV0, {tid, cause}). +-record(sesT_createReqV0, {tid, tidRaw, qos, recovery, selMode, flowLblData, flowLblSig, endUserAdd, accPointName, protConOpt, sgsnAddSig, sgsnAddUser, msisdn}). +-record(sesT_createResV0, {tid, cause, qos, reorderingReq, recovery, flowLblData, flowLblSig, chargId, endUserAdd, protConOpt, ggsnAddSig, ggsnAddUser}). +-record(sesT_updateReqV0, {tid, tidRaw, qos, recovery, flowLblData, flowLblSig, sgsnAddSig, sgsnAddUser}). +-record(sesT_updateResV0, {tid, cause, qos, recovery, flowLblData, flowLblSig, chargId, ggsnAddSig, ggsnAddUser}). +-record(sesT_echoReq, {dummy}). +-record(sesT_echoRes, {dummy}). +-record(sesT_echoReqV1, {dummy}). +-record(sesT_echoResV1, {recovery}). +-record(sesT_echoReqV0, {dummy}). +-record(sesT_echoResV0, {recovery}). +-record(masT_apnSecurity, {sgsnSel, subscribedSel, userSel, ipSpoofing}). +-record(masT_radiusServer, {radiusApn, radiusAddress, radiusMepAddress, timer, tries, secret}). +-record(masT_ipSegment, {startSegAddress, stopSegAddress, netmask}). +-record(masT_llf, {name, metric, id}). +-record(masT_apnLink, {ggsnAddress, ipSegList, ipAddressOrigin, llfConnName, mepAddress}). +-record(masT_ispSubObj, {label, value}). +-record(masT_ipcpData, {type, ipAddress, rawMessage}). +-record(masT_ipcp, {exists, code, id, ipcpList}). +-record(masT_pap, {exists, code, id, username, password}). +-record(masT_chap, {code, id, value, name}). +-record(masT_ispDevContextData, {nsapi, ipAddress, apnhandle}). +-record(masT_protocolConfigOptions, {chap, pap, ipcp}). +-record(masT_apnRadius, {radiusAddress, timer, tries, secret}). +-record(masT_outbandRadius, {gwAddress, llfConnName, primRadius, secRadius}). +-record(masT_radiusPair, {primRadius, secRadius}). +-record(masT_radiusOpt, {dummyMsisdnAuth, dummyMsisdnAcct, msisdnInAuth, msisdnInAcct, sendFullImsi, sendMccMnc, sendSelMode, sendChargingId, asynchAcct}). +-record(masT_radiusConfig, {hostApn, authPair, acctList, radiusOptions}). +-record(masT_apnConfig, {link, security, radiusConfig, primDns, secDns, dhcpAddress, indAcct, indAuth, userNameBasedSelection}). + +-endif. diff --git a/lib/hipe/test/bs_SUITE_data/bs_des.erl b/lib/hipe/test/bs_SUITE_data/bs_des.erl new file mode 100644 index 0000000000..9c495d37ad --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_des.erl @@ -0,0 +1,734 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_des.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : An implementation of the DES Encryption/Descryption +%%% algorithm using Erlang binaries. +%%% +%%% Created : 14 Apr 2004 +%%%------------------------------------------------------------------- +-module(bs_des). + +-export([encode/2, decode/2, test/0]). + +-define(ITERATIONS, 42). %% for benchmarking use a higher number + +test() -> + Bin = <<1:64>>, + Size= byte_size(Bin), + Key = <<4704650607608769871263876:64>>, + Jumbled = run_encode(?ITERATIONS, Bin, Key), + Unjumbled = run_decode(?ITERATIONS, Jumbled, Key), + <<Bin:Size/binary,_/binary>> = Unjumbled, + ok. + +run_encode(1, Bin, Key) -> + encode(Bin, Key); +run_encode(N, Bin, Key) -> + encode(Bin, Key), + run_encode(N-1, Bin, Key). + +run_decode(1, Bin, Key) -> + decode(Bin, Key); +run_decode(N, Bin, Key) -> + decode(Bin, Key), + run_decode(N-1, Bin, Key). + +encode(Data, Key) -> + Keys = schedule(Key), + list_to_binary(encode_data(Data, Keys)). + +decode(Data, Key) -> + Keys = lists:reverse(schedule(Key)), + list_to_binary(decode_data(Data, Keys)). + +encode_data(<<Data:8/binary, Rest/binary>>, Keys) -> + [ipinv(des_core(ip(Data), Keys))|encode_data(Rest, Keys)]; +encode_data(<<Rest/binary>>, Keys) -> + case byte_size(Rest) of + 0 -> []; + X -> + Y = 8 - X, + Data = <<Rest/binary, 0:Y/integer-unit:8>>, + [ipinv(des_core(ip(Data), Keys))] + end. + +decode_data(<<Data:8/binary, Rest/binary>>, Keys) -> + [ipinv(dechiper(ip(Data), Keys))|decode_data(Rest, Keys)]; +decode_data(_, _Keys) -> + []. + +schedule(Key) -> + NewKey = pc1(Key), + subkeys(NewKey, 1). + +subkeys(_Key, 17) -> + []; +subkeys(Key, N) -> + TmpKey = + case rotate(N) of + 1 -> + <<X1:1, L:27, X2:1, R:27>> = Key, + <<L:27, X1:1, R:27, X2:1>>; + 2 -> + <<X1:2, L:26, X2:2, R:26>> = Key, + <<L:26, X1:2, R:26, X2:2>> + end, + [pc2(TmpKey)|subkeys(TmpKey, N+1)]. + +pc2(<<I1:1, I2:1, I3:1, I4:1, I5:1, I6:1, I7:1, I8:1, + _I9:1, I10:1, I11:1, I12:1, I13:1, I14:1, I15:1, I16:1, + I17:1, _I18:1, I19:1, I20:1, I21:1, _I22:1, I23:1, I24:1, + _I25:1, I26:1, I27:1, I28:1, I29:1, I30:1, I31:1, I32:1, + I33:1, I34:1, _I35:1, I36:1, I37:1, _I38:1, I39:1, I40:1, + I41:1, I42:1, _I43:1, I44:1, I45:1, I46:1, I47:1, I48:1, + I49:1, I50:1, I51:1, I52:1, I53:1, _I54:1, I55:1, I56:1>>) -> + <<I14:1, I17:1, I11:1, I24:1, I1:1, I5:1, I3:1, I28:1, + I15:1, I6:1, I21:1, I10:1, I23:1, I19:1, I12:1, I4:1, + I26:1, I8:1, I16:1, I7:1, I27:1, I20:1, I13:1, I2:1, + I41:1, I52:1, I31:1, I37:1, I47:1, I55:1, I30:1, I40:1, + I51:1, I45:1, I33:1, I48:1, I44:1, I49:1, I39:1, I56:1, + I34:1, I53:1, I46:1, I42:1, I50:1, I36:1, I29:1, I32:1>>. + +pc1(<<I1:1, I2:1, I3:1, I4:1, I5:1, I6:1, I7:1, _:1, + I9:1, I10:1, I11:1, I12:1, I13:1, I14:1, I15:1, _:1, + I17:1, I18:1, I19:1, I20:1, I21:1, I22:1, I23:1, _:1, + I25:1, I26:1, I27:1, I28:1, I29:1, I30:1, I31:1, _:1, + I33:1, I34:1, I35:1, I36:1, I37:1, I38:1, I39:1, _:1, + I41:1, I42:1, I43:1, I44:1, I45:1, I46:1, I47:1, _:1, + I49:1, I50:1, I51:1, I52:1, I53:1, I54:1, I55:1, _:1, + I57:1, I58:1, I59:1, I60:1, I61:1, I62:1, I63:1, _:1>>) -> + <<I57:1, I49:1, I41:1, I33:1, I25:1, I17:1, I9:1, I1:1, + I58:1, I50:1, I42:1, I34:1, I26:1, I18:1, I10:1, I2:1, + I59:1, I51:1, I43:1, I35:1, I27:1, I19:1, I11:1, I3:1, + I60:1, I52:1, I44:1, I36:1, I63:1, I55:1, I47:1, I39:1, + I31:1, I23:1, I15:1, I7:1, I62:1, I54:1, I46:1, I38:1, + I30:1, I22:1, I14:1, I6:1, I61:1, I53:1, I45:1, I37:1, + I29:1, I21:1, I13:1, I5:1, I28:1, I20:1, I12:1, I4:1>>. + +ip(<<I1:1, I2:1, I3:1, I4:1, I5:1, I6:1, I7:1, I8:1, + I9:1, I10:1, I11:1, I12:1, I13:1, I14:1, I15:1, I16:1, + I17:1, I18:1, I19:1, I20:1, I21:1, I22:1, I23:1, I24:1, + I25:1, I26:1, I27:1, I28:1, I29:1, I30:1, I31:1, I32:1, + I33:1, I34:1, I35:1, I36:1, I37:1, I38:1, I39:1, I40:1, + I41:1, I42:1, I43:1, I44:1, I45:1, I46:1, I47:1, I48:1, + I49:1, I50:1, I51:1, I52:1, I53:1, I54:1, I55:1, I56:1, + I57:1, I58:1, I59:1, I60:1, I61:1, I62:1, I63:1, I64:1>>) -> + <<I58:1, I50:1, I42:1, I34:1, I26:1, I18:1, I10:1, I2:1, + I60:1, I52:1, I44:1, I36:1, I28:1, I20:1, I12:1, I4:1, + I62:1, I54:1, I46:1, I38:1, I30:1, I22:1, I14:1, I6:1, + I64:1, I56:1, I48:1, I40:1, I32:1, I24:1, I16:1, I8:1, + I57:1, I49:1, I41:1, I33:1, I25:1, I17:1, I9:1, I1:1, + I59:1, I51:1, I43:1, I35:1, I27:1, I19:1, I11:1, I3:1, + I61:1, I53:1, I45:1, I37:1, I29:1, I21:1, I13:1, I5:1, + I63:1, I55:1, I47:1, I39:1, I31:1, I23:1, I15:1, I7:1>>. + +ipinv(<<I58:1, I50:1, I42:1, I34:1, I26:1, I18:1, I10:1, I2:1, + I60:1, I52:1, I44:1, I36:1, I28:1, I20:1, I12:1, I4:1, + I62:1, I54:1, I46:1, I38:1, I30:1, I22:1, I14:1, I6:1, + I64:1, I56:1, I48:1, I40:1, I32:1, I24:1, I16:1, I8:1, + I57:1, I49:1, I41:1, I33:1, I25:1, I17:1, I9:1, I1:1, + I59:1, I51:1, I43:1, I35:1, I27:1, I19:1, I11:1, I3:1, + I61:1, I53:1, I45:1, I37:1, I29:1, I21:1, I13:1, I5:1, + I63:1, I55:1, I47:1, I39:1, I31:1, I23:1, I15:1, I7:1>>) -> + <<I1:1, I2:1, I3:1, I4:1, I5:1, I6:1, I7:1, I8:1, + I9:1, I10:1, I11:1, I12:1, I13:1, I14:1, I15:1, I16:1, + I17:1, I18:1, I19:1, I20:1, I21:1, I22:1, I23:1, I24:1, + I25:1, I26:1, I27:1, I28:1, I29:1, I30:1, I31:1, I32:1, + I33:1, I34:1, I35:1, I36:1, I37:1, I38:1, I39:1, I40:1, + I41:1, I42:1, I43:1, I44:1, I45:1, I46:1, I47:1, I48:1, + I49:1, I50:1, I51:1, I52:1, I53:1, I54:1, I55:1, I56:1, + I57:1, I58:1, I59:1, I60:1, I61:1, I62:1, I63:1, I64:1>>. + +dechiper(<<L:4/binary, R:4/binary>>, Keys) -> + dechiper(L, R, Keys, 16). + +dechiper(L, R, [], 0) -> + <<L:4/binary, R:4/binary>>; +dechiper(L, R, [Key|Rest], I) -> + NewL = ebit(L), + XorL = xor48(NewL, Key), + Sboxed = sboxing(XorL), + Ped = p(Sboxed), + EndL = xor32(Ped, R), + dechiper(EndL, L, Rest, I-1). + +des_core(<<L:4/binary, R:4/binary>>, Keys) -> + des_core(L, R, Keys, 0). + +des_core(L, R, [], 16) -> + <<L:4/binary, R:4/binary>>; +des_core(L, R, [Key|Rest], I) when I<16 -> + NewR = ebit(R), + XorR = xor48(NewR, Key), + Sboxed = sboxing(XorR), + Ped = p(Sboxed), + EndR = xor32(Ped, L), + des_core(R, EndR, Rest, I+1). + +ebit(<<I1:1, I2:2, I3:2,I4:2,I5:2,I6:2, + I7:2,I8:2,I9:2,I10:2,I11:2,I12:2, + I13:2,I14:2,I15:2,I16:2,I17:1>>) -> + <<I17:1, I1:1, I2:2, I3:2, I3:2, + I4:2, I5:2, I5:2, I6:2, + I7:2, I7:2, I8:2, I9:2, + I9:2, I10:2, I11:2, I11:2, + I12:2, I13:2, I13:2, I14:2, + I15:2, I15:2, I16:2, I17:1, I1:1>>. + +p(<<I1:1, I2:1, I3:1, I4:1, I5:1, I6:1, I7:1, I8:1, + I9:1, I10:1, I11:1, I12:1, I13:1, I14:1, I15:1, I16:1, + I17:1, I18:1, I19:1, I20:1, I21:1, I22:1, I23:1, I24:1, + I25:1, I26:1, I27:1, I28:1, I29:1, I30:1, I31:1, I32:1>>) -> + <<I16:1, I7:1, I20:1, I21:1, I29:1, I12:1, I28:1, I17:1, + I1:1, I15:1, I23:1, I26:1, I5:1, I18:1, I31:1, I10:1, + I2:1, I8:1, I24:1, I14:1, I32:1, I27:1, I3:1, I9:1, + I19:1, I13:1, I30:1, I6:1, I22:1, I11:1, I4:1, I25:1>>. + +rotate(1) -> 1; +rotate(2) -> 1; +rotate(9) -> 1; +rotate(16) -> 1; +rotate(N) when N>0, N<17 -> 2. + +%% xor64(<<I1:16, I2:16, I3:16, I4:16>>,<<J1:16, J2:16, J3:16, J4:16>>) -> +%% K1 = I1 bxor J1, +%% K2 = I2 bxor J2, +%% K3 = I3 bxor J3, +%% K4 = I4 bxor J4, +%% <<K1:16, K2:16, K3:16, K4:16>>. + +xor48(<<I1:16, I2:16, I3:16>>,<<J1:16, J2:16, J3:16>>) -> + K1 = I1 bxor J1, + K2 = I2 bxor J2, + K3 = I3 bxor J3, + <<K1:16, K2:16, K3:16>>. + +xor32(<<I1:16, I2:16>>,<<J1:16, J2:16>>) -> + K1 = I1 bxor J1, + K2 = I2 bxor J2, + <<K1:16, K2:16>>. + +sboxing(<<A1:6, A2:6, A3:6, A4:6, A5:6, A6:6, A7:6, A8:6>>) -> + S1 = sbox(A1, 1), + S2 = sbox(A2, 2), + S3 = sbox(A3, 3), + S4 = sbox(A4, 4), + S5 = sbox(A5, 5), + S6 = sbox(A6, 6), + S7 = sbox(A7, 7), + S8 = sbox(A8, 8), + <<S1:4,S2:4,S3:4,S4:4,S5:4,S6:4,S7:4,S8:4>>. + +sbox(0,1) -> 14; +sbox(1,1) -> 0; +sbox(2,1) -> 4; +sbox(3,1) -> 15; +sbox(4,1) -> 13; +sbox(5,1) -> 7; +sbox(6,1) -> 1; +sbox(7,1) -> 4; +sbox(8,1) -> 2; +sbox(9,1) -> 14; +sbox(10,1) -> 15; +sbox(11,1) -> 2; +sbox(12,1) -> 11; +sbox(13,1) -> 13; +sbox(14,1) -> 8; +sbox(15,1) -> 1; +sbox(16,1) -> 3; +sbox(17,1) -> 10; +sbox(18,1) -> 10; +sbox(19,1) -> 6; +sbox(20,1) -> 6; +sbox(21,1) -> 12; +sbox(22,1) -> 12; +sbox(23,1) -> 11; +sbox(24,1) -> 5; +sbox(25,1) -> 9; +sbox(26,1) -> 9; +sbox(27,1) -> 5; +sbox(28,1) -> 0; +sbox(29,1) -> 3; +sbox(30,1) -> 7; +sbox(31,1) -> 8; +sbox(32,1) -> 4; +sbox(33,1) -> 15; +sbox(34,1) -> 1; +sbox(35,1) -> 12; +sbox(36,1) -> 14; +sbox(37,1) -> 8; +sbox(38,1) -> 8; +sbox(39,1) -> 2; +sbox(40,1) -> 13; +sbox(41,1) -> 4; +sbox(42,1) -> 6; +sbox(43,1) -> 9; +sbox(44,1) -> 2; +sbox(45,1) -> 1; +sbox(46,1) -> 11; +sbox(47,1) -> 7; +sbox(48,1) -> 15; +sbox(49,1) -> 5; +sbox(50,1) -> 12; +sbox(51,1) -> 11; +sbox(52,1) -> 9; +sbox(53,1) -> 3; +sbox(54,1) -> 7; +sbox(55,1) -> 14; +sbox(56,1) -> 3; +sbox(57,1) -> 10; +sbox(58,1) -> 10; +sbox(59,1) -> 0; +sbox(60,1) -> 5; +sbox(61,1) -> 6; +sbox(62,1) -> 0; +sbox(63,1) -> 13; +sbox(0,2) -> 15; +sbox(1,2) -> 3; +sbox(2,2) -> 1; +sbox(3,2) -> 13; +sbox(4,2) -> 8; +sbox(5,2) -> 4; +sbox(6,2) -> 14; +sbox(7,2) -> 7; +sbox(8,2) -> 6; +sbox(9,2) -> 15; +sbox(10,2) -> 11; +sbox(11,2) -> 2; +sbox(12,2) -> 3; +sbox(13,2) -> 8; +sbox(14,2) -> 4; +sbox(15,2) -> 14; +sbox(16,2) -> 9; +sbox(17,2) -> 12; +sbox(18,2) -> 7; +sbox(19,2) -> 0; +sbox(20,2) -> 2; +sbox(21,2) -> 1; +sbox(22,2) -> 13; +sbox(23,2) -> 10; +sbox(24,2) -> 12; +sbox(25,2) -> 6; +sbox(26,2) -> 0; +sbox(27,2) -> 9; +sbox(28,2) -> 5; +sbox(29,2) -> 11; +sbox(30,2) -> 10; +sbox(31,2) -> 5; +sbox(32,2) -> 0; +sbox(33,2) -> 13; +sbox(34,2) -> 14; +sbox(35,2) -> 8; +sbox(36,2) -> 7; +sbox(37,2) -> 10; +sbox(38,2) -> 11; +sbox(39,2) -> 1; +sbox(40,2) -> 10; +sbox(41,2) -> 3; +sbox(42,2) -> 4; +sbox(43,2) -> 15; +sbox(44,2) -> 13; +sbox(45,2) -> 4; +sbox(46,2) -> 1; +sbox(47,2) -> 2; +sbox(48,2) -> 5; +sbox(49,2) -> 11; +sbox(50,2) -> 8; +sbox(51,2) -> 6; +sbox(52,2) -> 12; +sbox(53,2) -> 7; +sbox(54,2) -> 6; +sbox(55,2) -> 12; +sbox(56,2) -> 9; +sbox(57,2) -> 0; +sbox(58,2) -> 3; +sbox(59,2) -> 5; +sbox(60,2) -> 2; +sbox(61,2) -> 14; +sbox(62,2) -> 15; +sbox(63,2) -> 9; +sbox(0,3) -> 10; +sbox(1,3) -> 13; +sbox(2,3) -> 0; +sbox(3,3) -> 7; +sbox(4,3) -> 9; +sbox(5,3) -> 0; +sbox(6,3) -> 14; +sbox(7,3) -> 9; +sbox(8,3) -> 6; +sbox(9,3) -> 3; +sbox(10,3) -> 3; +sbox(11,3) -> 4; +sbox(12,3) -> 15; +sbox(13,3) -> 6; +sbox(14,3) -> 5; +sbox(15,3) -> 10; +sbox(16,3) -> 1; +sbox(17,3) -> 2; +sbox(18,3) -> 13; +sbox(19,3) -> 8; +sbox(20,3) -> 12; +sbox(21,3) -> 5; +sbox(22,3) -> 7; +sbox(23,3) -> 14; +sbox(24,3) -> 11; +sbox(25,3) -> 12; +sbox(26,3) -> 4; +sbox(27,3) -> 11; +sbox(28,3) -> 2; +sbox(29,3) -> 15; +sbox(30,3) -> 8; +sbox(31,3) -> 1; +sbox(32,3) -> 13; +sbox(33,3) -> 1; +sbox(34,3) -> 6; +sbox(35,3) -> 10; +sbox(36,3) -> 4; +sbox(37,3) -> 13; +sbox(38,3) -> 9; +sbox(39,3) -> 0; +sbox(40,3) -> 8; +sbox(41,3) -> 6; +sbox(42,3) -> 15; +sbox(43,3) -> 9; +sbox(44,3) -> 3; +sbox(45,3) -> 8; +sbox(46,3) -> 0; +sbox(47,3) -> 7; +sbox(48,3) -> 11; +sbox(49,3) -> 4; +sbox(50,3) -> 1; +sbox(51,3) -> 15; +sbox(52,3) -> 2; +sbox(53,3) -> 14; +sbox(54,3) -> 12; +sbox(55,3) -> 3; +sbox(56,3) -> 5; +sbox(57,3) -> 11; +sbox(58,3) -> 10; +sbox(59,3) -> 5; +sbox(60,3) -> 14; +sbox(61,3) -> 2; +sbox(62,3) -> 7; +sbox(63,3) -> 12; +sbox(0,4) -> 7; +sbox(1,4) -> 13; +sbox(2,4) -> 13; +sbox(3,4) -> 8; +sbox(4,4) -> 14; +sbox(5,4) -> 11; +sbox(6,4) -> 3; +sbox(7,4) -> 5; +sbox(8,4) -> 0; +sbox(9,4) -> 6; +sbox(10,4) -> 6; +sbox(11,4) -> 15; +sbox(12,4) -> 9; +sbox(13,4) -> 0; +sbox(14,4) -> 10; +sbox(15,4) -> 3; +sbox(16,4) -> 1; +sbox(17,4) -> 4; +sbox(18,4) -> 2; +sbox(19,4) -> 7; +sbox(20,4) -> 8; +sbox(21,4) -> 2; +sbox(22,4) -> 5; +sbox(23,4) -> 12; +sbox(24,4) -> 11; +sbox(25,4) -> 1; +sbox(26,4) -> 12; +sbox(27,4) -> 10; +sbox(28,4) -> 4; +sbox(29,4) -> 14; +sbox(30,4) -> 15; +sbox(31,4) -> 9; +sbox(32,4) -> 10; +sbox(33,4) -> 3; +sbox(34,4) -> 6; +sbox(35,4) -> 15; +sbox(36,4) -> 9; +sbox(37,4) -> 0; +sbox(38,4) -> 0; +sbox(39,4) -> 6; +sbox(40,4) -> 12; +sbox(41,4) -> 10; +sbox(42,4) -> 11; +sbox(43,4) -> 1; +sbox(44,4) -> 7; +sbox(45,4) -> 13; +sbox(46,4) -> 13; +sbox(47,4) -> 8; +sbox(48,4) -> 15; +sbox(49,4) -> 9; +sbox(50,4) -> 1; +sbox(51,4) -> 4; +sbox(52,4) -> 3; +sbox(53,4) -> 5; +sbox(54,4) -> 14; +sbox(55,4) -> 11; +sbox(56,4) -> 5; +sbox(57,4) -> 12; +sbox(58,4) -> 2; +sbox(59,4) -> 7; +sbox(60,4) -> 8; +sbox(61,4) -> 2; +sbox(62,4) -> 4; +sbox(63,4) -> 14; +sbox(0,5) -> 2; +sbox(1,5) -> 14; +sbox(2,5) -> 12; +sbox(3,5) -> 11; +sbox(4,5) -> 4; +sbox(5,5) -> 2; +sbox(6,5) -> 1; +sbox(7,5) -> 12; +sbox(8,5) -> 7; +sbox(9,5) -> 4; +sbox(10,5) -> 10; +sbox(11,5) -> 7; +sbox(12,5) -> 11; +sbox(13,5) -> 13; +sbox(14,5) -> 6; +sbox(15,5) -> 1; +sbox(16,5) -> 8; +sbox(17,5) -> 5; +sbox(18,5) -> 5; +sbox(19,5) -> 0; +sbox(20,5) -> 3; +sbox(21,5) -> 15; +sbox(22,5) -> 15; +sbox(23,5) -> 10; +sbox(24,5) -> 13; +sbox(25,5) -> 3; +sbox(26,5) -> 0; +sbox(27,5) -> 9; +sbox(28,5) -> 14; +sbox(29,5) -> 8; +sbox(30,5) -> 9; +sbox(31,5) -> 6; +sbox(32,5) -> 4; +sbox(33,5) -> 11; +sbox(34,5) -> 2; +sbox(35,5) -> 8; +sbox(36,5) -> 1; +sbox(37,5) -> 12; +sbox(38,5) -> 11; +sbox(39,5) -> 7; +sbox(40,5) -> 10; +sbox(41,5) -> 1; +sbox(42,5) -> 13; +sbox(43,5) -> 14; +sbox(44,5) -> 7; +sbox(45,5) -> 2; +sbox(46,5) -> 8; +sbox(47,5) -> 13; +sbox(48,5) -> 15; +sbox(49,5) -> 6; +sbox(50,5) -> 9; +sbox(51,5) -> 15; +sbox(52,5) -> 12; +sbox(53,5) -> 0; +sbox(54,5) -> 5; +sbox(55,5) -> 9; +sbox(56,5) -> 6; +sbox(57,5) -> 10; +sbox(58,5) -> 3; +sbox(59,5) -> 4; +sbox(60,5) -> 0; +sbox(61,5) -> 5; +sbox(62,5) -> 14; +sbox(63,5) -> 3; +sbox(0,6) -> 12; +sbox(1,6) -> 10; +sbox(2,6) -> 1; +sbox(3,6) -> 15; +sbox(4,6) -> 10; +sbox(5,6) -> 4; +sbox(6,6) -> 15; +sbox(7,6) -> 2; +sbox(8,6) -> 9; +sbox(9,6) -> 7; +sbox(10,6) -> 2; +sbox(11,6) -> 12; +sbox(12,6) -> 6; +sbox(13,6) -> 9; +sbox(14,6) -> 8; +sbox(15,6) -> 5; +sbox(16,6) -> 0; +sbox(17,6) -> 6; +sbox(18,6) -> 13; +sbox(19,6) -> 1; +sbox(20,6) -> 3; +sbox(21,6) -> 13; +sbox(22,6) -> 4; +sbox(23,6) -> 14; +sbox(24,6) -> 14; +sbox(25,6) -> 0; +sbox(26,6) -> 7; +sbox(27,6) -> 11; +sbox(28,6) -> 5; +sbox(29,6) -> 3; +sbox(30,6) -> 11; +sbox(31,6) -> 8; +sbox(32,6) -> 9; +sbox(33,6) -> 4; +sbox(34,6) -> 14; +sbox(35,6) -> 3; +sbox(36,6) -> 15; +sbox(37,6) -> 2; +sbox(38,6) -> 5; +sbox(39,6) -> 12; +sbox(40,6) -> 2; +sbox(41,6) -> 9; +sbox(42,6) -> 8; +sbox(43,6) -> 5; +sbox(44,6) -> 12; +sbox(45,6) -> 15; +sbox(46,6) -> 3; +sbox(47,6) -> 10; +sbox(48,6) -> 7; +sbox(49,6) -> 11; +sbox(50,6) -> 0; +sbox(51,6) -> 14; +sbox(52,6) -> 4; +sbox(53,6) -> 1; +sbox(54,6) -> 10; +sbox(55,6) -> 7; +sbox(56,6) -> 1; +sbox(57,6) -> 6; +sbox(58,6) -> 13; +sbox(59,6) -> 0; +sbox(60,6) -> 11; +sbox(61,6) -> 8; +sbox(62,6) -> 6; +sbox(63,6) -> 13; +sbox(0,7) -> 4; +sbox(1,7) -> 13; +sbox(2,7) -> 11; +sbox(3,7) -> 0; +sbox(4,7) -> 2; +sbox(5,7) -> 11; +sbox(6,7) -> 14; +sbox(7,7) -> 7; +sbox(8,7) -> 15; +sbox(9,7) -> 4; +sbox(10,7) -> 0; +sbox(11,7) -> 9; +sbox(12,7) -> 8; +sbox(13,7) -> 1; +sbox(14,7) -> 13; +sbox(15,7) -> 10; +sbox(16,7) -> 3; +sbox(17,7) -> 14; +sbox(18,7) -> 12; +sbox(19,7) -> 3; +sbox(20,7) -> 9; +sbox(21,7) -> 5; +sbox(22,7) -> 7; +sbox(23,7) -> 12; +sbox(24,7) -> 5; +sbox(25,7) -> 2; +sbox(26,7) -> 10; +sbox(27,7) -> 15; +sbox(28,7) -> 6; +sbox(29,7) -> 8; +sbox(30,7) -> 1; +sbox(31,7) -> 6; +sbox(32,7) -> 1; +sbox(33,7) -> 6; +sbox(34,7) -> 4; +sbox(35,7) -> 11; +sbox(36,7) -> 11; +sbox(37,7) -> 13; +sbox(38,7) -> 13; +sbox(39,7) -> 8; +sbox(40,7) -> 12; +sbox(41,7) -> 1; +sbox(42,7) -> 3; +sbox(43,7) -> 4; +sbox(44,7) -> 7; +sbox(45,7) -> 10; +sbox(46,7) -> 14; +sbox(47,7) -> 7; +sbox(48,7) -> 10; +sbox(49,7) -> 9; +sbox(50,7) -> 15; +sbox(51,7) -> 5; +sbox(52,7) -> 6; +sbox(53,7) -> 0; +sbox(54,7) -> 8; +sbox(55,7) -> 15; +sbox(56,7) -> 0; +sbox(57,7) -> 14; +sbox(58,7) -> 5; +sbox(59,7) -> 2; +sbox(60,7) -> 9; +sbox(61,7) -> 3; +sbox(62,7) -> 2; +sbox(63,7) -> 12; +sbox(0,8) -> 13; +sbox(1,8) -> 1; +sbox(2,8) -> 2; +sbox(3,8) -> 15; +sbox(4,8) -> 8; +sbox(5,8) -> 13; +sbox(6,8) -> 4; +sbox(7,8) -> 8; +sbox(8,8) -> 6; +sbox(9,8) -> 10; +sbox(10,8) -> 15; +sbox(11,8) -> 3; +sbox(12,8) -> 11; +sbox(13,8) -> 7; +sbox(14,8) -> 1; +sbox(15,8) -> 4; +sbox(16,8) -> 10; +sbox(17,8) -> 12; +sbox(18,8) -> 9; +sbox(19,8) -> 5; +sbox(20,8) -> 3; +sbox(21,8) -> 6; +sbox(22,8) -> 14; +sbox(23,8) -> 11; +sbox(24,8) -> 5; +sbox(25,8) -> 0; +sbox(26,8) -> 0; +sbox(27,8) -> 14; +sbox(28,8) -> 12; +sbox(29,8) -> 9; +sbox(30,8) -> 7; +sbox(31,8) -> 2; +sbox(32,8) -> 7; +sbox(33,8) -> 2; +sbox(34,8) -> 11; +sbox(35,8) -> 1; +sbox(36,8) -> 4; +sbox(37,8) -> 14; +sbox(38,8) -> 1; +sbox(39,8) -> 7; +sbox(40,8) -> 9; +sbox(41,8) -> 4; +sbox(42,8) -> 12; +sbox(43,8) -> 10; +sbox(44,8) -> 14; +sbox(45,8) -> 8; +sbox(46,8) -> 2; +sbox(47,8) -> 13; +sbox(48,8) -> 0; +sbox(49,8) -> 15; +sbox(50,8) -> 6; +sbox(51,8) -> 12; +sbox(52,8) -> 10; +sbox(53,8) -> 9; +sbox(54,8) -> 13; +sbox(55,8) -> 0; +sbox(56,8) -> 15; +sbox(57,8) -> 3; +sbox(58,8) -> 3; +sbox(59,8) -> 5; +sbox(60,8) -> 5; +sbox(61,8) -> 6; +sbox(62,8) -> 8; +sbox(63,8) -> 11. diff --git a/lib/hipe/test/bs_SUITE_data/bs_extract.erl b/lib/hipe/test/bs_SUITE_data/bs_extract.erl new file mode 100644 index 0000000000..0492689fa8 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_extract.erl @@ -0,0 +1,94 @@ +%% -*- erlang-indent-level: 2 -*- +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Among testing other things, this module shows why performing LCM on +%% SPARC is currently problematic. SPARC does not mark untagged values +%% as dead when they are live over function calls which in turn causes +%% them to be traced by the garbage collector leading to crashes. +%% +%% A simple way to get this behaviour is to compile just the function +%% +%% {bsextract,tid_internal_storage,2} +%% +%% with the compiler option "rtl_lcm" on and without. +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-module(bs_extract). + +-export([test/0]). + +-include("bs_decode_extract.hrl"). + +-define(PDU, <<30,16,0,90,0,1,0,0,255,255,255,255,81,67,101,7,0,0,0,96, + 6,12,146,18,14,0,15,252,16,0,0,17,0,0,128,0,2,241,33,131, + 0,20,7,97,112,110,48,49,51,97,8,101,114,105,99,115,115, + 111,110,2,115,101,132,0,20,128,192,35,16,1,5,0,16,5,117, + 115,101,114,53,5,112,97,115,115,53,133,0,4,172,28,12,1, + 133,0,4,172,28,12,3,134,0,8,145,148,113,129,0,0,0,0>>). + +-define(RES, {ok, {mvsgT_imsi, <<81,67,101,7,0,0,0,240>>}}). + +test() -> + ?RES = extract_v0_opt(1000, ?PDU), + ok. + +extract_v0_opt(0, Pdu) -> + get_external_id(Pdu); +extract_v0_opt(N, Pdu) -> + {ok,_} = get_external_id(Pdu), + extract_v0_opt(N-1, Pdu). + +get_external_id(<<0:3,_:4,0:1,1:8,_Length:16,SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + _TID:8/binary-unit:8,_InformationElements/binary>>) -> + {echo,#sesT_echoReqV0{},SequenceNumber}; +%% Create PDP Context Request +%% GTP97, SNN=0 +%% (No SNDCP N-PDU number) +get_external_id(<<0:3,_:4,0:1,16:8,_Length:16,_SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + TID:8/binary-unit:8,_InformationElements/binary>>) -> + {ok,_IMSI} = extract_imsi(TID); +%%% Update PDP Context Request +%%% GTP97, SNN=0 +%%% (No SNDCP N-PDU number) +get_external_id(<<0:3,_:4,0:1,18:8,_Length:16,_SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + TID:8/binary-unit:8,_InformationElements/binary>>) -> + {ok,_IMSI} = extract_imsi(TID); +%%% Delete PDP Context Request +%%% GTP97, SNN=0 +%%% (No SNDCP N-PDU number) +get_external_id(<<0:3,_:4,0:1,20:8,_Length:16,_SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + TID:8/binary-unit:8,_InformationElements/binary>>) -> + {ok,_IMSI} = extract_imsi(TID); +%%% Error handling: GTP Message Too Short +%%% Error handling: Unknown GTP Signalling message. +%%% Error handling: Unexpected GTP Signalling message. +get_external_id(_GTP_Message) -> + fault. + +%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%% extract_imsi/1 +%% Get the IMSI element from TID +extract_imsi(TID) -> + {ok,#mvsgT_tid{imsi=IMSI}} = tid_internal_storage(TID,[]), + {ok,IMSI}. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% tid_internal_storage/3 +%%% Convert TID binary to internal datatype +tid_internal_storage(Bin,_) -> + Size = byte_size(Bin) - 1, + <<Front:Size/binary,NSAPI:4,DigitN:4>> = Bin, + Result = + case DigitN of + 2#1111 -> + #mvsgT_tid{imsi = #mvsgT_imsi{value=Front}, nsapi = NSAPI}; + _ -> + Value = <<Front/binary,2#1111:4,DigitN:4>>, + #mvsgT_tid{imsi = #mvsgT_imsi{value = Value}, nsapi = NSAPI} + end, + {ok,Result}. diff --git a/lib/hipe/test/bs_SUITE_data/bs_flatb.erl b/lib/hipe/test/bs_SUITE_data/bs_flatb.erl new file mode 100644 index 0000000000..6163917965 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_flatb.erl @@ -0,0 +1,29 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------------- +%% Program which resulted in a badarg crash when compiled to native code. +%% The problem was that hipe_icode_primops was stating that the primop +%% {bs_start_match, ok_matchstate} could not fail which made the icode_type +%% pass removing the third clause of flatb/1. +%% +%% (The program was working correctly with hipe option 'no_icode_type'.) +%% +%% Reported by Andreas Sandberg on 3/1/2011 and fixed by Kostis on 5/1/2011 +%% with the help of Per Gustafsson. +%% -------------------------------------------------------------------------- +-module(bs_flatb). + +-export([hipe_options/0, test/0]). + +hipe_options() -> + [icode_type]. + +test() -> + [] = flatb([<<>>], []), + ok. + +flatb(<<X:8, Rest/binary>>, Acc) -> + flatb(Rest, [X|Acc]); +flatb(<<>>, Acc) -> + Acc; +flatb([V], Acc) -> + flatb(V, Acc). diff --git a/lib/hipe/test/bs_SUITE_data/bs_id3.erl b/lib/hipe/test/bs_SUITE_data/bs_id3.erl new file mode 100644 index 0000000000..a6152f05cd --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_id3.erl @@ -0,0 +1,75 @@ +%% -*- erlang-indent-level: 2 -*- +%%========================================================================== +%% From: Tomas Stejskal -- 23/02/2008 +%% I've found some strange behavior regarding binary matching. The module's +%% purpose is reading an id3 version 1 or version 1.1 tag from an mp3 bin. +%% When I use the function read_v1_or_v11_tag on a mp3 binary containing +%% version 1 tag, it returns an error. However, when the function +%% read_only_v1_tag is applied on the same file, it reads the tag data +%% correctly. The only difference between these two functions is that the +%% former has an extra branch to read version 1.1 tag. +%% This was a BEAM compiler bug which was fixed by a patch to beam_dead. +%%========================================================================== + +-module(bs_id3). + +-export([test/0]). + +-define(BIN, <<84,65,71,68,117,154,105,232,107,121,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,68,97,110,105,101,108,32,76,97,110, + 100,97,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,66,101,115,116, + 32,79,102,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 50,48,48,48,50,48,48,48,32,45,32,66,101,115,116,32,79,102, + 32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,12>>). + +test() -> + R1 = parse_only_v1_tag(?BIN), + R2 = parse_v1_or_v11_tag(?BIN), + %% io:format("~p\n~p\n", [R1, R2]), + R1 = R2, % crash if not equal + ok. + +parse_only_v1_tag(<<"TAG", Title:30/binary, + Artist:30/binary, Album:30/binary, + _Year:4/binary, _Comment:30/binary, + _Genre:8>>) -> + {ok, + {"ID3v1", + [{title, trim(Title)}, + {artist, trim(Artist)}, + {album, trim(Album)}]}}; +parse_only_v1_tag(_) -> + error. + +parse_v1_or_v11_tag(<<"TAG", Title:30/binary, + Artist:30/binary, Album:30/binary, + _Year:4/binary, _Comment:28/binary, + 0:8, Track:8, _Genre:8>>) -> + {ok, + {"ID3v1.1", + [{track, Track}, {title, trim(Title)}, + {artist, trim(Artist)}, {album, trim(Album)}]}}; +parse_v1_or_v11_tag(<<"TAG", Title:30/binary, + Artist:30/binary, Album:30/binary, + _Year:4/binary, _Comment:30/binary, + _Genre:8>>) -> + {ok, + {"ID3v1", + [{title, trim(Title)}, + {artist, trim(Artist)}, + {album, trim(Album)}]}}; +parse_v1_or_v11_tag(_) -> + error. + +trim(Bin) -> + list_to_binary(trim_blanks(binary_to_list(Bin))). + +trim_blanks(L) -> + lists:reverse(skip_blanks_and_zero(lists:reverse(L))). + +skip_blanks_and_zero([$\s|T]) -> + skip_blanks_and_zero(T); +skip_blanks_and_zero([0|T]) -> + skip_blanks_and_zero(T); +skip_blanks_and_zero(L) -> + L. diff --git a/lib/hipe/test/bs_SUITE_data/bs_match.erl b/lib/hipe/test/bs_SUITE_data/bs_match.erl new file mode 100644 index 0000000000..8194d878b8 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_match.erl @@ -0,0 +1,175 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_match.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : Performs simple matching and construction of binaries +%%% TODO : Add binary and float tests +%%% Created : 20 Feb 2004 +%%%------------------------------------------------------------------- +-module(bs_match). + +-export([test/0]). + +test() -> + Funs = [fun test_aligned/0, fun test_unaligned/0, + fun test_zero_tail/0, fun test_integer_matching/0], + lists:foreach(fun (F) -> ok = F() end, Funs). + +%%------------------------------------------------------------------- +%% Test aligned accesses + +test_aligned() -> + 10 = aligned_skip_bits_all(1, <<10,11,12>>), + ok = aligned(). + +aligned_skip_bits_all(N, Bin) -> + <<X:N/integer-unit:8, _/binary>> = Bin, + X. + +aligned() -> + Tail1 = mkbin([]), + {258, Tail1} = al_get_tail_used(mkbin([1,2])), + Tail2 = mkbin(lists:seq(1, 127)), + {35091, Tail2} = al_get_tail_used(mkbin([137,19|Tail2])), + 64896 = al_get_tail_unused(mkbin([253,128])), + 64895 = al_get_tail_unused(mkbin([253,127|lists:seq(42, 255)])), + Tail3 = mkbin(lists:seq(0, 19)), + {0, Tail1} = get_dyn_tail_used(Tail1, 0), + {0, Tail3} = get_dyn_tail_used(mkbin([Tail3]), 0), + {73, Tail3} = get_dyn_tail_used(mkbin([73|Tail3]), 8), + 0 = get_dyn_tail_unused(mkbin([]), 0), + 233 = get_dyn_tail_unused(mkbin([233]), 8), + 23 = get_dyn_tail_unused(mkbin([23,22,2]), 8), + ok. + +mkbin(L) when is_list(L) -> list_to_binary(L). + +al_get_tail_used(<<A:16,T/binary>>) -> {A, T}. + +al_get_tail_unused(<<A:16,_/binary>>) -> A. + +%%------------------------------------------------------------------- +%% Test unaligned accesses + +test_unaligned() -> + 10 = unaligned_skip_bits_all(8, <<10,11,12>>), + ok = unaligned(). + +unaligned_skip_bits_all(N, Bin) -> + <<X:N, _/binary>> = Bin, + X. + +unaligned() -> + {'EXIT', {function_clause,_}} = (catch get_tail_used(mkbin([42]))), + {'EXIT', {{badmatch,_},_}} = (catch get_dyn_tail_used(mkbin([137]), 3)), + {'EXIT', {function_clause,_}} = (catch get_tail_unused(mkbin([42,33]))), + {'EXIT', {{badmatch,_},_}} = (catch get_dyn_tail_unused(mkbin([44]), 7)), + ok. + +get_tail_used(<<A:1, T/binary>>) -> {A, T}. + +get_tail_unused(<<A:15, _/binary>>) -> A. + +get_dyn_tail_used(Bin, Sz) -> + <<A:Sz, T/binary>> = Bin, + {A,T}. + +get_dyn_tail_unused(Bin, Sz) -> + <<A:Sz, _T/binary>> = Bin, + A. + +%%------------------------------------------------------------------- +%% Test zero tail + +test_zero_tail() -> + 42 = zt8(mkbin([42])), + {'EXIT', {function_clause, _}} = (catch zt8(mkbin([1,2]))), + {'EXIT', {function_clause, _}} = (catch zt44(mkbin([1,2]))), + ok. + +zt8(<<A:8>>) -> A. + +zt44(<<_:4,_:4>>) -> ok. + +%%------------------------------------------------------------------- +%% Test integer matching + +test_integer_matching() -> + ok = test_static_integer_matching_1(), + ok = test_static_integer_matching_2(), + ok = test_static_integer_matching_3(), + ok = test_static_integer_matching_4(), + DynFun = fun (N) -> ok = test_dynamic_integer_matching(N) end, + lists:foreach(DynFun, [28, 27, 9, 17, 25, 8, 16, 24, 32]). + +test_static_integer_matching_1() -> + <<0:6, -25:28/integer-signed, 0:6>> = s11(), + <<0:6, -25:28/integer-little-signed, 0:6>> = s12(), + <<0:6, 25:28/integer-little, 0:6>> = s13(), + <<0:6, 25:28, 0:6>> = s14(), + ok. + +s11() -> + <<0:6, -25:28/integer-signed, 0:6>>. +s12() -> + <<0:6, -25:28/integer-little-signed, 0:6>>. +s13() -> + <<0:6, 25:28/integer-little, 0:6>>. +s14() -> + <<0:6, 25:28, 0:6>>. + +test_static_integer_matching_2() -> + <<0:6, -25:20/integer-signed, 0:6>> = s21(), + <<0:6, -25:20/integer-little-signed, 0:6>> = s22(), + <<0:6, 25:20/integer-little, 0:6>> = s23(), + <<0:6, 25:20, 0:6>> = s24(), + ok. + +s21() -> + <<0:6, -25:20/integer-signed, 0:6>>. +s22() -> + <<0:6, -25:20/integer-little-signed, 0:6>>. +s23() -> + <<0:6, 25:20/integer-little, 0:6>>. +s24() -> + <<0:6, 25:20, 0:6>>. + +test_static_integer_matching_3() -> + <<0:6, -25:12/integer-signed, 0:6>> = s31(), + <<0:6, -25:12/integer-little-signed, 0:6>> = s32(), + <<0:6, 25:12/integer-little, 0:6>> = s33(), + <<0:6, 25:12, 0:6>> = s34(), + ok. + +s31() -> + <<0:6, -25:12/integer-signed, 0:6>>. +s32() -> + <<0:6, -25:12/integer-little-signed, 0:6>>. +s33() -> + <<0:6, 25:12/integer-little, 0:6>>. +s34() -> + <<0:6, 25:12, 0:6>>. + +test_static_integer_matching_4() -> + <<0:6, -3:4/integer-signed, 0:6>> = s41(), + <<0:6, -3:4/integer-little-signed, 0:6>> = s42(), + <<0:6, 7:4/integer-little, 0:6>> = s43(), + <<0:6, 7:4, 0:6>> = s44(), + ok. + +s41() -> + <<0:6, -3:4/integer-signed, 0:6>>. +s42() -> + <<0:6, -3:4/integer-little-signed, 0:6>>. +s43() -> + <<0:6, 7:4/integer-little, 0:6>>. +s44() -> + <<0:6, 7:4, 0:6>>. + +test_dynamic_integer_matching(N) -> + S = 32 - N, + <<-12:N/integer-signed, 0:S>> = <<-12:N/integer-signed, 0:S>>, + <<-12:N/integer-little-signed, 0:S>> = <<-12:N/integer-little-signed, 0:S>>, + <<12:N/integer, 0:S>> = <<12:N/integer, 0:S>>, + <<12:N/integer-little, 0:S>> = <<12:N/integer-little, 0:S>>, + ok. diff --git a/lib/hipe/test/bs_SUITE_data/bs_native_float.erl b/lib/hipe/test/bs_SUITE_data/bs_native_float.erl new file mode 100644 index 0000000000..15fe0bf0c6 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_native_float.erl @@ -0,0 +1,22 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------- +%% File : bs_native_float.erl +%% Author : Kostis Sagonas +%% Description : Test sent by Bjorn Gustavsson to report a bug in the +%% handling of the 'native' endian specifier. +%% Created : 28 Nov 2004 +%%------------------------------------------------------------------- +-module(bs_native_float). + +-export([test/0]). + +test() -> + BeamRes = mk_bin(1.0, 2.0, 3.0), + hipe:c(?MODULE), %% Original was: hipe:c({?MODULE,vs_to_bin,1}, [o2]), + HipeRes = mk_bin(1.0, 2.0, 3.0), + %% io:format("Beam result = ~w\nHiPE result = ~w\n", [BeamRes,HipeRes]), + BeamRes = HipeRes, + ok. + +mk_bin(X, Y, Z) -> + <<X:64/native-float, Y:64/native-float, Z:64/native-float>>. diff --git a/lib/hipe/test/bs_SUITE_data/bs_orber.erl b/lib/hipe/test/bs_SUITE_data/bs_orber.erl new file mode 100644 index 0000000000..c80ab8928d --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_orber.erl @@ -0,0 +1,26 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : Checks that labels are handled properly from Core +%%% Created : 2 Nov 2004 +%%%------------------------------------------------------------------- +-module(bs_orber). + +-export([test/0]). + +test() -> + 1 = dec_giop_message_header(<<1,1:32/little-integer>>), + 1 = dec_giop_message_header(<<0,1:32/big-integer>>), + {2, 1} = dec_giop_message_header(<<2,1:32/little-integer>>), + {3, 1} = dec_giop_message_header(<<3,1:32/big-integer>>), + ok. + +dec_giop_message_header(<<1:8, MessSize:32/little-integer>>) -> + MessSize; +dec_giop_message_header(<<0:8, MessSize:32/big-integer>>) -> + MessSize; +dec_giop_message_header(<<Flags:8, MessSize:32/little-integer>>) when + ((Flags band 16#03) =:= 16#02) -> + {Flags, MessSize}; +dec_giop_message_header(<<Flags:8, MessSize:32/big-integer>>) -> + {Flags, MessSize}. diff --git a/lib/hipe/test/bs_SUITE_data/bs_pmatch.erl b/lib/hipe/test/bs_SUITE_data/bs_pmatch.erl new file mode 100644 index 0000000000..9474ffea4a --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_pmatch.erl @@ -0,0 +1,269 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +%% Tests that basic cases of binary pattern matching work +%%-------------------------------------------------------------------- +-module(bs_pmatch). + +-export([test/0]). + +test() -> + %% construct some binaries + Bin42 = <<42>>, + Bin = <<12,17,42,0,0,0>>, + BinSS = <<0,1,0,0,0>>, + %% do some pattern matching + ok = pm_const(Bin42), + <<17,42,0,0,0>> = pm_tail(Bin), + 42 = pm_little(<<0:1,42:7>>), + 42 = pm_rec(Bin), + 30 = pm_rec_acc(<<1,2,3,4,5,6,7,8,9,10>>, 0), + 42 = pm_binary_tuple(Bin42), + -1 = pm_with_illegal_float(), + %% do some pattern matching with bound segments + ok = pm_bound_var(), + ok = pm_bound_tail(), + %% do some tests with floating point numbers + ok = pm_float(), + ok = pm_float_little(), + %% do some pattern matching with segments of unknown sizes + {<<17>>, <<42,0,0,0>>} = pm_body_s(Bin, 1), + {<<17>>, <<42,0,0,0>>} = pm_body_ss(Bin, 1, 4), + {<<45>>, <<>>} = pm_size_split(<<1:16,45>>), + {<<45>>, <<46,47>>} = pm_size_split(<<1:16,45,46,47>>), + {<<45,46>>, <<47>>} = pm_size_split(<<2:16,45,46,47>>), + {<<45,46>>, <<47>>} = pm_size_split_2(2, <<2:16,45,46,47>>), + {'EXIT',{function_clause,_}} = (catch pm_size_split_2(42, <<2:16,45,46,47>>)), + {<<45,46,47>>, <<48>>} = pm_sizes_split(<<16:8,3:16,45,46,47,48>>), + <<"cdef">> = pm_skip_segment(<<2:8, "abcdef">>), + -1 = pm_double_size_in_head(BinSS), + -1 = pm_double_size_in_body(BinSS), + %% and finally some cases which were problematic for various reasons + ok = pm_bigs(), + ok = pm_sean(), + ok = pm_bin8(<<1,2,3,4,5,6,7,8>>), + ok = pm_bs_match_string(), + ok = pm_till_gc(), + ok. + +%%-------------------- +%% Test cases below +%%-------------------- + +pm_const(<<42>>) -> + ok. + +pm_tail(<<12, Bin/binary>>) -> + Bin. + +pm_little(<<_:1, X:15/little>>) -> + {wrong, X}; +pm_little(<<_:1, X:7/little>>) -> + X. + +pm_rec(<<12, Bin/binary>>) -> + pm_rec(Bin); +pm_rec(<<17, Word:4/little-signed-integer-unit:8>>) -> + Word. + +pm_rec_acc(<<_:4, A:4, Rest/binary>>, Acc) -> + case Rest of + <<X, Y, 9, NewRest/binary>> -> + pm_rec_acc(NewRest, X+Y+Acc); + <<X, 5, NewRest/binary>> -> + pm_rec_acc(NewRest, X+Acc); + <<2, NewRest/binary>> -> + pm_rec_acc(NewRest, 1+Acc); + <<NewRest/binary>> -> + pm_rec_acc(NewRest, A+Acc) + end; +pm_rec_acc(<<>>, Acc) -> + Acc. + +pm_binary_tuple(<<X>>) -> + X; +pm_binary_tuple({Y, Z}) -> + Y + Z. + +pm_with_illegal_float() -> + Bin = <<-1:64>>, % create a binary which is illegal as float + pm_float_integer(Bin). % try to match it out as a float + +pm_float_integer(<<F:64/float>>) -> F; +pm_float_integer(<<I:64/integer-signed>>) -> I. + +%%-------------------------------------------------------------------- +%% Some tests with bound variables in segments + +pm_bound_var() -> + ok = pm_bound_var(42, 13, <<42,13>>), + no = pm_bound_var(42, 13, <<42,255>>), + no = pm_bound_var(42, 13, <<154,255>>), + ok. + +pm_bound_var(A, B, <<A:8, B:8>>) -> ok; +pm_bound_var(_, _, _) -> no. + +pm_bound_tail() -> + ok = pm_bound_tail(<<>>, <<13,14>>), + ok = pm_bound_tail(<<2,3>>, <<1,1,2,3>>), + no = pm_bound_tail(<<2,3>>, <<1,1,2,7>>), + no = pm_bound_tail(<<2,3>>, <<1,1,2,3,4>>), + no = pm_bound_tail(<<2,3>>, <<>>), + ok. + +pm_bound_tail(T, <<_:16, T/binary>>) -> ok; +pm_bound_tail(_, _) -> no. + +%%-------------------------------------------------------------------- +%% Floating point tests + +pm_float() -> + F = f1(), + G = f_one(), + G = match_float(<<63,128,0,0>>, 32, 0), + G = match_float(<<63,240,0,0,0,0,0,0>>, 64, 0), + fcmp(F, match_float(<<F:32/float>>, 32, 0)), + fcmp(F, match_float(<<F:64/float>>, 64, 0)), + fcmp(F, match_float(<<1:1,F:32/float,127:7>>, 32, 1)), + fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)), + fcmp(F, match_float(<<1:13,F:32/float,127:3>>, 32, 13)), + fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)), + ok. + +fcmp(F1, F2) when (F1 - F2) / F2 < 0.0000001 -> ok. + +match_float(Bin0, Fsz, I) -> + Bin = make_sub_bin(Bin0), + Bsz = bit_size(Bin), + Tsz = Bsz - Fsz - I, + <<_:I,F:Fsz/float,_:Tsz>> = Bin, + F. + +pm_float_little() -> + F = f2(), + G = f_one(), + G = match_float_little(<<0,0,0,0,0,0,240,63>>, 64, 0), + G = match_float_little(<<0,0,128,63>>, 32, 0), + fcmp(F, match_float_little(<<F:32/float-little>>, 32, 0)), + fcmp(F, match_float_little(<<F:64/float-little>>, 64, 0)), + fcmp(F, match_float_little(<<1:1,F:32/float-little,127:7>>, 32, 1)), + fcmp(F, match_float_little(<<1:1,F:64/float-little,127:7>>, 64, 1)), + fcmp(F, match_float_little(<<1:13,F:32/float-little,127:3>>, 32, 13)), + fcmp(F, match_float_little(<<1:13,F:64/float-little,127:3>>, 64, 13)), + ok. + +match_float_little(Bin0, Fsz, I) -> + Bin = make_sub_bin(Bin0), + Bsz = bit_size(Bin), + Tsz = Bsz - Fsz - I, + <<_:I, F:Fsz/float-little, _:Tsz>> = Bin, + F. + +make_sub_bin(Bin0) -> + Sz = byte_size(Bin0), + Bin1 = <<37,Bin0/binary,38,39>>, + <<_:8,Bin:Sz/binary,_:8,_:8>> = Bin1, + Bin. + +f1() -> 3.1415. + +f2() -> 2.7133. + +f_one() -> 1.0. + +%%-------------------------------------------------------------------- +%% Some tests using size fields specified within the binary +pm_body_s(Bin, S1) -> + <<12, B1:S1/binary, B2:4/binary>> = Bin, %% 4 is hard-coded + {B1, B2}. + +pm_body_ss(Bin, S1, S2) -> + <<12, B1:S1/binary, B2:S2/binary>> = Bin, + {B1, B2}. + +pm_size_split(<<N:16, B:N/binary, T/binary>>) -> + {B, T}. + +pm_size_split_2(N, <<N:16, B:N/binary, T/binary>>) -> + {B, T}. + +pm_sizes_split(<<N0:8, N:N0, B:N/binary, T/binary>>) -> + {B, T}. + +pm_skip_segment(<<N:8, _:N/binary, T/binary>>) -> T. + +%%-------------------------------------------------------------------- +%% Some tests using multiple occurrences of size fields +pm_double_size_in_head(<<S:16, _:S/binary, _:S/binary, _/binary>>) -> + -S. + +pm_double_size_in_body(Bin) -> + <<S:16, _:S/binary, _:S/binary, _/binary>> = Bin, + -S. + +%%-------------------------------------------------------------------- +%% matching with 64-bit integers which become big nums +-define(BIG, 16#7fffffff7fffffff). + +pm_bigs() -> + <<X:64/little>> = <<?BIG:64/little>>, + true = (X =:= big()), + <<Y:64>> = <<?BIG:64>>, + true = (Y =:= big()), + ok. + +big() -> ?BIG. + +%%-------------------------------------------------------------------- + +pm_sean() -> + small = sean1(<<>>), + small = sean1(<<1>>), + small = sean1(<<1,2>>), + small = sean1(<<1,2,3>>), + large = sean1(<<1,2,3,4>>), + small = sean1(<<4>>), + small = sean1(<<4,5>>), + small = sean1(<<4,5,6>>), + {'EXIT', {function_clause, _}} = (catch sean1(<<4,5,6,7>>)), + ok. + +sean1(<<B/binary>>) when byte_size(B) < 4 -> small; +sean1(<<1, _/binary>>) -> large. + +%%-------------------------------------------------------------------- +%% Crashed on SPARC due to a bug in linear scan register allocator +pm_bin8(<<A, B, C, D, E, F, G, H>>) -> + 10 = add4(A, B, C, D), + 26 = add4(E, F, G, H), + ok. + +add4(X, Y, Z, W) -> + X + Y + Z + W. + +%%-------------------------------------------------------------------- +%% Cases that exposed bugs in the handling of bs_match_string with an +%% empty destination list. Reported on 2013/2/12 and fixed 2013/3/10. + +pm_bs_match_string() -> + Bin = <<42,42>>, + Bin = pm_match_string_head(Bin), + ok = (pm_match_string_fun())(Bin). + +pm_match_string_head(<<42, _/bits>> = B) -> B. + +pm_match_string_fun() -> + fun (<<X, _/bits>>) when X =:= 42 -> ok end. + +%%-------------------------------------------------------------------- +%% Match a lot to force a garbage collection which exposed a bug + +pm_till_gc() -> + Bin = <<16#76543210:32>>, + 16#76543210 = pm_a_lot(Bin, 1000000), + ok. + +pm_a_lot(<<X:32>>, 0) -> + X; +pm_a_lot(<<X:32>>, N) -> + pm_a_lot(<<X:32>>, N-1). diff --git a/lib/hipe/test/bs_SUITE_data/bs_pmatch_bugs.erl b/lib/hipe/test/bs_SUITE_data/bs_pmatch_bugs.erl new file mode 100644 index 0000000000..b280705a47 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_pmatch_bugs.erl @@ -0,0 +1,67 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +-module(bs_pmatch_bugs). + +-export([test/0]). + +test() -> + Bin = <<"123.123">>, + <<49,50,51>> = lex_digits1(Bin, 1, []), + <<49,50,51>> = lex_digits2(Bin, 1, []), + ok = var_bind_bug(<<1, 2, 3, 4, 5, 6, 7, 8>>), + ok. + +%%-------------------------------------------------------------------- +%% One of the lex_digits functions below gave incorrect results due to +%% incorrect pattern matching compilation of binaries by the byte code +%% compiler. Fixed by Bjorn Gustavsson on 5/3/2003. +%% -------------------------------------------------------------------- +lex_digits1(<<$., Rest/binary>>, _Val, _Acc) -> + Rest; +lex_digits1(<<N, Rest/binary>>, Val, Acc) when N >= $0, N =< $9 -> + lex_digits1(Rest, Val * 10 + dec(N), Acc); +lex_digits1(_Other, _Val, _Acc) -> + not_ok. + +lex_digits2(<<N, Rest/binary>>,Val, Acc) when N >= $0, N =< $9 -> + lex_digits2(Rest, Val * 10 + dec(N), Acc); +lex_digits2(<<$., Rest/binary>>, _Val, _Acc) -> + Rest; +lex_digits2(_Other, _Val, _Acc) -> + not_ok. + +dec(A) -> + A - $0. + +%%-------------------------------------------------------------------- +%% From: Bernard Duggan +%% Date: 11/3/2011 +%% +%% I've just run into an interesting little bit of behaviour that +%% doesn't seem quite right. erlc gives me the warning +%% +%% 43: Warning: this clause cannot match because a previous +%% clause at line 42 always matches +%% (line 42 is the "B -> wrong;" line). +%% +%% And sure enough, if you run test/0 you get 'wrong' back. +%% +%% That, in itself, is curious to me since by my understanding B should +%% be bound by the function header, and have no guarantee of being the +%% same as A. I can't see how it could be unbound. +%% +%% Doubly curious, is that if I stop using B as the size specifier of C, +%% like this: +%% +%% match(<<A:1/binary, B:8/integer, _C:1/binary, _Rest/binary>>) -> +%% +%% the warning goes away. And the result becomes 'ok' (in spite of +%% nothing in the body having changed, and the only thing changing in +%% the header being the size of an unused variable at the tail of the +%% binary). +%%-------------------------------------------------------------------- +var_bind_bug(<<A:1/binary, B:8/integer, _C:B/binary, _Rest/binary>>) -> + case A of + B -> wrong; + _ -> ok + end. diff --git a/lib/hipe/test/bs_SUITE_data/bs_pmatch_in_guards.erl b/lib/hipe/test/bs_SUITE_data/bs_pmatch_in_guards.erl new file mode 100644 index 0000000000..159227bb92 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_pmatch_in_guards.erl @@ -0,0 +1,23 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +%% Tests that basic cases of binary pattern matching in guards work +%%-------------------------------------------------------------------- +-module(bs_pmatch_in_guards). + +-export([test/0]). + +test() -> + 1 = in_guard(<<16#74ad:16>>, 16#e95, 5), + 2 = in_guard(<<16#3A,16#F7,"hello">>, 16#3AF7, <<"hello">>), + 3 = in_guard(<<16#FBCD:14,3.1415/float,3:2>>, 16#FBCD, 3.1415), + nope = in_guard(<<1>>, 42, b), + nope = in_guard(<<1>>, a, b), + nope = in_guard(<<1,2>>, 1, 1), + nope = in_guard(<<4,5>>, 1, 2.71), + nope = in_guard(<<4,5>>, 1, <<12,13>>), + ok. + +in_guard(Bin, A, B) when <<A:13,B:3>> == Bin -> 1; +in_guard(Bin, A, B) when <<A:16,B/binary>> == Bin -> 2; +in_guard(Bin, A, B) when <<A:14,B/float,3:2>> == Bin -> 3; +in_guard(_, _, _) -> nope. diff --git a/lib/hipe/test/bs_SUITE_data/bs_potpurri.erl b/lib/hipe/test/bs_SUITE_data/bs_potpurri.erl new file mode 100644 index 0000000000..8bc4fe5c88 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_potpurri.erl @@ -0,0 +1,200 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +-module(bs_potpurri). + +-export([test/0]). + +test() -> + ok = integer(), + ok = signed_integer(), + ok = dynamic(), + ok = more_dynamic(), + ok = mml(), + ok. + +%% compile(Opts0) -> +%% case proplists:get_bool(core, Opts0) of +%% true -> +%% test:note(?MODULE, "disabling compilation from core - BUG"), +%% Opts = [{core,false}|Opts0]; +%% false -> +%% Opts = Opts0 +%% end, +%% hipe:c(?MODULE, Opts). + +integer() -> + 0 = get_int(mkbin([])), + 0 = get_int(mkbin([0])), + 42 = get_int(mkbin([42])), + 255 = get_int(mkbin([255])), + 256 = get_int(mkbin([1,0])), + 257 = get_int(mkbin([1,1])), + 258 = get_int(mkbin([1,2])), + 258 = get_int(mkbin([1,2])), + 65534 = get_int(mkbin([255,254])), + 16776455 = get_int(mkbin([255,253,7])), + 4245492555 = get_int(mkbin([253,13,19,75])), + L = [200,1,19,128,222,42,97,111,200,1,19,128,222,42,97,111], + ok = cmp128(mkbin(L), uint(L)), + ok = fun_clause(catch get_int(mkbin(lists:seq(1,5)))), + ok. + +get_int(<<I:0>>) -> I; +get_int(<<I:8>>) -> I; +get_int(<<I:16>>) -> I; +get_int(<<I:24>>) -> I; +get_int(<<I:32>>) -> I. + +cmp128(<<I:128>>, I) -> ok; +cmp128(_Bin, _I) -> not_ok. + +signed_integer() -> + {no_match,_} = sint(mkbin([])), + {no_match,_} = sint(mkbin([1,2,3])), + 127 = sint(mkbin([127])), + -1 = sint(mkbin([255])), + -128 = sint(mkbin([128])), + 42 = sint(mkbin([42,255])), + 127 = sint(mkbin([127,255])), + ok. + +sint(Bin) -> + case Bin of + <<I:8/signed>> -> I; + <<I:8/signed,_:3,_:5>> -> I; + Other -> {no_match,Other} + end. + +uint(L) -> uint(L, 0). + +uint([H|T], Acc) -> uint(T, Acc bsl 8 bor H); +uint([], Acc) -> Acc. + +dynamic() -> + ok = dynamic(mkbin([255]), 8), + ok = dynamic(mkbin([255,255]), 16), + ok = dynamic(mkbin([255,255,255]), 24), + ok = dynamic(mkbin([255,255,255,255]), 32), + ok. + +dynamic(Bin, S1) when S1 >= 0 -> + S2 = bit_size(Bin) - S1, + dynamic(Bin, S1, S2, (1 bsl S1) - 1, (1 bsl S2) - 1), + dynamic(Bin, S1-1); +dynamic(_Bin, _) -> ok. + +dynamic(Bin, S1, S2, A, B) -> + %% io:format("~p ~p ~p ~p\n", [S1,S2,A,B]), + case Bin of + <<A:S1,B:S2>> -> + %% io:format("~p ~p ~p ~p\n", [S1,S2,A,B]), + ok; + <<A1:S1,B2:S2>> -> erlang:error(badmatch, [Bin,S1,S2,A,B,A1,B2]) + end. + +more_dynamic() -> + %% Unsigned big-endian numbers. + Unsigned = fun(Bin, List, SkipBef, N) -> + SkipAft = bit_size(Bin) - N - SkipBef, + <<_I1:SkipBef,Int:N,_I2:SkipAft>> = Bin, + Int = make_int(List, N, 0) + end, + ok = more_dynamic1(Unsigned, funny_binary(42)), + + %% Signed big-endian numbers. + Signed = fun(Bin, List, SkipBef, N) -> + SkipAft = bit_size(Bin) - N - SkipBef, + <<_I1:SkipBef,Int:N/signed,_I2:SkipAft>> = Bin, + case make_signed_int(List, N) of + Int -> ok; + Other -> + io:format("Bin = ~p,", [Bin]), + io:format("SkipBef = ~p, N = ~p", [SkipBef,N]), + io:format("Expected ~p, got ~p", [Int,Other]), + exit(Other) + end + end, + ok = more_dynamic1(Signed, funny_binary(43)), + + %% Unsigned little-endian numbers. + UnsLittle = fun(Bin, List, SkipBef, N) -> + SkipAft = bit_size(Bin) - N - SkipBef, + <<_I1:SkipBef,Int:N/little,_I2:SkipAft>> = Bin, + Int = make_int(big_to_little(List, N), N, 0) + end, + more_dynamic1(UnsLittle, funny_binary(44)), + + %% Signed little-endian numbers. + SignLittle = fun(Bin, List, SkipBef, N) -> + SkipAft = bit_size(Bin) - N - SkipBef, + <<_I1:SkipBef,Int:N/signed-little,_I2:SkipAft>> = Bin, + Little = big_to_little(List, N), + Int = make_signed_int(Little, N) + end, + ok = more_dynamic1(SignLittle, funny_binary(45)), + + ok. + +funny_binary(N) -> + B0 = erlang:md5([N]), + {B1,_B2} = split_binary(B0, byte_size(B0) div 2), + B1. + +more_dynamic1(Action, Bin) -> + BitList = bits_to_list(binary_to_list(Bin), 16#80), + more_dynamic2(Action, Bin, BitList, 0). + +more_dynamic2(Action, Bin, [_|T]=List, Bef) -> + more_dynamic3(Action, Bin, List, Bef, bit_size(Bin)), + more_dynamic2(Action, Bin, T, Bef+1); +more_dynamic2(_Action, _Bin, [], _Bef) -> ok. + +more_dynamic3(Action, Bin, List, Bef, Aft) when Bef =< Aft -> + %% io:format("~p, ~p", [Bef,Aft-Bef]), + Action(Bin, List, Bef, Aft-Bef), + more_dynamic3(Action, Bin, List, Bef, Aft-1); +more_dynamic3(_, _, _, _, _) -> ok. + +big_to_little(List, N) -> big_to_little(List, N, []). + +big_to_little([B0,B1,B2,B3,B4,B5,B6,B7|T], N, Acc) when N >= 8 -> + big_to_little(T, N-8, [B0,B1,B2,B3,B4,B5,B6,B7|Acc]); +big_to_little(List, N, Acc) -> lists:sublist(List, 1, N) ++ Acc. + +make_signed_int(_List, 0) -> 0; +make_signed_int([0|_]=List, N) -> make_int(List, N, 0); +make_signed_int([1|_]=List0, N) -> + List1 = reversed_sublist(List0, N, []), + List2 = two_complement_and_reverse(List1, 1, []), + -make_int(List2, length(List2), 0). + +reversed_sublist(_List, 0, Acc) -> Acc; +reversed_sublist([H|T], N, Acc) -> reversed_sublist(T, N-1, [H|Acc]). + +two_complement_and_reverse([H|T], Carry, Acc) -> + Sum = 1 - H + Carry, + two_complement_and_reverse(T, Sum div 2, [Sum rem 2|Acc]); +two_complement_and_reverse([], Carry, Acc) -> [Carry|Acc]. + +make_int(_List, 0, Acc) -> Acc; +make_int([H|T], N, Acc) -> make_int(T, N-1, Acc bsl 1 bor H). + +bits_to_list([_|T], 0) -> bits_to_list(T, 16#80); +bits_to_list([H|_]=List, Mask) -> + [case H band Mask of + 0 -> 0; + _ -> 1 + end|bits_to_list(List, Mask bsr 1)]; +bits_to_list([], _) -> []. + +fun_clause({'EXIT',{function_clause,_}}) -> ok. + +mkbin(L) when is_list(L) -> list_to_binary(L). + +mml() -> + single_byte_binary = mml_choose(<<42>>), + multi_byte_binary = mml_choose(<<42,43>>), + ok. + +mml_choose(<<_:8>>) -> single_byte_binary; +mml_choose(<<_:8, _T/binary>>) -> multi_byte_binary. diff --git a/lib/hipe/test/bs_SUITE_data/bs_remove3.erl b/lib/hipe/test/bs_SUITE_data/bs_remove3.erl new file mode 100644 index 0000000000..a98b0b5b28 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_remove3.erl @@ -0,0 +1,104 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_remove3.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : +%%% +%%% Created : 13 Apr 2004 by Per Gustafsson +%%%------------------------------------------------------------------- +-module(bs_remove3). + +-export([test/0]). + +-define(A, <<56,0,120,0,0,31,255,255,102,42,12,0,3,3,16,5,24,3,240,0,0,32,0,196, + 2,128,4,0,255,255,254,33,68,96,0,8,8,213,40,192,31,196,0,4,0,0>>). +-define(B, <<28,32,0,96,0,8,0,7,255,255,212,33,98,12,0,0,1,0,48,72,66,3,0,7,240, + 64,0,0,8,0,0,224,0,10,128,0,64,0,63,255,254,133,10,80,96,0,0,8,1,6, + 18,4,24,0,63,128,0,0,4,64,0,0>>). + +test() -> + Bin1 = <<30,16,0,90,0,1,0,0,255,255,255,255,81,67,101,7,0, + 0,0,96,6,12,146,18,14,0,15,252,16,0,0,17,0,0>>, + Bin = <<Bin1/binary, Bin1/binary>>, + ?A = loop(Bin, 10, fun run_list/1), + ?A = loop(Bin, 10, fun run_bin/1), + ?B = loop(Bin, 10, fun r31/1), + ok. + +loop(Arg, 0, F) -> + F(Arg); +loop(Arg, N, F) -> + F(Arg), + loop(Arg, N-1, F). + +run_list(Bin) -> + List = run1(Bin), + list_to_binary(List). + +run1(<<A1:2,_:1,A2:2,_:1,A3:2,_:1,A4:2,_:1, + A5:2,_:1,A6:2,_:1,A7:2,_:1,A8:2,_:1,Rest/binary>>) -> + [<<A1:2,A2:2,A3:2,A4:2,A5:2,A6:2,A7:2,A8:2>>, run2(Rest)]; +run1(<<A1:2,_:1,A2:2,_:1,A3:2,_:1,A4:2,_:1,A5:2,_:1,A6:1>>) -> + [<<A1:2,A2:2,A3:2,A4:2,A5:2,A6:1,0:5>>]; +run1(<<A1:2,_:1,A2:2,_:1,A3:2>>) -> + [<<A1:2,A2:2,A3:2,0:2>>]; +run1(<<>>) -> + []. + +run_bin(Bin) -> + run2(Bin). + +run2(<<A1:2,_:1,A2:2,_:1,A3:2,_:1,A4:2,_:1, + A5:2,_:1,A6:2,_:1,A7:2,_:1,A8:2,_:1,Rest/binary>>) -> + Bin = run2(Rest), + <<A1:2,A2:2,A3:2,A4:2,A5:2,A6:2,A7:2,A8:2,Bin/binary>>; +run2(<<A1:2,_:1,A2:2,_:1,A3:2,_:1,A4:2,_:1,A5:2,_:1,A6:1>>) -> + <<A1:2,A2:2,A3:2,A4:2,A5:2,A6:1,0:5>>; +run2(<<A1:2,_:1,A2:2,_:1,A3:2>>) -> + <<A1:2,A2:2,A3:2,0:2>>; +run2(<<>>) -> + <<>>. + +r31(Bin) -> + List = remove3rd1(0, 0, Bin, [-1]), + build(List, Bin, 0, <<>>). + +build([N1, N2|Rest], Bin, N, Present) -> + X = N1+1, Y = N2-X, + S = rest(N2), + <<_:X,A:Y,_:S,_/binary>> = Bin, + S1 = rest(N+Y), + NewPresent = <<Present:N/binary-unit:1, A:Y, 0:S1>>, + build([N2|Rest], Bin, N+Y, NewPresent); + +build([_], _Bin, _N, Present) -> + Present. + +rest(X) -> + case 8 - (X rem 8) of + 8 -> 0; + H -> H + end. + +remove3rd1(N, 2, Bin, List) -> + S = rest(N+1), + case Bin of + <<_:N, 1:1, _:S,_/binary>> -> + remove3rd1(N+1, 0, Bin, [N|List]); + <<_:N, 0:1, _:S,_/binary>> -> + remove3rd1(N+1, 2, Bin, List); + _ -> + Size = byte_size(Bin) * 8, + lists:reverse([Size|List]) + end; +remove3rd1(N, I, Bin, List) -> + S = rest(N+1), + case Bin of + <<_:N, 1:1, _:S,_/binary>> -> + remove3rd1(N+1, I+1, Bin, List); + <<_:N, 0:1, _:S,_/binary>> -> + remove3rd1(N+1, I, Bin, List); + _ -> + Size = byte_size(Bin) * 8, + lists:reverse([Size|List]) + end. diff --git a/lib/hipe/test/bs_SUITE_data/bs_save.erl b/lib/hipe/test/bs_SUITE_data/bs_save.erl new file mode 100644 index 0000000000..fe2b1105f2 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_save.erl @@ -0,0 +1,21 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_save.erl +%%% Author : Per Gustafsson +%%% Purpose : Tests that compilation works for bs_save +%%% Created : 1 Nov 2007 +%%%------------------------------------------------------------------- +-module(bs_save). + +-export([test/0]). + +test() -> + {[16257, 1], <<0>>} = inc_on_ones(<<255,1,128,1,128,0>>, 0, [], 5), + ok. + +inc_on_ones(Buffer, _Av, Al, 0) -> + {lists:reverse(Al), Buffer}; +inc_on_ones(<<1:1, H:7, T/binary>>, Av, Al, Len) -> + inc_on_ones(T, (Av bsl 7) bor H, Al, Len-1); +inc_on_ones(<<H, T/binary>>, Av, Al, Len) -> + inc_on_ones(T, 0, [((Av bsl 7) bor H)|Al], Len-1). diff --git a/lib/hipe/test/bs_SUITE_data/bs_shell_native.erl b/lib/hipe/test/bs_SUITE_data/bs_shell_native.erl new file mode 100644 index 0000000000..b438f8d9ef --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_shell_native.erl @@ -0,0 +1,275 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_shell_native.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : Tests that the Erlang shell works well when in native +%%% Created : 6 Sep 2006 +%%%------------------------------------------------------------------- +-module(bs_shell_native). + +-export([prepare_for_test/0, test/0]). +%% These need to be exported so that we emulate calling them from the shell +-export([parse_and_eval/1, receiver/1, receiver_alot/1, send_alot/3]). + +%% This makes sure the shell runs native code +prepare_for_test() -> + lists:foreach(fun (M) -> {ok, M} = hipe:c(M) end, [erl_bits, erl_eval]). + +test() -> + ok = eval_bits_in_shell(), + ok = eval_bin_comp_in_shell(), + ok. + +%%-------------------------------------------------------------------- +%% Tests for bit stream operations including matching, construction +%% and binary_to_list, list_to_binary in the shell +eval_bits_in_shell() -> + <<1:100>> = parse_and_eval("<<1:100>> = <<1:100>>."), + ok = match(7), + ok = match(9), + ok = match1(15), + ok = match1(31), + ok = horrid_match(), + ok = test_bitstr(), + ok = test_bitsize(), + ok = asymmetric_tests(), + ok = big_asymmetric_tests(), + ok = binary_to_and_from_list(), + ok = big_binary_to_and_from_list(), + ok = send_and_receive(), + ok = send_and_receive_alot(), + ok. + +parse_and_eval(String) -> + {ok, Toks, _} = erl_scan:string(String), + {ok, Exprs} = erl_parse:parse_exprs(Toks), + Bnds = erl_eval:new_bindings(), + case erl_eval:exprs(Exprs, Bnds) of + {value, V, _} -> + V; + V -> + V + end. + +match(N) -> + Str = "N =" ++ integer_to_list(N) ++ ", <<0:N>> = <<0:N>>.", + <<0:N>> = parse_and_eval(Str), + ok. + +match1(N) -> + Str = "N =" ++ integer_to_list(N) ++ ", <<42:N/little>> = <<42:N/little>>.", + <<42:N/little>> = parse_and_eval(Str), + ok. + +test_bitsize() -> + 101 = parse_and_eval("101 = erlang:bit_size(<<1:101>>)."), + 1001 = parse_and_eval("1001 = erlang:bit_size(<<1:1001>>)."), + 80 = parse_and_eval("80 = erlang:bit_size(<<1:80>>)."), + 800 = parse_and_eval("800 = erlang:bit_size(<<1:800>>)."), + S = + "Bin = <<0:16#1000000>>," + "BigBin = list_to_bitstring([Bin||_ <- lists:seq(1,16#10)] ++ [<<1:1>>])," + "16#10000001 = erlang:bit_size(BigBin).", + 16#10000001 = parse_and_eval(S), + %% Only run these on computers with lots of memory + %% HugeBin = list_to_bitstring([BigBin||_ <- lists:seq(1,16#10)]++[<<1:1>>]), + %% 16#100000011 = erlang:bit_size(HugeBin), + 0 = parse_and_eval("0 = erlang:bit_size(<<>>)."), + ok. + +horrid_match() -> + S = "<<1:4,B:24/bitstring>> = <<1:4,42:24/little>>, <<42:24/little>> = B.", + <<42:24/little>> = parse_and_eval(S), + ok. + +test_bitstr() -> + S = + "<<1:7,B/bitstring>> = <<1:7,<<1:1,6>>/bitstring>>," + "<<1:1,6>> = B," + "B = <<1:1,6>>.", + <<1:1,6>> = parse_and_eval(S), + ok. + +asymmetric_tests() -> + <<1:12>> = parse_and_eval("<<1:12>> = <<0,1:4>>."), + <<0,1:4>> = parse_and_eval("<<0,1:4>> = <<1:12>>."), + S1 = + "<<1:1,X/bitstring>> = <<128,255,0,0:2>>," + "<<1,254,0,0:1>> = X," + "X = <<1,254,0,0:1>>.", + <<1,254,0,0:1>> = parse_and_eval(S1), + S2 = + "<<1:1,X1:25/bitstring>> = <<128,255,0,0:2>>," + "<<1,254,0,0:1>> = X1," + "X1 = <<1,254,0,0:1>>.", + <<1,254,0,0:1>> = parse_and_eval(S2), + ok. + +big_asymmetric_tests() -> + <<1:875,1:12>> = parse_and_eval("<<1:875,1:12>> = <<1:875,0,1:4>>."), + <<1:875,0,1:4>> = parse_and_eval("<<1:875,0,1:4>> = <<1:875,1:12>>."), + S1 = + "<<1:1,X/bitstring>> = <<128,255,0,0:2,1:875>>," + "<<1,254,0,0:1,1:875>> = X," + "X = <<1,254,0,0:1,1:875>>.", + <<1,254,0,0:1,1:875>> = parse_and_eval(S1), + S2 = + "<<1:1,X1:900/bitstring>> = <<128,255,0,0:2,1:875>>," + "<<1,254,0,0:1,1:875>> = X1," + "X1 = <<1,254,0,0:1,1:875>>.", + parse_and_eval(S2), + ok. + +binary_to_and_from_list() -> + <<1:7>> = parse_and_eval("list_to_bitstring(bitstring_to_list(<<1:7>>))."), + <<1,2,3,4,1:1>> = parse_and_eval("list_to_bitstring(bitstring_to_list(<<1,2,3,4,1:1>>))."), + [1,2,3,4,<<1:1>>] = parse_and_eval("bitstring_to_list(<<1,2,3,4,1:1>>)."), + <<1:1,1,2,3,4>> = parse_and_eval("list_to_bitstring([<<1:1>>,1,2,3,4])."), + [128,129,1,130,<<0:1>>] = parse_and_eval("bitstring_to_list(<<1:1,1,2,3,4>>)."), + ok. + +big_binary_to_and_from_list() -> + S1 = "erlang:list_to_bitstring(bitstring_to_list(<<1:800,2,3,4,1:1>>)).", + <<1:800,2,3,4,1:1>> = parse_and_eval(S1), + S2 = "erlang:bitstring_to_list(<<1,2,3,4,1:800,1:1>>).", + [1,2,3,4|_Rest1] = parse_and_eval(S2), + S3 = "erlang:list_to_bitstring([<<1:801>>,1,2,3,4]).", + <<1:801,1,2,3,4>> = parse_and_eval(S3), + ok. + +send_and_receive() -> + S = + "Bin = <<1,2:7>>," + "Pid = spawn(fun() -> bs_shell_native:receiver(Bin) end)," + "Pid ! {self(),<<1:7,8:5,Bin/bitstring>>}," + "receive ok -> ok end.", + parse_and_eval(S). + +receiver(Bin) -> + receive + {Pid, <<1:7,8:5,Bin/bitstring>>} -> + Pid ! ok + end. + +send_and_receive_alot() -> + S = + "Bin = <<1:1000001>>," + "Pid = spawn(fun() -> bs_shell_native:receiver_alot(Bin) end)," + "bs_shell_native:send_alot(100,Bin,Pid).", + parse_and_eval(S). + +send_alot(N,Bin,Pid) when N > 0 -> + Pid ! {self(),<<1:7,8:5,Bin/bitstring>>}, + receive + ok -> + ok + end, + send_alot(N-1,Bin,Pid); +send_alot(0,_Bin,Pid) -> + Pid ! no_more, + ok. + +receiver_alot(Bin) -> + receive + {Pid, <<1:7,8:5,Bin/bitstring>>} -> + Pid ! ok; + no_more -> ok + end, + receiver_alot(Bin). + +%%-------------------------------------------------------------------- + +eval_bin_comp_in_shell() -> + ok = byte_aligned(), + ok = bit_aligned(), + ok = extended_byte_aligned(), + ok = extended_bit_aligned(), + ok = mixed(), + ok. + +byte_aligned() -> + <<"abcdefg">> = + parse_and_eval("<<\"abcdefg\">> = << <<(X+32)>> || <<X>> <= <<\"ABCDEFG\">> >>."), + <<1:32/little,2:32/little,3:32/little,4:32/little>> = + parse_and_eval("<<1:32/little,2:32/little,3:32/little,4:32/little>> = + << <<X:32/little>> || <<X:32>> <= <<1:32,2:32,3:32,4:32>> >>."), + <<1:32/little,2:32/little,3:32/little,4:32/little>> = + parse_and_eval("<<1:32/little,2:32/little,3:32/little,4:32/little>> = + << <<X:32/little>> || <<X:16>> <= <<1:16,2:16,3:16,4:16>> >>."), + ok. + +bit_aligned() -> + <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + parse_and_eval("<<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + << <<(X+32):7>> || <<X>> <= <<\"ABCDEFG\">> >>."), + <<"ABCDEFG">> = + parse_and_eval("<<\"ABCDEFG\">> = + << <<(X-32)>> || <<X:7>> <= <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> >>."), + <<1:31/little,2:31/little,3:31/little,4:31/little>> = + parse_and_eval("<<1:31/little,2:31/little,3:31/little,4:31/little>> = + << <<X:31/little>> || <<X:31>> <= <<1:31,2:31,3:31,4:31>> >>."), + <<1:31/little,2:31/little,3:31/little,4:31/little>> = + parse_and_eval("<<1:31/little,2:31/little,3:31/little,4:31/little>> = + << <<X:31/little>> || <<X:15>> <= <<1:15,2:15,3:15,4:15>> >>."), + ok. + +extended_byte_aligned() -> + <<"abcdefg">> = + parse_and_eval("<<\"abcdefg\">> = << <<(X+32)>> || X <- \"ABCDEFG\" >>."), + "abcdefg" = + parse_and_eval("\"abcdefg\" = [(X+32) || <<X>> <= <<\"ABCDEFG\">>]."), + <<1:32/little,2:32/little,3:32/little,4:32/little>> = + parse_and_eval("<<1:32/little,2:32/little,3:32/little,4:32/little>> = + << <<X:32/little>> || X <- [1,2,3,4] >>."), + [256,512,768,1024] = + parse_and_eval("[256,512,768,1024] = + [X || <<X:16/little>> <= <<1:16,2:16,3:16,4:16>>]."), + ok. + +extended_bit_aligned() -> + <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + parse_and_eval("<<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + << <<(X+32):7>> || X <- \"ABCDEFG\" >>."), + "ABCDEFG" = + parse_and_eval("\"ABCDEFG\" = [(X-32) || <<X:7>> <= +<<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>>]."), + <<1:31/little,2:31/little,3:31/little,4:31/little>> = + parse_and_eval("<<1:31/little,2:31/little,3:31/little,4:31/little>> = + << <<X:31/little>> || X <- [1,2,3,4] >>."), + [256,512,768,1024] = + parse_and_eval("[256,512,768,1024] = + [X || <<X:15/little>> <= <<1:15,2:15,3:15,4:15>>]."), + ok. + +mixed() -> + <<2,3,3,4,4,5,5,6>> = + parse_and_eval("<<2,3,3,4,4,5,5,6>> = + << <<(X+Y)>> || <<X>> <= <<1,2,3,4>>, <<Y>> <= <<1,2>> >>."), + <<2,3,3,4,4,5,5,6>> = + parse_and_eval("<<2,3,3,4,4,5,5,6>> = + << <<(X+Y)>> || <<X>> <= <<1,2,3,4>>, Y <- [1,2] >>."), + <<2,3,3,4,4,5,5,6>> = + parse_and_eval("<<2,3,3,4,4,5,5,6>> = + << <<(X+Y)>> || X <- [1,2,3,4], Y <- [1,2] >>."), + [2,3,3,4,4,5,5,6] = + parse_and_eval("[2,3,3,4,4,5,5,6] = + [(X+Y) || <<X>> <= <<1,2,3,4>>, <<Y>> <= <<1,2>>]."), + [2,3,3,4,4,5,5,6] = + parse_and_eval("[2,3,3,4,4,5,5,6] = + [(X+Y) || <<X>> <= <<1,2,3,4>>, Y <- [1,2]]."), + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + parse_and_eval("<<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + << <<(X+Y):3>> || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, <<Y:3>> <= <<1:3,2:3>> >>."), + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + parse_and_eval("<<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + << <<(X+Y):3>> || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, Y <- [1,2] >>."), + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + parse_and_eval("<<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + << <<(X+Y):3>> || X <- [1,2,3,4], Y <- [1,2] >>."), + [2,3,3,4,4,5,5,6] = + parse_and_eval("[2,3,3,4,4,5,5,6] = + [(X+Y) || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, <<Y:3>> <= <<1:3,2:3>>]."), + [2,3,3,4,4,5,5,6] = + parse_and_eval("[2,3,3,4,4,5,5,6] = + [(X+Y) || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, Y <- [1,2]]."), + ok. diff --git a/lib/hipe/test/bs_SUITE_data/bs_split.erl b/lib/hipe/test/bs_SUITE_data/bs_split.erl new file mode 100644 index 0000000000..2e52308a77 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_split.erl @@ -0,0 +1,105 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- + +-module(bs_split). + +-export([test/0]). + +test() -> + Funs = [fun byte_split_binary/0, fun bit_split_binary/0, fun z_split/0], + lists:foreach(fun (F) -> ok = F() end, Funs). + +%%-------------------------------------------------------------------- + +byte_split_binary() -> + L = lists:seq(0, 57), + B = mkbin(L), + byte_split(L, B, byte_size(B)). + +byte_split(L, B, Pos) when Pos >= 0 -> + Sz1 = Pos, + Sz2 = byte_size(B) - Pos, + bs1(L, B, Pos, Sz1, Sz2); +byte_split(_, _, _) -> ok. + +bs1(L, B, Pos, Sz1, Sz2) -> + <<B1:Sz1/binary, B2:Sz2/binary>> = B, + bs2(L, B, Pos, B1, B2). + +bs2(L, B, Pos, B1, B2)-> + B1 = list_to_binary(lists:sublist(L, 1, Pos)), + bs3(L, B, Pos, B2). + +bs3(L, B, Pos, B2) -> + B2 = list_to_binary(lists:nthtail(Pos, L)), + byte_split(L, B, Pos-1). + +%%-------------------------------------------------------------------- + +bit_split_binary() -> + Fun = fun(Bin, List, SkipBef, N) -> + SkipAft = bit_size(Bin) - N - SkipBef, + %% io:format("~p, ~p, ~p", [SkipBef,N,SkipAft]), + <<_I1:SkipBef,OutBin:N/binary-unit:1,_I2:SkipAft>> = Bin, + OutBin = make_bin_from_list(List, N) + end, + bit_split_binary1(Fun, erlang:md5(<<1,2,3>>)). + +bit_split_binary1(Action, Bin) -> + BitList = bits_to_list(binary_to_list(Bin), 16#80), + bit_split_binary2(Action, Bin, BitList, 0). + +bit_split_binary2(Action, Bin, [_|T]=List, Bef) -> + bit_split_binary3(Action, Bin, List, Bef, bit_size(Bin)), + bit_split_binary2(Action, Bin, T, Bef+1); +bit_split_binary2(_Action, _Bin, [], _Bef) -> ok. + +bit_split_binary3(Action, Bin, List, Bef, Aft) when Bef =< Aft -> + Action(Bin, List, Bef, (Aft-Bef) div 8 * 8), + bit_split_binary3(Action, Bin, List, Bef, Aft-8); +bit_split_binary3(_, _, _, _, _) -> ok. + +make_bin_from_list(_List, 0) -> + mkbin([]); +make_bin_from_list(List, N) -> + list_to_binary([make_int(List, 8, 0), + make_bin_from_list(lists:nthtail(8, List), N-8)]). + +make_int(_List, 0, Acc) -> Acc; +make_int([H|T], N, Acc) -> make_int(T, N-1, Acc bsl 1 bor H). + +bits_to_list([_|T], 0) -> bits_to_list(T, 16#80); +bits_to_list([H|_]=List, Mask) -> + [case H band Mask of + 0 -> 0; + _ -> 1 + end|bits_to_list(List, Mask bsr 1)]; +bits_to_list([], _) -> []. + +mkbin(L) when is_list(L) -> list_to_binary(L). + +%%-------------------------------------------------------------------- +%% Splits a series of null terminated segments of a binary without +%% creating any new sub-binaries until the zero is found. + +z_split() -> + [<<61,62,63>>] = z_split(<<61,62,63>>), + [<<61,62,63>>, <<>>] = z_split(<<61,62,63,0>>), + [<<61,62,63>>, <<64>>] = z_split(<<61,62,63,0,64>>), + [<<61,62,63>>, <<64,65,66>>] = z_split(<<61,62,63,0,64,65,66>>), + [<<61,62>>, <<64>>, <<>>, <<65,66>>] = z_split(<<61,62,0,64,0,0,65,66>>), + ok. + +z_split(B) when is_binary(B) -> + z_split(B, 0). + +z_split(B, N) -> + case B of + <<_B1:N/binary,0,_B2/binary>> -> % use skip_bits for B1, B2 + <<B1:N/binary,_,B2/binary>> = B, % and postpone the matching + [B1 | z_split(B2)]; + <<_:N/binary>> -> + [B]; + _ -> + z_split(B, N+1) + end. diff --git a/lib/hipe/test/bs_SUITE_data/bs_system_limit_32.erl b/lib/hipe/test/bs_SUITE_data/bs_system_limit_32.erl new file mode 100644 index 0000000000..eccb0083bd --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_system_limit_32.erl @@ -0,0 +1,26 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_system_limit_32.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : Checks binary system limits on 32-bit machines +%%% Created : 14 May 2008 +%%%------------------------------------------------------------------- +-module(bs_system_limit_32). + +-export([test/0]). + +test() -> + case erlang:system_info(wordsize) of + 4 -> system_limit_32(); + 8 -> ok + end. + +system_limit_32() -> + {'EXIT', {badarg, _}} = (catch <<42:(id(-1))>>), + {'EXIT', {badarg, _}} = (catch <<42:(id(-389739873536870912))/unit:8>>), + {'EXIT', {system_limit, _}} = (catch <<32:536870912/unit:8>>), + {'EXIT', {system_limit, _}} = (catch <<42:(id(536870912))/unit:8>>), + {'EXIT', {system_limit, _}} = (catch <<42:(id(536870912))/unit:8,1:1>>), + ok. + +id(X) -> X. diff --git a/lib/hipe/test/bs_SUITE_data/bs_utf.erl b/lib/hipe/test/bs_SUITE_data/bs_utf.erl new file mode 100644 index 0000000000..f50ae08964 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_utf.erl @@ -0,0 +1,18 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------- +%% Purpose: test support for UTF datatypes in binaries - INCOMPLETE +%%------------------------------------------------------------------- + +-module(bs_utf). + +-export([test/0]). + +test() -> + <<65>> = b65utf8(), + ok = m(<<65>>). + +m(<<65/utf8>>) -> + ok. + +b65utf8() -> + <<65/utf8>>. diff --git a/lib/hipe/test/bs_SUITE_data/bs_var_segs.erl b/lib/hipe/test/bs_SUITE_data/bs_var_segs.erl new file mode 100644 index 0000000000..a20df04b53 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_var_segs.erl @@ -0,0 +1,76 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +%% Author : Kostis Sagonas +%% Purpose : These tests are intended to test the construction and +%% matching of binaries using variable sizes +%% Notes : +%% - Added test that crashed BEAM compiler +%% - Added test that crashed when segments of size zero were used +%% and one that did not convert integers to floats when constructing +%% binaries. +%% - Added a construction test which crashed from core because of +%% problems with the effect flag (2004/11/15) +%%-------------------------------------------------------------------- +-module(bs_var_segs). + +-export([test/0]). + +test() -> + N1 = 18, + A1 = 2, + A1 = match1(N1, <<1:12, 2:N1, A1:2>>), + A1 = match2(N1, <<1:12, 2:N1/integer-little, A1:2>>), + N3 = 3, + A3 = <<1,2,3>>, + B3 = 2, + {A3, B3} = match3(N3, <<1:12, A3:N3/binary, B3:4>>), + N4 = 12, + B4 = <<1,2,3>>, + A4 = 2, + {A4, B4} = match4(N4, <<1:N4, A4:4, B4/binary>>), + Y = <<5>>, + Y = match5(a, Y), + <<73>> = gen1(8, 0, <<73>>), + <<171>> = gen2(8, 7, 2#10101010101010101), + <<0:64>> = construct(), + <<0:32>> = construct2(0), + ok = in_guard(<<16#BCD:14,3:2>>, 16#BCD), + ok. + +construct() -> + <<0:64/float>>. + +construct2(X) -> + <<X:32/little>>. + +match1(N, Bin) -> + <<1:12, 2:N, A:2>>=Bin, + A. + +match2(N, Bin) -> + <<1:12, 2:N/integer-little, A:2>>=Bin, + A. + +match3(N, Bin) -> + <<1:12, A:N/binary, B:4>>=Bin, + {A,B}. + +match4(N, Bin) -> + <<1:N, A:4, B/binary>>=Bin, + {A,B}. + +match5(X, Y) -> + case X of + a -> + Y2 = 8 + end, + <<5:Y2>> = Y. + +gen1(N, S, A) -> + <<A:S/binary-unit:1, A:(N-S)/binary-unit:1>>. + +gen2(N, S, A) -> + <<A:S/little, A:(N-S)/little>>. + +in_guard(Bin, A) when <<A:14,3:2>> == Bin -> ok; +in_guard(_, _) -> no. diff --git a/lib/hipe/test/hipe.spec b/lib/hipe/test/hipe.spec index 6b0b226dc3..2894f40354 100644 --- a/lib/hipe/test/hipe.spec +++ b/lib/hipe/test/hipe.spec @@ -1 +1,6 @@ -{suites,"../hipe_test",all}. +%% -*- erlang -*- + +{alias, tests, "../hipe_test"}. + +{suites, tests, all}. + diff --git a/lib/hipe/test/hipe_testsuite_driver.erl b/lib/hipe/test/hipe_testsuite_driver.erl new file mode 100644 index 0000000000..c8fdf1600c --- /dev/null +++ b/lib/hipe/test/hipe_testsuite_driver.erl @@ -0,0 +1,182 @@ +-module(hipe_testsuite_driver). + +-export([create_all_suites/0, run/3]). + +-include_lib("kernel/include/file.hrl"). + +-type testcase() :: atom(). +-type file_type() :: 'device' | 'directory' | 'regular' | 'other'. +-type ext_posix() :: file:posix() | 'badarg'. + +-define(suite_suffix, "_SUITE"). +-define(data_folder, "_data"). +-define(suite_data, ?suite_suffix ++ ?data_folder). + +-record(suite, {suitename :: string(), + outputfile :: file:io_device(), + testcases :: [testcase()]}). + +-spec create_all_suites() -> 'ok'. + +create_all_suites() -> + {ok, Cwd} = file:get_cwd(), + Suites = get_suites(Cwd), + lists:foreach(fun create_suite/1, Suites). + +-spec get_suites(file:filename()) -> [string()]. + +get_suites(Dir) -> + case file:list_dir(Dir) of + {error, _} -> []; + {ok, Filenames} -> + FullFilenames = [filename:join(Dir, F) || F <- Filenames], + Dirs = [suffix(filename:basename(F), ?suite_data) || + F <- FullFilenames, + file_type(F) =:= {ok, 'directory'}], + [S || {yes, S} <- Dirs] + end. + +suffix(String, Suffix) -> + case string:rstr(String, Suffix) of + 0 -> no; + Index -> + case string:substr(String, Index) =:= Suffix of + true -> {yes, string:sub_string(String, 1, Index-1)}; + false -> no + end + end. + +-spec file_type(file:filename()) -> {ok, file_type()} | {error, ext_posix()}. + +file_type(Filename) -> + case file:read_file_info(Filename) of + {ok, FI} -> {ok, FI#file_info.type}; + Error -> Error + end. + +-spec create_suite(string()) -> 'ok'. + +create_suite(SuiteName) -> + {ok, Cwd} = file:get_cwd(), + SuiteDirN = filename:join(Cwd, SuiteName ++ ?suite_data), + OutputFile = generate_suite_file(Cwd, SuiteName), + generate_suite(SuiteName, OutputFile, SuiteDirN). + +generate_suite_file(Cwd, SuiteName) -> + F = filename:join(Cwd, SuiteName ++ ?suite_suffix ++ ".erl"), + case file:open(F, [write]) of + {ok, IoDevice} -> IoDevice; + {error, _} = E -> exit({E, F}) + end. + +generate_suite(SuiteName, OutputFile, SuiteDirN) -> + TestCases = list_testcases(SuiteDirN), + Suite = #suite{suitename = SuiteName, outputfile = OutputFile, + testcases = TestCases}, + write_suite(Suite), + file:close(OutputFile). + +list_testcases(Dirname) -> + {ok, Files} = list_dir(Dirname, ".erl", true), + [list_to_atom(filename:basename(F, ".erl")) || F <- Files]. + +-spec list_dir(file:filename(), string(), boolean()) -> + {error, ext_posix()} | {ok, [file:filename()]}. + +list_dir(Dir, Extension, Dirs) -> + case file:list_dir(Dir) of + {error, _} = Error-> Error; + {ok, Filenames} -> + FullFilenames = [filename:join(Dir, F) || F <- Filenames], + Matches1 = case Dirs of + true -> + [F || F <- FullFilenames, + file_type(F) =:= {ok, 'directory'}]; + false -> [] + end, + Matches2 = [F || F <- FullFilenames, + file_type(F) =:= {ok, 'regular'}, + filename:extension(F) =:= Extension], + {ok, lists:sort(Matches1 ++ Matches2)} + end. + +write_suite(Suite) -> + write_header(Suite), + write_testcases(Suite). + +write_header(#suite{suitename = SuiteName, outputfile = OutputFile, + testcases = TestCases}) -> + Exports = format_export(TestCases), + TimeLimit = 2, %% with 1 it fails on some slow machines... + io:format(OutputFile, + "%% ATTENTION!\n" + "%% This is an automatically generated file. Do not edit.\n\n" + "-module(~s).\n\n" + "-export([suite/0, init_per_suite/0, init_per_suite/1,\n" + " end_per_suite/1, all/0]).\n" + "~s\n\n" + "-include_lib(\"common_test/include/ct.hrl\").\n\n" + "suite() ->\n" + " [{timetrap, {minutes, ~w}}].\n\n" + "init_per_suite() ->\n" + " [].\n\n" + "init_per_suite(Config) ->\n" + " case erlang:system_info(hipe_architecture) of\n" + " undefined -> {skip, \"HiPE not available or enabled\"};\n" + " _ -> Config\n" + " end.\n\n" + "end_per_suite(_Config) ->\n" + " ok.\n\n" + "all() ->\n" + " ~p.\n\n" + "test(Config, TestCase) ->\n" + " Dir = ?config(data_dir, Config),\n" + " OutDir = ?config(priv_dir, Config),\n" + " hipe_testsuite_driver:run(TestCase, Dir, OutDir)." + "\n\n", + [SuiteName ++ ?suite_suffix, Exports, TimeLimit, TestCases]). + +format_export(TestCases) -> + TL = [list_to_atom(atom_to_list(N)++"/1") || N <- TestCases], + TestCaseString = io_lib:format("-export(~p).", [TL]), + strip_quotes(lists:flatten(TestCaseString), []). + +strip_quotes([], Result) -> + lists:reverse(Result); +strip_quotes([$' |Rest], Result) -> + strip_quotes(Rest, Result); +strip_quotes([$\, |Rest], Result) -> + strip_quotes(Rest, [$\ , $\, |Result]); +strip_quotes([C|Rest], Result) -> + strip_quotes(Rest, [C|Result]). + +write_testcases(#suite{outputfile = OutputFile, testcases = TestCases}) -> + lists:foreach(fun (T) -> write_testcase(OutputFile, T) end, TestCases). + +write_testcase(OutputFile, TestCase) -> + io:format(OutputFile, + "~p(Config) ->\n" + " test(Config, ~p).\n\n", + [TestCase, TestCase]). + +-spec run(atom(), string(), string()) -> 'ok'. + +run(TestCase, Dir, _OutDir) -> + F = filename:join(Dir, atom_to_list(TestCase) ++ ".erl"), + {ok, TestCase} = compile:file(F), + ok = try TestCase:prepare_for_test() catch _:_ -> ok end, + %% DataFiles = try TestCase:datafiles() catch _:_ -> [] end, + %% lists:foreach(fun (DF) -> + %% Src = filename:join(Dir, DF), + %% Dst = filename:join(OutDir, DF), + %% {ok, _} = file:copy(Src, Dst) + %% end, DataFiles), + %% try + ok = TestCase:test(), + HiPEOpts = try TestCase:hipe_options() catch _:_ -> [] end, + {ok, TestCase} = hipe:c(TestCase, HiPEOpts), + ok = TestCase:test(). + %% after + %% lists:foreach(fun (DF) -> ok end, % = file:delete(DF) end, + %% [filename:join(OutDir, D) || D <- DataFiles]) + %% end. diff --git a/lib/hipe/vsn.mk b/lib/hipe/vsn.mk index ed4b4dc8d2..fb7e4b91a0 100644 --- a/lib/hipe/vsn.mk +++ b/lib/hipe/vsn.mk @@ -1 +1 @@ -HIPE_VSN = 3.10.2.2 +HIPE_VSN = 3.10.3 diff --git a/lib/hipe/x86/hipe_x86_assemble.erl b/lib/hipe/x86/hipe_x86_assemble.erl index 7878c7219d..3f756769c4 100644 --- a/lib/hipe/x86/hipe_x86_assemble.erl +++ b/lib/hipe/x86/hipe_x86_assemble.erl @@ -21,7 +21,6 @@ %%% %%% TODO: %%% - Simplify combine_label_maps and mk_data_relocs. -%%% - Move find_const to hipe_pack_constants? -ifdef(HIPE_AMD64). -define(HIPE_X86_ASSEMBLE, hipe_amd64_assemble). @@ -80,8 +79,8 @@ assemble(CompiledCode, Closures, Exports, Options) -> %% ?debug_msg("Constants are ~w bytes\n",[ConstSize])), %% SC = hipe_pack_constants:slim_constmap(ConstMap), - DataRelocs = mk_data_relocs(RefsFromConsts, LabelMap), - SSE = slim_sorted_exportmap(ExportMap,Closures,Exports), + DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), + SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap,Closures,Exports), SlimRefs = hipe_pack_constants:slim_refs(AccRefs), Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, ConstAlign, ConstSize, @@ -442,7 +441,7 @@ translate_imm(#x86_imm{value=Imm}, Context, MayTrunc8) -> case Imm of {Label,constant} -> {MFA,ConstMap} = Context, - ConstNo = find_const({MFA,Label}, ConstMap), + ConstNo = hipe_pack_constants:find_const({MFA,Label}, ConstMap), {constant,ConstNo}; {Label,closure} -> {closure,Label}; @@ -712,7 +711,7 @@ resolve_jmp_switch_arg(I, _Context) -> {rm64,hipe_amd64_encode:rm_mem(EA)}. -else. resolve_jmp_switch_arg(I, {MFA,ConstMap}) -> - ConstNo = find_const({MFA,hipe_x86:jmp_switch_jtab(I)}, ConstMap), + ConstNo = hipe_pack_constants:find_const({MFA,hipe_x86:jmp_switch_jtab(I)}, ConstMap), Disp32 = {?LOAD_ADDRESS,{constant,ConstNo}}, SINDEX = ?HIPE_X86_ENCODE:sindex(2, hipe_x86:temp_reg(hipe_x86:jmp_switch_temp(I))), EA = ?HIPE_X86_ENCODE:ea_disp32_sindex(Disp32, SINDEX), % this creates a SIB implicitly @@ -932,37 +931,6 @@ resolve_x87_binop_args(Src=#x86_fpreg{}, Dst=#x86_fpreg{})-> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -mk_data_relocs(RefsFromConsts, LabelMap) -> - lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])). - -mk_data_relocs([{MFA,Labels} | Rest], LabelMap, Acc) -> - Map = [case Label of - {L,Pos} -> - Offset = find({MFA,L}, LabelMap), - {Pos,Offset}; - {sorted,Base,OrderedLabels} -> - {sorted, Base, [begin - Offset = find({MFA,L}, LabelMap), - {Order, Offset} - end - || {L,Order} <- OrderedLabels]} - end - || Label <- Labels], - %% msg("Map: ~w Map\n",[Map]), - mk_data_relocs(Rest, LabelMap, [Map,Acc]); -mk_data_relocs([],_,Acc) -> Acc. - -find({MFA,L},LabelMap) -> - gb_trees:get({MFA,L}, LabelMap). - -slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) -> - IsClosure = lists:member({M,F,A}, Closures), - IsExported = is_exported(F, A, Exports), - [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)]; -slim_sorted_exportmap([],_,_) -> []. - -is_exported(F, A, Exports) -> lists:member({F,A}, Exports). - %%% %%% Assembly listing support (pp_asm option). %%% @@ -1001,14 +969,3 @@ fill_spaces(N) when N > 0 -> fill_spaces(N-1); fill_spaces(0) -> []. - -%%% -%%% Lookup a constant in a ConstMap. -%%% - -find_const({MFA,Label},[{pcm_entry,MFA,Label,ConstNo,_,_,_}|_]) -> - ConstNo; -find_const(N,[_|R]) -> - find_const(N,R); -find_const(C,[]) -> - ?EXIT({constant_not_found,C}). diff --git a/lib/ic/src/ic.app.src b/lib/ic/src/ic.app.src index 29aa6def00..7dd47ac9c6 100644 --- a/lib/ic/src/ic.app.src +++ b/lib/ic/src/ic.app.src @@ -46,7 +46,8 @@ {registered, []}, {applications, [stdlib, kernel]}, {env, []}, - {mod, {ic, []}} + {mod, {ic, []}}, + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0"]} ]}. diff --git a/lib/ic/vsn.mk b/lib/ic/vsn.mk index fe27d095d3..2ffbbad444 100644 --- a/lib/ic/vsn.mk +++ b/lib/ic/vsn.mk @@ -1 +1 @@ -IC_VSN = 4.3.4 +IC_VSN = 4.3.5 diff --git a/lib/inets/src/ftp/ftp.erl b/lib/inets/src/ftp/ftp.erl index 520db1b457..5674599ac5 100644 --- a/lib/inets/src/ftp/ftp.erl +++ b/lib/inets/src/ftp/ftp.erl @@ -192,7 +192,12 @@ do_open(Pid, OpenOptions, TLSOpts) -> 'ok' | {'error', Reason :: 'euser' | common_reason()}. user(Pid, User, Pass) -> - call(Pid, {user, User, Pass}, atom). + case {is_name_sane(User), is_name_sane(Pass)} of + {true, true} -> + call(Pid, {user, User, Pass}, atom); + _ -> + {error, euser} + end. -spec user(Pid :: pid(), User :: string(), @@ -201,7 +206,12 @@ user(Pid, User, Pass) -> 'ok' | {'error', Reason :: 'euser' | common_reason()}. user(Pid, User, Pass, Acc) -> - call(Pid, {user, User, Pass, Acc}, atom). + case {is_name_sane(User), is_name_sane(Pass), is_name_sane(Acc)} of + {true, true, true} -> + call(Pid, {user, User, Pass, Acc}, atom); + _ -> + {error, euser} + end. %%-------------------------------------------------------------------------- @@ -216,7 +226,12 @@ user(Pid, User, Pass, Acc) -> 'ok' | {'error', Reason :: 'eacct' | common_reason()}. account(Pid, Acc) -> - call(Pid, {account, Acc}, atom). + case is_name_sane(Acc) of + true -> + call(Pid, {account, Acc}, atom); + _ -> + {error, eacct} + end. %%-------------------------------------------------------------------------- @@ -262,7 +277,12 @@ lpwd(Pid) -> 'ok' | {'error', Reason :: restriction_reason() | common_reason()}. cd(Pid, Dir) -> - call(Pid, {cd, Dir}, atom). + case is_name_sane(Dir) of + true -> + call(Pid, {cd, Dir}, atom); + _ -> + {error, efnamena} + end. %%-------------------------------------------------------------------------- @@ -305,7 +325,12 @@ ls(Pid) -> {'error', Reason :: restriction_reason() | common_reason()}. ls(Pid, Dir) -> - call(Pid, {dir, long, Dir}, string). + case is_name_sane(Dir) of + true -> + call(Pid, {dir, long, Dir}, string); + _ -> + {error, efnamena} + end. %%-------------------------------------------------------------------------- @@ -333,7 +358,12 @@ nlist(Pid) -> {'error', Reason :: restriction_reason() | common_reason()}. nlist(Pid, Dir) -> - call(Pid, {dir, short, Dir}, string). + case is_name_sane(Dir) of + true -> + call(Pid, {dir, short, Dir}, string); + _ -> + {error, efnamena} + end. %%-------------------------------------------------------------------------- @@ -349,7 +379,12 @@ nlist(Pid, Dir) -> 'ok' | {'error', Reason :: restriction_reason() | common_reason()}. rename(Pid, Old, New) -> - call(Pid, {rename, Old, New}, string). + case {is_name_sane(Old), is_name_sane(New)} of + {true, true} -> + call(Pid, {rename, Old, New}, string); + _ -> + {error, efnamena} + end. %%-------------------------------------------------------------------------- @@ -365,7 +400,12 @@ rename(Pid, Old, New) -> 'ok' | {'error', Reason :: restriction_reason() | common_reason()}. delete(Pid, File) -> - call(Pid, {delete, File}, string). + case is_name_sane(File) of + true -> + call(Pid, {delete, File}, string); + _ -> + {error, efnamena} + end. %%-------------------------------------------------------------------------- @@ -380,7 +420,12 @@ delete(Pid, File) -> 'ok' | {'error', Reason :: restriction_reason() | common_reason()}. mkdir(Pid, Dir) -> - call(Pid, {mkdir, Dir}, atom). + case is_name_sane(Dir) of + true -> + call(Pid, {mkdir, Dir}, atom); + _ -> + {error, efnamena} + end. %%-------------------------------------------------------------------------- @@ -395,7 +440,12 @@ mkdir(Pid, Dir) -> 'ok' | {'error', Reason :: restriction_reason() | common_reason()}. rmdir(Pid, Dir) -> - call(Pid, {rmdir, Dir}, atom). + case is_name_sane(Dir) of + true -> + call(Pid, {rmdir, Dir}, atom); + _ -> + {error, efnamena} + end. %%-------------------------------------------------------------------------- @@ -437,7 +487,12 @@ recv(Pid, RemotFileName) -> 'ok' | {'error', Reason :: term()}. recv(Pid, RemotFileName, LocalFileName) -> - call(Pid, {recv, RemotFileName, LocalFileName}, atom). + case is_name_sane(RemotFileName) of + true -> + call(Pid, {recv, RemotFileName, LocalFileName}, atom); + _ -> + {error, efnamena} + end. %%-------------------------------------------------------------------------- @@ -456,7 +511,12 @@ recv(Pid, RemotFileName, LocalFileName) -> {'error', Reason :: restriction_reason() | common_reason()}. recv_bin(Pid, RemoteFile) -> - call(Pid, {recv_bin, RemoteFile}, bin). + case is_name_sane(RemoteFile) of + true -> + call(Pid, {recv_bin, RemoteFile}, bin); + _ -> + {error, efnamena} + end. %%-------------------------------------------------------------------------- @@ -473,7 +533,12 @@ recv_bin(Pid, RemoteFile) -> 'ok' | {'error', Reason :: restriction_reason() | common_reason()}. recv_chunk_start(Pid, RemoteFile) -> - call(Pid, {recv_chunk_start, RemoteFile}, atom). + case is_name_sane(RemoteFile) of + true -> + call(Pid, {recv_chunk_start, RemoteFile}, atom); + _ -> + {error, efnamena} + end. %%-------------------------------------------------------------------------- @@ -521,7 +586,12 @@ send(Pid, LocalFileName) -> shortage_reason()}. send(Pid, LocalFileName, RemotFileName) -> - call(Pid, {send, LocalFileName, RemotFileName}, atom). + case is_name_sane(RemotFileName) of + true -> + call(Pid, {send, LocalFileName, RemotFileName}, atom); + _ -> + {error, efnamena} + end. %%-------------------------------------------------------------------------- @@ -541,7 +611,12 @@ send(Pid, LocalFileName, RemotFileName) -> shortage_reason()}. send_bin(Pid, Bin, RemoteFile) when is_binary(Bin) -> - call(Pid, {send_bin, Bin, RemoteFile}, atom); + case is_name_sane(RemoteFile) of + true -> + call(Pid, {send_bin, Bin, RemoteFile}, atom); + _ -> + {error, efnamena} + end; send_bin(_Pid, _Bin, _RemoteFile) -> {error, enotbinary}. @@ -559,7 +634,12 @@ send_bin(_Pid, _Bin, _RemoteFile) -> 'ok' | {'error', Reason :: restriction_reason() | common_reason()}. send_chunk_start(Pid, RemoteFile) -> - call(Pid, {send_chunk_start, RemoteFile}, atom). + case is_name_sane(RemoteFile) of + true -> + call(Pid, {send_chunk_start, RemoteFile}, atom); + _ -> + {error, efnamena} + end. %%-------------------------------------------------------------------------- @@ -575,7 +655,12 @@ send_chunk_start(Pid, RemoteFile) -> 'ok' | {'error', Reason :: term()}. append_chunk_start(Pid, RemoteFile) -> - call(Pid, {append_chunk_start, RemoteFile}, atom). + case is_name_sane(RemoteFile) of + true -> + call(Pid, {append_chunk_start, RemoteFile}, atom); + _ -> + {error, efnamena} + end. %%-------------------------------------------------------------------------- @@ -683,7 +768,12 @@ append(Pid, LocalFileName) -> 'ok' | {'error', Reason :: term()}. append(Pid, LocalFileName, RemotFileName) -> - call(Pid, {append, LocalFileName, RemotFileName}, atom). + case is_name_sane(RemotFileName) of + true -> + call(Pid, {append, LocalFileName, RemotFileName}, atom); + _ -> + {error, efnamena} + end. %%-------------------------------------------------------------------------- @@ -705,7 +795,12 @@ append(Pid, LocalFileName, RemotFileName) -> shortage_reason()}. append_bin(Pid, Bin, RemoteFile) when is_binary(Bin) -> - call(Pid, {append_bin, Bin, RemoteFile}, atom); + case is_name_sane(RemoteFile) of + true -> + call(Pid, {append_bin, Bin, RemoteFile}, atom); + _ -> + {error, efnamena} + end; append_bin(_Pid, _Bin, _RemoteFile) -> {error, enotbinary}. @@ -2302,6 +2397,15 @@ send_bin(State, Bin) -> mk_cmd(Fmt, Args) -> [io_lib:format(Fmt, Args)| [?CR, ?LF]]. % Deep list ok. +is_name_sane([]) -> + true; +is_name_sane([?CR| _]) -> + false; +is_name_sane([?LF| _]) -> + false; +is_name_sane([_| Rest]) -> + is_name_sane(Rest). + pwd_result(Lines) -> {_, [?DOUBLE_QUOTE | Rest]} = lists:splitwith(fun(?DOUBLE_QUOTE) -> false; (_) -> true end, Lines), diff --git a/lib/inets/src/http_client/httpc_cookie.erl b/lib/inets/src/http_client/httpc_cookie.erl index 69900bae65..134115bdfa 100644 --- a/lib/inets/src/http_client/httpc_cookie.erl +++ b/lib/inets/src/http_client/httpc_cookie.erl @@ -335,7 +335,8 @@ add_domain(Str, #http_cookie{domain = Domain}) -> Str ++ "; $Domain=" ++ Domain. parse_set_cookies(CookieHeaders, DefaultPathDomain) -> - SetCookieHeaders = [Value || {"set-cookie", Value} <- CookieHeaders], + %% empty Set-Cookie header is invalid according to RFC but some sites violate it + SetCookieHeaders = [Value || {"set-cookie", Value} <- CookieHeaders, Value /= ""], Cookies = [parse_set_cookie(SetCookieHeader, DefaultPathDomain) || SetCookieHeader <- SetCookieHeaders], %% print_cookies("Parsed Cookies", Cookies), diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index a89a457a51..88e08be789 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -1119,15 +1119,8 @@ handle_http_body(Body, #state{headers = Headers, handle_response(State#state{headers = NewHeaders, body = NewBody}) end; - Encoding when is_list(Encoding) -> - ?hcrt("handle_http_body - encoding", [{encoding, Encoding}]), - NewState = answer_request(Request, - httpc_response:error(Request, - unknown_encoding), - State), - {stop, normal, NewState}; - _ -> - ?hcrt("handle_http_body - other", []), + Enc when Enc =:= "identity"; Enc =:= undefined -> + ?hcrt("handle_http_body - identity", []), Length = list_to_integer(Headers#http_response_h.'content-length'), case ((Length =< MaxBodySize) orelse (MaxBodySize =:= nolimit)) of @@ -1149,12 +1142,19 @@ handle_http_body(Body, #state{headers = Headers, body_too_big), State), {stop, normal, NewState} - end + end; + Encoding when is_list(Encoding) -> + ?hcrt("handle_http_body - other", [{encoding, Encoding}]), + NewState = answer_request(Request, + httpc_response:error(Request, + unknown_encoding), + State), + {stop, normal, NewState} end. handle_response(#state{status = new} = State) -> ?hcrd("handle response - status = new", []), - handle_response(check_persistent(State)); + handle_response(try_to_enable_pipeline_or_keep_alive(State)); handle_response(#state{request = Request, status = Status, @@ -1429,22 +1429,39 @@ is_keep_alive_enabled_server(_,_) -> is_keep_alive_connection(Headers, #session{client_close = ClientClose}) -> (not ((ClientClose) orelse httpc_response:is_server_closing(Headers))). -check_persistent( - #state{session = #session{type = Type} = Session, +try_to_enable_pipeline_or_keep_alive( + #state{session = Session, + request = #request{method = Method}, status_line = {Version, _, _}, headers = Headers, - profile_name = ProfileName} = State) -> + profile_name = ProfileName} = State) -> + ?hcrd("try to enable pipeline or keep-alive", + [{version, Version}, + {headers, Headers}, + {session, Session}]), case is_keep_alive_enabled_server(Version, Headers) andalso - is_keep_alive_connection(Headers, Session) of + is_keep_alive_connection(Headers, Session) of true -> - mark_persistent(ProfileName, Session), - State#state{status = Type}; + case (is_pipeline_enabled_client(Session) andalso + httpc_request:is_idempotent(Method)) of + true -> + insert_session(Session, ProfileName), + State#state{status = pipeline}; + false -> + insert_session(Session, ProfileName), + %% Make sure type is keep_alive in session + %% as it in this case might be pipeline + NewSession = Session#session{type = keep_alive}, + State#state{status = keep_alive, + session = NewSession} + end; false -> State#state{status = close} end. answer_request(#request{id = RequestId, from = From} = Request, Msg, - #state{timers = Timers, + #state{session = Session, + timers = Timers, profile_name = ProfileName} = State) -> ?hcrt("answer request", [{request, Request}, {msg, Msg}]), httpc_response:send(From, Msg), @@ -1454,14 +1471,19 @@ answer_request(#request{id = RequestId, from = From} = Request, Msg, Timer = {RequestId, TimerRef}, cancel_timer(TimerRef, {timeout, Request#request.id}), httpc_manager:request_done(RequestId, ProfileName), + NewSession = maybe_make_session_available(ProfileName, Session), Timers2 = Timers#timers{request_timers = lists:delete(Timer, RequestTimers)}, State#state{request = Request#request{from = answer_sent}, + session = NewSession, timers = Timers2}. -mark_persistent(ProfileName, Session) -> - update_session(ProfileName, Session, #session.persistent, true), - Session#session{persistent = true}. +maybe_make_session_available(ProfileName, + #session{available = false} = Session) -> + update_session(ProfileName, Session, #session.available, true), + Session#session{available = true}; +maybe_make_session_available(_ProfileName, Session) -> + Session. cancel_timers(#timers{request_timers = ReqTmrs, queue_timer = QTmr}) -> cancel_timer(QTmr, timeout_queue), @@ -1829,7 +1851,7 @@ update_session(ProfileName, #session{id = SessionId} = Session, Pos, Value) -> [ProfileName, SessionId, Pos, Value, (catch httpc_manager:which_session_info(ProfileName)), Session, - (catch httpc_manager:lookup_session(ProfileName, SessionId)), + (catch httpc_manager:lookup_session(SessionId, ProfileName)), T, E]), exit({failed_updating_session, [{profile, ProfileName}, diff --git a/lib/inets/src/http_client/httpc_internal.hrl b/lib/inets/src/http_client/httpc_internal.hrl index d5b3dd2a2a..add5d11dfa 100644 --- a/lib/inets/src/http_client/httpc_internal.hrl +++ b/lib/inets/src/http_client/httpc_internal.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2013. All Rights Reserved. +%% Copyright Ericsson AB 2005-2014. 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 @@ -143,8 +143,8 @@ %% true | false %% This will be true, when a response has been received for - %% the first request and the server has not closed the connection - persistent = false + %% the first request. See type above. + available = false }). diff --git a/lib/inets/src/http_client/httpc_manager.erl b/lib/inets/src/http_client/httpc_manager.erl index a3ed371e61..48a9c32454 100644 --- a/lib/inets/src/http_client/httpc_manager.erl +++ b/lib/inets/src/http_client/httpc_manager.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2013. All Rights Reserved. +%% Copyright Ericsson AB 2002-2014. 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 @@ -451,7 +451,7 @@ do_init(ProfileName, CookiesDir) -> %%-------------------------------------------------------------------- handle_call({request, Request}, _, State) -> ?hcri("request", [{request, Request}]), - case (catch handle_request(Request, State, false)) of + case (catch handle_request(Request, State)) of {reply, Msg, NewState} -> {reply, Msg, NewState}; Error -> @@ -511,7 +511,7 @@ handle_cast({retry_or_redirect_request, {Time, Request}}, {noreply, State}; handle_cast({retry_or_redirect_request, Request}, State) -> - case (catch handle_request(Request, State, true)) of + case (catch handle_request(Request, State)) of {reply, {ok, _}, NewState} -> {noreply, NewState}; Error -> @@ -724,7 +724,7 @@ get_handler_info(Tab) -> handle_request(#request{settings = #http_options{version = "HTTP/0.9"}} = Request, - State, _) -> + State) -> %% Act as an HTTP/0.9 client that does not know anything %% about persistent connections @@ -737,7 +737,7 @@ handle_request(#request{settings = handle_request(#request{settings = #http_options{version = "HTTP/1.0"}} = Request, - State, _) -> + State) -> %% Act as an HTTP/1.0 client that does not %% use persistent connections @@ -748,13 +748,13 @@ handle_request(#request{settings = start_handler(NewRequest#request{headers = NewHeaders}, State), {reply, {ok, NewRequest#request.id}, State}; -handle_request(Request, State = #state{options = Options}, Retry) -> +handle_request(Request, State = #state{options = Options}) -> NewRequest = handle_cookies(generate_request_id(Request), State), SessionType = session_type(Options), case select_session(Request#request.method, Request#request.address, - Request#request.scheme, SessionType, State, Retry) of + Request#request.scheme, SessionType, State) of {ok, HandlerPid} -> pipeline_or_keep_alive(NewRequest, HandlerPid, State); no_connection -> @@ -778,7 +778,6 @@ start_handler(#request{id = Id, #state{profile_name = ProfileName, handler_db = HandlerDb, options = Options}) -> - ClientClose = httpc_request:is_client_closing(Request#request.headers), {ok, Pid} = case is_inets_manager() of true -> @@ -789,18 +788,13 @@ start_handler(#request{id = Id, end, HandlerInfo = {Id, Pid, From}, ets:insert(HandlerDb, HandlerInfo), - insert_session(#session{id = {Request#request.address, Pid}, - scheme = Request#request.scheme, - client_close = ClientClose, - type = session_type(Options) - }, ProfileName), erlang:monitor(process, Pid). select_session(Method, HostPort, Scheme, SessionType, #state{options = #options{max_pipeline_length = MaxPipe, max_keep_alive_length = MaxKeepAlive}, - session_db = SessionDb}, Retry) -> + session_db = SessionDb}) -> ?hcrd("select session", [{session_type, SessionType}, {max_pipeline_length, MaxPipe}, {max_keep_alive_length, MaxKeepAlive}]), @@ -813,23 +807,13 @@ select_session(Method, HostPort, Scheme, SessionType, %% client_close, scheme and type specified. %% The fields id (part of: HandlerPid) and queue_length %% specified. - Pattern = case (Retry andalso SessionType == pipeline) of - true -> - #session{id = {HostPort, '$1'}, - client_close = false, - scheme = Scheme, - queue_length = '$2', - type = SessionType, - persistent = true, - _ = '_'}; - false -> - #session{id = {HostPort, '$1'}, - client_close = false, - scheme = Scheme, - queue_length = '$2', - type = SessionType, - _ = '_'} - end, + Pattern = #session{id = {HostPort, '$1'}, + client_close = false, + scheme = Scheme, + queue_length = '$2', + type = SessionType, + available = true, + _ = '_'}, %% {'_', {HostPort, '$1'}, false, Scheme, '_', '$2', SessionTyp}, Candidates = ets:match(SessionDb, Pattern), ?hcrd("select session", [{host_port, HostPort}, diff --git a/lib/inets/src/http_server/httpd_example.erl b/lib/inets/src/http_server/httpd_example.erl index 16a080f8e2..6fc07f033c 100644 --- a/lib/inets/src/http_server/httpd_example.erl +++ b/lib/inets/src/http_server/httpd_example.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2014. 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 @@ -66,7 +66,7 @@ get_bin(_Env,_Input) -> <INPUT TYPE=\"text\" NAME=\"input2\"> <INPUT TYPE=\"submit\"><BR> </FORM>" ++ "\n"), - footer()]. + list_to_binary(footer())]. post(_Env,[]) -> [header(), diff --git a/lib/inets/src/inets_app/inets.app.src b/lib/inets/src/inets_app/inets.app.src index a6dd364c2d..9eae962d03 100644 --- a/lib/inets/src/inets_app/inets.app.src +++ b/lib/inets/src/inets_app/inets.app.src @@ -110,4 +110,6 @@ {registered,[inets_sup, httpc_manager]}, %% If the "new" ssl is used then 'crypto' must be started before inets. {applications,[kernel,stdlib]}, - {mod,{inets_app,[]}}]}. + {mod,{inets_app,[]}}, + {runtime_dependencies, ["stdlib-2.0","ssl-5.3.4","runtime_tools-1.8.14", + "mnesia-4.12","kernel-3.0","erts-6.0"]}]}. diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src index 7a909b2f3f..dd081962cc 100644 --- a/lib/inets/src/inets_app/inets.appup.src +++ b/lib/inets/src/inets_app/inets.appup.src @@ -16,6 +16,12 @@ %% %% %CopyrightEnd% {"%VSN%", - [{<<"5\\..*">>,[{restart_application, inets}]}], - [{<<"5\\..*">>,[{restart_application, inets}]}] + [ + {"5.9.8", [{load_module, ftp, soft_purge, soft_purge, []}]}, + {<<"5\\..*">>,[{restart_application, inets}]} + ], + [ + {"5.9.8", [{load_module, ftp, soft_purge, soft_purge, []}]}, + {<<"5\\..*">>,[{restart_application, inets}]} + ] }. diff --git a/lib/inets/test/Makefile b/lib/inets/test/Makefile index c156b34406..609396273d 100644 --- a/lib/inets/test/Makefile +++ b/lib/inets/test/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2013. All Rights Reserved. +# Copyright Ericsson AB 1997-2014. 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 diff --git a/lib/inets/test/ftp_suite_lib.erl b/lib/inets/test/ftp_suite_lib.erl index 35f21cc74d..daee1bdcdc 100644 --- a/lib/inets/test/ftp_suite_lib.erl +++ b/lib/inets/test/ftp_suite_lib.erl @@ -1266,6 +1266,8 @@ read_log_6035([]) -> %%-------------------------------------------------------------------- do_user(Pid) -> {error, euser} = ftp:user(Pid, ?BAD_USER, ?FTP_PASS), + {error, euser} = ftp:user(Pid, ?FTP_USER++"\r\nPASS "++?FTP_PASS, ?FTP_PASS), + {error, euser} = ftp:user(Pid, ?FTP_USER, ?FTP_PASS++"\r\nCWD ."), ok = ftp:user(Pid, ?FTP_USER, ?FTP_PASS), ok. @@ -1278,6 +1280,7 @@ do_pwd(Pid) -> do_cd(Pid) -> ok = ftp:cd(Pid, "/pub"), {error, epath} = ftp:cd(Pid, ?BAD_DIR), + {error, efnamena} = ftp:cd(Pid, "/pub\r\nCWD ."), ok. do_lcd(Pid, Dir) -> @@ -1294,11 +1297,14 @@ do_ls(Pid) -> %% directory, but can also be a filename or a group %% of files (including wildcards). {ok, _} = ftp:ls(Pid, "incom*"), + %% but \r\n can't be in the wildcard + {error, efnamena} = ftp:ls(Pid, "incoming\r\nCWD ."), ok. do_nlist(Pid, WildcardSupport) -> {ok, _} = ftp:nlist(Pid), {ok, _} = ftp:nlist(Pid, "incoming"), + {error, efnamena} = ftp:ls(Pid, "incoming\r\nCWD ."), %% neither nlist nor ls operates on a directory %% they operate on a pathname, which *can* be a %% directory, but can also be a filename or a group @@ -1324,6 +1330,8 @@ do_rename(Pid, Config) -> ftp:delete(Pid, NewLFile), % reset ok = ftp:send(Pid, LFile), {error, epath} = ftp:rename(Pid, NewLFile, LFile), + {error, efnamena} = ftp:rename(Pid, NewLFile++"\r\nRNTO "++LFile++"\r\nRNFR "++NewLFile, LFile), + {error, efnamena} = ftp:rename(Pid, NewLFile, LFile++"\r\nCWD ."), ok = ftp:rename(Pid, LFile, NewLFile), ftp:delete(Pid, LFile), % cleanup ftp:delete(Pid, NewLFile), % cleanup @@ -1338,6 +1346,7 @@ do_delete(Pid, Config) -> ok = ftp:cd(Pid, "incoming"), ok = ftp:lcd(Pid, PrivDir), ftp:delete(Pid,LFile), % reset + {error, efnamena} = ftp:delete(Pid,LFile++"\r\nCWD ."), ok = ftp:send(Pid, LFile), ok = ftp:delete(Pid,LFile), ok. @@ -1348,6 +1357,8 @@ do_mkdir(Pid) -> integer_to_list(B) ++ "_" ++ integer_to_list(C), ok = ftp:cd(Pid, "incoming"), {ok, CurrDir} = ftp:pwd(Pid), + {error, efnamena} = ftp:mkdir(Pid, NewDir++"\r\nCWD ."), + {error, efnamena} = ftp:rmdir(Pid, NewDir++"\r\nCWD ."), ok = ftp:mkdir(Pid, NewDir), ok = ftp:cd(Pid, NewDir), ok = ftp:cd(Pid, CurrDir), @@ -1363,6 +1374,7 @@ do_send(Pid, Config) -> ok = file:write_file(AbsLFile, list_to_binary(Contents)), ok = ftp:cd(Pid, "incoming"), ok = ftp:lcd(Pid, PrivDir), + {error, efnamena} = ftp:send(Pid, LFile, RFile++"1\r\nCWD ."), ok = ftp:send(Pid, LFile, RFile), {ok, RFilesString} = ftp:nlist(Pid), RFiles = split(RFilesString), @@ -1392,6 +1404,7 @@ do_append(Pid, Config) -> ftp:delete(Pid, RFile), ftp:delete(Pid, LFile), + {error, efnamena} = ftp:append(Pid, LFile, RFile++"1\r\nCWD ."), ok = ftp:append(Pid, LFile, RFile), ok = ftp:append(Pid, LFile, RFile), ok = ftp:append(Pid, LFile), @@ -1413,6 +1426,7 @@ do_send_bin(Pid, Config) -> Bin = list_to_binary(Contents), ok = ftp:cd(Pid, "incoming"), {error, enotbinary} = ftp:send_bin(Pid, Contents, File), + {error, efnamena} = ftp:send_bin(Pid, Bin, File++"1\r\nCWD ."), ok = ftp:send_bin(Pid, Bin, File), {ok, RFilesString} = ftp:nlist(Pid), RFiles = split(RFilesString), @@ -1426,6 +1440,7 @@ do_append_bin(Pid, Config) -> Bin = list_to_binary(Contents), ok = ftp:cd(Pid, "incoming"), {error, enotbinary} = ftp:append_bin(Pid, Contents, File), + {error, efnamena} = ftp:append_bin(Pid, Bin, File++"1\r\nCWD ."), ok = ftp:append_bin(Pid, Bin, File), ok = ftp:append_bin(Pid, Bin, File), %% Control the contents of the file @@ -1438,6 +1453,7 @@ do_send_chunk(Pid, Config) -> Contents = "ftp_SUITE test ...", Bin = list_to_binary(Contents), ok = ftp:cd(Pid, "incoming"), + {error, efnamena} = ftp:send_chunk_start(Pid, File++"1\r\nCWD ."), ok = ftp:send_chunk_start(Pid, File), {error, echunk} = ftp:cd(Pid, "incoming"), {error, enotbinary} = ftp:send_chunk(Pid, Contents), @@ -1454,6 +1470,7 @@ do_append_chunk(Pid, Config) -> File = ?config(file, Config), Contents = ["ER","LE","RL"], ok = ftp:cd(Pid, "incoming"), + {error, efnamena} = ftp:append_chunk_start(Pid, File++"1\r\nCWD ."), ok = ftp:append_chunk_start(Pid, File), {error, enotbinary} = ftp:append_chunk(Pid, lists:nth(1,Contents)), ok = ftp:append_chunk(Pid,list_to_binary(lists:nth(1,Contents))), @@ -1480,6 +1497,7 @@ do_recv(Pid, Config) -> ok = file:delete(AbsFile), % cleanup test_server:sleep(100), ok = ftp:lcd(Pid, PrivDir), + {error, efnamena} = ftp:recv(Pid, File++"\r\nCWD ."), ok = ftp:recv(Pid, File), {ok, Files} = file:list_dir(PrivDir), true = lists:member(File, Files), @@ -1495,6 +1513,7 @@ do_recv_bin(Pid, Config) -> ok = ftp:cd(Pid, "incoming"), ok = ftp:send_bin(Pid, Bin1, File), test_server:sleep(100), + {error, efnamena} = ftp:recv_bin(Pid, File++"\r\nCWD ."), {ok, Bin2} = ftp:recv_bin(Pid, File), ok = ftp:delete(Pid, File), % cleanup Contents2 = binary_to_list(Bin2), @@ -1520,6 +1539,7 @@ do_recv_chunk(Pid, Config) -> ok = ftp:send_bin(Pid, Bin1, File), test_server:sleep(100), {error, "ftp:recv_chunk_start/2 not called"} = recv_chunk(Pid, <<>>), + {error, efnamena} = ftp:recv_chunk_start(Pid, File++"\r\nCWD ."), ok = ftp:recv_chunk_start(Pid, File), {ok, Contents2} = recv_chunk(Pid, <<>>), ok = ftp:delete(Pid, File), % cleanup diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index fe6edd504e..b1b799c953 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2014. 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 @@ -91,6 +91,7 @@ only_simulated() -> [ cookie, cookie_profile, + empty_set_cookie, trace, stream_once, no_content_204, @@ -104,6 +105,7 @@ only_simulated() -> remote_socket_close, remote_socket_close_async, transfer_encoding, + transfer_encoding_identity, redirect_loop, redirect_moved_permanently, redirect_multiple_choises, @@ -296,6 +298,9 @@ trace(Config) when is_list(Config) -> pipeline(Config) when is_list(Config) -> Request = {url(group_name(Config), "/dummy.html", Config), []}, {ok, _} = httpc:request(get, Request, [], [], pipeline), + + %% Make sure pipeline session is registerd + test_server:sleep(4000), keep_alive_requests(Request, pipeline). %%-------------------------------------------------------------------- @@ -303,6 +308,9 @@ pipeline(Config) when is_list(Config) -> persistent_connection(Config) when is_list(Config) -> Request = {url(group_name(Config), "/dummy.html", Config), []}, {ok, _} = httpc:request(get, Request, [], [], persistent), + + %% Make sure pipeline session is registerd + test_server:sleep(4000), keep_alive_requests(Request, persistent). %%------------------------------------------------------------------------- @@ -530,6 +538,19 @@ cookie_profile(Config) when is_list(Config) -> inets:stop(httpc, cookie_test). %%------------------------------------------------------------------------- +empty_set_cookie() -> + [{doc, "Test empty Set-Cookie header."}]. +empty_set_cookie(Config) when is_list(Config) -> + ok = httpc:set_options([{cookies, enabled}]), + + Request0 = {url(group_name(Config), "/empty_set_cookie.html", Config), []}, + + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, Request0, [], []), + + ok = httpc:set_options([{cookies, disabled}]). + +%%------------------------------------------------------------------------- headers_as_is(doc) -> ["Test the option headers_as_is"]; headers_as_is(Config) when is_list(Config) -> @@ -624,6 +645,12 @@ transfer_encoding(Config) when is_list(Config) -> %%------------------------------------------------------------------------- +transfer_encoding_identity(Config) when is_list(Config) -> + URL = url(group_name(Config), "/identity_transfer_encoding.html", Config), + {ok, {{_,200,_}, [_|_], "IDENTITY"}} = httpc:request(URL). + +%%------------------------------------------------------------------------- + empty_response_header() -> [{doc, "Test the case that the HTTP server does not send any headers. Solves OTP-6830"}]. empty_response_header(Config) when is_list(Config) -> @@ -1609,6 +1636,13 @@ handle_uri(_,"/capital_transfer_encoding.html",_,_,Socket,_) -> send(Socket, http_chunk:encode("obar</BODY></HTML>")), http_chunk:encode_last(); +handle_uri(_,"/identity_transfer_encoding.html",_,_,_,_) -> + "HTTP/1.0 200 OK\r\n" + "Transfer-Encoding:identity\r\n" + "Content-Length:8\r\n" + "\r\n" + "IDENTITY"; + handle_uri(_,"/cookie.html",_,_,_,_) -> "HTTP/1.1 200 ok\r\n" ++ "set-cookie:" ++ "test_cookie=true; path=/;" ++ @@ -1616,6 +1650,12 @@ handle_uri(_,"/cookie.html",_,_,_,_) -> "Content-Length:32\r\n\r\n"++ "<HTML><BODY>foobar</BODY></HTML>"; +handle_uri(_,"/empty_set_cookie.html",_,_,_,_) -> + "HTTP/1.1 200 ok\r\n" ++ + "set-cookie: \r\n" ++ + "Content-Length:32\r\n\r\n"++ + "<HTML><BODY>foobar</BODY></HTML>"; + handle_uri(_,"/missing_crlf.html",_,_,_,_) -> "HTTP/1.1 200 ok" ++ "Content-Length:32\r\n" ++ diff --git a/lib/inets/test/httpd_1_0.erl b/lib/inets/test/httpd_1_0.erl index 53f23b12e0..0836c9e881 100644 --- a/lib/inets/test/httpd_1_0.erl +++ b/lib/inets/test/httpd_1_0.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2014. 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 @@ -20,7 +20,7 @@ -module(httpd_1_0). --export([host/4]). +-export([host/4, trace/4]). %%------------------------------------------------------------------------- %% Test cases @@ -31,3 +31,8 @@ host(Type, Port, Host, Node) -> "GET / HTTP/1.0\r\n\r\n", [{statuscode, 200}, {version, "HTTP/1.0"}]). +trace(Type, Port, Host, Node)-> + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "TRACE / HTTP/1.0\r\n\r\n", + [{statuscode, 501}, + {version, "HTTP/1.0"}]). diff --git a/lib/inets/test/httpd_1_1.erl b/lib/inets/test/httpd_1_1.erl index 4b2a5f619d..6a5fc4a18f 100644 --- a/lib/inets/test/httpd_1_1.erl +++ b/lib/inets/test/httpd_1_1.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2013. All Rights Reserved. +%% Copyright Ericsson AB 2005-2014. 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 @@ -22,7 +22,7 @@ -include_lib("kernel/include/file.hrl"). --export([host/4, chunked/4, expect/4, range/4, if_test/5, http_trace/4, +-export([host/4, chunked/4, expect/4, range/4, if_test/5, trace/4, head/4, mod_cgi_chunked_encoding_test/5]). %% -define(all_keys_lower_case,true). @@ -152,13 +152,13 @@ if_test(Type, Port, Host, Node, DocRoot)-> calendar:datetime_to_gregorian_seconds(FileInfo#file_info.mtime), Mod = httpd_util:rfc1123_date(calendar:gregorian_seconds_to_datetime( - CreatedSec-1)), + CreatedSec-1)), %% Test that we get the data when the file is modified ok = httpd_test_lib:verify_request(Type, Host, Port, Node, "GET / HTTP/1.1\r\nHost:" ++ Host ++ - "\r\nIf-Modified-Since:" ++ - Mod ++ "\r\n\r\n", + "\r\nIf-Modified-Since:" ++ + Mod ++ "\r\n\r\n", [{statuscode, 200}]), Mod1 = httpd_util:rfc1123_date(calendar:gregorian_seconds_to_datetime( CreatedSec+100)), @@ -168,74 +168,69 @@ if_test(Type, Port, Host, Node, DocRoot)-> ++ Mod1 ++"\r\n\r\n", [{statuscode, 304}]), - + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, "GET / HTTP/1.1\r\nHost:" ++ Host ++ - "\r\nIf-Modified-Since:" ++ - "AAA[...]AAAA" ++ "\r\n\r\n", + "\r\nIf-Modified-Since:" ++ + "AAA[...]AAAA" ++ "\r\n\r\n", [{statuscode, 400}]), - - - Mod2 = httpd_util:rfc1123_date(calendar:gregorian_seconds_to_datetime( + + Mod2 = httpd_util:rfc1123_date(calendar:gregorian_seconds_to_datetime( CreatedSec+1)), - %% Control that the If-Unmodified-Header lmits the response - ok = httpd_test_lib:verify_request(Type,Host,Port,Node, - "GET / HTTP/1.1\r\nHost:" - ++ Host ++ - "\r\nIf-Unmodified-Since:" ++ Mod2 - ++ "\r\n\r\n", - [{statuscode, 200}]), - Mod3 = httpd_util:rfc1123_date(calendar:gregorian_seconds_to_datetime( + %% Control that the If-Unmodified-Header lmits the response + ok = httpd_test_lib:verify_request(Type,Host,Port,Node, + "GET / HTTP/1.1\r\nHost:" + ++ Host ++ + "\r\nIf-Unmodified-Since:" ++ Mod2 + ++ "\r\n\r\n", + [{statuscode, 200}]), + Mod3 = httpd_util:rfc1123_date(calendar:gregorian_seconds_to_datetime( CreatedSec-1)), ok = httpd_test_lib:verify_request(Type, Host, Port, Node, - "GET / HTTP/1.1\r\nHost:" - ++ Host ++ - "\r\nIf-Unmodified-Since:"++ Mod3 + "GET / HTTP/1.1\r\nHost:" + ++ Host ++ + "\r\nIf-Unmodified-Since:"++ Mod3 ++"\r\n\r\n", - [{statuscode, 412}]), + [{statuscode, 412}]), - %% Control that we get the body when the etag match + %% Control that we get the body when the etag match ok = httpd_test_lib:verify_request(Type, Host, Port, Node, - "GET / HTTP/1.1\r\nHost:" ++ Host - ++"\r\n"++ - "If-Match:"++ - httpd_util:create_etag(FileInfo)++ - "\r\n\r\n", - [{statuscode, 200}]), - ok = httpd_test_lib:verify_request(Type, Host, Port, Node, - "GET / HTTP/1.1\r\nHost:" ++ - Host ++ "\r\n"++ - "If-Match:NotEtag\r\n\r\n", - [{statuscode, 412}]), + "GET / HTTP/1.1\r\nHost:" ++ Host + ++"\r\n"++ + "If-Match:"++ + httpd_util:create_etag(FileInfo)++ + "\r\n\r\n", + [{statuscode, 200}]), + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET / HTTP/1.1\r\nHost:" ++ + Host ++ "\r\n"++ + "If-Match:NotEtag\r\n\r\n", + [{statuscode, 412}]), - %% Control the response when the if-none-match header is there - ok = httpd_test_lib:verify_request(Type, Host, Port, Node, - "GET / HTTP/1.1\r\nHost:" - ++ Host ++"\r\n"++ - "If-None-Match:NoTaag," ++ - httpd_util:create_etag(FileInfo) ++ - "\r\n\r\n", - [{statuscode, 304}]), + %% Control the response when the if-none-match header is there + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET / HTTP/1.1\r\nHost:" + ++ Host ++"\r\n"++ + "If-None-Match:NoTaag," ++ + httpd_util:create_etag(FileInfo) ++ + "\r\n\r\n", + [{statuscode, 304}]), ok = httpd_test_lib:verify_request(Type, Host, Port, Node, "GET / HTTP/1.1\r\nHost:" - ++ Host ++ "\r\n"++ - "If-None-Match:NotEtag," - "NeihterEtag\r\n\r\n", + ++ Host ++ "\r\n"++ + "If-None-Match:NotEtag," + "NeihterEtag\r\n\r\n", [{statuscode,200}]), ok. - -http_trace(Type, Port, Host, Node)-> + +trace(Type, Port, Host, Node)-> ok = httpd_test_lib:verify_request(Type, Host, Port, Node, "TRACE / HTTP/1.1\r\n" ++ "Host:" ++ Host ++ "\r\n" ++ "Max-Forwards:2\r\n\r\n", - [{statuscode, 200}]), - ok = httpd_test_lib:verify_request(Type, Host, Port, Node, - "TRACE / HTTP/1.0\r\n\r\n", - [{statuscode, 501}, - {version, "HTTP/1.0"}]). + [{statuscode, 200}]). head(Type, Port, Host, Node)-> %% mod_include ok = httpd_test_lib:verify_request(Type, Host, Port, Node, @@ -283,7 +278,7 @@ mod_cgi_chunked_encoding_test(Type, Port, Host, Node, [Request| Rest])-> %%-------------------------------------------------------------------- validateRangeRequest(Socket,Response,ValidBody,C,O,DE)-> receive - {tcp,Socket,Data} -> + {_,Socket,Data} -> case string:str(Data,"\r\n") of 0-> validateRangeRequest(Socket, @@ -312,7 +307,7 @@ validateRangeRequest1(Socket, Response, ValidBody) -> case end_of_header(Response) of false -> receive - {tcp,Socket,Data} -> + {_,Socket,Data} -> validateRangeRequest1(Socket, Response ++ Data, ValidBody); _-> @@ -331,10 +326,10 @@ validateRangeRequest2(Socket, Head, Body, ValidBody, {multiPart,Boundary})-> validateMultiPartRangeRequest(Body, ValidBody, Boundary); false-> receive - {tcp, Socket, Data} -> + {_, Socket, Data} -> validateRangeRequest2(Socket, Head, Body ++ Data, ValidBody, {multiPart, Boundary}); - {tcp_closed, Socket} -> + {_, Socket} -> error; _ -> error @@ -353,7 +348,7 @@ validateRangeRequest2(Socket, Head, Body, ValidBody, BodySize) end; Size when Size < BodySize -> receive - {tcp, Socket, Data} -> + {_, Socket, Data} -> validateRangeRequest2(Socket, Head, Body ++ Data, ValidBody, BodySize); _ -> diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index c0d73663d3..3eb8a0818f 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -26,6 +26,7 @@ -include_lib("kernel/include/file.hrl"). -include_lib("common_test/include/ct.hrl"). +-include_lib("public_key/include/public_key.hrl"). -include("inets_test_lib.hrl"). %% Note: This directive should only be used in test suites. @@ -33,6 +34,11 @@ -record(httpd_user, {user_name, password, user_data}). -record(httpd_group, {group_name, userlist}). +-define(MAX_HEADER_SIZE, 256). +%% Minutes before failed auths timeout. +-define(FAIL_EXPIRE_TIME,1). +%% Seconds before successful auths timeout. +-define(AUTH_TIMEOUT,5). %%-------------------------------------------------------------------- %% Common Test interface functions ----------------------------------- @@ -42,22 +48,59 @@ suite() -> all() -> [ - {group, http}, - {group, http_limit} - %%{group, https} + {group, http_basic}, + {group, https_basic}, + {group, http_limit}, + {group, https_limit}, + {group, http_basic_auth}, + {group, https_basic_auth}, + {group, http_auth_api}, + {group, https_auth_api}, + {group, http_auth_api_dets}, + {group, https_auth_api_dets}, + {group, http_auth_api_mnesia}, + {group, https_auth_api_mnesia}, + {group, http_htaccess}, + {group, https_htaccess}, + {group, http_security}, + {group, https_security} ]. groups() -> [ - {http, [], all_groups()}, - %%{https, [], all_groups()}, - {http_limit, [], [max_clients_1_1, max_clients_1_0, max_clients_0_9]}, - {http_1_1, [], [host, chunked, expect, cgi] ++ http_head() ++ http_get()}, - {http_1_0, [], [host, cgi] ++ http_head() ++ http_get()}, - {http_0_9, [], http_head() ++ http_get()} + {http_basic, [], basic_groups()}, + {https_basic, [], basic_groups()}, + {http_limit, [], [{group, limit}]}, + {https_limit, [], [{group, limit}]}, + {http_basic_auth, [], [{group, basic_auth}]}, + {https_basic_auth, [], [{group, basic_auth}]}, + {http_auth_api, [], [{group, auth_api}]}, + {https_auth_api, [], [{group, auth_api}]}, + {http_auth_api_dets, [], [{group, auth_api_dets}]}, + {https_auth_api_dets, [], [{group, auth_api_dets}]}, + {http_auth_api_mnesia, [], [{group, auth_api_mnesia}]}, + {https_auth_api_mnesia, [], [{group, auth_api_mnesia}]}, + {http_htaccess, [], [{group, htaccess}]}, + {https_htaccess, [], [{group, htaccess}]}, + {http_security, [], [{group, security}]}, + {https_security, [], [{group, security}]}, + {limit, [], [max_clients_1_1, max_clients_1_0, max_clients_0_9]}, + {basic_auth, [], [basic_auth_1_1, basic_auth_1_0, basic_auth_0_9]}, + {auth_api, [], [auth_api_1_1, auth_api_1_0, auth_api_0_9 + ]}, + {auth_api_dets, [], [auth_api_1_1, auth_api_1_0, auth_api_0_9 + ]}, + {auth_api_mnesia, [], [auth_api_1_1, auth_api_1_0, auth_api_0_9 + ]}, + {htaccess, [], [htaccess_1_1, htaccess_1_0, htaccess_0_9]}, + {security, [], [security_1_1, security_1_0]}, %% Skip 0.9 as causes timing issus in test code + {http_1_1, [], [host, chunked, expect, cgi, cgi_chunked_encoding_test, + trace, range, if_modified_since] ++ http_head() ++ http_get() ++ load()}, + {http_1_0, [], [host, cgi, trace] ++ http_head() ++ http_get() ++ load()}, + {http_0_9, [], http_head() ++ http_get() ++ load()} ]. -all_groups ()-> +basic_groups ()-> [{group, http_1_1}, {group, http_1_0}, {group, http_0_9} @@ -66,15 +109,27 @@ all_groups ()-> http_head() -> [head]. http_get() -> - [alias, get, - basic_auth, - esi, ssi]. + [alias, + get, + %%actions, Add configuration so that this test mod_action + esi, + ssi, + content_length, + bad_hex, + missing_CR, + max_header, + ipv6 + ]. +load() -> + [light, medium + %%,heavy + ]. + init_per_suite(Config) -> PrivDir = ?config(priv_dir, Config), DataDir = ?config(data_dir, Config), inets_test_lib:stop_apps([inets]), - inets_test_lib:start_apps([inets]), ServerRoot = filename:join(PrivDir, "server_root"), inets_test_lib:del_dirs(ServerRoot), DocRoot = filename:join(ServerRoot, "htdocs"), @@ -82,21 +137,31 @@ init_per_suite(Config) -> [{server_root, ServerRoot}, {doc_root, DocRoot}, {node, node()}, - {host, inets_test_lib:hostname()} | Config]. + {host, inets_test_lib:hostname()}, + {address, getaddr()} | Config]. end_per_suite(_Config) -> ok. %%-------------------------------------------------------------------- -init_per_group(https = Group, Config0) -> - case start_apps(Group) of - ok -> - init_httpd(Group, [{type, ssl} | Config0]); - _ -> - {skip, "Could not start https apps"} - end; - -init_per_group(Group, Config0) when Group == http; Group == http_limit -> +init_per_group(Group, Config0) when Group == https_basic; + Group == https_limit; + Group == https_basic_auth; + Group == https_auth_api; + Group == https_auth_api_dets; + Group == https_auth_api_mnesia; + Group == https_security + -> + init_ssl(Group, Config0); +init_per_group(Group, Config0) when Group == http_basic; + Group == http_limit; + Group == http_basic_auth; + Group == http_auth_api; + Group == http_auth_api_dets; + Group == http_auth_api_mnesia; + Group == http_security + -> + ok = start_apps(Group), init_httpd(Group, [{type, ip_comm} | Config0]); init_per_group(http_1_1, Config) -> [{http_version, "HTTP/1.1"} | Config]; @@ -104,22 +169,57 @@ init_per_group(http_1_0, Config) -> [{http_version, "HTTP/1.0"} | Config]; init_per_group(http_0_9, Config) -> [{http_version, "HTTP/0.9"} | Config]; +init_per_group(http_htaccess = Group, Config) -> + Path = ?config(doc_root, Config), + catch remove_htaccess(Path), + create_htaccess_data(Path, ?config(address, Config)), + ok = start_apps(Group), + init_httpd(Group, [{type, ip_comm} | Config]); +init_per_group(https_htaccess = Group, Config) -> + Path = ?config(doc_root, Config), + catch remove_htaccess(Path), + create_htaccess_data(Path, ?config(address, Config)), + init_ssl(Group, Config); +init_per_group(auth_api, Config) -> + [{auth_prefix, ""} | Config]; +init_per_group(auth_api_dets, Config) -> + [{auth_prefix, "dets_"} | Config]; +init_per_group(auth_api_mnesia, Config) -> + start_mnesia(?config(node, Config)), + [{auth_prefix, "mnesia_"} | Config]; init_per_group(_, Config) -> Config. -end_per_group(http, _Config) -> - ok; -end_per_group(https, _Config) -> - ssl:stop(); + +end_per_group(Group, _Config) when Group == http_basic; + Group == http_limit; + Group == http_basic_auth; + Group == http_auth_api; + Group == http_auth_api_dets; + Group == http_auth_api_mnesia; + Group == http_htaccess; + Group == http_security + -> + inets:stop(); +end_per_group(Group, _Config) when Group == https_basic; + Group == https_limit; + Group == https_basic_auth; + Group == https_auth_api; + Group == http_auth_api_dets; + Group == http_auth_api_mnesia; + Group == https_htaccess; + Group == http_security + -> + ssl:stop(), + inets:stop(); + +end_per_group(auth_api_mnesia, _) -> + cleanup_mnesia(); + end_per_group(_, _) -> ok. -init_httpd(Group, Config0) -> - Config1 = proplists:delete(port, Config0), - Config = proplists:delete(server_pid, Config1), - {Pid, Port} = server_start(Group, server_config(Group, Config)), - [{server_pid, Pid}, {port, Port} | Config]. %%-------------------------------------------------------------------- -init_per_testcase(host, Config) -> +init_per_testcase(Case, Config) when Case == host; Case == trace -> Prop = ?config(tc_group_properties, Config), Name = proplists:get_value(name, Prop), Cb = case Name of @@ -129,15 +229,15 @@ init_per_testcase(host, Config) -> httpd_1_1 end, [{version_cb, Cb} | proplists:delete(version_cb, Config)]; + +init_per_testcase(range, Config) -> + DocRoot = ?config(doc_root, Config), + create_range_data(DocRoot), + Config; + init_per_testcase(_, Config) -> Config. -%% init_per_testcase(basic_auth = Case, Config) -> -%% start_mnesia(?config(node, Config)), -%% common_init_per_test_case(Case, Config); - -%% end_per_testcase(basic_auth, Config) -> -%% cleanup_mnesia(); end_per_testcase(_Case, _Config) -> ok. @@ -163,8 +263,11 @@ get() -> get(Config) when is_list(Config) -> Version = ?config(http_version, Config), Host = ?config(host, Config), + Type = ?config(type, Config), ok = httpd_test_lib:verify_request(?config(type, Config), Host, - ?config(port, Config), ?config(node, Config), + ?config(port, Config), + transport_opts(Type, Config), + ?config(node, Config), http_request("GET /index.html ", Version, Host), [{statuscode, 200}, {header, "Content-Type", "text/html"}, @@ -172,6 +275,15 @@ get(Config) when is_list(Config) -> {header, "Server"}, {version, Version}]). +basic_auth_1_1(Config) when is_list(Config) -> + basic_auth([{http_version, "HTTP/1.1"} | Config]). + +basic_auth_1_0(Config) when is_list(Config) -> + basic_auth([{http_version, "HTTP/1.0"} | Config]). + +basic_auth_0_9(Config) when is_list(Config) -> + basic_auth([{http_version, "HTTP/0.9"} | Config]). + basic_auth() -> [{doc, "Test Basic authentication with WWW-Authenticate header"}]. @@ -203,13 +315,211 @@ basic_auth(Config) -> Config, [{statuscode, 200}]), %% Authentication still required! basic_auth_requiered(Config). - + +auth_api_1_1(Config) when is_list(Config) -> + auth_api([{http_version, "HTTP/1.1"} | Config]). + +auth_api_1_0(Config) when is_list(Config) -> + auth_api([{http_version, "HTTP/1.0"} | Config]). + +auth_api_0_9(Config) when is_list(Config) -> + auth_api([{http_version, "HTTP/0.9"} | Config]). + +auth_api() -> + [{doc, "Test mod_auth API"}]. + +auth_api(Config) when is_list(Config) -> + Prefix = ?config(auth_prefix, Config), + do_auth_api(Prefix, Config). + +do_auth_api(AuthPrefix, Config) -> + Version = ?config(http_version, Config), + Host = ?config(host, Config), + Port = ?config(port, Config), + Node = ?config(node, Config), + ServerRoot = ?config(server_root, Config), + ok = http_status("GET / ", Config, + [{statuscode, 200}]), + ok = auth_status(auth_request("/", "one", "WrongPassword", Version, Host), Config, + [{statuscode, 200}]), + + %% Make sure Authenticate header is received even the second time + %% we try a incorrect password! Otherwise a browser client will hang! + ok = auth_status(auth_request("/" ++ AuthPrefix ++ "open/", + "dummy", "WrongPassword", Version, Host), Config, + [{statuscode, 401}, + {header, "WWW-Authenticate"}]), + ok = auth_status(auth_request("/" ++ AuthPrefix ++ "open/", "dummy", "WrongPassword", + Version, Host), Config, [{statuscode, 401}, + {header, "WWW-Authenticate"}]), + + %% Change the password to DummyPassword then try to add a user + %% Get an error and set it to NoPassword + ok = update_password(Node, ServerRoot, Host, Port, AuthPrefix, + "open", "NoPassword", "DummyPassword"), + {error,bad_password} = + add_user(Node, ServerRoot, Port, AuthPrefix, "open", "one", + "onePassword", []), + ok = update_password(Node, ServerRoot, Host, Port, AuthPrefix, "open", + "DummyPassword", "NoPassword"), + + %% Test /*open, require user one Aladdin + remove_users(Node, ServerRoot, Host, Port, AuthPrefix, "open"), + + ok = auth_status(auth_request("/" ++ AuthPrefix ++ "open/", + "one", "onePassword", Version, Host), Config, + [{statuscode, 401}]), + + ok = auth_status(auth_request("/" ++ AuthPrefix ++ "open/", + "two", "twoPassword", Version, Host), Config, + [{statuscode, 401}]), + + ok = auth_status(auth_request("/" ++ AuthPrefix ++ "open/", + "Aladdin", "onePassword", Version, Host), + Config, [{statuscode, 401}]), + + true = add_user(Node, ServerRoot, Port, AuthPrefix, "open", "one", + "onePassword", []), + true = add_user(Node, ServerRoot, Port, AuthPrefix, "open", "two", + "twoPassword", []), + true = add_user(Node, ServerRoot, Port, AuthPrefix, "open", "Aladdin", + "AladdinPassword", []), + {ok, [_|_]} = list_users(Node, ServerRoot, Host, Port, + AuthPrefix, "open"), + ok = auth_status(auth_request("/" ++ AuthPrefix ++ "open/", + "one", "WrongPassword", Version, Host), + Config, [{statuscode, 401}]), + ok = auth_status(auth_request("/" ++ AuthPrefix ++ "open/", + "one", "onePassword", Version, Host), + Config, [{statuscode, 200}]), + ok = auth_status(auth_request("/" ++ AuthPrefix ++ "open/", + "two", "twoPassword", Version, Host), + Config,[{statuscode, 401}]), + ok = auth_status(auth_request("/" ++ AuthPrefix ++ "open/", + "Aladdin", "WrongPassword", Version, Host), + Config,[{statuscode, 401}]), + ok = auth_status(auth_request("/" ++ AuthPrefix ++ "open/", + "Aladdin", "AladdinPassword", Version, Host), + Config, [{statuscode, 200}]), + + remove_users(Node, ServerRoot, Host, Port, AuthPrefix, "open"), + {ok, []} = list_users(Node, ServerRoot, Host, Port, + AuthPrefix, "open"), + + %% Phase 2 + remove_users(Node, ServerRoot, Host, Port, AuthPrefix, "secret"), + {ok, []} = list_users(Node, ServerRoot, Host, Port, AuthPrefix, + "secret"), + ok = auth_status(auth_request("/" ++ AuthPrefix ++ "secret/", + "one", "onePassword", Version, Host), + Config, [{statuscode, 401}]), + ok = auth_status(auth_request("/" ++ AuthPrefix ++ "secret/", + "two", "twoPassword", Version, Host), + Config, [{statuscode, 401}]), + ok = auth_status(auth_request("/" ++ AuthPrefix ++ "secret/", + "three", "threePassword", Version, Host), + Config, [{statuscode, 401}]), + add_user(Node, ServerRoot, Port, AuthPrefix, "secret", "one", + "onePassword", + []), + add_user(Node, ServerRoot, Port, AuthPrefix, "secret", + "two", "twoPassword", []), + add_user(Node, ServerRoot, Port, AuthPrefix, "secret", "Aladdin", + "AladdinPassword",[]), + add_group_member(Node, ServerRoot, Port, AuthPrefix, "secret", + "one", "group1"), + add_group_member(Node, ServerRoot, Port, AuthPrefix, "secret", + "two", "group1"), + add_group_member(Node, ServerRoot, Port, AuthPrefix, + "secret", "Aladdin", "group2"), + ok = auth_status(auth_request("/" ++ AuthPrefix ++ "secret/", + "one", "onePassword", Version, Host), + Config, [{statuscode, 200}]), + ok = auth_status(auth_request("/" ++ AuthPrefix ++ "secret/", + "two", "twoPassword", Version, Host), + Config,[{statuscode, 200}]), + ok = auth_status(auth_request("/" ++ AuthPrefix ++ "secret/", + "Aladdin", "AladdinPassword", Version, Host), + Config, [{statuscode, 200}]), + ok = auth_status(auth_request("/" ++ AuthPrefix ++ "secret/", + "three", "threePassword", Version, Host), + Config, [{statuscode, 401}]), + remove_users(Node, ServerRoot, Host, Port, AuthPrefix, "secret"), + {ok, []} = list_users(Node, ServerRoot, Host, Port, + AuthPrefix, "secret"), + remove_groups(Node, ServerRoot, Host, Port, AuthPrefix, "secret"), + + {ok, []} = list_groups(Node, ServerRoot, Host, Port, AuthPrefix, "secret"), + + %% Phase 3 + remove_users(Node, ServerRoot, Host, Port, AuthPrefix, "secret/top_secret"), + remove_groups(Node, ServerRoot, Host, Port, AuthPrefix, "secret/top_secret"), + + ok = auth_status(auth_request("/" ++ AuthPrefix ++ + "secret/top_secret/", + "three", "threePassword", Version, Host), + Config, [{statuscode, 401}]), + ok = auth_status(auth_request("/" ++ AuthPrefix ++ + "secret/top_secret/", "two", "twoPassword", Version, Host), + Config, [{statuscode, 401}]), + add_user(Node, ServerRoot, Port, AuthPrefix, + "secret/top_secret","three", + "threePassword",[]), + add_user(Node, ServerRoot, Port, AuthPrefix, "secret/top_secret", + "two","twoPassword", []), + add_group_member(Node, ServerRoot, Port, AuthPrefix, "secret/top_secret", "three", "group3"), + ok = auth_status(auth_request("/" ++ AuthPrefix ++ + "secret/top_secret/", "three", "threePassword", + Version, Host), + Config, [{statuscode, 200}]), + ok = auth_status(auth_request("/" ++ AuthPrefix ++ + "secret/top_secret/", "two", "twoPassword", Version, Host), + Config, [{statuscode, 401}]), + add_group_member(Node, ServerRoot, Port, AuthPrefix, "secret/top_secret", "two", "group3"), + ok = auth_status(auth_request("/" ++ AuthPrefix ++ + "secret/top_secret/", + "two", "twoPassword", Version, Host), + Config, [{statuscode, 200}]), + remove_users(Node, ServerRoot, Host, Port, AuthPrefix, "secret/top_secret"), + {ok, []} = list_users(Node, ServerRoot, Host, Port, + AuthPrefix, "secret/top_secret"), + remove_groups(Node, ServerRoot, Host, Port, AuthPrefix, "secret/top_secret"), + {ok, []} = list_groups(Node, ServerRoot, Host, Port, AuthPrefix, "secret/top_secret"), + ok = auth_status(auth_request("/" ++ AuthPrefix ++ + "secret/top_secret/", "two", "twoPassword", Version, Host), + Config, [{statuscode, 401}]), + ok = auth_status(auth_request("/" ++ AuthPrefix ++ + "secret/top_secret/","three", "threePassword", Version, Host), + Config, [{statuscde, 401}]). +%%------------------------------------------------------------------------- +ipv6() -> + [{require, ipv6_hosts}, + {doc,"Test ipv6."}]. +ipv6(Config) when is_list(Config) -> + {ok, Hostname0} = inet:gethostname(), + case lists:member(list_to_atom(Hostname0), ct:get_config(ipv6_hosts)) of + true -> + Version = ?config(http_version, Config), + Host = ?config(host, Config), + URI = http_request("GET /", Version, Host), + httpd_test_lib:verify_request(?config(type, Config), Host, + ?config(port, Config), [inet6], + ?config(code, Config), + URI, + [{statuscode, 200}, {version, Version}]); + false -> + {skip, "Host does not support IPv6"} + end. + +%%------------------------------------------------------------------------- ssi() -> [{doc, "HTTP GET server side include test"}]. ssi(Config) when is_list(Config) -> Version = ?config(http_version, Config), Host = ?config(host, Config), + Type = ?config(type, Config), ok = httpd_test_lib:verify_request(?config(type, Config), Host, ?config(port, Config), + transport_opts(Type, Config), ?config(node, Config), http_request("GET /fsize.shtml ", Version, Host), [{statuscode, 200}, @@ -217,6 +527,131 @@ ssi(Config) when is_list(Config) -> {header, "Date"}, {header, "Server"}, {version, Version}]). +%%------------------------------------------------------------------------- +htaccess_1_1(Config) when is_list(Config) -> + htaccess([{http_version, "HTTP/1.1"} | Config]). + +htaccess_1_0(Config) when is_list(Config) -> + htaccess([{http_version, "HTTP/1.0"} | Config]). + +htaccess_0_9(Config) when is_list(Config) -> + htaccess([{http_version, "HTTP/0.9"} | Config]). + +htaccess() -> + [{doc, "Test mod_auth API"}]. + +htaccess(Config) when is_list(Config) -> + Version = ?config(http_version, Config), + Host = ?config(host, Config), + Type = ?config(type, Config), + Port = ?config(port, Config), + Node = ?config(node, Config), + %% Control that authentication required! + %% Control that the pages that shall be + %% authenticated really need authenticatin + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + http_request("GET /ht/open/ ", Version, Host), + [{statuscode, 401}, + {version, Version}, + {header, "WWW-Authenticate"}]), + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + http_request("GET /ht/secret/ ", Version, Host), + [{statuscode, 401}, + {version, Version}, + {header, "WWW-Authenticate"}]), + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + http_request("GET /ht/secret/top_secret/ ", + Version, Host), + [{statuscode, 401}, + {version, Version}, + {header, "WWW-Authenticate"}]), + + %% Make sure Authenticate header is received even the second time + %% we try a incorrect password! Otherwise a browser client will hang! + ok = auth_status(auth_request("/ht/open/", + "dummy", "WrongPassword", Version, Host), Config, + [{statuscode, 401}, + {header, "WWW-Authenticate"}]), + ok = auth_status(auth_request("/ht/open/", + "dummy", "WrongPassword", Version, Host), Config, + [{statuscode, 401}, + {header, "WWW-Authenticate"}]), + + %% Control that not just the first user in the list is valid + %% Control the first user + %% Authennticating ["one:OnePassword" user first in user list] + ok = auth_status(auth_request("/ht/open/dummy.html", "one", "OnePassword", + Version, Host), Config, + [{statuscode, 200}]), + + %% Control the second user + %% Authentication OK and a directory listing is supplied! + %% ["Aladdin:open sesame" user second in user list] + ok = auth_status(auth_request("/ht/open/","Aladdin", + "AladdinPassword", Version, Host), Config, + [{statuscode, 200}]), + + %% Contro that bad passwords and userids get a good denial + %% User correct but wrong password! ["one:one" user first in user list] + ok = auth_status(auth_request("/ht/open/", "one", "one", Version, Host), Config, + [{statuscode, 401}]), + %% Neither user or password correct! ["dummy:dummy"] + ok = auth_status(auth_request("/ht/open/", "dummy", "dummy", Version, Host), Config, + [{statuscode, 401}]), + + %% Control that authetication still works, even if its a member in a group + %% Authentication OK! ["two:TwoPassword" user in first group] + ok = auth_status(auth_request("/ht/secret/dummy.html", "two", + "TwoPassword", Version, Host), Config, + [{statuscode, 200}]), + + %% Authentication OK and a directory listing is supplied! + %% ["three:ThreePassword" user in second group] + ok = auth_status(auth_request("/ht/secret/", "three", + "ThreePassword", Version, Host), Config, + [{statuscode, 200}]), + + %% Deny users with bad passwords even if the user is a group member + %% User correct but wrong password! ["two:two" user in first group] + ok = auth_status(auth_request("/ht/secret/", "two", "two", Version, Host), Config, + [{statuscode, 401}]), + %% Neither user or password correct! ["dummy:dummy"] + ok = auth_status(auth_request("/ht/secret/", "dummy", "dummy", Version, Host), Config, + [{statuscode, 401}]), + + %% control that we deny the users that are in subnet above the allowed + ok = auth_status(auth_request("/ht/blocknet/dummy.html", "four", + "FourPassword", Version, Host), Config, + [{statuscode, 403}]), + %% Control that we only applies the rules to the right methods + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + http_request("HEAD /ht/blocknet/dummy.html ", Version, Host), + [{statuscode, head_status(Version)}, + {version, Version}]), + + %% Control that the rerquire directive can be overrideen + ok = auth_status(auth_request("/ht/secret/top_secret/ ", "Aladdin", "AladdinPassword", + Version, Host), Config, + [{statuscode, 401}]), + + %% Authentication still required! + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + http_request("GET /ht/open/ ", Version, Host), + [{statuscode, 401}, + {version, Version}, + {header, "WWW-Authenticate"}]), + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + http_request("GET /ht/secret/ ", Version, Host), + [{statuscode, 401}, + {version, Version}, + {header, "WWW-Authenticate"}]), + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + http_request("GET /ht/secret/top_secret/ ", Version, Host), + [{statuscode, 401}, + {version, Version}, + {header, "WWW-Authenticate"}]). + +%%------------------------------------------------------------------------- host() -> [{doc, "Test host header"}]. @@ -224,21 +659,21 @@ host(Config) when is_list(Config) -> Cb = ?config(version_cb, Config), Cb:host(?config(type, Config), ?config(port, Config), ?config(host, Config), ?config(node, Config)). - +%%------------------------------------------------------------------------- chunked() -> [{doc, "Check that the server accepts chunked requests."}]. chunked(Config) when is_list(Config) -> httpd_1_1:chunked(?config(type, Config), ?config(port, Config), ?config(host, Config), ?config(node, Config)). - +%%------------------------------------------------------------------------- expect() -> ["Check that the server handles request with the expect header " "field appropiate"]. expect(Config) when is_list(Config) -> httpd_1_1:expect(?config(type, Config), ?config(port, Config), ?config(host, Config), ?config(node, Config)). - +%%------------------------------------------------------------------------- max_clients_1_1() -> [{doc, "Test max clients limit"}]. @@ -256,7 +691,7 @@ max_clients_0_9() -> max_clients_0_9(Config) when is_list(Config) -> do_max_clients([{http_version, "HTTP/0.9"} | Config]). - +%%------------------------------------------------------------------------- esi() -> [{doc, "Test mod_esi"}]. @@ -286,7 +721,7 @@ esi(Config) when is_list(Config) -> ok = http_status("GET /cgi-bin/erl/httpd_example:get ", Config, [{statuscode, 200}, {no_header, "cache-control"}]). - +%%------------------------------------------------------------------------- cgi() -> [{doc, "Test mod_cgi"}]. @@ -361,7 +796,27 @@ cgi(Config) when is_list(Config) -> ok = http_status("GET /cgi-bin/" ++ Script ++ " ", Config, [{statuscode, 200}, {no_header, "cache-control"}]). - +%%------------------------------------------------------------------------- +cgi_chunked_encoding_test() -> + [{doc, "Test chunked encoding together with mod_cgi "}]. +cgi_chunked_encoding_test(Config) when is_list(Config) -> + Host = ?config(host, Config), + Script = + case test_server:os_type() of + {win32, _} -> + "/cgi-bin/printenv.bat"; + _ -> + "/cgi-bin/printenv.sh" + end, + Requests = + ["GET " ++ Script ++ " HTTP/1.1\r\nHost:"++ Host ++"\r\n\r\n", + "GET /cgi-bin/erl/httpd_example/newformat HTTP/1.1\r\nHost:" + ++ Host ++"\r\n\r\n"], + httpd_1_1:mod_cgi_chunked_encoding_test(?config(type, Config), ?config(port, Config), + Host, + ?config(node, Config), + Requests). +%%------------------------------------------------------------------------- alias() -> [{doc, "Test mod_alias"}]. @@ -389,160 +844,246 @@ alias(Config) when is_list(Config) -> [{statuscode, 301}, {header, "Location"}, {header, "Content-Type","text/html"}]). +%%------------------------------------------------------------------------- +actions() -> + [{doc, "Test mod_actions"}]. +actions(Config) when is_list(Config) -> + ok = http_status("GET /", Config, [{statuscode, 200}]). -%% auth_api() -> -%% [{doc, "Test mod_auth API"}]. - -%% auth_api(Config) when is_list(Config) -> -%% Version = ?config(http_version, Config), -%% Host = ?config(host, Config), -%% ok = http_status("GET / ", Config, -%% [{statuscode, 200}]), -%% ok = auth_status(auth_request("/", "one", "WrongPassword", Version, Host), Config, -%% [{statuscode, 200}]), - -%% %% Make sure Authenticate header is received even the second time -%% %% we try a incorrect password! Otherwise a browser client will hang! -%% ok = auth_status(auth_request("/" ++ AuthStoreType ++ "open/", -%% "dummy", "WrongPassword", Host), Config, -%% [{statuscode, 401}, -%% {header, "WWW-Authenticate"}]), -%% ok = auth_status(auth_request("/" ++ AuthStoreType ++ "open/", "dummy", "WrongPassword", -%% Host), Config, [{statuscode, 401}, -%% {header, "WWW-Authenticate"}]), - -%% %% Change the password to DummyPassword then try to add a user -%% %% Get an error and set it to NoPassword -%% ok = update_password(Node, ServerRoot, Host, Port, AuthStoreType ++ -%% "open", "NoPassword", "DummyPassword"), -%% {error,bad_password} = -%% add_user(Node, ServerRoot, Port, AuthStoreType ++ "open", "one", -%% "onePassword", []), -%% ok = update_password(Node, ServerRoot, Host, Port, AuthStoreType ++"open", -%% "DummyPassword", "NoPassword"), - -%% %% Test /*open, require user one Aladdin -%% remove_users(Node, ServerRoot, Host, Port, AuthStoreType ++ "open"), +%%------------------------------------------------------------------------- +range() -> + [{doc, "Test Range header"}]. + +range(Config) when is_list(Config) -> + httpd_1_1:range(?config(type, Config), ?config(port, Config), + ?config(host, Config), ?config(node, Config)). + +%%------------------------------------------------------------------------- +if_modified_since() -> + [{doc, "Test If-Modified-Since header"}]. + +if_modified_since(Config) when is_list(Config) -> + httpd_1_1:if_test(?config(type, Config), ?config(port, Config), + ?config(host, Config), ?config(node, Config), + ?config(doc_root, Config)). +%%------------------------------------------------------------------------- +trace() -> + [{doc, "Test TRACE method"}]. + +trace(Config) when is_list(Config) -> + Cb = ?config(version_cb, Config), + Cb:trace(?config(type, Config), ?config(port, Config), + ?config(host, Config), ?config(node, Config)). + +%%------------------------------------------------------------------------- +light() -> + ["Test light load"]. +light(Config) when is_list(Config) -> + httpd_load:load_test(?config(type, Config), ?config(port, Config), ?config(host, Config), + ?config(node, Config), 10). +%%------------------------------------------------------------------------- +medium() -> + ["Test medium load"]. +medium(Config) when is_list(Config) -> + httpd_load:load_test(?config(type, Config), ?config(port, Config), ?config(host, Config), + ?config(node, Config), 100). +%%------------------------------------------------------------------------- +heavy() -> + ["Test heavy load"]. +heavy(Config) when is_list(Config) -> + httpd_load:load_test(?config(type, Config), ?config(port, Config), ?config(host, Config), + ?config(node, Config), + 1000). +%%------------------------------------------------------------------------- +content_length() -> + ["Tests that content-length is correct OTP-5775"]. +content_length(Config) -> + Version = ?config(http_version, Config), + Host = ?config(host, Config), + ok = httpd_test_lib:verify_request(?config(type, Config), Host, + ?config(port, Config), ?config(node, Config), + http_request("GET /cgi-bin/erl/httpd_example:get_bin ", + Version, Host), + [{statuscode, 200}, + {content_length, 274}, + {version, Version}]). +%%------------------------------------------------------------------------- +bad_hex() -> + ["Tests that a URI with a bad hexadecimal code is handled OTP-6003"]. +bad_hex(Config) -> + Version = ?config(http_version, Config), + Host = ?config(host, Config), + ok = httpd_test_lib:verify_request(?config(type, Config), Host, + ?config(port, Config), ?config(node, Config), + http_request("GET http://www.erlang.org/%skalle ", + Version, Host), + [{statuscode, 400}, + {version, Version}]). +%%------------------------------------------------------------------------- +missing_CR() -> + ["Tests missing CR in delimiter OTP-7304"]. +missing_CR(Config) -> + Version = ?config(http_version, Config), + Host = ?config(host, Config), + ok = httpd_test_lib:verify_request(?config(type, Config), Host, + ?config(port, Config), ?config(node, Config), + http_request_missing_CR("GET /index.html ", Version, Host), + [{statuscode, 200}, + {version, Version}]). + +%%------------------------------------------------------------------------- +max_header() -> + ["Denial Of Service (DOS) attack, prevented by max_header"]. +max_header(Config) when is_list(Config) -> + Version = ?config(http_version, Config), + Host = ?config(host, Config), + case Version of + "HTTP/0.9" -> + {skip, no_implemented}; + _ -> + dos_hostname(?config(type, Config), ?config(port, Config), Host, + ?config(node, Config), Version, ?MAX_HEADER_SIZE) + end. + +%%------------------------------------------------------------------------- +security_1_1(Config) when is_list(Config) -> + security([{http_version, "HTTP/1.1"} | Config]). + +security_1_0(Config) when is_list(Config) -> + security([{http_version, "HTTP/1.0"} | Config]). + +security() -> + ["Test mod_security"]. +security(Config) -> + Version = ?config(http_version, Config), + Host = ?config(host, Config), + Port = ?config(port, Config), + Node = ?config(node, Config), + ServerRoot = ?config(server_root, Config), + + global:register_name(mod_security_test, self()), % Receive events + + test_server:sleep(5000), + + OpenDir = filename:join([ServerRoot, "htdocs", "open"]), + + %% Test blocking / unblocking of users. -%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "open/", -%% "one", "onePassword", [{statuscode, 401}]), + %% /open, require user one Aladdin + remove_users(Node, ServerRoot, Host, Port, "", "open"), + + ok = auth_status(auth_request("/open/", + "one", "onePassword", Version, Host), Config, + [{statuscode, 401}]), + + receive_security_event({event, auth_fail, Port, OpenDir, + [{user, "one"}, {password, "onePassword"}]}, + Node, Port), -%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "open/", -%% "two", "twoPassword", [{statuscode, 401}]), + ok = auth_status(auth_request("/open/", + "two", "twoPassword", Version, Host), Config, + [{statuscode, 401}]), -%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "open/", -%% "Aladdin", "onePassword", [{statuscode, 401}]), - -%% add_user(Node, ServerRoot, Port, AuthStoreType ++ "open", "one", -%% "onePassword", []), -%% add_user(Node, ServerRoot, Port, AuthStoreType ++ "open", "two", -%% "twoPassword", []), -%% add_user(Node, ServerRoot, Port, AuthStoreType ++ "open", "Aladdin", -%% "AladdinPassword", []), + receive_security_event({event, auth_fail, Port, OpenDir, + [{user, "two"}, {password, "twoPassword"}]}, + Node, Port), + + ok = auth_status(auth_request("/open/", + "Aladdin", "AladdinPassword", Version, Host), + Config, [{statuscode, 401}]), + + receive_security_event({event, auth_fail, Port, OpenDir, + [{user, "Aladdin"}, + {password, "AladdinPassword"}]}, + Node, Port), + + add_user(Node, ServerRoot, Port, "", "open", "one", "onePassword", []), + add_user(Node, ServerRoot, Port, "", "open", "two", "twoPassword", []), + + ok = auth_status(auth_request("/open/", "one", "WrongPassword", Version, Host), Config, + [{statuscode, 401}]), + + receive_security_event({event, auth_fail, Port, OpenDir, + [{user, "one"}, {password, "WrongPassword"}]}, + Node, Port), + + ok = auth_status(auth_request("/open/", "one", "WrongPassword", Version, Host), Config, + [{statuscode, 401}]), + + receive_security_event({event, auth_fail, Port, OpenDir, + [{user, "one"}, {password, "WrongPassword"}]}, + Node, Port), + receive_security_event({event, user_block, Port, OpenDir, + [{user, "one"}]}, Node, Port), + + global:unregister_name(mod_security_test), % No more events. + + ok = auth_status(auth_request("/open/", "one", "WrongPassword", Version, Host), Config, + [{statuscode, 401}]), + + %% User "one" should be blocked now.. + case list_blocked_users(Node, Port) of + [{"one",_, Port, OpenDir,_}] -> + ok; + Blocked -> + ct:fail({unexpected_blocked, Blocked}) + end, + + [{"one",_, Port, OpenDir,_}] = list_blocked_users(Node, Port, OpenDir), + + true = unblock_user(Node, "one", Port, OpenDir), + %% User "one" should not be blocked any more. + + [] = list_blocked_users(Node, Port), + + ok = auth_status(auth_request("/open/", "one", "onePassword", Version, Host), Config, + [{statuscode, 200}]), + + %% Test list_auth_users & auth_timeout + + ["one"] = list_auth_users(Node, Port), + + ok = auth_status(auth_request("/open/", "two", "onePassword", Version, Host), Config, + [{statuscode, 401}]), + + ["one"] = list_auth_users(Node, Port), + -%% {ok, [_|_]} = list_users(Node, ServerRoot, Host, Port, -%% AuthStoreType++"open"), -%% auth_request(Type, Host, Port, Node, "/" ++ AuthStoreType ++ "open/", -%% "one", "WrongPassword", [{statuscode, 401}]), -%% auth_request(Type, Host, Port, Node, "/" ++ AuthStoreType ++ "open/", -%% "one", "onePassword", [{statuscode, 200}]), -%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "open/", -%% "two", "twoPassword", [{statuscode, 401}]), -%% auth_request(Type, Host, Port, Node, "/" ++ AuthStoreType ++ "open/", -%% "Aladdin", "WrongPassword", [{statuscode, 401}]), -%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "open/", -%% "Aladdin", "AladdinPassword", [{statuscode, 200}]), + ["one"] = list_auth_users(Node, Port, OpenDir), + -%% remove_users(Node, ServerRoot, Host, Port, AuthStoreType++"open"), -%% {ok, []} = list_users(Node, ServerRoot, Host, Port, -%% AuthStoreType++"open"), - -%% %% Phase 2 -%% remove_users(Node, ServerRoot, Host, Port, AuthStoreType++"secret"), -%% {ok, []} = list_users(Node, ServerRoot, Host, Port, AuthStoreType ++ -%% "secret"), -%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "secret/", -%% "one", "onePassword", [{statuscode, 401}]), -%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "secret/", -%% "two", "twoPassword", [{statuscode, 401}]), -%% auth_request(Type, Host, Port, Node, "/" ++ AuthStoreType ++ "secret/", -%% "three", "threePassword", [{statuscode, 401}]), -%% add_user(Node, ServerRoot, Port, AuthStoreType ++ "secret", "one", -%% "onePassword", -%% []), -%% add_user(Node, ServerRoot, Port, AuthStoreType ++ "secret", -%% "two", "twoPassword", []), -%% add_user(Node, ServerRoot, Port, AuthStoreType++"secret", "Aladdin", -%% "AladdinPassword",[]), -%% add_group_member(Node, ServerRoot, Port, AuthStoreType ++ "secret", -%% "one", "group1"), -%% add_group_member(Node, ServerRoot, Port, AuthStoreType ++ "secret", -%% "two", "group1"), -%% add_group_member(Node, ServerRoot, Port, AuthStoreType ++ -%% "secret", "Aladdin", "group2"), -%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "secret/", -%% "one", "onePassword", [{statuscode, 200}]), -%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "secret/", -%% "two", "twoPassword", [{statuscode, 200}]), -%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "secret/", -%% "Aladdin", "AladdinPassword", [{statuscode, 200}]), -%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "secret/", -%% "three", "threePassword", [{statuscode, 401}]), -%% remove_users(Node, ServerRoot, Host, Port, AuthStoreType ++ "secret"), -%% {ok, []} = list_users(Node, ServerRoot, Host, Port, -%% AuthStoreType ++ "secret"), -%% remove_groups(Node, ServerRoot, Host, Port, AuthStoreType ++ "secret"), -%% Directory = filename:join([ServerRoot, "htdocs", AuthStoreType ++ -%% "secret"]), -%% {ok, []} = list_groups(Node, ServerRoot, Host, Port, Directory), - -%% %% Phase 3 -%% remove_users(Node, ServerRoot, Host, Port, AuthStoreType ++ -%% "secret/top_secret"), -%% remove_groups(Node, ServerRoot, Host, Port, AuthStoreType ++ -%% "secret/top_secret"), -%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ -%% "secret/top_secret/", -%% "three", "threePassword", [{statuscode, 401}]), -%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ -%% "secret/top_secret/", "two", "twoPassword", -%% [{statuscode, 401}]), -%% add_user(Node, ServerRoot, Port, AuthStoreType ++ -%% "secret/top_secret","three", -%% "threePassword",[]), -%% add_user(Node, ServerRoot, Port, AuthStoreType ++ "secret/top_secret", -%% "two","twoPassword", []), -%% add_group_member(Node, ServerRoot, Port, AuthStoreType ++ -%% "secret/top_secret", -%% "three", "group3"), -%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ -%% "secret/top_secret/", "three", "threePassword", -%% [{statuscode, 200}]), -%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ -%% "secret/top_secret/", "two", "twoPassword", -%% [{statuscode, 401}]), -%% add_group_member(Node, ServerRoot, Port, AuthStoreType ++ -%% "secret/top_secret", -%% "two", "group3"), -%% auth_request(Type,Host,Port,Node,"/" ++ AuthStoreType ++ -%% "secret/top_secret/", -%% "two", "twoPassword", [{statuscode, 200}]), -%% remove_users(Node, ServerRoot, Host, Port, AuthStoreType ++ -%% "secret/top_secret"), -%% {ok, []} = list_users(Node, ServerRoot, Host, Port, -%% AuthStoreType ++ "secret/top_secret"), -%% remove_groups(Node, ServerRoot, Host, Port, AuthStoreType ++ -%% "secret/top_secret"), -%% Directory2 = filename:join([ServerRoot, "htdocs", -%% AuthStoreType ++ "secret/top_secret"]), -%% {ok, []} = list_groups(Node, ServerRoot, Host, Port, Directory2), -%% auth_request(Type, Host, Port, Node, "/" ++ AuthStoreType ++ -%% "secret/top_secret/", "two", "twoPassword", -%% [{statuscode, 401}]), -%% auth_request(Type, Host, Port, Node, "/" ++ AuthStoreType ++ -%% "secret/top_secret/","three", "threePassword", -%% [{statuscode, 401}]). + ok = auth_status(auth_request("/open/", "two", "twoPassword", Version, Host), Config, + [{statuscode, 401}]), + + ["one"] = list_auth_users(Node, Port), + + + ["one"] = list_auth_users(Node, Port, OpenDir), + + %% Wait for successful auth to timeout. + test_server:sleep(?AUTH_TIMEOUT*1001), + + [] = list_auth_users(Node, Port), + + [] = list_auth_users(Node, Port, OpenDir), + + %% "two" is blocked. + + true = unblock_user(Node, "two", Port, OpenDir), + + + %% Test explicit blocking. Block user 'two'. + + [] = list_blocked_users(Node,Port,OpenDir), + + true = block_user(Node, "two", Port, OpenDir, 10), + + ok = auth_status(auth_request("/open/", "two", "twoPassword", Version, Host), Config, + [{statuscode, 401}]), + + true = unblock_user(Node, "two", Port, OpenDir). + %%-------------------------------------------------------------------- @@ -550,21 +1091,34 @@ alias(Config) when is_list(Config) -> %%-------------------------------------------------------------------- do_max_clients(Config) -> Version = ?config(http_version, Config), - Host = ?config(host, Config), - start_blocker(Config), - ok = httpd_test_lib:verify_request(?config(type, Config), Host, - ?config(port, Config), ?config(node, Config), - http_request("GET /index.html ", Version, Host), + Host = ?config(host, Config), + Port = ?config(port, Config), + Type = ?config(type, Config), + + Request = http_request("GET /index.html ", Version, Host), + BlockRequest = http_request("GET /eval?httpd_example:delay(2000) ", Version, Host), + {ok, Socket} = inets_test_lib:connect_bin(Type, Host, Port, transport_opts(Type, Config)), + inets_test_lib:send(Type, Socket, BlockRequest), + ct:sleep(100), + ok = httpd_test_lib:verify_request(Type, Host, + Port, + transport_opts(Type, Config), + ?config(node, Config), + Request, [{statuscode, 503}, {version, Version}]), receive - after 2000 -> - ok = httpd_test_lib:verify_request(?config(type, Config), Host, - ?config(port, Config), ?config(node, Config), - http_request("GET /index.html ", Version, Host), - [{statuscode, 200}, - {version, Version}]) - end. + {_, Socket, _Msg} -> + ok + end, + inets_test_lib:close(Type, Socket), + ok = httpd_test_lib:verify_request(Type, Host, + Port, + transport_opts(Type, Config), + ?config(node, Config), + Request, + [{statuscode, 200}, + {version, Version}]). setup_server_dirs(ServerRoot, DocRoot, DataDir) -> CgiDir = filename:join(ServerRoot, "cgi-bin"), @@ -604,10 +1158,24 @@ setup_server_dirs(ServerRoot, DocRoot, DataDir) -> ok = file:write_file_info(EnvCGI, FileInfo1#file_info{mode = 8#00755}). -start_apps(https) -> - inets_test_lib:start_apps([crypto, public_key, ssl]); -start_apps(_) -> - ok. +start_apps(Group) when Group == https_basic; + Group == https_limit; + Group == https_basic_auth; + Group == https_auth_api; + Group == https_auth_api_dets; + Group == https_auth_api_mnesia; + Group == http_htaccess; + Group == http_security -> + inets_test_lib:start_apps([inets, asn1, crypto, public_key, ssl]); +start_apps(Group) when Group == http_basic; + Group == http_limit; + Group == http_basic_auth; + Group == http_auth_api; + Group == http_auth_api_dets; + Group == http_auth_api_mnesia; + Group == https_htaccess; + Group == https_security -> + inets_test_lib:start_apps([inets]). server_start(_, HttpdConfig) -> {ok, Pid} = inets:start(httpd, HttpdConfig), @@ -615,6 +1183,80 @@ server_start(_, HttpdConfig) -> {value, {_, _, Info}} = lists:keysearch(Pid, 2, Serv), {Pid, proplists:get_value(port, Info)}. +init_ssl(Group, Config) -> + PrivDir = ?config(priv_dir, Config), + CaKey = {_Trusted,_} = + erl_make_certs:make_cert([{key, dsa}, + {subject, + [{name, "Public Key"}, + {?'id-at-name', + {printableString, "public_key"}}, + {?'id-at-pseudonym', + {printableString, "pubkey"}}, + {city, "Stockholm"}, + {country, "SE"}, + {org, "erlang"}, + {org_unit, "testing dep"} + ]} + ]), + ok = erl_make_certs:write_pem(PrivDir, "public_key_cacert", CaKey), + + CertK1 = {_Cert1, _} = erl_make_certs:make_cert([{issuer, CaKey}]), + CertK2 = {_Cert2,_} = erl_make_certs:make_cert([{issuer, CertK1}, + {digest, md5}, + {extensions, false}]), + ok = erl_make_certs:write_pem(PrivDir, "public_key_cert", CertK2), + + case start_apps(Group) of + ok -> + init_httpd(Group, [{type, ssl} | Config]); + _ -> + {skip, "Could not start https apps"} + end. + +server_config(http_basic, Config) -> + basic_conf() ++ server_config(http, Config); +server_config(https_basic, Config) -> + basic_conf() ++ server_config(https, Config); +server_config(http_limit, Config) -> + [{max_clients, 1}] ++ server_config(http, Config); +server_config(https_limit, Config) -> + [{max_clients, 1}] ++ server_config(https, Config); +server_config(http_basic_auth, Config) -> + ServerRoot = ?config(server_root, Config), + auth_conf(ServerRoot) ++ server_config(http, Config); +server_config(https_basic_auth, Config) -> + ServerRoot = ?config(server_root, Config), + auth_conf(ServerRoot) ++ server_config(https, Config); +server_config(http_auth_api, Config) -> + ServerRoot = ?config(server_root, Config), + auth_api_conf(ServerRoot, plain) ++ server_config(http, Config); +server_config(https_auth_api, Config) -> + ServerRoot = ?config(server_root, Config), + auth_api_conf(ServerRoot, plain) ++ server_config(https, Config); +server_config(http_auth_api_dets, Config) -> + ServerRoot = ?config(server_root, Config), + auth_api_conf(ServerRoot, dets) ++ server_config(http, Config); +server_config(https_auth_api_dets, Config) -> + ServerRoot = ?config(server_root, Config), + auth_api_conf(ServerRoot, dets) ++ server_config(https, Config); +server_config(http_auth_api_mnesia, Config) -> + ServerRoot = ?config(server_root, Config), + auth_api_conf(ServerRoot, mnesia) ++ server_config(http, Config); +server_config(https_auth_api_mnesia, Config) -> + ServerRoot = ?config(server_root, Config), + auth_api_conf(ServerRoot, mnesia) ++ server_config(https, Config); +server_config(http_htaccess, Config) -> + auth_access_conf() ++ server_config(http, Config); +server_config(https_htaccess, Config) -> + auth_access_conf() ++ server_config(https, Config); +server_config(http_security, Config) -> + ServerRoot = ?config(server_root, Config), + tl(auth_conf(ServerRoot)) ++ security_conf(ServerRoot) ++ server_config(http, Config); +server_config(https_security, Config) -> + ServerRoot = ?config(server_root, Config), + tl(auth_conf(ServerRoot)) ++ security_conf(ServerRoot) ++ server_config(https, Config); + server_config(http, Config) -> ServerRoot = ?config(server_root, Config), [{port, 0}, @@ -625,6 +1267,7 @@ server_config(http, Config) -> {ipfamily, inet}, {max_header_size, 256}, {max_header_action, close}, + {directory_index, ["index.html", "welcome.html"]}, {mime_types, [{"html","text/html"},{"htm","text/html"}, {"shtml","text/html"}, {"gif", "image/gif"}]}, {alias, {"/icons/", filename:join(ServerRoot,"icons") ++ "/"}}, @@ -633,13 +1276,24 @@ server_config(http, Config) -> {script_alias, {"/htbin/", filename:join(ServerRoot, "cgi-bin") ++ "/"}}, {erl_script_alias, {"/cgi-bin/erl", [httpd_example, io]}}, {eval_script_alias, {"/eval", [httpd_example, io]}} - ] ++ auth_conf(ServerRoot); + ]; -server_config(http_limit, Config) -> - [{max_clients, 1}] ++ server_config(http, Config); - -server_config(_, _) -> - []. +server_config(https, Config) -> + PrivDir = ?config(priv_dir, Config), + [{socket_type, {essl, + [{cacertfile, + filename:join(PrivDir, "public_key_cacert.pem")}, + {certfile, + filename:join(PrivDir, "public_key_cert.pem")}, + {keyfile, + filename:join(PrivDir, "public_key_cert_key.pem")} + ]}}] ++ server_config(http, Config). + +init_httpd(Group, Config0) -> + Config1 = proplists:delete(port, Config0), + Config = proplists:delete(server_pid, Config1), + {Pid, Port} = server_start(Group, server_config(Group, Config)), + [{server_pid, Pid}, {port, Port} | Config]. http_request(Request, "HTTP/1.1" = Version, Host, {Headers, Body}) -> Request ++ Version ++ "\r\nhost:" ++ Host ++ "\r\n" ++ Headers ++ "\r\n" ++ Body; @@ -662,19 +1316,33 @@ auth_request(Path, User, Passwd, Version, _Host) -> base64:encode_to_string(User++":"++Passwd) ++ "\r\n\r\n". +http_request_missing_CR(Request, "HTTP/1.1" = Version, Host) -> + Request ++ Version ++ "\r\nhost:" ++ Host ++ "\r\n\r\n\n"; +http_request_missing_CR(Request, Version, _) -> + Request ++ Version ++ "\r\n\n". + head_status("HTTP/0.9") -> 501; %% Not implemented in HTTP/0.9 head_status(_) -> 200. +basic_conf() -> + [{modules, [mod_alias, mod_range, mod_responsecontrol, + mod_trace, mod_esi, mod_cgi, mod_dir, mod_get, mod_head]}]. + +auth_access_conf() -> + [{modules, [mod_alias, mod_htaccess, mod_dir, mod_get, mod_head]}, + {access_files, [".htaccess"]}]. + auth_conf(Root) -> - [{directory, {filename:join(Root, "htdocs/open"), + [{modules, [mod_alias, mod_auth, mod_dir, mod_get, mod_head]}, + {directory, {filename:join(Root, "htdocs/open"), [{auth_type, plain}, {auth_name, "Open Area"}, {auth_user_file, filename:join(Root, "auth/passwd")}, {auth_group_file, filename:join(Root, "auth/group")}, {require_user, ["one", "Aladdin"]}]}}, - {directory, {filename:join(Root, "htdocs/secret"), + {directory, {filename:join(Root, "htdocs/secret"), [{auth_type, plain}, {auth_name, "Secret Area"}, {auth_user_file, filename:join(Root, "auth/passwd")}, @@ -685,43 +1353,134 @@ auth_conf(Root) -> {auth_name, "Top Secret Area"}, {auth_user_file, filename:join(Root, "auth/passwd")}, {auth_group_file, filename:join(Root, "auth/group")}, - {require_group, ["group3"]}]}}, + {require_group, ["group3"]}]}}]. + +auth_api_conf(Root, plain) -> + [{modules, [mod_alias, mod_auth, mod_dir, mod_get, mod_head]}, {directory, {filename:join(Root, "htdocs/open"), - [{auth_type, mnesia}, + [{auth_type, plain}, {auth_name, "Open Area"}, {auth_user_file, filename:join(Root, "auth/passwd")}, {auth_group_file, filename:join(Root, "auth/group")}, {require_user, ["one", "Aladdin"]}]}}, {directory, {filename:join(Root, "htdocs/secret"), - [{auth_type, mnesia}, + [{auth_type, plain}, {auth_name, "Secret Area"}, {auth_user_file, filename:join(Root, "auth/passwd")}, {auth_group_file, filename:join(Root, "auth/group")}, - {require_group, ["group1", "group2"]}]}} - ]. + {require_group, ["group1", "group2"]}]}}, + {directory, {filename:join(Root, "htdocs/secret/top_secret"), + [{auth_type, plain}, + {auth_name, "Top Secret Area"}, + {auth_user_file, filename:join(Root, "auth/passwd")}, + {auth_group_file, filename:join(Root, "auth/group")}, + {require_group, ["group3"]}]}}]; +auth_api_conf(Root, dets) -> + [ + {modules, [mod_alias, mod_auth, mod_dir, mod_get, mod_head]}, + {directory, {filename:join(Root, "htdocs/dets_open"), + [{auth_type, dets}, + {auth_name, "Dets Open Area"}, + {auth_user_file, filename:join(Root, "passwd")}, + {auth_group_file, filename:join(Root, "group")}, + {require_user, ["one", "Aladdin"]}]}}, + {directory, {filename:join(Root, "htdocs/dets_secret"), + [{auth_type, dets}, + {auth_name, "Dests Secret Area"}, + {auth_user_file, filename:join(Root, "passwd")}, + {auth_group_file, filename:join(Root, "group")}, + {require_group, ["group1", "group2"]}]}}, + {directory, {filename:join(Root, "htdocs/dets_secret/top_secret"), + [{auth_type, dets}, + {auth_name, "Dets Top Secret Area"}, + {auth_user_file, filename:join(Root, "passwd")}, + {auth_group_file, filename:join(Root, "group")}, + {require_group, ["group3"]}]}} + ]; + +auth_api_conf(Root, mnesia) -> + [{modules, [mod_alias, mod_auth, mod_dir, mod_get, mod_head]}, + {directory, {filename:join(Root, "htdocs/mnesia_open"), + [{auth_type, mnesia}, + {auth_name, "Mnesia Open Area"}, + {require_user, ["one", "Aladdin"]}]}}, + {directory, {filename:join(Root, "htdocs/mnesia_secret"), + [{auth_type, mnesia}, + {auth_name, "Mnesia Secret Area"}, + {require_group, ["group1", "group2"]}]}}, + {directory, {filename:join(Root, "htdocs/mnesia_secret/top_secret"), + [{auth_type, mnesia}, + {auth_name, "Mnesia Top Secret Area"}, + {require_group, ["group3"]}]}}]. + +security_conf(Root) -> + SecFile = filename:join(Root, "security_data"), + Open = filename:join(Root, "htdocs/open"), + Secret = filename:join(Root, "htdocs/secret"), + TopSecret = filename:join(Root, "htdocs/secret/top_secret"), + + [{modules, [mod_alias, mod_auth, mod_security, mod_dir, mod_get, mod_head]}, + {security_directory, {Open, + [{auth_name, "Open Area"}, + {auth_user_file, filename:join(Root, "auth/passwd")}, + {auth_group_file, filename:join(Root, "auth/group")}, + {require_user, ["one", "Aladdin"]} | + mod_security_conf(SecFile, Open)]}}, + {security_directory, {Secret, + [{auth_name, "Secret Area"}, + {auth_user_file, filename:join(Root, "auth/passwd")}, + {auth_group_file, filename:join(Root, "auth/group")}, + {require_group, ["group1", "group2"]} | + mod_security_conf(SecFile, Secret)]}}, + {security_directory, {TopSecret, + [{auth_name, "Top Secret Area"}, + {auth_user_file, filename:join(Root, "auth/passwd")}, + {auth_group_file, filename:join(Root, "auth/group")}, + {require_group, ["group3"]} | + mod_security_conf(SecFile, TopSecret)]}}]. + +mod_security_conf(SecFile, Dir) -> + [{data_file, SecFile}, + {max_retries, 3}, + {fail_expire_time, ?FAIL_EXPIRE_TIME}, + {block_time, 1}, + {auth_timeout, ?AUTH_TIMEOUT}, + {callback_module, ?MODULE}, + {path, Dir} %% This is should not be needed, but is atm, awful design! + ]. + http_status(Request, Config, Expected) -> Version = ?config(http_version, Config), Host = ?config(host, Config), + Type = ?config(type, Config), httpd_test_lib:verify_request(?config(type, Config), Host, - ?config(port, Config), ?config(node, Config), + ?config(port, Config), + transport_opts(Type, Config), + ?config(node, Config), http_request(Request, Version, Host), Expected ++ [{version, Version}]). http_status(Request, HeadersAndBody, Config, Expected) -> Version = ?config(http_version, Config), - Host = ?config(host, Config), + Host = ?config(host, Config), + Type = ?config(type, Config), httpd_test_lib:verify_request(?config(type, Config), Host, - ?config(port, Config), ?config(node, Config), + ?config(port, Config), + transport_opts(Type, Config), + ?config(node, Config), http_request(Request, Version, Host, HeadersAndBody), Expected ++ [{version, Version}]). auth_status(AuthRequest, Config, Expected) -> Version = ?config(http_version, Config), Host = ?config(host, Config), + Type = ?config(type, Config), httpd_test_lib:verify_request(?config(type, Config), Host, - ?config(port, Config), ?config(node, Config), + ?config(port, Config), + transport_opts(Type, Config), + ?config(node, Config), AuthRequest, Expected ++ [{version, Version}]). @@ -772,23 +1531,258 @@ cleanup_mnesia() -> mnesia:delete_schema([node()]), ok. -start_blocker(Config) -> - spawn(httpd_SUITE, init_blocker, [self(), Config]), - receive - blocker_start -> +transport_opts(ssl, Config) -> + PrivDir = ?config(priv_dir, Config), + [{cacertfile, filename:join(PrivDir, "public_key_cacert.pem")}]; +transport_opts(_, _) -> + []. + + +%%% mod_range +create_range_data(Path) -> + PathAndFileName=filename:join([Path,"range.txt"]), + case file:read_file(PathAndFileName) of + {error, enoent} -> + file:write_file(PathAndFileName,list_to_binary(["12345678901234567890", + "12345678901234567890", + "12345678901234567890", + "12345678901234567890", + "12345678901234567890"])); + _ -> ok end. + +%%% mod_htaccess +create_htaccess_data(Path, IpAddress)-> + create_htaccess_dirs(Path), + + create_html_file(filename:join([Path,"ht/open/dummy.html"])), + create_html_file(filename:join([Path,"ht/blocknet/dummy.html"])), + create_html_file(filename:join([Path,"ht/secret/dummy.html"])), + create_html_file(filename:join([Path,"ht/secret/top_secret/dummy.html"])), -init_blocker(From, Config) -> - From ! blocker_start, - block(Config). + create_htaccess_file(filename:join([Path,"ht/open/.htaccess"]), + Path, "user one Aladdin"), + create_htaccess_file(filename:join([Path,"ht/secret/.htaccess"]), + Path, "group group1 group2"), + create_htaccess_file(filename:join([Path, + "ht/secret/top_secret/.htaccess"]), + Path, "user four"), + create_htaccess_file(filename:join([Path,"ht/blocknet/.htaccess"]), + Path, nouser, IpAddress), + + create_user_group_file(filename:join([Path,"ht","users.file"]), + "one:OnePassword\ntwo:TwoPassword\nthree:" + "ThreePassword\nfour:FourPassword\nAladdin:" + "AladdinPassword"), + create_user_group_file(filename:join([Path,"ht","groups.file"]), + "group1: two one\ngroup2: two three"). + +create_html_file(PathAndFileName)-> + file:write_file(PathAndFileName,list_to_binary( + "<html><head><title>test</title></head> + <body>testar</body></html>")). + +create_htaccess_file(PathAndFileName, BaseDir, RequireData)-> + file:write_file(PathAndFileName, + list_to_binary( + "AuthUserFile "++ BaseDir ++ + "/ht/users.file\nAuthGroupFile "++ BaseDir + ++ "/ht/groups.file\nAuthName Test\nAuthType" + " Basic\n<Limit>\nrequire " ++ RequireData ++ + "\n</Limit>")). + +create_htaccess_file(PathAndFileName, BaseDir, nouser, IpAddress)-> + file:write_file(PathAndFileName,list_to_binary( + "AuthUserFile "++ BaseDir ++ + "/ht/users.file\nAuthGroupFile " ++ + BaseDir ++ "/ht/groups.file\nAuthName" + " Test\nAuthType" + " Basic\n<Limit GET>\n\tallow from " ++ + format_ip(IpAddress, + string:rchr(IpAddress,$.)) ++ + "\n</Limit>")). + +create_user_group_file(PathAndFileName, Data)-> + file:write_file(PathAndFileName, list_to_binary(Data)). + +create_htaccess_dirs(Path)-> + ok = file:make_dir(filename:join([Path,"ht"])), + ok = file:make_dir(filename:join([Path,"ht/open"])), + ok = file:make_dir(filename:join([Path,"ht/blocknet"])), + ok = file:make_dir(filename:join([Path,"ht/secret"])), + ok = file:make_dir(filename:join([Path,"ht/secret/top_secret"])). + +remove_htaccess_dirs(Path)-> + file:del_dir(filename:join([Path,"ht/secret/top_secret"])), + file:del_dir(filename:join([Path,"ht/secret"])), + file:del_dir(filename:join([Path,"ht/blocknet"])), + file:del_dir(filename:join([Path,"ht/open"])), + file:del_dir(filename:join([Path,"ht"])). + +format_ip(IpAddress,Pos)when Pos > 0-> + case lists:nth(Pos,IpAddress) of + $.-> + case lists:nth(Pos-2,IpAddress) of + $.-> + format_ip(IpAddress,Pos-3); + _-> + lists:sublist(IpAddress,Pos-2) ++ "." + end; + _ -> + format_ip(IpAddress,Pos-1) + end; + +format_ip(IpAddress, _Pos)-> + "1" ++ IpAddress. + +remove_htaccess(Path)-> + file:delete(filename:join([Path,"ht/open/dummy.html"])), + file:delete(filename:join([Path,"ht/secret/dummy.html"])), + file:delete(filename:join([Path,"ht/secret/top_secret/dummy.html"])), + file:delete(filename:join([Path,"ht/blocknet/dummy.html"])), + file:delete(filename:join([Path,"ht/blocknet/.htaccess"])), + file:delete(filename:join([Path,"ht/open/.htaccess"])), + file:delete(filename:join([Path,"ht/secret/.htaccess"])), + file:delete(filename:join([Path,"ht/secret/top_secret/.htaccess"])), + file:delete(filename:join([Path,"ht","users.file"])), + file:delete(filename:join([Path,"ht","groups.file"])), + remove_htaccess_dirs(Path). + +dos_hostname(Type, Port, Host, Node, Version, Max) -> + TooLongHeader = lists:append(lists:duplicate(Max + 1, "a")), + + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + dos_hostname_request("", Version), + [{statuscode, 200}, + {version, Version}]), + + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + dos_hostname_request("dummy-host.ericsson.se", Version), + [{statuscode, 200}, + {version, Version}]), + + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + dos_hostname_request(TooLongHeader, Version), + [{statuscode, dos_code(Version)}, + {version, Version}]). +dos_hostname_request(Host, Version) -> + dos_http_request("GET / ", Version, Host). + +dos_http_request(Request, "HTTP/1.1" = Version, Host) -> + http_request(Request, Version, Host); +dos_http_request(Request, Version, Host) -> + Request ++ Version ++ "\r\nhost:" ++ Host ++ "\r\n\r\n". + +dos_code("HTTP/1.0") -> + 403; %% 413 not defined in HTTP/1.0 +dos_code(_) -> + 413. + +update_password(Node, ServerRoot, _Address, Port, AuthPrefix, Dir, Old, New)-> + Directory = filename:join([ServerRoot, "htdocs", AuthPrefix ++ Dir]), + rpc:call(Node, mod_auth, update_password, + [undefined, Port, Directory, Old, New, New]). + +add_user(Node, Root, Port, AuthPrefix, Dir, User, Password, UserData) -> + Addr = undefined, + Directory = filename:join([Root, "htdocs", AuthPrefix ++ Dir]), + rpc:call(Node, mod_auth, add_user, + [User, Password, UserData, Addr, Port, Directory]). + + +delete_user(Node, Root, _Host, Port, AuthPrefix, Dir, User) -> + Addr = undefined, + Directory = filename:join([Root, "htdocs", AuthPrefix ++ Dir]), + rpc:call(Node, mod_auth, delete_user, [User, Addr, Port, Directory]). +remove_users(Node, ServerRoot, Host, Port, AuthPrefix, Dir) -> + %% List users, delete them, and make sure they are gone. + case list_users(Node, ServerRoot, Host, Port, AuthPrefix, Dir) of + {ok, Users} -> + lists:foreach(fun(User) -> + delete_user(Node, ServerRoot, Host, + Port, AuthPrefix, Dir, User) + end, + Users), + {ok, []} = list_users(Node, ServerRoot, Host, Port, AuthPrefix, Dir); + _ -> + ok + end. + +list_users(Node, Root, _Host, Port, AuthPrefix, Dir) -> + Addr = undefined, + Directory = filename:join([Root, "htdocs", AuthPrefix ++ Dir]), + rpc:call(Node, mod_auth, list_users, [Addr, Port, Directory]). + +remove_groups(Node, ServerRoot, Host, Port, AuthPrefix, Dir) -> + {ok, Groups} = list_groups(Node, ServerRoot, Host, Port, AuthPrefix, Dir), + lists:foreach(fun(Group) -> + delete_group(Node, Group, Port, ServerRoot, AuthPrefix, Dir) + end, + Groups), + {ok, []} = list_groups(Node, ServerRoot, Host, Port, AuthPrefix, Dir). + +delete_group(Node, Group, Port, Root, AuthPrefix, Dir) -> + Addr = undefined, + Directory = filename:join([Root, "htdocs", AuthPrefix ++ Dir]), + rpc:call(Node, mod_auth, delete_group, [Group, Addr, Port, Directory]). + +list_groups(Node, Root, _, Port, AuthPrefix, Dir) -> + Addr = undefined, + Directory = filename:join([Root, "htdocs", AuthPrefix ++ Dir]), + rpc:call(Node, mod_auth, list_groups, [Addr, Port, Directory]). + +add_group_member(Node, Root, Port, AuthPrefix, Dir, User, Group) -> + Addr = undefined, + Directory = filename:join([Root, "htdocs", AuthPrefix ++ Dir]), + rpc:call(Node, mod_auth, add_group_member, [Group, User, Addr, Port, + Directory]). +getaddr() -> + {ok,HostName} = inet:gethostname(), + {ok,{A1,A2,A3,A4}} = inet:getaddr(HostName,inet), + lists:flatten(io_lib:format("~p.~p.~p.~p",[A1,A2,A3,A4])). + +receive_security_event(Event, Node, Port) -> + receive + Event -> + ok; + {'EXIT', _, _} -> + receive_security_event(Event, Node, Port) + after 5000 -> + %% Flush the message queue, to see if we got something... + inets_test_lib:flush() + end. + +list_blocked_users(Node,Port) -> + Addr = undefined, % Assumed to be on the same host + rpc:call(Node, mod_security, list_blocked_users, [Addr,Port]). + +list_blocked_users(Node,Port,Dir) -> + Addr = undefined, % Assumed to be on the same host + rpc:call(Node, mod_security, list_blocked_users, [Addr,Port,Dir]). + +block_user(Node,User,Port,Dir,Sec) -> + Addr = undefined, % Assumed to be on the same host + rpc:call(Node, mod_security, block_user, [User, Addr, Port, Dir, Sec]). + +unblock_user(Node,User,Port,Dir) -> + Addr = undefined, % Assumed to be on the same host + rpc:call(Node, mod_security, unblock_user, [User, Addr, Port, Dir]). + +list_auth_users(Node,Port) -> + Addr = undefined, % Assumed to be on the same host + rpc:call(Node, mod_security, list_auth_users, [Addr,Port]). + +list_auth_users(Node,Port,Dir) -> + Addr = undefined, % Assumed to be on the same host + rpc:call(Node, mod_security, list_auth_users, [Addr,Port,Dir]). + +event(What, Port, Dir, Data) -> + Msg = {event, What, Port, Dir, Data}, + case global:whereis_name(mod_security_test) of + undefined -> + ok; + _Pid -> + global:send(mod_security_test, Msg) + end. -block(Config) -> - Version = ?config(http_version, Config), - Host = ?config(host, Config), - httpd_test_lib:verify_request(?config(type, Config), Host, - ?config(port, Config), ?config(node, Config), - http_request("GET /eval?httpd_example:delay(1000) ", - Version, Host), - [{statuscode, 200}, - {version, Version}]). diff --git a/lib/inets/test/httpd_basic_SUITE.erl b/lib/inets/test/httpd_basic_SUITE.erl index 2d06f3e70c..fbe65145dc 100644 --- a/lib/inets/test/httpd_basic_SUITE.erl +++ b/lib/inets/test/httpd_basic_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2012. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. 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 @@ -65,7 +65,8 @@ end_per_group(_GroupName, Config) -> init_per_suite(Config) -> tsp("init_per_suite -> entry with" "~n Config: ~p", [Config]), - ok = inets:start(), + inets_test_lib:stop_apps([inets]), + inets_test_lib:start_apps([inets]), PrivDir = ?config(priv_dir, Config), DataDir = ?config(data_dir, Config), diff --git a/lib/inets/test/httpd_test_lib.erl b/lib/inets/test/httpd_test_lib.erl index 6406eeae79..ed466fd727 100644 --- a/lib/inets/test/httpd_test_lib.erl +++ b/lib/inets/test/httpd_test_lib.erl @@ -92,16 +92,6 @@ verify_request(SocketType, Host, Port, Node, RequestStr, Options, TimeOut) verify_request(SocketType, Host, Port, [], Node, RequestStr, Options, TimeOut). verify_request(SocketType, Host, Port, TranspOpts0, Node, RequestStr, Options, TimeOut) -> - tsp("verify_request -> entry with" - "~n SocketType: ~p" - "~n Host: ~p" - "~n Port: ~p" - "~n TranspOpts: ~p" - "~n Node: ~p" - "~n Options: ~p" - "~n TimeOut: ~p", - [SocketType, Host, Port, TranspOpts0, Node, Options, TimeOut]), - %% For now, until we modernize the httpd tests TranspOpts = case lists:member(inet6, TranspOpts0) of @@ -113,10 +103,7 @@ verify_request(SocketType, Host, Port, TranspOpts0, Node, RequestStr, Options, T try inets_test_lib:connect_bin(SocketType, Host, Port, TranspOpts) of {ok, Socket} -> - tsp("verify_request -> connected - now send message"), SendRes = inets_test_lib:send(SocketType, Socket, RequestStr), - tsp("verify_request -> send result: " - "~n ~p", [SendRes]), State = case inets_regexp:match(RequestStr, "printenv") of nomatch -> #state{}; @@ -127,37 +114,24 @@ verify_request(SocketType, Host, Port, TranspOpts0, Node, RequestStr, Options, T case request(State#state{request = RequestStr, socket = Socket}, TimeOut) of {error, Reason} -> - tsp("verify_request -> request failed: " - "~n Reason: ~p", [Reason]), {error, Reason}; NewState -> - tsp("verify_request -> validate reply: " - "~n NewState: ~p", [NewState]), ValidateResult = validate(RequestStr, NewState, Options, Node, Port), - tsp("verify_request -> validation result: " - "~n ~p", [ValidateResult]), inets_test_lib:close(SocketType, Socket), ValidateResult end; ConnectError -> - tsp("verify_request -> connect error: " - "~n ~p" - "~n", [ConnectError]), - tsf({connect_error, ConnectError, - [SocketType, Host, Port, TranspOpts]}) + ct:fail({connect_error, ConnectError, + [SocketType, Host, Port, TranspOpts]}) catch T:E -> - tsp("verify_request -> connect failed: " - "~n E: ~p" - "~n T: ~p" - "~n", [E, T]), - tsf({connect_failure, - [{type, T}, - {error, E}, - {stacktrace, erlang:get_stacktrace()}, - {args, [SocketType, Host, Port, TranspOpts]}]}) + ct:fail({connect_failure, + [{type, T}, + {error, E}, + {stacktrace, erlang:get_stacktrace()}, + {args, [SocketType, Host, Port, TranspOpts]}]}) end. request(#state{mfa = {Module, Function, Args}, @@ -166,10 +140,6 @@ request(#state{mfa = {Module, Function, Args}, HeadRequest = lists:sublist(RequestStr, 1, 4), receive {tcp, Socket, Data} -> - io:format("~p ~w[~w]request -> received (tcp) data" - "~n Data: ~p" - "~n", [self(), ?MODULE, ?LINE, Data]), - print(tcp, Data, State), case Module:Function([Data | Args]) of {ok, Parsed} -> handle_http_msg(Parsed, State); @@ -179,22 +149,12 @@ request(#state{mfa = {Module, Function, Args}, request(State#state{mfa = NewMFA}, TimeOut) end; {tcp_closed, Socket} when Function =:= whole_body -> - io:format("~p ~w[~w]request -> " - "received (tcp) closed when whole_body" - "~n", [self(), ?MODULE, ?LINE]), - print(tcp, "closed", State), State#state{body = hd(Args)}; {tcp_closed, Socket} -> - io:format("~p ~w[~w]request -> received (tcp) closed" - "~n", [self(), ?MODULE, ?LINE]), exit({test_failed, connection_closed}); {tcp_error, Socket, Reason} -> - io:format("~p ~w[~w]request -> received (tcp) error" - "~n Reason: ~p" - "~n", [self(), ?MODULE, ?LINE, Reason]), ct:fail({tcp_error, Reason}); {ssl, Socket, Data} -> - print(ssl, Data, State), case Module:Function([Data | Args]) of {ok, Parsed} -> handle_http_msg(Parsed, State); @@ -204,28 +164,19 @@ request(#state{mfa = {Module, Function, Args}, request(State#state{mfa = NewMFA}, TimeOut) end; {ssl_closed, Socket} when Function =:= whole_body -> - print(ssl, "closed", State), State#state{body = hd(Args)}; {ssl_closed, Socket} -> exit({test_failed, connection_closed}); {ssl_error, Socket, Reason} -> ct:fail({ssl_error, Reason}) after TimeOut -> - io:format("~p ~w[~w]request -> timeout" - "~n", [self(), ?MODULE, ?LINE]), + ct:pal("~p ~w[~w]request -> timeout" + "~n", [self(), ?MODULE, ?LINE]), ct:fail(connection_timed_out) end. handle_http_msg({Version, StatusCode, ReasonPharse, Headers, Body}, State = #state{request = RequestStr}) -> - io:format("~p ~w[~w]handle_http_msg -> entry with" - "~n Version: ~p" - "~n StatusCode: ~p" - "~n ReasonPharse: ~p" - "~n Headers: ~p" - "~n Body: ~p" - "~n", [self(), ?MODULE, ?LINE, - Version, StatusCode, ReasonPharse, Headers, Body]), case is_expect(RequestStr) of true -> State#state{status_line = {Version, @@ -285,11 +236,6 @@ validate(RequestStr, #state{status_line = {Version, StatusCode, _}, headers = Headers, body = Body}, Options, N, P) -> - tsp("validate -> entry with" - "~n StatusCode: ~p" - "~n Headers: ~p" - "~n Body: ~p", [StatusCode, Headers, Body]), - check_version(Version, Options), case lists:keysearch(statuscode, 1, Options) of {value, _} -> @@ -311,20 +257,20 @@ check_version(Version, Options) -> {value, {version, Version}} -> ok; {value, {version, Ver}} -> - tsf({wrong_version, [{got, Version}, - {expected, Ver}]}); + ct:fail({wrong_version, [{got, Version}, + {expected, Ver}]}); _ -> - case Version of - "HTTP/1.1" -> - ok; + case Version of + "HTTP/1.1" -> + ok; _ -> - tsf({wrong_version, [{got, Version}, - {expected, "HTTP/1.1"}]}) - end + ct:fail({wrong_version, [{got, Version}, + {expected, "HTTP/1.1"}]}) + end end. check_status_code(StatusCode, [], Options) -> - tsf({wrong_status_code, [{got, StatusCode}, {expected, Options}]}); + ct:fail({wrong_status_code, [{got, StatusCode}, {expected, Options}]}); check_status_code(StatusCode, Current = [_ | Rest], Options) -> case lists:keysearch(statuscode, 1, Current) of {value, {statuscode, StatusCode}} -> @@ -332,7 +278,7 @@ check_status_code(StatusCode, Current = [_ | Rest], Options) -> {value, {statuscode, _OtherStatus}} -> check_status_code(StatusCode, Rest, Options); false -> - tsf({wrong_status_code, [{got, StatusCode}, {expected, Options}]}) + ct:fail({wrong_status_code, [{got, StatusCode}, {expected, Options}]}) end. do_validate(_, [], _, _) -> @@ -345,9 +291,9 @@ do_validate(Header, [{header, HeaderField}|Rest], N, P) -> {value, {LowerHeaderField, _Value}} -> ok; false -> - tsf({missing_header_field, LowerHeaderField, Header}); + ct:fail({missing_header_field, LowerHeaderField, Header}); _ -> - tsf({missing_header_field, LowerHeaderField, Header}) + ct:fail({missing_header_field, LowerHeaderField, Header}) end, do_validate(Header, Rest, N, P); do_validate(Header, [{header, HeaderField, Value}|Rest],N,P) -> @@ -356,15 +302,15 @@ do_validate(Header, [{header, HeaderField, Value}|Rest],N,P) -> {value, {LowerHeaderField, Value}} -> ok; false -> - tsf({wrong_header_field_value, LowerHeaderField, Header}); + ct:fail({wrong_header_field_value, LowerHeaderField, Header}); _ -> - tsf({wrong_header_field_value, LowerHeaderField, Header}) + ct:fail({wrong_header_field_value, LowerHeaderField, Header}) end, do_validate(Header, Rest, N, P); do_validate(Header,[{no_header, HeaderField}|Rest],N,P) -> case lists:keysearch(HeaderField,1,Header) of {value,_} -> - tsf({wrong_header_field_value, HeaderField, Header}); + ct:fail({wrong_header_field_value, HeaderField, Header}); _ -> ok end, @@ -382,14 +328,14 @@ is_expect(RequestStr) -> %% OTP-5775, content-length check_body("GET /cgi-bin/erl/httpd_example:get_bin HTTP/1.0\r\n\r\n", 200, "text/html", Length, _Body) when (Length =/= 274) -> - tsf(content_length_error); + ct:fail(content_length_error); check_body("GET /cgi-bin/cgi_echo HTTP/1.0\r\n\r\n", 200, "text/plain", _, Body) -> case size(Body) of 100 -> ok; _ -> - tsf(content_length_error) + ct:fail(content_length_error) end; check_body(RequestStr, 200, "text/html", _, Body) -> @@ -404,16 +350,3 @@ check_body(RequestStr, 200, "text/html", _, Body) -> check_body(_, _, _, _,_) -> ok. -print(Proto, Data, #state{print = true}) -> - ct:pal("Received ~p: ~p~n", [Proto, Data]); -print(_, _, #state{print = false}) -> - ok. - - -tsp(F) -> - inets_test_lib:tsp(F). -tsp(F, A) -> - inets_test_lib:tsp(F, A). - -tsf(Reason) -> - inets_test_lib:tsf(Reason). diff --git a/lib/inets/test/inets_sup_SUITE.erl b/lib/inets/test/inets_sup_SUITE.erl index 12b85a816f..cf28f5a245 100644 --- a/lib/inets/test/inets_sup_SUITE.erl +++ b/lib/inets/test/inets_sup_SUITE.erl @@ -260,10 +260,10 @@ tftpd_worker(suite) -> []; tftpd_worker(Config) when is_list(Config) -> [] = supervisor:which_children(tftp_sup), - {ok, Pid0} = inets:start(tftpd, [{host, "localhost"}, - {port, inet_port()}]), - {ok, _Pid1} = inets:start(tftpd, [{host, "localhost"}, - {port, inet_port()}], stand_alone), + {ok, Pid0} = inets:start(tftpd, [{host, inets_test_lib:hostname()}, + {port, 0}]), + {ok, _Pid1} = inets:start(tftpd, [{host, inets_test_lib:hostname()}, + {port, 0}], stand_alone), [{_,Pid0, worker, _}] = supervisor:which_children(tftp_sup), inets:stop(tftpd, Pid0), @@ -397,13 +397,6 @@ httpc_subtree(Config) when is_list(Config) -> tsp("httpc_subtree -> done"), ok. -inet_port() -> - {ok, Socket} = gen_tcp:listen(0, [{reuseaddr, true}]), - {ok, Port} = inet:port(Socket), - gen_tcp:close(Socket), - Port. - - tsp(F) -> tsp(F, []). tsp(F, A) -> diff --git a/lib/inets/test/old_httpd_SUITE.erl b/lib/inets/test/old_httpd_SUITE.erl index de9aa4562e..3e1a1a3845 100644 --- a/lib/inets/test/old_httpd_SUITE.erl +++ b/lib/inets/test/old_httpd_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2013. All Rights Reserved. +%% Copyright Ericsson AB 2005-2014. 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 @@ -155,65 +155,103 @@ all() -> [ {group, ip}, {group, ssl}, - {group, http_1_1_ip}, - {group, http_1_0_ip}, - {group, http_0_9_ip}, - {group, ipv6}, + %%{group, http_1_1_ip}, + %%{group, http_1_0_ip}, + %%{group, http_0_9_ip}, + %%{group, ipv6}, {group, tickets} ]. groups() -> [ {ip, [], - [ip_mod_alias, ip_mod_actions, ip_mod_security, - ip_mod_auth, ip_mod_auth_api, ip_mod_auth_mnesia_api, - ip_mod_htaccess, ip_mod_cgi, ip_mod_esi, ip_mod_get, - ip_mod_head, ip_mod_all, ip_load_light, ip_load_medium, - ip_load_heavy, ip_dos_hostname, ip_time_test, - ip_restart_no_block, ip_restart_disturbing_block, - ip_restart_non_disturbing_block, - ip_block_disturbing_idle, ip_block_non_disturbing_idle, - ip_block_503, ip_block_disturbing_active, - ip_block_non_disturbing_active, - ip_block_disturbing_active_timeout_not_released, - ip_block_disturbing_active_timeout_released, - ip_block_non_disturbing_active_timeout_not_released, - ip_block_non_disturbing_active_timeout_released, - ip_block_disturbing_blocker_dies, - ip_block_non_disturbing_blocker_dies]}, + [ + %%ip_mod_alias, + ip_mod_actions, + %%ip_mod_security, + %% ip_mod_auth, + %% ip_mod_auth_api, + ip_mod_auth_mnesia_api, + %%ip_mod_htaccess, + %%ip_mod_cgi, + %%ip_mod_esi, + %%ip_mod_get, + %%ip_mod_head, + %%ip_mod_all, + %% ip_load_light, + %% ip_load_medium, + %% ip_load_heavy, + %%ip_dos_hostname, + ip_time_test + %% Replaced by load_config + %% ip_restart_no_block, + %% ip_restart_disturbing_block, + %% ip_restart_non_disturbing_block, + %% ip_block_disturbing_idle, + %% ip_block_non_disturbing_idle, + %% ip_block_503, + %% ip_block_disturbing_active, + %% ip_block_non_disturbing_active, + %% ip_block_disturbing_active_timeout_not_released, + %% ip_block_disturbing_active_timeout_released, + %% ip_block_non_disturbing_active_timeout_not_released, + %% ip_block_non_disturbing_active_timeout_released, + %% ip_block_disturbing_blocker_dies, + %% ip_block_non_disturbing_blocker_dies + ]}, {ssl, [], [{group, essl}]}, {essl, [], - [essl_mod_alias, essl_mod_actions, essl_mod_security, - essl_mod_auth, essl_mod_auth_api, - essl_mod_auth_mnesia_api, essl_mod_htaccess, - essl_mod_cgi, essl_mod_esi, essl_mod_get, essl_mod_head, - essl_mod_all, essl_load_light, essl_load_medium, - essl_load_heavy, essl_dos_hostname, essl_time_test, - essl_restart_no_block, essl_restart_disturbing_block, - essl_restart_non_disturbing_block, - essl_block_disturbing_idle, - essl_block_non_disturbing_idle, essl_block_503, - essl_block_disturbing_active, - essl_block_non_disturbing_active, - essl_block_disturbing_active_timeout_not_released, - essl_block_disturbing_active_timeout_released, - essl_block_non_disturbing_active_timeout_not_released, - essl_block_non_disturbing_active_timeout_released, - essl_block_disturbing_blocker_dies, - essl_block_non_disturbing_blocker_dies]}, - {http_1_1_ip, [], - [ip_host, ip_chunked, ip_expect, ip_range, ip_if_test, - ip_http_trace, ip_http1_1_head, - ip_mod_cgi_chunked_encoding_test]}, - {http_1_0_ip, [], - [ip_head_1_0, ip_get_1_0, ip_post_1_0]}, - {http_0_9_ip, [], [ip_get_0_9]}, - {ipv6, [], [ipv6_hostname_ipcomm, ipv6_address_ipcomm, - ipv6_hostname_essl, ipv6_address_essl]}, + [ + %%essl_mod_alias, + essl_mod_actions, + %% essl_mod_security, + %% essl_mod_auth, + %% essl_mod_auth_api, + essl_mod_auth_mnesia_api, + %%essl_mod_htaccess, + %%essl_mod_cgi, + %%essl_mod_esi, + %%essl_mod_get, + %%essl_mod_head, + %% essl_mod_all, + %% essl_load_light, + %% essl_load_medium, + %% essl_load_heavy, + %%essl_dos_hostname, + essl_time_test + %% Replaced by load_config + %% essl_restart_no_block, + %% essl_restart_disturbing_block, + %% essl_restart_non_disturbing_block, + %% essl_block_disturbing_idle, + %% essl_block_non_disturbing_idle, essl_block_503, + %% essl_block_disturbing_active, + %% essl_block_non_disturbing_active, + %% essl_block_disturbing_active_timeout_not_released, + %% essl_block_disturbing_active_timeout_released, + %% essl_block_non_disturbing_active_timeout_not_released, + %% essl_block_non_disturbing_active_timeout_released, + %% essl_block_disturbing_blocker_dies, + %% essl_block_non_disturbing_blocker_dies + ]}, + %% {http_1_1_ip, [], + %% [ + %% %%ip_host, ip_chunked, ip_expect, + %% %%ip_range, + %% %%ip_if_test + %% %%ip_http_trace, ip_http1_1_head, + %% %%ip_mod_cgi_chunked_encoding_test + %% ]}, + %%{http_1_0_ip, [], + %%[ip_head_1_0, ip_get_1_0, ip_post_1_0]}, + %%{http_0_9_ip, [], [ip_get_0_9]}, + %% {ipv6, [], [ipv6_hostname_ipcomm, ipv6_address_ipcomm, + %% ipv6_hostname_essl, ipv6_address_essl]}, {tickets, [], - [ticket_5775, ticket_5865, ticket_5913, ticket_6003, - ticket_7304]}]. - + [%%ticket_5775, ticket_5865, + ticket_5913%%, ticket_6003, + %%ticket_7304 + ]}]. init_per_group(ipv6 = _GroupName, Config) -> case inets_test_lib:has_ipv6_support() of diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index cccfb7a44f..cbcf0362c9 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -18,7 +18,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 5.9.8 +INETS_VSN = 5.10 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" - diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java index 968f284bff..3ef44b8851 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2013. All Rights Reserved. + * Copyright Ericsson AB 2000-2014. 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 @@ -92,6 +92,7 @@ public class AbstractNode { static final int dFlagNewFloats = 0x800; static final int dFlagUnicodeIo = 0x1000; static final int dFlagUtf8Atoms = 0x10000; + static final int dFlagMapTag = 0x20000; int ntype = NTYPE_R6; int proto = 0; // tcp/ip @@ -100,7 +101,7 @@ public class AbstractNode { int creation = 0; int flags = dFlagExtendedReferences | dFlagExtendedPidsPorts | dFlagBitBinaries | dFlagNewFloats | dFlagFunTags - | dflagNewFunTags | dFlagUtf8Atoms; + | dflagNewFunTags | dFlagUtf8Atoms | dFlagMapTag; /* initialize hostname and default cookie */ static { diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java index 7c1cf84e98..03c18e55a2 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java @@ -125,8 +125,6 @@ public class OtpErlangMap extends OtpErlangObject implements Serializable, for (int i = 0; i < arity; i++) { keys[i] = buf.read_any(); - } - for (int i = 0; i < arity; i++) { values[i] = buf.read_any(); } } else { @@ -227,8 +225,6 @@ public class OtpErlangMap extends OtpErlangObject implements Serializable, for (int i = 0; i < arity; i++) { buf.write_any(keys[i]); - } - for (int i = 0; i < arity; i++) { buf.write_any(values[i]); } } diff --git a/lib/jinterface/test/jinterface_SUITE_data/Maps.java b/lib/jinterface/test/jinterface_SUITE_data/Maps.java index 136a665f23..653defc621 100644 --- a/lib/jinterface/test/jinterface_SUITE_data/Maps.java +++ b/lib/jinterface/test/jinterface_SUITE_data/Maps.java @@ -42,16 +42,16 @@ class Maps { runTest(new byte[] { (byte) 131, 116, 0, 0, 0, 1, 100, 0, 1, 97, 100, 0, 1, 98 }, "#{a => b}", 2); // make sure keys are sorted here, jinterface doesn't reorder them - runTest(new byte[] { (byte) 131, 116, 0, 0, 0, 2, 97, 2, 100, 0, 1, 97, - 106, 97, 1 }, "#{2 => [],a => 1}", 3); + runTest(new byte[] { (byte) 131, 116, 0, 0, 0, 2, 97, 2, 106, + 100, 0, 1, 97, 97, 1 }, "#{2 => [],a => 1}", 3); runTest(new byte[] { (byte) 131, 116, 0, 0, 0, 1, 104, 1, 97, 3, 108, 0, 0, 0, 1, 100, 0, 1, 114, 106 }, "#{{3} => [r]}", 4); try { // #{2 => [],a => 1} final OtpErlangMap map = new OtpErlangMap(new OtpInputStream( - new byte[] { (byte) 131, 116, 0, 0, 0, 2, 97, 2, 100, 0, 1, - 97, 106, 97, 1 })); + new byte[] { (byte) 131, 116, 0, 0, 0, 2, 97, 2, 106, + 100, 0, 1, 97, 97, 1 })); if (map.arity() != 2) { fail(5); diff --git a/lib/jinterface/vsn.mk b/lib/jinterface/vsn.mk index 1954040c3d..c50200fab6 100644 --- a/lib/jinterface/vsn.mk +++ b/lib/jinterface/vsn.mk @@ -1 +1 @@ -JINTERFACE_VSN = 1.5.8 +JINTERFACE_VSN = 1.5.9 diff --git a/lib/kernel/doc/src/Makefile b/lib/kernel/doc/src/Makefile index de3ca1e176..ec5d1f09e4 100644 --- a/lib/kernel/doc/src/Makefile +++ b/lib/kernel/doc/src/Makefile @@ -76,8 +76,8 @@ BOOK_FILES = book.xml XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ - $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_REF4_FILES) \ - $(XML_REF6_FILES) $(XML_APPLICATION_FILES) + $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_REF4_FILES)\ + $(XML_REF6_FILES) $(XML_APPLICATION_FILES) # ---------------------------------------------------- diff --git a/lib/kernel/doc/src/app.xml b/lib/kernel/doc/src/app.xml index 7c9d6eecec..8575d94048 100644 --- a/lib/kernel/doc/src/app.xml +++ b/lib/kernel/doc/src/app.xml @@ -61,7 +61,8 @@ {applications, Apps}, {env, Env}, {mod, Start}, - {start_phases, Phases}]}. + {start_phases, Phases}, + {runtime_dependencies, RTDeps}]}. Value Default ----- ------- @@ -77,8 +78,10 @@ Apps [App] [] Env [{Par,Val}] [] Start {Module,StartArgs} [] Phases [{Phase,PhaseArgs}] undefined +RTDeps [ApplicationVersion] [] Module = Name = App = Par = Phase = atom() - Val = StartArgs = PhaseArgs = term()</code> + Val = StartArgs = PhaseArgs = term() + ApplicationVersion = string()</code> <p><c>Application</c> is the name of the application.</p> <p>For the application controller, all keys are optional. The respective default values are used for any omitted keys.</p> @@ -87,6 +90,8 @@ Phases [{Phase,PhaseArgs}] undefined <c>description</c>, <c>vsn</c>, <c>modules</c>, <c>registered</c> and <c>applications</c>. The other keys are ignored by <c>systools</c>.</p> + <warning><p>The <c>RTDeps</c> type was introduced in OTP 17.0 and + might be subject to changes during the OTP 17 release.</p></warning> <taglist> <tag><c>description</c></tag> <item> @@ -185,6 +190,33 @@ Phases [{Phase,PhaseArgs}] undefined start phases must be a subset of the set of phases defined for the primary application. Refer to <em>OTP Design Principles</em> for more information.</p> </item> + <tag><marker id="runtime_dependencies"><c>runtime_dependencies</c></marker></tag> + <item><p>A list of application versions that the application + depends on. An example of such an application version is + <c>"kernel-3.0"</c>. Application versions specified as runtime + dependencies are minimum requirements. That is, a larger + application version than the one specified in the + dependency satisfies the requirement. For information on + how to compare application versions see + <seealso marker="doc/system_principles:versions">the + documentation of versions in the system principles + guide</seealso>. Note that that the application version + specifies a source code version. An additional indirect + requirement is that installed binary application of + the specified version has been built so that it is + compatible with the rest of the system.</p> + <p>Some dependencies might only be required in specific runtime + scenarios. In the case such optional dependencies exist, these are + specified and documented in the corresponding "App" documentation + of the specific application.</p> + <warning><p>The <c>runtime_dependencies</c> key was introduced in + OTP 17.0. The type of its value might be subject to changes during + the OTP 17 release.</p></warning> + <warning><p>All runtime dependencies specified in OTP applications + during the OTP 17 release may not be completely correct. This + is actively being worked on. Declared runtime dependencies in OTP + applications are expected to be correct in OTP 18.</p></warning> + </item> </taglist> </section> diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml index b3ec9fd33d..8dae34431b 100644 --- a/lib/kernel/doc/src/file.xml +++ b/lib/kernel/doc/src/file.xml @@ -642,6 +642,11 @@ <item> <p>Symbolic links are not supported on this platform.</p> </item> + <tag><c>eperm</c></tag> + <item> + <p>User does not have privileges to create symbolic links + (<c>SeCreateSymbolicLinkPrivilege</c> on Windows).</p> + </item> </taglist> </desc> </func> @@ -1630,6 +1635,11 @@ <desc> <p>Sets the current working directory of the file server to <c><anno>Dir</anno></c>. Returns <c>ok</c> if successful.</p> + <p>The functions in the <c>file</c> module usually treat binaries + as raw filenames, i.e. they are passed as is even when the encoding + of the binary does not agree with <c>file:native_name_encoding()</c>. + This function however expects binaries to be encoded according to the + value returned by <c>file:native_name_encoding()</c>.</p> <p>Typical error reasons are:</p> <taglist> <tag><c>enoent</c></tag> @@ -1654,8 +1664,8 @@ <tag><c>no_translation</c></tag> <item> <p><c><anno>Dir</anno></c> is a <c>binary()</c> with - characters coded in ISO-latin-1 and the VM was started - with the parameter <c>+fnue</c>.</p> + characters coded in ISO-latin-1 and the VM is operating + with unicode file name encoding.</p> </item> </taglist> <warning> diff --git a/lib/kernel/doc/src/ref_man.xml b/lib/kernel/doc/src/ref_man.xml index c1b9eac9d7..bd25d1e78d 100644 --- a/lib/kernel/doc/src/ref_man.xml +++ b/lib/kernel/doc/src/ref_man.xml @@ -13,12 +13,12 @@ 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. - + </legalnotice> <title>Kernel Reference Manual</title> @@ -65,4 +65,3 @@ <xi:include href="app.xml"/> <xi:include href="config.xml"/> </application> - diff --git a/lib/kernel/doc/src/ref_man.xml.src b/lib/kernel/doc/src/ref_man.xml.src new file mode 100644 index 0000000000..bd25d1e78d --- /dev/null +++ b/lib/kernel/doc/src/ref_man.xml.src @@ -0,0 +1,67 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE application SYSTEM "application.dtd"> + +<application xmlns:xi="http://www.w3.org/2001/XInclude"> + <header> + <copyright> + <year>1996</year><year>2013</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + 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. + + </legalnotice> + + <title>Kernel Reference Manual</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> + </header> + <description> + <p>The <em>Kernel</em> application has all the code necessary to run + the Erlang runtime system itself: file servers and code servers + and so on.</p> + </description> + <xi:include href="kernel_app.xml"/> + <xi:include href="application.xml"/> + <xi:include href="auth.xml"/> + <xi:include href="code.xml"/> + <xi:include href="disk_log.xml"/> + <xi:include href="erl_boot_server.xml"/> + <xi:include href="erl_ddll.xml"/> + <xi:include href="erl_prim_loader_stub.xml"/> + <xi:include href="erlang_stub.xml"/> + <xi:include href="error_handler.xml"/> + <xi:include href="error_logger.xml"/> + <xi:include href="file.xml"/> + <xi:include href="gen_tcp.xml"/> + <xi:include href="gen_udp.xml"/> + <xi:include href="gen_sctp.xml"/> + <xi:include href="global.xml"/> + <xi:include href="global_group.xml"/> + <xi:include href="heart.xml"/> + <xi:include href="inet.xml"/> + <xi:include href="inet_res.xml"/> + <xi:include href="init_stub.xml"/> + <xi:include href="net_adm.xml"/> + <xi:include href="net_kernel.xml"/> + <xi:include href="os.xml"/> + <xi:include href="pg2.xml"/> + <xi:include href="rpc.xml"/> + <xi:include href="seq_trace.xml"/> + <xi:include href="user.xml"/> + <xi:include href="wrap_log_reader.xml"/> + <xi:include href="zlib_stub.xml"/> + <xi:include href="app.xml"/> + <xi:include href="config.xml"/> +</application> diff --git a/lib/kernel/include/dist.hrl b/lib/kernel/include/dist.hrl index e32c112e63..77556d1303 100644 --- a/lib/kernel/include/dist.hrl +++ b/lib/kernel/include/dist.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2014. 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 @@ -37,3 +37,4 @@ -define(DFLAG_DIST_HDR_ATOM_CACHE,16#2000). -define(DFLAG_SMALL_ATOM_TAGS, 16#4000). -define(DFLAG_UTF8_ATOMS, 16#10000). +-define(DFLAG_MAP_TAG, 16#20000). diff --git a/lib/kernel/src/disk_log_server.erl b/lib/kernel/src/disk_log_server.erl index 684ea5b5db..45334912eb 100644 --- a/lib/kernel/src/disk_log_server.erl +++ b/lib/kernel/src/disk_log_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2014. 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 @@ -199,7 +199,7 @@ do_open({open, W, #arg{name = Name}=A}=Req, From, State) -> false when W =:= local -> case A#arg.distributed of {true, Nodes} -> - Fun = fun() -> open_distr_rpc(Nodes, A, From) end, + Fun = open_distr_rpc_fun(Nodes, A, From), _Pid = spawn(Fun), %% No pending reply is expected, but don't reply yet. {pending, State}; @@ -225,11 +225,15 @@ do_open({open, W, #arg{name = Name}=A}=Req, From, State) -> end end. +-spec open_distr_rpc_fun([node()], _, _) -> % XXX: underspecified + fun(() -> no_return()). + +open_distr_rpc_fun(Nodes, A, From) -> + fun() -> open_distr_rpc(Nodes, A, From) end. + %% Spawning a process is a means to avoid deadlock when %% disk_log_servers mutually open disk_logs. --spec open_distr_rpc([node()], _, _) -> no_return(). % XXX: underspecified - open_distr_rpc(Nodes, A, From) -> {AllReplies, BadNodes} = rpc:multicall(Nodes, ?MODULE, dist_open, [A]), {Ok, Bad} = cr(AllReplies, [], []), diff --git a/lib/kernel/src/dist_util.erl b/lib/kernel/src/dist_util.erl index fc50ec6717..b127fe2e33 100644 --- a/lib/kernel/src/dist_util.erl +++ b/lib/kernel/src/dist_util.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2014. 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 @@ -116,7 +116,8 @@ make_this_flags(RequestType, OtherNode) -> ?DFLAG_UNICODE_IO bor ?DFLAG_DIST_HDR_ATOM_CACHE bor ?DFLAG_SMALL_ATOM_TAGS bor - ?DFLAG_UTF8_ATOMS). + ?DFLAG_UTF8_ATOMS bor + ?DFLAG_MAP_TAG). handshake_other_started(#hs_data{request_type=ReqType}=HSData0) -> {PreOtherFlags,Node,Version} = recv_name(HSData0), diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index 23cf74f80f..20b703e084 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -199,7 +199,8 @@ get_cwd(Drive) -> check_and_call(get_cwd, [file_name(Drive)]). -spec set_cwd(Dir) -> ok | {error, Reason} when - Dir :: name(), + Dir :: name() | EncodedBinary, + EncodedBinary :: binary(), Reason :: posix() | badarg | no_translation. set_cwd(Dirname) -> diff --git a/lib/kernel/src/global.erl b/lib/kernel/src/global.erl index ef878b8d0c..0a4edea452 100644 --- a/lib/kernel/src/global.erl +++ b/lib/kernel/src/global.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -1513,14 +1513,18 @@ delete_global_name(_Name, _Pid) -> -record(him, {node, locker, vsn, my_tag}). start_the_locker(DoTrace) -> - spawn_link(fun() -> init_the_locker(DoTrace) end). - -init_the_locker(DoTrace) -> - process_flag(trap_exit, true), % needed? - S0 = #multi{do_trace = DoTrace}, - S1 = update_locker_known({add, get_known()}, S0), - loop_the_locker(S1), - erlang:error(locker_exited). + spawn_link(init_the_locker_fun(DoTrace)). + +-spec init_the_locker_fun(boolean()) -> fun(() -> no_return()). + +init_the_locker_fun(DoTrace) -> + fun() -> + process_flag(trap_exit, true), % needed? + S0 = #multi{do_trace = DoTrace}, + S1 = update_locker_known({add, get_known()}, S0), + loop_the_locker(S1), + erlang:error(locker_exited) + end. loop_the_locker(S) -> ?trace({loop_the_locker,S}), diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl index e111cb800e..e5928c7b63 100644 --- a/lib/kernel/src/hipe_unified_loader.erl +++ b/lib/kernel/src/hipe_unified_loader.erl @@ -194,6 +194,13 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) -> CodeSize, CodeBinary, Refs, 0,[] % ColdSize, CRrefs ] = binary_to_term(Bin), + ?debug_msg("***** ErLLVM *****~nVersion: ~s~nCheckSum: ~w~nConstAlign: ~w~n" ++ + "ConstSize: ~w~nConstMap: ~w~nLabelMap: ~w~nExportMap ~w~nRefs ~w~n", + [Version, CheckSum, ConstAlign, ConstSize, ConstMap, LabelMap, ExportMap, + Refs]), + %% Write HiPE binary code to a file in the current directory in order to + %% debug by disassembling. + %% file:write_file("erl.o", CodeBinary, [binary]), %% Check that we are loading up-to-date code. version_check(Version, Mod), case hipe_bifs:check_crc(CheckSum) of @@ -203,6 +210,7 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) -> "please regenerate native code for this runtime system\n", [Mod]), bad_crc; true -> + put(closures_to_patch, []), %% Create data segment {ConstAddr,ConstMap2} = create_data_segment(ConstAlign, ConstSize, ConstMap), @@ -220,24 +228,33 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) -> {MFAs,Addresses} = exports(ExportMap, CodeAddress), %% Remove references to old versions of the module. ReferencesToPatch = get_refs_from(MFAs, []), + %% io:format("References to patch: ~w~n", [ReferencesToPatch]), ok = remove_refs_from(MFAs), %% Patch all dynamic references in the code. %% Function calls, Atoms, Constants, System calls ok = patch(Refs, CodeAddress, ConstMap2, Addresses, TrampolineMap), + %% Tell the system where the loaded funs are. %% (patches the BEAM code to redirect to native.) case Beam of [] -> + %% This module was previously loaded as BEAM code during system + %% start-up before the code server has started (-enable-native-libs + %% is active), so we must now patch the pre-existing entries in the + %% fun table with the native code addresses for all closures. + lists:foreach(fun({FE, DestAddress}) -> + hipe_bifs:set_native_address_in_fe(FE, DestAddress) + end, erase(closures_to_patch)), export_funs(Addresses), ok; BeamBinary when is_binary(BeamBinary) -> %% Find all closures in the code. + [] = erase(closures_to_patch), %Clean up, assertion. ClosurePatches = find_closure_patches(Refs), AddressesOfClosuresToPatch = calculate_addresses(ClosurePatches, CodeAddress, Addresses), export_funs(Addresses), - export_funs(Mod, BeamBinary, Addresses, AddressesOfClosuresToPatch), - ok + export_funs(Mod, BeamBinary, Addresses, AddressesOfClosuresToPatch) end, %% Redirect references to the old module to the new module's BEAM stub. patch_to_emu_step2(OldReferencesToPatch), @@ -245,6 +262,9 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) -> %% The call to export_funs/1 above updated the native addresses %% for the targets, so passing 'Addresses' is not needed. redirect(ReferencesToPatch), + %% Final clean up. + _ = erase(hipe_patch_closures), + _ = erase(hipe_assert_code_area), ?debug_msg("****************Loader Finished****************\n", []), {module,Mod} % for compatibility with code:load_file/1 end. @@ -562,12 +582,17 @@ patch_closure(DestMFA, Uniq, Index, Address, Addresses) -> case get(hipe_patch_closures) of false -> []; % This is taken care of when registering the module. - true -> % We are not loading a module patch these closures + true -> + %% We are replacing a previosly loaded BEAM module with native code, + %% so we must reference the pre-existing entries in the fun table + %% from the native code. We must delay actually patching the native + %% address into the fun entry to ensure that the native code cannot + %% be called until it has been completely fixed up. RemoteOrLocal = local, % closure code refs are local DestAddress = get_native_address(DestMFA, Addresses, RemoteOrLocal), BEAMAddress = hipe_bifs:fun_to_address(DestMFA), - FE = hipe_bifs:make_fe(DestAddress, mod(DestMFA), - {Uniq, Index, BEAMAddress}), + FE = hipe_bifs:get_fe(mod(DestMFA), {Uniq, Index, BEAMAddress}), + put(closures_to_patch, [{FE,DestAddress}|get(closures_to_patch)]), ?debug_msg("Patch FE(~w) to 0x~.16b->0x~.16b (emu:0x~.16b)\n", [DestMFA, FE, DestAddress, BEAMAddress]), ?ASSERT(assert_local_patch(Address)), diff --git a/lib/kernel/src/inet_config.erl b/lib/kernel/src/inet_config.erl index 2461f3ff25..fdc244f959 100644 --- a/lib/kernel/src/inet_config.erl +++ b/lib/kernel/src/inet_config.erl @@ -197,6 +197,9 @@ do_load_resolv({win32,Type}, longnames) -> win32_load_from_registry(Type), inet_db:set_lookup([native]); +do_load_resolv({ose,_}, _) -> + inet_db:set_lookup([file]); + do_load_resolv(_, _) -> inet_db:set_lookup([native]). diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src index cb8c98ab06..5658c6b6cf 100644 --- a/lib/kernel/src/kernel.app.src +++ b/lib/kernel/src/kernel.app.src @@ -114,6 +114,7 @@ pg2]}, {applications, []}, {env, [{error_logger, tty}]}, - {mod, {kernel, []}} + {mod, {kernel, []}}, + {runtime_dependencies, ["erts-6.0", "stdlib-2.0", "sasl-2.4"]} ] }. diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl index 9ffa9adeab..187fd0001b 100644 --- a/lib/kernel/src/os.erl +++ b/lib/kernel/src/os.erl @@ -67,7 +67,7 @@ unsetenv(_) -> %%% End of BIFs -spec type() -> {Osfamily, Osname} when - Osfamily :: unix | win32, + Osfamily :: unix | win32 | ose, Osname :: atom(). type() -> @@ -230,7 +230,9 @@ unix_cmd(Cmd) -> %% and the commands are read from standard input. We set the %% $1 parameter for easy identification of the resident shell. %% --define(SHELL, "/bin/sh -s unix:cmd 2>&1"). +-define(ROOT, "/"). +-define(ROOT_ANDROID, "/system"). +-define(SHELL, "bin/sh -s unix:cmd 2>&1"). -define(PORT_CREATOR_NAME, os_cmd_port_creator). %% @@ -280,7 +282,12 @@ start_port_srv(Request) -> end. start_port_srv_handle({Ref,Client}) -> - Reply = try open_port({spawn, ?SHELL},[stream]) of + Path = case lists:reverse(erlang:system_info(system_architecture)) of + % androideabi + "ibaediordna" ++ _ -> filename:join([?ROOT_ANDROID, ?SHELL]); + _ -> filename:join([?ROOT, ?SHELL]) + end, + Reply = try open_port({spawn, Path},[stream]) of Port when is_port(Port) -> (catch port_connect(Port, Client)), unlink(Port), diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index c75639ae7e..f6d6cd94ab 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -161,7 +161,13 @@ init_per_suite(Config) when is_list(Config) -> ok -> [{sasl,started}] end, - ok = application:start(os_mon), + ok = case os:type() of + {ose,_} -> + ok; + _ -> + application:start(os_mon) + end, + case os:type() of {win32, _} -> Priv = ?config(priv_dir, Config), @@ -185,7 +191,13 @@ end_per_suite(Config) when is_list(Config) -> _ -> ok end, - application:stop(os_mon), + + case os:type() of + {ose,_} -> + ok; + _ -> + application:stop(os_mon) + end, case proplists:get_value(sasl, Config) of started -> application:stop(sasl); @@ -416,7 +428,13 @@ make_del_dir(Config) when is_list(Config) -> % because there are processes having that directory as current. ?line ok = ?FILE_MODULE:make_dir(NewDir), ?line {ok,CurrentDir} = file:get_cwd(), - ?line ok = ?FILE_MODULE:set_cwd(NewDir), + case {os:type(), length(NewDir) >= 260 } of + {{win32,_}, true} -> + io:format("Skip set_cwd for windows path longer than 260 (MAX_PATH)\n", []), + io:format("\nNewDir = ~p\n", [NewDir]); + _ -> + ?line ok = ?FILE_MODULE:set_cwd(NewDir) + end, try %% Check that we get an error when trying to create... %% a deep directory @@ -473,32 +491,39 @@ cur_dir_0(Config) when is_list(Config) -> atom_to_list(?MODULE) ++"_curdir"), ?line ok = ?FILE_MODULE:make_dir(NewDir), - ?line io:format("cd to ~s",[NewDir]), - ?line ok = ?FILE_MODULE:set_cwd(NewDir), - - %% Create a file in the new current directory, and check that it - %% really is created there - ?line UncommonName = "uncommon.fil", - ?line {ok,Fd} = ?FILE_MODULE:open(UncommonName,read_write), - ?line ok = ?FILE_MODULE:close(Fd), - ?line {ok,NewDirFiles} = ?FILE_MODULE:list_dir("."), - ?line true = lists:member(UncommonName,NewDirFiles), - - %% Delete the directory and return to the old current directory - %% and check that the created file isn't there (too!) - ?line expect({error, einval}, {error, eacces}, - ?FILE_MODULE:del_dir(NewDir)), - ?line ?FILE_MODULE:delete(UncommonName), - ?line {ok,[]} = ?FILE_MODULE:list_dir("."), - ?line ok = ?FILE_MODULE:set_cwd(Dir1), - ?line io:format("cd back to ~s",[Dir1]), - ?line ok = ?FILE_MODULE:del_dir(NewDir), - ?line {error, enoent} = ?FILE_MODULE:set_cwd(NewDir), - ?line ok = ?FILE_MODULE:set_cwd(Dir1), - ?line io:format("cd back to ~s",[Dir1]), - ?line {ok,OldDirFiles} = ?FILE_MODULE:list_dir("."), - ?line false = lists:member(UncommonName,OldDirFiles), - + case {os:type(), length(NewDir) >= 260} of + {{win32,_}, true} -> + io:format("Skip set_cwd for windows path longer than 260 (MAX_PATH):\n"), + io:format("\nNewDir = ~p\n", [NewDir]); + _ -> + io:format("cd to ~s",[NewDir]), + ok = ?FILE_MODULE:set_cwd(NewDir), + + %% Create a file in the new current directory, and check that it + %% really is created there + UncommonName = "uncommon.fil", + {ok,Fd} = ?FILE_MODULE:open(UncommonName,read_write), + ok = ?FILE_MODULE:close(Fd), + {ok,NewDirFiles} = ?FILE_MODULE:list_dir("."), + true = lists:member(UncommonName,NewDirFiles), + + %% Delete the directory and return to the old current directory + %% and check that the created file isn't there (too!) + expect({error, einval}, {error, eacces}, + ?FILE_MODULE:del_dir(NewDir)), + ?FILE_MODULE:delete(UncommonName), + {ok,[]} = ?FILE_MODULE:list_dir("."), + ok = ?FILE_MODULE:set_cwd(Dir1), + io:format("cd back to ~s",[Dir1]), + + ok = ?FILE_MODULE:del_dir(NewDir), + {error, enoent} = ?FILE_MODULE:set_cwd(NewDir), + ok = ?FILE_MODULE:set_cwd(Dir1), + io:format("cd back to ~s",[Dir1]), + {ok,OldDirFiles} = ?FILE_MODULE:list_dir("."), + false = lists:member(UncommonName,OldDirFiles) + end, + %% Try doing some bad things ?line {error, badarg} = ?FILE_MODULE:set_cwd({foo,bar}), ?line {error, enoent} = ?FILE_MODULE:set_cwd(""), @@ -525,11 +550,11 @@ cur_dir_1(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:seconds(5)), ?line case os:type() of - {unix, _} -> - ?line {error, enotsup} = ?FILE_MODULE:get_cwd("d:"); - {win32, _} -> - win_cur_dir_1(Config) - end, + {win32, _} -> + win_cur_dir_1(Config); + _ -> + ?line {error, enotsup} = ?FILE_MODULE:get_cwd("d:") + end, ?line [] = flush(), ?line test_server:timetrap_cancel(Dog), ok. @@ -712,7 +737,10 @@ open1(Config) when is_list(Config) -> ?line io:format(Fd1,Str,[]), ?line {ok,0} = ?FILE_MODULE:position(Fd1,bof), ?line Str = io:get_line(Fd1,''), - ?line Str = io:get_line(Fd2,''), + ?line case io:get_line(Fd2,'') of + Str -> Str; + eof -> Str + end, ?line ok = ?FILE_MODULE:close(Fd2), ?line {ok,0} = ?FILE_MODULE:position(Fd1,bof), ?line ok = ?FILE_MODULE:truncate(Fd1), @@ -1246,7 +1274,7 @@ file_info_basic_directory(Config) when is_list(Config) -> ?line test_directory("/", read_write), ?line test_directory("c:/", read_write), ?line test_directory("c:\\", read_write); - {unix, _} -> + _ -> ?line test_directory("/", read) end, test_server:timetrap_cancel(Dog). @@ -1967,7 +1995,6 @@ names(Config) when is_list(Config) -> ?line Name1 = filename:join(RootDir, FileName), ?line Name2 = [RootDir,"/","foo1",".","fil"], ?line Name3 = [RootDir,"/",foo,$1,[[[],[],'.']],"f",il], - ?line Name4 = list_to_atom(Name1), ?line {ok,Fd0} = ?FILE_MODULE:open(Name1,write), ?line ok = ?FILE_MODULE:close(Fd0), @@ -1980,23 +2007,33 @@ names(Config) when is_list(Config) -> ?line ok = ?FILE_MODULE:close(Fd2), ?line {ok,Fd3} = ?FILE_MODULE:open(Name3,read), ?line ok = ?FILE_MODULE:close(Fd3), - ?line {ok,Fd4} = ?FILE_MODULE:open(Name4,read), - ?line ok = ?FILE_MODULE:close(Fd4), + case length(Name1) > 255 of + true -> + io:format("Path too long for an atom:\n\n~p\n", [Name1]); + false -> + Name4 = list_to_atom(Name1), + {ok,Fd4} = ?FILE_MODULE:open(Name4,read), + ok = ?FILE_MODULE:close(Fd4) + end, %% Try some path names ?line Path1 = RootDir, ?line Path2 = [RootDir], ?line Path3 = ['',[],[RootDir,[[]]]], - ?line Path4 = list_to_atom(Path1), ?line {ok,Fd11,_} = ?FILE_MODULE:path_open([Path1],FileName,read), ?line ok = ?FILE_MODULE:close(Fd11), ?line {ok,Fd12,_} = ?FILE_MODULE:path_open([Path2],FileName,read), ?line ok = ?FILE_MODULE:close(Fd12), ?line {ok,Fd13,_} = ?FILE_MODULE:path_open([Path3],FileName,read), ?line ok = ?FILE_MODULE:close(Fd13), - ?line {ok,Fd14,_} = ?FILE_MODULE:path_open([Path4],FileName,read), - ?line ok = ?FILE_MODULE:close(Fd14), - + case length(Path1) > 255 of + true-> + io:format("Path too long for an atom:\n\n~p\n", [Path1]); + false -> + Path4 = list_to_atom(Path1), + {ok,Fd14,_} = ?FILE_MODULE:path_open([Path4],FileName,read), + ok = ?FILE_MODULE:close(Fd14) + end, ?line [] = flush(), ?line test_server:timetrap_cancel(Dog), ok. @@ -2030,15 +2067,15 @@ e_delete(Config) when is_list(Config) -> %% No permission. ?line case os:type() of - {unix, _} -> + {win32, _} -> + %% Remove a character device. + ?line {error, eacces} = ?FILE_MODULE:delete("nul"); + _ -> ?line ?FILE_MODULE:write_file_info( Base, #file_info {mode=0}), ?line {error, eacces} = ?FILE_MODULE:delete(Afile), ?line ?FILE_MODULE:write_file_info( - Base, #file_info {mode=8#600}); - {win32, _} -> - %% Remove a character device. - ?line {error, eacces} = ?FILE_MODULE:delete("nul") + Base, #file_info {mode=8#600}) end, ?line [] = flush(), @@ -2140,6 +2177,9 @@ e_rename(Config) when is_list(Config) -> %% At least Windows NT can %% successfully move a file to %% another drive. + ok; + {ose, _} -> + %% disabled for now ok end, [] = flush(), @@ -2171,13 +2211,13 @@ e_make_dir(Config) when is_list(Config) -> %% No permission (on Unix only). case os:type() of - {unix, _} -> + {win32, _} -> + ok; + _ -> ?FILE_MODULE:write_file_info(Base, #file_info {mode=0}), {error, eacces} = ?FILE_MODULE:make_dir(filename:join(Base, "xxxx")), ?FILE_MODULE:write_file_info( - Base, #file_info {mode=8#600}); - {win32, _} -> - ok + Base, #file_info {mode=8#600}) end, test_server:timetrap_cancel(Dog), ok. @@ -2220,14 +2260,14 @@ e_del_dir(Config) when is_list(Config) -> %% No permission. case os:type() of - {unix, _} -> + {win32, _} -> + ok; + _ -> ADirectory = filename:join(Base, "no_perm"), ok = ?FILE_MODULE:make_dir(ADirectory), ?FILE_MODULE:write_file_info( Base, #file_info {mode=0}), {error, eacces} = ?FILE_MODULE:del_dir(ADirectory), - ?FILE_MODULE:write_file_info( Base, #file_info {mode=8#600}); - {win32, _} -> - ok + ?FILE_MODULE:write_file_info( Base, #file_info {mode=8#600}) end, [] = flush(), test_server:timetrap_cancel(Dog), @@ -2655,6 +2695,9 @@ symlinks(Config) when is_list(Config) -> case ?FILE_MODULE:make_symlink(Name, Alias) of {error, enotsup} -> {skipped, "Links not supported on this platform"}; + {error, eperm} -> + {win32,_} = os:type(), + {skipped, "Windows user not privileged to create symlinks"}; ok -> ?line {ok, Info1} = ?FILE_MODULE:read_file_info(Name), ?line {ok, Info1} = ?FILE_MODULE:read_file_info(Alias), @@ -3581,7 +3624,11 @@ otp_10852(Config) when is_list(Config) -> ok = rpc_call(Node, list_dir_all, [B]), ok = rpc_call(Node, read_file, [B]), ok = rpc_call(Node, make_link, [B,B]), - ok = rpc_call(Node, make_symlink, [B,B]), + case rpc_call(Node, make_symlink, [B,B]) of + ok -> ok; + {error, E} when (E =:= enotsup) or (E =:= eperm) -> + {win32,_} = os:type() + end, ok = rpc_call(Node, delete, [B]), ok = rpc_call(Node, make_dir, [B]), ok = rpc_call(Node, del_dir, [B]), diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index ee8bfcceb1..2df4bf7c95 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2014. 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 @@ -50,6 +50,14 @@ oct_acceptor/1, otp_7731_server/1, zombie_server/2, do_iter_max_socks/2]). +init_per_testcase(wrapping_oct, Config) when is_list(Config) -> + Dog = case os:type() of + {ose,_} -> + test_server:timetrap(test_server:minutes(20)); + _Else -> + test_server:timetrap(test_server:seconds(600)) + end, + [{watchdog, Dog}|Config]; init_per_testcase(iter_max_socks, Config) when is_list(Config) -> Dog = case os:type() of {win32,_} -> @@ -58,6 +66,17 @@ init_per_testcase(iter_max_socks, Config) when is_list(Config) -> test_server:timetrap(test_server:seconds(240)) end, [{watchdog, Dog}|Config]; +init_per_testcase(accept_system_limit, Config) when is_list(Config) -> + case os:type() of + {ose,_} -> + {skip,"Skip in OSE"}; + _ -> + Dog = test_server:timetrap(test_server:seconds(240)), + [{watchdog,Dog}|Config] + end; +init_per_testcase(wrapping_oct, Config) when is_list(Config) -> + Dog = test_server:timetrap(test_server:seconds(600)), + [{watchdog, Dog}|Config]; init_per_testcase(_Func, Config) when is_list(Config) -> Dog = test_server:timetrap(test_server:seconds(240)), [{watchdog, Dog}|Config]. @@ -537,7 +556,6 @@ otp_3924(Config) when is_list(Config) -> otp_3924_1(MaxDelay). otp_3924_1(MaxDelay) -> - Dog = test_server:timetrap(test_server:seconds(240)), ?line {ok, Node} = start_node(otp_3924), ?line DataLen = 100*1024, ?line Data = otp_3924_data(DataLen), @@ -548,7 +566,6 @@ otp_3924_1(MaxDelay) -> ?line ok = otp_3924(MaxDelay, Node, Data, DataLen, N) end), ?line test_server:stop_node(Node), - test_server:timetrap_cancel(Dog), ok. otp_3924(MaxDelay, Node, Data, DataLen, N) -> @@ -1953,7 +1970,9 @@ accept_system_limit(doc) -> accept_system_limit(Config) when is_list(Config) -> ?line {ok, LS} = gen_tcp:listen(0, []), ?line {ok, TcpPort} = inet:port(LS), - ?line Connector = spawn_link(fun () -> connector(TcpPort) end), + Me = self(), + ?line Connector = spawn_link(fun () -> connector(TcpPort, Me) end), + receive {Connector, sync} -> Connector ! {self(), continue} end, ?line ok = acceptor(LS, false, []), ?line Connector ! stop, ok. @@ -1970,8 +1989,10 @@ acceptor(LS, GotSL, A) -> error end. -connector(TcpPort) -> +connector(TcpPort, Tester) -> ManyPorts = open_ports([]), + Tester ! {self(), sync}, + receive {Tester, continue} -> timer:sleep(100) end, ConnF = fun (Port) -> case catch gen_tcp:connect({127,0,0,1}, TcpPort, []) of {ok, Sock} -> @@ -2705,13 +2726,11 @@ wrapping_oct(doc) -> wrapping_oct(suite) -> []; wrapping_oct(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(600)), {ok,Sock} = gen_tcp:listen(0,[{active,false},{mode,binary}]), {ok,Port} = inet:port(Sock), spawn_link(?MODULE,oct_acceptor,[Sock]), Res = oct_datapump(Port,16#1FFFFFFFF), gen_tcp:close(Sock), - test_server:timetrap_cancel(Dog), ok = Res, ok. diff --git a/lib/kernel/test/heart_SUITE.erl b/lib/kernel/test/heart_SUITE.erl index 320b23bea1..35d3b75b34 100644 --- a/lib/kernel/test/heart_SUITE.erl +++ b/lib/kernel/test/heart_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -93,10 +93,10 @@ start_check(Type, Name) -> start_check(Type, Name, []). start_check(Type, Name, Envs) -> Args = case ?t:os_type() of - {win32,_} -> - "-heart " ++ env_encode([{"HEART_COMMAND", no_reboot}|Envs]); + {win32,_} -> + "+t50000 -heart " ++ env_encode([{"HEART_COMMAND", no_reboot}|Envs]); _ -> - "-heart " ++ env_encode(Envs) + "+t50000 -heart " ++ env_encode(Envs) end, {ok, Node} = case Type of loose -> diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl index 199e597e78..05bd5b3a3d 100644 --- a/lib/kernel/test/prim_file_SUITE.erl +++ b/lib/kernel/test/prim_file_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2013. All Rights Reserved. +%% Copyright Ericsson AB 2000-2014. 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 @@ -78,7 +78,7 @@ _ -> apply(?PRIM_FILE, F, [H | A]) end). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> []. all() -> [read_write_file, {group, dirs}, {group, files}, @@ -183,7 +183,6 @@ time_dist({_D1, _T1} = DT1, {_D2, _T2} = DT2) -> read_write_file(suite) -> []; read_write_file(doc) -> []; read_write_file(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), ?line RootDir = ?config(priv_dir,Config), ?line Name = filename:join(RootDir, atom_to_list(?MODULE) @@ -232,7 +231,6 @@ read_write_file(Config) when is_list(Config) -> ?line {ok,Bin5} = ?PRIM_FILE:read_file(Name), ?line {Bin1,Bin2} = split_binary(Bin5,byte_size(Bin1)), - ?line test_server:timetrap_cancel(Dog), ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -254,7 +252,6 @@ make_del_dir_b(Config) when is_list(Config) -> Result. make_del_dir(Config, Handle, Suffix) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), ?line RootDir = ?config(priv_dir,Config), ?line NewDir = filename:join(RootDir, atom_to_list(?MODULE) @@ -269,7 +266,13 @@ make_del_dir(Config, Handle, Suffix) -> % because there are processes having that directory as current. ?line ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]), ?line {ok, CurrentDir} = ?PRIM_FILE_call(get_cwd, Handle, []), - ?line ok = ?PRIM_FILE_call(set_cwd, Handle, [NewDir]), + case {os:type(), length(NewDir) >= 260 } of + {{win32,_}, true} -> + io:format("Skip set_cwd for windows path longer than 260 (MAX_PATH)\n", []), + io:format("\nNewDir = ~p\n", [NewDir]); + _ -> + ok = ?PRIM_FILE_call(set_cwd, Handle, [NewDir]) + end, try %% Check that we get an error when trying to create... %% a deep directory @@ -302,9 +305,7 @@ make_del_dir(Config, Handle, Suffix) -> {error, einval} -> ok %FreeBSD end, ?line {error, enoent} = ?PRIM_FILE_call(del_dir, Handle, [""]), - ?line {error, badarg} = ?PRIM_FILE_call(del_dir, Handle, [[3,2,1,{}]]), - - ?line test_server:timetrap_cancel(Dog) + ?line {error, badarg} = ?PRIM_FILE_call(del_dir, Handle, [[3,2,1,{}]]) after ?line ok = ?PRIM_FILE_call(set_cwd, Handle, [CurrentDir]) end, @@ -324,7 +325,6 @@ cur_dir_0b(Config) when is_list(Config) -> Result. cur_dir_0(Config, Handle) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), %% Find out the current dir, and cd to it ;-) ?line {ok,BaseDir} = ?PRIM_FILE_call(get_cwd, Handle, []), ?line Dir1 = BaseDir ++ "", %% Check that it's a string @@ -341,31 +341,37 @@ cur_dir_0(Config, Handle) -> ?line RootDir = ?config(priv_dir,Config), ?line NewDir = filename:join(RootDir, DirName), ?line ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]), - ?line io:format("cd to ~s",[NewDir]), - ?line ok = ?PRIM_FILE_call(set_cwd, Handle, [NewDir]), - - %% Create a file in the new current directory, and check that it - %% really is created there - ?line UncommonName = "uncommon.fil", - ?line {ok,Fd} = ?PRIM_FILE:open(UncommonName, [read, write]), - ?line ok = ?PRIM_FILE:close(Fd), - ?line {ok,NewDirFiles} = ?PRIM_FILE_call(list_dir, Handle, ["."]), - ?line true = lists:member(UncommonName,NewDirFiles), - - %% Delete the directory and return to the old current directory - %% and check that the created file isn't there (too!) - ?line expect({error, einval}, {error, eacces}, {error, eexist}, + case {os:type(), length(NewDir) >= 260} of + {{win32,_}, true} -> + io:format("Skip set_cwd for windows path longer than 260 (MAX_PATH):\n"), + io:format("\nNewDir = ~p\n", [NewDir]); + _ -> + io:format("cd to ~s",[NewDir]), + ok = ?PRIM_FILE_call(set_cwd, Handle, [NewDir]), + + %% Create a file in the new current directory, and check that it + %% really is created there + UncommonName = "uncommon.fil", + {ok,Fd} = ?PRIM_FILE:open(UncommonName, [read, write]), + ok = ?PRIM_FILE:close(Fd), + {ok,NewDirFiles} = ?PRIM_FILE_call(list_dir, Handle, ["."]), + true = lists:member(UncommonName,NewDirFiles), + + %% Delete the directory and return to the old current directory + %% and check that the created file isn't there (too!) + expect({error, einval}, {error, eacces}, {error, eexist}, ?PRIM_FILE_call(del_dir, Handle, [NewDir])), - ?line ?PRIM_FILE_call(delete, Handle, [UncommonName]), - ?line {ok,[]} = ?PRIM_FILE_call(list_dir, Handle, ["."]), - ?line ok = ?PRIM_FILE_call(set_cwd, Handle, [Dir1]), - ?line io:format("cd back to ~s",[Dir1]), - ?line ok = ?PRIM_FILE_call(del_dir, Handle, [NewDir]), - ?line {error, enoent} = ?PRIM_FILE_call(set_cwd, Handle, [NewDir]), - ?line ok = ?PRIM_FILE_call(set_cwd, Handle, [Dir1]), - ?line io:format("cd back to ~s",[Dir1]), - ?line {ok,OldDirFiles} = ?PRIM_FILE_call(list_dir, Handle, ["."]), - ?line false = lists:member(UncommonName,OldDirFiles), + ?PRIM_FILE_call(delete, Handle, [UncommonName]), + {ok,[]} = ?PRIM_FILE_call(list_dir, Handle, ["."]), + ok = ?PRIM_FILE_call(set_cwd, Handle, [Dir1]), + io:format("cd back to ~s",[Dir1]), + ok = ?PRIM_FILE_call(del_dir, Handle, [NewDir]), + {error, enoent} = ?PRIM_FILE_call(set_cwd, Handle, [NewDir]), + ok = ?PRIM_FILE_call(set_cwd, Handle, [Dir1]), + io:format("cd back to ~s",[Dir1]), + {ok,OldDirFiles} = ?PRIM_FILE_call(list_dir, Handle, ["."]), + false = lists:member(UncommonName,OldDirFiles) + end, %% Try doing some bad things ?line {error, badarg} = @@ -385,7 +391,6 @@ cur_dir_0(Config, Handle) -> ?line {ok, BaseDir} = ?PRIM_FILE_call(get_cwd, Handle, []), ?line false = lists:member($\\, BaseDir), - ?line test_server:timetrap_cancel(Dog), ok. %% Tests ?PRIM_FILE:get_cwd/1. @@ -404,16 +409,13 @@ cur_dir_1b(Config) when is_list(Config) -> Result. cur_dir_1(Config, Handle) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - ?line case os:type() of - {unix, _} -> - ?line {error, enotsup} = - ?PRIM_FILE_call(get_cwd, Handle, ["d:"]); {win32, _} -> - win_cur_dir_1(Config, Handle) + win_cur_dir_1(Config, Handle); + _ -> + ?line {error, enotsup} = + ?PRIM_FILE_call(get_cwd, Handle, ["d:"]) end, - ?line test_server:timetrap_cancel(Dog), ok. win_cur_dir_1(_Config, Handle) -> @@ -439,7 +441,6 @@ win_cur_dir_1(_Config, Handle) -> open1(suite) -> []; open1(doc) -> []; open1(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), ?line RootDir = ?config(priv_dir,Config), ?line NewDir = filename:join(RootDir, atom_to_list(?MODULE) @@ -453,7 +454,10 @@ open1(Config) when is_list(Config) -> ?line ?PRIM_FILE:write(Fd1,Str), ?line {ok,0} = ?PRIM_FILE:position(Fd1,bof), ?line {ok, Str} = ?PRIM_FILE:read(Fd1,Length), - ?line {ok, Str} = ?PRIM_FILE:read(Fd2,Length), + ?line case ?PRIM_FILE:read(Fd2,Length) of + {ok,Str} -> Str; + eof -> Str + end, ?line ok = ?PRIM_FILE:close(Fd2), ?line {ok,0} = ?PRIM_FILE:position(Fd1,bof), ?line ok = ?PRIM_FILE:truncate(Fd1), @@ -462,7 +466,6 @@ open1(Config) when is_list(Config) -> ?line {ok,Fd3} = ?PRIM_FILE:open(Name, [read]), ?line eof = ?PRIM_FILE:read(Fd3,Length), ?line ok = ?PRIM_FILE:close(Fd3), - ?line test_server:timetrap_cancel(Dog), ok. %% Tests all open modes. @@ -514,7 +517,6 @@ modes(Config) when is_list(Config) -> close(suite) -> []; close(doc) -> []; close(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), ?line RootDir = ?config(priv_dir,Config), ?line Name = filename:join(RootDir, atom_to_list(?MODULE) @@ -531,13 +533,11 @@ close(Config) when is_list(Config) -> ?line Val = ?PRIM_FILE:close(Fd1), ?line io:format("Second close gave: ~p", [Val]), - ?line test_server:timetrap_cancel(Dog), ok. access(suite) -> []; access(doc) -> []; access(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), ?line RootDir = ?config(priv_dir,Config), ?line Name = filename:join(RootDir, atom_to_list(?MODULE) @@ -559,7 +559,6 @@ access(Config) when is_list(Config) -> ?line {ok, Str} = ?PRIM_FILE:read(Fd3,length(Str)), ?line ok = ?PRIM_FILE:close(Fd3), - ?line test_server:timetrap_cancel(Dog), ok. %% Tests ?PRIM_FILE:read/2 and ?PRIM_FILE:write/2. @@ -567,7 +566,6 @@ access(Config) when is_list(Config) -> read_write(suite) -> []; read_write(doc) -> []; read_write(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), ?line RootDir = ?config(priv_dir, Config), ?line NewDir = filename:join(RootDir, atom_to_list(?MODULE) @@ -579,7 +577,6 @@ read_write(Config) when is_list(Config) -> ?line {ok, Fd} = ?PRIM_FILE:open(Name, [read, write]), ?line read_write_test(Fd), - ?line test_server:timetrap_cancel(Dog), ok. read_write_test(File) -> @@ -597,7 +594,6 @@ read_write_test(File) -> pread_write(suite) -> []; pread_write(doc) -> []; pread_write(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), ?line RootDir = ?config(priv_dir, Config), ?line NewDir = filename:join(RootDir, atom_to_list(?MODULE) @@ -609,7 +605,6 @@ pread_write(Config) when is_list(Config) -> ?line {ok, Fd} = ?PRIM_FILE:open(Name, [read, write]), ?line pread_write_test(Fd), - ?line test_server:timetrap_cancel(Dog), ok. pread_write_test(File) -> @@ -629,7 +624,6 @@ pread_write_test(File) -> append(doc) -> "Test appending to a file."; append(suite) -> []; append(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), ?line RootDir = ?config(priv_dir, Config), ?line NewDir = filename:join(RootDir, atom_to_list(?MODULE) @@ -656,13 +650,11 @@ append(Config) when is_list(Config) -> ?line Expected = list_to_binary([First, Second, Third]), ?line {ok, Expected} = ?PRIM_FILE:read_file(Name1), - ?line test_server:timetrap_cancel(Dog), ok. exclusive(suite) -> []; exclusive(doc) -> "Test exclusive access to a file."; exclusive(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), ?line RootDir = ?config(priv_dir,Config), ?line NewDir = filename:join(RootDir, atom_to_list(?MODULE) @@ -672,7 +664,6 @@ exclusive(Config) when is_list(Config) -> ?line {ok,Fd} = ?PRIM_FILE:open(Name, [write, exclusive]), ?line {error, eexist} = ?PRIM_FILE:open(Name, [write, exclusive]), ?line ok = ?PRIM_FILE:close(Fd), - ?line test_server:timetrap_cancel(Dog), ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -681,7 +672,6 @@ exclusive(Config) when is_list(Config) -> pos1(suite) -> []; pos1(doc) -> []; pos1(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), ?line RootDir = ?config(priv_dir,Config), ?line Name = filename:join(RootDir, atom_to_list(?MODULE) @@ -738,13 +728,11 @@ pos1(Config) when is_list(Config) -> ?line {ok, 0} = ?PRIM_FILE:position(Fd2,{eof,-8}), ?line {ok, "A"} = ?PRIM_FILE:read(Fd2,1), ?line {error, einval} = ?PRIM_FILE:position(Fd2,{eof,-9}), - ?line test_server:timetrap_cancel(Dog), ok. pos2(suite) -> []; pos2(doc) -> []; pos2(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), ?line RootDir = ?config(priv_dir,Config), ?line Name = filename:join(RootDir, atom_to_list(?MODULE) @@ -761,7 +749,6 @@ pos2(Config) when is_list(Config) -> ?line {ok, "D"} = ?PRIM_FILE:read(Fd2,1), ?line io:format("DONE"), - ?line test_server:timetrap_cancel(Dog), ok. @@ -779,7 +766,6 @@ file_info_basic_file_b(Config) when is_list(Config) -> Result. file_info_basic_file(Config, Handle, Suffix) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), ?line RootDir = ?config(priv_dir, Config), %% Create a short file. @@ -808,7 +794,6 @@ file_info_basic_file(Config, Handle, Suffix) -> ?line {MD, MT} = ModifyTime, ?line all_integers(tuple_to_list(MD) ++ tuple_to_list(MT)), - ?line test_server:timetrap_cancel(Dog), ok. file_info_basic_directory_a(suite) -> []; @@ -825,8 +810,6 @@ file_info_basic_directory_b(Config) when is_list(Config) -> Result. file_info_basic_directory(Config, Handle) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - %% Note: filename:join/1 removes any trailing slash, %% which is essential for ?PRIM_FILE:read_file_info/1 to work on %% platforms such as Windows95. @@ -843,10 +826,10 @@ file_info_basic_directory(Config, Handle) -> ?line test_directory("/", read_write, Handle), ?line test_directory("c:/", read_write, Handle), ?line test_directory("c:\\", read_write, Handle); - {unix, _} -> + _ -> ?line test_directory("/", read, Handle) end, - ?line test_server:timetrap_cancel(Dog). + ok. test_directory(Name, ExpectedAccess, Handle) -> ?line {ok, FileInfo} = ?PRIM_FILE_call(read_file_info, Handle, [Name]), @@ -887,14 +870,12 @@ file_info_bad_b(Config) when is_list(Config) -> Result. file_info_bad(Config, Handle) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), ?line RootDir = filename:join([?config(priv_dir, Config)]), ?line {error, enoent} = ?PRIM_FILE_call( read_file_info, Handle, [filename:join(RootDir, atom_to_list(?MODULE)++"_nonexistent")]), - ?line test_server:timetrap_cancel(Dog), ok. %% Test that the file times behave as they should. @@ -1189,7 +1170,6 @@ get_good_directory(Config) -> truncate(suite) -> []; truncate(doc) -> []; truncate(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), ?line RootDir = ?config(priv_dir,Config), ?line Name = filename:join(RootDir, atom_to_list(?MODULE) @@ -1215,14 +1195,12 @@ truncate(Config) when is_list(Config) -> ?line {ok, 5} = ?PRIM_FILE:position(Fd2, 5), ?line {error, _} = ?PRIM_FILE:truncate(Fd2), - ?line test_server:timetrap_cancel(Dog), ok. datasync(suite) -> []; datasync(doc) -> "Tests that ?PRIM_FILE:datasync/1 at least doesn't crash."; datasync(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), ?line PrivDir = ?config(priv_dir, Config), ?line Sync = filename:join(PrivDir, atom_to_list(?MODULE) @@ -1233,14 +1211,12 @@ datasync(Config) when is_list(Config) -> ?line ok = ?PRIM_FILE:datasync(Fd), ?line ok = ?PRIM_FILE:close(Fd), - ?line test_server:timetrap_cancel(Dog), ok. sync(suite) -> []; sync(doc) -> "Tests that ?PRIM_FILE:sync/1 at least doesn't crash."; sync(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), ?line PrivDir = ?config(priv_dir, Config), ?line Sync = filename:join(PrivDir, atom_to_list(?MODULE) @@ -1251,14 +1227,12 @@ sync(Config) when is_list(Config) -> ?line ok = ?PRIM_FILE:sync(Fd), ?line ok = ?PRIM_FILE:close(Fd), - ?line test_server:timetrap_cancel(Dog), ok. advise(suite) -> []; advise(doc) -> "Tests that ?PRIM_FILE:advise/4 at least doesn't crash."; advise(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), ?line PrivDir = ?config(priv_dir, Config), ?line Advise = filename:join(PrivDir, atom_to_list(?MODULE) @@ -1322,7 +1296,6 @@ advise(Config) when is_list(Config) -> ?line eof = ?PRIM_FILE:read_line(Fd9), ?line ok = ?PRIM_FILE:close(Fd9), - ?line test_server:timetrap_cancel(Dog), ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1366,7 +1339,6 @@ check_large_write(Dog, Fd, _, _, []) -> allocate(suite) -> []; allocate(doc) -> "Tests that ?PRIM_FILE:allocate/3 at least doesn't crash."; allocate(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), ?line PrivDir = ?config(priv_dir, Config), ?line Allocate = filename:join(PrivDir, atom_to_list(?MODULE) @@ -1399,7 +1371,6 @@ allocate(Config) when is_list(Config) -> ?line ok = ?PRIM_FILE:write(Fd4, Line2), ?line ok = ?PRIM_FILE:close(Fd4), - ?line test_server:timetrap_cancel(Dog), ok. allocate_and_assert(Fd, Offset, Length) -> @@ -1447,7 +1418,6 @@ delete_b(Config) when is_list(Config) -> Result. delete(Config, Handle, Suffix) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), ?line RootDir = ?config(priv_dir,Config), ?line Name = filename:join(RootDir, atom_to_list(?MODULE) @@ -1463,7 +1433,6 @@ delete(Config, Handle, Suffix) -> ?line {error, _} = ?PRIM_FILE:open(Name, [read]), %% Try deleting a nonexistent file ?line {error, enoent} = ?PRIM_FILE_call(delete, Handle, [Name]), - ?line test_server:timetrap_cancel(Dog), ok. rename_a(suite) ->[]; @@ -1480,7 +1449,6 @@ rename_b(Config) when is_list(Config) -> Result. rename(Config, Handle, Suffix) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), ?line RootDir = ?config(priv_dir,Config), ?line FileName1 = atom_to_list(?MODULE)++"_rename"++Suffix++".fil", ?line FileName2 = atom_to_list(?MODULE)++"_rename"++Suffix++".ful", @@ -1533,7 +1501,6 @@ rename(Config, Handle, Suffix) -> ?PRIM_FILE_call(rename, Handle, [DirName2, Name2foo]), ?line io:format("Errmsg2: ~p",[Msg2]), - ?line test_server:timetrap_cancel(Dog), ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1568,15 +1535,15 @@ e_delete(Config) when is_list(Config) -> %% No permission. ?line case os:type() of - {unix, _} -> + {win32, _} -> + %% Remove a character device. + ?line {error, eacces} = ?PRIM_FILE:delete("nul"); + _ -> ?line ?PRIM_FILE:write_file_info( Base, #file_info {mode=0}), ?line {error, eacces} = ?PRIM_FILE:delete(Afile), ?line ?PRIM_FILE:write_file_info( - Base, #file_info {mode=8#600}); - {win32, _} -> - %% Remove a character device. - ?line {error, eacces} = ?PRIM_FILE:delete("nul") + Base, #file_info {mode=8#600}) end, ?line test_server:timetrap_cancel(Dog), @@ -1656,7 +1623,12 @@ e_rename(Config) when is_list(Config) -> %% XXX - Gross hack! ?line Comment = case os:type() of - {unix, _} -> + {win32, _} -> + %% At least Windows NT can + %% successfully move a file to + %% another drive. + ok; + {unix, _ } -> OtherFs = "/tmp", ?line NameOnOtherFs = filename:join(OtherFs, @@ -1681,10 +1653,8 @@ e_rename(Config) when is_list(Config) -> Else end, Com; - {win32, _} -> - %% At least Windows NT can - %% successfully move a file to - %% another drive. + {ose, _} -> + %% disabled for now ok end, ?line test_server:timetrap_cancel(Dog), @@ -1714,14 +1684,14 @@ e_make_dir(Config) when is_list(Config) -> %% No permission (on Unix only). case os:type() of - {unix, _} -> + {win32, _} -> + ok; + _ -> ?line ?PRIM_FILE:write_file_info(Base, #file_info {mode=0}), ?line {error, eacces} = ?PRIM_FILE:make_dir(filename:join(Base, "xxxx")), ?line - ?PRIM_FILE:write_file_info(Base, #file_info {mode=8#600}); - {win32, _} -> - ok + ?PRIM_FILE:write_file_info(Base, #file_info {mode=8#600}) end, ?line test_server:timetrap_cancel(Dog), ok. @@ -1767,15 +1737,15 @@ e_del_dir(Config) when is_list(Config) -> %% No permission. case os:type() of - {unix, _} -> + {win32, _} -> + ok; + _ -> ?line ADirectory = filename:join(Base, "no_perm"), ?line ok = ?PRIM_FILE:make_dir(ADirectory), ?line ?PRIM_FILE:write_file_info(Base, #file_info {mode=0}), ?line {error, eacces} = ?PRIM_FILE:del_dir(ADirectory), ?line ?PRIM_FILE:write_file_info( - Base, #file_info {mode=8#600}); - {win32, _} -> - ok + Base, #file_info {mode=8#600}) end, ?line test_server:timetrap_cancel(Dog), ok. @@ -2023,6 +1993,9 @@ symlinks(Config, Handle, Suffix) -> case ?PRIM_FILE_call(make_symlink, Handle, [Name, Alias]) of {error, enotsup} -> {skipped, "Links not supported on this platform"}; + {error, eperm} -> + {win32,_} = os:type(), + {skipped, "Windows user not privileged to create links"}; ok -> ?line {ok, Info1} = ?PRIM_FILE_call(read_file_info, Handle, [Name]), diff --git a/lib/megaco/aclocal.m4 b/lib/megaco/aclocal.m4 index 46b30a16b3..2b47f7c4bc 100644 --- a/lib/megaco/aclocal.m4 +++ b/lib/megaco/aclocal.m4 @@ -74,6 +74,21 @@ AC_ARG_VAR(erl_xcomp_clock_gettime_cpu_time, [clock_gettime() can be used for re AC_ARG_VAR(erl_xcomp_after_morecore_hook, [__after_morecore_hook can track malloc()s core memory usage: yes|no (only used when cross compiling)]) AC_ARG_VAR(erl_xcomp_dlsym_brk_wrappers, [dlsym(RTLD_NEXT, _) brk wrappers can track malloc()s core memory usage: yes|no (only used when cross compiling)]) +dnl Cross compilation variables for OSE +AC_ARG_VAR(erl_xcomp_ose_ldflags_pass1, [Linker flags for the OSE module (pass 1) (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_ldflags_pass2, [Linker flags for the OSE module (pass 2) (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_OSEROOT, [OSE installation root directory (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_STRIP, [Strip utility shipped with the OSE distribution(only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_POST_LINK, [OSE postlink tool (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_SET_CONF, [Sets the configuration for an OSE load module (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_ELF_SIZE, [Prints the section size information for an OSE load module (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_LCF, [OSE load module linker configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_BEAM_LM_CONF, [BEAM OSE load module default configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_EPMD_LM_CONF, [EPMD OSE load module default configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_RUN_ERL_LM_CONF, [run_erl_lm OSE load module default configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_CONFD, [OSE confd source file]) +AC_ARG_VAR(erl_xcomp_ose_CRT0_LM, [OSE crt0 lm source file]) + ]) AC_DEFUN(ERL_XCOMP_SYSROOT_INIT, @@ -488,6 +503,8 @@ AC_CACHE_VAL(ac_cv_sys_ipv6_support, #ifdef __WIN32__ #include <winsock2.h> #include <ws2tcpip.h> +#elif __OSE__ +#error "no ipv6" #else #include <netinet/in.h> #endif], @@ -500,6 +517,8 @@ else #ifdef __WIN32__ #include <winsock2.h> #include <ws2tcpip.h> +#elif __OSE__ +#error "no ipv6" #else #include <netinet/in.h> #endif], @@ -728,6 +747,12 @@ if test "X$host_os" = "Xwin32"; then THR_LIBS= THR_LIB_NAME=win32_threads THR_LIB_TYPE=win32_threads +elif test "X$host_os" = "Xose"; then + AC_MSG_RESULT(yes) + THR_DEFS="-DOSE_THREADS" + THR_LIBS= + THR_LIB_NAME=ose_threads + THR_LIB_TYPE=ose_threads else AC_MSG_RESULT(no) THR_DEFS= @@ -1078,9 +1103,22 @@ case "$THR_LIB_NAME" in test "$ethr_have_native_atomics" = "yes" && ethr_have_native_spinlock=yes ;; - pthread) - ETHR_THR_LIB_BASE_DIR=pthread - AC_DEFINE(ETHR_PTHREADS, 1, [Define if you have pthreads]) + pthread|ose_threads) + case "$THR_LIB_NAME" in + pthread) + ETHR_THR_LIB_BASE_DIR=pthread + AC_DEFINE(ETHR_PTHREADS, 1, [Define if you have pthreads]) + ;; + ose_threads) + AC_DEFINE(ETHR_OSE_THREADS, 1, + [Define if you have OSE style threads]) + ETHR_THR_LIB_BASE_DIR=ose + AC_CHECK_HEADER(ose_spi/ose_spi.h, + AC_DEFINE(HAVE_OSE_SPI_H, 1, + [Define if you have the "ose_spi/ose_spi.h" header file.])) + ;; + esac + if test "x$THR_LIB_NAME" == "xpthread"; then case $host_os in openbsd*) # The default stack size is insufficient for our needs @@ -1139,6 +1177,7 @@ case "$THR_LIB_NAME" in *) ;; esac + fi dnl We sometimes need ETHR_DEFS in order to find certain headers dnl (at least for pthread.h on osf1). saved_cppflags="$CPPFLAGS" @@ -1151,7 +1190,6 @@ case "$THR_LIB_NAME" in dnl dnl Check for headers dnl - AC_CHECK_HEADER(pthread.h, \ AC_DEFINE(ETHR_HAVE_PTHREAD_H, 1, \ [Define if you have the <pthread.h> header file.])) @@ -1184,7 +1222,7 @@ case "$THR_LIB_NAME" in dnl dnl Check for functions dnl - + if test "x$THR_LIB_NAME" == "xpthread"; then AC_CHECK_FUNC(pthread_spin_lock, \ [ethr_have_native_spinlock=yes \ AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \ @@ -1311,6 +1349,8 @@ case "$THR_LIB_NAME" in AC_MSG_RESULT([$linux_futex]) test $linux_futex = yes && AC_DEFINE(ETHR_HAVE_LINUX_FUTEX, 1, [Define if you have a linux futex implementation.]) + fi + AC_CHECK_SIZEOF(int) AC_CHECK_SIZEOF(long) AC_CHECK_SIZEOF(long long) diff --git a/lib/megaco/src/app/megaco.app.src b/lib/megaco/src/app/megaco.app.src index 40265166ae..6ab85a1bbc 100644 --- a/lib/megaco/src/app/megaco.app.src +++ b/lib/megaco/src/app/megaco.app.src @@ -112,7 +112,10 @@ megaco_trans_sup, megaco_misc_sup, megaco_sup]}, {applications, [stdlib, kernel]}, {env, []}, - {mod, {megaco_sup, []}} + {mod, {megaco_sup, []}}, + {runtime_dependencies, ["stdlib-2.0","runtime_tools-1.8.14","kernel-3.0", + "et-1.5","erts-6.0","debugger-4.0", + "asn1-3.0"]} ]}. diff --git a/lib/megaco/vsn.mk b/lib/megaco/vsn.mk index 01d429d0ae..373f5199bf 100644 --- a/lib/megaco/vsn.mk +++ b/lib/megaco/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = megaco -MEGACO_VSN = 3.17.0.3 +MEGACO_VSN = 3.17.1 PRE_VSN = APP_VSN = "$(APPLICATION)-$(MEGACO_VSN)$(PRE_VSN)" diff --git a/lib/mnesia/src/mnesia.app.src b/lib/mnesia/src/mnesia.app.src index 3715488ec2..e755864792 100644 --- a/lib/mnesia/src/mnesia.app.src +++ b/lib/mnesia/src/mnesia.app.src @@ -47,6 +47,7 @@ mnesia_tm ]}, {applications, [kernel, stdlib]}, - {mod, {mnesia_sup, []}}]}. + {mod, {mnesia_sup, []}}, + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0"]}]}. diff --git a/lib/mnesia/src/mnesia.hrl b/lib/mnesia/src/mnesia.hrl index 2855792646..c8010d5466 100644 --- a/lib/mnesia/src/mnesia.hrl +++ b/lib/mnesia/src/mnesia.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -35,7 +35,7 @@ -define(ets_last(Tab), ets:last(Tab)). -define(ets_prev(Tab, Key), ets:prev(Tab, Key)). -define(ets_slot(Tab, Pos), ets:slot(Tab, Pos)). --define(ets_new_table(Tab, Props), ets:new(Tab, Props)). +-define(ets_new_table(Tab, Props), _ = ets:new(Tab, Props)). -define(ets_delete_table(Tab), ets:delete(Tab)). -define(ets_fixtable(Tab, Bool), ets:fixtable(Tab, Bool)). diff --git a/lib/mnesia/src/mnesia_index.erl b/lib/mnesia/src/mnesia_index.erl index 8fef611a48..87cb58dae1 100644 --- a/lib/mnesia/src/mnesia_index.erl +++ b/lib/mnesia/src/mnesia_index.erl @@ -52,7 +52,11 @@ val(Var) -> case ?catch_val(Var) of - {'EXIT', _ReASoN_} -> mnesia_lib:other_val(Var, _ReASoN_); + {'EXIT', _ReASoN_} -> + case mnesia_lib:other_val(Var) of + error -> mnesia_lib:pr_other(Var, _ReASoN_); + Val -> Val + end; _VaLuE_ -> _VaLuE_ end. diff --git a/lib/mnesia/src/mnesia_lib.erl b/lib/mnesia/src/mnesia_lib.erl index 109e924971..a32c69c59e 100644 --- a/lib/mnesia/src/mnesia_lib.erl +++ b/lib/mnesia/src/mnesia_lib.erl @@ -115,6 +115,8 @@ mkcore/1, not_active_here/1, other_val/2, + other_val/1, + pr_other/2, overload_read/0, overload_read/1, overload_set/2, @@ -389,16 +391,19 @@ unset(Var) -> ?ets_delete(mnesia_gvar, Var). other_val(Var, Other) -> + case other_val(Var) of + error -> pr_other(Var, Other); + Val -> Val + end. + +other_val(Var) -> case Var of {_, where_to_read} -> nowhere; {_, where_to_write} -> []; {_, active_replicas} -> []; - _ -> - pr_other(Var, Other) + _ -> error end. --spec pr_other(_,_) -> no_return(). - pr_other(Var, Other) -> Why = case is_running() of diff --git a/lib/mnesia/src/mnesia_locker.erl b/lib/mnesia/src/mnesia_locker.erl index 32cea903c9..81b435c6dc 100644 --- a/lib/mnesia/src/mnesia_locker.erl +++ b/lib/mnesia/src/mnesia_locker.erl @@ -270,7 +270,8 @@ try_sticky_lock(Tid, Op, Pid, {Tab, _} = Oid) -> try_lock(Tid, Op, Pid, Oid); [{_,N}] -> Req = {Pid, {Op, Tid, Oid}}, - Pid ! {?MODULE, node(), {switch, N, Req}} + Pid ! {?MODULE, node(), {switch, N, Req}}, + true end. try_lock(Tid, read_write, Pid, Oid) -> diff --git a/lib/mnesia/src/mnesia_recover.erl b/lib/mnesia/src/mnesia_recover.erl index 0548a25ebf..b6492707e2 100644 --- a/lib/mnesia/src/mnesia_recover.erl +++ b/lib/mnesia/src/mnesia_recover.erl @@ -178,7 +178,11 @@ log_decision(D) -> val(Var) -> case ?catch_val(Var) of - {'EXIT', Reason} -> mnesia_lib:other_val(Var, Reason); + {'EXIT', Reason} -> + case mnesia_lib:other_val(Var) of + error -> mnesia_lib:pr_other(Var, Reason); + Val -> Val + end; Value -> Value end. diff --git a/lib/mnesia/src/mnesia_snmp_hook.erl b/lib/mnesia/src/mnesia_snmp_hook.erl index 893b39f3c0..256f83b029 100644 --- a/lib/mnesia/src/mnesia_snmp_hook.erl +++ b/lib/mnesia/src/mnesia_snmp_hook.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -32,7 +32,11 @@ val(Var) -> case ?catch_val(Var) of - {'EXIT', _ReASoN_} -> mnesia_lib:other_val(Var, _ReASoN_); + {'EXIT', _ReASoN_} -> + case mnesia_lib:other_val(Var) of + error -> mnesia_lib:pr_other(Var, _ReASoN_); + Val -> Val + end; _VaLuE_ -> _VaLuE_ end. diff --git a/lib/mnesia/test/mnesia_config_test.erl b/lib/mnesia/test/mnesia_config_test.erl index 6baf86a4a5..c495bce63f 100644 --- a/lib/mnesia/test/mnesia_config_test.erl +++ b/lib/mnesia/test/mnesia_config_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2014. 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 @@ -639,10 +639,10 @@ send_compressed(Config) -> end, ?match([], mnesia_test_lib:kill_mnesia([N2])), - + sys:get_status(mnesia_monitor), %% sync N1 ?match([], mnesia_test_lib:kill_mnesia([N1])), ?match(ok, mnesia:start([{send_compressed, 9}])), - ?match(ok, mnesia:wait_for_tables([t0,t1,t2], 5000)), + ?match(ok, mnesia:wait_for_tables([t0,t1,t2], 25000)), ?match({atomic, ok}, mnesia:transaction(Create, [t0])), ?match({atomic, ok}, mnesia:transaction(Create, [t1])), @@ -1158,6 +1158,7 @@ dynamic_basic(Config) when is_list(Config) -> %%% SYNC!!! timer:sleep(1000), + sys:get_status(mnesia_monitor), ?match([N3,N1], sort(rpc:call(N1, mnesia, system_info, [running_db_nodes]))), ?match([N3,N1], sort(rpc:call(N3, mnesia, system_info, [running_db_nodes]))), diff --git a/lib/mnesia/test/mnesia_evil_coverage_test.erl b/lib/mnesia/test/mnesia_evil_coverage_test.erl index 91820238e5..2d1623b6ca 100644 --- a/lib/mnesia/test/mnesia_evil_coverage_test.erl +++ b/lib/mnesia/test/mnesia_evil_coverage_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -671,13 +671,16 @@ add_copy_when_going_down(Config) -> ?acquire_nodes(2, Config ++ [{tc_timeout, timer:minutes(2)}]), ?match({atomic, ok}, mnesia:create_table(a, [{ram_copies, [Node1]}])), %% Grab a write lock + Tester = self(), WriteAndWait = fun() -> mnesia:write({a,1,1}), - receive continue -> ok + Tester ! {self(), got_lock}, + receive continue -> ok end end, - _Lock = spawn(fun() -> mnesia:transaction(WriteAndWait) end), - Tester = self(), + Locker = spawn(fun() -> mnesia:transaction(WriteAndWait) end), + receive {Locker, got_lock} -> ok end, + spawn_link(fun() -> Res = rpc:call(Node2, mnesia, add_table_copy, [a, Node2, ram_copies]), Tester ! {test, Res} diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk index 064ba43791..c596f98c81 100644 --- a/lib/mnesia/vsn.mk +++ b/lib/mnesia/vsn.mk @@ -1 +1 @@ -MNESIA_VSN = 4.11 +MNESIA_VSN = 4.12 diff --git a/lib/observer/src/cdv_dist_cb.erl b/lib/observer/src/cdv_dist_cb.erl index 3860324d6f..f7e6c9aded 100644 --- a/lib/observer/src/cdv_dist_cb.erl +++ b/lib/observer/src/cdv_dist_cb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2014. 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 @@ -22,7 +22,8 @@ get_info/1, get_detail_cols/1, get_details/1, - detail_pages/0]). + detail_pages/0, + format/1]). -include_lib("wx/include/wx.hrl"). -include("crashdump_viewer.hrl"). @@ -75,6 +76,11 @@ init_gen_page(Parent, Info) -> Fields = info_fields(), cdv_info_wx:start_link(Parent,{Fields,Info,[]}). +format({creations,Creations}) -> + string:join([integer_to_list(C) || C <- Creations],","); +format(D) -> + D. + %%%----------------------------------------------------------------- %%% Internal info_fields() -> @@ -83,7 +89,7 @@ info_fields() -> {"Type", conn_type}, {"Channel", channel}, {"Controller", {click,controller}}, - {"Creation", creation}, + {"Creation", {{format,fun format/1},creation}}, {"Extra Info", error}]}, {scroll_boxes, [{"Remote Links",1,{click,remote_links}}, diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl index a17efbccb0..a08d27d070 100644 --- a/lib/observer/src/crashdump_viewer.erl +++ b/lib/observer/src/crashdump_viewer.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2013. All Rights Reserved. +%% Copyright Ericsson AB 2003-2014. 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 @@ -1576,7 +1576,13 @@ get_nodeinfo(Fd,Nod) -> "Controller" -> get_nodeinfo(Fd,Nod#nod{controller=val(Fd)}); "Creation" -> - get_nodeinfo(Fd,Nod#nod{creation=list_to_integer(val(Fd))}); + %% Throwing away elements like "(refc=1)", which might be + %% printed from a debug compiled emulator. + Creations = lists:flatmap(fun(C) -> try [list_to_integer(C)] + catch error:badarg -> [] + end + end, string:tokens(val(Fd)," ")), + get_nodeinfo(Fd,Nod#nod{creation={creations,Creations}}); "Remote link" -> Procs = val(Fd), % e.g. "<0.31.0> <4322.54.0>" {Local,Remote} = split(Procs), @@ -2559,11 +2565,11 @@ progress_pmap(Report,File,Fun,List) -> {L1,L2} = if length(L)>=NPerProc -> lists:split(NPerProc,L); true -> {L,[]} % last chunk end, - P = spawn( + {P,_Ref} = + spawn_monitor( fun() -> progress_map(Collector,ReportInterval,File,Fun,L1) end), - erlang:monitor(process,P), {L2,[P|Ps]} end, {List,[]}, diff --git a/lib/observer/src/observer.app.src b/lib/observer/src/observer.app.src index f14f0ee849..97a54cd6f9 100644 --- a/lib/observer/src/observer.app.src +++ b/lib/observer/src/observer.app.src @@ -60,6 +60,9 @@ ttb_et]}, {registered, []}, {applications, [kernel, stdlib]}, - {env, []}]}. + {env, []}, + {runtime_dependencies, ["wx-1.2","stdlib-2.0","runtime_tools-1.8.14", + "kernel-3.0","inets-5.10","et-1.5", + "erts-6.0"]}]}. diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index cedaf7d2b8..34c7b127ff 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -249,6 +249,8 @@ to_str({func, {F,A}}) when is_atom(F), is_integer(A) -> lists:concat([F, "/", A]); to_str({func, {F,'_'}}) when is_atom(F) -> atom_to_list(F); +to_str({{format,Fun},Value}) when is_function(Fun) -> + Fun(Value); to_str({A, B}) when is_atom(A), is_atom(B) -> lists:concat([A, ":", B]); to_str({M,F,A}) when is_atom(M), is_atom(F), is_integer(A) -> diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl index 7a582436b4..f6e7d18f65 100644 --- a/lib/observer/test/crashdump_viewer_SUITE.erl +++ b/lib/observer/test/crashdump_viewer_SUITE.erl @@ -120,27 +120,63 @@ start_stop(Config) when is_list(Config) -> Dump = hd(?config(dumps,Config)), timer:sleep(1000), - ProcsBefore = length(processes()), + ProcsBefore = processes(), + NumProcsBefore = length(ProcsBefore), ok = crashdump_viewer:start(Dump), - true = is_pid(whereis(crashdump_viewer_server)), - true = is_pid(whereis(cdv_wx)), - true = is_pid(whereis(cdv_proc_cb)), - true = is_pid(whereis(cdv_port_cb)), - true = is_pid(whereis(cdv_ets_cb)), - true = is_pid(whereis(cdv_timer_cb)), - true = is_pid(whereis(cdv_fun_cb)), - true = is_pid(whereis(cdv_atom_cb)), - true = is_pid(whereis(cdv_dist_cb)), - true = is_pid(whereis(cdv_mod_cb)), + ExpectedRegistered = [crashdump_viewer_server, + cdv_wx, + cdv_proc_cb, + cdv_proc_cb__holder, + cdv_port_cb, + cdv_port_cb__holder, + cdv_ets_cb, + cdv_ets_cb__holder, + cdv_timer_cb, + cdv_timer_cb__holder, + cdv_fun_cb, + cdv_fun_cb__holder, + cdv_atom_cb, + cdv_atom_cb__holder, + cdv_dist_cb, + cdv_dist_cb__holder, + cdv_mod_cb, + cdv_mod_cb__holder], + Regs=[begin + P=whereis(N), + {P,N,erlang:monitor(process,P)} + end || N <- ExpectedRegistered], + ct:log("CDV procs: ~n~p~n",[Regs]), + [true=is_pid(P) || {P,_,_} <- Regs], timer:sleep(5000), % give some time to live ok = crashdump_viewer:stop(), - timer:sleep(1000), % give some time to stop - undefined = whereis(crashdump_viewer_server), - undefined = whereis(cdv_wx), - ProcsAfter=length(processes()), - ProcsAfter=ProcsBefore, + recv_downs(Regs), + timer:sleep(2000), + ProcsAfter = processes(), + NumProcsAfter = length(ProcsAfter), + if NumProcsAfter=/=NumProcsBefore -> + ct:log("Before but not after:~n~p~n", + [[{P,process_info(P)} || P <- ProcsBefore -- ProcsAfter]]), + ct:log("After but not before:~n~p~n", + [[{P,process_info(P)} || P <- ProcsAfter -- ProcsBefore]]), + ct:fail("leaking processes"); + true -> + ok + end, ok. +recv_downs([]) -> + ok; +recv_downs(Regs) -> + receive + {'DOWN',Ref,process,_Pid,_} -> + ct:log("Got 'DOWN' for process ~n~p~n",[_Pid]), + recv_downs(lists:keydelete(Ref,3,Regs)) + after 30000 -> + ct:log("Timeout waiting for down:~n~p~n", + [[{Reg,process_info(P)} || {P,_,_}=Reg <- Regs]]), + ct:log("Message queue:~n~p~n",[process_info(self(),messages)]) + end. + %% Try to load nonexisting file non_existing(Config) when is_list(Config) -> ExpectedReason = "non-existing-file is not an Erlang crash dump\n", @@ -428,8 +464,10 @@ do_create_dumps(DataDir,Rel) -> end. -%% Create a dump which has two visible nodes, one hidden and one +%% Create a dump which has three visible nodes, one hidden and one %% not connected node, and with monitors and links between nodes. +%% One of the visible nodes is stopped and started again in order to +%% get multiple creations. full_dist_dump(DataDir,Rel) -> Opt = rel_opt(Rel), Pz = "-pz \"" ++ filename:dirname(code:which(?MODULE)) ++ "\"", @@ -450,6 +488,15 @@ full_dist_dump(DataDir,Rel) -> get_response(P4), get_response(P1), + %% start, stop and start a node in order to get multiple 'creations' + {ok,N5} = ?t:start_node(n5,peer,Opt ++ PzOpt), + P51 = rpc:call(N5,?helper_mod,remote_proc,[P1,Creator]), + get_response(P51), + ?t:stop_node(N5), + {ok,N5} = ?t:start_node(n5,peer,Opt ++ PzOpt), + P52 = rpc:call(N5,?helper_mod,remote_proc,[P1,Creator]), + get_response(P52), + {aaaaaaaa,N1} ! {hello,from,other,node}, % distribution message ?t:stop_node(N3), @@ -458,6 +505,7 @@ full_dist_dump(DataDir,Rel) -> ?t:stop_node(N2), ?t:stop_node(N4), + ?t:stop_node(N5), CD. get_response(P) -> diff --git a/lib/observer/vsn.mk b/lib/observer/vsn.mk index f48809a839..a6300eeb18 100644 --- a/lib/observer/vsn.mk +++ b/lib/observer/vsn.mk @@ -1 +1 @@ -OBSERVER_VSN = 1.3.1.2 +OBSERVER_VSN = 2.0 diff --git a/lib/odbc/aclocal.m4 b/lib/odbc/aclocal.m4 index 46b30a16b3..2b47f7c4bc 100644 --- a/lib/odbc/aclocal.m4 +++ b/lib/odbc/aclocal.m4 @@ -74,6 +74,21 @@ AC_ARG_VAR(erl_xcomp_clock_gettime_cpu_time, [clock_gettime() can be used for re AC_ARG_VAR(erl_xcomp_after_morecore_hook, [__after_morecore_hook can track malloc()s core memory usage: yes|no (only used when cross compiling)]) AC_ARG_VAR(erl_xcomp_dlsym_brk_wrappers, [dlsym(RTLD_NEXT, _) brk wrappers can track malloc()s core memory usage: yes|no (only used when cross compiling)]) +dnl Cross compilation variables for OSE +AC_ARG_VAR(erl_xcomp_ose_ldflags_pass1, [Linker flags for the OSE module (pass 1) (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_ldflags_pass2, [Linker flags for the OSE module (pass 2) (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_OSEROOT, [OSE installation root directory (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_STRIP, [Strip utility shipped with the OSE distribution(only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_POST_LINK, [OSE postlink tool (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_SET_CONF, [Sets the configuration for an OSE load module (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_ELF_SIZE, [Prints the section size information for an OSE load module (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_LCF, [OSE load module linker configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_BEAM_LM_CONF, [BEAM OSE load module default configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_EPMD_LM_CONF, [EPMD OSE load module default configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_RUN_ERL_LM_CONF, [run_erl_lm OSE load module default configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_CONFD, [OSE confd source file]) +AC_ARG_VAR(erl_xcomp_ose_CRT0_LM, [OSE crt0 lm source file]) + ]) AC_DEFUN(ERL_XCOMP_SYSROOT_INIT, @@ -488,6 +503,8 @@ AC_CACHE_VAL(ac_cv_sys_ipv6_support, #ifdef __WIN32__ #include <winsock2.h> #include <ws2tcpip.h> +#elif __OSE__ +#error "no ipv6" #else #include <netinet/in.h> #endif], @@ -500,6 +517,8 @@ else #ifdef __WIN32__ #include <winsock2.h> #include <ws2tcpip.h> +#elif __OSE__ +#error "no ipv6" #else #include <netinet/in.h> #endif], @@ -728,6 +747,12 @@ if test "X$host_os" = "Xwin32"; then THR_LIBS= THR_LIB_NAME=win32_threads THR_LIB_TYPE=win32_threads +elif test "X$host_os" = "Xose"; then + AC_MSG_RESULT(yes) + THR_DEFS="-DOSE_THREADS" + THR_LIBS= + THR_LIB_NAME=ose_threads + THR_LIB_TYPE=ose_threads else AC_MSG_RESULT(no) THR_DEFS= @@ -1078,9 +1103,22 @@ case "$THR_LIB_NAME" in test "$ethr_have_native_atomics" = "yes" && ethr_have_native_spinlock=yes ;; - pthread) - ETHR_THR_LIB_BASE_DIR=pthread - AC_DEFINE(ETHR_PTHREADS, 1, [Define if you have pthreads]) + pthread|ose_threads) + case "$THR_LIB_NAME" in + pthread) + ETHR_THR_LIB_BASE_DIR=pthread + AC_DEFINE(ETHR_PTHREADS, 1, [Define if you have pthreads]) + ;; + ose_threads) + AC_DEFINE(ETHR_OSE_THREADS, 1, + [Define if you have OSE style threads]) + ETHR_THR_LIB_BASE_DIR=ose + AC_CHECK_HEADER(ose_spi/ose_spi.h, + AC_DEFINE(HAVE_OSE_SPI_H, 1, + [Define if you have the "ose_spi/ose_spi.h" header file.])) + ;; + esac + if test "x$THR_LIB_NAME" == "xpthread"; then case $host_os in openbsd*) # The default stack size is insufficient for our needs @@ -1139,6 +1177,7 @@ case "$THR_LIB_NAME" in *) ;; esac + fi dnl We sometimes need ETHR_DEFS in order to find certain headers dnl (at least for pthread.h on osf1). saved_cppflags="$CPPFLAGS" @@ -1151,7 +1190,6 @@ case "$THR_LIB_NAME" in dnl dnl Check for headers dnl - AC_CHECK_HEADER(pthread.h, \ AC_DEFINE(ETHR_HAVE_PTHREAD_H, 1, \ [Define if you have the <pthread.h> header file.])) @@ -1184,7 +1222,7 @@ case "$THR_LIB_NAME" in dnl dnl Check for functions dnl - + if test "x$THR_LIB_NAME" == "xpthread"; then AC_CHECK_FUNC(pthread_spin_lock, \ [ethr_have_native_spinlock=yes \ AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \ @@ -1311,6 +1349,8 @@ case "$THR_LIB_NAME" in AC_MSG_RESULT([$linux_futex]) test $linux_futex = yes && AC_DEFINE(ETHR_HAVE_LINUX_FUTEX, 1, [Define if you have a linux futex implementation.]) + fi + AC_CHECK_SIZEOF(int) AC_CHECK_SIZEOF(long) AC_CHECK_SIZEOF(long long) diff --git a/lib/odbc/src/odbc.app.src b/lib/odbc/src/odbc.app.src index 5229b28c08..b2c5775de2 100644 --- a/lib/odbc/src/odbc.app.src +++ b/lib/odbc/src/odbc.app.src @@ -11,5 +11,6 @@ ]}, {applications, [kernel, stdlib]}, {env,[]}, - {mod, {odbc_app, []}}]}. + {mod, {odbc_app, []}}, + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0"]}]}. diff --git a/lib/odbc/vsn.mk b/lib/odbc/vsn.mk index d9e2ab26a9..1af4751248 100644 --- a/lib/odbc/vsn.mk +++ b/lib/odbc/vsn.mk @@ -1 +1 @@ -ODBC_VSN = 2.10.19 +ODBC_VSN = 2.10.20 diff --git a/lib/orber/src/orber.app.src b/lib/orber/src/orber.app.src index 88df4162b6..30bd90347d 100644 --- a/lib/orber/src/orber.app.src +++ b/lib/orber/src/orber.app.src @@ -103,7 +103,9 @@ orber_iiop_pm, orber_env]}, {applications, [stdlib, kernel, mnesia]}, {env, []}, - {mod, {orber, []}} + {mod, {orber, []}}, + {runtime_dependencies, ["stdlib-2.0","ssl-5.3.4","mnesia-4.12","kernel-3.0", + "inets-5.10","erts-6.0"]} ]}. diff --git a/lib/orber/vsn.mk b/lib/orber/vsn.mk index 7bbebc65dc..3ea64b1ff6 100644 --- a/lib/orber/vsn.mk +++ b/lib/orber/vsn.mk @@ -1,2 +1,2 @@ -ORBER_VSN = 3.6.26.1 +ORBER_VSN = 3.6.27 diff --git a/lib/os_mon/c_src/memsup.c b/lib/os_mon/c_src/memsup.c index b5114d10ed..409db84aa7 100644 --- a/lib/os_mon/c_src/memsup.c +++ b/lib/os_mon/c_src/memsup.c @@ -324,7 +324,7 @@ get_mem_procfs(memory_ext *me){ /* arch specific functions */ -#if defined(__linux__) /* ifdef SYSINFO */ +#if defined(__linux__) && !defined(__ANDROID__)/* ifdef SYSINFO */ /* sysinfo does not include cached memory which is a problem. */ static int get_extended_mem_sysinfo(memory_ext *me) { @@ -395,8 +395,12 @@ get_extended_mem_sgi(memory_ext *me) { static void get_extended_mem(memory_ext *me) { +/* android */ +#if defined(__ANDROID__) + if (get_mem_procfs(me)) return; + /* linux */ -#if defined(__linux__) +#elif defined(__linux__) if (get_mem_procfs(me)) return; if (get_extended_mem_sysinfo(me)) return; diff --git a/lib/os_mon/src/os_mon.app.src b/lib/os_mon/src/os_mon.app.src index 15bbd2663c..cc08cebe3d 100644 --- a/lib/os_mon/src/os_mon.app.src +++ b/lib/os_mon/src/os_mon.app.src @@ -29,4 +29,7 @@ {start_disksup, true}, {start_memsup, true}, {start_os_sup, false}]}, - {mod, {os_mon, []}}]}. + {mod, {os_mon, []}}, + {runtime_dependencies, ["stdlib-2.0","snmp-4.25.1","sasl-2.4", + "otp_mibs-1.0.9","mnesia-4.12","kernel-3.0", + "erts-6.0"]}]}. diff --git a/lib/os_mon/test/cpu_sup_SUITE.erl b/lib/os_mon/test/cpu_sup_SUITE.erl index e0382cb0c7..9f58e043db 100644 --- a/lib/os_mon/test/cpu_sup_SUITE.erl +++ b/lib/os_mon/test/cpu_sup_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2011. All Rights Reserved. +%% Copyright Ericsson AB 2002-2014. 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 @@ -257,8 +257,8 @@ port(Config) when is_list(Config) -> terminate(suite) -> []; terminate(Config) when is_list(Config) -> - ?line ok = application:set_env(os_mon, start_cpu_sup, false), - ?line ok = supervisor:terminate_child(os_mon_sup, cpu_sup), + ok = application:set_env(os_mon, start_cpu_sup, false), + _ = supervisor:terminate_child(os_mon_sup, cpu_sup), ok. unavailable(suite) -> diff --git a/lib/os_mon/test/disksup_SUITE.erl b/lib/os_mon/test/disksup_SUITE.erl index 9c65d8b692..94661cfa77 100644 --- a/lib/os_mon/test/disksup_SUITE.erl +++ b/lib/os_mon/test/disksup_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -350,15 +350,16 @@ otp_5910(doc) -> otp_5910(Config) when is_list(Config) -> %% Make sure disksup sets at least one alarm - Data = disksup:get_disk_data(), + Data = lists:sort(disksup:get_disk_data()), Threshold0 = disksup:get_almost_full_threshold(), Threshold = case over_threshold(Data, Threshold0) of - 0 -> - [{_Id,_Kbyte,Cap}|_] = Data, - ok = disksup:set_almost_full_threshold((Cap-1)/100), - Cap-1; - _N -> Threshold0 - end, + 0 -> + [{_Id,_Kbyte,Cap}|_] = Data, + io:format("Data ~p Threshold ~p ~n",[Data, Cap-1]), + ok = disksup:set_almost_full_threshold((Cap-1)/100), + Cap-1; + _N -> Threshold0 + end, ok = application:set_env(os_mon, disk_almost_full_threshold, Threshold/100), disksup ! timeout, % force a disk check Data2 = disksup:get_disk_data(), diff --git a/lib/os_mon/vsn.mk b/lib/os_mon/vsn.mk index e9e90729f2..74397c2bc6 100644 --- a/lib/os_mon/vsn.mk +++ b/lib/os_mon/vsn.mk @@ -1 +1 @@ -OS_MON_VSN = 2.2.14 +OS_MON_VSN = 2.2.15 diff --git a/lib/ose/Makefile b/lib/ose/Makefile new file mode 100644 index 0000000000..2959f04c3e --- /dev/null +++ b/lib/ose/Makefile @@ -0,0 +1,36 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1996-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% +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# +# Macros +# + +SUB_DIRECTORIES = src doc/src + +include vsn.mk +VSN = $(OSE_VSN) + +SPECIAL_TARGETS = + +# +# Default Subdir Targets +# +include $(ERL_TOP)/make/otp_subdir.mk diff --git a/lib/ose/doc/html/.gitignore b/lib/ose/doc/html/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/ose/doc/html/.gitignore diff --git a/lib/ose/doc/man3/.gitignore b/lib/ose/doc/man3/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/ose/doc/man3/.gitignore diff --git a/lib/ose/doc/man6/.gitignore b/lib/ose/doc/man6/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/ose/doc/man6/.gitignore diff --git a/lib/ose/doc/pdf/.gitignore b/lib/ose/doc/pdf/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/ose/doc/pdf/.gitignore diff --git a/lib/ose/doc/src/.gitignore b/lib/ose/doc/src/.gitignore new file mode 100644 index 0000000000..860e9e703e --- /dev/null +++ b/lib/ose/doc/src/.gitignore @@ -0,0 +1 @@ +ose.xml diff --git a/lib/ose/doc/src/Makefile b/lib/ose/doc/src/Makefile new file mode 100644 index 0000000000..dd58029064 --- /dev/null +++ b/lib/ose/doc/src/Makefile @@ -0,0 +1,132 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2012. 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% +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../../vsn.mk +VSN=$(OSE_VSN) +APPLICATION=ose + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) + +# ---------------------------------------------------- +# Help application directory specification +# ---------------------------------------------------- +EDOC_DIR = $(ERL_TOP)/lib/edoc +SYNTAX_TOOLS_DIR = $(ERL_TOP)/lib/syntax_tools + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- +XML_APPLICATION_FILES = ref_man.xml + +XML_REF3_FILES = \ + ose.xml \ + ose_erl_driver.xml + +XML_REF6_FILES = ose_app.xml + +XML_PART_FILES = part.xml +XML_CHAPTER_FILES = notes.xml ose_intro.xml ose_signals_chapter.xml + +BOOK_FILES = book.xml + +XML_FILES = \ + $(BOOK_FILES) $(XML_CHAPTER_FILES) \ + $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_REF6_FILES) \ + $(XML_APPLICATION_FILES) + +# ---------------------------------------------------- + +HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ + $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) + +INFO_FILE = ../../info + +MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) +MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) + +HTML_REF_MAN_FILE = $(HTMLDIR)/index.html + +TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf + +SPECS_FILES = + +TOP_SPECS_FILE = + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +XML_FLAGS += + +SPECS_FLAGS = -I../../include -I../../../kernel/include + +OSE_SRC_DIR = ../../src + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- +docs: man pdf html + +$(TOP_PDF_FILE): $(XML_FILES) + +pdf: $(TOP_PDF_FILE) + +html: $(HTML_REF_MAN_FILE) + +man: $(MAN3_FILES) $(MAN6_FILES) + +ose.xml: $(OSE_SRC_DIR)/ose.erl + escript $(DOCGEN)/priv/bin/xml_from_edoc.escript\ + $(OSE_SRC_DIR)/$(@:%.xml=%.erl) + +debug opt: + +clean clean_docs: + rm -rf $(HTMLDIR)/* + rm -f $(MAN3DIR)/* + rm -f $(MAN6DIR)/* + rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) + rm -f $(SPECDIR)/* + rm -f errs core *~ + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_docs_spec: docs + $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" + $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" + $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" + $(INSTALL_DATA) $(HTMLDIR)/* \ + "$(RELSYSDIR)/doc/html" + $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" + $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" + $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" + $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6" + $(INSTALL_DATA) $(MAN6_FILES) "$(RELEASE_PATH)/man/man6" + +release_spec: diff --git a/lib/ose/doc/src/book.xml b/lib/ose/doc/src/book.xml new file mode 100644 index 0000000000..485806e05b --- /dev/null +++ b/lib/ose/doc/src/book.xml @@ -0,0 +1,48 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE book SYSTEM "book.dtd"> + +<book xmlns:xi="http://www.w3.org/2001/XInclude"> + <header titlestyle="normal"> + <copyright> + <year>2014</year><year>2014</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + 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. + + </legalnotice> + + <title>OSE</title> + <prepared>Lukas Larsson</prepared> + <docno></docno> + <date>2014-01-08</date> + <rev>1.0</rev> + <file>book.xml</file> + </header> + <insidecover> + </insidecover> + <pagetext>OSE</pagetext> + <preamble> + <contents level="2"></contents> + </preamble> + <parts> + <xi:include href="part.xml"/> + </parts> + <applications> + <xi:include href="ref_man.xml"/> + </applications> + <releasenotes> + <xi:include href="notes.xml"/> + </releasenotes> + <listofterms></listofterms> + <index></index> +</book> diff --git a/lib/ose/doc/src/notes.xml b/lib/ose/doc/src/notes.xml new file mode 100644 index 0000000000..760b92feed --- /dev/null +++ b/lib/ose/doc/src/notes.xml @@ -0,0 +1,33 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2014</year><year>2014</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + 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. + + </legalnotice> + + <title>OSE Release Notes</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> + <file>notes.xml</file> + </header> + <p>This document describes the changes made to the OSE application.</p> + +</chapter> diff --git a/lib/ose/doc/src/ose_app.xml b/lib/ose/doc/src/ose_app.xml new file mode 100644 index 0000000000..e40656fd7b --- /dev/null +++ b/lib/ose/doc/src/ose_app.xml @@ -0,0 +1,37 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE appref SYSTEM "appref.dtd"> + +<appref> + <header> + <copyright> + <year>2014</year><year>2014</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + 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. + + </legalnotice> + + <title>Enea OSE</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> + </header> + <app>ose</app> + <appsummary>The OSE Application</appsummary> + <description> + <p>The OSE application contains modules and documentation that only + applies when running Erlang/OTP on Enea OSE.</p> + </description> + +</appref> diff --git a/lib/ose/doc/src/ose_erl_driver.xml b/lib/ose/doc/src/ose_erl_driver.xml new file mode 100644 index 0000000000..1d89d7aeea --- /dev/null +++ b/lib/ose/doc/src/ose_erl_driver.xml @@ -0,0 +1,110 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE cref SYSTEM "cref.dtd"> + +<cref> + <header> + <copyright> + <year>2013</year><year>2014</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + 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. + + </legalnotice> + + <title>erl_driver for Enea OSE</title> + <prepared>Lukas Larsson</prepared> + <docno></docno> + <date>2014-01-08</date> + <rev>A</rev> + <file>ose_erl_driver.xml</file> + </header> + <lib>ose_erl_driver</lib> + <libsummary>Linked-in drivers in Enea OSE</libsummary> + <description> + <p>Writing Linked-in drivers that also work on Enea OSE is very similar for + how you would do it for Unix. The difference from Unix is that + driver_select, ready_input and ready_output all work with signals + instead of file descriptors. This means that the driver_select is + used to specify which type of signal should trigger calls to + ready_input/ready_output. The functions described below are available + to driver programmers on Enea OSE to facilitate this. + </p> + </description> + <section> + <title>DATA TYPES</title> + + <taglist> + <tag><marker id="union_SIGNAL"/>union SIGNAL</tag> + <item>See the Enea OSE SPI documentation for a description.</item> + <tag><marker id="SIGSELECT"/>SIGSELECT</tag> + <item>See the Enea OSE SPI documentation for a description.</item> + <tag><marker id="ErlDrvEvent"/>ErlDrvEvent</tag> + <item>The <c>ErlDrvEvent</c> is a handle to a signal number and id combination. It is passed to <seealso marker="erts:erl_driver#driver_select">driver_select(3)</seealso>.</item> + <tag><marker id="ErlDrvOseEventId"/>ErlDrvOseEventId</tag> + <item>This is the id used to associate a specific signal to a + certain driver instance. </item> + </taglist> + </section> + <funcs> + <func> + <name><ret>union SIGNAL *</ret><nametext>erl_drv_ose_get_signal(ErlDrvEvent drv_event)</nametext></name> + <desc> + <marker id="erl_drv_ose_get_signal"></marker> + <p>Fetch the next signal associated with <c>drv_event</c>. + Signals will be returned in the order which they were received and + when no more signals are available <c>NULL</c> will be returned. + Use this function in the ready_input/ready_output callbacks + to get signals.</p> + </desc> + </func> + <func> + <name><ret>ErlDrvEvent</ret><nametext>erl_drv_ose_event_alloc(SIGSELECT signo, ErlDrvOseEventId id, ErlDrvOseEventId (*resolve_signal)(union SIGNAL* sig), void *extra)</nametext></name> + <desc> + <marker id="erl_drv_ose_event_alloc"></marker> + <p>Create a new <c>ErlDrvEvent</c> associated with <c>signo</c>, + <c>id</c> and uses the <c>resolve_signal</c> function to extract + the <c>id</c> from a signal with <c>signo</c>. The <c>extra</c> + parameter can be used for additional data. See + <seealso marker="ose_signals_chapter#driver"> + Signals in a Linked-in driver</seealso> in the OSE User's Guide. + </p> + </desc> + </func> + <func> + <name><ret>void</ret><nametext>erl_drv_ose_event_free(ErlDrvEvent drv_event)</nametext></name> + <desc> + <marker id="erl_drv_ose_event_free"></marker> + <p>Free a <c>ErlDrvEvent</c>. This should always be done in the + <seealso marker="erts:driver_entry#stop_select">stop_select</seealso> + callback when the event is no longer being used.</p> + </desc> + </func> + <func> + <name><ret>void</ret><nametext>erl_drv_ose_event_fetch(ErlDrvEvent drv_event, SIGSELECT *signo, ErlDrvOseEventId *id, void **extra)</nametext></name> + <desc> + <marker id="erl_drv_ose_event_fetch"></marker> + <p>Write the signal number, id and any extra data associated with <c>drv_event</c> + into <c>*signo</c> and <c>*id</c> respectively. <c>NULL</c> can be + also passed as <c>signo</c> or <c>id</c> in order to ignore that field. + </p> + </desc> + </func> + </funcs> + <section> + <title>SEE ALSO</title> + <p> + <seealso marker="erts:driver_entry">driver_entry(3)</seealso>, + <seealso marker="erts:erl_driver">erl_driver(3)</seealso> + </p> + </section> +</cref> diff --git a/lib/ose/doc/src/ose_intro.xml b/lib/ose/doc/src/ose_intro.xml new file mode 100644 index 0000000000..b5e3ef8b33 --- /dev/null +++ b/lib/ose/doc/src/ose_intro.xml @@ -0,0 +1,153 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2013</year><year>2014</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + 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. + + </legalnotice> + + <title>Introduction</title> + <prepared>Lukas Larsson</prepared> + <docno></docno> + <date>2014-01-08</date> + <rev>A</rev> + <file>ose_intro.xml</file> + </header> + + <section> + <title>Features</title> + </section> + + <section> + <title>Starting Erlang/OTP</title> + <p> + Starting Erlang/OTP on OSE is not as simple as on Unix/Windows (yet). + First of all you have to explicitly use the beam (or beam.smp) executables + found in erts-X.Y.Z/bin as the load module that you run. This in turn + means that you have to supply the raw beam arguments to the emulator + when starting. Fortunately <c>erl</c> on Unix/Windows has a + undocumented flag called <c>-emu_args_exit</c> that can be used to + figure out what the arguments to beam look like. For example:</p> + <code># erl +Mut false +A 10 +S 4:4 +Muycs256 +P 2096 +Q 2096 -emu_args_exit +-Mut +false +-A +10 +-S +4:4 +-Muycs256 +-P +2096 +-Q +2096 +-- +-root +/usr/local/lib/erlang +-progname +erl +-- +-home +/home/erlang +--</code> + <p> + The arguments are printed on seperate lines to make it possible to know + what has to be quoted with ". Each line is one quotable unit. + So taking the arguments above you can supply them to pm_create or + just execute directly on the command line. For example:</p> + <code>rtose@acp3400> pm_install erlang /mst/erlang/erts-6.0/bin/beam.smp +rtose@acp3400> pm_create -c ARGV="-Mut false -A 10 -S 4:4 -Muycs256 -P 2096 -Q 2099 -- -root /mst/erlang -progname erl -- -home /mst/erlang --" erlang +pid: 0x110059 +rtose@acp3400> pm_start 0x110059</code> + <p> + Also note that since we are running erl to figure out the arguments on a + seperate machine the paths have to be updated. In the example above + <c>/usr/local/lib/erlang</c> was replaced by <c>/mst/erlang/</c>. The + goal is to in future releases not have to do the special argument handling + but for now (OTP 17.0) you have to do it. + </p> + <note> + Because of a limitation in the way the OSE handles stdio when starting + load modules using pm_install/create the Erlang shell only reads every + other command from stdin. However if you start Erlang using run_erl + you do not have this problem. So it is highly recommended that you + start Erlang using run_erl. + </note> + </section> + + <section> + <title>run_erl and to_erl</title> + <p> + In OSE run_erl and to_erl are combined into a single load module called + run_erl_lm. Installing and starting the load module will add two new + shell commands called run_erl and to_erl. They work in exactly the same + way as the unix variants of run_erl and to_erl, except that the read + and write pipes have to be placed under the /pipe vm. One additional + option also exists to run_erl on ose: + <taglist> + <tag><c>-block Name</c></tag> + <item>The name of the install handle and block that will be created/used by + installing and exectuting the first part of the command. If nothing + if given the basename of the load module will be used for this value. + Example: + <code>pm_install erlang /path/to/erlang/vm/beam.smp +run_erl -daemon -block erlang /pipe/ /mst/erlang_logs/ "beam.smp -A 1 -- -root /mst/erlang -- -home /mst --"</code> + </item> + </taglist> + The same argument munching as when starting Erlang/OTP without run_erl + has to be done. If <c>-daemon</c> is given then all error printouts + are sent to the ramlog. + See also + <seealso marker="erts:run_erl">run_erl</seealso> for more details. + </p> + <p> + Below is an example of how to get started with <c>run_erl_lm</c>. + <code>rtose@acp3400> pm_install run_erl_lm /mst/erlang/erts-6.0/bin/run_erl_lm +rtose@acp3400> pm_create run_erl_lm +pid: 0x1c005d +rtose@acp3400> pm_start 0x1c005d +rtose@acp3400> mkdir /mst/erlang_log +rtose@acp3400> run_erl -daemon /pipe/ /mst/erlang_log/ "/mst/erlang/erts-6.0/bin/beam.smp -A 1 -- -root /mst/erlang -- -home /mst --" +rtose@acp3400> to_erl +Attaching to /pipe/erlang.pipe.1 (^C to exit) +os:type(). +{ose,release} +2> +'to_erl' terminated.</code> + Note that Ctrl-C is used instead of Ctrl-D to exit the to_erl shell. + </p> + </section> + + <section> + <title>epmd</title> + <p> + In OSE epmd will not be started automatically so if you want to use + Erlang distribution you have to manually start epmd. + </p> + </section> + + <section> + <title>VM Process Priorities</title> + <p> + It is possible to set the priorities you want for the OSE processes that + thr emulator creates in the lmconf. An example of how to do it can be + found in the default lmconf file in + $ERL_TOP/erts/emulator/sys/ose/beam.lmconf. + </p> + </section> + +</chapter> diff --git a/lib/ose/doc/src/ose_signals_chapter.xml b/lib/ose/doc/src/ose_signals_chapter.xml new file mode 100644 index 0000000000..ff501777cc --- /dev/null +++ b/lib/ose/doc/src/ose_signals_chapter.xml @@ -0,0 +1,239 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2013</year><year>2014</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + 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. + + </legalnotice> + + <title>Interacting with Enea OSE</title> + <prepared>Lukas Larsson</prepared> + <docno></docno> + <date>2014-01-08</date> + <rev>A</rev> + <file>ose_signals_chapter.xml</file> + </header> + + <marker id="introduction"></marker> + <section> + <title>Introduction</title> + <p>The main way which programs on Enea OSE interact is through the + usage of message passing, much the same way as Erlang processes + communicate. There are two ways in which an Erlang programmer can + interact with the signals sent from other Enea OSE processes; either + through the provided <c>ose</c> module, or by writing a custom linked-in + driver. This User's Guide describes and provides examples for both + approaches. + </p> + </section> + + <marker id="erlang"></marker> + <section> + <title>Signals in Erlang</title> + <p>Erlang/OTP on OSE provides a erlang module called + <seealso marker="ose:ose">ose</seealso> that can be used to interact + with other OSE processes using message passing. The api in the module + is very similar to the native OSE api, so for details of how the + functions work please refer to the official OSE documenation. Below + is an example usage of the API. + </p> + <code>1> P1 = ose:open("p1"). +#Port>0.344> +2> ose:hunt(P1,"p2"). +{#Port>0.344>,1} +3> P2 = ose:open("p2"). +#Port>0.355> +4> flush(). +Shell got {mailbox_up,#Port>0.344>,{#Port>0.344>,1},852189} +ok +5> ose:listen(P1,[1234]). +ok +6> ose:send(P2,ose:get_id(P1),1234,>>"hello">>). +ok +7> flush(). +Shell got {message,#Port>0.344>,{852189,1245316,1234,>>"hello">>}} +ok</code> + </section> + + <marker id="driver"></marker> + <section> + <title>Signals in a Linked-in driver</title> + <p> + Writing Linked-in drivers for OSE is very similar to how it is done + for Unix/Windows. It is only the way in which the driver subscribes + and consumed external events that is different. In Unix (and Windows) + file descriptiors (and Event Objects) are used to select on. On OSE + we use signals to deliver the same functionality. There are two large + differences between a signal and an fd. + </p> + <p> + In OSE it is not possible for a signal number to be a unique identifier + for a resource in the same way as an fd is. For example; let's say we + implement a driver that does an asynchronous hunt that uses signal + number 1234 as the hunt_sig. If we want to be able to have multiple + hunt ports running at the same time we have to have someway of routing + the signal to the correct port. This is achieved by supplying a secondary + id that can be retrieved through the meta-data or payload of the signal, + e.g: + <code>ErlDrvEvent event = erl_drv_ose_event_alloc(1234,port,resolver);</code> + The event you get back from + <seealso marker="ose_erl_driver#erl_drv_ose_event_alloc"> + erl_drv_ose_event_alloc</seealso> can then be used by + <seealso marker="erts:erl_driver#driver_select">driver_select</seealso> + to subscribe to signals. The first argument is just the signal number + that we are interested in. The second is the id that we choose to use, + in this case the port id that we got in the + <seealso marker="erts:driver_entry#start">start</seealso> callback is + used. The third argument is a function pointer to a function that can + be used to figure out the id from a given signal. The fourth argument can + point to any additional data you might want to associate with the event. + There is a complete. You can examine the data contained in the event with + <seealso marker="ose_erl_driver#erl_drv_ose_event_fetch">erl_drv_ose_event_fetch</seealso> + , eg: + <code>erl_drv_ose_event_fetch(event, &signal, &port, (void **)&extra);</code> + example of what this could look like in + <seealso marker="#example">the next section</seealso>. + <note>It is very important to issue the driver_select call before + any of the signals you are interested in are sent. If driver_select + is called after the signal is sent, there is a high probability that it + will be lost.</note> + </p> + <p> + The other difference from unix is that in OSE the payload of the event + (i.e. the signal data) is already received when the ready_output/input + callbacks are called. This means that you access the data of a signal + by calling <seealso marker="ose_erl_driver#erl_drv_ose_get_signal"> + erl_drv_ose_get_signal</seealso>. Additionally multiple signals might be + associated with the event, so you should call + <seealso marker="ose_erl_driver#erl_drv_ose_get_signal"> + erl_drv_ose_get_signal</seealso> until <c>NULL</c> is returned. + </p> + </section> + + <marker id="example"></marker> + <section> + <title>Example Linked-in driver</title> +<code>#include "erl_driver.h" +#include "ose.h" + +struct huntsig { + SIGSELECT signo; + ErlDrvPort port; +}; + +union SIGNAL { + SIGSELECT signo; + struct huntsig; +} + +/* Here we have to get the id from the signal. In this case we use the + port id since we have control over the data structure of the signal. + It is however possible to use anything in here. The only restriction + is that the same id has to be used for all signals of the same number.*/ +ErlDrvOseEventId resolver(union SIGNAL *sig) { + return (ErlDrvOseEventId)sig->huntsig.port; +} + +static int drv_init(void) { return 0; }; + +static ErlDrvData drv_start(ErlDrvPort port, char *command) { + return (ErlDrvData)port; +} + +static ErlDrvSSizeT control(ErlDrvData driver_data, unsigned int cmd, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen) { + ErlDrvPort port = (ErlDrvPort)driver_data; + + /* An example of extra data to associate with the event */ + char *extra_data = driver_alloc(80); + snprintf("extra_data, "Event, sig_no: 1234, and port: %d", port); + + /* Create a new event to select on */ + ErlDrvOseEvent evt = erl_drv_ose_event_alloc(1234,port,resolver, extra_data); + + /* Make sure to do the select call _BEFORE_ the signal arrives. + The signal might get lost if the hunt call is done before the + select. */ + driver_select(port,evt,ERL_DRV_READ|ERL_DRV_USE,1); + + union SIGNAL *sig = alloc(sizeof(union SIGNAL),1234); + sig->huntsig.port = port; + hunt("testprocess",0,NULL,&sig); + return 0; +} + +static void ready_input(ErlDrvData driver_data, ErlDrvEvent evt) { + char *extra_data; + /* Get the first signal payload from the event */ + union SIGNAL *sig = erl_drv_ose_get_signal(evt); + ErlDrvPort port = (ErlDrvPort)driver_data; + while (sig != NULL) { + if (sig->signo == 1234) { + /* Print out the string we added as the extra parameter */ + erl_drv_ose_event_fetch(evt, NULL, NULL, (void **)&extra_data); + printf("We've received: %s\n", extra_data); + + /* If it is our signal we send a message with the sender of the signal + to the controlling erlang process */ + ErlDrvTermData reply[] = { ERL_DRV_UINT, (ErlDrvUInt)sender(&sig) }; + erl_drv_send_term(port,reply,sizeof(reply) / sizeof(reply[0])); + } + + /* Cleanup the signal and deselect on the event. + Note that the event itself has to be free'd in the stop_select + callback. */ + free_buf(&sig); + driver_select(port,evt,ERL_DRV_READ|ERL_DRV_USE,0); + + /* There could be more than one signal waiting in this event, so + we have to loop until sig == NULL */ + sig = erl_drv_ose_get_signal(evt); + } +} + +static void stop_select(ErlDrvEvent event, void *reserved) +{ + /* Free the extra_data */ + erl_drv_ose_event_fetch(evt, NULL, NULL, (void **)&extra_data); + driver_free(extra_data); + + /* Free the event itself */ + erl_drv_ose_event_free(event); +} + +/** + * Setup the driver entry for the Erlang runtime + **/ +ErlDrvEntry ose_signal_driver_entry = { + .init = drv_init, + .start = drv_start, + .stop = drv_stop, + .ready_input = ready_input, + .driver_name = DRIVER_NAME, + .control = control, + .extended_marker = ERL_DRV_EXTENDED_MARKER, + .major_version = ERL_DRV_EXTENDED_MAJOR_VERSION, + .minor_version = ERL_DRV_EXTENDED_MINOR_VERSION, + .driver_flags = ERL_DRV_FLAG_USE_PORT_LOCKING, + .stop_select = stop_select +}; +</code> + </section> + +</chapter> diff --git a/lib/ose/doc/src/part.xml b/lib/ose/doc/src/part.xml new file mode 100644 index 0000000000..250bb11f96 --- /dev/null +++ b/lib/ose/doc/src/part.xml @@ -0,0 +1,38 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE part SYSTEM "part.dtd"> + +<part xmlns:xi="http://www.w3.org/2001/XInclude"> + <header> + <copyright> + <year>2014</year> + <year>2014</year> + <holder>Ericsson AB, All Rights Reserved</holder> + </copyright> + <legalnotice> + 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. + + The Initial Developer of the Original Code is Ericsson AB. + </legalnotice> + + <title>OSE User's Guide</title> + <prepared>Lukas Larsson</prepared> + <docno></docno> + <date>2014-01-08</date> + <rev>1.0</rev> + <file>part.xml</file> + </header> + <description> + <p><em>OSE</em>.</p> + </description> + <xi:include href="ose_intro.xml"/> + <xi:include href="ose_signals_chapter.xml"/> +</part> diff --git a/lib/ose/doc/src/ref_man.xml b/lib/ose/doc/src/ref_man.xml new file mode 100644 index 0000000000..54c1182fcb --- /dev/null +++ b/lib/ose/doc/src/ref_man.xml @@ -0,0 +1,39 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE application SYSTEM "application.dtd"> + +<application xmlns:xi="http://www.w3.org/2001/XInclude"> + <header> + <copyright> + <year>2014</year><year>2014</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + 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. + + </legalnotice> + + <title>OSE Reference Manual</title> + <prepared>Lukas Larsson</prepared> + <docno></docno> + <date>2014-01-08</date> + <rev>1.0</rev> + <file>ref_man.xml</file> + </header> + <description> + <p>The Standard Erlang Libraries application, <em>STDLIB</em>, + contains modules for manipulating lists, strings and files etc.</p> + <br></br> + </description> + <xi:include href="ose_app.xml"/> + <xi:include href="ose.xml"/> + <xi:include href="ose_erl_driver.xml"/> +</application> diff --git a/lib/ose/ebin/.gitignore b/lib/ose/ebin/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/ose/ebin/.gitignore diff --git a/lib/ose/include/.gitignore b/lib/ose/include/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/ose/include/.gitignore diff --git a/lib/ose/info b/lib/ose/info new file mode 100644 index 0000000000..85c07dbe82 --- /dev/null +++ b/lib/ose/info @@ -0,0 +1,2 @@ +group: misc Miscellaneous Applications +short: Description of Enea OSE specific functionality diff --git a/lib/ose/src/Makefile b/lib/ose/src/Makefile new file mode 100644 index 0000000000..88f89578fb --- /dev/null +++ b/lib/ose/src/Makefile @@ -0,0 +1,106 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1996-2013. 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% +# + +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../vsn.mk +VSN=$(OSE_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/ose-$(VSN) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- +MODULES= \ + ose + +HRL_FILES= + +INTERNAL_HRL_FILES= + +ERL_FILES= $(MODULES:%=%.erl) + +TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET) + +APP_FILE= ose.app + +APP_SRC= $(APP_FILE).src +APP_TARGET= $(EBIN)/$(APP_FILE) + +APPUP_FILE= ose.appup + +APPUP_SRC= $(APPUP_FILE).src +APPUP_TARGET= $(EBIN)/$(APPUP_FILE) + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- + +ifeq ($(NATIVE_LIBS_ENABLED),yes) +ERL_COMPILE_FLAGS += +native +endif +ERL_COMPILE_FLAGS += -I../include -I../../kernel/include -Werror + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt: $(TARGET_FILES) + +clean: + rm -f $(TARGET_FILES) + rm -f core + rm -f erl_parse.erl + +docs: + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + +$(APP_TARGET): $(APP_SRC) ../vsn.mk + $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ + +$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk + $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) "$(RELSYSDIR)/src" + $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)/src" + $(INSTALL_DIR) "$(RELSYSDIR)/include" + $(INSTALL_DIR) "$(RELSYSDIR)/ebin" + $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin" + +release_docs_spec: + +# ---------------------------------------------------- +# Dependencies -- alphabetically, please +# ---------------------------------------------------- diff --git a/lib/ose/src/ose.app.src b/lib/ose/src/ose.app.src new file mode 100644 index 0000000000..60699c369b --- /dev/null +++ b/lib/ose/src/ose.app.src @@ -0,0 +1,27 @@ +%% This is an -*- erlang -*- file. +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-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% +%% +{application, ose, + [{description, "Enea OSE specific modules"}, + {vsn, "%VSN%"}, + {modules, [ose]}, + {registered,[]}, + {applications, [stdlib,kernel]}, + {env, []}, + {runtime_dependencies, ["stdlib-2.0","erts-6.0"]}]}. diff --git a/lib/ose/src/ose.appup.src b/lib/ose/src/ose.appup.src new file mode 100644 index 0000000000..6654efde16 --- /dev/null +++ b/lib/ose/src/ose.appup.src @@ -0,0 +1,22 @@ +%% -*- erlang -*- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2013. 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% +{"%VSN%", + [ + ], + [ + ]}. diff --git a/lib/ose/src/ose.erl b/lib/ose/src/ose.erl new file mode 100644 index 0000000000..77f11addf9 --- /dev/null +++ b/lib/ose/src/ose.erl @@ -0,0 +1,452 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. 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% +%% +%% @doc Interface module for OSE messaging and process monitoring from Erlang +%% +%% For each mailbox created through {@link open/1} a OSE phantom process with +%% that name is started. Since phantom processes are used the memory footprint +%% of each mailbox is quite small. +%% +%% To receive messages you first have to subscribe to the specific message +%% numbers that you are interested in with {@link listen/2}. The messages +%% will be sent to the Erlang process that created the mailbox. +%% +%% @end +%% +-module(ose). + +%%============================================================================== +%% Exported API +%%============================================================================== +-export([open/1, + close/1, + get_id/1, + get_name/2, + hunt/2, + dehunt/2, + attach/2, + detach/2, + send/4, + send/5, + listen/2 + ]). + +%%============================================================================== +%% Types +%%============================================================================== +-opaque mailbox() :: port(). +%% Mailbox handle. Implemented as an erlang port. + +-opaque mailbox_id() :: integer(). +%% Mailbox ID, this is the same as the process id of an OSE process. +%% An integer. + +-type message_number() :: 0..4294967295. +%% OSE Signal number + +-opaque hunt_ref() :: {mailbox(),integer()}. +%% Reference from a hunt request. This term will be included +%% in a successful hunt response. + +-opaque attach_ref() :: {mailbox(),integer()}. +%% Reference from an attach request. This term will be included +%% in the term returned when the attached mailbox disappears. + +-export_type([mailbox_id/0, + message_number/0, + mailbox/0, + hunt_ref/0, + attach_ref/0]). + +%%============================================================================== +%% Defines +%%============================================================================== +-define(DRIVER_NAME, "ose_signal_drv"). +-define(GET_SPID, 1). +-define(GET_NAME, 2). +-define(HUNT, 100). +-define(DEHUNT, 101). +-define(ATTACH, 102). +-define(DETACH, 103). +-define(SEND, 104). +-define(SEND_W_S, 105). +-define(LISTEN, 106). +-define(OPEN, 200). + +-define(INT_32BIT(Int),(is_integer(Int) andalso (Int >= 0) andalso (Int < (1 bsl 32)))). + +%%============================================================================== +%% API functions +%%============================================================================== + +%%------------------------------------------------------------------------------ +%% @doc Create a mailbox with the given name and return a port that handles +%% the mailbox. +%% +%% An OSE phantom process with the given name will be created that will send any +%% messages sent through this mailbox. Any messages sent to the new OSE process +%% will automatically be converted to an Erlang message and sent to the Erlang +%% process that calls this function. See {@link listen/2} for details about the +%% format of the message sent. +%% +%% The caller gets linked to the created mailbox. +%% +%% raises: `badarg' | `system_limit' +%% +%% @see listen/2 +%% @end +%%------------------------------------------------------------------------------ +-spec open(Name) -> Port when + Name :: iodata(), + Port :: mailbox(). +open(Name) -> + try open_port({spawn_driver,?DRIVER_NAME}, [binary]) of + Port -> + try port_command(Port,[?OPEN,Name]) of + true -> + receive + {ose_drv_reply,Port,{error,Error}} -> + close(Port), + erlang:error(Error,[Name]); + {ose_drv_reply,Port,ok} -> + Port + end + catch + error:badarg -> close(Port),erlang:error(badarg,[Name]) + end + catch + error:badarg -> erlang:error(badarg,[Name]) + end. + +%%------------------------------------------------------------------------------ +%% @doc Close a mailbox +%% +%% This kills the OSE phantom process associated with this mailbox. +%% +%% Will also consume any ``{'EXIT',Port,_}'' message from the port that comes +%% due to the port closing when the calling process traps exits. +%% +%% raises: `badarg' +%% @end +%%------------------------------------------------------------------------------ +-spec close(Port) -> ok when + Port :: mailbox(). +close(Port) when is_port(Port) -> + %% Copied from prim_inet + case erlang:process_info(self(), trap_exit) of + {trap_exit,true} -> + link(Port), + catch erlang:port_close(Port), + receive {'EXIT',Port,_} -> ok end; + {trap_exit,false} -> + catch erlang:port_close(Port), + ok + end; +close(NotPort) -> + erlang:error(badarg,[NotPort]). + +%%------------------------------------------------------------------------------ +%% @doc Get the mailbox id for the given port. +%% +%% The mailbox id is the same as the OSE process id of the OSE phantom process +%% that this mailbox represents. +%% +%% raises: `badarg' +%% @end +%%------------------------------------------------------------------------------ +-spec get_id(Port) -> Pid when + Port :: mailbox(), + Pid :: mailbox_id(). +get_id(Port) -> + try port_control(Port, ?GET_SPID, <<>>) of + <<Spid:32>> -> Spid + catch error:_Error -> + erlang:error(badarg,[Port]) + end. + +%%------------------------------------------------------------------------------ +%% @doc Get the mailbox name for the given mailbox id. +%% +%% The mailbox name is the name of the OSE process with process id Pid. +%% +%% This call will fail with badarg if the underlying system does not support +%% getting the name from a process id. +%% +%% raises: `badarg' +%% @end +%%------------------------------------------------------------------------------ +-spec get_name(Port, Pid) -> Name | undefined when + Port :: mailbox(), + Pid :: mailbox_id(), + Name :: binary(). +get_name(Port, Pid) when ?INT_32BIT(Pid) -> + try port_control(Port, ?GET_NAME, <<Pid:32>>) of + [] -> undefined; + Res -> Res + catch error:_Error -> + erlang:error(badarg,[Port,Pid]) + end; +get_name(Port, Pid) -> + erlang:error(badarg,[Port,Pid]). + + +%%------------------------------------------------------------------------------ +%% @doc Hunt for OSE process by name. +%% +%% Will send `{mailbox_up, Port, Ref, MboxId}' +%% to the calling process when the OSE process becomes available. +%% +%% Returns a reference term that can be used to cancel the hunt +%% using {@link dehunt/2}. +%% +%% raises: `badarg' +%% +%% @end +%%------------------------------------------------------------------------------ +-spec hunt(Port, HuntPath) -> Ref when + Port :: mailbox(), + HuntPath :: iodata(), + Ref :: hunt_ref(). +hunt(Port, HuntPath) -> + try port_command(Port, [?HUNT,HuntPath]) of + true -> + receive + {ose_drv_reply,Port,{error,Error}} -> + erlang:error(Error,[Port,HuntPath]); + {ose_drv_reply,Port,Ref} -> + Ref + end + catch error:_Error -> + erlang:error(badarg,[Port,HuntPath]) + end. + +%%------------------------------------------------------------------------------ +%% @doc Stop hunting for OSE process. +%% +%% If a message for this hunt has been sent but not received +%% by the calling process, it is removed from the message queue. +%% Note that this only works if the same process that did +%% the hunt does the dehunt. +%% +%% raises: `badarg' +%% +%% @see hunt/2 +%% @end +%%------------------------------------------------------------------------------ +-spec dehunt(Port, Ref) -> ok when + Port :: mailbox(), + Ref :: hunt_ref(). +dehunt(Port, {Port,Ref}) when ?INT_32BIT(Ref) -> + try port_command(Port, <<?DEHUNT:8, Ref:32>>) of + true -> + receive + {ose_drv_reply,Port,{error,enoent}} -> + %% enoent could mean that it is in the message queue + receive + {mailbox_up, Port, {Port,Ref}, _} -> + ok + after 0 -> + ok + end; + {ose_drv_reply,Port,ok} -> + ok + end + catch error:_Error -> + erlang:error(badarg,[Port,{Port,Ref}]) + end; +dehunt(Port,Ref) -> + erlang:error(badarg,[Port,Ref]). + +%%------------------------------------------------------------------------------ +%% @doc Attach to an OSE process. +%% +%% Will send `{mailbox_down, Port, Ref, MboxId}' +%% to the calling process if the OSE process exits. +%% +%% Returns a reference that can be used to cancel the attachment +%% using {@link detach/2}. +%% +%% raises: `badarg' | `enomem' +%% +%% @end +%%------------------------------------------------------------------------------ +-spec attach(Port,Pid) -> Ref when + Port :: mailbox(), + Pid :: mailbox_id(), + Ref :: attach_ref(). +attach(Port, Spid) when ?INT_32BIT(Spid) -> + try port_command(Port, <<?ATTACH:8, Spid:32>>) of + true -> + receive + {ose_drv_reply,Port,{error,Error}} -> + erlang:error(Error,[Port,Spid]); + {ose_drv_reply,Port,Ref} -> + Ref + end + catch error:_Error -> + erlang:error(badarg,[Port,Spid]) + end; +attach(Port,Spid) -> + erlang:error(badarg,[Port,Spid]). + + +%%------------------------------------------------------------------------------ +%% @doc Remove attachment to an OSE process. +%% +%% If a message for this monitor has been sent but not received +%% by the calling process, it is removed from the message queue. +%% Note that this only works of the same process +%% that did the attach does the detach. +%% +%% raises: `badarg' +%% +%% @see attach/2 +%% @end +%%------------------------------------------------------------------------------ +-spec detach(Port,Ref) -> ok when + Port :: mailbox(), + Ref :: attach_ref(). +detach(Port, {Port,Ref} ) when ?INT_32BIT(Ref) -> + try port_command(Port, <<?DETACH:8, Ref:32>>) of + true -> + receive + {ose_drv_reply,Port,{error,enoent}} -> + %% enoent could mean that it is in the message queue + receive + {mailbox_down,Port,{Port,Ref},_} -> + ok + after 0 -> + ok + end; + {ose_drv_reply,Port,ok} -> + ok + end + catch error:_Error -> + erlang:error(badarg,[Port,{Port,Ref}]) + end; +detach(Port,Ref) -> + erlang:error(badarg,[Port,Ref]). + +%%------------------------------------------------------------------------------ +%% @doc Send an OSE message. +%% +%% The message is sent from the OSE process' own ID that is: `get_id(Port)'. +%% +%% raises: `badarg' +%% +%% @see send/5 +%% @end +%%------------------------------------------------------------------------------ +-spec send(Port,Pid,SigNo,SigData) -> ok when + Port :: mailbox(), + Pid :: mailbox_id(), + SigNo :: message_number(), + SigData :: iodata(). +send(Port, Spid, SigNo, SigData) when ?INT_32BIT(Spid), ?INT_32BIT(SigNo) -> + try erlang:port_command(Port, [<<?SEND:8, Spid:32, SigNo:32>>, SigData]) of + true -> ok + catch error:_Error -> + erlang:error(badarg,[Port,Spid,SigNo,SigData]) + end; +send(Port,Spid,SigNo,SigData) -> + erlang:error(badarg,[Port,Spid,SigNo,SigData]). + + +%%------------------------------------------------------------------------------ +%% @doc Send an OSE message with different sender. +%% +%% As {@link send/4} but the sender will be `SenderPid'. +%% +%% raises: `badarg' +%% +%% @see send/4 +%% @end +%%------------------------------------------------------------------------------ +-spec send(Port,Pid,SenderPid,SigNo,SigData) -> ok when + Port :: mailbox(), + Pid :: mailbox_id(), + SenderPid :: mailbox_id(), + SigNo :: message_number(), + SigData :: iodata(). +send(Port, Spid, SenderPid, SigNo, SigData) + when ?INT_32BIT(Spid), ?INT_32BIT(SenderPid), ?INT_32BIT(SigNo) -> + try erlang:port_command(Port, [<<?SEND_W_S:8, Spid:32, SenderPid:32, + SigNo:32>>, SigData]) of + true -> ok + catch error:_Error -> + erlang:error(badarg,[Port,Spid,SenderPid,SigNo,SigData]) + end; +send(Port,Spid,SenderPid,SigNo,SigData) -> + erlang:error(badarg,[Port,Spid,SenderPid,SigNo,SigData]). + +%%------------------------------------------------------------------------------ +%% @doc Start listening for specified OSE signal numbers. +%% +%% The mailbox will send `{message,Port,{FromMboxId,ToMboxId,MsgNo,MsgData}}' +%% to the process that created the mailbox when an OSE message with any +%% of the specified `SigNos' arrives. +%% +%% Repeated calls to listen will replace the current set of signal numbers to +%% listen to. i.e +%% +%% ```1>ose:listen(MsgB,[1234,12345]). +%% ok +%% 2> ose:listen(MsgB,[1234,123456]). +%% ok.''' +%% +%% The above will first listen for signals with numbers 1234 and 12345, and then +%% replace that with only listening to 1234 and 123456. +%% +%% With the current implementation it is not possible to listen to all signal +%% numbers. +%% +%% raises: `badarg' | `enomem' +%% +%% @end +%%------------------------------------------------------------------------------ +-spec listen(Port, SigNos) -> ok when + Port :: mailbox(), + SigNos :: list(message_number()). +listen(Port, SigNos) when is_list(SigNos) -> + USSigNos = lists:usort(SigNos), + BinSigNos = try + << <<SigNo:32>> || + SigNo <- USSigNos, + ?INT_32BIT(SigNo) orelse erlang:error(badarg) + >> + catch _:_ -> + erlang:error(badarg,[Port,SigNos]) + end, + try port_command(Port, [?LISTEN, BinSigNos]) of + true -> + receive + {ose_drv_reply,Port,{error,Error}} -> + erlang:error(Error,[Port,SigNos]); + {ose_drv_reply,Port,Else} -> + Else + end + catch error:_Error -> + erlang:error(badarg,[Port,SigNos]) + end; +listen(Port, SigNos) -> + erlang:error(badarg,[Port,SigNos]). + + +%%%============================================================================= +%%% Internal functions +%%%============================================================================= diff --git a/lib/ose/test/Makefile b/lib/ose/test/Makefile new file mode 100644 index 0000000000..7e2080ba38 --- /dev/null +++ b/lib/ose/test/Makefile @@ -0,0 +1,67 @@ +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- + +MODULES= \ + ose_SUITE + +ERL_FILES= $(MODULES:%=%.erl) + +TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) + +INSTALL_PROGS= $(TARGET_FILES) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/ose_test + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- + +ERL_MAKE_FLAGS += +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \ + -I$(ERL_TOP)/lib/kernel/include + +EBIN = . + +EMAKEFILE=Emakefile +COVERFILE=ose.cover + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +make_emakefile: + $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \ + > $(EMAKEFILE) + +tests debug opt: make_emakefile + erl $(ERL_MAKE_FLAGS) -make + +clean: + rm -f $(EMAKEFILE) + rm -f $(TARGET_FILES) + rm -f core + +docs: + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + +release_tests_spec: make_emakefile + $(INSTALL_DIR) "$(RELSYSDIR)" + $(INSTALL_DATA) ose.spec $(EMAKEFILE) \ + $(ERL_FILES) $(COVERFILE) "$(RELSYSDIR)" + chmod -R u+w "$(RELSYSDIR)" + @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) + +release_docs_spec: diff --git a/lib/ose/test/ose.cover b/lib/ose/test/ose.cover new file mode 100644 index 0000000000..7b846cfaf6 --- /dev/null +++ b/lib/ose/test/ose.cover @@ -0,0 +1,2 @@ +%% -*- erlang -*- +{incl_app,ose,details}. diff --git a/lib/ose/test/ose.spec b/lib/ose/test/ose.spec new file mode 100644 index 0000000000..c897e8cd16 --- /dev/null +++ b/lib/ose/test/ose.spec @@ -0,0 +1 @@ +{suites,"../ose_test",all}. diff --git a/lib/ose/test/ose_SUITE.erl b/lib/ose/test/ose_SUITE.erl new file mode 100644 index 0000000000..7e81b19894 --- /dev/null +++ b/lib/ose/test/ose_SUITE.erl @@ -0,0 +1,765 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2013. 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(ose_SUITE). + +%-compile(export_all). + +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2,init_per_testcase/2, + end_per_testcase/2]). +-export([ + basic/1,stress/1,multi_msg_numbers/1,multi_mailboxes/1, + hunt/1,multi_hunt/1,dehunt/1,multi_dehunt/1, + attach/1,multi_attach/1,detach/1,multi_detach/1, + open_errors/1,close_errors/1,get_id_errors/1,get_name_errors/1, + hunt_errors/1,dehunt_errors/1,attach_errors/1,detach_errors/1, + send_errors/1,send_w_s_errors/1,listen_errors/1 + ]). + +-define(INTERFACE,ose). + + +init_per_testcase(_Func, Config) -> + Config. +end_per_testcase(_Func, _Config) -> + ok. + +suite() -> [{timeout,{30,seconds}}]. + +all() -> + [ + basic,stress,multi_msg_numbers,multi_mailboxes, + hunt,multi_hunt,dehunt,multi_dehunt, + attach,multi_attach,detach,multi_detach, + + open_errors,close_errors,get_id_errors,get_name_errors, + hunt_errors,dehunt_errors,attach_errors,detach_errors, + send_errors,send_w_s_errors,listen_errors + ]. + +groups() -> + []. + +init_per_suite(Config) -> + case os:type() of + {ose,_} -> + Config; + _Else -> + {skip,"Only run on OSE"} + end. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +basic(_Config) -> + + [P1,P2] = multi_open(2,[42]), + P1Id = ?INTERFACE:get_id(P1), + P2Id = ?INTERFACE:get_id(P2), + + ok = ?INTERFACE:send(P2,P1Id,42,<<"ping">>), + receive + {message,P1,V1} -> + {P2Id,P1Id,42,<<"ping">>} = V1, + ?INTERFACE:send(P1,P2Id,42,<<"pong">>); + Else1 -> + ct:fail({got_wrong_message,Else1}) + end, + + receive + {message,P2,V2} -> + {P1Id,P2Id,42,<<"pong">>} = V2; + Else2 -> + ct:fail({got_wrong_message,Else2}) + end, + + ?INTERFACE:close(P1), + ?INTERFACE:close(P2). + +%% Send 1000 messages and see if we can cope and that msg order is preserved +stress(_Config) -> + + Iterations = 1000, + + [P1,P2] = multi_open(2,[42]), + P1Id = ?INTERFACE:get_id(P1), + P2Id = ?INTERFACE:get_id(P2), + + spawn(fun() -> + n(fun(N) -> + Msg = [<<"ping">>|integer_to_list(N)], + ?INTERFACE:send(P2,P1Id,42,Msg) + end,Iterations) + end), + timer:sleep(100), + n(fun(N) -> + receive + {message,P1,Value} -> + Int = integer_to_binary(N), + {P2Id,P1Id,42,<<"ping",Int/binary>>} = Value, + ok; + Else -> + ct:fail({got_wrong_message,Else}) + end + end,Iterations), + + ?INTERFACE:close(P1), + ?INTERFACE:close(P2). + +%% Listen to 1000 different message numbers and send some random messages +multi_msg_numbers(_Config) -> + + Iterations = 100, + + [P1,P2] = multi_open(2,lists:seq(2000,3000)), + P1Id = ?INTERFACE:get_id(P1), + + n(fun(_) -> + Num = random:uniform(1000)+2000, + ?INTERFACE:send(P2,P1Id,Num,<<"ping",(integer_to_binary(Num))/binary>>) + end,Iterations), + + n(fun(_) -> + receive + {message,P1,{_,_,Id,<<"ping",Num/binary>>}} when Id > 2000; + Id =< 3000 -> + Id = binary_to_integer(Num), + ok; + Else -> + ct:fail({got_wrong_message,Else}) + end + end,Iterations), + + ?INTERFACE:close(P1), + ?INTERFACE:close(P2). + + +%% Create 100 mailboxes and send messages to them +multi_mailboxes(_Config) -> + + Mailboxes = 100, + + [P1|MBs] = multi_open(Mailboxes,[42]), + + [?INTERFACE:send(P1,?INTERFACE:get_id(P),42,[<<"ping">>,?INTERFACE:get_name(P,?INTERFACE:get_id(P))]) || P <- MBs], + + [receive + {message,P,Value} -> + Name = ?INTERFACE:get_name(P,?INTERFACE:get_id(P)), + {_,_,42,<<"ping",Name/binary>>} = Value, + ok + end || P <- MBs], + + [?INTERFACE:close(P) || P <- [P1|MBs]], + ok. + +hunt(_Config) -> + [P1,P2] = multi_open(2,[]), + + Ref = ?INTERFACE:hunt(P1,"p2"), + receive + {mailbox_up,P1,Ref,Pid} -> + Pid = ?INTERFACE:get_id(P2), + ?INTERFACE:close(P1), + ?INTERFACE:close(P2); + Else -> + ct:fail({got_wrong_message,Else,Ref}) + end. + +multi_hunt(_Config) -> + + Iterations = 100, + + P = ?INTERFACE:open("p"), + + Refs = [?INTERFACE:hunt(P,"p"++integer_to_list(N))|| N <- lists:seq(1,Iterations)], + + Pids = [begin + Prt = ?INTERFACE:open("p"++integer_to_list(N)), + Pid = ?INTERFACE:get_id(Prt), + ?INTERFACE:close(Prt), + Pid + end || N <- lists:seq(1,Iterations)], + + [receive + {mailbox_up,P,Ref,Pid} -> + ok + after 10 -> + ct:fail({did_not_get,Pid,Ref}) + end || {Pid,Ref} <- lists:zip(Pids,Refs)], + ?INTERFACE:close(P). + + +dehunt(_Config) -> + [P1] = multi_open(1,[]), + Ref = ?INTERFACE:hunt(P1,"p2"), + receive + _Else -> ct:fail({got,_Else}) + after 1000 -> + ok + end, + P2 = ?INTERFACE:open("p2"), + + % Make sure any messages are sent + receive after 10 -> ok end, + + ok = ?INTERFACE:dehunt(P1,Ref), + + % Make sure no messages are received + receive + _Else2 -> ct:fail({got,_Else2}) + after 1000 -> + ?INTERFACE:close(P1), + ?INTERFACE:close(P2) + end. + +%%% +%%% This testcase basically: +%%% spawn 10 processes that in parallel +%%% adds some hunts for different OSE processes +%%% maybe create hunted OSE process +%%% dehunt half of the hunts +%%% create more hunts +%%% if not created create hunted OSE process +%%% veryify that all expected hunt messages are received +%%% verify that all processes exited correctly +%%% +%%% This complex test is done to make sure that the internal handling +%%% of dehunt works as expected. +%%% +multi_dehunt(_Config) -> + [P1] = multi_open(1,[]), + + Scenario = + fun(Iterations) -> + + Hunted = "p"++integer_to_list(Iterations), + %% Start a couple of hunts + Refs = [?INTERFACE:hunt(P1,Hunted) || _ <- lists:seq(1,Iterations)], + + %% We alternate if the process is opened before or after the dehunt + P2O = if Iterations rem 2 == 0 -> + ?INTERFACE:open(Hunted); + true -> + undefined + end, + + %% Remove half of them + {RemRefs,_} = lists:mapfoldl(fun(Ref,Acc) when Acc rem 2 == 0 -> + ok = ?INTERFACE:dehunt(P1,Ref), + {[],Acc+1}; + (Ref,Acc) -> + {Ref,Acc+1} + end,0,Refs), + + %% Add some new ones + NewRefs = [?INTERFACE:hunt(P1,Hunted) + || _ <- lists:seq(1,Iterations div 4)] + ++ lists:flatten(RemRefs), + + P2 = if P2O == undefined -> + ?INTERFACE:open(Hunted); + true -> + P2O + end, + P2Id = ?INTERFACE:get_id(P2), + + %% Receive all the expected ones + lists:foreach(fun(Ref) -> + receive + {mailbox_up,P1,Ref,P2Id} -> + ok + after 1000 -> + io:format("Flush: ~p~n",[flush()]), + io:format("~p~n",[{Iterations,{did_not_get, Ref}}]), + ok = Ref + end + end,NewRefs), + + %% Check that no other have arrived + receive + _Else -> + io:format("Flush: ~p~n",[flush()]), + io:format("~p~n",[{Iterations,{got, _Else}}]), + ok = _Else + after 100 -> + ok + end, + ?INTERFACE:close(P2) + end, + + Self = self(), + + n(fun(N) -> + spawn(fun() -> Self ! + Scenario(N*25) + end), + ok + end,10), + + n(fun(_N) -> + receive ok -> ok + after 60000 -> ct:fail(failed) + end + end,10), + ?INTERFACE:close(P1). + +attach(_Config) -> + [P1,P2] = multi_open(2,[]), + + P2Id = ?INTERFACE:get_id(P2), + Ref = ?INTERFACE:attach(P1,P2Id), + ?INTERFACE:close(P2), + receive + {mailbox_down,P1,Ref,P2Id} -> + ?INTERFACE:close(P1); + _Else -> + ct:fail({got,_Else, {P1,Ref,P2Id}}) + after 1000 -> + ct:fail({did_not_get,P1,Ref,P2Id}) + end. + +multi_attach(_Config) -> + + Iterations = 100, + + [P1|Pids] = multi_open(Iterations,[]), + + Refs = [{?INTERFACE:get_id(Pid),?INTERFACE:attach(P1,?INTERFACE:get_id(Pid))} || Pid <- Pids], + + [?INTERFACE:close(Pid) || Pid <- Pids], + + [receive + {mailbox_down,P1,Ref,Pid} -> + ok + after 10000 -> + ct:fail({did_not_get,Pid,Ref}) + end || {Pid,Ref} <- Refs], + ?INTERFACE:close(P1). + +detach(_Config) -> + [P1,P2] = multi_open(2,[]), + P2Id = ?INTERFACE:get_id(P2), + Ref = ?INTERFACE:attach(P1,P2Id), + receive + _Else -> ct:fail({got,_Else}) + after 100 -> + ok + end, + + ?INTERFACE:close(P2), + + % Make sure any messages are sent + receive after 10 -> ok end, + + ?INTERFACE:detach(P1,Ref), + + % Make sure no messages are received + receive + _Else2 -> ct:fail({got,_Else2}) + after 1000 -> + ?INTERFACE:close(P1) + end. + +%%% +%%% This testcase basically: +%%% spawn 10 processes that in parallel +%%% adds some attach for different OSE processes +%%% maybe close OSE process +%%% dehunt half of the hunts +%%% create more hunts +%%% if not closed close attached OSE process +%%% veryify that all expected attach messages are received +%%% verify that all processes exited correctly +%%% +%%% This complex test is done to make sure that the internal handling +%%% of dehunt works as expected. +%%% +multi_detach(_Config) -> + [P1] = multi_open(1,[]), + + Scenario = + fun(Iterations) -> + + Attached = ?INTERFACE:open("p"++integer_to_list(Iterations)), + AttachedId = ?INTERFACE:get_id(Attached), + %% Start a couple of attachs + Refs = [?INTERFACE:attach(P1,AttachedId) || _ <- lists:seq(1,Iterations)], + + %% We alternate if the process is closed before or after the detach + P2O = if Iterations rem 2 == 0 -> + ?INTERFACE:close(Attached); + true -> + undefined + end, + + %% Remove half of them + {RemRefs,_} = lists:mapfoldl(fun(Ref,Acc) when Acc rem 2 == 0 -> + ok = ?INTERFACE:detach(P1,Ref), + {[],Acc+1}; + (Ref,Acc) -> + {Ref,Acc+1} + end,0,Refs), + + %% Add some new ones + NewRefs = [?INTERFACE:attach(P1,AttachedId) + || _ <- lists:seq(1,Iterations div 4)] + ++ lists:flatten(RemRefs), + + if P2O == undefined -> + ?INTERFACE:close(Attached); + true -> + P2O + end, + + %% Receive all the expected ones + lists:foreach(fun(Ref) -> + receive + {mailbox_down,P1,Ref,AttachedId} -> + ok + after 1000 -> + io:format("Flush: ~p~n",[flush()]), + io:format("~p~n",[{Iterations,{did_not_get, Ref}}]), + ok = Ref + end + end,NewRefs), + + %% Check that no other have arrived + receive + _Else -> + io:format("Flush: ~p~n",[flush()]), + io:format("~p~n",[{Iterations,{got, _Else}}]), + ok = _Else + after 100 -> + ok + end + end, + + Self = self(), + + n(fun(N) -> + spawn(fun() -> Self ! + Scenario(N*5) + end), + ok + end,10), + + n(fun(_N) -> + receive ok -> ok + after 60000 -> ct:fail(failed) + end + end,10), + ?INTERFACE:close(P1). + + +open_errors(_Config) -> + {'EXIT',{badarg,[{?INTERFACE,open,[inval],_}|_]}} = + (catch ?INTERFACE:open(inval)), + {'EXIT',{badarg,[{?INTERFACE,open,[["p"|1]],_}|_]}} = + (catch ?INTERFACE:open(["p"|1])), + {'EXIT',{badarg,[{?INTERFACE,open,[["p",1234]],_}|_]}} = + (catch ?INTERFACE:open(["p",1234])), + + ok. + +close_errors(_Config) -> + {'EXIT',{badarg,[{?INTERFACE,close,[inval],_}|_]}} = + (catch ?INTERFACE:close(inval)), + + P1 = ?INTERFACE:open("p1"), + ok = ?INTERFACE:close(P1), + ok = ?INTERFACE:close(P1). + + +get_id_errors(_Config) -> + {'EXIT',{badarg,[{?INTERFACE,get_id,[inval],_}|_]}} = + (catch ?INTERFACE:get_id(inval)), + + P1 = ?INTERFACE:open("p1"), + ok = ?INTERFACE:close(P1), + {'EXIT',{badarg,[{?INTERFACE,get_id,[P1],_}|_]}} = + (catch ?INTERFACE:get_id(P1)), + + ok. + +get_name_errors(_Config) -> + P1 = ?INTERFACE:open("p1"), + {'EXIT',{badarg,[{?INTERFACE,get_name,[P1,inval],_}|_]}} = + (catch ?INTERFACE:get_name(P1,inval)), + + undefined = ?INTERFACE:get_name(P1,1234), + + P2 = ?INTERFACE:open("p2"), + P2Id = ?INTERFACE:get_id(P2), + ok = ?INTERFACE:close(P1), + {'EXIT',{badarg,[{?INTERFACE,get_name,[P1,P2Id],_}|_]}} = + (catch ?INTERFACE:get_name(P1,P2Id)), + ?INTERFACE:close(P2), + + P3 = ?INTERFACE:open([255]), + <<255>> = ?INTERFACE:get_name(P3, ?INTERFACE:get_id(P3)), + ?INTERFACE:close(P3), + + ok. + +hunt_errors(_Config) -> + + {'EXIT',{badarg,[{?INTERFACE,hunt,[inval,"hello"],_}|_]}} = + (catch ?INTERFACE:hunt(inval,"hello")), + + P1 = ?INTERFACE:open("p1"), + {'EXIT',{badarg,[{?INTERFACE,hunt,[P1,["hello",12345]],_}|_]}} = + (catch ?INTERFACE:hunt(P1,["hello",12345])), + + P2 = ?INTERFACE:open(<<255>>), + P2Pid = ?INTERFACE:get_id(P2), + Ref = ?INTERFACE:hunt(P1,[255]), + receive + {mailbox_up,P1,Ref,P2Pid} -> + ok; + Else -> + ct:fail({got,Else,{mailbox_up,P1,Ref,P2Pid}}) + after 150 -> + ct:fail({did_not_get,{mailbox_up,P1,Ref,P2Pid}}) + end, + + ok = ?INTERFACE:close(P1), + ok = ?INTERFACE:close(P2), + {'EXIT',{badarg,[{?INTERFACE,hunt,[P1,["hello"]],_}|_]}} = + (catch ?INTERFACE:hunt(P1,["hello"])), + + ok. + +dehunt_errors(_Config) -> + P1 = ?INTERFACE:open("p1"), + Ref = ?INTERFACE:hunt(P1,"p2"), + + {'EXIT',{badarg,[{?INTERFACE,dehunt,[inval,Ref],_}|_]}} = + (catch ?INTERFACE:dehunt(inval,Ref)), + + {'EXIT',{badarg,[{?INTERFACE,dehunt,[P1,inval],_}|_]}} = + (catch ?INTERFACE:dehunt(P1,inval)), + + ok = ?INTERFACE:dehunt(P1,Ref), + ok = ?INTERFACE:dehunt(P1,Ref), + + ok = ?INTERFACE:close(P1), + + {'EXIT',{badarg,[{?INTERFACE,dehunt,[P1,Ref],_}|_]}} = + (catch ?INTERFACE:dehunt(P1,Ref)), + + case ?INTERFACE of + ose -> ok; + _ -> + P2 = ?INTERFACE:open("p2"), + ok = ?INTERFACE:close(P2) + end, + + receive + Else -> ct:fail({got,Else}) + after 100 -> + ok + end. + +attach_errors(_Config) -> + P1 = ?INTERFACE:open("p1"), + P2 = ?INTERFACE:open("p2"), + P2Id = ?INTERFACE:get_id(P2), + + {'EXIT',{badarg,[{?INTERFACE,attach,[inval,P2Id],_}|_]}} = + (catch ?INTERFACE:attach(inval,P2Id)), + + {'EXIT',{badarg,[{?INTERFACE,attach,[P1,[12345]],_}|_]}} = + (catch ?INTERFACE:attach(P1,[12345])), + + ok = ?INTERFACE:close(P1), + ok = ?INTERFACE:close(P2), + {'EXIT',{badarg,[{?INTERFACE,attach,[P1,P2Id],_}|_]}} = + (catch ?INTERFACE:attach(P1,P2Id)), + + ok. + +detach_errors(_Config) -> + P1 = ?INTERFACE:open("p1"), + P2 = ?INTERFACE:open("p2"), + P2Id = ?INTERFACE:get_id(P2), + + Ref = ?INTERFACE:attach(P1,P2Id), + + {'EXIT',{badarg,[{?INTERFACE,detach,[inval,Ref],_}|_]}} = + (catch ?INTERFACE:detach(inval,Ref)), + + {'EXIT',{badarg,[{?INTERFACE,detach,[P1,inval],_}|_]}} = + (catch ?INTERFACE:detach(P1,inval)), + + ok = ?INTERFACE:detach(P1,Ref), + ok = ?INTERFACE:detach(P1,Ref), + + case ?INTERFACE of + ose -> ok; + _ -> + ok = ?INTERFACE:close(P1) + end, + + ok = ?INTERFACE:close(P2), + ok = ?INTERFACE:close(P1), + + {'EXIT',{badarg,[{?INTERFACE,detach,[P1,Ref],_}|_]}} = + (catch ?INTERFACE:detach(P1,Ref)), + + receive + Else -> ct:fail({got,Else}) + after 100 -> + ok + end. + +send_errors(_Config) -> + P1 = ?INTERFACE:open("p1"), + P2 = ?INTERFACE:open("p2"), + P2Id = ?INTERFACE:get_id(P2), + + {'EXIT',{badarg,[{?INTERFACE,send,[inval,P2Id,42,"hello"],_}|_]}} = + (catch ?INTERFACE:send(inval,P2Id,42,"hello")), + {'EXIT',{badarg,[{?INTERFACE,send,[P1,inval,42,"hello"],_}|_]}} = + (catch ?INTERFACE:send(P1,inval,42,"hello")), + {'EXIT',{badarg,[{?INTERFACE,send,[P1,P2Id,inval,"hello"],_}|_]}} = + (catch ?INTERFACE:send(P1,P2Id,inval,"hello")), + {'EXIT',{badarg,[{?INTERFACE,send,[P1,P2Id,42,inval],_}|_]}} = + (catch ?INTERFACE:send(P1,P2Id,42,inval)), + + ok = ?INTERFACE:close(P2), + ok = ?INTERFACE:send(P1,P2Id,42,"hello"), + ok = ?INTERFACE:close(P1), + + {'EXIT',{badarg,[{?INTERFACE,send,[P1,P2Id,42,"hello"],_}|_]}} = + (catch ?INTERFACE:send(P1,P2Id,42,"hello")), + + receive + Else -> ct:fail({got,Else}) + after 100 -> + ok + end. + +send_w_s_errors(_Config) -> + P1 = ?INTERFACE:open("p1"), + P1Id = ?INTERFACE:get_id(P1), + P2 = ?INTERFACE:open("p2"), + P2Id = ?INTERFACE:get_id(P2), + P3 = ?INTERFACE:open("p3"), + P3Id = ?INTERFACE:get_id(P3), + + {'EXIT',{badarg,[{?INTERFACE,send,[inval,P2Id,P1Id,42,"hello"],_}|_]}} = + (catch ?INTERFACE:send(inval,P2Id,P1Id,42,"hello")), + {'EXIT',{badarg,[{?INTERFACE,send,[P2,-1,P1Id,42,"hello"],_}|_]}} = + (catch ?INTERFACE:send(P2,-1,P1Id,42,"hello")), + {'EXIT',{badarg,[{?INTERFACE,send,[P2,P2Id,1 bsl 32,42,"hello"],_}|_]}} = + (catch ?INTERFACE:send(P2,P2Id,1 bsl 32,42,"hello")), + {'EXIT',{badarg,[{?INTERFACE,send,[P2,P2Id,P1Id,inval,"hello"],_}|_]}} = + (catch ?INTERFACE:send(P2,P2Id,P1Id,inval,"hello")), + {'EXIT',{badarg,[{?INTERFACE,send,[P2,P2Id,P1Id,42,inval],_}|_]}} = + (catch ?INTERFACE:send(P2,P2Id,P1Id,42,inval)), + + ok = ?INTERFACE:close(P3), + ok = ?INTERFACE:send(P2,P3Id,P1Id,42,"hello"), + + ok = ?INTERFACE:close(P1), + ok = ?INTERFACE:send(P2,P2Id,P1Id,42,"hello"), + ok = ?INTERFACE:close(P2), + + {'EXIT',{badarg,[{?INTERFACE,send,[P1,P2Id,P1Id,42,"hello"],_}|_]}} = + (catch ?INTERFACE:send(P1,P2Id,P1Id,42,"hello")), + + receive + Else -> ct:fail({got,Else}) + after 100 -> + ok + end. + +listen_errors(_Config) -> + + P1 = ?INTERFACE:open("p1"), + P1Id = ?INTERFACE:get_id(P1), + + {'EXIT',{badarg,[{?INTERFACE,listen,[inval,[42]],_}|_]}} = + (catch ?INTERFACE:listen(inval,[42])), + {'EXIT',{badarg,[{?INTERFACE,listen,[P1,inval],_}|_]}} = + (catch ?INTERFACE:listen(P1,inval)), + {'EXIT',{badarg,[{?INTERFACE,listen,[P1,[1 bsl 33]],_}|_]}} = + (catch ?INTERFACE:listen(P1,[1 bsl 33])), + + ok = ?INTERFACE:listen(P1,[42,42,42,42,42,42,42,42,42,42,42,42,42]), + + case ?INTERFACE of + ose -> ok; + _ -> + ?INTERFACE:send(P1,P1Id,42,"hello"), + timer:sleep(50), + ?INTERFACE:listen(P1,[]), + ?INTERFACE:send(P1,P1Id,42,"hello2"), + + receive + {message,P1,42,"hello"} -> ok + end, + + receive + Else -> ct:fail({got,Else}) + after 100 -> + ok + end + end, + + ok = ?INTERFACE:close(P1), + {'EXIT',{badarg,[{?INTERFACE,listen,[P1,[42]],_}|_]}} = + (catch ?INTERFACE:listen(P1,[42])), + + ok. + +%% +%% Internal functions +%% +multi_open(N,ListenNums) -> + multi_open(N,ListenNums,[]). + +multi_open(0,_,Acc) -> + Acc; +multi_open(N,ListenNums,Acc) -> + P = ?INTERFACE:open("p"++integer_to_list(N)), + ok = ?INTERFACE:listen(P,ListenNums), + multi_open(N-1,ListenNums,[P|Acc]). + +n(_F,0) -> + ok; +n(F,N) -> + ok = F(N), + n(F,N-1). + + +flush() -> + receive + Msg -> + [Msg|flush()] + after 0 -> + [] + end. diff --git a/lib/ose/vsn.mk b/lib/ose/vsn.mk new file mode 100644 index 0000000000..78ffa4d496 --- /dev/null +++ b/lib/ose/vsn.mk @@ -0,0 +1 @@ +OSE_VSN = 1.0 diff --git a/lib/otp_mibs/src/otp_mibs.app.src b/lib/otp_mibs/src/otp_mibs.app.src index b177af0709..ebc656b0b2 100644 --- a/lib/otp_mibs/src/otp_mibs.app.src +++ b/lib/otp_mibs/src/otp_mibs.app.src @@ -23,5 +23,7 @@ {modules, [otp_mib]}, {registered, []}, {applications, [kernel, stdlib, snmp]}, - {env,[]}]}. + {env,[]}, + {runtime_dependencies, ["stdlib-2.0","snmp-4.25.1","mnesia-4.12", + "kernel-3.0","erts-6.0"]}]}. diff --git a/lib/otp_mibs/vsn.mk b/lib/otp_mibs/vsn.mk index 96d3088224..98db21c132 100644 --- a/lib/otp_mibs/vsn.mk +++ b/lib/otp_mibs/vsn.mk @@ -1,4 +1,4 @@ -OTP_MIBS_VSN = 1.0.8 +OTP_MIBS_VSN = 1.0.9 # Note: The branch 'otp_mibs' is defunct as of otp_mibs-1.0.4 and # should NOT be used again. diff --git a/lib/parsetools/doc/src/yecc.xml b/lib/parsetools/doc/src/yecc.xml index 380cac967a..7298e09c2c 100644 --- a/lib/parsetools/doc/src/yecc.xml +++ b/lib/parsetools/doc/src/yecc.xml @@ -425,9 +425,9 @@ myparser:parse_and_scan({Mod, Tokenizer, Args}) </code> Nonterminals E T F. Terminals '+' '*' '(' ')' number. Rootsymbol E. -E -> E '+' T: ['$2', '$1', '$3']. +E -> E '+' T: {'$2', '$1', '$3'}. E -> T : '$1'. -T -> T '*' F: ['$2', '$1', '$3']. +T -> T '*' F: {'$2', '$1', '$3'}. T -> F : '$1'. F -> '(' E ')' : '$2'. F -> number : '$1'. </code> @@ -438,8 +438,8 @@ Terminals '+' '*' '(' ')' number. Rootsymbol E. Left 100 '+'. Left 200 '*'. -E -> E '+' E : ['$2', '$1', '$3']. -E -> E '*' E : ['$2', '$1', '$3']. +E -> E '+' E : {'$2', '$1', '$3'}. +E -> E '*' E : {'$2', '$1', '$3'}. E -> '(' E ')' : '$2'. E -> number : '$1'. </code> <p>3. An overloaded minus operator:</p> diff --git a/lib/parsetools/src/parsetools.app.src b/lib/parsetools/src/parsetools.app.src index af62fc4f6b..9eeb8fcc05 100644 --- a/lib/parsetools/src/parsetools.app.src +++ b/lib/parsetools/src/parsetools.app.src @@ -11,7 +11,8 @@ {applications, [kernel,stdlib]}, {env, [{file_util_search_methods,[{"", ""}, {"ebin", "esrc"}, {"ebin", "src"}]} ] - } + }, + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0"]} ] }. diff --git a/lib/parsetools/vsn.mk b/lib/parsetools/vsn.mk index d62962c54a..8fd7422c1c 100644 --- a/lib/parsetools/vsn.mk +++ b/lib/parsetools/vsn.mk @@ -1 +1 @@ -PARSETOOLS_VSN = 2.0.10 +PARSETOOLS_VSN = 2.0.11 diff --git a/lib/percept/src/percept.app.src b/lib/percept/src/percept.app.src index cf4a9fc438..f8991ee577 100644 --- a/lib/percept/src/percept.app.src +++ b/lib/percept/src/percept.app.src @@ -35,7 +35,9 @@ ]}, {registered, [percept_db,percept_port]}, {applications, [kernel,stdlib]}, - {env,[]} + {env,[]}, + {runtime_dependencies, ["stdlib-2.0","runtime_tools-1.8.14","kernel-3.0", + "inets-5.10","erts-6.0"]} ]}. diff --git a/lib/percept/vsn.mk b/lib/percept/vsn.mk index 99729c11e2..935a9d1336 100644 --- a/lib/percept/vsn.mk +++ b/lib/percept/vsn.mk @@ -1 +1 @@ -PERCEPT_VSN = 0.8.8.2 +PERCEPT_VSN = 0.8.9 diff --git a/lib/public_key/src/pubkey_cert.erl b/lib/public_key/src/pubkey_cert.erl index dc8d68c78f..ae517ca642 100644 --- a/lib/public_key/src/pubkey_cert.erl +++ b/lib/public_key/src/pubkey_cert.erl @@ -319,6 +319,8 @@ verify_fun(Otpcert, Result, UserState0, VerifyFun) -> %% %% Description: Extracts a specific extension from a list of extensions. %%-------------------------------------------------------------------- +select_extension(_, asn1_NOVALUE) -> + undefined; select_extension(_, []) -> undefined; select_extension(Id, [#'Extension'{extnID = Id} = Extension | _]) -> @@ -342,8 +344,11 @@ match_name(uniformResourceIdentifier, URI, [PermittedName | Rest]) -> incomplete -> false; {_, _, Host, _, _} -> - match_name(fun is_valid_host_or_domain/2, Host, - PermittedName, Rest) + PN = case split_uri(PermittedName) of + {_, _, PNhost, _, _} -> PNhost; + _X -> PermittedName + end, + match_name(fun is_valid_host_or_domain/2, Host, PN, Rest) end; match_name(emailAddress, Name, [PermittedName | Rest]) -> @@ -511,10 +516,10 @@ is_dir_name2(Value, Value) -> true; is_dir_name2({printableString, Value1}, {printableString, Value2}) -> string:to_lower(strip_spaces(Value1)) =:= string:to_lower(strip_spaces(Value2)); -is_dir_name2({utf8String, Value1}, String) -> %% BUGBUG FIX UTF8 conv - is_dir_name2({printableString, binary_to_list(Value1)}, String); -is_dir_name2(String, {utf8String, Value1}) -> %% BUGBUG FIX UTF8 conv - is_dir_name2(String, {printableString, binary_to_list(Value1)}); +is_dir_name2({utf8String, Value1}, String) -> + is_dir_name2({printableString, unicode:characters_to_list(Value1)}, String); +is_dir_name2(String, {utf8String, Value1}) -> + is_dir_name2(String, {printableString, unicode:characters_to_list(Value1)}); is_dir_name2(_, _) -> false. diff --git a/lib/public_key/src/pubkey_crl.erl b/lib/public_key/src/pubkey_crl.erl index eaba5bfa1b..f0df4bc3f2 100644 --- a/lib/public_key/src/pubkey_crl.erl +++ b/lib/public_key/src/pubkey_crl.erl @@ -39,7 +39,13 @@ validate(OtpCert, OtherDPCRLs, DP, {DerCRL, CRL}, {DerDeltaCRL, DeltaCRL}, CertIssuer = TBSCert#'OTPTBSCertificate'.issuer, TBSCRL = CRL#'CertificateList'.tbsCertList, CRLIssuer = TBSCRL#'TBSCertList'.issuer, - AltNames = subject_alt_names(TBSCert#'OTPTBSCertificate'.extensions), + AltNames = case pubkey_cert:select_extension(?'id-ce-subjectAltName', + TBSCert#'OTPTBSCertificate'.extensions) of + undefined -> + []; + Ext -> + Ext#'Extension'.extnValue + end, revoked_status(DP, IDP, {directoryName, CRLIssuer}, [ {directoryName, CertIssuer} | AltNames], SerialNumber, Revoked, DeltaRevoked, RevokedState1); @@ -397,16 +403,18 @@ verify_dp_name(IDPNames, DPorIssuerNames) -> match_one([], _) -> false; match_one([{Type, Name} | Names], CandidateNames) -> - Candidates = [NameName || {NameType, NameName} <- CandidateNames, NameType == Type], + Candidates = [NameName || {NameType, NameName} <- CandidateNames, + NameType == Type], case Candidates of [] -> false; - [_|_] -> case pubkey_cert:match_name(Type, Name, Candidates) of - true -> - true; - false -> - match_one(Names, CandidateNames) - end + [_|_] -> + case pubkey_cert:match_name(Type, Name, Candidates) of + true -> + true; + false -> + match_one(Names, CandidateNames) + end end. verify_dp_bools(TBSCert, IDP) -> @@ -664,6 +672,8 @@ verify_extensions([#'TBSCertList_revokedCertificates_SEQOF'{crlEntryExtensions = verify_extensions(pubkey_cert:extensions_list(Ext)) and verify_extensions(Rest); verify_extensions([]) -> true; +verify_extensions(asn1_NOVALUE) -> + true; verify_extensions([#'Extension'{critical = true, extnID = Id} | Rest]) -> case lists:member(Id, [?'id-ce-authorityKeyIdentifier', ?'id-ce-issuerAltName', @@ -689,13 +699,3 @@ authority_key_identifier(Extensions) -> Enc = extension_value(?'id-ce-authorityKeyIdentifier', 'AuthorityKeyIdentifier', Extensions), pubkey_cert_records:transform(Enc, decode). - -subject_alt_names(Extensions) -> - Enc = extension_value(?'id-ce-subjectAltName', - 'GeneralNames', Extensions), - case Enc of - undefined -> - []; - _ -> - pubkey_cert_records:transform(Enc, decode) - end. diff --git a/lib/public_key/src/public_key.app.src b/lib/public_key/src/public_key.app.src index 736a778a4b..88ef07c5a6 100644 --- a/lib/public_key/src/public_key.app.src +++ b/lib/public_key/src/public_key.app.src @@ -13,7 +13,9 @@ ]}, {applications, [asn1, crypto, kernel, stdlib]}, {registered, []}, - {env, []} + {env, []}, + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0","crypto-3.3", + "asn1-3.0"]} ] }. diff --git a/lib/public_key/vsn.mk b/lib/public_key/vsn.mk index 3473757c5f..f0450918aa 100644 --- a/lib/public_key/vsn.mk +++ b/lib/public_key/vsn.mk @@ -1 +1 @@ -PUBLIC_KEY_VSN = 0.21 +PUBLIC_KEY_VSN = 0.22 diff --git a/lib/reltool/src/reltool.app.src b/lib/reltool/src/reltool.app.src index 4188f341f1..65fcf4aae5 100644 --- a/lib/reltool/src/reltool.app.src +++ b/lib/reltool/src/reltool.app.src @@ -34,5 +34,7 @@ ]}, {registered, []}, {applications, [stdlib, kernel]}, - {env, []} + {env, []}, + {runtime_dependencies, ["wx-1.2","tools-2.6.14","stdlib-2.0","sasl-2.4", + "kernel-3.0","erts-6.0"]} ]}. diff --git a/lib/reltool/src/reltool.hrl b/lib/reltool/src/reltool.hrl index f0d8b38519..56161a152a 100644 --- a/lib/reltool/src/reltool.hrl +++ b/lib/reltool/src/reltool.hrl @@ -164,7 +164,8 @@ applications = [] :: [app_name()], env = [] :: [{atom(), term()}], mod = undefined :: {mod_name(), [term()]} | undefined, - start_phases = undefined :: [{atom(), term()}] | undefined + start_phases = undefined :: [{atom(), term()}] | undefined, + runtime_dependencies = [] :: [string()] }). -record(regexp, {source, compiled}). diff --git a/lib/reltool/src/reltool_server.erl b/lib/reltool/src/reltool_server.erl index 97785ca7f8..98eeed5c27 100644 --- a/lib/reltool/src/reltool_server.erl +++ b/lib/reltool/src/reltool_server.erl @@ -1125,6 +1125,9 @@ parse_app_info(File, [{Key, Val} | KeyVals], AI, Status) -> start_phases -> parse_app_info(File, KeyVals, AI#app_info{start_phases = Val}, Status); + runtime_dependencies -> + parse_app_info(File, KeyVals, AI#app_info{runtime_dependencies = Val}, + Status); _ -> Status2 = reltool_utils:add_warning("Unexpected item ~p in app file ~tp.", diff --git a/lib/reltool/vsn.mk b/lib/reltool/vsn.mk index 16ec570d22..163b77dfa0 100644 --- a/lib/reltool/vsn.mk +++ b/lib/reltool/vsn.mk @@ -1 +1 @@ -RELTOOL_VSN = 0.6.4.1 +RELTOOL_VSN = 0.6.5 diff --git a/lib/runtime_tools/c_src/Makefile.in b/lib/runtime_tools/c_src/Makefile.in index 2bcb93b4dd..d46b4997f7 100644 --- a/lib/runtime_tools/c_src/Makefile.in +++ b/lib/runtime_tools/c_src/Makefile.in @@ -101,7 +101,12 @@ endif _create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) +ifneq ($(findstring ose,$(TARGET)),ose) debug opt valgrind: $(SOLIBS) $(OBJDIR) $(LIBDIR) $(NIF_LIB) +else +# We do not build this on OSE +debug opt valgrind: +endif DYNTRACE_OBJS = $(before_DTrace_OBJS) @@ -153,8 +158,10 @@ include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt $(INSTALL_DIR) "$(RELSYSDIR)/priv/obj" $(INSTALL_DIR) "$(RELSYSDIR)/priv/lib" +ifneq ($(findstring ose,$(TARGET)),ose) $(INSTALL_PROGRAM) $(DYNTRACE_OBJS) "$(RELSYSDIR)/priv/obj" $(INSTALL_PROGRAM) $(NIF_LIB) $(SOLIBS) "$(RELSYSDIR)/priv/lib" +endif release_docs_spec: diff --git a/lib/runtime_tools/doc/specs/.gitignore b/lib/runtime_tools/doc/specs/.gitignore new file mode 100644 index 0000000000..322eebcb06 --- /dev/null +++ b/lib/runtime_tools/doc/specs/.gitignore @@ -0,0 +1 @@ +specs_*.xml diff --git a/lib/runtime_tools/doc/src/Makefile b/lib/runtime_tools/doc/src/Makefile index 51d93df418..07c63197e9 100644 --- a/lib/runtime_tools/doc/src/Makefile +++ b/lib/runtime_tools/doc/src/Makefile @@ -40,7 +40,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml -XML_REF3_FILES = dbg.xml dyntrace.xml erts_alloc_config.xml +XML_REF3_FILES = dbg.xml dyntrace.xml erts_alloc_config.xml system_information.xml XML_REF6_FILES = runtime_tools_app.xml XML_PART_FILES = part_notes.xml part_notes_history.xml part.xml @@ -71,12 +71,20 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf +SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) + +TOP_SPECS_FILE = specs.xml + # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- XML_FLAGS += DVIPS_FLAGS += +SPECS_ESRC = ../../src + +SPECS_FLAGS = -I../../include -I../../../kernel/src + # ---------------------------------------------------- # Targets # ---------------------------------------------------- diff --git a/lib/runtime_tools/doc/src/ref_man.xml b/lib/runtime_tools/doc/src/ref_man.xml index 6017f3cdaa..25fa97896b 100644 --- a/lib/runtime_tools/doc/src/ref_man.xml +++ b/lib/runtime_tools/doc/src/ref_man.xml @@ -35,5 +35,6 @@ <xi:include href="dbg.xml"/> <xi:include href="dyntrace.xml"/> <xi:include href="erts_alloc_config.xml"/> + <xi:include href="system_information.xml"/> </application> diff --git a/lib/runtime_tools/doc/src/specs.xml b/lib/runtime_tools/doc/src/specs.xml new file mode 100644 index 0000000000..d4c3c9dfe6 --- /dev/null +++ b/lib/runtime_tools/doc/src/specs.xml @@ -0,0 +1,4 @@ +<?xml version="1.0" encoding="utf-8" ?> +<specs xmlns:xi="http://www.w3.org/2001/XInclude"> + <xi:include href="../specs/specs_system_information.xml"/> +</specs> diff --git a/lib/runtime_tools/doc/src/system_information.xml b/lib/runtime_tools/doc/src/system_information.xml new file mode 100644 index 0000000000..b586334ae7 --- /dev/null +++ b/lib/runtime_tools/doc/src/system_information.xml @@ -0,0 +1,98 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2014</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + 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. + + </legalnotice> + + <title></title> + <prepared></prepared> + <responsible></responsible> + <docno>1</docno> + <approved></approved> + <checked></checked> + <date></date> + <rev></rev> + <file>system_information.xml</file> + </header> + <module>system_information</module> + <modulesummary>System Information</modulesummary> + <description> + <p></p> + </description> + <funcs> + <func> + <name name="sanity_check" arity="0"/> + <fsummary>Perform a sanity check</fsummary> + <desc> + <p>Performs a sanity check on the system. If no issues + were found, <c>ok</c> is returned. If issues were + found, <c>{failed, <anno>Failures</anno>}</c> is + returned. All failures found will be part of the + <c><anno>Failures</anno></c> list. Currently defined + <c><anno>Failure</anno></c> elements in the + <c><anno>Failures</anno></c> list:</p> + <taglist> + <tag><c><anno>InvalidAppFile</anno></c></tag> + <item><p>An application has an invalid <c>.app</c> file. The + second element identifies the application which has the + invalid <c>.app</c> file.</p></item> + <tag><c><anno>InvalidApplicationVersion</anno></c></tag> + <item><p>An application has an invalid application version. + The second element identifies the application version that + is invalid.</p></item> + <tag><c><anno>MissingRuntimeDependencies</anno></c></tag> + <item><p>An application is missing + <seealso marker="kernel:app#runtime_dependencies">runtime + dependencies</seealso>. The second element identifies the + application (with version) that has missing dependencies. + The third element contains the missing dependencies.</p> + <p>Note that this check use application versions that + are loaded, or will be loaded when used. You might have + application versions that satisfies all dependencies + installed in the system, but if those are not loaded this + check will fail. The system will of course also fail when + used like this. This may happen when you have multiple + <seealso marker="doc/system_principles:versions">branched + versions</seealso> of the same application installed in the + system, but you do not use a + <seealso marker="doc/system_principles:system_principles#BOOTSCRIPT">boot + script</seealso> identifing the correct application version.</p> + </item> + </taglist> + <p>Currently the sanity check is limited to verifying + runtime dependencies found in the <c>.app</c> files of + all applications. More checks will be introduced in the + future. This implies that the return type <em>will</em> + change in the future.</p> + <note><p>An <c>ok</c> return value only means that + <c>sanity_check/0</c> did not find any issues, <em>not</em> + that no issues exist.</p></note> + </desc> + </func> + <func> + <name name="to_file" arity="1"/> + <fsummary>Write miscellaneous system information to file</fsummary> + <desc><p>Writes miscellaneous system information to file. This + information will typically be requested by the Erlang/OTP team + at Ericsson AB when reporting an issue.</p></desc> + </func> + </funcs> + </erlref> + diff --git a/lib/runtime_tools/src/erts_alloc_config.erl b/lib/runtime_tools/src/erts_alloc_config.erl index 284e88d4a7..b9a26dc0dc 100644 --- a/lib/runtime_tools/src/erts_alloc_config.erl +++ b/lib/runtime_tools/src/erts_alloc_config.erl @@ -39,6 +39,8 @@ need_config_change, alloc_util, instances, + strategy, + acul, low_mbc_blocks_size, high_mbc_blocks_size, sbct, @@ -54,8 +56,6 @@ -define(SERVER, '__erts_alloc_config__'). --define(MAX_ALLOCATOR_INSTANCES, 16). - -define(KB, 1024). -define(MB, 1048576). @@ -99,23 +99,11 @@ {ets_alloc, 131072}, {fix_alloc, 131072}, {eheap_alloc, 524288}, - {ll_alloc, 2097152}, + {ll_alloc, 131072}, {sl_alloc, 131072}, {temp_alloc, 131072}, {driver_alloc, 131072}]). --define(MMMBC_DEFAULTS, - [{binary_alloc, 10}, - {std_alloc, 10}, - {ets_alloc, 10}, - {fix_alloc, 10}, - {eheap_alloc, 10}, - {ll_alloc, 0}, - {sl_alloc, 10}, - {temp_alloc, 10}, - {driver_alloc, 10}]). - - %%% %%% Exported interface %%% @@ -230,20 +218,72 @@ server_loop(State) -> end, server_loop(NewState). -allocator_instances(temp_alloc) -> - erlang:system_info(schedulers) + 1; -allocator_instances(ll_alloc) -> +carrier_migration_support(aoff) -> + true; +carrier_migration_support(aoffcbf) -> + true; +carrier_migration_support(aoffcaobf) -> + true; +carrier_migration_support(_) -> + false. + +allocator_instances(ll_alloc, Strategy) -> + case carrier_migration_support(Strategy) of + true -> erlang:system_info(schedulers); + false -> 1 + end; +allocator_instances(_A, undefined) -> 1; -allocator_instances(_Allocator) -> - case erlang:system_info(schedulers) of - Schdlrs when Schdlrs =< ?MAX_ALLOCATOR_INSTANCES -> Schdlrs; - _Schdlrs -> ?MAX_ALLOCATOR_INSTANCES +allocator_instances(_A, _Strategy) -> + erlang:system_info(schedulers). + +strategy(temp_alloc, _AI) -> + af; +strategy(A, AI) -> + try + {A, OptList} = lists:keyfind(A, 1, AI), + {as, S} = lists:keyfind(as, 1, OptList), + S + catch + _ : _ -> + undefined + end. + +strategy_str(af) -> + "A fit"; +strategy_str(gf) -> + "Good fit"; +strategy_str(bf) -> + "Best fit"; +strategy_str(aobf) -> + "Address order best fit"; +strategy_str(aoff) -> + "Address order first fit"; +strategy_str(aoffcbf) -> + "Address order first fit carrier best fit"; +strategy_str(aoffcaobf) -> + "Address order first fit carrier adress order best fit". + +default_acul(A, S) -> + case carrier_migration_support(S) of + false -> + 0; + true -> + case A of + ll_alloc -> 85; + eheap_alloc -> 45; + _ -> 60 + end end. - + make_state() -> + {_, _, _, AI} = erlang:system_info(allocator), #state{alloc = lists:map(fun (A) -> + S = strategy(A, AI), #alloc{name = A, - instances = allocator_instances(A)} + strategy = S, + acul = default_acul(A, S), + instances = allocator_instances(A, S)} end, ?ALLOCATORS)}. @@ -345,7 +385,7 @@ do_save_scenario(AlcList) -> conf_size(Bytes) when is_integer(Bytes), Bytes < 0 -> exit({bad_value, Bytes}); conf_size(Bytes) when is_integer(Bytes), Bytes < 1*?MB -> - ?ROUNDUP(?B2KB(Bytes), 128); + ?ROUNDUP(?B2KB(Bytes), 256); conf_size(Bytes) when is_integer(Bytes), Bytes < 10*?MB -> ?ROUNDUP(?B2KB(Bytes), ?B2KB(1*?MB)); conf_size(Bytes) when is_integer(Bytes), Bytes < 100*?MB -> @@ -376,28 +416,25 @@ mmbcs(#conf{format_to = FTO}, temp_alloc -> BlocksSize; _ -> BlocksSize div Insts end, - case BS > default_mmbcs(A, Insts) of - true -> + DefMMBCS = default_mmbcs(A, Insts), + case {Insts, BS > DefMMBCS} of + {1, true} -> MMBCS = conf_size(BS), fc(FTO, "Main mbc size of ~p kilobytes.", [MMBCS]), format(FTO, " +M~cmmbcs ~p~n", [alloc_char(A), MMBCS]); - false -> + _ -> + MMBCS = ?B2KB(DefMMBCS), + fc(FTO, "Main mbc size of ~p kilobytes.", [MMBCS]), + format(FTO, " +M~cmmbcs ~p~n", [alloc_char(A), MMBCS]), ok end. -smbcs_lmbcs_mmmbc(#conf{format_to = FTO}, - #alloc{name = A, instances = Insts, segments = Segments}) -> - MMMBC = case {A, Insts} of - {_, 1} -> Segments#segment.number; - {temp_alloc, _} -> Segments#segment.number; - _ -> (Segments#segment.number div Insts) + 1 - end, +smbcs_lmbcs(#conf{format_to = FTO}, + #alloc{name = A, segments = Segments}) -> MBCS = Segments#segment.size, AC = alloc_char(A), fc(FTO, "Mseg mbc size of ~p kilobytes.", [MBCS]), format(FTO, " +M~csmbcs ~p +M~clmbcs ~p~n", [AC, MBCS, AC, MBCS]), - fc(FTO, "Max ~p mseg mbcs.", [MMMBC]), - format(FTO, " +M~cmmmbc ~p~n", [AC, MMMBC]), ok. alloc_char(binary_alloc) -> $B; @@ -462,6 +499,8 @@ au_conf_alloc(#conf{format_to = FTO} = Conf, #alloc{name = A, alloc_util = true, instances = Insts, + acul = Acul, + strategy = Strategy, low_mbc_blocks_size = Low, high_mbc_blocks_size = High} = Alc) -> fcp(FTO, "Usage of mbcs: ~p - ~p kilobytes", [?B2KB(Low), ?B2KB(High)]), @@ -470,31 +509,49 @@ au_conf_alloc(#conf{format_to = FTO} = Conf, fc(FTO, "One instance used."), format(FTO, " +M~ct false~n", [alloc_char(A)]); _ -> - fc(FTO, "~p instances used.", + fc(FTO, "~p + 1 instances used.", [Insts]), - format(FTO, " +M~ct true~n", [alloc_char(A)]) - end, + format(FTO, " +M~ct true~n", [alloc_char(A)]), + case Strategy of + undefined -> + ok; + _ -> + fc(FTO, "Allocation strategy: ~s.", + [strategy_str(Strategy)]), + format(FTO, " +M~cas ~s~n", [alloc_char(A), + atom_to_list(Strategy)]) + end, + case carrier_migration_support(Strategy) of + false -> + ok; + true -> + fc(FTO, "Abandon carrier utilization limit of ~p%.", [Acul]), + format(FTO, " +M~cacul ~p~n", [alloc_char(A), Acul]) + end + end, mmbcs(Conf, Alc), - smbcs_lmbcs_mmmbc(Conf, Alc), + smbcs_lmbcs(Conf, Alc), sbct(Conf, Alc). -large_growth(Low, High) -> - High - Low >= ?LARGE_GROWTH_ABS_LIMIT. - calc_seg_size(Growth, Segs) -> conf_size(round(Growth*?FRAG_FACT*?GROWTH_SEG_FACT) div Segs). calc_growth_segments(Conf, AlcList0) -> - CalcSmall = fun (#alloc{name = ll_alloc} = Alc, Acc) -> - {Alc#alloc{segments = #segment{size = 0, + CalcSmall = fun (#alloc{name = ll_alloc, instances = 1} = Alc, Acc) -> + {Alc#alloc{segments = #segment{size = conf_size(0), number = 0}}, Acc}; (#alloc{alloc_util = true, - low_mbc_blocks_size = Low, + instances = Insts, + low_mbc_blocks_size = LowMBC, high_mbc_blocks_size = High} = Alc, {SL, AL}) -> + Low = case Insts of + 1 -> LowMBC; + _ -> 0 + end, Growth = High - Low, - case large_growth(Low, High) of + case Growth >= ?LARGE_GROWTH_ABS_LIMIT of true -> {Alc, {SL, AL+1}}; false -> @@ -522,8 +579,13 @@ calc_growth_segments(Conf, AlcList0) -> end, CalcLarge = fun (#alloc{alloc_util = true, segments = undefined, - low_mbc_blocks_size = Low, + instances = Insts, + low_mbc_blocks_size = LowMBC, high_mbc_blocks_size = High} = Alc) -> + Low = case Insts of + 1 -> LowMBC; + _ -> 0 + end, Growth = High - Low, SegSize = calc_seg_size(Growth, SegsPerAlloc), @@ -560,15 +622,10 @@ format_header(FTO) -> case erlang:system_info(schedulers) of 1 -> ok; Schdlrs -> - MinSchdlrs = case Schdlrs > ?MAX_ALLOCATOR_INSTANCES of - true -> ?MAX_ALLOCATOR_INSTANCES; - false -> Schdlrs - end, fcp(FTO, "NOTE: This configuration was made for ~p schedulers. " - "It is very important that at least ~p schedulers " - "are used.", - [Schdlrs, MinSchdlrs]) + "It is very important that ~p schedulers are used.", + [Schdlrs, Schdlrs]) end, fcp(FTO, "This configuration is intended as a suggestion and " diff --git a/lib/runtime_tools/src/runtime_tools.app.src b/lib/runtime_tools/src/runtime_tools.app.src index d46cfe1f32..0a70802c08 100644 --- a/lib/runtime_tools/src/runtime_tools.app.src +++ b/lib/runtime_tools/src/runtime_tools.app.src @@ -25,6 +25,8 @@ {registered, [runtime_tools_sup]}, {applications, [kernel, stdlib]}, {env, []}, - {mod, {runtime_tools, []}}]}. + {mod, {runtime_tools, []}}, + {runtime_dependencies, ["stdlib-2.0","mnesia-4.12","kernel-3.0", + "erts-6.0"]}]}. diff --git a/lib/runtime_tools/src/system_information.erl b/lib/runtime_tools/src/system_information.erl index 603b698d5e..f541d6e449 100644 --- a/lib/runtime_tools/src/system_information.erl +++ b/lib/runtime_tools/src/system_information.erl @@ -39,7 +39,8 @@ application/1, application/2, environment/0, environment/1, module/1, module/2, - modules/1 + modules/1, + sanity_check/0 ]). %% gen_server callbacks @@ -85,9 +86,14 @@ report() -> [ {erts_compile_info, erlang:system_info(compile_info)}, {beam_dynamic_libraries, get_dynamic_libraries()}, {environment_erts, os_getenv_erts_specific()}, - {environment, [split_env(Env) || Env <- os:getenv()]} + {environment, [split_env(Env) || Env <- os:getenv()]}, + {sanity_check, sanity_check()} ]. +-spec to_file(FileName) -> ok | {error, Reason} when + FileName :: file:name_all(), + Reason :: file:posix() | badarg | terminated | system_limit. + to_file(File) -> file:write_file(File, iolist_to_binary([ io_lib:format("{system_information_version, ~p}.~n", [ @@ -130,6 +136,27 @@ module(M, Opts) when is_atom(M), is_list(Opts) -> modules(Opt) when is_atom(Opt) -> gen_server:call(?SERVER, {modules, Opt}). + +-spec sanity_check() -> ok | {failed, Failures} when + Application :: atom(), + ApplicationVersion :: string(), + MissingRuntimeDependencies :: {missing_runtime_dependencies, + ApplicationVersion, + [ApplicationVersion]}, + InvalidApplicationVersion :: {invalid_application_version, + ApplicationVersion}, + InvalidAppFile :: {invalid_app_file, Application}, + Failure :: MissingRuntimeDependencies + | InvalidApplicationVersion + | InvalidAppFile, + Failures :: [Failure]. + +sanity_check() -> + case check_runtime_dependencies() of + [] -> ok; + Issues -> {failed, Issues} + end. + %%=================================================================== %% gen_server callbacks %%=================================================================== @@ -457,6 +484,8 @@ get_application_from_path(Path) -> {description, proplists:get_value(description, Info, [])}, {vsn, proplists:get_value(vsn, Info, [])}, {path, Path}, + {runtime_dependencies, + proplists:get_value(runtime_dependencies, Info, [])}, {modules, get_modules_from_path(Path)} ]} end. @@ -552,3 +581,252 @@ get_beam_name() -> Value -> Value end, Beam ++ Type ++ Flavor. + +%% Check runtime dependencies... + +vsnstr2vsn(VsnStr) -> + list_to_tuple(lists:map(fun (Part) -> + list_to_integer(Part) + end, + string:tokens(VsnStr, "."))). + +rtdepstrs2rtdeps([]) -> + []; +rtdepstrs2rtdeps([RTDep | RTDeps]) -> + [AppStr, VsnStr] = string:tokens(RTDep, "-"), + [{list_to_atom(AppStr), vsnstr2vsn(VsnStr)} | rtdepstrs2rtdeps(RTDeps)]. + +build_app_table([], AppTab) -> + AppTab; +build_app_table([App | Apps], AppTab0) -> + AppTab1 = try + %% We may have multiple application versions installed + %% of the same application! It is therefore important + %% to look up the application version that actually will + %% be used via code server. + AppFile = code:where_is_file(atom_to_list(App) ++ ".app"), + {ok, [{application, App, Info}]} = file:consult(AppFile), + VsnStr = proplists:get_value(vsn, Info), + Vsn = vsnstr2vsn(VsnStr), + RTDepStrs = proplists:get_value(runtime_dependencies, + Info, []), + RTDeps = rtdepstrs2rtdeps(RTDepStrs), + gb_trees:insert(App, {Vsn, RTDeps}, AppTab0) + catch + _ : _ -> + AppTab0 + end, + build_app_table(Apps, AppTab1). + +meets_min_req(Vsn, Vsn) -> + true; +meets_min_req({X}, VsnReq) -> + meets_min_req({X, 0, 0}, VsnReq); +meets_min_req({X, Y}, VsnReq) -> + meets_min_req({X, Y, 0}, VsnReq); +meets_min_req(Vsn, {X}) -> + meets_min_req(Vsn, {X, 0, 0}); +meets_min_req(Vsn, {X, Y}) -> + meets_min_req(Vsn, {X, Y, 0}); +meets_min_req({X, _Y, _Z}, {XReq, _YReq, _ZReq}) when X > XReq -> + true; +meets_min_req({X, Y, _Z}, {X, YReq, _ZReq}) when Y > YReq -> + true; +meets_min_req({X, Y, Z}, {X, Y, ZReq}) when Z > ZReq -> + true; +meets_min_req({_X, _Y, _Z}, {_XReq, _YReq, _ZReq}) -> + false; +meets_min_req(Vsn, VsnReq) -> + gp_meets_min_req(mk_gp_vsn_list(Vsn), mk_gp_vsn_list(VsnReq)). + +gp_meets_min_req([X, Y, Z | _Vs], [X, Y, Z]) -> + true; +gp_meets_min_req([X, Y, Z | _Vs], [XReq, YReq, ZReq]) -> + meets_min_req({X, Y, Z}, {XReq, YReq, ZReq}); +gp_meets_min_req([X, Y, Z | Vs], [X, Y, Z | VReqs]) -> + gp_meets_min_req_tail(Vs, VReqs); +gp_meets_min_req(_Vsn, _VReq) -> + %% Versions on different version branches, i.e., the minimum + %% required functionality is not included in Vsn. + false. + +gp_meets_min_req_tail([V | Vs], [V | VReqs]) -> + gp_meets_min_req_tail(Vs, VReqs); +gp_meets_min_req_tail([], []) -> + true; +gp_meets_min_req_tail([_V | _Vs], []) -> + true; +gp_meets_min_req_tail([V | _Vs], [VReq]) when V > VReq -> + true; +gp_meets_min_req_tail(_Vs, _VReqs) -> + %% Versions on different version branches, i.e., the minimum + %% required functionality is not included in Vsn. + false. + +mk_gp_vsn_list(Vsn) -> + [X, Y, Z | Tail] = tuple_to_list(Vsn), + [X, Y, Z | remove_trailing_zeroes(Tail)]. + +remove_trailing_zeroes([]) -> + []; +remove_trailing_zeroes([0 | Vs]) -> + case remove_trailing_zeroes(Vs) of + [] -> []; + NewVs -> [0 | NewVs] + end; +remove_trailing_zeroes([V | Vs]) -> + [V | remove_trailing_zeroes(Vs)]. + +mk_app_vsn_str({App, Vsn}) -> + mk_app_vsn_str(App, Vsn). + +mk_app_vsn_str(App, Vsn) -> + VsnList = tuple_to_list(Vsn), + lists:flatten([atom_to_list(App), + $-, + integer_to_list(hd(VsnList)), + lists:map(fun (Part) -> + [$., integer_to_list(Part)] + end, tl(VsnList))]). + +otp_17_0_vsns_orddict() -> + [{asn1,{3,0}}, + {common_test,{1,8}}, + {compiler,{5,0}}, + {cosEvent,{2,1,15}}, + {cosEventDomain,{1,1,14}}, + {cosFileTransfer,{1,1,16}}, + {cosNotification,{1,1,21}}, + {cosProperty,{1,1,17}}, + {cosTime,{1,1,14}}, + {cosTransactions,{1,2,14}}, + {crypto,{3,3}}, + {debugger,{4,0}}, + {dialyzer,{2,7}}, + {diameter,{1,6}}, + {edoc,{0,7,13}}, + {eldap,{1,0,3}}, + {erl_docgen,{0,3,5}}, + {erl_interface,{3,7,16}}, + {erts,{6,0}}, + {et,{1,5}}, + {eunit,{2,2,7}}, + {gs,{1,5,16}}, + {hipe,{3,10,3}}, + {ic,{4,3,5}}, + {inets,{5,10}}, + {jinterface,{1,5,9}}, + {kernel,{3,0}}, + {megaco,{3,17,1}}, + {mnesia,{4,12}}, + {observer,{2,0}}, + {odbc,{2,10,20}}, + {orber,{3,6,27}}, + {os_mon,{2,2,15}}, + {ose,{1,0}}, + {otp_mibs,{1,0,9}}, + {parsetools,{2,0,11}}, + {percept,{0,8,9}}, + {public_key,{0,22}}, + {reltool,{0,6,5}}, + {runtime_tools,{1,8,14}}, + {sasl,{2,4}}, + {snmp,{4,25,1}}, + {ssh,{3,0,1}}, + {ssl,{5,3,4}}, + {stdlib,{2,0}}, + {syntax_tools,{1,6,14}}, + {test_server,{3,7}}, + {tools,{2,6,14}}, + {typer,{0,9,6}}, + {webtool,{0,8,10}}, + {wx,{1,2}}, + {xmerl,{1,3,7}}]. + +otp_17_0_vsns_tab() -> + gb_trees:from_orddict(otp_17_0_vsns_orddict()). + +check_runtime_dependency({App, DepVsn}, AppTab) -> + case gb_trees:lookup(App, AppTab) of + none -> + false; + {value, {Vsn, _}} -> + meets_min_req(Vsn, DepVsn) + end. + +check_runtime_dependencies(App, AppTab, OtpMinVsnTab) -> + case gb_trees:lookup(App, AppTab) of + none -> + [{invalid_app_file, App}]; + {value, {Vsn, RTDeps}} -> + RTD = case lists:foldl( + fun (RTDep, Acc) -> + case check_runtime_dependency(RTDep, AppTab) of + true -> + Acc; + false -> + [mk_app_vsn_str(RTDep) | Acc] + end + end, + [], + RTDeps) of + [] -> + []; + MissingDeps -> + [{missing_runtime_dependencies, + mk_app_vsn_str(App, Vsn), + MissingDeps}] + end, + case gb_trees:lookup(App, OtpMinVsnTab) of + none -> + RTD; + {value, MinVsn} -> + case meets_min_req(Vsn, MinVsn) of + true -> + RTD; + false -> + [{invalid_application_version, + mk_app_vsn_str(App, Vsn)} | RTD] + end + end + end. + +app_file_to_app(AF) -> + list_to_atom(filename:basename(AF, ".app")). + +get_apps() -> + get_apps(code:get_path(), []). + +get_apps([], Apps) -> + lists:usort(Apps); +get_apps([Path|Paths], Apps) -> + case filelib:wildcard(filename:join(Path, "*.app")) of + [] -> + %% Not app or invalid app + get_apps(Paths, Apps); + [AppFile] -> + get_apps(Paths, [app_file_to_app(AppFile) | Apps]); + [_AppFile| _] = AppFiles -> + %% Strange with multple .app files... Lets put them + %% all in the list and see what we get... + lists:map(fun (AF) -> + app_file_to_app(AF) + end, AppFiles) ++ Apps + end. + +check_runtime_dependencies() -> + OtpMinVsnTab = otp_17_0_vsns_tab(), + Apps = get_apps(), + AppTab = build_app_table(Apps, gb_trees:empty()), + lists:foldl(fun (App, Acc) -> + case check_runtime_dependencies(App, + AppTab, + OtpMinVsnTab) of + [] -> Acc; + Issues -> Issues ++ Acc + end + end, + [], + Apps). + +%% End of runtime dependency checks diff --git a/lib/runtime_tools/test/system_information_SUITE.erl b/lib/runtime_tools/test/system_information_SUITE.erl index fb9455a30f..53d20060e7 100644 --- a/lib/runtime_tools/test/system_information_SUITE.erl +++ b/lib/runtime_tools/test/system_information_SUITE.erl @@ -33,6 +33,7 @@ api_report/1, api_to_file/1, api_from_file/1, + sanity_check/1, %% server api_start_stop/1, validate_server_interface/1 @@ -84,7 +85,8 @@ all() -> [ api_to_file, api_from_file, api_start_stop, - validate_server_interface + validate_server_interface, + sanity_check ]. @@ -262,6 +264,9 @@ validate_server_interface(Config) -> ok = system_information:stop(), ok. +sanity_check(Config) when is_list(Config) -> + ok = system_information:sanity_check(). + %% aux @@ -288,7 +293,8 @@ validate_report(Report) -> erts_compile_info, beam_dynamic_libraries, environment_erts, - environment + environment, + sanity_check ], Report). ensure_report_keys([], _) -> ok; diff --git a/lib/runtime_tools/test/system_information_SUITE_data/information_test_report.dat b/lib/runtime_tools/test/system_information_SUITE_data/information_test_report.dat index 0900eadd4a..18938372a3 100644 --- a/lib/runtime_tools/test/system_information_SUITE_data/information_test_report.dat +++ b/lib/runtime_tools/test/system_information_SUITE_data/information_test_report.dat @@ -9870,4 +9870,5 @@ {"MANPATH", "/usr/local/man:/usr/share/man:/usr/X11R6/man:/opt/gnome/share/man"}, {"LESSKEY","/etc/lesskey.bin"}, - {"LC_PAPER","sv_SE.UTF-8"}]}]}. + {"LC_PAPER","sv_SE.UTF-8"}]}, + {sanity_check,ok}]}. diff --git a/lib/runtime_tools/vsn.mk b/lib/runtime_tools/vsn.mk index c282661a61..32953dfc5a 100644 --- a/lib/runtime_tools/vsn.mk +++ b/lib/runtime_tools/vsn.mk @@ -1 +1 @@ -RUNTIME_TOOLS_VSN = 1.8.13 +RUNTIME_TOOLS_VSN = 1.8.14 diff --git a/lib/sasl/src/sasl.app.src b/lib/sasl/src/sasl.app.src index 8c814cfaf5..8e95197a2a 100644 --- a/lib/sasl/src/sasl.app.src +++ b/lib/sasl/src/sasl.app.src @@ -44,5 +44,7 @@ {applications, [kernel, stdlib]}, {env, [{sasl_error_logger, tty}, {errlog_type, all}]}, - {mod, {sasl, []}}]}. + {mod, {sasl, []}}, + {runtime_dependencies, ["tools-2.6.14","stdlib-2.0","kernel-3.0", + "erts-6.0"]}]}. diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index 3d370a93a5..e5da797efb 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -2233,7 +2233,7 @@ format_error({undefined_applications,Apps}) -> io_lib:format("Undefined applications: ~p~n",[Apps]); format_error({duplicate_modules,Dups}) -> io_lib:format("Duplicated modules: ~n~ts", - [map(fun({{Mod,_,App1,_,_},{Mod,_,App2,_,_}}) -> + [map(fun({{Mod,App1,_},{Mod,App2,_}}) -> io_lib:format("\t~w specified in ~w and ~w~n", [Mod,App1,App2]) end, Dups)]); diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl index e3f6933476..1d3a71e94e 100644 --- a/lib/sasl/test/systools_SUITE.erl +++ b/lib/sasl/test/systools_SUITE.erl @@ -47,6 +47,7 @@ abnormal_script/1, src_tests_script/1, crazy_script/1, included_script/1, included_override_script/1, included_fail_script/1, included_bug_script/1, exref_script/1, + duplicate_modules_script/1, otp_3065_circular_dependenies/1, included_and_used_sort_script/1]). -export([tar_options/1, normal_tar/1, no_mod_vsn_tar/1, system_files_tar/1, system_files_tar/2, invalid_system_files_tar/1, @@ -84,6 +85,7 @@ groups() -> src_tests_script, crazy_script, included_script, included_override_script, included_fail_script, included_bug_script, exref_script, + duplicate_modules_script, otp_3065_circular_dependenies, included_and_used_sort_script]}, {tar, [], [tar_options, normal_tar, no_mod_vsn_tar, system_files_tar, @@ -822,6 +824,33 @@ no_hipe({ok, Value}) -> {ok, Value} end. +%% duplicate_modules_script: Check that make_script rejects two +%% applications providing the same module. +duplicate_modules_script(Config) when is_list(Config) -> + {ok, OldDir} = file:get_cwd(), + + {LatestDir, LatestName} = create_script(duplicate_modules,Config), + + DataDir = filename:absname(?copydir), + + ok = file:set_cwd(LatestDir), + LibDir = fname([DataDir, d_duplicate_modules, lib]), + P = [fname([LibDir, 'app1-1.0', ebin]), + fname([LibDir, 'app2-1.0', ebin])], + + %% Check wrong app vsn + error = systools:make_script(LatestName, [{path, P}]), + {error, + systools_make, + {duplicate_modules, [ + {{myapp,app1,_}, {myapp,app2,_}} + ] + } + } = systools:make_script(LatestName, [silent, {path, P}]), + + ok = file:set_cwd(OldDir), + ok. + %% tar_options: Check illegal tar options. tar_options(Config) when is_list(Config) -> {'EXIT',{{badarg,[{path,["Path",12,"Another"]}]}, _}} = @@ -2186,7 +2215,10 @@ create_script(current_all_future_sasl,Config) -> do_create_script(current_all_future_sasl,Config,current,Apps); create_script({unicode,RelVsn},Config) -> Apps = core_apps(current) ++ [{ua,"1.0"}], - do_create_script(unicode,RelVsn,Config,current,Apps). + do_create_script(unicode,RelVsn,Config,current,Apps); +create_script(duplicate_modules,Config) -> + Apps = core_apps(current) ++ [{app1,"1.0"},{app2,"1.0"}], + do_create_script(duplicate_modules,Config,current,Apps). do_create_script(Id,Config,ErtsVsn,AppVsns) -> diff --git a/lib/sasl/test/systools_SUITE_data/d_duplicate_modules/lib/app1-1.0/ebin/app1.app b/lib/sasl/test/systools_SUITE_data/d_duplicate_modules/lib/app1-1.0/ebin/app1.app new file mode 100644 index 0000000000..dea9257f2f --- /dev/null +++ b/lib/sasl/test/systools_SUITE_data/d_duplicate_modules/lib/app1-1.0/ebin/app1.app @@ -0,0 +1,7 @@ +{application, app1, + [{description, "Application 1"}, + {vsn, "1.0"}, + {modules, [myapp]}, + {registered, []}, + {applications, []}, + {env, []}]}. diff --git a/lib/sasl/test/systools_SUITE_data/d_duplicate_modules/lib/app1-1.0/src/myapp.erl b/lib/sasl/test/systools_SUITE_data/d_duplicate_modules/lib/app1-1.0/src/myapp.erl new file mode 100644 index 0000000000..bf2ab7c79c --- /dev/null +++ b/lib/sasl/test/systools_SUITE_data/d_duplicate_modules/lib/app1-1.0/src/myapp.erl @@ -0,0 +1,2 @@ +-module(myapp). +-vsn("1.0"). diff --git a/lib/sasl/test/systools_SUITE_data/d_duplicate_modules/lib/app2-1.0/ebin/app2.app b/lib/sasl/test/systools_SUITE_data/d_duplicate_modules/lib/app2-1.0/ebin/app2.app new file mode 100644 index 0000000000..476750d8b2 --- /dev/null +++ b/lib/sasl/test/systools_SUITE_data/d_duplicate_modules/lib/app2-1.0/ebin/app2.app @@ -0,0 +1,7 @@ +{application, app2, + [{description, "Application 2"}, + {vsn, "1.0"}, + {modules, [myapp]}, + {registered, []}, + {applications, []}, + {env, []}]}. diff --git a/lib/sasl/test/systools_SUITE_data/d_duplicate_modules/lib/app2-1.0/src/myapp.erl b/lib/sasl/test/systools_SUITE_data/d_duplicate_modules/lib/app2-1.0/src/myapp.erl new file mode 100644 index 0000000000..bf2ab7c79c --- /dev/null +++ b/lib/sasl/test/systools_SUITE_data/d_duplicate_modules/lib/app2-1.0/src/myapp.erl @@ -0,0 +1,2 @@ +-module(myapp). +-vsn("1.0"). diff --git a/lib/snmp/doc/src/snmpa_mib_data.xml b/lib/snmp/doc/src/snmpa_mib_data.xml index c1ea0a91f9..95a33e603e 100644 --- a/lib/snmp/doc/src/snmpa_mib_data.xml +++ b/lib/snmp/doc/src/snmpa_mib_data.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="iso-8859-1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE erlref SYSTEM "erlref.dtd"> <erlref> <header> <copyright> - <year>2013</year><year>2013</year> + <year>2013</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/snmp/doc/src/snmpa_mib_storage.xml b/lib/snmp/doc/src/snmpa_mib_storage.xml index a857ce79e8..791fbc80fe 100644 --- a/lib/snmp/doc/src/snmpa_mib_storage.xml +++ b/lib/snmp/doc/src/snmpa_mib_storage.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="iso-8859-1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE erlref SYSTEM "erlref.dtd"> <erlref> <header> <copyright> - <year>2013</year><year>2013</year> + <year>2013</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/snmp/src/app/snmp.app.src b/lib/snmp/src/app/snmp.app.src index 904d17954b..cbd292e4c3 100644 --- a/lib/snmp/src/app/snmp.app.src +++ b/lib/snmp/src/app/snmp.app.src @@ -136,4 +136,6 @@ %% configuration and use), and in that case mnesia must also be started, %% before snmp. {applications, [kernel, stdlib]}, - {mod, {snmp_app, []}}]}. + {mod, {snmp_app, []}}, + {runtime_dependencies, ["stdlib-2.0","runtime_tools-1.8.14","mnesia-4.12", + "kernel-3.0","erts-6.0","crypto-3.3"]}]}. diff --git a/lib/snmp/test/Makefile b/lib/snmp/test/Makefile index f22b7ea8ee..7bc9dd07d4 100644 --- a/lib/snmp/test/Makefile +++ b/lib/snmp/test/Makefile @@ -93,10 +93,10 @@ ifeq ($(SNMP_DEBUG),e) SNMP_FLAGS += -Dsnmp_error endif ifeq ($(SNMP_DEBUG),l) - SNMP_FLAGS += -Dsnmp_log + SNMP_FLAGS += -Dsnmp_error -Dsnmp_log endif ifeq ($(SNMP_DEBUG),d) - SNMP_FLAGS += -Dsnmp_debug + SNMP_FLAGS += -Dsnmp_error -Dsnmp_log -Dsnmp_debug endif ifeq ($(DONT_USE_TS),true) diff --git a/lib/snmp/test/modules.mk b/lib/snmp/test/modules.mk index 3d658bf8e8..fd8315ec4d 100644 --- a/lib/snmp/test/modules.mk +++ b/lib/snmp/test/modules.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2012. All Rights Reserved. +# Copyright Ericsson AB 2004-2014. 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 @@ -42,6 +42,7 @@ TEST_UTIL_MODULES = \ snmp_test_manager \ snmp_test_mgr \ snmp_test_mgr_misc \ + snmp_test_mgr_counter_server \ sa \ klas3 \ test1 \ diff --git a/lib/snmp/test/snmp_agent_test.erl b/lib/snmp/test/snmp_agent_test.erl index 89a6ce1253..2a9f2e842d 100644 --- a/lib/snmp/test/snmp_agent_test.erl +++ b/lib/snmp/test/snmp_agent_test.erl @@ -19,10 +19,6 @@ -module(snmp_agent_test). -%% TODO -%% * Test fault-tolerance (kill master etc) -%% - -export([ all/0, groups/0, @@ -41,7 +37,7 @@ v1_processing/1, big/1, big2/1, - loop_mib/1, + loop_mib_1/1, api/1, subagent/1, mnesia/1, @@ -394,8 +390,9 @@ usm_read/0, usm_del_user/0, usm_bad/0, - loop_mib_1/0, - loop_mib_2/0, + loop_mib_1_test/0, + loop_mib_2_test/0, + loop_mib_3_test/0, otp_1129_i/1, otp_1162_test/0, otp_1131_test/0, @@ -546,8 +543,9 @@ groups() -> init_per_suite(Config0) when is_list(Config0) -> - ?DBG("init_per_suite -> entry with" - "~n Config0: ~p", [Config0]), + p("init_per_suite -> entry with" + "~n Config: ~p" + "~n Nodes: ~p", [Config0, erlang:nodes()]), Config1 = snmp_test_lib:init_suite_top_dir(?MODULE, Config0), Config2 = snmp_test_lib:fix_data_dir(Config1), @@ -558,16 +556,32 @@ init_per_suite(Config0) when is_list(Config0) -> Config3 = [{mib_dir, MibDir}, {std_mib_dir, StdMibDir} | Config2], - ?DBG("init_per_suite -> end with" - "~n Config3: ~p", [Config3]), + snmp_test_mgr_counter_server:start(), + + p("init_per_suite -> end when" + "~n Config: ~p" + "~n Nodes: ~p", [Config3, erlang:nodes()]), Config3. end_per_suite(Config) when is_list(Config) -> - ?DBG("end_per_suite -> entry with" - "~n Config: ~p", [Config]), + p("end_per_suite -> entry with" + "~n Config: ~p" + "~n Nodes: ~p", [Config, erlang:nodes()]), + + case snmp_test_mgr_counter_server:stop() of + {ok, _Counters} -> + p("end_per_suite -> sucessfully stopped counter server" + "~n Counters: ~p", [_Counters]); + + {error, Reason} -> + p("end_per_suite -> failed stopping counter server" + "~n Reason: ~p", [Reason]) + end, + p("end_per_suite -> end when" + "~n Nodes: ~p", [erlang:nodes()]), Config. @@ -675,10 +689,16 @@ end_per_group(_GroupName, Config) -> %% ---- Init Per TestCase ---- init_per_testcase(Case, Config) when is_list(Config) -> - ?DBG("init_per_testcase -> entry with" - "~n Config: ~p", [Config]), + p("init_per_testcase -> entry with" + "~n Config: ~p" + "~n Nodes: ~p", [Config, erlang:nodes()]), - init_per_testcase1(Case, Config). + Result = init_per_testcase1(Case, Config), + + p("init_per_testcase -> done when" + "~n Result: ~p" + "~n Nodes: ~p", [Result, erlang:nodes()]), + Result. init_per_testcase1(otp8395 = Case, Config) when is_list(Config) -> ?DBG("init_per_testcase1 -> entry with" @@ -719,12 +739,18 @@ init_per_testcase1(_Case, Config) when is_list(Config) -> %% ---- End Per TestCase ---- end_per_testcase(Case, Config) when is_list(Config) -> - ?DBG("end_per_testcase -> entry with" - "~n Config: ~p", [Config]), + p("end_per_testcase -> entry with" + "~n Config: ~p" + "~n Nodes: ~p", [Config, erlang:nodes()]), display_log(Config), - end_per_testcase1(Case, Config). + Result = end_per_testcase1(Case, Config), + + p("end_per_testcase -> done with" + "~n Result: ~p" + "~n Nodes: ~p", [Result, erlang:nodes()]), + Result. end_per_testcase1(otp8395, Config) when is_list(Config) -> otp8395({fin, Config}); @@ -1173,7 +1199,7 @@ mse_simple(X) -> ?P(mse_simple), simple(X). mse_v1_processing(X) -> ?P(mse_v1_processing), v1_processing(X). mse_big(X) -> ?P(mse_big), big(X). mse_big2(X) -> ?P(mse_big2), big2(X). -mse_loop_mib(X) -> ?P(mse_loop_mib), loop_mib(X). +mse_loop_mib(X) -> ?P(mse_loop_mib), loop_mib_1(X). mse_api(X) -> ?P(mse_api), api(X). mse_sa_register(X) -> ?P(mse_sa_register), sa_register(X). mse_v1_trap(X) -> ?P(mse_v1_trap), v1_trap(X). @@ -1194,7 +1220,7 @@ msd_simple(X) -> ?P(msd_simple), simple(X). msd_v1_processing(X) -> ?P(msd_v1_processing), v1_processing(X). msd_big(X) -> ?P(msd_big), big(X). msd_big2(X) -> ?P(msd_big2), big2(X). -msd_loop_mib(X) -> ?P(msd_loop_mib), loop_mib(X). +msd_loop_mib(X) -> ?P(msd_loop_mib), loop_mib_1(X). msd_api(X) -> ?P(msd_api), api(X). msd_sa_register(X) -> ?P(msd_sa_register), sa_register(X). msd_v1_trap(X) -> ?P(msd_v1_trap), v1_trap(X). @@ -1215,7 +1241,7 @@ msm_simple(X) -> ?P(msm_simple), simple(X). msm_v1_processing(X) -> ?P(msm_v1_processing), v1_processing(X). msm_big(X) -> ?P(msm_big2), big(X). msm_big2(X) -> ?P(msm_loop_mib), big2(X). -msm_loop_mib(X) -> ?P(msm_loop_mib), loop_mib(X). +msm_loop_mib(X) -> ?P(msm_loop_mib), loop_mib_1(X). msm_api(X) -> ?P(msm_api), api(X). msm_sa_register(X) -> ?P(msm_sa_register), sa_register(X). msm_v1_trap(X) -> ?P(msm_v1_trap), v1_trap(X). @@ -1618,7 +1644,7 @@ v1_cases() -> v1_processing, big, big2, - loop_mib, + loop_mib_1, api, subagent, mnesia, @@ -2095,9 +2121,9 @@ await_dummy_manager_started(Pid) -> {ok,Pid,Port}; {'EXIT', Pid, Reason} -> {error, Pid, Reason}; - O -> + _O -> ?LOG("dummy_manager_start -> received unknown message:" - "~n ~p",[O]), + "~n ~p",[_O]), await_dummy_manager_started(Pid) end. @@ -2120,16 +2146,16 @@ dummy_manager_send_trap2(Pid) -> dummy_manager_await_trap2_ack() -> ?DBG("dummy_manager_await_trap2 -> entry",[]), receive - {received_trap,Trap} -> - ?LOG("dummy_manager_await_trap2 -> received trap: ~p",[Trap]), + {received_trap, _Trap} -> + ?LOG("dummy_manager_await_trap2 -> received trap: ~p", [_Trap]), %% Note: %% Without this sleep the v2_inform_i testcase failes! There %% is no relation between these two test cases as far as I %% able to figure out... ?SLEEP(60000), ok; - O -> - ?ERR("dummy_manager_await_trap2 -> unexpected message: ~p",[O]), + _O -> + ?ERR("dummy_manager_await_trap2 -> unexpected message: ~p",[_O]), ok after 10000 -> ?ERR("dummy_manager_await_trap2 -> timeout",[]), @@ -2155,32 +2181,34 @@ dummy_manager_loop(P,S,MA) -> "~n Trap: ~p",[Trap]), snmpa:send_trap(MA, Trap, "standard trap"), dummy_manager_loop(P,S,MA); - {udp, _UdpId, Ip, UdpPort, Bytes} -> + {udp, _UdpId, _Ip, _UdpPort, Bytes} -> ?LOG("dummy_manager_loop -> received upd message" "~n from: ~p:~p" "~n size: ~p", - [Ip, UdpPort, dummy_manager_message_sz(Bytes)]), + [_Ip, _UdpPort, dummy_manager_message_sz(Bytes)]), R = dummy_manager_handle_message(Bytes), - ?DBG("dummy_manager_loop -> R: ~p",[R]), + ?DBG("dummy_manager_loop -> R: ~p", [R]), P ! R, - dummy_manager_loop(P,S,MA); + dummy_manager_loop(P, S, MA); stop -> ?DBG("dummy_manager_loop -> received stop request",[]), P ! {dummy_manager_stopping, self()}, gen_udp:close(S), exit(normal); - O -> + _O -> ?LOG("dummy_manager_loop -> received unknown message:" - "~n ~p",[O]), - dummy_manager_loop(P,S,MA) + "~n ~p", [_O]), + dummy_manager_loop(P, S, MA) end. +-ifdef(snmp_log). dummy_manager_message_sz(B) when is_binary(B) -> size(B); dummy_manager_message_sz(L) when is_list(L) -> length(L); dummy_manager_message_sz(_) -> undefined. +-endif. dummy_manager_handle_message(Bytes) -> case (catch snmp_pdus:dec_message(Bytes)) of @@ -3398,11 +3426,11 @@ simple_standard_test() -> db_notify_client(suite) -> []; db_notify_client(Config) when is_list(Config) -> ?P(db_notify_client), - {SaNode, MgrNode, MibDir} = init_case(Config), + {_SaNode, _MgrNode, _MibDir} = init_case(Config), ?DBG("db_notify_client -> case initiated: " "~n SaNode: ~p" "~n MgrNode: ~p" - "~n MibDir: ~p", [SaNode, MgrNode, MibDir]), + "~n MibDir: ~p", [_SaNode, _MgrNode, _MibDir]), ?DBG("db_notify_client -> maximize verbosity", []), snmpa_local_db:verbosity(trace), Self = self(), @@ -4153,8 +4181,8 @@ ma_v2_inform1(MA) -> CmdExp = fun(ok) -> ok; - ({ok, Val}) -> - ?DBG("ma_v2_inform -> [cmd2] Val: ~p", [Val]), + ({ok, _Val}) -> + ?DBG("ma_v2_inform -> [cmd2] Val: ~p", [_Val]), ok; ({error, Id, Extra}) -> {error, {unexpected, Id, Extra}}; @@ -4189,10 +4217,10 @@ ma_v2_inform1(MA) -> CmdSnmpTargets = fun(T) -> receive - {snmp_targets, T, [Addr]} -> + {snmp_targets, T, [_Addr]} -> ?DBG("ma_v2_inform1 -> " "received expected snmp_targets " - "~n with receiver: ~p",[Addr]), + "~n with receiver: ~p", [_Addr]), ok; {snmp_targets, T, Addrs} -> ?ERR("ma_v2_inform1 -> " @@ -4210,16 +4238,16 @@ ma_v2_inform1(MA) -> Cmd06 = fun() -> receive - {snmp_notification, Tag03, {got_response, Addr}} -> + {snmp_notification, Tag03, {got_response, _Addr}} -> ?DBG("ma_v2_inform1 -> " "received expected snmp_notification " - "[with manager response] from: ~n ~p",[Addr]), + "[with manager response] from: ~n ~p", [_Addr]), ok; - {snmp_notification, Tag03, {no_response, Addr}} -> + {snmp_notification, Tag03, {no_response, _Addr}} -> ?ERR("ma_v2_inform1 -> " "received unexpected snmp_notification " "[without manager response] from: ~n ~p", - [Addr]), + [_Addr]), {error, no_response} after 20000 -> @@ -4249,16 +4277,16 @@ ma_v2_inform1(MA) -> Cmd10 = fun() -> receive - {snmp_notification, Tag07, {got_response, Addr}} -> + {snmp_notification, Tag07, {got_response, _Addr}} -> ?ERR("ma_v2_inform1 -> " "received unexpected snmp_notification " - "[with manager response] from: ~n ~p", [Addr]), + "[with manager response] from: ~n ~p", [_Addr]), {error, got_response}; - {snmp_notification, Tag07, {no_response, Addr}} -> + {snmp_notification, Tag07, {no_response, _Addr}} -> ?DBG("ma_v2_inform1 -> " "received expected snmp_notification " "[without manager response] from: ~n ~p", - [Addr]), + [_Addr]), ok after 240000 -> @@ -4302,8 +4330,8 @@ ma_v2_inform2(MA) -> CmdExp = fun(ok) -> ok; - ({ok, Val}) -> - ?DBG("ma_v2_inform -> [cmd2] Val: ~p", [Val]), + ({ok, _Val}) -> + ?DBG("ma_v2_inform -> [cmd2] Val: ~p", [_Val]), ok; ({error, Id, Extra}) -> {error, {unexpected, Id, Extra}}; @@ -4383,8 +4411,8 @@ ma_v2_inform3(MA) -> "~n send notification: testTrapv22", [MA]), CmdExpectInform = - fun(No, Response) -> - ?DBG("CmdExpectInform -> ~p: ~n~p", [No, Response]), + fun(_No, Response) -> + ?DBG("CmdExpectInform -> ~p: ~n~p", [_No, Response]), ?expect2({inform, Response}, [{[sysUpTime, 0], any}, {[snmpTrapOID, 0], ?system ++ [0,1]}]) @@ -4393,8 +4421,8 @@ ma_v2_inform3(MA) -> CmdExp = fun(ok) -> ok; - ({ok, Val}) -> - ?DBG("CmdExp -> Val: ~p", [Val]), + ({ok, _Val}) -> + ?DBG("CmdExp -> Val: ~p", [_Val]), ok; ({error, Id, Extra}) -> {error, {unexpected, Id, Extra}}; @@ -4505,17 +4533,17 @@ delivery_info(Tag, Address, DeliveryResult, Extra) -> command_handler([]) -> ok; -command_handler([{No, Desc, Cmd}|Rest]) -> - ?LOG("command_handler -> command ~w: ~n ~s", [No, Desc]), +command_handler([{_No, _Desc, Cmd}|Rest]) -> + ?LOG("command_handler -> command ~w: ~n ~s", [_No, _Desc]), case (catch Cmd()) of ok -> - ?LOG("command_handler -> ~w: ok",[No]), + ?LOG("command_handler -> ~w: ok", [_No]), command_handler(Rest); {error, Reason} -> - ?ERR("command_handler -> ~w error: ~n~p",[No, Reason]), + ?ERR("command_handler -> ~w error: ~n~p", [_No, Reason]), ?line ?FAIL(Reason); Error -> - ?ERR("command_handler -> ~w unexpected: ~n~p",[No, Error]), + ?ERR("command_handler -> ~w unexpected: ~n~p", [_No, Error]), ?line ?FAIL({unexpected_command_result, Error}) end. @@ -5516,57 +5544,59 @@ usm_bad() -> %% works. %% Load all std mibs that are not loaded by default. %%----------------------------------------------------------------- -loop_mib(suite) -> []; -loop_mib(Config) when is_list(Config) -> - ?P(loop_mib), - ?LOG("loop_mib -> initiate case",[]), +loop_mib_1(suite) -> []; +loop_mib_1(Config) when is_list(Config) -> + ?P(loop_mib_1), + ?LOG("loop_mib_1 -> initiate case",[]), %% snmpa:verbosity(master_agent,debug), %% snmpa:verbosity(mib_server,info), - {SaNode, MgrNode, MibDir} = init_case(Config), - ?DBG("loop_mib -> ~n" + {_SaNode, _MgrNode, _MibDir} = init_case(Config), + ?DBG("loop_mib_1 -> ~n" "\tSaNode: ~p~n" "\tMgrNode: ~p~n" - "\tMibDir: ~p",[SaNode, MgrNode, MibDir]), - ?DBG("loop_mib -> load mib SNMP-COMMUNITY-MIB",[]), + "\tMibDir: ~p", [_SaNode, _MgrNode, _MibDir]), + ?DBG("loop_mib_1 -> load mib SNMP-COMMUNITY-MIB",[]), ?line load_master_std("SNMP-COMMUNITY-MIB"), - ?DBG("loop_mib -> load mib SNMP-MPD-MIB",[]), + ?DBG("loop_mib_1 -> load mib SNMP-MPD-MIB",[]), ?line load_master_std("SNMP-MPD-MIB"), - ?DBG("loop_mib -> load mib SNMP-TARGET-MIB",[]), + ?DBG("loop_mib_1 -> load mib SNMP-TARGET-MIB",[]), ?line load_master_std("SNMP-TARGET-MIB"), - ?DBG("loop_mib -> load mib SNMP-NOTIFICATION-MIB",[]), + ?DBG("loop_mib_1 -> load mib SNMP-NOTIFICATION-MIB",[]), ?line load_master_std("SNMP-NOTIFICATION-MIB"), - ?DBG("loop_mib -> load mib SNMP-FRAMEWORK-MIB",[]), + ?DBG("loop_mib_1 -> load mib SNMP-FRAMEWORK-MIB",[]), ?line load_master_std("SNMP-FRAMEWORK-MIB"), - ?DBG("loop_mib -> load mib SNMP-VIEW-BASED-ACM-MIB",[]), + ?DBG("loop_mib_1 -> load mib SNMP-VIEW-BASED-ACM-MIB",[]), ?line load_master_std("SNMP-VIEW-BASED-ACM-MIB"), - ?DBG("loop_mib -> try",[]), - try_test(loop_mib_1), - ?DBG("loop_mib -> unload mib SNMP-COMMUNITY-MIB",[]), + ?DBG("loop_mib_1 -> try",[]), + + try_test(loop_mib_1_test), + + ?DBG("loop_mib_1 -> unload mib SNMP-COMMUNITY-MIB",[]), ?line unload_master("SNMP-COMMUNITY-MIB"), - ?DBG("loop_mib -> unload mib SNMP-MPD-MIB",[]), + ?DBG("loop_mib_1 -> unload mib SNMP-MPD-MIB",[]), ?line unload_master("SNMP-MPD-MIB"), - ?DBG("loop_mib -> unload mib SNMP-TARGET-MIB",[]), + ?DBG("loop_mib_1 -> unload mib SNMP-TARGET-MIB",[]), ?line unload_master("SNMP-TARGET-MIB"), - ?DBG("loop_mib -> unload mib SNMP-NOTIFICATION-MIB",[]), + ?DBG("loop_mib_1 -> unload mib SNMP-NOTIFICATION-MIB",[]), ?line unload_master("SNMP-NOTIFICATION-MIB"), - ?DBG("loop_mib -> unload mib SNMP-FRAMEWORK-MIB",[]), + ?DBG("loop_mib_1 -> unload mib SNMP-FRAMEWORK-MIB",[]), ?line unload_master("SNMP-FRAMEWORK-MIB"), - ?DBG("loop_mib -> unload mib SNMP-VIEW-BASED-ACM-MIB",[]), + ?DBG("loop_mib_1 -> unload mib SNMP-VIEW-BASED-ACM-MIB",[]), ?line unload_master("SNMP-VIEW-BASED-ACM-MIB"), %% snmpa:verbosity(master_agent,log), %% snmpa:verbosity(mib_server,silence), - ?LOG("loop_mib -> done",[]). + ?LOG("loop_mib_1 -> done",[]). loop_mib_2(suite) -> []; loop_mib_2(Config) when is_list(Config) -> ?P(loop_mib_2), ?LOG("loop_mib_2 -> initiate case",[]), - {SaNode, MgrNode, MibDir} = init_case(Config), - ?DBG("loop_mib_2 -> ~n" + {_SaNode, _MgrNode, _MibDir} = init_case(Config), + ?DBG("do_loop_mib_2 -> ~n" "\tSaNode: ~p~n" "\tMgrNode: ~p~n" - "\tMibDir: ~p",[SaNode, MgrNode, MibDir]), + "\tMibDir: ~p", [_SaNode, _MgrNode, _MibDir]), ?DBG("loop_mib_2 -> load mibs",[]), ?line load_master_std("SNMP-COMMUNITY-MIB"), ?line load_master_std("SNMP-MPD-MIB"), @@ -5574,7 +5604,9 @@ loop_mib_2(Config) when is_list(Config) -> ?line load_master_std("SNMP-NOTIFICATION-MIB"), ?line load_master_std("SNMP-FRAMEWORK-MIB"), ?line load_master_std("SNMP-VIEW-BASED-ACM-MIB"), - try_test(loop_mib_2), + + try_test(loop_mib_2_test), + ?DBG("loop_mib_2 -> unload mibs",[]), ?line unload_master("SNMP-COMMUNITY-MIB"), ?line unload_master("SNMP-MPD-MIB"), @@ -5589,18 +5621,18 @@ loop_mib_3(suite) -> []; loop_mib_3(Config) when is_list(Config) -> ?P(loop_mib_3), ?LOG("loop_mib_3 -> initiate case",[]), - {SaNode, MgrNode, MibDir} = init_case(Config), + {_SaNode, _MgrNode, _MibDir} = init_case(Config), ?DBG("loop_mib_3 -> ~n" "\tSaNode: ~p~n" "\tMgrNode: ~p~n" - "\tMibDir: ~p",[SaNode, MgrNode, MibDir]), + "\tMibDir: ~p", [_SaNode, _MgrNode, _MibDir]), ?DBG("loop_mib_3 -> load mibs",[]), ?line load_master_std("SNMP-TARGET-MIB"), ?line load_master_std("SNMP-NOTIFICATION-MIB"), ?line load_master_std("SNMP-VIEW-BASED-ACM-MIB"), ?line load_master_std("SNMP-USER-BASED-SM-MIB"), - try_test(loop_mib_2), + try_test(loop_mib_3_test), ?DBG("loop_mib_3 -> unload mibs",[]), ?line unload_master("SNMP-TARGET-MIB"), @@ -5611,17 +5643,16 @@ loop_mib_3(Config) when is_list(Config) -> %% Req. As many mibs all possible -loop_mib_1() -> - ?DBG("loop_mib_1 -> entry",[]), +loop_mib_1_test() -> + ?DBG("loop_mib_1_test -> entry",[]), N = loop_it_1([1,1], 0), io:format(user, "found ~w varibles\n", [N]), ?line N = if N < 100 -> 100; true -> N end. - loop_it_1(Oid, N) -> - ?DBG("loop_it_1 -> entry with~n" + ?DBG("loop_it_1_test -> entry with~n" "\tOid: ~p~n" "\tN: ~p",[Oid,N]), case get_next_req([Oid]) of @@ -5629,13 +5660,13 @@ loop_it_1(Oid, N) -> error_status = noError, error_index = 0, varbinds = [#varbind{oid = NOid, - value = Value}]} when NOid > Oid -> - ?DBG("loop_it_1 -> " + value = _Value}]} when NOid > Oid -> + ?DBG("loop_it_1_test -> " "~n NOid: ~p" - "~n Value: ~p",[NOid, Value]), - ?line [Value2] = get_req(1, [NOid]), % must not be same - ?DBG("loop_it_1 -> " - "~n Value2: ~p",[Value2]), + "~n Value: ~p", [NOid, _Value]), + ?line [_Value2] = get_req(1, [NOid]), % must not be same + ?DBG("loop_it_1_test -> " + "~n Value2: ~p", [_Value2]), loop_it_1(NOid, N+1); #pdu{type = 'get-response', @@ -5648,7 +5679,7 @@ loop_it_1(Oid, N) -> error_status = noSuchName, error_index = 1, varbinds = [_]} -> - ?DBG("loop_it_1 -> done: ~p",[N]), + ?DBG("loop_it_1_test -> done: ~p",[N]), N; #pdu{type = 'get-response', @@ -5669,14 +5700,13 @@ loop_it_1(Oid, N) -> %% Req. As many mibs all possible -loop_mib_2() -> - ?DBG("loop_mib_1 -> entry",[]), +loop_mib_2_test() -> + ?DBG("loop_mib_2_test -> entry",[]), N = loop_it_2([1,1], 0), io:format(user, "found ~w varibles\n", [N]), ?line N = if N < 100 -> 100; true -> N end. - loop_it_2(Oid, N) -> ?DBG("loop_it_2 -> entry with" @@ -5686,22 +5716,22 @@ loop_it_2(Oid, N) -> #pdu{type = 'get-response', error_status = noError, error_index = 0, - varbinds = [#varbind{oid = NOid, value = endOfMibView}]} -> + varbinds = [#varbind{oid = _NOid, value = endOfMibView}]} -> ?DBG("loop_it_2 -> " - "~n NOid: ~p",[NOid]), + "~n NOid: ~p", [_NOid]), N; #pdu{type = 'get-response', error_status = noError, error_index = 0, varbinds = [#varbind{oid = NOid, - value = Value}]} when NOid > Oid -> + value = _Value}]} when NOid > Oid -> ?DBG("loop_it_2 -> " "~n NOid: ~p" - "~n Value: ~p",[NOid, Value]), - ?line [Value2] = get_req(1, [NOid]), % must not be same + "~n Value: ~p", [NOid, _Value]), + ?line [_Value2] = get_req(1, [NOid]), % must not be same ?DBG("loop_it_2 -> " - "~n Value2: ~p",[Value2]), + "~n Value2: ~p", [_Value2]), loop_it_2(NOid, N+1); #pdu{type = 'get-response', @@ -5744,6 +5774,10 @@ loop_it_2(Oid, N) -> end. +loop_mib_3_test() -> + ?DBG("loop_mib_3_test -> entry",[]), + loop_mib_2_test(). + %%%----------------------------------------------------------------- %%% Testing of reported bugs and other tickets. @@ -6611,16 +6645,16 @@ otp8395(Config) when is_list(Config) -> AgentNode = ?config(agent_node, Config), AgentLogDir = ?config(agent_log_dir, Config), OutFile = join([AgentLogDir, "otp8395.txt"]), - {ok, LogInfo} = rpc:call(AgentNode, snmpa, log_info, []), - ?DBG("otp8395 -> LogInfo: ~p", [LogInfo]), + {ok, _LogInfo} = rpc:call(AgentNode, snmpa, log_info, []), + ?DBG("otp8395 -> LogInfo: ~p", [_LogInfo]), %% SyncRes = rpc:call(AgentNode, snmp, log_sync, [?audit_trail_log_name]), %% ?DBG("otp8395 -> SyncRes: ~p", [SyncRes]), ok = agent_log_validation(AgentNode), - LTTRes = + _LTTRes = rpc:call(AgentNode, snmpa, log_to_txt, [AgentLogDir, [], OutFile]), - ?DBG("otp8395 -> LTTRes: ~p", [LTTRes]), + ?DBG("otp8395 -> LTTRes: ~p", [_LTTRes]), ?SLEEP(1000), ?DBG("otp8395 -> done", []), @@ -6941,10 +6975,10 @@ stop_stdalone_agent(Pid) when (node(Pid) =/= node()) -> MRef = erlang:monitor(process, Pid), rpc:call(node(Pid), ?MODULE, stop_stdalone_agent, [Pid]), receive - {'DOWN', MRef, process, Pid, Info} -> + {'DOWN', MRef, process, Pid, _Info} -> ?DBG("received expected DOWN message " "regarding snmp agent supervisor: " - "~n Info: ~p", [Info]), + "~n Info: ~p", [_Info]), ok after 5000 -> ?DBG("no DOWN message " @@ -7003,9 +7037,9 @@ do_info(MaNode) -> tree_size_bytes, db_memory]}], verify_info(Info, Keys), - OldInfo = snmpa:old_info_format(Info), - ?DBG("info_test1 -> OldInfo: ~n~p", [OldInfo]), - verify_old_info(OldInfo), + %% OldInfo = snmpa:old_info_format(Info), + %% ?DBG("info_test1 -> OldInfo: ~n~p", [OldInfo]), + %% verify_old_info(OldInfo), ok. verify_info([], []) -> @@ -7048,20 +7082,20 @@ verify_subinfo(Info0, [Key|Keys]) -> verify_subinfo(Info, Keys) end. -verify_old_info(Info) -> - Keys = [vsns, subagents, loaded_mibs, - tree_size_bytes, process_memory, db_memory], - verify_old_info(Keys, Info). - -verify_old_info([], _) -> - ok; -verify_old_info([Key|Keys], Info) -> - case lists:keymember(Key, 1, Info) of - true -> - verify_old_info(Keys, Info); - false -> - ?FAIL({missing_old_info, Key}) - end. +%% verify_old_info(Info) -> +%% Keys = [vsns, subagents, loaded_mibs, +%% tree_size_bytes, process_memory, db_memory], +%% verify_old_info(Keys, Info). + +%% verify_old_info([], _) -> +%% ok; +%% verify_old_info([Key|Keys], Info) -> +%% case lists:keymember(Key, 1, Info) of +%% true -> +%% verify_old_info(Keys, Info); +%% false -> +%% ?FAIL({missing_old_info, Key}) +%% end. %% Index String - string used in index is(S) -> [length(S) | S]. diff --git a/lib/snmp/test/snmp_agent_test_lib.erl b/lib/snmp/test/snmp_agent_test_lib.erl index 122289c28e..d7109253f7 100644 --- a/lib/snmp/test/snmp_agent_test_lib.erl +++ b/lib/snmp/test/snmp_agent_test_lib.erl @@ -299,10 +299,10 @@ call(N,M,F,A) -> "~n Loc: ~p", [Rn, Loc]), put(test_server_loc, Loc), exit(Rn); - {done, Ret, Zed} -> + {done, Ret, _Zed} -> ?DBG("call -> done:" "~n Ret: ~p" - "~n Zed: ~p", [Ret, Zed]), + "~n Zed: ~p", [Ret, _Zed]), case Ret of {error, Reason} -> exit(Reason); @@ -338,8 +338,8 @@ run(Mod, Func, Args, Opts) -> CtxEngineID = snmp_misc:get_option(context_engine_id, Opts, EngineID), Community = snmp_misc:get_option(community, Opts, "all-rights"), ?DBG("run -> start crypto app",[]), - Crypto = ?CRYPTO_START(), - ?DBG("run -> Crypto: ~p", [Crypto]), + _CryptoRes = ?CRYPTO_START(), + ?DBG("run -> Crypto: ~p", [_CryptoRes]), catch snmp_test_mgr:stop(), % If we had a running mgr from a failed case StdM = join(code:priv_dir(snmp), "mibs") ++ "/", Vsn = get(vsn), @@ -676,9 +676,9 @@ stop_agent(Config) when is_list(Config) -> (catch process_info(Sup)), (catch process_info(Par))]), - Info = agent_info(Sup), + _Info = agent_info(Sup), ?DBG("stop_agent -> Agent info: " - "~n ~p", [Info]), + "~n ~p", [_Info]), stop_sup(Sup, Par), @@ -1303,10 +1303,10 @@ get_req(Id, Vars) -> {ok, Val} -> ?DBG("get_req -> response: ~p",[Val]), Val; - {error, _, {ExpFmt, ExpArg}, {ActFmt, ActArg}} -> + {error, _, {_ExpFmt, ExpArg}, {_ActFmt, ActArg}} -> ?DBG("get_req -> error for ~p: " - "~n " ++ ExpFmt ++ - "~n " ++ ActFmt, + "~n " ++ _ExpFmt ++ + "~n " ++ _ActFmt, [Id] ++ ExpArg ++ ActArg), exit({unexpected_response, ExpArg, ActArg}); Error -> @@ -1527,9 +1527,9 @@ rewrite_target_addr_conf(Dir, NewPort) -> case file:read_file_info(TAFile) of {ok, _} -> ok; - {error, R} -> + {error, _R} -> ?ERR("failure reading file info of " - "target address config file: ~p",[R]), + "target address config file: ~p", [_R]), ok end, diff --git a/lib/snmp/test/snmp_manager_test.erl b/lib/snmp/test/snmp_manager_test.erl index 5fe18980bc..3a654a2805 100644 --- a/lib/snmp/test/snmp_manager_test.erl +++ b/lib/snmp/test/snmp_manager_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2013. All Rights Reserved. +%% Copyright Ericsson AB 2003-2014. 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 @@ -139,6 +139,8 @@ -define(NS_TIMEOUT, 10000). +-define(DEFAULT_MNESIA_DEBUG, none). + %%---------------------------------------------------------------------- %% Records @@ -173,7 +175,9 @@ end_per_suite(Config) when is_list(Config) -> init_per_testcase(Case, Config) when is_list(Config) -> - io:format(user, "~n~n*** INIT ~w:~w ***~n~n", [?MODULE,Case]), + io:format(user, "~n~n*** INIT ~w:~w ***~n~n", [?MODULE, Case]), + p(Case, "init_per_testcase begin when" + "~n Nodes: ~p~n~n", [erlang:nodes()]), %% This version of the API, based on Addr and Port, has been deprecated DeprecatedApiCases = [ @@ -187,16 +191,25 @@ init_per_testcase(Case, Config) when is_list(Config) -> simple_async_get_bulk1, misc_async1 ], - case lists:member(Case, DeprecatedApiCases) of - true -> - %% ?SKIP(api_no_longer_supported); - {skip, api_no_longer_supported}; - false -> - init_per_testcase2(Case, Config) - end. + Result = + case lists:member(Case, DeprecatedApiCases) of + true -> + %% ?SKIP(api_no_longer_supported); + {skip, api_no_longer_supported}; + false -> + init_per_testcase2(Case, Config) + end, + p(Case, "init_per_testcase end when" + "~n Nodes: ~p" + "~n Result: ~p" + "~n~n", [Result, erlang:nodes()]), + Result. init_per_testcase2(Case, Config) -> - ?DBG("init_per_testcase2 -> ~p", [erlang:nodes()]), + ?DBG("init_per_testcase2 -> " + "~n Case: ~p" + "~n Config: ~p" + "~n Nodes: ~p", [Case, Config, erlang:nodes()]), CaseTopDir = snmp_test_lib:init_testcase_top_dir(Case, Config), @@ -314,6 +327,8 @@ init_per_testcase3(Case, Config) -> end. end_per_testcase(Case, Config) when is_list(Config) -> + p(Case, "end_per_testcase begin when" + "~n Nodes: ~p~n~n", [erlang:nodes()]), ?DBG("fin [~w] Nodes [1]: ~p", [Case, erlang:nodes()]), Dog = ?config(watchdog, Config), ?WD_STOP(Dog), @@ -322,6 +337,8 @@ end_per_testcase(Case, Config) when is_list(Config) -> ?DBG("fin [~w] Nodes [2]: ~p", [Case, erlang:nodes()]), %% TopDir = ?config(top_dir, Conf2), %% ?DEL_DIR(TopDir), + p(Case, "end_per_testcase end when" + "~n Nodes: ~p~n~n", [erlang:nodes()]), Conf2. end_per_testcase2(Case, Config) -> @@ -428,10 +445,10 @@ groups() -> {request_tests, [], [ {group, get_tests}, - {group, get_next_tests}, + {group, get_next_tests}, {group, set_tests}, - {group, bulk_tests}, - {group, misc_request_tests} + {group, bulk_tests}, + {group, misc_request_tests} ] }, {request_tests_mt, [], @@ -5303,34 +5320,59 @@ init_manager(AutoInform, Config) -> ?line Node = start_manager_node(), + %% The point with this (try catch block) is to be + %% able to do some cleanup in case we fail to + %% start some of the apps. That is, if we fail to + %% start the apps (mnesia, crypto and snmp agent) + %% we stop the (agent) node! - %% -- - %% Start and initiate crypto on manager node - %% - - ?line ok = init_crypto(Node), + try + begin - %% - %% Write manager config - %% + %% -- + %% Start and initiate crypto on manager node + %% + + ?line ok = init_crypto(Node), + + %% + %% Write manager config + %% + + ?line ok = write_manager_config(Config), + + IRB = case AutoInform of + true -> + auto; + _ -> + user + end, + Conf = [{manager_node, Node}, {irb, IRB} | Config], + Vsns = [v1,v2,v3], + start_manager(Node, Vsns, Conf) + end + catch + T:E -> + StackTrace = ?STACK(), + p("Failure during manager start: " + "~n Error Type: ~p" + "~n Error: ~p" + "~n StackTrace: ~p", [T, E, StackTrace]), + %% And now, *try* to cleanup + (catch stop_node(Node)), + ?FAIL({failed_starting_manager, T, E, StackTrace}) + end. - ?line ok = write_manager_config(Config), - - IRB = case AutoInform of - true -> - auto; - _ -> - user - end, - Conf = [{manager_node, Node}, {irb, IRB} | Config], - Vsns = [v1,v2,v3], - start_manager(Node, Vsns, Conf). - fin_manager(Config) -> Node = ?config(manager_node, Config), - stop_manager(Node, Config), - fin_crypto(Node), - stop_node(Node), + StopMgrRes = stop_manager(Node), + StopCryptoRes = fin_crypto(Node), + StopNode = stop_node(Node), + p("fin_agent -> stop apps and (mgr node ~p) node results: " + "~n SNMP Mgr: ~p" + "~n Crypto: ~p" + "~n Node: ~p", + [Node, StopMgrRes, StopCryptoRes, StopNode]), Config. @@ -5352,52 +5394,93 @@ init_agent(Config) -> ?line Node = start_agent_node(), + %% The point with this (try catch block) is to be + %% able to do some cleanup in case we fail to + %% start some of the apps. That is, if we fail to + %% start the apps (mnesia, crypto and snmp agent) + %% we stop the (agent) node! - %% -- - %% Start and initiate mnesia on agent node - %% - - ?line ok = init_mnesia(Node, Dir), - - - %% -- - %% Start and initiate crypto on agent node - %% - - ?line ok = init_crypto(Node), - - - %% - %% Write agent config - %% - - Vsns = [v1,v2], - ?line ok = write_agent_config(Vsns, Config), - - Conf = [{agent_node, Node}, - {mib_dir, MibDir} | Config], + try + begin + + %% -- + %% Start and initiate mnesia on agent node + %% + + ?line ok = init_mnesia(Node, Dir, ?config(mnesia_debug, Config)), + + + %% -- + %% Start and initiate crypto on agent node + %% + + ?line ok = init_crypto(Node), + + + %% + %% Write agent config + %% + + Vsns = [v1,v2], + ?line ok = write_agent_config(Vsns, Config), + + Conf = [{agent_node, Node}, + {mib_dir, MibDir} | Config], - %% - %% Start the agent - %% - - start_agent(Node, Vsns, Conf). + %% + %% Start the agent + %% + + start_agent(Node, Vsns, Conf) + end + catch + T:E -> + StackTrace = ?STACK(), + p("Failure during agent start: " + "~n Error Type: ~p" + "~n Error: ~p" + "~n StackTrace: ~p", [T, E, StackTrace]), + %% And now, *try* to cleanup + (catch stop_node(Node)), + ?FAIL({failed_starting_agent, T, E, StackTrace}) + end. + fin_agent(Config) -> Node = ?config(agent_node, Config), - stop_agent(Node, Config), - fin_crypto(Node), - fin_mnesia(Node), - stop_node(Node), + StopAgentRes = stop_agent(Node), + StopCryptoRes = fin_crypto(Node), + StopMnesiaRes = fin_mnesia(Node), + StopNode = stop_node(Node), + p("fin_agent -> stop apps and (agent node ~p) node results: " + "~n SNMP Agent: ~p" + "~n Crypto: ~p" + "~n Mnesia: ~p" + "~n Node: ~p", + [Node, StopAgentRes, StopCryptoRes, StopMnesiaRes, StopNode]), Config. -init_mnesia(Node, Dir) -> +init_mnesia(Node, Dir, MnesiaDebug) + when ((MnesiaDebug =/= none) andalso + (MnesiaDebug =/= debug) andalso (MnesiaDebug =/= trace)) -> + init_mnesia(Node, Dir, ?DEFAULT_MNESIA_DEBUG); +init_mnesia(Node, Dir, MnesiaDebug) -> ?DBG("init_mnesia -> load application mnesia", []), ?line ok = load_mnesia(Node), ?DBG("init_mnesia -> application mnesia: set_env dir: ~n~p",[Dir]), ?line ok = set_mnesia_env(Node, dir, filename:join(Dir, "mnesia")), + %% Just in case, only set (known to be) valid values for debug + if + ((MnesiaDebug =:= debug) orelse (MnesiaDebug =:= trace)) -> + ?DBG("init_mnesia -> application mnesia: set_env debug: ~w", + [MnesiaDebug]), + ?line ok = set_mnesia_env(Node, debug, MnesiaDebug); + true -> + ok + end, + ?DBG("init_mnesia -> create mnesia schema",[]), ?line case create_schema(Node) of ok -> @@ -5434,25 +5517,89 @@ fin_crypto(Node) -> %% -- Misc application wrapper functions -- -load_app(Node, App) when (Node =:= node()) andalso is_atom(App) -> - application:load(App); -load_app(Node, App) when is_atom(App) -> - rcall(Node, application, load, [App]). - -start_app(Node, App) when (Node =:= node()) andalso is_atom(App) -> - application:start(App); +load_app(Node, App) -> + VerifySuccess = fun(ok) -> + ok; + ({error, {already_loaded, LoadedApp}}) when (LoadedApp =:= App) -> + ok; + ({error, Reason}) -> + p("failed loading app ~w on ~p: " + "~n ~p", [App, Node, Reason]), + ?FAIL({failed_load, Node, App, Reason}) + end, + do_load_app(Node, App, VerifySuccess). + +do_load_app(Node, App, VerifySuccess) + when (Node =:= node()) andalso is_atom(App) -> + %% Local app + exec(fun() -> application:load(App) end, VerifySuccess); +do_load_app(Node, App, VerifySuccess) -> + %% Remote app + exec(fun() -> rcall(Node, application, load, [App]) end, VerifySuccess). + + start_app(Node, App) -> - rcall(Node, application, start, [App]). + VerifySuccess = fun(ok) -> + ok; + ({error, {already_started, LoadedApp}}) when (LoadedApp =:= App) -> + ok; + ({error, Reason}) -> + p("failed starting app ~w on ~p: " + "~n ~p", [App, Node, Reason]), + ?FAIL({failed_start, Node, App, Reason}) + end, + start_app(Node, App, VerifySuccess). + +start_app(Node, App, VerifySuccess) + when (Node =:= node()) andalso is_atom(App) -> + exec(fun() -> application:start(App) end, VerifySuccess); +start_app(Node, App, VerifySuccess) -> + exec(fun() -> rcall(Node, application, start, [App]) end, VerifySuccess). + + +stop_app(Node, App) -> + VerifySuccess = fun(ok) -> + ok; + ({error, {not_started, LoadedApp}}) when (LoadedApp =:= App) -> + ok; + ({error, Reason}) -> + p("failed stopping app ~w on ~p: " + "~n ~p", [App, Node, Reason]), + ?FAIL({failed_stop, Node, App, Reason}) + end, + stop_app(Node, App, VerifySuccess). + +stop_app(Node, App, VerifySuccess) + when (Node =:= node()) andalso is_atom(App) -> + exec(fun() -> application:stop(App) end, VerifySuccess); +stop_app(Node, App, VerifySuccess) when is_atom(App) -> + exec(fun() -> rcall(Node, application, stop, [App]) end, VerifySuccess). + + +set_app_env(Node, App, Key, Val) -> + VerifySuccess = fun(ok) -> + ok; + ({error, Reason}) -> + p("failed setting app ~w env on ~p" + "~n Key: ~p" + "~n Val: ~p" + "~n Reason: ~p" + "~n ~p", [App, Node, Key, Val, Reason]), + ?FAIL({failed_set_app_env, + Node, App, Key, Val, Reason}) + end, + set_app_env(Node, App, Key, Val, VerifySuccess). -stop_app(Node, App) when (Node =:= node()) andalso is_atom(App) -> - application:stop(App); -stop_app(Node, App) when is_atom(App) -> - rcall(Node, application, stop, [App]). +set_app_env(Node, App, Key, Val, VerifySuccess) + when (Node =:= node()) andalso is_atom(App) -> + exec(fun() -> application:set_env(App, Key, Val) end, VerifySuccess); +set_app_env(Node, App, Key, Val, VerifySuccess) when is_atom(App) -> + exec(fun() -> rcall(Node, application, set_env, [App, Key, Val]) end, + VerifySuccess). -set_app_env(Node, App, Key, Val) when (Node =:= node()) andalso is_atom(App) -> - application:set_env(App, Key, Val); -set_app_env(Node, App, Key, Val) when is_atom(App) -> - rcall(Node, application, set_env, [App, Key, Val]). + +exec(Cmd, VerifySuccess) -> + VerifySuccess(Cmd()). %% -- Misc snmp wrapper functions -- @@ -5900,9 +6047,9 @@ start_manager(Node, Vsns, Conf0, _Opts) -> Conf0. -stop_manager(Node, Conf) -> - stop_snmp(Node), - Conf. +stop_manager(Node) -> + stop_snmp(Node). + %% -- Misc agent wrapper functions -- @@ -5951,9 +6098,8 @@ start_agent(Node, Vsns, Conf0, _Opts) -> ?line ok = start_snmp(Node), Conf0. -stop_agent(Node, Conf) -> - stop_snmp(Node), - Conf. +stop_agent(Node) -> + stop_snmp(Node). agent_load_mib(Node, Mib) -> rcall(Node, snmpa, load_mibs, [[Mib]]). @@ -6015,17 +6161,18 @@ stop_node(Node) -> rpc:cast(Node, erlang, halt, []), await_stopped(Node, 5). -await_stopped(_, 0) -> +await_stopped(Node, 0) -> + p("await_stopped -> ~p still exist: giving up", [Node]), ok; await_stopped(Node, N) -> Nodes = erlang:nodes(), case lists:member(Node, Nodes) of true -> - ?DBG("[~w] ~p still exist", [N, Node]), + p("await_stopped -> ~p still exist: ~w", [Node, N]), ?SLEEP(1000), await_stopped(Node, N-1); false -> - ?DBG("[~w] ~p gone", [N, Node]), + p("await_stopped -> ~p gone: ~w", [Node, N]), ok end. @@ -6271,7 +6418,7 @@ p(F, A) -> p(TName, F, A) -> io:format("*** [~w][~s] ***" - "~n" ++ F ++ "~n", [TName, formated_timestamp()|A]). + "~n " ++ F ++ "~n", [TName, formated_timestamp()|A]). formated_timestamp() -> snmp_test_lib:formated_timestamp(). diff --git a/lib/snmp/test/snmp_test_mgr.erl b/lib/snmp/test/snmp_test_mgr.erl index 40fcbce8f1..d4eb00ff91 100644 --- a/lib/snmp/test/snmp_test_mgr.erl +++ b/lib/snmp/test/snmp_test_mgr.erl @@ -657,7 +657,8 @@ make_vb(Oid) -> #varbind{oid = Oid, variabletype = 'NULL', value = 'NULL'}. make_request_id() -> - random:uniform(16#FFFFFFF-1). + %% random:uniform(16#FFFFFFF-1). + snmp_test_mgr_counter_server:increment(mgr_request_id, 1, 1, 2147483647). echo_pdu(PDU, MiniMIB) -> io:format("~s", [snmp_misc:format_pdu(PDU, MiniMIB)]). diff --git a/lib/snmp/test/snmp_test_mgr_counter_server.erl b/lib/snmp/test/snmp_test_mgr_counter_server.erl new file mode 100644 index 0000000000..db31e0380b --- /dev/null +++ b/lib/snmp/test/snmp_test_mgr_counter_server.erl @@ -0,0 +1,152 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014-2014. 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% +%% + +%% +%% The reason for this (test) counter server is that the +%% agent test suite is implemented in such a way that the +%% agent is started once and then used for several test cases. +%% Each request is given a request id which *was* generated using +%% random! It is therefor possible, although unlikely, that a +%% request may get a request id that has recently been used, +%% which will cause the agent to silently reject the request. +%% For this reason, we start this server at the start of the +%% agent suite and stop it at the end and all request ids are +%% generated by this server. +%% + +-module(snmp_test_mgr_counter_server). + +-export([start/0, stop/0, increment/4]). + +-define(SERVER, ?MODULE). +-define(TAB, snmp_test_mgr_counter_tab). + + +%%%------------------------------------------------------------------- +%%% API +%%%------------------------------------------------------------------- + +-spec start() -> ok. + +start() -> + Parent = self(), + ReqIdServer = spawn(fun() -> init(Parent) end), + receive + {ReqIdServer, ok} -> + ok; + {ReqIdServer, {error, Reason}} -> + exit({failed_starting_counter_server, Reason}) + after 5000 -> + exit(ReqIdServer, kill), % Cleanup, just in case + exit({failed_starting_counter_server, timeout}) + end. + +-spec stop() -> {ok, Counters :: list()} | {error, Reason :: term()}. + +stop() -> + request(stop). + + +-spec increment(Counter :: atom(), + Initial :: non_neg_integer(), + Increment :: pos_integer(), + Max :: pos_integer()) -> + Next :: pos_integer(). + +increment(Counter, Initial, Increment, Max) -> + Request = {increment, Counter, Initial, Increment, Max}, + case request(Request) of + {ok, ReqId} -> + ReqId; + {error, Reason} -> + exit(Reason) + end. + + +request(Request) -> + Id = make_ref(), + Msg = {self(), Id, Request}, + try + begin + global:send(?SERVER, Msg), + receive + {reply, Id, Reply} -> + {ok, Reply} + end + end + catch + T:E -> + {error, {T, E}} + end. + + +%%%------------------------------------------------------------------- +%%% Internal functions +%%%------------------------------------------------------------------- + +init(Parent) -> + p("starting"), + case global:register_name(?SERVER, self()) of + yes -> + p("name registration ok"), + Parent ! {self(), ok}; + no -> + p("name registration failed"), + Parent ! {self(), registration_failed}, + exit(registration_failed) + end, + ets:new(?TAB, [set, named_table, {keypos, 1}]), + loop(). + +loop() -> + receive + {From, Id, {increment, Counter, Initial, Increment, Max}} -> + Position = 2, + Threshold = Max, + SetValue = Initial, + UpdateOp = {Position, Increment, Threshold, SetValue}, + NextVal = + try ets:update_counter(?TAB, Counter, UpdateOp) of + Next when is_integer(Next) -> + p("increment ~w: (next) ~w", [Counter, Next]), + Next + catch + error:badarg -> + %% Oups, first time + p("increment ~w: (initial) ~w", [Counter, Initial]), + ets:insert(?TAB, {Counter, Initial}), + Initial + end, + From ! {reply, Id, NextVal}, + loop(); + + {From, Id, stop} -> + p("stop"), + Counters = ets:tab2list(?TAB), + From ! {reply, Id, Counters}, + exit(normal) + end. + + +p(F) -> + p(F, []). + +p(F, A) -> + io:format("*** [~s] COUNTER-SERVER [~w] " ++ F ++ "~n", + [snmp_test_lib:formated_timestamp(), self() | A]). diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index 533e313bdb..04c3cc9392 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = snmp -SNMP_VSN = 4.25.0.1 +SNMP_VSN = 4.25.1 PRE_VSN = APP_VSN = "$(APPLICATION)-$(SNMP_VSN)$(PRE_VSN)" diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index eaf96d0230..7fbd70c87e 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -304,6 +304,23 @@ <c><![CDATA[true]]></c> if the password is valid and <c><![CDATA[false]]></c> otherwise.</p> </item> + + <tag><c><![CDATA[{negotiation_timeout, integer()}]]></c></tag> + <item> + <p>Max time in milliseconds for the authentication negotiation. The default value is 2 minutes. + </p> + </item> + + <tag><c><![CDATA[{parallel_login, boolean()}]]></c></tag> + <item> + <p>If set to false (the default value), only one login is handled a time. If set to true, an unlimited logins will be allowed simultanously. Note that this affects only the connections with authentication in progress, not the already authenticated connections. + </p> + <warning> + <p>Do not enable parallel_logins without protecting the server by other means like a firewall. If set to true, there is no protection against dos attacs.</p> + </warning> + + </item> + <tag><c><![CDATA[{key_cb, atom()}]]></c></tag> <item> <p>Module implementing the behaviour <seealso marker="ssh_server_key_api">ssh_server_key_api</seealso>. diff --git a/lib/ssh/src/ssh.app.src b/lib/ssh/src/ssh.app.src index 74d7293be0..e0a51b3574 100644 --- a/lib/ssh/src/ssh.app.src +++ b/lib/ssh/src/ssh.app.src @@ -38,6 +38,8 @@ {registered, []}, {applications, [kernel, stdlib, crypto, public_key]}, {env, []}, - {mod, {ssh_app, []}}]}. + {mod, {ssh_app, []}}, + {runtime_dependencies, ["stdlib-2.0","public_key-0.22","kernel-3.0", + "erts-6.0","crypto-3.3"]}]}. diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src index df34a5a3ff..1917c95f5a 100644 --- a/lib/ssh/src/ssh.appup.src +++ b/lib/ssh/src/ssh.appup.src @@ -19,13 +19,9 @@ {"%VSN%", [ - {<<"2\\.1\\..*">>, [{restart_application, ssh}]}, - {<<"2\\.0\\..*">>, [{restart_application, ssh}]}, - {<<"1\\..*">>, [{restart_application, ssh}]} + {<<".*">>, [{restart_application, ssh}]} ], [ - {<<"2\\.1\\..*">>,[{restart_application, ssh}]}, - {<<"2\\.0\\..*">>, [{restart_application, ssh}]}, - {<<"1\\..*">>, [{restart_application, ssh}]} + {<<".*">>, [{restart_application, ssh}]} ] }. diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index d50d5a0cb3..de6e8cc421 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -1,4 +1,4 @@ -%% +% %% %CopyrightBegin% %% %% Copyright Ericsson AB 2004-2013. All Rights Reserved. @@ -332,6 +332,12 @@ handle_option([{idle_time, _} = Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{rekey_limit, _} = Opt|Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); +handle_option([{negotiation_timeout, _} = Opt|Rest], SocketOptions, SshOptions) -> + handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); +handle_option([{parallel_login, _} = Opt|Rest], SocketOptions, SshOptions) -> + handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); +handle_option([parallel_login|Rest], SocketOptions, SshOptions) -> + handle_option(Rest, SocketOptions, [handle_ssh_option({parallel_login,true}) | SshOptions]); handle_option([Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, [handle_inet_option(Opt) | SocketOptions], SshOptions). @@ -360,6 +366,10 @@ handle_ssh_option({pref_public_key_algs, Value} = Opt) when is_list(Value), leng end; handle_ssh_option({connect_timeout, Value} = Opt) when is_integer(Value); Value == infinity -> Opt; +handle_ssh_option({negotiation_timeout, Value} = Opt) when is_integer(Value); Value == infinity -> + Opt; +handle_ssh_option({parallel_login, Value} = Opt) when Value==true ; Value==false -> + Opt; handle_ssh_option({user, Value} = Opt) when is_list(Value) -> Opt; handle_ssh_option({dsa_pass_phrase, Value} = Opt) when is_list(Value) -> diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl index 91905b2eaf..e57b07cee8 100644 --- a/lib/ssh/src/ssh_acceptor.erl +++ b/lib/ssh/src/ssh_acceptor.erl @@ -84,11 +84,14 @@ handle_connection(_Callback, Address, Port, Options, Socket) -> SystemSup = ssh_system_sup:system_supervisor(Address, Port), {ok, SubSysSup} = ssh_system_sup:start_subsystem(SystemSup, Options), ConnectionSup = ssh_subsystem_sup:connection_supervisor(SubSysSup), + Timeout = proplists:get_value(negotiation_timeout, + proplists:get_value(ssh_opts, Options, []), + 2*60*1000), ssh_connection_handler:start_connection(server, Socket, [{supervisors, [{system_sup, SystemSup}, {subsystem_sup, SubSysSup}, {connection_sup, ConnectionSup}]} - | Options], infinity). + | Options], Timeout). handle_error(timeout) -> ok; diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 070a2db5a8..322da50f21 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -110,8 +110,16 @@ start_connection(server = Role, Socket, Options, Timeout) -> {ok, Pid} = ssh_connection_sup:start_child(ConnectionSup, [Role, Socket, Opts]), {_, Callback, _} = proplists:get_value(transport, Options, {tcp, gen_tcp, tcp_closed}), socket_control(Socket, Pid, Callback), - Ref = erlang:monitor(process, Pid), - handshake(Pid, Ref, Timeout) + case proplists:get_value(parallel_login, Opts, false) of + true -> + spawn(fun() -> + Ref = erlang:monitor(process, Pid), + handshake(Pid, Ref, Timeout) + end); + false -> + Ref = erlang:monitor(process, Pid), + handshake(Pid, Ref, Timeout) + end catch exit:{noproc, _} -> {error, ssh_not_started}; @@ -206,7 +214,7 @@ global_request(ConnectionHandler, Type, false = Reply, Data) -> send_all_state_event(ConnectionHandler, {global_request, self(), Type, Reply, Data}). %%-------------------------------------------------------------------- --spec send(pid(), channel_id(), integer(), iolist(), timeout()) -> +-spec send(pid(), channel_id(), integer(), iodata(), timeout()) -> ok | {error, timeout} | {error, closed}. %%-------------------------------------------------------------------- send(ConnectionHandler, ChannelId, Type, Data, Timeout) -> diff --git a/lib/ssh/test/ssh_unicode_SUITE.erl b/lib/ssh/test/ssh_unicode_SUITE.erl index a896a425b9..cc916673b3 100644 --- a/lib/ssh/test/ssh_unicode_SUITE.erl +++ b/lib/ssh/test/ssh_unicode_SUITE.erl @@ -1,10 +1,7 @@ -%% Next line needed to enable utf8-strings in Erlang: -%% -*- coding: utf-8 -*- - %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2013. All Rights Reserved. +%% Copyright Ericsson AB 2005-2014. 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 diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 910dca3889..4bc1a9a644 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1999</year><year>2013</year> + <year>1999</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -184,12 +184,6 @@ <item> The DER encoded trusted certificates. If this option is supplied it will override the cacertfile option.</item> - <tag>{cacertfile, path()}</tag> - <item>Path to file containing PEM encoded - CA certificates (trusted certificates used for verifying a peer - certificate). May be omitted if you do not want to verify - the peer.</item> - <tag>{ciphers, ciphers()}</tag> <item>The cipher suites that should be supported. The function <c>cipher_suites/0</c> can be used to find all ciphers that are @@ -354,7 +348,13 @@ fun(srp, Username :: string(), UserState :: term()) -> <item>Specifies if client should try to reuse sessions when possible. </item> - + + <tag>{cacertfile, path()}</tag> + <item>The path to a file containing PEM encoded CA certificates. The CA + certificates are used during server authentication and when building the + client certificate chain. + </item> + <tag>{client_preferred_next_protocols, {Precedence :: server | client, ClientPrefs :: [binary()]}}</tag> <tag>{client_preferred_next_protocols, {Precedence :: server | client, ClientPrefs :: [binary()], Default :: binary()}}</tag> <item> @@ -403,7 +403,17 @@ fun(srp, Username :: string(), UserState :: term()) -> meaning in the server than in the client.</p> <taglist> - + + <tag>{cacertfile, path()}</tag> + <item>The path to a file containing PEM encoded CA + certificates. The CA certificates are used to build the server + certificate chain, and for client authentication. Also the CAs + are used in the list of acceptable client CAs passed to the + client when a certificate is requested. May be omitted if there + is no need to verify the client and if there are not any + intermediate CAs for the server certificate. + </item> + <tag>{dh, der_encoded()}</tag> <item>The DER encoded Diffie Hellman parameters. If this option is supplied it will override the dhfile option. diff --git a/lib/ssl/src/dtls.erl b/lib/ssl/src/dtls.erl index 1cad9560b5..780bddeb10 100644 --- a/lib/ssl/src/dtls.erl +++ b/lib/ssl/src/dtls.erl @@ -31,25 +31,29 @@ handshake/1, handshake/2, handshake/3]). %%-------------------------------------------------------------------- +%% +%% Description: Connect to a DTLS server. +%%-------------------------------------------------------------------- + -spec connect(host() | port(), [connect_option()]) -> {ok, #sslsocket{}} | {error, reason()}. + +connect(Socket, Options) when is_port(Socket) -> + connect(Socket, Options, infinity). + -spec connect(host() | port(), [connect_option()] | inet:port_number(), timeout() | list()) -> {ok, #sslsocket{}} | {error, reason()}. --spec connect(host() | port(), inet:port_number(), list(), timeout()) -> - {ok, #sslsocket{}} | {error, reason()}. - -%% -%% Description: Connect to an DTLS server. -%%-------------------------------------------------------------------- -connect(Socket, Options) when is_port(Socket) -> - connect(Socket, Options, infinity). connect(Socket, SslOptions, Timeout) when is_port(Socket) -> DTLSOpts = [{protocol, dtls} | SslOptions], ssl:connect(Socket, DTLSOpts, Timeout); connect(Host, Port, Options) -> connect(Host, Port, Options, infinity). + +-spec connect(host() | port(), inet:port_number(), list(), timeout()) -> + {ok, #sslsocket{}} | {error, reason()}. + connect(Host, Port, Options, Timeout) -> DTLSOpts = [{protocol, dtls} | Options], ssl:connect(Host, Port, DTLSOpts, Timeout). @@ -65,38 +69,44 @@ listen(Port, Options) -> ssl:listen(Port, DTLSOpts). %%-------------------------------------------------------------------- --spec accept(#sslsocket{}) -> {ok, #sslsocket{}} | - {error, reason()}. --spec accept(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} | - {error, reason()}. %% %% Description: Performs transport accept on an ssl listen socket %%-------------------------------------------------------------------- +-spec accept(#sslsocket{}) -> {ok, #sslsocket{}} | + {error, reason()}. accept(ListenSocket) -> accept(ListenSocket, infinity). + +-spec accept(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} | + {error, reason()}. accept(Socket, Timeout) -> ssl:transport_accept(Socket, Timeout). %%-------------------------------------------------------------------- --spec handshake(#sslsocket{}) -> ok | {error, reason()}. --spec handshake(#sslsocket{} | port(), timeout()| [ssl_option() - | transport_option()]) -> - ok | {ok, #sslsocket{}} | {error, reason()}. --spec handshake(port(), [ssl_option()| transport_option()], timeout()) -> - {ok, #sslsocket{}} | {error, reason()}. %% %% Description: Performs accept on an ssl listen socket. e.i. performs %% ssl handshake. %%-------------------------------------------------------------------- +-spec handshake(#sslsocket{}) -> ok | {error, reason()}. + handshake(ListenSocket) -> handshake(ListenSocket, infinity). + +-spec handshake(#sslsocket{} | port(), timeout()| [ssl_option() + | transport_option()]) -> + ok | {ok, #sslsocket{}} | {error, reason()}. + handshake(#sslsocket{} = Socket, Timeout) -> ssl:ssl_accept(Socket, Timeout); handshake(ListenSocket, SslOptions) when is_port(ListenSocket) -> handshake(ListenSocket, SslOptions, infinity). + +-spec handshake(port(), [ssl_option()| transport_option()], timeout()) -> + {ok, #sslsocket{}} | {error, reason()}. + handshake(Socket, SslOptions, Timeout) when is_port(Socket) -> ssl:ssl_accept(Socket, SslOptions, Timeout). diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index da2e076856..57f8dd86d3 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2014. 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 @@ -20,222 +20,514 @@ %% Internal application API -%%==================================================================== +-behaviour(gen_fsm). + +-include("dtls_connection.hrl"). +-include("dtls_handshake.hrl"). +-include("ssl_alert.hrl"). +-include("dtls_record.hrl"). +-include("ssl_cipher.hrl"). +-include("ssl_api.hrl"). +-include("ssl_internal.hrl"). +-include("ssl_srp.hrl"). +-include_lib("public_key/include/public_key.hrl"). + %% Internal application API -%%==================================================================== +%% Setup +-export([start_fsm/8]). + +%% State transition handling +-export([next_record/1, next_state/4%, + %%next_state_connection/2 + ]). + +%% Handshake handling +-export([%%renegotiate/1, + send_handshake/2, send_change_cipher/2]). + +%% Alert and close handling +-export([send_alert/2, handle_own_alert/4, %%handle_close_alert/3, + handle_normal_shutdown/3 + %%handle_unexpected_message/3, + %%alert_user/5, alert_user/8 + ]). + +%% Data handling +-export([%%write_application_data/3, + read_application_data/2%%, +%% passive_receive/2, next_record_if_active/1 + ]). + +%% Called by tls_connection_sup +-export([start_link/7]). +%% gen_fsm callbacks +-export([init/1, hello/2, certify/2, cipher/2, + abbreviated/2, connection/2, handle_event/3, + handle_sync_event/4, handle_info/3, terminate/3, code_change/4]). -%% %%==================================================================== -%% %% State functions -%% %%==================================================================== - -%% -spec hello(start | #hello_request{} | #client_hello{} | #server_hello{} | term(), -%% #state{}) -> gen_fsm_state_return(). -%% %%-------------------------------------------------------------------- -%% hello(start, #state{host = Host, port = Port, role = client, -%% ssl_options = SslOpts, -%% session = #session{own_certificate = Cert} = Session0, -%% session_cache = Cache, session_cache_cb = CacheCb, -%% connection_states = ConnectionStates0, -%% renegotiation = {Renegotiation, _}, -%% client_cookie = Cookie} = State0) -> -%% Hello = dtls_handshake:client_hello(Host, Port, Cookie, ConnectionStates0, SslOpts, -%% Cache, CacheCb, Renegotiation, Cert), - -%% Version = Hello#client_hello.client_version, -%% State1 = State0#state{negotiated_version = Version, %% Requested version -%% session = -%% Session0#session{session_id = Hello#client_hello.session_id}, -%% dtls_handshake_history = ssl_handshake:init_handshake_history()}, - -%% State2 = send_flight(Hello, waiting, State1), - -%% {Record, State} = next_record(State2), -%% next_state(hello, hello, Record, State); - -%% hello(start, #state{role = server} = State0) -> -%% {Record, State} = next_record(State0), -%% next_state(hello, hello, Record, State); - -%% hello(#hello_request{}, #state{role = client} = State0) -> -%% {Record, State} = next_record(State0), -%% next_state(hello, hello, Record, State); - -%% hello(#server_hello{cipher_suite = CipherSuite, -%% compression_method = Compression} = Hello, -%% #state{session = #session{session_id = OldId}, -%% connection_states = ConnectionStates0, -%% role = client, -%% negotiated_version = ReqVersion, -%% renegotiation = {Renegotiation, _}, -%% ssl_options = SslOptions} = State1) -> -%% State0 = flight_done(State1), -%% case ssl_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of -%% #alert{} = Alert -> -%% handle_own_alert(Alert, ReqVersion, hello, State0); -%% {Version, NewId, ConnectionStates, NextProtocol} -> -%% {KeyAlgorithm, _, _, _} = -%% ssl_cipher:suite_definition(CipherSuite), - -%% PremasterSecret = make_premaster_secret(ReqVersion, KeyAlgorithm), - -%% NewNextProtocol = case NextProtocol of -%% undefined -> -%% State0#state.next_protocol; -%% _ -> -%% NextProtocol -%% end, - -%% State = State0#state{key_algorithm = KeyAlgorithm, -%% hashsign_algorithm = default_hashsign(Version, KeyAlgorithm), -%% negotiated_version = Version, -%% connection_states = ConnectionStates, -%% premaster_secret = PremasterSecret, -%% expecting_next_protocol_negotiation = NextProtocol =/= undefined, -%% next_protocol = NewNextProtocol}, - -%% case ssl_session:is_new(OldId, NewId) of -%% true -> -%% handle_new_session(NewId, CipherSuite, Compression, -%% State#state{connection_states = ConnectionStates}); -%% false -> -%% handle_resumed_session(NewId, State#state{connection_states = ConnectionStates}) -%% end -%% end; - -%% hello(#hello_verify_request{cookie = Cookie}, -%% #state{host = Host, port = Port, -%% session = #session{own_certificate = Cert}, -%% session_cache = Cache, session_cache_cb = CacheCb, -%% ssl_options = SslOpts, -%% connection_states = ConnectionStates0, -%% renegotiation = {Renegotiation, _}} = State0) -> -%% Hello = ssl_handshake:client_hello(Host, Port, Cookie, ConnectionStates0, SslOpts, -%% Cache, CacheCb, Renegotiation, Cert), -%% State1 = State0#state{ -%% tls_handshake_history = ssl_handshake:init_handshake_history(), -%% client_cookie = Cookie}, -%% State2 = send_flight(Hello, waiting, State1), - -%% {Record, State} = next_record(State2), -%% next_state(hello, hello, Record, State); - - -%% %%-------------------------------------------------------------------- -%% -spec abbreviated(#hello_request{} | #finished{} | term(), -%% #state{}) -> gen_fsm_state_return(). -%% %%-------------------------------------------------------------------- - -%% abbreviated(timeout, State) -> -%% { next_state, abbreviated, State, hibernate }; - -%% abbreviated(Msg, State) -> -%% handle_unexpected_message(Msg, abbreviated, State). - -%% %%-------------------------------------------------------------------- -%% -spec certify(#hello_request{} | #certificate{} | #server_key_exchange{} | -%% #certificate_request{} | #server_hello_done{} | #client_key_exchange{} | term(), -%% #state{}) -> gen_fsm_state_return(). -%% %%-------------------------------------------------------------------- - - -%% certify(timeout, State) -> -%% { next_state, certify, State, hibernate }; - -%% certify(Msg, State) -> -%% handle_unexpected_message(Msg, certify, State). - - -%% %%-------------------------------------------------------------------- -%% -spec cipher(#hello_request{} | #certificate_verify{} | #finished{} | term(), -%% #state{}) -> gen_fsm_state_return(). -%% %%-------------------------------------------------------------------- - -%% cipher(timeout, State) -> -%% { next_state, cipher, State, hibernate }; - -%% cipher(Msg, State) -> -%% handle_unexpected_message(Msg, cipher, State). - -%% %%-------------------------------------------------------------------- -%% -spec connection(#hello_request{} | #client_hello{} | term(), -%% #state{}) -> gen_fsm_state_return(). -%% %%-------------------------------------------------------------------- - -%% connection(timeout, State) -> -%% {next_state, connection, State, hibernate}; - -%% connection(Msg, State) -> -%% handle_unexpected_message(Msg, connection, State). - -%% %%-------------------------------------------------------------------- -%% %%% Internal functions -%% %%-------------------------------------------------------------------- -%% handle_unexpected_message(Msg, Info, #state{negotiated_version = Version} = State) -> -%% Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), -%% handle_own_alert(Alert, Version, {Info, Msg}, State). - -%% send_flight(HandshakeRec, FlightState, State) -> -%% send_flight(FlightState, buffer_flight(HandshakeRec, State)). - -%% send_flight(FlightState, State = #state{negotiated_version = Version, -%% flight_buffer = Buffer}) -> - -%% State1 = do_send_flight(queue:to_list(Buffer), [], State), -%% finish_send_flight(Version, FlightState, State1). - -%% resend_flight(State = #state{negotiated_version = Version, -%% flight_state = FlightState, -%% flight_buffer = Buffer}) -%% when FlightState == finished; FlightState == waiting -> -%% State1 = do_send_flight(queue:to_list(Buffer), [], State), -%% finish_send_flight(Version, FlightState, State1); - -%% resend_flight(State) -> -%% State. - -%% flight_done(State) -> -%% cancel_dtls_retransmit_timer(State#state{flight_state = done, -%% flight_buffer = undefined}). - -%% do_send_flight([], BinMsgs, State = #state{transport_cb = Transport, socket = Socket}) -> -%% Transport:send(Socket, lists:reverse(BinMsgs)), -%% State; -%% do_send_flight([{Epoch, MsgSeq, HandshakeRec}|T], BinMsgs0, -%% State = #state{negotiated_version = Version, -%% connection_states = ConnectionStates0}) -> -%% CS0 = ssl_record:connection_state_by_epoch(ConnectionStates0, Epoch, write), -%% {BinMsgs, CS1} = encode_handshake_rec(HandshakeRec, Version, MsgSeq, BinMsgs0, CS0), -%% ConnectionStates1 = ssl_record:set_connection_state_by_epoch(ConnectionStates0, CS1, write), -%% do_send_flight(T, BinMsgs, State#state{connection_states = ConnectionStates1}). - -%% cancel_dtls_retransmit_timer(State = #state{dtls_retransmit_timer = TimerRef}) -> -%% cancel_timer(TimerRef), -%% State#state{dtls_retransmit_timer = undefined}. - -%% rearm_dtls_retransmit_timer(State = #state{dtls_retransmit_timer = undefined}) -> -%% TimerRef = erlang:start_timer(1000, self(), dtls_retransmit), -%% State#state{dtls_retransmit_timer = TimerRef}; -%% rearm_dtls_retransmit_timer(State) -> -%% State. - -%% finish_send_flight({254, _}, waiting, State) -> -%% TimerRef = erlang:start_timer(1000, self(), dtls_retransmit), -%% State#state{ -%% dtls_retransmit_timer = TimerRef, -%% last_retransmit = timestamp(), -%% flight_state = waiting}; - -%% finish_send_flight(_, FlightState, State) -> -%% State#state{flight_state = FlightState}. - -%% timestamp() -> -%% {Mega, Sec, Micro} = erlang:now(), -%% Mega * 1000000 * 1000 + Sec * 1000 + (Micro div 1000). - -%% encode_handshake_rec(HandshakeRec, Version, MsgSeq, BinMsgs0, CS0) -> -%% {_, Fragments} = ssl_handshake:encode_handshake(HandshakeRec, Version, MsgSeq, 1400), -%% lists:foldl(fun(F, {Bin, C0}) -> -%% {B, C1} = ssl_record:encode_handshake(F, Version, C0), -%% {[B|Bin], C1} end, {BinMsgs0, CS0}, Fragments). +%%==================================================================== +%% Internal application API +%%==================================================================== +start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_} = Opts, + User, {CbModule, _,_, _} = CbInfo, + Timeout) -> + try + {ok, Pid} = dtls_connection_sup:start_child([Role, Host, Port, Socket, + Opts, User, CbInfo]), + {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule), + ok = ssl_connection:handshake(SslSocket, Timeout), + {ok, SslSocket} + catch + error:{badmatch, {error, _} = Error} -> + Error + end; + +start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_} = Opts, + User, {CbModule, _,_, _} = CbInfo, + Timeout) -> + try + {ok, Pid} = dtls_connection_sup:start_child_dist([Role, Host, Port, Socket, + Opts, User, CbInfo]), + {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule), + ok = ssl_connection:handshake(SslSocket, Timeout), + {ok, SslSocket} + catch + error:{badmatch, {error, _} = Error} -> + Error + end. + +send_handshake(Handshake, #state{negotiated_version = Version, + tls_handshake_history = Hist0, + connection_states = ConnectionStates0} = State0) -> + {BinHandshake, ConnectionStates, Hist} = + encode_handshake(Handshake, Version, ConnectionStates0, Hist0), + send_flight(BinHandshake, State0#state{connection_states = ConnectionStates, + tls_handshake_history = Hist + }). + +send_alert(Alert, #state{negotiated_version = Version, + socket = Socket, + transport_cb = Transport, + connection_states = ConnectionStates0} = State0) -> + {BinMsg, ConnectionStates} = + ssl_alert:encode(Alert, Version, ConnectionStates0), + Transport:send(Socket, BinMsg), + State0#state{connection_states = ConnectionStates}. + +send_change_cipher(Msg, #state{connection_states = ConnectionStates0, + socket = Socket, + negotiated_version = Version, + transport_cb = Transport} = State0) -> + {BinChangeCipher, ConnectionStates} = + encode_change_cipher(Msg, Version, ConnectionStates0), + Transport:send(Socket, BinChangeCipher), + State0#state{connection_states = ConnectionStates}. + +%%==================================================================== +%% tls_connection_sup API +%%==================================================================== + +%%-------------------------------------------------------------------- +-spec start_link(atom(), host(), inet:port_number(), port(), list(), pid(), tuple()) -> + {ok, pid()} | ignore | {error, reason()}. +%% +%% Description: Creates a gen_fsm process which calls Module:init/1 to +%% initialize. To ensure a synchronized start-up procedure, this function +%% does not return until Module:init/1 has returned. +%%-------------------------------------------------------------------- +start_link(Role, Host, Port, Socket, Options, User, CbInfo) -> + {ok, proc_lib:spawn_link(?MODULE, init, [[Role, Host, Port, Socket, Options, User, CbInfo]])}. + +init([Role, Host, Port, Socket, {SSLOpts0, _} = Options, User, CbInfo]) -> + process_flag(trap_exit, true), + State0 = initial_state(Role, Host, Port, Socket, Options, User, CbInfo), + Handshake = ssl_handshake:init_handshake_history(), + TimeStamp = calendar:datetime_to_gregorian_seconds({date(), time()}), + try ssl_config:init(SSLOpts0, Role) of + {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, OwnCert, Key, DHParams} -> + Session = State0#state.session, + State = State0#state{ + tls_handshake_history = Handshake, + session = Session#session{own_certificate = OwnCert, + time_stamp = TimeStamp}, + file_ref_db = FileRefHandle, + cert_db_ref = Ref, + cert_db = CertDbHandle, + session_cache = CacheHandle, + private_key = Key, + diffie_hellman_params = DHParams}, + gen_fsm:enter_loop(?MODULE, [], hello, State, get_timeout(State)) + catch + throw:Error -> + gen_fsm:enter_loop(?MODULE, [], error, {Error,State0}, get_timeout(State0)) + end. + +%%-------------------------------------------------------------------- +%% Description:There should be one instance of this function for each +%% possible state name. Whenever a gen_fsm receives an event sent +%% using gen_fsm:send_event/2, the instance of this function with the +%% same name as the current state name StateName is called to handle +%% the event. It is also called if a timeout occurs. +%% +hello(start, #state{host = Host, port = Port, role = client, + ssl_options = SslOpts, + session = #session{own_certificate = Cert} = Session0, + session_cache = Cache, session_cache_cb = CacheCb, + transport_cb = Transport, socket = Socket, + connection_states = ConnectionStates0, + renegotiation = {Renegotiation, _}} = State0) -> + Hello = dtls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, + Cache, CacheCb, Renegotiation, Cert), + + Version = Hello#client_hello.client_version, + Handshake0 = ssl_handshake:init_handshake_history(), + {BinMsg, ConnectionStates, Handshake} = + encode_handshake(Hello, Version, ConnectionStates0, Handshake0), + Transport:send(Socket, BinMsg), + State1 = State0#state{connection_states = ConnectionStates, + negotiated_version = Version, %% Requested version + session = + Session0#session{session_id = Hello#client_hello.session_id}, + tls_handshake_history = Handshake}, + {Record, State} = next_record(State1), + next_state(hello, hello, Record, State); + +hello(Hello = #client_hello{client_version = ClientVersion, + extensions = #hello_extensions{hash_signs = HashSigns}}, + State = #state{connection_states = ConnectionStates0, + port = Port, session = #session{own_certificate = Cert} = Session0, + renegotiation = {Renegotiation, _}, + session_cache = Cache, + session_cache_cb = CacheCb, + ssl_options = SslOpts}) -> + HashSign = ssl_handshake:select_hashsign(HashSigns, Cert), + case dtls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, + ConnectionStates0, Cert}, Renegotiation) of + {Version, {Type, Session}, + ConnectionStates, + #hello_extensions{ec_point_formats = EcPointFormats, + elliptic_curves = EllipticCurves} = ServerHelloExt} -> + ssl_connection:hello({common_client_hello, Type, ServerHelloExt, HashSign}, + State#state{connection_states = ConnectionStates, + negotiated_version = Version, + session = Session, + client_ecc = {EllipticCurves, EcPointFormats}}, ?MODULE); + #alert{} = Alert -> + handle_own_alert(Alert, ClientVersion, hello, State) + end; +hello(Hello, + #state{connection_states = ConnectionStates0, + negotiated_version = ReqVersion, + role = client, + renegotiation = {Renegotiation, _}, + ssl_options = SslOptions} = State) -> + case dtls_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of + #alert{} = Alert -> + handle_own_alert(Alert, ReqVersion, hello, State); + {Version, NewId, ConnectionStates, NextProtocol} -> + ssl_connection:handle_session(Hello, + Version, NewId, ConnectionStates, NextProtocol, State) + end; + +hello(Msg, State) -> + ssl_connection:hello(Msg, State, ?MODULE). + +abbreviated(Msg, State) -> + ssl_connection:abbreviated(Msg, State, ?MODULE). + +certify(Msg, State) -> + ssl_connection:certify(Msg, State, ?MODULE). + +cipher(Msg, State) -> + ssl_connection:cipher(Msg, State, ?MODULE). + +connection(#hello_request{}, #state{host = Host, port = Port, + session = #session{own_certificate = Cert} = Session0, + session_cache = Cache, session_cache_cb = CacheCb, + ssl_options = SslOpts, + connection_states = ConnectionStates0, + renegotiation = {Renegotiation, _}} = State0) -> + Hello = dtls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, + Cache, CacheCb, Renegotiation, Cert), + %% TODO DTLS version State1 = send_handshake(Hello, State0), + State1 = State0, + {Record, State} = + next_record( + State1#state{session = Session0#session{session_id + = Hello#client_hello.session_id}}), + next_state(connection, hello, Record, State); + +connection(#client_hello{} = Hello, #state{role = server, allow_renegotiate = true} = State) -> + %% Mitigate Computational DoS attack + %% http://www.educatedguesswork.org/2011/10/ssltls_and_computational_dos.html + %% http://www.thc.org/thc-ssl-dos/ Rather than disabling client + %% initiated renegotiation we will disallow many client initiated + %% renegotiations immediately after each other. + erlang:send_after(?WAIT_TO_ALLOW_RENEGOTIATION, self(), allow_renegotiate), + hello(Hello, State#state{allow_renegotiate = false}); + +connection(#client_hello{}, #state{role = server, allow_renegotiate = false} = State0) -> + Alert = ?ALERT_REC(?WARNING, ?NO_RENEGOTIATION), + State = send_alert(Alert, State0), + next_state_connection(connection, State); + +connection(Msg, State) -> + ssl_connection:connection(Msg, State, tls_connection). + +%%-------------------------------------------------------------------- +%% Description: Whenever a gen_fsm receives an event sent using +%% gen_fsm:send_all_state_event/2, this function is called to handle +%% the event. Not currently used! +%%-------------------------------------------------------------------- +handle_event(_Event, StateName, State) -> + {next_state, StateName, State, get_timeout(State)}. + +%%-------------------------------------------------------------------- +%% Description: Whenever a gen_fsm receives an event sent using +%% gen_fsm:sync_send_all_state_event/2,3, this function is called to handle +%% the event. +%%-------------------------------------------------------------------- +handle_sync_event(Event, From, StateName, State) -> + ssl_connection:handle_sync_event(Event, From, StateName, State). + +%%-------------------------------------------------------------------- +%% Description: This function is called by a gen_fsm when it receives any +%% other message than a synchronous or asynchronous event +%% (or a system message). +%%-------------------------------------------------------------------- + +%% raw data from socket, unpack records +handle_info({Protocol, _, Data}, StateName, + #state{data_tag = Protocol} = State0) -> + %% Simplify for now to avoid dialzer warnings before implementation is compleate + %% case next_tls_record(Data, State0) of + %% {Record, State} -> + %% next_state(StateName, StateName, Record, State); + %% #alert{} = Alert -> + %% handle_normal_shutdown(Alert, StateName, State0), + %% {stop, {shutdown, own_alert}, State0} + %% end; + {Record, State} = next_tls_record(Data, State0), + next_state(StateName, StateName, Record, State); + +handle_info({CloseTag, Socket}, StateName, + #state{socket = Socket, close_tag = CloseTag, + negotiated_version = _Version} = State) -> + handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State), + {stop, {shutdown, transport_closed}, State}; + +handle_info(Msg, StateName, State) -> + ssl_connection:handle_info(Msg, StateName, State). + +%%-------------------------------------------------------------------- +%% Description:This function is called by a gen_fsm when it is about +%% to terminate. It should be the opposite of Module:init/1 and do any +%% necessary cleaning up. When it returns, the gen_fsm terminates with +%% Reason. The return value is ignored. +%%-------------------------------------------------------------------- +terminate(Reason, StateName, State) -> + ssl_connection:terminate(Reason, StateName, State). + +%%-------------------------------------------------------------------- +%% code_change(OldVsn, StateName, State, Extra) -> {ok, StateName, NewState} +%% Description: Convert process state when code is changed +%%-------------------------------------------------------------------- +code_change(_OldVsn, StateName, State, _Extra) -> + {ok, StateName, State}. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +encode_handshake(Handshake, Version, ConnectionStates0, Hist0) -> + Seq = sequence(ConnectionStates0), + {EncHandshake, FragmentedHandshake} = dtls_handshake:encode_handshake(Handshake, Version, + Seq), + Hist = ssl_handshake:update_handshake_history(Hist0, EncHandshake), + {Encoded, ConnectionStates} = + dtls_record:encode_handshake(FragmentedHandshake, + Version, ConnectionStates0), + {Encoded, ConnectionStates, Hist}. + +next_record(#state{%%flight = #flight{state = finished}, + protocol_buffers = + #protocol_buffers{dtls_packets = [], dtls_cipher_texts = [CT | Rest]} + = Buffers, + connection_states = ConnStates0} = State) -> + case dtls_record:decode_cipher_text(CT, ConnStates0) of + {Plain, ConnStates} -> + {Plain, State#state{protocol_buffers = + Buffers#protocol_buffers{dtls_cipher_texts = Rest}, + connection_states = ConnStates}}; + #alert{} = Alert -> + {Alert, State} + end; +next_record(#state{socket = Socket, + transport_cb = Transport} = State) -> %% when FlightState =/= finished + ssl_socket:setopts(Transport, Socket, [{active,once}]), + {no_record, State}; + + +next_record(State) -> + {no_record, State}. + +next_state(Current,_, #alert{} = Alert, #state{negotiated_version = Version} = State) -> + handle_own_alert(Alert, Version, Current, State); + +next_state(_,Next, no_record, State) -> + {next_state, Next, State, get_timeout(State)}; + +%% next_state(_,Next, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, State) -> +%% Alerts = decode_alerts(EncAlerts), +%% handle_alerts(Alerts, {next_state, Next, State, get_timeout(State)}); + +next_state(Current, Next, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, + State0 = #state{protocol_buffers = + #protocol_buffers{dtls_handshake_buffer = Buf0} = Buffers, + negotiated_version = Version}) -> + Handle = + fun({#hello_request{} = Packet, _}, {next_state, connection = SName, State}) -> + %% This message should not be included in handshake + %% message hashes. Starts new handshake (renegotiation) + Hs0 = ssl_handshake:init_handshake_history(), + ?MODULE:SName(Packet, State#state{tls_handshake_history=Hs0, + renegotiation = {true, peer}}); + ({#hello_request{} = Packet, _}, {next_state, SName, State}) -> + %% This message should not be included in handshake + %% message hashes. Already in negotiation so it will be ignored! + ?MODULE:SName(Packet, State); + ({#client_hello{} = Packet, Raw}, {next_state, connection = SName, State}) -> + Version = Packet#client_hello.client_version, + Hs0 = ssl_handshake:init_handshake_history(), + Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw), + ?MODULE:SName(Packet, State#state{tls_handshake_history=Hs1, + renegotiation = {true, peer}}); + ({Packet, Raw}, {next_state, SName, State = #state{tls_handshake_history=Hs0}}) -> + Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw), + ?MODULE:SName(Packet, State#state{tls_handshake_history=Hs1}); + (_, StopState) -> StopState + end, + try + {Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0), + State = State0#state{protocol_buffers = + Buffers#protocol_buffers{dtls_packets = Packets, + dtls_handshake_buffer = Buf}}, + handle_dtls_handshake(Handle, Next, State) + catch throw:#alert{} = Alert -> + handle_own_alert(Alert, Version, Current, State0) + end; + +next_state(_, StateName, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, State0) -> + %% Simplify for now to avoid dialzer warnings before implementation is compleate + %% case read_application_data(Data, State0) of + %% Stop = {stop,_,_} -> + %% Stop; + %% {Record, State} -> + %% next_state(StateName, StateName, Record, State) + %% end; + {Record, State} = read_application_data(Data, State0), + next_state(StateName, StateName, Record, State); + +next_state(Current, Next, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = <<1>>} = + _ChangeCipher, + #state{connection_states = ConnectionStates0} = State0) -> + ConnectionStates1 = + ssl_record:activate_pending_connection_state(ConnectionStates0, read), + {Record, State} = next_record(State0#state{connection_states = ConnectionStates1}), + next_state(Current, Next, Record, State); +next_state(Current, Next, #ssl_tls{type = _Unknown}, State0) -> + %% Ignore unknown type + {Record, State} = next_record(State0), + next_state(Current, Next, Record, State). + +handle_dtls_handshake(Handle, StateName, + #state{protocol_buffers = + #protocol_buffers{dtls_packets = [Packet]} = Buffers} = State) -> + FsmReturn = {next_state, StateName, State#state{protocol_buffers = + Buffers#protocol_buffers{dtls_packets = []}}}, + Handle(Packet, FsmReturn); + +handle_dtls_handshake(Handle, StateName, + #state{protocol_buffers = + #protocol_buffers{dtls_packets = [Packet | Packets]} = Buffers} = + State0) -> + FsmReturn = {next_state, StateName, State0#state{protocol_buffers = + Buffers#protocol_buffers{dtls_packets = + Packets}}}, + case Handle(Packet, FsmReturn) of + {next_state, NextStateName, State, _Timeout} -> + handle_dtls_handshake(Handle, NextStateName, State); + {stop, _,_} = Stop -> + Stop + end. + + +send_flight(Fragments, #state{transport_cb = Transport, socket = Socket, + protocol_buffers = _PBuffers} = State) -> + Transport:send(Socket, Fragments), + %% Start retransmission + %% State#state{protocol_buffers = + %% (PBuffers#protocol_buffers){ #flight{state = waiting}}}}. + State. + +handle_own_alert(_,_,_, State) -> %% Place holder + {stop, {shutdown, own_alert}, State}. + +handle_normal_shutdown(_, _, _State) -> %% Place holder + ok. + +encode_change_cipher(#change_cipher_spec{}, Version, ConnectionStates) -> + dtls_record:encode_change_cipher_spec(Version, ConnectionStates). + +initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, + {CbModule, DataTag, CloseTag, ErrorTag}) -> + ConnectionStates = ssl_record:init_connection_states(Role), + + SessionCacheCb = case application:get_env(ssl, session_cb) of + {ok, Cb} when is_atom(Cb) -> + Cb; + _ -> + ssl_session_cache + end, + + Monitor = erlang:monitor(process, User), + + #state{socket_options = SocketOptions, + %% We do not want to save the password in the state so that + %% could be written in the clear into error logs. + ssl_options = SSLOptions#ssl_options{password = undefined}, + session = #session{is_resumable = new}, + transport_cb = CbModule, + data_tag = DataTag, + close_tag = CloseTag, + error_tag = ErrorTag, + role = Role, + host = Host, + port = Port, + socket = Socket, + connection_states = ConnectionStates, + protocol_buffers = #protocol_buffers{}, + user_application = {Monitor, User}, + user_data_buffer = <<>>, + session_cache_cb = SessionCacheCb, + renegotiation = {false, first}, + start_or_recv_from = undefined, + send_queue = queue:new(), + protocol_cb = ?MODULE + }. +read_application_data(_,State) -> + {#ssl_tls{fragment = <<"place holder">>}, State}. + +next_tls_record(_, State) -> + {#ssl_tls{fragment = <<"place holder">>}, State}. + +get_timeout(_) -> %% Place holder + infinity. + +next_state_connection(_, State) -> %% Place holder + {next_state, connection, State, get_timeout(State)}. + +sequence(_) -> + %%TODO real imp + 1. diff --git a/lib/ssl/src/dtls_connection.hrl b/lib/ssl/src/dtls_connection.hrl index b8dff479d5..08707dc8de 100644 --- a/lib/ssl/src/dtls_connection.hrl +++ b/lib/ssl/src/dtls_connection.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2014. 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 @@ -28,24 +28,19 @@ -include("ssl_connection.hrl"). -record(protocol_buffers, { - dtls_packets = [] ::[binary()], % Not yet handled decode ssl/tls packets. - dtls_record_buffer :: binary(), % Buffer of incomplete records - dtls_handshake_buffer :: binary(), % Buffer of incomplete handshakes - dtls_cipher_texts :: [binary()], - dtls_cipher_texts_next :: [binary()] % Received for Epoch not yet active + dtls_packets = [], %%::[binary()], % Not yet handled decode ssl/tls packets. + dtls_record_buffer = <<>>, %%:: binary(), % Buffer of incomplete records + dtls_handshake_buffer = <<>>, %%:: binary(), % Buffer of incomplete handshakes + dtls_cipher_texts = [], %%:: [binary()], + dtls_cipher_texts_next %%:: [binary()] % Received for Epoch not yet active }). -record(flight, { last_retransmit, last_read_seq, msl_timer, - flight_state, - flight_buffer, % buffer of not yet ACKed TLS records - }). - --record(message_sequences, { - read = 0, - write = 0 + state, + buffer % buffer of not yet ACKed TLS records }). -endif. % -ifdef(dtls_connection). diff --git a/lib/ssl/src/dtls_connection_sup.erl b/lib/ssl/src/dtls_connection_sup.erl index 9fe545be18..0b4711cfb4 100644 --- a/lib/ssl/src/dtls_connection_sup.erl +++ b/lib/ssl/src/dtls_connection_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. 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 @@ -26,8 +26,8 @@ -behaviour(supervisor). %% API --export([start_link/0]). --export([start_child/1]). +-export([start_link/0, start_link_dist/0]). +-export([start_child/1, start_child_dist/1]). %% Supervisor callback -export([init/1]). @@ -38,8 +38,14 @@ start_link() -> supervisor:start_link({local, ?MODULE}, ?MODULE, []). +start_link_dist() -> + supervisor:start_link({local, dtls_connection_sup_dist}, ?MODULE, []). + start_child(Args) -> supervisor:start_child(?MODULE, Args). + +start_child_dist(Args) -> + supervisor:start_child(dtls_connection_sup_dist, Args). %%%========================================================================= %%% Supervisor callback diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index 5db2434753..31d525b295 100644 --- a/lib/ssl/src/dtls_handshake.erl +++ b/lib/ssl/src/dtls_handshake.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2014. 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 @@ -20,11 +20,15 @@ -include("dtls_handshake.hrl"). -include("dtls_record.hrl"). -include("ssl_internal.hrl"). +-include("ssl_alert.hrl"). --export([client_hello/8, client_hello/9, hello/3, +-export([client_hello/8, client_hello/9, hello/4, get_dtls_handshake/2, - dtls_handshake_new_flight/1, dtls_handshake_new_epoch/1, - encode_handshake/4]). + %%dtls_handshake_new_flight/1, dtls_handshake_new_epoch/1, + encode_handshake/3]). + +-type dtls_handshake() :: #client_hello{} | #hello_verify_request{} | + ssl_handshake:ssl_handshake(). %%==================================================================== %% Internal application API @@ -54,12 +58,12 @@ client_hello(Host, Port, Cookie, ConnectionStates, ciphers = UserSuites } = SslOpts, Cache, CacheCb, Renegotiation, OwnCert) -> - Version = dtls_record:highest_protocol_version(Versions), + Version = dtls_record:highest_protocol_version(Versions), Pending = ssl_record:pending_connection_state(ConnectionStates, read), SecParams = Pending#connection_state.security_parameters, CipherSuites = ssl_handshake:available_suites(UserSuites, Version), - Extensions = ssl_handshake:client_hello_extensions(Host, Version, CipherSuites, + Extensions = ssl_handshake:client_hello_extensions(Host, dtls_v1:corresponding_tls_version(Version), CipherSuites, SslOpts, ConnectionStates, Renegotiation), Id = ssl_session:client_id({Host, Port, SslOpts}, Cache, CacheCb, OwnCert), @@ -73,163 +77,197 @@ client_hello(Host, Port, Cookie, ConnectionStates, extensions = Extensions }. -hello(Address, Port, - #ssl_tls{epoch = _Epoch, record_seq = _Seq, - version = Version} = Record) -> - {[{Hello, _}], _, _} = - get_dtls_handshake(Record, - dtls_handshake_new_flight(undefined)), - #client_hello{client_version = {Major, Minor}, - random = Random, - session_id = SessionId, - cipher_suites = CipherSuites, - compression_methods = CompressionMethods} = Hello, - CookieData = [address_to_bin(Address, Port), - <<?BYTE(Major), ?BYTE(Minor)>>, - Random, SessionId, CipherSuites, CompressionMethods], - Cookie = crypto:hmac(sha, <<"secret">>, CookieData), - - case Hello of - #client_hello{cookie = Cookie} -> - accept; - _ -> - %% generate HelloVerifyRequest - HelloVerifyRequest = encode_handshake(#hello_verify_request{protocol_version = Version, - cookie = Cookie}, - Version, 0, 1400), - {reply, HelloVerifyRequest} - end. +hello(#server_hello{server_version = Version, random = Random, + cipher_suite = CipherSuite, + compression_method = Compression, + session_id = SessionId, extensions = HelloExt}, + #ssl_options{versions = SupportedVersions} = SslOpt, + ConnectionStates0, Renegotiation) -> + case dtls_record:is_acceptable_version(Version, SupportedVersions) of + true -> + handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, + Compression, HelloExt, SslOpt, ConnectionStates0, Renegotiation); + false -> + ?ALERT_REC(?FATAL, ?PROTOCOL_VERSION) + end; -%%-------------------------------------------------------------------- -encode_handshake(Package, Version, MsgSeq, Mss) -> - {MsgType, Bin} = enc_hs(Package, Version), +hello(#client_hello{client_version = ClientVersion}, _Options, {_,_,_,_,ConnectionStates,_}, _Renegotiation) -> + %% Return correct typ to make dialyzer happy until we have time to make the real imp. + {ClientVersion, {new, #session{}}, ConnectionStates, #hello_extensions{}}. + +%% hello(Address, Port, +%% #ssl_tls{epoch = _Epoch, sequence_number = _Seq, +%% version = Version} = Record) -> +%% case get_dtls_handshake(Record, +%% dtls_handshake_new_flight(undefined)) of +%% {[Hello | _], _} -> +%% hello(Address, Port, Version, Hello); +%% {retransmit, HandshakeState} -> +%% {retransmit, HandshakeState} +%% end. + +%% hello(Address, Port, Version, Hello) -> +%% #client_hello{client_version = {Major, Minor}, +%% random = Random, +%% session_id = SessionId, +%% cipher_suites = CipherSuites, +%% compression_methods = CompressionMethods} = Hello, +%% CookieData = [address_to_bin(Address, Port), +%% <<?BYTE(Major), ?BYTE(Minor)>>, +%% Random, SessionId, CipherSuites, CompressionMethods], +%% Cookie = crypto:hmac(sha, <<"secret">>, CookieData), + +%% case Hello of +%% #client_hello{cookie = Cookie} -> +%% accept; +%% _ -> +%% %% generate HelloVerifyRequest +%% HelloVerifyRequest = enc_hs(#hello_verify_request{protocol_version = Version, +%% cookie = Cookie}, +%% Version, 0, 1400), +%% {reply, HelloVerifyRequest} +%% end. + +%% %%-------------------------------------------------------------------- +encode_handshake(Handshake, Version, MsgSeq) -> + {MsgType, Bin} = enc_handshake(Handshake, Version), Len = byte_size(Bin), - HsHistory = [MsgType, ?uint24(Len), ?uint16(MsgSeq), ?uint24(0), ?uint24(Len), Bin], - BinMsg = dtls_split_handshake(Mss, MsgType, Len, MsgSeq, Bin, 0, []), - {HsHistory, BinMsg}. + EncHandshake = [MsgType, ?uint24(Len), ?uint16(MsgSeq), ?uint24(0), ?uint24(Len), Bin], + FragmentedHandshake = dtls_fragment(erlang:iolist_size(EncHandshake), MsgType, Len, MsgSeq, Bin, 0, []), + {EncHandshake, FragmentedHandshake}. -%-------------------------------------------------------------------- +%%-------------------------------------------------------------------- -spec get_dtls_handshake(#ssl_tls{}, #dtls_hs_state{} | binary()) -> - {[dtls_handshake()], #dtls_hs_state{}} | {retransmit, #dtls_hs_state{}}. -% -% Description: Given a DTLS state and new data from ssl_record, collects -% and returns it as a list of handshake messages, also returns a new -% DTLS state -%-------------------------------------------------------------------- -% get_dtls_handshake(Record, <<>>) -> -% get_dtls_handshake_aux(Record, dtls_hs_state_init()); + {[dtls_handshake()], #dtls_hs_state{}} | {retransmit, #dtls_hs_state{}}. +%% +%% Description: Given a DTLS state and new data from ssl_record, collects +%% and returns it as a list of handshake messages, also returns a new +%% DTLS state +%%-------------------------------------------------------------------- +get_dtls_handshake(Record, <<>>) -> + get_dtls_handshake_aux(Record, #dtls_hs_state{}); %% Init handshake state!? get_dtls_handshake(Record, HsState) -> get_dtls_handshake_aux(Record, HsState). -%-------------------------------------------------------------------- --spec dtls_handshake_new_epoch(#dtls_hs_state{}) -> #dtls_hs_state{}. -% -% Description: Reset the DTLS decoder state for a new Epoch -%-------------------------------------------------------------------- -% dtls_handshake_new_epoch(<<>>) -> -% dtls_hs_state_init(); -dtls_handshake_new_epoch(HsState) -> - HsState#dtls_hs_state{highest_record_seq = 0, - starting_read_seq = HsState#dtls_hs_state.current_read_seq, - fragments = gb_trees:empty(), completed = []}. - -%-------------------------------------------------------------------- --spec dtls_handshake_new_flight(integer() | undefined) -> #dtls_hs_state{}. -% -% Description: Init the DTLS decoder state for a new Flight -dtls_handshake_new_flight(ExpectedReadReq) -> - #dtls_hs_state{current_read_seq = ExpectedReadReq, - highest_record_seq = 0, - starting_read_seq = 0, - fragments = gb_trees:empty(), completed = []}. +%% %%-------------------------------------------------------------------- +%% -spec dtls_handshake_new_epoch(#dtls_hs_state{}) -> #dtls_hs_state{}. +%% %% +%% %% Description: Reset the DTLS decoder state for a new Epoch +%% %%-------------------------------------------------------------------- +%% dtls_handshake_new_epoch(<<>>) -> +%% dtls_hs_state_init(); +%% dtls_handshake_new_epoch(HsState) -> +%% HsState#dtls_hs_state{highest_record_seq = 0, +%% starting_read_seq = HsState#dtls_hs_state.current_read_seq, +%% fragments = gb_trees:empty(), completed = []}. + +%% %-------------------------------------------------------------------- +%% -spec dtls_handshake_new_flight(integer() | undefined) -> #dtls_hs_state{}. +%% % +%% % Description: Init the DTLS decoder state for a new Flight +%% dtls_handshake_new_flight(ExpectedReadReq) -> +%% #dtls_hs_state{current_read_seq = ExpectedReadReq, +%% highest_record_seq = 0, +%% starting_read_seq = 0, +%% fragments = gb_trees:empty(), completed = []}. %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- +handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, + Compression, HelloExt, SslOpt, ConnectionStates0, Renegotiation) -> + case ssl_handshake:handle_server_hello_extensions(dtls_record, Random, CipherSuite, + Compression, HelloExt, Version, + SslOpt, ConnectionStates0, Renegotiation) of + #alert{} = Alert -> + Alert; + {ConnectionStates, Protocol} -> + {Version, SessionId, ConnectionStates, Protocol} + end. -dtls_split_handshake(Mss, MsgType, Len, MsgSeq, Bin, Offset, Acc) +dtls_fragment(Mss, MsgType, Len, MsgSeq, Bin, Offset, Acc) when byte_size(Bin) + 12 < Mss -> FragmentLen = byte_size(Bin), BinMsg = [MsgType, ?uint24(Len), ?uint16(MsgSeq), ?uint24(Offset), ?uint24(FragmentLen), Bin], lists:reverse([BinMsg|Acc]); -dtls_split_handshake(Mss, MsgType, Len, MsgSeq, Bin, Offset, Acc) -> +dtls_fragment(Mss, MsgType, Len, MsgSeq, Bin, Offset, Acc) -> FragmentLen = Mss - 12, <<Fragment:FragmentLen/bytes, Rest/binary>> = Bin, BinMsg = [MsgType, ?uint24(Len), ?uint16(MsgSeq), ?uint24(Offset), ?uint24(FragmentLen), Fragment], - dtls_split_handshake(Mss, MsgType, Len, MsgSeq, Rest, Offset + FragmentLen, [BinMsg|Acc]). + dtls_fragment(Mss, MsgType, Len, MsgSeq, Rest, Offset + FragmentLen, [BinMsg|Acc]). get_dtls_handshake_aux(#ssl_tls{version = Version, - record_seq = SeqNo, - fragment = Data}, HsState) -> + sequence_number = SeqNo, + fragment = Data}, HsState) -> get_dtls_handshake_aux(Version, SeqNo, Data, HsState). get_dtls_handshake_aux(Version, SeqNo, - <<?BYTE(Type), ?UINT24(Length), - ?UINT16(MessageSeq), - ?UINT24(FragmentOffset), ?UINT24(FragmentLength), - Body:FragmentLength/binary, Rest/binary>>, - HsState0) -> + <<?BYTE(Type), ?UINT24(Length), + ?UINT16(MessageSeq), + ?UINT24(FragmentOffset), ?UINT24(FragmentLength), + Body:FragmentLength/binary, Rest/binary>>, + HsState0) -> case reassemble_dtls_fragment(SeqNo, Type, Length, MessageSeq, - FragmentOffset, FragmentLength, - Body, HsState0) of - {retransmit, HsState1} -> - case Rest of - <<>> -> - {retransmit, HsState1}; - _ -> - get_dtls_handshake_aux(Version, SeqNo, Rest, HsState1) - end; - {HsState1, HighestSeqNo, MsgBody} -> - HsState2 = dec_dtls_fragment(Version, HighestSeqNo, Type, Length, MessageSeq, MsgBody, HsState1), - HsState3 = process_dtls_fragments(Version, HsState2), - get_dtls_handshake_aux(Version, SeqNo, Rest, HsState3); - HsState2 -> - HsState3 = process_dtls_fragments(Version, HsState2), - get_dtls_handshake_aux(Version, SeqNo, Rest, HsState3) - end; + FragmentOffset, FragmentLength, + Body, HsState0) of + {retransmit, HsState1} -> + case Rest of + <<>> -> + {retransmit, HsState1}; + _ -> + get_dtls_handshake_aux(Version, SeqNo, Rest, HsState1) + end; + {HsState1, HighestSeqNo, MsgBody} -> + HsState2 = dec_dtls_fragment(Version, HighestSeqNo, Type, Length, MessageSeq, MsgBody, HsState1), + HsState3 = process_dtls_fragments(Version, HsState2), + get_dtls_handshake_aux(Version, SeqNo, Rest, HsState3); + HsState2 -> + HsState3 = process_dtls_fragments(Version, HsState2), + get_dtls_handshake_aux(Version, SeqNo, Rest, HsState3) + end; get_dtls_handshake_aux(_Version, _SeqNo, <<>>, HsState) -> - {lists:reverse(HsState#dtls_hs_state.completed), - HsState#dtls_hs_state{completed = []}}. + {lists:reverse(HsState#dtls_hs_state.completed), + HsState#dtls_hs_state{completed = []}}. dec_dtls_fragment(Version, SeqNo, Type, Length, MessageSeq, MsgBody, - HsState = #dtls_hs_state{highest_record_seq = HighestSeqNo, completed = Acc}) -> + HsState = #dtls_hs_state{highest_record_seq = HighestSeqNo, completed = Acc}) -> Raw = <<?BYTE(Type), ?UINT24(Length), ?UINT16(MessageSeq), ?UINT24(0), ?UINT24(Length), MsgBody/binary>>, H = decode_handshake(Version, Type, MsgBody), HsState#dtls_hs_state{completed = [{H,Raw}|Acc], highest_record_seq = erlang:max(HighestSeqNo, SeqNo)}. process_dtls_fragments(Version, - HsState0 = #dtls_hs_state{current_read_seq = CurrentReadSeq, - fragments = Fragments0}) -> + HsState0 = #dtls_hs_state{current_read_seq = CurrentReadSeq, + fragments = Fragments0}) -> case gb_trees:is_empty(Fragments0) of - true -> - HsState0; - _ -> - case gb_trees:smallest(Fragments0) of - {CurrentReadSeq, {SeqNo, Type, Length, CurrentReadSeq, {Length, [{0, Length}], MsgBody}}} -> - HsState1 = dtls_hs_state_process_seq(HsState0), - HsState2 = dec_dtls_fragment(Version, SeqNo, Type, Length, CurrentReadSeq, MsgBody, HsState1), - process_dtls_fragments(Version, HsState2); - _ -> - HsState0 - end - end. + true -> + HsState0; + _ -> + case gb_trees:smallest(Fragments0) of + {CurrentReadSeq, {SeqNo, Type, Length, CurrentReadSeq, {Length, [{0, Length}], MsgBody}}} -> + HsState1 = dtls_hs_state_process_seq(HsState0), + HsState2 = dec_dtls_fragment(Version, SeqNo, Type, Length, CurrentReadSeq, MsgBody, HsState1), + process_dtls_fragments(Version, HsState2); + _ -> + HsState0 + end + end. dtls_hs_state_process_seq(HsState0 = #dtls_hs_state{current_read_seq = CurrentReadSeq, - fragments = Fragments0}) -> + fragments = Fragments0}) -> Fragments1 = gb_trees:delete_any(CurrentReadSeq, Fragments0), HsState0#dtls_hs_state{current_read_seq = CurrentReadSeq + 1, - fragments = Fragments1}. + fragments = Fragments1}. dtls_hs_state_add_fragment(MessageSeq, Fragment, HsState0 = #dtls_hs_state{fragments = Fragments0}) -> Fragments1 = gb_trees:enter(MessageSeq, Fragment, Fragments0), HsState0#dtls_hs_state{fragments = Fragments1}. reassemble_dtls_fragment(SeqNo, Type, Length, MessageSeq, 0, Length, - Body, HsState0 = #dtls_hs_state{current_read_seq = undefined}) + Body, HsState0 = #dtls_hs_state{current_read_seq = undefined}) when Type == ?CLIENT_HELLO; Type == ?SERVER_HELLO; - Type == ?HELLO_VERIFY_REQUEST -> + Type == ?HELLO_VERIFY_REQUEST -> %% First message, should be client hello %% return the current message and set the next expected Sequence %% @@ -245,8 +283,8 @@ reassemble_dtls_fragment(_SeqNo, _Type, Length, _MessageSeq, _, Length, HsState; reassemble_dtls_fragment(SeqNo, _Type, Length, MessageSeq, 0, Length, - Body, HsState0 = - #dtls_hs_state{starting_read_seq = StartingReadSeq}) + Body, HsState0 = + #dtls_hs_state{starting_read_seq = StartingReadSeq}) when MessageSeq < StartingReadSeq -> %% this has to be the start of a new flight, let it through %% @@ -257,69 +295,69 @@ reassemble_dtls_fragment(SeqNo, _Type, Length, MessageSeq, 0, Length, {HsState, SeqNo, Body}; reassemble_dtls_fragment(_SeqNo, _Type, Length, MessageSeq, 0, Length, - _Body, HsState = - #dtls_hs_state{current_read_seq = CurrentReadSeq}) + _Body, HsState = + #dtls_hs_state{current_read_seq = CurrentReadSeq}) when MessageSeq < CurrentReadSeq -> {retransmit, HsState}; reassemble_dtls_fragment(_SeqNo, _Type, Length, MessageSeq, 0, Length, - _Body, HsState = #dtls_hs_state{current_read_seq = CurrentReadSeq}) + _Body, HsState = #dtls_hs_state{current_read_seq = CurrentReadSeq}) when MessageSeq < CurrentReadSeq -> HsState; reassemble_dtls_fragment(SeqNo, _Type, Length, MessageSeq, 0, Length, - Body, HsState0 = #dtls_hs_state{current_read_seq = MessageSeq}) -> + Body, HsState0 = #dtls_hs_state{current_read_seq = MessageSeq}) -> %% Message fully contained and it's the current seq HsState1 = dtls_hs_state_process_seq(HsState0), {HsState1, SeqNo, Body}; reassemble_dtls_fragment(SeqNo, Type, Length, MessageSeq, 0, Length, - Body, HsState) -> + Body, HsState) -> %% Message fully contained and it's the NOT the current seq -> buffer Fragment = {SeqNo, Type, Length, MessageSeq, - dtls_fragment_init(Length, 0, Length, Body)}, + dtls_fragment_init(Length, 0, Length, Body)}, dtls_hs_state_add_fragment(MessageSeq, Fragment, HsState); reassemble_dtls_fragment(_SeqNo, _Type, Length, MessageSeq, FragmentOffset, FragmentLength, - _Body, - HsState = #dtls_hs_state{current_read_seq = CurrentReadSeq}) + _Body, + HsState = #dtls_hs_state{current_read_seq = CurrentReadSeq}) when FragmentOffset + FragmentLength == Length andalso MessageSeq == (CurrentReadSeq - 1) -> {retransmit, HsState}; reassemble_dtls_fragment(_SeqNo, _Type, _Length, MessageSeq, _FragmentOffset, _FragmentLength, - _Body, - HsState = #dtls_hs_state{current_read_seq = CurrentReadSeq}) + _Body, + HsState = #dtls_hs_state{current_read_seq = CurrentReadSeq}) when MessageSeq < CurrentReadSeq -> HsState; reassemble_dtls_fragment(SeqNo, Type, Length, MessageSeq, - FragmentOffset, FragmentLength, - Body, - HsState = #dtls_hs_state{fragments = Fragments0}) -> + FragmentOffset, FragmentLength, + Body, + HsState = #dtls_hs_state{fragments = Fragments0}) -> case gb_trees:lookup(MessageSeq, Fragments0) of - {value, Fragment} -> - dtls_fragment_reassemble(SeqNo, Type, Length, MessageSeq, - FragmentOffset, FragmentLength, - Body, Fragment, HsState); - none -> - dtls_fragment_start(SeqNo, Type, Length, MessageSeq, - FragmentOffset, FragmentLength, - Body, HsState) + {value, Fragment} -> + dtls_fragment_reassemble(SeqNo, Type, Length, MessageSeq, + FragmentOffset, FragmentLength, + Body, Fragment, HsState); + none -> + dtls_fragment_start(SeqNo, Type, Length, MessageSeq, + FragmentOffset, FragmentLength, + Body, HsState) end. dtls_fragment_start(SeqNo, Type, Length, MessageSeq, - FragmentOffset, FragmentLength, - Body, HsState = #dtls_hs_state{fragments = Fragments0}) -> + FragmentOffset, FragmentLength, + Body, HsState = #dtls_hs_state{fragments = Fragments0}) -> Fragment = {SeqNo, Type, Length, MessageSeq, - dtls_fragment_init(Length, FragmentOffset, FragmentLength, Body)}, - Fragments1 = gb_trees:insert(MessageSeq, Fragment, Fragments0), + dtls_fragment_init(Length, FragmentOffset, FragmentLength, Body)}, + Fragments1 = gb_trees:insert(MessageSeq, Fragment, Fragments0), HsState#dtls_hs_state{fragments = Fragments1}. dtls_fragment_reassemble(SeqNo, Type, Length, MessageSeq, FragmentOffset, FragmentLength, - Body, - {LastSeqNo, Type, Length, MessageSeq, FragBuffer0}, - HsState = #dtls_hs_state{fragments = Fragments0}) -> + Body, + {LastSeqNo, Type, Length, MessageSeq, FragBuffer0}, + HsState = #dtls_hs_state{fragments = Fragments0}) -> FragBuffer1 = dtls_fragment_add(FragBuffer0, FragmentOffset, FragmentLength, Body), Fragment = {erlang:max(SeqNo, LastSeqNo), Type, Length, MessageSeq, FragBuffer1}, Fragments1 = gb_trees:enter(MessageSeq, Fragment, Fragments0), @@ -328,8 +366,8 @@ dtls_fragment_reassemble(SeqNo, Type, Length, MessageSeq, %% Type, Length or Seq mismatch, drop everything... %% Note: the RFC is not clear on how to handle this... dtls_fragment_reassemble(_SeqNo, _Type, _Length, MessageSeq, - _FragmentOffset, _FragmentLength, _Body, _Fragment, - HsState = #dtls_hs_state{fragments = Fragments0}) -> + _FragmentOffset, _FragmentLength, _Body, _Fragment, + HsState = #dtls_hs_state{fragments = Fragments0}) -> Fragments1 = gb_trees:delete_any(MessageSeq, Fragments0), HsState#dtls_hs_state{fragments = Fragments1}. @@ -360,7 +398,7 @@ merge_fragment_list(Rest = [{HStart, _HEnd}|_], Frag = {_FStart, FEnd}, Acc) lists:reverse(Acc) ++ [Frag|Rest]; merge_fragment_list([{HStart, HEnd}|Rest], _Frag = {FStart, FEnd}, Acc) - when + when FStart =< HEnd orelse FEnd >= HStart -> Start = erlang:min(HStart, FStart), End = erlang:max(HEnd, FEnd), @@ -370,20 +408,20 @@ merge_fragment_list([{HStart, HEnd}|Rest], _Frag = {FStart, FEnd}, Acc) add_fragment(List, {FragmentOffset, FragmentLength}) -> merge_fragment_list(List, {FragmentOffset, FragmentOffset + FragmentLength}, []). -enc_hs(#hello_verify_request{protocol_version = {Major, Minor}, - cookie = Cookie}, _Version) -> - CookieLength = byte_size(Cookie), +enc_handshake(#hello_verify_request{protocol_version = {Major, Minor}, + cookie = Cookie}, _Version) -> + CookieLength = byte_size(Cookie), {?HELLO_VERIFY_REQUEST, <<?BYTE(Major), ?BYTE(Minor), - ?BYTE(CookieLength), - Cookie/binary>>}; - -enc_hs(#client_hello{client_version = {Major, Minor}, - random = Random, - session_id = SessionID, - cookie = Cookie, - cipher_suites = CipherSuites, - compression_methods = CompMethods, - extensions = HelloExtensions}, Version) -> + ?BYTE(CookieLength), + Cookie/binary>>}; + +enc_handshake(#client_hello{client_version = {Major, Minor}, + random = Random, + session_id = SessionID, + cookie = Cookie, + cipher_suites = CipherSuites, + compression_methods = CompMethods, + extensions = HelloExtensions}, Version) -> SIDLength = byte_size(SessionID), BinCookie = enc_client_hello_cookie(Version, Cookie), BinCompMethods = list_to_binary(CompMethods), @@ -391,13 +429,13 @@ enc_hs(#client_hello{client_version = {Major, Minor}, BinCipherSuites = list_to_binary(CipherSuites), CsLength = byte_size(BinCipherSuites), ExtensionsBin = ssl_handshake:encode_hello_extensions(HelloExtensions), - + {?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, - ?BYTE(SIDLength), SessionID/binary, - BinCookie/binary, - ?UINT16(CsLength), BinCipherSuites/binary, - ?BYTE(CmLength), BinCompMethods/binary, ExtensionsBin/binary>>}; -enc_hs(HandshakeMsg, Version) -> + ?BYTE(SIDLength), SessionID/binary, + BinCookie/binary, + ?UINT16(CsLength), BinCipherSuites/binary, + ?BYTE(CmLength), BinCompMethods/binary, ExtensionsBin/binary>>}; +enc_handshake(HandshakeMsg, Version) -> ssl_handshake:encode_handshake(HandshakeMsg, Version). enc_client_hello_cookie(_, <<>>) -> @@ -407,26 +445,26 @@ enc_client_hello_cookie(_, Cookie) -> <<?BYTE(CookieLength), Cookie/binary>>. decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, - ?BYTE(SID_length), Session_ID:SID_length/binary, - ?BYTE(Cookie_length), Cookie:Cookie_length/binary, - ?UINT16(Cs_length), CipherSuites:Cs_length/binary, - ?BYTE(Cm_length), Comp_methods:Cm_length/binary, - Extensions/binary>>) -> - + ?BYTE(SID_length), Session_ID:SID_length/binary, + ?BYTE(Cookie_length), Cookie:Cookie_length/binary, + ?UINT16(Cs_length), CipherSuites:Cs_length/binary, + ?BYTE(Cm_length), Comp_methods:Cm_length/binary, + Extensions/binary>>) -> + DecodedExtensions = ssl_handshake:decode_hello_extensions(Extensions), - + #client_hello{ client_version = {Major,Minor}, random = Random, - session_id = Session_ID, + session_id = Session_ID, cookie = Cookie, cipher_suites = ssl_handshake:decode_suites('2_bytes', CipherSuites), compression_methods = Comp_methods, extensions = DecodedExtensions - }; + }; decode_handshake(_Version, ?HELLO_VERIFY_REQUEST, <<?BYTE(Major), ?BYTE(Minor), - ?BYTE(CookieLength), Cookie:CookieLength/binary>>) -> + ?BYTE(CookieLength), Cookie:CookieLength/binary>>) -> #hello_verify_request{ protocol_version = {Major,Minor}, @@ -434,7 +472,7 @@ decode_handshake(_Version, ?HELLO_VERIFY_REQUEST, <<?BYTE(Major), ?BYTE(Minor), decode_handshake(Version, Tag, Msg) -> ssl_handshake:decode_handshake(Version, Tag, Msg). -address_to_bin({A,B,C,D}, Port) -> - <<0:80,16#ffff:16,A,B,C,D,Port:16>>; -address_to_bin({A,B,C,D,E,F,G,H}, Port) -> - <<A:16,B:16,C:16,D:16,E:16,F:16,G:16,H:16,Port:16>>. +%% address_to_bin({A,B,C,D}, Port) -> +%% <<0:80,16#ffff:16,A,B,C,D,Port:16>>; +%% address_to_bin({A,B,C,D,E,F,G,H}, Port) -> +%% <<A:16,B:16,C:16,D:16,E:16,F:16,G:16,H:16,Port:16>>. diff --git a/lib/ssl/src/dtls_handshake.hrl b/lib/ssl/src/dtls_handshake.hrl index 5bdf45f627..3b57575b6d 100644 --- a/lib/ssl/src/dtls_handshake.hrl +++ b/lib/ssl/src/dtls_handshake.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2014. 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,6 +53,4 @@ completed }). --type dtls_handshake() :: #client_hello{} | #hello_verify_request{} | ssl_handshake(). - -endif. % -ifdef(dtls_handshake). diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl index b0a7976864..a7bbb6bc40 100644 --- a/lib/ssl/src/dtls_record.erl +++ b/lib/ssl/src/dtls_record.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2014. 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 @@ -35,7 +35,7 @@ -export([decode_cipher_text/2]). %% Encoding --export([encode_plain_text/4]). +-export([encode_plain_text/4, encode_handshake/3, encode_change_cipher_spec/2]). %% Protocol version handling -export([protocol_version/1, lowest_protocol_version/2, @@ -46,6 +46,11 @@ -export([init_connection_state_seq/2, current_connection_state_epoch/2, set_connection_state_by_epoch/3, connection_state_by_epoch/3]). +-export_type([dtls_version/0, dtls_atom_version/0]). + +-type dtls_version() :: ssl_record:ssl_version(). +-type dtls_atom_version() :: dtlsv1 | 'dtlsv1.2'. + -compile(inline). %%==================================================================== @@ -70,7 +75,7 @@ get_dtls_records_aux(<<?BYTE(?APPLICATION_DATA),?BYTE(MajVer),?BYTE(MinVer), Acc) -> get_dtls_records_aux(Rest, [#ssl_tls{type = ?APPLICATION_DATA, version = {MajVer, MinVer}, - epoch = Epoch, record_seq = SequenceNumber, + epoch = Epoch, sequence_number = SequenceNumber, fragment = Data} | Acc]); get_dtls_records_aux(<<?BYTE(?HANDSHAKE),?BYTE(MajVer),?BYTE(MinVer), ?UINT16(Epoch), ?UINT48(SequenceNumber), @@ -78,7 +83,7 @@ get_dtls_records_aux(<<?BYTE(?HANDSHAKE),?BYTE(MajVer),?BYTE(MinVer), Data:Length/binary, Rest/binary>>, Acc) when MajVer >= 128 -> get_dtls_records_aux(Rest, [#ssl_tls{type = ?HANDSHAKE, version = {MajVer, MinVer}, - epoch = Epoch, record_seq = SequenceNumber, + epoch = Epoch, sequence_number = SequenceNumber, fragment = Data} | Acc]); get_dtls_records_aux(<<?BYTE(?ALERT),?BYTE(MajVer),?BYTE(MinVer), ?UINT16(Epoch), ?UINT48(SequenceNumber), @@ -86,7 +91,7 @@ get_dtls_records_aux(<<?BYTE(?ALERT),?BYTE(MajVer),?BYTE(MinVer), Rest/binary>>, Acc) -> get_dtls_records_aux(Rest, [#ssl_tls{type = ?ALERT, version = {MajVer, MinVer}, - epoch = Epoch, record_seq = SequenceNumber, + epoch = Epoch, sequence_number = SequenceNumber, fragment = Data} | Acc]); get_dtls_records_aux(<<?BYTE(?CHANGE_CIPHER_SPEC),?BYTE(MajVer),?BYTE(MinVer), ?UINT16(Epoch), ?UINT48(SequenceNumber), @@ -94,7 +99,7 @@ get_dtls_records_aux(<<?BYTE(?CHANGE_CIPHER_SPEC),?BYTE(MajVer),?BYTE(MinVer), Acc) -> get_dtls_records_aux(Rest, [#ssl_tls{type = ?CHANGE_CIPHER_SPEC, version = {MajVer, MinVer}, - epoch = Epoch, record_seq = SequenceNumber, + epoch = Epoch, sequence_number = SequenceNumber, fragment = Data} | Acc]); get_dtls_records_aux(<<0:1, _CT:7, ?BYTE(_MajVer), ?BYTE(_MinVer), @@ -125,14 +130,15 @@ encode_plain_text(Type, Version, Data, {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), WriteState1 = WriteState0#connection_state{compression_state = CompS1}, MacHash = calc_mac_hash(WriteState1, Type, Version, Epoch, Seq, Comp), - {CipherFragment, WriteState} = ssl_record:cipher(Version, Comp, WriteState1, MacHash), + {CipherFragment, WriteState} = ssl_record:cipher(dtls_v1:corresponding_tls_version(Version), + Comp, WriteState1, MacHash), CipherText = encode_tls_cipher_text(Type, Version, Epoch, Seq, CipherFragment), {CipherText, ConnectionStates#connection_states{current_write = WriteState#connection_state{sequence_number = Seq +1}}}. decode_cipher_text(#ssl_tls{type = Type, version = Version, epoch = Epoch, - record_seq = Seq, + sequence_number = Seq, fragment = CipherFragment} = CipherText, #connection_states{current_read = #connection_state{compression_state = CompressionS0, @@ -141,7 +147,7 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version, CompressAlg = SecParams#security_parameters.compression_algorithm, {PlainFragment, Mac, ReadState1} = ssl_record:decipher(dtls_v1:corresponding_tls_version(Version), CipherFragment, ReadState0), - MacHash = calc_mac_hash(Type, Version, Epoch, Seq, PlainFragment, ReadState1), + MacHash = calc_mac_hash(ReadState1, Type, Version, Epoch, Seq, PlainFragment), case ssl_record:is_correct_mac(Mac, MacHash) of true -> {Plain, CompressionS1} = ssl_record:uncompress(CompressAlg, @@ -153,10 +159,27 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version, false -> ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) end. +%%-------------------------------------------------------------------- +-spec encode_handshake(iolist(), dtls_version(), #connection_states{}) -> + {iolist(), #connection_states{}}. +%% +%% Description: Encodes a handshake message to send on the ssl-socket. +%%-------------------------------------------------------------------- +encode_handshake(Frag, Version, ConnectionStates) -> + encode_plain_text(?HANDSHAKE, Version, Frag, ConnectionStates). + +%%-------------------------------------------------------------------- +-spec encode_change_cipher_spec(dtls_version(), #connection_states{}) -> + {iolist(), #connection_states{}}. +%% +%% Description: Encodes a change_cipher_spec-message to send on the ssl socket. +%%-------------------------------------------------------------------- +encode_change_cipher_spec(Version, ConnectionStates) -> + encode_plain_text(?CHANGE_CIPHER_SPEC, Version, <<1:8>>, ConnectionStates). %%-------------------------------------------------------------------- --spec protocol_version(tls_atom_version() | tls_version()) -> - tls_version() | tls_atom_version(). +-spec protocol_version(dtls_atom_version() | dtls_version()) -> + dtls_version() | dtls_atom_version(). %% %% Description: Creates a protocol version record from a version atom %% or vice versa. @@ -170,7 +193,7 @@ protocol_version({254, 253}) -> protocol_version({254, 255}) -> dtlsv1. %%-------------------------------------------------------------------- --spec lowest_protocol_version(tls_version(), tls_version()) -> tls_version(). +-spec lowest_protocol_version(dtls_version(), dtls_version()) -> dtls_version(). %% %% Description: Lowes protocol version of two given versions %%-------------------------------------------------------------------- @@ -183,7 +206,7 @@ lowest_protocol_version(Version = {M,_}, {N, _}) when M > N -> lowest_protocol_version(_,Version) -> Version. %%-------------------------------------------------------------------- --spec highest_protocol_version([tls_version()]) -> tls_version(). +-spec highest_protocol_version([dtls_version()]) -> dtls_version(). %% %% Description: Highest protocol version present in a list %%-------------------------------------------------------------------- @@ -203,7 +226,7 @@ highest_protocol_version(_, [Version | Rest]) -> %%-------------------------------------------------------------------- --spec supported_protocol_versions() -> [tls_version()]. +-spec supported_protocol_versions() -> [dtls_version()]. %% %% Description: Protocol versions supported %%-------------------------------------------------------------------- @@ -234,7 +257,7 @@ supported_connection_protocol_versions([]) -> ?ALL_DATAGRAM_SUPPORTED_VERSIONS. %%-------------------------------------------------------------------- --spec is_acceptable_version(tls_version(), Supported :: [tls_version()]) -> boolean(). +-spec is_acceptable_version(dtls_version(), Supported :: [dtls_version()]) -> boolean(). %% %% Description: ssl version 2 is not acceptable security risks are too big. %% @@ -244,7 +267,7 @@ is_acceptable_version(Version, Versions) -> %%-------------------------------------------------------------------- --spec init_connection_state_seq(tls_version(), #connection_states{}) -> +-spec init_connection_state_seq(dtls_version(), #connection_states{}) -> #connection_state{}. %% %% Description: Copy the read sequence number to the write sequence number @@ -343,5 +366,5 @@ calc_mac_hash(#connection_state{mac_secret = MacSecret, Length, Fragment). mac_hash(Version, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) -> - dtls_v1:mac_hash(MacAlg, MacSecret, SeqNo, Type, Version, + dtls_v1:mac_hash(Version, MacAlg, MacSecret, SeqNo, Type, Length, Fragment). diff --git a/lib/ssl/src/dtls_record.hrl b/lib/ssl/src/dtls_record.hrl index e935d84bdf..edb77fb2b1 100644 --- a/lib/ssl/src/dtls_record.hrl +++ b/lib/ssl/src/dtls_record.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2014. 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 @@ -28,16 +28,15 @@ -include("ssl_record.hrl"). %% Common TLS and DTLS records and Constantes -%% Used to handle tls_plain_text, tls_compressed and tls_cipher_text +%% Used to handle dtls_plain_text, dtls_compressed and dtls_cipher_text -record(ssl_tls, { type, version, - record_seq, % used in plain_text - epoch, % used in plain_text - message_seq, - fragment_offset, - fragment_length, + epoch, + sequence_number, + offset, + length, fragment }). diff --git a/lib/ssl/src/dtls_v1.erl b/lib/ssl/src/dtls_v1.erl index 6e41641483..5a7ab32887 100644 --- a/lib/ssl/src/dtls_v1.erl +++ b/lib/ssl/src/dtls_v1.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2014. 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 @@ -22,7 +22,7 @@ -export([suites/1, mac_hash/7, ecc_curves/1, corresponding_tls_version/1]). --spec suites(Minor:: 253|255) -> [cipher_suite()]. +-spec suites(Minor:: 253|255) -> [ssl_cipher:cipher_suite()]. suites(Minor) -> tls_v1:suites(corresponding_minor_tls_version(Minor)). diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index 68ebc49e4a..99839f6149 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -47,6 +47,8 @@ {registered, [ssl_sup, ssl_manager]}, {applications, [crypto, public_key, kernel, stdlib]}, {env, []}, - {mod, {ssl_app, []}}]}. + {mod, {ssl_app, []}}, + {runtime_dependencies, ["stdlib-2.0","public_key-0.22","kernel-3.0", + "erts-6.0","crypto-3.3"]}]}. diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index 3a64841976..b0ef292c4e 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,27 +1,36 @@ %% -*- erlang -*- {"%VSN%", [ - {<<"5.3.2">>, [{load_module, ssl, soft_purge, soft_purge, []}, - {load_module, ssl_connection, soft_purge, soft_purge, []}, - {load_module, ssl_handshake, soft_purge, soft_purge, []}, - {load_module, tls_connection, soft_purge, soft_purge, []}]}, - {<<"5.3.1">>, [{restart_application, ssl}]}, - {<<"5.2\\*">>, [{restart_application, ssl}]}, - {<<"5.1\\*">>, [{restart_application, ssl}]}, - {<<"5.0\\*">>, [{restart_application, ssl}]}, - {<<"4\\.*">>, [{restart_application, ssl}]}, - {<<"3\\.*">>, [{restart_application, ssl}]} + {"5.3.3", [{load_module, ssl, soft_purge, soft_purge, []}, + {load_module, ssl_connection, soft_purge, soft_purge, []}, + {load_module, ssl_handshake, soft_purge, soft_purge, []}, + {load_module, tls_handshake, soft_purge, soft_purge, []}, + {load_module, tls_connection, soft_purge, soft_purge, []}]}, + {"5.3.2", [{load_module, ssl, soft_purge, soft_purge, []}, + {load_module, ssl_connection, soft_purge, soft_purge, []}, + {load_module, ssl_handshake, soft_purge, soft_purge, []}, + {load_module, tls_handshake, soft_purge, soft_purge, []}, + {load_module, tls_connection, soft_purge, soft_purge, []}]}, + {<<"5\\.3\\.1($|\\..*)">>, [{restart_application, ssl}]}, + {<<"5\\.[0-2]($|\\..*)">>, [{restart_application, ssl}]}, + {<<"4\\..*">>, [{restart_application, ssl}]}, + {<<"3\\..*">>, [{restart_application, ssl}]} ], [ - {<<"5.3.2">>, [{load_module, ssl, soft_purge, soft_purge, []}, - {load_module, ssl_connection, soft_purge, soft_purge, []}, - {load_module, ssl_handshake, soft_purge, soft_purge, []}, - {load_module, tls_connection, soft_purge, soft_purge, []}]}, - {<<"5.3.1">>, [{restart_application, ssl}]}, - {<<"5.2\\*">>, [{restart_application, ssl}]}, - {<<"5.1\\*">>, [{restart_application, ssl}]}, - {<<"5.0\\*">>, [{restart_application, ssl}]}, - {<<"4\\.*">>, [{restart_application, ssl}]}, - {<<"3\\.*">>, [{restart_application, ssl}]} - ]}. + {"5.3.3", [{load_module, ssl, soft_purge, soft_purge, []}, + {load_module, ssl_connection, soft_purge, soft_purge, []}, + {load_module, ssl_handshake, soft_purge, soft_purge, []}, + {load_module, tls_handshake, soft_purge, soft_purge, []}, + {load_module, tls_connection, soft_purge, soft_purge, []}]}, + {"5.3.2", [{load_module, ssl, soft_purge, soft_purge, []}, + {load_module, ssl_connection, soft_purge, soft_purge, []}, + {load_module, ssl_handshake, soft_purge, soft_purge, []}, + {load_module, tls_handshake, soft_purge, soft_purge, []}, + {load_module, tls_connection, soft_purge, soft_purge, []}]}, + {<<"5\\.3\\.1($|\\..*)">>, [{restart_application, ssl}]}, + {<<"5\\.[0-2]($|\\..*)">>, [{restart_application, ssl}]}, + {<<"4\\..*">>, [{restart_application, ssl}]}, + {<<"3\\..*">>, [{restart_application, ssl}]} + ] +}. diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index c3bdeb1a54..a88bf45293 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -276,7 +276,7 @@ controlling_process(#sslsocket{pid = {Listen, Transport:controlling_process(Listen, NewOwner). %%-------------------------------------------------------------------- --spec connection_info(#sslsocket{}) -> {ok, {tls_atom_version(), erl_cipher_suite()}} | +-spec connection_info(#sslsocket{}) -> {ok, {tls_record:tls_atom_version(), ssl_cipher:erl_cipher_suite()}} | {error, reason()}. %% %% Description: Returns ssl protocol and cipher used for the connection @@ -312,7 +312,7 @@ peercert(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> {error, enotconn}. %%-------------------------------------------------------------------- --spec suite_definition(cipher_suite()) -> erl_cipher_suite(). +-spec suite_definition(ssl_cipher:cipher_suite()) -> ssl_cipher:erl_cipher_suite(). %% %% Description: Return erlang cipher suite definition. %%-------------------------------------------------------------------- @@ -330,8 +330,8 @@ negotiated_next_protocol(#sslsocket{pid = Pid}) -> ssl_connection:negotiated_next_protocol(Pid). %%-------------------------------------------------------------------- --spec cipher_suites() -> [erl_cipher_suite()]. --spec cipher_suites(erlang | openssl | all) -> [erl_cipher_suite()] | [string()]. +-spec cipher_suites() -> [ssl_cipher:erl_cipher_suite()]. +-spec cipher_suites(erlang | openssl | all) -> [ssl_cipher:erl_cipher_suite()] | [string()]. %% Description: Returns all supported cipher suites. %%-------------------------------------------------------------------- @@ -437,8 +437,8 @@ session_info(#sslsocket{pid = {Listen,_}}) when is_port(Listen) -> {error, enotconn}. %%--------------------------------------------------------------- --spec versions() -> [{ssl_app, string()} | {supported, [tls_atom_version()]} | - {available, [tls_atom_version()]}]. +-spec versions() -> [{ssl_app, string()} | {supported, [tls_record:tls_atom_version()]} | + {available, [tls_record:tls_atom_version()]}]. %% %% Description: Returns a list of relevant versions. %%-------------------------------------------------------------------- @@ -557,6 +557,9 @@ do_connect(Address, Port, handle_options(Opts0, _Role) -> Opts = proplists:expand([{binary, [{mode, binary}]}, {list, [{mode, list}]}], Opts0), + assert_proplist(Opts), + RecordCb = record_cb(Opts), + ReuseSessionFun = fun(_, _, _, _) -> true end, DefaultVerifyNoneFun = @@ -599,12 +602,14 @@ handle_options(Opts0, _Role) -> end, CertFile = handle_option(certfile, Opts, <<>>), - + + RecordCb = record_cb(Opts), + Versions = case handle_option(versions, Opts, []) of [] -> - tls_record:supported_protocol_versions(); + RecordCb:supported_protocol_versions(); Vsns -> - [tls_record:protocol_version(Vsn) || Vsn <- Vsns] + [RecordCb:protocol_version(Vsn) || Vsn <- Vsns] end, SSLOptions = #ssl_options{ @@ -1034,6 +1039,13 @@ connection_cb(dtls) -> connection_cb(Opts) -> connection_cb(proplists:get_value(protocol, Opts, tls)). +record_cb(tls) -> + tls_record; +record_cb(dtls) -> + dtls_record; +record_cb(Opts) -> + record_cb(proplists:get_value(protocol, Opts, tls)). + connection_sup(tls_connection) -> tls_connection_sup; connection_sup(dtls_connection) -> @@ -1042,3 +1054,15 @@ connection_sup(dtls_connection) -> binary_filename(FileName) -> Enc = file:native_name_encoding(), unicode:characters_to_binary(FileName, unicode, Enc). + +assert_proplist([]) -> + true; +assert_proplist([{Key,_} | Rest]) when is_atom(Key) -> + assert_proplist(Rest); +%% Handle exceptions +assert_proplist([inet | Rest]) -> + assert_proplist(Rest); +assert_proplist([inet6 | Rest]) -> + assert_proplist(Rest); +assert_proplist([Value | _]) -> + throw({option_not_a_key_value_tuple, Value}). diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl index 5c842b4d19..db1535b5ec 100644 --- a/lib/ssl/src/ssl_alert.erl +++ b/lib/ssl/src/ssl_alert.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. 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 @@ -38,7 +38,7 @@ %%==================================================================== %%-------------------------------------------------------------------- --spec encode(#alert{}, tls_version(), #connection_states{}) -> +-spec encode(#alert{}, ssl_record:ssl_version(), #connection_states{}) -> {iolist(), #connection_states{}}. %% %% Description: @@ -124,5 +124,17 @@ description_txt(?USER_CANCELED) -> "user canceled"; description_txt(?NO_RENEGOTIATION) -> "no renegotiation"; +description_txt(?UNSUPPORTED_EXTENSION) -> + "unsupported extension"; +description_txt(?CERTIFICATE_UNOBTAINABLE) -> + "certificate unobtainable"; +description_txt(?UNRECOGNISED_NAME) -> + "unrecognised name"; +description_txt(?BAD_CERTIFICATE_STATUS_RESPONSE) -> + "bad certificate status response"; +description_txt(?BAD_CERTIFICATE_HASH_VALUE) -> + "bad certificate hash value"; description_txt(?UNKNOWN_PSK_IDENTITY) -> - "unknown psk identity". + "unknown psk identity"; +description_txt(Enum) -> + lists:flatten(io_lib:format("unsupported/unknown alert: ~p", [Enum])). diff --git a/lib/ssl/src/ssl_alert.hrl b/lib/ssl/src/ssl_alert.hrl index 2a8a91aefa..2d1f323085 100644 --- a/lib/ssl/src/ssl_alert.hrl +++ b/lib/ssl/src/ssl_alert.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2012. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. 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 @@ -48,7 +48,7 @@ %% unsupported_certificate(43), %% certificate_revoked(44), %% certificate_expired(45), - %% certificate_unknown(46), +%% certificate_unknown(46), %% illegal_parameter(47), %% unknown_ca(48), %% access_denied(49), @@ -60,6 +60,13 @@ %% internal_error(80), %% user_canceled(90), %% no_renegotiation(100), +%% RFC 4366 +%% unsupported_extension(110), +%% certificate_unobtainable(111), +%% unrecognized_name(112), +%% bad_certificate_status_response(113), +%% bad_certificate_hash_value(114), +%% RFC 4366 %% unknown_psk_identity(115), %% (255) %% } AlertDescription; @@ -88,6 +95,11 @@ -define(INTERNAL_ERROR, 80). -define(USER_CANCELED, 90). -define(NO_RENEGOTIATION, 100). +-define(UNSUPPORTED_EXTENSION, 110). +-define(CERTIFICATE_UNOBTAINABLE, 111). +-define(UNRECOGNISED_NAME, 112). +-define(BAD_CERTIFICATE_STATUS_RESPONSE, 113). +-define(BAD_CERTIFICATE_HASH_VALUE, 114). -define(UNKNOWN_PSK_IDENTITY, 115). -define(ALERT_REC(Level,Desc), #alert{level=Level,description=Desc,where={?FILE, ?LINE}}). diff --git a/lib/ssl/src/ssl_api.hrl b/lib/ssl/src/ssl_api.hrl index 607991750f..22185ff60a 100644 --- a/lib/ssl/src/ssl_api.hrl +++ b/lib/ssl/src/ssl_api.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2014. 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 @@ -24,8 +24,6 @@ %% Visible in API -export_type([connect_option/0, listen_option/0, ssl_option/0, transport_option/0, - erl_cipher_suite/0, %% From ssl_cipher.hrl - tls_atom_version/0, %% From ssl_internal.hrl prf_random/0, sslsocket/0]). @@ -39,23 +37,24 @@ -type listen_option() :: socket_listen_option() | ssl_option() | transport_option(). -type socket_listen_option() :: gen_tcp:listen_option(). --type ssl_option() :: {verify, verify_type()} | - {verify_fun, {fun(), InitialUserState::term()}} | - {fail_if_no_peer_cert, boolean()} | {depth, integer()} | - {cert, Der::binary()} | {certfile, path()} | {key, Der::binary()} | - {keyfile, path()} | {password, string()} | {cacerts, [Der::binary()]} | - {cacertfile, path()} | {dh, Der::binary()} | {dhfile, path()} | - {user_lookup_fun, {fun(), InitialUserState::term()}} | - {psk_identity, string()} | - {srp_identity, {string(), string()}} | - {ciphers, ciphers()} | {ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} | - {reuse_session, fun()} | {hibernate_after, integer()|undefined} | - {next_protocols_advertised, list(binary())} | - {client_preferred_next_protocols, binary(), client | server, list(binary())}. +-type ssl_option() :: {versions, ssl_record:ssl_atom_version()} | + {verify, verify_type()} | + {verify_fun, {fun(), InitialUserState::term()}} | + {fail_if_no_peer_cert, boolean()} | {depth, integer()} | + {cert, Der::binary()} | {certfile, path()} | {key, Der::binary()} | + {keyfile, path()} | {password, string()} | {cacerts, [Der::binary()]} | + {cacertfile, path()} | {dh, Der::binary()} | {dhfile, path()} | + {user_lookup_fun, {fun(), InitialUserState::term()}} | + {psk_identity, string()} | + {srp_identity, {string(), string()}} | + {ciphers, ciphers()} | {ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} | + {reuse_session, fun()} | {hibernate_after, integer()|undefined} | + {next_protocols_advertised, list(binary())} | + {client_preferred_next_protocols, binary(), client | server, list(binary())}. -type verify_type() :: verify_none | verify_peer. -type path() :: string(). --type ciphers() :: [erl_cipher_suite()] | +-type ciphers() :: [ssl_cipher:erl_cipher_suite()] | string(). % (according to old API) -type ssl_imp() :: new | old. diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index b2077c662a..78a328ace8 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. 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 @@ -38,6 +38,21 @@ openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2]). +-export_type([cipher_suite/0, + erl_cipher_suite/0, openssl_cipher_suite/0, + key_algo/0]). + +-type cipher() :: null |rc4_128 | idea_cbc | des40_cbc | des_cbc | '3des_ede_cbc' + | aes_128_cbc | aes_256_cbc. +-type hash() :: null | sha | md5 | sha224 | sha256 | sha384 | sha512. +-type key_algo() :: null | rsa | dhe_rsa | dhe_dss | ecdhe_ecdsa| ecdh_ecdsa | ecdh_rsa| srp_rsa| srp_dss | psk | dhe_psk | rsa_psk | dh_anon | ecdh_anon | srp_anon. +-type erl_cipher_suite() :: {key_algo(), cipher(), hash()}. +-type int_cipher_suite() :: {key_algo(), cipher(), hash(), hash() | default_prf}. +-type cipher_suite() :: binary(). +-type cipher_enum() :: integer(). +-type openssl_cipher_suite() :: string(). + + -compile(inline). %%-------------------------------------------------------------------- @@ -51,7 +66,7 @@ security_parameters(?TLS_NULL_WITH_NULL_NULL = CipherSuite, SecParams) -> security_parameters(undefined, CipherSuite, SecParams). %%-------------------------------------------------------------------- --spec security_parameters(tls_version() | undefined, cipher_suite(), #security_parameters{}) -> +-spec security_parameters(ssl_record:ssl_version() | undefined, cipher_suite(), #security_parameters{}) -> #security_parameters{}. %% %% Description: Returns a security parameters record where the @@ -72,7 +87,7 @@ security_parameters(Version, CipherSuite, SecParams) -> hash_size = hash_size(Hash)}. %%-------------------------------------------------------------------- --spec cipher(cipher_enum(), #cipher_state{}, binary(), iolist(), tls_version()) -> +-spec cipher(cipher_enum(), #cipher_state{}, binary(), iodata(), ssl_record:ssl_version()) -> {binary(), #cipher_state{}}. %% %% Description: Encrypts the data and the MAC using chipher described @@ -127,7 +142,7 @@ block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV} = CS0, {T, CS0#cipher_state{iv=NextIV}}. %%-------------------------------------------------------------------- --spec decipher(cipher_enum(), integer(), #cipher_state{}, binary(), tls_version()) -> +-spec decipher(cipher_enum(), integer(), #cipher_state{}, binary(), ssl_record:ssl_version()) -> {binary(), binary(), #cipher_state{}} | #alert{}. %% %% Description: Decrypts the data and the MAC using cipher described @@ -200,7 +215,7 @@ block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) end. %%-------------------------------------------------------------------- --spec suites(tls_version()) -> [cipher_suite()]. +-spec suites(ssl_record:ssl_version()) -> [cipher_suite()]. %% %% Description: Returns a list of supported cipher suites. %%-------------------------------------------------------------------- @@ -229,7 +244,7 @@ anonymous_suites() -> ?TLS_ECDH_anon_WITH_AES_256_CBC_SHA]. %%-------------------------------------------------------------------- --spec psk_suites(tls_version() | integer()) -> [cipher_suite()]. +-spec psk_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()]. %% %% Description: Returns a list of the PSK cipher suites, only supported %% if explicitly set by user. diff --git a/lib/ssl/src/ssl_cipher.hrl b/lib/ssl/src/ssl_cipher.hrl index 62a5269def..3ce9c19aa9 100644 --- a/lib/ssl/src/ssl_cipher.hrl +++ b/lib/ssl/src/ssl_cipher.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. 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 @@ -26,16 +26,6 @@ -ifndef(ssl_cipher). -define(ssl_cipher, true). --type cipher() :: null |rc4_128 | idea_cbc | des40_cbc | des_cbc | '3des_ede_cbc' - | aes_128_cbc | aes_256_cbc. --type hash() :: null | sha | md5 | sha224 | sha256 | sha384 | sha512. --type key_algo() :: null | rsa | dhe_rsa | dhe_dss | ecdhe_ecdsa| ecdh_ecdsa | ecdh_rsa| srp_rsa| srp_dss | psk | dhe_psk | rsa_psk | dh_anon | ecdh_anon | srp_anon. --type erl_cipher_suite() :: {key_algo(), cipher(), hash()}. --type int_cipher_suite() :: {key_algo(), cipher(), hash(), hash() | default_prf}. --type cipher_suite() :: binary(). --type cipher_enum() :: integer(). --type openssl_cipher_suite() :: string(). - %%% SSL cipher protocol %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -define(CHANGE_CIPHER_SPEC_PROTO, 1). % _PROTO to not clash with % SSL record protocol diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index e283e6079e..ed9e4d344f 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -52,6 +52,7 @@ %% SSL all state functions -export([handle_sync_event/4, handle_info/3, terminate/3]). + %%==================================================================== %% Internal application API %%==================================================================== diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index 341a4217e4..b01c6cb1b3 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -48,17 +48,17 @@ socket_options :: #socket_options{}, connection_states :: #connection_states{}, protocol_buffers :: term(), %% #protocol_buffers{} from tls_record.hrl or dtls_recor.hrl - tls_handshake_history ::tls_handshake_history(), + tls_handshake_history :: ssl_handshake:ssl_handshake_history(), cert_db :: reference(), session :: #session{}, session_cache :: db_handle(), session_cache_cb :: atom(), - negotiated_version :: tls_version(), + negotiated_version :: ssl_record:ssl_version(), client_certificate_requested = false :: boolean(), - key_algorithm :: key_algo(), + key_algorithm :: ssl_cipher:key_algo(), hashsign_algorithm = {undefined, undefined}, cert_hashsign_algorithm, - public_key_info ::public_key_info(), + public_key_info ::ssl_handshake:public_key_info(), private_key ::public_key:private_key(), diffie_hellman_params, % PKIX: #'DHParameter'{} relevant for server side diffie_hellman_keys, % {PublicKey, PrivateKey} diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 7b4cf8eb06..1108edcf48 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -31,6 +31,18 @@ -include("ssl_srp.hrl"). -include_lib("public_key/include/public_key.hrl"). +-export_type([ssl_handshake/0, ssl_handshake_history/0, + public_key_info/0, oid/0]). + +-type oid() :: tuple(). +-type public_key_params() :: #'Dss-Parms'{} | {namedCurve, oid()} | #'ECParameters'{} | term(). +-type public_key_info() :: {oid(), #'RSAPublicKey'{} | integer() | #'ECPoint'{}, public_key_params()}. +-type ssl_handshake_history() :: {[binary()], [binary()]}. + +-type ssl_handshake() :: #server_hello{} | #server_hello_done{} | #certificate{} | #certificate_request{} | + #client_key_exchange{} | #finished{} | #certificate_verify{} | + #hello_request{} | #next_protocol{}. + %% Handshake messages -export([hello_request/0, server_hello/4, server_hello_done/0, certificate/4, certificate_request/4, key_exchange/3, @@ -80,7 +92,7 @@ hello_request() -> #hello_request{}. %%-------------------------------------------------------------------- --spec server_hello(#session{}, tls_version(), #connection_states{}, +-spec server_hello(#session{}, ssl_record:ssl_version(), #connection_states{}, #hello_extensions{}) -> #server_hello{}. %% %% Description: Creates a server hello message. @@ -164,8 +176,8 @@ next_protocol(SelectedProtocol) -> %%-------------------------------------------------------------------- -spec client_certificate_verify(undefined | der_cert(), binary(), - tls_version(), term(), public_key:private_key(), - tls_handshake_history()) -> + ssl_record:ssl_version(), term(), public_key:private_key(), + ssl_handshake_history()) -> #certificate_verify{} | ignore | #alert{}. %% %% Description: Creates a certificate_verify message, called by the client. @@ -188,7 +200,7 @@ client_certificate_verify(OwnCert, MasterSecret, Version, end. %%-------------------------------------------------------------------- --spec certificate_request(erl_cipher_suite(), db_handle(), certdb_ref(), tls_version()) -> +-spec certificate_request(ssl_cipher:erl_cipher_suite(), db_handle(), certdb_ref(), ssl_record:ssl_version()) -> #certificate_request{}. %% %% Description: Creates a certificate_request message, called by the server. @@ -203,7 +215,7 @@ certificate_request(CipherSuite, CertDbHandle, CertDbRef, Version) -> certificate_authorities = Authorities }. %%-------------------------------------------------------------------- --spec key_exchange(client | server, tls_version(), +-spec key_exchange(client | server, ssl_record:ssl_version(), {premaster_secret, binary(), public_key_info()} | {dh, binary()} | {dh, {binary(), binary()}, #'DHParameter'{}, {HashAlgo::atom(), SignAlgo::atom()}, @@ -304,7 +316,7 @@ key_exchange(server, Version, {srp, {PublicKey, _}, ClientRandom, ServerRandom, PrivateKey). %%-------------------------------------------------------------------- --spec finished(tls_version(), client | server, integer(), binary(), tls_handshake_history()) -> +-spec finished(ssl_record:ssl_version(), client | server, integer(), binary(), ssl_handshake_history()) -> #finished{}. %% %% Description: Creates a handshake finished message @@ -315,8 +327,7 @@ finished(Version, Role, PrfAlgo, MasterSecret, {Handshake, _}) -> % use the curr %% ---------- Handle handshake messages ---------- -verify_server_key(#server_key_params{params = Params, - params_bin = EncParams, +verify_server_key(#server_key_params{params_bin = EncParams, signature = Signature}, HashSign = {HashAlgo, _}, ConnectionStates, Version, PubKeyInfo) -> @@ -332,8 +343,8 @@ verify_server_key(#server_key_params{params = Params, verify_signature(Version, Hash, HashSign, Signature, PubKeyInfo). %%-------------------------------------------------------------------- --spec certificate_verify(binary(), public_key_info(), tls_version(), term(), - binary(), tls_handshake_history()) -> valid | #alert{}. +-spec certificate_verify(binary(), public_key_info(), ssl_record:ssl_version(), term(), + binary(), ssl_handshake_history()) -> valid | #alert{}. %% %% Description: Checks that the certificate_verify message is valid. %%-------------------------------------------------------------------- @@ -347,7 +358,7 @@ certificate_verify(Signature, PublicKeyInfo, Version, ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE) end. %%-------------------------------------------------------------------- --spec verify_signature(tls_version(), binary(), {term(), term()}, binary(), +-spec verify_signature(ssl_record:ssl_version(), binary(), {term(), term()}, binary(), public_key_info()) -> true | false. %% %% Description: Checks that a public_key signature is valid. @@ -427,8 +438,8 @@ certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef, end. %%-------------------------------------------------------------------- --spec verify_connection(tls_version(), #finished{}, client | server, integer(), binary(), - tls_handshake_history()) -> verified | #alert{}. +-spec verify_connection(ssl_record:ssl_version(), #finished{}, client | server, integer(), binary(), + ssl_handshake_history()) -> verified | #alert{}. %% %% Description: Checks the ssl handshake finished message to verify %% the connection. @@ -444,7 +455,7 @@ verify_connection(Version, #finished{verify_data = Data}, end. %%-------------------------------------------------------------------- --spec init_handshake_history() -> tls_handshake_history(). +-spec init_handshake_history() -> ssl_handshake_history(). %% %% Description: Initialize the empty handshake history buffer. @@ -453,8 +464,8 @@ init_handshake_history() -> {[], []}. %%-------------------------------------------------------------------- --spec update_handshake_history(tls_handshake_history(), Data ::term()) -> - tls_handshake_history(). +-spec update_handshake_history(ssl_handshake:ssl_handshake_history(), Data ::term()) -> + ssl_handshake:ssl_handshake_history(). %% %% Description: Update the handshake history buffer with Data. %%-------------------------------------------------------------------- @@ -568,7 +579,7 @@ server_key_exchange_hash(md5sha, Value) -> server_key_exchange_hash(Hash, Value) -> crypto:hash(Hash, Value). %%-------------------------------------------------------------------- --spec prf(tls_version(), binary(), binary(), [binary()], non_neg_integer()) -> +-spec prf(ssl_record:ssl_version(), binary(), binary(), [binary()], non_neg_integer()) -> {ok, binary()} | {error, undefined}. %% %% Description: use the TLS PRF to generate key material @@ -612,7 +623,7 @@ select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert) -> HashSign end. %%-------------------------------------------------------------------- --spec select_cert_hashsign(#hash_sign_algos{}| undefined, oid(), tls_version() | {undefined, undefined}) -> +-spec select_cert_hashsign(#hash_sign_algos{}| undefined, oid(), ssl_record:ssl_version() | {undefined, undefined}) -> {atom(), atom()}. %% @@ -632,7 +643,7 @@ select_cert_hashsign(undefined, ?'id-dsa', _) -> {sha, dsa}. %%-------------------------------------------------------------------- --spec master_secret(atom(), tls_version(), #session{} | binary(), #connection_states{}, +-spec master_secret(atom(), ssl_record:ssl_version(), #session{} | binary(), #connection_states{}, client | server) -> {binary(), #connection_states{}} | #alert{}. %% %% Description: Sets or calculates the master secret and calculate keys, @@ -817,7 +828,7 @@ enc_server_key_exchange(Version, Params, {HashAlgo, SignAlgo}, end. %%-------------------------------------------------------------------- --spec decode_client_key(binary(), key_algo(), tls_version()) -> +-spec decode_client_key(binary(), ssl_cipher:key_algo(), ssl_record:ssl_version()) -> #encrypted_premaster_secret{} | #client_diffie_hellman_public{} | #client_ec_diffie_hellman_public{} @@ -832,7 +843,7 @@ decode_client_key(ClientKey, Type, Version) -> dec_client_key(ClientKey, key_exchange_alg(Type), Version). %%-------------------------------------------------------------------- --spec decode_server_key(binary(), key_algo(), tls_version()) -> +-spec decode_server_key(binary(), ssl_cipher:key_algo(), ssl_record:ssl_version()) -> #server_key_params{}. %% %% Description: Decode server_key data and return appropriate type @@ -1655,7 +1666,16 @@ dec_hello_extensions(<<?UINT16(?SIGNATURE_ALGORITHMS_EXT), ?UINT16(Len), dec_hello_extensions(<<?UINT16(?ELLIPTIC_CURVES_EXT), ?UINT16(Len), ExtData:Len/binary, Rest/binary>>, Acc) -> <<?UINT16(_), EllipticCurveList/binary>> = ExtData, - EllipticCurves = [tls_v1:enum_to_oid(X) || <<X:16>> <= EllipticCurveList], + %% Ignore unknown curves + Pick = fun(Enum) -> + case tls_v1:enum_to_oid(Enum) of + undefined -> + false; + Oid -> + {true, Oid} + end + end, + EllipticCurves = lists:filtermap(Pick, [ECC || <<ECC:16>> <= EllipticCurveList]), dec_hello_extensions(Rest, Acc#hello_extensions{elliptic_curves = #elliptic_curves{elliptic_curve_list = EllipticCurves}}); diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index 75160526b9..80284faef0 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. 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 @@ -352,18 +352,4 @@ hostname = undefined }). -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Dialyzer types -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - --type oid() :: tuple(). --type public_key_params() :: #'Dss-Parms'{} | {namedCurve, oid()} | #'ECParameters'{} | term(). --type public_key_info() :: {oid(), #'RSAPublicKey'{} | integer() | #'ECPoint'{}, public_key_params()}. --type tls_handshake_history() :: {[binary()], [binary()]}. - --type ssl_handshake() :: #server_hello{} | #server_hello_done{} | #certificate{} | #certificate_request{} | - #client_key_exchange{} | #finished{} | #certificate_verify{} | - #hello_request{} | #next_protocol{}. - - -endif. % -ifdef(ssl_handshake). diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 64b89e9f95..cec5d8fbb1 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -30,8 +30,6 @@ -type from() :: term(). -type host() :: inet:ip_address() | inet:hostname(). -type session_id() :: 0 | binary(). --type tls_version() :: {integer(), integer()}. --type tls_atom_version() :: sslv3 | tlsv1 | 'tlsv1.1' | 'tlsv1.2'. -type certdb_ref() :: reference(). -type db_handle() :: term(). -type der_cert() :: binary(). @@ -73,7 +71,7 @@ -record(ssl_options, { protocol :: tls | dtls, - versions :: ['tlsv1.2' | 'tlsv1.1' | tlsv1 | sslv3] | ['dtlsv1.2' | dtlsv1], + versions :: [ssl_record:ssl_version()], %% ssl_record:atom_version() in API verify :: verify_none | verify_peer, verify_fun, %%:: fun(CertVerifyErrors::term()) -> boolean(), fail_if_no_peer_cert :: boolean(), diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 4d5eaeb607..fbc73e0e42 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -167,27 +167,27 @@ clean_cert_db(Ref, File) -> ok. %%-------------------------------------------------------------------- --spec register_session(inet:port_number(), #session{}) -> ok. --spec register_session(host(), inet:port_number(), #session{}) -> ok. %% %% Description: Make the session available for reuse. %%-------------------------------------------------------------------- +-spec register_session(host(), inet:port_number(), #session{}) -> ok. register_session(Host, Port, Session) -> cast({register_session, Host, Port, Session}). +-spec register_session(inet:port_number(), #session{}) -> ok. register_session(Port, Session) -> cast({register_session, Port, Session}). %%-------------------------------------------------------------------- --spec invalidate_session(inet:port_number(), #session{}) -> ok. --spec invalidate_session(host(), inet:port_number(), #session{}) -> ok. %% %% Description: Make the session unavailable for reuse. After %% a the session has been marked "is_resumable = false" for some while %% it will be safe to remove the data from the session database. %%-------------------------------------------------------------------- +-spec invalidate_session(host(), inet:port_number(), #session{}) -> ok. invalidate_session(Host, Port, Session) -> cast({invalidate_session, Host, Port, Session}). +-spec invalidate_session(inet:port_number(), #session{}) -> ok. invalidate_session(Port, Session) -> cast({invalidate_session, Port, Session}). diff --git a/lib/ssl/src/ssl_pkix_db.erl b/lib/ssl/src/ssl_pkix_db.erl index 9de50c8f26..e59aba0618 100644 --- a/lib/ssl/src/ssl_pkix_db.erl +++ b/lib/ssl/src/ssl_pkix_db.erl @@ -115,17 +115,17 @@ add_trusted_certs(_Pid, File, [CertsDb, RefDb, PemChache] = Db) -> new_trusted_cert_entry({MD5, File}, Db) end. %%-------------------------------------------------------------------- --spec cache_pem_file({binary(), binary()}, [db_handle()]) -> {ok, term()}. --spec cache_pem_file(reference(), {binary(), binary()}, [db_handle()]) -> {ok, term()}. %% %% Description: Cache file as binary in DB %%-------------------------------------------------------------------- +-spec cache_pem_file({binary(), binary()}, [db_handle()]) -> {ok, term()}. cache_pem_file({MD5, File}, [_CertsDb, _RefDb, PemChache]) -> {ok, PemBin} = file:read_file(File), Content = public_key:pem_decode(PemBin), insert(MD5, Content, PemChache), {ok, Content}. +-spec cache_pem_file(reference(), {binary(), binary()}, [db_handle()]) -> {ok, term()}. cache_pem_file(Ref, {MD5, File}, [_CertsDb, _RefDb, PemChache]) -> {ok, PemBin} = file:read_file(File), Content = public_key:pem_decode(PemBin), diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index 018c8befe0..b0e9943e6d 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2014. 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 @@ -50,6 +50,11 @@ %% Payload encryption/decryption -export([cipher/4, decipher/3, is_correct_mac/2]). +-export_type([ssl_version/0, ssl_atom_version/0]). + +-type ssl_version() :: {integer(), integer()}. +-type ssl_atom_version() :: tls_record:tls_atom_version(). + %%==================================================================== %% Internal application API %%==================================================================== @@ -299,7 +304,7 @@ set_pending_cipher_state(#connection_states{pending_read = Read, %%-------------------------------------------------------------------- --spec encode_handshake(iolist(), tls_version(), #connection_states{}) -> +-spec encode_handshake(iolist(), ssl_version(), #connection_states{}) -> {iolist(), #connection_states{}}. %% %% Description: Encodes a handshake message to send on the ssl-socket. @@ -308,7 +313,7 @@ encode_handshake(Frag, Version, ConnectionStates) -> encode_plain_text(?HANDSHAKE, Version, Frag, ConnectionStates). %%-------------------------------------------------------------------- --spec encode_alert_record(#alert{}, tls_version(), #connection_states{}) -> +-spec encode_alert_record(#alert{}, ssl_version(), #connection_states{}) -> {iolist(), #connection_states{}}. %% %% Description: Encodes an alert message to send on the ssl-socket. @@ -319,7 +324,7 @@ encode_alert_record(#alert{level = Level, description = Description}, ConnectionStates). %%-------------------------------------------------------------------- --spec encode_change_cipher_spec(tls_version(), #connection_states{}) -> +-spec encode_change_cipher_spec(ssl_version(), #connection_states{}) -> {iolist(), #connection_states{}}. %% %% Description: Encodes a change_cipher_spec-message to send on the ssl socket. @@ -328,7 +333,7 @@ encode_change_cipher_spec(Version, ConnectionStates) -> encode_plain_text(?CHANGE_CIPHER_SPEC, Version, <<1:8>>, ConnectionStates). %%-------------------------------------------------------------------- --spec encode_data(binary(), tls_version(), #connection_states{}) -> +-spec encode_data(binary(), ssl_version(), #connection_states{}) -> {iolist(), #connection_states{}}. %% %% Description: Encodes data to send on the ssl-socket. @@ -356,7 +361,7 @@ compressions() -> [?byte(?NULL)]. %%-------------------------------------------------------------------- --spec cipher(tls_version(), iolist(), #connection_state{}, MacHash::binary()) -> +-spec cipher(ssl_version(), iodata(), #connection_state{}, MacHash::binary()) -> {CipherFragment::binary(), #connection_state{}}. %% %% Description: Payload encryption @@ -372,7 +377,7 @@ cipher(Version, Fragment, ssl_cipher:cipher(BulkCipherAlgo, CipherS0, MacHash, Fragment, Version), {CipherFragment, WriteState0#connection_state{cipher_state = CipherS1}}. %%-------------------------------------------------------------------- --spec decipher(tls_version(), binary(), #connection_state{}) -> {binary(), binary(), #connection_state{}}. +-spec decipher(ssl_version(), binary(), #connection_state{}) -> {binary(), binary(), #connection_state{}}. %% %% Description: Payload decryption %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/ssl_record.hrl b/lib/ssl/src/ssl_record.hrl index c17fa53a62..87ed233c0a 100644 --- a/lib/ssl/src/ssl_record.hrl +++ b/lib/ssl/src/ssl_record.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. 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 @@ -20,7 +20,7 @@ %% %%---------------------------------------------------------------------- %% Purpose: Record and constant defenitions for the SSL-record protocol -%% see RFC 2246 +% see RFC 2246 %%---------------------------------------------------------------------- -ifndef(ssl_record). diff --git a/lib/ssl/src/ssl_sup.erl b/lib/ssl/src/ssl_sup.erl index 77b40a7b38..e1aeb11ca4 100644 --- a/lib/ssl/src/ssl_sup.erl +++ b/lib/ssl/src/ssl_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2014. 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 @@ -89,14 +89,14 @@ tls_connection_manager_child_spec() -> Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -dtls_connection_manager_child_spec() -> - Name = dtls_connection, - StartFunc = {dtls_connection_sup, start_link, []}, - Restart = permanent, - Shutdown = 4000, - Modules = [dtls_connection, ssl_connection], - Type = supervisor, - {Name, StartFunc, Restart, Shutdown, Type, Modules}. +%% dtls_connection_manager_child_spec() -> +%% Name = dtls_connection, +%% StartFunc = {dtls_connection_sup, start_link, []}, +%% Restart = permanent, +%% Shutdown = 4000, +%% Modules = [dtls_connection, ssl_connection], +%% Type = supervisor, +%% {Name, StartFunc, Restart, Shutdown, Type, Modules}. session_cb_init_args() -> case application:get_env(ssl, session_cb_init_args) of diff --git a/lib/ssl/src/ssl_v3.erl b/lib/ssl/src/ssl_v3.erl index d477b3df81..68f7f5dee2 100644 --- a/lib/ssl/src/ssl_v3.erl +++ b/lib/ssl/src/ssl_v3.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. 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 @@ -130,7 +130,7 @@ setup_keys(MasterSecret, ServerRandom, ClientRandom, HS, KML, _EKML, IVS) -> {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, ServerWriteKey, ClientIV, ServerIV}. --spec suites() -> [cipher_suite()]. +-spec suites() -> [ssl_cipher:cipher_suite()]. suites() -> [ diff --git a/lib/ssl/src/tls.erl b/lib/ssl/src/tls.erl index 3e7b2db9c2..c829129250 100644 --- a/lib/ssl/src/tls.erl +++ b/lib/ssl/src/tls.erl @@ -30,25 +30,29 @@ handshake/1, handshake/2, handshake/3]). %%-------------------------------------------------------------------- --spec connect(host() | port(), [connect_option()]) -> {ok, #sslsocket{}} | - {error, reason()}. --spec connect(host() | port(), [connect_option()] | inet:port_number(), - timeout() | list()) -> - {ok, #sslsocket{}} | {error, reason()}. --spec connect(host() | port(), inet:port_number(), list(), timeout()) -> - {ok, #sslsocket{}} | {error, reason()}. - %% %% Description: Connect to an TLS server. %%-------------------------------------------------------------------- +-spec connect(host() | port(), [connect_option()]) -> {ok, #sslsocket{}} | + {error, reason()}. + connect(Socket, Options) when is_port(Socket) -> connect(Socket, Options, infinity). + +-spec connect(host() | port(), [connect_option()] | inet:port_number(), + timeout() | list()) -> + {ok, #sslsocket{}} | {error, reason()}. + connect(Socket, SslOptions, Timeout) when is_port(Socket) -> TLSOpts = [{protocol, tls} | SslOptions], ssl:connect(Socket, TLSOpts, Timeout); connect(Host, Port, Options) -> connect(Host, Port, Options, infinity). + +-spec connect(host() | port(), inet:port_number(), list(), timeout()) -> + {ok, #sslsocket{}} | {error, reason()}. + connect(Host, Port, Options, Timeout) -> TLSOpts = [{protocol, tls} | Options], ssl:connect(Host, Port, TLSOpts, Timeout). @@ -64,39 +68,44 @@ listen(Port, Options) -> ssl:listen(Port, TLSOpts). %%-------------------------------------------------------------------- --spec accept(#sslsocket{}) -> {ok, #sslsocket{}} | - {error, reason()}. --spec accept(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} | - {error, reason()}. %% %% Description: Performs transport accept on an ssl listen socket %%-------------------------------------------------------------------- +-spec accept(#sslsocket{}) -> {ok, #sslsocket{}} | + {error, reason()}. accept(ListenSocket) -> accept(ListenSocket, infinity). + +-spec accept(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} | + {error, reason()}. accept(Socket, Timeout) -> ssl:transport_accept(Socket, Timeout). %%-------------------------------------------------------------------- --spec handshake(#sslsocket{}) -> ok | {error, reason()}. --spec handshake(#sslsocket{} | port(), timeout()| [ssl_option() - | transport_option()]) -> - ok | {ok, #sslsocket{}} | {error, reason()}. --spec handshake(port(), [ssl_option()| transport_option()], timeout()) -> - {ok, #sslsocket{}} | {error, reason()}. %% %% Description: Performs accept on an ssl listen socket. e.i. performs %% ssl handshake. %%-------------------------------------------------------------------- +-spec handshake(#sslsocket{}) -> ok | {error, reason()}. + handshake(ListenSocket) -> handshake(ListenSocket, infinity). +-spec handshake(#sslsocket{} | port(), timeout()| [ssl_option() + | transport_option()]) -> + ok | {ok, #sslsocket{}} | {error, reason()}. + handshake(#sslsocket{} = Socket, Timeout) -> ssl:ssl_accept(Socket, Timeout); handshake(ListenSocket, SslOptions) when is_port(ListenSocket) -> handshake(ListenSocket, SslOptions, infinity). + +-spec handshake(port(), [ssl_option()| transport_option()], timeout()) -> + {ok, #sslsocket{}} | {error, reason()}. + handshake(Socket, SslOptions, Timeout) when is_port(Socket) -> ssl:ssl_accept(Socket, SslOptions, Timeout). diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index 01abefca46..183cabcfcd 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -33,6 +33,8 @@ -export([client_hello/8, hello/4, get_tls_handshake/3, encode_handshake/2, decode_handshake/3]). +-type tls_handshake() :: #client_hello{} | ssl_handshake:ssl_handshake(). + %%==================================================================== %% Internal application API %%==================================================================== @@ -71,11 +73,11 @@ client_hello(Host, Port, ConnectionStates, #connection_states{} | {inet:port_number(), #session{}, db_handle(), atom(), #connection_states{}, binary() | undefined}, boolean()) -> - {tls_version(), session_id(), #connection_states{}, binary() | undefined}| - {tls_version(), {resumed | new, #session{}}, #connection_states{}, - [binary()] | undefined, - [oid()] | undefined, [oid()] | undefined} | - #alert{}. + {tls_record:tls_version(), session_id(), #connection_states{}, binary() | undefined}| + {tls_record:tls_version(), {resumed | new, #session{}}, #connection_states{}, + [binary()] | undefined, + [ssl_handshake:oid()] | undefined, [ssl_handshake:oid()] | undefined} | + #alert{}. %% %% Description: Handles a recieved hello message %%-------------------------------------------------------------------- @@ -122,7 +124,7 @@ hello(#client_hello{client_version = ClientVersion, end. %%-------------------------------------------------------------------- --spec encode_handshake(tls_handshake(), tls_version()) -> iolist(). +-spec encode_handshake(tls_handshake(), tls_record:tls_version()) -> iolist(). %% %% Description: Encode a handshake packet %%--------------------------------------------------------------------x @@ -132,7 +134,7 @@ encode_handshake(Package, Version) -> [MsgType, ?uint24(Len), Bin]. %%-------------------------------------------------------------------- --spec get_tls_handshake(tls_version(), binary(), binary() | iolist()) -> +-spec get_tls_handshake(tls_record:tls_version(), binary(), binary() | iolist()) -> {[tls_handshake()], binary()}. %% %% Description: Given buffered and new data from ssl_record, collects diff --git a/lib/ssl/src/tls_handshake.hrl b/lib/ssl/src/tls_handshake.hrl index dbe930cb90..1646e5b6f2 100644 --- a/lib/ssl/src/tls_handshake.hrl +++ b/lib/ssl/src/tls_handshake.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2014. 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 @@ -37,6 +37,4 @@ extensions }). --type tls_handshake() :: #client_hello{} | ssl_handshake(). - -endif. % -ifdef(tls_handshake). diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index 88107557a0..4da08e9c51 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. 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 @@ -44,6 +44,11 @@ highest_protocol_version/1, supported_protocol_versions/0, is_acceptable_version/1, is_acceptable_version/2]). +-export_type([tls_version/0, tls_atom_version/0]). + +-type tls_version() :: ssl_record:ssl_version(). +-type tls_atom_version() :: sslv3 | tlsv1 | 'tlsv1.1' | 'tlsv1.2'. + -compile(inline). %%==================================================================== @@ -262,18 +267,18 @@ supported_protocol_versions([_|_] = Vsns) -> Vsns. %%-------------------------------------------------------------------- --spec is_acceptable_version(tls_version()) -> boolean(). --spec is_acceptable_version(tls_version(), Supported :: [tls_version()]) -> boolean(). %% %% Description: ssl version 2 is not acceptable security risks are too big. %% %%-------------------------------------------------------------------- +-spec is_acceptable_version(tls_version()) -> boolean(). is_acceptable_version({N,_}) when N >= ?LOWEST_MAJOR_SUPPORTED_VERSION -> true; is_acceptable_version(_) -> false. +-spec is_acceptable_version(tls_version(), Supported :: [tls_version()]) -> boolean(). is_acceptable_version({N,_} = Version, Versions) when N >= ?LOWEST_MAJOR_SUPPORTED_VERSION -> lists:member(Version, Versions); diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index 7c7fdd64c3..067417d163 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. 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 @@ -166,7 +166,7 @@ setup_keys(Version, PrfAlgo, MasterSecret, ServerRandom, ClientRandom, HashSize, {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, ServerWriteKey, ClientIV, ServerIV}. --spec mac_hash(integer(), binary(), integer(), integer(), tls_version(), +-spec mac_hash(integer(), binary(), integer(), integer(), tls_record:tls_version(), integer(), binary()) -> binary(). mac_hash(Method, Mac_write_secret, Seq_num, Type, {Major, Minor}, @@ -181,7 +181,7 @@ mac_hash(Method, Mac_write_secret, Seq_num, Type, {Major, Minor}, Fragment]), Mac. --spec suites(1|2|3) -> [cipher_suite()]. +-spec suites(1|2|3) -> [ssl_cipher:cipher_suite()]. suites(Minor) when Minor == 1; Minor == 2-> case sufficent_ec_support() of @@ -439,7 +439,9 @@ enum_to_oid(24) -> ?secp384r1; enum_to_oid(25) -> ?secp521r1; enum_to_oid(26) -> ?brainpoolP256r1; enum_to_oid(27) -> ?brainpoolP384r1; -enum_to_oid(28) -> ?brainpoolP512r1. +enum_to_oid(28) -> ?brainpoolP512r1; +enum_to_oid(_) -> + undefined. sufficent_ec_support() -> CryptoSupport = crypto:supports(), diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 244eb5ce0a..2f8ff6f04e 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -39,6 +39,7 @@ MODULES = \ ssl_basic_SUITE \ ssl_cipher_SUITE \ ssl_certificate_verify_SUITE\ + ssl_crl_SUITE\ ssl_dist_SUITE \ ssl_handshake_SUITE \ ssl_npn_hello_SUITE \ diff --git a/lib/ssl/test/make_certs.erl b/lib/ssl/test/make_certs.erl index 4603a9f846..c438ae2b87 100644 --- a/lib/ssl/test/make_certs.erl +++ b/lib/ssl/test/make_certs.erl @@ -18,23 +18,68 @@ %% -module(make_certs). +-compile([export_all]). --export([all/2]). +%-export([all/1, all/2, rootCA/2, intermediateCA/3, endusers/3, enduser/3, revoke/3, gencrl/2, verify/3]). --record(dn, {commonName, +-record(config, {commonName, organizationalUnitName = "Erlang OTP", organizationName = "Ericsson AB", localityName = "Stockholm", countryName = "SE", - emailAddress = "[email protected]"}). + emailAddress = "[email protected]", + default_bits = 2048, + v2_crls = true, + ecc_certs = false, + issuing_distribution_point = false, + openssl_cmd = "openssl"}). + + +default_config() -> + #config{}. + +make_config(Args) -> + make_config(Args, #config{}). + +make_config([], C) -> + C; +make_config([{organizationalUnitName, Name}|T], C) when is_list(Name) -> + make_config(T, C#config{organizationalUnitName = Name}); +make_config([{organizationName, Name}|T], C) when is_list(Name) -> + make_config(T, C#config{organizationName = Name}); +make_config([{localityName, Name}|T], C) when is_list(Name) -> + make_config(T, C#config{localityName = Name}); +make_config([{countryName, Name}|T], C) when is_list(Name) -> + make_config(T, C#config{countryName = Name}); +make_config([{emailAddress, Name}|T], C) when is_list(Name) -> + make_config(T, C#config{emailAddress = Name}); +make_config([{default_bits, Bits}|T], C) when is_integer(Bits) -> + make_config(T, C#config{default_bits = Bits}); +make_config([{v2_crls, Bool}|T], C) when is_boolean(Bool) -> + make_config(T, C#config{v2_crls = Bool}); +make_config([{ecc_certs, Bool}|T], C) when is_boolean(Bool) -> + make_config(T, C#config{ecc_certs = Bool}); +make_config([{issuing_distribution_point, Bool}|T], C) when is_boolean(Bool) -> + make_config(T, C#config{issuing_distribution_point = Bool}); +make_config([{openssl_cmd, Cmd}|T], C) when is_list(Cmd) -> + make_config(T, C#config{openssl_cmd = Cmd}). + + +all([DataDir, PrivDir]) -> + all(DataDir, PrivDir). all(DataDir, PrivDir) -> - OpenSSLCmd = "openssl", + all(DataDir, PrivDir, #config{}). + +all(DataDir, PrivDir, C) when is_list(C) -> + all(DataDir, PrivDir, make_config(C)); +all(DataDir, PrivDir, C = #config{}) -> + ok = filelib:ensure_dir(filename:join(PrivDir, "erlangCA")), create_rnd(DataDir, PrivDir), % For all requests - rootCA(PrivDir, OpenSSLCmd, "erlangCA"), - intermediateCA(PrivDir, OpenSSLCmd, "otpCA", "erlangCA"), - endusers(PrivDir, OpenSSLCmd, "otpCA", ["client", "server"]), - collect_certs(PrivDir, ["erlangCA", "otpCA"], ["client", "server"]), + rootCA(PrivDir, "erlangCA", C), + intermediateCA(PrivDir, "otpCA", "erlangCA", C), + endusers(PrivDir, "otpCA", ["client", "server", "revoked"], C), + endusers(PrivDir, "erlangCA", ["localhost"], C), %% Create keycert files SDir = filename:join([PrivDir, "server"]), SC = filename:join([SDir, "cert.pem"]), @@ -46,7 +91,14 @@ all(DataDir, PrivDir) -> CK = filename:join([CDir, "key.pem"]), CKC = filename:join([CDir, "keycert.pem"]), append_files([CK, CC], CKC), - remove_rnd(PrivDir). + RDir = filename:join([PrivDir, "revoked"]), + RC = filename:join([RDir, "cert.pem"]), + RK = filename:join([RDir, "key.pem"]), + RKC = filename:join([RDir, "keycert.pem"]), + revoke(PrivDir, "otpCA", "revoked", C), + append_files([RK, RC], RKC), + remove_rnd(PrivDir), + {ok, C}. append_files(FileNames, ResultFileName) -> {ok, ResultFile} = file:open(ResultFileName, [write]), @@ -59,111 +111,176 @@ do_append_files([F|Fs], RF) -> ok = file:write(RF, Data), do_append_files(Fs, RF). -rootCA(Root, OpenSSLCmd, Name) -> - create_ca_dir(Root, Name, ca_cnf(Name)), - DN = #dn{commonName = Name}, - create_self_signed_cert(Root, OpenSSLCmd, Name, req_cnf(DN)), - ok. +rootCA(Root, Name, C) -> + create_ca_dir(Root, Name, ca_cnf(C#config{commonName = Name})), + create_self_signed_cert(Root, Name, req_cnf(C#config{commonName = Name}), C), + file:copy(filename:join([Root, Name, "cert.pem"]), filename:join([Root, Name, "cacerts.pem"])), + gencrl(Root, Name, C). -intermediateCA(Root, OpenSSLCmd, CA, ParentCA) -> - CA = "otpCA", - create_ca_dir(Root, CA, ca_cnf(CA)), +intermediateCA(Root, CA, ParentCA, C) -> + create_ca_dir(Root, CA, ca_cnf(C#config{commonName = CA})), CARoot = filename:join([Root, CA]), - DN = #dn{commonName = CA}, CnfFile = filename:join([CARoot, "req.cnf"]), - file:write_file(CnfFile, req_cnf(DN)), + file:write_file(CnfFile, req_cnf(C#config{commonName = CA})), KeyFile = filename:join([CARoot, "private", "key.pem"]), ReqFile = filename:join([CARoot, "req.pem"]), - create_req(Root, OpenSSLCmd, CnfFile, KeyFile, ReqFile), + create_req(Root, CnfFile, KeyFile, ReqFile, C), CertFile = filename:join([CARoot, "cert.pem"]), - sign_req(Root, OpenSSLCmd, ParentCA, "ca_cert", ReqFile, CertFile). - -endusers(Root, OpenSSLCmd, CA, Users) -> - lists:foreach(fun(User) -> enduser(Root, OpenSSLCmd, CA, User) end, Users). - -enduser(Root, OpenSSLCmd, CA, User) -> + sign_req(Root, ParentCA, "ca_cert", ReqFile, CertFile, C), + CACertsFile = filename:join(CARoot, "cacerts.pem"), + file:copy(filename:join([Root, ParentCA, "cacerts.pem"]), CACertsFile), + %% append this CA's cert to the cacerts file + {ok, Bin} = file:read_file(CertFile), + {ok, FD} = file:open(CACertsFile, [append]), + file:write(FD, ["\n", Bin]), + file:close(FD), + gencrl(Root, CA, C). + +endusers(Root, CA, Users, C) -> + [enduser(Root, CA, User, C) || User <- Users]. + +enduser(Root, CA, User, C) -> UsrRoot = filename:join([Root, User]), file:make_dir(UsrRoot), CnfFile = filename:join([UsrRoot, "req.cnf"]), - DN = #dn{commonName = User}, - file:write_file(CnfFile, req_cnf(DN)), + file:write_file(CnfFile, req_cnf(C#config{commonName = User})), KeyFile = filename:join([UsrRoot, "key.pem"]), ReqFile = filename:join([UsrRoot, "req.pem"]), - create_req(Root, OpenSSLCmd, CnfFile, KeyFile, ReqFile), + create_req(Root, CnfFile, KeyFile, ReqFile, C), + %create_req(Root, CnfFile, KeyFile, ReqFile), CertFileAllUsage = filename:join([UsrRoot, "cert.pem"]), - sign_req(Root, OpenSSLCmd, CA, "user_cert", ReqFile, CertFileAllUsage), + sign_req(Root, CA, "user_cert", ReqFile, CertFileAllUsage, C), CertFileDigitalSigOnly = filename:join([UsrRoot, "digital_signature_only_cert.pem"]), - sign_req(Root, OpenSSLCmd, CA, "user_cert_digital_signature_only", ReqFile, CertFileDigitalSigOnly). - -collect_certs(Root, CAs, Users) -> - Bins = lists:foldr( - fun(CA, Acc) -> - File = filename:join([Root, CA, "cert.pem"]), - {ok, Bin} = file:read_file(File), - [Bin, "\n" | Acc] - end, [], CAs), - lists:foreach( - fun(User) -> - File = filename:join([Root, User, "cacerts.pem"]), - file:write_file(File, Bins) - end, Users). + sign_req(Root, CA, "user_cert_digital_signature_only", ReqFile, CertFileDigitalSigOnly, C), + CACertsFile = filename:join(UsrRoot, "cacerts.pem"), + file:copy(filename:join([Root, CA, "cacerts.pem"]), CACertsFile), + ok. + +revoke(Root, CA, User, C) -> + UsrCert = filename:join([Root, User, "cert.pem"]), + CACnfFile = filename:join([Root, CA, "ca.cnf"]), + Cmd = [C#config.openssl_cmd, " ca" + " -revoke ", UsrCert, + [" -crl_reason keyCompromise" || C#config.v2_crls ], + " -config ", CACnfFile], + Env = [{"ROOTDIR", filename:absname(Root)}], + cmd(Cmd, Env), + gencrl(Root, CA, C). + +gencrl(Root, CA, C) -> + CACnfFile = filename:join([Root, CA, "ca.cnf"]), + CACRLFile = filename:join([Root, CA, "crl.pem"]), + Cmd = [C#config.openssl_cmd, " ca" + " -gencrl ", + " -crlhours 24", + " -out ", CACRLFile, + " -config ", CACnfFile], + Env = [{"ROOTDIR", filename:absname(Root)}], + cmd(Cmd, Env). -create_self_signed_cert(Root, OpenSSLCmd, CAName, Cnf) -> +verify(Root, CA, User, C) -> + CAFile = filename:join([Root, User, "cacerts.pem"]), + CACRLFile = filename:join([Root, CA, "crl.pem"]), + CertFile = filename:join([Root, User, "cert.pem"]), + Cmd = [C#config.openssl_cmd, " verify" + " -CAfile ", CAFile, + " -CRLfile ", CACRLFile, %% this is undocumented, but seems to work + " -crl_check ", + CertFile], + Env = [{"ROOTDIR", filename:absname(Root)}], + try cmd(Cmd, Env) catch + exit:{eval_cmd, _, _} -> + invalid + end. + +create_self_signed_cert(Root, CAName, Cnf, C = #config{ecc_certs = true}) -> CARoot = filename:join([Root, CAName]), CnfFile = filename:join([CARoot, "req.cnf"]), file:write_file(CnfFile, Cnf), KeyFile = filename:join([CARoot, "private", "key.pem"]), CertFile = filename:join([CARoot, "cert.pem"]), - Cmd = [OpenSSLCmd, " req" + Cmd = [C#config.openssl_cmd, " ecparam" + " -out ", KeyFile, + " -name secp521r1 ", + %" -name sect283k1 ", + " -genkey "], + Env = [{"ROOTDIR", filename:absname(Root)}], + cmd(Cmd, Env), + + Cmd2 = [C#config.openssl_cmd, " req" " -new" " -x509" " -config ", CnfFile, - " -keyout ", KeyFile, + " -key ", KeyFile, + " -outform PEM ", " -out ", CertFile], - Env = [{"ROOTDIR", Root}], - cmd(Cmd, Env), - fix_key_file(OpenSSLCmd, KeyFile). - -% openssl 1.0 generates key files in pkcs8 format by default and we don't handle this format -fix_key_file(OpenSSLCmd, KeyFile) -> - KeyFileTmp = KeyFile ++ ".tmp", - Cmd = [OpenSSLCmd, " rsa", - " -in ", - KeyFile, - " -out ", - KeyFileTmp], - cmd(Cmd, []), - ok = file:rename(KeyFileTmp, KeyFile). + cmd(Cmd2, Env); +create_self_signed_cert(Root, CAName, Cnf, C) -> + CARoot = filename:join([Root, CAName]), + CnfFile = filename:join([CARoot, "req.cnf"]), + file:write_file(CnfFile, Cnf), + KeyFile = filename:join([CARoot, "private", "key.pem"]), + CertFile = filename:join([CARoot, "cert.pem"]), + Cmd = [C#config.openssl_cmd, " req" + " -new" + " -x509" + " -config ", CnfFile, + " -keyout ", KeyFile, + " -outform PEM", + " -out ", CertFile], + Env = [{"ROOTDIR", filename:absname(Root)}], + cmd(Cmd, Env). + create_ca_dir(Root, CAName, Cnf) -> CARoot = filename:join([Root, CAName]), + ok = filelib:ensure_dir(CARoot), file:make_dir(CARoot), create_dirs(CARoot, ["certs", "crl", "newcerts", "private"]), create_rnd(Root, filename:join([CAName, "private"])), create_files(CARoot, [{"serial", "01\n"}, + {"crlnumber", "01"}, {"index.txt", ""}, {"ca.cnf", Cnf}]). -create_req(Root, OpenSSLCmd, CnfFile, KeyFile, ReqFile) -> - Cmd = [OpenSSLCmd, " req" +create_req(Root, CnfFile, KeyFile, ReqFile, C = #config{ecc_certs = true}) -> + Cmd = [C#config.openssl_cmd, " ecparam" + " -out ", KeyFile, + " -name secp521r1 ", + %" -name sect283k1 ", + " -genkey "], + Env = [{"ROOTDIR", filename:absname(Root)}], + cmd(Cmd, Env), + Cmd2 = [C#config.openssl_cmd, " req" + " -new ", + " -key ", KeyFile, + " -outform PEM ", + " -out ", ReqFile, + " -config ", CnfFile], + cmd(Cmd2, Env); + %fix_key_file(KeyFile). +create_req(Root, CnfFile, KeyFile, ReqFile, C) -> + Cmd = [C#config.openssl_cmd, " req" " -new" " -config ", CnfFile, + " -outform PEM ", " -keyout ", KeyFile, " -out ", ReqFile], - Env = [{"ROOTDIR", Root}], - cmd(Cmd, Env), - fix_key_file(OpenSSLCmd, KeyFile). + Env = [{"ROOTDIR", filename:absname(Root)}], + cmd(Cmd, Env). + %fix_key_file(KeyFile). + -sign_req(Root, OpenSSLCmd, CA, CertType, ReqFile, CertFile) -> +sign_req(Root, CA, CertType, ReqFile, CertFile, C) -> CACnfFile = filename:join([Root, CA, "ca.cnf"]), - Cmd = [OpenSSLCmd, " ca" + Cmd = [C#config.openssl_cmd, " ca" " -batch" " -notext" " -config ", CACnfFile, " -extensions ", CertType, " -in ", ReqFile, " -out ", CertFile], - Env = [{"ROOTDIR", Root}], + Env = [{"ROOTDIR", filename:absname(Root)}], cmd(Cmd, Env). %% @@ -194,19 +311,19 @@ cmd(Cmd, Env) -> FCmd = lists:flatten(Cmd), Port = open_port({spawn, FCmd}, [stream, eof, exit_status, stderr_to_stdout, {env, Env}]), - eval_cmd(Port). + eval_cmd(Port, FCmd). -eval_cmd(Port) -> +eval_cmd(Port, Cmd) -> receive {Port, {data, _}} -> - eval_cmd(Port); + eval_cmd(Port, Cmd); {Port, eof} -> ok end, receive {Port, {exit_status, Status}} when Status /= 0 -> %% io:fwrite("exit status: ~w~n", [Status]), - exit({eval_cmd, Status}) + exit({eval_cmd, Cmd, Status}) after 0 -> ok end. @@ -215,7 +332,7 @@ eval_cmd(Port) -> %% Contents of configuration files %% -req_cnf(DN) -> +req_cnf(C) -> ["# Purpose: Configuration for requests (end users and CAs)." "\n" "ROOTDIR = $ENV::ROOTDIR\n" @@ -224,7 +341,7 @@ req_cnf(DN) -> "[req]\n" "input_password = secret\n" "output_password = secret\n" - "default_bits = 1024\n" + "default_bits = ", integer_to_list(C#config.default_bits), "\n" "RANDFILE = $ROOTDIR/RAND\n" "encrypt_key = no\n" "default_md = sha1\n" @@ -235,12 +352,12 @@ req_cnf(DN) -> "\n" "[name]\n" - "commonName = ", DN#dn.commonName, "\n" - "organizationalUnitName = ", DN#dn.organizationalUnitName, "\n" - "organizationName = ", DN#dn.organizationName, "\n" - "localityName = ", DN#dn.localityName, "\n" - "countryName = ", DN#dn.countryName, "\n" - "emailAddress = ", DN#dn.emailAddress, "\n" + "commonName = ", C#config.commonName, "\n" + "organizationalUnitName = ", C#config.organizationalUnitName, "\n" + "organizationName = ", C#config.organizationName, "\n" + "localityName = ", C#config.localityName, "\n" + "countryName = ", C#config.countryName, "\n" + "emailAddress = ", C#config.emailAddress, "\n" "\n" "[ca_ext]\n" @@ -249,8 +366,7 @@ req_cnf(DN) -> "subjectKeyIdentifier = hash\n" "subjectAltName = email:copy\n"]. - -ca_cnf(CA) -> +ca_cnf(C) -> ["# Purpose: Configuration for CAs.\n" "\n" "ROOTDIR = $ENV::ROOTDIR\n" @@ -258,21 +374,23 @@ ca_cnf(CA) -> "\n" "[ca]\n" - "dir = $ROOTDIR/", CA, "\n" + "dir = $ROOTDIR/", C#config.commonName, "\n" "certs = $dir/certs\n" "crl_dir = $dir/crl\n" "database = $dir/index.txt\n" "new_certs_dir = $dir/newcerts\n" "certificate = $dir/cert.pem\n" "serial = $dir/serial\n" - "crl = $dir/crl.pem\n" + "crl = $dir/crl.pem\n", + ["crlnumber = $dir/crlnumber\n" || C#config.v2_crls], "private_key = $dir/private/key.pem\n" "RANDFILE = $dir/private/RAND\n" "\n" - "x509_extensions = user_cert\n" + "x509_extensions = user_cert\n", + ["crl_extensions = crl_ext\n" || C#config.v2_crls], "unique_subject = no\n" "default_days = 3600\n" - "default_md = sha1\n" + "default_md = sha256\n" "preserve = no\n" "policy = policy_match\n" "\n" @@ -286,6 +404,13 @@ ca_cnf(CA) -> "emailAddress = supplied\n" "\n" + "[crl_ext]\n" + "authorityKeyIdentifier=keyid:always,issuer:always\n", + ["issuingDistributionPoint=critical, @idpsec\n" || C#config.issuing_distribution_point], + + "[idpsec]\n" + "fullname=URI:http://localhost:8000/",C#config.commonName,"/crl.pem\n" + "[user_cert]\n" "basicConstraints = CA:false\n" "keyUsage = nonRepudiation, digitalSignature, keyEncipherment\n" @@ -293,6 +418,12 @@ ca_cnf(CA) -> "authorityKeyIdentifier = keyid,issuer:always\n" "subjectAltName = email:copy\n" "issuerAltName = issuer:copy\n" + "crlDistributionPoints=@crl_section\n" + + "[crl_section]\n" + %% intentionally invalid + "URI.1=http://localhost/",C#config.commonName,"/crl.pem\n" + "URI.2=http://localhost:8000/",C#config.commonName,"/crl.pem\n" "\n" "[user_cert_digital_signature_only]\n" @@ -310,4 +441,7 @@ ca_cnf(CA) -> "subjectKeyIdentifier = hash\n" "authorityKeyIdentifier = keyid:always,issuer:always\n" "subjectAltName = email:copy\n" - "issuerAltName = issuer:copy\n"]. + "issuerAltName = issuer:copy\n" + "crlDistributionPoints=@crl_section\n" + ]. + diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 523760aba6..0148e1f5bc 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -96,6 +96,7 @@ basic_tests() -> options_tests() -> [der_input, misc_ssl_options, + ssl_options_not_proplist, socket_options, invalid_inet_get_option, invalid_inet_get_option_not_list, @@ -308,7 +309,11 @@ alerts(Config) when is_list(Config) -> ?ILLEGAL_PARAMETER, ?UNKNOWN_CA, ?ACCESS_DENIED, ?DECODE_ERROR, ?DECRYPT_ERROR, ?EXPORT_RESTRICTION, ?PROTOCOL_VERSION, ?INSUFFICIENT_SECURITY, ?INTERNAL_ERROR, ?USER_CANCELED, - ?NO_RENEGOTIATION], + ?NO_RENEGOTIATION, ?UNSUPPORTED_EXTENSION, ?CERTIFICATE_UNOBTAINABLE, + ?UNRECOGNISED_NAME, ?BAD_CERTIFICATE_STATUS_RESPONSE, + ?BAD_CERTIFICATE_HASH_VALUE, ?UNKNOWN_PSK_IDENTITY, + 255 %% Unsupported/unknow alert will result in a description too + ], Alerts = [?ALERT_REC(?WARNING, ?CLOSE_NOTIFY) | [?ALERT_REC(?FATAL, Desc) || Desc <- Descriptions]], lists:foreach(fun(Alert) -> @@ -990,7 +995,7 @@ misc_ssl_options(Config) when is_list(Config) -> ServerOpts = ?config(server_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - %% Chek that ssl options not tested elsewhere are filtered away e.i. not passed to inet. + %% Check that ssl options not tested elsewhere are filtered away e.i. not passed to inet. TestOpts = [{depth, 1}, {key, undefined}, {password, []}, @@ -1018,6 +1023,17 @@ misc_ssl_options(Config) when is_list(Config) -> ssl_test_lib:close(Client). %%-------------------------------------------------------------------- +ssl_options_not_proplist() -> + [{doc,"Test what happens if an option is not a key value tuple"}]. + +ssl_options_not_proplist(Config) when is_list(Config) -> + BadOption = {client_preferred_next_protocols, + client, [<<"spdy/3">>,<<"http/1.1">>], <<"http/1.1">>}, + {option_not_a_key_value_tuple, BadOption} = + ssl:connect("twitter.com", 443, [binary, {active, false}, + BadOption]). + +%%-------------------------------------------------------------------- versions() -> [{doc,"Test API function versions/0"}]. diff --git a/lib/ssl/test/ssl_crl_SUITE.erl b/lib/ssl/test/ssl_crl_SUITE.erl new file mode 100644 index 0000000000..da0349904c --- /dev/null +++ b/lib/ssl/test/ssl_crl_SUITE.erl @@ -0,0 +1,530 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2013. 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(ssl_crl_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("public_key/include/public_key.hrl"). + +-define(TIMEOUT, 120000). +-define(LONG_TIMEOUT, 600000). +-define(SLEEP, 1000). +-define(OPENSSL_RENEGOTIATE, "R\n"). +-define(OPENSSL_QUIT, "Q\n"). +-define(OPENSSL_GARBAGE, "P\n"). +-define(EXPIRE, 10). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [ + {group, basic}, + {group, v1_crl}, + {group, idp_crl} + ]. + +groups() -> + [{basic, [], basic_tests()}, + {v1_crl, [], v1_crl_tests()}, + {idp_crl, [], idp_crl_tests()}]. + +basic_tests() -> + [crl_verify_valid, crl_verify_revoked]. + +v1_crl_tests() -> + [crl_verify_valid, crl_verify_revoked]. + +idp_crl_tests() -> + [crl_verify_valid, crl_verify_revoked]. + +%%%================================================================ +%%% Suite init/end + +init_per_suite(Config0) -> + Dog = ct:timetrap(?LONG_TIMEOUT *2), + case os:find_executable("openssl") of + false -> + {skip, "Openssl not found"}; + _ -> + TLSVersion = ?config(tls_version, Config0), + OpenSSL_version = (catch os:cmd("openssl version")), + ct:log("TLS version: ~p~nOpenSSL version: ~p~n~n~p:module_info(): ~p~n~nssh:module_info(): ~p~n", + [TLSVersion, OpenSSL_version, ?MODULE, ?MODULE:module_info(), ssh:module_info()]), + case ssl_test_lib:enough_openssl_crl_support(OpenSSL_version) of + false -> + {skip, io_lib:format("Bad openssl version: ~p",[OpenSSL_version])}; + _ -> + catch crypto:stop(), + try crypto:start() of + ok -> + ssl:start(), + [{watchdog, Dog}, {openssl_version,OpenSSL_version} | Config0] + catch _C:_E -> + ct:log("crypto:start() caught ~p:~p",[_C,_E]), + {skip, "Crypto did not start"} + end + end + end. + +end_per_suite(_Config) -> + ssl:stop(), + application:stop(crypto). + +%%%================================================================ +%%% Group init/end + +init_per_group(Group, Config) -> + ct:log("~p:~p~nlisteners to port 8000:~n~p~n)",[?MODULE,?LINE,os:cmd("netstat -tln|grep ':8000'")]), + ssl:start(), + inets:start(), + CertDir = filename:join(?config(priv_dir, Config), Group), + DataDir = ?config(data_dir, Config), + ServerRoot = make_dir_path([?config(priv_dir,Config), Group, tmp]), + Result = make_certs:all(DataDir, CertDir, cert_opts(Group)), + ct:log("~p:~p~nmake_certs:all(~n DataDir=~p,~n CertDir=~p,~n ServerRoot=~p~n Opts=~p~n) returned ~p~n", [?MODULE,?LINE,DataDir, CertDir, ServerRoot, cert_opts(Group), Result]), + %% start a HTTP server to serve the CRLs + {ok, Httpd} = inets:start(httpd, [{server_name, "localhost"}, {port, 8000}, + {server_root, ServerRoot}, + {document_root, CertDir}, + {modules, [mod_get]} + ]), + ct:log("~p:~p~nlisteners to port 8000:~n~p~n)",[?MODULE,?LINE,os:cmd("netstat -tln|grep ':8000'")]), + [{make_cert_result, Result}, {cert_dir, CertDir}, {httpd, Httpd} | Config]. + +cert_opts(v1_crl) -> [{v2_crls, false}]; +cert_opts(idp_crl) -> [{issuing_distribution_point, true}]; +cert_opts(_) -> []. + +make_dir_path(PathComponents) -> + lists:foldl(fun(F,P0) -> file:make_dir(P=filename:join(P0,F)), P end, + "", + PathComponents). + + +end_per_group(_GroupName, Config) -> + case ?config(httpd, Config) of + undefined -> ok; + Pid -> + ct:log("Stop httpd ~p",[Pid]), + ok = inets:stop(httpd, Pid) + ,ct:log("Stopped",[]) + end, + inets:stop(), + ct:log("~p:~p~nlisteners to port 8000:~n~p~n)",[?MODULE,?LINE,os:cmd("netstat -tln|grep ':8000'")]), + Config. + +%%%================================================================ +%%% Test cases + +crl_verify_valid() -> + [{doc,"Verify a simple valid CRL chain"}]. +crl_verify_valid(Config) when is_list(Config) -> + process_flag(trap_exit, true), + PrivDir = ?config(cert_dir, Config), + ServerOpts = [{keyfile, filename:join([PrivDir, "server", "key.pem"])}, + {certfile, filename:join([PrivDir, "server", "cert.pem"])}, + {cacertfile, filename:join([PrivDir, "server", "cacerts.pem"])}], + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Data = "From openssl to erlang", + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, erlang_ssl_receive, [Data]}}, + %{mfa, {ssl_test_lib, no_result, []}}, + {options, ServerOpts}]), + ct:log("~p:~p~nreturn from ssl_test_lib:start_server:~n~p",[?MODULE,?LINE,Server]), + Port = ssl_test_lib:inet_port(Server), + + CACerts = load_cert(filename:join([PrivDir, "erlangCA", "cacerts.pem"])), + + ClientOpts = [{cacerts, CACerts}, + {verify, verify_peer}, + {verify_fun, {fun validate_function/3, {CACerts, []}}}], + + + ct:log("~p:~p~ncalling ssl_test_lib:start_client",[?MODULE,?LINE]), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, + erlang_ssl_send, [Data]}}, + %{mfa, {ssl_test_lib, no_result, []}}, + {options, ClientOpts}]), + ct:log("~p:~p~nreturn from ssl_test_lib:start_client:~n~p",[?MODULE,?LINE,Client]), + + ssl_test_lib:check_result(Client, ok, Server, ok), + + %% Clean close down! Server needs to be closed first !! + ssl_test_lib:close(Server), + ssl_test_lib:close(Client), + process_flag(trap_exit, false). + +crl_verify_revoked() -> + [{doc,"Verify a simple valid CRL chain"}]. +crl_verify_revoked(Config) when is_list(Config) -> + process_flag(trap_exit, true), + PrivDir = ?config(cert_dir, Config), + ServerOpts = [{keyfile, filename:join([PrivDir, "revoked", "key.pem"])}, + {certfile, filename:join([PrivDir, "revoked", "cert.pem"])}, + {cacertfile, filename:join([PrivDir, "revoked", "cacerts.pem"])}], + ct:log("~p:~p~nserver opts ~p~n", [?MODULE,?LINE, ServerOpts]), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + %{mfa, {?MODULE, erlang_ssl_receive, [Data]}}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + CACerts = load_cert(filename:join([PrivDir, "erlangCA", "cacerts.pem"])), + ClientOpts = [{cacerts, CACerts}, + {verify, verify_peer}, + {verify_fun, {fun validate_function/3, {CACerts, []}}}], + + {connect_failed, _} = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + %{mfa, {?MODULE, + %erlang_ssl_receive, [Data]}}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, ClientOpts}]), + + %% Clean close down! Server needs to be closed first !! + ssl_test_lib:close(Server), + process_flag(trap_exit, false). + +%%%================================================================ +%%% Lib + +erlang_ssl_receive(Socket, Data) -> + ct:log("~p:~p~nConnection info: ~p~n", + [?MODULE,?LINE, ssl:connection_info(Socket)]), + receive + {ssl, Socket, Data} -> + ct:log("~p:~p~nReceived ~p~n",[?MODULE,?LINE, Data]), + %% open_ssl server sometimes hangs waiting in blocking read + ssl:send(Socket, "Got it"), + ok; + {ssl, Socket, Byte} when length(Byte) == 1 -> + erlang_ssl_receive(Socket, tl(Data)); + {Port, {data,Debug}} when is_port(Port) -> + ct:log("~p:~p~nopenssl ~s~n",[?MODULE,?LINE, Debug]), + erlang_ssl_receive(Socket,Data); + Other -> + ct:fail({unexpected_message, Other}) + after 4000 -> + ct:fail({did_not_get, Data}) + end. + + +erlang_ssl_send(Socket, Data) -> + ct:log("~p:~p~nConnection info: ~p~n", + [?MODULE,?LINE, ssl:connection_info(Socket)]), + ssl:send(Socket, Data), + ok. + +load_certs(undefined) -> + undefined; +load_certs(CertDir) -> + case file:list_dir(CertDir) of + {ok, Certs} -> + load_certs(lists:map(fun(Cert) -> filename:join(CertDir, Cert) + end, Certs), []); + {error, _} -> + undefined + end. + +load_certs([], Acc) -> + ct:log("~p:~p~nSuccessfully loaded ~p CA certificates~n", [?MODULE,?LINE, length(Acc)]), + Acc; +load_certs([Cert|Certs], Acc) -> + case filelib:is_dir(Cert) of + true -> + load_certs(Certs, Acc); + _ -> + %ct:log("~p:~p~nLoading certificate ~p~n", [?MODULE,?LINE, Cert]), + load_certs(Certs, load_cert(Cert) ++ Acc) + end. + +load_cert(Cert) -> + {ok, Bin} = file:read_file(Cert), + case filename:extension(Cert) of + ".der" -> + %% no decoding necessary + [Bin]; + _ -> + %% assume PEM otherwise + Contents = public_key:pem_decode(Bin), + [DER || {Type, DER, Cipher} <- Contents, Type == 'Certificate', Cipher == 'not_encrypted'] + end. + +%% @doc Validator function for SSL negotiation. +%% +validate_function(Cert, valid_peer, State) -> + ct:log("~p:~p~nvaliding peer ~p with ~p intermediate certs~n", + [?MODULE,?LINE, get_common_name(Cert), + length(element(2, State))]), + %% peer certificate validated, now check the CRL + Res = (catch check_crl(Cert, State)), + ct:log("~p:~p~nCRL validate result for ~p: ~p~n", + [?MODULE,?LINE, get_common_name(Cert), Res]), + {Res, State}; +validate_function(Cert, valid, {TrustedCAs, IntermediateCerts}=State) -> + case public_key:pkix_is_self_signed(Cert) of + true -> + ct:log("~p:~p~nroot certificate~n",[?MODULE,?LINE]), + %% this is a root cert, no CRL + {valid, {TrustedCAs, [Cert|IntermediateCerts]}}; + false -> + %% check is valid CA certificate, add to the list of + %% intermediates + Res = (catch check_crl(Cert, State)), + ct:log("~p:~p~nCRL intermediate CA validate result for ~p: ~p~n", + [?MODULE,?LINE, get_common_name(Cert), Res]), + {Res, {TrustedCAs, [Cert|IntermediateCerts]}} + end; +validate_function(_Cert, _Event, State) -> + %ct:log("~p:~p~nignoring event ~p~n", [?MODULE,?LINE, _Event]), + {valid, State}. + +%% @doc Given a certificate, find CRL distribution points for the given +%% certificate, fetch, and attempt to validate each CRL through +%% issuer_function/4. +%% +check_crl(Cert, State) -> + %% pull the CRL distribution point(s) out of the certificate, if any + ct:log("~p:~p~ncheck_crl(~n Cert=~p,~nState=~p~n)",[?MODULE,?LINE,Cert,State]), + case pubkey_cert:select_extension( + ?'id-ce-cRLDistributionPoints', + pubkey_cert:extensions_list(Cert#'OTPCertificate'.tbsCertificate#'OTPTBSCertificate'.extensions)) of + undefined -> + ct:log("~p:~p~nno CRL distribution points for ~p~n", + [?MODULE,?LINE, get_common_name(Cert)]), + %% fail; we can't validate if there's no CRL + no_crl; + CRLExtension -> + ct:log("~p:~p~nCRLExtension=~p)",[?MODULE,?LINE,CRLExtension]), + CRLDistPoints = CRLExtension#'Extension'.extnValue, + DPointsAndCRLs = lists:foldl(fun(Point, Acc) -> + %% try to read the CRL over http or from a + %% local file + case fetch_point(Point) of + not_available -> + ct:log("~p:~p~nfetch_point returned~n~p~n)",[?MODULE,?LINE,not_available]), + Acc; + Res -> + ct:log("~p:~p~nfetch_point returned~n~p~n)",[?MODULE,?LINE,Res]), + [{Point, Res} | Acc] + end + end, [], CRLDistPoints), + public_key:pkix_crls_validate(Cert, + DPointsAndCRLs, + [{issuer_fun, + {fun issuer_function/4, State}}]) + end. + +%% @doc Given a list of distribution points for CRLs, certificates and +%% both trusted and intermediary certificates, attempt to build and +%% authority chain back via build_chain to verify that it is valid. +%% +issuer_function(_DP, CRL, _Issuer, {TrustedCAs, IntermediateCerts}) -> + %% XXX the 'Issuer' we get passed here is the AuthorityKeyIdentifier, + %% which we are not currently smart enough to understand + %% Read the CA certs out of the file + ct:log("~p:~p~nissuer_function(~nCRL=~p,~nLast param=~p)",[?MODULE,?LINE,CRL, {TrustedCAs, IntermediateCerts}]), + Certs = [public_key:pkix_decode_cert(DER, otp) || DER <- TrustedCAs], + %% get the real issuer out of the CRL + Issuer = public_key:pkix_normalize_name( + pubkey_cert_records:transform( + CRL#'CertificateList'.tbsCertList#'TBSCertList'.issuer, decode)), + %% assume certificates are ordered from root to tip + case find_issuer(Issuer, IntermediateCerts ++ Certs) of + undefined -> + ct:log("~p:~p~nunable to find certificate matching CRL issuer ~p~n", + [?MODULE,?LINE, Issuer]), + error; + IssuerCert -> + ct:log("~p:~p~nIssuerCert=~p~n)",[?MODULE,?LINE,IssuerCert]), + case build_chain({public_key:pkix_encode('OTPCertificate', + IssuerCert, + otp), + IssuerCert}, IntermediateCerts, Certs, []) of + undefined -> + error; + {OTPCert, Path} -> + {ok, OTPCert, Path} + end + end. + +%% @doc Attempt to build authority chain back using intermediary +%% certificates, falling back on trusted certificates if the +%% intermediary chain of certificates does not fully extend to the +%% root. +%% +%% Returns: {RootCA :: #OTPCertificate{}, Chain :: [der_encoded()]} +%% +build_chain({DER, Cert}, IntCerts, TrustedCerts, Acc) -> + %% check if this cert is self-signed, if it is, we've reached the + %% root of the chain + Issuer = public_key:pkix_normalize_name( + Cert#'OTPCertificate'.tbsCertificate#'OTPTBSCertificate'.issuer), + Subject = public_key:pkix_normalize_name( + Cert#'OTPCertificate'.tbsCertificate#'OTPTBSCertificate'.subject), + case Issuer == Subject of + true -> + case find_issuer(Issuer, TrustedCerts) of + undefined -> + ct:log("~p:~p~nself-signed certificate is NOT trusted~n",[?MODULE,?LINE]), + undefined; + TrustedCert -> + %% return the cert from the trusted list, to prevent + %% issuer spoofing + {TrustedCert, + [public_key:pkix_encode( + 'OTPCertificate', TrustedCert, otp)|Acc]} + end; + false -> + Match = lists:foldl( + fun(C, undefined) -> + S = public_key:pkix_normalize_name(C#'OTPCertificate'.tbsCertificate#'OTPTBSCertificate'.subject), + %% compare the subject to the current issuer + case Issuer == S of + true -> + %% we've found our man + {public_key:pkix_encode('OTPCertificate', C, otp), C}; + false -> + undefined + end; + (_E, A) -> + %% already matched + A + end, undefined, IntCerts), + case Match of + undefined when IntCerts /= TrustedCerts -> + %% continue the chain by using the trusted CAs + ct:log("~p:~p~nRan out of intermediate certs, switching to trusted certs~n",[?MODULE,?LINE]), + build_chain({DER, Cert}, TrustedCerts, TrustedCerts, Acc); + undefined -> + ct:log("Can't construct chain of trust beyond ~p~n", + [?MODULE,?LINE, get_common_name(Cert)]), + %% can't find the current cert's issuer + undefined; + Match -> + build_chain(Match, IntCerts, TrustedCerts, [DER|Acc]) + end + end. + +%% @doc Given a certificate and a list of trusted or intermediary +%% certificates, attempt to find a match in the list or bail with +%% undefined. +find_issuer(Issuer, Certs) -> + lists:foldl( + fun(OTPCert, undefined) -> + %% check if this certificate matches the issuer + Normal = public_key:pkix_normalize_name( + OTPCert#'OTPCertificate'.tbsCertificate#'OTPTBSCertificate'.subject), + case Normal == Issuer of + true -> + OTPCert; + false -> + undefined + end; + (_E, Acc) -> + %% already found a match + Acc + end, undefined, Certs). + +%% @doc Find distribution points for a given CRL and then attempt to +%% fetch the CRL from the first available. +fetch_point(#'DistributionPoint'{distributionPoint={fullName, Names}}) -> + Decoded = [{NameType, + pubkey_cert_records:transform(Name, decode)} + || {NameType, Name} <- Names], + ct:log("~p:~p~ncall fetch(~nDecoded=~p~n)",[?MODULE,?LINE,Decoded]), + fetch(Decoded). + +%% @doc Given a list of locations to retrieve a CRL from, attempt to +%% retrieve either from a file or http resource and bail as soon as +%% it can be found. +%% +%% Currently, only hand a armored PEM or DER encoded file, with +%% defaulting to DER. +%% +fetch([]) -> + not_available; +fetch([{uniformResourceIdentifier, "http"++_=URL}|Rest]) -> + ct:log("~p:~p~ngetting CRL from ~p~n", [?MODULE,?LINE, URL]), + ct:log("~p:~p~nlisteners to port 8000:~n~p~n)",[?MODULE,?LINE,os:cmd("netstat -tln|grep ':8000'")]), + case httpc:request(get, {URL, []}, [], [{body_format, binary}]) of + {ok, {_Status, _Headers, Body}} -> + case Body of + <<"-----BEGIN", _/binary>> -> + ct:log("~p:~p~npublic_key:pem_decode,~nBody=~p~n)",[?MODULE,?LINE,Body]), + [{'CertificateList', + DER, _}=CertList] = public_key:pem_decode(Body), + ct:log("~p:~p~npublic_key:pem_entry_decode,~nCertList=~p~n)",[?MODULE,?LINE,CertList]), + {DER, public_key:pem_entry_decode(CertList)}; + _ -> + ct:log("~p:~p~npublic_key:pem_entry_decode,~nBody=~p~n)",[?MODULE,?LINE,{'CertificateList', Body, not_encrypted}]), + %% assume DER encoded + CertList = public_key:pem_entry_decode( + {'CertificateList', Body, not_encrypted}), + {Body, CertList} + end; + {error, _Reason} -> + ct:log("~p:~p~nfailed to get CRL ~p~n", [?MODULE,?LINE, _Reason]), + fetch(Rest); + Other -> + ct:log("~p:~p~nreally failed to get CRL ~p~n", [?MODULE,?LINE, Other]), + fetch(Rest) + end; +fetch([Loc|Rest]) -> + %% unsupported CRL location + ct:log("~p:~p~nunable to fetch CRL from unsupported location ~p~n", + [?MODULE,?LINE, Loc]), + fetch(Rest). + +%% get the common name attribute out of an OTPCertificate record +get_common_name(OTPCert) -> + %% You'd think there'd be an easier way than this giant mess, but I + %% couldn't find one. + {rdnSequence, Subject} = OTPCert#'OTPCertificate'.tbsCertificate#'OTPTBSCertificate'.subject, + case [Attribute#'AttributeTypeAndValue'.value || [Attribute] <- Subject, + Attribute#'AttributeTypeAndValue'.type == ?'id-at-commonName'] of + [Att] -> + case Att of + {teletexString, Str} -> Str; + {printableString, Str} -> Str; + {utf8String, Bin} -> binary_to_list(Bin) + end; + _ -> + unknown + end. + diff --git a/lib/ssl/test/ssl_handshake_SUITE.erl b/lib/ssl/test/ssl_handshake_SUITE.erl index 7e8e8d2611..6d020c472b 100644 --- a/lib/ssl/test/ssl_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_handshake_SUITE.erl @@ -34,6 +34,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [decode_hello_handshake, decode_single_hello_extension_correctly, + decode_supported_elliptic_curves_hello_extension_correctly, decode_unknown_hello_extension_correctly, encode_single_hello_sni_extension_correctly]. @@ -67,6 +68,17 @@ decode_single_hello_extension_correctly(_Config) -> #renegotiation_info{renegotiated_connection = <<0>>} = Extensions#hello_extensions.renegotiation_info. +decode_supported_elliptic_curves_hello_extension_correctly(_Config) -> + % List of supported and unsupported curves (RFC4492:S5.1.1) + ClientEllipticCurves = [0, tls_v1:oid_to_enum(?sect233k1), 37, tls_v1:oid_to_enum(?sect193r2), 16#badc], + % Construct extension binary - modified version of ssl_handshake:encode_hello_extensions([#elliptic_curves{}], _) + EllipticCurveList = << <<X:16>> || X <- ClientEllipticCurves>>, + ListLen = byte_size(EllipticCurveList), + Len = ListLen + 2, + Extension = <<?UINT16(?ELLIPTIC_CURVES_EXT), ?UINT16(Len), ?UINT16(ListLen), EllipticCurveList/binary>>, + % after decoding we should see only valid curves + #hello_extensions{elliptic_curves = DecodedCurves} = ssl_handshake:decode_hello_extensions(Extension), + #elliptic_curves{elliptic_curve_list = [?sect233k1, ?sect193r2]} = DecodedCurves. decode_unknown_hello_extension_correctly(_Config) -> FourByteUnknown = <<16#CA,16#FE, ?UINT16(4), 3, 0, 1, 2>>, diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 7ed9adfcd9..7d8ece8d19 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -60,7 +60,7 @@ run_server(Opts) -> Options = proplists:get_value(options, Opts), Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), - ct:log("ssl:listen(~p, ~p)~n", [Port, Options]), + ct:log("~p:~p~nssl:listen(~p, ~p)~n", [?MODULE,?LINE, Port, Options]), {ok, ListenSocket} = rpc:call(Node, Transport, listen, [Port, Options]), Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), @@ -78,13 +78,13 @@ do_run_server(ListenSocket, AcceptSocket, Opts) -> Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), {Module, Function, Args} = proplists:get_value(mfa, Opts), - ct:log("Server: apply(~p,~p,~p)~n", - [Module, Function, [AcceptSocket | Args]]), + ct:log("~p:~p~nServer: apply(~p,~p,~p)~n", + [?MODULE,?LINE, Module, Function, [AcceptSocket | Args]]), case rpc:call(Node, Module, Function, [AcceptSocket | Args]) of no_result_msg -> ok; Msg -> - ct:log("Server Msg: ~p ~n", [Msg]), + ct:log("~p:~p~nServer Msg: ~p ~n", [?MODULE,?LINE, Msg]), Pid ! {self(), Msg} end, receive @@ -93,10 +93,10 @@ do_run_server(ListenSocket, AcceptSocket, Opts) -> {listen, MFA} -> run_server(ListenSocket, [MFA | proplists:delete(mfa, Opts)]); close -> - ct:log("Server closing ~p ~n", [self()]), + ct:log("~p:~p~nServer closing ~p ~n", [?MODULE,?LINE, self()]), Result = rpc:call(Node, Transport, close, [AcceptSocket], 500), Result1 = rpc:call(Node, Transport, close, [ListenSocket], 500), - ct:log("Result ~p : ~p ~n", [Result, Result1]); + ct:log("~p:~p~nResult ~p : ~p ~n", [?MODULE,?LINE, Result, Result1]); {ssl_closed, _} -> ok end. @@ -116,7 +116,7 @@ connect(#sslsocket{} = ListenSocket, Opts) -> end; connect(ListenSocket, Opts) -> Node = proplists:get_value(node, Opts), - ct:log("gen_tcp:accept(~p)~n", [ListenSocket]), + ct:log("~p:~p~ngen_tcp:accept(~p)~n", [?MODULE,?LINE, ListenSocket]), {ok, AcceptSocket} = rpc:call(Node, gen_tcp, accept, [ListenSocket]), AcceptSocket. @@ -124,15 +124,17 @@ connect(ListenSocket, Opts) -> connect(_, _, 0, AcceptSocket, _) -> AcceptSocket; connect(ListenSocket, Node, N, _, Timeout) -> - ct:log("ssl:transport_accept(~p)~n", [ListenSocket]), + ct:log("~p:~p~nssl:transport_accept(~p)~n", [?MODULE,?LINE, ListenSocket]), {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept, [ListenSocket]), - ct:log("ssl:ssl_accept(~p, ~p)~n", [AcceptSocket, Timeout]), + ct:log("~p:~p~nssl:ssl_accept(~p, ~p)~n", [?MODULE,?LINE, AcceptSocket, Timeout]), case rpc:call(Node, ssl, ssl_accept, [AcceptSocket, Timeout]) of ok -> +ct:log("~p:~p~nok from ssl:ssl_accept@~p",[?MODULE,?LINE, Node]), connect(ListenSocket, Node, N-1, AcceptSocket, Timeout); Result -> +ct:log("~p:~p~nssl:ssl_accept@~p ret ~p",[?MODULE,?LINE, Node,Result]), Result end. @@ -148,11 +150,13 @@ remove_close_msg(ReconnectTimes) -> start_client(Args) -> Result = spawn_link(?MODULE, run_client_init, [lists:delete(return_socket, Args)]), receive - { connected, Socket } -> - case lists:member(return_socket, Args) of - true -> { Result, Socket }; - false -> Result - end + {connected, Socket} -> + case lists:member(return_socket, Args) of + true -> {Result, Socket}; + false -> Result + end; + {connect_failed, Reason} -> + {connect_failed, Reason} end. run_client_init(Opts) -> @@ -166,27 +170,30 @@ run_client(Opts) -> Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), Options = proplists:get_value(options, Opts), - ct:log("ssl:connect(~p, ~p, ~p)~n", [Host, Port, Options]), + ct:log("~p:~p~nssl:connect(~p, ~p, ~p)~n", [?MODULE,?LINE, Host, Port, Options]), +ct:log("~p:~p~nnet_adm:ping(~p)=~p",[?MODULE,?LINE, Node,net_adm:ping(Node)]), +%%ct:log("~p:~p~n~p:connect(~p, ~p, ~p)@~p~n", [?MODULE,?LINE, Transport, Host, Port, Options, Node]), +ct:log("~p:~p~n~p:connect(~p, ~p, ...)@~p~n", [?MODULE,?LINE, Transport, Host, Port, Node]), case rpc:call(Node, Transport, connect, [Host, Port, Options]) of {ok, Socket} -> - Pid ! { connected, Socket }, - ct:log("Client: connected~n", []), + Pid ! {connected, Socket}, + ct:log("~p:~p~nClient: connected~n", [?MODULE,?LINE]), %% In special cases we want to know the client port, it will %% be indicated by sending {port, 0} in options list! send_selected_port(Pid, proplists:get_value(port, Options), Socket), {Module, Function, Args} = proplists:get_value(mfa, Opts), - ct:log("Client: apply(~p,~p,~p)~n", - [Module, Function, [Socket | Args]]), + ct:log("~p:~p~nClient: apply(~p,~p,~p)~n", + [?MODULE,?LINE, Module, Function, [Socket | Args]]), case rpc:call(Node, Module, Function, [Socket | Args]) of no_result_msg -> ok; Msg -> - ct:log("Client Msg: ~p ~n", [Msg]), + ct:log("~p:~p~nClient Msg: ~p ~n", [?MODULE,?LINE, Msg]), Pid ! {self(), Msg} end, receive close -> - ct:log("Client closing~n", []), + ct:log("~p:~p~nClient closing~n", [?MODULE,?LINE]), rpc:call(Node, Transport, close, [Socket]); {ssl_closed, Socket} -> ok; @@ -196,50 +203,42 @@ run_client(Opts) -> {error, econnrefused = Reason} -> case get(retries) of N when N < 5 -> + ct:log("~p:~p~neconnrefused retries=~p sleep ~p",[?MODULE,?LINE, N,?SLEEP]), put(retries, N+1), ct:sleep(?SLEEP), run_client(Opts); _ -> - ct:log("Client faild several times: connection failed: ~p ~n", [Reason]), + ct:log("~p:~p~nClient faild several times: connection failed: ~p ~n", [?MODULE,?LINE, Reason]), Pid ! {self(), {error, Reason}} end; {error, Reason} -> - ct:log("Client: connection failed: ~p ~n", [Reason]), - Pid ! {self(), {error, Reason}} + ct:log("~p:~p~nClient: connection failed: ~p ~n", [?MODULE,?LINE, Reason]), + Pid ! {connect_failed, Reason}; + {badrpc,BadRPC} -> + ct:log("~p:~p~nBad rpc: ~p",[?MODULE,?LINE, BadRPC]), + Pid ! {connect_failed, {badrpc,BadRPC}} end. close(Pid) -> - ct:log("Close ~p ~n", [Pid]), + ct:log("~p:~p~nClose ~p ~n", [?MODULE,?LINE, Pid]), Monitor = erlang:monitor(process, Pid), Pid ! close, receive {'DOWN', Monitor, process, Pid, Reason} -> erlang:demonitor(Monitor), - ct:log("Pid: ~p down due to:~p ~n", [Pid, Reason]) + ct:log("~p:~p~nPid: ~p down due to:~p ~n", [?MODULE,?LINE, Pid, Reason]) end. check_result(Server, ServerMsg, Client, ClientMsg) -> receive - {Server, ServerMsg} -> - receive - {Client, ClientMsg} -> - ok; - Unexpected -> - Reason = {{expected, {Client, ClientMsg}}, - {got, Unexpected}}, - ct:fail(Reason) - end; - {Client, ClientMsg} -> - receive - {Server, ServerMsg} -> - ok; - Unexpected -> - Reason = {{expected, {Server, ClientMsg}}, - {got, Unexpected}}, - ct:fail(Reason) - end; + {Server, ServerMsg} -> + check_result(Client, ClientMsg); + + {Client, ClientMsg} -> + check_result(Server, ServerMsg); + {Port, {data,Debug}} when is_port(Port) -> - io:format("openssl ~s~n",[Debug]), + ct:log("~p:~p~nopenssl ~s~n",[?MODULE,?LINE, Debug]), check_result(Server, ServerMsg, Client, ClientMsg); Unexpected -> @@ -253,7 +252,7 @@ check_result(Pid, Msg) -> {Pid, Msg} -> ok; {Port, {data,Debug}} when is_port(Port) -> - io:format("openssl ~s~n",[Debug]), + ct:log("~p:~p~nopenssl ~s~n",[?MODULE,?LINE, Debug]), check_result(Pid,Msg); Unexpected -> Reason = {{expected, {Pid, Msg}}, @@ -278,7 +277,7 @@ wait_for_result(Server, ServerMsg, Client, ClientMsg) -> %% Unexpected end; {Port, {data,Debug}} when is_port(Port) -> - io:format("openssl ~s~n",[Debug]), + ct:log("~p:~p~nopenssl ~s~n",[?MODULE,?LINE, Debug]), wait_for_result(Server, ServerMsg, Client, ClientMsg) %% Unexpected -> %% Unexpected @@ -290,7 +289,7 @@ wait_for_result(Pid, Msg) -> {Pid, Msg} -> ok; {Port, {data,Debug}} when is_port(Port) -> - io:format("openssl ~s~n",[Debug]), + ct:log("~p:~p~nopenssl ~s~n",[?MODULE,?LINE, Debug]), wait_for_result(Pid,Msg) %% Unexpected -> %% Unexpected @@ -515,33 +514,33 @@ run_upgrade_server(Opts) -> SslOptions = proplists:get_value(ssl_options, Opts), Pid = proplists:get_value(from, Opts), - ct:log("gen_tcp:listen(~p, ~p)~n", [Port, TcpOptions]), + ct:log("~p:~p~ngen_tcp:listen(~p, ~p)~n", [?MODULE,?LINE, Port, TcpOptions]), {ok, ListenSocket} = rpc:call(Node, gen_tcp, listen, [Port, TcpOptions]), Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), - ct:log("gen_tcp:accept(~p)~n", [ListenSocket]), + ct:log("~p:~p~ngen_tcp:accept(~p)~n", [?MODULE,?LINE, ListenSocket]), {ok, AcceptSocket} = rpc:call(Node, gen_tcp, accept, [ListenSocket]), try {ok, SslAcceptSocket} = case TimeOut of infinity -> - ct:log("ssl:ssl_accept(~p, ~p)~n", - [AcceptSocket, SslOptions]), + ct:log("~p:~p~nssl:ssl_accept(~p, ~p)~n", + [?MODULE,?LINE, AcceptSocket, SslOptions]), rpc:call(Node, ssl, ssl_accept, [AcceptSocket, SslOptions]); _ -> - ct:log("ssl:ssl_accept(~p, ~p, ~p)~n", - [AcceptSocket, SslOptions, TimeOut]), + ct:log("~p:~p~nssl:ssl_accept(~p, ~p, ~p)~n", + [?MODULE,?LINE, AcceptSocket, SslOptions, TimeOut]), rpc:call(Node, ssl, ssl_accept, [AcceptSocket, SslOptions, TimeOut]) end, {Module, Function, Args} = proplists:get_value(mfa, Opts), Msg = rpc:call(Node, Module, Function, [SslAcceptSocket | Args]), - ct:log("Upgrade Server Msg: ~p ~n", [Msg]), + ct:log("~p:~p~nUpgrade Server Msg: ~p ~n", [?MODULE,?LINE, Msg]), Pid ! {self(), Msg}, receive close -> - ct:log("Upgrade Server closing~n", []), + ct:log("~p:~p~nUpgrade Server closing~n", [?MODULE,?LINE]), rpc:call(Node, ssl, close, [SslAcceptSocket]) end catch error:{badmatch, Error} -> @@ -559,24 +558,24 @@ run_upgrade_client(Opts) -> TcpOptions = proplists:get_value(tcp_options, Opts), SslOptions = proplists:get_value(ssl_options, Opts), - ct:log("gen_tcp:connect(~p, ~p, ~p)~n", - [Host, Port, TcpOptions]), + ct:log("~p:~p~ngen_tcp:connect(~p, ~p, ~p)~n", + [?MODULE,?LINE, Host, Port, TcpOptions]), {ok, Socket} = rpc:call(Node, gen_tcp, connect, [Host, Port, TcpOptions]), send_selected_port(Pid, Port, Socket), - ct:log("ssl:connect(~p, ~p)~n", [Socket, SslOptions]), + ct:log("~p:~p~nssl:connect(~p, ~p)~n", [?MODULE,?LINE, Socket, SslOptions]), {ok, SslSocket} = rpc:call(Node, ssl, connect, [Socket, SslOptions]), {Module, Function, Args} = proplists:get_value(mfa, Opts), - ct:log("apply(~p, ~p, ~p)~n", - [Module, Function, [SslSocket | Args]]), + ct:log("~p:~p~napply(~p, ~p, ~p)~n", + [?MODULE,?LINE, Module, Function, [SslSocket | Args]]), Msg = rpc:call(Node, Module, Function, [SslSocket | Args]), - ct:log("Upgrade Client Msg: ~p ~n", [Msg]), + ct:log("~p:~p~nUpgrade Client Msg: ~p ~n", [?MODULE,?LINE, Msg]), Pid ! {self(), Msg}, receive close -> - ct:log("Upgrade Client closing~n", []), + ct:log("~p:~p~nUpgrade Client closing~n", [?MODULE,?LINE]), rpc:call(Node, ssl, close, [SslSocket]) end. @@ -595,21 +594,21 @@ run_upgrade_server_error(Opts) -> SslOptions = proplists:get_value(ssl_options, Opts), Pid = proplists:get_value(from, Opts), - ct:log("gen_tcp:listen(~p, ~p)~n", [Port, TcpOptions]), + ct:log("~p:~p~ngen_tcp:listen(~p, ~p)~n", [?MODULE,?LINE, Port, TcpOptions]), {ok, ListenSocket} = rpc:call(Node, gen_tcp, listen, [Port, TcpOptions]), Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), - ct:log("gen_tcp:accept(~p)~n", [ListenSocket]), + ct:log("~p:~p~ngen_tcp:accept(~p)~n", [?MODULE,?LINE, ListenSocket]), {ok, AcceptSocket} = rpc:call(Node, gen_tcp, accept, [ListenSocket]), Error = case TimeOut of infinity -> - ct:log("ssl:ssl_accept(~p, ~p)~n", - [AcceptSocket, SslOptions]), + ct:log("~p:~p~nssl:ssl_accept(~p, ~p)~n", + [?MODULE,?LINE, AcceptSocket, SslOptions]), rpc:call(Node, ssl, ssl_accept, [AcceptSocket, SslOptions]); _ -> - ct:log("ssl:ssl_accept(~p, ~p, ~p)~n", - [AcceptSocket, SslOptions, TimeOut]), + ct:log("~p:~p~nssl:ssl_accept(~p, ~p, ~p)~n", + [?MODULE,?LINE, AcceptSocket, SslOptions, TimeOut]), rpc:call(Node, ssl, ssl_accept, [AcceptSocket, SslOptions, TimeOut]) end, @@ -628,26 +627,26 @@ run_server_error(Opts) -> Options = proplists:get_value(options, Opts), Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), - ct:log("ssl:listen(~p, ~p)~n", [Port, Options]), + ct:log("~p:~p~nssl:listen(~p, ~p)~n", [?MODULE,?LINE, Port, Options]), case rpc:call(Node, Transport, listen, [Port, Options]) of {ok, #sslsocket{} = ListenSocket} -> %% To make sure error_client will %% get {error, closed} and not {error, connection_refused} Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), - ct:log("ssl:transport_accept(~p)~n", [ListenSocket]), + ct:log("~p:~p~nssl:transport_accept(~p)~n", [?MODULE,?LINE, ListenSocket]), case rpc:call(Node, Transport, transport_accept, [ListenSocket]) of {error, _} = Error -> Pid ! {self(), Error}; {ok, AcceptSocket} -> - ct:log("ssl:ssl_accept(~p)~n", [AcceptSocket]), + ct:log("~p:~p~nssl:ssl_accept(~p)~n", [?MODULE,?LINE, AcceptSocket]), Error = rpc:call(Node, ssl, ssl_accept, [AcceptSocket]), Pid ! {self(), Error} end; {ok, ListenSocket} -> Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), - ct:log("~p:accept(~p)~n", [Transport, ListenSocket]), + ct:log("~p:~p~n~p:accept(~p)~n", [?MODULE,?LINE, Transport, ListenSocket]), case rpc:call(Node, Transport, accept, [ListenSocket]) of {error, _} = Error -> Pid ! {self(), Error} @@ -669,7 +668,7 @@ run_client_error(Opts) -> Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), Options = proplists:get_value(options, Opts), - ct:log("ssl:connect(~p, ~p, ~p)~n", [Host, Port, Options]), + ct:log("~p:~p~nssl:connect(~p, ~p, ~p)~n", [?MODULE,?LINE, Host, Port, Options]), Error = rpc:call(Node, Transport, connect, [Host, Port, Options]), Pid ! {self(), Error}. @@ -892,7 +891,7 @@ der_to_pem(File, Entries) -> cipher_result(Socket, Result) -> Result = ssl:connection_info(Socket), - ct:log("Successfull connect: ~p~n", [Result]), + ct:log("~p:~p~nSuccessfull connect: ~p~n", [?MODULE,?LINE, Result]), %% Importante to send two packets here %% to properly test "cipher state" handling ssl:send(Socket, "Hello\n"), @@ -1061,10 +1060,13 @@ check_sane_openssl_version(Version) -> true end. +enough_openssl_crl_support("OpenSSL 0." ++ _) -> false; +enough_openssl_crl_support(_) -> true. + wait_for_openssl_server() -> receive {Port, {data, Debug}} when is_port(Port) -> - ct:log("openssl ~s~n",[Debug]), + ct:log("~p:~p~nopenssl ~s~n",[?MODULE,?LINE, Debug]), %% openssl has started make sure %% it will be in accept. Parsing %% output is too error prone. (Even diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index a6e0efed25..e08f5dff78 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 5.3.3 +SSL_VSN = 5.3.4 diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile index 6f1e61e70c..ff77c3eea0 100644 --- a/lib/stdlib/doc/src/Makefile +++ b/lib/stdlib/doc/src/Makefile @@ -71,6 +71,7 @@ XML_REF3_FILES = \ lib.xml \ lists.xml \ log_mf_h.xml \ + maps.xml \ math.xml \ ms_transform.xml \ orddict.xml \ diff --git a/lib/stdlib/doc/src/epp.xml b/lib/stdlib/doc/src/epp.xml index cf33530395..452341f7d2 100644 --- a/lib/stdlib/doc/src/epp.xml +++ b/lib/stdlib/doc/src/epp.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -46,8 +46,10 @@ valid encodings are <c>Latin-1</c> and <c>UTF-8</c> where the case of the characters can be chosen freely. Examples:</p> <pre> -%% coding: utf-8 -%% For this file we have chosen encoding = Latin-1 +%% coding: utf-8</pre> + <pre> +%% For this file we have chosen encoding = Latin-1</pre> + <pre> %% -*- coding: latin-1 -*-</pre> </description> <datatypes> @@ -64,11 +66,29 @@ </datatypes> <funcs> <func> + <name name="open" arity="1"/> + <fsummary>Open a file for preprocessing</fsummary> + <desc> + <p>Opens a file for preprocessing.</p> + <p>If <c>extra</c> is given in + <c><anno>Options</anno></c>, the return value will be + <c>{ok, <anno>Epp</anno>, <anno>Extra</anno>}</c> instead + of <c>{ok, <anno>Epp</anno>}</c>.</p> + </desc> + </func> + <func> <name name="open" arity="2"/> + <fsummary>Open a file for preprocessing</fsummary> + <desc> + <p>Equivalent to <c>epp:open([{name, FileName}, {includes, IncludePath}])</c>.</p> + </desc> + </func> + <func> <name name="open" arity="3"/> <fsummary>Open a file for preprocessing</fsummary> <desc> - <p>Opens a file for preprocessing.</p> + <p>Equivalent to <c>epp:open([{name, FileName}, {includes, IncludePath}, + {macros, PredefMacros}])</c>.</p> </desc> </func> <func> @@ -89,12 +109,24 @@ </desc> </func> <func> - <name name="parse_file" arity="3"/> + <name name="parse_file" arity="2"/> <fsummary>Preprocess and parse an Erlang source file</fsummary> <desc> <p>Preprocesses and parses an Erlang source file. - Note that the tuple <c>{eof, <anno>Line</anno>}</c> returned at end-of-file is - included as a "form".</p> + Note that the tuple <c>{eof, <anno>Line</anno>}</c> returned + at end-of-file is included as a "form".</p> + <p>If <c>extra</c> is given in + <c><anno>Options</anno></c>, the return value will be + <c>{ok, [<anno>Form</anno>], <anno>Extra</anno>}</c> instead + of <c>{ok, [<anno>Form</anno>]}</c>.</p> + </desc> + </func> + <func> + <name name="parse_file" arity="3"/> + <fsummary>Preprocess and parse an Erlang source file</fsummary> + <desc> + <p>Equivalent to <c>epp:parse_file(FileName, [{includes, IncludePath}, + {macros, PredefMacros}])</c>.</p> </desc> </func> <func> @@ -111,7 +143,7 @@ <p>Returns a string representation of an encoding. The string is recognized by <c>read_encoding/1,2</c>, <c>read_encoding_from_binary/1,2</c>, and - <c>set_encoding/1</c> as a valid encoding.</p> + <c>set_encoding/1,2</c> as a valid encoding.</p> </desc> </func> <func> @@ -157,6 +189,22 @@ </desc> </func> <func> + <name name="set_encoding" arity="2"/> + <fsummary>Read and set the encoding of an IO device</fsummary> + <desc> + <p>Reads the <seealso marker="#encoding">encoding</seealso> from + an IO device and sets the encoding of the device + accordingly. The position of the IO device referenced by + <c><anno>File</anno></c> is not affected. If no valid + encoding can be read from the IO device the encoding of the + IO device is set to the + <seealso marker="#encoding">encoding</seealso> given by + <c><anno>Default</anno></c>.</p> + <p>Returns the read encoding, or <c>none</c> if no valid + encoding was found.</p> + </desc> + </func> + <func> <name name="format_error" arity="1"/> <fsummary>Format an error descriptor</fsummary> <desc> diff --git a/lib/stdlib/doc/src/erl_parse.xml b/lib/stdlib/doc/src/erl_parse.xml index 2d5aff3c6c..cf0bff48cd 100644 --- a/lib/stdlib/doc/src/erl_parse.xml +++ b/lib/stdlib/doc/src/erl_parse.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -173,6 +173,7 @@ </func> <func> <name name="abstract" arity="2"/> + <type name="encoding_func"/> <fsummary>Convert an Erlang term into an abstract form</fsummary> <desc> <p>Converts the Erlang data structure <c><anno>Data</anno></c> into an @@ -183,7 +184,12 @@ selecting which integer lists will be considered as strings. The default is to use the encoding returned by <seealso marker="epp#default_encoding/0"> - <c>epp:default_encoding/0</c></seealso></p> + <c>epp:default_encoding/0</c></seealso>. + The value <c>none</c> means that no integer lists will be + considered as strings. The <c>encoding_func()</c> will be + called with one integer of a list at a time, and if it + returns <c>true</c> for every integer the list will be + considered a string.</p> </desc> </func> </funcs> diff --git a/lib/stdlib/doc/src/maps.xml b/lib/stdlib/doc/src/maps.xml new file mode 100644 index 0000000000..76137e3dee --- /dev/null +++ b/lib/stdlib/doc/src/maps.xml @@ -0,0 +1,318 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2013</year><year>2014</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + 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. + </legalnotice> + <title>maps</title> + <prepared>Björn-Egil Dahlberg</prepared> + <docno>1</docno> + <date>2014-02-28</date> + <rev>A</rev> + </header> + <module>maps</module> + <modulesummary>Maps Processing Functions</modulesummary> + <description> + <p>This module contains functions for maps processing.</p> + </description> + <funcs> + + <func> + <name name="find" arity="2"/> + <fsummary></fsummary> + <desc> + <p> + Returns a tuple <c>{ok, Value}</c> where <c><anno>Value</anno></c> is the value associated with <c><anno>Key</anno></c>, + or <c>error</c> if no value is associated with <c><anno>Key</anno></c> in <c><anno>Map</anno></c>. + </p> + <p>Example:</p> + <code type="none"> +> Map = #{"hi" => 42}, + Key = "hi", + maps:find(Key,Map). +{ok,42} </code> + </desc> + </func> + + <func> + <name name="fold" arity="3"/> + <fsummary></fsummary> + <desc> + <p> + Calls <c>F(K, V, AccIn)</c> for every <c><anno>K</anno></c> to value <c><anno>V</anno></c> + association in <c><anno>Map</anno></c> in + arbitrary order. The function <c>fun F/3</c> must return a new accumulator + which is passed to the next successive call. <c>maps:fold/3</c> returns the final + value of the accumulator. The initial accumulator value <c><anno>Init</anno></c> is returned if + the map is empty. + </p> + <p>Example:</p> + <code type="none"> +> Fun = fun(K,V,AccIn) when is_list(K) -> AccIn + V end, + Map = #{"k1" => 1, "k2" => 2, "k3" => 3}, + maps:fold(Fun,0,Map). +6</code> + </desc> + </func> + + <func> + <name name="from_list" arity="1"/> + <fsummary></fsummary> + <desc> + <p> + The function takes a list of key-value tuples elements and builds a + map. The associations may be in any order and both keys and values in the + association may be of any term. If the same key appears more than once, + the latter (rightmost) value is used and the previous values are ignored. + </p> + <p>Example:</p> + <code type="none"> +> List = [{"a",ignored},{1337,"value two"},{42,value_three},{"a",1}], + maps:from_list(List). +#{42 => value_three,1337 => "value two","a" => 1}</code> + </desc> + </func> + + <func> + <name name="get" arity="2"/> + <fsummary></fsummary> + <desc> + <p> + Returns the value <c><anno>Value</anno></c> associated with <c><anno>Key</anno></c> if + <c><anno>Map</anno></c> contains <c><anno>Key</anno></c>. + If no value is associated with <c><anno>Key</anno></c> then the call will + fail with an exception. + </p> + <p>Example:</p> + <code type="none"> +> Key = 1337, + Map = #{42 => value_two,1337 => "value one","a" => 1}, + maps:get(Key,Map). +"value one"</code> + </desc> + </func> + + <func> + <name name="is_key" arity="2"/> + <fsummary></fsummary> + <desc> + <p> + Returns <c>true</c> if map <c><anno>Map</anno></c> contains <c><anno>Key</anno></c> and returns + <c>false</c> if it does not contain the <c><anno>Key</anno></c>. + The function will fail with an exception if <c><anno>Map</anno></c> is not a Map. + </p> + <p>Example:</p> + <code type="none"> +> Map = #{"42" => value}. +#{"42"> => value} +> maps:is_key("42",Map). +true +> maps:is_key(value,Map). +false</code> + </desc> + </func> + + <func> + <name name="keys" arity="1"/> + <fsummary></fsummary> + <desc> + <p> + Returns a complete list of keys, in arbitrary order, which resides within <c><anno>Map</anno></c>. + </p> + <p>Example:</p> + <code type="none"> +> Map = #{42 => value_three,1337 => "value two","a" => 1}, + maps:keys(Map). +[42,1337,"a"]</code> + </desc> + </func> + + <func> + <name name="map" arity="2"/> + <fsummary></fsummary> + <desc> + <p> + The function produces a new map <c><anno>Map2</anno></c> by calling the function <c>fun F(K, V1)</c> for + every <c><anno>K</anno></c> to value <c><anno>V1</anno></c> association in <c><anno>Map1</anno></c> in arbitrary order. + The function <c>fun F/2</c> must return the value <c><anno>V2</anno></c> to be associated with key <c><anno>K</anno></c> for + the new map <c><anno>Map2</anno></c>. + </p> + <p>Example:</p> + <code type="none"> +> Fun = fun(K,V1) when is_list(K) -> V1*2 end, + Map = #{"k1" => 1, "k2" => 2, "k3" => 3}, + maps:map(Fun,Map). +#{"k1" => 2,"k2" => 4,"k3" => 6}</code> + </desc> + </func> + + <func> + <name name="merge" arity="2"/> + <fsummary></fsummary> + <desc> + <p> + Merges two maps into a single map <c><anno>Map3</anno></c>. If two keys exists in both maps the + value in <c><anno>Map1</anno></c> will be superseded by the value in <c><anno>Map2</anno></c>. + </p> + <p>Example:</p> + <code type="none"> +> Map1 = #{a => "value_one", b => "value_two"}, + Map2 = #{a => 1, c => 2}, + maps:merge(Map1,Map2). +#{a => 1,b => "value_two",c => 2}</code> + </desc> + </func> + + <func> + <name name="new" arity="0"/> + <fsummary></fsummary> + <desc> + <p> + Returns a new empty map. + </p> + <p>Example:</p> + <code type="none"> +> maps:new(). +#{}</code> + </desc> + </func> + + <func> + <name name="put" arity="3"/> + <fsummary></fsummary> + <desc> + <p> + Associates <c><anno>Key</anno></c> with value <c><anno>Value</anno></c> and inserts the association into map <c>Map2</c>. + If key <c><anno>Key</anno></c> already exists in map <c><anno>Map1</anno></c>, the old associated value is + replaced by value <c><anno>Value</anno></c>. The function returns a new map <c><anno>Map2</anno></c> containing the new association and + the old associations in <c><anno>Map1</anno></c>. + </p> + <p>Example:</p> + <code type="none"> +> Map = #{"a" => 1}. +#{"a" => 1} +> maps:put("a", 42, Map). +#{"a" => 42} +> maps:put("b", 1337, Map). +#{"a" => 1,"b" => 1337}</code> + </desc> + </func> + + <func> + <name name="remove" arity="2"/> + <fsummary></fsummary> + <desc> + <p> + The function removes the <c><anno>Key</anno></c>, if it exists, and its associated value from + <c><anno>Map1</anno></c> and returns a new map <c><anno>Map2</anno></c> without key <c><anno>Key</anno></c>. + </p> + <p>Example:</p> + <code type="none"> +> Map = #{"a" => 1}. +#{"a" => 1} +> maps:remove("a",Map). +#{} +> maps:remove("b",Map). +#{"a" => 1}</code> + </desc> + </func> + + <func> + <name name="size" arity="1"/> + <fsummary></fsummary> + <desc> + <p> + The function returns the number of key-value associations in the <c><anno>Map</anno></c>. + This operation happens in constant time. + </p> + <p>Example:</p> + <code type="none"> +> Map = #{42 => value_two,1337 => "value one","a" => 1}, + maps:size(Map). +3</code> + </desc> + </func> + + <func> + <name name="to_list" arity="1"/> + <fsummary></fsummary> + <desc> + <p> + The fuction returns a list of pairs representing the key-value associations of <c><anno>Map</anno></c>, + where the pairs, <c>[{K1,V1}, ..., {Kn,Vn}]</c>, are returned in arbitrary order. + </p> + <p>Example:</p> + <code type="none"> +> Map = #{42 => value_three,1337 => "value two","a" => 1}, + maps:to_list(Map). +[{42,value_three},{1337,"value two"},{"a",1}]</code> + </desc> + </func> + + <func> + <name name="update" arity="3"/> + <fsummary></fsummary> + <desc> + <p> + If <c><anno>Key</anno></c> exists in <c><anno>Map1</anno></c> the old associated value is + replaced by value <c><anno>Value</anno></c>. The function returns a new map <c><anno>Map2</anno></c> containing + the new associated value. If <c><anno>Key</anno></c> does not exist in <c><anno>Map1</anno></c> an exception is + generated. + </p> + <p>Example:</p> + <code type="none"> +> Map = #{"a" => 1}. +#{"a" => 1} +> maps:update("a", 42, Map). +#{"a" => 42}</code> + </desc> + </func> + + <func> + <name name="values" arity="1"/> + <fsummary></fsummary> + <desc> + <p> + Returns a complete list of values, in arbitrary order, contained in map <c>M</c>. + </p> + <p>Example:</p> + <code type="none"> +> Map = #{42 => value_three,1337 => "value two","a" => 1}, + maps:values(Map). +[value_three,"value two",1]</code> + </desc> + </func> + + <func> + <name name="without" arity="2"/> + <fsummary></fsummary> + <desc> + <p> + Returns a new map <c><anno>Map2</anno></c> without the keys <c>K1</c> through <c>Kn</c> and their associated values from map <c><anno>Map1</anno></c>. + Any key in <c><anno>Ks</anno></c> that does not exist in <c><anno>Map1</anno></c> are ignored. + </p> + <p>Example:</p> + <code type="none"> +> Map = #{42 => value_three,1337 => "value two","a" => 1}, + Ks = ["a",42,"other key"], + maps:without(Ks,Map). +#{1337 => "value two"}</code> + </desc> + </func> + </funcs> +</erlref> diff --git a/lib/stdlib/doc/src/ref_man.xml b/lib/stdlib/doc/src/ref_man.xml index 4ecd02a4bf..6c35578bdf 100644 --- a/lib/stdlib/doc/src/ref_man.xml +++ b/lib/stdlib/doc/src/ref_man.xml @@ -68,6 +68,7 @@ <xi:include href="lib.xml"/> <xi:include href="lists.xml"/> <xi:include href="log_mf_h.xml"/> + <xi:include href="maps.xml"/> <xi:include href="math.xml"/> <xi:include href="ms_transform.xml"/> <xi:include href="orddict.xml"/> diff --git a/lib/stdlib/doc/src/specs.xml b/lib/stdlib/doc/src/specs.xml index 213ce7563f..60a04ed5e7 100644 --- a/lib/stdlib/doc/src/specs.xml +++ b/lib/stdlib/doc/src/specs.xml @@ -34,6 +34,7 @@ <xi:include href="../specs/specs_lib.xml"/> <xi:include href="../specs/specs_lists.xml"/> <xi:include href="../specs/specs_log_mf_h.xml"/> + <xi:include href="../specs/specs_maps.xml"/> <xi:include href="../specs/specs_math.xml"/> <xi:include href="../specs/specs_ms_transform.xml"/> <xi:include href="../specs/specs_orddict.xml"/> diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index 8197684d2d..3a5027d595 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -262,12 +262,12 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} locally as <c>Name</c> using <c>register/2</c>. If <c><anno>SupName</anno>={global,Name}</c> the supervisor is registered globally as <c>Name</c> using <c>global:register_name/2</c>. If - <c><anno>SupName</anno>={via,Module,Name}</c> the supervisor + <c><anno>SupName</anno>={via,<anno>Module</anno>,<anno>Name</anno>}</c> the supervisor is registered as <c>Name</c> using the registry represented by <c>Module</c>. The <c>Module</c> callback should export the functions <c>register_name/2</c>, <c>unregister_name/1</c> and <c>send/2</c>, which should behave like the corresponding functions in <c>global</c>. - Thus, <c>{via,global,Name}</c> is a valid reference.</p> + Thus, <c>{via,global,<anno>Name</anno>}</c> is a valid reference.</p> <p>If no name is provided, the supervisor is not registered.</p> <p><c><anno>Module</anno></c> is the name of the callback module.</p> <p><c><anno>Args</anno></c> is an arbitrary term which is passed as diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml index ab8b380f49..a46fa1289f 100644 --- a/lib/stdlib/doc/src/sys.xml +++ b/lib/stdlib/doc/src/sys.xml @@ -246,6 +246,22 @@ <c>{Module, Id, HandlerState}</c>, where <c>Module</c> is the event handler's module name, <c>Id</c> is the handler's ID (which is the value <c>false</c> if it was registered without an ID), and <c>HandlerState</c> is the handler's state.</p> + <p>If the callback module exports a <c>system_get_state/1</c> function, it will be called in the + target process to get its state. Its argument is the same as the <c>Misc</c> value returned by + <seealso marker="#get_status-1">get_status/1,2</seealso>, and the <c>system_get_state/1</c> + function is expected to extract the callback module's state from it. The <c>system_get_state/1</c> + function must return <c>{ok, State}</c> where <c>State</c> is the callback module's state.</p> + <p>If the callback module does not export a <c>system_get_state/1</c> function, <c>get_state/1,2</c> + assumes the <c>Misc</c> value is the callback module's state and returns it directly instead.</p> + <p>If the callback module's <c>system_get_state/1</c> function crashes or throws an exception, the + caller exits with error <c>{callback_failed, {Module, system_get_state}, {Class, Reason}}</c> where + <c>Module</c> is the name of the callback module and <c>Class</c> and <c>Reason</c> indicate + details of the exception.</p> + <p>The <c>system_get_state/1</c> function is primarily useful for user-defined + behaviours and modules that implement OTP <seealso marker="#special_process">special + processes</seealso>. The <c>gen_server</c>, <c>gen_fsm</c>, and <c>gen_event</c> OTP + behaviour modules export this function, and so callback modules for those behaviours + need not supply their own.</p> <p>To obtain more information about a process, including its state, see <seealso marker="#get_status-1">get_status/1</seealso> and <seealso marker="#get_status-2">get_status/2</seealso>.</p> @@ -289,6 +305,28 @@ function means that only the state of the particular event handler it was working on when it failed or crashed is unchanged; it can still succeed in changing the states of other event handlers registered in the same <c>gen_event</c> process.</p> + <p>If the callback module exports a <c>system_replace_state/2</c> function, it will be called in the + target process to replace its state using <c>StateFun</c>. Its two arguments are <c>StateFun</c> + and <c>Misc</c>, where <c>Misc</c> is the same as the <c>Misc</c> value returned by + <seealso marker="#get_status-1">get_status/1,2</seealso>. A <c>system_replace_state/2</c> function + is expected to return <c>{ok, NewState, NewMisc}</c> where <c>NewState</c> is the callback module's + new state obtained by calling <c>StateFun</c>, and <c>NewMisc</c> is a possibly new value used to + replace the original <c>Misc</c> (required since <c>Misc</c> often contains the callback + module's state within it).</p> + <p>If the callback module does not export a <c>system_replace_state/2</c> function, + <c>replace_state/2,3</c> assumes the <c>Misc</c> value is the callback module's state, passes it + to <c>StateFun</c> and uses the return value as both the new state and as the new value of + <c>Misc</c>.</p> + <p>If the callback module's <c>system_replace_state/2</c> function crashes or throws an exception, + the caller exits with error <c>{callback_failed, {Module, system_replace_state}, {Class, Reason}}</c> + where <c>Module</c> is the name of the callback module and <c>Class</c> and <c>Reason</c> indicate details + of the exception. If the callback module does not provide a <c>system_replace_state/2</c> function and + <c>StateFun</c> crashes or throws an exception, the caller exits with error + <c>{callback_failed, StateFun, {Class, Reason}}</c>.</p> + <p>The <c>system_replace_state/2</c> function is primarily useful for user-defined behaviours and + modules that implement OTP <seealso marker="#special_process">special processes</seealso>. The + <c>gen_server</c>, <c>gen_fsm</c>, and <c>gen_event</c> OTP behaviour modules export this function, + and so callback modules for those behaviours need not supply their own.</p> </desc> </func> <func> @@ -322,7 +360,7 @@ <section> <title>Process Implementation Functions</title> - <p>The following functions are used when implementing a + <p><marker id="special_process"/>The following functions are used when implementing a special process. This is an ordinary process which does not use a standard behaviour, but a process which understands the standard system messages.</p> </section> @@ -375,8 +413,9 @@ process continues the execution, or <c><anno>Module</anno>:system_terminate(Reason, <anno>Parent</anno>, <anno>Debug</anno>, <anno>Misc</anno>)</c> if the process should terminate. The <c><anno>Module</anno></c> must export - <c>system_continue/3</c>, <c>system_terminate/4</c>, and - <c>system_code_change/4</c> (see below). + <c>system_continue/3</c>, <c>system_terminate/4</c>, + <c>system_code_change/4</c>, <c>system_get_state/1</c> and + <c>system_replace_state/2</c> (see below). </p> <p>The <c><anno>Misc</anno></c> argument can be used to save internal data in a process, for example its state. It is sent to @@ -444,6 +483,34 @@ defined, the atom <c>undefined</c> is sent.</p> </desc> </func> + <func> + <name>Mod:system_get_state(Misc) -> {ok, State}</name> + <fsummary>Called when the process should return its current state</fsummary> + <type> + <v>Misc = term()</v> + <v>State = term()</v> + </type> + <desc> + <p>This function is called from <c>sys:handle_system_msg/6</c> when the process + should return a term that reflects its current state. <c>State</c> is the + value returned by <c>sys:get_state/2</c>.</p> + </desc> + </func> + <func> + <name>Mod:system_replace_state(StateFun, Misc) -> {ok, NState, NMisc}</name> + <fsummary>Called when the process should replace its current state</fsummary> + <type> + <v>StateFun = fun((State :: term()) -> NState)</v> + <v>Misc = term()</v> + <v>NState = term()</v> + <v>NMisc = term()</v> + </type> + <desc> + <p>This function is called from <c>sys:handle_system_msg/6</c> when the process + should replace its current state. <c>NState</c> is the value returned by + <c>sys:replace_state/3</c>.</p> + </desc> + </func> </funcs> </erlref> diff --git a/lib/stdlib/doc/src/unicode_usage.xml b/lib/stdlib/doc/src/unicode_usage.xml index 75505d7d84..bebfbd4514 100644 --- a/lib/stdlib/doc/src/unicode_usage.xml +++ b/lib/stdlib/doc/src/unicode_usage.xml @@ -848,6 +848,7 @@ Eshell V5.10.1 (abort with ^G) </section> <section> <title>Unicode in Environment and Parameters</title> + <marker id="unicode_in_environment_and_parameters"/> <p>Environment variables and their interpretation is handled much in the same way as file names. If Unicode file names are enabled, environment variables as well as parameters to the Erlang VM are @@ -996,7 +997,8 @@ ok </pre> </section> <section> - <title><marker id="unicode_options_summary"/>Summary of Options</title> + <title>Summary of Options</title> + <marker id="unicode_options_summary"/> <p>The Unicode support is controlled by both command line switches, some standard environment variables and the version of OTP you are using. Most options affect mainly the way Unicode data is displayed, diff --git a/lib/stdlib/doc/src/zip.xml b/lib/stdlib/doc/src/zip.xml index 66c21da193..48b376743d 100644 --- a/lib/stdlib/doc/src/zip.xml +++ b/lib/stdlib/doc/src/zip.xml @@ -123,6 +123,18 @@ </taglist> </desc> </datatype> + <datatype> + <name name="filename"/> + <p>The name of a zip file.</p> + </datatype> + <datatype><name name="extension"/></datatype> + <datatype><name name="extension_spec"/></datatype> + <datatype> + <name name="create_option"/> + <desc> + <p>These options are described in <seealso marker="#zip_options">create/3</seealso>.</p> + </desc> + </datatype> </datatypes> <funcs> <func> @@ -160,6 +172,7 @@ set to <c>["gif", "jpg"]</c> and <c>uncompress</c> is set to <c>["jpg"]</c>, only files with <c>"gif"</c> as extension will be compressed. No other files will be compressed.</p> + <marker id="zip_options"></marker> <p>The following options are available:</p> <taglist> <tag><c>cooked</c></tag> diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index 44dad04f43..c32da1624f 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -1785,6 +1785,7 @@ read_file_header(FileName, Access, RamFile) -> Version =:= 9 -> dets_v9:read_file_header(Fd, FileName); true -> + _ = file:close(Fd), throw({error, {not_a_dets_file, FileName}}) end. @@ -2113,6 +2114,8 @@ test_bchunk_format(Head, Term) -> do_open_file([Fname, Verbose], Parent, Server, Ref) -> case catch fopen2(Fname, Ref) of + {error, {tooshort, _}} -> + err({error, {not_a_dets_file, Fname}}); {error, _Reason} = Error -> err(Error); {ok, Head} -> @@ -2126,11 +2129,10 @@ do_open_file([Fname, Verbose], Parent, Server, Ref) -> [Bad]), {error, {dets_bug, Fname, Bad}} end; -do_open_file([Tab, OpenArgs, Verb], Parent, Server, Ref) -> +do_open_file([Tab, OpenArgs, Verb], Parent, Server, _Ref) -> case catch fopen3(Tab, OpenArgs) of {error, {tooshort, _}} -> - _ = file:delete(OpenArgs#open_args.file), - do_open_file([Tab, OpenArgs, Verb], Parent, Server, Ref); + err({error, {not_a_dets_file, OpenArgs#open_args.file}}); {error, _Reason} = Error -> err(Error); {ok, Head} -> @@ -2486,7 +2488,6 @@ fopen2(Fname, Tab) -> {ok, _} -> Acc = read_write, Ram = false, - %% Fd is not always closed upon error, but exit is soon called. {ok, Fd, FH} = read_file_header(Fname, Acc, Ram), Mod = FH#fileheader.mod, Do = case Mod:check_file_header(FH, Fd) of @@ -2542,7 +2543,6 @@ fopen_existing_file(Tab, OpenArgs) -> ram_file = Ram, delayed_write = CacheSz, auto_save = Auto, access = Acc, version = Version, debug = Debug} = OpenArgs, - %% Fd is not always closed upon error, but exit is soon called. {ok, Fd, FH} = read_file_header(Fname, Acc, Ram), V9 = (Version =:= 9) or (Version =:= default), MinF = (MinSlots =:= default) or (MinSlots =:= FH#fileheader.min_no_slots), diff --git a/lib/stdlib/src/dict.erl b/lib/stdlib/src/dict.erl index 6088e1a2dd..cf8fb3114a 100644 --- a/lib/stdlib/src/dict.erl +++ b/lib/stdlib/src/dict.erl @@ -55,8 +55,7 @@ -define(exp_size, (?seg_size * ?expand_load)). -define(con_size, (?seg_size * ?contract_load)). --type segs(K, V) :: tuple() - | {K, V}. % dummy +-type segs(_Key, _Value) :: tuple(). %% Define a hashtable. The default values are the standard ones. -record(dict, diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 68e079b7e5..9b506b0a44 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -20,12 +20,12 @@ %% An Erlang code preprocessor. --export([open/2,open/3,open/5,close/1,format_error/1]). +-export([open/1, open/2,open/3,open/5,close/1,format_error/1]). -export([scan_erl_form/1,parse_erl_form/1,macro_defs/1]). --export([parse_file/1, parse_file/3]). +-export([parse_file/1, parse_file/2, parse_file/3]). -export([default_encoding/0, encoding_to_string/1, read_encoding_from_binary/1, read_encoding_from_binary/2, - set_encoding/1, read_encoding/1, read_encoding/2]). + set_encoding/1, set_encoding/2, read_encoding/1, read_encoding/2]). -export([interpret_file_attribute/1]). -export([normalize_typed_record_fields/1,restore_typed_record_fields/1]). @@ -33,21 +33,34 @@ -export_type([source_encoding/0]). --type macros() :: [{atom(), term()}]. +-type macros() :: [atom() | {atom(), term()}]. -type epp_handle() :: pid(). -type source_encoding() :: latin1 | utf8. +-type ifdef() :: 'ifdef' | 'ifndef' | 'else'. + +-type name() :: {'atom', atom()}. +-type argspec() :: 'none' %No arguments + | non_neg_integer(). %Number of arguments +-type tokens() :: [erl_scan:token()]. +-type used() :: {name(), argspec()}. + +-define(DEFAULT_ENCODING, utf8). + %% Epp state record. --record(epp, {file, %Current file - location, %Current location - delta, %Offset from Location (-file) - name="", %Current file name - name2="", %-"-, modified by -file - istk=[], %Ifdef stack - sstk=[], %State stack - path=[], %Include-path - macs = dict:new() :: dict:dict(),%Macros (don't care locations) - uses = dict:new() :: dict:dict(),%Macro use structure +-record(epp, {file :: file:io_device(), %Current file + location=1, %Current location + delta=0 :: non_neg_integer(), %Offset from Location (-file) + name="" :: file:name(), %Current file name + name2="" :: file:name(), %-"-, modified by -file + istk=[] :: [ifdef()], %Ifdef stack + sstk=[] :: [#epp{}], %State stack + path=[] :: [file:name()], %Include-path + macs = dict:new() %Macros (don't care locations) + :: dict:dict(name(), {argspec(), tokens()}), + uses = dict:new() %Macro use structure + :: dict:dict(name(), [{argspec(), [used()]}]), + default_encoding = ?DEFAULT_ENCODING :: source_encoding(), pre_opened = false :: boolean() }). @@ -58,6 +71,7 @@ %%% distinction in the internal representation would simplify the code %%% a little. +%% open(Options) %% open(FileName, IncludePath) %% open(FileName, IncludePath, PreDefMacros) %% open(FileName, IoDevice, StartLocation, IncludePath, PreDefMacros) @@ -65,6 +79,7 @@ %% scan_erl_form(Epp) %% parse_erl_form(Epp) %% parse_file(Epp) +%% parse_file(FileName, Options) %% parse_file(FileName, IncludePath, PreDefMacros) %% macro_defs(Epp) @@ -87,14 +102,43 @@ open(Name, Path) -> ErrorDescriptor :: term(). open(Name, Path, Pdm) -> - Self = self(), - Epp = spawn(fun() -> server(Self, Name, Path, Pdm) end), - epp_request(Epp). + internal_open([{name, Name}, {includes, Path}, {macros, Pdm}], #epp{}). open(Name, File, StartLocation, Path, Pdm) -> - Self = self(), - Epp = spawn(fun() -> server(Self, Name, File, StartLocation,Path,Pdm) end), - epp_request(Epp). + internal_open([{name, Name}, {includes, Path}, {macros, Pdm}], + #epp{file=File, pre_opened=true, location=StartLocation}). + +-spec open(Options) -> + {'ok', Epp} | {'ok', Epp, Extra} | {'error', ErrorDescriptor} when + Options :: [{'default_encoding', DefEncoding :: source_encoding()} | + {'includes', IncludePath :: [DirectoryName :: file:name()]} | + {'macros', PredefMacros :: macros()} | + {'name',FileName :: file:name()} | + 'extra'], + Epp :: epp_handle(), + Extra :: [{'encoding', source_encoding() | 'none'}], + ErrorDescriptor :: term(). + +open(Options) -> + internal_open(Options, #epp{}). + +internal_open(Options, St) -> + case proplists:get_value(name, Options) of + undefined -> + erlang:error(badarg); + Name -> + Self = self(), + Epp = spawn(fun() -> server(Self, Name, Options, St) end), + case epp_request(Epp) of + {ok, Pid, Encoding} -> + case proplists:get_bool(extra, Options) of + true -> {ok, Pid, [{encoding, Encoding}]}; + false -> {ok, Pid} + end; + Other -> + Other + end + end. -spec close(Epp) -> 'ok' when Epp :: epp_handle(). @@ -170,9 +214,6 @@ format_error({'NYI',What}) -> io_lib:format("not yet implemented '~s'", [What]); format_error(E) -> file:format_error(E). -%% parse_file(FileName, IncludePath, [PreDefMacro]) -> -%% {ok,[Form]} | {error,OpenError} - -spec parse_file(FileName, IncludePath, PredefMacros) -> {'ok', [Form]} | {error, OpenError} when FileName :: file:name(), @@ -184,17 +225,40 @@ format_error(E) -> file:format_error(E). OpenError :: file:posix() | badarg | system_limit. parse_file(Ifile, Path, Predefs) -> - case open(Ifile, Path, Predefs) of + parse_file(Ifile, [{includes, Path}, {macros, Predefs}]). + +-spec parse_file(FileName, Options) -> + {'ok', [Form]} | {'ok', [Form], Extra} | {error, OpenError} when + FileName :: file:name(), + Options :: [{'includes', IncludePath :: [DirectoryName :: file:name()]} | + {'macros', PredefMacros :: macros()} | + {'default_encoding', DefEncoding :: source_encoding()} | + 'extra'], + Form :: erl_parse:abstract_form() | {'error', ErrorInfo} | {'eof',Line}, + Line :: erl_scan:line(), + ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(), + Extra :: [{'encoding', source_encoding() | 'none'}], + OpenError :: file:posix() | badarg | system_limit. + +parse_file(Ifile, Options) -> + case internal_open([{name, Ifile} | Options], #epp{}) of {ok,Epp} -> Forms = parse_file(Epp), close(Epp), {ok,Forms}; + {ok,Epp,Extra} -> + Forms = parse_file(Epp), + close(Epp), + {ok,Forms,Extra}; {error,E} -> {error,E} end. -%% parse_file(Epp) -> -%% [Form] +-spec parse_file(Epp) -> [Form] when + Epp :: epp_handle(), + Form :: erl_parse:abstract_form() | {'error', ErrorInfo} | {'eof',Line}, + Line :: erl_scan:line(), + ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(). parse_file(Epp) -> case parse_erl_form(Epp) of @@ -219,8 +283,6 @@ parse_file(Epp) -> [{eof,Location}] end. --define(DEFAULT_ENCODING, utf8). - -spec default_encoding() -> source_encoding(). default_encoding() -> @@ -258,9 +320,16 @@ read_encoding(Name, Options) -> File :: io:device(). % pid(); raw files don't work set_encoding(File) -> + set_encoding(File, ?DEFAULT_ENCODING). + +-spec set_encoding(File, Default) -> source_encoding() | none when + Default :: source_encoding(), + File :: io:device(). % pid(); raw files don't work + +set_encoding(File, Default) -> Encoding = read_encoding_from_file(File, true), Enc = case Encoding of - none -> default_encoding(); + none -> Default; Encoding -> Encoding end, ok = io:setopts(File, [{encoding, Enc}]), @@ -446,35 +515,37 @@ restore_typed_record_fields([{attribute,La,type,{{record,Record},Fields,[]}}| restore_typed_record_fields([Form|Forms]) -> [Form|restore_typed_record_fields(Forms)]. -%% server(StarterPid, FileName, Path, PreDefMacros) - -server(Pid, Name, Path, Pdm) -> +server(Pid, Name, Options, #epp{pre_opened=PreOpened}=St) -> process_flag(trap_exit, true), - case file:open(Name, [read]) of - {ok,File} -> - Location = 1, - init_server(Pid, Name, File, Location, Path, Pdm, false); - {error,E} -> - epp_reply(Pid, {error,E}) + case PreOpened of + false -> + case file:open(Name, [read]) of + {ok,File} -> + init_server(Pid, Name, Options, St#epp{file = File}); + {error,E} -> + epp_reply(Pid, {error,E}) + end; + true -> + init_server(Pid, Name, Options, St) end. -%% server(StarterPid, FileName, IoDevice, Location, Path, PreDefMacros) -server(Pid, Name, File, AtLocation, Path, Pdm) -> - process_flag(trap_exit, true), - init_server(Pid, Name, File, AtLocation, Path, Pdm, true). - -init_server(Pid, Name, File, AtLocation, Path, Pdm, Pre) -> +init_server(Pid, Name, Options, St0) -> + Pdm = proplists:get_value(macros, Options, []), Ms0 = predef_macros(Name), case user_predef(Pdm, Ms0) of {ok,Ms1} -> - _ = set_encoding(File), - epp_reply(Pid, {ok,self()}), + #epp{file = File, location = AtLocation} = St0, + DefEncoding = proplists:get_value(default_encoding, Options, + ?DEFAULT_ENCODING), + Encoding = set_encoding(File, DefEncoding), + epp_reply(Pid, {ok,self(),Encoding}), %% ensure directory of current source file is %% first in path - Path1 = [filename:dirname(Name) | Path], - St = #epp{file=File, location=AtLocation, delta=0, - name=Name, name2=Name, path=Path1, macs=Ms1, - pre_opened = Pre}, + Path = [filename:dirname(Name) | + proplists:get_value(includes, Options, [])], + St = St0#epp{delta=0, name=Name, name2=Name, + path=Path, macs=Ms1, + default_encoding=DefEncoding}, From = wait_request(St), enter_file_reply(From, Name, AtLocation, AtLocation), wait_req_scan(St); @@ -600,9 +671,11 @@ enter_file2(NewF, Pname, From, St0, AtLocation) -> %% the path) must be dropped, otherwise the path used within the current %% file will depend on the order of file inclusions in the parent files Path = [filename:dirname(Pname) | tl(St0#epp.path)], - _ = set_encoding(NewF), + DefEncoding = St0#epp.default_encoding, + _ = set_encoding(NewF, DefEncoding), #epp{file=NewF,location=Loc,name=Pname,name2=Pname,delta=0, - sstk=[St0|St0#epp.sstk],path=Path,macs=Ms}. + sstk=[St0|St0#epp.sstk],path=Path,macs=Ms, + default_encoding=DefEncoding}. enter_file_reply(From, Name, Location, AtLocation) -> Attr = loc_attr(AtLocation), diff --git a/lib/stdlib/src/erl_compile.erl b/lib/stdlib/src/erl_compile.erl index ed8fea5d78..caed4d41d6 100644 --- a/lib/stdlib/src/erl_compile.erl +++ b/lib/stdlib/src/erl_compile.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2014. 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 @@ -66,7 +66,7 @@ my_halt(Reason) -> compile(List) -> process_flag(trap_exit, true), - Pid = spawn_link(fun() -> compiler_runner(List) end), + Pid = spawn_link(compiler_runner(List)), receive {'EXIT', Pid, {compiler_result, Result}} -> Result; @@ -79,14 +79,16 @@ compile(List) -> error end. --spec compiler_runner([cmd_line_arg()]) -> no_return(). +-spec compiler_runner([cmd_line_arg()]) -> fun(() -> no_return()). compiler_runner(List) -> - %% We don't want the current directory in the code path. - %% Remove it. - Path = [D || D <- code:get_path(), D =/= "."], - true = code:set_path(Path), - exit({compiler_result, compile1(List)}). + fun() -> + %% We don't want the current directory in the code path. + %% Remove it. + Path = [D || D <- code:get_path(), D =/= "."], + true = code:set_path(Path), + exit({compiler_result, compile1(List)}) + end. %% Parses the first part of the option list. diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 63e7be4b74..acde3ad5d6 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -18,6 +18,9 @@ %% -module(erl_eval). +%% Guard is_map/1 is not yet supported in HiPE. +-compile(no_native). + %% An evaluator for Erlang abstract syntax. -export([exprs/2,exprs/3,exprs/4,expr/2,expr/3,expr/4,expr/5, @@ -243,11 +246,18 @@ expr({record,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> %% map expr({map,_, Binding,Es}, Bs0, Lf, Ef, RBs) -> {value, Map0, Bs1} = expr(Binding, Bs0, Lf, Ef, RBs), - {Vs,Bs} = eval_map_fields(Es, Bs1, Lf, Ef), - ret_expr(lists:foldl(fun - ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi); - ({map_exact,K,V}, Mi) -> maps:update(K,V,Mi) - end, Map0, Vs), Bs, RBs); + case Map0 of + #{} -> + {Vs,Bs} = eval_map_fields(Es, Bs1, Lf, Ef), + Map1 = lists:foldl(fun ({map_assoc,K,V}, Mi) -> + maps:put(K, V, Mi); + ({map_exact,K,V}, Mi) -> + maps:update(K, V, Mi) + end, Map0, Vs), + ret_expr(Map1, Bs, RBs); + _ -> + erlang:raise(error, {badarg,Map0}, stacktrace()) + end; expr({map,_,Es}, Bs0, Lf, Ef, RBs) -> {Vs,Bs} = eval_map_fields(Es, Bs0, Lf, Ef), ret_expr(lists:foldl(fun @@ -1006,12 +1016,16 @@ guard0([], _Bs, _Lf, _Ef) -> true. guard_test({call,L,{atom,Ln,F},As0}, Bs0, Lf, Ef) -> TT = type_test(F), G = {call,L,{atom,Ln,TT},As0}, - try {value,true,_} = expr(G, Bs0, Lf, Ef, none) - catch error:_ -> {value,false,Bs0} end; -guard_test({call,L,{remote,_Lr,{atom,_Lm,erlang},{atom,_Lf,_F}=T},As0}, + expr_guard_test(G, Bs0, Lf, Ef); +guard_test({call,L,{remote,Lr,{atom,Lm,erlang},{atom,Lf,F}},As0}, Bs0, Lf, Ef) -> - guard_test({call,L,T,As0}, Bs0, Lf, Ef); + TT = type_test(F), + G = {call,L,{remote,Lr,{atom,Lm,erlang},{atom,Lf,TT}},As0}, + expr_guard_test(G, Bs0, Lf, Ef); guard_test(G, Bs0, Lf, Ef) -> + expr_guard_test(G, Bs0, Lf, Ef). + +expr_guard_test(G, Bs0, Lf, Ef) -> try {value,true,_} = expr(G, Bs0, Lf, Ef, none) catch error:_ -> {value,false,Bs0} end. @@ -1109,9 +1123,10 @@ match1({tuple,_,Elts}, Tuple, Bs, BBs) match_tuple(Elts, Tuple, 1, Bs, BBs); match1({tuple,_,_}, _, _Bs, _BBs) -> throw(nomatch); -match1({map,_,Fs}, Map, Bs, BBs) -> +match1({map,_,Fs}, #{}=Map, Bs, BBs) -> match_map(Fs, Map, Bs, BBs); - +match1({map,_,_}, _, _Bs, _BBs) -> + throw(nomatch); match1({bin, _, Fs}, <<_/bitstring>>=B, Bs0, BBs) -> eval_bits:match_bits(Fs, B, Bs0, BBs, match_fun(BBs), diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 9f5be2da37..c4c94fbee4 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -80,13 +80,17 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> -type fa() :: {atom(), arity()}. % function+arity -type ta() :: {atom(), arity()}. % type+arity +-record(typeinfo, {attr, line}). + %% Usage of records, functions, and imports. The variable table, which %% is passed on as an argument, holds the usage of variables. -record(usage, { calls = dict:new(), %Who calls who imported = [], %Actually imported functions - used_records=sets:new() :: sets:set(),%Used record definitions - used_types = dict:new() :: dict:dict()%Used type definitions + used_records = sets:new() %Used record definitions + :: sets:set(atom()), + used_types = dict:new() %Used type definitions + :: dict:dict(ta(), line()) }). %% Define the lint state record. @@ -95,13 +99,17 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> -record(lint, {state=start :: 'start' | 'attribute' | 'function', module=[], %Module behaviour=[], %Behaviour - exports=gb_sets:empty() :: gb_sets:set(),%Exports - imports=[], %Imports + exports=gb_sets:empty() :: gb_sets:set(fa()),%Exports + imports=[] :: [fa()], %Imports, an orddict() compile=[], %Compile flags - records=dict:new() :: dict:dict(), %Record definitions - locals=gb_sets:empty() :: gb_sets:set(),%All defined functions (prescanned) - no_auto=gb_sets:empty() :: gb_sets:set() | 'all',%Functions explicitly not autoimported - defined=gb_sets:empty() :: gb_sets:set(),%Defined fuctions + records=dict:new() %Record definitions + :: dict:dict(atom(), {line(),Fields :: term()}), + locals=gb_sets:empty() %All defined functions (prescanned) + :: gb_sets:set(fa()), + no_auto=gb_sets:empty() %Functions explicitly not autoimported + :: gb_sets:set(fa()) | 'all', + defined=gb_sets:empty() %Defined fuctions + :: gb_sets:set(fa()), on_load=[] :: [fa()], %On-load function on_load_line=0 :: line(), %Line for on_load clashes=[], %Exported functions named as BIFs @@ -116,12 +124,16 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> %outside any fun or lc xqlc= false :: boolean(), %true if qlc.hrl included new = false :: boolean(), %Has user-defined 'new/N' - called= [] :: [{fa(),line()}], %Called functions + called= [] :: [{fa(),line()}], %Called functions usage = #usage{} :: #usage{}, - specs = dict:new() :: dict:dict(), %Type specifications - callbacks = dict:new() :: dict:dict(), %Callback types - types = dict:new() :: dict:dict(), %Type definitions - exp_types=gb_sets:empty():: gb_sets:set()%Exported types + specs = dict:new() %Type specifications + :: dict:dict(mfa(), line()), + callbacks = dict:new() %Callback types + :: dict:dict(mfa(), line()), + types = dict:new() %Type definitions + :: dict:dict(ta(), #typeinfo{}), + exp_types=gb_sets:empty() %Exported types + :: gb_sets:set(ta()) }). -type lint_state() :: #lint{}. @@ -225,6 +237,8 @@ format_error({too_many_arguments,Arity}) -> "maximum allowed is ~w", [Arity,?MAX_ARGUMENTS]); %% --- patterns and guards --- format_error(illegal_pattern) -> "illegal pattern"; +format_error(illegal_map_key) -> + "illegal map key"; format_error({illegal_map_key_variable,K}) -> io_lib:format("illegal use of variable ~w in map",[K]); format_error(illegal_bin_pattern) -> @@ -317,10 +331,14 @@ format_error({undefined_type, {TypeName, Arity}}) -> io_lib:format("type ~w~s undefined", [TypeName, gen_type_paren(Arity)]); format_error({unused_type, {TypeName, Arity}}) -> io_lib:format("type ~w~s is unused", [TypeName, gen_type_paren(Arity)]); -format_error({new_builtin_type, {TypeName, Arity}}) -> - io_lib:format("type ~w~s is a new builtin type; " +%% format_error({new_builtin_type, {TypeName, Arity}}) -> +%% io_lib:format("type ~w~s is a new builtin type; " +%% "its (re)definition is allowed only until the next release", +%% [TypeName, gen_type_paren(Arity)]); +format_error({new_var_arity_type, TypeName}) -> + io_lib:format("type ~w is a new builtin type; " "its (re)definition is allowed only until the next release", - [TypeName, gen_type_paren(Arity)]); + [TypeName]); format_error({builtin_type, {TypeName, Arity}}) -> io_lib:format("type ~w~s is a builtin type; it cannot be redefined", [TypeName, gen_type_paren(Arity)]); @@ -344,10 +362,19 @@ format_error(spec_wrong_arity) -> "spec has the wrong arity"; format_error(callback_wrong_arity) -> "callback has the wrong arity"; -format_error({deprecated_type, {Name, Arity}, {Mod, NewName}, Rel}) -> +format_error({deprecated_builtin_type, {Name, Arity}, + Replacement, Rel}) -> + UseS = case Replacement of + {Mod, NewName} -> + io_lib:format("use ~w:~w/~w", [Mod, NewName, Arity]); + {Mod, NewName, NewArity} -> + io_lib:format("use ~w:~w/~w or preferably ~w:~w/~w", + [Mod, NewName, Arity, + Mod, NewName, NewArity]) + end, io_lib:format("type ~w/~w is deprecated and will be " - "removed in ~s; use ~w:~w/~w", - [Name, Arity, Rel, Mod, NewName, Arity]); + "removed in ~s; use ~s", + [Name, Arity, Rel, UseS]); format_error({not_exported_opaque, {TypeName, Arity}}) -> io_lib:format("opaque type ~w~s is not exported", [TypeName, gen_type_paren(Arity)]); @@ -499,6 +526,9 @@ start(File, Opts) -> {deprecated_function, bool_option(warn_deprecated_function, nowarn_deprecated_function, true, Opts)}, + {deprecated_type, + bool_option(warn_deprecated_type, nowarn_deprecated_type, + true, Opts)}, {obsolete_guard, bool_option(warn_obsolete_guard, nowarn_obsolete_guard, true, Opts)}, @@ -1156,7 +1186,7 @@ export_type(Line, ETs, #lint{usage = Usage, exp_types = ETs0} = St0) -> add_error(Line, {bad_export_type, ETs}, St0) end. --spec exports(lint_state()) -> gb_sets:set(). +-spec exports(lint_state()) -> gb_sets:set(fa()). exports(#lint{compile = Opts, defined = Defs, exports = Es}) -> case lists:member(export_all, Opts) of @@ -1373,18 +1403,20 @@ pattern({cons,_Line,H,T}, Vt, Old, Bvt, St0) -> pattern({tuple,_Line,Ps}, Vt, Old, Bvt, St) -> pattern_list(Ps, Vt, Old, Bvt, St); pattern({map,_Line,Ps}, Vt, Old, Bvt, St) -> - pattern_list(Ps, Vt, Old, Bvt, St); -pattern({map_field_assoc,Line,_,_}, _, _, _, St) -> - {[],[],add_error(Line, illegal_pattern, St)}; -pattern({map_field_exact,Line,KP,VP}, Vt, Old, Bvt0, St0) -> - %% if the key pattern has variables we should fail - case expr(KP,[],St0) of - {[],_} -> - pattern(VP, Vt, Old, Bvt0, St0); - {[Var|_],_} -> - %% found variables in key expression - {Vt,Old,add_error(Line,{illegal_map_key_variable,element(1,Var)},St0)} - end; + foldl(fun + ({map_field_assoc,L,_,_}, {Psvt,Bvt0,St0}) -> + {Psvt,Bvt0,add_error(L, illegal_pattern, St0)}; + ({map_field_exact,L,KP,VP}, {Psvt,Bvt0,St0}) -> + case is_valid_map_key(KP, St0) of + true -> + {Pvt,Bvt1,St1} = pattern(VP, Vt, Old, Bvt, St0), + {vtmerge_pat(Pvt, Psvt),vtmerge_pat(Bvt0, Bvt1), St1}; + false -> + {Psvt,Bvt0,add_error(L, illegal_map_key, St0)}; + {false,variable,Var} -> + {Psvt,Bvt0,add_error(L, {illegal_map_key_variable,Var}, St0)} + end + end, {[],[],St}, Ps); %%pattern({struct,_Line,_Tag,Ps}, Vt, Old, Bvt, St) -> %% pattern_list(Ps, Vt, Old, Bvt, St); pattern({record_index,Line,Name,Field}, _Vt, _Old, _Bvt, St) -> @@ -1773,13 +1805,11 @@ gexpr({cons,_Line,H,T}, Vt, St) -> gexpr({tuple,_Line,Es}, Vt, St) -> gexpr_list(Es, Vt, St); gexpr({map,_Line,Es}, Vt, St) -> - gexpr_list(Es, Vt, St); + map_fields(Es, Vt, check_assoc_fields(Es, St), fun gexpr_list/3); gexpr({map,_Line,Src,Es}, Vt, St) -> - gexpr_list([Src|Es], Vt, St); -gexpr({map_field_assoc,_Line,K,V}, Vt, St) -> - gexpr_list([K,V], Vt, St); -gexpr({map_field_exact,_Line,K,V}, Vt, St) -> - gexpr_list([K,V], Vt, St); + {Svt,St1} = gexpr(Src, Vt, St), + {Fvt,St2} = map_fields(Es, Vt, St1, fun gexpr_list/3), + {vtmerge(Svt, Fvt),St2}; gexpr({record_index,Line,Name,Field}, _Vt, St) -> check_record(Line, Name, St, fun (Dfs, St1) -> record_field(Field, Name, Dfs, St1) end ); @@ -1852,6 +1882,10 @@ gexpr({op,Line,Op,A}, Vt, St0) -> true -> {Avt,St1}; false -> {Avt,add_error(Line, illegal_guard_expr, St1)} end; +gexpr({op,_,'andalso',L,R}, Vt, St) -> + gexpr_list([L,R], Vt, St); +gexpr({op,_,'orelse',L,R}, Vt, St) -> + gexpr_list([L,R], Vt, St); gexpr({op,Line,Op,L,R}, Vt, St0) -> {Avt,St1} = gexpr_list([L,R], Vt, St0), case is_gexpr_op(Op, 2) of @@ -1938,12 +1972,14 @@ is_gexpr({call,L,{tuple,Lt,[{atom,Lm,erlang},{atom,Lf,F}]},As}, RDs) -> is_gexpr({call,L,{remote,Lt,{atom,Lm,erlang},{atom,Lf,F}},As}, RDs); is_gexpr({op,_L,Op,A}, RDs) -> is_gexpr_op(Op, 1) andalso is_gexpr(A, RDs); +is_gexpr({op,_L,'andalso',A1,A2}, RDs) -> + is_gexpr_list([A1,A2], RDs); +is_gexpr({op,_L,'orelse',A1,A2}, RDs) -> + is_gexpr_list([A1,A2], RDs); is_gexpr({op,_L,Op,A1,A2}, RDs) -> is_gexpr_op(Op, 2) andalso is_gexpr_list([A1,A2], RDs); is_gexpr(_Other, _RDs) -> false. -is_gexpr_op('andalso', 2) -> true; -is_gexpr_op('orelse', 2) -> true; is_gexpr_op(Op, A) -> try erl_internal:op_type(Op, A) of arith -> true; @@ -1997,24 +2033,12 @@ expr({bc,_Line,E,Qs}, Vt, St) -> handle_comprehension(E, Qs, Vt, St); expr({tuple,_Line,Es}, Vt, St) -> expr_list(Es, Vt, St); -expr({map,Line,Es}, Vt, St) -> - {Rvt,St1} = expr_list(Es,Vt,St), - case is_valid_map_construction(Es) of - true -> {Rvt,St1}; - false -> {[],add_error(Line,illegal_map_construction,St1)} - end; +expr({map,_Line,Es}, Vt, St) -> + map_fields(Es, Vt, check_assoc_fields(Es, St), fun expr_list/3); expr({map,_Line,Src,Es}, Vt, St) -> - expr_list([Src|Es], Vt, St); -expr({map_field_assoc,Line,K,V}, Vt, St) -> - case is_valid_map_key(K,St) of - true -> expr_list([K,V], Vt, St); - {false,Var} -> {[],add_error(Line,{illegal_map_key_variable,Var},St)} - end; -expr({map_field_exact,Line,K,V}, Vt, St) -> - case is_valid_map_key(K,St) of - true -> expr_list([K,V], Vt, St); - {false,Var} -> {[],add_error(Line,{illegal_map_key_variable,Var},St)} - end; + {Svt,St1} = expr(Src, Vt, St), + {Fvt,St2} = map_fields(Es, Vt, St1, fun expr_list/3), + {vtupdate(Svt, Fvt),St2}; expr({record_index,Line,Name,Field}, _Vt, St) -> check_record(Line, Name, St, fun (Dfs, St1) -> record_field(Field, Name, Dfs, St1) end); @@ -2222,6 +2246,26 @@ record_expr(Line, Rec, Vt, St0) -> St1 = warn_invalid_record(Line, Rec, St0), expr(Rec, Vt, St1). +check_assoc_fields([{map_field_exact,Line,_,_}|Fs], St) -> + check_assoc_fields(Fs, add_error(Line, illegal_map_construction, St)); +check_assoc_fields([{map_field_assoc,_,_,_}|Fs], St) -> + check_assoc_fields(Fs, St); +check_assoc_fields([], St) -> + St. + +map_fields([{Tag,Line,K,V}|Fs], Vt, St, F) when Tag =:= map_field_assoc; + Tag =:= map_field_exact -> + St1 = case is_valid_map_key(K, St) of + true -> St; + false -> add_error(Line, illegal_map_key, St); + {false,variable,Var} -> add_error(Line, {illegal_map_key_variable,Var}, St) + end, + {Pvt,St2} = F([K,V], Vt, St1), + {Vts,St3} = map_fields(Fs, Vt, St2, F), + {vtupdate(Pvt, Vts),St3}; +map_fields([], Vt, St, _) -> + {Vt,St}. + %% warn_invalid_record(Line, Record, State0) -> State %% Adds warning if the record is invalid. @@ -2274,18 +2318,64 @@ is_valid_call(Call) -> _ -> true end. -%% check_map_construction -%% Only #{ K => V }, i.e. assoc is a valid construction -is_valid_map_construction([{map_field_assoc,_,_,_}|Es]) -> - is_valid_map_construction(Es); -is_valid_map_construction([]) -> true; -is_valid_map_construction(_) -> false. +%% is_valid_map_key(K,St) -> true | false | {false, Var::atom()} +%% check for value expression without variables is_valid_map_key(K,St) -> case expr(K,[],St) of - {[],_} -> true; + {[],_} -> + is_valid_map_key_value(K); {[Var|_],_} -> - {false,element(1,Var)} + {false,variable,element(1,Var)} + end. + +is_valid_map_key_value(K) -> + case K of + {char,_,_} -> true; + {integer,_,_} -> true; + {float,_,_} -> true; + {string,_,_} -> true; + {nil,_} -> true; + {atom,_,_} -> true; + {cons,_,H,T} -> + is_valid_map_key_value(H) andalso + is_valid_map_key_value(T); + {tuple,_,Es} -> + foldl(fun(E,B) -> + B andalso is_valid_map_key_value(E) + end,true,Es); + {map,_,Arg,Ps} -> + % only check for value expressions to be valid + % invalid map expressions are later checked in + % core and kernel + is_valid_map_key_value(Arg) andalso foldl(fun + ({Tag,_,Ke,Ve},B) when Tag =:= map_field_assoc; + Tag =:= map_field_exact -> + B andalso is_valid_map_key_value(Ke) + andalso is_valid_map_key_value(Ve) + end,true,Ps); + {map,_,Ps} -> + foldl(fun + ({Tag,_,Ke,Ve},B) when Tag =:= map_field_assoc; + Tag =:= map_field_exact -> + B andalso is_valid_map_key_value(Ke) + andalso is_valid_map_key_value(Ve) + end, true, Ps); + {record,_,_,Fs} -> + foldl(fun + ({record_field,_,Ke,Ve},B) -> + B andalso is_valid_map_key_value(Ke) + andalso is_valid_map_key_value(Ve) + end,true,Fs); + {bin,_,Es} -> + % only check for value expressions to be valid + % invalid binary expressions are later checked in + % core and kernel + foldl(fun + ({bin_element,_,E,_,_},B) -> + B andalso is_valid_map_key_value(E) + end,true,Es); + _ -> false end. %% record_def(Line, RecordName, [RecField], State) -> State. @@ -2500,8 +2590,6 @@ find_field(_F, []) -> error. %% Attr :: 'type' | 'opaque' %% Checks that a type definition is valid. --record(typeinfo, {attr, line}). - type_def(_Attr, _Line, {record, _RecName}, Fields, [], St0) -> %% The record field names and such are checked in the record format. %% We only need to check the types. @@ -2518,32 +2606,46 @@ type_def(Attr, Line, TypeName, ProtoType, Args, St0) -> CheckType = {type, -1, product, [ProtoType|Args]}, check_type(CheckType, St#lint{types=NewDefs}) end, - case (dict:is_key(TypePair, TypeDefs) orelse is_var_arity_type(TypeName)) of - true -> - case is_default_type(TypePair) of - true -> - case is_newly_introduced_builtin_type(TypePair) of - %% allow some types just for bootstrapping - true -> - Warn = {new_builtin_type, TypePair}, - St1 = add_warning(Line, Warn, St0), - StoreType(St1); - false -> - add_error(Line, {builtin_type, TypePair}, St0) - end; - false -> add_error(Line, {redefine_type, TypePair}, St0) - end; - false -> - St1 = case - Attr =:= opaque andalso - is_underspecified(ProtoType, Arity) - of - true -> - Warn = {underspecified_opaque, TypePair}, - add_warning(Line, Warn, St0); - false -> St0 - end, - StoreType(St1) + case is_default_type(TypePair) of + true -> + case is_obsolete_builtin_type(TypePair) of + true -> StoreType(St0); + false -> add_error(Line, {builtin_type, TypePair}, St0) +%% case is_newly_introduced_builtin_type(TypePair) of +%% %% allow some types just for bootstrapping +%% true -> +%% Warn = {new_builtin_type, TypePair}, +%% St1 = add_warning(Line, Warn, St0), +%% StoreType(St1); +%% false -> +%% add_error(Line, {builtin_type, TypePair}, St0) +%% end + end; + false -> + case + dict:is_key(TypePair, TypeDefs) orelse + is_var_arity_type(TypeName) + of + true -> + case is_newly_introduced_var_arity_type(TypeName) of + true -> + Warn = {new_var_arity_type, TypeName}, + add_warning(Line, Warn, St0); + false -> + add_error(Line, {redefine_type, TypePair}, St0) + end; + false -> + St1 = case + Attr =:= opaque andalso + is_underspecified(ProtoType, Arity) + of + true -> + Warn = {underspecified_opaque, TypePair}, + add_warning(Line, Warn, St0); + false -> St0 + end, + StoreType(St1) + end end. is_underspecified({type,_,term,[]}, 0) -> true; @@ -2637,10 +2739,11 @@ check_type({type, La, TypeName, Args}, SeenVars, St) -> St1 = case is_var_arity_type(TypeName) of true -> St; false -> - Obsolete = obsolete_type(TypePair), + Obsolete = (is_warn_enabled(deprecated_type, St) + andalso obsolete_builtin_type(TypePair)), IsObsolete = case Obsolete of - {deprecated, {M, _}, _} when M =/= Module -> + {deprecated, Repl, _} when element(1, Repl) =/= Module -> case dict:find(TypePair, Types) of {ok, _} -> false; error -> true @@ -2650,7 +2753,8 @@ check_type({type, La, TypeName, Args}, SeenVars, St) -> case IsObsolete of true -> {deprecated, Replacement, Rel} = Obsolete, - W = {deprecated_type, TypePair, Replacement, Rel}, + Tag = deprecated_builtin_type, + W = {Tag, TypePair, Replacement, Rel}, add_warning(La, W, St); false -> OldUsed = Usage#usage.used_types, @@ -2701,6 +2805,7 @@ check_record_types([], _Name, _DefFields, SeenVars, St, _SeenFields) -> {SeenVars, St}. is_var_arity_type(tuple) -> true; +is_var_arity_type(map) -> true; is_var_arity_type(product) -> true; is_var_arity_type(union) -> true; is_var_arity_type(record) -> true; @@ -2733,7 +2838,6 @@ is_default_type({iodata, 0}) -> true; is_default_type({iolist, 0}) -> true; is_default_type({list, 0}) -> true; is_default_type({list, 1}) -> true; -is_default_type({map, 0}) -> true; is_default_type({maybe_improper_list, 0}) -> true; is_default_type({maybe_improper_list, 2}) -> true; is_default_type({mfa, 0}) -> true; @@ -2764,31 +2868,32 @@ is_default_type({timeout, 0}) -> true; is_default_type({var, 1}) -> true; is_default_type(_) -> false. -%% R13 -is_newly_introduced_builtin_type({arity, 0}) -> true; -is_newly_introduced_builtin_type({array, 0}) -> true; % opaque -is_newly_introduced_builtin_type({bitstring, 0}) -> true; -is_newly_introduced_builtin_type({dict, 0}) -> true; % opaque -is_newly_introduced_builtin_type({digraph, 0}) -> true; % opaque -is_newly_introduced_builtin_type({gb_set, 0}) -> true; % opaque -is_newly_introduced_builtin_type({gb_tree, 0}) -> true; % opaque -is_newly_introduced_builtin_type({iodata, 0}) -> true; -is_newly_introduced_builtin_type({queue, 0}) -> true; % opaque -is_newly_introduced_builtin_type({set, 0}) -> true; % opaque -%% R13B01 -is_newly_introduced_builtin_type({boolean, 0}) -> true; -is_newly_introduced_builtin_type({Name, _}) when is_atom(Name) -> false. +is_newly_introduced_var_arity_type(map) -> true; +is_newly_introduced_var_arity_type(_) -> false. + +%% is_newly_introduced_builtin_type({Name, _}) when is_atom(Name) -> false. + +is_obsolete_builtin_type(TypePair) -> + obsolete_builtin_type(TypePair) =/= no. %% Obsolete in OTP 17.0. -obsolete_type({array, 0}) -> {deprecated, {array, array}, "OTP 18.0"}; -obsolete_type({dict, 0}) -> {deprecated, {dict, dict}, "OTP 18.0"}; -obsolete_type({digraph, 0}) -> {deprecated, {digraph, graph}, "OTP 18.0"}; -obsolete_type({gb_set, 0}) -> {deprecated, {gb_sets, set}, "OTP 18.0"}; -obsolete_type({gb_tree, 0}) -> {deprecated, {gb_trees, tree}, "OTP 18.0"}; -obsolete_type({queue, 0}) -> {deprecated, {queue, queue}, "OTP 18.0"}; -obsolete_type({set, 0}) -> {deprecated, {sets, set}, "OTP 18.0"}; -obsolete_type({tid, 0}) -> {deprecated, {ets, tid}, "OTP 18.0"}; -obsolete_type({Name, _}) when is_atom(Name) -> no. +obsolete_builtin_type({array, 0}) -> + {deprecated, {array, array, 1}, "OTP 18.0"}; +obsolete_builtin_type({dict, 0}) -> + {deprecated, {dict, dict, 2}, "OTP 18.0"}; +obsolete_builtin_type({digraph, 0}) -> + {deprecated, {digraph, graph}, "OTP 18.0"}; +obsolete_builtin_type({gb_set, 0}) -> + {deprecated, {gb_sets, set, 1}, "OTP 18.0"}; +obsolete_builtin_type({gb_tree, 0}) -> + {deprecated, {gb_trees, tree, 2}, "OTP 18.0"}; +obsolete_builtin_type({queue, 0}) -> + {deprecated, {queue, queue, 1}, "OTP 18.0"}; +obsolete_builtin_type({set, 0}) -> + {deprecated, {sets, set, 1}, "OTP 18.0"}; +obsolete_builtin_type({tid, 0}) -> + {deprecated, {ets, tid}, "OTP 18.0"}; +obsolete_builtin_type({Name, A}) when is_atom(Name), is_integer(A) -> no. %% spec_decl(Line, Fun, Types, State) -> State. diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 6316db7054..1dc5fc52a7 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -919,59 +919,63 @@ normalise_list([]) -> Data :: term(), AbsTerm :: abstract_expr(). abstract(T) -> - abstract(T, 0, epp:default_encoding()). + abstract(T, 0, enc_func(epp:default_encoding())). + +-type encoding_func() :: fun((non_neg_integer()) -> boolean()). %%% abstract/2 takes line and encoding options -spec abstract(Data, Options) -> AbsTerm when Data :: term(), Options :: Line | [Option], Option :: {line, Line} | {encoding, Encoding}, - Encoding :: latin1 | unicode | utf8, + Encoding :: 'latin1' | 'unicode' | 'utf8' | 'none' | encoding_func(), Line :: erl_scan:line(), AbsTerm :: abstract_expr(). abstract(T, Line) when is_integer(Line) -> - abstract(T, Line, epp:default_encoding()); + abstract(T, Line, enc_func(epp:default_encoding())); abstract(T, Options) when is_list(Options) -> Line = proplists:get_value(line, Options, 0), Encoding = proplists:get_value(encoding, Options,epp:default_encoding()), - abstract(T, Line, Encoding). + EncFunc = enc_func(Encoding), + abstract(T, Line, EncFunc). -define(UNICODE(C), - is_integer(C) andalso - (C >= 0 andalso C < 16#D800 orelse + (C < 16#D800 orelse C > 16#DFFF andalso C < 16#FFFE orelse C > 16#FFFF andalso C =< 16#10FFFF)). +enc_func(latin1) -> fun(C) -> C < 256 end; +enc_func(unicode) -> fun(C) -> ?UNICODE(C) end; +enc_func(utf8) -> fun(C) -> ?UNICODE(C) end; +enc_func(none) -> none; +enc_func(Fun) when is_function(Fun, 1) -> Fun; +enc_func(Term) -> erlang:error({badarg, Term}). + abstract(T, L, _E) when is_integer(T) -> {integer,L,T}; abstract(T, L, _E) when is_float(T) -> {float,L,T}; abstract(T, L, _E) when is_atom(T) -> {atom,L,T}; abstract([], L, _E) -> {nil,L}; abstract(B, L, _E) when is_bitstring(B) -> {bin, L, [abstract_byte(Byte, L) || Byte <- bitstring_to_list(B)]}; -abstract([C|T], L, unicode=E) when ?UNICODE(C) -> - abstract_unicode_string(T, [C], L, E); -abstract([C|T], L, utf8=E) when ?UNICODE(C) -> - abstract_unicode_string(T, [C], L, E); -abstract([C|T], L, latin1=E) when is_integer(C), 0 =< C, C < 256 -> - abstract_string(T, [C], L, E); -abstract([H|T], L, E) -> +abstract([H|T], L, none=E) -> {cons,L,abstract(H, L, E),abstract(T, L, E)}; +abstract(List, L, E) when is_list(List) -> + abstract_list(List, [], L, E); abstract(Tuple, L, E) when is_tuple(Tuple) -> - {tuple,L,abstract_list(tuple_to_list(Tuple), L, E)}. - -abstract_string([C|T], String, L, E) when is_integer(C), 0 =< C, C < 256 -> - abstract_string(T, [C|String], L, E); -abstract_string([], String, L, _E) -> - {string, L, lists:reverse(String)}; -abstract_string(T, String, L, E) -> - not_string(String, abstract(T, L, E), L, E). - -abstract_unicode_string([C|T], String, L, E) when ?UNICODE(C) -> - abstract_unicode_string(T, [C|String], L, E); -abstract_unicode_string([], String, L, _E) -> + {tuple,L,abstract_tuple_list(tuple_to_list(Tuple), L, E)}. + +abstract_list([H|T], String, L, E) -> + case is_integer(H) andalso H >= 0 andalso E(H) of + true -> + abstract_list(T, [H|String], L, E); + false -> + AbstrList = {cons,L,abstract(H, L, E),abstract(T, L, E)}, + not_string(String, AbstrList, L, E) + end; +abstract_list([], String, L, _E) -> {string, L, lists:reverse(String)}; -abstract_unicode_string(T, String, L, E) -> +abstract_list(T, String, L, E) -> not_string(String, abstract(T, L, E), L, E). not_string([C|T], Result, L, E) -> @@ -979,9 +983,9 @@ not_string([C|T], Result, L, E) -> not_string([], Result, _L, _E) -> Result. -abstract_list([H|T], L, E) -> - [abstract(H, L, E)|abstract_list(T, L, E)]; -abstract_list([], _L, _E) -> +abstract_tuple_list([H|T], L, E) -> + [abstract(H, L, E)|abstract_tuple_list(T, L, E)]; +abstract_tuple_list([], _L, _E) -> []. abstract_byte(Byte, L) when is_integer(Byte) -> diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index 35f6dff57e..6bd0eb8a22 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. 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 @@ -59,7 +59,6 @@ file:filename() | {file:filename(), binary()} | {file:filename(), binary(), file:file_info()}. --type zip_create_option() :: term(). -type section() :: shebang | {shebang, shebang() | default | undefined} @@ -68,8 +67,8 @@ | {emu_args, emu_args() | undefined} | {source, file:filename() | binary()} | {beam, file:filename() | binary()} - | {archive, file:filename() | binary()} - | {archive, [zip_file()], [zip_create_option()]}. + | {archive, zip:filename() | binary()} + | {archive, [zip_file()], [zip:create_option()]}. %%----------------------------------------------------------------------- @@ -289,6 +288,8 @@ start(EscriptOptions) -> my_halt(127) end. +-spec parse_and_run(_, _, _) -> no_return(). + parse_and_run(File, Args, Options) -> CheckOnly = lists:member("s", Options), {Source, Module, FormsOrBin, HasRecs, Mode} = @@ -727,6 +728,8 @@ epp_parse_file2(Epp, S, Forms, Parsed) -> %% Evaluate script %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-spec debug(_, _, _) -> no_return(). + debug(Module, AbsMod, Args) -> case hidden_apply(debugger, debugger, start, []) of {ok, _} -> @@ -742,6 +745,8 @@ debug(Module, AbsMod, Args) -> fatal("Cannot start the debugger") end. +-spec run(_, _) -> no_return(). + run(Module, Args) -> try Module:main(Args), @@ -751,6 +756,8 @@ run(Module, Args) -> fatal(format_exception(Class, Reason)) end. +-spec interpret(_, _, _, _) -> no_return(). + interpret(Forms, HasRecs, File, Args) -> %% Basic validation before execution case erl_lint:module(Forms) of diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index 66e54ef221..e6bde5673c 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -516,8 +516,10 @@ pathtype(Atom) when is_atom(Atom) -> pathtype(atom_to_list(Atom)); pathtype(Name) when is_list(Name) or is_binary(Name) -> case os:type() of - {unix, _} -> unix_pathtype(Name); - {win32, _} -> win32_pathtype(Name) + {win32, _} -> + win32_pathtype(Name); + {_, _} -> + unix_pathtype(Name) end. unix_pathtype(<<$/,_/binary>>) -> diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl index 7281549ea7..63116fa16e 100644 --- a/lib/stdlib/src/gen.erl +++ b/lib/stdlib/src/gen.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -37,7 +37,9 @@ %%----------------------------------------------------------------- -type linkage() :: 'link' | 'nolink'. --type emgr_name() :: {'local', atom()} | {'global', term()} | {via, atom(), term()}. +-type emgr_name() :: {'local', atom()} + | {'global', term()} + | {'via', Module :: module(), Name :: term()}. -type start_ret() :: {'ok', pid()} | 'ignore' | {'error', term()}. diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index 7629e88fbf..d39dd89d3a 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -40,6 +40,8 @@ system_continue/3, system_terminate/4, system_code_change/4, + system_get_state/1, + system_replace_state/2, format_status/2]). -export_type([handler/0, handler_args/0, add_handler_ret/0, @@ -229,24 +231,6 @@ wake_hib(Parent, ServerName, MSL, Debug) -> fetch_msg(Parent, ServerName, MSL, Debug, Hib) -> receive - {system, From, get_state} -> - States = [{Mod,Id,State} || #handler{module=Mod, id=Id, state=State} <- MSL], - sys:handle_system_msg(get_state, From, Parent, ?MODULE, Debug, - {States, [ServerName, MSL, Hib]}, Hib); - {system, From, {replace_state, StateFun}} -> - {NMSL, NStates} = - lists:unzip([begin - Cur = {Mod,Id,State}, - try - NState = {Mod,Id,NS} = StateFun(Cur), - {HS#handler{state=NS}, NState} - catch - _:_ -> - {HS, Cur} - end - end || #handler{module=Mod, id=Id, state=State}=HS <- MSL]), - sys:handle_system_msg(replace_state, From, Parent, ?MODULE, Debug, - {NStates, [ServerName, NMSL, Hib]}, Hib); {system, From, Req} -> sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug, [ServerName, MSL, Hib],Hib); @@ -383,6 +367,23 @@ system_code_change([ServerName, MSL, Hib], Module, OldVsn, Extra) -> MSL), {ok, [ServerName, MSL1, Hib]}. +system_get_state([_ServerName, MSL, _Hib]) -> + {ok, [{Mod,Id,State} || #handler{module=Mod, id=Id, state=State} <- MSL]}. + +system_replace_state(StateFun, [ServerName, MSL, Hib]) -> + {NMSL, NStates} = + lists:unzip([begin + Cur = {Mod,Id,State}, + try + NState = {Mod,Id,NS} = StateFun(Cur), + {HS#handler{state=NS}, NState} + catch + _:_ -> + {HS, Cur} + end + end || #handler{module=Mod, id=Id, state=State}=HS <- MSL]), + {ok, NStates, [ServerName, NMSL, Hib]}. + %%----------------------------------------------------------------- %% Format debug messages. Print them as the call-back module sees %% them, not as the real erlang messages. Use trace for that. diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index e9654322f1..e914f7d0b2 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -118,6 +118,8 @@ system_continue/3, system_terminate/4, system_code_change/4, + system_get_state/1, + system_replace_state/2, format_status/2]). -import(error_logger, [format/2]). @@ -422,17 +424,6 @@ wake_hib(Parent, Name, StateName, StateData, Mod, Debug) -> decode_msg(Msg,Parent, Name, StateName, StateData, Mod, Time, Debug, Hib) -> case Msg of - {system, From, get_state} -> - Misc = [Name, StateName, StateData, Mod, Time], - sys:handle_system_msg(get_state, From, Parent, ?MODULE, Debug, - {{StateName, StateData}, Misc}, Hib); - {system, From, {replace_state, StateFun}} -> - State = {StateName, StateData}, - NState = {NStateName, NStateData} = try StateFun(State) - catch _:_ -> State end, - NMisc = [Name, NStateName, NStateData, Mod, Time], - sys:handle_system_msg(replace_state, From, Parent, ?MODULE, Debug, - {NState, NMisc}, Hib); {system, From, Req} -> sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug, [Name, StateName, StateData, Mod, Time], Hib); @@ -467,6 +458,13 @@ system_code_change([Name, StateName, StateData, Mod, Time], Else -> Else end. +system_get_state([_Name, StateName, StateData, _Mod, _Time]) -> + {ok, {StateName, StateData}}. + +system_replace_state(StateFun, [Name, StateName, StateData, Mod, Time]) -> + Result = {NStateName, NStateData} = StateFun({StateName, StateData}), + {ok, Result, [Name, NStateName, NStateData, Mod, Time]}. + %%----------------------------------------------------------------- %% Format debug messages. Print them as the call-back module sees %% them, not as the real erlang messages. Use trace for that. diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index 5f14e48b0a..202a931fae 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -98,6 +98,8 @@ -export([system_continue/3, system_terminate/4, system_code_change/4, + system_get_state/1, + system_replace_state/2, format_status/2]). %% Internal exports @@ -372,13 +374,6 @@ wake_hib(Parent, Name, State, Mod, Debug) -> decode_msg(Msg, Parent, Name, State, Mod, Time, Debug, Hib) -> case Msg of - {system, From, get_state} -> - sys:handle_system_msg(get_state, From, Parent, ?MODULE, Debug, - {State, [Name, State, Mod, Time]}, Hib); - {system, From, {replace_state, StateFun}} -> - NState = try StateFun(State) catch _:_ -> State end, - sys:handle_system_msg(replace_state, From, Parent, ?MODULE, Debug, - {NState, [Name, NState, Mod, Time]}, Hib); {system, From, Req} -> sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug, [Name, State, Mod, Time], Hib); @@ -687,6 +682,13 @@ system_code_change([Name, State, Mod, Time], _Module, OldVsn, Extra) -> Else -> Else end. +system_get_state([_Name, State, _Mod, _Time]) -> + {ok, State}. + +system_replace_state(StateFun, [Name, State, Mod, Time]) -> + NState = StateFun(State), + {ok, NState, [Name, NState, Mod, Time]}. + %%----------------------------------------------------------------- %% Format debug messages. Print them as the call-back module sees %% them, not as the real erlang messages. Use trace for that. diff --git a/lib/stdlib/src/io.erl b/lib/stdlib/src/io.erl index b11d41e2eb..27e2a82b41 100644 --- a/lib/stdlib/src/io.erl +++ b/lib/stdlib/src/io.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -177,13 +177,15 @@ get_password(Io) -> | {'expand_fun', expand_fun()} | {'encoding', encoding()}. --spec getopts() -> [opt_pair()]. +-spec getopts() -> [opt_pair()] | {'error', Reason} when + Reason :: term(). getopts() -> getopts(default_input()). --spec getopts(IoDevice) -> [opt_pair()] when - IoDevice :: device(). +-spec getopts(IoDevice) -> [opt_pair()] | {'error', Reason} when + IoDevice :: device(), + Reason :: term(). getopts(Io) -> request(Io, getopts). diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl index 9005fede4d..4057abd8d5 100644 --- a/lib/stdlib/src/io_lib_pretty.erl +++ b/lib/stdlib/src/io_lib_pretty.erl @@ -66,13 +66,13 @@ print(Term) -> (term(), options()) -> chars(). print(Term, Options) when is_list(Options) -> - Col = proplists:get_value(column, Options, 1), - Ll = proplists:get_value(line_length, Options, 80), - D = proplists:get_value(depth, Options, -1), - M = proplists:get_value(max_chars, Options, -1), - RecDefFun = proplists:get_value(record_print_fun, Options, no_fun), - Encoding = proplists:get_value(encoding, Options, epp:default_encoding()), - Strings = proplists:get_value(strings, Options, true), + Col = get_option(column, Options, 1), + Ll = get_option(line_length, Options, 80), + D = get_option(depth, Options, -1), + M = get_option(max_chars, Options, -1), + RecDefFun = get_option(record_print_fun, Options, no_fun), + Encoding = get_option(encoding, Options, epp:default_encoding()), + Strings = get_option(strings, Options, true), print(Term, Col, Ll, D, M, RecDefFun, Encoding, Strings); print(Term, RecDefFun) -> print(Term, -1, RecDefFun). @@ -761,3 +761,10 @@ chars(C, N) when (N band 1) =:= 0 -> chars(C, N) -> S = chars(C, N bsr 1), [C, S | S]. + +get_option(Key, TupleList, Default) -> + case lists:keyfind(Key, 1, TupleList) of + false -> Default; + {Key, Value} -> Value; + _ -> Default + end. diff --git a/lib/stdlib/src/maps.erl b/lib/stdlib/src/maps.erl index 57b5072639..1f94d9e69d 100644 --- a/lib/stdlib/src/maps.erl +++ b/lib/stdlib/src/maps.erl @@ -45,7 +45,6 @@ -compile(no_native). -%% Shadowed by erl_bif_types: maps:get/3 -spec get(Key,Map) -> Value when Key :: term(), Map :: map(), @@ -54,7 +53,6 @@ get(_,_) -> erlang:nif_error(undef). -%% Shadowed by erl_bif_types: maps:find/3 -spec find(Key,Map) -> {ok, Value} | error when Key :: term(), Map :: map(), @@ -63,8 +61,8 @@ get(_,_) -> erlang:nif_error(undef). find(_,_) -> erlang:nif_error(undef). -%% Shadowed by erl_bif_types: maps:from_list/1 --spec from_list([{Key,Value}]) -> Map when +-spec from_list(List) -> Map when + List :: [{Key,Value}], Key :: term(), Value :: term(), Map :: map(). @@ -72,7 +70,6 @@ find(_,_) -> erlang:nif_error(undef). from_list(_) -> erlang:nif_error(undef). -%% Shadowed by erl_bif_types: maps:is_key/2 -spec is_key(Key,Map) -> boolean() when Key :: term(), Map :: map(). @@ -80,7 +77,6 @@ from_list(_) -> erlang:nif_error(undef). is_key(_,_) -> erlang:nif_error(undef). -%% Shadowed by erl_bif_types: maps:keys/1 -spec keys(Map) -> Keys when Map :: map(), Keys :: [Key], @@ -89,7 +85,6 @@ is_key(_,_) -> erlang:nif_error(undef). keys(_) -> erlang:nif_error(undef). -%% Shadowed by erl_bif_types: maps:merge/2 -spec merge(Map1,Map2) -> Map3 when Map1 :: map(), Map2 :: map(), @@ -99,14 +94,12 @@ merge(_,_) -> erlang:nif_error(undef). -%% Shadowed by erl_bif_types: maps:new/0 -spec new() -> Map when Map :: map(). new() -> erlang:nif_error(undef). -%% Shadowed by erl_bif_types: maps:put/3 -spec put(Key,Value,Map1) -> Map2 when Key :: term(), Value :: term(), @@ -116,7 +109,6 @@ new() -> erlang:nif_error(undef). put(_,_,_) -> erlang:nif_error(undef). -%% Shadowed by erl_bif_types: maps:put/3 -spec remove(Key,Map1) -> Map2 when Key :: term(), Map1 :: map(), @@ -125,7 +117,6 @@ put(_,_,_) -> erlang:nif_error(undef). remove(_,_) -> erlang:nif_error(undef). -%% Shadowed by erl_bif_types: maps:to_list/1 -spec to_list(Map) -> [{Key,Value}] when Map :: map(), Key :: term(), @@ -134,7 +125,6 @@ remove(_,_) -> erlang:nif_error(undef). to_list(_) -> erlang:nif_error(undef). -%% Shadowed by erl_bif_types: maps:update/3 -spec update(Key,Value,Map1) -> Map2 when Key :: term(), Value :: term(), @@ -144,7 +134,6 @@ to_list(_) -> erlang:nif_error(undef). update(_,_,_) -> erlang:nif_error(undef). -%% Shadowed by erl_bif_types: maps:values/1 -spec values(Map) -> Keys when Map :: map(), Keys :: [Key], diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 380bc3eccc..971a2e2baa 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -250,12 +250,12 @@ obsolete_1(snmp, N, A) -> false -> no; true -> - {deprecated, "Deprecated (will be removed in R17B); use snmpa:"++atom_to_list(N)++"/"++ + {deprecated, "Deprecated (will be removed in OTP 18); use snmpa:"++atom_to_list(N)++"/"++ integer_to_list(A)++" instead"} end; obsolete_1(snmpa, old_info_format, 1) -> - {deprecated, "Deprecated; (will be removed in R17B); use \"new\" format instead"}; + {deprecated, "Deprecated; (will be removed in OTP 18); use \"new\" format instead"}; obsolete_1(snmpm, agent_info, 3) -> {removed, {snmpm, agent_info, 2}, "R16B"}; obsolete_1(snmpm, update_agent_info, 5) -> @@ -366,23 +366,6 @@ obsolete_1(auth, node_cookie, 1) -> obsolete_1(auth, node_cookie, 2) -> {deprecated, "Deprecated; use erlang:set_cookie/2 and net_adm:ping/1 instead"}; -obsolete_1(erlang, is_constant, 1) -> - {removed, "Removed in R13B"}; - -%% Added in R12B-0. -obsolete_1(ssl, port, 1) -> - {removed, {ssl, sockname, 1}, "R13B"}; -obsolete_1(ssl, accept, A) when A =:= 1; A =:= 2 -> - {removed, "deprecated; use ssl:transport_accept/1,2 and ssl:ssl_accept/1,2"}; -obsolete_1(erlang, fault, 1) -> - {removed, {erlang,error,1}, "R13B"}; -obsolete_1(erlang, fault, 2) -> - {removed, {erlang,error,2}, "R13B"}; - -%% Added in R12B-2. -obsolete_1(file, rawopen, 2) -> - {removed, "deprecated (will be removed in R13B); use file:open/2 with the raw option"}; - obsolete_1(http, request, 1) -> {removed,{httpc,request,1},"R15B"}; obsolete_1(http, request, 2) -> {removed,{httpc,request,2},"R15B"}; obsolete_1(http, request, 4) -> {removed,{httpc,request,4},"R15B"}; @@ -524,7 +507,7 @@ obsolete_1(docb_xml_check, _, _) -> %% Added in R15B obsolete_1(asn1rt, F, _) when F == load_driver; F == unload_driver -> - {deprecated,"deprecated (will be removed in R16A); has no effect as drivers are no longer used."}; + {deprecated,"deprecated (will be removed in OTP 18); has no effect as drivers are no longer used"}; obsolete_1(ssl, pid, 1) -> {removed,"was removed in R16; is no longer needed"}; obsolete_1(inviso, _, _) -> @@ -532,7 +515,7 @@ obsolete_1(inviso, _, _) -> %% Added in R15B01. obsolete_1(gs, _, _) -> - {deprecated,"the gs application has been deprecated and will be removed in R17; use the wx application instead"}; + {deprecated,"the gs application has been deprecated and will be removed in OTP 18; use the wx application instead"}; obsolete_1(ssh, sign_data, 2) -> {deprecated,"deprecated (will be removed in R16A); use public_key:pem_decode/1, public_key:pem_entry_decode/1 " "and public_key:sign/3 instead"}; diff --git a/lib/stdlib/src/qlc_pt.erl b/lib/stdlib/src/qlc_pt.erl index c26764eb18..b6bb758dfb 100644 --- a/lib/stdlib/src/qlc_pt.erl +++ b/lib/stdlib/src/qlc_pt.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2014. 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 @@ -1218,13 +1218,14 @@ lu_skip(ColConstants, FilterData, PatternFrame, PatternVars, %% column, the filter will not be skipped. %% (an example: {X=1} <- ..., X =:= 1). length(D = Cols -- PatternColumns) =:= 1, - Frame <- SFs, - begin + {{_,Col} = Column, Constants} <- D, + %% Check that the following holds for all frames. + lists:all( + fun(Frame) -> %% The column is compared/matched against a constant. %% If there are no more comparisons/matches then %% the filter can be replaced by the lookup of %% the constant. - [{{_,Col} = Column, Constants}] = D, {VarI, FrameI} = unify_column(Frame, PV, Col, BindFun, Imported), VarValues = deref_skip(VarI, FrameI, LookupOp, Imported), @@ -1253,7 +1254,7 @@ lu_skip(ColConstants, FilterData, PatternFrame, PatternVars, length(VarValues) =< 1 andalso (Constants -- LookedUpConstants =:= []) andalso bindings_is_subset(Frame, F2, Imported) - end], + end, SFs)], ColFils = family_list(ColFil), %% The skip tag 'all' means that all filters are covered by the lookup. %% It does not imply that there is only one generator as is the case diff --git a/lib/stdlib/src/sets.erl b/lib/stdlib/src/sets.erl index be4b600f25..167a676281 100644 --- a/lib/stdlib/src/sets.erl +++ b/lib/stdlib/src/sets.erl @@ -55,9 +55,8 @@ %%------------------------------------------------------------------------------ --type seg() :: tuple(). --type segs(E) :: tuple() - | E. % dummy +-type seg() :: tuple(). +-type segs(_Element) :: tuple(). %% Define a hash set. The default values are the standard ones. -record(set, diff --git a/lib/stdlib/src/slave.erl b/lib/stdlib/src/slave.erl index 3e647635bc..1898dc8aba 100644 --- a/lib/stdlib/src/slave.erl +++ b/lib/stdlib/src/slave.erl @@ -290,7 +290,10 @@ register_unique_name(Number) -> %% no need to use rsh. mk_cmd(Host, Name, Args, Waiter, Prog0) -> - Prog = quote_progname(Prog0), + Prog = case os:type() of + {ose,_} -> mk_ose_prog(Prog0); + _ -> quote_progname(Prog0) + end, BasicCmd = lists:concat([Prog, " -detached -noinput -master ", node(), " ", long_or_short(), Name, "@", Host, @@ -310,6 +313,24 @@ mk_cmd(Host, Name, Args, Waiter, Prog0) -> end end. +%% On OSE we have to pass the beam arguments directory to the slave +%% process. To find out what arguments that should be passed on we +%% make an assumption. All arguments after the last "--" should be +%% skipped. So given these arguments: +%% -Muycs256 -A 1 -- -root /mst/ -progname beam.debug.smp -- -home /mst/ -- -kernel inetrc '"/mst/inetrc.conf"' -- -name test@localhost +%% we send +%% -Muycs256 -A 1 -- -root /mst/ -progname beam.debug.smp -- -home /mst/ -- -kernel inetrc '"/mst/inetrc.conf"' -- +%% to the slave with whatever other args that are added in mk_cmd. +mk_ose_prog(Prog) -> + SkipTail = fun("--",[]) -> + ["--"]; + (_,[]) -> + []; + (Arg,Args) -> + [Arg," "|Args] + end, + [Prog,tl(lists:foldr(SkipTail,[],erlang:system_info(emu_args)))]. + %% This is an attempt to distinguish between spaces in the program %% path and spaces that separate arguments. The program is quoted to %% allow spaces in the path. diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index a64b8e13c0..d388410de0 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -102,5 +102,8 @@ {registered,[timer_server,rsh_starter,take_over_monitor,pool_master, dets]}, {applications, [kernel]}, - {env, []}]}. + {env, []}, + {runtime_dependencies, ["sasl-2.4","kernel-3.0","erts-6.0","crypto-3.3", + "compiler-5.0"]} +]}. diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl index 04f8dfb61b..e25cc25f57 100644 --- a/lib/stdlib/src/sys.erl +++ b/lib/stdlib/src/sys.erl @@ -102,20 +102,31 @@ get_status(Name, Timeout) -> send_system_msg(Name, get_status, Timeout). -spec get_state(Name) -> State when Name :: name(), State :: term(). -get_state(Name) -> send_system_msg(Name, get_state). +get_state(Name) -> + case send_system_msg(Name, get_state) of + {error, Reason} -> error(Reason); + State -> State + end. -spec get_state(Name, Timeout) -> State when Name :: name(), Timeout :: timeout(), State :: term(). -get_state(Name, Timeout) -> send_system_msg(Name, get_state, Timeout). +get_state(Name, Timeout) -> + case send_system_msg(Name, get_state, Timeout) of + {error, Reason} -> error(Reason); + State -> State + end. -spec replace_state(Name, StateFun) -> NewState when Name :: name(), StateFun :: fun((State :: term()) -> NewState :: term()), NewState :: term(). replace_state(Name, StateFun) -> - send_system_msg(Name, {replace_state, StateFun}). + case send_system_msg(Name, {replace_state, StateFun}) of + {error, Reason} -> error(Reason); + State -> State + end. -spec replace_state(Name, StateFun, Timeout) -> NewState when Name :: name(), @@ -123,7 +134,10 @@ replace_state(Name, StateFun) -> Timeout :: timeout(), NewState :: term(). replace_state(Name, StateFun, Timeout) -> - send_system_msg(Name, {replace_state, StateFun}, Timeout). + case send_system_msg(Name, {replace_state, StateFun}, Timeout) of + {error, Reason} -> error(Reason); + State -> State + end. -spec change_code(Name, Module, OldVsn, Extra) -> 'ok' | {error, Reason} when Name :: name(), @@ -390,10 +404,11 @@ do_cmd(_, suspend, _Parent, _Mod, Debug, Misc) -> {suspended, ok, Debug, Misc}; do_cmd(_, resume, _Parent, _Mod, Debug, Misc) -> {running, ok, Debug, Misc}; -do_cmd(SysState, get_state, _Parent, _Mod, Debug, {State, Misc}) -> - {SysState, State, Debug, Misc}; -do_cmd(SysState, replace_state, _Parent, _Mod, Debug, {State, Misc}) -> - {SysState, State, Debug, Misc}; +do_cmd(SysState, get_state, _Parent, Mod, Debug, Misc) -> + {SysState, do_get_state(Mod, Misc), Debug, Misc}; +do_cmd(SysState, {replace_state, StateFun}, _Parent, Mod, Debug, Misc) -> + {Res, NMisc} = do_replace_state(StateFun, Mod, Misc), + {SysState, Res, Debug, NMisc}; do_cmd(SysState, get_status, Parent, Mod, Debug, Misc) -> Res = get_status(SysState, Parent, Mod, Debug, Misc), {SysState, Res, Debug, Misc}; @@ -407,6 +422,40 @@ do_cmd(suspended, {change_code, Module, Vsn, Extra}, _Parent, do_cmd(SysState, Other, _Parent, _Mod, Debug, Misc) -> {SysState, {error, {unknown_system_msg, Other}}, Debug, Misc}. +do_get_state(Mod, Misc) -> + case erlang:function_exported(Mod, system_get_state, 1) of + true -> + try + {ok, State} = Mod:system_get_state(Misc), + State + catch + Cl:Exc -> + {error, {callback_failed,{Mod,system_get_state},{Cl,Exc}}} + end; + false -> + Misc + end. + +do_replace_state(StateFun, Mod, Misc) -> + case erlang:function_exported(Mod, system_replace_state, 2) of + true -> + try + {ok, State, NMisc} = Mod:system_replace_state(StateFun, Misc), + {State, NMisc} + catch + Cl:Exc -> + {{error, {callback_failed,{Mod,system_replace_state},{Cl,Exc}}}, Misc} + end; + false -> + try + NMisc = StateFun(Misc), + {NMisc, NMisc} + catch + Cl:Exc -> + {{error, {callback_failed,StateFun,{Cl,Exc}}}, Misc} + end + end. + get_status(SysState, Parent, Mod, Debug, Misc) -> PDict = get(), FmtMisc = diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl index c40ce8e203..b768c6d0b9 100644 --- a/lib/stdlib/src/zip.erl +++ b/lib/stdlib/src/zip.erl @@ -203,8 +203,18 @@ zip_comment_length}). --type zip_file() :: #zip_file{}. +-type create_option() :: memory | cooked | verbose | {comment, string()} + | {cwd, file:filename()} + | {compress, extension_spec()} + | {uncompress, extension_spec()}. +-type extension() :: string(). +-type extension_spec() :: all | [extension()] | {add, [extension()]} | {del, [extension()]}. +-type filename() :: file:filename(). + -type zip_comment() :: #zip_comment{}. +-type zip_file() :: #zip_file{}. + +-export_type([create_option/0, filename/0]). %% Open a zip archive with options %% @@ -340,13 +350,13 @@ unzip(F) -> unzip(F, []). -spec(unzip(Archive, Options) -> RetValue when Archive :: file:name() | binary(), Options :: [Option], - Option :: {file_list, FileList} + Option :: {file_list, FileList} | cooked | keep_old_files | verbose | memory | {file_filter, FileFilter} | {cwd, CWD}, FileList :: [file:name()], FileBinList :: [{file:name(),binary()}], FileFilter :: fun((ZipFile) -> boolean()), - CWD :: string(), + CWD :: file:filename(), ZipFile :: zip_file(), RetValue :: {ok, FileList} | {ok, FileBinList} @@ -430,7 +440,7 @@ zip(F, Files) -> zip(F, Files, []). What :: all | [Extension] | {add, [Extension]} | {del, [Extension]}, Extension :: string(), Comment :: string(), - CWD :: string(), + CWD :: file:filename(), RetValue :: {ok, FileName :: file:name()} | {ok, {FileName :: file:name(), binary()}} | {error, Reason :: term()}). @@ -712,8 +722,8 @@ table(F, O) -> list_dir(F, O). FileList :: [FileSpec], FileSpec :: file:name() | {file:name(), binary()} | {file:name(), binary(), file:file_info()}, - RetValue :: {ok, FileName :: file:name()} - | {ok, {FileName :: file:name(), binary()}} + RetValue :: {ok, FileName :: filename()} + | {ok, {FileName :: filename(), binary()}} | {error, Reason :: term()}). create(F, Fs) -> zip(F, Fs). @@ -724,14 +734,9 @@ create(F, Fs) -> zip(F, Fs). FileSpec :: file:name() | {file:name(), binary()} | {file:name(), binary(), file:file_info()}, Options :: [Option], - Option :: memory | cooked | verbose | {comment, Comment} - | {cwd, CWD} | {compress, What} | {uncompress, What}, - What :: all | [Extension] | {add, [Extension]} | {del, [Extension]}, - Extension :: string(), - Comment :: string(), - CWD :: string(), - RetValue :: {ok, FileName :: file:name()} - | {ok, {FileName :: file:name(), binary()}} + Option :: create_option(), + RetValue :: {ok, FileName :: filename()} + | {ok, {FileName :: filename(), binary()}} | {error, Reason :: term()}). create(F, Fs, O) -> zip(F, Fs, O). @@ -755,7 +760,7 @@ extract(F) -> unzip(F). FileList :: [file:name()], FileBinList :: [{file:name(),binary()}], FileFilter :: fun((ZipFile) -> boolean()), - CWD :: string(), + CWD :: file:filename(), ZipFile :: zip_file(), RetValue :: {ok, FileList} | {ok, FileBinList} @@ -1153,7 +1158,7 @@ zip_open(Archive) -> zip_open(Archive, []). Archive :: file:name() | binary(), ZipHandle :: pid(), Options :: [Option], - Option :: cooked | memory | {cwd, CWD :: string()}, + Option :: cooked | memory | {cwd, CWD :: file:filename()}, Reason :: term()). zip_open(Archive, Options) -> diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index af82f22b21..39f6ce423a 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -73,6 +73,8 @@ MODULES= \ supervisor_SUITE \ supervisor_bridge_SUITE \ sys_SUITE \ + sys_sp1 \ + sys_sp2 \ tar_SUITE \ timer_SUITE \ timer_simple_SUITE \ diff --git a/lib/stdlib/test/binary_module_SUITE.erl b/lib/stdlib/test/binary_module_SUITE.erl index d5a0fe21b4..32cec0db6f 100644 --- a/lib/stdlib/test/binary_module_SUITE.erl +++ b/lib/stdlib/test/binary_module_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2014. 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 @@ -40,7 +40,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). % Default timetrap timeout (set in init_per_testcase). % Some of these testcases are really heavy... --define(default_timeout, ?t:minutes(20)). +-define(default_timeout, ?t:minutes(30)). -endif. diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index 059d553b00..6be37cbecf 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -52,7 +52,7 @@ simultaneous_open/1, insert_new/1, repair_continuation/1, otp_5487/1, otp_6206/1, otp_6359/1, otp_4738/1, otp_7146/1, otp_8070/1, otp_8856/1, otp_8898/1, otp_8899/1, otp_8903/1, - otp_8923/1, otp_9282/1, otp_11245/1]). + otp_8923/1, otp_9282/1, otp_11245/1, otp_11709/1]). -export([dets_dirty_loop/0]). @@ -109,7 +109,7 @@ all() -> many_clients, otp_4906, otp_5402, simultaneous_open, insert_new, repair_continuation, otp_5487, otp_6206, otp_6359, otp_4738, otp_7146, otp_8070, otp_8856, otp_8898, - otp_8899, otp_8903, otp_8923, otp_9282, otp_11245 + otp_8899, otp_8903, otp_8923, otp_9282, otp_11245, otp_11709 ]. groups() -> @@ -772,9 +772,9 @@ open_1(Config, V) -> crash(Fname, TypePos), {error, {invalid_type_code,Fname}} = dets:open_file(Fname), truncate(Fname, HeadSize - 10), - {error, {tooshort,Fname}} = dets:open_file(Fname), - {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{version,V}]), - ok = dets:close(TabRef), + {error,{not_a_dets_file,Fname}} = dets:open_file(Fname), + {error,{not_a_dets_file,Fname}} = + dets:open_file(TabRef, [{file,Fname},{version,V}]), file:delete(Fname), {error,{file_error,{foo,bar},_}} = dets:is_dets_file({foo,bar}), @@ -967,10 +967,12 @@ fast_init_table(Config) -> {'EXIT', _} = (catch dets:init_table(TabRef, fun(foo) -> bar end, {format,bchunk})), dets:close(TabRef), + file:delete(Fname), {ok, _} = dets:open_file(TabRef, Args), {'EXIT', _} = (catch dets:init_table(TabRef, fun() -> foo end, {format,bchunk})), dets:close(TabRef), + file:delete(Fname), {ok, _} = dets:open_file(TabRef, Args), {'EXIT', {badarg, _}} = (catch dets:init_table(TabRef, nofun, {format,bchunk})), @@ -979,10 +981,12 @@ fast_init_table(Config) -> away = (catch dets:init_table(TabRef, fun(_) -> throw(away) end, {format,bchunk})), dets:close(TabRef), + file:delete(Fname), {ok, _} = dets:open_file(TabRef, Args), {error, {init_fun, fopp}} = dets:init_table(TabRef, fun(read) -> fopp end, {format,bchunk}), dets:close(TabRef), + file:delete(Fname), {ok, _} = dets:open_file(TabRef, Args), dets:safe_fixtable(TabRef, true), {error, {fixed_table, TabRef}} = @@ -1389,23 +1393,6 @@ repair(Config, V) -> {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{version,V}]), ok = ins(TabRef, 100), ok = dets:close(TabRef), - truncate(Fname, HeadSize - 10), - %% a new file is created ('tooshort') - {ok, TabRef} = dets:open_file(TabRef, - [{file,Fname},{version,V}, - {min_no_slots,1000}, - {max_no_slots,1000000}]), - case dets:info(TabRef, no_slots) of - undefined -> ok; - {Min1,Slot1,Max1} -> - true = Min1 =< Slot1, true = Slot1 =< Max1, - true = 1000 < Min1, true = 1000+256 > Min1, - true = 1000000 < Max1, true = (1 bsl 20)+256 > Max1 - end, - 0 = dets:info(TabRef, size), - no_keys_test(TabRef), - _ = histogram(TabRef, silent), - ok = dets:close(TabRef), file:delete(Fname), %% version bump (v8) @@ -3920,19 +3907,52 @@ otp_11245(Config) when is_list(Config) -> file:delete(File), ok. +otp_11709(doc) -> + ["OTP-11709. Bugfixes."]; +otp_11709(suite) -> + []; +otp_11709(Config) when is_list(Config) -> + Short = <<"foo">>, + Long = <<"a sufficiently long text">>, + + %% Bug: leaking file descriptor + P0 = pps(), + File = filename(otp_11709, Config), + ok = file:write_file(File, Long), + false = dets:is_dets_file(File), + check_pps(P0), + + %% Bug: deleting file + Args = [[{access, A}, {repair, R}] || + A <- [read, read_write], + R <- [true, false, force]], + Fun1 = fun(S, As) -> + P1 = pps(), + ok = file:write_file(File, S), + {error,{not_a_dets_file,File}} = dets:open_file(File, As), + {ok, S} = file:read_file(File), + check_pps(P1) + end, + Fun2 = fun(S) -> + _ = [Fun1(S, As) || As <- Args], + ok + end, + ok = Fun2(Long), % no change here + ok = Fun2(Short), % mimic the behaviour for longer files + + %% open_file/1 + ok = file:write_file(File, Long), + {error,{not_a_dets_file,File}} = dets:open_file(File), % no change + ok = file:write_file(File, Short), + {error,{not_a_dets_file,File}} = dets:open_file(File), % mimic + + _ = file:delete(File), + ok. + %% %% Parts common to several test cases %% -start_node_rel(Name, Rel, How) -> - Release = [{release, atom_to_list(Rel)}], - Pa = filename:dirname(code:which(?MODULE)), - test_server:start_node(Name, How, - [{args, - " -kernel net_setuptime 100 " - " -pa " ++ Pa}, - {erl, Release}]). - crash(File, Where) -> crash(File, Where, 10). @@ -4323,7 +4343,7 @@ check_badarg({'EXIT', {badarg, [{M,F,Args,_} | _]}}, M, F, Args) -> check_badarg({'EXIT', {badarg, [{M,F,A,_} | _]}}, M, F, Args) -> true = test_server:is_native(M) andalso length(Args) =:= A. -check_pps(P0) -> +check_pps({Ports0,Procs0} = P0) -> case pps() of P0 -> ok; @@ -4335,22 +4355,28 @@ check_pps(P0) -> case pps() of P0 -> ok; - P1 -> - io:format("failure, got ~p~n, expected ~p\n", [P1, P0]), - {Ports0,Procs0} = P0, - {Ports1,Procs1} = P1, - show("Old ports", Ports0 -- Ports1), - show("New ports", Ports1 -- Ports0), - show("Old procs", Procs0 -- Procs1), - show("New procs", Procs1 -- Procs0), - ?t:fail() - end + {Ports1,Procs1} = P1 -> + case {Ports1 -- Ports0, Procs1 -- Procs0} of + {[], []} -> ok; + {PortsDiff,ProcsDiff} -> + io:format("failure, got ~p~n, expected ~p\n", [P1, P0]), + show("Old port", Ports0 -- Ports1), + show("New port", PortsDiff), + show("Old proc", Procs0 -- Procs1), + show("New proc", ProcsDiff), + ?t:fail() + end + end end. show(_S, []) -> ok; -show(S, L) -> - io:format("~s: ~p~n", [S, L]). +show(S, [Pid|Pids]) when is_pid(Pid) -> + io:format("~s: ~p~n", [S, erlang:process_info(Pid)]), + show(S, Pids); +show(S, [Port|Ports]) when is_port(Port)-> + io:format("~s: ~p~n", [S, erlang:port_info(Port)]), + show(S, Ports). pps() -> dets:start(), diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 0b4726c07a..b17e8bd186 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -26,7 +26,7 @@ pmod/1, not_circular/1, skip_header/1, otp_6277/1, otp_7702/1, otp_8130/1, overload_mac/1, otp_8388/1, otp_8470/1, otp_8503/1, otp_8562/1, otp_8665/1, otp_8911/1, otp_10302/1, otp_10820/1, - otp_11728/1]). + otp_11728/1, encoding/1]). -export([epp_parse_erl_form/2]). @@ -68,7 +68,8 @@ all() -> {group, variable}, otp_4870, otp_4871, otp_5362, pmod, not_circular, skip_header, otp_6277, otp_7702, otp_8130, overload_mac, otp_8388, otp_8470, otp_8503, otp_8562, - otp_8665, otp_8911, otp_10302, otp_10820, otp_11728]. + otp_8665, otp_8911, otp_10302, otp_10820, otp_11728, + encoding]. groups() -> [{upcase_mac, [], [upcase_mac_1, upcase_mac_2]}, @@ -123,10 +124,22 @@ include_local(Config) when is_list(Config) -> %%% regular epp:parse_file, the test case will time out, and then epp %%% server will go on growing until we dump core. epp_parse_file(File, Inc, Predef) -> - {ok, Epp} = epp:open(File, Inc, Predef), + List = do_epp_parse_file(fun() -> + epp:open(File, Inc, Predef) + end), + List = do_epp_parse_file(fun() -> + Opts = [{name, File}, + {includes, Inc}, + {macros, Predef}], + epp:open(Opts) + end), + {ok, List}. + +do_epp_parse_file(Open) -> + {ok, Epp} = Open(), List = collect_epp_forms(Epp), epp:close(Epp), - {ok, List}. + List. collect_epp_forms(Epp) -> Result = epp_parse_erl_form(Epp), @@ -1413,6 +1426,63 @@ otp_11728(Config) when is_list(Config) -> _ = file:delete(ErlFile), ok. +%% Check the new API for setting the default encoding. +encoding(Config) when is_list(Config) -> + Dir = ?config(priv_dir, Config), + ErlFile = filename:join(Dir, "encoding.erl"), + + %% Try a latin-1 file with no encoding given. + C1 = <<"-module(encoding). + %% ",246," + ">>, + ok = file:write_file(ErlFile, C1), + {ok,[{attribute,1,file,_}, + {attribute,1,module,encoding}, + {error,_}, + {error,{2,epp,cannot_parse}}, + {eof,2}]} = epp:parse_file(ErlFile, []), + {ok,[{attribute,1,file,_}, + {attribute,1,module,encoding}, + {eof,3}]} = + epp:parse_file(ErlFile, [{default_encoding,latin1}]), + {ok,[{attribute,1,file,_}, + {attribute,1,module,encoding}, + {eof,3}],[{encoding,none}]} = + epp:parse_file(ErlFile, [{default_encoding,latin1},extra]), + + %% Try a latin-1 file with encoding given in a comment. + C2 = <<"-module(encoding). + %% encoding: latin-1 + %% ",246," + ">>, + ok = file:write_file(ErlFile, C2), + {ok,[{attribute,1,file,_}, + {attribute,1,module,encoding}, + {eof,4}]} = + epp:parse_file(ErlFile, []), + {ok,[{attribute,1,file,_}, + {attribute,1,module,encoding}, + {eof,4}]} = + epp:parse_file(ErlFile, [{default_encoding,latin1}]), + {ok,[{attribute,1,file,_}, + {attribute,1,module,encoding}, + {eof,4}]} = + epp:parse_file(ErlFile, [{default_encoding,utf8}]), + {ok,[{attribute,1,file,_}, + {attribute,1,module,encoding}, + {eof,4}],[{encoding,latin1}]} = + epp:parse_file(ErlFile, [extra]), + {ok,[{attribute,1,file,_}, + {attribute,1,module,encoding}, + {eof,4}],[{encoding,latin1}]} = + epp:parse_file(ErlFile, [{default_encoding,latin1},extra]), + {ok,[{attribute,1,file,_}, + {attribute,1,module,encoding}, + {eof,4}],[{encoding,latin1}]} = + epp:parse_file(ErlFile, [{default_encoding,utf8},extra]), + ok. + + check(Config, Tests) -> eval_tests(Config, fun check_test/2, Tests). diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index b194c7cb41..b91d14b5b8 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -25,7 +25,7 @@ match_bin/1, string_plusplus/1, pattern_expr/1, - guard_3/1, guard_4/1, + guard_3/1, guard_4/1, guard_5/1, lc/1, simple_cases/1, unary_plus/1, @@ -79,7 +79,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [guard_1, guard_2, match_pattern, string_plusplus, - pattern_expr, match_bin, guard_3, guard_4, lc, + pattern_expr, match_bin, guard_3, guard_4, guard_5, lc, simple_cases, unary_plus, apply_atom, otp_5269, otp_6539, otp_6543, otp_6787, otp_6977, otp_7550, otp_8133, otp_10622, funs, try_catch, eval_expr_5, zero_width, @@ -248,6 +248,20 @@ guard_4(Config) when is_list(Config) -> false), ok. +guard_5(doc) -> + ["Guards with erlang:'=='/2"]; +guard_5(suite) -> + []; +guard_5(Config) when is_list(Config) -> + {ok,Tokens ,_} = + erl_scan:string("case 1 of A when erlang:'=='(A, 1) -> true end."), + {ok, [Expr]} = erl_parse:parse_exprs(Tokens), + true = guard_5_compiled(), + {value, true, [{'A',1}]} = erl_eval:expr(Expr, []), + ok. + +guard_5_compiled() -> + case 1 of A when erlang:'=='(A, 1) -> true end. lc(doc) -> ["OTP-4518."]; @@ -1437,6 +1451,8 @@ eep43(Config) when is_list(Config) -> " {Map#{a := B},Map#{a => c},Map#{d => e}} " "end.", {#{a => b},#{a => c},#{a => b,d => e}}), + error_check("[camembert]#{}.", {badarg,[camembert]}), + error_check("#{} = 1.", {badmatch,1}), ok. %% Check the string in different contexts: as is; in fun; from compiled code. diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 1614a2722f..bb14de333d 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -52,6 +52,7 @@ guard/1, otp_4886/1, otp_4988/1, otp_5091/1, otp_5276/1, otp_5338/1, otp_5362/1, otp_5371/1, otp_7227/1, otp_5494/1, otp_5644/1, otp_5878/1, otp_5917/1, otp_6585/1, otp_6885/1, otp_10436/1, otp_11254/1, + otp_11772/1, otp_11771/1, export_all/1, bif_clash/1, behaviour_basic/1, behaviour_multiple/1, @@ -61,7 +62,8 @@ on_load_successful/1, on_load_failing/1, too_many_arguments/1, basic_errors/1,bin_syntax_errors/1, - predef/1 + predef/1, + maps/1,maps_type/1 ]). % Default timetrap timeout (set in init_per_testcase). @@ -85,10 +87,12 @@ all() -> unsized_binary_in_bin_gen_pattern, otp_4886, otp_4988, otp_5091, otp_5276, otp_5338, otp_5362, otp_5371, otp_7227, otp_5494, otp_5644, - otp_5878, otp_5917, otp_6585, otp_6885, otp_10436, otp_11254,export_all, + otp_5878, otp_5917, otp_6585, otp_6885, otp_10436, otp_11254, + otp_11772, otp_11771, export_all, bif_clash, behaviour_basic, behaviour_multiple, otp_7550, otp_8051, format_warn, {group, on_load}, - too_many_arguments, basic_errors, bin_syntax_errors, predef]. + too_many_arguments, basic_errors, bin_syntax_errors, predef, + maps, maps_type]. groups() -> [{unused_vars_warn, [], @@ -1275,10 +1279,9 @@ guard(Config) when is_list(Config) -> tuple. ">>, [nowarn_obsolete_guard], - {error, + {errors, [{6,erl_lint,illegal_guard_expr},{18,erl_lint,illegal_guard_expr}], - [{18,erl_lint,{removed,{erlang,is_constant,1}, - "Removed in R13B"}}]}}, + []}}, {guard2, <<"-record(apa,{}). t1(A) when atom(A), atom(A) -> @@ -1337,14 +1340,11 @@ guard(Config) when is_list(Config) -> tuple. ">>, [nowarn_obsolete_guard], - {error,[{6,erl_lint,illegal_guard_expr}, - {6,erl_lint,illegal_guard_expr}, - {18,erl_lint,illegal_guard_expr}, - {18,erl_lint,illegal_guard_expr}], - [{18,erl_lint,{removed,{erlang,is_constant,1}, - "Removed in R13B"}}, - {18,erl_lint,{removed,{erlang,is_constant,1}, - "Removed in R13B"}}]}}, + {errors,[{6,erl_lint,illegal_guard_expr}, + {6,erl_lint,illegal_guard_expr}, + {18,erl_lint,illegal_guard_expr}, + {18,erl_lint,illegal_guard_expr}], + []}}, {guard3, <<"-record(apa,{}). t2(A) when atom(A); atom(A) -> @@ -1494,7 +1494,15 @@ guard(Config) when is_list(Config) -> [], {errors,[{1,erl_lint,illegal_guard_expr}, {2,erl_lint,illegal_guard_expr}, - {3,erl_lint,illegal_guard_expr}],[]}} + {3,erl_lint,illegal_guard_expr}],[]}}, + {guard9, + <<"t(X, Y) when erlang:'andalso'(X, Y) -> ok; + t(X, Y) when erlang:'orelse'(X, Y) -> ok. + ">>, + [], + {errors,[{1,erl_lint,illegal_guard_expr}, + {2,erl_lint,illegal_guard_expr}], + []}} ], ?line [] = run(Config, Ts1), ok. @@ -2553,7 +2561,7 @@ otp_10436(Config) when is_list(Config) -> ok. otp_11254(doc) -> - "OTP-11254. Warnings for opaque types."; + "OTP-11254. M:F/A could crash the linter."; otp_11254(suite) -> []; otp_11254(Config) when is_list(Config) -> Ts = <<"-module(p2). @@ -2566,6 +2574,62 @@ otp_11254(Config) when is_list(Config) -> run_test2(Config, Ts, []), ok. +otp_11772(doc) -> + "OTP-11772. Reintroduce errors for redefined builtin types."; +otp_11772(suite) -> []; +otp_11772(Config) when is_list(Config) -> + Ts = <<" + -module(newly). + + -compile(export_all). + + %% Built-in: + -type node() :: node(). + -type mfa() :: tuple(). + -type gb_tree() :: mfa(). % Allowed since Erlang/OTP 17.0 + -type digraph() :: [_]. % Allowed since Erlang/OTP 17.0 + + -type t() :: mfa() | digraph() | gb_tree() | node(). + + -spec t() -> t(). + + t() -> + 1. + ">>, + {errors,[{7,erl_lint,{builtin_type,{node,0}}}, + {8,erl_lint,{builtin_type,{mfa,0}}}], + []} = run_test2(Config, Ts, []), + ok. + +otp_11771(doc) -> + "OTP-11771. Do not allow redefinition of the types arity(_) &c.."; +otp_11771(suite) -> []; +otp_11771(Config) when is_list(Config) -> + Ts = <<" + -module(newly). + + -compile(export_all). + + %% No longer allowed in 17.0: + -type arity() :: atom(). + -type bitstring() :: list(). + -type iodata() :: integer(). + -type boolean() :: iodata(). + + -type t() :: arity() | bitstring() | iodata() | boolean(). + + -spec t() -> t(). + + t() -> + 1. + ">>, + {errors,[{7,erl_lint,{builtin_type,{arity,0}}}, + {8,erl_lint,{builtin_type,{bitstring,0}}}, + {9,erl_lint,{builtin_type,{iodata,0}}}, + {10,erl_lint,{builtin_type,{boolean,0}}}], + []} = run_test2(Config, Ts, []), + ok. + export_all(doc) -> "OTP-7392. Warning for export_all."; export_all(Config) when is_list(Config) -> @@ -3243,20 +3307,136 @@ bin_syntax_errors(Config) -> ok. predef(doc) -> - "Predefined types: array(), digraph(), and so on"; + "OTP-10342: Predefined types: array(), digraph(), and so on"; predef(suite) -> []; predef(Config) when is_list(Config) -> W = get_compilation_warnings(Config, "predef", []), [] = W, W2 = get_compilation_warnings(Config, "predef2", []), - [{7,erl_lint,{deprecated_type,{array,0},{array,array},"OTP 18.0"}}, - {12,erl_lint,{deprecated_type,{dict,0},{dict,dict},"OTP 18.0"}}, - {17,erl_lint,{deprecated_type,{digraph,0},{digraph,graph},"OTP 18.0"}}, - {27,erl_lint,{deprecated_type,{gb_set,0},{gb_sets,set},"OTP 18.0"}}, - {32,erl_lint,{deprecated_type,{gb_tree,0},{gb_trees,tree},"OTP 18.0"}}, - {37,erl_lint,{deprecated_type,{queue,0},{queue,queue},"OTP 18.0"}}, - {42,erl_lint,{deprecated_type,{set,0},{sets,set},"OTP 18.0"}}, - {47,erl_lint,{deprecated_type,{tid,0},{ets,tid},"OTP 18.0"}}] = W2, + Tag = deprecated_builtin_type, + [{7,erl_lint,{Tag,{array,0},{array,array,1},"OTP 18.0"}}, + {12,erl_lint,{Tag,{dict,0},{dict,dict,2},"OTP 18.0"}}, + {17,erl_lint,{Tag,{digraph,0},{digraph,graph},"OTP 18.0"}}, + {27,erl_lint,{Tag,{gb_set,0},{gb_sets,set,1},"OTP 18.0"}}, + {32,erl_lint,{Tag,{gb_tree,0},{gb_trees,tree,2},"OTP 18.0"}}, + {37,erl_lint,{Tag,{queue,0},{queue,queue,1},"OTP 18.0"}}, + {42,erl_lint,{Tag,{set,0},{sets,set,1},"OTP 18.0"}}, + {47,erl_lint,{Tag,{tid,0},{ets,tid},"OTP 18.0"}}] = W2, + Ts = [{otp_10342_1, + <<"-compile(nowarn_deprecated_type). + + -spec t(dict()) -> non_neg_integer(). + + t(D) -> + erlang:phash2(D, 3000). + ">>, + {[nowarn_unused_function]}, + []}, + {otp_10342_2, + <<"-spec t(dict()) -> non_neg_integer(). + + t(D) -> + erlang:phash2(D, 3000). + ">>, + {[nowarn_unused_function]}, + {warnings,[{1,erl_lint, + {deprecated_builtin_type,{dict,0},{dict,dict,2}, + "OTP 18.0"}}]}}], + [] = run(Config, Ts), + ok. + +maps(Config) -> + %% TODO: test key patterns, not done because map patterns are going to be + %% changed a lot. + Ts = [{illegal_map_construction, + <<"t() -> + #{ a := b, + c => d, + e := f + }#{ a := b, + c => d, + e := f }; + t() when is_map(#{ a := b, + c => d + }#{ a := b, + c => d, + e := f }) -> + ok. + ">>, + [], + {errors,[{2,erl_lint,illegal_map_construction}, + {4,erl_lint,illegal_map_construction}, + {8,erl_lint,illegal_map_construction}], + []}}, + {illegal_pattern, + <<"t(#{ a := A, + c => d, + e := F, + g := 1 + 1, + h := _, + i := (_X = _Y), + j := (x ! y) }) -> + {A,F}. + ">>, + [], + {errors,[{2,erl_lint,illegal_pattern}, + {7,erl_lint,illegal_pattern}], + []}}, + {error_in_illegal_map_construction, + <<"t() -> #{ a := X }.">>, + [], + {errors,[{1,erl_lint,illegal_map_construction}, + {1,erl_lint,{unbound_var,'X'}}], + []}}, + {errors_in_map_keys, + <<"t(V) -> #{ a => 1, + #{a=>V} => 2, + #{ \"hi\" => wazzup, hi => ho } => yep, + [try a catch _:_ -> b end] => nope, + ok => 1.0, + [3+3] => nope, + 1.0 => yep, + {3.0+3} => nope, + {yep} => yep, + [case a of a -> a end] => nope + }. + ">>, + [], + {errors,[{2,erl_lint,{illegal_map_key_variable,'V'}}, + {4,erl_lint,illegal_map_key}, + {6,erl_lint,illegal_map_key}, + {8,erl_lint,illegal_map_key}, + {10,erl_lint,illegal_map_key}],[]}}], + [] = run(Config, Ts), + ok. + +maps_type(Config) when is_list(Config) -> + Ts = [ + {maps_type1, + <<" + -type m() :: #{a => integer()}. + -spec t1(#{k=>term()}) -> {term(), map()}. + + t1(#{k:=V}=M) -> {V,M}. + + -spec t2(m()) -> integer(). + + t2(#{a:=V}) -> V. + ">>, + [], + []}, + {maps_type2, + <<" + %% Built-in var arity map type: + -type map() :: tuple(). + -type a() :: map(). + + -spec t(a()) -> a(). + t(M) -> M. + ">>, + [], + {warnings,[{3,erl_lint,{new_var_arity_type,map}}]}}], + [] = run(Config, Ts), ok. run(Config, Tests) -> diff --git a/lib/stdlib/test/erl_lint_SUITE_data/predef.erl b/lib/stdlib/test/erl_lint_SUITE_data/predef.erl index c2364fd1c2..ee9073aa67 100644 --- a/lib/stdlib/test/erl_lint_SUITE_data/predef.erl +++ b/lib/stdlib/test/erl_lint_SUITE_data/predef.erl @@ -5,8 +5,8 @@ -export_type([array/0, digraph/0, gb_set/0]). -%% Before R17B local re-definitions of pre-defined opaque types were -%% ignored but did not generate any warning. +%% Before Erlang/OTP 17.0 local re-definitions of pre-defined opaque +%% types were ignored but did not generate any warning. -opaque array() :: atom(). -opaque digraph() :: atom(). -opaque gb_set() :: atom(). diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl index 447e159cd4..35067e8116 100644 --- a/lib/stdlib/test/erl_scan_SUITE.erl +++ b/lib/stdlib/test/erl_scan_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2014. 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 @@ -21,7 +21,7 @@ init_per_group/2,end_per_group/2]). -export([ error_1/1, error_2/1, iso88591/1, otp_7810/1, otp_10302/1, - otp_10990/1, otp_10992/1]). + otp_10990/1, otp_10992/1, otp_11807/1]). -import(lists, [nth/2,flatten/1]). -import(io_lib, [print/1]). @@ -60,7 +60,8 @@ end_per_testcase(_Case, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [{group, error}, iso88591, otp_7810, otp_10302, otp_10990, otp_10992]. + [{group, error}, iso88591, otp_7810, otp_10302, otp_10990, otp_10992, + otp_11807]. groups() -> [{error, [], [error_1, error_2]}]. @@ -1144,6 +1145,25 @@ otp_10992(Config) when is_list(Config) -> erl_parse:abstract([$A,42.0], [{encoding,utf8}]), ok. +otp_11807(doc) -> + "OTP-11807. Generalize erl_parse:abstract/2."; +otp_11807(suite) -> + []; +otp_11807(Config) when is_list(Config) -> + {cons,0,{integer,0,97},{cons,0,{integer,0,98},{nil,0}}} = + erl_parse:abstract("ab", [{encoding,none}]), + {cons,0,{integer,0,-1},{nil,0}} = + erl_parse:abstract([-1], [{encoding,latin1}]), + ASCII = fun(I) -> I >= 0 andalso I < 128 end, + {string,0,"xyz"} = erl_parse:abstract("xyz", [{encoding,ASCII}]), + {cons,0,{integer,0,228},{nil,0}} = + erl_parse:abstract([228], [{encoding,ASCII}]), + {cons,0,{integer,0,97},{atom,0,a}} = + erl_parse:abstract("a"++a, [{encoding,latin1}]), + {'EXIT', {{badarg,bad},_}} = % minor backward incompatibility + (catch erl_parse:abstract("string", [{encoding,bad}])), + ok. + test_string(String, Expected) -> {ok, Expected, _End} = erl_scan:string(String), test(String). diff --git a/lib/stdlib/test/filename_SUITE.erl b/lib/stdlib/test/filename_SUITE.erl index 232df6a13f..ecd9cff9f9 100644 --- a/lib/stdlib/test/filename_SUITE.erl +++ b/lib/stdlib/test/filename_SUITE.erl @@ -96,11 +96,19 @@ absname(Config) when is_list(Config) -> ?line file:set_cwd(Cwd), ok; - {unix, _} -> - ?line ok = file:set_cwd("/usr"), - ?line "/usr/foo" = filename:absname(foo), - ?line "/usr/foo" = filename:absname("foo"), - ?line "/usr/../ebin" = filename:absname("../ebin"), + Type -> + case Type of + {unix, _} -> + ?line ok = file:set_cwd("/usr"), + ?line "/usr/foo" = filename:absname(foo), + ?line "/usr/foo" = filename:absname("foo"), + ?line "/usr/../ebin" = filename:absname("../ebin"); + {ose, _} -> + ?line ok = file:set_cwd("/romfs"), + ?line "/romfs/foo" = filename:absname(foo), + ?line "/romfs/foo" = filename:absname("foo"), + ?line "/romfs/../ebin" = filename:absname("../ebin") + end, ?line file:set_cwd("/"), ?line "/foo" = filename:absname(foo), @@ -155,7 +163,7 @@ absname_2(Config) when is_list(Config) -> ?line "a:/erlang" = filename:absname("a:erlang", [Drive|":/"]), ok; - {unix, _} -> + _ -> ?line "/usr/foo" = filename:absname(foo, "/usr"), ?line "/usr/foo" = filename:absname("foo", "/usr"), ?line "/usr/../ebin" = filename:absname("../ebin", "/usr"), @@ -189,7 +197,7 @@ basename_1(Config) when is_list(Config) -> ?line "foo" = filename:basename(["usr\\foo\\"]), ?line "foo" = filename:basename("A:\\usr\\foo"), ?line "foo" = filename:basename("A:foo"); - {unix, _} -> + _ -> ?line "strange\\but\\true" = filename:basename("strange\\but\\true") end, @@ -219,7 +227,7 @@ basename_2(Config) when is_list(Config) -> ?line "foo.erl" = filename:basename("c:\\usr.hrl\\foo.erl", ".hrl"), ?line "foo" = filename:basename("A:\\usr\\foo", ".hrl"); - {unix, _} -> + _ -> ?line "strange\\but\\true" = filename:basename("strange\\but\\true.erl", ".erl"), ?line "strange\\but\\true" = @@ -317,7 +325,7 @@ join(Config) when is_list(Config) -> filename:join(["A:","C:usr","foo.erl"]), ?line "d:/foo" = filename:join([$D, $:, $/, []], "foo"), ok; - {unix, _} -> + _ -> ok end. @@ -332,7 +340,7 @@ pathtype(Config) when is_list(Config) -> ?line volumerelative = filename:pathtype("/usr/local/bin"), ?line volumerelative = filename:pathtype("A:usr/local/bin"), ok; - {unix, _} -> + _ -> ?line absolute = filename:pathtype("/"), ?line absolute = filename:pathtype("/usr/local/bin"), ok @@ -450,10 +458,17 @@ absname_bin(Config) when is_list(Config) -> ?line file:set_cwd(Cwd), ok; - {unix, _} -> - ?line ok = file:set_cwd(<<"/usr">>), - ?line <<"/usr/foo">> = filename:absname(<<"foo">>), - ?line <<"/usr/../ebin">> = filename:absname(<<"../ebin">>), + Type -> + case Type of + {unix,_} -> + ?line ok = file:set_cwd(<<"/usr">>), + ?line <<"/usr/foo">> = filename:absname(<<"foo">>), + ?line <<"/usr/../ebin">> = filename:absname(<<"../ebin">>); + {ose,_} -> + ?line ok = file:set_cwd(<<"/romfs">>), + ?line <<"/romfs/foo">> = filename:absname(<<"foo">>), + ?line <<"/romfs/../ebin">> = filename:absname(<<"../ebin">>) + end, ?line file:set_cwd(<<"/">>), ?line <<"/foo">> = filename:absname(<<"foo">>), @@ -503,7 +518,7 @@ absname_bin_2(Config) when is_list(Config) -> ?line <<"a:/erlang">> = filename:absname(<<"a:erlang">>, <<Drive:8,":/">>), ok; - {unix, _} -> + _ -> ?line <<"/usr/foo">> = filename:absname(<<"foo">>, <<"/usr">>), ?line <<"/usr/../ebin">> = filename:absname(<<"../ebin">>, <<"/usr">>), @@ -527,7 +542,7 @@ basename_bin_1(Config) when is_list(Config) -> {win32, _} -> ?line <<"foo">> = filename:basename(<<"A:\\usr\\foo">>), ?line <<"foo">> = filename:basename(<<"A:foo">>); - {unix, _} -> + _ -> ?line <<"strange\\but\\true">> = filename:basename(<<"strange\\but\\true">>) end, @@ -551,7 +566,7 @@ basename_bin_2(Config) when is_list(Config) -> ?line <<"foo.erl">> = filename:basename(<<"c:\\usr.hrl\\foo.erl">>, <<".hrl">>), ?line <<"foo">> = filename:basename(<<"A:\\usr\\foo">>, <<".hrl">>); - {unix, _} -> + _ -> ?line <<"strange\\but\\true">> = filename:basename(<<"strange\\but\\true.erl">>, <<".erl">>), ?line <<"strange\\but\\true">> = @@ -639,7 +654,7 @@ join_bin(Config) when is_list(Config) -> filename:join([<<"A:">>,<<"C:usr">>,<<"foo.erl">>]), ?line <<"d:/foo">> = filename:join([$D, $:, $/, []], <<"foo">>), ok; - {unix, _} -> + _ -> ok end. @@ -653,7 +668,7 @@ pathtype_bin(Config) when is_list(Config) -> volumerelative = filename:pathtype(<<"/usr/local/bin">>), volumerelative = filename:pathtype(<<"A:usr/local/bin">>), ok; - {unix, _} -> + _ -> absolute = filename:pathtype(<<"/">>), absolute = filename:pathtype(<<"/usr/local/bin">>), ok diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl index 5819ef3890..60a1ba8c60 100644 --- a/lib/stdlib/test/gen_event_SUITE.erl +++ b/lib/stdlib/test/gen_event_SUITE.erl @@ -974,6 +974,10 @@ get_state(Config) when is_list(Config) -> [{dummy1_h,false,State1},{dummy1_h,id,State2}] = lists:sort(Result1), Result2 = sys:get_state(Pid, 5000), [{dummy1_h,false,State1},{dummy1_h,id,State2}] = lists:sort(Result2), + ok = sys:suspend(Pid), + Result3 = sys:get_state(Pid), + [{dummy1_h,false,State1},{dummy1_h,id,State2}] = lists:sort(Result3), + ok = sys:resume(Pid), ok = gen_event:stop(Pid), ok. @@ -998,4 +1002,11 @@ replace_state(Config) when is_list(Config) -> Replace3 = fun(_) -> exit(fail) end, [{dummy1_h,false,NState2}] = sys:replace_state(Pid, Replace3), [{dummy1_h,false,NState2}] = sys:get_state(Pid), + %% verify state replaced if process sys suspended + NState3 = "replaced again and again", + Replace4 = fun({dummy1_h,false,_}=S) -> setelement(3,S,NState3) end, + ok = sys:suspend(Pid), + [{dummy1_h,false,NState3}] = sys:replace_state(Pid, Replace4), + ok = sys:resume(Pid), + [{dummy1_h,false,NState3}] = sys:get_state(Pid), ok. diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl index fd15838b7d..8aeec07ae8 100644 --- a/lib/stdlib/test/gen_fsm_SUITE.erl +++ b/lib/stdlib/test/gen_fsm_SUITE.erl @@ -426,6 +426,14 @@ get_state(Config) when is_list(Config) -> {idle, State} = sys:get_state(gfsm), {idle, State} = sys:get_state(gfsm, 5000), stop_it(Pid2), + + %% check that get_state works when pid is sys suspended + {ok, Pid3} = gen_fsm:start(gen_fsm_SUITE, {state_data, State}, []), + {idle, State} = sys:get_state(Pid3), + ok = sys:suspend(Pid3), + {idle, State} = sys:get_state(Pid3, 5000), + ok = sys:resume(Pid3), + stop_it(Pid3), ok. replace_state(Config) when is_list(Config) -> @@ -442,8 +450,18 @@ replace_state(Config) when is_list(Config) -> {state0, NState2} = sys:get_state(Pid), %% verify no change in state if replace function crashes Replace3 = fun(_) -> error(fail) end, - {state0, NState2} = sys:replace_state(Pid, Replace3), + {'EXIT',{{callback_failed, + {gen_fsm,system_replace_state},{error,fail}},_}} = + (catch sys:replace_state(Pid, Replace3)), {state0, NState2} = sys:get_state(Pid), + %% verify state replaced if process sys suspended + ok = sys:suspend(Pid), + Suffix2 = " and again", + NState3 = NState2 ++ Suffix2, + Replace4 = fun({StateName, _}) -> {StateName, NState3} end, + {state0, NState3} = sys:replace_state(Pid, Replace4), + ok = sys:resume(Pid), + {state0, NState3} = sys:get_state(Pid, 5000), stop_it(Pid), ok. diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index a360a0809b..960e7f60e7 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -1049,6 +1049,9 @@ get_state(Config) when is_list(Config) -> {ok, Pid} = gen_server:start_link(?MODULE, {state,State}, []), State = sys:get_state(Pid), State = sys:get_state(Pid, 5000), + ok = sys:suspend(Pid), + State = sys:get_state(Pid), + ok = sys:resume(Pid), ok. %% Verify that sys:replace_state correctly replaces gen_server state @@ -1075,8 +1078,18 @@ replace_state(Config) when is_list(Config) -> NState2 = sys:get_state(Pid, 5000), %% verify no change in state if replace function crashes Replace3 = fun(_) -> throw(fail) end, - NState2 = sys:replace_state(Pid, Replace3), + {'EXIT',{{callback_failed, + {gen_server,system_replace_state},{throw,fail}},_}} = + (catch sys:replace_state(Pid, Replace3)), NState2 = sys:get_state(Pid, 5000), + %% verify state replaced if process sys suspended + ok = sys:suspend(Pid), + Suffix2 = " and again", + NState3 = NState2 ++ Suffix2, + Replace4 = fun(S) -> S ++ Suffix2 end, + NState3 = sys:replace_state(Pid, Replace4), + ok = sys:resume(Pid), + NState3 = sys:get_state(Pid, 5000), ok. %% Test that the time for a huge message queue is not diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index 2846657c09..37fbb5267b 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2014. 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 @@ -72,7 +72,7 @@ otp_5644/1, otp_5195/1, otp_6038_bug/1, otp_6359/1, otp_6562/1, otp_6590/1, otp_6673/1, otp_6964/1, otp_7114/1, otp_7238/1, - otp_7232/1, otp_7552/1, otp_6674/1, otp_7714/1, + otp_7232/1, otp_7552/1, otp_6674/1, otp_7714/1, otp_11758/1, manpage/1, @@ -142,7 +142,7 @@ groups() -> {tickets, [], [otp_5644, otp_5195, otp_6038_bug, otp_6359, otp_6562, otp_6590, otp_6673, otp_6964, otp_7114, otp_7232, - otp_7238, otp_7552, otp_6674, otp_7714]}, + otp_7238, otp_7552, otp_6674, otp_7714, otp_11758]}, {compat, [], [backward, forward]}]. init_per_suite(Config) -> @@ -6670,6 +6670,19 @@ otp_7714(Config) when is_list(Config) -> ets:delete(E2)">>], ?line run(Config, Ts). +otp_11758(doc) -> + "OTP-11758. Bug."; +otp_11758(suite) -> []; +otp_11758(Config) when is_list(Config) -> + Ts = [<<"T = ets:new(r, [{keypos, 2}]), + L = [{rrr, xxx, aaa}, {rrr, yyy, bbb}], + true = ets:insert(T, L), + QH = qlc:q([{rrr, B, C} || {rrr, B, C} <- ets:table(T), + (B =:= xxx) or (B =:= yyy) and (C =:= aaa)]), + [{rrr,xxx,aaa}] = qlc:e(QH), + ets:delete(T)">>], + run(Config, Ts). + otp_6674(doc) -> "OTP-6674. match/comparison."; otp_6674(suite) -> []; diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index 692dfe0faa..e016432f4d 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -54,7 +54,7 @@ config(priv_dir,_) -> -include_lib("test_server/include/test_server.hrl"). -export([init_per_testcase/2, end_per_testcase/2]). % Default timetrap timeout (set in init_per_testcase). --define(default_timeout, ?t:minutes(2)). +-define(default_timeout, ?t:minutes(10)). init_per_testcase(_Case, Config) -> ?line Dog = ?t:timetrap(?default_timeout), ?line OrigPath = code:get_path(), diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index ac5a34c3bc..836ea7c030 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -60,7 +60,7 @@ simple_one_for_one_extra/1, simple_one_for_one_shutdown/1]). %% Misc tests --export([child_unlink/1, tree/1, count_children_memory/1, +-export([child_unlink/1, tree/1, count_children/1, do_not_save_start_parameters_for_temporary_children/1, do_not_save_child_specs_for_temporary_children/1, simple_one_for_one_scale_many_temporary_children/1, @@ -82,7 +82,7 @@ all() -> {group, normal_termination}, {group, shutdown_termination}, {group, abnormal_termination}, child_unlink, tree, - count_children_memory, do_not_save_start_parameters_for_temporary_children, + count_children, do_not_save_start_parameters_for_temporary_children, do_not_save_child_specs_for_temporary_children, simple_one_for_one_scale_many_temporary_children, temporary_bystander, simple_global_supervisor, hanging_restart_loop, hanging_restart_loop_simple]. @@ -129,23 +129,10 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. -init_per_testcase(count_children_memory, Config) -> - try erlang:memory() of - _ -> - erts_debug:set_internal_state(available_internal_state, true), - Dog = ?t:timetrap(?TIMEOUT), - [{watchdog,Dog}|Config] - catch error:notsup -> - {skip, "+Meamin used during test; erlang:memory/1 not available"} - end; init_per_testcase(_Case, Config) -> Dog = ?t:timetrap(?TIMEOUT), [{watchdog,Dog}|Config]. -end_per_testcase(count_children_memory, Config) -> - catch erts_debug:set_internal_state(available_internal_state, false), - ?t:timetrap_cancel(?config(watchdog,Config)), - ok; end_per_testcase(_Case, Config) -> ?t:timetrap_cancel(?config(watchdog,Config)), ok. @@ -1249,34 +1236,24 @@ tree(Config) when is_list(Config) -> [0,0,0,0] = get_child_counts(NewSup2). %%------------------------------------------------------------------------- -%% Test that count_children does not eat memory. -count_children_memory(Config) when is_list(Config) -> +%% Test count_children +count_children(Config) when is_list(Config) -> process_flag(trap_exit, true), Child = {child, {supervisor_1, start_child, []}, temporary, 1000, worker, []}, {ok, SupPid} = start_link({ok, {{simple_one_for_one, 2, 3600}, [Child]}}), [supervisor:start_child(sup_test, []) || _Ignore <- lists:seq(1,1000)], - garbage_collect(), - _Size1 = proc_memory(), Children = supervisor:which_children(sup_test), - _Size2 = proc_memory(), ChildCount = get_child_counts(sup_test), - _Size3 = proc_memory(), [supervisor:start_child(sup_test, []) || _Ignore2 <- lists:seq(1,1000)], - garbage_collect(), - Children2 = supervisor:which_children(sup_test), - Size4 = proc_memory(), ChildCount2 = get_child_counts(sup_test), - Size5 = proc_memory(), + Children2 = supervisor:which_children(sup_test), - garbage_collect(), - Children3 = supervisor:which_children(sup_test), - Size6 = proc_memory(), ChildCount3 = get_child_counts(sup_test), - Size7 = proc_memory(), + Children3 = supervisor:which_children(sup_test), 1000 = length(Children), [1,1000,0,1000] = ChildCount, @@ -1285,27 +1262,9 @@ count_children_memory(Config) when is_list(Config) -> Children3 = Children2, ChildCount3 = ChildCount2, - %% count_children consumes memory using an accumulator function, - %% but the space can be reclaimed incrementally, - %% which_children may generate garbage that will be reclaimed later. - case (Size5 =< Size4) of - true -> ok; - false -> - test_server:fail({count_children, used_more_memory,Size4,Size5}) - end, - case Size7 =< Size6 of - true -> ok; - false -> - test_server:fail({count_children, used_more_memory,Size6,Size7}) - end, - [terminate(SupPid, Pid, child, kill) || {undefined, Pid, worker, _Modules} <- Children3], [1,0,0,0] = get_child_counts(sup_test). -proc_memory() -> - erts_debug:set_internal_state(wait, deallocations), - erlang:memory(processes_used). - %%------------------------------------------------------------------------- %% Temporary children shall not be restarted so they should not save %% start parameters, as it potentially can take up a huge amount of @@ -1483,7 +1442,7 @@ simple_one_for_one_scale_many_temporary_children(_Config) -> if T1 > 0 -> Scaling = T2 div T1, - if Scaling > 20 -> + if Scaling > 50 -> %% The scaling shoul be linear (i.e.10, really), but we %% give some extra here to avoid failing the test %% unecessarily. diff --git a/lib/stdlib/test/sys_SUITE.erl b/lib/stdlib/test/sys_SUITE.erl index c06ba545e7..f38bc87ae5 100644 --- a/lib/stdlib/test/sys_SUITE.erl +++ b/lib/stdlib/test/sys_SUITE.erl @@ -19,7 +19,7 @@ -module(sys_SUITE). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2,log/1,log_to_file/1, - stats/1,trace/1,suspend/1,install/1]). + stats/1,trace/1,suspend/1,install/1,special_process/1]). -export([handle_call/3,terminate/2,init/1]). -include_lib("test_server/include/test_server.hrl"). @@ -27,14 +27,12 @@ %% Doesn't look into change_code at all -%% Doesn't address writing your own process that understands -%% system messages at all. suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [log, log_to_file, stats, trace, suspend, install]. + [log, log_to_file, stats, trace, suspend, install, special_process]. groups() -> []. @@ -157,6 +155,84 @@ install(Config) when is_list(Config) -> ?line stop(), ok. +special_process(suite) -> []; +special_process(Config) when is_list(Config) -> + ok = spec_proc(sys_sp1), + ok = spec_proc(sys_sp2). + +spec_proc(Mod) -> + {ok,_} = Mod:start_link(100), + ok = sys:statistics(Mod,true), + ok = sys:trace(Mod,true), + 1 = Ch = Mod:alloc(), + Free = lists:seq(2,100), + Replace = case sys:get_state(Mod) of + {[Ch],Free} -> + fun({A,F}) -> + Free = F, + {A,[2,3,4]} + end; + {state,[Ch],Free} -> + fun({state,A,F}) -> + Free = F, + {state,A,[2,3,4]} + end + end, + case sys:replace_state(Mod, Replace) of + {[Ch],[2,3,4]} -> ok; + {state,[Ch],[2,3,4]} -> ok + end, + ok = Mod:free(Ch), + case sys:get_state(Mod) of + {[],[1,2,3,4]} -> ok; + {state,[],[1,2,3,4]} -> ok + end, + {ok,[{start_time,_}, + {current_time,_}, + {reductions,_}, + {messages_in,2}, + {messages_out,1}]} = sys:statistics(Mod,get), + ok = sys:statistics(Mod,false), + [] = sys:replace_state(Mod, fun(_) -> [] end), + process_flag(trap_exit,true), + ok = case catch sys:get_state(Mod) of + [] -> + ok; + {'EXIT',{{callback_failed, + {Mod,system_get_state},{throw,fail}},_}} -> + ok + end, + Mod:stop(), + WaitForUnregister = fun W() -> + case whereis(Mod) of + undefined -> ok; + _ -> timer:sleep(10), W() + end + end, + WaitForUnregister(), + {ok,_} = Mod:start_link(4), + ok = case catch sys:replace_state(Mod, fun(_) -> {} end) of + {} -> + ok; + {'EXIT',{{callback_failed, + {Mod,system_replace_state},{throw,fail}},_}} -> + ok + end, + Mod:stop(), + WaitForUnregister(), + {ok,_} = Mod:start_link(4), + StateFun = fun(_) -> error(fail) end, + ok = case catch sys:replace_state(Mod, StateFun) of + {} -> + ok; + {'EXIT',{{callback_failed, + {Mod,system_replace_state},{error,fail}},_}} -> + ok; + {'EXIT',{{callback_failed,StateFun,{error,fail}},_}} -> + ok + end, + Mod:stop(). + %%%%%%%%%%%%%%%%%%%% %% Dummy server diff --git a/lib/stdlib/test/sys_sp1.erl b/lib/stdlib/test/sys_sp1.erl new file mode 100644 index 0000000000..e84ffcfa12 --- /dev/null +++ b/lib/stdlib/test/sys_sp1.erl @@ -0,0 +1,114 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2013. 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(sys_sp1). +-export([start_link/1, stop/0]). +-export([alloc/0, free/1]). +-export([init/1]). +-export([system_continue/3, system_terminate/4, + write_debug/3, + system_get_state/1, system_replace_state/2]). + +%% Implements the ch4 example from the Design Principles doc. Same as +%% sys_sp2 except this module exports system_get_state/1 and +%% system_replace_state/2 + +start_link(NumCh) -> + proc_lib:start_link(?MODULE, init, [[self(),NumCh]]). + +stop() -> + ?MODULE ! stop, + ok. + +alloc() -> + ?MODULE ! {self(), alloc}, + receive + {?MODULE, Res} -> + Res + end. + +free(Ch) -> + ?MODULE ! {free, Ch}, + ok. + +init([Parent,NumCh]) -> + register(?MODULE, self()), + Chs = channels(NumCh), + Deb = sys:debug_options([]), + proc_lib:init_ack(Parent, {ok, self()}), + loop(Chs, Parent, Deb). + +loop(Chs, Parent, Deb) -> + receive + {From, alloc} -> + Deb2 = sys:handle_debug(Deb, fun write_debug/3, + ?MODULE, {in, alloc, From}), + {Ch, Chs2} = alloc(Chs), + From ! {?MODULE, Ch}, + Deb3 = sys:handle_debug(Deb2, fun write_debug/3, + ?MODULE, {out, {?MODULE, Ch}, From}), + loop(Chs2, Parent, Deb3); + {free, Ch} -> + Deb2 = sys:handle_debug(Deb, fun write_debug/3, + ?MODULE, {in, {free, Ch}}), + Chs2 = free(Ch, Chs), + loop(Chs2, Parent, Deb2); + {system, From, Request} -> + sys:handle_system_msg(Request, From, Parent, + ?MODULE, Deb, Chs); + stop -> + sys:handle_debug(Deb, fun write_debug/3, + ?MODULE, {in, stop}), + ok + end. + +system_continue(Parent, Deb, Chs) -> + loop(Chs, Parent, Deb). + +system_terminate(Reason, _Parent, _Deb, _Chs) -> + exit(Reason). + +system_get_state([]) -> + throw(fail); +system_get_state(Chs) -> + {ok, Chs}. + +system_replace_state(_StateFun, {}) -> + throw(fail); +system_replace_state(StateFun, Chs) -> + NChs = StateFun(Chs), + {ok, NChs, NChs}. + +write_debug(Dev, Event, Name) -> + io:format(Dev, "~p event = ~p~n", [Name, Event]). + +channels(NumCh) -> + {_Allocated=[], _Free=lists:seq(1,NumCh)}. + +alloc({_, []}) -> + {error, "no channels available"}; +alloc({Allocated, [H|T]}) -> + {H, {[H|Allocated], T}}. + +free(Ch, {Alloc, Free}=Channels) -> + case lists:member(Ch, Alloc) of + true -> + {lists:delete(Ch, Alloc), [Ch|Free]}; + false -> + Channels + end. diff --git a/lib/stdlib/test/sys_sp2.erl b/lib/stdlib/test/sys_sp2.erl new file mode 100644 index 0000000000..56a5e4d071 --- /dev/null +++ b/lib/stdlib/test/sys_sp2.erl @@ -0,0 +1,107 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2013. 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(sys_sp2). +-export([start_link/1, stop/0]). +-export([alloc/0, free/1]). +-export([init/1]). +-export([system_continue/3, system_terminate/4, + write_debug/3]). + +%% Implements the ch4 example from the Design Principles doc. Same as +%% sys_sp1 except this module does not export system_get_state/1 or +%% system_replace_state/2 + +start_link(NumCh) -> + proc_lib:start_link(?MODULE, init, [[self(),NumCh]]). + +stop() -> + ?MODULE ! stop, + ok. + +alloc() -> + ?MODULE ! {self(), alloc}, + receive + {?MODULE, Res} -> + Res + end. + +free(Ch) -> + ?MODULE ! {free, Ch}, + ok. + +%% can't use 2-tuple for state here as we do in sys_sp1, since the 2-tuple +%% is not compatible with the backward compatibility handling for +%% sys:get_state in sys.erl +-record(state, {alloc,free}). + +init([Parent,NumCh]) -> + register(?MODULE, self()), + Chs = channels(NumCh), + Deb = sys:debug_options([]), + proc_lib:init_ack(Parent, {ok, self()}), + loop(Chs, Parent, Deb). + +loop(Chs, Parent, Deb) -> + receive + {From, alloc} -> + Deb2 = sys:handle_debug(Deb, fun write_debug/3, + ?MODULE, {in, alloc, From}), + {Ch, Chs2} = alloc(Chs), + From ! {?MODULE, Ch}, + Deb3 = sys:handle_debug(Deb2, fun write_debug/3, + ?MODULE, {out, {?MODULE, Ch}, From}), + loop(Chs2, Parent, Deb3); + {free, Ch} -> + Deb2 = sys:handle_debug(Deb, fun write_debug/3, + ?MODULE, {in, {free, Ch}}), + Chs2 = free(Ch, Chs), + loop(Chs2, Parent, Deb2); + {system, From, Request} -> + sys:handle_system_msg(Request, From, Parent, + ?MODULE, Deb, Chs); + stop -> + sys:handle_debug(Deb, fun write_debug/3, + ?MODULE, {in, stop}), + ok + end. + +system_continue(Parent, Deb, Chs) -> + loop(Chs, Parent, Deb). + +system_terminate(Reason, _Parent, _Deb, _Chs) -> + exit(Reason). + +write_debug(Dev, Event, Name) -> + io:format(Dev, "~p event = ~p~n", [Name, Event]). + +channels(NumCh) -> + #state{alloc=[], free=lists:seq(1,NumCh)}. + +alloc(#state{free=[]}=Channels) -> + {{error, "no channels available"}, Channels}; +alloc(#state{alloc=Allocated, free=[H|T]}) -> + {H, #state{alloc=[H|Allocated], free=T}}. + +free(Ch, #state{alloc=Alloc, free=Free}=Channels) -> + case lists:member(Ch, Alloc) of + true -> + #state{alloc=lists:delete(Ch, Alloc), free=[Ch|Free]}; + false -> + Channels + end. diff --git a/lib/stdlib/test/unicode_SUITE.erl b/lib/stdlib/test/unicode_SUITE.erl index e2d789bbe6..10b29d0d28 100644 --- a/lib/stdlib/test/unicode_SUITE.erl +++ b/lib/stdlib/test/unicode_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. 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 @@ -98,7 +98,7 @@ ex_binaries_errors_utf8(Config) when is_list(Config) -> unicode:characters_to_list(Chomped), BrokenPart = iolist_to_binary(DeepBrokenPart2) end || X <- lists:seq(1,OKLen) ] - end || N <- lists:seq(1,20) ], + end || N <- lists:seq(1,21,4) ], ok. ex_binaries_errors_utf16_little(Config) when is_list(Config) -> @@ -124,7 +124,7 @@ ex_binaries_errors_utf16_little(Config) when is_list(Config) -> unicode:characters_to_list(Chomped,{utf16,little}), BrokenPart = iolist_to_binary(DeepBrokenPart2) end || X <- lists:seq(1,OKLen) ] - end || N <- lists:seq(1,15) ], + end || N <- lists:seq(1,16,3) ], ok. ex_binaries_errors_utf16_big(Config) when is_list(Config) -> BrokenPart = << <<X:16/big>> || X <- lists:seq(16#DC00,16#DFFF) >>, @@ -149,7 +149,7 @@ ex_binaries_errors_utf16_big(Config) when is_list(Config) -> unicode:characters_to_list(Chomped,{utf16,big}), BrokenPart = iolist_to_binary(DeepBrokenPart2) end || X <- lists:seq(1,OKLen) ] - end || N <- lists:seq(1,15) ], + end || N <- lists:seq(1,16,3) ], ok. ex_binaries_errors_utf32_big(Config) when is_list(Config) -> @@ -175,7 +175,7 @@ ex_binaries_errors_utf32_big(Config) when is_list(Config) -> unicode:characters_to_list(Chomped,{utf32,big}), BrokenPart = iolist_to_binary(DeepBrokenPart2) end || X <- lists:seq(1,OKLen) ] - end || N <- lists:seq(1,15) ], + end || N <- lists:seq(1,16,3) ], ok. ex_binaries_errors_utf32_little(Config) when is_list(Config) -> @@ -201,7 +201,7 @@ ex_binaries_errors_utf32_little(Config) when is_list(Config) -> unicode:characters_to_list(Chomped,{utf32,little}), BrokenPart = iolist_to_binary(DeepBrokenPart2) end || X <- lists:seq(1,OKLen) ] - end || N <- lists:seq(1,15) ], + end || N <- lists:seq(1,16,3) ], ok. diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index ed9decd4b5..c9996c954e 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -1984,7 +1984,7 @@ revert_map_expr(Node) -> %% Otherwise, if `Node' represents "<code><em>Argument</em>#{...}</code>", %% `Argument' is returned. %% -%% @see map_expr/3 +%% @see map_expr/2 -spec map_expr_argument(syntaxTree()) -> 'none' | syntaxTree(). @@ -2002,7 +2002,7 @@ map_expr_argument(Node) -> %% ===================================================================== %% @doc Returns the list of field subtrees of a `map_expr' node. %% -%% @see map_expr/3 +%% @see map_expr/2 -spec map_expr_fields(syntaxTree()) -> [syntaxTree()]. @@ -2023,7 +2023,7 @@ map_expr_fields(Node) -> %% %% @see map_field_assoc_name/1 %% @see map_field_assoc_value/1 -%% @see map_expr/3 +%% @see map_expr/2 -record(map_field_assoc, {name :: syntaxTree(), value :: syntaxTree()}). @@ -2081,7 +2081,7 @@ map_field_assoc_value(Node) -> %% %% @see map_field_exact_name/1 %% @see map_field_exact_value/1 -%% @see map_expr/3 +%% @see map_expr/2 -record(map_field_exact, {name :: syntaxTree(), value :: syntaxTree()}). diff --git a/lib/syntax_tools/src/igor.erl b/lib/syntax_tools/src/igor.erl index e6aff7b20a..0420508f2a 100644 --- a/lib/syntax_tools/src/igor.erl +++ b/lib/syntax_tools/src/igor.erl @@ -727,7 +727,7 @@ merge_sources(Name, Sources, Opts) -> %% Data structure for keeping state during transformation. --record(state, {export :: sets:set(atom(), arity())}). +-record(state, {export :: sets:set({atom(), arity()})}). state__add_export(Name, Arity, S) -> S#state{export = sets:add_element({Name, Arity}, diff --git a/lib/syntax_tools/src/syntax_tools.app.src b/lib/syntax_tools/src/syntax_tools.app.src index dc0b9edd62..83dcb5fe23 100644 --- a/lib/syntax_tools/src/syntax_tools.app.src +++ b/lib/syntax_tools/src/syntax_tools.app.src @@ -14,4 +14,5 @@ prettypr]}, {registered,[]}, {applications, [stdlib]}, - {env, []}]}. + {env, []}, + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0"]}]}. diff --git a/lib/syntax_tools/vsn.mk b/lib/syntax_tools/vsn.mk index 26153a55f1..cf396ce636 100644 --- a/lib/syntax_tools/vsn.mk +++ b/lib/syntax_tools/vsn.mk @@ -1 +1 @@ -SYNTAX_TOOLS_VSN = 1.6.13 +SYNTAX_TOOLS_VSN = 1.6.14 diff --git a/lib/test_server/src/test_server.app.src b/lib/test_server/src/test_server.app.src index 42e78ed279..5672baa6ef 100644 --- a/lib/test_server/src/test_server.app.src +++ b/lib/test_server/src/test_server.app.src @@ -31,5 +31,8 @@ test_server, test_server_break_process]}, {applications, [kernel,stdlib]}, - {env, []}]}. + {env, []}, + {runtime_dependencies, ["tools-2.6.14","stdlib-2.0","runtime_tools-1.8.14", + "observer-2.0","kernel-3.0","inets-5.10", + "erts-6.0"]}]}. diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index 82672521f7..9b05bddf63 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -1208,6 +1208,10 @@ do_init_per_testcase(Mod, Args) -> "a Config list.\n",[]}, {skip,{failed,{Mod,init_per_testcase,bad_return}}} catch + throw:{Skip,Reason} when Skip =:= skip; Skip =:= skipped -> + {skip,Reason}; + exit:{Skip,Reason} when Skip =:= skip; Skip =:= skipped -> + {skip,Reason}; throw:Other -> set_loc(erlang:get_stacktrace()), Line = get_loc(), @@ -1378,6 +1382,10 @@ ts_tc(M, F, A) -> Result = try apply(M, F, A) catch + throw:{skip, Reason} -> {skip, Reason}; + throw:{skipped, Reason} -> {skip, Reason}; + exit:{skip, Reason} -> {skip, Reason}; + exit:{skipped, Reason} -> {skip, Reason}; Type:Reason -> Stk = erlang:get_stacktrace(), set_loc(Stk), diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index dcf905db24..5fbc47a813 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -1407,7 +1407,7 @@ remove_conf([{conf, _Ref, Props, _MF}|Cases], NoConf, Repeats) -> end; remove_conf([{make,_Ref,_MF}|Cases], NoConf, Repeats) -> remove_conf(Cases, NoConf, Repeats); -remove_conf([{skip_case,{{_M,all},_Cmt}}|Cases], NoConf, Repeats) -> +remove_conf([{skip_case,{{_M,all},_Cmt},_Mode}|Cases], NoConf, Repeats) -> remove_conf(Cases, NoConf, Repeats); remove_conf([{skip_case,{Type,_Ref,_MF,_Cmt}}|Cases], NoConf, Repeats) when Type==conf; @@ -1431,7 +1431,7 @@ remove_conf([], NoConf, true) -> remove_conf([], NoConf, false) -> lists:reverse(NoConf). -get_suites([{skip_case,{{Mod,_Func},_Cmt}}|Tests], Mods) when is_atom(Mod) -> +get_suites([{skip_case,{{Mod,_F},_Cmt},_Mode}|Tests], Mods) when is_atom(Mod) -> case add_mod(Mod, Mods) of true -> get_suites(Tests, [Mod|Mods]); false -> get_suites(Tests, Mods) @@ -1833,7 +1833,7 @@ html_isolate_modules(List, FwMod) -> html_isolate_modules(List, sets:new(), FwMod). html_isolate_modules([], Set, _) -> sets:to_list(Set); -html_isolate_modules([{skip_case,_}|Cases], Set, FwMod) -> +html_isolate_modules([{skip_case,{_Case,_Cmt},_Mode}|Cases], Set, FwMod) -> html_isolate_modules(Cases, Set, FwMod); html_isolate_modules([{conf,_Ref,Props,{FwMod,_Func}}|Cases], Set, FwMod) -> Set1 = case proplists:get_value(suite, Props) of @@ -1937,26 +1937,30 @@ copy_html_file(Src, DestDir) -> add_init_and_end_per_suite([{make,_,_}=Case|Cases], LastMod, LastRef, FwMod) -> [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)]; -add_init_and_end_per_suite([{skip_case,{{Mod,all},_}}=Case|Cases], LastMod, +add_init_and_end_per_suite([{skip_case,{{Mod,all},_},_}=Case|Cases], LastMod, LastRef, FwMod) when Mod =/= LastMod -> {PreCases, NextMod, NextRef} = do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod), - PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef, FwMod)]; -add_init_and_end_per_suite([{skip_case,{{Mod,_},_}}=Case|Cases], LastMod, - LastRef, FwMod) when Mod =/= LastMod -> + PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, + NextRef, FwMod)]; +add_init_and_end_per_suite([{skip_case,{{Mod,_},_Cmt},_Mode}=Case|Cases], + LastMod, LastRef, FwMod) when Mod =/= LastMod -> {PreCases, NextMod, NextRef} = do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod), - PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef, FwMod)]; -add_init_and_end_per_suite([{skip_case,{conf,_,{Mod,_},_},_}=Case|Cases], LastMod, - LastRef, FwMod) when Mod =/= LastMod -> + PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, + NextRef, FwMod)]; +add_init_and_end_per_suite([{skip_case,{conf,_,{Mod,_},_},_}=Case|Cases], + LastMod, LastRef, FwMod) when Mod =/= LastMod -> {PreCases, NextMod, NextRef} = do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod), - PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef, FwMod)]; + PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, + NextRef, FwMod)]; add_init_and_end_per_suite([{skip_case,{conf,_,{Mod,_},_}}=Case|Cases], LastMod, LastRef, FwMod) when Mod =/= LastMod -> {PreCases, NextMod, NextRef} = do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod), - PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef, FwMod)]; + PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, + NextRef, FwMod)]; add_init_and_end_per_suite([{conf,Ref,Props,{FwMod,Func}}=Case|Cases], LastMod, LastRef, FwMod) -> %% if Mod == FwMod, this conf test is (probably) a test case group where @@ -1977,7 +1981,8 @@ add_init_and_end_per_suite([{conf,_,_,{Mod,_}}=Case|Cases], LastMod, LastRef, FwMod) when Mod =/= LastMod, Mod =/= FwMod -> {PreCases, NextMod, NextRef} = do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod), - PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef, FwMod)]; + PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, + NextRef, FwMod)]; add_init_and_end_per_suite([SkipCase|Cases], LastMod, LastRef, FwMod) when element(1,SkipCase) == skip_case -> [SkipCase|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)]; @@ -1987,12 +1992,14 @@ add_init_and_end_per_suite([{Mod,_}=Case|Cases], LastMod, LastRef, FwMod) when Mod =/= LastMod, Mod =/= FwMod -> {PreCases, NextMod, NextRef} = do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod), - PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef, FwMod)]; + PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, + NextRef, FwMod)]; add_init_and_end_per_suite([{Mod,_,_}=Case|Cases], LastMod, LastRef, FwMod) when Mod =/= LastMod, Mod =/= FwMod -> {PreCases, NextMod, NextRef} = do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod), - PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef, FwMod)]; + PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, + NextRef, FwMod)]; add_init_and_end_per_suite([Case|Cases], LastMod, LastRef, FwMod)-> [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)]; add_init_and_end_per_suite([], _LastMod, undefined, _FwMod) -> @@ -2169,7 +2176,7 @@ run_test_cases(TestSpec, Config, TimetrapData) -> %% comment (which gets printed in the log files) describes why the case %% was skipped. %% -%% {skip_case,{Case,Comment}} A normal test case skipped by the user. +%% {skip_case,{Case,Comment},Mode} A normal test case skipped by the user. %% The comment (which gets printed in the log files) describes why the %% case was skipped. %% @@ -2342,7 +2349,7 @@ run_test_cases_loop([{SkipTag,{Type,Ref,Case,Comment},SkipMode}|Cases], ParentRef -> Reason = {group_result,GrName,failed}, skip_cases_upto(ParentRef, Cases, - Reason, tc, Mode, + Reason, tc, ParentMode, SkipTag) end; false -> @@ -2401,22 +2408,27 @@ run_test_cases_loop([{auto_skip_case,{Case,Comment},SkipMode}|Cases], Config, TimetrapData, Mode, Status) -> {Mod,Func} = skip_case(auto, undefined, get(test_server_case_num)+1, Case, Comment, is_io_buffered(), SkipMode), - test_server_sup:framework_call(report, [tc_auto_skip,{Mod,Func,Comment}]), + test_server_sup:framework_call(report, [tc_auto_skip, + {Mod,{Func,get_name(SkipMode)}, + Comment}]), run_test_cases_loop(Cases, Config, TimetrapData, Mode, update_status(skipped, Mod, Func, Status)); -run_test_cases_loop([{skip_case,{{Mod,all}=Case,Comment}}|Cases], +run_test_cases_loop([{skip_case,{{Mod,all}=Case,Comment},SkipMode}|Cases], Config, TimetrapData, Mode, Status) -> - skip_case(user, undefined, 0, Case, Comment, false, Mode), + skip_case(user, undefined, 0, Case, Comment, false, SkipMode), test_server_sup:framework_call(report, [tc_user_skip, - {Mod,all,Comment}]), + {Mod,{all,get_name(SkipMode)}, + Comment}]), run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status); -run_test_cases_loop([{skip_case,{Case,Comment}}|Cases], +run_test_cases_loop([{skip_case,{Case,Comment},SkipMode}|Cases], Config, TimetrapData, Mode, Status) -> {Mod,Func} = skip_case(user, undefined, get(test_server_case_num)+1, - Case, Comment, is_io_buffered()), - test_server_sup:framework_call(report, [tc_user_skip,{Mod,Func,Comment}]), + Case, Comment, is_io_buffered(), SkipMode), + test_server_sup:framework_call(report, [tc_user_skip, + {Mod,{Func,get_name(SkipMode)}, + Comment}]), run_test_cases_loop(Cases, Config, TimetrapData, Mode, update_status(skipped, Mod, Func, Status)); @@ -2430,8 +2442,9 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, {Ref,Ref} -> case check_props(parallel, tl(Mode0)) of false -> - %% this is an end conf for a top level parallel group, collect - %% results from the test case processes and calc total time + %% this is an end conf for a top level parallel group, + %% collect results from the test case processes + %% and calc total time OkSkipFail = handle_test_case_io_and_status(), file:set_cwd(filename:dirname(get(test_server_dir))), After = ?now, @@ -2955,7 +2968,6 @@ get_tc_results([{_,{OkSkipFail,_}} | _Status]) -> get_tc_results([]) -> % in case init_per_suite crashed {[],[],[]}. - conf(Ref, Props) -> {Ref,Props,?now}. @@ -3160,10 +3172,6 @@ random_order(N, {Pos,NewSeed}, IxCases, Shuffled) -> %% SendSync determines if start and finished messages must be sent so %% that the printouts can be buffered and handled in order with io from %% parallel processes. - -skip_case(Type, Ref, CaseNum, Case, Comment, SendSync) -> - skip_case(Type, Ref, CaseNum, Case, Comment, SendSync, []). - skip_case(Type, Ref, CaseNum, Case, Comment, SendSync, Mode) -> MF = {Mod,Func} = case Case of {M,F,_A} -> {M,F}; @@ -3241,7 +3249,7 @@ skip_case1(Type, CaseNum, Mod, Func, Comment, Mode) -> %% SkipType = skip_case | auto_skip_case %% Mark all cases tagged with Ref as skipped. -skip_cases_upto(Ref, Cases, Reason, Origin, Mode, SkipType) -> +skip_cases_upto(Ref, Cases, Reason, Origin, Mode, SkipType) -> {_,Modified,Rest} = modify_cases_upto(Ref, {skip,Reason,Origin,Mode,SkipType}, Cases), Modified++Rest. @@ -3326,21 +3334,34 @@ modify_cases_upto1(Ref, {copy,NewRef}, {[C|Orig],[{skip_case,{Type,NewRef,MF,Cmt}}|Alt],T}; %% next is a skip_case, could be one test case or 'all' in suite, we must proceed -modify_cases_upto1(Ref, ModOp, [{skip_case,{_F,_Cmt}}=MF|T], Orig, Alt) -> +modify_cases_upto1(Ref, ModOp, [{skip_case,{_F,_Cmt},_Mode}=MF|T], Orig, Alt) -> modify_cases_upto1(Ref, ModOp, T, [MF|Orig], [MF|Alt]); %% next is a normal case (possibly in a sequence), mark as skipped, or copy, and proceed -modify_cases_upto1(Ref, {skip,Reason,_,_,skip_case}=Op, +modify_cases_upto1(Ref, {skip,Reason,_,Mode,skip_case}=Op, [{_M,_F}=MF|T], Orig, Alt) -> - modify_cases_upto1(Ref, Op, T, Orig, [{skip_case,{MF,Reason}}|Alt]); + modify_cases_upto1(Ref, Op, T, Orig, [{skip_case,{MF,Reason},Mode}|Alt]); modify_cases_upto1(Ref, {skip,Reason,_,Mode,auto_skip_case}=Op, [{_M,_F}=MF|T], Orig, Alt) -> modify_cases_upto1(Ref, Op, T, Orig, [{auto_skip_case,{MF,Reason},Mode}|Alt]); modify_cases_upto1(Ref, CopyOp, [{_M,_F}=MF|T], Orig, Alt) -> modify_cases_upto1(Ref, CopyOp, T, [MF|Orig], [MF|Alt]); +%% next is a conf case, modify the Mode arg to keep track of sub groups +modify_cases_upto1(Ref, {skip,Reason,FType,Mode,SkipType}, + [{conf,OtherRef,Props,_MF}|T], Orig, Alt) -> + case hd(Mode) of + {OtherRef,_,_} -> % end conf + modify_cases_upto1(Ref, {skip,Reason,FType,tl(Mode),SkipType}, + T, Orig, Alt); + _ -> % start conf + Mode1 = [conf(OtherRef,Props)|Mode], + modify_cases_upto1(Ref, {skip,Reason,FType,Mode1,SkipType}, + T, Orig, Alt) + end; + %% next is some other case, ignore or copy -modify_cases_upto1(Ref, {skip,_,_,_,_}=Op, [_|T], Orig, Alt) -> +modify_cases_upto1(Ref, {skip,_,_,_,_}=Op, [_Other|T], Orig, Alt) -> modify_cases_upto1(Ref, Op, T, Orig, Alt); modify_cases_upto1(Ref, CopyOp, [C|T], Orig, Alt) -> modify_cases_upto1(Ref, CopyOp, T, [C|Orig], [C|Alt]). @@ -3665,12 +3686,13 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, update_config(hd(Args), [{priv_dir,PrivDir++"/"}, {tc_logfile,MinorName}]) end, - + GrName = get_name(Mode), test_server_sup:framework_call(report, - [tc_start,{{Mod,Func},MinorName}]), + [tc_start,{{Mod,{Func,GrName}}, + MinorName}]), print_props((RunInit==skip_init), get_props(Mode)), - GroupName = case get_name(Mode) of + GrNameStr = case GrName of undefined -> ""; Name -> cast_to_list(Name) end, @@ -3683,14 +3705,14 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, "<td>" ++ Col0 ++ "~ts" ++ Col1 ++ "</td>" "<td><a href=\"~ts\">~w</a></td>" "<td><a href=\"~ts#top\"><</a> <a href=\"~ts#end\">></a></td>", - [num2str(Num),fw_name(Mod),GroupName,EncMinorBase,Func, + [num2str(Num),fw_name(Mod),GrNameStr,EncMinorBase,Func, EncMinorBase,EncMinorBase]), do_unless_parallel(Main, fun erlang:yield/0), %% run the test case {Result,DetectedFail,ProcsBefore,ProcsAfter} = - run_test_case_apply(Num, Mod, Func, [UpdatedArgs], get_name(Mode), + run_test_case_apply(Num, Mod, Func, [UpdatedArgs], GrName, RunInit, TimetrapData), {Time,RetVal,Loc,Opts,Comment} = case Result of @@ -3709,41 +3731,41 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Status = case {Time,RetVal} of {died,{timetrap_timeout,TimetrapTimeout}} -> - progress(failed, Num, Mod, Func, Loc, + progress(failed, Num, Mod, Func, GrName, Loc, timetrap_timeout, TimetrapTimeout, Comment, Style); {died,Reason} -> - progress(failed, Num, Mod, Func, Loc, Reason, + progress(failed, Num, Mod, Func, GrName, Loc, Reason, Time, Comment, Style); {_,{'EXIT',{Skip,Reason}}} when Skip==skip; Skip==skipped; Skip==auto_skip -> - progress(skip, Num, Mod, Func, Loc, Reason, + progress(skip, Num, Mod, Func, GrName, Loc, Reason, Time, Comment, Style); {_,{'EXIT',_Pid,{Skip,Reason}}} when Skip==skip; Skip==skipped -> - progress(skip, Num, Mod, Func, Loc, Reason, + progress(skip, Num, Mod, Func, GrName, Loc, Reason, Time, Comment, Style); {_,{'EXIT',_Pid,Reason}} -> - progress(failed, Num, Mod, Func, Loc, Reason, + progress(failed, Num, Mod, Func, GrName, Loc, Reason, Time, Comment, Style); {_,{'EXIT',Reason}} -> - progress(failed, Num, Mod, Func, Loc, Reason, + progress(failed, Num, Mod, Func, GrName, Loc, Reason, Time, Comment, Style); {_,{Fail,Reason}} when Fail =:= fail; Fail =:= failed -> - progress(failed, Num, Mod, Func, Loc, Reason, + progress(failed, Num, Mod, Func, GrName, Loc, Reason, Time, Comment, Style); {_,Reason={auto_skip,_Why}} -> - progress(skip, Num, Mod, Func, Loc, Reason, + progress(skip, Num, Mod, Func, GrName, Loc, Reason, Time, Comment, Style); {_,{Skip,Reason}} when Skip==skip; Skip==skipped -> - progress(skip, Num, Mod, Func, Loc, Reason, + progress(skip, Num, Mod, Func, GrName, Loc, Reason, Time, Comment, Style); {Time,RetVal} -> case DetectedFail of [] -> - progress(ok, Num, Mod, Func, Loc, RetVal, + progress(ok, Num, Mod, Func, GrName, Loc, RetVal, Time, Comment, Style); Reason -> - progress(failed, Num, Mod, Func, Loc, Reason, + progress(failed, Num, Mod, Func, GrName, Loc, Reason, Time, Comment, Style) end end, @@ -3848,7 +3870,7 @@ num2str(N) -> integer_to_list(N). %% Note: Strings that are to be written to the minor log must %% be prefixed with "=== " here, or the indentation will be wrong. -progress(skip, CaseNum, Mod, Func, Loc, Reason, Time, +progress(skip, CaseNum, Mod, Func, GrName, Loc, Reason, Time, Comment, {St0,St1}) -> {Reason1,{Color,Ret,ReportTag}} = if_auto_skip(Reason, @@ -3857,7 +3879,7 @@ progress(skip, CaseNum, Mod, Func, Loc, Reason, Time, print(major, "=result ~w: ~p", [ReportTag,Reason1]), print(1, "*** SKIPPED ~ts ***", [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]), - test_server_sup:framework_call(report, [tc_done,{Mod,Func, + test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName}, {ReportTag,Reason1}}]), ReasonStr = reason_to_string(Reason1), ReasonStr1 = lists:flatten([string:strip(S,left) || @@ -3882,13 +3904,13 @@ progress(skip, CaseNum, Mod, Func, Loc, Reason, Time, print(minor, "=== reason = ~ts", [ReasonStr1]), Ret; -progress(failed, CaseNum, Mod, Func, Loc, timetrap_timeout, T, +progress(failed, CaseNum, Mod, Func, GrName, Loc, timetrap_timeout, T, Comment0, {St0,St1}) -> print(major, "=result failed: timeout, ~p", [Loc]), print(1, "*** FAILED ~ts ***", [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]), test_server_sup:framework_call(report, - [tc_done,{Mod,Func, + [tc_done,{Mod,{Func,GrName}, {failed,timetrap_timeout}}]), FormatLastLoc = test_server_sup:format_loc(get_last_loc(Loc)), ErrorReason = io_lib:format("{timetrap_timeout,~ts}", [FormatLastLoc]), @@ -3908,13 +3930,13 @@ progress(failed, CaseNum, Mod, Func, Loc, timetrap_timeout, T, print(minor, "=== reason = timetrap timeout", []), failed; -progress(failed, CaseNum, Mod, Func, Loc, {testcase_aborted,Reason}, _T, +progress(failed, CaseNum, Mod, Func, GrName, Loc, {testcase_aborted,Reason}, _T, Comment0, {St0,St1}) -> print(major, "=result failed: testcase_aborted, ~p", [Loc]), print(1, "*** FAILED ~ts ***", [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]), test_server_sup:framework_call(report, - [tc_done,{Mod,Func, + [tc_done,{Mod,{Func,GrName}, {failed,testcase_aborted}}]), FormatLastLoc = test_server_sup:format_loc(get_last_loc(Loc)), ErrorReason = io_lib:format("{testcase_aborted,~ts}", [FormatLastLoc]), @@ -3934,12 +3956,12 @@ progress(failed, CaseNum, Mod, Func, Loc, {testcase_aborted,Reason}, _T, print(minor, "=== reason = {testcase_aborted,~p}", [Reason]), failed; -progress(failed, CaseNum, Mod, Func, unknown, Reason, Time, +progress(failed, CaseNum, Mod, Func, GrName, unknown, Reason, Time, Comment0, {St0,St1}) -> print(major, "=result failed: ~p, ~w", [Reason,unknown]), print(1, "*** FAILED ~ts ***", [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]), - test_server_sup:framework_call(report, [tc_done,{Mod,Func, + test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName}, {failed,Reason}}]), TimeStr = io_lib:format(if is_float(Time) -> "~.3fs"; true -> "~w" @@ -3970,12 +3992,12 @@ progress(failed, CaseNum, Mod, Func, unknown, Reason, Time, print(minor, "=== reason = " ++ FStr, [FormattedReason]), failed; -progress(failed, CaseNum, Mod, Func, Loc, Reason, Time, +progress(failed, CaseNum, Mod, Func, GrName, Loc, Reason, Time, Comment0, {St0,St1}) -> print(major, "=result failed: ~p, ~p", [Reason,Loc]), print(1, "*** FAILED ~ts ***", [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]), - test_server_sup:framework_call(report, [tc_done,{Mod,Func, + test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName}, {failed,Reason}}]), TimeStr = io_lib:format(if is_float(Time) -> "~.3fs"; true -> "~w" @@ -3997,10 +4019,10 @@ progress(failed, CaseNum, Mod, Func, Loc, Reason, Time, print(minor, "=== reason = " ++ FStr, [FormattedReason]), failed; -progress(ok, _CaseNum, Mod, Func, _Loc, RetVal, Time, +progress(ok, _CaseNum, Mod, Func, GrName, _Loc, RetVal, Time, Comment0, {St0,St1}) -> print(minor, "successfully completed test case", []), - test_server_sup:framework_call(report, [tc_done,{Mod,Func,ok}]), + test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},ok}]), Comment = case RetVal of {comment,RetComment} -> @@ -4489,18 +4511,18 @@ update_config(Config, []) -> collect_all_cases(Top, Skip) when is_list(Skip) -> Result = - case collect_cases(Top, #cc{mod=[],skip=Skip}) of + case collect_cases(Top, #cc{mod=[],skip=Skip}, []) of {ok,Cases,_St} -> Cases; Other -> Other end, Result. -collect_cases([], St) -> {ok,[],St}; -collect_cases([Case|Cs0], St0) -> - case collect_cases(Case, St0) of +collect_cases([], St, _) -> {ok,[],St}; +collect_cases([Case|Cs0], St0, Mode) -> + case collect_cases(Case, St0, Mode) of {ok,FlatCases1,St1} -> - case collect_cases(Cs0, St1) of + case collect_cases(Cs0, St1, Mode) of {ok,FlatCases2,St} -> {ok,FlatCases1 ++ FlatCases2,St}; {error,_Reason} = Error -> Error @@ -4509,39 +4531,41 @@ collect_cases([Case|Cs0], St0) -> end; -collect_cases({module,Case}, St) when is_atom(Case), is_atom(St#cc.mod) -> - collect_case({St#cc.mod,Case}, St); -collect_cases({module,Mod,Case}, St) -> - collect_case({Mod,Case}, St); -collect_cases({module,Mod,Case,Args}, St) -> - collect_case({Mod,Case,Args}, St); - -collect_cases({dir,SubDir}, St) -> - collect_files(SubDir, "*_SUITE", St); -collect_cases({dir,SubDir,Pattern}, St) -> - collect_files(SubDir, Pattern++"*", St); - -collect_cases({conf,InitF,CaseList,FinMF}, St) when is_atom(InitF) -> - collect_cases({conf,[],{St#cc.mod,InitF},CaseList,FinMF}, St); -collect_cases({conf,InitMF,CaseList,FinF}, St) when is_atom(FinF) -> - collect_cases({conf,[],InitMF,CaseList,{St#cc.mod,FinF}}, St); -collect_cases({conf,InitMF,CaseList,FinMF}, St0) -> - collect_cases({conf,[],InitMF,CaseList,FinMF}, St0); -collect_cases({conf,Props,InitF,CaseList,FinMF}, St) when is_atom(InitF) -> +collect_cases({module,Case}, St, Mode) when is_atom(Case), is_atom(St#cc.mod) -> + collect_case({St#cc.mod,Case}, St, Mode); +collect_cases({module,Mod,Case}, St, Mode) -> + collect_case({Mod,Case}, St, Mode); +collect_cases({module,Mod,Case,Args}, St, Mode) -> + collect_case({Mod,Case,Args}, St, Mode); + +collect_cases({dir,SubDir}, St, Mode) -> + collect_files(SubDir, "*_SUITE", St, Mode); +collect_cases({dir,SubDir,Pattern}, St, Mode) -> + collect_files(SubDir, Pattern++"*", St, Mode); + +collect_cases({conf,InitF,CaseList,FinMF}, St, Mode) when is_atom(InitF) -> + collect_cases({conf,[],{St#cc.mod,InitF},CaseList,FinMF}, St, Mode); +collect_cases({conf,InitMF,CaseList,FinF}, St, Mode) when is_atom(FinF) -> + collect_cases({conf,[],InitMF,CaseList,{St#cc.mod,FinF}}, St, Mode); +collect_cases({conf,InitMF,CaseList,FinMF}, St0, Mode) -> + collect_cases({conf,[],InitMF,CaseList,FinMF}, St0, Mode); +collect_cases({conf,Props,InitF,CaseList,FinMF}, St, Mode) when is_atom(InitF) -> case init_props(Props) of {error,_} -> {ok,[],St}; Props1 -> - collect_cases({conf,Props1,{St#cc.mod,InitF},CaseList,FinMF}, St) + collect_cases({conf,Props1,{St#cc.mod,InitF},CaseList,FinMF}, + St, Mode) end; -collect_cases({conf,Props,InitMF,CaseList,FinF}, St) when is_atom(FinF) -> +collect_cases({conf,Props,InitMF,CaseList,FinF}, St, Mode) when is_atom(FinF) -> case init_props(Props) of {error,_} -> {ok,[],St}; Props1 -> - collect_cases({conf,Props1,InitMF,CaseList,{St#cc.mod,FinF}}, St) + collect_cases({conf,Props1,InitMF,CaseList,{St#cc.mod,FinF}}, + St, Mode) end; -collect_cases({conf,Props,InitMF,CaseList,FinMF} = Conf, St) -> +collect_cases({conf,Props,InitMF,CaseList,FinMF} = Conf, St, Mode) -> case init_props(Props) of {error,_} -> {ok,[],St}; @@ -4549,13 +4573,13 @@ collect_cases({conf,Props,InitMF,CaseList,FinMF} = Conf, St) -> Ref = make_ref(), Skips = St#cc.skip, Props2 = [{suite,St#cc.mod} | lists:delete(suite,Props1)], - Mode = [{Ref,Props2,undefined}], + Mode1 = [{Ref,Props2,undefined} | Mode], case in_skip_list({St#cc.mod,Conf}, Skips) of {true,Comment} -> % conf init skipped - {ok,[{skip_case,{conf,Ref,InitMF,Comment},Mode} | + {ok,[{skip_case,{conf,Ref,InitMF,Comment},Mode1} | [] ++ [{conf,Ref,[],FinMF}]],St}; {true,Name,Comment} when is_atom(Name) -> % all cases skipped - case collect_cases(CaseList, St) of + case collect_cases(CaseList, St, Mode1) of {ok,[],_St} = Empty -> Empty; {ok,FlatCases,St1} -> @@ -4563,15 +4587,15 @@ collect_cases({conf,Props,InitMF,CaseList,FinMF} = Conf, St) -> keep_name(Props1), FinMF}], Skipped = skip_cases_upto(Ref, Cases2Skip, Comment, - conf, Mode, skip_case), - {ok,[{skip_case,{conf,Ref,InitMF,Comment},Mode} | + conf, Mode1, skip_case), + {ok,[{skip_case,{conf,Ref,InitMF,Comment},Mode1} | Skipped],St1}; {error,_Reason} = Error -> Error end; {true,ToSkip,_} when is_list(ToSkip) -> % some cases skipped case collect_cases(CaseList, - St#cc{skip=ToSkip++Skips}) of + St#cc{skip=ToSkip++Skips}, Mode1) of {ok,[],_St} = Empty -> Empty; {ok,FlatCases,St1} -> @@ -4583,7 +4607,7 @@ collect_cases({conf,Props,InitMF,CaseList,FinMF} = Conf, St) -> Error end; false -> - case collect_cases(CaseList, St) of + case collect_cases(CaseList, St, Mode1) of {ok,[],_St} = Empty -> Empty; {ok,FlatCases,St1} -> @@ -4597,8 +4621,8 @@ collect_cases({conf,Props,InitMF,CaseList,FinMF} = Conf, St) -> end end; -collect_cases({make,InitMFA,CaseList,FinMFA}, St0) -> - case collect_cases(CaseList, St0) of +collect_cases({make,InitMFA,CaseList,FinMFA}, St0, Mode) -> + case collect_cases(CaseList, St0, Mode) of {ok,[],_St} = Empty -> Empty; {ok,FlatCases,St} -> Ref = make_ref(), @@ -4607,62 +4631,62 @@ collect_cases({make,InitMFA,CaseList,FinMFA}, St0) -> {error,_Reason} = Error -> Error end; -collect_cases({Module, Cases}, St) when is_list(Cases) -> - case (catch collect_case(Cases, St#cc{mod=Module}, [])) of +collect_cases({Module, Cases}, St, Mode) when is_list(Cases) -> + case (catch collect_case(Cases, St#cc{mod=Module}, [], Mode)) of {ok, NewCases, NewSt} -> {ok, NewCases, NewSt}; Other -> {error, Other} end; -collect_cases({_Mod,_Case}=Spec, St) -> - collect_case(Spec, St); +collect_cases({_Mod,_Case}=Spec, St, Mode) -> + collect_case(Spec, St, Mode); -collect_cases({_Mod,_Case,_Args}=Spec, St) -> - collect_case(Spec, St); -collect_cases(Case, St) when is_atom(Case), is_atom(St#cc.mod) -> - collect_case({St#cc.mod,Case}, St); -collect_cases(Other, St) -> +collect_cases({_Mod,_Case,_Args}=Spec, St, Mode) -> + collect_case(Spec, St, Mode); +collect_cases(Case, St, Mode) when is_atom(Case), is_atom(St#cc.mod) -> + collect_case({St#cc.mod,Case}, St, Mode); +collect_cases(Other, St, _Mode) -> {error,{bad_subtest_spec,St#cc.mod,Other}}. -collect_case({Mod,{conf,_,_,_,_}=Conf}, St) -> - collect_case_invoke(Mod, Conf, [], St); +collect_case({Mod,{conf,_,_,_,_}=Conf}, St, Mode) -> + collect_case_invoke(Mod, Conf, [], St, Mode); -collect_case(MFA, St) -> +collect_case(MFA, St, Mode) -> case in_skip_list(MFA, St#cc.skip) of {true,Comment} -> - {ok,[{skip_case,{MFA,Comment}}],St}; + {ok,[{skip_case,{MFA,Comment},Mode}],St}; false -> case MFA of - {Mod,Case} -> collect_case_invoke(Mod, Case, MFA, St); + {Mod,Case} -> collect_case_invoke(Mod, Case, MFA, St, Mode); {_Mod,_Case,_Args} -> {ok,[MFA],St} end end. -collect_case([], St, Acc) -> +collect_case([], St, Acc, _Mode) -> {ok, Acc, St}; -collect_case([Case | Cases], St, Acc) -> - {ok, FlatCases, NewSt} = collect_case({St#cc.mod, Case}, St), - collect_case(Cases, NewSt, Acc ++ FlatCases). +collect_case([Case | Cases], St, Acc, Mode) -> + {ok, FlatCases, NewSt} = collect_case({St#cc.mod, Case}, St, Mode), + collect_case(Cases, NewSt, Acc ++ FlatCases, Mode). -collect_case_invoke(Mod, Case, MFA, St) -> +collect_case_invoke(Mod, Case, MFA, St, Mode) -> case get_fw_mod(undefined) of undefined -> case catch apply(Mod, Case, [suite]) of {'EXIT',_} -> {ok,[MFA],St}; Suite -> - collect_subcases(Mod, Case, MFA, St, Suite) + collect_subcases(Mod, Case, MFA, St, Suite, Mode) end; _ -> Suite = test_server_sup:framework_call(get_suite, [Mod,Case], []), - collect_subcases(Mod, Case, MFA, St, Suite) + collect_subcases(Mod, Case, MFA, St, Suite, Mode) end. -collect_subcases(Mod, Case, MFA, St, Suite) -> +collect_subcases(Mod, Case, MFA, St, Suite, Mode) -> case Suite of [] when Case == all -> {ok,[],St}; [] when element(1, Case) == conf -> {ok,[],St}; @@ -4670,28 +4694,28 @@ collect_subcases(Mod, Case, MFA, St, Suite) -> %%%! --- START Kept for backwards compatibility --- %%%! Requirements are not used {req,ReqList} -> - collect_case_deny(Mod, Case, MFA, ReqList, [], St); + collect_case_deny(Mod, Case, MFA, ReqList, [], St, Mode); {req,ReqList,SubCases} -> - collect_case_deny(Mod, Case, MFA, ReqList, SubCases, St); + collect_case_deny(Mod, Case, MFA, ReqList, SubCases, St, Mode); %%%! --- END Kept for backwards compatibility --- {Skip,Reason} when Skip==skip; Skip==skipped -> - {ok,[{skip_case,{MFA,Reason}}],St}; + {ok,[{skip_case,{MFA,Reason},Mode}],St}; {error,Reason} -> throw(Reason); SubCases -> - collect_case_subcases(Mod, Case, SubCases, St) + collect_case_subcases(Mod, Case, SubCases, St, Mode) end. -collect_case_subcases(Mod, Case, SubCases, St0) -> +collect_case_subcases(Mod, Case, SubCases, St0, Mode) -> OldMod = St0#cc.mod, - case collect_cases(SubCases, St0#cc{mod=Mod}) of + case collect_cases(SubCases, St0#cc{mod=Mod}, Mode) of {ok,FlatCases,St} -> {ok,FlatCases,St#cc{mod=OldMod}}; {error,Reason} -> {error,{{Mod,Case},Reason}} end. -collect_files(Dir, Pattern, St) -> +collect_files(Dir, Pattern, St, Mode) -> {ok,Cwd} = file:get_cwd(), Dir1 = filename:join(Cwd, Dir), Wc = filename:join([Dir1,Pattern++code:objfile_extension()]), @@ -4701,7 +4725,7 @@ collect_files(Dir, Pattern, St) -> {error,{collect_fail,Dir,Pattern}}; Mods0 -> Mods = [{path_to_module(Mod),all} || Mod <- lists:sort(Mods0)], - collect_cases(Mods, St) + collect_cases(Mods, St, Mode) end. path_to_module(Path) when is_list(Path) -> @@ -4711,14 +4735,14 @@ path_to_module(Path) when is_list(Path) -> %% anyway. It should be removed or renamed! list_to_atom(filename:rootname(filename:basename(Path))). -collect_case_deny(Mod, Case, MFA, ReqList, SubCases, St) -> +collect_case_deny(Mod, Case, MFA, ReqList, SubCases, St, Mode) -> case {check_deny(ReqList, St#cc.skip),SubCases} of {{denied,Comment},_SubCases} -> - {ok,[{skip_case,{MFA,Comment}}],St}; + {ok,[{skip_case,{MFA,Comment},Mode}],St}; {granted,[]} -> {ok,[MFA],St}; {granted,SubCases} -> - collect_case_subcases(Mod, Case, SubCases, St) + collect_case_subcases(Mod, Case, SubCases, St, Mode) end. check_deny([Req|Reqs], DenyList) -> @@ -5476,10 +5500,16 @@ write_html_file(File,Content) -> %% The 'major' log file, which is a pure text file is also written %% with utf8 encoding open_utf8_file(File) -> - file:open(File,[write,{encoding,utf8}]). + case file:open(File,AllOpts=[write,{encoding,utf8}]) of + {error,Reason} -> {error,{Reason,{File,AllOpts}}}; + Result -> Result + end. open_utf8_file(File,Opts) -> - file:open(File,[{encoding,utf8}|Opts]). + case file:open(File,AllOpts=[{encoding,utf8}|Opts]) of + {error,Reason} -> {error,{Reason,{File,AllOpts}}}; + Result -> Result + end. %% Write a file with specified encoding write_file(File,Content,latin1) -> diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl index 3cfa84a52f..96e369a138 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/test_server/src/test_server_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2014. 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 @@ -469,7 +469,7 @@ check_instruction(_, {add_application, Application, Type}, _, _) -> check_instruction(_, Instr, _, _) -> throw({error, {low_level_or_invalid_instruction, Instr}}). -check_module(Module, Modules) when is_atom(Module) -> +check_module(Module, Modules) -> case {is_atom(Module), lists:member(Module, Modules)} of {true, true} -> ok; {true, false} -> throw({error, {unknown_module, Module}}); diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl index 11d6f7af4d..bc7d244c7c 100644 --- a/lib/test_server/src/ts.erl +++ b/lib/test_server/src/ts.erl @@ -24,7 +24,7 @@ -module(ts). --export([run/0, run/1, run/2, run/3, run/4, +-export([run/0, run/1, run/2, run/3, run/4, run/5, tests/0, tests/1, install/0, install/1, bench/0, bench/1, bench/2, benchmarks/0, @@ -389,6 +389,16 @@ run(Testspec, Mod, Grs={group,_Groups}, Config) when is_atom(Testspec), Args = [{suite,Mod},Grs], run_test(atom_to_list(Testspec), Args, Options). +%% run/5 +%% Run one or more test cases in a group with Options. +run(Testspec, Mod, Group, Cases, Config) when is_atom(Testspec), + is_atom(Mod), + is_list(Config) -> + Group1 = if is_tuple(Group) -> Group; true -> {group,Group} end, + Cases1 = if is_tuple(Cases) -> Cases; true -> {testcase,Cases} end, + Options=check_test_get_opts(Testspec, Config), + Args = [{suite,Mod},Group1,Cases1], + run_test(atom_to_list(Testspec), Args, Options). is_list_of_suites(List) -> lists:all(fun(Suite) -> diff --git a/lib/test_server/src/ts.unix.config b/lib/test_server/src/ts.unix.config index a34857b9e5..1ba5d9033e 100644 --- a/lib/test_server/src/ts.unix.config +++ b/lib/test_server/src/ts.unix.config @@ -3,4 +3,4 @@ %% Always run a (VNC) X server on host %% {xserver, "xserver.example.com:66"}. -{unix,[{telnet,"belegost"},{username,"bofh"},{password,"root"},{keep_alive,true}]}. +{unix,[{telnet,"belegost"},{username,"telnet-test"},{password,"tset-tenlet"},{keep_alive,true}]}. diff --git a/lib/test_server/src/ts_run.erl b/lib/test_server/src/ts_run.erl index d96abfc55a..18d021f780 100644 --- a/lib/test_server/src/ts_run.erl +++ b/lib/test_server/src/ts_run.erl @@ -398,8 +398,9 @@ make_common_test_args(Args0, Options0, _Vars) -> end, ConfigFiles = [{config,[filename:join(ConfigPath,File) || File <- get_config_files()]}], - io_lib:format("~100000p",[Args0++Trace++Cover++Logdir++ - ConfigFiles++Options++TimeTrap]). + io_lib:format("~100000p",[[{abort_if_missing_suites,true} | + Args0++Trace++Cover++Logdir++ + ConfigFiles++Options++TimeTrap]]). to_list(X) when is_atom(X) -> atom_to_list(X); diff --git a/lib/test_server/vsn.mk b/lib/test_server/vsn.mk index 6871b5bd14..4eb70aa2cd 100644 --- a/lib/test_server/vsn.mk +++ b/lib/test_server/vsn.mk @@ -1 +1 @@ -TEST_SERVER_VSN = 3.6.4 +TEST_SERVER_VSN = 3.7 diff --git a/lib/tools/c_src/Makefile.in b/lib/tools/c_src/Makefile.in index aea5686ae9..b1eb69f9dc 100644 --- a/lib/tools/c_src/Makefile.in +++ b/lib/tools/c_src/Makefile.in @@ -96,8 +96,11 @@ DRIVERS= ifneq ($(strip $(ETHR_LIB_NAME)),) # Need ethread package for emem +ifneq ($(findstring ose,$(TARGET)),ose) +# Do not build on OSE PROGS += $(BIN_DIR)/emem$(TYPEMARKER)@EXEEXT@ endif +endif EMEM_OBJ_DIR=$(OBJ_DIR)/emem CREATE_DIRS += $(EMEM_OBJ_DIR) @@ -148,7 +151,12 @@ ERTS_LIB = $(ERL_TOP/erts/lib_src/obj/$(TARGET)/$(TYPE)/MADE _create_dirs := $(shell mkdir -p $(CREATE_DIRS)) +ifneq ($(findstring ose,$(TARGET)),ose) all: $(PROGS) $(DRIVERS) +else +# Do not build dynamic files on OSE +all: +endif $(ERTS_LIB): $(make_verbose)cd $(ERL_TOP)/erts/lib_src && $(MAKE) $(TYPE) diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index f007f780eb..ec5a1f4bc5 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -1420,6 +1420,10 @@ Other commands: (if (boundp 'after-change-major-mode-hook) (run-hooks 'after-change-major-mode-hook))) +;;;###autoload +(dolist (r '("\\.erl$" "\\.app\\.src$" "\\.escript" + "\\.hrl$" "\\.xrl$" "\\.yrl" "/ebin/.+\\.app")) + (add-to-list 'auto-mode-alist (cons r 'erlang-mode))) (defun erlang-syntax-table-init () (if (null erlang-mode-syntax-table) @@ -2570,9 +2574,9 @@ Value is list (stack token-start token-type in-what)." (erlang-pop stack)) (if (and stack (memq (car (car stack)) '(icr begin fun try))) (erlang-pop stack)))) - ((looking-at "catch.*of") + ((looking-at "catch\\b.*of") t) - ((looking-at "catch\\s *\\($\\|%\\|.*->\\)") + ((looking-at "catch\\b\\s *\\($\\|%\\|.*->\\)") ;; Must pop top icr layer, `catch' in try/catch ;;will push a new layer next. (progn @@ -2620,9 +2624,9 @@ Value is list (stack token-start token-type in-what)." ;;((looking-at "when\\s *\\($\\|%\\)") ((looking-at "when[^_a-zA-Z0-9]") (erlang-push (list 'when token (current-column)) stack)) - ((looking-at "catch.*of") + ((looking-at "catch\\b.*of") t) - ((looking-at "catch\\s *\\($\\|%\\|.*->\\)") + ((looking-at "catch\\b\\s *\\($\\|%\\|.*->\\)") (erlang-push (list 'icr token (current-column)) stack)) ;;(erlang-push (list '-> token (current-column)) stack)) ;;((looking-at "^of$") @@ -2913,7 +2917,7 @@ Return nil if inside string, t if in a comment." (if stack (erlang-caddr (car stack)) 0)) - ((looking-at "catch\\($\\|[^_a-zA-Z0-9]\\)") + ((looking-at "catch\\b\\($\\|[^_a-zA-Z0-9]\\)") ;; Are we in a try (let ((start (if (eq (car stack-top) '->) (car (cdr stack)) @@ -3124,12 +3128,12 @@ This assumes that the preceding expression is either simple (defun erlang-at-keyword () "Are we looking at an Erlang keyword which will increase indentation?" (looking-at (concat "\\(when\\|if\\|fun\\|case\\|begin\\|" - "of\\|receive\\|after\\|catch\\|try\\)[^_a-zA-Z0-9]"))) + "of\\|receive\\|after\\|catch\\|try\\)\\b"))) (defun erlang-at-operator () "Are we looking at an Erlang operator?" (looking-at - "\\(bnot\\|div\\|mod\\|band\\|bor\\|bxor\\|bsl\\|bsr\\)[^_a-zA-Z0-9]")) + "\\(bnot\\|div\\|mod\\|band\\|bor\\|bxor\\|bsl\\|bsr\\)\\b")) (defun erlang-comment-indent () "Compute Erlang comment indentation. diff --git a/lib/tools/emacs/test.erl.indented b/lib/tools/emacs/test.erl.indented index 0dc1b47f0d..1c1086ca58 100644 --- a/lib/tools/emacs/test.erl.indented +++ b/lib/tools/emacs/test.erl.indented @@ -749,3 +749,14 @@ commas_first() -> %% this used to result in a scan-sexp error [{ }]. + +%% this used to result in 2x the correct indentation within the function +%% body, due to the function name being mistaken for a keyword +catcher(N) -> + try generate_exception(N) of + Val -> {N, normal, Val} + catch + throw:X -> {N, caught, thrown, X}; + exit:X -> {N, caught, exited, X}; + error:X -> {N, caught, error, X} + end. diff --git a/lib/tools/emacs/test.erl.orig b/lib/tools/emacs/test.erl.orig index c7d2dc4ce5..a9d09000d2 100644 --- a/lib/tools/emacs/test.erl.orig +++ b/lib/tools/emacs/test.erl.orig @@ -749,3 +749,14 @@ commas_first() -> %% this used to result in a scan-sexp error [{ }]. + +%% this used to result in 2x the correct indentation within the function +%% body, due to the function name being mistaken for a keyword +catcher(N) -> +try generate_exception(N) of +Val -> {N, normal, Val} +catch +throw:X -> {N, caught, thrown, X}; +exit:X -> {N, caught, exited, X}; +error:X -> {N, caught, error, X} +end. diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index a24d70ed92..113fa24bd5 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -1764,6 +1764,25 @@ munge_expr({record,Line,Arg,Name,Exprs}, Vars) -> munge_expr({record_field,Line,ExprL,ExprR}, Vars) -> {MungedExprR, Vars2} = munge_expr(ExprR, Vars), {{record_field,Line,ExprL,MungedExprR}, Vars2}; +munge_expr({map,Line,Fields}, Vars) -> + %% EEP 43 + {MungedFields, Vars2} = munge_exprs(Fields, Vars, []), + {{map,Line,MungedFields}, Vars2}; +munge_expr({map,Line,Arg,Fields}, Vars) -> + %% EEP 43 + {MungedArg, Vars2} = munge_expr(Arg, Vars), + {MungedFields, Vars3} = munge_exprs(Fields, Vars2, []), + {{map,Line,MungedArg,MungedFields}, Vars3}; +munge_expr({map_field_assoc,Line,Name,Value}, Vars) -> + %% EEP 43 + {MungedName, Vars2} = munge_expr(Name, Vars), + {MungedValue, Vars3} = munge_expr(Value, Vars2), + {{map_field_assoc,Line,MungedName,MungedValue}, Vars3}; +munge_expr({map_field_exact,Line,Name,Value}, Vars) -> + %% EEP 43 + {MungedName, Vars2} = munge_expr(Name, Vars), + {MungedValue, Vars3} = munge_expr(Value, Vars2), + {{map_field_exact,Line,MungedName,MungedValue}, Vars3}; munge_expr({cons,Line,ExprH,ExprT}, Vars) -> {MungedExprH, Vars2} = munge_expr(ExprH, Vars), {MungedExprT, Vars3} = munge_expr(ExprT, Vars2), diff --git a/lib/tools/src/tools.app.src b/lib/tools/src/tools.app.src index 553c5eb96b..ec5b6f3a82 100644 --- a/lib/tools/src/tools.app.src +++ b/lib/tools/src/tools.app.src @@ -39,23 +39,9 @@ {applications, [kernel, stdlib]}, {env, [{file_util_search_methods,[{"", ""}, {"ebin", "esrc"}, {"ebin", "src"}]} ] - } + }, + {runtime_dependencies, ["webtool-0.8.10","stdlib-2.0","runtime_tools-1.8.14", + "kernel-3.0","inets-5.10","erts-6.0", + "compiler-5.0"]} ] }. - - - - - - - - - - - - - - - - - diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index ec61c57cec..80807b1d38 100644 --- a/lib/tools/test/cover_SUITE.erl +++ b/lib/tools/test/cover_SUITE.erl @@ -516,13 +516,11 @@ reconnect(Config) -> cover:flush(N1), rpc:call(N1,f,f1,[]), - %% This will cause a call to f:f2() when nodes()==[] on N1 + %% This will cause first casue the N1 node to initiate a + %% disconnect and then call f:f2() when nodes() =:= [] on N1. rpc:cast(N1,f,call_f2_when_isolated,[]), - - %% Disconnect and check that node is removed from main cover node - net_kernel:disconnect(N1), timer:sleep(500), % allow some to detect disconnect and for f:f2() call - [] = cover:which_nodes(), + cover_which_nodes([]), %% Do some add one module (b) and remove one module (a) code:purge(a), @@ -530,7 +528,7 @@ reconnect(Config) -> {ok,b} = cover:compile(b), cover_compiled = code:which(b), - [] = cover:which_nodes(), + cover_which_nodes([]), check_f_calls(1,0), % only the first call - before the flush %% Reconnect the node and check that b and f are cover compiled but not a @@ -573,7 +571,7 @@ die_and_reconnect(Config) -> %% Kill the node rpc:call(N1,erlang,halt,[]), - [] = cover:which_nodes(), + cover_which_nodes([]), check_f_calls(1,0), % only the first call - before the flush @@ -614,7 +612,7 @@ dont_reconnect_after_stop(Config) -> %% Stop cover on the node, then terminate the node cover:stop(N1), rpc:call(N1,erlang,halt,[]), - [] = cover:which_nodes(), + cover_which_nodes([]), check_f_calls(1,0), @@ -622,7 +620,7 @@ dont_reconnect_after_stop(Config) -> {ok,N1} = ?t:start_node(NodeName,peer, [{args," -pa " ++ DataDir},{start_cover,false}]), timer:sleep(300), - [] = cover:which_nodes(), + cover_which_nodes([]), Beam = rpc:call(N1,code,which,[f]), false = (Beam==cover_compiled), @@ -667,7 +665,7 @@ stop_node_after_disconnect(Config) -> {ok,N1} = ?t:start_node(NodeName,peer, [{args," -pa " ++ DataDir},{start_cover,false}]), timer:sleep(300), - [] = cover:which_nodes(), + cover_which_nodes([]), Beam = rpc:call(N1,code,which,[f]), false = (Beam==cover_compiled), @@ -1575,3 +1573,21 @@ is_unloaded(What) -> check_f_calls(F1,F2) -> {ok,[{{f,f1,0},F1},{{f,f2,0},F2}|_]} = cover:analyse(f,calls,function). + +cover_which_nodes(Expected) -> + case cover:which_nodes() of + Expected -> + ok; + Other -> + {Time,ok} = timer:tc(fun Retry() -> + case cover:which_nodes() of + Expected -> ok; + _ -> + ?t:sleep(100), + Retry() + end + end), + io:format("~p ms before cover:which_nodes() returned ~p", + [Time,Expected]), + Expected = Other + end. diff --git a/lib/tools/test/cover_SUITE_data/f.erl b/lib/tools/test/cover_SUITE_data/f.erl index ce2963014a..a29a67b388 100644 --- a/lib/tools/test/cover_SUITE_data/f.erl +++ b/lib/tools/test/cover_SUITE_data/f.erl @@ -10,10 +10,15 @@ f2() -> f2_line2. call_f2_when_isolated() -> + [Other] = nodes(), + net_kernel:disconnect(Other), + do_call_f2_when_isolated(). + +do_call_f2_when_isolated() -> case nodes() of [] -> f2(); _ -> timer:sleep(100), - call_f2_when_isolated() + do_call_f2_when_isolated() end. diff --git a/lib/tools/vsn.mk b/lib/tools/vsn.mk index 0cead00554..2d2970de3a 100644 --- a/lib/tools/vsn.mk +++ b/lib/tools/vsn.mk @@ -1 +1 @@ -TOOLS_VSN = 2.6.13 +TOOLS_VSN = 2.6.14 diff --git a/lib/typer/src/typer.app.src b/lib/typer/src/typer.app.src index 850829e1dc..974091b44c 100644 --- a/lib/typer/src/typer.app.src +++ b/lib/typer/src/typer.app.src @@ -6,4 +6,6 @@ {modules, [typer]}, {registered, []}, {applications, [compiler, dialyzer, hipe, kernel, stdlib]}, - {env, []}]}. + {env, []}, + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","hipe-3.10.3","erts-6.0", + "dialyzer-2.7","compiler-5.0"]}]}. diff --git a/lib/typer/vsn.mk b/lib/typer/vsn.mk index 5ac145d9ff..49fdda756e 100644 --- a/lib/typer/vsn.mk +++ b/lib/typer/vsn.mk @@ -1 +1 @@ -TYPER_VSN = 0.9.5 +TYPER_VSN = 0.9.6 diff --git a/lib/webtool/src/webtool.app.src b/lib/webtool/src/webtool.app.src index 8c6774c533..3d8d11ea60 100644 --- a/lib/webtool/src/webtool.app.src +++ b/lib/webtool/src/webtool.app.src @@ -21,5 +21,7 @@ {vsn,"%VSN%"}, {modules,[webtool,webtool_sup]}, {registered,[web_tool,websup]}, - {applications,[kernel,stdlib]}]}. + {applications,[kernel,stdlib]}, + {runtime_dependencies, ["stdlib-2.0","observer-2.0","kernel-3.0", + "inets-5.10","erts-6.0"]}]}. diff --git a/lib/webtool/vsn.mk b/lib/webtool/vsn.mk index d356a8954d..a79c273d9f 100644 --- a/lib/webtool/vsn.mk +++ b/lib/webtool/vsn.mk @@ -1 +1 @@ -WEBTOOL_VSN=0.8.9.2 +WEBTOOL_VSN=0.8.10 diff --git a/lib/wx/aclocal.m4 b/lib/wx/aclocal.m4 index 46b30a16b3..2b47f7c4bc 100644 --- a/lib/wx/aclocal.m4 +++ b/lib/wx/aclocal.m4 @@ -74,6 +74,21 @@ AC_ARG_VAR(erl_xcomp_clock_gettime_cpu_time, [clock_gettime() can be used for re AC_ARG_VAR(erl_xcomp_after_morecore_hook, [__after_morecore_hook can track malloc()s core memory usage: yes|no (only used when cross compiling)]) AC_ARG_VAR(erl_xcomp_dlsym_brk_wrappers, [dlsym(RTLD_NEXT, _) brk wrappers can track malloc()s core memory usage: yes|no (only used when cross compiling)]) +dnl Cross compilation variables for OSE +AC_ARG_VAR(erl_xcomp_ose_ldflags_pass1, [Linker flags for the OSE module (pass 1) (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_ldflags_pass2, [Linker flags for the OSE module (pass 2) (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_OSEROOT, [OSE installation root directory (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_STRIP, [Strip utility shipped with the OSE distribution(only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_POST_LINK, [OSE postlink tool (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_SET_CONF, [Sets the configuration for an OSE load module (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_ELF_SIZE, [Prints the section size information for an OSE load module (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_LM_LCF, [OSE load module linker configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_BEAM_LM_CONF, [BEAM OSE load module default configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_EPMD_LM_CONF, [EPMD OSE load module default configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_RUN_ERL_LM_CONF, [run_erl_lm OSE load module default configuration file (only used when cross compiling for OSE)]) +AC_ARG_VAR(erl_xcomp_ose_CONFD, [OSE confd source file]) +AC_ARG_VAR(erl_xcomp_ose_CRT0_LM, [OSE crt0 lm source file]) + ]) AC_DEFUN(ERL_XCOMP_SYSROOT_INIT, @@ -488,6 +503,8 @@ AC_CACHE_VAL(ac_cv_sys_ipv6_support, #ifdef __WIN32__ #include <winsock2.h> #include <ws2tcpip.h> +#elif __OSE__ +#error "no ipv6" #else #include <netinet/in.h> #endif], @@ -500,6 +517,8 @@ else #ifdef __WIN32__ #include <winsock2.h> #include <ws2tcpip.h> +#elif __OSE__ +#error "no ipv6" #else #include <netinet/in.h> #endif], @@ -728,6 +747,12 @@ if test "X$host_os" = "Xwin32"; then THR_LIBS= THR_LIB_NAME=win32_threads THR_LIB_TYPE=win32_threads +elif test "X$host_os" = "Xose"; then + AC_MSG_RESULT(yes) + THR_DEFS="-DOSE_THREADS" + THR_LIBS= + THR_LIB_NAME=ose_threads + THR_LIB_TYPE=ose_threads else AC_MSG_RESULT(no) THR_DEFS= @@ -1078,9 +1103,22 @@ case "$THR_LIB_NAME" in test "$ethr_have_native_atomics" = "yes" && ethr_have_native_spinlock=yes ;; - pthread) - ETHR_THR_LIB_BASE_DIR=pthread - AC_DEFINE(ETHR_PTHREADS, 1, [Define if you have pthreads]) + pthread|ose_threads) + case "$THR_LIB_NAME" in + pthread) + ETHR_THR_LIB_BASE_DIR=pthread + AC_DEFINE(ETHR_PTHREADS, 1, [Define if you have pthreads]) + ;; + ose_threads) + AC_DEFINE(ETHR_OSE_THREADS, 1, + [Define if you have OSE style threads]) + ETHR_THR_LIB_BASE_DIR=ose + AC_CHECK_HEADER(ose_spi/ose_spi.h, + AC_DEFINE(HAVE_OSE_SPI_H, 1, + [Define if you have the "ose_spi/ose_spi.h" header file.])) + ;; + esac + if test "x$THR_LIB_NAME" == "xpthread"; then case $host_os in openbsd*) # The default stack size is insufficient for our needs @@ -1139,6 +1177,7 @@ case "$THR_LIB_NAME" in *) ;; esac + fi dnl We sometimes need ETHR_DEFS in order to find certain headers dnl (at least for pthread.h on osf1). saved_cppflags="$CPPFLAGS" @@ -1151,7 +1190,6 @@ case "$THR_LIB_NAME" in dnl dnl Check for headers dnl - AC_CHECK_HEADER(pthread.h, \ AC_DEFINE(ETHR_HAVE_PTHREAD_H, 1, \ [Define if you have the <pthread.h> header file.])) @@ -1184,7 +1222,7 @@ case "$THR_LIB_NAME" in dnl dnl Check for functions dnl - + if test "x$THR_LIB_NAME" == "xpthread"; then AC_CHECK_FUNC(pthread_spin_lock, \ [ethr_have_native_spinlock=yes \ AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \ @@ -1311,6 +1349,8 @@ case "$THR_LIB_NAME" in AC_MSG_RESULT([$linux_futex]) test $linux_futex = yes && AC_DEFINE(ETHR_HAVE_LINUX_FUTEX, 1, [Define if you have a linux futex implementation.]) + fi + AC_CHECK_SIZEOF(int) AC_CHECK_SIZEOF(long) AC_CHECK_SIZEOF(long long) diff --git a/lib/wx/src/wx.app.src b/lib/wx/src/wx.app.src index e13982b0c1..d5ac478f20 100644 --- a/lib/wx/src/wx.app.src +++ b/lib/wx/src/wx.app.src @@ -33,5 +33,6 @@ ]}, {registered, []}, {applications, [stdlib, kernel]}, - {env, []} + {env, []}, + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0"]} ]}. diff --git a/lib/wx/test/wx_basic_SUITE.erl b/lib/wx/test/wx_basic_SUITE.erl index 7bdbd4594c..e3bbb21a23 100644 --- a/lib/wx/test/wx_basic_SUITE.erl +++ b/lib/wx/test/wx_basic_SUITE.erl @@ -341,23 +341,22 @@ wx_object(Config) -> Me = self(), ?m({call, foobar, {Me, _}}, wx_object:call(Frame, foobar)), ?m(ok, wx_object:cast(Frame, foobar2)), - ?m([{cast, foobar2}], flush()), + ?m([{cast, foobar2}|_], flush()), FramePid = wx_object:get_pid(Frame), io:format("wx_object pid ~p~n",[FramePid]), FramePid ! foo3, - ?m([{info, foo3}], flush()), + ?m([{info, foo3}|_], flush()), ?m(ok, wx_object:cast(Frame, fun(_) -> hehe end)), - ?m([{cast, hehe}], flush()), + ?m([{cast, hehe}|_], flush()), wxWindow:refresh(Frame), - ?m([{sync_event, #wx{event=#wxPaint{}}, _}], flush()), + ?m([{sync_event, #wx{event=#wxPaint{}}, _}|_], flush()), ?m(ok, wx_object:cast(Frame, fun(_) -> timer:sleep(200), slept end)), %% The sleep above should not hinder the Paint event below %% Which it did in my buggy handling of the sync_callback wxWindow:refresh(Frame), - ?m([{sync_event, #wx{event=#wxPaint{}}, _}], flush()), timer:sleep(500), - ?m([{cast, slept}], flush()), + ?m([{sync_event, #wx{event=#wxPaint{}}, _}, {cast, slept}|_], flush()), Monitor = erlang:monitor(process, FramePid), case proplists:get_value(user, Config, false) of @@ -397,7 +396,7 @@ check_events([], Async, Sync) -> end. flush() -> - flush([], 500). + flush([], 1500). flush(Acc, Wait) -> receive diff --git a/lib/wx/vsn.mk b/lib/wx/vsn.mk index c018b4fb86..5523c20440 100644 --- a/lib/wx/vsn.mk +++ b/lib/wx/vsn.mk @@ -1 +1 @@ -WX_VSN = 1.1.2 +WX_VSN = 1.2 diff --git a/lib/xmerl/src/xmerl.app.src b/lib/xmerl/src/xmerl.app.src index b471447bbd..45cfe9d250 100644 --- a/lib/xmerl/src/xmerl.app.src +++ b/lib/xmerl/src/xmerl.app.src @@ -39,5 +39,6 @@ {registered, []}, {env, []}, - {applications, [kernel, stdlib]} + {applications, [kernel, stdlib]}, + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0"]} ]}. diff --git a/lib/xmerl/vsn.mk b/lib/xmerl/vsn.mk index 333466c11e..aab2a37d6c 100644 --- a/lib/xmerl/vsn.mk +++ b/lib/xmerl/vsn.mk @@ -1 +1 @@ -XMERL_VSN = 1.3.6 +XMERL_VSN = 1.3.7 diff --git a/make/ose_lm.mk.in b/make/ose_lm.mk.in new file mode 100644 index 0000000000..5455ad94c6 --- /dev/null +++ b/make/ose_lm.mk.in @@ -0,0 +1,75 @@ +#-*-makefile-*- ; force emacs to enter makefile-mode +# ---------------------------------------------------- +# Template target for generating an OSE5 load module +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2013. 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% +# +# Author: Petre Pircalabu +# ---------------------------------------------------- + +# ---------------------------------------------------- +# build-ose-load-module +# Creates an OSE5 load module +# params: +# $(1) - The output target +# $(2) - Objects +# $(3) - Libraries +# $(4) - LM configuration file +# ---------------------------------------------------- + +ifeq ($(findstring ose,$(TARGET)),ose) +LDR1FLAGS = @erl_xcomp_ose_ldflags_pass1@ +LDR2FLAGS = @erl_xcomp_ose_ldflags_pass2@ +OSEROOT = @erl_xcomp_ose_OSEROOT@ +LCF = @erl_xcomp_ose_LM_LCF@ +BEAM_LMCONF = @erl_xcomp_ose_BEAM_LM_CONF@ +EPMD_LMCONF = @erl_xcomp_ose_EPMD_LM_CONF@ +RUN_ERL_LMCONF = @erl_xcomp_ose_RUN_ERL_LM_CONF@ +STRIP = @erl_xcomp_ose_STRIP@ +LM_POST_LINK = @erl_xcomp_ose_LM_POST_LINK@ +LM_SET_CONF = @erl_xcomp_ose_LM_SET_CONF@ +LM_ELF_SIZE = @erl_xcomp_ose_LM_ELF_SIZE@ +OSE_CONFD = @erl_xcomp_ose_CONFD@ +CRT0_LM = @erl_xcomp_ose_CRT0_LM@ +endif + +define build-ose-load-module + @echo " --- Linking $(1)" + + @echo " --- Linking $(1) (pass 1)" + $(ld_verbose)$(PURIFY) $(LD) -o $(1)_unconfigured_ro -r \ + $(2) --start-group $(3) --end-group --cref --discard-none -M > $(1)_1.map + + @echo " --- Linking $(1) (pass 2)" + $(ld_verbose)$(PURIFY) $(LD) -o $(1)_unconfigured \ + $(1)_unconfigured_ro -T $(LCF) -n --emit-relocs -e crt0_lm --cref \ + --discard-none -M > $(1)_2.map + + @echo " --- Inserting configuration" + $(ld_verbose) $(LM_SET_CONF) $(1)_unconfigured < $(4) + + @echo " --- Striping $(1)" +# $(ld_verbose) $(STRIP) $(1)_unconfigured + + @echo " --- Postlinking $(1)" + $(ld_verbose) $(LM_POST_LINK) $(1)_unconfigured + + @echo " --- Sizing $(1)" + $(ld_verbose) $(LM_ELF_SIZE) $(1)_unconfigured + mv $(1)_unconfigured $(1) +endef diff --git a/make/otp_released_app.mk b/make/otp_released_app.mk new file mode 100644 index 0000000000..fb5205ab23 --- /dev/null +++ b/make/otp_released_app.mk @@ -0,0 +1,43 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2014. 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% + +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk +include $(APP_PWD)/vsn.mk +include $(ERL_TOP)/make/otp_default_release_path.mk + +RELEASED_APP_VSN=$(APP)-$($(APP_VSN)) +ifeq ($(TESTROOT),) +REL_DIR=$(OTP_DEFAULT_RELEASE_PATH)/releases/$(SYSTEM_VSN) +else +REL_DIR=$(TESTROOT)/releases/$(SYSTEM_VSN) +endif +INST_APP_VSNS=$(REL_DIR)/installed_application_versions + +.PHONY: update + +update: + test -d "$(REL_DIR)" || mkdir -p "$(REL_DIR)" ; \ + if test ! -f "$(INST_APP_VSNS)" ; then \ + echo "$(RELEASED_APP_VSN)" > "$(INST_APP_VSNS)" || exit 1; \ + else \ + if test x = x`grep $(RELEASED_APP_VSN) "$(INST_APP_VSNS)"` ; then \ + echo $(RELEASED_APP_VSN) >> "$(INST_APP_VSNS)" || exit 1; \ + fi ; \ + fi + diff --git a/make/otp_subdir.mk b/make/otp_subdir.mk index f31ab05c87..e6a75cce17 100644 --- a/make/otp_subdir.mk +++ b/make/otp_subdir.mk @@ -44,5 +44,14 @@ opt debug release docs release_docs tests release_tests clean depend valgrind st fi ; \ done ; \ if test -f vsn.mk; then \ + if test release = $@ && test ! -f SKIP; then \ + app=`basename $$app_pwd` ; \ + app_vsn=`echo $$app | sed "y|abcdefghijklmnopqrstuvwxyz|ABCDEFGHIJKLMNOPQRSTUVWXYZ|"` ; \ + app_vsn=$${app_vsn}_VSN ; \ + ( $(MAKE) -f "$(ERL_TOP)/make/otp_released_app.mk" \ + APP_PWD="$$app_pwd" APP_VSN=$$app_vsn APP=$$app \ + TESTROOT="$(TESTROOT)" update) \ + || exit $$? ; \ + fi ; \ echo "=== Leaving application" `basename $$app_pwd` ; \ fi diff --git a/make/verify_runtime_dependencies b/make/verify_runtime_dependencies new file mode 100755 index 0000000000..b8eea06b6e --- /dev/null +++ b/make/verify_runtime_dependencies @@ -0,0 +1,313 @@ +#!/usr/bin/env escript +%% -*- erlang -*- + +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. 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% +%% + +%%%------------------------------------------------------------------- +%%% @author Rickard Green <[email protected]> +%%% @copyright (C) 2014, Rickard Green +%%% @doc +%%% Verify runtime dependencies when patching OTP applications. +%%% @end +%%% Created : 4 Mar 2014 by Rickard Green <[email protected]> +%%%------------------------------------------------------------------- + +-mode(compile). + +-export([main/1]). + +main(Args) -> + {Force, Release, SourceDir, TargetDir, AppList} = parse_args(Args, + false, + [], + [], + [], + []), + SourceAppInfo = read_source_app_info(AppList, SourceDir), + AppVsnsTab0 = current_target_app_vsns(TargetDir, Release), + AppVsnsTab1 = add_source_app_vsns(SourceAppInfo, AppVsnsTab0), + case verify_runtime_deps(SourceAppInfo, AppVsnsTab1, true) of + true -> + ok; + false -> + case Force of + true -> + warn("Your OTP development system was updated with " + "unfulfilled runtime dependencies. The system " + "may not be working as expected.", []); + false -> + err("Unfulfilled runtime dependencies. " + "See warnings above.~n", []) + end + end, + halt(0). + +parse_args(["-force" | Args], _, Release, SourceDir, TargetDir, Apps) -> + parse_args(Args, true, Release, SourceDir, TargetDir, Apps); +parse_args(["-release", Release | Args], Force, _, SourceDir, TargetDir, Apps) -> + parse_args(Args, Force, Release, SourceDir, TargetDir, Apps); +parse_args(["-source", SourceDir | Args], Force, Release, _, TargetDir, Apps) -> + parse_args(Args, Force, Release, SourceDir, TargetDir, Apps); +parse_args(["-target", TargetDir | Args], Force, Release, SourceDir, _, Apps) -> + parse_args(Args, Force, Release, SourceDir, TargetDir, Apps); +parse_args([App | Args], Force, Release, SourceDir, TargetDir, OldApps) -> + parse_args(Args, Force, Release, SourceDir, TargetDir, [App | OldApps]); +parse_args([], _, [], _, _, _) -> + err("Missing release~n", []); +parse_args([], _, _, [], _, _) -> + err("Missing source directory~n", []); +parse_args([], _, _, _, [], _) -> + err("Missing target directory~n", []); +parse_args([], _, _, _, _, []) -> + err("Missing applications~n"); +parse_args([], Force, Release, SourceDir, TargetDir, Apps) -> + {Force, Release, SourceDir, TargetDir, Apps}. + + +%warn(Format) -> +% warn(Format, []). + +warn(Format, Args) -> + io:format(standard_error, "WARNING: " ++ Format, Args). + +err(Format) -> + err(Format, []). + +err(Format, Args) -> + io:format(standard_error, "ERROR: " ++ Format, Args), + halt(1). + +read_file(FileName) -> + case file:read_file(FileName) of + {ok, Content} -> + binary_to_list(Content); + {error, Error} -> + err("Failed to read ~s: ~p~n", [FileName, Error]) + end. + +consult_file(FileName) -> + case file:consult(FileName) of + {ok, Terms} -> + Terms; + {error, Error} -> + err("Failed to consult ~s: ~p~n", [FileName, Error]) + end. + +current_target_app_vsns(TargetDir, Release) -> + IAV = read_file(filename:join([TargetDir, "releases", Release, + "installed_application_versions"])), + DirList = string:tokens(IAV, "\n\r\t "), + LibDir = filename:join(TargetDir, "lib"), + make_app_vsns_tab(DirList, LibDir, gb_trees:empty()). + +make_app_vsns_tab([], _LibDir, GBT) -> + GBT; +make_app_vsns_tab([AppVer | AppVsns], LibDir, GBT0) -> + GBT1 = try + case file:read_file_info(filename:join(LibDir, AppVer)) of + {ok, _FInfo} -> + [App, Vsn] = string:tokens(AppVer, "-"), + add_app_vsn(App, Vsn, GBT0); + _ -> + GBT0 + end + catch + _:_ -> + warn("Unexpected directory: ~p~n", + [filename:join(LibDir, AppVer)]), + GBT0 + end, + make_app_vsns_tab(AppVsns, LibDir, GBT1). + +add_app_vsn(App, VsnList, GBT) when is_atom(App) -> + Vsn = parse_vsn(VsnList), + case gb_trees:lookup(App, GBT) of + none -> + gb_trees:insert(App, [Vsn], GBT); + {value, Vsns} -> + gb_trees:update(App, [Vsn | Vsns], GBT) + end; +add_app_vsn(AppStr, VsnList, GBT) -> + add_app_vsn(list_to_atom(AppStr), VsnList, GBT). + +add_source_app_vsns([], AppVsnsTab) -> + AppVsnsTab; +add_source_app_vsns([{App, Vsn, _IReqs} | AI], AppVsnsTab) -> + add_source_app_vsns(AI, add_app_vsn(App, Vsn, AppVsnsTab)). + +read_source_app_info([], _SourceDir) -> + []; +read_source_app_info([App | Apps], SourceDir) -> + AppFile = case App of + "erts" -> + filename:join([SourceDir, "erts", "preloaded", "ebin", + "erts.app"]); + _ -> + filename:join([SourceDir, "lib", App, "ebin", + App ++ ".app"]) + end, + AppAtom = list_to_atom(App), + case consult_file(AppFile) of + [{application, AppAtom, InfoList}] -> + Vsn = case lists:keyfind(vsn, 1, InfoList) of + {vsn, V} -> + V; + _ -> + err("Missing vsn in ~p~n", AppFile) + end, + AI = case lists:keyfind(runtime_dependencies, 1, InfoList) of + {runtime_dependencies, IReqs} -> + case parse_inst_reqs(IReqs) of + error -> + err("Failed to parse runtime_dependencies in ~p~n", + [AppFile]); + ParsedIReqs -> + {AppAtom, Vsn, ParsedIReqs} + end; + _ -> + {AppAtom, Vsn, []} + end, + [AI | read_source_app_info(Apps, SourceDir)]; + _ -> + err("Failed to parse ~p~n", [AppFile]) + end. + +parse_vsn(VsnStr) -> + list_to_tuple(lists:map(fun (IL) -> + list_to_integer(IL) + end, string:tokens(VsnStr, "."))). + +parse_inst_reqs(InstReqs) -> + try + parse_inst_reqs_aux(InstReqs) + catch + _ : _ -> + error + end. + +parse_inst_reqs_aux([]) -> + []; +parse_inst_reqs_aux([IR | IRs]) -> + [App, VsnStr] = string:tokens(IR, "-"), + [{list_to_atom(App), parse_vsn(VsnStr)} | parse_inst_reqs_aux(IRs)]. + +make_app_vsn_str({App, VsnTup}) -> + make_app_vsn_str(tuple_to_list(VsnTup), [atom_to_list(App), $-]). + +make_app_vsn_str([I], Acc) -> + lists:flatten([Acc, integer_to_list(I)]); +make_app_vsn_str([I | Is], Acc) -> + make_app_vsn_str(Is, [Acc, integer_to_list(I), $.]). + +missing_min_req(App, AppVsn, IReq) -> + warn("Unfulfilled runtime dependency for application ~p-~s: ~s~n", + [App, AppVsn, make_app_vsn_str(IReq)]). + +verify_runtime_deps([], _AppVsnsTab, Res) -> + Res; +verify_runtime_deps([{App, Vsn, IReqs} | SAIs], AppVsnsTab, Res0) -> + Res = lists:foldl( + fun ({IRApp, IRMinVsn} = InstReq, AccRes) -> + case gb_trees:lookup(IRApp, AppVsnsTab) of + none -> + missing_min_req(App, Vsn, InstReq), + false; + {value, AppVsns} -> + try + lists:foreach( + fun (AppVsn) -> + case meets_min_req(AppVsn, IRMinVsn) of + true -> + throw(true); + false -> + false + end + end, + AppVsns), + missing_min_req(App, Vsn, InstReq), + false + catch + throw : true -> + AccRes + end + end + end, + Res0, + IReqs), + verify_runtime_deps(SAIs, AppVsnsTab, Res). + +meets_min_req(Vsn, Vsn) -> + true; +meets_min_req({X}, VsnReq) -> + meets_min_req({X, 0, 0}, VsnReq); +meets_min_req({X, Y}, VsnReq) -> + meets_min_req({X, Y, 0}, VsnReq); +meets_min_req(Vsn, {X}) -> + meets_min_req(Vsn, {X, 0, 0}); +meets_min_req(Vsn, {X, Y}) -> + meets_min_req(Vsn, {X, Y, 0}); +meets_min_req({X, _Y, _Z}, {XReq, _YReq, _ZReq}) when X > XReq -> + true; +meets_min_req({X, Y, _Z}, {X, YReq, _ZReq}) when Y > YReq -> + true; +meets_min_req({X, Y, Z}, {X, Y, ZReq}) when Z > ZReq -> + true; +meets_min_req({_X, _Y, _Z}, {_XReq, _YReq, _ZReq}) -> + false; +meets_min_req(Vsn, VsnReq) -> + gp_meets_min_req(mk_gp_vsn_list(Vsn), mk_gp_vsn_list(VsnReq)). + +gp_meets_min_req([X, Y, Z | _Vs], [X, Y, Z]) -> + true; +gp_meets_min_req([X, Y, Z | _Vs], [XReq, YReq, ZReq]) -> + meets_min_req({X, Y, Z}, {XReq, YReq, ZReq}); +gp_meets_min_req([X, Y, Z | Vs], [X, Y, Z | VReqs]) -> + gp_meets_min_req_tail(Vs, VReqs); +gp_meets_min_req(_Vsn, _VReq) -> + %% Versions on different version branches, i.e., the minimum + %% required functionality is not included in Vsn. + false. + +gp_meets_min_req_tail([V | Vs], [V | VReqs]) -> + gp_meets_min_req_tail(Vs, VReqs); +gp_meets_min_req_tail([], []) -> + true; +gp_meets_min_req_tail([_V | _Vs], []) -> + true; +gp_meets_min_req_tail([V | _Vs], [VReq]) when V > VReq -> + true; +gp_meets_min_req_tail(_Vs, _VReqs) -> + %% Versions on different version branches, i.e., the minimum + %% required functionality is not included in Vsn. + false. + +mk_gp_vsn_list(Vsn) -> + [X, Y, Z | Tail] = tuple_to_list(Vsn), + [X, Y, Z | remove_trailing_zeroes(Tail)]. + +remove_trailing_zeroes([]) -> + []; +remove_trailing_zeroes([0 | Vs]) -> + case remove_trailing_zeroes(Vs) of + [] -> []; + NewVs -> [0 | NewVs] + end; +remove_trailing_zeroes([V | Vs]) -> + [V | remove_trailing_zeroes(Vs)]. @@ -52,7 +52,7 @@ usage () echo " release [-a] <target_dir> - creates full release to <target_dir>" echo " smp [-a] - build an Erlang system, smp flavor only" echo " tests <dir> - Build testsuites to <dir>" - echo " patch_app <target_dir> <app1>... - build given apps to <target_dir>" + echo " patch_app [-f] <target_dir> <app1>... - build given apps to <target_dir>" echo " If core apps are patched, new start scripts will be created" echo " and 'Install' must be run again." echo "" @@ -173,6 +173,14 @@ determine_version_controller () # Special static config flags for certain platforms are set here set_config_flags () { + # + # NOTE! Do not add special flags here without a *very good* + # reason. We normally do not want "./otp_build configure" + # and "./configure" to produce different results. + # However, in the Windows case this does not matter, since + # the only supported way to build on Windows is using + # otp_build. + # # * Extra flags to pass to configure are placed in `CONFIG_FLAGS'. # * The command line is no longer added to `CONFIG_FLAGS' by # `set_config_flags'. It is instead passed directly to @@ -183,16 +191,6 @@ set_config_flags () # (in the cross compilation case the whole command line as well as # the cross configuration have been moved here). - if target_contains linux; then - XX=`echo $* | grep -v able-fp-exceptions` - if [ "$*" = "$XX" ]; then - CONFIG_FLAGS="$CONFIG_FLAGS --disable-fp-exceptions" - fi - fi - if target_contains "univel-sysv4"; then - CONFIG_FLAGS="$CONFIG_FLAGS --x-libraries=/usr/lib/X11" - fi - if target_contains free_source; then CONFIG_FLAGS="$CONFIG_FLAGS --host=$TARGET" fi @@ -1211,25 +1209,37 @@ do_patch_app () if [ X`$MAKE is_cross_configured` = Xyes ]; then TARGET=`$MAKE target_configured` fi + if [ "x$1" = "x-f" ]; then + force="-force" + shift + else + force= + fi target_dir=$1 - if [ ! -d $target_dir/releases/$otp_major_vsn ]; then + if [ ! -d "$target_dir/releases/$otp_major_vsn" ]; then echo "No OTP $otp_major_vsn installation in $target_dir" 1>&2 exit 1 fi shift - otp_version=`cat "$target_dir/OTP_VERSION"` || { echo "Not able to read $target_dir/OTP_VERSION" 1>&2; exit 1; } - { echo "$otp_version" | sed "s|^\([^\*]*\)\**|\1\*\*|g" > $target_dir/OTP_VERSION; } 2>/dev/null || { echo "Not able to update $target_dir/OTP_VERSION" 1>&2; exit 1; } + otp_version=`cat "$target_dir/releases/$otp_major_vsn/OTP_VERSION"` || { echo "Not able to read $target_dir/releases/$otp_major_vsn/OTP_VERSION" 1>&2; exit 1; } + { echo "$otp_version" | sed "s|^\([^\*]*\)\**|\1\*\*|g" > "$target_dir/releases/$otp_major_vsn/OTP_VERSION"; } 2>/dev/null || { echo "Not able to update $target_dir/OTP_VERSION" 1>&2; exit 1; } + + PATH="$ERL_TOP/bootstrap/bin:$PATH" $ERL_TOP/make/verify_runtime_dependencies -release "$otp_major_vsn" -source "$ERL_TOP" -target "$target_dir" $force "$@" + + if [ $? -ne 0 ]; then + exit $? + fi # Build all applications to target for app in "$@"; do if [ "$app" = "erts" ] && [ -d $ERL_TOP/$app ]; then (cd $ERL_TOP/$app && $MAKE MAKE="$MAKE" TARGET=$TARGET \ - TESTROOT=$target_dir release) || exit 1 + TESTROOT="$target_dir" release) || exit 1 elif [ "$app" != "erts" ] && [ -d $ERL_TOP/lib/$app ]; then (cd $ERL_TOP/lib/$app && $MAKE MAKE="$MAKE" TARGET=$TARGET \ - TESTROOT=$target_dir release) || exit 1 + TESTROOT="$target_dir" release) || exit 1 else echo "Invalid application $app" 1>&2 exit 1 @@ -1256,62 +1266,62 @@ do_patch_app () # and find the old versions for those not included if [ "X$update_rel" != "X" ]; then if [ "X$erts_vsn" = "X" ]; then - erts_vsns=`ls -d $target_dir/erts-* | sed "s|$target_dir/erts-\([0-9\.].*\)|\1|g"` + erts_vsns=`ls -d "$target_dir"/erts-* | sed "s|$target_dir/erts-\([0-9\.].*\)|\1|g"` erts_vsn=`echo "$erts_vsns" | sort -t '.' -g | tail -n 1` fi if [ "X$kernel_vsn" = "X" ]; then - kernel_vsns=`ls -d $target_dir/lib/kernel-* | sed "s|$target_dir/lib/kernel-\([0-9\.].*\)|\1|g"` + kernel_vsns=`ls -d "$target_dir"/lib/kernel-* | sed "s|$target_dir/lib/kernel-\([0-9\.].*\)|\1|g"` kernel_vsn=`echo "$kernel_vsns" | sort -t '.' -g | tail -n 1` fi if [ "X$stdlib_vsn" = "X" ]; then - stdlib_vsns=`ls -d $target_dir/lib/stdlib-* | sed "s|$target_dir/lib/stdlib-\([0-9\.].*\)|\1|g"` + stdlib_vsns=`ls -d "$target_dir"/lib/stdlib-* | sed "s|$target_dir/lib/stdlib-\([0-9\.].*\)|\1|g"` stdlib_vsn=`echo "$stdlib_vsns" | sort -t '.' -g | tail -n 1` fi if [ "X$sasl_vsn" = "X" ]; then - sasl_vsns=`ls -d $target_dir/lib/sasl-* | sed "s|$target_dir/lib/sasl-\([0-9\.].*\)|\1|g"` + sasl_vsns=`ls -d "$target_dir"/lib/sasl-* | sed "s|$target_dir/lib/sasl-\([0-9\.].*\)|\1|g"` sasl_vsn=`echo "$sasl_vsns" | sort -t '.' -g | tail -n 1` fi # Generate .rel, .script and .boot - to tmp dir - start_clean="{release, {\"OTP APN 181 01\",\"$otp_major_vsn\"}, {erts, \"$erts_vsn\"},\n [{kernel,\"$kernel_vsn\"},\n {stdlib,\"$stdlib_vsn\"}]}.\n" - start_sasl="{release, {\"OTP APN 181 01\",\"$otp_major_vsn\"}, {erts, \"$erts_vsn\"},\n [{kernel,\"$kernel_vsn\"},\n {stdlib,\"$stdlib_vsn\"},\n {sasl,\"$sasl_vsn\"}]}.\n" + start_clean="{release, {\"Erlang/OTP\",\"$otp_major_vsn\"}, {erts, \"$erts_vsn\"},\n [{kernel,\"$kernel_vsn\"},\n {stdlib,\"$stdlib_vsn\"}]}.\n" + start_sasl="{release, {\"Erlang/OTP\",\"$otp_major_vsn\"}, {erts, \"$erts_vsn\"},\n [{kernel,\"$kernel_vsn\"},\n {stdlib,\"$stdlib_vsn\"},\n {sasl,\"$sasl_vsn\"}]}.\n" - tmp_dir=$target_dir/tmp; - if [ ! -d $tmp_dir ]; then - mkdir $tmp_dir + tmp_dir="$target_dir/tmp"; + if [ ! -d "$tmp_dir" ]; then + mkdir "$tmp_dir" fi - echo $start_sasl > $tmp_dir/start_sasl.rel - echo $start_clean > $tmp_dir/start_clean.rel - echo $start_clean > $tmp_dir/no_dot_erlang.rel + echo "$start_sasl" > "$tmp_dir/start_sasl.rel" + echo "$start_clean" > "$tmp_dir/start_clean.rel" + echo "$start_clean" > "$tmp_dir/no_dot_erlang.rel" - erlc=$ERL_TOP/bootstrap/bin/erlc - if [ ! -x $erlc ]; then + erlc="$ERL_TOP/bootstrap/bin/erlc" + if [ ! -x "$erlc" ]; then echo "erlc not found, can not create .script and .boot files" 1>&2 exit 1 fi - $erlc -I$target_dir/lib/*/ebin -o$tmp_dir $tmp_dir/start_sasl.rel || exit 1 - $erlc -I$target_dir/lib/*/ebin -o$tmp_dir +no_warn_sasl $tmp_dir/start_clean.rel || exit 1 - $erlc -I$target_dir/lib/*/ebin -o$tmp_dir +no_warn_sasl +no_dot_erlang $tmp_dir/no_dot_erlang.rel || exit 1 + $erlc -I"$target_dir"/lib/*/ebin -o$tmp_dir $tmp_dir/start_sasl.rel || exit 1 + $erlc -I"$target_dir"/lib/*/ebin -o$tmp_dir +no_warn_sasl $tmp_dir/start_clean.rel || exit 1 + $erlc -I"$target_dir"/lib/*/ebin -o$tmp_dir +no_warn_sasl +no_dot_erlang $tmp_dir/no_dot_erlang.rel || exit 1 # Generate RELEASES file - erl=$ERL_TOP/bootstrap/bin/erl - if [ ! -x $erl ]; then + erl="$ERL_TOP/bootstrap/bin/erl" + if [ ! -x "$erl" ]; then echo "erl not found, can not create RELEASES file" 1>&2 exit 1 fi - $erl -noinput +B -eval "release_handler:create_RELEASES(\"%ERL_ROOT%\", \"$tmp_dir\", \"$tmp_dir/start_sasl.rel\", []), halt()" || exit 1 + "$erl" -noinput +B -eval "release_handler:create_RELEASES(\"%ERL_ROOT%\", \"$tmp_dir\", \"$tmp_dir/start_sasl.rel\", []), halt()" || exit 1 # If all good so far, move generated files into target area - mv $tmp_dir/RELEASES $target_dir/releases/RELEASES.src - mv $tmp_dir/* $target_dir/releases/$otp_major_vsn - rmdir $tmp_dir + mv "$tmp_dir/RELEASES" "$target_dir/releases/RELEASES.src" + mv "$tmp_dir"/* "$target_dir/releases/$otp_major_vsn" + rmdir "$tmp_dir" # Remove old start scripts (forces a new run of Install) - rm -f $target_dir/releases/RELEASES - rm -f $target_dir/bin/*.script - rm -f $target_dir/bin/*.boot - rm -f $target_dir/bin/erl + rm -f "$target_dir"/releases/RELEASES + rm -f "$target_dir"/bin/*.script + rm -f "$target_dir"/bin/*.boot + rm -f "$target_dir"/bin/erl fi } diff --git a/otp_versions.table b/otp_versions.table new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/otp_versions.table diff --git a/system/doc/design_principles/spec_proc.xml b/system/doc/design_principles/spec_proc.xml index 8de7a5fe03..e4fb5fdca7 100644 --- a/system/doc/design_principles/spec_proc.xml +++ b/system/doc/design_principles/spec_proc.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1997</year><year>2013</year> + <year>1997</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -130,7 +130,8 @@ ok -export([alloc/0, free/1]). -export([init/1]). -export([system_continue/3, system_terminate/4, - write_debug/3]). + write_debug/3, + system_get_state/1, system_replace_state/2]). start_link() -> proc_lib:start_link(ch4, init, [self()]). @@ -156,15 +157,15 @@ init(Parent) -> loop(Chs, Parent, Deb) -> receive {From, alloc} -> - Deb2 = sys:handle_debug(Deb, {ch4, write_debug}, + Deb2 = sys:handle_debug(Deb, fun ch4:write_debug/3, ch4, {in, alloc, From}), {Ch, Chs2} = alloc(Chs), From ! {ch4, Ch}, - Deb3 = sys:handle_debug(Deb2, {ch4, write_debug}, + Deb3 = sys:handle_debug(Deb2, fun ch4:write_debug/3, ch4, {out, {ch4, Ch}, From}), loop(Chs2, Parent, Deb3); {free, Ch} -> - Deb2 = sys:handle_debug(Deb, {ch4, write_debug}, + Deb2 = sys:handle_debug(Deb, fun ch4:write_debug/3, ch4, {in, {free, Ch}}), Chs2 = free(Ch, Chs), loop(Chs2, Parent, Deb2); @@ -177,9 +178,16 @@ loop(Chs, Parent, Deb) -> system_continue(Parent, Deb, Chs) -> loop(Chs, Parent, Deb). -system_terminate(Reason, Parent, Deb, Chs) -> +system_terminate(Reason, _Parent, _Deb, _Chs) -> exit(Reason). +system_get_state(Chs) -> + {ok, Chs}. + +system_replace_state(StateFun, Chs) -> + NChs = StateFun(Chs), + {ok, NChs, NChs}. + write_debug(Dev, Event, Name) -> io:format(Dev, "~p event = ~p~n", [Name, Event]).</pre> <p>Example on how the simple debugging functions in <c>sys</c> can @@ -281,10 +289,10 @@ sys:handle_debug(Deb, Func, Info, Event) => Deb1</code> <p><c>Deb</c> is the debug structure.</p> </item> <item> - <p><c>Func</c> is a tuple <c>{Module, Name}</c> (or a fun) and - should specify a (user defined) function used to format + <p><c>Func</c> is a fun specifying + a (user defined) function used to format trace output. For each system event, the format function is - called as <c>Module:Name(Dev, Event, Info)</c>, where:</p> + called as <c>Func(Dev, Event, Info)</c>, where:</p> <list type="bulleted"> <item> <p><c>Dev</c> is the IO device to which the output should @@ -319,15 +327,15 @@ sys:handle_debug(Deb, Func, Info, Event) => Deb1</code> loop(Chs, Parent, Deb) -> receive {From, alloc} -> - Deb2 = sys:handle_debug(Deb, {ch4, write_debug}, + Deb2 = sys:handle_debug(Deb, fun ch4:write_debug/3, ch4, {in, alloc, From}), {Ch, Chs2} = alloc(Chs), From ! {ch4, Ch}, - Deb3 = sys:handle_debug(Deb2, {ch4, write_debug}, + Deb3 = sys:handle_debug(Deb2, fun ch4:write_debug/3, ch4, {out, {ch4, Ch}, From}), loop(Chs2, Parent, Deb3); {free, Ch} -> - Deb2 = sys:handle_debug(Deb, {ch4, write_debug}, + Deb2 = sys:handle_debug(Deb, fun ch4:write_debug/3, ch4, {in, {free, Ch}}), Chs2 = free(Ch, Chs), loop(Chs2, Parent, Deb2); @@ -366,8 +374,15 @@ Module:system_terminate(Reason, Parent, Deb, State)</code> <item><c>Module</c> is the name of the module.</item> <item><c>Deb</c> is the debug structure.</item> <item><c>State</c> is a term describing the internal state and - is passed to <c>system_continue</c>/<c>system_terminate</c>.</item> + is passed to <c>system_continue</c>/<c>system_terminate</c>/ + <c>system_get_state</c>/<c>system_replace_state</c>.</item> </list> + <p>If the process should return its state <c>handle_system_msg</c> will call:</p> + <code type="none"> +Module:system_get_state(State)</code> + <p>or if the process should replace its state using the fun <c>StateFun</c>:</p> + <code type="none"> +Module:system_replace_state(StateFun, State)</code> <p>In the example:</p> <code type="none"> loop(Chs, Parent, Deb) -> @@ -383,7 +398,15 @@ system_continue(Parent, Deb, Chs) -> loop(Chs, Parent, Deb). system_terminate(Reason, Parent, Deb, Chs) -> - exit(Reason).</code> + exit(Reason). + +system_get_state(Chs) -> + {ok, Chs, Chs}. + +system_replace_state(StateFun, Chs) -> + NChs = StateFun(Chs), + {ok, NChs, NChs}. +</code> <p>If the special process is set to trap exits, note that if the parent process terminates, the expected behavior is to terminate with the same reason:</p> @@ -408,11 +431,11 @@ loop(...) -> <section> <title>User-Defined Behaviours</title> - <p>To implement a user-defined behaviour, write code similar to + <p><marker id="behaviours"/>To implement a user-defined behaviour, write code similar to code for a special process but calling functions in a callback module for handling specific tasks.</p> <p>If it is desired that the compiler should warn for missing callback - functions, as it does for the OTP behaviours, add callback attributes in the + functions, as it does for the OTP behaviours, add <c>-callback</c> attributes in the behaviour module to describe the expected callbacks:</p> <code type="none"> -callback Name1(Arg1_1, Arg1_2, ..., Arg1_N1) -> Res1. @@ -422,15 +445,15 @@ loop(...) -> <p>where <c>NameX</c> are the names of the expected callbacks and <c>ArgX_Y</c>, <c>ResX</c> are types as they are described in Specifications for functions in <seealso marker="../reference_manual/typespec">Types and - Function Specifications</seealso>. The whole syntax of spec attributes is - supported by callback attributes.</p> + Function Specifications</seealso>. The whole syntax of <c>-spec</c> attribute is + supported by <c>-callback</c> attribute.</p> <p>Alternatively you may directly implement and export the function:</p> <code type="none"> behaviour_info(callbacks) -> - [{Name1,Arity1},...,{NameN,ArityN}].</code> - <p>where each <c>{Name,Arity}</c> specifies the name and arity of a callback + [{Name1, Arity1},...,{NameN, ArityN}].</code> + <p>where each <c>{Name, Arity}</c> specifies the name and arity of a callback function. This function is otherwise automatically generated by the compiler - using the callback attributes.</p> + using the <c>-callback</c> attributes.</p> <p>When the compiler encounters the module attribute <c>-behaviour(Behaviour).</c> in a module <c>Mod</c>, it will call <c>Behaviour:behaviour_info(callbacks)</c> and compare the result with the diff --git a/system/doc/installation_guide/otp_version.xml b/system/doc/installation_guide/otp_version.xml deleted file mode 100644 index dcba2d1702..0000000000 --- a/system/doc/installation_guide/otp_version.xml +++ /dev/null @@ -1,71 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2014</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>OTP version</title> - <prepared></prepared> - <responsible></responsible> - <docno></docno> - <approved></approved> - <checked></checked> - <date>2014-02-19</date> - <rev></rev> - <file>otp_version.xml</file> - </header> - <p>As of OTP release 17, the OTP release number corresponds to - the major OTP version number. In the normal case, the OTP version - number will be constructed as - <c><Major>.<Minor>.<Patch></c>. However more - dot separated parts may exist. If all parts less significant than - <c>Minor</c> equals <c>0</c>, they are omitted when printing the - version. Release candidates have an <c>-rc<N></c> suffix. The - OTP version as a concept was introduced in OTP 17.</p> - <p>OTP of a specific version is a set of applications of - specific versions. The application versions identified by - an OTP version corresponds to application versions that - have been tested together by the Erlang/OTP team at Ericsson AB. - An OTP system can however be put together with applications from - different OTP versions. Such a combination of application versions - has not been tested by the Erlang/OTP team. It is therefore - <em>always preferred to use OTP applications from one single OTP - version</em>.</p> - <p>In an OTP source code tree as well as in an installed OTP - development system, the OTP version can be read from the text - file <c>OTP_VERSION</c> in the OTP installation root directory - (<seealso marker="kernel:code#root_dir/0"><c>code:root_dir()</c></seealso>).</p> - <p>If the version read from the <c>OTP_VERSION</c> file in a - development system has a <c>**</c> suffix, the system has been - patched using the <c>$ERL_TOP/otp_build patch_app</c> tool. In - this case, the system consists of application versions from - multiple OTP versions. The version preceding the <c>**</c> - suffix corresponds to the OTP version of the base system that - has been patched.</p> - <p>On a target system (see the - <seealso marker="doc/system_principles:create_target">system principles</seealso> - documentation) no <c>OTP_VERSION</c> file will exist. This since - one easily can create a target system where it is hard to even - determine the base OTP version.</p> - <p>Note that if a development system is updated by other means - than <c>$ERL_TOP/otp_build patch_app</c>, the <c>OTP_VERSION</c> - file may identify wrong OTP version.</p> -</chapter> - diff --git a/system/doc/installation_guide/part.xml b/system/doc/installation_guide/part.xml index 150df39512..19808fd165 100644 --- a/system/doc/installation_guide/part.xml +++ b/system/doc/installation_guide/part.xml @@ -31,7 +31,6 @@ <description> <p>How to install Erlang/OTP on UNIX or Windows.</p> </description> - <xi:include href="otp_version.xml"/> <xi:include href="install-binary.xml"/> <xi:include href="verification.xml"/> <xi:include href="INSTALL.xml"/> diff --git a/system/doc/installation_guide/xmlfiles.mk b/system/doc/installation_guide/xmlfiles.mk index 245491ab94..3995c607af 100644 --- a/system/doc/installation_guide/xmlfiles.mk +++ b/system/doc/installation_guide/xmlfiles.mk @@ -17,7 +17,6 @@ # %CopyrightEnd% # INST_GUIDE_CHAPTER_FILES = \ - otp_version.xml \ install-binary.xml \ verification.xml \ INSTALL.xml \ diff --git a/system/doc/reference_manual/character_set.xml b/system/doc/reference_manual/character_set.xml new file mode 100644 index 0000000000..884898eb34 --- /dev/null +++ b/system/doc/reference_manual/character_set.xml @@ -0,0 +1,132 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2014</year><year>2014</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + 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. + + </legalnotice> + + <title>Character Set and Source File Encoding</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> + <file>character_set.xml</file> + </header> + + <section> + <title>Character Set</title> + <p>In Erlang 4.8/OTP R5A the syntax of Erlang tokens was extended to + allow the use of the full ISO-8859-1 (Latin-1) character set. This + is noticeable in the following ways:</p> + <list type="bulleted"> + <item> + <p>All the Latin-1 printable characters can be used and are + shown without the escape backslash convention.</p> + </item> + <item> + <p>Atoms and variables can use all Latin-1 letters.</p> + </item> + </list> + <table> + <row> + <cell align="left" valign="middle"><em>Octal</em></cell> + <cell align="left" valign="middle"><em>Decimal</em></cell> + <cell align="left" valign="middle"> </cell> + <cell align="left" valign="middle"><em>Class</em></cell> + </row> + <row> + <cell align="left" valign="middle">200 - 237</cell> + <cell align="left" valign="middle">128 - 159</cell> + <cell align="left" valign="middle"> </cell> + <cell align="left" valign="middle">Control characters</cell> + </row> + <row> + <cell align="left" valign="middle">240 - 277</cell> + <cell align="left" valign="middle">160 - 191</cell> + <cell align="right" valign="middle">- ¿</cell> + <cell align="left" valign="middle">Punctuation characters</cell> + </row> + <row> + <cell align="left" valign="middle">300 - 326</cell> + <cell align="left" valign="middle">192 - 214</cell> + <cell align="center" valign="middle">À - Ö</cell> + <cell align="left" valign="middle">Uppercase letters</cell> + </row> + <row> + <cell align="center" valign="middle">327</cell> + <cell align="center" valign="middle">215</cell> + <cell align="center" valign="middle">×</cell> + <cell align="left" valign="middle">Punctuation character</cell> + </row> + <row> + <cell align="left" valign="middle">330 - 336</cell> + <cell align="left" valign="middle">216 - 222</cell> + <cell align="center" valign="middle">Ø - Þ</cell> + <cell align="left" valign="middle">Uppercase letters</cell> + </row> + <row> + <cell align="left" valign="middle">337 - 366</cell> + <cell align="left" valign="middle">223 - 246</cell> + <cell align="center" valign="middle">ß - ö</cell> + <cell align="left" valign="middle">Lowercase letters</cell> + </row> + <row> + <cell align="center" valign="middle">367</cell> + <cell align="center" valign="middle">247</cell> + <cell align="center" valign="middle">÷</cell> + <cell align="left" valign="middle">Punctuation character</cell> + </row> + <row> + <cell align="left" valign="middle">370 - 377</cell> + <cell align="left" valign="middle">248 - 255</cell> + <cell align="center" valign="middle">ø - ÿ</cell> + <cell align="left" valign="middle">Lowercase letters</cell> + </row> + <tcaption>Character Classes.</tcaption> + </table> + <p>In Erlang/OTP R16B the syntax of Erlang tokens was extended to + handle Unicode. To begin with the support is limited to + strings, but Erlang/OTP 18 is expected to handle Unicode atoms + as well. More about the usage of Unicode in Erlang source files + can be found in <seealso + marker="stdlib:unicode_usage#unicode_in_erlang">STDLIB's User's + Guide</seealso>.</p> + </section> + <section> + <title>Source File Encoding</title> + <p>The Erlang source file <marker + id="encoding">encoding</marker> is selected by a + comment in one of the first two lines of the source file. The + first string that matches the regular expression + <c>coding\s*[:=]\s*([-a-zA-Z0-9])+</c> selects the encoding. If + the matching string is not a valid encoding it is ignored. The + valid encodings are <c>Latin-1</c> and <c>UTF-8</c> where the + case of the characters can be chosen freely.</p> + <p>The following example selects UTF-8 as default encoding:</p> + <pre> +%% coding: utf-8</pre> + <p>Two more examples, both selecting Latin-1 as default encoding:</p> + <pre> +%% For this file we have chosen encoding = Latin-1</pre> + <pre> +%% -*- coding: latin-1 -*-</pre> + <p>The default encoding for Erlang source files was changed from + Latin-1 to UTF-8 in Erlang OTP 17.0.</p> + </section> +</chapter> diff --git a/system/doc/reference_manual/introduction.xml b/system/doc/reference_manual/introduction.xml index aa42967625..36bec17825 100644 --- a/system/doc/reference_manual/introduction.xml +++ b/system/doc/reference_manual/introduction.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2003</year><year>2013</year> + <year>2003</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -79,88 +79,5 @@ when xor</p> </section> - <section> - <title>Character Set</title> - <p>In Erlang 4.8/OTP R5A the syntax of Erlang tokens was extended to - allow the use of the full ISO-8859-1 (Latin-1) character set. This - is noticeable in the following ways:</p> - <list type="bulleted"> - <item> - <p>All the Latin-1 printable characters can be used and are - shown without the escape backslash convention.</p> - </item> - <item> - <p>Atoms and variables can use all Latin-1 letters.</p> - </item> - </list> - <table> - <row> - <cell align="left" valign="middle"><em>Octal</em></cell> - <cell align="left" valign="middle"><em>Decimal</em></cell> - <cell align="left" valign="middle"> </cell> - <cell align="left" valign="middle"><em>Class</em></cell> - </row> - <row> - <cell align="left" valign="middle">200 - 237</cell> - <cell align="left" valign="middle">128 - 159</cell> - <cell align="left" valign="middle"> </cell> - <cell align="left" valign="middle">Control characters</cell> - </row> - <row> - <cell align="left" valign="middle">240 - 277</cell> - <cell align="left" valign="middle">160 - 191</cell> - <cell align="right" valign="middle">- ¿</cell> - <cell align="left" valign="middle">Punctuation characters</cell> - </row> - <row> - <cell align="left" valign="middle">300 - 326</cell> - <cell align="left" valign="middle">192 - 214</cell> - <cell align="center" valign="middle">À - Ö</cell> - <cell align="left" valign="middle">Uppercase letters</cell> - </row> - <row> - <cell align="center" valign="middle">327</cell> - <cell align="center" valign="middle">215</cell> - <cell align="center" valign="middle">×</cell> - <cell align="left" valign="middle">Punctuation character</cell> - </row> - <row> - <cell align="left" valign="middle">330 - 336</cell> - <cell align="left" valign="middle">216 - 222</cell> - <cell align="center" valign="middle">Ø - Þ</cell> - <cell align="left" valign="middle">Uppercase letters</cell> - </row> - <row> - <cell align="left" valign="middle">337 - 366</cell> - <cell align="left" valign="middle">223 - 246</cell> - <cell align="center" valign="middle">ß - ö</cell> - <cell align="left" valign="middle">Lowercase letters</cell> - </row> - <row> - <cell align="center" valign="middle">367</cell> - <cell align="center" valign="middle">247</cell> - <cell align="center" valign="middle">÷</cell> - <cell align="left" valign="middle">Punctuation character</cell> - </row> - <row> - <cell align="left" valign="middle">370 - 377</cell> - <cell align="left" valign="middle">248 - 255</cell> - <cell align="center" valign="middle">ø - ÿ</cell> - <cell align="left" valign="middle">Lowercase letters</cell> - </row> - <tcaption>Character Classes.</tcaption> - </table> - <p>In Erlang/OTP R16 the syntax of Erlang tokens was extended to - handle Unicode. To begin with the support is limited to strings, - but Erlang/OTP R18 is expected to handle Unicode atoms as well. - More about the usage of Unicode in Erlang source files can be - found in <seealso - marker="stdlib:unicode_usage#unicode_in_erlang">STDLIB's User'S - Guide</seealso>. The default encoding for Erlang source files - is still Latin-1, but in Erlang/OTP R17 the default encoding - will be UTF-8. The details on how to state the encoding of an - Erlang source file can be found in <seealso - marker="stdlib:epp#encoding">epp(3)</seealso>.</p> - </section> </chapter> diff --git a/system/doc/reference_manual/modules.xml b/system/doc/reference_manual/modules.xml index 9e5f4de385..cd4c3a1b1b 100644 --- a/system/doc/reference_manual/modules.xml +++ b/system/doc/reference_manual/modules.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2003</year><year>2013</year> + <year>2003</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -134,8 +134,21 @@ fact(0) -> % | standard behaviours <c>gen_server</c>, <c>gen_fsm</c>, <c>gen_event</c> or <c>supervisor</c>.</p> <p>The spelling <c>behavior</c> is also accepted.</p> - <p>Read more about behaviours and callback modules in OTP Design - Principles.</p> + <p>The callback functions of the module can be specified either + directly by the exported function <c>behaviour_info/1</c>:</p> + <pre> +behaviour_info(callbacks) -> Callbacks.</pre> + <p>or by a <c>-callback</c> attribute for each callback + function:</p> + <pre> +-callback Name(Arguments) -> Result.</pre> + <p>where <c>Arguments</c> is a list of zero or more arguments. + The <c>-callback</c> attribute is to be preferred since the + extra type information can be used by tools to produce + documentation or find discrepancies.</p> + <p>Read more about behaviours and callback modules in + <seealso marker="doc/design_principles:spec_proc#behaviours"> + OTP Design Principles</seealso>.</p> </section> <section> diff --git a/system/doc/reference_manual/part.xml b/system/doc/reference_manual/part.xml index b4f114c268..ee8f3dd7eb 100644 --- a/system/doc/reference_manual/part.xml +++ b/system/doc/reference_manual/part.xml @@ -4,7 +4,7 @@ <part xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>2003</year><year>2013</year> + <year>2003</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -28,6 +28,7 @@ <rev></rev> </header> <xi:include href="introduction.xml"/> + <xi:include href="character_set.xml"/> <xi:include href="data_types.xml"/> <xi:include href="patterns.xml"/> <xi:include href="modules.xml"/> diff --git a/system/doc/system_principles/part.xml b/system/doc/system_principles/part.xml index 915d5aca9b..811428baae 100644 --- a/system/doc/system_principles/part.xml +++ b/system/doc/system_principles/part.xml @@ -31,5 +31,6 @@ <xi:include href="system_principles.xml"/> <xi:include href="error_logging.xml"/> <xi:include href="create_target.xml"/> + <xi:include href="versions.xml"/> </part> diff --git a/system/doc/system_principles/versions.xml b/system/doc/system_principles/versions.xml new file mode 100644 index 0000000000..2bf0d18010 --- /dev/null +++ b/system/doc/system_principles/versions.xml @@ -0,0 +1,268 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2014</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + 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. + + </legalnotice> + + <title>Versions</title> + <prepared></prepared> + <responsible></responsible> + <docno></docno> + <approved></approved> + <checked></checked> + <date>2014-02-19</date> + <rev></rev> + <file>versions.xml</file> + </header> + <section><title>OTP Version</title> + <p>As of OTP release 17, the OTP release number corresponds to + the major part of the OTP version. The OTP version as a concept was + introduced in OTP 17. The <seealso marker="#version_scheme">version + scheme</seealso> used is described in more detail below.</p> + + <p>OTP of a specific version is a set of applications of specific + versions. The application versions identified by an OTP version + corresponds to application versions that have been tested together + by the Erlang/OTP team at Ericsson AB. An OTP system can however be + put together with applications from different OTP versions. Such a + combination of application versions has not been tested by the + Erlang/OTP team. It is therefore <em>always preferred to use OTP + applications from one single OTP version</em>.</p> + + <p>Release candidates have an <c>-rc<N></c> + suffix. The suffix <c>-rc0</c> will be used during development up to + the first release candidate.</p> + + <section><title>Retrieving Current OTP Version</title> + <p>In an OTP source code tree, the OTP version can be read from + the text file <c><OTP source root>/OTP_VERSION</c>. The + absolute path to the file can be constructed by calling + <c>filename:join([<seealso marker="kernel:code#root_dir/0">code:root_dir()</seealso>, "OTP_VERSION"])</c>.</p> + <p>In an installed OTP development system, the OTP version can be read + from the text file <c><OTP installation root>/releases/<OTP release number>/OTP_VERSION</c>. + The absolute path to the file can by constructed by calling + <c>filename:join([<seealso marker="kernel:code#root_dir/0">code:root_dir()</seealso>, "releases", <seealso marker="erts:erlang#system_info_otp_release">erlang:system_info(otp_release)</seealso>, "OTP_VERSION"]).</c></p> + <p>If the version read from the <c>OTP_VERSION</c> file in a + development system has a <c>**</c> suffix, the system has been + patched using the + <seealso marker="doc/installation_guide:PATCH-APP"><c>$ERL_TOP/otp_build patch_app</c></seealso> + tool. In this case, the system consists of application versions from + multiple OTP versions. The version preceding the <c>**</c> + suffix corresponds to the OTP version of the base system that + has been patched. Note that if a development system is updated by + other means than <c>$ERL_TOP/otp_build patch_app</c>, the + <c>OTP_VERSION</c> file may identify wrong OTP version.</p> + + <p>No <c>OTP_VERSION</c> file will be placed in a + <seealso marker="create_target">target system</seealso> created + by OTP tools. This since one easily can create a target system + where it is hard to even determine the base OTP version. You may, + however, place such a file there yourself if you know the OTP + version.</p> + </section> + + <section><title>OTP Versions Table</title> + <p>The text file <c><OTP source root>/otp_versions.table</c> that + is part of the source code contains information about all OTP versions + from OTP 17.0 up to current OTP version. Each line contains information + about application versions that are part of a specific OTP version, and + is on the format:</p> +<pre> +<OtpVersion> : <ChangedAppVersions> # <UnchangedAppVersions> : +</pre> + <p><c><OtpVersion></c> is on the format <c>OTP-<VSN></c>, i.e., + the same as the git tag used to identify the source. + <c><ChangedAppVersions></c> and <c><UnchangedAppVersions></c> + are space separated lists of application versions on the + format <c><application>-<vsn></c>. + <c><ChangedAppVersions></c> corresponds to changed applications + with new version numbers in this OTP version, and + <c><UnchangedAppVersions></c> corresponds to unchanged application + versions in this OTP version. Both of them might be empty, although + not at the same time. If <ChangedAppVersions> is empty, no changes + has been made that change the build result of any application. This could + for example be a pure bug fix of the build system. The order of lines + is undefined. All white space characters in this file are either space + (character 32) or line-break (character 10).</p> + <p>Using ordinary UNIX tools like <c>sed</c> and <c>grep</c> one + can easily find answers to various questions like:</p> + <taglist> + <tag>Which OTP versions are <c>kernel-3.0</c> part of?</tag> + <item><p><c> $ grep ' kernel-3\.0 ' otp_versions.table</c></p></item> + <tag>In which OTP version was <c>kernel-3.0</c> introduced?</tag> + <item><p><c> $ sed 's/#.*//;/ kernel-3\.0 /!d' otp_versions.table</c></p></item> + </taglist> + <p>The above commands give a bit more information than the exact answers, + but adequate information when manually searching for answers to these + questions.</p> + <warning><p>The format of the <c>otp_versions.table</c> might be subject + to changes during the OTP 17 release.</p></warning> + </section> + </section> + + <section><title>Application Version</title> + <p>As of OTP 17.0 application versions will use the same + <seealso marker="#version_scheme">version scheme</seealso> as the + OTP version. Application versions part of a release candidate will + however not have an <c>-rc<N></c> suffix as the OTP version. + Also note that a major increment in an application version does not + necessarily imply a major increment of the OTP version. This depends + on whether the major change in the application is considered as a + major change for OTP as a whole or not.</p> + </section> + + <marker id="version_scheme"/> + <section><title>Version Scheme</title> + <note>Note that the version scheme was changed as of OTP 17.0. This implies + that application versions used prior to OTP 17.0 do not adhere to this + version scheme. <seealso marker="#otp_17_0_app_versions">A list of + application versions used in OTP 17.0</seealso> can be found + at the end of this document.</note> + + <p>In the normal case, a version will be constructed as + <c><Major>.<Minor>.<Patch></c> where <c><Major></c> + is the most significant part. However, more dot separated parts than + this may exist. The dot separated parts consists of non-negative integers. + If all parts less significant than <c><Minor></c> equals <c>0</c>, + they are omitted. The three normal parts + <c><Major>.<Minor>.<Patch></c> will be changed as + follows:</p> + <taglist> + <tag><c><Major></c></tag><item>Increased when major changes, + including incompatibilities, have been made.</item> + <tag><c><Minor></c></tag><item>Increased when new functionality + has been added.</item> + <tag><c><Patch></c></tag><item>Increased when pure bug fixes + have been made.</item> + </taglist> + <p>When a part in the version number is increased, all less significant + parts are set to <c>0</c>.</p> + + <p>An application version or an OTP version identifies source code + versions. That is, it does not imply anything about how the application + or OTP has been built.</p> + + <section><title>Order of Versions</title> + <p>Version numbers in general are only partially ordered. However, + normal version numbers (with three parts) as of OTP 17.0 have a total + or linear order. This applies both to normal OTP versions and + normal application versions.</p> + + <p>When comparing two version numbers that have an order, one + compare each part as ordinary integers from the most + significant part towards less significant parts. The order is + defined by the first parts of the same significance that + differ. An OTP version with a larger version include all + changes that that are part of a smaller OTP version. The same + goes for application versions.</p> + + <p>In the general case, versions may have more than three parts. In + this case the versions are only partially ordered. Note that such + versions are only used in exceptional cases. When an extra + part (out of the normal three parts) is added to a version number, + a new branch of versions is made. The new branch has a linear + order against the base version. However, versions on different + branches have no order. Since they have no order, we + only know that they all include what is included in their + closest common ancestor. When branching multiple times from the + same base version, <c>0</c> parts are added between the base + version and the least significant <c>1</c> part until a unique + version is found. Versions that have an order can be compared + as described in the paragraph above.</p> + + <p>An example of branched versions: The version <c>6.0.2.1</c> + is a branched version from the base version <c>6.0.2</c>. + Versions on the form <c>6.0.2.<X></c> can be compared + with normal versions smaller than or equal to <c>6.0.2</c>, + and other versions on the form <c>6.0.2.<X></c>. The + version <c>6.0.2.1</c> will include all changes in + <c>6.0.2</c>. However, <c>6.0.3</c> will most likely + <em>not</em> include all changes in <c>6.0.2.1</c> (note that + these versions have no order). A second branched version from the base + version <c>6.0.2</c> will be version <c>6.0.2.0.1</c>, and a + third branched version will be <c>6.0.2.0.0.1</c>.</p> + </section> + </section> + + <marker id="otp_17_0_app_versions"/> + <section><title>OTP 17.0 Application Versions</title> + <p>The following application versions were part of OTP 17.0. If + the normal part of an applications version number compares + as smaller than the corresponding application version in this list, + the version number does not adhere to the version scheme introduced + in OTP 17.0 and should be considered as not having an order against + versions used as of OTP 17.0.</p> + <list> + <item><c>asn1-3.0</c></item> + <item><c>common_test-1.8</c></item> + <item><c>compiler-5.0</c></item> + <item><c>cosEvent-2.1.15</c></item> + <item><c>cosEventDomain-1.1.14</c></item> + <item><c>cosFileTransfer-1.1.16</c></item> + <item><c>cosNotification-1.1.21</c></item> + <item><c>cosProperty-1.1.17</c></item> + <item><c>cosTime-1.1.14</c></item> + <item><c>cosTransactions-1.2.14</c></item> + <item><c>crypto-3.3</c></item> + <item><c>debugger-4.0</c></item> + <item><c>dialyzer-2.7</c></item> + <item><c>diameter-1.6</c></item> + <item><c>edoc-0.7.13</c></item> + <item><c>eldap-1.0.3</c></item> + <item><c>erl_docgen-0.3.5</c></item> + <item><c>erl_interface-3.7.16</c></item> + <item><c>erts-6.0</c></item> + <item><c>et-1.5</c></item> + <item><c>eunit-2.2.7</c></item> + <item><c>gs-1.5.16</c></item> + <item><c>hipe-3.10.3</c></item> + <item><c>ic-4.3.5</c></item> + <item><c>inets-5.10</c></item> + <item><c>jinterface-1.5.9</c></item> + <item><c>kernel-3.0</c></item> + <item><c>megaco-3.17.1</c></item> + <item><c>mnesia-4.12</c></item> + <item><c>observer-2.0</c></item> + <item><c>odbc-2.10.20</c></item> + <item><c>orber-3.6.27</c></item> + <item><c>os_mon-2.2.15</c></item> + <item><c>ose-1.0</c></item> + <item><c>otp_mibs-1.0.9</c></item> + <item><c>parsetools-2.0.11</c></item> + <item><c>percept-0.8.9</c></item> + <item><c>public_key-0.22</c></item> + <item><c>reltool-0.6.5</c></item> + <item><c>runtime_tools-1.8.14</c></item> + <item><c>sasl-2.4</c></item> + <item><c>snmp-4.25.1</c></item> + <item><c>ssh-3.0.1</c></item> + <item><c>ssl-5.3.4</c></item> + <item><c>stdlib-2.0</c></item> + <item><c>syntax_tools-1.6.14</c></item> + <item><c>test_server-3.7</c></item> + <item><c>tools-2.6.14</c></item> + <item><c>typer-0.9.6</c></item> + <item><c>webtool-0.8.10</c></item> + <item><c>wx-1.2</c></item> + <item><c>xmerl-1.3.7</c></item> + </list> + </section> +</chapter> + diff --git a/system/doc/system_principles/xmlfiles.mk b/system/doc/system_principles/xmlfiles.mk index 4cbc00ed52..9743949798 100644 --- a/system/doc/system_principles/xmlfiles.mk +++ b/system/doc/system_principles/xmlfiles.mk @@ -19,4 +19,5 @@ SYSTEM_PRINCIPLES_CHAPTER_FILES = \ system_principles.xml \ error_logging.xml \ - create_target.xml + create_target.xml \ + versions.xml diff --git a/system/doc/top/Makefile b/system/doc/top/Makefile index 79fd875d68..319f08f010 100644 --- a/system/doc/top/Makefile +++ b/system/doc/top/Makefile @@ -114,7 +114,7 @@ $(INDEX_SCRIPT): $(INDEX_SRC) $(ERLC) -o$(EBIN) +warn_unused_vars $< # We don't list toc_*.html as targets because we don't know -$(HTMLDIR)/index.html + $(HTMLDIR)/applications.html: $(INDEX_SCRIPT) +$(HTMLDIR)/index.html + $(HTMLDIR)/applications.html: $(INDEX_SCRIPT) $(TEMPLATES) echo "Generating index $@" # Check if we are building the index from source or an installed release if test "$$RELEASE_ROOT" = "" ; then \ diff --git a/system/doc/top/templates/index.html.src b/system/doc/top/templates/index.html.src index a176bc9a14..7acdadbf8a 100644 --- a/system/doc/top/templates/index.html.src +++ b/system/doc/top/templates/index.html.src @@ -2,7 +2,7 @@ <!-- %CopyrightBegin% -Copyright Ericsson AB 2009-2013. All Rights Reserved. +Copyright Ericsson AB 2009-2014. 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 @@ -104,10 +104,16 @@ In addition to the documentation here Erlang is described in several recent book </p> <ul> <li> +<a href="http://shop.oreilly.com/product/0636920025818.do">"Introducing Erlang"</a> from O'Reilly. +</li> +<li> +<a href="http://www.nostarch.com/erlang">"Learn You Some Erlang for Great Good!"</a> from nostarch. +</li> +<li> <a href="http://oreilly.com/catalog/9780596518189">"Erlang Programming"</a> from O'Reilly. </li> <li> -<a href="http://www.pragprog.com/titles/jaerlang">"Programming Erlang"</a> from Pragmatic. +<a href="http://www.pragprog.com/book/jaerlang2/programming-erlang">"Programming Erlang"</a> from Pragmatic. </li> <li> <a href="http://www.manning.com/logan">"Erlang and OTP in Action"</a> from Manning. diff --git a/xcomp/README.md b/xcomp/README.md index 768efc9c7d..d88fb89fd8 100644 --- a/xcomp/README.md +++ b/xcomp/README.md @@ -1,559 +1,7 @@ Cross Compiling Erlang/OTP ========================== -Introduction ------------- +See the [$ERL_TOP/HOWTO/INSTALL-CROSS.md][] documentation. -This document describes how to cross compile Erlang/OTP-%OTP-REL%. Note that -the support for cross compiling Erlang/OTP should be considered as -experimental. As far as we know, the %OTP-REL% release should cross compile -fine, but since we currently have a very limited set of cross compilation -environments to test with we cannot be sure. The cross compilation support -will remain in an experimental state until we get a lot more cross compilation -environments to test with. -You are advised to read the whole document before attempting to cross -compile Erlang/OTP. However, before reading this document, you should read -the [$ERL_TOP/INSTALL.md][] document which describes building and installing -Erlang/OTP in general. `$ERL_TOP` is the top directory in the source tree. - -### otp\_build Versus configure/make ### - -Building Erlang/OTP can be done either by using the `$ERL_TOP/otp_build` -script, or by invoking `$ERL_TOP/configure` and `make` directly. Building using -`otp_build` is easier since it involves fewer steps, but the `otp_build` build -procedure is not as flexible as the `configure`/`make` build procedure. Note -that `otp_build configure` will produce a default configuration that differs -from what `configure` will produce by default. For example, currently -`--disable-dynamic-ssl-lib` is added to the `configure` command line arguments -unless `--enable-dynamic-ssl-lib` has been explicitly passed. The binary -releases that we deliver are built using `otp_build`. The defaults used by -`otp_build configure` may change at any time without prior notice. - -### Cross Configuration ### - -The `$ERL_TOP/xcomp/erl-xcomp.conf.template` file contains all available cross -configuration variables and can be used as a template when creating a cross -compilation configuration. All [cross configuration variables][] are also -listed at the end of this document. For examples of working cross -configurations see the `$ERL_TOP/xcomp/erl-xcomp-TileraMDE2.0-tilepro.conf` -file and the `$ERL_TOP/xcomp/erl-xcomp-x86_64-saf-linux-gnu.conf` file. If the -default behavior of a variable is satisfactory, the variable does not need to -be set. However, the `configure` script will issue a warning when a default -value is used. When a variable has been set, no warning will be issued. - -A cross configuration file can be passed to `otp_build configure` using the -`--xcomp-conf` command line argument. Note that `configure` does not accept -this command line argument. When using the `configure` script directly, pass -the configuration variables as arguments to `configure` using a -`<VARIABLE>=<VALUE>` syntax. Variables can also be passed as environment -variables to `configure`. However, if you pass the configuration in the -environment, make sure to unset all of these environment variables before -invoking `make`; otherwise, the environment variables might set make variables -in some applications, or parts of some applications, and you may end up with -an erroneously configured build. - -### What can be Cross Compiled? ### - -All Erlang/OTP applications except the `wx` application can be cross compiled. -The build of the `wx` driver will currently be automatically disabled when -cross compiling. - -### Compatibility ### - -The build system, including cross compilation configuration variables used, -may be subject to non backward compatible changes without prior notice. -Current cross build system has been tested when cross compiling some Linux/GNU -systems, but has only been partly tested for more esoteric platforms. The -VxWorks example file is highly dependent on our environment and is here more -or less only for internal use. - -### Patches ### - -Please submit any patches for cross compiling in a way consistent with this -system. All input is welcome as we have a very limited set of cross compiling -environments to test with. If a new configuration variable is needed, add it -to `$ERL_TOP/xcomp/erl-xcomp.conf.template`, and use it in `configure.in`. -Other files that might need to be updated are: - -- `$ERL_TOP/xcomp/erl-xcomp-vars.sh` -- `$ERL_TOP/erl-build-tool-vars.sh` -- `$ERL_TOP/erts/aclocal.m4` -- `$ERL_TOP/xcomp/README.md` -- `$ERL_TOP/xcomp/erl-xcomp-*.conf` - -Note that this might be an incomplete list of files that need to be updated. - -General information on how to submit patches can be found at: - <http://wiki.github.com/erlang/otp/submitting-patches> - -Build and Install Procedure ---------------------------- - -If you are building in Git, you want to read the [Building in Git][] section -of [$ERL_TOP/INSTALL.md][] before proceeding. - -We will first go through the `configure`/`make` build procedure which people -probably are most familiar with. - -### Building With configure/make Directly ### - - (1) - -Change directory into the top directory of the Erlang/OTP source tree. - - $ cd $ERL_TOP - -In order to compile Erlang code, a small Erlang bootstrap system has to be -built, or an Erlang/OTP system of the same release as the one being built -has to be provided in the `$PATH`. The Erlang/OTP for the target system will -be built using this Erlang system, together with the cross compilation tools -provided. - -If you want to build the documentation out of the same source tree as you are -cross compiling in, you currently need a full Erlang/OTP system of the same -release as the one being built for the build machine. If this is the case, -build and install one for the build machine (or use one already built) and add -it to the `$PATH` before cross building, and building the documentation. See -the [How to Build the Documentation][] section in the [$ERL_TOP/INSTALL.md][] -document for information on how to build the documentation. - -If you want to build using a compatible Erlang/OTP system in the `$PATH`, -jump to (3). - -#### Building a Bootstrap System #### - - (2) - - $ ./configure --enable-bootstrap-only - $ make - -The `--enable-bootstrap-only` argument to `configure` isn't strictly necessary, -but will speed things up. It will only run `configure` in applications -necessary for the bootstrap, and will disable a lot of things not needed by -the bootstrap system. If you run `configure` without `--enable-boostrap-only` -you also have to run make as `make bootstrap`; otherwise, the whole system will -be built. - -#### Cross Building the System #### - - (3) - - $ ./configure --host=<HOST> --build=<BUILD> [Other Config Args] - $ make - -`<HOST>` is the host/target system that you build for. It does not have to be -a full `CPU-VENDOR-OS` triplet, but can be. The full `CPU-VENDOR-OS` triplet -will be created by executing `$ERL_TOP/erts/autoconf/config.sub <HOST>`. If -`config.sub` fails, you need to be more specific. - -`<BUILD>` should equal the `CPU-VENDOR-OS` triplet of the system that you -build on. If you execute `$ERL_TOP/erts/autoconf/config.guess`, it will in -most cases print the triplet you want to use for this. - -Pass the cross compilation variables as command line arguments to `configure` -using a `<VARIABLE>=<VALUE>` syntax. - -> *NOTE*: You can *not* pass a configuration file using the `--xcomp-conf` -> argument when you invoke `configure` directly. The `--xcomp-conf` argument -> can only be passed to `otp_build configure`. - -`make` will verify that the Erlang/OTP system used when building is of the -same release as the system being built, and will fail if this is not the case. -It is possible, however not recommended, to force the cross compilation even -though the wrong Erlang/OTP system is used. This by invoking `make` like this: -`make ERL_XCOMP_FORCE_DIFFERENT_OTP=yes`. - -> *WARNING*: Invoking `make ERL_XCOMP_FORCE_DIFFERENT_OTP=yes` might fail, -> silently produce suboptimal code, or silently produce erroneous code. - -#### Installing #### - -You can either install using the installation paths determined by `configure` -(4), or install manually using (5). - -##### Installing Using Paths Determined by configure ##### - - (4) - - $ make install DESTDIR=<TEMPORARY_PREFIX> - -`make install` will install at a location specified when doing `configure`. -`configure` arguments specifying where the installation should reside are for -example: `--prefix`, `--exec-prefix`, `--libdir`, `--bindir`, etc. By default -it will install under `/usr/local`. You typically do not want to install your -cross build under `/usr/local` on your build machine. Using [DESTDIR][] -will cause the installation paths to be prefixed by `$DESTDIR`. This makes it -possible to install and package the installation on the build machine without -having to place the installation in the same directory on the build machine as -it should be executed from on the target machine. - -When `make install` has finished, change directory into `$DESTDIR`, package -the system, move it to the target machine, and unpack it. Note that the -installation will only be working on the target machine at the location -determined by `configure`. - -##### Installing Manually ##### - - (5) - - $ make release RELEASE_ROOT=<RELEASE_DIR> - -`make release` will copy what you have built for the target machine to -`<RELEASE_DIR>`. The `Install` script will not be run. The content of -`<RELEASE_DIR>` is what by default ends up in `/usr/local/lib/erlang`. - -The `Install` script used when installing Erlang/OTP requires common Unix -tools such as `sed` to be present in your `$PATH`. If your target system -does not have such tools, you need to run the `Install` script on your -build machine before packaging Erlang/OTP. The `Install` script should -currently be invoked as follows in the directory where it resides -(the top directory): - - $ ./Install [-cross] [-minimal|-sasl] <ERL_ROOT> - -where: - -* `-minimal` Creates an installation that starts up a minimal amount - of applications, i.e., only `kernel` and `stdlib` are started. The - minimal system is normally enough, and is what `make install` uses. -* `-sasl` Creates an installation that also starts up the `sasl` - application. -* `-cross` For cross compilation. Informs the install script that it - is run on the build machine. -* `<ERL_ROOT>` - The absolute path to the Erlang installation to use - at run time. This is often the same as the current working directory, - but does not have to be. It can follow any other path through the file - system to the same directory. - -If neither `-minimal`, nor `-sasl` is passed as argument you will be -prompted. - -You can now either do: - - (6) - -* Decide where the installation should be located on the target machine, - run the `Install` script on the build machine, and package the installed - installation. The installation just need to be unpacked at the right - location on the target machine: - - $ cd <RELEASE_DIR> - $ ./Install -cross [-minimal|-sasl] <ABSOLUTE_INSTALL_DIR_ON_TARGET> - -or: - - (7) - -* Package the installation in `<RELEASE_DIR>`, place it wherever you want - on your target machine, and run the `Install` script on your target - machine: - - $ cd <ABSOLUTE_INSTALL_DIR_ON_TARGET> - $ ./Install [-minimal|-sasl] <ABSOLUTE_INSTALL_DIR_ON_TARGET> - -### Building With the otp\_build Script ### - - (8) - - $ cd $ERL_TOP - - (9) - - $ ./otp_build configure --xcomp-conf=<FILE> [Other Config Args] - -alternatively: - - $ ./otp_build configure --host=<HOST> --build=<BUILD> [Other Config Args] - -If you have your cross compilation configuration in a file, pass it using the -`--xcomp-conf=<FILE>` command line argument. If not, pass `--host=<HOST>`, -`--build=<BUILD>`, and the configuration variables using a `<VARIABLE>=<VALUE>` -syntax on the command line (same as in (3)). Note that `<HOST>` and `<BUILD>` -have to be passed one way or the other; either by using `erl_xcomp_host=<HOST>` -and `erl_xcomp_build=<BUILD>` in the configuration file, or by using the -`--host=<HOST>`, and `--build=<BUILD>` command line arguments. - -`otp_build configure` will configure both for the boostrap system on the -build machine and the cross host system. - - (10) - - $ ./otp_build boot -a - -`otp_build boot -a` will first build a bootstrap system for the build machine -and then do the cross build of the system. - - (11) - - $ ./otp_build release -a <RELEASE_DIR> - -`otp_build release -a` will do the same as (5), and you will after this have -to do a manual install either by doing (6), or (7). - -Testing the cross compiled system --------------------------------------- -Some of the tests that come with erlang use native code to test. This means -that when cross compiling erlang you also have to cross compile test suites -in order to run tests on the target host. To do this you first have to release -the tests as usual. - - $ make release_tests - -or - - $ ./otp_build tests - -The tests will be released into `$ERL_TOP/release/tests`. After releasing the -tests you have to install the tests on the build machine. You supply the same -xcomp file as to `./otp_build` in (9). - - $ cd $ERL_TOP/release/tests/test_server/ - $ $ERL_TOP/bootstrap/bin/erl -eval 'ts:install([{xcomp,"<FILE>"}])' -s ts compile_testcases -s init stop - -You should get a lot of printouts as the testcases are compiled. Once done you -should copy the entire `$ERL_TOP/release/tests` folder to the cross host system. - -Then go to the cross host system and setup the erlang installed in (4) or (5) -to be in your `$PATH`. Then go to what previously was -`$ERL_TOP/release/tests/test_server` and issue the following command. - - $ erl -s ts install -s ts run all_tests -s init stop - -The configure should be skipped and all tests should hopefully pass. For more -details about how to use ts run `erl -s ts help -s init stop` - -Currently Used Configuration Variables --------------------------------------- - -Note that you cannot define arbitrary variables in a cross compilation -configuration file. Only the ones listed below will be guaranteed to be -visible throughout the whole execution of all `configure` scripts. Other -variables needs to be defined as arguments to `configure` or exported in -the environment. - -### Variables for otp\_build Only ### - -Variables in this section are only used, when configuring Erlang/OTP for -cross compilation using `$ERL_TOP/otp_build configure`. - -> *NOTE*: These variables currently have *no* effect if you configure using -> the `configure` script directly. - -* `erl_xcomp_build` - The build system used. This value will be passed as - `--build=$erl_xcomp_build` argument to the `configure` script. It does - not have to be a full `CPU-VENDOR-OS` triplet, but can be. The full - `CPU-VENDOR-OS` triplet will be created by - `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_build`. If set to `guess`, - the build system will be guessed using - `$ERL_TOP/erts/autoconf/config.guess`. - -* `erl_xcomp_host` - Cross host/target system to build for. This value will - be passed as `--host=$erl_xcomp_host` argument to the `configure` script. - It does not have to be a full `CPU-VENDOR-OS` triplet, but can be. The - full `CPU-VENDOR-OS` triplet will be created by - `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_host`. - -* `erl_xcomp_configure_flags` - Extra configure flags to pass to the - `configure` script. - -### Cross Compiler and Other Tools ### - -If the cross compilation tools are prefixed by `<HOST>-` you probably do -not need to set these variables (where `<HOST>` is what has been passed as -`--host=<HOST>` argument to `configure`). - -All variables in this section can also be used when native compiling. - -* `CC` - C compiler. - -* `CFLAGS` - C compiler flags. - -* `STATIC_CFLAGS` - Static C compiler flags. - -* `CFLAG_RUNTIME_LIBRARY_PATH` - This flag should set runtime library - search path for the shared libraries. Note that this actually is a - linker flag, but it needs to be passed via the compiler. - -* `CPP` - C pre-processor. - -* `CPPFLAGS` - C pre-processor flags. - -* `CXX` - C++ compiler. - -* `CXXFLAGS` - C++ compiler flags. - -* `LD` - Linker. - -* `LDFLAGS` - Linker flags. - -* `LIBS` - Libraries. - -#### Dynamic Erlang Driver Linking #### - -> *NOTE*: Either set all or none of the `DED_LD*` variables. - -* `DED_LD` - Linker for Dynamically loaded Erlang Drivers. - -* `DED_LDFLAGS` - Linker flags to use with `DED_LD`. - -* `DED_LD_FLAG_RUNTIME_LIBRARY_PATH` - This flag should set runtime library - search path for shared libraries when linking with `DED_LD`. - -#### Large File Support #### - -> *NOTE*: Either set all or none of the `LFS_*` variables. - -* `LFS_CFLAGS` - Large file support C compiler flags. - -* `LFS_LDFLAGS` - Large file support linker flags. - -* `LFS_LIBS` - Large file support libraries. - -#### Other Tools #### - -* `RANLIB` - `ranlib` archive index tool. - -* `AR` - `ar` archiving tool. - -* `GETCONF` - `getconf` system configuration inspection tool. `getconf` is - currently used for finding out large file support flags to use, and - on Linux systems for finding out if we have an NPTL thread library or - not. - -### Cross System Root Locations ### - -* `erl_xcomp_sysroot` - The absolute path to the system root of the cross - compilation environment. Currently, the `crypto`, `odbc`, `ssh` and - `ssl` applications need the system root. These applications will be - skipped if the system root has not been set. The system root might be - needed for other things too. If this is the case and the system root - has not been set, `configure` will fail and request you to set it. - -* `erl_xcomp_isysroot` - The absolute path to the system root for includes - of the cross compilation environment. If not set, this value defaults - to `$erl_xcomp_sysroot`, i.e., only set this value if the include system - root path is not the same as the system root path. - -### Optional Feature, and Bug Tests ### - -These tests cannot (always) be done automatically when cross compiling. You -usually do not need to set these variables. - -> *WARNING*: Setting these variables wrong may cause hard to detect -> runtime errors. If you need to change these values, *really* make sure -> that the values are correct. - -> *NOTE*: Some of these values will override results of tests performed -> by `configure`, and some will not be used until `configure` is sure that -> it cannot figure the result out. - -The `configure` script will issue a warning when a default value is used. -When a variable has been set, no warning will be issued. - -* `erl_xcomp_after_morecore_hook` - `yes|no`. Defaults to `no`. If `yes`, - the target system must have a working `__after_morecore_hook` that can be - used for tracking used `malloc()` implementations core memory usage. - This is currently only used by unsupported features. - -* `erl_xcomp_bigendian` - `yes|no`. No default. If `yes`, the target system - must be big endian. If `no`, little endian. This can often be - automatically detected, but not always. If not automatically detected, - `configure` will fail unless this variable is set. Since no default - value is used, `configure` will try to figure this out automatically. - -* `erl_xcomp_double_middle` - `yes|no`. Defaults to `no`. - If `yes`, the target system must have doubles in "middle-endian" format. If - `no`, it has "regular" endianness. - -* `erl_xcomp_clock_gettime_cpu_time` - `yes|no`. Defaults to `no`. If `yes`, - the target system must have a working `clock_gettime()` implementation - that can be used for retrieving process CPU time. - -* `erl_xcomp_getaddrinfo` - `yes|no`. Defaults to `no`. If `yes`, the target - system must have a working `getaddrinfo()` implementation that can - handle both IPv4 and IPv6. - -* `erl_xcomp_gethrvtime_procfs_ioctl` - `yes|no`. Defaults to `no`. If `yes`, - the target system must have a working `gethrvtime()` implementation and - is used with procfs `ioctl()`. - -* `erl_xcomp_dlsym_brk_wrappers` - `yes|no`. Defaults to `no`. If `yes`, the - target system must have a working `dlsym(RTLD_NEXT, <S>)` implementation - that can be used on `brk` and `sbrk` symbols used by the `malloc()` - implementation in use, and by this track the `malloc()` implementations - core memory usage. This is currently only used by unsupported features. - -* `erl_xcomp_kqueue` - `yes|no`. Defaults to `no`. If `yes`, the target - system must have a working `kqueue()` implementation that returns a file - descriptor which can be used by `poll()` and/or `select()`. If `no` and - the target system has not got `epoll()` or `/dev/poll`, the kernel-poll - feature will be disabled. - -* `erl_xcomp_linux_clock_gettime_correction` - `yes|no`. Defaults to `yes` on - Linux; otherwise, `no`. If `yes`, `clock_gettime(CLOCK_MONOTONIC, _)` on - the target system must work. This variable is recommended to be set to - `no` on Linux systems with kernel versions less than 2.6. - -* `erl_xcomp_linux_nptl` - `yes|no`. Defaults to `yes` on Linux; otherwise, - `no`. If `yes`, the target system must have NPTL (Native POSIX Thread - Library). Older Linux systems have LinuxThreads instead of NPTL (Linux - kernel versions typically less than 2.6). - -* `erl_xcomp_linux_usable_sigaltstack` - `yes|no`. Defaults to `yes` on Linux; - otherwise, `no`. If `yes`, `sigaltstack()` must be usable on the target - system. `sigaltstack()` on Linux kernel versions less than 2.4 are - broken. - -* `erl_xcomp_linux_usable_sigusrx` - `yes|no`. Defaults to `yes`. If `yes`, - the `SIGUSR1` and `SIGUSR2` signals must be usable by the ERTS. Old - LinuxThreads thread libraries (Linux kernel versions typically less than - 2.2) used these signals and made them unusable by the ERTS. - -* `erl_xcomp_poll` - `yes|no`. Defaults to `no` on Darwin/MacOSX; otherwise, - `yes`. If `yes`, the target system must have a working `poll()` - implementation that also can handle devices. If `no`, `select()` will be - used instead of `poll()`. - -* `erl_xcomp_putenv_copy` - `yes|no`. Defaults to `no`. If `yes`, the target - system must have a `putenv()` implementation that stores a copy of the - key/value pair. - -* `erl_xcomp_reliable_fpe` - `yes|no`. Defaults to `no`. If `yes`, the target - system must have reliable floating point exceptions. - -Copyright and License ---------------------- - -%CopyrightBegin% - -Copyright Ericsson AB 2009-2012. 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% - -Modifying This Document ------------------------ - -Before modifying this document you need to have a look at the -`$ERL_TOP/README.md.txt` document. - - - - [$ERL_TOP/INSTALL.md]: INSTALL - [Building in Git]: INSTALL#How-to-Build-and-Install-ErlangOTP_Building-in-Git - [How to Build the Documentation]: INSTALL#The-ErlangOTP-Documentation_How-to-Build-the-Documentation - [cross configuration variables]: #Currently-Used-Configuration-Variables - [DESTDIR]: http://www.gnu.org/prep/standards/html_node/DESTDIR.html - - [?TOC]: true + [$ERL_TOP/HOWTO/INSTALL-CROSS.md]: ../HOWTO/INSTALL-CROSS.md diff --git a/xcomp/erl-xcomp-arm-android.conf b/xcomp/erl-xcomp-arm-android.conf new file mode 100644 index 0000000000..4fd1f270d1 --- /dev/null +++ b/xcomp/erl-xcomp-arm-android.conf @@ -0,0 +1,264 @@ +## -*-shell-script-*- +## +## %CopyrightBegin% +## +## Copyright Ericsson AB 2009-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 +## 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% +## +## File: erl-xcomp.conf.template +## Author: +## +## ----------------------------------------------------------------------------- +## When cross compiling Erlang/OTP using `otp_build', copy this file and set +## the variables needed below. Then pass the path to the copy of this file as +## an argument to `otp_build' in the configure stage: +## `otp_build configure --xcomp-conf=<FILE>' +## ----------------------------------------------------------------------------- + +## Note that you cannot define arbitrary variables in a cross compilation +## configuration file. Only the ones listed below will be guaranteed to be +## visible throughout the whole execution of all `configure' scripts. Other +## variables needs to be defined as arguments to `configure' or exported in +## the environment. + +## -- Variables for `otp_build' Only ------------------------------------------- + +## Variables in this section are only used, when configuring Erlang/OTP for +## cross compilation using `$ERL_TOP/otp_build configure'. + +## *NOTE*! These variables currently have *no* effect if you configure using +## the `configure' script directly. + +# * `erl_xcomp_build' - The build system used. This value will be passed as +# `--build=$erl_xcomp_build' argument to the `configure' script. It does +# not have to be a full `CPU-VENDOR-OS' triplet, but can be. The full +# `CPU-VENDOR-OS' triplet will be created by +# `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_build'. If set to `guess', +# the build system will be guessed using +# `$ERL_TOP/erts/autoconf/config.guess'. +erl_xcomp_build=guess + +# * `erl_xcomp_host' - Cross host/target system to build for. This value will +# be passed as `--host=$erl_xcomp_host' argument to the `configure' script. +# It does not have to be a full `CPU-VENDOR-OS' triplet, but can be. The +# full `CPU-VENDOR-OS' triplet will be created by +# `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_host'. +erl_xcomp_host=arm-linux-androideabi + +# * `erl_xcomp_configure_flags' - Extra configure flags to pass to the +# `configure' script. +erl_xcomp_configure_flags="--disable-hipe --without-termcap" + + +## -- Cross Compiler and Other Tools ------------------------------------------- + +## +## +NDK_SYSROOT=$NDK_ROOT/platforms/$NDK_PLAT/arch-arm + +## If the cross compilation tools are prefixed by `<HOST>-' you probably do +## not need to set these variables (where `<HOST>' is what has been passed as +## `--host=<HOST>' argument to `configure'). + +## All variables in this section can also be used when native compiling. + +# * `CC' - C compiler. +CC="arm-linux-androideabi-gcc --sysroot=$NDK_SYSROOT" + +# * `CFLAGS' - C compiler flags. +CFLAGS="-static -march=armv7-a -msoft-float -mthumb" + +# * `STATIC_CFLAGS' - Static C compiler flags. +#STATIC_CFLAGS= + +# * `CFLAG_RUNTIME_LIBRARY_PATH' - This flag should set runtime library +# search path for the shared libraries. Note that this actually is a +# linker flag, but it needs to be passed via the compiler. +#CFLAG_RUNTIME_LIBRARY_PATH= + +# * `CPP' - C pre-processor. +CPP="arm-linux-androideabi-cpp --sysroot=$NDK_SYSROOT" + +# * `CPPFLAGS' - C pre-processor flags. +CPPFLAGS="-static -march=armv7-a -msoft-float -mthumb" + +# * `CXX' - C++ compiler. +CXX="arm-linux-androideabi-c++ --sysroot=$NDK_SYSROOT" + +# * `CXXFLAGS' - C++ compiler flags. +CXXFLAGS="-static -march=armv7-a -msoft-float -mthumb" + +# * `LD' - Linker. +#LD= + +# * `LDFLAGS' - Linker flags. +LDFLAGS="-static -march=armv7-a -msoft-float -mthumb" + +# * `LIBS' - Libraries. +#LIBS= + +## -- *D*ynamic *E*rlang *D*river Linking -- + +## *NOTE*! Either set all or none of the `DED_LD*' variables. + +# * `DED_LD' - Linker for Dynamically loaded Erlang Drivers. +#DED_LD= + +# * `DED_LDFLAGS' - Linker flags to use with `DED_LD'. +#DED_LDFLAGS= + +# * `DED_LD_FLAG_RUNTIME_LIBRARY_PATH' - This flag should set runtime library +# search path for shared libraries when linking with `DED_LD'. +#DED_LD_FLAG_RUNTIME_LIBRARY_PATH= + +## -- Large File Support -- + +## *NOTE*! Either set all or none of the `LFS_*' variables. + +# * `LFS_CFLAGS' - Large file support C compiler flags. +#LFS_CFLAGS= + +# * `LFS_LDFLAGS' - Large file support linker flags. +#LFS_LDFLAGS= + +# * `LFS_LIBS' - Large file support libraries. +#LFS_LIBS= + +## -- Other Tools -- + +# * `RANLIB' - `ranlib' archive index tool. +#RANLIB= + +# * `AR' - `ar' archiving tool. +#AR= + +# * `GETCONF' - `getconf' system configuration inspection tool. `getconf' is +# currently used for finding out large file support flags to use, and +# on Linux systems for finding out if we have an NPTL thread library or +# not. +#GETCONF= + +## -- Cross System Root Locations ---------------------------------------------- + +# * `erl_xcomp_sysroot' - The absolute path to the system root of the cross +# compilation environment. Currently, the `crypto', `odbc', `ssh' and +# `ssl' applications need the system root. These applications will be +# skipped if the system root has not been set. The system root might be +# needed for other things too. If this is the case and the system root +# has not been set, `configure' will fail and request you to set it. +erl_xcomp_sysroot="$NDK_SYSROOT" + + +# * `erl_xcomp_isysroot' - The absolute path to the system root for includes +# of the cross compilation environment. If not set, this value defaults +# to `$erl_xcomp_sysroot', i.e., only set this value if the include system +# root path is not the same as the system root path. +#erl_xcomp_isysroot= + +## -- Optional Feature, and Bug Tests ------------------------------------------ + +## These tests cannot (always) be done automatically when cross compiling. You +## usually do not need to set these variables. Only set these if you really +## know what you are doing. + +## Note that some of these values will override results of tests performed +## by `configure', and some will not be used until `configure' is sure that +## it cannot figure the result out. + +## The `configure' script will issue a warning when a default value is used. +## When a variable has been set, no warning will be issued. + +# * `erl_xcomp_after_morecore_hook' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `__after_morecore_hook' that can be +# used for tracking used `malloc()' implementations core memory usage. +# This is currently only used by unsupported features. +#erl_xcomp_after_morecore_hook= + +# * `erl_xcomp_bigendian' - `yes|no'. No default. If `yes', the target system +# must be big endian. If `no', little endian. This can often be +# automatically detected, but not always. If not automatically detected, +# `configure' will fail unless this variable is set. Since no default +# value is used, `configure' will try to figure this out automatically. +#erl_xcomp_bigendian= + +# * `erl_xcomp_clock_gettime_cpu_time' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `clock_gettime()' implementation +# that can be used for retrieving process CPU time. +#erl_xcomp_clock_gettime_cpu_time= + +# * `erl_xcomp_getaddrinfo' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a working `getaddrinfo()' implementation that can +# handle both IPv4 and IPv6. +#erl_xcomp_getaddrinfo= + +# * `erl_xcomp_gethrvtime_procfs_ioctl' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `gethrvtime()' implementation and +# is used with procfs `ioctl()'. +#erl_xcomp_gethrvtime_procfs_ioctl= + +# * `erl_xcomp_dlsym_brk_wrappers' - `yes|no'. Defaults to `no'. If `yes', the +# target system must have a working `dlsym(RTLD_NEXT, <S>)' implementation +# that can be used on `brk' and `sbrk' symbols used by the `malloc()' +# implementation in use, and by this track the `malloc()' implementations +# core memory usage. This is currently only used by unsupported features. +#erl_xcomp_dlsym_brk_wrappers= + +# * `erl_xcomp_kqueue' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a working `kqueue()' implementation that returns a file +# descriptor which can be used by `poll()' and/or `select()'. If `no' and +# the target system has not got `epoll()' or `/dev/poll', the kernel-poll +# feature will be disabled. +#erl_xcomp_kqueue= + +# * `erl_xcomp_linux_clock_gettime_correction' - `yes|no'. Defaults to `yes' on +# Linux; otherwise, `no'. If `yes', `clock_gettime(CLOCK_MONOTONIC, _)' on +# the target system must work. This variable is recommended to be set to +# `no' on Linux systems with kernel versions less than 2.6. +#erl_xcomp_linux_clock_gettime_correction= + +# * `erl_xcomp_linux_nptl' - `yes|no'. Defaults to `yes' on Linux; otherwise, +# `no'. If `yes', the target system must have NPTL (Native POSIX Thread +# Library). Older Linux systems have LinuxThreads instead of NPTL (Linux +# kernel versions typically less than 2.6). +#erl_xcomp_linux_nptl= + +# * `erl_xcomp_linux_usable_sigaltstack' - `yes|no'. Defaults to `yes' on Linux; +# otherwise, `no'. If `yes', `sigaltstack()' must be usable on the target +# system. `sigaltstack()' on Linux kernel versions less than 2.4 are +# broken. +#erl_xcomp_linux_usable_sigaltstack= + +# * `erl_xcomp_linux_usable_sigusrx' - `yes|no'. Defaults to `yes'. If `yes', +# the `SIGUSR1' and `SIGUSR2' signals must be usable by the ERTS. Old +# LinuxThreads thread libraries (Linux kernel versions typically less than +# 2.2) used these signals and made them unusable by the ERTS. +#erl_xcomp_linux_usable_sigusrx= + +# * `erl_xcomp_poll' - `yes|no'. Defaults to `no' on Darwin/MacOSX; otherwise, +# `yes'. If `yes', the target system must have a working `poll()' +# implementation that also can handle devices. If `no', `select()' will be +# used instead of `poll()'. +#erl_xcomp_poll= + +# * `erl_xcomp_putenv_copy' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a `putenv()' implementation that stores a copy of the +# key/value pair. +#erl_xcomp_putenv_copy= + +# * `erl_xcomp_reliable_fpe' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have reliable floating point exceptions. +#erl_xcomp_reliable_fpe= + +## ----------------------------------------------------------------------------- diff --git a/xcomp/erl-xcomp-powerpc-ose5.conf b/xcomp/erl-xcomp-powerpc-ose5.conf new file mode 100644 index 0000000000..bf49b32827 --- /dev/null +++ b/xcomp/erl-xcomp-powerpc-ose5.conf @@ -0,0 +1,357 @@ +## -*-shell-script-*- +## +## %CopyrightBegin% +## +## Copyright Ericsson AB 2009-2012. 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% +## +## File: erl-xcomp-sfk-linux-ose5.conf +## Author: Petre Pircalabu +## +## ----------------------------------------------------------------------------- +## When cross compiling Erlang/OTP using `otp_build', copy this file and set +## the variables needed below. Then pass the path to the copy of this file as +## an argument to `otp_build' in the configure stage: +## `otp_build configure --xcomp-conf=<FILE>' +## ----------------------------------------------------------------------------- + +## Note that you cannot define arbitrary variables in a cross compilation +## configuration file. Only the ones listed below will be guaranteed to be +## visible throughout the whole execution of all `configure' scripts. Other +## variables needs to be defined as arguments to `configure' or exported in +## the environment. + +## -- Variables needed for an OSE5 build --------------------------------------- +OSEROOT="/vobs/ose5/system" +HOST="linux" + +GCCVERSION="4.4.3" +GCCROOT="${OSEROOT}/gcc_linux_powerpc_${GCCVERSION}" + +OSEDEBUG="no" +OSESSL="no" + +case ${GCCVERSION} in +4.4.3) + GCCTARGET="powerpc-eabi" + ;; +4.6.3) + GCCTARGET="powerpc-ose-eabi" + ;; +*) + echo "Error: Unknown GCCVERSION: ${GCCVERSION}" + exit 1 +esac + +if [ ${OSEDEBUG} != "yes" ]; +then +OPT_LEVEL="-O2" +else +OPT_LEVEL="" +fi + +if [ ${OSESSL} = "yes" ]; +then +## If your crypto is not in OSEROOT then you have to use --with-ssl to +## point to the correct place. Also CRYPTO_LIB_PATH has to be modified to +## point there as well. +CRYPTO_CONFIG_OPTION="--disable-dynamic-ssl-lib" +CRYPTO_NIF_PATH=",$ERL_TOP/lib/crypto/priv/lib/powerpc-unknown-ose/crypto.a" +CRYPTO_LIB_PATH="${OSEROOT}/lib/powerpc/libsslcrypto.a" +else +CRYPTO_CONFIG_OPTION="--without-ssl" +CRYPTO_NIF_PATH="" +CRYPTO_LIB_PATH="" +fi + + +## -- Variables for `otp_build' Only ------------------------------------------- + +## Variables in this section are only used, when configuring Erlang/OTP for +## cross compilation using `$ERL_TOP/otp_build configure'. + +## *NOTE*! These variables currently have *no* effect if you configure using +## the `configure' script directly. + +# * `erl_xcomp_build' - The build system used. This value will be passed as +# `--build=$erl_xcomp_build' argument to the `configure' script. It does +# not have to be a full `CPU-VENDOR-OS' triplet, but can be. The full +# `CPU-VENDOR-OS' triplet will be created by +# `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_build'. If set to `guess', +# the build system will be guessed using +# `$ERL_TOP/erts/autoconf/config.guess'. +erl_xcomp_build=guess + +# * `erl_xcomp_host' - Cross host/target system to build for. This value will +# be passed as `--host=$erl_xcomp_host' argument to the `configure' script. +# It does not have to be a full `CPU-VENDOR-OS' triplet, but can be. The +# full `CPU-VENDOR-OS' triplet will be created by +# `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_host'. +erl_xcomp_host="powerpc-ose" + +disabled_apps="--without-erl_interface --without-os_mon --without-megaco --without-observer --without-wx --without-appmon --without-cosEvent --without-cosEventDomain --without-cosFileTransfer --without-cosNotification --without-cosProperty --without-cosTime --without-cosTransactions --without-debugger --without-dialyzer --without-edoc --without-erl_docgen --without-eunit --without-gs --without-hipe --without-ic --without-orber --without-pman --without-toolbar --without-tv --without-webtool --without-typer" + +# * `erl_xcomp_configure_flags' - Extra configure flags to pass to the +# `configure' script. +erl_xcomp_configure_flags="${CRYPTO_CONFIG_OPTION} --disable-kernel-poll --disable-hipe --without-termcap --without-javac ${disabled_apps} --enable-static-nifs=$ERL_TOP/lib/asn1/priv/lib/powerpc-unknown-ose/asn1rt_nif.a${CRYPTO_NIF_PATH}" + +## -- Cross Compiler and Other Tools ------------------------------------------- + +## If the cross compilation tools are prefixed by `<HOST>-' you probably do +## not need to set these variables (where `<HOST>' is what has been passed as +## `--host=<HOST>' argument to `configure'). + +## All variables in this section can also be used when native compiling. + +# * `CC' - C compiler. +CC="$GCCROOT/bin/$GCCTARGET-gcc" + +# * `CFLAGS' - C compiler flags. +CFLAGS="-msoft-float -g -fno-strict-aliasing -fno-builtin -fshort-wchar -Wall -Wno-unknown-pragmas -mpowerpc -nostdlib -I$GCCROOT/include/c++/$GCCVERSION -I$OSEROOT/include -I$OSEROOT/include/ose_spi -I$OSEROOT/include/gcc -MD -MP -D__OSE__ -DBIG_ENDIAN -DCF_CONF_SIZE=0x800 ${OPT_LEVEL}" + + +# * `STATIC_CFLAGS' - Static C compiler flags. +#STATIC_CFLAGS= + +# * `CFLAG_RUNTIME_LIBRARY_PATH' - This flag should set runtime library +# search path for the shared libraries. Note that this actually is a +# linker flag, but it needs to be passed via the compiler. +#CFLAG_RUNTIME_LIBRARY_PATH= + +# * `CPP' - C pre-processor. +CPP="$GCCROOT/bin/$GCCTARGET-cpp" + +# * `CPPFLAGS' - C pre-processor flags. +CPPFLAGS="-msoft-float -g -fno-strict-aliasing -fno-builtin -fshort-wchar -Wall -Wno-unknown-pragmas -mpowerpc -nostdlib -I$GCCROOT/include/c++/$GCCVERSION -I$OSEROOT/include -I$OSEROOT/include/ose_spi -I$OSEROOT/include/gcc -MD -MP -D__OSE__ -DBIG_ENDIAN -DCF_CONF_SIZE=0x800 ${OPT_LEVEL}" + + +# * `CXX' - C++ compiler. +CXX="$GCCROOT/bin/$GCCTARGET-g++" + +# * `CXXFLAGS' - C++ compiler flags. +CXXFLAGS="-msoft-float -g -fno-strict-aliasing -ansi -I$GCCROOT/include/c++/$GCCVERSION -I$OSEROOT/include -I$OSEROOT/include/gcc ${OPT_LEVEL}" + +# * `LD' - Linker. +LD="${GCCROOT}/bin/${GCCTARGET}-ld" + +# * `LDFLAGS' - Linker flags. +LDFLAGS="-Wl,-ecrt0_lm -Wl,-T,${ERL_TOP}/erts/emulator/sys/ose/gcc_${GCCVERSION}_lm_ppc.lcf" + +# * `LIBS' - Libraries. +LIBS="${OSEROOT}/lib/powerpc/libcrt.a ${OSEROOT}/lib/powerpc/libm.a ${GCCROOT}/lib/gcc/${GCCTARGET}/${GCCVERSION}/nof/libgcc.a ${CRYPTO_LIB_PATH}" + +## -- *D*ynamic *E*rlang *D*river Linking -- + +## *NOTE*! Either set all or none of the `DED_LD*' variables. + +# * `DED_LD' - Linker for Dynamically loaded Erlang Drivers. +DED_LD= + +# * `DED_LDFLAGS' - Linker flags to use with `DED_LD'. +DED_LDFLAGS= + +# * `DED_LD_FLAG_RUNTIME_LIBRARY_PATH' - This flag should set runtime library +# search path for shared libraries when linking with `DED_LD'. +DED_LD_FLAG_RUNTIME_LIBRARY_PATH= + +## -- Large File Support -- + +## *NOTE*! Either set all or none of the `LFS_*' variables. + +# * `LFS_CFLAGS' - Large file support C compiler flags. +#LFS_CFLAGS= + +# * `LFS_LDFLAGS' - Large file support linker flags. +#LFS_LDFLAGS= + +# * `LFS_LIBS' - Large file support libraries. +#LFS_LIBS= + +## -- Other Tools -- + +# * `RANLIB' - `ranlib' archive index tool. +RANLIB="$GCCROOT/bin/$GCCTARGET-ranlib" + +# * `AR' - `ar' archiving tool. +AR="$GCCROOT/bin/$GCCTARGET-ar" + +# * `STRIP' - `strip +STRIP="$GCCROOT/bin/$GCCTARGET-strip" + +# * `GETCONF' - `getconf' system configuration inspection tool. `getconf' is +# currently used for finding out large file support flags to use, and +# on Linux systems for finding out if we have an NPTL thread library or +# not. +#GETCONF= + +## -- Cross System Root Locations ---------------------------------------------- + +# * `erl_xcomp_sysroot' - The absolute path to the system root of the cross +# compilation environment. Currently, the `crypto', `odbc', `ssh' and +# `ssl' applications need the system root. These applications will be +# skipped if the system root has not been set. The system root might be +# needed for other things too. If this is the case and the system root +# has not been set, `configure' will fail and request you to set it. +erl_xcomp_sysroot="$OSEROOT" + +# * `erl_xcomp_isysroot' - The absolute path to the system root for includes +# of the cross compilation environment. If not set, this value defaults +# to `$erl_xcomp_sysroot', i.e., only set this value if the include system +# root path is not the same as the system root path. +#erl_xcomp_isysroot="$OSEROOT" + +## -- Optional Feature, and Bug Tests ------------------------------------------ + +## These tests cannot (always) be done automatically when cross compiling. You +## usually do not need to set these variables. Only set these if you really +## know what you are doing. + +## Note that some of these values will override results of tests performed +## by `configure', and some will not be used until `configure' is sure that +## it cannot figure the result out. + +## The `configure' script will issue a warning when a default value is used. +## When a variable has been set, no warning will be issued. + +# * `erl_xcomp_after_morecore_hook' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `__after_morecore_hook' that can be +# used for tracking used `malloc()' implementations core memory usage. +# This is currently only used by unsupported features. +#erl_xcomp_after_morecore_hook= + +# * `erl_xcomp_bigendian' - `yes|no'. No default. If `yes', the target system +# must be big endian. If `no', little endian. This can often be +# automatically detected, but not always. If not automatically detected, +# `configure' will fail unless this variable is set. Since no default +# value is used, `configure' will try to figure this out automatically. +#erl_xcomp_bigendian= + +# * `erl_xcomp_double_middle` - `yes|no`. No default. If `yes`, the +# target system must have doubles in "middle-endian" format. If +# `no`, it has "regular" endianness. This can often be automatically +# detected, but not always. If not automatically detected, +# `configure` will fail unless this variable is set. Since no +# default value is used, `configure` will try to figure this out +# automatically. +#erl_xcomp_double_middle_endian + +# * `erl_xcomp_clock_gettime_cpu_time' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `clock_gettime()' implementation +# that can be used for retrieving process CPU time. +#erl_xcomp_clock_gettime_cpu_time= + +# * `erl_xcomp_getaddrinfo' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a working `getaddrinfo()' implementation that can +# handle both IPv4 and IPv6. +#erl_xcomp_getaddrinfo= + +# * `erl_xcomp_gethrvtime_procfs_ioctl' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `gethrvtime()' implementation and +# is used with procfs `ioctl()'. +#erl_xcomp_gethrvtime_procfs_ioctl= + +# * `erl_xcomp_dlsym_brk_wrappers' - `yes|no'. Defaults to `no'. If `yes', the +# target system must have a working `dlsym(RTLD_NEXT, <S>)' implementation +# that can be used on `brk' and `sbrk' symbols used by the `malloc()' +# implementation in use, and by this track the `malloc()' implementations +# core memory usage. This is currently only used by unsupported features. +#erl_xcomp_dlsym_brk_wrappers= + +# * `erl_xcomp_kqueue' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a working `kqueue()' implementation that returns a file +# descriptor which can be used by `poll()' and/or `select()'. If `no' and +# the target system has not got `epoll()' or `/dev/poll', the kernel-poll +# feature will be disabled. +#erl_xcomp_kqueue= + +# * `erl_xcomp_linux_clock_gettime_correction' - `yes|no'. Defaults to `yes' on +# Linux; otherwise, `no'. If `yes', `clock_gettime(CLOCK_MONOTONIC, _)' on +# the target system must work. This variable is recommended to be set to +# `no' on Linux systems with kernel versions less than 2.6. +#erl_xcomp_linux_clock_gettime_correction= + +# * `erl_xcomp_linux_nptl' - `yes|no'. Defaults to `yes' on Linux; otherwise, +# `no'. If `yes', the target system must have NPTL (Native POSIX Thread +# Library). Older Linux systems have LinuxThreads instead of NPTL (Linux +# kernel versions typically less than 2.6). +#erl_xcomp_linux_nptl= + +# * `erl_xcomp_linux_usable_sigaltstack' - `yes|no'. Defaults to `yes' on Linux; +# otherwise, `no'. If `yes', `sigaltstack()' must be usable on the target +# system. `sigaltstack()' on Linux kernel versions less than 2.4 are +# broken. +#erl_xcomp_linux_usable_sigaltstack= + +# * `erl_xcomp_linux_usable_sigusrx' - `yes|no'. Defaults to `yes'. If `yes', +# the `SIGUSR1' and `SIGUSR2' signals must be usable by the ERTS. Old +# LinuxThreads thread libraries (Linux kernel versions typically less than +# 2.2) used these signals and made them unusable by the ERTS. +#erl_xcomp_linux_usable_sigusrx= + +# * `erl_xcomp_poll' - `yes|no'. Defaults to `no' on Darwin/MacOSX; otherwise, +# `yes'. If `yes', the target system must have a working `poll()' +# implementation that also can handle devices. If `no', `select()' will be +# used instead of `poll()'. +erl_xcomp_poll=no + +# * `erl_xcomp_putenv_copy' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a `putenv()' implementation that stores a copy of the +# key/value pair. +#erl_xcomp_putenv_copy= + +# * `erl_xcomp_reliable_fpe' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have reliable floating point exceptions. +#erl_xcomp_reliable_fpe= +# * `erl_xcomp_ose_ldflags_pass1` - Linker flags for the OSE module (pass 1) +erl_xcomp_ose_ldflags_pass1="-r --no-omagic" + +# * `erl_xcomp_ose_ldflags_pass2` - Linker flags for the OSE module (pass 2) +erl_xcomp_ose_ldflags_pass2="-n --emit-relocs -ecrt0_lm --no-omagic" + +# * `erl_xcomp_ose_OSEROOT` - OSE installation root directory +erl_xcomp_ose_OSEROOT="${OSEROOT}" + +# * `erl_xcomp_ose_STRIP` - Strip utility shipped with the OSE distribution +erl_xcomp_ose_STRIP="${GCCROOT}/bin/${GCCTARGET}-strip" + +# * `erl_xcomp_ose_LM_POST_LINK` - OSE postlink tool +erl_xcomp_ose_LM_POST_LINK="${OSEROOT}/bin/${HOST}/lm_post_link" + +# * `erl_xcomp_ose_LM_SET_CONF` - Sets the configuration for an OSE load module +erl_xcomp_ose_LM_SET_CONF="${OSEROOT}/bin/${HOST}/lm_set_conf" + +# * `erl_xcomp_ose_LM_ELF_SIZE` - OSE load module elf size tool +erl_xcomp_ose_LM_ELF_SIZE="${OSEROOT}/bin/${HOST}/lm_elf_size" + +# * `erl_xcomp_ose_LM_LCF` - OSE load module linker configuration file +erl_xcomp_ose_LM_LCF="${ERL_TOP}/erts/emulator/sys/ose/gcc_${GCCVERSION}_lm_ppc.lcf" + +# * `erl_xcomp_ose_BEAM_LM_CONF` - beam OSE load module configuration file +erl_xcomp_ose_BEAM_LM_CONF="${ERL_TOP}/erts/emulator/sys/ose/beam.lmconf" + +# * `erl_xcomp_ose_RUN_ERL_LM_CONF` - run_erl_lm OSE load module configuration file +erl_xcomp_ose_RUN_ERL_LM_CONF="${ERL_TOP}/erts/etc/ose/etc.lmconf" + +# * `erl_xcomp_ose_EPMD_LM_CONF` - epmd OSE load module configuration file +erl_xcomp_ose_EPMD_LM_CONF="${ERL_TOP}/erts/etc/ose/etc.lmconf" + +# * `erl_xcomp_ose_CONFD` - OSE confd source file +erl_xcomp_ose_CONFD="${OSEROOT}/src/ose_confd.c" + +# * `erl_xcomp_ose_CRT0_LM` - OSE crt0 lm source file +erl_xcomp_ose_CRT0_LM="${OSEROOT}/src/crt0_lm.c" + + +## ----------------------------------------------------------------------------- diff --git a/xcomp/erl-xcomp-sfk-linux-ose5.conf b/xcomp/erl-xcomp-sfk-linux-ose5.conf new file mode 100644 index 0000000000..a9c06f3cb4 --- /dev/null +++ b/xcomp/erl-xcomp-sfk-linux-ose5.conf @@ -0,0 +1,304 @@ +## -*-shell-script-*- +## +## %CopyrightBegin% +## +## Copyright Ericsson AB 2009-2012. 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% +## +## File: erl-xcomp-sfk-linux-ose5.conf +## Author: Petre Pircalabu +## +## ----------------------------------------------------------------------------- +## When cross compiling Erlang/OTP using `otp_build', copy this file and set +## the variables needed below. Then pass the path to the copy of this file as +## an argument to `otp_build' in the configure stage: +## `otp_build configure --xcomp-conf=<FILE>' +## ----------------------------------------------------------------------------- + +## Note that you cannot define arbitrary variables in a cross compilation +## configuration file. Only the ones listed below will be guaranteed to be +## visible throughout the whole execution of all `configure' scripts. Other +## variables needs to be defined as arguments to `configure' or exported in +## the environment. + +## -- Variables needed for an OSE5 build --------------------------------------- +OSEROOT="/vobs/ose5/system" +HOST="linux" +GCCVERSION="4.6.3" +GCCROOT="${OSEROOT}/gcc_linux_x86_${GCCVERSION}" +GCCTARGET="i386-elf" + +## -- Variables for `otp_build' Only ------------------------------------------- + +## Variables in this section are only used, when configuring Erlang/OTP for +## cross compilation using `$ERL_TOP/otp_build configure'. + +## *NOTE*! These variables currently have *no* effect if you configure using +## the `configure' script directly. + +# * `erl_xcomp_build' - The build system used. This value will be passed as +# `--build=$erl_xcomp_build' argument to the `configure' script. It does +# not have to be a full `CPU-VENDOR-OS' triplet, but can be. The full +# `CPU-VENDOR-OS' triplet will be created by +# `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_build'. If set to `guess', +# the build system will be guessed using +# `$ERL_TOP/erts/autoconf/config.guess'. +erl_xcomp_build=guess + +# * `erl_xcomp_host' - Cross host/target system to build for. This value will +# be passed as `--host=$erl_xcomp_host' argument to the `configure' script. +# It does not have to be a full `CPU-VENDOR-OS' triplet, but can be. The +# full `CPU-VENDOR-OS' triplet will be created by +# `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_host'. +erl_xcomp_host="$GCCTARGET-ose" + +# * `erl_xcomp_configure_flags' - Extra configure flags to pass to the +# `configure' script. +erl_xcomp_configure_flags="--disable-threads --disable-smp-support --disable-kernel-poll --disable-hipe --without-termcap --without-javac --disable-dynamic-ssl-lib --disable-shared-zlib --without-ssl --enable-static-nifs --enable-static-nifs=$ERL_TOP/lib/asn1/priv/lib/powerpc-unknown-ose/asn1rt_nif.a" + +## -- Cross Compiler and Other Tools ------------------------------------------- + +## If the cross compilation tools are prefixed by `<HOST>-' you probably do +## not need to set these variables (where `<HOST>' is what has been passed as +## `--host=<HOST>' argument to `configure'). + +## All variables in this section can also be used when native compiling. + +# * `CC' - C compiler. +CC="$GCCROOT/bin/$GCCTARGET-gcc" + +# * `CFLAGS' - C compiler flags. +CFLAGS="-g -fno-strict-aliasing -fno-builtin -fshort-wchar -Wall -Wno-unknown-pragmas -I$GCCROOT/include/c++/$GCCVERSION -I$OSEROOT/include -I$OSEROOT/include/ose_spi -I$OSEROOT/include/gcc -MD -MP -D__OSE__ -DLITTLE_ENDIAN -DCF_CONF_SIZE=0x800" + +# * `STATIC_CFLAGS' - Static C compiler flags. +#STATIC_CFLAGS= + +# * `CFLAG_RUNTIME_LIBRARY_PATH' - This flag should set runtime library +# search path for the shared libraries. Note that this actually is a +# linker flag, but it needs to be passed via the compiler. +#CFLAG_RUNTIME_LIBRARY_PATH= + +# * `CPP' - C pre-processor. +#CPP= + +# * `CPPFLAGS' - C pre-processor flags. +CPPFLAGS="-g -fno-strict-aliasing -fno-builtin -fshort-wchar -Wall -Wno-unknown-pragmas -I$GCCROOT/include/c++/$GCCVERSION -I$OSEROOT/include -I$OSEROOT/include/ose_spi -I$OSEROOT/include/gcc -MD -MP -D__OSE__ -DLITTLE_ENDIAN -DCF_CONF_SIZE=0x800" + +# * `CXX' - C++ compiler. +#CXX= + +# * `CXXFLAGS' - C++ compiler flags. +CXXFLAGS="-g -fno-strict-aliasing -ansi -I$GCCROOT/include/c++/$GCCVERSION -I$OSEROOT/include -I$OSEROOT/include/gcc " + +# * `LD' - Linker. +LD="$GCCROOT/bin/$GCCTARGET-ld" + +# * `LDFLAGS' - Linker flags. +LDFLAGS="-Wl,-ecrt0_lm -Wl,-T,$ERL_TOP/erts/emulator/sys/ose/gcc_lm_x86_$GCCVERSION.lcf" + +# * `LIBS' - Libraries. +LIBS="$OSEROOT/lib/x86/libcrt.a $OSEROOT/lib/x86/libm.a $GCCROOT/lib/gcc/$GCCTARGET/$GCCVERSION/libgcc.a" + +## -- *D*ynamic *E*rlang *D*river Linking -- + +## *NOTE*! Either set all or none of the `DED_LD*' variables. + +# * `DED_LD' - Linker for Dynamically loaded Erlang Drivers. +#DED_LD= + +# * `DED_LDFLAGS' - Linker flags to use with `DED_LD'. +#DED_LDFLAGS= + +# * `DED_LD_FLAG_RUNTIME_LIBRARY_PATH' - This flag should set runtime library +# search path for shared libraries when linking with `DED_LD'. +#DED_LD_FLAG_RUNTIME_LIBRARY_PATH= + +## -- Large File Support -- + +## *NOTE*! Either set all or none of the `LFS_*' variables. + +# * `LFS_CFLAGS' - Large file support C compiler flags. +#LFS_CFLAGS= + +# * `LFS_LDFLAGS' - Large file support linker flags. +#LFS_LDFLAGS= + +# * `LFS_LIBS' - Large file support libraries. +#LFS_LIBS= + +## -- Other Tools -- + +# * `RANLIB' - `ranlib' archive index tool. +RANLIB="$GCCROOT/bin/$GCCTARGET-ranlib" + +# * `AR' - `ar' archiving tool. +AR="$GCCROOT/bin/$GCCTARGET-ar" + +# * `STRIP' - `strip +STRIP="$GCCROOT/bin/$GCCTARGET-strip" + +# * `GETCONF' - `getconf' system configuration inspection tool. `getconf' is +# currently used for finding out large file support flags to use, and +# on Linux systems for finding out if we have an NPTL thread library or +# not. +#GETCONF= + +## -- Cross System Root Locations ---------------------------------------------- + +# * `erl_xcomp_sysroot' - The absolute path to the system root of the cross +# compilation environment. Currently, the `crypto', `odbc', `ssh' and +# `ssl' applications need the system root. These applications will be +# skipped if the system root has not been set. The system root might be +# needed for other things too. If this is the case and the system root +# has not been set, `configure' will fail and request you to set it. +erl_xcomp_sysroot="$OSEROOT" + +# * `erl_xcomp_isysroot' - The absolute path to the system root for includes +# of the cross compilation environment. If not set, this value defaults +# to `$erl_xcomp_sysroot', i.e., only set this value if the include system +# root path is not the same as the system root path. +erl_xcomp_isysroot="$OSEROOT/include" + +## -- Optional Feature, and Bug Tests ------------------------------------------ + +## These tests cannot (always) be done automatically when cross compiling. You +## usually do not need to set these variables. Only set these if you really +## know what you are doing. + +## Note that some of these values will override results of tests performed +## by `configure', and some will not be used until `configure' is sure that +## it cannot figure the result out. + +## The `configure' script will issue a warning when a default value is used. +## When a variable has been set, no warning will be issued. + +# * `erl_xcomp_after_morecore_hook' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `__after_morecore_hook' that can be +# used for tracking used `malloc()' implementations core memory usage. +# This is currently only used by unsupported features. +#erl_xcomp_after_morecore_hook= + +# * `erl_xcomp_bigendian' - `yes|no'. No default. If `yes', the target system +# must be big endian. If `no', little endian. This can often be +# automatically detected, but not always. If not automatically detected, +# `configure' will fail unless this variable is set. Since no default +# value is used, `configure' will try to figure this out automatically. +#erl_xcomp_bigendian= + +# * `erl_xcomp_double_middle` - `yes|no`. No default. If `yes`, the +# target system must have doubles in "middle-endian" format. If +# `no`, it has "regular" endianness. This can often be automatically +# detected, but not always. If not automatically detected, +# `configure` will fail unless this variable is set. Since no +# default value is used, `configure` will try to figure this out +# automatically. +#erl_xcomp_double_middle_endian + +# * `erl_xcomp_clock_gettime_cpu_time' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `clock_gettime()' implementation +# that can be used for retrieving process CPU time. +#erl_xcomp_clock_gettime_cpu_time= + +# * `erl_xcomp_getaddrinfo' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a working `getaddrinfo()' implementation that can +# handle both IPv4 and IPv6. +#erl_xcomp_getaddrinfo= + +# * `erl_xcomp_gethrvtime_procfs_ioctl' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `gethrvtime()' implementation and +# is used with procfs `ioctl()'. +#erl_xcomp_gethrvtime_procfs_ioctl= + +# * `erl_xcomp_dlsym_brk_wrappers' - `yes|no'. Defaults to `no'. If `yes', the +# target system must have a working `dlsym(RTLD_NEXT, <S>)' implementation +# that can be used on `brk' and `sbrk' symbols used by the `malloc()' +# implementation in use, and by this track the `malloc()' implementations +# core memory usage. This is currently only used by unsupported features. +#erl_xcomp_dlsym_brk_wrappers= + +# * `erl_xcomp_kqueue' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a working `kqueue()' implementation that returns a file +# descriptor which can be used by `poll()' and/or `select()'. If `no' and +# the target system has not got `epoll()' or `/dev/poll', the kernel-poll +# feature will be disabled. +#erl_xcomp_kqueue= + +# * `erl_xcomp_linux_clock_gettime_correction' - `yes|no'. Defaults to `yes' on +# Linux; otherwise, `no'. If `yes', `clock_gettime(CLOCK_MONOTONIC, _)' on +# the target system must work. This variable is recommended to be set to +# `no' on Linux systems with kernel versions less than 2.6. +#erl_xcomp_linux_clock_gettime_correction= + +# * `erl_xcomp_linux_nptl' - `yes|no'. Defaults to `yes' on Linux; otherwise, +# `no'. If `yes', the target system must have NPTL (Native POSIX Thread +# Library). Older Linux systems have LinuxThreads instead of NPTL (Linux +# kernel versions typically less than 2.6). +#erl_xcomp_linux_nptl= + +# * `erl_xcomp_linux_usable_sigaltstack' - `yes|no'. Defaults to `yes' on Linux; +# otherwise, `no'. If `yes', `sigaltstack()' must be usable on the target +# system. `sigaltstack()' on Linux kernel versions less than 2.4 are +# broken. +#erl_xcomp_linux_usable_sigaltstack= + +# * `erl_xcomp_linux_usable_sigusrx' - `yes|no'. Defaults to `yes'. If `yes', +# the `SIGUSR1' and `SIGUSR2' signals must be usable by the ERTS. Old +# LinuxThreads thread libraries (Linux kernel versions typically less than +# 2.2) used these signals and made them unusable by the ERTS. +#erl_xcomp_linux_usable_sigusrx= + +# * `erl_xcomp_poll' - `yes|no'. Defaults to `no' on Darwin/MacOSX; otherwise, +# `yes'. If `yes', the target system must have a working `poll()' +# implementation that also can handle devices. If `no', `select()' will be +# used instead of `poll()'. +erl_xcomp_poll=no + +# * `erl_xcomp_putenv_copy' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a `putenv()' implementation that stores a copy of the +# key/value pair. +#erl_xcomp_putenv_copy= + +# * `erl_xcomp_reliable_fpe' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have reliable floating point exceptions. +#erl_xcomp_reliable_fpe= + +# * `erl_xcomp_ose_ldflags_pass1` - Linker flags for the OSE module (pass 1) +erl_xcomp_ose_ldflags_pass1="-r --no-omagic" + +# * `erl_xcomp_ose_ldflags_pass2` - Linker flags for the OSE module (pass 2) +erl_xcomp_ose_ldflags_pass2="-n --emit-relocs -ecrt0_lm --no-omagic" + +# * `erl_xcomp_ose_OSEROOT` - OSE installation root directory +erl_xcomp_ose_OSEROOT="$OSEROOT" + +# * `erl_xcomp_ose_STRIP` - Strip utility shipped with the OSE distribution +erl_xcomp_ose_STRIP="$GCCROOT/bin/$GCCTARGET-strip" + +# * `erl_xcomp_ose_LM_POST_LINK` - OSE postlink tool +erl_xcomp_ose_LM_POST_LINK="$OSEROOT/bin/$HOST/lm_post_link" + +# * `erl_xcomp_ose_LM_SET_CONF` - OSE load module configuration tool +erl_xcomp_ose_LM_SET_CONF="$OSEROOT/bin/$HOST/lm_set_conf" + +# * `erl_xcomp_ose_LM_GET_CONF` - OSE load module elf size tool +erl_xcomp_ose_LM_ELF_SIZE="$OSEROOT/bin/$HOST/lm_elf_size" + +# * `erl_xcomp_ose_LM_LCF` - OSE load module linker configuration file +erl_xcomp_ose_LM_LCF="${ERL_TOP}/erts/emulator/sys/ose/gcc_lm_x86_$GCCVERSION.lcf" + +# * `erl_xcomp_ose_LM_CONF` - OSE load module default configuration file +erl_xcomp_ose_LM_CONF="${ERL_TOP}/erts/emulator/sys/ose/default.lmconf" + +## ----------------------------------------------------------------------------- diff --git a/xcomp/erl-xcomp-vars.sh b/xcomp/erl-xcomp-vars.sh index 337e0fb809..5e55c3af1b 100644 --- a/xcomp/erl-xcomp-vars.sh +++ b/xcomp/erl-xcomp-vars.sh @@ -26,4 +26,4 @@ # and precious variables in $ERL_TOP/erts/aclocal.m4. # -erl_xcomp_vars="erl_xcomp_sysroot erl_xcomp_isysroot erl_xcomp_bigendian erl_xcomp_double_middle_endian erl_xcomp_linux_clock_gettime_correction erl_xcomp_linux_nptl erl_xcomp_linux_usable_sigusrx erl_xcomp_linux_usable_sigaltstack erl_xcomp_poll erl_xcomp_kqueue erl_xcomp_putenv_copy erl_xcomp_reliable_fpe erl_xcomp_getaddrinfo erl_xcomp_gethrvtime_procfs_ioctl erl_xcomp_clock_gettime_cpu_time erl_xcomp_after_morecore_hook erl_xcomp_dlsym_brk_wrappers erl_xcomp_posix_memalign" +erl_xcomp_vars="erl_xcomp_sysroot erl_xcomp_isysroot erl_xcomp_bigendian erl_xcomp_double_middle_endian erl_xcomp_linux_clock_gettime_correction erl_xcomp_linux_nptl erl_xcomp_linux_usable_sigusrx erl_xcomp_linux_usable_sigaltstack erl_xcomp_poll erl_xcomp_kqueue erl_xcomp_putenv_copy erl_xcomp_reliable_fpe erl_xcomp_getaddrinfo erl_xcomp_gethrvtime_procfs_ioctl erl_xcomp_clock_gettime_cpu_time erl_xcomp_after_morecore_hook erl_xcomp_dlsym_brk_wrappers erl_xcomp_posix_memalign erl_xcomp_ose_ldflags_pass1 erl_xcomp_ose_ldflags_pass2 erl_xcomp_ose_OSEROOT erl_xcomp_ose_STRIP erl_xcomp_ose_LM_POST_LINK erl_xcomp_ose_LM_SET_CONF erl_xcomp_ose_LM_GET_CONF erl_xcomp_ose_LM_ELF_SIZE erl_xcomp_ose_LM_LCF erl_xcomp_ose_BEAM_LM_CONF erl_xcomp_ose_EPMD_LM_CONF erl_xcomp_ose_RUN_ERL_LM_CONF erl_xcomp_ose_CONFD erl_xcomp_ose_CRT0_LM" |